mescc: Refactor type system: WIP

* module/language/c99/compiler.mes (): WIP
* module/language/c99/info.scm (): WIP

diff --git a/build-aux/check-mescc.sh b/build-aux/check-mescc.sh
index dd2d5b62d78efda4bbbdb3b9df76aa49ed0c5830..2f52620dafbe0b292644d943a51508638878c1e6 100755 (executable)
--- a/build-aux/check-mescc.sh
+++ b/build-aux/check-mescc.sh
@@ -232,9 +232,6 @@ broken="$broken
 42_function_pointer
 46_grep
 49_bracket_evaluation
-
-52_unnamed_enum
-55_lshift_type
 "
 
 #22_floating_point       ; float

diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes
index 7947a019396293186b0e68030821466fe70a12b3..c810ee9fde81175635411935794ec650dfad9fb4 100644 (file)
--- a/module/language/c99/compiler.mes
+++ b/module/language/c99/compiler.mes
@@ -138,7 +138,6 @@
   (cons `(tag ,name) (make-type 'enum 4 fields)))
 
 (define (struct->type-entry name fields)
-  (stderr "struct->type-entry name=~s fields=~s\n" name fields)
   (let ((size (apply + (map (compose ->size cdr) fields))))
     (cons `(tag ,name) (make-type 'struct size fields))))
 
@@ -196,11 +195,137 @@
     ((,name . ,type) (->size type))
     (_ (error (format #f "field:size: ~s\n" o)))))
 
-(define (ast->type info o)
-  (let ((type (-><type> (ast-><type> o info))))
+(define (ast->type o info)
+  (define (type-helper o info)
+    (pmatch o
+      (,t (guard (type? t)) t)
+      (,p (guard (pointer? p)) p)
+      (,a (guard (c-array? a)) a)
+
+      ((char ,value) (get-type "char" info))
+      ((enum-ref . _) (get-type "int" info))
+      ((fixed ,value) (get-type "int" info))
+      ((sizeof-expr . _) (get-type "int" info))
+      ((sizeof-type . _) (get-type "int" info))
+      ((string _) (make-c-array (get-type "char" info) #f))
+      ((void) (get-type "void" info))
+
+      ((type-name ,type) (ast->type type info))
+      ((type-name ,type (abs-declr ,pointer))
+       (let ((rank (pointer->rank pointer)))
+         (rank+= (ast->type type info) rank)))
+
+      ((ident ,name) (ident->type info name))
+      ((tag ,name) (or (get-type o info)
+                       o))
+
+      (,name (guard (string? name))
+             (let ((type (get-type name info)))
+               (ast->type type info)))
+
+      ((fctn-call (p-expr (ident ,name)) . _) (or (ident->type info name)
+                                                  (get-type "int" info)))
+
+      ((fixed-type ,type) (ast->type type info))
+      ((float-type ,type) (ast->type type info))
+      ((type-spec ,type) (ast->type type info))
+      ((typename ,type) (ast->type type info))
+
+      ((array-ref ,index ,array) (rank-- (ast->type array info)))
+
+      ((de-ref ,expr) (rank-- (ast->type expr info)))
+      ((ref-to ,expr) (rank++ (ast->type expr info)))
+
+      ((p-expr ,expr) (ast->type expr info))
+      ((pre-inc ,expr) (ast->type expr info))
+      ((post-inc ,expr) (ast->type expr info))
+
+      ((struct-ref (ident ,type))
+       (or (get-type type info)
+           (let ((struct (if (pair? type) type `(tag ,type))))
+             (ast->type struct info))))
+      ((union-ref (ident ,type))
+       (or (get-type type info)
+           (let ((struct (if (pair? type) type `(tag ,type))))
+             (ast->type struct info))))
+
+      ((struct-def (ident ,name) . _)
+       (ast->type `(tag ,name) info))
+      ((union-def (ident ,name) . _)
+       (ast->type `(tag ,name) info))
+      ((struct-def (field-list . ,fields))
+       (let ((fields (append-map (struct-field info) fields)))
+         (make-type 'struct (apply + (map field:size fields)) fields)))
+      ((union-def (field-list . ,fields))
+       (let ((fields (append-map (struct-field info) fields)))
+         (make-type 'union (apply + (map field:size fields)) fields)))
+      ((enum-def (enum-def-list . ,fields))
+       (get-type "int" info))
+
+      ((d-sel (ident ,field) ,struct)
+       (let ((type0 (ast->type struct info)))
+         (ast->type (field-type info type0 field) info)))
+
+      ((i-sel (ident ,field) ,struct)
+       (let ((type0 (ast->type (rank-- (ast->type struct info)) info)))
+         (ast->type (field-type info type0 field) info)))
+
+      ;; arithmetic
+      ((pre-inc ,a) (ast->type a info))
+      ((pre-dec ,a) (ast->type a info))
+      ((post-inc ,a) (ast->type a info))
+      ((post-dec ,a) (ast->type a info))
+      ((add ,a ,b) (ast->type a info))
+      ((sub ,a ,b) (ast->type a info))
+      ((bitwise-and ,a ,b) (ast->type a info))
+      ((bitwise-not ,a) (ast->type a info))
+      ((bitwise-or ,a ,b) (ast->type a info))
+      ((bitwise-xor ,a ,b) (ast->type a info))
+      ((lshift ,a ,b) (ast->type a info))
+      ((rshift ,a ,b) (ast->type a info))
+      ((div ,a ,b) (ast->type a info))
+      ((mod ,a ,b) (ast->type a info))
+      ((mul ,a ,b) (ast->type a info))
+      ((not ,a) (ast->type a info))
+      ((neg ,a) (ast->type a info))
+      ((eq ,a ,b) (ast->type a info))
+      ((ge ,a ,b) (ast->type a info))
+      ((gt ,a ,b) (ast->type a info))
+      ((ne ,a ,b) (ast->type a info))
+      ((le ,a ,b) (ast->type a info))
+      ((lt ,a ,b) (ast->type a info))
+
+      ;; logical
+      ((or ,a ,b) (ast->type a info))
+      ((and ,a ,b) (ast->type a info))
+
+      ((cast (type-name ,type) ,expr) (ast->type type info))
+
+      ((cast (type-name ,type (abs-declr ,pointer)) ,expr)
+       (let ((rank (pointer->rank pointer)))
+         (rank+= (ast->type type info) rank)))
+
+      ((decl-spec-list (type-spec ,type))
+       (ast->type type info))
+      ((assn-expr ,a ,op ,b)
+       (ast->type a info))
+
+      (_ (get-type o info))))
+
+  (let ((type (type-helper o info)))
+    (cond ((or (type? type)
+               (pointer? type) type
+               (c-array? type)) type)
+          ((and (equal? type o) (pair? type) (eq? (car type) 'tag)) o)
+          ((equal? type o)
+           (error "ast->type: not supported: " o))
+          (else (ast->type type info)))))
+
+(define (ast->basic-type o info)
+  (let ((type (->type (ast->type o info))))
     (cond ((type? type) type)
           ((equal? type o) o)
-          (else (ast->type info type)))))
+          (else (ast->type type info)))))
 
 (define (get-type o info)
   (let ((t (assoc-ref (.types info) o)))
@@ -208,132 +333,15 @@
       ((typedef ,next) (or (get-type next info) o))
       (_ t))))
 
-(define (ast-><type> o info)
-  (pmatch o
-    (,t (guard (type? t)) t)
-    (,p (guard (pointer? p)) p)
-    (,a (guard (c-array? a)) a)
-
-    ((char ,value) (get-type "char" info))
-    ((enum-ref . _) (get-type "int" info))
-    ((fixed ,value) (get-type "int" info))
-    ((sizeof-expr . _) (get-type "int" info))
-    ((sizeof-type . _) (get-type "int" info))
-    ((string _) (make-c-array (get-type "char" info) #f))
-    ((void) (get-type "void" info))
-
-    ((ident ,name) (ident->type info name))
-    ((fctn-call (p-expr (ident ,name)) . _) (ident->type info name))
-
-
-    ((fixed-type ,type) (ast-><type> type info))
-    ((float-type ,type) (ast-><type> type info))
-    ((typename ,type) (ast-><type> type info))
-
-    ((array-ref ,index ,array) (rank-- (ast-><type> array info)))
-
-    ((de-ref ,expr) (rank-- (ast-><type> expr info)))
-    ((ref-to ,expr) (rank++ (ast-><type> expr info)))
-
-    ((p-expr ,expr) (ast-><type> expr info))
-    ((pre-inc ,expr) (ast-><type> expr info))
-    ((post-inc ,expr) (ast-><type> expr info))
-
-    ((type-spec (typename ,type)) (ast-><type> type info))
-
-    ((struct-ref (ident ,type))
-     (or (get-type type info)
-         (let ((struct (if (pair? type) type `(tag ,type))))
-           (ast-><type> struct info))))
-    ((union-ref (ident ,type))
-     (or (get-type type info)
-         (let ((struct (if (pair? type) type `(tag ,type))))
-           (ast-><type> struct info))))
-
-    ;;;
-    ((struct-def (ident ,name) . _)
-     (ast-><type> `(tag ,name) info))
-    ((union-def (ident ,name) . _)
-     (ast-><type> `(tag ,name) info))
-    ((struct-def (field-list . ,fields))
-     (let ((fields (append-map (struct-field info) fields)))
-       (make-type 'struct (apply + (map field:size fields)) fields)))
-    ((union-def (field-list . ,fields))
-     (let ((fields (append-map (struct-field info) fields)))
-       (make-type 'union (apply + (map field:size fields)) fields)))
-
-
-
-    ((d-sel (ident ,field) ,struct)
-     (let ((type0 (ast-><type> struct info)))
-       (ast-><type> (field-type info type0 field) info)))
-    ((i-sel (ident ,field) ,struct)
-     (let ((type0 (ast-><type> struct info)))
-       (ast-><type> (field-type info type0 field) info)))
-
-    ;; arithmetic
-    ((pre-inc ,a) (ast-><type> a info))
-    ((pre-dec ,a) (ast-><type> a info))
-    ((post-inc ,a) (ast-><type> a info))
-    ((post-dec ,a) (ast-><type> a info))
-    ((add ,a ,b) (ast-><type> a info))
-    ((sub ,a ,b) (ast-><type> a info))
-    ((bitwise-and ,a ,b) (ast-><type> a info))
-    ((bitwise-not ,a) (ast-><type> a info))
-    ((bitwise-or ,a ,b) (ast-><type> a info))
-    ((bitwise-xor ,a ,b) (ast-><type> a info))
-    ((lshift ,a ,b) (ast-><type> a info))
-    ((rshift ,a ,b) (ast-><type> a info))
-    ((div ,a ,b) (ast-><type> a info))
-    ((mod ,a ,b) (ast-><type> a info))
-    ((mul ,a ,b) (ast-><type> a info))
-    ((not ,a) (ast-><type> a info))
-    ((neg ,a) (ast-><type> a info))
-    ((eq ,a ,b) (ast-><type> a info))
-    ((ge ,a ,b) (ast-><type> a info))
-    ((gt ,a ,b) (ast-><type> a info))
-    ((ne ,a ,b) (ast-><type> a info))
-    ((le ,a ,b) (ast-><type> a info))
-    ((lt ,a ,b) (ast-><type> a info))
-
-    ;; logical
-    ((or ,a ,b) (ast-><type> a info))
-    ((and ,a ,b) (ast-><type> a info))
-
-
-    ((cast (type-name ,type) ,expr)     ; FIXME: ignore expr?
-     (ast-><type> type info))
-    ((cast (type-name ,type (abs-declr ,pointer)) ,expr) ; FIXME: ignore expr?
-     (ast-><type> type info))
-
-    ((decl-spec-list (type-spec ,type))
-     (ast-><type> type info))
-    ((assn-expr ,a ,op ,b)
-     (ast-><type> a info))
-
-
-    (_ (let ((type (get-type o info)))
-         (cond ((type? type) type)
-               ((and (pair? type) (eq? (car type) 'tag))
-                (stderr "NO STRUCT YET:~s\n" (.types info))
-                type)
-               ((and (pair? o) (eq? (car o) 'tag))
-                (stderr "NO STRUCT YET:~s\n" (.types info))
-                o)
-               (else
-                (stderr "types: ~s\n" (.types info))
-                (error "ast->type: not supported: " o)))))))
-
-(define (ast-type->description info o)
-  ((compose type:description (cut ast->type info <>) o)))
 
 (define (ast-type->size info o)
-  ((compose type:size -><type> (cut ast->type info <>)) o))
+  (let ((type (->type (ast->type o info))))
+    (cond ((type? type) (type:size type))
+          (else (stderr "ast-type->size barf: ~s => ~s\n" o type)
+                4))))
 
 (define (field-field info struct field)
-  (let* ((xtype (if (type? struct) struct
-                    (ast->type info struct)))
-         (fields (type:description xtype)))
+  (let* ((fields (type:description struct)))
     (let loop ((fields fields))
       (if (null? fields) (error (format #f "no such field: ~a in ~s" field struct))
           (let ((f (car fields)))
@@ -343,42 +351,38 @@
                   (else (loop (cdr fields)))))))))
 
 (define (field-offset info struct field)
-  (let ((xtype (if (type? struct) struct
-                   (ast->type info struct))))
-    (if (eq? (type:type xtype) 'union) 0
-        (let ((fields (type:description xtype)))
-          (let loop ((fields fields) (offset 0))
-            (if (null? fields) (error (format #f "no such field: ~a in ~s" field struct))
-                (let ((f (car fields)))
-                  (cond ((equal? (car f) field) offset)
-                        ((and (eq? (car f) 'struct) (type? (cdr f)))
-                         (let ((fields (type:description (cdr f))))
-                           (find (lambda (x) (equal? (car x) field)) fields)
-                           (apply + (cons offset
-                                          (map field:size
-                                               (member field (reverse fields)
-                                                       (lambda (a b)
-                                                         (equal? a (car b) field))))))))
-                        ((and (eq? (car f) 'union) (type? (cdr f)))
-                         (let ((fields (type:description (cdr f))))
-                           (find (lambda (x) (equal? (car x) field)) fields)
-                           offset))
-                        (else (loop (cdr fields) (+ offset (field:size f))))))))))))
+  (if (eq? (type:type struct) 'union) 0
+      (let ((fields (type:description struct)))
+        (let loop ((fields fields) (offset 0))
+          (if (null? fields) (error (format #f "no such field: ~a in ~s" field struct))
+              (let ((f (car fields)))
+                (cond ((equal? (car f) field) offset)
+                      ((and (eq? (car f) 'struct) (type? (cdr f)))
+                       (let ((fields (type:description (cdr f))))
+                         (find (lambda (x) (equal? (car x) field)) fields)
+                         (apply + (cons offset
+                                        (map field:size
+                                             (member field (reverse fields)
+                                                     (lambda (a b)
+                                                       (equal? a (car b) field))))))))
+                      ((and (eq? (car f) 'union) (type? (cdr f)))
+                       (let ((fields (type:description (cdr f))))
+                         (find (lambda (x) (equal? (car x) field)) fields)
+                         offset))
+                      (else (loop (cdr fields) (+ offset (field:size f)))))))))))
 
 (define (field-pointer info struct field)
   (let ((field (field-field info struct field)))
     (field:pointer field)))
 
 (define (field-size info struct field)
-  (let ((xtype (if (type? struct) struct
-                   (ast->type info struct))))
-    (if (eq? (type:type xtype) 'union) 0
-        (let ((field (field-field info struct field)))
-          (field:size field)))))
+  (if (eq? (type:type struct) 'union) 0
+      (let ((field (field-field info struct field)))
+        (field:size field))))
 
 (define (field-type info struct field)
   (let ((field (field-field info struct field)))
-    (cdr field)))
+    (ast->type (cdr field) info)))
 
 (define (struct->fields o)
   (pmatch o
@@ -401,14 +405,21 @@
 
 (define (ident->variable info o)
   (or (assoc-ref (.locals info) o)
-      (assoc-ref (.globals info) o)
       (assoc-ref (.statics info) o)
+      (assoc-ref (filter (negate static-global?) (.globals info)) o)
       (assoc-ref (.constants info) o)
       (assoc-ref (.functions info) o)
       (begin
         (stderr "info=~s\n" info)
         (error "ident->variable: undefined variabled:" o))))
 
+(define (static-global? o)
+  ((compose global:function cdr) o))
+
+(define (string-global? o)
+  (and (pair? (car o))
+       (eq? (caar o) #:string)))
+
 (define (ident->type info o)
   (let ((var (ident->variable info o)))
     (cond ((global? var) (global:type var))
@@ -419,128 +430,33 @@
           (else (stderr "ident->type ~s => ~s\n" o var)
                 #f))))
 
+(define (local:pointer o)
+  (->rank o))
+
 (define (ident->rank info o)
-  (let ((local (assoc-ref (.locals info) o)))
-    (if local (let* ((t 0 ;; <pointer> ((compose type:pointer local:type) local)
-                        )
-                     (v (local:pointer local))
-                     (p (+ (abs t) (abs v))))
-                (if (or (< t 0) (< v 0)) (- p) p))
-        (let ((global (assoc-ref (.globals info) o)))
-          (if global
-              (let* ((t 0 ;; <pointer> ((compose type:pointer global:type) global)
-                        )
-                     (v (global:pointer global))
-                     (p (+ (abs t) (abs v))))
-                (if (or (< t 0) (< v 0)) (- p) p))
-              0)))))
+  (->rank (ident->variable info o)))
 
 (define (ident->size info o)
-    ((compose type:size (cut ident->type info <>)) o))
-
-(define (ptr-inc o)
-  (if (< o 0) (1- o)
-      (1+ o)))
-
-(define (ptr-dec o)
-  (if (< o 0) (1+ o)
-      (1- o)))
+  ((compose type:size (cut ident->type info <>)) o))
 
-(define (pointer->ptr o)
+(define (pointer->rank o)
   (pmatch o
     ((pointer) 1)
-    ((pointer ,pointer) (1+ (pointer->ptr pointer)))))
+    ((pointer ,pointer) (1+ (pointer->rank pointer)))))
 
 (define (expr->rank info o)
-  (pmatch o
-    ((pointer . _) (pointer->ptr o))
-    ((p-expr (char ,value)) 0)
-    ((p-expr (fixed ,value)) 0)
-    ((ident ,name) (ident->rank info name))
-    ((p-expr ,expr) (expr->rank info expr))
-    ((de-ref ,expr) (ptr-dec (expr->rank info expr)))
-    ((assn-expr ,lhs ,op ,rhs) (expr->rank info lhs))
-    ((add ,a ,b) (expr->rank info a))
-    ((div ,a ,b) (expr->rank info a))
-    ((mod ,a ,b) (expr->rank info a))
-    ((mul ,a ,b) (expr->rank info a))
-    ((sub ,a ,b) (expr->rank info a))
-    ((neg ,a) (expr->rank info a))
-    ((pre-inc ,a) (expr->rank info a))
-    ((pre-dec ,a) (expr->rank info a))
-    ((post-inc ,a) (expr->rank info a))
-    ((post-dec ,a) (expr->rank info a))
-    ((ref-to ,expr) (ptr-inc (expr->rank info expr)))
-    ((array-ref ,index ,array)
-     (ptr-dec (abs (expr->rank info array))))
-
-    ((d-sel (ident ,field) ,struct)
-     (let ((type (ast->type info struct)))
-       (field-pointer info type field)))
+  (->rank (ast->type o info)))
 
-    ((i-sel (ident ,field) ,struct)
-     (let ((type (ast->type info struct)))
-       (field-pointer info type field)))
-
-    ((cast (type-name ,type) ,expr)     ; FIXME: add expr?
-     (let* ((type (ast->type info type)))
-       (->rank type)))
-    ((cast (type-name ,type (abs-declr ,pointer)) ,expr) ; FIXME: add expr?
-     (let* ((type (ast->type info type))
-            (pointer0 (->rank type))
-            (pointer1 (ptr-declr->rank pointer))
-            (pointer2 (expr->rank info expr)))
-       (+ pointer0 pointer1)))
-    ((type-spec ,type)
-     (or (and=> (ast->type info o) ->rank)
-         (begin
-           (stderr "expr->rank: not supported: ~a\n" o)
-           0)))
-    ((fctn-call (p-expr (ident ,function)) . ,rest)
-     (or (and=> (and=> (assoc-ref (.functions info) function) function:type)
-                (lambda (t)
-                  (and (type? t) 0 (->rank t))))
-         (begin
-           (stderr "expr->rank: no such function: ~a\n" function)
-           0)))
-
-    ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr ,pointer ,init) . ,initzer)))
-     (let* ((t (expr->rank info `(type-spec ,type)))
-            (i (expr->rank info init))
-            (p (expr->rank info pointer))
-            (e (+ (abs t) (abs i) (abs p))))
-       (if (or (< t 0) (< i 0)) (- e) e)))
-    ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr ,init . ,initzer)))
-     (let* ((t (expr->rank info `(type-spec ,type)))
-            (i  (expr->rank info init))
-            (p (+ (abs t) (abs i))))
-       (if (or (< t 0) (< i 0)) (- p) p)))
-    ((ptr-declr ,pointer (array-of ,array . ,rest))
-     (let* ((p (expr->rank info pointer))
-            (a (expr->rank info array))
-            (t (+ (abs p) (abs a) 2)))
-       (- t)))
-    ((ptr-declr ,pointer . ,rest)
-     (expr->rank info pointer))
-    ((array-of ,array . ,rest)
-     (let ((a (abs (expr->rank info array))))
-       (- (+ a 1))))
-    (_ (stderr "expr->rank: not supported: ~s\n" o) 0)))
-
-(define (expr->size info o)
-  (let ((ptr (expr->rank info o)))
-    (if (or (= ptr -1)
-            (= ptr 0))
-        (ast-type->size info o)
-        %pointer-size)))
+(define (ast->size o info)
+  (->size (ast->type o info)))
 
 (define (append-text info text)
   (clone info #:text (append (.text info) text)))
 
 (define (push-global info)
   (lambda (o)
-    (let ((ptr (ident->rank info o)))
-      (cond ((< ptr 0) (list (i386:push-label `(#:address ,o))))
+    (let ((rank (ident->rank info o)))
+      (cond ((< rank 0) (list (i386:push-label `(#:address ,o)))) ;; FIXME
             (else (list (i386:push-label-mem `(#:address ,o))))))))
 
 (define (push-local locals)
@@ -555,80 +471,84 @@
   (lambda (o)
     (wrap-as (i386:push-local-address (local:id o)))))
 
-(define push-global-de-ref push-global)
-
 (define (push-local-de-ref info)
   (lambda (o)
-    (let* ((local o)
-           (ptr (local:pointer local))
-           (size (if (= ptr 1) (ast-type->size info (local:type o))
-                     4)))
+    (let ((size (->size o)))
       (case size
         ((1) (wrap-as (i386:push-byte-local-de-ref (local:id o))))
         ((2) (wrap-as (i386:push-word-local-de-ref (local:id o))))
         ((4) (wrap-as (i386:push-local-de-ref (local:id o))))
         (else (error (format #f "TODO: push size >4: ~a\n" size)))))))
 
+ ;; (if (= ptr 2) (ast-type->size info (local:type o)) ;; URG
+ ;;                       4)
 (define (push-local-de-de-ref info)
   (lambda (o)
-    (let* ((local o)
-           (ptr (local:pointer local))
-           (size (if (= ptr 2) (ast-type->size info (local:type o));; URG
-                     4)))
+    (let ((size (->size (rank-- (rank-- o)))))
       (if (= size 1)
           (wrap-as (i386:push-byte-local-de-de-ref (local:id o)))
           (error "TODO int-de-de-ref")))))
 
-(define (make-global-entry name type pointer array value)
-  (cons name (make-global name type pointer array value #f)))
+(define (make-global-entry name type value)
+  (cons name (make-global name type value #f)))
 
 (define (string->global-entry string)
   (let ((value (append (string->list string) (list #\nul))))
-   (make-global-entry `(#:string ,string) "char" 0 (length value) value)))
+   (make-global-entry `(#:string ,string) "char" value))) ;; FIXME char-array
 
-(define (make-local-entry name type pointer array id)
-  (cons name (make-local name type pointer array id)))
+(define (make-local-entry name type id)
+  (cons name (make-local name type id)))
 
 (define* (mescc:trace name #:optional (type ""))
   (format (current-error-port) "    :~a~a\n" name type))
 
 (define (push-ident info)
   (lambda (o)
-    (let ((local (assoc-ref (.locals info) o)))
-      (if local
-          (begin
-            (let* ((ptr (local:pointer local)))
-             (if (or (< ptr 0)) ((push-local-address (.locals info)) local)
-                 ((push-local (.locals info)) local))))
-          (let ((global (assoc-ref (.globals info) o)))
-            (if global
-                ((push-global info) o) ;; FIXME: char*/int
-                (let ((constant (assoc-ref (.constants info) o)))
-                  (if constant
-                      (wrap-as (append (i386:value->accu constant)
-                                       (i386:push-accu)))
-                      ((push-global-address #f) `(#:address ,o))))))))))
+    (cond ((assoc-ref (.locals info) o)
+           =>
+           (push-local (.locals info)))
+          ((assoc-ref (.statics info) o)
+           =>
+           (push-global info))
+          ((assoc-ref (filter (negate static-global?) (.globals info)) o)
+           =>
+           (push-global info))
+          ((assoc-ref (.constants info) o)
+           =>
+           (lambda (constant)
+             (wrap-as (append (i386:value->accu constant)
+                              (i386:push-accu)))))
+          (else
+           ((push-global-address #f) `(#:address ,o))))))
 
 (define (push-ident-address info)
   (lambda (o)
-    (let ((local (assoc-ref (.locals info) o)))
-      (if local ((push-local-address (.locals info)) local)
-          (let ((global (assoc-ref (.globals info) o)))
-          (if global
-              ((push-global-address info) o)
-              ((push-global-address #f) `(#:address ,o))))))))
+    (cond ((assoc-ref (.locals info) o)
+           =>
+           (push-local-address (.locals info)))
+          ((assoc-ref (.statics info) o)
+           =>
+           (push-global-address info))
+          ((assoc-ref (filter (negate static-global?) (.globals info)) o)
+           =>
+           (push-global-address info))
+          (else
+           ((push-global-address #f) `(#:address ,o))))))
 
 (define (push-ident-de-ref info)
   (lambda (o)
-    (let ((local (assoc-ref (.locals info) o)))
-      (if local ((push-local-de-ref info) local)
-          ((push-global-de-ref info) o)))))
+    (cond ((assoc-ref (.locals info) o)
+           =>
+           (push-local-de-ref info))
+          (else ((push-global info) o)))))
 
 (define (push-ident-de-de-ref info)
   (lambda (o)
-    (let ((local (assoc-ref (.locals info) o)))
-      (if local ((push-local-de-de-ref info) local)
-          (error "TODO: global push-local-de-de-ref")))))
+    (cond ((assoc-ref (.locals info) o)
+           =>
+           (push-local-de-de-ref info))
+          (else
+           (error "not supported: global push-ident-de-de-ref:" o)))))
 
 (define (expr->arg info)
   (lambda (o)
@@ -646,37 +566,33 @@
       (if (assoc-ref globals string) globals
           (append globals (list (string->global-entry o)))))))
 
-(define (local->accu o)
-  (let* ((ptr (local:pointer o))
-         (type (local:type o))
-         (size (if (= ptr 0) (type:size type)
-                   4)))
-    (cond ((< ptr 0) (wrap-as (i386:local-ptr->accu (local:id o))))
-          (else (wrap-as (case size
-                           ((1) (i386:byte-local->accu (local:id o)))
-                           ((2) (i386:word-local->accu (local:id o)))
-                           (else (i386:local->accu (local:id o)))))))))
-
 (define (ident->accu info)
   (lambda (o)
     (cond ((assoc-ref (.locals info) o) => local->accu)
-          ((assoc-ref (.statics info) o)
-           =>
-           (lambda (global)
-             (let* ((ptr (ident->rank info o)))
-               (cond ((< ptr 0) (list (i386:label->accu `(#:address ,global))))
-                     (else (list (i386:label-mem->accu `(#:address ,global))))))))
-          ((assoc-ref (.globals info) o)
-           =>
-           (lambda (global)
-             (let* ((ptr (ident->rank info o)))
-               (cond ((< ptr 0) (list (i386:label->accu `(#:address ,o))))
-                     (else (list (i386:label-mem->accu `(#:address ,o))))))))
-          ((assoc-ref (.constants info) o)
-           =>
-           (lambda (constant) (wrap-as (i386:value->accu constant))))
+          ((assoc-ref (.statics info) o) => global->accu)
+          ((assoc-ref (filter (negate static-global?) (.globals info)) o) => global->accu)
+          ((assoc-ref (.constants info) o) => number->accu)
           (else (list (i386:label->accu `(#:address ,o)))))))
 
+(define (local->accu o)
+  (let* ((type (local:type o)))
+    (cond ((or (c-array? type)
+               (structured-type? type)) (wrap-as (i386:local-ptr->accu (local:id o))))
+          (else (let ((size (->size o)))
+                  (wrap-as (case size
+                             ((1) (i386:byte-local->accu (local:id o)))
+                             ((2) (i386:word-local->accu (local:id o)))
+                             (else (i386:local->accu (local:id o))))))))))
+
+(define (global->accu o)
+  (let ((type (global:type o)))
+    (cond ((or (c-array? type)
+               (structured-type? type)) (wrap-as (i386:label->accu `(#:address ,o))))
+          (else (wrap-as (i386:label-mem->accu `(#:address ,o)))))))
+
+(define (number->accu o)
+  (wrap-as (i386:value->accu o)))
+
 (define (ident-address->accu info)
   (lambda (o)
     (cond ((assoc-ref (.locals info) o)
@@ -685,7 +601,7 @@
           ((assoc-ref (.statics info) o)
            =>
            (lambda (global) (list (i386:label->accu `(#:address ,global)))))
-          ((assoc-ref (.globals info) o)
+          ((assoc-ref (filter (negate static-global?) (.globals info)) o)
            =>
            (lambda (global) (list (i386:label->accu `(#:address ,global)))))
           (else (list (i386:label->accu `(#:address ,o)))))))
@@ -699,7 +615,7 @@
      ((assoc-ref (.statics info) o)
       =>
       (lambda (global) (list (i386:label->base `(#:address ,global)))))
-     ((assoc-ref (.globals info) o)
+     ((assoc-ref (filter (negate static-global?) (.globals info)) o)
       =>
       (lambda (global) (list (i386:label->base `(#:address ,global)))))
      (else (list (i386:label->base `(#:address ,o)))))))
@@ -709,7 +625,7 @@
 
 (define (accu->local+n-text local n)
   (let* ((type (local:type local))
-         (ptr (local:pointer local))
+         (ptr (->rank local))
          (size (if (= ptr -1) ((compose type:size local:type) local)
                    4))
          (id (local:id local)))
@@ -760,12 +676,6 @@
            =>
            (lambda (global) (list (i386:label-mem-add `(#:address ,global) n)))))))
 
-(define (expr-add info)
-  (lambda (o n)
-    (let* ((info (expr->accu* o info))
-           (info (append-text info (wrap-as (i386:accu-mem-add n)))))
-      info)))
-
 (define (ident-address-add info)
   (lambda (o n)
     (cond ((assoc-ref (.locals info) o)
@@ -787,15 +697,6 @@
                                                    (i386:accu-mem-add n)
                                                    (i386:pop-accu)))))))))
 
-(define (binop->accu info)
-  (lambda (a b c)
-    (let* ((info (expr->accu a info))
-           (info (expr->base b info)))
-      (append-text info (wrap-as c)))))
-
-(define (wrap-as o . annotation)
-  `(,@annotation ,o))
-
 (define (make-comment o)
   (wrap-as `((#:comment ,o))))
 
@@ -864,19 +765,19 @@
      (expr->accu expr info))
 
     ((d-sel (ident ,field) ,struct)
-     (let* ((type (ast->type info struct))
+     (let* ((type (ast->basic-type struct info))
             (offset (field-offset info type field))
             (info (expr->accu* struct info)))
        (append-text info (wrap-as (i386:accu+value offset)))))
 
     ((i-sel (ident ,field) (fctn-call (p-expr (ident ,function)) . ,rest))
-     (let* ((type (ast->type info `(fctn-call (p-expr (ident ,function)) ,@rest)))
+     (let* ((type (ast->basic-type `(fctn-call (p-expr (ident ,function)) ,@rest) info))
             (offset (field-offset info type field))
             (info (expr->accu `(fctn-call (p-expr (ident ,function)) ,@rest) info)))
        (append-text info (wrap-as (i386:accu+value offset)))))
 
     ((i-sel (ident ,field) ,struct)
-     (let* ((type (ast->type info struct))
+     (let* ((type (ast->basic-type struct info))
             (offset (field-offset info type field))
             (info (expr->accu* struct info)))
        (append-text info (append (wrap-as (i386:mem->accu))
@@ -884,14 +785,19 @@
 
     ((array-ref ,index ,array)
      (let* ((info (expr->accu index info))
-            (ptr (expr->rank info array))
-            (size (expr->size info o))
+            (size (ast->size o info))
             (info (accu*n info size))
             (info (expr->base array info)))
        (append-text info (wrap-as (i386:accu+base)))))
 
     (_ (error "expr->accu*: not supported: " o))))
 
+(define (expr-add info)
+  (lambda (o n)
+    (let* ((info (expr->accu* o info))
+           (info (append-text info (wrap-as (i386:accu-mem-add n)))))
+      info)))
+
 (define (expr->accu o info)
   (let ((locals (.locals info))
         (constants (.constants info))
@@ -934,7 +840,7 @@
 
       ;; offsetoff
       ((ref-to (i-sel (ident ,field) (cast (type-name (decl-spec-list ,struct) (abs-declr (pointer))) (p-expr (fixed ,base)))))
-       (let* ((type (ast->type info struct))
+       (let* ((type (ast->basic-type struct info))
               (offset (field-offset info type field))
               (base (cstring->number base)))
          (append-text info (wrap-as (i386:value->accu (+ base offset))))))
@@ -951,29 +857,14 @@
        (expr->accu* expr info))
 
       ((sizeof-expr ,expr)
-       (append-text info (wrap-as (i386:value->accu (expr->size info expr)))))
-
-      ((sizeof-type (type-name (decl-spec-list (type-spec (fixed-type ,name)))))
-       (let* ((type name)
-              (size (ast-type->size info type)))
-         (append-text info (wrap-as (i386:value->accu size)))))
-
-      ((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident ,type))))))
-       (let* ((type `(tag ,type))
-              (size (ast-type->size info type)))
-         (append-text info (wrap-as (i386:value->accu size)))))
-
-      ((sizeof-type (type-name (decl-spec-list (type-spec (typename ,type)))))
-       (let ((size (ast-type->size info type)))
-         (append-text info (wrap-as (i386:value->accu size)))))
+       (append-text info (wrap-as (i386:value->accu (ast->size expr info)))))
 
-      ((sizeof-type (type-name (decl-spec-list ,type) (abs-declr (pointer))))
-       (let ((size 4))
-         (append-text info (wrap-as (i386:value->accu size)))))
+      ((sizeof-type ,type)
+       (append-text info (wrap-as (i386:value->accu (ast->size type info)))))
 
       ((array-ref ,index ,array)
        (let* ((info (expr->accu* o info))
-              (size (expr->size info o)))
+              (size (ast->size o info)))
          (append-text info (wrap-as (case size
                                       ((1) (i386:byte-mem->accu))
                                       ((2) (i386:word-mem->accu))
@@ -983,7 +874,7 @@
       ((d-sel ,field ,struct)
        (let* ((info (expr->accu* o info))
               (info (append-text info (ast->comment o)))
-              (type (ast-><type> o info))
+              (type (ast->type o info))
               (size (->size type))
               (array? (c-array? type)))
          (if array? info
@@ -996,7 +887,7 @@
       ((i-sel ,field ,struct)
        (let* ((info (expr->accu* o info))
               (info (append-text info (ast->comment o)))
-              (type (ast-><type> o info))
+              (type (ast->type o info))
               (size (->size type))
               (array? (c-array? type)))
          (if array? info
@@ -1008,7 +899,7 @@
 
       ((de-ref ,expr)
        (let* ((info (expr->accu expr info))
-              (size (expr->size info o)))
+              (size (ast->size o info)))
          (append-text info (wrap-as (case size
                                       ((1) (i386:byte-mem->accu))
                                       ((2) (i386:word-mem->accu))
@@ -1052,9 +943,9 @@
       ((post-inc ,expr)
        (let* ((info (append (expr->accu expr info)))
               (info (append-text info (wrap-as (i386:push-accu))))
-              (ptr (expr->rank info expr))
-              (size (cond ((= ptr 1) (ast-type->size info expr))
-                          ((> ptr 1) 4)
+              (rank (expr->rank info expr))
+              (size (cond ((= rank 1) (ast-type->size info expr))
+                          ((> rank 1) 4)
                           (else 1)))
               (info ((expr-add info) expr size))
               (info (append-text info (wrap-as (i386:pop-accu)))))
@@ -1063,27 +954,27 @@
       ((post-dec ,expr)
        (let* ((info (append (expr->accu expr info)))
               (info (append-text info (wrap-as (i386:push-accu))))
-              (ptr (expr->rank info expr))
-              (size (cond ((= ptr 1) (ast-type->size info expr))
-                          ((> ptr 1) 4)
+              (rank (expr->rank info expr))
+              (size (cond ((= rank 1) (ast-type->size info expr))
+                          ((> rank 1) 4)
                           (else 1)))
               (info ((expr-add info) expr (- size)))
               (info (append-text info (wrap-as (i386:pop-accu)))))
          info))
 
       ((pre-inc ,expr)
-       (let* ((ptr (expr->rank info expr))
-              (size (cond ((= ptr 1) (ast-type->size info expr))
-                          ((> ptr 1) 4)
+       (let* ((rank (expr->rank info expr))
+              (size (cond ((= rank 1) (ast-type->size info expr))
+                          ((> rank 1) 4)
                           (else 1)))
               (info ((expr-add info) expr size))
               (info (append (expr->accu expr info))))
          info))
 
       ((pre-dec ,expr)
-       (let* ((ptr (expr->rank info expr))
-              (size (cond ((= ptr 1) (ast-type->size info expr))
-                          ((> ptr 1) 4)
+       (let* ((rank (expr->rank info expr))
+              (size (cond ((= rank 1) (ast-type->size info expr))
+                          ((> rank 1) 4)
                           (else 1)))
               (info ((expr-add info) expr (- size)))
               (info (append (expr->accu expr info))))
@@ -1092,13 +983,12 @@
 
 
       ((add ,a (p-expr (fixed ,value)))
-       (let* ((ptr (expr->rank info a))
-              (type (ast->type info a))
+       (let* ((rank (expr->rank info a))
+              (type (ast->basic-type a info))
               (struct? (structured-type? type))
-              (size (cond ((= ptr 1) (ast-type->size info a))
-                          ((> ptr 1) 4)
-                          ((and struct? (= ptr -2)) 4)
-                          ((and struct? (= ptr 2)) 4)
+              (size (cond ((= rank 1) (ast-type->size info a))
+                          ((> rank 1) 4)
+                          ((and struct? (= rank 2)) 4)
                           (else 1)))
               (info (expr->accu a info))
               (value (cstring->number value))
@@ -1106,14 +996,13 @@
          (append-text info (wrap-as (i386:accu+value value)))))
 
       ((add ,a ,b)
-       (let* ((ptr (expr->rank info a))
-              (ptr-b (expr->rank info b))
-              (type (ast->type info a))
+       (let* ((rank (expr->rank info a))
+              (rank-b (expr->rank info b))
+              (type (ast->basic-type a info))
               (struct? (structured-type? type))
-              (size (cond ((= ptr 1) (ast-type->size info a))
-                          ((> ptr 1) 4)
-                          ((and struct? (= ptr -2)) 4)
-                          ((and struct? (= ptr 2)) 4)
+              (size (cond ((= rank 1) (ast-type->size info a))
+                          ((> rank 1) 4)
+                          ((and struct? (= rank 2)) 4)
                           (else 1))))
          (if (or (= size 1)) ((binop->accu info) a b (i386:accu+base))
              (let* ((info (expr->accu b info))
@@ -1124,13 +1013,13 @@
                (append-text info (wrap-as (i386:accu+base)))))))
 
       ((sub ,a (p-expr (fixed ,value)))
-       (let* ((ptr (expr->rank info a))
-              (type (ast->type info a))
+       (let* ((rank (expr->rank info a))
+              (type (ast->basic-type a info))
               (struct? (structured-type? type))
-              (size (cond ((= ptr 1) (ast-type->size info a))
-                          ((> ptr 1) 4)
-                          ((and struct? (= ptr -2)) 4)
-                          ((and struct? (= ptr 2)) 4)
+              (size (->size type))
+              (size (cond ((= rank 1) size)
+                          ((> rank 1) 4)
+                          ((and struct? (= rank 2)) 4)
                           (else 1)))
               (info (expr->accu a info))
               (value (cstring->number value))
@@ -1138,18 +1027,18 @@
          (append-text info (wrap-as (i386:accu+value (- value))))))
 
       ((sub ,a ,b)
-       (let* ((ptr (expr->rank info a))
-              (ptr-b (expr->rank info b))
-              (type (ast->type info a))
+       (let* ((rank (expr->rank info a))
+              (rank-b (expr->rank info b))
+              (type (ast->basic-type a info))
               (struct? (structured-type? type))
-              (size  (cond ((= ptr 1) (ast-type->size info a))
-                           ((> ptr 1) 4)
-                           ((and struct? (= ptr -2)) 4)
-                           ((and struct? (= ptr 2)) 4)
+              (size (->size type))
+              (size  (cond ((= rank 1) size)
+                           ((> rank 1) 4)
+                           ((and struct? (= rank 2)) 4)
                            (else 1))))
-         (if (or (= size 1) (or (= ptr-b -2) (= ptr-b 1)))
+         (if (or (= size 1) (or (= rank-b 2) (= rank-b 1)))
              (let ((info ((binop->accu info) a b (i386:accu-base))))
-               (if (and (not (= ptr-b -2)) (not (= ptr-b 1))) info
+               (if (and (not (= rank-b 2)) (not (= rank-b 1))) info
                    (append-text info (wrap-as (append (i386:value->base size)
                                                       (i386:accu/base))))))
              (let* ((info (expr->accu b info))
@@ -1230,35 +1119,33 @@
       ((assn-expr (de-ref (post-inc (p-expr (ident ,name)))) (op ,op) ,b)
        (let* ((info (expr->accu `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b) info))
               (type (ident->type info name))
-              (ptr (ident->rank info name))
-              (size (if (> ptr 1) 4 1)))
+              (rank (ident->rank info name))
+              (size (if (> rank 1) 4 1)))
          (append-text info ((ident-add info) name size))))
 
       ((assn-expr (de-ref (post-dec (p-expr (ident ,name)))) (op ,op) ,b)
        (let* ((info (expr->accu `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b) info))
               (type (ident->type info name))
-              (ptr (ident->rank info name))
-              (size (if (> ptr 1) 4 1)))
+              (rank (ident->rank info name))
+              (size (if (> rank 1) 4 1)))
          (append-text info ((ident-add info) name (- size)))))
 
       ((assn-expr ,a (op ,op) ,b)
        (let* ((info (append-text info (ast->comment o)))
-              (ptr-a (expr->rank info a))
-              (ptr-b (expr->rank info b))
-              (size-a (expr->size info a))
-              (size-b (expr->size info b))
+              (type (ast->type a info))
+              (rank (->rank type))
+              (type-b (ast->type b info))
+              (rank-b (->rank type-b))
+              (size (->size type))
+              (size-b (->size type-b))
               (info (expr->accu b info))
               (info (if (equal? op "=") info
-                        (let* ((ptr (expr->rank info a))
-                               (ptr-b (expr->rank info b))
-                               (type (ast->type info a))
-                               (struct? (structured-type? type))
-                               (size (cond ((= ptr 1) (ast-type->size info a))
-                                           ((> ptr 1) 4)
-                                           ((and struct? (= ptr -2)) 4)
-                                           ((and struct? (= ptr 2)) 4)
+                        (let* ((struct? (structured-type? type))
+                               (size (cond ((= rank 1) (ast-type->size info a))
+                                           ((> rank 1) 4)
+                                           ((and struct? (= rank 2)) 4)
                                            (else 1)))
-                               (info (if (or (= size 1) (= ptr-b 1)) info
+                               (info (if (or (= size 1) (= rank-b 1)) info
                                          (let ((info (append-text info (wrap-as (i386:value->base size)))))
                                            (append-text info (wrap-as (i386:accu*base))))))
                                (info (append-text info (wrap-as (i386:push-accu))))
@@ -1275,28 +1162,28 @@
                                                              ((equal? op ">>=") (wrap-as (i386:accu>>base)))
                                                              ((equal? op "<<=") (wrap-as (i386:accu<<base)))
                                                              (else (error (format #f "mescc: op ~a not supported: ~a\n" op o)))))))
-                          (cond ((not (and (= ptr 1) (= ptr-b 1))) info)
+                          (cond ((not (and (= rank 1) (= rank-b 1))) info)
                                 ((equal? op "-=") (append-text info (wrap-as (append (i386:value->base size)
                                                                                      (i386:accu/base)))))
-                                (else (error (format #f "invalid operands to binary ~s (have ~s* and ~s*)" op type (ast->type info b)))))))))
+                                (else (error (format #f "invalid operands to binary ~s (have ~s* and ~s*)" op type (ast->basic-type b info)))))))))
          (when (and (equal? op "=")
-                    (not (= size-a size-b))
-                    (not (and (or (= size-a 1) (= size-a 2))
+                    (not (= size size-b))
+                    (not (and (or (= size 1) (= size 2))
                               (= size-b 4)))
-                    (not (and (= size-a 2)
+                    (not (and (= size 2)
                               (= size-b 4)))
-                    (not (and (= size-a 4)
+                    (not (and (= size 4)
                               (or (= size-b 1) (= size-b 2)))))
            (stderr "ERROR assign: ~a" (with-output-to-string (lambda () (pretty-print-c99 o))))
-           (stderr "   size[~a]:~a != size[~a]:~a\n"  ptr-a size-a ptr-b size-b))
+           (stderr "   size[~a]:~a != size[~a]:~a\n"  rank size rank-b size-b))
          (pmatch a
            ((p-expr (ident ,name))
-            (if (or (<= size-a 4) ;; FIXME: long long = int
+            (if (or (<= size 4) ;; FIXME: long long = int
                     (<= size-b 4)) (append-text info ((accu->ident info) name))
                     (let ((info (expr->base* a info)))
-                      (accu->base-mem*n info size-a))))
+                      (accu->base-mem*n info size))))
            (_ (let ((info (expr->base* a info)))
-                (accu->base-mem*n info (min size-a (max 4 size-b)))))))) ;; FIXME: long long = int
+                (accu->base-mem*n info (min size (max 4 size-b)))))))) ;; FIXME: long long = int
 
       (_ (error "expr->accu: not supported: " o)))))
 
@@ -1306,6 +1193,15 @@
          (info (append-text info (wrap-as (append (i386:accu->base) (i386:pop-accu))))))
     info))
 
+(define (binop->accu info)
+  (lambda (a b c)
+    (let* ((info (expr->accu a info))
+           (info (expr->base b info)))
+      (append-text info (wrap-as c)))))
+
+(define (wrap-as o . annotation)
+  `(,@annotation ,o))
+
 (define (expr->base* o info)
   (let* ((info (append-text info (wrap-as (i386:push-accu))))
          (info (expr->accu* o info))
@@ -1416,15 +1312,15 @@
               (info (append-text info (wrap-as `((#:label ,skip-b-label))))))
          info))
 
-      ((array-ref ,index ,expr) (let* ((ptr (expr->rank info expr))
-                                       (size (if (= ptr 1) (ast-type->size info expr)
+      ((array-ref ,index ,expr) (let* ((rank (expr->rank info expr))
+                                       (size (if (= rank 1) (ast-type->size info expr)
                                                  4)))
                                   ((jump (if (= size 1) i386:jump-byte-z
                                              i386:jump-z)
                                          (wrap-as (i386:accu-zero?))) o)))
 
-      ((de-ref ,expr) (let* ((ptr (expr->rank info expr))
-                             (size (if (= ptr 1) (ast-type->size info expr)
+      ((de-ref ,expr) (let* ((rank (expr->rank info expr))
+                             (size (if (= rank 1) (ast-type->size info expr)
                                        4)))
                         ((jump (if (= size 1) i386:jump-byte-z
                                    i386:jump-z)
@@ -1498,20 +1394,20 @@
   (lambda (o)
     (pmatch o
       ((comp-decl (decl-spec-list (type-spec ,type)) (comp-declr-list (comp-declr (ident ,name))))
-       (list (cons name (ast-><type> type info))))
+       (list (cons name (ast->type type info))))
       ((comp-decl (decl-spec-list (type-spec ,type)) (comp-declr-list (comp-declr (ptr-declr ,pointer (ident ,name)))))
-       (let ((rank (pointer->ptr pointer)))
-         (list (cons name (rank+= (ast-><type> type info) rank)))))
+       (let ((rank (pointer->rank pointer)))
+         (list (cons name (rank+= (ast->type type info) rank)))))
       ((comp-decl (decl-spec-list (type-spec ,type)) (comp-declr-list (comp-declr (ftn-declr (scope (ptr-declr ,pointer (ident ,name))) _))))
-       (let ((rank (pointer->ptr pointer)))
-         (list (cons name (rank+= (ast-><type> type info) rank)))))
+       (let ((rank (pointer->rank pointer)))
+         (list (cons name (rank+= (ast->type type info) rank)))))
       ((comp-decl (decl-spec-list (type-spec ,type)) (comp-declr-list (comp-declr (ptr-declr ,pointer (array-of (ident ,name) ,count)))))
-       (let ((rank (pointer->ptr pointer))
+       (let ((rank (pointer->rank pointer))
              (count (expr->number info count)))
          (list (cons name (make-c-array (rank+= type rank) count)))))
       ((comp-decl (decl-spec-list (type-spec ,type)) (comp-declr-list (comp-declr (array-of (ident ,name) ,count))))
        (let ((count (expr->number info count)))
-         (list (cons name (make-c-array (ast-><type> type info) count)))))
+         (list (cons name (make-c-array (ast->type type info) count)))))
       ((comp-decl (decl-spec-list (type-spec (struct-def (field-list . ,fields)))))
        (let ((fields (append-map (struct-field info) fields)))
          (list (cons 'struct (make-type 'struct (apply + (map field:size fields)) fields)))))
@@ -1803,42 +1699,28 @@
   (lambda (o)
     (cons (car o) (set-field (cdr o) (global:function) function))))
 
-(define (decl-local->info info)
-  (lambda (o)
-    (pmatch o
-      (((decl-spec-list (stor-spec (static)) (type-spec ,type)) (init-declr-list ,init))
-       (let* ((function (.function info))
-              (i (clone info #:function #f #:globals '()))
-              (i ((decl->info i `(decl (decl-spec-list (type-spec ,type)) (init-declr-list ,init)))))
-              (statics (map (global->static function) (.globals i))))
-         (clone info #:statics (append statics (.statics info)))))
-      (_ #f))))
-
-(define (decl-global->info info)
-  (lambda (o)
-    #f))
-
 (define (decl->info info o)
   (pmatch o
     (((decl-spec-list (type-spec ,type)) (init-declr-list . ,inits))
      (let* ((info (type->info type #f info))
-            (type (ast->type info type))
-            (pointer 0))                ; FIXME
-       (fold (cut init-declr->info type pointer <> <>) info (map cdr inits))))
+            (type (ast->type type info)))
+       (fold (cut init-declr->info type <> <>) info (map cdr inits))))
     (((decl-spec-list (type-spec ,type)))
      (type->info type #f info))
     (((decl-spec-list (stor-spec (typedef)) (type-spec ,type)) (init-declr-list (init-declr (ident ,name))))
      (let* ((info (type->info type name info))
-            (type (ast->type info type)))
+            (type (ast->type type info)))
        (clone info #:types (acons name type (.types info)))))
     (((decl-spec-list (stor-spec (,store)) (type-spec ,type)) (init-declr-list . ,inits))
-     (let* ((type (ast->type info type))
-            (pointer 0)                 ; FIXME
-            (function (.function info))
-            (tmp (clone info #:function #f #:globals '()))
-            (tmp (fold (cut init-declr->info type pointer <> <>) tmp (map cdr inits)))
-            (statics (map (global->static function) (.globals tmp))))
-       (clone info #:statics (append statics (.statics info)))))
+     (let* ((type (ast->type type info))
+            (function (.function info)))
+       (if (not function) (fold (cut init-declr->info type <> <>) info (map cdr inits))
+           (let* ((tmp (clone info #:function #f #:globals '()))
+                  (tmp (fold (cut init-declr->info type <> <>) tmp (map cdr inits)))
+                  (statics (map (global->static function) (.globals tmp)))
+                  (strings (filter string-global? (.globals tmp))))
+             (clone info #:globals (append (.globals info) strings)
+                    #:statics (append statics (.statics info)))))))
     (((@ . _))
      (stderr "decl->info: skip: ~s\n" o)
      info)
@@ -1870,7 +1752,6 @@
 
 (define (init-struct-field local field init info)
   (let* ((offset (field-offset info (local:type local) (car field)))
-         (pointer (field:pointer field))
          (size (field:size field))
          (empty (clone info #:text '())))
     (clone info #:text
@@ -1904,6 +1785,7 @@
                        ((2) (i386:word-accu->base-mem+n offset))
                        (else (i386:accu->base-mem+n offset))))))))
 
+
 (define (init-local local o n info)
   (pmatch o
     (#f info)
@@ -1912,7 +1794,7 @@
     ((initzer-list ,init)
      (init-local local init n info))
     ((initzer-list . ,inits)
-     (let ((struct? (pke 'struct? local '=> (structured-type? local))))
+     (let ((struct? (structured-type? local)))
        (cond (struct?
               (let ((fields ((compose struct->fields local:type) local)))
                 (fold (cut init-struct-field local <> <> <>) info fields (append inits (map (const '(p-expr (fixed "22"))) (iota (max 0 (- (length fields) (length inits)))))))))
@@ -1923,35 +1805,55 @@
     (_ (let ((info (init->accu o info)))
          (append-text info (accu->local+n-text local n))))))
 
-(define (local->info type pointer array name o init info)
+(define (local->info type name o init info)
   (let* ((locals (.locals info))
          (id (if (or (null? locals) (not (local-var? (cdar locals)))) 1
                  (1+ (local:id (cdar locals)))))
-         (local (make-local-entry name type pointer array id))
-         (struct? (and (or (zero? pointer)
-                           (= -1 pointer))
-                       (structured-type? type)))
-         (size (or (and (zero? pointer) (type? type) (type:size type))
-                   (and struct? (and=> (ast->type info type) ->size))
-                   4))
+         (local (make-local-entry name type id))
+         (pointer (->rank (cdr local)))
+         (array (or (and (c-array? type) type)
+                    (and (pointer? type) (c-array? (pointer:type type))
+                         (pointer:type type))
+                    (and (pointer? type)
+                         (pointer? (pointer:type type))
+                         (c-array? (pointer:type (pointer:type type)))
+                         (pointer:type (pointer:type type)))))
+         (struct? (structured-type? type))
+         (size (->size type))
+         (count (and (c-array? array) (c-array:count array)))
          (local (if (not array) local
-                    (make-local-entry name type pointer array (+ (local:id (cdr local)) -1 (quotient (+ (* array size) 3) 4)))))
-         (local (if struct? (make-local-entry name type -1 array (+ (local:id (cdr local)) (quotient (+ size 3) 4)))
+                    (make-local-entry name type (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4)))))
+         (local (if struct? (make-local-entry name type (+ (local:id (cdr local)) (quotient (+ size 3) 4)))
                     local))
          (locals (cons local locals))
          (info (clone info #:locals locals))
          (local (cdr local)))
     (init-local local init 0 info)))
 
-(define (global->info type pointer array name o init info)
-  (let* ((size (cond ((type? type) (type:size type))
-                     ((not (zero? pointer)) 4)
-                     (else (error "global->info: no such type:" type))))
+(define (global->info type name o init info)
+  (let* ((rank (->rank type))
+         (size (cond ;;((not (zero? rank)) 4)
+                ((pointer? type) 4)
+                ((c-array? type) (cond ((pointer? (c-array:type type)) 4)
+                                       ((type? (c-array:type type)) ((compose type:size c-array:type) type))
+                                       (else (error "urg:" type))))
+                ((type? type) (type:size type))
+                (else (error "global->info: no such type:" type))))
          (data (cond ((not init) (string->list (make-string size #\nul)))
-                     (array (array-init->data (and array (* array (type:size type))) init info))
+                     ((let ((array (or (and (c-array? type) type)
+                                       (and (pointer? type)
+                                            (c-array? (pointer:type type))
+                                            (pointer:type type))
+                                       (and (pointer? type)
+                                            (pointer? (pointer:type type))
+                                            (c-array? (pointer:type (pointer:type type)))
+                                            (pointer:type (pointer:type type))))))
+                        array)
+                      =>
+                      (lambda (array) (array-init->data (* (c-array:count array) size) init info)))
                      (else (let ((data (init->data init info)))
                              (append data (string->list (make-string (max 0 (- size (length data))) #\nul)))))))
-         (global (make-global-entry name type pointer array data)))
+         (global (make-global-entry name type data)))
     (clone info #:globals (append (.globals info) (list global)))))
 
 (define (array-init-element->data size o info)
@@ -1985,60 +1887,57 @@
     (() (string->list (make-string size #\nul)))
     (_ (error "array-init->data: not supported: " o))))
 
-(define (init-declr->info type pointer o info)
+(define (init-declr->info type o info)
   (pmatch o
     (((ident ,name))
-     (if (.function info) (local->info type pointer #f name o #f info)
-         (global->info type pointer #f name o #f info)))
+     (if (.function info) (local->info type name o #f info)
+         (global->info type name o #f info)))
     (((ident ,name) (initzer ,init))
      (let* ((strings (init->strings init info))
             (info (if (null? strings) info
-                      (clone info #:globals (append (.globals info) strings))))
-            (struct? (and (zero? pointer)
-                          (structured-type? type)))
-            (pointer (if struct? (- (1+ (abs pointer))) pointer)))
-       (if (.function info) (local->info type pointer #f name o init info)
-           (global->info type pointer #f name o init info))))
+                      (clone info #:globals (append (.globals info) strings)))))
+       (if (.function info) (local->info type name o init info)
+           (global->info type name o init info))))
     (((ftn-declr (ident ,name) . ,_))
      (let ((functions (.functions info)))
        (if (member name functions) info
            (let* ((type (ftn-declr:get-type info `(ftn-declr (ident ,name) ,@_)))
                   (function (make-function name type  #f)))
              (clone info #:functions (cons (cons name function) functions))))))
-    (((ftn-declr (scope (ptr-declr ,p (ident ,name))) ,param-list) ,init)
-
-     (let ((pointer (+ pointer (pointer->ptr p))))
-       (if (.function info) (local->info type pointer #f name o init info)
-           (global->info type pointer #f name o init info))))
-    (((ptr-declr ,p . ,_) . ,init)
-     (let ((pointer (+ pointer (pointer->ptr p))))
-       (init-declr->info type pointer (append _ init) info)))
-    (((array-of (ident ,name) ,array) . ,init)
+    (((ftn-declr (scope (ptr-declr ,pointer (ident ,name))) ,param-list) ,init)
+     (let* ((rank (pointer->rank pointer))
+            (type (rank+= type rank)))
+       (if (.function info) (local->info type name o init info)
+           (global->info type name o init info))))
+    (((ptr-declr ,pointer . ,_) . ,init)
+     (let* ((rank (pointer->rank pointer))
+            (type (rank+= type rank)))
+       (init-declr->info type (append _ init) info)))
+    (((array-of (ident ,name) ,count) . ,init)
      (let* ((strings (init->strings init info))
             (info (if (null? strings) info
                       (clone info #:globals (append (.globals info) strings))))
-            (array (expr->number info array))
-            (pointer (- (1+ pointer))))
-       (if (.function info) (local->info type pointer array name o init info)
-           (global->info type pointer array name o init info))))
+            (count (expr->number info count))
+            (type (make-c-array type count)))
+       (if (.function info) (local->info type name o init info)
+           (global->info type name o init info))))
     (((array-of (ident ,name)) . ,init)
      (let* ((strings (init->strings init info))
             (info (if (null? strings) info
                       (clone info #:globals (append (.globals info) strings))))
-            (pointer (- (1+ pointer))))
-       (if (.function info) (local->info type pointer (length (cadar init)) name o init info)
-           (global->info type pointer #f name o init info))))
-
+            (count (length (cadar init)))
+            (type (make-c-array type count)))
+       (if (.function info) (local->info type name o init info)
+           (global->info type name o init info))))
     ;; FIXME: recursion
-    (((array-of (array-of (ident ,name) ,array) ,array1) . ,init)
+    (((array-of (array-of (ident ,name) ,count) ,count1) . ,init)
      (let* ((strings (init->strings init info))
             (info (if (null? strings) info
                       (clone info #:globals (append (.globals info) strings))))
-            (array (expr->number info array))
-            (pointer (- (+ 2 pointer))))
-       (if (.function info) (local->info type pointer array name o init info)
-           (global->info type pointer array name o init info))))
-
+            (count (expr->number info count))
+            (type (make-c-array (rank++ type) count)))
+       (if (.function info) (local->info type name o init info)
+           (global->info type name o init info))))
     (_ (error "init-declr->info: not supported: " o))))
 
 (define (enum-def-list->constants constants fields)
@@ -2074,7 +1973,7 @@
      (let ((var (ident->variable info name)))
        `((#:address ,var))))
     ((ref-to (i-sel (ident ,field) (cast (type-name (decl-spec-list ,struct) (abs-declr (pointer))) (p-expr (fixed ,base)))))
-     (let* ((type (ast->type info struct))
+     (let* ((type (ast->type struct info))
             (offset (field-offset info type field))
             (base (cstring->number base)))
        (int->bv32 (+ base offset))))
@@ -2082,6 +1981,7 @@
     ((,number . _) (guard (number? number))
      (append (map int->bv32 o)))
     ((initzer ,init) (init->data init info))
+    ((cast _ ,expr) (init->data expr info))
     (_ (error "init->data: not supported: " o))))
 
 (define (init->strings o info)
@@ -2143,6 +2043,7 @@
      (let ((type-entry (union->type-entry name (append-map (struct-field info) fields))))
        (clone info #:types (cons type-entry (.types info)))))
 
+    ((enum-ref . _) info)
     ((struct-ref . _) info)
     ((typename ,name) info)
     ((union-ref . _) info)
@@ -2171,9 +2072,14 @@
 (define (param-decl:get-type o info)
   (pmatch o
     ((ellipsis) #f)
-    ((param-decl (decl-spec-list (type-spec (void)))) #f)
-    ((param-decl (decl-spec-list (type-spec ,type)) _) (ast->type info type))
-    ((param-decl ,type _) (ast->type info type))
+    ((param-decl (decl-spec-list ,type)) (ast->type type info))
+    ((param-decl (decl-spec-list (type-spec ,type)) (param-declr (ptr-declr ,pointer (ident ,name))))
+     (let ((rank (pointer->rank pointer)))
+       (rank+= (ast->type type info) rank)))
+    ((param-decl (decl-spec-list ,type) (param-declr (ptr-declr ,pointer (array-of _))))
+     (let ((rank (pointer->rank pointer)))
+       (rank+= (ast->type type info) (1+ rank))))
+    ((param-decl ,type _) (ast->type type info))
     (_ (error "param-decl:get-type not supported:" o))))
 
 (define (fctn-defn:get-formals o)
@@ -2197,20 +2103,6 @@
                         (i386:function-locals)))))
     (_ (error "param-list->text: not supported: " o))))
 
-(define (param-decl:get-ptr o)
-  (pmatch o
-    ((param-decl (decl-spec-list . ,decl) (param-declr (ident ,name) (array-of _)))
-     1)
-    ((param-decl (decl-spec-list . ,decl) (param-declr (ident ,name)))
-     0)
-    ((param-decl _ (param-declr (ptr-declr ,pointer (array-of _))))
-     (1+ (pointer->ptr pointer)))
-    ((param-decl _ (param-declr (ptr-declr ,pointer . _)))
-     (pointer->ptr pointer))
-    ((param-decl (decl-spec-list (type-spec (void))))
-     0)
-    (_ (error "param-decl:get-ptr: not supported: " o))))
-
 (define (param-list->locals o info)
   (pmatch o
     ((param-list . ,formals)
@@ -2218,22 +2110,20 @@
        (map make-local-entry
             (map param-decl:get-name formals)
             (map (cut param-decl:get-type <> info) formals)
-            (map param-decl:get-ptr formals)
-            (map (const #f) (iota n))
             (iota n -2 -1))))
     (_ (error "param-list->locals: not supported:" o))))
 
 (define (fctn-defn:get-type info o)
   (pmatch o
     (((decl-spec-list (type-spec ,type)) (ptr-declr ,pointer . _) ,statement)
-     (let* ((type (ast->type info type))
+     (let* ((type (ast->type type info))
             (rank (ptr-declr->rank pointer)))
        (if (zero? rank) type
            (make-pointer type rank))))
     (((decl-spec-list (type-spec ,type)) . ,rest)
-     (ast->type info type))
+     (ast->type type info))
     (((decl-spec-list (stor-spec ,store) (type-spec ,type)) (ftn-declr (ident _) _) _)
-     (ast->type info type))
+     (ast->type type info))
     (_ (error "fctn-defn:get-type: not supported:" o))))
 
 (define (ftn-declr:get-type info o)
@@ -2259,7 +2149,7 @@
            (text (param-list->text formals))
            (locals (param-list->locals formals info))
            (statement (fctn-defn:get-statement o))
-           (info (clone info #:locals locals #:function name #:text text))
+           (info (clone info #:locals locals #:function name #:text text #:statics '()))
            (info (ast->info statement info))
            (locals (.locals info))
            (local (and (pair? locals) (car locals)))

diff --git a/module/language/c99/info.scm b/module/language/c99/info.scm
index b613fda8bee8a27db5986e23cfc93e54f93595ea..1d387ced520bc644e7dd3bf059e089d4ec7d61e0 100644 (file)
--- a/module/language/c99/info.scm
+++ b/module/language/c99/info.scm
@@ -97,7 +97,7 @@
             function:type
             function:text
 
-            -><type>
+            ->type
             ->rank
             rank--
             rank++
@@ -162,36 +162,32 @@
   (value var:value))
 
 (define-immutable-record-type <global>
-  (make-global- name type var pointer c-array value function)
+  (make-global- name type var value function)
   global?
   (name global:name)
   (type global:type)
   (var global:var)                      ; <var>
 
-  (pointer global:pointer)
-  (c-array global:c-array)
   (value global:value)
   (function global:function))
 
-(define (make-global name type pointer c-array value function)
-  (make-global- name type (make-var name type function #f value) pointer c-array value function))
+(define (make-global name type value function)
+  (make-global- name type (make-var name type function #f value) value function))
 
 (define (global->string o)
   (or (and=> (global:function o) (cut string-append <> "-" (global:name o)))
       (global:name o)))
 
 (define-immutable-record-type <local>
-  (make-local- type var id pointer c-array)
+  (make-local- type var id)
   local?
   (type local:type)
   (var local:var)                       ; <var>
 
-  (id local:id)
-  (pointer local:pointer)
-  (c-array local:c-array))
+  (id local:id))
 
-(define (make-local name type pointer c-array id)
-  (make-local- type (make-var name type #f id #f) id pointer c-array))
+(define (make-local name type id)
+  (make-local- type (make-var name type #f id #f) id))
 
 (define-immutable-record-type <function>
   (make-function name type text)
@@ -207,7 +203,7 @@
         ((and (pair? o) (eq? (car o) 'tag))) ;; FIXME: enum?
         (else #f)))
 
-(define (-><type> o)
+(define (->type o)
   (cond ((type? o) o)
         ((pointer? o) (pointer:type o))
         ((c-array? o) (c-array:type o))
@@ -216,7 +212,7 @@
         (#t
          (format (current-error-port) "->type--: not a <type>: ~s\n" o)
          (make-type 'builtin 4 #f))
-        (else (error "-><type>: not a <type>:" o))))
+        (else (error "->type: not a <type>:" o))))
 
 (define (->rank o)
   (cond ((type? o) 0)

diff --git a/scaffold/tests/23-pointer.c b/scaffold/tests/23-pointer.c
index 0ae2d78ccc3fdf5f5df60286c0ca5c54901269f1..4c446a288c61671a7f8c0b517950b2a37f240178 100644 (file)
--- a/scaffold/tests/23-pointer.c
+++ b/scaffold/tests/23-pointer.c
@@ -20,6 +20,7 @@
 
 #include "00-test.i"
 
+char *g_hello = "hello";
 char g_arena[4] = "XXX";
 char *g_chars = g_arena;
 
@@ -32,32 +33,36 @@ struct foo *file;
 int
 test ()
 {
-  if (*g_chars != 'X') return 1;
+  if (*g_hello != 'h') return 1;
+  if (g_hello[0] != 'h') return 2;
+  if (g_chars[0] != 'X') return 3;
+  if (*g_chars != 'X') return 4;
+
   g_arena[0] = 'A';
-  if (*g_chars != 'A') return 2;
+  if (*g_chars != 'A') return 5;
   char *x = g_arena;
-  if (*x++ != 'A') return 3;
+  if (*x++ != 'A') return 5;
   *x++ = 'C';
-  if (g_chars[1] != 'C') return 4;
-  if (g_chars[2] != 'X') return 5;
+  if (g_chars[1] != 'C') return 7;
+  if (g_chars[2] != 'X') return 8;
   *--x = 'X';
-  if (g_chars[1] != 'X') return 7;
+  if (g_chars[1] != 'X') return 9;
 
   char **pp = &x;
-  if (**pp != 'X') return 7;
+  if (**pp != 'X') return 10;
 
   char *p = *pp;
-  if (*p != 'X') return 8;
+  if (*p != 'X') return 11;
 
   char ***ppp = &pp;
-  if (***ppp != 'X') return 9;
+  if (***ppp != 'X') return 12;
 
   char **pp2 = *ppp;
-  if (**pp2 != 'X') return 10;
+  if (**pp2 != 'X') return 13;
 
   struct foo *f = 0;
-  if (f) return 11;
-  if (file) return 12;
+  if (f) return 14;
+  if (file) return 15;
 
   return 0;
 }

diff --git a/scaffold/tests/46-function-static.c b/scaffold/tests/46-function-static.c
index 658b167f3b2e019718921407545aaeb6966a0904..2fcada905a753235b472a87b4f97639767e69ab2 100644 (file)
--- a/scaffold/tests/46-function-static.c
+++ b/scaffold/tests/46-function-static.c
@@ -18,6 +18,8 @@
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+static int i = 2;
+
 int
 test ()
 {
@@ -27,10 +29,9 @@ test ()
   return foo - i--;
 }
 
-static int i = 2;
 int
 main ()
 {
   test ();
-  return test ();
+  return i - 2 - test ();
 }

diff --git a/scaffold/tests/64-make-cell.c b/scaffold/tests/64-make-cell.c
index c9f460ca743514d90598ba9d720e2a863d5bf357..b37c6a265dcb491bd987beffb999134a4f879cab 100644 (file)
--- a/scaffold/tests/64-make-cell.c
+++ b/scaffold/tests/64-make-cell.c
@@ -32,11 +32,7 @@ struct scm {
 
 int bla = 1234;
 char g_arena[84];
-#if __MESC__
-struct scm *g_cells = g_arena;
-#else
 struct scm *g_cells = (struct scm*)g_arena;
-#endif
 char *g_chars = g_arena;
 
 int foo () {puts ("t: foo\n"); return 0;};

diff --git a/scaffold/tests/t.c b/scaffold/tests/t.c
index 1324e375a96d7b342a2cc1d47c22b804b1b7fc73..0e9937524696a02c16ecc8dd00125abb961d1758 100644 (file)
--- a/scaffold/tests/t.c
+++ b/scaffold/tests/t.c
@@ -41,6 +41,14 @@ struct anon {struct {int bar; int baz;};};
 
 struct here {int and;} there;
 
+int
+test (struct foo* p)
+{
+  struct foo *g = &f;
+  g[0].length = 0;
+  p[0].length = 0;
+}
+
 int
 main (int argc, char* argv[])
 {