mescc: Refactor variable declaration.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sat, 5 May 2018 10:30:06 +0000 (12:30 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sat, 5 May 2018 10:30:06 +0000 (12:30 +0200)
* module/language/c99/compiler.mes (decl->info): Refactor.

27 files changed:
build-aux/check-mescc.sh
doc/UPDATE-0.13 [new file with mode: 0644]
module/language/c99/compiler.mes
module/language/c99/info.scm
module/mes/M1.mes
scaffold/boot/02-identifier.scm [new file with mode: 0644]
scaffold/boot/03-big-string.scm [new file with mode: 0644]
scaffold/boot/05-big-list.scm [new file with mode: 0644]
scaffold/boot/05-list-list.scm [new file with mode: 0644]
scaffold/boot/60-let-syntax-expanded.scm [new file with mode: 0644]
scaffold/boot/call-cc.scm [new file with mode: 0644]
scaffold/boot/memory.scm [new file with mode: 0644]
scaffold/boot/numbers.scm [new file with mode: 0644]
scaffold/tests/21-char[].c
scaffold/tests/23-pointer.c
scaffold/tests/46-function-static.c
scaffold/tests/48-global-static.c [deleted file]
scaffold/tests/49-global-static.c [new file with mode: 0644]
scaffold/tests/54-argv.c
scaffold/tests/62-array.c [new file with mode: 0644]
scaffold/tests/63-struct-cell.c
scaffold/tests/70-printf.c
scaffold/tests/71-struct-array.c
scaffold/tests/7i-struct-struct.c
scaffold/tests/90-goto-var.c [new file with mode: 0644]
scaffold/tests/91-goto-array.c [new file with mode: 0644]
scaffold/tests/t.c

index 1de60a9aa166faf0e7d7628f85995a29c600c1ec..dd2d5b62d78efda4bbbdb3b9df76aa49ed0c5830 100755 (executable)
@@ -75,6 +75,7 @@ t
 46-function-static
 47-function-expression
 48-function-destruct
+49-global-static
 50-assert
 51-strcmp
 52-itoa
@@ -82,6 +83,7 @@ t
 54-argv
 60-math
 61-array
+62-array
 63-struct-cell
 64-make-cell
 65-read
@@ -205,8 +207,8 @@ tests="
 50_logical_second_arg
 51_static
 52_unnamed_enum
-55_lshift_type
 54_goto
+55_lshift_type
 "
 
 broken="$broken
@@ -219,6 +221,7 @@ broken="$broken
 27_sizeof
 28_strings
 
+31_args
 32_led
 34_array_assignment
 37_sprintf
@@ -230,7 +233,6 @@ broken="$broken
 46_grep
 49_bracket_evaluation
 
-51_static
 52_unnamed_enum
 55_lshift_type
 "
diff --git a/doc/UPDATE-0.13 b/doc/UPDATE-0.13
new file mode 100644 (file)
index 0000000..00b5784
--- /dev/null
@@ -0,0 +1,87 @@
+Subject: wip-bootstrap updated
+
+I've updated the wip-bootstrap branch[0] for Mes[1] 0.13.  It has new
+mes-boot and tcc-boot packages.  mes-boot is a bootstrap version of
+Mes; it only depends on mescc-tools and a previously compiled mes.M1
+seed.  Likewise, tcc-boot depends on a precompiled tcc-seed.  Also,
+tcc-boot uses a heavily patched version of the tcc sources.
+
+Mes 0.13 is the first release that can bootstrap a fairly functional
+tcc-boot.  This bootstrapped tcc passes 67/68 C tests that were created
+for MesCC.  It can compile a version if itself where float, long long
+and bitfield are patched out...but linking fails.  This amazing
+compiler can now be played with by doing something like
+
+--8<---------------cut here---------------start------------->8---
+git checkout wip-bootstrap
+make
+./pre-inst-env guix build tcc-boot # may take ~2h
+./pre-inst-env guix environment --ad-hoc tcc-boot
+mes-tcc --help  #duck and run
+--8<---------------cut here---------------end--------------->8---
+
+The next big effort will be to make this mes-tcc fully functional and
+integrate this with GuixSD.  To give you a taste of that,
+here's latest bug I'm currently looking at (pretty printed comments
+are only added when Guile runs MesCC, the problem is in LEA)
+
+--8<---------------cut here---------------start------------->8---
+$ diff -u ../mes-seed/mes.M1 src/mes.M1
+--- ../mes-seed/mes.M1 2018-05-01 18:49:37.312162270 +0200
++++ src/mes.M1 2018-05-01 19:49:40.774770406 +0200
+@@ -35805,12 +33091,11 @@
+       call32 %strcpy
+       add____$i8,%esp !0x8
+       test___%eax,%eax
+-                                      # strcpy(buf + strlen(buf), "/mes/"); 
+-      push___$i32 &_string_reader_read_list_266
++      push___$i32 &_string_reader_read_list_265
+       mov____%ebp,%eax
+-      add____$i32,%eax %0x-200
++      add____$i32,%eax %0x-800
+       push___%eax
+-      lea____0x32(%ebp),%eax %0x-200
++      lea____0x32(%ebp),%eax %0x-800
+       push___%eax
+       call32 %strlen
+       add____$i8,%esp !0x4
+--8<---------------cut here---------------end--------------->8---
+
+We also need to remove some shortcuts that we took, most notably:
+mes-seed[3].  This seed consists of 1MB of M1 code.  mes.M1 is
+produced by compiling mes.c using MesCC, the C compiler written in
+(Guile) Scheme that comes with Mes.  Although that's really terrible,
+it's probably a big step forward: currently GuixSD uses ~250MB of
+binary seed: the bootstrap binaries.
+
+The plan is to replace the mes.M1 seed with mes.M2 and compile this
+new mes.M2 seed using the brand new M2-Planet[2].  M2 is basically
+simple C with structs, without preprocessor.  This will reduce the
+seed size by a factor of 10 while making it much more readable.
+
+An excerpt of the TODO I keep in Mes' BOOTSTRAP document
+
+--8<---------------cut here---------------start------------->8---
+* TODO
+** have tcc-boot's mes-tcc compile a fully functional tcc
+*** mescc: fix unknown bug.
+*** mescc: support function-static.
+*** mescc: support/grok global static.
+*** mescc: support unsigned comparison, arithmetic.
+*** mescc: support long long (do we need long long to get long long in tcc)?
+*** mescc: support bitfield (do we need bitfield to get bitfield in tcc)?
+*** mescc: support float (do we need float to get float in tcc)?
+** have bootstrapped tcc compile gcc-4.7
+** remove or upstream patches from tcc-boot
+** prepare src/mes.c for M2-Planet[2] transpiler
+** integrate with GuixSD
+** x86_64, arm, the Hurd
+--8<---------------cut here---------------end--------------->8---
+
+Greetings,
+janneke
+
+[0] http://git.savannah.gnu.org/cgit/guix.git/log/?h=wip-bootstrap
+[1] https://gitlab.com/janneke/mes
+[2] https://github.com/oriansj/m2-planet
+[3] https://gitlab.com/janneke/mes-seed
index f68b77c3a43733a9d10f4eee4657ac3295f551f3..81be01241cfba168a9d3a935029920e7041b8052 100644 (file)
                    (cons (ast-strip-const h) (ast-strip-const t))))
     (_  o)))
 
