mescc: Use records for Guile: <global>.

* module/language/c99/info.scm (<global>): New record.
* module/language/c99/compiler.mes (make-global-entry): Rename from
  make-global.  Update callers.
* module/language/c99/info.mes (make-global, global:type,
  global:pointer, global:value): Move from compiler.mes.
This commit is contained in:
Jan Nieuwenhuizen 2017-07-15 11:24:14 +02:00
parent c0fb6d247d
commit d2650c8ebf
3 changed files with 48 additions and 29 deletions

View File

@ -203,21 +203,17 @@
(wrap-as (i386:push-byte-local-de-de-ref (local:id o))) (wrap-as (i386:push-byte-local-de-de-ref (local:id o)))
(error "TODO int-de-de-ref"))))) (error "TODO int-de-de-ref")))))
(define (make-global name type pointer value) (define (make-global-entry key type pointer value)
(cons name (list type pointer value))) (cons key (make-global type pointer value)))
(define global:type car) (define (string->global-entry string)
(define global:pointer cadr) (make-global-entry `(#:string ,string) "string" 0 (append (string->list string) (list #\nul))))
(define global:value caddr)
(define (string->global string) (define (int->global-entry value)
(make-global `(#:string ,string) "string" 0 (append (string->list string) (list #\nul)))) (make-global-entry (number->string value) "int" 0 (int->bv32 value)))
(define (int->global value) (define (ident->global-entry name type pointer value)
(make-global (number->string value) "int" 0 (int->bv32 value))) (make-global-entry name type pointer (if (pair? value) value (int->bv32 value))))
(define (ident->global name type pointer value)
(make-global name type pointer (if (pair? value) value (int->bv32 value))))
(define (make-local name type pointer id) (define (make-local name type pointer id)
(cons name (list type pointer id))) (cons name (list type pointer id)))
@ -274,7 +270,7 @@
(lambda (o) (lambda (o)
(let ((string `(#:string ,o))) (let ((string `(#:string ,o)))
(if (assoc-ref globals string) globals (if (assoc-ref globals string) globals
(append globals (list (string->global o))))))) (append globals (list (string->global-entry o)))))))
(define (expr->arg info) ;; FIXME: get Mes curried-definitions (define (expr->arg info) ;; FIXME: get Mes curried-definitions
(lambda (o) (lambda (o)
@ -1132,7 +1128,9 @@
(assoc-ref (.functions info) o)))) (assoc-ref (.functions info) o))))
(define (ident->type info o) (define (ident->type info o)
(and=> (ident->decl info o) car)) (let ((type (ident->decl info o)))
(cond ((global? type) (global:type type))
(else (car type)))))
(define (ident->pointer info o) (define (ident->pointer info o)
(let ((local (assoc-ref (.locals info) o))) (let ((local (assoc-ref (.locals info) o)))
@ -1379,14 +1377,14 @@
(let ((type "int")) ;; FIXME (let ((type "int")) ;; FIXME
(if (.function info) (if (.function info)
(clone info #:locals (add-local locals name type 0)) (clone info #:locals (add-local locals name type 0))
(clone info #:globals (append globals (list (ident->global name type 0 0))))))) (clone info #:globals (append globals (list (ident->global-entry name type 0 0)))))))
;; char **p; ;; char **p;
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer (pointer)) (ident ,name))))) ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
(if (.function info) (if (.function info)
(let ((locals (add-local locals name type 2))) (let ((locals (add-local locals name type 2)))
(clone info #:locals locals)) (clone info #:locals locals))
(let ((globals (append globals (list (ident->global name type 2 0))))) (let ((globals (append globals (list (ident->global-entry name type 2 0)))))
(clone info #:globals globals)))) (clone info #:globals globals))))
;; struct foo bar[2]; ;; struct foo bar[2];
@ -1404,7 +1402,7 @@
(let* ((globals (.globals info)) (let* ((globals (.globals info))
(count (cstring->number count)) (count (cstring->number count))
(size (type->size info type)) (size (type->size info type))
(array (make-global name type -1 (string->list (make-string (* count size) #\nul)))) (array (make-global-entry name type -1 (string->list (make-string (* count size) #\nul))))
(globals (append globals (list array)))) (globals (append globals (list array))))
(clone info #:globals globals))))) (clone info #:globals globals)))))
@ -1422,7 +1420,7 @@
(let* ((globals (.globals info)) (let* ((globals (.globals info))
(count (cstring->number count)) (count (cstring->number count))
(size (type->size info type)) (size (type->size info type))
(array (make-global name type 1 (string->list (make-string (* count size) #\nul)))) (array (make-global-entry name type 1 (string->list (make-string (* count size) #\nul))))
(globals (append globals (list array)))) (globals (append globals (list array))))
(clone info #:globals globals))))) (clone info #:globals globals)))))
@ -1449,7 +1447,7 @@
(info (clone info #:locals locals))) (info (clone info #:locals locals)))
(append-text info (append ((ident->accu info) value) (append-text info (append ((ident->accu info) value)
((accu->ident info) name)))) ((accu->ident info) name))))
(let ((globals (append globals (list (ident->global name type 1 `(,value #f #f #f)))))) (let ((globals (append globals (list (ident->global-entry name type 1 `(,value #f #f #f))))))
(clone info #:globals globals))))) (clone info #:globals globals)))))
;; enum foo { }; ;; enum foo { };
@ -1513,7 +1511,7 @@
(global-names (map car globals)) (global-names (map car globals))
(initzer-globals (filter (lambda (g) (and g (not (member (car g) global-names)))) initzer-globals)) (initzer-globals (filter (lambda (g) (and g (not (member (car g) global-names)))) initzer-globals))
(globals (append globals initzer-globals)) (globals (append globals initzer-globals))
(global (make-global name type 2 (append-map (initzer->data info) initzers))) (global (make-global-entry name type 2 (append-map (initzer->data info) initzers)))
(globals (append globals (list global)))) (globals (append globals (list global))))
(clone info #:globals globals))))) (clone info #:globals globals)))))
@ -1535,8 +1533,8 @@
(initzers (map (initzer->non-const info) initzers))) (initzers (map (initzer->non-const info) initzers)))
(if (.function info) (if (.function info)
(error "TODO: <type> x[] = {};" o) (error "TODO: <type> x[] = {};" o)
(let* ( ;;(global (make-global name type 2 (string->list (make-string size #\nul)))) (let* ( ;;(global (make-global-entry name type 2 (string->list (make-string size #\nul))))
(global (make-global name type 2 (append-map (initzer->data info) initzers))) (global (make-global-entry name type 2 (append-map (initzer->data info) initzers)))
(global-names (map car globals)) (global-names (map car globals))
(entries (filter (lambda (g) (and g (not (member (car g) global-names)))) entries)) (entries (filter (lambda (g) (and g (not (member (car g) global-names)))) entries))
(globals (append globals entries (list global)))) (globals (append globals entries (list global))))
@ -1551,7 +1549,7 @@
(local (make-local name type -1 (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4)))) (local (make-local name type -1 (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4))))
(locals (cons local locals))) (locals (cons local locals)))
(clone info #:locals locals)))) (clone info #:locals locals))))
(clone info #:globals (append globals (list (ident->global name type 0 0)))))) (clone info #:globals (append globals (list (ident->global-entry name type 0 0))))))
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr ,init . ,initzer))) ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr ,init . ,initzer)))
(let* ((info (type->info info type)) (let* ((info (type->info info type))
@ -1574,8 +1572,8 @@
(info (if (null? initzer) info (append-text info ((accu->ident info) name))))) (info (if (null? initzer) info (append-text info ((accu->ident info) name)))))
info) info)
(let* ((pointer (if (and (pair? type) (equal? (car type) "struct")) 2 pointer)) (let* ((pointer (if (and (pair? type) (equal? (car type) "struct")) 2 pointer))
(global (make-global name type pointer (if (null? initzer) (string->list (make-string size #\nul)) (global (make-global-entry name type pointer (if (null? initzer) (string->list (make-string size #\nul))
(append-map (initzer->data info) initzer)))) (append-map (initzer->data info) initzer))))
(globals (append globals (list global)))) (globals (append globals (list global))))
(clone info #:globals globals))))) (clone info #:globals globals)))))
@ -1853,8 +1851,8 @@
((p-expr (string ,string)) ((p-expr (string ,string))
(let ((g `(#:string ,string))) (let ((g `(#:string ,string)))
(or (assoc g globals) (or (assoc g globals)
(string->global string)))) (string->global-entry string))))
;;((p-expr (fixed ,value)) (int->global (cstring->number value))) ;;((p-expr (fixed ,value)) (int->global-entry (cstring->number value)))
(_ #f)))) (_ #f))))
(define (initzer->globals globals) (define (initzer->globals globals)

View File

@ -102,3 +102,10 @@
(define type:size cadr) (define type:size cadr)
(define type:pointer caddr) (define type:pointer caddr)
(define type:description cadddr) (define type:description cadddr)
(define (make-global name type pointer value)
(cons name (list type pointer value)))
(define global:type car)
(define global:pointer cadr)
(define global:value caddr)

View File

@ -30,7 +30,6 @@
#:export (<info> #:export (<info>
make make
make-<info> make-<info>
make-type
info? info?
.types .types
@ -43,10 +42,18 @@
.break .break
.continue .continue
make-type
type?
type:type type:type
type:size type:size
type:pointer type:pointer
type:description)) type:description
make-global
global?
global:type
global:pointer
global:value))
(cond-expand (cond-expand
(guile-2) (guile-2)
@ -77,3 +84,10 @@
(size type:size) (size type:size)
(pointer type:pointer) (pointer type:pointer)
(description type:description)) (description type:description))
(define-immutable-record-type <global>
(make-global type pointer value)
global?
(type global:type)
(pointer global:pointer)
(value global:value))