-(define (ast:function? o)
-  (and (pair? o) (eq? (car o) 'fctn-defn)))
-
-(define (.name o)
-  (pmatch o
-    ((fctn-defn _ (ftn-declr (ident ,name) _) _) name)
-    ((fctn-defn _ (ptr-declr (pointer) (ftn-declr (ident ,name) _)) _) name)
-    ((fctn-defn _ (ptr-declr (pointer (pointer)) (ftn-declr (ident ,name) _)) _) name)
-    ((ellipsis) #f)
-    ((param-decl (decl-spec-list (type-spec (void)))) #f)
-    ((param-decl _ (param-declr (ident ,name))) name)
-    ((param-decl _ (param-declr (ptr-declr (pointer) (ident ,name)))) name)
-    ((param-decl _ (param-declr (ptr-declr (pointer) (array-of (ident ,name))))) name)
-    ((param-decl _ (param-declr (ptr-declr (pointer (pointer)) (ident ,name)))) name)
-    ((param-decl _ (param-declr (ptr-declr (pointer (pointer (pointer))) (ident ,name)))) name)
-    ((param-decl _ (param-declr (ptr-declr (pointer (decl-spec-list) (pointer)) (ident ,name)))) name)
-    ((param-decl _ (param-declr (ptr-declr (pointer (decl-spec-list)) (array-of (ident ,name))))) name)
-    ((param-decl _ (param-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,params)))) name)
-    (_
-     (format (current-error-port) "SKIP: .name =~a\n" o))))
-
-(define (.type o)
-  (pmatch o
-    ((ellipsis) #f)
-    ((param-decl (decl-spec-list (type-spec (void)))) #f)
-    ((param-decl (decl-spec-list (type-spec ,type)) _) (decl->ast-type type))
-    ((param-decl ,type _) type)
-    (_
-     (format (current-error-port) "SKIP: .type =~a\n" o))))
-
-(define (.statements o)
-  (pmatch o
-    ((fctn-defn _ (ftn-declr (ident ,name) _) (compd-stmt (block-item-list . ,statements))) statements)
-    ((fctn-defn _ (ptr-declr (pointer) (ftn-declr (ident ,name) _)) (compd-stmt (block-item-list . ,statements))) statements)
-    ((fctn-defn _ (ptr-declr (pointer (pointer)) (ftn-declr (ident ,name) _)) (compd-stmt (block-item-list . ,statements))) statements)
-    (_ (error ".statements: not supported: " o))))
-
 (define (clone o . rest)
   (cond ((info? o)
          (let ((types (.types o))
     ((,name ,type ,size ,pointer) size)
     (_ (error (format #f "field:size: ~s\n" o)))))
 
+(define (struct:size o)
+  (field:size (cons 'struct (type:description o)))) ;;FIXME
+
 (define (field:type o)
   (pmatch o
     ((,name ,type ,size ,pointer) type)
     (_ (error (format #f "field:type: ~s\n" o)))))
 
-(define (get-type info o)
-  (let ((t (assoc-ref (.types info) o)))
-    (pmatch t
-      ((typedef ,next) (or (get-type info next) o))
-      (_ t))))
-
-(define (ast-type->type info o)
-  (if (type? o) o
-      (pmatch o
-        ((p-expr ,expr) (ast-type->type info (expr->type info o)))
-        ((pre-inc ,expr) (ast-type->type info expr))
-        ((post-inc ,expr) (ast-type->type info expr))
-        ((decl-spec-list ,type-spec)
-         (ast-type->type info type-spec))
-        ((decl-spec-list (type-qual ,qual) (type-spec (fixed-type ,type)))
-         (ast-type->type info type))
-        ((array-ref ,index (p-expr (ident ,array)))
-         (ast-type->type info `(p-expr (ident ,array))))
-        ((struct-ref (ident ,type))
-         (or (get-type info type)
-             (let ((struct (if (pair? type) type `("tag" ,type))))
-               (ast-type->type info struct))))
-        ((union-ref (ident ,type))
-         (or (get-type info type)
-             (let ((struct (if (pair? type) type `("tag" ,type))))
-               (ast-type->type info struct))))
-        ((void) (ast-type->type info "void"))
-        ((type-spec ,type) (ast-type->type info type))
-        ((fixed-type ,type) (ast-type->type info type))
-        ((float-type ,type) (ast-type->type info type))
-        ((typename ,type) (ast-type->type info type))
-        ((de-ref ,expr)
-         (ast-type->type info expr))
-        ((d-sel (idend ,field) ,struct)
-         (let ((type0 (ast-type->type info struct)))
-           (field-type info type0 field)))
-        ((i-sel (ident ,field) ,struct)
-         (let ((type0 (ast-type->type info struct)))
-           (field-type info type0 field)))
-        (_ (let ((type (get-type info o)))
-             (if type type
-                 (begin
-                   (stderr "types: ~s\n" (.types info))
-                   (error "ast-type->type: not supported: " o))))))))
+(define (ast->type info o)
+  (define (get-type o)
+    (let ((t (assoc-ref (.types info) o)))
+      (pmatch t
+        ((typedef ,next) (or (get-type next) o))
+        (_ t))))
+  (pmatch o
+    (,t (guard (type? t)) t)
+    ((p-expr ,expr) (ast->type info expr))
+    ((pre-inc ,expr) (ast->type info expr))
+    ((post-inc ,expr) (ast->type info expr))
+    ((ident ,name) (ident->type info name))
+    ((char ,value) (get-type "char"))
+    ((fixed ,value) (get-type "int"))
+    ((type-spec (typename ,type))
+     (ast->type info type))
+    ((array-ref ,index ,array)
+     (ast->type info array))
+    ((struct-ref (ident ,type))
+     (or (get-type type)
+         (let ((struct (if (pair? type) type `("tag" ,type))))
+           (ast->type info struct))))
+    ((union-ref (ident ,type))
+     (or (get-type type)
+         (let ((struct (if (pair? type) type `("tag" ,type))))
+           (ast->type info struct))))
+    ((struct-def (ident ,name) . _)
+     (ast->type info `("tag" ,name)))
+    ((union-def (ident ,name) . _)
+     (ast->type info `("tag" ,name)))
+    ((struct-def (field-list . ,fields))
+     (let ((fields (append-map (struct-field info) fields)))
+       (make-type 'struct (apply + (map field:size fields)) 0 fields)))
+    ((union-def (field-list . ,fields))
+     (let ((fields (append-map (struct-field info) fields)))
+       (make-type 'union (apply + (map field:size fields)) 0 fields)))
+    ((void) (ast->type info "void"))
+    ((fixed-type ,type) (ast->type info type))
+    ((float-type ,type) (ast->type info type))
+    ((typename ,type) (ast->type info type))
+    ((de-ref ,expr)
+     (ast->type info expr))
+    ((d-sel (ident ,field) ,struct)
+     (let ((type0 (ast->type info struct)))
+       (ast->type info (field-type info type0 field))))
+    ((i-sel (ident ,field) ,struct)
+     (let ((type0 (ast->type info struct)))
+       (ast->type info (field-type info type0 field))))
+    ((ref-to ,expr) (ast->type info expr))
+    ((pre-inc ,a) (ast->type info a))
+    ((pre-dec ,a) (ast->type info a))
+    ((post-inc ,a) (ast->type info a))
+    ((post-dec ,a) (ast->type info a))
+    ((add ,a ,b) (ast->type info a))
+    ((sub ,a ,b) (ast->type info a))
+    ((bitwise-and ,a ,b) (ast->type info a))
+    ((bitwise-not ,a) (ast->type info a))
+    ((bitwise-or ,a ,b) (ast->type info a))
+    ((bitwise-xor ,a ,b) (ast->type info a))
+    ((lshift ,a ,b) (ast->type info a))
+    ((rshift ,a ,b) (ast->type info a))
+    ((div ,a ,b) (ast->type info a))
+    ((mod ,a ,b) (ast->type info a))
+    ((mul ,a ,b) (ast->type info a))
+    ((not ,a) (ast->type info a))
+    ((neg ,a) (ast->type info a))
+    ((eq ,a ,b) (ast->type info a))
+    ((ge ,a ,b) (ast->type info a))
+    ((gt ,a ,b) (ast->type info a))
+    ((ne ,a ,b) (ast->type info a))
+    ((le ,a ,b) (ast->type info a))
+    ((lt ,a ,b) (ast->type info a))
+    ((or ,a ,b) (ast->type info a))
+    ((and ,a ,b) (ast->type info a))
+    ((cast (type-name ,type) ,expr)     ; FIXME: ignore expr?
+     (ast->type info type))
+    ((cast (type-name ,type (abs-declr ,pointer)) ,expr) ; FIXME: ignore expr?
+     (ast->type info type))
+    ((decl-spec-list (type-spec ,type))
+     (ast->type info type))
+    ((assn-expr ,a ,op ,b)
+     (ast->type info a))
+    ((enum-ref . _) (get-type "int"))
+    ((sizeof-type . _) (get-type "int"))
+    ((sizeof-expr . _) (get-type "int"))
+    ((string _) (get-type "char"))
+    ((fctn-call (p-expr (ident ,function)) . ,rest)
+     (or (and=> (assoc-ref (.functions info) function) function:type)
+         (begin
+           (stderr "ast->type: no such function: ~s\n" function)
+           (get-type "int"))))
+    (_ (let ((type (get-type o)))
+         (cond ((type? type) type)
+               ((and (pair? type) (equal? (car type) "tag"))
+                (stderr "NO STRUCT YET:~s\n" (.types info))
+                type)
+               ((and (pair? o) (equal? (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)
-  (let* ((type (ast-type->type info o))
-         (xtype (if (type? type) type
-                    (ast-type->type info type))))
-    (type:description xtype)))
+  ((compose type:description (cut ast->type info <>) o)))
 
 (define (ast-type->size info o)
-  (let* ((type (ast-type->type info o))
-         (xtype (if (type? type) type
-                    (ast-type->type info type))))
-    (type:size xtype)))
+  ;;((compose type:size (cut ast->type info <>)) o)
+  (let ((type (if (type? o) o
+                  (ast->type info o))))
+    (if (not (type? type)) (error "ast-type->size: no such type:" o)
+        (type:size type))))
 
 (define (field-field info struct field)
   (let* ((xtype (if (type? struct) struct
-                    (ast-type->type info struct)))
+                    (ast->type info struct)))
          (fields (type:description xtype)))
     (let loop ((fields fields))
       (if (null? fields) (error (format #f "no such field: ~a in ~s" field struct))
 
 (define (field-offset info struct field)
   (let ((xtype (if (type? struct) struct
-                    (ast-type->type info struct))))
+                    (ast->type info struct))))
     (if (eq? (type:type xtype) 'union) 0
         (let ((fields (type:description xtype)))
           (let loop ((fields fields) (offset 0))
 
 (define (field-size info struct field)
   (let ((xtype (if (type? struct) struct
-                   (ast-type->type info struct))))
+                   (ast->type info struct))))
     (if (eq? (type:type xtype) 'union) 0
         (let ((field (field-field info struct field)))
           (field:size field)))))
   (let ((field (field-field info struct field)))
     (field:type field)))
 
-(define (ast->type o)
+(define (struct->fields o)
   (pmatch o
-    ((fixed-type ,type)
-     type)
-    ((typename ,type)
-     type)
-    ((struct-ref (ident ,type))
-     `("tag" ,type))
-    (_ (stderr "SKIP: .type=~s\n" o)
-       "int")))
-
-(define (decl->ast-type o)
-  (pmatch o
-    ((fixed-type ,type) type)
-    ((struct-ref (ident (,name))) `("tag" ,name))
-    ((struct-ref (ident ,name)) `("tag" ,name))
-    ((struct-def (ident ,name) . ,fields) `("tag" ,name))
-    ((decl (decl-spec-list (type-spec (struct-ref (ident ,name))))) ;; "scm"
-     `("tag" ,name)) ;; FIXME
-    ((typename ,name) name)
-    (,name name)
-    (_ (error "decl->ast-type: not supported: " o))))
+    (_ (guard (and (type? o) (eq? (type:type o) 'struct)))
+       (append-map struct->fields (type:description o)))
+    (_ (guard (and (type? o) (eq? (type:type o) 'union)))
+       (struct->fields (car (type:description o))))
+    ((struct . ,fields)
+     (append-map struct->fields fields))
+    (_ (list o))))
 
 (define (byte->hex.m1 o)
   (string-drop o 2))
         (let ((s (string-drop o (string-length prefix))))
           (list (format #f "'~a'" (string-join (map byte->hex.m1 (cdr (string-split o #\space))) " ")))))))
 
-(define (ident->decl info o)
+(define (ident->variable info o)
   (or (assoc-ref (.locals info) o)
       (assoc-ref (.globals info) o)
+      (assoc-ref (.statics info) o)
       (assoc-ref (.constants info) o)
+      (assoc-ref (.functions info) o)
       (begin
-        (stderr "NO IDENT: ~a\n" o)
-        (assoc-ref (.functions info) o))))
+        (stderr "info=~s\n" info)
+        (error "ident->variable: undefined variabled:" o))))
 
 (define (ident->type info o)
-  (let ((type (ident->decl info o)))
-    (cond ((global? type) (global:type type))
-          ((local? type) (local:type type))
-          ((assoc-ref (.constants info) o) "int")
-          (else (stderr "ident->type ~s => ~s\n" o type)
-                (car type)))))
+  (let ((var (ident->variable info o)))
+    (cond ((global? var) (global:type var))
+          ((local? var) (local:type var))
+          ((assoc-ref (.constants info) o) (assoc-ref (.types info) "int"))
+          ((pair? var) (car var))
+          (else (stderr "ident->type ~s => ~s\n" o var)
+                #f))))
 
 (define (ident->pointer info o)
   (let ((local (assoc-ref (.locals info) o)))
-    (if local (local:pointer local)
+    (if local (let* ((t ((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
-              (global:pointer (ident->decl info o))
+              (let* ((t ((compose type:pointer global:type) global))
+                     ;;(global:pointer (ident->variable info o))
+                     (v (global:pointer global))
+                     (p (+ (abs t) (abs v))))
+                (if (or (< t 0) (< v 0)) (- p) p))
               0)))))
 
-(define (ident->type-size info o)
-  (let* ((type (ident->type info o))
-         (xtype (ast-type->type info type)))
-    (type:size xtype)))
+(define (ident->size info o)
+    ((compose type:size (cut ident->type info <>)) o))
 
 (define (ptr-inc o)
   (if (< o 0) (1- o)
   (if (< o 0) (1+ o)
       (1- o)))
 
-(define (expr->pointer info o)
+(define (pointer->ptr o)
   (pmatch o
     ((pointer) 1)
+    ((pointer ,pointer) (1+ (pointer->ptr pointer)))))
+
+(define (expr->pointer info o)
+  (pmatch o
+    ((pointer . _) (pointer->ptr o))
     ((p-expr (char ,value)) 0)
     ((p-expr (fixed ,value)) 0)
-    ((p-expr (ident ,name)) (ident->pointer info name))
+    ((ident ,name) (ident->pointer info name))
+    ((p-expr ,expr) (expr->pointer info expr))
     ((de-ref ,expr) (ptr-dec (expr->pointer info expr)))
     ((assn-expr ,lhs ,op ,rhs) (expr->pointer info lhs))
     ((add ,a ,b) (expr->pointer info a))
     ((post-inc ,a) (expr->pointer info a))
     ((post-dec ,a) (expr->pointer info a))
     ((ref-to ,expr) (ptr-inc (expr->pointer info expr)))
-    ((array-ref ,index ,array) (ptr-dec (expr->pointer info array)))
+    ((array-ref ,index ,array)
+     (ptr-dec (abs (expr->pointer info array))))
 
     ((d-sel (ident ,field) ,struct)
-     (let ((type (expr->type info struct)))
+     (let ((type (ast->type info struct)))
        (field-pointer info type field)))
 
     ((i-sel (ident ,field) ,struct)
-     (let ((type (expr->type info struct)))
+     (let ((type (ast->type info struct)))
        (field-pointer info type field)))
 
     ((cast (type-name ,type) ,expr)     ; FIXME: add expr?
-     (let* ((type (ast-type->type info type))
+     (let* ((type (ast->type info type))
             (pointer (type:pointer type)))
        pointer))
     ((cast (type-name ,type (abs-declr ,pointer)) ,expr) ; FIXME: add expr?
-     (let* ((type (ast-type->type info type))
+     (let* ((type (ast->type info type))
             (pointer0 (type:pointer type))
             (pointer1 (ptr-declr->pointer pointer))
             (pointer2 (expr->pointer info expr)))
        (+ pointer0 pointer1)))
     ((type-spec ,type)
-     (or (and=> (ast-type->type info o) type:pointer)
+     (or (and=> (ast->type info o) type:pointer)
          (begin
            (stderr "expr->pointer: not supported: ~a\n" o)
            0)))
          (begin
            (stderr "expr->pointer: no such function: ~a\n" function)
            0)))
-    (_ (stderr "expr->pointer: not supported: ~s\n" o) 0)))
-
-(define (expr->type-size info o)
-  (pmatch o
-    ((p-expr (char ,value)) 1)
-    ((p-expr (fixed ,name)) %int-size)
-    ((p-expr (ident ,name)) (ident->type-size info name))
-
-    ((array-ref ,index ,array)
-     (let ((type (expr->type info array)))
-       (ast-type->size info type)))
-
-    ((d-sel (ident ,field) ,struct)
-     (let* ((type (expr->type info struct))
-            (type (field-type info type field)))
-       (ast-type->size info type)))
 
-    ((i-sel (ident ,field) ,struct)
-     (let* ((type (expr->type info struct))
-            (type (field-type info type field)))
-       (ast-type->size info type)))
-
-    ((de-ref ,expr) (expr->type-size info expr))
-    ((ref-to ,expr) (expr->type-size info expr))
-    ((add ,a ,b) (expr->type-size info a))
-    ((div ,a ,b) (expr->type-size info a))
-    ((mod ,a ,b) (expr->type-size info a))
-    ((mul ,a ,b) (expr->type-size info a))
-    ((sub ,a ,b) (expr->type-size info a))
-    ((neg ,a) (expr->type-size info a))
-    ((pre-inc ,a) (expr->type-size info a))
-    ((pre-dec ,a) (expr->type-size info a))
-    ((post-inc ,a) (expr->type-size info a))
-    ((post-dec ,a) (expr->type-size info a))
-    ((cast (type-name ,type) ,expr)     ; FIXME: ignore expr?
-     (let ((type (ast-type->type info type)))
-       (type:size type)))
-    ((cast (type-name ,type (abs-declr ,pointer)) ,expr) ; FIXME: ignore expr?
-     (let ((type (ast-type->type info type)))
-       (type:size type)))
-    ((fctn-call (p-expr (ident ,function)) . ,rest)
-     (or (and=> (and=> (assoc-ref (.functions info) function) function:type)
-                (lambda (t)
-                  (and (type? t) (type:size t))))
-         (begin
-           (stderr "expr->type-size: no such function: ~a\n" function)
-           4)))
-    (_ (stderr "expr->type-size: not supported: ~s\n" o) 4)))
+    ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr ,pointer ,init) . ,initzer)))
+     (let* ((t (expr->pointer info `(type-spec ,type)))
+            (i (expr->pointer info init))
+            (p (expr->pointer 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->pointer info `(type-spec ,type)))
+            (i  (expr->pointer 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->pointer info pointer))
+            (a (expr->pointer info array))
+            (t (+ (abs p) (abs a) 2)))
+       (- t)))
+    ((ptr-declr ,pointer . ,rest)
+     (expr->pointer info pointer))
+    ((array-of ,array . ,rest)
+     (let ((a (abs (expr->pointer info array))))
+       (- (+ a 1))))
+    (_ (stderr "expr->pointer: not supported: ~s\n" o) 0)))
 
 (define (expr->size info o)
   (let ((ptr (expr->pointer info o)))
     (if (or (= ptr -1)
             (= ptr 0))
-        (expr->type-size info o)
+        (ast-type->size info o)
         %pointer-size)))
 
-(define (expr->type info o)
-  (pmatch o
-    ((p-expr (char ,name)) "char")
-    ((p-expr (fixed ,value)) "int")
-    ((p-expr (ident ,name)) (ident->type info name))
-    ((array-ref ,index ,array)
-     (expr->type info array))
-
-    ((i-sel (ident ,field) ,struct)
-     (let ((type (expr->type info struct)))
-       (field-type info type field)))
-
-    ((d-sel (ident ,field) ,struct)
-     (let ((type (expr->type info struct)))
-       (field-type info type field)))    
-    
-    ((de-ref ,expr) (expr->type info expr))
-    ((ref-to ,expr) (expr->type info expr))
-    ((add ,a ,b) (expr->type info a))
-    ((div ,a ,b) (expr->type info a))
-    ((mod ,a ,b) (expr->type info a))
-    ((mul ,a ,b) (expr->type info a))
-    ((sub ,a ,b) (expr->type info a))
-    ((neg ,a) (expr->type info a))
-    ((pre-inc ,a) (expr->type info a))
-    ((pre-dec ,a) (expr->type info a))
-    ((post-inc ,a) (expr->type info a))
-    ((post-dec ,a) (expr->type info a))
-    ((cast (type-name ,type) ,expr) ; FIXME: ignore expr?
-     type)
-    ((cast (type-name ,type (abs-declr ,pointer)) ,expr) ; FIXME: ignore expr?
-     type)
-    ((fctn-call (p-expr (ident ,function)) . ,rest)
-     (or (and=> (assoc-ref (.functions info) function) function:type)
-         (begin
-           (stderr "expr->type: no such function: ~s\n" function)
-           "int")))
-    (_ ;;(error (format #f "expr->type: not supported: ~s") o)
-     (stderr "TODO: expr->type: not supported: ~s\n" o)
-     "int")))
-
 (define (append-text info text)
   (clone info #:text (append (.text info) text)))
 
           (wrap-as (i386:push-byte-local-de-de-ref (local:id o)))
           (error "TODO int-de-de-ref")))))
 
-(define (make-global-entry key type pointer value)
-  (cons key (make-global key type pointer value #f)))
+(define (make-global-entry key type pointer array value)
+  (cons key (make-global key type pointer array value #f)))
 
 (define (string->global-entry string)
-  (make-global-entry `(#:string ,string) "string" 0 (append (string->list string) (list #\nul))))
-
-(define (int->global-entry value)
-  (make-global-entry (number->string value) "int" 0 (int->bv32 value)))
+  (let ((value (append (string->list string) (list #\nul))))
+   (make-global-entry `(#:string ,string) "char" 0 (length value) value)))
 
-(define (ident->global-entry name type pointer value)
-  (make-global-entry name type pointer (if (pair? value) value (int->bv32 value))))
-
-(define (make-local-entry name type pointer id)
-  (cons name (make-local type pointer id)))
+(define (make-local-entry name type pointer array id)
+  (cons name (make-local type pointer array id)))
 
 (define* (mescc:trace name #:optional (type ""))
   (format (current-error-port) "    :~a~a\n" name type))
 
 (define (expr->arg info)
   (lambda (o)
-    (let ((info ((expr->accu info) o)))
-      (append-text info (wrap-as (i386:push-accu))))))
+    (pmatch o
+      ((p-expr (string ,string))
+       (let* ((globals ((globals:add-string (.globals info)) string))
+              (info (clone info #:globals globals)))
+         (append-text info ((push-global-address info) `(#:string ,string)))))
+      (_ (let ((info (expr->accu o info)))
+           (append-text info (wrap-as (i386:push-accu))))))))
 
 (define (globals:add-string globals)
   (lambda (o)
       (if (assoc-ref globals string) globals
           (append globals (list (string->global-entry o)))))))
 
-(define (expr->arg info) ;; FIXME: get Mes curried-definitions
-  (lambda (o)
-    (let ((text (.text info)))
-      (pmatch o
-
-        ((p-expr (string ,string))
-         (let* ((globals ((globals:add-string (.globals info)) string))
-                (info (clone info #:globals globals)))
-           (append-text info ((push-global-address info) `(#:string ,string)))))
-
-        ((p-expr (ident ,name))
-         (append-text info ((push-ident info) name)))
-
-        ((cast (type-name (decl-spec-list (type-spec (fixed-type _)))
-                          (abs-declr (pointer)))
-               ,cast)
-         ((expr->arg info) cast))
-
-        ((cast (type-name (decl-spec-list (type-spec (fixed-type ,type)))) ,cast)
-         ((expr->arg info) cast))
-
-        ((de-ref (p-expr (ident ,name)))
-         (append-text info ((push-ident-de-ref info) name)))
-
-        ((de-ref (de-ref (p-expr (ident ,name))))
-         (append-text info ((push-ident-de-de-ref info) name)))
-
-        ((ref-to (p-expr (ident ,name)))
-         (append-text info ((push-ident-address info) name)))
-
-        (_ (append-text ((expr->accu info) o)
-                        (wrap-as (i386:push-accu))))))))
+(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)
-           =>
-           (lambda (local)
-             (let* ((ptr (local:pointer local))
-                    (type (ident->type info o))
-                    (size (if (= ptr 0) (ast-type->size info type)
-                              4)))
-               (cond ((< ptr 0) (wrap-as (i386:local-ptr->accu (local:id local))))
-                     (else (wrap-as (case size
-                                      ((1) (i386:byte-local->accu (local:id local)))
-                                      ((2) (i386:word-local->accu (local:id local)))
-                                      (else (i386:local->accu (local:id local))))))))))
+    (cond ((assoc-ref (.locals info) o) => local->accu)
           ((assoc-ref (.statics info) o)
            =>
            (lambda (global)
 (define (value->accu v)
   (wrap-as (i386:value->accu v)))
 
+(define (accu->local+n-text local n)
+  (let* ((type (local:type local))
+         (ptr (local:pointer local))
+         (size (if (= ptr -1) ((compose type:size local:type) local)
+                   4))
+         (id (local:id local)))
+    (wrap-as (case size
+               ((1) (i386:byte-accu->local+n id n))
+               ((2) (i386:word-accu->local+n id n))
+               (else (i386:accu->local+n id n))))))
+
 (define (accu->ident info)
   (lambda (o)
-    (let* ((local (assoc-ref (.locals info) o))
-           (ptr (ident->pointer info o))
-           (size (if (or (= ptr -1) (= ptr 0)) (ident->type-size info o)
-                     4)))
-      (if local (if (<= size 4) (wrap-as (i386:accu->local (local:id local)))
-                    (wrap-as (i386:accu*n->local (local:id local) size)))
-          (if (<= size 4) (wrap-as (i386:accu->label o))
-              (wrap-as (i386:accu*n->label o size)))))))
+    (cond ((assoc-ref (.locals info) o)
+           =>
+           (lambda (local) (let ((size (->size local)))
+                             (if (<= size 4) (wrap-as (i386:accu->local (local:id local)))
+                                 (wrap-as (i386:accu*n->local (local:id local) size))))))
+          ((assoc-ref (.statics info) o)
+           =>
+           (lambda (global) (let ((size (->size global)))
+                              (if (<= size 4) (wrap-as (i386:accu->label global))
+                                  (wrap-as (i386:accu*n->label global size))))))
+          ((assoc-ref (filter (negate static-global?) (.globals info)) o)
+           =>
+           (lambda (global) (let ((size (->size global)))
+                              (if (<= size 4) (wrap-as (i386:accu->label global))
+                                  (wrap-as (i386:accu*n->label global size)))))))))
 
 (define (value->ident info)
   (lambda (o value)
-    (let ((local (assoc-ref (.locals info) o)))
-      (if local (wrap-as (i386:value->local (local:id local) value))
-          (list (i386:value->label `(#:address ,o) value))))))
+    (cond ((assoc-ref (.locals info) o)
+           =>
+           (lambda (local) (wrap-as (i386:value->local (local:id local) value))))
+          ((assoc-ref (.statics info) o)
+           =>
+           (lambda (global) (list (i386:value->label `(#:address ,global) value))))
+          ((assoc-ref (filter (negate static-global?) (.globals info)) o)
+           =>
+           (lambda (global) (list (i386:value->label `(#:address ,global) value)))))))
 
 (define (ident-add info)
   (lambda (o n)
-    (let ((local (assoc-ref (.locals info) o)))
-      (if local (wrap-as (i386:local-add (local:id local) n))
-          (list (i386:label-mem-add `(#:address ,o) n))))))
+    (cond ((assoc-ref (.locals info) o)
+           =>
+           (lambda (local) (wrap-as (i386:local-add (local:id local) n))))
+          ((assoc-ref (.statics info) o)
+           =>
+           (lambda (global) (list (i386:label-mem-add `(#:address ,o) n))))
+          ((assoc-ref (filter (negate static-global?) (.globals info)) o)
+           =>
+           (lambda (global) (list (i386:label-mem-add `(#:address ,global) n)))))))
 
 (define (expr-add info)
   (lambda (o n)
-    (let* ((info ((expr->accu* info) o))
+    (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)
-    (let ((local (assoc-ref (.locals info) o)))
-      (if local (wrap-as (append (i386:push-accu)
-                                 (i386:local->accu (local:id local))
-                                 (i386:accu-mem-add n)
-                                 (i386:pop-accu)))
-          (list (wrap-as (append (i386:push-accu)
-                                 (i386:label->accu `(#:address ,o))
-                                 (i386:accu-mem-add n)
-                                 (i386:pop-accu))))))))
+    (cond ((assoc-ref (.locals info) o)
+           =>
+           (lambda (local) (wrap-as (append (i386:push-accu)
+                                            (i386:local->accu (local:id local))
+                                            (i386:accu-mem-add n)
+                                            (i386:pop-accu)))))
+          ((assoc-ref (.statics info) o)
+           =>
+           (lambda (global) (list (wrap-as (append (i386:push-accu)
+                                                   (i386:label->accu `(#:address ,global))
+                                                   (i386:accu-mem-add n)
+                                                   (i386:pop-accu))))))
+          ((assoc-ref (filter (negate static-global?) (.globals info)) o)
+           =>
+           (lambda (global) (list (wrap-as (append (i386:push-accu)
+                                                   (i386:label->accu `(#:address ,global))
+                                                   (i386:accu-mem-add n)
+                                                   (i386:pop-accu)))))))))
 
 (define (binop->accu info)
   (lambda (a b c)
-    (let* ((info ((expr->accu info) a))
-           (info ((expr->base info) b)))
+    (let* ((info (expr->accu a info))
+           (info (expr->base b info)))
       (append-text info (wrap-as c)))))
 
 (define (wrap-as o . annotation)
 
 (define (ast->comment o)
   (if mes? '()
-      (let ((source (with-output-to-string (lambda () (pretty-print-c99 o)))))
-        (make-comment (string-join (string-split source #\newline) " ")))))
+      (begin
+        (pmatch o
+          ;; Nyacc 0.80.42: missing  (enum-ref (ident "fred"))
+          ((decl (decl-spec-list (type-spec (enum-ref . _))) . _)
+           '())
+         (_ (let ((source (with-output-to-string (lambda () (pretty-print-c99 o)))))
+              (make-comment (string-join (string-split source #\newline) " "))))))))
 
 (define (accu*n info n)
   (append-text info (wrap-as (case n
 (define (accu->base-mem*n info n)
   (append-text info (accu->base-mem*n- info n)))
 
-(define (accu->local+n info local)
-  (lambda (n)
-    (let* ((type (local:type local))
-           (ptr (local:pointer local))
-           (size (if (= ptr -2) (ast-type->size info type)
-                     4))
-           (id (local:id local)))
-      (append-text info (wrap-as (case size
-                                   ((1) (i386:byte-accu->local+n id n))
-                                   ((2) (i386:word-accu->local+n id n))
-                                   (else (i386:accu->local+n id n))))))))
-
-(define (expr->accu* info)
-  (lambda (o)
+(define (expr->accu* o info)
+  (pmatch o
+
+    ((p-expr (ident ,name))
+     (append-text info ((ident-address->accu info) name)))
+
+    ((de-ref ,expr)
+     (expr->accu expr info))
+
+    ((d-sel (ident ,field) ,struct)
+     (let* ((type (ast->type info struct))
+            (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)))
+            (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))
+            (offset (field-offset info type field))
+            (info (expr->accu* struct info)))
+       (append-text info (append (wrap-as (i386:mem->accu))
+                                 (wrap-as (i386:accu+value offset))))))
+
+    ((array-ref ,index ,array)
+     (let* ((info (expr->accu index info))
+            (ptr (expr->pointer info array))
+            (size (expr->size info o))
+            (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->accu o info)
+  (let ((locals (.locals info))
+        (constants (.constants info))
+        (text (.text info))
+        (globals (.globals info)))
     (pmatch o
+      ((expr) info)
+
+      ((comma-expr) info)
+
+      ((comma-expr ,a . ,rest)
+       (let ((info (expr->accu a info)))
+         (expr->accu `(comma-expr ,@rest) info)))
+
+      ((p-expr (string ,string))
+       (let* ((globals ((globals:add-string globals) string))
+              (info (clone info #:globals globals)))
+         (append-text info (list (i386:label->accu `(#:string ,string))))))
+
+      ((p-expr (fixed ,value))
+       (let ((value (cstring->number value)))
+         (append-text info (wrap-as (i386:value->accu value)))))
+
+      ((neg (p-expr (fixed ,value)))
+       (let ((value (- (cstring->number value))))
+         (append-text info (wrap-as (i386:value->accu value)))))
+
+      ((p-expr (char ,char))
+       (let ((char (char->integer (car (string->list char)))))
+         (append-text info (wrap-as (i386:value->accu char)))))
+
+      ((p-expr (string . ,strings))
+       (append-text info (list (i386:label->accu `(#:string ,(apply string-append strings))))))
 
       ((p-expr (ident ,name))
-       (append-text info ((ident-address->accu info) name)))
+       (append-text info ((ident->accu info) name)))
 
-      ((de-ref ,expr)
-       ((expr->accu info) expr))
+      ((initzer ,initzer)
+       (expr->accu initzer info))
 
-      ((d-sel (ident ,field) ,struct)
-       (let* ((type (expr->type info struct))
+      ;; 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))
               (offset (field-offset info type field))
-              (info ((expr->accu* info) struct)))
-         (append-text info (wrap-as (i386:accu+value offset)))))
+              (base (cstring->number base)))
+         (append-text info (wrap-as (i386:value->accu (+ base offset))))))
 
-      ((i-sel (ident ,field) (fctn-call (p-expr (ident ,function)) . ,rest))
-       (let* ((type (expr->type info `(fctn-call (p-expr (ident ,function)) ,@rest)))
-              (offset (field-offset info type field))
-              (info ((expr->accu info) `(fctn-call (p-expr (ident ,function)) ,@rest))))
-         (append-text info (wrap-as (i386:accu+value offset)))))
+      ;; &foo
+      ((ref-to (p-expr (ident ,name)))
+       (append-text info ((ident-address->accu info) name)))
 
-      ((i-sel (ident ,field) ,struct)
-       (let* ((type (expr->type info struct))
-              (offset (field-offset info type field))
-              (info ((expr->accu* info) struct)))
-         (append-text info (append (wrap-as (i386:mem->accu))
-                                   (wrap-as (i386:accu+value offset))))))
+      ;; &*foo
+      ((ref-to (de-ref ,expr))
+       (expr->accu expr info))
+
+      ((ref-to ,expr)
+       (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)))))
+
+      ((sizeof-type (type-name (decl-spec-list ,type) (abs-declr (pointer))))
+       (let ((size 4))
+         (append-text info (wrap-as (i386:value->accu size)))))
 
       ((array-ref ,index ,array)
-       (let* ((info ((expr->accu info) index))
-              (ptr (expr->pointer info array))
-              (size (if (or (= ptr 1) (= ptr -1) (= ptr -2)) (expr->type-size info array)
-                        4))
-              (info (accu*n info size))
-              (info ((expr->base info) array)))
-         (append-text info (wrap-as (i386:accu+base)))))
+       (let* ((info (expr->accu* o info))
+              (size (expr->size info o)))
+         (append-text info (wrap-as (case size
+                                      ((1) (i386:byte-mem->accu))
+                                      ((2) (i386:word-mem->accu))
+                                      ((4) (i386:mem->accu))
+                                      (else '()))))))
+
+      ((d-sel ,field ,struct)
+       (let* ((info (expr->accu* o info))
+              (info (append-text info (ast->comment o)))
+              (ptr (expr->pointer info o))
+              (size (if (= ptr 0) (ast-type->size info o)
+                        4)))
+         (if (or (= -2 ptr) (= -1 ptr)) info
+             (append-text info (wrap-as (case size
+                                          ((1) (i386:byte-mem->accu))
+                                          ((2) (i386:word-mem->accu))
+                                          ((4) (i386:mem->accu))
+                                          (else '())))))))
+
+      ((i-sel ,field ,struct)
+       (let* ((info (expr->accu* o info))
+              (info (append-text info (ast->comment o)))
+              (ptr (expr->pointer info o))
+              (size (if (= ptr 0) (ast-type->size info o)
+                        4)))
+         (if (or (= -2 ptr) (= ptr -1)) info
+             (append-text info (wrap-as (case size
+                                          ((1) (i386:byte-mem->accu))
+                                          ((2) (i386:word-mem->accu))
+                                          ((4) (i386:mem->accu))
+                                          (else '())))))))
 
-      (_ (error "expr->accu*: not supported: " o)))))
+      ((de-ref ,expr)
+       (let* ((info (expr->accu expr info))
+              (size (expr->size info o)))
+         (append-text info (wrap-as (case size
+                                      ((1) (i386:byte-mem->accu))
+                                      ((2) (i386:word-mem->accu))
+                                      ((4) (i386:mem->accu))
+                                      (else '()))))))
+
+      ((fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list))
+       (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
+                                 (append-text info (wrap-as (asm->m1 arg0))))
+           (let* ((text-length (length text))
+                  (args-info (let loop ((expressions (reverse expr-list)) (info info))
+                               (if (null? expressions) info
+                                   (loop (cdr expressions) ((expr->arg info) (car expressions))))))
+                  (n (length expr-list)))
+             (if (not (assoc-ref locals name))
+                 (begin
+                   (if (and (not (assoc name (.functions info)))
+                            (not (assoc name globals))
+                            (not (equal? name (.function info))))
+                       (stderr "warning: undeclared function: ~a\n" name))
+                   (append-text args-info (list (i386:call-label name n))))
+                 (let* ((empty (clone info #:text '()))
+                        (accu (expr->accu `(p-expr (ident ,name)) empty)))
+                   (append-text args-info (append (.text accu)
+                                                  (list (i386:call-accu n)))))))))
+
+      ((fctn-call ,function (expr-list . ,expr-list))
+       (let* ((text-length (length text))
+              (args-info (let loop ((expressions (reverse expr-list)) (info info))
+                           (if (null? expressions) info
+                               (loop (cdr expressions) ((expr->arg info) (car expressions))))))
+              (n (length expr-list))
+              (empty (clone info #:text '()))
+              (accu (expr->accu function empty)))
+         (append-text args-info (append (.text accu)
+                                        (list (i386:call-accu n))))))
+
+      ((cond-expr . ,cond-expr)
+       (ast->info `(expr-stmt ,o) info))
+
+      ((post-inc ,expr)
+       (let* ((info (append (expr->accu expr info)))
+              (info (append-text info (wrap-as (i386:push-accu))))
+              (ptr (expr->pointer info expr))
+              (size (cond ((= ptr 1) (ast-type->size info expr))
+                          ((> ptr 1) 4)
+                          (else 1)))
+              (info ((expr-add info) expr size))
+              (info (append-text info (wrap-as (i386:pop-accu)))))
+         info))
 
-(define (expr->accu info)
-  (lambda (o)
-    (let ((locals (.locals info))
-          (constants (.constants info))
-          (text (.text info))
-          (globals (.globals info)))
-      (define (add-local locals name type pointer)
-        (let* ((id (if (or (null? locals) (not (local-var? (cdar locals)))) 1
-                       (1+ (local:id (cdar locals)))))
-               (locals (cons (make-local-entry name type pointer id) locals)))
-          locals))
-      (pmatch o
-        ((expr) info)
-
-        ((comma-expr) info)
-
-        ((comma-expr ,a . ,rest)
-         (let ((info ((expr->accu info) a)))
-           ((expr->accu info) `(comma-expr ,@rest))))
-
-        ((p-expr (string ,string))
-         (let* ((globals ((globals:add-string globals) string))
-                (info (clone info #:globals globals)))
-           (append-text info (list (i386:label->accu `(#:string ,string))))))
-
-        ;; FIXME: FROM INFO ...only zero?!
-        ((p-expr (fixed ,value))
-         (let ((value (cstring->number value)))
-           (append-text info (wrap-as (i386:value->accu value)))))
-
-        ((p-expr (char ,char))
-         (let ((char (char->integer (car (string->list char)))))
-           (append-text info (wrap-as (i386:value->accu char)))))
-
-        ((p-expr (string . ,strings))
-         (append-text info (list (i386:label->accu `(#:string ,(apply string-append strings))))))
-
-        ((p-expr (ident ,name))
-         (append-text info ((ident->accu info) name)))
-
-        ((initzer ,initzer)
-         ((expr->accu info) initzer))
-
-        ;; offsetoff
-        ((ref-to (i-sel (ident ,field) (cast (type-name (decl-spec-list ,struct) (abs-declr (pointer))) (p-expr (fixed ,base)))))
-         (let* ((type (decl->ast-type struct))
-                (offset (field-offset info type field))
-                (base (cstring->number base)))
-           (append-text info (wrap-as (i386:value->accu (+ base offset))))))
-
-        ;; &foo
-        ((ref-to (p-expr (ident ,name)))
-         (append-text info ((ident-address->accu info) name)))
-
-        ;; &*foo
-        ((ref-to (de-ref ,expr))
-         ((expr->accu info) expr))
-
-        ((ref-to ,expr)
-         ((expr->accu* info) expr))
-
-        ((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)))))
-
-        ((sizeof-type (type-name (decl-spec-list ,type) (abs-declr (pointer))))
-         (let ((size 4))
-           (append-text info (wrap-as (i386:value->accu size)))))
-
-        ;; <expr>[baz]
-        ((array-ref ,index ,array)
-         (let* ((info ((expr->accu* info) o))
-                (ptr (expr->pointer info array))
-                (size (if (or (= ptr 1) (= ptr -1) (= ptr -2)) (expr->type-size info array)
-                          4)))
-           (append-text info (wrap-as (case size
-                                        ((1) (i386:byte-mem->accu))
-                                        ((2) (i386:word-mem->accu))
-                                        ((4) (i386:mem->accu))
-                                        (else '()))))))
-
-        ((d-sel ,field ,struct)
-         (let* ((info ((expr->accu* info) o))
-                (info (append-text info (ast->comment o)))
-                (ptr (expr->pointer info o))
-                (size (if (= ptr 0) (expr->type-size info o)
-                          4)))
-           (if (or (= -2 ptr) (= -1 ptr)) info
-               (append-text info (wrap-as (case size
-                                            ((1) (i386:byte-mem->accu))
-                                            ((2) (i386:word-mem->accu))
-                                            ((4) (i386:mem->accu))
-                                            (else '())))))))
-
-        ((i-sel ,field ,struct)
-         (let* ((info ((expr->accu* info) o))
-                (info (append-text info (ast->comment o)))
-                (ptr (expr->pointer info o))
-                (size (if (= ptr 0) (expr->type-size info o)
-                          4)))
-           (if (or (= -2 ptr) (= ptr -1)) info
-               (append-text info (wrap-as (case size
-                                            ((1) (i386:byte-mem->accu))
-                                            ((2) (i386:word-mem->accu))
-                                            ((4) (i386:mem->accu))
-                                            (else '())))))))
-
-        ((de-ref ,expr)
-         (let* ((info ((expr->accu info) expr))
-                (ptr (expr->pointer info expr))
-                (size (expr->size info o)))
-           (append-text info (wrap-as (case size
-                                        ((1) (i386:byte-mem->accu))
-                                        ((2) (i386:word-mem->accu))
-                                        ((4) (i386:mem->accu))
-                                        (else '()))))))
-
-        ((fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list))
-         (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
-                                   (append-text info (wrap-as (asm->m1 arg0))))
-             (let* ((text-length (length text))
-                    (args-info (let loop ((expressions (reverse expr-list)) (info info))
-                                 (if (null? expressions) info
-                                     (loop (cdr expressions) ((expr->arg info) (car expressions))))))
-                    (n (length expr-list)))
-               (if (not (assoc-ref locals name))
-                   (begin
-                     (if (and (not (assoc name (.functions info)))
-                              (not (assoc name globals))
-                              (not (equal? name (.function info))))
-                         (stderr "warning: undeclared function: ~a\n" name))
-                     (append-text args-info (list (i386:call-label name n))))
-                   (let* ((empty (clone info #:text '()))
-                          (accu ((expr->accu empty) `(p-expr (ident ,name)))))
-                     (append-text args-info (append (.text accu)
-                                                    (list (i386:call-accu n)))))))))
-
-        ((fctn-call ,function (expr-list . ,expr-list))
-         (let* ((text-length (length text))
-                (args-info (let loop ((expressions (reverse expr-list)) (info info))
-                             (if (null? expressions) info
-                                 (loop (cdr expressions) ((expr->arg info) (car expressions))))))
-                (n (length expr-list))
-                (empty (clone info #:text '()))
-                (accu ((expr->accu empty) function)))
-           (append-text args-info (append (.text accu)
-                                          (list (i386:call-accu n))))))
-
-        ((cond-expr . ,cond-expr)
-         ((ast->info info) `(expr-stmt ,o)))
-
-        ((post-inc ,expr)
-         (let* ((info (append ((expr->accu info) expr)))
-                (info (append-text info (wrap-as (i386:push-accu))))
-                (ptr (expr->pointer info expr))
-                (size (cond ((= ptr 1) (expr->type-size info expr))
-                            ((> ptr 1) 4)
-                            (else 1)))
-                (info ((expr-add info) expr size))
-                (info (append-text info (wrap-as (i386:pop-accu)))))
-           info))
-
-        ((post-dec ,expr)
-         (let* ((info (append ((expr->accu info) expr)))
-                (info (append-text info (wrap-as (i386:push-accu))))
-                (ptr (expr->pointer info expr))
-                (size (cond ((= ptr 1) (expr->type-size info expr))
-                            ((> ptr 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->pointer info expr))
-                (size (cond ((= ptr 1) (expr->type-size info expr))
-                            ((> ptr 1) 4)
-                            (else 1)))
-                (info ((expr-add info) expr size))
-                (info (append ((expr->accu info) expr))))
-           info))
-
-        ((pre-dec ,expr)
-         (let* ((ptr (expr->pointer info expr))
-                (size (cond ((= ptr 1) (expr->type-size info expr))
-                            ((> ptr 1) 4)
-                            (else 1)))
-                (info ((expr-add info) expr (- size)))
-                (info (append ((expr->accu info) expr))))
-           info))
-
-
-
-        ((add ,a (p-expr (fixed ,value)))
-         (let* ((ptr (expr->pointer info a))
-                (type0 (expr->type info a))
-                (struct? (memq (type:type (ast-type->type info type0)) '(struct union)))
-                (size (cond ((= ptr 1) (expr->type-size info a))
-                            ((> ptr 1) 4)
-                            ((and struct? (= ptr -2)) 4)
-                            ((and struct? (= ptr 2)) 4)
-                            (else 1)))
-                (info ((expr->accu info) a))
-                (value (cstring->number value))
-                (value (* size value)))
-           (append-text info (wrap-as (i386:accu+value value)))))
-
-        ((add ,a ,b)
-         (let* ((ptr (expr->pointer info a))
-                (ptr-b (expr->pointer info b))
-                (type0 (expr->type info a))
-                (struct? (memq (type:type (ast-type->type info type0)) '(struct union)))
-                (size (cond ((= ptr 1) (expr->type-size info a))
-                            ((> ptr 1) 4)
-                            ((and struct? (= ptr -2)) 4)
-                            ((and struct? (= ptr 2)) 4)
-                            (else 1))))
-           (if (or (= size 1)) ((binop->accu info) a b (i386:accu+base))
-               (let* ((info ((expr->accu info) b))
-                      (info (append-text info (wrap-as (append (i386:value->base size)
-                                                               (i386:accu*base)
-                                                               (i386:accu->base)))))
-                      (info ((expr->accu info) a)))
-                 (append-text info (wrap-as (i386:accu+base)))))))
-
-        ((sub ,a (p-expr (fixed ,value)))
-         (let* ((ptr (expr->pointer info a))
-                (type0 (expr->type info a))
-                (struct? (memq (type:type (ast-type->type info type0)) '(struct union)))
-                (size (cond ((= ptr 1) (expr->type-size info a))
-                            ((> ptr 1) 4)
-                            ((and struct? (= ptr -2)) 4)
-                            ((and struct? (= ptr 2)) 4)
-                            (else 1)))
-                (info ((expr->accu info) a))
-                (value (cstring->number value))
-                (value (* size value)))
-           (append-text info (wrap-as (i386:accu+value (- value))))))
-
-        ((sub ,a ,b)
-         (let* ((ptr (expr->pointer info a))
-                (ptr-b (expr->pointer info b))
-                (type0 (expr->type info a))
-                (struct? (memq (type:type (ast-type->type info type0)) '(struct union)))
-                (size  (cond ((= ptr 1) (expr->type-size info a))
-                             ((> ptr 1) 4)
-                             ((and struct? (= ptr -2)) 4)
-                             ((and struct? (= ptr 2)) 4)
-                             (else 1))))
-           (if (or (= size 1) (or (= ptr-b -2) (= ptr-b 1)))
-               (let ((info ((binop->accu info) a b (i386:accu-base))))
-                 (if (and (not (= ptr-b -2)) (not (= ptr-b 1))) info
-                     (append-text info (wrap-as (append (i386:value->base size)
-                                                        (i386:accu/base))))))
-               (let* ((info ((expr->accu info) b))
-                      (info (append-text info (wrap-as (append (i386:value->base size)
-                                                               (i386:accu*base)
-                                                               (i386:accu->base)))))
-                      (info ((expr->accu info) a)))
-                 (append-text info (wrap-as (i386:accu-base)))))))
-
-        ((bitwise-and ,a ,b) ((binop->accu info) a b (i386:accu-and-base)))
-        ((bitwise-not ,expr)
-         (let ((info ((ast->info info) expr)))
-           (append-text info (wrap-as (i386:accu-not)))))
-        ((bitwise-or ,a ,b) ((binop->accu info) a b (i386:accu-or-base)))
-        ((bitwise-xor ,a ,b) ((binop->accu info) a b (i386:accu-xor-base)))
-        ((lshift ,a ,b) ((binop->accu info) a b (i386:accu<<base)))
-        ((rshift ,a ,b) ((binop->accu info) a b (i386:accu>>base)))
-        ((div ,a ,b) ((binop->accu info) a b (i386:accu/base)))
-        ((mod ,a ,b) ((binop->accu info) a b (i386:accu%base)))
-        ((mul ,a ,b) ((binop->accu info) a b (i386:accu*base)))
-
-        ((not ,expr)
-         (let* ((test-info ((ast->info info) expr)))
-           (clone info #:text
-                  (append (.text test-info)
-                          (wrap-as (i386:accu-negate)))
-                  #:globals (.globals test-info))))
-
-        ((neg ,expr)
-         (let ((info ((expr->base info) expr)))
-           (append-text info (append (wrap-as (i386:value->accu 0))
-                                     (wrap-as (i386:sub-base))))))
-
-        ((eq ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:z->accu))))
-        ((ge ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:ge?->accu))))
-        ((gt ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:g?->accu) (i386:accu-test))))
-
-        ;; FIXME: set accu *and* flags
-        ((ne ,a ,b) ((binop->accu info) a b (append (i386:push-accu)
-                                                    (i386:sub-base)
-                                                    (i386:nz->accu)
-                                                    (i386:accu<->stack)
-                                                    (i386:sub-base)
-                                                    (i386:xor-zf)
-                                                    (i386:pop-accu))))
-
-        ((ne ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:xor-zf))))
-        ((le ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:le?->accu))))
-        ((lt ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:l?->accu))))
-
-        ((or ,a ,b)
-         (let* ((info ((expr->accu info) a))
-                (here (number->string (length (.text info))))
-                (skip-b-label (string-append "_" (.function info) "_" here "_or_skip_b"))
-                (info (append-text info (wrap-as (i386:accu-test))))
-                (info (append-text info (wrap-as (i386:jump-nz skip-b-label))))
-                (info (append-text info (wrap-as (i386:accu-test))))
-                (info ((expr->accu info) b))
-                (info (append-text info (wrap-as (i386:accu-test))))
-                (info (append-text info (wrap-as `((#:label ,skip-b-label))))))
-           info))
-
-        ((and ,a ,b)
-         (let* ((info ((expr->accu info) a))
-                (here (number->string (length (.text info))))
-                (skip-b-label (string-append "_" (.function info) "_" here "_and_skip_b"))
-                (info (append-text info (wrap-as (i386:accu-test))))
-                (info (append-text info (wrap-as (i386:jump-z skip-b-label))))
-                (info (append-text info (wrap-as (i386:accu-test))))
-                (info ((expr->accu info) b))
-                (info (append-text info (wrap-as (i386:accu-test))))
-                (info (append-text info (wrap-as `((#:label ,skip-b-label))))))
-           info))
-
-        ((cast ,type ,expr)
-         ((expr->accu info) expr))
-
-        ((assn-expr (de-ref (post-inc (p-expr (ident ,name)))) (op ,op) ,b)
-         (let* ((info ((expr->accu info) `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b)))
-                (type (ident->type info name))
-                (ptr (ident->pointer info name))
-                (size (if (> ptr 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 info) `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b)))
-                (type (ident->type info name))
-                (ptr (ident->pointer info name))
-                (size (if (> ptr 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->pointer info a))
-                (ptr-b (expr->pointer info b))
-                (size-a (expr->size info a))
-                (size-b (expr->size info b))
-                (info ((expr->accu info) b))
-                (info (if (equal? op "=") info
-                          (let* ((ptr (expr->pointer info a))
-                                 (ptr-b (expr->pointer info b))
-                                 (type0 (expr->type info a))
-                                 (struct? (memq (type:type (ast-type->type info type0)) '(struct union)))
-                                 (size (cond ((= ptr 1) (expr->type-size info a))
-                                             ((> ptr 1) 4)
-                                             ((and struct? (= ptr -2)) 4)
-                                             ((and struct? (= ptr 2)) 4)
-                                             (else 1)))
-                                 (info (if (or (= size 1) (= ptr-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))))
-                                 (info ((expr->accu info) a))
-                                 (info (append-text info (wrap-as (i386:pop-base))))
-                                 (info (append-text info (cond ((equal? op "+=") (wrap-as (i386:accu+base)))
-                                                               ((equal? op "-=") (wrap-as (i386:accu-base)))
-                                                               ((equal? op "*=") (wrap-as (i386:accu*base)))
-                                                               ((equal? op "/=") (wrap-as (i386:accu/base)))
-                                                               ((equal? op "%=") (wrap-as (i386:accu%base)))
-                                                               ((equal? op "&=") (wrap-as (i386:accu-and-base)))
-                                                               ((equal? op "|=") (wrap-as (i386:accu-or-base)))
-                                                               ((equal? op "^=") (wrap-as (i386:accu-xor-base)))
-                                                               ((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)
-                                  ((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 type0 (expr->type info b)))))))))
-           (when (and (equal? op "=")
-                      (not (= size-a size-b))
-                      (not (and (or (= size-a 1) (= size-a 2))
-                                (= size-b 4)))
-                      (not (and (= size-a 2)
-                                (= size-b 4)))
-                      (not (and (= size-a 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))
-           (pmatch a
-             ((p-expr (ident ,name))
-              (if (or (<= size-a 4) ;; FIXME: long long = int
-                      (<= size-b 4)) (append-text info ((accu->ident info) name))
-                      (let ((info ((expr->base* info) a)))
-                        (accu->base-mem*n info size-a))))
-             (_ (let ((info ((expr->base* info) a)))
-                  (accu->base-mem*n info (min size-a (max 4 size-b)))))))) ;; FIXME: long long = int
-
-        (_ (error "expr->accu: not supported: " o))))))
-
-(define (expr->base info)
-  (lambda (o)
-    (let* ((info (append-text info (wrap-as (i386:push-accu))))
-           (info ((expr->accu info) o))
-           (info (append-text info (wrap-as (append (i386:accu->base) (i386:pop-accu))))))
-      info)))
+      ((post-dec ,expr)
+       (let* ((info (append (expr->accu expr info)))
+              (info (append-text info (wrap-as (i386:push-accu))))
+              (ptr (expr->pointer info expr))
+              (size (cond ((= ptr 1) (ast-type->size info expr))
+                          ((> ptr 1) 4)
+                          (else 1)))
+              (info ((expr-add info) expr (- size)))
+              (info (append-text info (wrap-as (i386:pop-accu)))))
+         info))
 
-(define (expr->base* info)
-  (lambda (o)
-    (let* ((info (append-text info (wrap-as (i386:push-accu))))
-           (info ((expr->accu* info) o))
-           (info (append-text info (wrap-as (i386:accu->base))))
-           (info (append-text info (wrap-as (i386:pop-accu)))))
-      info)))
+      ((pre-inc ,expr)
+       (let* ((ptr (expr->pointer info expr))
+              (size (cond ((= ptr 1) (ast-type->size info expr))
+                          ((> ptr 1) 4)
+                          (else 1)))
+              (info ((expr-add info) expr size))
+              (info (append (expr->accu expr info))))
+         info))
+
+      ((pre-dec ,expr)
+       (let* ((ptr (expr->pointer info expr))
+              (size (cond ((= ptr 1) (ast-type->size info expr))
+                          ((> ptr 1) 4)
+                          (else 1)))
+              (info ((expr-add info) expr (- size)))
+              (info (append (expr->accu expr info))))
+         info))
+
+
+
+      ((add ,a (p-expr (fixed ,value)))
+       (let* ((ptr (expr->pointer info a))
+              (type (ast->type info a))
+              (struct? (or (and (pair? type) (equal? (car type) "tag"))
+                           (memq (type:type type) '(struct union))))
+              (size (cond ((= ptr 1) (ast-type->size info a))
+                          ((> ptr 1) 4)
+                          ((and struct? (= ptr -2)) 4)
+                          ((and struct? (= ptr 2)) 4)
+                          (else 1)))
+              (info (expr->accu a info))
+              (value (cstring->number value))
+              (value (* size value)))
+         (append-text info (wrap-as (i386:accu+value value)))))
+
+      ((add ,a ,b)
+       (let* ((ptr (expr->pointer info a))
+              (ptr-b (expr->pointer info b))
+              (type (ast->type info a))
+              (struct? (or (and (pair? type) (equal? (car type) "tag"))
+                           (memq (type:type type) '(struct union))))
+              (size (cond ((= ptr 1) (ast-type->size info a))
+                          ((> ptr 1) 4)
+                          ((and struct? (= ptr -2)) 4)
+                          ((and struct? (= ptr 2)) 4)
+                          (else 1))))
+         (if (or (= size 1)) ((binop->accu info) a b (i386:accu+base))
+             (let* ((info (expr->accu b info))
+                    (info (append-text info (wrap-as (append (i386:value->base size)
+                                                             (i386:accu*base)
+                                                             (i386:accu->base)))))
+                    (info (expr->accu a info)))
+               (append-text info (wrap-as (i386:accu+base)))))))
+
+      ((sub ,a (p-expr (fixed ,value)))
+       (let* ((ptr (expr->pointer info a))
+              (type (ast->type info a))
+              (struct? (or (and (pair? type) (equal? (car type) "tag"))
+                           (memq (type:type type) '(struct union))))
+              (size (cond ((= ptr 1) (ast-type->size info a))
+                          ((> ptr 1) 4)
+                          ((and struct? (= ptr -2)) 4)
+                          ((and struct? (= ptr 2)) 4)
+                          (else 1)))
+              (info (expr->accu a info))
+              (value (cstring->number value))
+              (value (* size value)))
+         (append-text info (wrap-as (i386:accu+value (- value))))))
+
+      ((sub ,a ,b)
+       (let* ((ptr (expr->pointer info a))
+              (ptr-b (expr->pointer info b))
+              (type (ast->type info a))
+              (struct? (or (and (pair? type) (equal? (car type) "tag"))
+                           (memq (type:type type) '(struct union))))
+              (size  (cond ((= ptr 1) (ast-type->size info a))
+                           ((> ptr 1) 4)
+                           ((and struct? (= ptr -2)) 4)
+                           ((and struct? (= ptr 2)) 4)
+                           (else 1))))
+         (if (or (= size 1) (or (= ptr-b -2) (= ptr-b 1)))
+             (let ((info ((binop->accu info) a b (i386:accu-base))))
+               (if (and (not (= ptr-b -2)) (not (= ptr-b 1))) info
+                   (append-text info (wrap-as (append (i386:value->base size)
+                                                      (i386:accu/base))))))
+             (let* ((info (expr->accu b info))
+                    (info (append-text info (wrap-as (append (i386:value->base size)
+                                                             (i386:accu*base)
+                                                             (i386:accu->base)))))
+                    (info (expr->accu a info)))
+               (append-text info (wrap-as (i386:accu-base)))))))
+
+      ((bitwise-and ,a ,b) ((binop->accu info) a b (i386:accu-and-base)))
+      ((bitwise-not ,expr)
+       (let ((info (ast->info expr info)))
+         (append-text info (wrap-as (i386:accu-not)))))
+      ((bitwise-or ,a ,b) ((binop->accu info) a b (i386:accu-or-base)))
+      ((bitwise-xor ,a ,b) ((binop->accu info) a b (i386:accu-xor-base)))
+      ((lshift ,a ,b) ((binop->accu info) a b (i386:accu<<base)))
+      ((rshift ,a ,b) ((binop->accu info) a b (i386:accu>>base)))
+      ((div ,a ,b) ((binop->accu info) a b (i386:accu/base)))
+      ((mod ,a ,b) ((binop->accu info) a b (i386:accu%base)))
+      ((mul ,a ,b) ((binop->accu info) a b (i386:accu*base)))
+
+      ((not ,expr)
+       (let* ((test-info (ast->info expr info)))
+         (clone info #:text
+                (append (.text test-info)
+                        (wrap-as (i386:accu-negate)))
+                #:globals (.globals test-info))))
+
+      ((neg ,expr)
+       (let ((info (expr->base expr info)))
+         (append-text info (append (wrap-as (i386:value->accu 0))
+                                   (wrap-as (i386:sub-base))))))
+
+      ((eq ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:z->accu))))
+      ((ge ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:ge?->accu))))
+      ((gt ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:g?->accu) (i386:accu-test))))
+
+      ;; FIXME: set accu *and* flags
+      ((ne ,a ,b) ((binop->accu info) a b (append (i386:push-accu)
+                                                  (i386:sub-base)
+                                                  (i386:nz->accu)
+                                                  (i386:accu<->stack)
+                                                  (i386:sub-base)
+                                                  (i386:xor-zf)
+                                                  (i386:pop-accu))))
+
+      ((ne ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:xor-zf))))
+      ((le ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:le?->accu))))
+      ((lt ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:l?->accu))))
+
+      ((or ,a ,b)
+       (let* ((info (expr->accu a info))
+              (here (number->string (length (.text info))))
+              (skip-b-label (string-append "_" (.function info) "_" here "_or_skip_b"))
+              (info (append-text info (wrap-as (i386:accu-test))))
+              (info (append-text info (wrap-as (i386:jump-nz skip-b-label))))
+              (info (append-text info (wrap-as (i386:accu-test))))
+              (info (expr->accu b info))
+              (info (append-text info (wrap-as (i386:accu-test))))
+              (info (append-text info (wrap-as `((#:label ,skip-b-label))))))
+         info))
+
+      ((and ,a ,b)
+       (let* ((info (expr->accu a info))
+              (here (number->string (length (.text info))))
+              (skip-b-label (string-append "_" (.function info) "_" here "_and_skip_b"))
+              (info (append-text info (wrap-as (i386:accu-test))))
+              (info (append-text info (wrap-as (i386:jump-z skip-b-label))))
+              (info (append-text info (wrap-as (i386:accu-test))))
+              (info (expr->accu b info))
+              (info (append-text info (wrap-as (i386:accu-test))))
+              (info (append-text info (wrap-as `((#:label ,skip-b-label))))))
+         info))
+
+      ((cast ,type ,expr)
+       (expr->accu expr info))
+
+      ((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->pointer info name))
+              (size (if (> ptr 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->pointer info name))
+              (size (if (> ptr 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->pointer info a))
+              (ptr-b (expr->pointer info b))
+              (size-a (expr->size info a))
+              (size-b (expr->size info b))
+              (info (expr->accu b info))
+              (info (if (equal? op "=") info
+                        (let* ((ptr (expr->pointer info a))
+                               (ptr-b (expr->pointer info b))
+                               (type (ast->type info a))
+                               (struct? (or (and (pair? type) (equal? (car type) "tag"))
+                                            (memq (type:type type) '(struct union))))
+                               (size (cond ((= ptr 1) (ast-type->size info a))
+                                           ((> ptr 1) 4)
+                                           ((and struct? (= ptr -2)) 4)
+                                           ((and struct? (= ptr 2)) 4)
+                                           (else 1)))
+                               (info (if (or (= size 1) (= ptr-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))))
+                               (info (expr->accu a info))
+                               (info (append-text info (wrap-as (i386:pop-base))))
+                               (info (append-text info (cond ((equal? op "+=") (wrap-as (i386:accu+base)))
+                                                             ((equal? op "-=") (wrap-as (i386:accu-base)))
+                                                             ((equal? op "*=") (wrap-as (i386:accu*base)))
+                                                             ((equal? op "/=") (wrap-as (i386:accu/base)))
+                                                             ((equal? op "%=") (wrap-as (i386:accu%base)))
+                                                             ((equal? op "&=") (wrap-as (i386:accu-and-base)))
+                                                             ((equal? op "|=") (wrap-as (i386:accu-or-base)))
+                                                             ((equal? op "^=") (wrap-as (i386:accu-xor-base)))
+                                                             ((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)
+                                ((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)))))))))
+         (when (and (equal? op "=")
+                    (not (= size-a size-b))
+                    (not (and (or (= size-a 1) (= size-a 2))
+                              (= size-b 4)))
+                    (not (and (= size-a 2)
+                              (= size-b 4)))
+                    (not (and (= size-a 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))
+         (pmatch a
+           ((p-expr (ident ,name))
+            (if (or (<= size-a 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))))
+           (_ (let ((info (expr->base* a info)))
+                (accu->base-mem*n info (min size-a (max 4 size-b)))))))) ;; FIXME: long long = int
+
+      (_ (error "expr->accu: not supported: " o)))))
+
+(define (expr->base o info)
+  (let* ((info (append-text info (wrap-as (i386:push-accu))))
+         (info (expr->accu o info))
+         (info (append-text info (wrap-as (append (i386:accu->base) (i386:pop-accu))))))
+    info))
+
+(define (expr->base* o info)
+  (let* ((info (append-text info (wrap-as (i386:push-accu))))
+         (info (expr->accu* o info))
+         (info (append-text info (wrap-as (i386:accu->base))))
+         (info (append-text info (wrap-as (i386:pop-accu)))))
+    info))
 
 (define (comment? o)
   (and (pair? o) (pair? (car o)) (eq? (caar o) #:comment)))
         ((compd-stmt (block-item-list . ,elements))
          (let ((clause (or clause (cases+jump info cases))))
            (loop `(compd-stmt (block-item-list ,@(cdr elements))) cases
-                 ((ast->info clause) (car elements)))))
+                 (ast->info (car elements) clause))))
         (()
          (let ((clause (or clause (cases+jump info cases))))
            (if last? clause
         (_
          (let ((clause (or clause (cases+jump info cases))))
            (loop '() cases
-                 ((ast->info clause) o))))))))
+                 (ast->info o clause))))))))
 
 (define (test-jump-label->info info label)
   (define (jump type . test)
     (lambda (o)
-      (let* ((info ((ast->info info) o))
+      (let* ((info (ast->info o info))
              (info (append-text info (make-comment "jmp test LABEL")))
              (jump-text (wrap-as (type label))))
         (append-text info (append (if (null? test) '() (car test))
 
 (define (expr->number info o)
   (pmatch o
-    ((p-expr (fixed ,a))
-     (cstring->number a))
+    ((fixed ,a) (cstring->number a))
+    ((p-expr ,expr) (expr->number info expr))
     ((neg ,a)
      (- (expr->number info a)))
     ((add ,a ,b)
     ((cast ,type ,expr) (expr->number info expr))
     ((cond-expr ,test ,then ,else)
      (if (p-expr->bool info test) (expr->number info then) (expr->number info else)))
+    (,string (guard (string? string)) (cstring->number string))
     (_  (error (format #f "expr->number: not supported: ~s\n" o)))))
 
 (define (p-expr->bool info o)
   (pmatch o
     ((eq ,a ,b) (eq? (expr->number info a) (expr->number info b)))))
 
+
 (define (struct-field info)
   (lambda (o)
     (pmatch o
          (list (list name type (* count size) -2))))
 
       ((comp-decl (decl-spec-list (type-spec ,type)) (comp-declr-list (comp-declr (array-of (ident ,name) ,count))))
-       (let ((size (ast-type->size info type))
-             (count (expr->number info count)))
-         (list (list name type (* count size) -1))))
+       (let* ((type (if (type? type) type
+                        (ast->type info type)))
+              (size (ast-type->size info type))
+              (count (expr->number info count)))
+         (list (list name type (* count size) -1))))      
 
       ((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
        (list (list name `("tag" ,type) 4 2)))
     ((pointer (pointer (pointer))) 3)
     (_ (error "ptr-declr->pointer not supported: " o))))
 
-(define (init-declr->name o)
-  (pmatch o
-    ((ident ,name) name)
-    ((ptr-declr ,pointer (ident ,name)) name)
-    ((array-of (ident ,name)) name)
-    ((array-of (ident ,name) ,index) name)
-    ((ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,params)) name)
-    ((ptr-declr (pointer) (array-of (ident ,name))) name)
-    ((ptr-declr (pointer) (array-of (ident ,name) (p-expr ,size))) name)
-    (_ (error "init-declr->name not supported: " o))))
-
-(define (init-declr->count info o)
-  (pmatch o
-    ((array-of (ident ,name) ,count) (expr->number info count))
-    (_ #f)))
-
-(define (init-declr->pointer o)
-  (pmatch o
-    ((ident ,name) 0)
-    ((ptr-declr ,pointer (ident ,name)) (ptr-declr->pointer pointer))
-    ((array-of (ident ,name) ,index) -2)
-    ((array-of (ident ,name)) -2)
-    ((ftn-declr (scope (ptr-declr ,pointer (ident ,name))) (param-list . ,params)) (ptr-declr->pointer pointer))
-    ((ptr-declr (pointer) (array-of (ident ,name))) -2)
-    ((ptr-declr (pointer) (array-of (ident ,name) (p-expr ,size))) -2)
-    (_ (error "init-declr->pointer not supported: " o))))
-
 (define (statements->clauses statements)
   (let loop ((statements statements) (clauses '()))
     (if (null? statements) clauses
                        (_ (loop2 (cdr statements) (append c (list s)))))))))
             (_ (error "statements->clauses: not supported:" s)))))))
 
+(define (ast->info o info)
+  (let ((functions (.functions info))
+        (globals (.globals info))
+        (locals (.locals info))
+        (constants (.constants info))
+        (types (.types info))
+        (text (.text info)))
+    (pmatch o
+      (((trans-unit . _) . _) (ast-list->info o info))
+      ((trans-unit . ,_) (ast-list->info _ info))
+      ((fctn-defn . ,_) (fctn-defn->info _ info))
+
+      ((cpp-stmt (define (name ,name) (repl ,value)))
+       info)
+
+      ((cast (type-name (decl-spec-list (type-spec (void)))) _)
+       info)
+
+      ((break)
+       (let ((label (car (.break info))))
+         (append-text info (wrap-as (i386:jump label)))))
+
+      ((continue)
+       (let ((label (car (.continue info))))
+         (append-text info (wrap-as (i386:jump label)))))
+
+      ;; FIXME: expr-stmt wrapper?
+      (trans-unit info)
+      ((expr-stmt) info)
+
+      ((compd-stmt (block-item-list . ,_)) (ast-list->info _ info))
+
+      ((asm-expr ,gnuc (,null ,arg0 . string))
+       (append-text info (wrap-as (asm->m1 arg0))))
+
+      ((expr-stmt (fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)))
+       (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list))))
+                                 (append-text info (wrap-as (asm->m1 arg0))))
+           (let* ((info (append-text info (ast->comment o)))
+                  (info (expr->accu `(fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)) info)))
+             (append-text info (wrap-as (i386:accu-zero?))))))
+
+      ((if ,test ,then)
+       (let* ((info (append-text info (ast->comment `(if ,test (ellipsis)))))
+              (here (number->string (length text)))
+              (label (string-append "_" (.function info) "_" here "_"))
+              (break-label (string-append label "break"))
+              (else-label (string-append label "else"))
+              (info ((test-jump-label->info info break-label) test))
+              (info (ast->info then info))
+              (info (append-text info (wrap-as (i386:jump break-label))))
+              (info (append-text info (wrap-as `((#:label ,break-label))))))
+         (clone info
+                #:locals locals)))
+
+      ((if ,test ,then ,else)
+       (let* ((info (append-text info (ast->comment `(if ,test (ellipsis) (ellipsis)))))
+              (here (number->string (length text)))
+              (label (string-append "_" (.function info) "_" here "_"))
+              (break-label (string-append label "break"))
+              (else-label (string-append label "else"))
+              (info ((test-jump-label->info info else-label) test))
+              (info (ast->info then info))
+              (info (append-text info (wrap-as (i386:jump break-label))))
+              (info (append-text info (wrap-as `((#:label ,else-label)))))
+              (info (ast->info else info))
+              (info (append-text info (wrap-as `((#:label ,break-label))))))
+         (clone info
+                #:locals locals)))
+
+      ;; Hmm?
+      ((expr-stmt (cond-expr ,test ,then ,else))
+       (let* ((info (append-text info (ast->comment `(cond-expr ,test (ellipsis) (ellipsis)))))
+              (here (number->string (length text)))
+              (label (string-append "_" (.function info) "_" here "_"))
+              (else-label (string-append label "else"))
+              (break-label (string-append label "break"))
+              (info ((test-jump-label->info info else-label) test))
+              (info (ast->info then info))
+              (info (append-text info (wrap-as (i386:jump break-label))))
+              (info (append-text info (wrap-as `((#:label ,else-label)))))
+              (info (ast->info else info))
+              (info (append-text info (wrap-as `((#:label ,break-label))))))
+         info))
+
+      ((switch ,expr (compd-stmt (block-item-list . ,statements)))
+       (let* ((info (append-text info (ast->comment `(switch ,expr (compd-stmt (block-item-list (ellipsis)))))))
+              (here (number->string (length text)))
+              (label (string-append "_" (.function info) "_" here "_"))
+              (break-label (string-append label "break"))
+              (clauses (statements->clauses statements))
+              (info (expr->accu expr info))
+              (info (clone info #:break (cons break-label (.break info))))
+              (info (let loop ((clauses clauses) (i 0) (info info))
+                      (if (null? clauses) info
+                          (loop (cdr clauses) (1+ i) ((clause->info info i label (null? (cdr clauses))) (car clauses))))))
+              (info (append-text info (wrap-as `((#:label ,break-label))))))
+         (clone info
+                #:locals locals
+                #:break (cdr (.break info)))))
+
+      ((for ,init ,test ,step ,body)
+       (let* ((info (append-text info (ast->comment `(for ,init ,test ,step (ellipsis)))))
+              (here (number->string (length text)))
+              (label (string-append "_" (.function info) "_" here "_"))
+              (break-label (string-append label "break"))
+              (loop-label (string-append label "loop"))
+              (continue-label (string-append label "continue"))
+              (initial-skip-label (string-append label "initial_skip"))
+              (info (ast->info init info))
+              (info (clone info #:break (cons break-label (.break info))))
+              (info (clone info #:continue (cons continue-label (.continue info))))
+              (info (append-text info (wrap-as (i386:jump initial-skip-label))))
+              (info (append-text info (wrap-as `((#:label ,loop-label)))))
+              (info (ast->info body info))
+              (info (append-text info (wrap-as `((#:label ,continue-label)))))
+              (info (expr->accu step info))
+              (info (append-text info (wrap-as `((#:label ,initial-skip-label)))))
+              (info ((test-jump-label->info info break-label) test))
+              (info (append-text info (wrap-as (i386:jump loop-label))))
+              (info (append-text info (wrap-as `((#:label ,break-label))))))
+         (clone info
+                #:locals locals
+                #:break (cdr (.break info))
+                #:continue (cdr (.continue info)))))
+
+      ((while ,test ,body)
+       (let* ((info (append-text info (ast->comment `(while ,test (ellipsis)))))
+              (here (number->string (length text)))
+              (label (string-append "_" (.function info) "_" here "_"))
+              (break-label (string-append label "break"))
+              (loop-label (string-append label "loop"))
+              (continue-label (string-append label "continue"))
+              (info (append-text info (wrap-as (i386:jump continue-label))))
+              (info (clone info #:break (cons break-label (.break info))))
+              (info (clone info #:continue (cons continue-label (.continue info))))
+              (info (append-text info (wrap-as `((#:label ,loop-label)))))
+              (info (ast->info body info))
+              (info (append-text info (wrap-as `((#:label ,continue-label)))))
+              (info ((test-jump-label->info info break-label) test))
+              (info (append-text info (wrap-as (i386:jump loop-label))))
+              (info (append-text info (wrap-as `((#:label ,break-label))))))
+         (clone info
+                #:locals locals
+                #:break (cdr (.break info))
+                #:continue (cdr (.continue info)))))
+
+      ((do-while ,body ,test)
+       (let* ((info (append-text info (ast->comment `(do-while ,test (ellipsis)))))
+              (here (number->string (length text)))
+              (label (string-append "_" (.function info) "_" here "_"))
+              (break-label (string-append label "break"))
+              (loop-label (string-append label "loop"))
+              (continue-label (string-append label "continue"))
+              (info (clone info #:break (cons break-label (.break info))))
+              (info (clone info #:continue (cons continue-label (.continue info))))
+              (info (append-text info (wrap-as `((#:label ,loop-label)))))
+              (info (ast->info body info))
+              (info (append-text info (wrap-as `((#:label ,continue-label)))))
+              (info ((test-jump-label->info info break-label) test))
+              (info (append-text info (wrap-as (i386:jump loop-label))))
+              (info (append-text info (wrap-as `((#:label ,break-label))))))
+         (clone info
+                #:locals locals
+                #:break (cdr (.break info))
+                #:continue (cdr (.continue info)))))
+
+      ((labeled-stmt (ident ,label) ,statement)
+       (let ((info (append-text info `(((#:label ,(string-append "_" (.function info) "_label_" label)))))))
+         (ast->info statement info)))
+
+      ((goto (ident ,label))
+       (append-text info (wrap-as (i386:jump (string-append "_" (.function info) "_label_" label)))))
+
+      ((return ,expr)
+       (let ((info (expr->accu expr info)))
+         (append-text info (append (wrap-as (i386:ret))))))
+
+      ((decl . ,decl)
+       ;;FIXME: ridiculous performance hit with mes
+       (let ((info (append-text info (ast->comment o))))
+         (decl->info info decl)))
+      ;; ...
+      ((gt . _) (expr->accu o info))
+      ((ge . _) (expr->accu o info))
+      ((ne . _) (expr->accu o info))
+      ((eq . _) (expr->accu o info))
+      ((le . _) (expr->accu o info))
+      ((lt . _) (expr->accu o info))
+      ((lshift . _) (expr->accu o info))
+      ((rshift . _) (expr->accu o info))
+
+      ;; EXPR
+      ((expr-stmt ,expression)
+       (let ((info (expr->accu expression info)))
+         (append-text info (wrap-as (i386:accu-zero?)))))
+
+      ;; FIXME: why do we get (post-inc ...) here
+      ;; (array-ref
+      (_ (let ((info (expr->accu o info)))
+           (append-text info (wrap-as (i386:accu-zero?))))))))
+
+(define (ast-list->info o info)
+  (fold ast->info info o))
+
 (define (global->static function)
   (lambda (o)
     (cons (car o) (set-field (cdr o) (global:function) function))))
       (((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))))
+              (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))))
   (lambda (o)
     #f))
 
-(define (decl->info info)
-  (lambda (o)
-    (let ((functions (.functions info))
-          (globals (.globals info))
-          (locals (.locals info))
-          (constants (.constants info))
-          (types (.types info))
-          (text (.text info)))
-      (define (add-local locals name type pointer)
-        (let* ((id (if (or (null? locals) (not (local-var? (cdar locals)))) 1
-                       (1+ (local:id (cdar locals)))))
-               (locals (cons (make-local-entry name type pointer id) locals)))
-          locals))
-      (define (declare name)
-        (if (member name functions) info
-            (let* ((type (function->type info o))
-                   (function (make-function name type  #f)))
-              (clone info #:functions (cons (cons name function) functions)))))
+(define (decl->info info o)
+  (pmatch o
+    (((decl-spec-list (type-spec ,type)) (init-declr-list . ,inits))
+     (let* ((info (type->info info type))
+            (type (ast->type info type))
+            (pointer 0))                ; FIXME
+       (fold (cut init-declr->info type pointer <> <>) info (map cdr inits))))
+    (((decl-spec-list (type-spec ,type)))
+     (type->info info type))
+    (((decl-spec-list (stor-spec (typedef)) (type-spec ,type)) (init-declr-list (init-declr (ident ,name))))
+     (let* ((info (type->info info type))
+            (type (ast->type info type)))
+       (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)))))
+    (((@ . _))
+     (stderr "decl->info: skip: ~s\n" o)
+     info)
+    (_ (error "decl->info: not supported:" o))))
+
+(define (ast->name o)
+  (pmatch o
+    ((ident ,name) name)
+    ((ptr-declr ,pointer (ident ,name)) name)
+    ((array-of ,array . ,_) (ast->name array))
+    ((ftn-declr (scope (ptr-declr ,pointer (ident ,name)))) name)
+    ((ptr-declr ,pointer ,decl . ,_) (ast->name decl))
+    (_ (error "ast->name not supported: " o))))
 
-      (pmatch o
+(define (init-declr->count info o)
+  (pmatch o
+    ((array-of (ident ,name) ,count) (expr->number info count))
+    (_ #f)))
 
-        ;; FIXME: Nyacc sometimes produces extra parens: (ident (<struct-name>))
-        ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))))
-         (declare name))
+(define (init->accu o info)
+  (pmatch o
+    ((initzer-list (initzer ,expr)) (expr->accu expr info))
+    (((#:string ,string))
+     (append-text info (list (i386:label->accu `(#:string ,string)))))
+    ((,number . _) (guard (number? number))
+     (append-text info (wrap-as (i386:value->accu 0))))
+    ((,c . ,_) (guard (char? c)) info)
+    (_ (expr->accu o info))))
+
+(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
+           (append
+            (.text info)
+            (local->accu local)
+            (wrap-as (append (i386:accu->base)))
+            (wrap-as (append (i386:push-base)))
+            (.text (expr->accu init empty))
+            (wrap-as (append (i386:pop-base)))
+            (wrap-as (case size
+                       ((1) (i386:byte-accu->base-mem+n offset))
+                       ((2) (i386:word-accu->base-mem+n offset))
+                       (else (i386:accu->base-mem+n offset))))))))
+
+(define (init-array-entry local index init info)
+  (let* ((size (or (and (zero? (local:pointer local)) ((compose type:size local:type) local))
+                   4))
+         (offset (* index size))
+         (empty (clone info #:text '())))
+    (clone info #:text
+           (append
+            (.text info)
+            (local->accu local)
+            (wrap-as (append (i386:accu->base)))
+            (wrap-as (append (i386:push-base)))
+            (.text (expr->accu init empty))
+            (wrap-as (append (i386:pop-base)))
+            (wrap-as (case size
+                       ((1) (i386:byte-accu->base-mem+n offset))
+                       ((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)
+    ((initzer ,init)
+     (init-local local init n info))
+    ((initzer-list ,init)
+     (init-local local init n info))
+    ((initzer-list . ,inits)
+     (let* ((type ((compose type:type local:type) local))
+            (struct? (or (and (pair? type) (equal? (car type) "tag"))
+                         (memq type '(struct union)))))
+       (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)))))))))
+             (else (fold (cut init-local local <> <> <>) info inits (iota (length inits)))))))
+    (((initzer (initzer-list . ,inits)))
+     (fold (cut init-array-entry local <> <> <>) info (iota (length inits)) inits))
+    (() info)
+    (_ (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)
+  (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))
+                       (or (and (pair? type)
+                                (equal? (car type) "tag"))
+                           (and (type? type)
+                                (memq (type:type type) '(struct union))))))
+         (size (or (and (zero? pointer) (type? type) (type:size type))
+                   (and struct? (and=> (ast->type info type) struct:size))
+                   4))
+         (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)))
+                    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))))
+         (data (cond ((not init) (string->list (make-string size #\nul)))
+                     (array (array-init->data (and array (* array (type:size type))) 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)))
+    (clone info #:globals (append (.globals info) (list global)))))
+
+(define (array-init-element->data size o info)
+  (pmatch o
+    ((initzer (p-expr (string ,string)))
+     `((#:string ,string)))
+    ((initzer (p-expr (fixed ,fixed)))
+     (int->bv32 (expr->number info fixed)))
+    (_ (init->data o info))
+    ;;(_ (error "array-init-element->data: not supported: " o))
+    ))
 
-        ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name))))
-         (clone info #:types (cons (cons name (get-type info type)) types)))
+(define (array-init->data size o info)
+  (pmatch o
+    (((initzer (initzer-list . ,inits)))
+     (map (cut array-init-element->data size <> info) inits))
 
-        ;; int foo ();
-        ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))))
-         (declare name))
+    ((initzer (p-expr (string ,string)))
+     (let ((data (string->list string)))
+       (if (not size) data
+           (append data (string->list (make-string (max 0 (- size (length data))) #\nul))))))
 
-        ;; void foo ();
-        ((decl (decl-spec-list (type-spec (void))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))))
-         (declare name))
-
-        ;; void foo (*);
-        ((decl (decl-spec-list (type-spec (void))) (init-declr-list (init-declr (ptr-declr (pointer) (ftn-declr (ident ,name) (param-list . ,param-list))))))
-         (declare name))
-
-        ;; char *strcpy ();
-        ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ftn-declr (ident ,name) (param-list . ,param-list))))))
-         (declare name))
-
-        ;; printf (char const* format, ...)
-        ((decl (decl-spec-list ,type) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list ,param-list . (ellipsis))))))
-         (declare name))
-
-        ;; <name> tcc_new
-        ((decl (decl-spec-list ,type) (init-declr-list (init-declr (ptr-declr (pointer) (ftn-declr (ident ,name) (param-list . ,param-list))))))
-         (declare name))
-
-        ;; extern type foo ()
-        ((decl (decl-spec-list (stor-spec (extern)) ,type) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))))
-         (declare name))
-
-        ;; static
-        ((decl (decl-spec-list (stor-spec (static)) (type-spec ,type)) (init-declr-list ,init-declr-list))
-         (guard (not (.function info)))
-         ((decl->info info) `(decl (decl-spec-list (type-spec ,type)) (init-declr-list ,init-declr-list))))
-
-        ;; struct TCCState;
-        ((decl (decl-spec-list (type-spec (struct-ref (ident ,name)))))
-         info)
-
-        ;; extern type global;
-        ((decl (decl-spec-list (stor-spec (extern)) ,type) (init-declr-list (init-declr (ident ,name))))
-         info)
-
-        ((decl (decl-spec-list (stor-spec (static)) ,type) (init-declr-list (init-declr (ident ,name))))
-         ((decl->info info) `(decl (decl-spec-list ,type) (init-declr-list (init-declr (ident ,name)))))
-         info)
-
-        ;; extern foo *bar;
-        ((decl (decl-spec-list (stor-spec (extern)) ,type) (init-declr-list (init-declr (ptr-declr ,pointer (ident ,name)))))
-         info)
-
-        ((decl (decl-spec-list (stor-spec (static)) ,type) (init-declr-list (init-declr (ptr-declr ,pointer (ident ,name)))))
-         ((decl->info info) `(decl (decl-spec-list ,type) (init-declr-list (init-declr (ptr-declr ,pointer (ident ,name)))))))
-
-        ;; ST_DATA int ch, tok; -- TCC, why oh why so difficult?
-        ((decl (decl-spec-list (stor-spec (extern)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name)) . ,rest))
-         info)
-
-        ;; ST_DATA Section *text_section, *data_section, *bss_section; /* predefined sections */
-        ((decl (decl-spec-list (stor-spec (extern)) (type-spec (typename ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name))) . ,rest))
-         info)
-
-        ;; ST_DATA CType char_pointer_type, func_old_type, int_type, size_type;
-        ((decl (decl-spec-list (stor-spec (extern)) (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name)) . ,rest))
-         info)
-
-        ;; ST_DATA SValue __vstack[1+/*to make bcheck happy*/ VSTACK_SIZE], *vtop;
-        ;; Yay, let's hear it for the T-for Tiny in TCC!?
-        ((decl (decl-spec-list (stor-spec (extern)) (type-spec (typename ,type))) (init-declr-list (init-declr (array-of (ident ,name) (add (p-expr (fixed ,a)) (p-expr (fixed ,b))))) (init-declr (ptr-declr (pointer) (ident ,name2)))))
-         info)
-
-        ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name))))
-         (clone info #:types (cons (cons name (or (get-type info type) `(typedef ("tag" ,type)))) types)))
-
-        ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name))))
-         (clone info #:types (cons (cons name (or (get-type info type) `(typedef ("tag" ,type)))) types)))
-
-        ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name))))
-         (clone info #:types (cons (cons name (or (get-type info type) `(typedef ,type))) types)))
-
-        ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (typename ,type))) (init-declr-list (init-declr (array-of (ident ,name) ,value))))
-         (let* ((type (get-type info type))
-                (value (expr->number info value))
-                (size (* value 4))
-                (pointer -1)
-                (type (make-type 'array size pointer type)))
-           (clone info #:types (cons (cons name type) types))))
-
-        ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ptr-declr ,pointer (ident ,name)))))
-         (let* ((pointer (expr->pointer info pointer))
-                (type (or (get-type info type) `(typedef ,type)))
-                (size 4)
-                (type (make-type 'typedef size pointer type)))
-           (clone info #:types (cons (cons name type) types))))
-
-        ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-def ,field-list))) (init-declr-list (init-declr (ident ,name))))
-         ((decl->info info) `(decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-def (ident ,name) ,field-list))) (init-declr-list (init-declr (ident ,name))))))
-
-        ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (union-def ,field-list))) (init-declr-list (init-declr (ident ,name))))
-         ((decl->info info) `(decl (decl-spec-list (stor-spec (typedef)) (type-spec (union-def (ident ,name) ,field-list))) (init-declr-list (init-declr (ident ,name))))))
-
-        ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-def (ident ,type) ,field-list))) (init-declr-list (init-declr (ident ,name))))
-         (let* ((info ((decl->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,type) ,field-list))))))
-                (types (.types info)))
-           (clone info #:types (cons (cons name (or (get-type info `("tag" ,type)) `(typedef ,type))) types))))
-
-        ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (union-def (ident ,type) ,field-list))) (init-declr-list (init-declr (ident ,name))))
-         (let* ((info ((decl->info info) `(decl (decl-spec-list (type-spec (union-def (ident ,type) ,field-list))))))
-                (types (.types info)))
-           (clone info #:types (cons (cons name (or (get-type info `("tag" ,type)) `(typedef ,type))) types))))
-
-        ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
-         (let* ((type (get-type info type))
-                (type (make-type (type:type type)
-                                 (type:size type)
-                                 (1+ (type:pointer type))
-                                 (type:description type)))
-                (type-entry (cons name type)))
-           (clone info #:types (cons type-entry types))))
-
-        ;; struct
-        ((decl (decl-spec-list (type-spec (struct-def (ident ,name) (field-list . ,fields)))))
-         (let ((type-entry (struct->type-entry name (append-map (struct-field info) fields))))
-           (clone info #:types (cons type-entry types))))
-
-        ;; union
-        ((decl (decl-spec-list (type-spec (union-def (ident ,name) (field-list . ,fields)))))
-         (let ((type-entry (union->type-entry name (append-map (struct-field info) fields))))
-           (clone info #:types (cons type-entry types))))
-
-        ;; enum e i;
-        ((decl (decl-spec-list (type-spec (enum-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name))))
-         (let ((type "int")) ;; FIXME
-           (if (.function info)
-               (clone info #:locals (add-local locals name type 0))
-               (clone info #:globals (append globals (list (ident->global-entry name type 0 0)))))))
-
-        ;; struct foo bar[2];
-        ;; char arena[20000];
-        ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (array-of (ident ,name) ,count))))
-         (let ((type (ast->type type)))
-           (if (.function info)
-               (let* ((local (car (add-local locals name type -1)))
-                      (count (expr->number info count))
-                      (size (ast-type->size info type))
-                      (pointer (expr->pointer info `(type-spec ,type)))
-                      (pointer (- -1 pointer))
-                      (local (make-local-entry name type pointer (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4))))
-                      (locals (cons local locals))
-                      (info (clone info #:locals locals)))
-                 info)
-               (let* ((foo (mescc:trace name " <g>"))
-                      (globals (.globals info))
-                      (count (expr->number info count))
-                      (size (ast-type->size info type))
-                      (pointer (expr->pointer info `(type-spec ,type)))
-                      (pointer (- -1 pointer))
-                      (array (make-global-entry name type pointer (string->list (make-string (* count size) #\nul))))
-                      (globals (append globals (list array))))
-                 (clone info #:globals globals)))))
-
-        ;; struct foo *bar[2];
-        ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr (pointer) (array-of (ident ,name) ,count)))))
-         (let ((type (ast->type type)))
-           (if (.function info)
-               (let* ((local (car (add-local locals name type -1)))
-                      (count (expr->number info count))
-                      (size 4)
-                      (pointer (expr->pointer info `(type-spec ,type)))
-                      (pointer (- -3 pointer))
-                      (local (make-local-entry name type pointer (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4))))
-                      (locals (cons local locals))
-                      (info (clone info #:locals locals)))
-                 info)
-               (let* ((foo (mescc:trace name " <g>"))
-                      (globals (.globals info))
-                      (count (expr->number info count))
-                      (size 4)
-                      (pointer (expr->pointer info `(type-spec ,type)))
-                      (pointer (- -3 pointer))
-                      (global (make-global-entry name type pointer (string->list (make-string (* count size) #\nul))))
-                      (globals (append globals (list global))))
-                 (clone info #:globals globals)))))
-
-        ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (array-of (ident ,name) (p-expr (fixed ,size))) (initzer (p-expr (string ,string))))))
-         (if (.function info)
-             (error  "TODO: " o)
-             (let* ((foo (mescc:trace name " <g>"))
-                    (globals (.globals info))
-                    ;; (count (cstring->number count))
-                    ;; (size (ast-type->size info type))
-                    (array (make-global-entry name type -1 (string->list string)))
-                    (globals (append globals (list array))))
-               (clone info #:globals globals))))
-
-        ;; int (*function) (void) = g_functions[g_cells[fn].cdr].function;
-        ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,param-list)) (initzer ,initzer))))
-         (let* ((locals (add-local locals name type 1))
-                (info (clone info #:locals locals))
-                (empty (clone info #:text '()))
-                (accu ((expr->accu empty) initzer)))
-           (clone info
-                  #:text
-                  (append text
-                          (.text accu)
-                          ((accu->ident info) name)
-                          (wrap-as (append (i386:label->base `(#:address "_start"))
-                                           (i386:accu+base))))
-                  #:locals locals)))
-
-        ;; char *p = g_cells;
-        ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (ident ,value))))))
-         (let ((info (append-text info (ast->comment o)))
-               (type (decl->ast-type type)))
-           (if (.function info)
-               (let* ((locals (add-local locals name type  1))
-                      (info (clone info #:locals locals)))
-                 (append-text info (append ((ident->accu info) value)
-                                           ((accu->ident info) name))))
-               (let ((globals (append globals (list (ident->global-entry name type 1 `(,value #f #f #f))))))
-                 (clone info #:globals globals)))))
-
-        ;; enum foo { };
-        ((decl (decl-spec-list (type-spec (enum-def (ident ,name) (enum-def-list . ,fields)))))
-         (let ((type-entry (enum->type-entry name fields))
-               (constants (enum-def-list->constants constants fields)))
-           (clone info
-                  #:types (cons type-entry types)
-                  #:constants (append constants (.constants info)))))
-
-        ;; enum {};
-        ((decl (decl-spec-list (type-spec (enum-def (enum-def-list . ,fields)))))
-         (let ((constants (enum-def-list->constants constants fields)))
-           (clone info
-                  #:constants (append constants (.constants info)))))
-
-        ((decl (decl-spec-list (type-spec (struct-def (ident ,type) (field-list . ,fields))))
-               (init-declr-list (init-declr (ident ,name))))
-         (let ((info ((decl->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,type) (field-list . ,fields))))))))
-           ((decl->info info) `(decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name)))))))
-
-        ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (union-def (ident ,type) ,fields))) (init-declr-list (init-declr (ident ,name))))
-         (let ((info ((decl->info info) `(decl (decl-spec-list (type-spec (union-def (ident ,type) ,fields)))))))
-           ((decl->info info) `(decl (decl-spec-list (type-spec (union-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name)))))))
-
-        ;; struct f = {...};
-        ;; LOCALS!
-        ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ident ,name) (initzer (initzer-list . ,initzers)))))
-         (if (not (.function info)) (mescc:trace name " <g>"))
-         (let* ((info (append-text info (ast->comment o)))
-                (type (decl->ast-type type))
-                (fields (ast-type->description info type))
-                (xtype (ast-type->type info type))
-                (fields (if (not (eq? (type:type xtype) 'union)) fields
-                            (list-head fields 1)))
-                (size (ast-type->size info type))
-                (initzers (map (initzer->non-const info) initzers)))
-           (if (.function info)
-               (let* ((initzer-globals (filter identity (append-map (initzer->globals globals) initzers)))
-                      (global-names (map car globals))
-                      (initzer-globals (filter (lambda (g) (and g (not (member (car g) global-names)))) initzer-globals))
-                      (globals (append globals initzer-globals))
-                      (local (car (add-local locals name type -1)))
-                      (local (make-local-entry name type -1 (+ (local:id (cdr local)) (quotient (+ size 3) 4))))
-                      (locals (cons local locals))
-                      (info (clone info #:locals locals #:globals globals))
-                      (empty (clone info #:text '())))
-                 (let loop ((fields fields) (initzers initzers) (info info))
-                   (if (null? fields) info
-                       (let ((offset (field-offset info type (field:name (car fields))))
-                             (size (field:size (car fields)))
-                             (initzer (if (null? initzers) '(p-expr (fixed "0")) (car initzers))))
-                         (loop (cdr fields) (if (null? initzers) '() (cdr initzers))
-                               (clone info #:text
-                                      (append
-                                       (.text info)
-                                       ((ident->accu info) name)
-                                       (wrap-as (append (i386:accu->base)))
-                                       (.text ((expr->accu empty) initzer))
-                                       (wrap-as (case size
-                                                  ((1) (i386:byte-accu->base-mem+n offset))
-                                                  ((2) (i386:word-accu->base-mem+n offset))
-                                                  (else (i386:accu->base-mem+n offset)))))))))))
-               (let* ((initzer-globals (filter identity (append-map (initzer->globals globals) initzers)))
-                      (global-names (map car globals))
-                      (initzer-globals (filter (lambda (g) (and g (not (member (car g) global-names)))) initzer-globals))
-                      (globals (append globals initzer-globals))
-                      (global (make-global-entry name type -1 (append-map (initzer->data info) initzers)))
-                      (globals (append globals (list global))))
-                 (clone info #:globals globals)))))
-
-        ;; DECL
-        ;; char *bla[] = {"a", "b"};
-        ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr (pointer) (array-of (ident ,name))) (initzer (initzer-list . ,initzers)))))
-         (if (not (.function info)) (mescc:trace name " <g>"))
-         (let* ((type (decl->ast-type type))
-                (pointer (expr->pointer info `(type-spec ,type)))
-                (pointer (- -3 pointer))
-                (entries (filter identity (append-map (initzer->globals globals) initzers)))
-                (global-names (map car globals))
-                (entries (filter (lambda (g) (and g (not (member (car g) global-names)))) entries))
-                (globals (append globals entries))
-                (entry-size 4)
-                (size (* (length entries) entry-size))
-                (initzers (map (initzer->non-const info) initzers)))
-           (if (.function info)
-               (let* ((count (length initzers))
-                      (local (car (add-local locals name type -1)))
-                      (local (make-local-entry name type pointer (+ (local:id (cdr local)) -1 (1+ count))))
-                      (locals (cons local locals))
-                      (info (clone info #:locals locals))
-                      (info (clone info #:globals globals))
-                      (empty (clone info #:text '())))
-                 (let loop ((index 0) (initzers initzers) (info info))
-                   (if (null? initzers) info
-                       (let ((offset (* index 4))
-                             (initzer (car initzers)))
-                         (loop (1+ index) (cdr initzers)
-                               (clone info #:text
-                                      (append
-                                       (.text info)
-                                       ((ident->accu info) name)
-                                       (wrap-as (append (i386:accu->base)))
-                                       (.text ((expr->accu empty) initzer))
-                                       (wrap-as (i386:accu->base-mem+n offset)))))))))
-               (let* ((global (make-global-entry name type pointer (append-map (initzer->data info) initzers)))
-                      (globals (append globals (list global))))
-                 (clone info #:globals globals)))))
-
-        ;; int foo[2] = { ... }
-        ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (array-of (ident ,name) ,count) (initzer (initzer-list . ,initzers)))))
-         (if (not (.function info)) (mescc:trace name " <g>"))
-         (let* ((info (type->info info type))
-                (xtype type)
-                (type (decl->ast-type type))
-                (pointer (expr->pointer info `(type-spec ,type)))
-                (pointer (- -2 pointer))
-                (initzer-globals (filter identity (append-map (initzer->globals globals) initzers)))
-                (global-names (map car globals))
-                (initzer-globals (filter (lambda (g) (and g (not (member (car g) global-names)))) initzer-globals))
-                (initzers ((initzer->non-const info) initzers))
-                (info (append-text info (ast->comment o)))
-                (globals (append globals initzer-globals))
-                (info (clone info #:globals globals))
-                (type-size (if (<= pointer 0) (ast-type->size info type)
-                               4))
-                (count (expr->number info count))
-                (size (* count type-size)))
-           (if (.function info)
-               (let* ((local (car (add-local locals name type 1)))
-                      (local (make-local-entry name type pointer (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4))))
-                      (locals (cons local locals))
-                      (local (cdr local))
-                      (info (clone info #:locals locals))
-                      (info (let loop ((info info) (initzers initzers) (n 0))
-                              (if (null? initzers) info
-                                  (let* ((info ((initzer->accu info) (car initzers)))
-                                         (info ((accu->local+n info local) n)))
-                                    (loop info (cdr initzers) (+ n type-size)))))))
-                 info)
-               (let* ((global (make-global-entry name type pointer (append-map (initzer->data info) initzers)))
-                      (globals (append globals (list global))))
-                 (clone info #:globals globals)))))
-
-        ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr ,init . ,initzer)))
-         (let* ((info (type->info info type))
-                (xtype type)
-                (type (decl->ast-type type))
-                (name (init-declr->name init))
-                (foo (if (not (.function info)) (mescc:trace name " <g>")))
-                (pointer (init-declr->pointer init))
-                (initzer-globals (if (null? initzer) '()
-                                     (filter identity (append-map (initzer->globals globals) initzer))))
-                (global-names (map car globals))
-                (initzer-globals (filter (lambda (g) (and g (not (member (car g) global-names)))) initzer-globals))
-                (initzer (if (null? initzer) '() ((initzer->non-const info) initzer)))
-                ;;FIXME: ridiculous performance hit with mes
-                (info (append-text info (ast->comment o)))
-                (globals (append globals initzer-globals))
-                (info (clone info #:globals globals))
-                (struct? (and (zero? pointer)
-                              (or (and (pair? type) (equal? (car type) "tag"))
-                                  (memq (type:type (ast-type->type info xtype)) '(struct union)))))
-                (pointer (if struct? -1 pointer))
-                (size (if (<= pointer 0) (ast-type->size info type)
-                          4))
-                (count (init-declr->count info init)) ; array... split me up?
-                (size (if count (* count size) size)))
-           (if (.function info)
-               (let* ((locals (if (or (> pointer 0) (<= size 4)) (add-local locals name type pointer)
-                                  (let* ((local (car (add-local locals name type 1)))
-                                         (local (make-local-entry name type pointer (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4)))))
-                                    (cons local locals))))
-                      (info (clone info #:locals locals))
-                      (info (if (null? initzer) info ((initzer->accu info) (car initzer))))
-                      ;; FIXME array...struct?
-                      (info (if (null? initzer) info (append-text info ((accu->ident info) name)))))
-                 info)
-               (let* ((global (make-global-entry name type pointer (if (null? initzer) (string->list (make-string size #\nul))
-                                                                       (append-map (initzer->data info) initzer))))
-                      (globals (append globals (list global))))
-                 (clone info #:globals globals)))))
-
-        ((decl (decl-spec-list (type-spec ,type)) (init-declr-list . ,inits))
-         (let loop ((inits inits) (info info))
-           (if (null? inits) info
-               (loop (cdr inits)
-                     ((decl->info info)
-                      `(decl (decl-spec-list (type-spec ,type)) (init-declr-list ,(car inits))))))))
-
-        ((decl (decl-spec-list (stor-spec (static)) (type-spec ,type)) ,init)
-         ((decl->info info) `(decl (decl-spec-list (type-spec ,type)) ,init)))
-
-        ((decl (decl-spec-list (stor-spec (typedef)) ,type) ,name)
-         (format (current-error-port) "SKIP: typedef=~s\n" o)
-         info)
-
-        ((decl (@ ,at))
-         (format (current-error-port) "SKIP: at=~s\n" o)
-         info)
-
-        ((decl . _) (error "decl->info: not supported: " o))))))
-
-(define (ast->info info)
-  (lambda (o)
-    (let ((functions (.functions info))
-          (globals (.globals info))
-          (locals (.locals info))
-          (constants (.constants info))
-          (types (.types info))
-          (text (.text info)))
-      (pmatch o
-        (((trans-unit . _) . _)
-         ((ast-list->info info)  o))
-        ((trans-unit . ,elements)
-         ((ast-list->info info) elements))
-        ((fctn-defn . _) ((function->info info) o))
-        ((cpp-stmt (define (name ,name) (repl ,value)))
-         info)
-
-        ((cast (type-name (decl-spec-list (type-spec (void)))) _)
-         info)
-
-        ((break)
-         (let ((label (car (.break info))))
-           (append-text info (wrap-as (i386:jump label)))))
-
-        ((continue)
-         (let ((label (car (.continue info))))
-           (append-text info (wrap-as (i386:jump label)))))
-
-        ;; FIXME: expr-stmt wrapper?
-        (trans-unit info)
-        ((expr-stmt) info)
-
-        ((compd-stmt (block-item-list . ,statements)) ((ast-list->info info) statements))
-
-        ((asm-expr ,gnuc (,null ,arg0 . string))
-         (append-text info (wrap-as (asm->m1 arg0))))
-
-        ((expr-stmt (fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)))
-         (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list))))
-                                   (append-text info (wrap-as (asm->m1 arg0))))
-             (let* ((info (append-text info (ast->comment o)))
-                    (info ((expr->accu info) `(fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)))))
-               (append-text info (wrap-as (i386:accu-zero?))))))
-
-        ((if ,test ,then)
-         (let* ((info (append-text info (ast->comment `(if ,test (ellipsis)))))
-                (here (number->string (length text)))
-                (label (string-append "_" (.function info) "_" here "_"))
-                (break-label (string-append label "break"))
-                (else-label (string-append label "else"))
-                (info ((test-jump-label->info info break-label) test))
-                (info ((ast->info info) then))
-                (info (append-text info (wrap-as (i386:jump break-label))))
-                (info (append-text info (wrap-as `((#:label ,break-label))))))
-           (clone info
-                  #:locals locals)))
-
-        ((if ,test ,then ,else)
-         (let* ((info (append-text info (ast->comment `(if ,test (ellipsis) (ellipsis)))))
-                (here (number->string (length text)))
-                (label (string-append "_" (.function info) "_" here "_"))
-                (break-label (string-append label "break"))
-                (else-label (string-append label "else"))
-                (info ((test-jump-label->info info else-label) test))
-                (info ((ast->info info) then))
-                (info (append-text info (wrap-as (i386:jump break-label))))
-                (info (append-text info (wrap-as `((#:label ,else-label)))))
-                (info ((ast->info info) else))
-                (info (append-text info (wrap-as `((#:label ,break-label))))))
-           (clone info
-                  #:locals locals)))
-
-        ;; Hmm?
-        ((expr-stmt (cond-expr ,test ,then ,else))
-         (let* ((info (append-text info (ast->comment `(cond-expr ,test (ellipsis) (ellipsis)))))
-                (here (number->string (length text)))
-                (label (string-append "_" (.function info) "_" here "_"))
-                (else-label (string-append label "else"))
-                (break-label (string-append label "break"))
-                (info ((test-jump-label->info info else-label) test))
-                (info ((ast->info info) then))
-                (info (append-text info (wrap-as (i386:jump break-label))))
-                (info (append-text info (wrap-as `((#:label ,else-label)))))
-                (info ((ast->info info) else))
-                (info (append-text info (wrap-as `((#:label ,break-label))))))
-           info))
-
-        ((switch ,expr (compd-stmt (block-item-list . ,statements)))
-         (let* ((info (append-text info (ast->comment `(switch ,expr (compd-stmt (block-item-list (ellipsis)))))))
-                (here (number->string (length text)))
-                (label (string-append "_" (.function info) "_" here "_"))
-                (break-label (string-append label "break"))
-                (clauses (statements->clauses statements))
-                (info ((expr->accu info) expr))
-                (info (clone info #:break (cons break-label (.break info))))
-                (info (let loop ((clauses clauses) (i 0) (info info))
-                        (if (null? clauses) info
-                            (loop (cdr clauses) (1+ i) ((clause->info info i label (null? (cdr clauses))) (car clauses))))))
-                (info (append-text info (wrap-as `((#:label ,break-label))))))
-           (clone info
-                  #:locals locals
-                  #:break (cdr (.break info)))))
-
-        ((for ,init ,test ,step ,body)
-         (let* ((info (append-text info (ast->comment `(for ,init ,test ,step (ellipsis)))))
-                (here (number->string (length text)))
-                (label (string-append "_" (.function info) "_" here "_"))
-                (break-label (string-append label "break"))
-                (loop-label (string-append label "loop"))
-                (continue-label (string-append label "continue"))
-                (initial-skip-label (string-append label "initial_skip"))
-                (info ((ast->info info) init))
-                (info (clone info #:break (cons break-label (.break info))))
-                (info (clone info #:continue (cons continue-label (.continue info))))
-                (info (append-text info (wrap-as (i386:jump initial-skip-label))))
-                (info (append-text info (wrap-as `((#:label ,loop-label)))))
-                (info ((ast->info info) body))
-                (info (append-text info (wrap-as `((#:label ,continue-label)))))
-                (info ((expr->accu info) step))
-                (info (append-text info (wrap-as `((#:label ,initial-skip-label)))))
-                (info ((test-jump-label->info info break-label) test))
-                (info (append-text info (wrap-as (i386:jump loop-label))))
-                (info (append-text info (wrap-as `((#:label ,break-label))))))
-           (clone info
-                  #:locals locals
-                  #:break (cdr (.break info))
-                  #:continue (cdr (.continue info)))))
-
-        ((while ,test ,body)
-         (let* ((info (append-text info (ast->comment `(while ,test (ellipsis)))))
-                (here (number->string (length text)))
-                (label (string-append "_" (.function info) "_" here "_"))
-                (break-label (string-append label "break"))
-                (loop-label (string-append label "loop"))
-                (continue-label (string-append label "continue"))
-                (info (append-text info (wrap-as (i386:jump continue-label))))
-                (info (clone info #:break (cons break-label (.break info))))
-                (info (clone info #:continue (cons continue-label (.continue info))))
-                (info (append-text info (wrap-as `((#:label ,loop-label)))))
-                (info ((ast->info info) body))
-                (info (append-text info (wrap-as `((#:label ,continue-label)))))
-                (info ((test-jump-label->info info break-label) test))
-                (info (append-text info (wrap-as (i386:jump loop-label))))
-                (info (append-text info (wrap-as `((#:label ,break-label))))))
-           (clone info
-                  #:locals locals
-                  #:break (cdr (.break info))
-                  #:continue (cdr (.continue info)))))
-
-        ((do-while ,body ,test)
-         (let* ((info (append-text info (ast->comment `(do-while ,test (ellipsis)))))
-                (here (number->string (length text)))
-                (label (string-append "_" (.function info) "_" here "_"))
-                (break-label (string-append label "break"))
-                (loop-label (string-append label "loop"))
-                (continue-label (string-append label "continue"))
-                (info (clone info #:break (cons break-label (.break info))))
-                (info (clone info #:continue (cons continue-label (.continue info))))
-                (info (append-text info (wrap-as `((#:label ,loop-label)))))
-                (info ((ast->info info) body))
-                (info (append-text info (wrap-as `((#:label ,continue-label)))))
-                (info ((test-jump-label->info info break-label) test))
-                (info (append-text info (wrap-as (i386:jump loop-label))))
-                (info (append-text info (wrap-as `((#:label ,break-label))))))
-           (clone info
-                  #:locals locals
-                  #:break (cdr (.break info))
-                  #:continue (cdr (.continue info)))))
-
-        ((labeled-stmt (ident ,label) ,statement)
-         (let ((info (append-text info `(((#:label ,(string-append "_" (.function info) "_label_" label)))))))
-           ((ast->info info) statement)))
-
-        ((goto (ident ,label))
-         (append-text info (wrap-as (i386:jump (string-append "_" (.function info) "_label_" label)))))
-
-        ((return ,expr)
-         (let ((info ((expr->accu info) expr)))
-           (append-text info (append (wrap-as (i386:ret))))))
-
-        ((decl . ,decl)
-         (or (if (.function info)
-                 ((decl-local->info info) decl)
-                 ((decl-global->info info) decl))
-             ((decl->info info) o)))
-
-        ;; ...
-        ((gt . _) ((expr->accu info) o))
-        ((ge . _) ((expr->accu info) o))
-        ((ne . _) ((expr->accu info) o))
-        ((eq . _) ((expr->accu info) o))
-        ((le . _) ((expr->accu info) o))
-        ((lt . _) ((expr->accu info) o))
-        ((lshift . _) ((expr->accu info) o))
-        ((rshift . _) ((expr->accu info) o))
-
-        ;; EXPR
-        ((expr-stmt ,expression)
-         (let ((info ((expr->accu info) expression)))
-           (append-text info (wrap-as (i386:accu-zero?)))))
-
-        ;; FIXME: why do we get (post-inc ...) here
-        ;; (array-ref
-        (_ (let ((info ((expr->accu info) o)))
-             (append-text info (wrap-as (i386:accu-zero?)))))))))
+    (((initzer (p-expr (string ,string))))
+     (let ((data (string->list string)))
+       (if (not size) data
+           (append data (string->list (make-string (max 0 (- size (length data))) #\nul))))))
+
+    ((initzer (p-expr (fixed ,fixed)))
+     (int->bv32 (expr->number info fixed)))
+
+    (() (string->list (make-string size #\nul)))
+    (_ (error "array-init->data: not supported: " o))))
+
+(define (init-declr->info type pointer 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)))
+    (((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)
+                          (or (and (pair? type) (equal? (car type) "tag"))
+                              (memq (type:type type) '(struct union)))))
+            (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))))
+    (((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)
+     (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))))
+    (((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))))
+
+    ;; FIXME: recursion
+    (((array-of (array-of (ident ,name) ,array) ,array1) . ,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))))
+
+    (_ (error "init-declr->info: not supported: " o))))
 
 (define (enum-def-list->constants constants fields)
   (let loop ((fields fields) (i 0) (constants constants))
                 (1+ i)
                 (append constants (list (ident->constant name i))))))))
 
-(define (initzer->non-const info)
-  (lambda (o)
-    (pmatch o
-      ((initzer (p-expr (ident ,name)))
-       (let ((value (assoc-ref (.constants info) name)))
-         `(initzer (p-expr (fixed ,(number->string value))))))
-      (_ o))))
-
-(define (initzer->value info)
-  (lambda (o)
-    (pmatch o
-      ((p-expr (fixed ,value)) (cstring->number value))
-      (_ (error "initzer->value: " o)))))
-
-(define (initzer->data info)
-  (lambda (o)
-    (pmatch o
-      ((initzer (p-expr (char ,char))) (int->bv32 (char->integer (string-ref char 0))))
-      ((initzer (p-expr (char ,char))) (list (char->integer (string-ref char 0))))
-      ((initzer (p-expr (string ,string))) `((#:string ,string) #f #f #f))
-      ((initzer (p-expr (string . ,strings))) `((#:string ,(string-join strings "")) #f #f #f))
-      ((initzer (initzer-list . ,initzers)) (append-map (initzer->data info) initzers))
-      ((initzer (ref-to (p-expr (ident ,name)))) `(,name #f #f #f))
-      ((initzer (ref-to (i-sel (ident ,field) (cast (type-name (decl-spec-list ,struct) (abs-declr (pointer))) (p-expr (fixed ,base))))))
-       (let* ((type (decl->ast-type struct))
-              (offset (field-offset info type field))
-              (base (cstring->number base)))
-         (int->bv32 (+ base offset))))
-      (() (int->bv32 0))
-      ((initzer ,p-expr)
-       (int->bv32 (expr->number info p-expr)))
-      (_ (error "initzer->data: not supported: " o)))))
-
-(define (initzer->accu info)
-  (lambda (o)
-    (pmatch o
-      ((initzer-list . ,initzers) (fold (lambda (i info) ((expr->accu info) i)) info initzers))
-      ((initzer (initzer-list . ,initzers)) (fold (lambda (i info) ((expr->accu info) i)) info initzers))
-      ((initzer ,initzer) ((expr->accu info) o))
-      (() (append-text info (wrap-as (i386:value->accu 0))))
-      (_ (error "initzer->accu: " o)))))
-
-(define (expr->global globals)
-  (lambda (o)
+(define (init->data o info)
+  (pmatch o
+    ((p-expr ,expr) (init->data expr info))
+    ((fixed ,fixed) (int->bv32 (expr->number info o)))
+    ((char ,char) (int->bv32 (char->integer (string-ref char 0))))
+    ((string ,string) `((#:string ,string)))
+    ((string . ,strings) `((#:string ,(string-join strings ""))))
+    ((ident ,name) (let ((var (ident->variable info name)))
+                     `((#:address ,var))))
+    ((initzer-list . ,initzers) (append-map (cut init->data <> info) initzers))
+    (((initzer (initzer-list . ,inits)))
+     (init->data `(initzer-list . ,inits) info))
+    ((ref-to (p-expr (ident ,name)))
+     (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))
+            (offset (field-offset info type field))
+            (base (cstring->number base)))
+       (int->bv32 (+ base offset))))
+    ((,char . _) (guard (char? char)) o)
+    ((,number . _) (guard (number? number))
+     (append (map int->bv32 o)))
+    ((initzer ,init) (init->data init info))
+    (_ (error "init->data: not supported: " o))))
+
+(define (init->strings o info)
+  (let ((globals (.globals info)))
     (pmatch o
       ((p-expr (string ,string))
        (let ((g `(#:string ,string)))
-         (or (assoc g globals)
-             (string->global-entry string))))
+         (if (assoc g globals) '()
+             (list (string->global-entry string)))))
       ((p-expr (string . ,strings))
        (let* ((string (string-join strings ""))
               (g `(#:string ,string)))
-         (or (assoc g globals)
-             (string->global-entry string))))
-      ;;((p-expr (fixed ,value)) (int->global-entry (cstring->number value)))
-      (_ #f))))
-
-(define (initzer->globals globals)
-  (lambda (o)
-    (pmatch o
-      ((initzer (initzer-list . ,initzers)) (append-map (initzer->globals globals) initzers))
-      ((initzer ,initzer) (list ((expr->global globals) initzer)))
-      (_ '(#f)))))
+         (if (assoc g globals) '()
+             (list (string->global-entry string)))))
+      (((initzer (initzer-list . ,init)))
+       (append-map (cut init->strings <> info) init))
+      ((initzer ,init)
+       (init->strings init info))
+      ((initzer-list . ,init)
+       (append-map (cut init->strings <> info) init))
+      (_ '()))))
 
 (define (type->info info o)
   (pmatch o
+    ((enum-def (ident ,name) (enum-def-list . ,fields))
+     (mescc:trace name " <t>")
+     (let* ((type-entry (enum->type-entry name fields))
+            (constants (enum-def-list->constants (.constants info) fields)))
+       (clone info
+              #:types (cons type-entry (.types info))
+              #:constants (append constants (.constants info)))))
     ((struct-def (ident ,name) (field-list . ,fields))
      (mescc:trace name " <t>")
      (let ((type-entry (struct->type-entry name (append-map (struct-field info) fields))))
        (clone info #:types (cons type-entry (.types info)))))
-    (_  info)))
+    ((struct-ref . _)
+     info)
+    ((union-def (ident ,name) (field-list . ,fields))
+     (mescc:trace name " <t>")
+     (let ((type-entry (union->type-entry name (append-map (struct-field info) fields))))
+       (clone info #:types (cons type-entry (.types info)))))
+    ((union-ref . _)
+     info)
+    (_ 
+     (stderr "type->info: not supported: ~s\n" o)
+     info)))
+
+;;;\f fctn-defn
+(define (param-decl:get-name o)
+  (pmatch o
+    ((ellipsis) #f)
+    ((param-decl (decl-spec-list (type-spec (void)))) #f)
+    ((param-decl _ (param-declr ,ast)) (ast->name ast))
+    (_ (error "param-decl:get-name not supported:" o))))
 
-(define (.formals o)
+(define (fctn-defn:get-name o)
   (pmatch o
-    ((fctn-defn _ (ftn-declr _ ,formals) _) formals)
-    ((fctn-defn _ (ptr-declr (pointer) (ftn-declr _ ,formals)) _) formals)
-    ((fctn-defn _ (ptr-declr (pointer (pointer)) (ftn-declr _ ,formals)) _) formals)
-    ((fctn-defn _ (ptr-declr (pointer (pointer (pointer))) (ftn-declr _ ,formals)) _) formals)
-    (_ (error ".formals: " o))))
+    ((_ (ftn-declr (ident ,name) _) _) name)
+    ((_ (ptr-declr (pointer . _) (ftn-declr (ident ,name) _)) _) name)
+    (_ (error "fctn-defn:get-name not supported:" o))))
+
+(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))
+    (_ (error "param-decl:get-type not supported:" o))))
+
+(define (fctn-defn:get-formals o)
+  (pmatch o
+    ((_ (ftn-declr _ ,formals) _) formals)
+    ((_ (ptr-declr (pointer . _) (ftn-declr _ ,formals)) _) formals)
+    (_ (error "fctn-defn->formals: not supported:" o))))
 
 (define (formal->text n)
   (lambda (o i)
     '()
     ))
 
-(define (formals->text o)
+(define (param-list->text o)
   (pmatch o
     ((param-list . ,formals)
      (let ((n (length formals)))
        (wrap-as (append (i386:function-preamble)
                         (append-map (formal->text n) formals (iota n))
                         (i386:function-locals)))))
-    (_ (error "formals->text: not supported: " o))))
+    (_ (error "param-list->text: not supported: " o))))
 
-(define (formal:ptr 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 (decl-spec-list . ,decl) (param-declr (ptr-declr (pointer) (array-of (ident ,name)))))
-     2)
-    ((param-decl (decl-spec-list . ,decl) (param-declr (ptr-declr (pointer) (ident ,name))))
-     1)
-    ((param-decl (decl-spec-list . ,decl) (param-declr (ptr-declr (pointer) . _)))
-     1)
-    ((param-decl (decl-spec-list . ,decl) (param-declr (ptr-declr (pointer (pointer)) (ident ,name))))
-     2)
-    ((param-decl (decl-spec-list . ,decl) (param-declr (ptr-declr (pointer (pointer (pointer))) (ident ,name))))
-     3)
-    (_ 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 (formals->locals o)
+(define (param-list->locals o info)
   (pmatch o
     ((param-list . ,formals)
      (let ((n (length formals)))
-       (map make-local-entry (map .name formals) (map .type formals) (map formal:ptr formals) (iota n -2 -1))))
-    (_ (error "formals->locals: not supported: " o))))
-
-
-(define (function->type info o)
+       (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
-    ((fctn-defn (decl-spec-list (type-spec ,type)) (ptr-declr ,pointer ,rest) ,statement)
-     (let ((type (ast-type->type info type))
+    (((decl-spec-list (type-spec ,type)) (ptr-declr ,pointer . _) ,statement)
+     (let ((type (ast->type info type))
            (pointer (ptr-declr->pointer pointer)))
        (make-type (type:type type)
                   (type:size type)
                   (+ (type:pointer type) pointer)
                   (type:description type))))
-    ((decl (decl-spec-list (type-spec ,type)) (init-declr (ptr-declr ,pointer (ftn-declr . ,rest))))
-     (let ((type (ast-type->type info type))
-           (pointer (ptr-declr->pointer pointer)))
-       (make-type (type:type type)
-                  (type:size type)
-                  (+ (type:pointer type) pointer)
-                  (type:description type))))
-    ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr ,pointer (ftn-declr . ,rest)))))
-     (ast-type->type info type))
-    ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ftn-declr . ,rest))))
-     (ast-type->type info type))
-    ((decl (decl-spec-list (stor-spec ,store) (type-spec ,type)) (init-declr-list (init-declr (ptr-declr ,pointer (ftn-declr . ,rest)))))
-     (ast-type->type info type))
-    ((decl (decl-spec-list (stor-spec ,store) (type-spec ,type)) (init-declr-list (init-declr (ftn-declr . ,rest))))
-     (ast-type->type info type))
-    ((fctn-defn (decl-spec-list (stor-spec . ,store) (type-spec ,type)) (ptr-declr ,pointer (ftn-declr . ,rest)) ,statement)
-     (ast-type->type info type))
-    ((fctn-defn (decl-spec-list (stor-spec . ,store) (type-spec ,type)) . ,rest)
-     (ast-type->type info type))
-    ((decl (decl-spec-list (type-spec ,type)) (init-declr (ftn-declr . ,rest)))
-     (ast-type->type info type))
-    ((fctn-defn (decl-spec-list (type-spec ,type)) . ,rest)
-     (ast-type->type info type))
-    (_ (stderr "TODO: function->type: not supported: ~s\n" o)
-       (get-type info "info"))))
-
-(define (function->info info)
-  (lambda (o)
-    (define (assert-return text)
-      (let ((return (wrap-as (i386:ret))))
-        (if (equal? (list-tail text (- (length text) (length return))) return) text
-            (append text return))))
-    (let* ((name (.name o))
-           (type (function->type info o))
-           (formals (.formals o))
-           (text (formals->text formals))
-           (locals (formals->locals formals)))
-      (mescc:trace name)
-      (let loop ((statements (.statements o))
-                 (info (clone info #:locals locals #:function (.name o) #:text text)))
-        (if (null? statements) (let* ((locals (.locals info))
-                                      (local (and (pair? locals) (car locals)))
-                                      (count (and=> local (compose local:id cdr)))
-                                      (stack (and count (* count 4))))
-                                 (if (and stack (getenv "MESC_DEBUG")) (stderr "        stack: ~a\n" stack))
-                                 (clone info
-                                        #:function #f
-                                        #:globals (append (.statics info) (.globals info))
-                                        #:statics '()
-                                        #:functions (append (.functions info) (list (cons name (make-function name type (assert-return (.text info))))))))
-            (let* ((statement (car statements)))
-              (loop (cdr statements)
-                    ((ast->info info) (car statements)))))))))
+    (((decl-spec-list (type-spec ,type)) . ,rest)
+     (ast->type info type))
+    (((decl-spec-list (stor-spec ,store) (type-spec ,type)) (ftn-declr (ident _) _) _)
+     (ast->type info type))
+    (_ (error "fctn-defn:get-type: not supported:" o))))
 
-;; exports
+(define (ftn-declr:get-type info o)
+  (pmatch o
+    ((ftn-declr (ident _) . _) #f)
+    (_ (error "fctn-decrl:get-type: not supported:" o))))
 
-(define (ast-list->info info)
-  (lambda (elements)
-    (let loop ((elements elements) (info info))
-      (if (null? elements) info
-          (loop (cdr elements) ((ast->info info) (car elements)))))))
+(define (fctn-defn:get-statement o)
+  (pmatch o
+    ((_ (ftn-declr (ident _) _) ,statement) statement)
+    ((_ (ptr-declr (pointer . _) (ftn-declr (ident _) . _)) ,statement) statement)
+    (_ (error "fctn-defn:get-statement: not supported: " o))))
+
+(define (fctn-defn->info o info)
+  (define (assert-return text)
+    (let ((return (wrap-as (i386:ret))))
+      (if (equal? (list-tail text (- (length text) (length return))) return) text
+          (append text return))))
+  (let ((name (fctn-defn:get-name o)))
+    (mescc:trace name)
+    (let* ((type (fctn-defn:get-type info o))
+           (formals (fctn-defn:get-formals o))
+           (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 (ast->info statement info))
+           (locals (.locals info))
+           (local (and (pair? locals) (car locals)))
+           (count (and=> local (compose local:id cdr)))
+           (stack (and count (* count 4))))
+      (if (and stack (getenv "MESC_DEBUG")) (stderr "        stack: ~a\n" stack))
+      (clone info
+             #:function #f
+             #:globals (append (.statics info) (.globals info))
+             #:statics '()
+             #:functions (append (.functions info) (list (cons name (make-function name type (assert-return (.text info))))))))))
+
+;; exports
 
-(define* (c99-ast->info ast)
-  ((ast->info (make <info> #:types i386:type-alist)) ast))
+(define* (c99-ast->info o)
+  (ast->info o (make <info> #:types i386:type-alist)))
 
 (define* (c99-input->ast #:key (defines '()) (includes '()))
   (stderr "parsing: input\n")
     (let* ((info (make <info> #:types i386:type-alist))
            (ast (c99-input->ast #:defines defines #:includes includes))
            (foo (stderr "compiling: input\n"))
-           (info ((ast->info info) ast))
+           (info (ast->info ast info))
            (info (clone info #:text '() #:locals '())))
       info)))
 
index de6c62aecba4371edc40196c5576d478a87165c1..69bacbcf0495dbfd6d34595d5612651b956498ab 100644 (file)
@@ -57,6 +57,7 @@
             global:name
             global:type
             global:pointer
+            global:array
             global:value
             global:function
             global->string
@@ -66,6 +67,7 @@
             local?
             local:type
             local:pointer
+            local:array
             local:id
 
             <function>
   (description type:description))
 
 (define-immutable-record-type <global>
-  (make-global name type pointer value function)
+  (make-global name type pointer array value function)
   global?
   (name global:name)
   (type global:type)
   (pointer global:pointer)
+  (array global:array)
   (value global:value)
   (function global:function))
 
       (global:name o)))
 
 (define-immutable-record-type <local>
-  (make-local type pointer id)
+  (make-local type pointer array id)
   local?
   (type local:type)
   (pointer local:pointer)
+  (array local:array)
   (id local:id))
 
 (define-immutable-record-type <function>
index 8871ef13341525f02f4f0312b1067216b92629d5..e515d4252246532167d3b7d82d9fdd677eaeba78 100644 (file)
            (hex2:address address))
           ((#:address (#:address ,global)) (guard (global? global))
            (hex2:address (global->string global)))
-          ((#:string ,string) (hex2:address (string->label o)))
-          ((#:address ,address) (string? address) (hex2:address address))
-          ((#:address ,global) (global? global) (error "urg1: global without a name\n"))
+          ((#:string ,string)
+           (hex2:address (string->label o)))
+          ((#:address ,address) (guard (string? address)) (hex2:address address))
+          ((#:address ,global) (guard (global? global))
+           (hex2:address (global->string global)))
           ((#:offset ,offset) (hex2:offset offset))
           ((#:offset1 ,offset1) (hex2:offset1 offset1))
           ((#:immediate ,immediate) (hex2:immediate immediate))
diff --git a/scaffold/boot/02-identifier.scm b/scaffold/boot/02-identifier.scm
new file mode 100644 (file)
index 0000000..cf78d91
--- /dev/null
@@ -0,0 +1,25 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+'boo
+'4a
+12345
+-22
++44
+(list 0)
+'...
diff --git a/scaffold/boot/03-big-string.scm b/scaffold/boot/03-big-string.scm
new file mode 100644 (file)
index 0000000..f741c66
--- /dev/null
@@ -0,0 +1,56 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+"Mes is distributed WITHOUT ANY WARRANTY.  The following
+sections from the GNU General Public License, version 3, should
+make that clear.
+
+  15. Disclaimer of Warranty.
+
+  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM \"AS IS\" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. Limitation of Liability.
+
+  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+  17. Interpretation of Sections 15 and 16.
+
+  If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+See <http://www.gnu.org/licenses/gpl.html>, for more details.
+"
diff --git a/scaffold/boot/05-big-list.scm b/scaffold/boot/05-big-list.scm
new file mode 100644 (file)
index 0000000..a254137
--- /dev/null
@@ -0,0 +1,28 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(list 00 01 02 03 04 05 06 07 08 09
+      10 11 12 13 14 15 16 17 18 19
+      20 21 22 23 24 25 26 27 28 29
+      30 31 32 33 34 35 36 37 38 39
+      40 41 42 43 44 45 46 47 48 49
+      50 51 52 53 54 55 56 57 58 59
+      60 61 62 63 64 65 66 67 68 69
+      70 71 72 73 74 75 76 77 78 79
+      80 81 82 83 84 85 86 87 88 89
+      90 91 92 93 94 95 96 97 98 99)
diff --git a/scaffold/boot/05-list-list.scm b/scaffold/boot/05-list-list.scm
new file mode 100644 (file)
index 0000000..4cd913f
--- /dev/null
@@ -0,0 +1,19 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(list 0 1 (list 20 21) 3)
diff --git a/scaffold/boot/60-let-syntax-expanded.scm b/scaffold/boot/60-let-syntax-expanded.scm
new file mode 100644 (file)
index 0000000..7a29925
--- /dev/null
@@ -0,0 +1,564 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+;; boot-00.scm
+(define mes %version)
+
+(define (defined? x)
+  (assq x (current-module)))
+
+(define (cond-expand-expander clauses)
+  (if (defined? (car (car clauses)))
+      (cdr (car clauses))
+      (cond-expand-expander (cdr clauses))))
+
+(define-macro (cond-expand . clauses)
+  (cons 'begin (cond-expand-expander clauses)))
+;; end boot-00.scm
+
+;; boot-01.scm
+(define <cell:character> 0)
+(define <cell:pair> 7)
+(define <cell:string> 10)
+
+(define (pair? x) (eq? (core:type x) <cell:pair>))
+(define (not x) (if x #f #t))
+
+(define (display x . rest)
+  (if (null? rest) (core:display x)
+      (core:display-port x (car rest))))
+
+(define (write x . rest)
+  (if (null? rest) (core:write x)
+      (core:write-port x (car rest))))
+
+(define (list->string lst)
+  (core:make-cell <cell:string> lst 0))
+
+(define (integer->char x)
+  (core:make-cell <cell:character> 0 x))
+
+(define (newline . rest)
+  (core:display (list->string (list (integer->char 10)))))
+
+(define (string->list s)
+  (core:car s))
+
+(define (cadr x) (car (cdr x)))
+
+(define (map1 f lst)
+  (if (null? lst) (list)
+      (cons (f (car lst)) (map1 f (cdr lst)))))
+
+(define map map1)
+
+(define (cons* . rest)
+  (if (null? (cdr rest)) (car rest)
+      (cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
+
+(define (apply f h . t)
+  (if (null? t) (core:apply f h (current-module))
+      (apply f (apply cons* (cons h t)))))
+
+(define (append . rest)
+  (if (null? rest) '()
+      (if (null? (cdr rest)) (car rest)
+          (append2 (car rest) (apply append (cdr rest))))))
+;; end boot-01.scm
+
+;;((lambda (*program*) *program*) (primitive-load 0))
+;;(primitive-load 0)
+
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-macro (and . x)
+  (if (null? x) #t
+      (if (null? (cdr x)) (car x)
+          (list (quote if) (car x) (cons (quote and) (cdr x))
+                #f))))
+
+(define-macro (or . x)
+  (if (null? x) #f
+      (if (null? (cdr x)) (car x)
+          (list (list (quote lambda) (list (quote r))
+                      (list (quote if) (quote r) (quote r)
+                            (cons (quote or) (cdr x))))
+                (car x)))))
+
+(define else #t)
+(define-macro (cond . clauses)
+  (list 'if (pair? clauses)
+        (list (cons
+               'lambda
+               (cons
+                '(test)
+                (list (list 'if 'test
+                            (if (pair? (cdr (car clauses)))
+                                (if (eq? (car (cdr (car clauses))) '=>)
+                                    (append2 (cdr (cdr (car clauses))) '(test))
+                                    (list (cons 'lambda (cons '() (cons 'test (cdr (car clauses)))))))
+                                (list (cons 'lambda (cons '() (cons 'test (cdr (car clauses)))))))
+                            (if (pair? (cdr clauses))
+                                (cons 'cond (cdr clauses)))))))
+              (car (car clauses)))))
+
+(define (memq x lst)
+  (if (null? lst) #f
+      (if (eq? x (car lst)) lst
+          (memq x (cdr lst)))))
+
+;; (cond-expand
+;;  (guile
+;;   (define closure identity)
+;;   (define body identity)
+;;   (define append2 append)
+;;   (define (core:apply f a m) (f a))
+;;   )
+;;  (mes
+  (define <cell:symbol> 11)
+  (define (symbol? x)
+    (eq? (core:type x) <cell:symbol>))
+
+  (define (string->symbol s)
+    (if (not (pair? (core:car s))) '()
+        (core:lookup-symbol (core:car s))))
+
+  (define <cell:string> 10)
+  (define (string? x)
+    (eq? (core:type x) <cell:string>))
+  
+  (define <cell:vector> 14)
+  (define (vector? x)
+    (eq? (core:type x) <cell:vector>))
+  ;; (define (body x)
+  ;; (core:cdr (core:cdr (core:cdr (cdr (assq 'x (current-module)))))))
+  ;; (define (closure x)
+  ;;   (map car (cdr (core:cdr (core:car (core:cdr (cdr (assq 'x (current-module)))))))))
+  ;; ))
+
+(define (cons* . rest)
+  (if (null? (cdr rest)) (car rest)
+      (cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
+
+(define (apply f h . t)
+  (if (null? t) (core:apply f h (current-module))
+      (apply f (apply cons* (cons h t)))))
+
+(define (append . rest)
+  (if (null? rest) '()
+      (if (null? (cdr rest)) (car rest)
+          (append2 (car rest) (apply append (cdr rest))))))
+
+(define-macro (quasiquote x)
+  ;;(core:display-error "quasiquote:") (core:write-error x) (core:display-error "\n")
+  (define (loop x)
+    ;;(core:display-error "loop:") (core:write-error x) (core:display-error "\n")
+    (if (vector? x) (list 'list->vector (loop (vector->list x)))
+        (if (not (pair? x)) (cons 'quote (cons x '()))
+            (if (eq? (car x) 'quasiquote) (loop (loop (cadr x)))
+                (if (eq? (car x) 'unquote) (cadr x)
+                    (if (and (pair? (car x)) (eq? (caar x) 'unquote-splicing))
+                        ((lambda (d)
+                           (list 'append (car (cdr (car x))) d))
+                         (loop (cdr x)))
+                        ((lambda (a d)
+                           (if (pair? d)
+                               (if (eq? (car d) 'quote)
+                                   (if (and (pair? a) (eq? (car a) 'quote))
+                                       (list 'quote (cons (cadr a) (cadr d)))
+                                       (if (null? (cadr d))
+                                           (list 'list a)
+                                           (list 'cons* a d)))
+                                   (if (memq (car d) '(list cons*))
+                                       (cons (car d) (cons a (cdr d)))
+                                       (list 'cons* a d)))
+                               (list 'cons* a d)))
+                         (loop (car x))
+                         (loop (cdr x)))))))))
+  (loop x))
+
+(define (caar x) (car (car x)))
+(define (cadr x) (car (cdr x)))
+(define (cdar x) (cdr (car x)))
+(define (cddr x) (cdr (cdr x)))
+
+(define-macro (simple-let bindings . rest)
+  (cons (cons 'lambda (cons (map car bindings) rest))
+        (map cadr bindings)))
+
+(define-macro (xsimple-let bindings rest)
+  `(,`(lambda ,(map car bindings) ,@rest)
+    ,@(map cadr bindings)))
+
+(define-macro (xnamed-let name bindings rest)
+  `(simple-let ((,name *unspecified*))
+     (set! ,name (lambda ,(map car bindings) ,@rest))
+     (,name ,@(map cadr bindings))))
+
+(define-macro (let bindings-or-name . rest)
+  (if (symbol? bindings-or-name) ;; IF
+      `(xnamed-let ,bindings-or-name ,(car rest) ,(cdr rest))
+      `(xsimple-let ,bindings-or-name ,rest)))
+
+(define (expand-let* bindings body)
+  (if (null? bindings)
+      `((lambda () ,@body))
+      `((lambda (,(caar bindings))
+          ,(expand-let* (cdr bindings) body))
+        ,@(cdar bindings))))
+
+(define-macro (let* bindings . body)
+  (expand-let* bindings body))
+
+(define (equal2? a b)
+  (if (and (null? a) (null? b)) #t
+      (if (and (pair? a) (pair? b))
+          (and (equal2? (car a) (car b))
+               (equal2? (cdr a) (cdr b)))
+          (if (and (string? a) (string? b))
+              (eq? (string->symbol a) (string->symbol b))
+              (if (and (vector? a) (vector? b))
+                  (equal2? (vector->list a) (vector->list b))
+                  (eq? a b))))))
+
+(define equal? equal2?)
+(define (member x lst)
+  (if (null? lst) #f
+      (if (equal2? x (car lst)) lst
+          (member x (cdr lst)))))
+
+(define (<= . rest)
+  (or (apply < rest)
+      (apply = rest)))
+
+(define (>= . rest)
+  (or (apply > rest)
+      (apply = rest)))
+
+(define (list? x)
+  (or (null? x)
+      (and (pair? x) (list? (cdr x)))))
+
+;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright (c) 1993-2004 by Richard Kelsey and Jonathan Rees.
+;;; Copyright © 2016 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; syntax.mes is loaded after scm.mes.  It provides the R5RS hygienic
+;;; macros define-syntax, syntax-rules and define-syntax-rule.
+;;; syntax-rules is adapted from scheme48-1.1/scheme/alt/syntax.scm
+
+;;; Code:
+
+;;; Copyright (c) 1993-2004 by Richard Kelsey and Jonathan Rees. See file COPYING.
+
+;;; scheme48-1.1/COPYING
+
+;; Copyright (c) 1993-2004 Richard Kelsey and Jonathan Rees
+;; All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;; 1. Redistributions of source code must retain the above copyright
+;;    notice, this list of conditions and the following disclaimer.
+;; 2. Redistributions in binary form must reproduce the above copyright
+;;    notice, this list of conditions and the following disclaimer in the
+;;    documentation and/or other materials provided with the distribution.
+;; 3. The name of the authors may not be used to endorse or promote products
+;;    derived from this software without specific prior written permission.
+
+;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+;; IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+(cond-expand
+ (guile)
+ (mes
+  (define-macro (define-syntax macro-name transformer . stuff)
+    `(define-macro (,macro-name . args)
+       (,transformer (cons ',macro-name args)
+                     (lambda (x0) x0)
+                     eq?)))))
+
+;; Rewrite-rule compiler (a.k.a. "extend-syntax")
+
+;; Example:
+;;
+;; (define-syntax or
+;;   (syntax-rules ()
+;;     ((or) #f)
+;;     ((or e) e)
+;;     ((or e1 e ...) (let ((temp e1))
+;;                    (if temp temp (or e ...))))))
+
+(cond-expand
+ (guile)
+ (mes
+  (define-syntax syntax-rules
+    (let ()
+      (define name? symbol?)
+
+      (define (segment-pattern? pattern)
+        (and (segment-template? pattern)
+             (or (null? (cddr pattern))
+                 (syntax-error0 "segment matching not implemented" pattern))))
+    
+      (define (segment-template? pattern)
+        (and (pair? pattern)
+             (pair? (cdr pattern))
+             (memq (cadr pattern) indicators-for-zero-or-more)))
+    
+      (define indicators-for-zero-or-more (list (string->symbol "...") '---))
+    
+      (lambda (exp r c)
+
+        (define %input (r '%input))     ;Gensym these, if you like.
+        (define %compare (r '%compare))
+        (define %rename (r '%rename))
+        (define %tail (r '%tail))
+        (define %temp (r '%temp))
+
+        (define rules (cddr exp))
+        (define subkeywords (cadr exp))
+
+        (define (make-transformer rules)
+          ;;(core:display-error "make-transformer:") (core:write-error rules) (core:display-error "\n")
+          `(lambda (,%input ,%rename ,%compare)
+             (let ((,%tail (cdr ,%input)))
+               (cond ,@(map process-rule rules)
+                     (else
+                      (syntax-error1
+                       "use of macro doesn't match definition"
+                       ,%input))))))
+
+        (define (process-rule rule)
+          ;;(core:display-error "process-rule:") (core:write-error rule) (core:display-error "\n")
+          (if (and (pair? rule)
+                   (pair? (cdr rule))
+                   (null? (cddr rule)))
+              (let ((pattern (cdar rule))
+                    (template (cadr rule)))
+                `((and ,@(process-match %tail pattern))
+                  (let* ,(process-pattern pattern
+                                          %tail
+                                          (lambda (x) x))
+                    ,(process-template template
+                                       0
+                                       (meta-variables pattern 0 '())))))
+              (syntax-error2 "ill-formed syntax rule" rule)))
+      
+        ;; Generate code to test whether input expression matches pattern
+
+        (define (process-match input pattern)
+          ;;(core:display-error "process-match:") (core:write-error input) (core:display-error "\n")
+          ;;(core:display-error "      pattern:") (core:write-error pattern) (core:display-error "\n")
+          (cond ((name? pattern)
+                 (if (member pattern subkeywords)
+                     `((,%compare ,input (,%rename ',pattern)))
+                     `()))
+                ((segment-pattern? pattern)
+                 (process-segment-match input (car pattern)))
+                ((pair? pattern)
+                 `((let ((,%temp ,input))
+                     (and (pair? ,%temp)
+                          ,@(process-match `(car ,%temp) (car pattern))
+                          ,@(process-match `(cdr ,%temp) (cdr pattern))))))
+                ((or (null? pattern) (boolean? pattern) (char? pattern))
+                 `((eq? ,input ',pattern)))
+                (else
+                 `((equal? ,input ',pattern)))))
+      
+        (define (process-segment-match input pattern)
+          ;;(core:display-error "process-segment-match:") (core:write-error input) (core:display-error "\n")
+          ;;(core:display-error "              pattern:") (core:write-error pattern) (core:display-error "\n")
+          (let ((conjuncts (process-match '(car l) pattern)))
+            (if (null? conjuncts)
+                `((list? ,input))       ;+++
+                `((let loop ((l ,input))
+                    (or (null? l)
+                        (and (pair? l)
+                             ,@conjuncts
+                             (loop (cdr l)))))))))
+      
+        ;; Generate code to take apart the input expression
+        ;; This is pretty bad, but it seems to work (can't say why).
+
+        (define (process-pattern pattern path mapit)
+          ;;(core:display-error "process-pattern:") (core:write-error pattern) (core:display-error "\n")
+          ;;(core:display-error "           path:") (core:write-error path) (core:display-error "\n")
+          (cond ((name? pattern)
+                 (if (memq pattern subkeywords)
+                     '()
+                     (list (list pattern (mapit path)))))
+                ((segment-pattern? pattern)
+                 (process-pattern (car pattern)
+                                  %temp
+                                  (lambda (x) ;temp is free in x
+                                    (mapit (if (eq? %temp x)
+                                               path ;+++
+                                               `(map (lambda (,%temp) ,x)
+                                                     ,path))))))
+                ((pair? pattern)
+                 (append (process-pattern (car pattern) `(car ,path) mapit)
+                         (process-pattern (cdr pattern) `(cdr ,path) mapit)))
+                (else '())))
+
+        ;; Generate code to compose the output expression according to template
+
+        (define (process-template template rank env)
+          ;;(core:display-error "process-template:") (core:write-error template) (core:display-error "\n")
+          (cond ((name? template)
+                 (let ((probe (assq template env)))
+                   (if probe
+                       (if (<= (cdr probe) rank)
+                           template
+                           (syntax-error3 "template rank error (too few ...'s?)"
+                                         template))
+                       `(,%rename ',template))))
+                ((segment-template? template)
+                 (let ((vars
+                        (free-meta-variables (car template) (+ rank 1) env '())))
+                   (if (null? vars)
+                       (silent-syntax-error4 "too many ...'s" template)
+                       (let* ((x (process-template (car template)
+                                                   (+ rank 1)
+                                                   env))
+                              (gen (if (equal? (list x) vars)
+                                       x ;+++
+                                       `(map (lambda ,vars ,x)
+                                             ,@vars))))
+                         (if (null? (cddr template))
+                             gen        ;+++
+                             `(append ,gen ,(process-template (cddr template)
+                                                              rank env)))))))
+                ((pair? template)
+                 `(cons ,(process-template (car template) rank env)
+                        ,(process-template (cdr template) rank env)))
+                (else `(quote ,template))))
+
+        ;; Return an association list of (var . rank)
+
+        (define (meta-variables pattern rank vars)
+          ;;(core:display-error "meta-variables:") (core:write-error pattern) (core:display-error "\n")
+          (cond ((name? pattern)
+                 (if (memq pattern subkeywords)
+                     vars
+                     (cons (cons pattern rank) vars)))
+                ((segment-pattern? pattern)
+                 (meta-variables (car pattern) (+ rank 1) vars))
+                ((pair? pattern)
+                 (meta-variables (car pattern) rank
+                                 (meta-variables (cdr pattern) rank vars)))
+                (else vars)))
+
+        ;; Return a list of meta-variables of given higher rank
+
+        (define (free-meta-variables template rank env free)
+          ;;(core:display-error "meta-variables:") (core:write-error template) (core:display-error "\n")
+          (cond ((name? template)
+                 (if (and (not (memq template free))
+                          (let ((probe (assq template env)))
+                            (and probe (>= (cdr probe) rank))))
+                     (cons template free)
+                     free))
+                ((segment-template? template)
+                 (free-meta-variables (car template)
+                                      rank env
+                                      (free-meta-variables (cddr template)
+                                                           rank env free)))
+                ((pair? template)
+                 (free-meta-variables (car template)
+                                      rank env
+                                      (free-meta-variables (cdr template)
+                                                           rank env free)))
+                (else free)))
+
+        c                               ;ignored
+
+        ;; Kludge for Scheme48 linker.
+        ;; `(cons ,(make-transformer rules)
+        ;;          ',(find-free-names-in-syntax-rules subkeywords rules))
+
+        (make-transformer rules))))))
+
+(cond-expand
+ (guile)
+ (mes
+  (define-macro (let-syntax bindings . rest)
+    `((lambda ()
+        ,@(map (lambda (binding)
+                 `(define-macro (,(car binding) . args)
+                    (,(cadr binding) (cons ',(car binding) args)
+                     (lambda (x0) x0)
+                     eq?)))
+               bindings)
+        ,@rest)))))
+
+(core:display
+ (let-syntax ((xwhen (syntax-rules ()
+                       ((xwhen condition exp ...)
+                        (if (not condition)
+                            (begin exp ...))))))
+   (xwhen #f 42)))
+
+
diff --git a/scaffold/boot/call-cc.scm b/scaffold/boot/call-cc.scm
new file mode 100644 (file)
index 0000000..6348206
--- /dev/null
@@ -0,0 +1,60 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+;; ,expand (let loop ((i 10)) (if (eq? i 0) 0 (begin (core:display-error i) (core:display-error "\n") (loop (- i 1)))))
+;; (let loop ((i 10)) (if (eq? i 0) 0 (begin (display i) (display "\n") (loop (- i 1)))))
+
+(define global "global\n")
+(define v #(0 1 2))
+(define vv #(#(0 1 2) 0 1 2))
+((lambda (loop)
+   (set! loop
+         (lambda (i)
+           (core:display global)
+           (core:display (values 'foobar global))
+           (core:display v)
+           (core:display vv)
+           (core:display "i=")
+           (core:display i)
+           (core:display "\n")
+           (if (eq? i 0) 0
+               (begin
+                 ((lambda (cont seen?)
+                   (+ 1 (call-with-current-continuation (lambda (c) (set! cont c) 1)))
+                   (core:display "  seen?=")
+                   (core:display seen?)
+                   (core:display "\n")
+                   (if seen? 0
+                       (begin
+                         (set! seen? #t)
+                         (cont 2))))
+                  #f #f)
+                 (loop (- i 1))))))
+   (loop 10000))
+ *unspecified*)
+
+;; ((lambda (cont seen?)
+;;    (+ 1 (call-with-current-continuation (lambda (c) (set! cont c) 1)))
+;;    (core:display "seen?=")
+;;    (core:display seen?)
+;;    (core:display "\n")
+;;    (if seen? 0
+;;        (begin
+;;          (set! seen? #t)
+;;          (cont 2))))
+;;  #f #f)
diff --git a/scaffold/boot/memory.scm b/scaffold/boot/memory.scm
new file mode 100644 (file)
index 0000000..4d6efb0
--- /dev/null
@@ -0,0 +1,41 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+;; ,expand (let loop ((i 10)) (if (eq? i 0) 0 (begin (core:display-error i) (core:display-error "\n") (loop (- i 1)))))
+;; (let loop ((i 10)) (if (eq? i 0) 0 (begin (display i) (display "\n") (loop (- i 1)))))
+
+((lambda (loop)
+   (set! loop
+         (lambda (i)
+           (if (eq? i 0) 0
+               (begin
+                 (core:display i)
+                 (core:display "\n")
+                 (loop (- i 1))))))
+   (loop 10))
+ *unspecified*)
+
+;; ((lambda (loop)
+;;    (set! loop
+;;          (lambda (i)
+;;            (if (eq? i 0) 0
+;;                (begin (display i)
+;;                       (display "\n")
+;;                       (loop (- i 1))))))
+;;    (loop 10))
+;;  *unspecified*)
diff --git a/scaffold/boot/numbers.scm b/scaffold/boot/numbers.scm
new file mode 100644 (file)
index 0000000..1db5291
--- /dev/null
@@ -0,0 +1 @@
+(cdr '(0 . 1))
index f9573591c4f649546829bc04f621a42640f33e25..1910993414a30274f613115af592603b366a3aef 100644 (file)
 int
 test ()
 {
-  int f;
-  int v = 3;
   char *s = "mes";
   if (!s[0]) return 1;
+  int f;
+  int v = 3;
   if (!s[f]) return 1;
   if (s[3]) return 1;
   if (s[v]) return 1;
index a1770cb2543dc09a757656d64041e612fcc048e6..0ae2d78ccc3fdf5f5df60286c0ca5c54901269f1 100644 (file)
@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * Mes --- Maxwell Equations of Software
- * Copyright © 2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of Mes.
  *
index 27464cf80c1e4eda033f445a7ae97a2500a31dde..658b167f3b2e019718921407545aaeb6966a0904 100644 (file)
@@ -22,7 +22,9 @@ int
 test ()
 {
   static int i = 1;
-  return i--;
+  static int foo = 0;
+  foo = 0;
+  return foo - i--;
 }
 
 static int i = 2;
diff --git a/scaffold/tests/48-global-static.c b/scaffold/tests/48-global-static.c
deleted file mode 100644 (file)
index e669b33..0000000
+++ /dev/null
@@ -1,35 +0,0 @@
-/* -*-comment-start: "//";comment-end:""-*-
- * Mes --- Maxwell Equations of Software
- * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
- *
- * This file is part of Mes.
- *
- * Mes is free software; you can redistribute it and/or modify it
- * under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 3 of the License, or (at
- * your option) any later version.
- *
- * Mes is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
- */
-
-static int sint;
-static int sint2, sint3;
-
-static int
-test ()
-{
-  return 0;
-}
-
-static int i = 2;
-int
-main ()
-{
-  return test ();
-}
diff --git a/scaffold/tests/49-global-static.c b/scaffold/tests/49-global-static.c
new file mode 100644 (file)
index 0000000..e669b33
--- /dev/null
@@ -0,0 +1,35 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of Mes.
+ *
+ * Mes is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * Mes is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+static int sint;
+static int sint2, sint3;
+
+static int
+test ()
+{
+  return 0;
+}
+
+static int i = 2;
+int
+main ()
+{
+  return test ();
+}
index 84c5516bfee32525a84fc9c2ddef1bde12102b1f..9a66268df0e45cbf025617409b17fe493c75ebc8 100644 (file)
@@ -26,6 +26,7 @@ main (int argc, char *argv[])
 {
   puts ("\n");
   puts ("t: argv[0] == \"scaffold/test....\"\n");
+  puts ("argv0="); puts (argv[0]); puts ("\n");
   if (strncmp (argv[0], "scaffold/test", 5)) return 1;
 
   puts ("t: *argv\"\n");
@@ -33,7 +34,7 @@ main (int argc, char *argv[])
   puts ("\n");
 
   puts ("t: if (argc > 1 && !strcmp (argv[1], \"--help\")\n");
-  if (argc > 1 && !strcmp (argv[1], "--help")) return 1;
+  if (argc > 1 && !strcmp (argv[1], "--help")) return 2;
 
   return 0;
 }
diff --git a/scaffold/tests/62-array.c b/scaffold/tests/62-array.c
new file mode 100644 (file)
index 0000000..6c9a540
--- /dev/null
@@ -0,0 +1,55 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of Mes.
+ *
+ * Mes is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * Mes is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <string.h>
+int one_two_three[3] =
+{
+  1, 2, 3
+};
+
+char *foo_bar_baz[3] =
+{
+  "foo", "bar", "baz"
+};
+
+char foo_bar_baz_haha[3][4] =
+{
+  "foo", "bar", "baz"
+};
+
+char *foo = "foo";
+char *bar = "bar";
+char *baz = "baz";
+
+char *foo_bar_baz_mwhuhahaha[3] =
+{
+  &foo, &bar, &baz
+};
+
+int
+main ()
+{
+  puts ("one:"); puts (itoa (one_two_three[0])); puts ("\n");
+  puts ("foo:"); puts (foo_bar_baz[1]); puts ("\n");
+  puts ("bar:"); puts (foo_bar_baz_haha[2]); puts ("\n");
+  char *p = foo_bar_baz_haha[2];
+  puts ("baz:"); puts (p); puts ("\n");
+  return strcmp (foo_bar_baz[2], "baz");
+}
index f23761ecf9dfee68b62ffc53d329df58b6d23100..821559471d693c0410ede37d91e53c8eec706e9b 100644 (file)
 
 #include "30-test.i"
 
-#include <stdio.h>
+// #include <stdio.h>
 #include <stdlib.h>
-#include <string.h>
-
-int
-add (int a, int b)
-{
-  return a + b;
-}
-
-int
-inc (int i)
-{
-  return i + 1;
-}
-
-struct scm {
-  int type;
-  int car;
-  int cdr;
-};
-
-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;};
-int bar (int i) {puts ("t: bar\n"); return 0;};
+// #include <string.h>
+
+// int
+// add (int a, int b)
+// {
+//   return a + b;
+// }
+
+// int
+// inc (int i)
+// {
+//   return i + 1;
+// }
+
+// struct scm {
+//   int type;
+//   int car;
+//   int cdr;
+// };
+
+// 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;};
+// int bar (int i) {puts ("t: bar\n"); return 0;};
 struct function {
   int (*function) (void);
   int arity;
   char *name;
 };
 struct function g_fun = {&exit,1,"fun"};
-struct function g_foo = {&foo,0,"foo"};
-struct function g_bar = {&bar,1,"bar"};
+// struct function g_foo = {&foo,0,"foo"};
+// struct function g_bar = {&bar,1,"bar"};
 
 //void *functions[2];
 int functions[2];
@@ -68,181 +68,183 @@ int functions[2];
 struct function g_functions[2];
 int g_function = 0;
 
-enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVECTOR, TBROKEN_HEART};
+// enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVECTOR, TBROKEN_HEART};
 
-typedef int SCM;
-int g_free = 3;
-SCM tmp;
-SCM tmp_num;
+// typedef int SCM;
+// int g_free = 3;
+// SCM tmp;
+// SCM tmp_num;
 
-int ARENA_SIZE = 200;
-#define TYPE(x) g_cells[x].type
-#define CAR(x) g_cells[x].car
-#define CDR(x) g_cells[x].cdr
-#define VALUE(x) g_cells[x].cdr
+// int ARENA_SIZE = 200;
+// #define TYPE(x) g_cells[x].type
+// #define CAR(x) g_cells[x].car
+// #define CDR(x) g_cells[x].cdr
+// #define VALUE(x) g_cells[x].cdr
 
-#define CAAR(x) CAR (CAR (x))
+// #define CAAR(x) CAR (CAR (x))
 
-struct scm scm_fun = {TFUNCTION,0,0};
-SCM cell_fun;
+// struct scm scm_fun = {TFUNCTION,0,0};
+// SCM cell_fun;
 
 
 int
 test ()
 {
-  puts ("\n");
-  puts ("t: g_cells[0] = g_cells[1]\n");
-  TYPE (1) = 1;
-  CAR (1) = 2;
-  CDR (1) = 3;
-  g_cells[0] = g_cells[1];
-  if (TYPE (0) != 1) return 1;
-  if (CAR (0) != 2) return 2;
-  if (CDR (0) != 3) return 3;
-
-  puts ("t: g_cells[i] = g_cells[j]\n");
-  int i = 0;
-  int j = 1;
-  TYPE (1) = 4;
-  CAR (1) = 5;
-  CDR (1) = 6;
-  g_cells[i] = g_cells[j];
-  if (TYPE (0) != 4) return 1;
-  if (CAR (0) != 5) return 2;
-  if (CDR (0) != 6) return 3;
-
-  puts ("t: g_cells[0+add(0,0] = g_cells[0+inc(0)]\n");
-  TYPE (1) = 1;
-  CAR (1) = 2;
-  CDR (1) = 3;
-  g_cells[0+add(0, 0)] = g_cells[0+inc(0)];
-  if (TYPE (0) != 1) return 1;
-  if (CAR (0) != 2) return 2;
-  if (CDR (0) != 3) return 3;
-
-  g_cells[0].type = TNUMBER;
-  g_cells[0].car = 0;
-  g_cells[0].cdr = 0;
-  g_cells[1].type = TNUMBER;
-  g_cells[1].car = 0;
-  g_cells[1].cdr = 0;
-
-  puts ("t: TYPE (0) != TYPE (1)\n");
-  if (TYPE (0) == TYPE (1)) goto ok;
-  return 1;
- ok:
-
-  g_cells[0].car = 1;
-  g_cells[1].car = 2;
-
-  puts ("t: int c = VALUE (0)\n");
-  int c = CAR (0);
-  if (c != 1) return 1;
-
-  puts ("t: CAAR (0) != 2\n");
-  if (CAAR (0) != 2) return 1;
-
-  puts ("t: 2 != CAAR (0)\n");
-  if (2 != CAAR (0)) return 1;
-
-  g_cells[3].type = 0x64;
-  if (g_cells[3].type != 0x64)
-    return g_cells[3].type;
-
-  TYPE (4) = 4;
-  if (TYPE (4) != 4)
-    return 4;
//  puts ("\n");
//  puts ("t: g_cells[0] = g_cells[1]\n");
//  TYPE (1) = 1;
//  CAR (1) = 2;
//  CDR (1) = 3;
//  g_cells[0] = g_cells[1];
//  if (TYPE (0) != 1) return 1;
//  if (CAR (0) != 2) return 2;
//  if (CDR (0) != 3) return 3;
+
//  puts ("t: g_cells[i] = g_cells[j]\n");
//  int i = 0;
//  int j = 1;
//  TYPE (1) = 4;
//  CAR (1) = 5;
//  CDR (1) = 6;
//  g_cells[i] = g_cells[j];
//  if (TYPE (0) != 4) return 1;
//  if (CAR (0) != 5) return 2;
//  if (CDR (0) != 6) return 3;
+
//  puts ("t: g_cells[0+add(0,0] = g_cells[0+inc(0)]\n");
//  TYPE (1) = 1;
//  CAR (1) = 2;
//  CDR (1) = 3;
//  g_cells[0+add(0, 0)] = g_cells[0+inc(0)];
//  if (TYPE (0) != 1) return 1;
//  if (CAR (0) != 2) return 2;
//  if (CDR (0) != 3) return 3;
+
//  g_cells[0].type = TNUMBER;
//  g_cells[0].car = 0;
//  g_cells[0].cdr = 0;
//  g_cells[1].type = TNUMBER;
//  g_cells[1].car = 0;
//  g_cells[1].cdr = 0;
+
//  puts ("t: TYPE (0) != TYPE (1)\n");
//  if (TYPE (0) == TYPE (1)) goto ok;
//  return 1;
// ok:
+
//  g_cells[0].car = 1;
//  g_cells[1].car = 2;
+
//  puts ("t: int c = VALUE (0)\n");
//  int c = CAR (0);
//  if (c != 1) return 1;
+
//  puts ("t: CAAR (0) != 2\n");
//  if (CAAR (0) != 2) return 1;
+
//  puts ("t: 2 != CAAR (0)\n");
//  if (2 != CAAR (0)) return 1;
+
//  g_cells[3].type = 0x64;
//  if (g_cells[3].type != 0x64)
//    return g_cells[3].type;
+
//  TYPE (4) = 4;
//  if (TYPE (4) != 4)
//    return 4;
   
-  CDR (3) = 0x22;
-  CDR (4) = 0x23;
-  if (CDR (3) != 0x22)
-    return CDR (3);
//  CDR (3) = 0x22;
//  CDR (4) = 0x23;
//  if (CDR (3) != 0x22)
//    return CDR (3);
 
-  puts ("t: g_fun.arity != 1;\n");
-  if (g_fun.arity != 1) return 1;
//  puts ("t: g_fun.arity != 1;\n");
//  if (g_fun.arity != 1) return 1;
 
-  puts ("t: g_fun.function != exit;\n");
-  if (g_fun.function != &exit) return 1;
//  puts ("t: g_fun.function != exit;\n");
//  if (g_fun.function != &exit) return 1;
 
-  puts ("t: struct fun = {&exit,1,\"exit\"};\n");
-  struct function fun = {&exit,1,"exit"};
//  puts ("t: struct fun = {&exit,1,\"exit\"};\n");
//  struct function fun = {&exit,1,"exit"};
 
-  puts ("t: fun.arity != 1;\n");
-  if (fun.arity != 1) return 1;
//  puts ("t: fun.arity != 1;\n");
//  if (fun.arity != 1) return 1;
 
-  puts ("t: fun.function != exit;\n");
-  if (fun.function != &exit) return 1;
//  puts ("t: fun.function != exit;\n");
//  if (fun.function != &exit) return 1;
 
-  puts ("t: puts (fun.name)\n");
-  if (strcmp (fun.name, "exit")) return 1;
//  puts ("t: puts (fun.name)\n");
//  if (strcmp (fun.name, "exit")) return 1;
 
-  puts ("t: puts (g_fun.name)\n");
-  if (strcmp (g_fun.name, "fun")) return 1;
//  puts ("t: puts (g_fun.name)\n");
//  if (strcmp (g_fun.name, "fun")) return 1;
 
-  puts ("t: g_functions[g_function++] = g_foo;\n");
-  g_functions[g_function++] = g_foo;
//  puts ("t: g_functions[g_function++] = g_foo;\n");
//  g_functions[g_function++] = g_foo;
 
-  puts ("t: pbar->arity == 1\n");
-  struct function* barp = &g_bar;
-  if (barp->arity != 1) return 1;
//  puts ("t: pbar->arity == 1\n");
//  struct function* barp = &g_bar;
//  if (barp->arity != 1) return 1;
 
-  int fn = 0;
-  puts ("t: g_functions[g_cells[fn].cdr].arity\n");
-  if (g_functions[g_cells[fn].cdr].arity) return 1;
-  if (g_functions[g_cells[fn].cdr].arity != 0) return 1;
//  int fn = 0;
//  puts ("t: g_functions[g_cells[fn].cdr].arity\n");
//  if (g_functions[g_cells[fn].cdr].arity) return 1;
//  if (g_functions[g_cells[fn].cdr].arity != 0) return 1;
 
-  int (*functionx) (void) = 0;
-  functionx = g_functions[0].function;
-  puts ("t: functionx == foo\n");
-  if (functionx != foo) return 11;
//  int (*functionx) (void) = 0;
//  functionx = g_functions[0].function;
//  puts ("t: functionx == foo\n");
//  if (functionx != foo) return 11;
 
-  puts ("t: g_functions[0].name\n");
-  if (strcmp (g_functions[0].name, "foo")) return 1;
//  puts ("t: g_functions[0].name\n");
//  if (strcmp (g_functions[0].name, "foo")) return 1;
 
-  puts ("t: (functionx) () == foo\n");
-  if ((functionx) () != 0) return 12;
//  puts ("t: (functionx) () == foo\n");
//  if ((functionx) () != 0) return 12;
 
-  puts ("t: g_functions[<foo>].arity\n");
-  if (g_functions[0].arity != 0) return 17;
//  puts ("t: g_functions[<foo>].arity\n");
//  if (g_functions[0].arity != 0) return 17;
 
-  fn++;
-  g_functions[fn] = g_bar;
-  g_cells[fn].cdr = fn;
-  if (g_cells[fn].cdr != fn) return 13;
//  fn++;
//  g_functions[fn] = g_bar;
//  g_cells[fn].cdr = fn;
//  if (g_cells[fn].cdr != fn) return 13;
 
-  puts ("t: g_functions[g_cells[fn].cdr].function\n");
-  functionx = g_functions[g_cells[fn].cdr].function;
//  puts ("t: g_functions[g_cells[fn].cdr].function\n");
//  functionx = g_functions[g_cells[fn].cdr].function;
 
-  puts ("t: g_functions[1].name\n");
-  if (strcmp (g_functions[1].name, "bar")) return 1;
//  puts ("t: g_functions[1].name\n");
//  if (strcmp (g_functions[1].name, "bar")) return 1;
 
-  puts ("t: functionx == bar\n");
-  if (functionx != bar) return 15;
//  puts ("t: functionx == bar\n");
//  if (functionx != bar) return 15;
 
-  puts ("t: (functiony) (1) == bar\n");
-  int (*functiony) (int) = 0;
-  functiony = g_functions[g_cells[fn].cdr].function;
-  if ((functiony) (1) != 0) return 16;
//  puts ("t: (functiony) (1) == bar\n");
//  int (*functiony) (int) = 0;
//  functiony = g_functions[g_cells[fn].cdr].function;
//  if ((functiony) (1) != 0) return 16;
 
-  puts ("t: g_functions[<bar>].arity\n");
-  if (g_functions[fn].arity != 1) return 18;
//  puts ("t: g_functions[<bar>].arity\n");
//  if (g_functions[fn].arity != 1) return 18;
 
-  // fake name
-  scm_fun.car = 33;
-  scm_fun.cdr = g_function;
-  //g_functions[g_function++] = g_fun;
+ //  // fake name
+ //  scm_fun.car = 33;
+ //  scm_fun.cdr = g_function;
+ //  //g_functions[g_function++] = g_fun;
+  g_function++;
+  puts ("fun");
   g_functions[g_function] = g_fun;
-  cell_fun = g_free++;
-  g_cells[cell_fun] = scm_fun;
+  // cell_fun = g_free++;
+  // g_cells[cell_fun] = scm_fun;
 
-  puts ("t: TYPE (cell_fun)\n");
-  if (TYPE (cell_fun) != TFUNCTION) return 1;
+  // puts ("t: TYPE (cell_fun)\n");
+  // if (TYPE (cell_fun) != TFUNCTION) return 1;
 
-  puts ("t: CAR (cell_fun)\n");
-  if (CAR (cell_fun) != 33) return 1;
+  // puts ("t: CAR (cell_fun)\n");
+  // if (CAR (cell_fun) != 33) return 1;
 
-  puts ("t: CDR (cell_fun)\n");
-  if (CDR (cell_fun) != g_function) return 1;
+  // puts ("t: CDR (cell_fun)\n");
+  // if (CDR (cell_fun) != g_function) return 1;
 
   return 0;
 }
index 9bd8a8d84c9bd55dfe239057ff96871da59d82f2..469e17ecf41fcf1c1e60e4147867c8cc59bae1e0 100644 (file)
@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * Mes --- Maxwell Equations of Software
- * Copyright © 2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of Mes.
  *
@@ -34,13 +34,14 @@ test ()
   sprintf (buf, "c=%c\n", c);
   if (strcmp (buf, "c=m\n")) return 1;
 
+  if (i != 3) return 15;
   printf ("i=%d\n", i);
   sprintf (buf, "i=%d\n", i);
-  if (strcmp (buf, "i=3\n")) return 1;
+  if (strcmp (buf, "i=3\n")) return 2;
 
   printf ("s=%s\n", s);
   sprintf (buf, "s=%s\n", s);
-  if (strcmp (buf, "s=mes\n")) return 1;
+  if (strcmp (buf, "s=mes\n")) return 3;
 
   return 0;
 }
index 2fbc7daaecc0f7d3ddeca9c59e3497616ee5f052..86118f84931d4db90c5aa8afc3d905d9f833ebb1 100644 (file)
@@ -69,6 +69,8 @@ test ()
   char *strings[] = { "one\n", "two\n", "three\n", NULL };
   char **p = strings;
   while (*p) puts (*p++);
+  if (strcmp (strings[1], "two\n"))
+    return 3;
 
   strcpy (f.name, "hallo\n");
   puts (f.name);
index 3418be72b00e1939ad33eb97b2e98ccef856c3ea..6198ee884f50be588a41f6e47d7116e63d0f80ab 100644 (file)
@@ -54,9 +54,9 @@ test ()
   struct anon a = {3,4};
   a.baz = 4; // FIXME
   printf ("a.bar=%d\n", a.bar);
-  if (a.bar != 3) return 1;
+  if (a.bar != 3) return 3;
   printf ("a.baz=%d\n", a.baz);
-  if (a.baz != 4) return 1;
+  if (a.baz != 4) return 4;
   
   return 0;
 }
diff --git a/scaffold/tests/90-goto-var.c b/scaffold/tests/90-goto-var.c
new file mode 100644 (file)
index 0000000..d89276a
--- /dev/null
@@ -0,0 +1,13 @@
+
+int
+main ()
+{
+  static void *lbl = &&lbl_b;
+  
+  goto *lbl;
+ lbl_a:
+  return 1;
+lbl_b:
+  return 0;
+}
+
diff --git a/scaffold/tests/91-goto-array.c b/scaffold/tests/91-goto-array.c
new file mode 100644 (file)
index 0000000..a6050f4
--- /dev/null
@@ -0,0 +1,34 @@
+#include <stdio.h>
+
+int main(void) {
+       static void *lbls[] = { &&lbl_h, &&lbl_e, &&lbl_l, &&lbl_l, &&lbl_o, &&lbl_quit };
+       static void **lbl = lbls;
+       
+       goto **lbl;
+
+lbl_e:
+       printf("e");
+       lbl++;
+       goto **lbl;
+
+lbl_o:
+       printf("o");
+       lbl++;
+       goto **lbl;
+lbl_h:
+       printf("h");
+       lbl++;
+       goto **lbl;
+
+lbl_l:
+       printf("l");
+       lbl++;
+       goto **lbl;
+
+lbl_quit:
+       puts("");
+       return 0;
+
+}
+
+
index 2c737708c48a58350fae3be2a46074b32bf4e733..fe6bf40ac4d9406c490fa78b54088ef9f7aa92a1 100644 (file)
@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * Mes --- Maxwell Equations of Software
- * Copyright © 2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of Mes.
  *
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
-#include "30-test.i"
 
-char g_arena[4] = "XXX";
-char *g_chars = g_arena;
+int puts (char const*);
+#include <string.h>
+char global_arena[10];
+int global_i = 1;
+int global_unitialized;
+char* global_string = "foo";
+char global_array[8] = "XXX";
+char *global_chars = global_array;
+typedef int SCM;
+enum type_t {TCHAR};
+char *env[] = {"foo", "bar", "baz", 0};
+char *list[2] = {"foo\n", "bar\n"};
+
+struct foo {int length; char* string;};
+struct foo f = {3, "foo"};
+struct foo g_foes[2];
+int g_foe;
+
+struct anon {struct {int bar; int baz;};};
+
+struct here {int and;} there;
 
 int
-test ()
+main (int argc, char* argv[])
 {
-  puts ("X\n");
-  if (*g_chars != 'X') return 1;
-  g_arena[0] = 'A';
-  puts ("A\n");
-  if (*g_chars != 'A') return 1;
-
-  puts ("*x A\n");
-  char *x = g_arena;
-  if (*x != 'A') return 1;
-
-  puts ("*x++ A\n");
-  if (*x++ != 'A') return 1;
-
-  puts ("t: *x++ != 'C'\n");
-  *x++ = 'C';
-  if (g_chars[1] != 'C') return 1;
+  int i;
+  int j = 1;
+  int k, l = 1;
+  if (j != 1)
+    return 1;
+  if (l != 1)
+    return 2;
+  if (global_i != 1)
+    return 3;
+  global_arena[1] = 0;
+  if (global_i != 1)
+    return 4;
+  if (global_unitialized != 0)
+    return 5;
+  if (strcmp (global_string, "foo"))
+    return 6;
+  char *s = "bar";
+  if (strcmp (s, "bar"))
+    return 7;
+  if (*global_array != 'X')
+    return 8;
+  if (*global_chars != 'X')
+    return 9;
+  SCM x = 0;
+  if (x != 0)
+    return 9;
+  if (TCHAR != 0)
+    return 11;
+  if (strncmp (argv[0], "scaffold/test", 5))
+    return 12;
+  if (strcmp (env[0], "foo"))
+    return 13;
+  if (strcmp (env[2], "baz"))
+    return 14;
+  if (env[3])
+    return 15;
+  if (f.length != 3)
+    return 16;
+  if (strcmp (f.string, "foo"))
+    return 17;
+  struct foo g = {4, "baar"};
+  if (g.length != 4)
+    return 16;
+  if (strcmp (g.string, "baar"))
+    return 18;
+  struct foo f = {3, "foo"};
+  g_foes[0] = f;
+  g_foes[1] = f;
+  if (g_foe)
+    return 19;
+  char *strings[] = { "one\n", "two\n", "three\n", 0 };
+  char **p = strings;
+  while (*p) puts (*p++);
+  if (strcmp (strings[1], "two\n"))
+    return 20;
+  p = list;
+  struct anon a = {3,4};
+  eputs ("bar:"); eputs (itoa (a.bar)); eputs ("\n");
+  eputs ("baz:"); eputs (itoa (a.baz)); eputs ("\n");
+  if (a.bar != 3) return 1;
+  if (a.baz != 4) return 2;
+
+  i = 1;
+  int lst[6] = {-1, 1 - 1, i, 2, 3};
+  for (int i = 0; i < 4; i++)
+    {
+      puts ("i: "); puts (itoa (lst[i])); puts ("\n");
+      if (lst[i+1] != i)
+        return i;
+    }
 
   return 0;
 }