mescc: Run mini-mes.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 29 Jan 2017 14:22:39 +0000 (15:22 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sun, 29 Jan 2017 14:22:39 +0000 (15:22 +0100)
* .gitignore: Ignore tiny-mes and tiny .mo's.
* doc/examples/tiny-mes.c: Simplify.
* doc/examples/mini-mes.c: Use simplifications from tiny-mes.
* doc/examples/t.c (read_test, struct_test): New functions.
  (test): Add tests for arena, g_cells globals.
* module/mes/elf-util.mes (dec->hex): New function.
  (lambda/label->list): Add text-address parameter.  Update callers.
* module/language/c99/compiler.mes (make, info, clone): Add init field.
  (.init): New function.
  (ident->accu): Add exceptions for globals.
* module/mes/elf-util.scm: Export it.
* module/mes/libc-i386.mes (i386:accu->base-ref,
  i386:byte-accu->base-ref, i386:accu->base-ref+n,
  i386:accu->global-ref, i386:global-ref->accu, i386:global-ref->base,
  i386:global-add, i386:global->accu):, i386:local-ref->accu,
  i386:local-ptr->accu, i386:local-ptr->base): New functions.
* module/mes/libc-i386.scm: Export them.

.gitignore
HACKING
module/language/c99/compiler.mes
module/mes/elf-util.mes
module/mes/elf-util.scm
module/mes/elf.mes
module/mes/libc-i386.mes
module/mes/libc-i386.scm
scaffold/mini-mes.c
scaffold/t.c
scaffold/tiny-mes.c

index 4feb23978d27e5a99bc56bdd5c8de58c0f697988..5bc1b3e64f62ebf64b0b9a2f53c7e782bf581fb4 100644 (file)
@@ -15,6 +15,9 @@
 /mes
 /micro-mes
 /mini-mes
+/tiny-mes
+/module/mes/hack-32.mo
+/module/mes/read-0-32.mo
 /module/mes/read-0.mo
 /out
 ?
diff --git a/HACKING b/HACKING
index 261cb9fab5784cbc573406b1b6b0769c8f219809..38cf92dd54e9dc75358ee6b44eeeff7cef9144fe 100644 (file)
--- a/HACKING
+++ b/HACKING
@@ -107,3 +107,12 @@ sc: http://sph.mn/content/3d3
 *** [[http://www.scheme-reports.org/][Scheme Reports]] 
 *** [[ftp://publications.ai.mit.edu/ai-publications/pdf/AIM-349.pdf][Scheme - Report on Scheme]]
 *** [[ftp://publications.ai.mit.edu/ai-publications/pdf/AIM-452.pdf][RRS - Revised Report on Scheme]]
+
+** tiny schemes
+http://forum.osdev.org/viewtopic.php?f=15&t=19937
+
+http://www.stripedgazelle.org/joey/dreamos.html
+http://armpit.sourceforge.net/
+http://common-lisp.net/project/movitz/movitz.html
+
+<civodul> janneke: https://github.com/namin/inc looks interesting  [15:18]
index c7c91fc2d904514376b136a670e615c33063f170..0b7b5dbc083f7abdf52f82aec1583d9fb3bb9dc9 100644 (file)
@@ -25,6 +25,8 @@
 
 ;;; Code:
 
+;;(define barf #f)
+
 (cond-expand
  (guile-2
   (set-port-encoding! (current-output-port) "ISO-8859-1"))
@@ -62,7 +64,7 @@
 
 (define (write-any x)
   (write-char (cond ((char? x) x)
-                    ((and (number? x) (< (+ x 256) 0)) (format (current-error-port) "***BROKEN*** x=~a\n" x) (integer->char #xaa))
+                    ((and (number? x) (< (+ x 256) 0)) (format (current-error-port) "***BROKEN*** x=~a ==> ~a\n" x (dec->hex x)) (integer->char #xaa))
                     ((number? x) (integer->char (if (>= x 0) x (+ x 256))))
                     ((procedure? x)
                      (stderr "write-any: proc: ~a\n" x)
     ((param-decl _ (param-declr (ptr-declr (pointer) (ident ,name)))) name)
     ((param-decl _ (param-declr (ptr-declr (pointer) (array-of (ident ,name))))) name)
     (_
-     (format (current-error-port) "SKIP .name =~a\n" o))))
+     (format (current-error-port) "SKIP: .name =~a\n" o))))
+
+(define (.type o)
+  (pmatch o
+    ((param-decl (decl-spec-list (type-spec ,type)) _) (decl->type type))
+    ((param-decl ,type _) type)
+    (_
+     (format (current-error-port) "SKIP: .type =~a\n" o))))
 
 (define (.statements o)
   (pmatch o
 (define <constants> '<constants>)
 (define <functions> '<functions>)
 (define <globals> '<globals>)
+(define <init> '<init>)
 (define <locals> '<locals>)
 (define <function> '<function>)
 (define <text> '<text>)
 
-(define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (function #f) (text '()))
+(define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (init '()) (locals '()) (function #f) (text '()))
   (pmatch o
     (<info> (list <info>
                   (cons <types> types)
                   (cons <constants> constants)
                   (cons <functions> functions)
                   (cons <globals> globals)
+                  (cons <init> init)
                   (cons <locals> locals)
                   (cons <function> function)
                   (cons <text> text)))))
   (pmatch o
     ((<info> . ,alist) (assq-ref alist <globals>))))
 
+(define (.init o)
+  (pmatch o
+    ((<info> . ,alist) (assq-ref alist <init>))))
+
 (define (.locals o)
   (pmatch o
     ((<info> . ,alist) (assq-ref alist <locals>))))
                (constants (.constants o))
                (functions (.functions o))
                (globals (.globals o))
+               (init (.init o))
                (locals (.locals o))
                (function (.function o))
                (text (.text o)))
                           (constants constants)
                           (functions functions)
                           (globals globals)
+                          (init init)
                           (locals locals)
                           (function function)
                           (text text))
-                         (make <info> #:types types #:constants constants #:functions functions #:globals globals #:locals locals #:function function #:text text))))))
+                         (make <info> #:types types #:constants constants #:functions functions #:globals globals #:init init #:locals locals #:function function #:text text))))))
 
-(define (push-global-ref globals)
+(define (push-global-address globals)
   (lambda (o)
-    (lambda (f g t d)
-      (i386:push-global-ref (+ (data-offset o g) d)))))
+     (lambda (f g ta t d)
+      (i386:push-global-address (+ (data-offset o g) d)))))
 
 (define (push-global globals)
   (lambda (o)
-    (lambda (f g t d)
+    (lambda (f g ta t d)
       (i386:push-global (+ (data-offset o g) d)))))
 
 (define push-global-de-ref push-global)
 
-(define (push-ident globals locals)
+(define (string->global string)
+  (make-global string "string" 0 (append (string->list string) (list #\nul))))
+
+(define (ident->global name type pointer value)
+  (make-global name type pointer (int->bv32 value)))
+
+(define (make-local name type pointer id)
+  (cons name (list type pointer id)))
+(define local:type car)
+(define local:pointer cadr)
+(define local:id caddr)
+
+(define (push-ident info)
   (lambda (o)
-    (let ((local (assoc-ref locals o)))
-      (if local (i386:push-local local)
-          ((push-global globals) o))))) ;; FIXME: char*/int
+    (let ((local (assoc-ref (.locals info) o)))
+      (if local (i386:push-local (local:id local))
+          ((push-global (.globals info)) o))))) ;; FIXME: char*/int
 
-(define (push-ident-ref globals locals)
+(define (push-ident-address info)
   (lambda (o)
-    (let ((local (assoc-ref locals o)))
-      (if local (i386:push-local-ref local)
-          ((push-global-ref globals) o)))))
+    (let ((local (assoc-ref (.locals info) o)))
+      (if local (i386:push-local-address (local:id local))
+          ((push-global-address (.globals info)) o)))))
 
-(define (push-ident-de-ref globals locals)
+(define (push-ident-de-ref info)
   (lambda (o)
-    (let ((local (assoc-ref locals o)))
-      (if local (i386:push-local-de-ref local)
-          ((push-global-de-ref globals) o)))))
+    (let ((local (assoc-ref (.locals info) o)))
+      (if local (i386:push-local-de-ref (local:id local))
+          ((push-global-de-ref (.globals info)) o)))))
 
 (define (expr->arg info) ;; FIXME: get Mes curried-definitions
   (lambda (o)
     (pmatch o
       ((p-expr (fixed ,value)) (cstring->number value))
       ((neg (p-expr (fixed ,value))) (- (cstring->number value)))
-      ((p-expr (string ,string)) ((push-global-ref (.globals info)) string))
+      ((p-expr (string ,string)) ((push-global-address info) string))
       ((p-expr (ident ,name))
-       ((push-ident (.globals info) (.locals info)) name))
+       ((push-ident info) name))
 
-      ((array-ref (p-expr (fixed ,value)) (p-expr (ident ,name)))
-       (let ((value (cstring->number value))
+      ;; g_cells[0]
+      ((array-ref (p-expr (fixed ,index)) (p-expr (ident ,array)))
+       (let ((index (cstring->number index))
              (size 4)) ;; FIXME: type: int
          (append
-          ((ident->base info) name)
+          ((ident->base info) array)
           (list
-           (lambda (f g t d)
+           (lambda (f g ta t d)
              (append
-              (i386:value->accu (* size value)) ;; FIXME: type: int
+              (i386:value->accu (* size index)) ;; FIXME: type: int
               (i386:base-mem->accu)             ;; FIXME: type: int
               (i386:push-accu)                  ;; hmm
               ))))))
 
+      ;; g_cells[i]
+      ((array-ref (p-expr (ident ,index)) (p-expr (ident ,array)))
+       (let ((index (cstring->number index))
+             (size 4)) ;; FIXME: type: int
+         (append
+          ((ident->base info) array)
+          ((ident->accu info) array)
+          (list (lambda (f g ta t d)
+                  ;;(i386:byte-base-mem->accu)
+                  (i386:base-mem->accu)
+                  ))
+          (list
+           (lambda (f g ta t d)
+             (append
+              (i386:push-accu)))))))
+
       ((de-ref (p-expr (ident ,name)))
-       (lambda (f g t d)
-         ((push-ident-de-ref (.globals info) (.locals info)) name)))
+       (lambda (f g ta t d)
+         ((push-ident-de-ref info) name)))
 
       ((ref-to (p-expr (ident ,name)))
-       (lambda (f g t d)
-         ((push-ident-ref (.globals info) (.locals info)) name)))
+       (lambda (f g ta t d)
+         ((push-ident-address info) name)))
 
       ;; f (car (x))
       ((fctn-call . ,call)
               (info ((ast->info empty) o)))
          (append (.text info)
                  (list
-                  (lambda (f g t d)
+                  (lambda (f g ta t d)
                     (i386:push-accu))))))
 
       ;; f (CAR (x))
        (let* ((empty (clone info #:text '()))
               (expr ((expr->accu empty) `(d-sel ,@d-sel))))
          (append (.text expr)
-                 (list (lambda (f g t d)
+                 (list (lambda (f g ta t d)
                          (i386:push-accu))))))
 
       ;; f (0 + x)
              ,cast)
        ((expr->arg info) cast))
       (_
-       (format (current-error-port) "SKIP expr->arg=~s\n" o)     
+       (format (current-error-port) "SKIP: expr->arg=~s\n" o)
+       barf
        0))))
 
+;; FIXME: see ident->base
 (define (ident->accu info)
   (lambda (o)
-    (let ((local (assoc-ref (.locals info) o)))
+    (let ((local (assoc-ref (.locals info) o))
+          (global (assoc-ref (.globals info) o))
+          (constant (assoc-ref (.constants info) o)))
+      ;; (stderr "ident->accu: local[~a]: ~a\n" o (and local (local:id local)))
+      ;; (stderr "ident->accu: global[~a]: ~a\n" o global)
+      ;; (stderr "globals: ~a\n" (.globals info))
+      ;; (if (and (not global) (not (local:id local)))
+      ;;     (stderr "globals: ~a\n" (map car (.globals info))))
       (if local
-          (list (lambda (f g t d)
-                  (if (equal? o "c1")
-                      (i386:byte-local->accu local) ;; FIXME
-                      (i386:local->accu local))))
-          (list (lambda (f g t d)
-                  (i386:global->accu (+ (data-offset o g) d))))))))
+          (let ((ptr (local:pointer local)))
+            (stderr "ident->accu PTR[~a]: ~a\n" o ptr)
+            (cond ((equal? o "c1")
+                   (list (lambda (f g ta t d)
+                           (i386:byte-local->accu (local:id local))))) ;; FIXME type
+                  ((equal? o "functionx")
+                   (list (lambda (f g ta t d)
+                           (i386:local->accu (local:id local))))) ;; FIXME type
+                  (else
+                   (case ptr
+                     ((-1) (list (lambda (f g ta t d)
+                                   (i386:local-ptr->accu (local:id local)))))
+                     (else (list (lambda (f g ta t d)
+                                   (i386:local->accu (local:id local)))))))))
+          (if global
+              (let ((ptr (ident->pointer info o)))
+                (stderr "ident->accu PTR[~a]: ~a\n" o ptr)
+                (case ptr
+                  ((-1) (list (lambda (f g ta t d)
+                                (i386:global->accu (+ (data-offset o g) d)))))
+                  (else (list (lambda (f g ta t d)
+                                (i386:global-address->accu (+ (data-offset o g) d)))))))
+              (if constant
+                  (list (lambda (f g ta t d)
+                          (i386:value->accu constant)))
+                  (list (lambda (f g ta t d)
+                          (i386:global->accu (+ ta (function-offset o f)))))))))))
+
+(define (value->accu v)
+  (list (lambda (f g ta t d)
+          (i386:value->accu v))))
 
 (define (accu->ident info)
   (lambda (o)
     (let ((local (assoc-ref (.locals info) o)))
       (if local
-          (list (lambda (f g t d)
-                  (i386:accu->local local)))
-          (list (lambda (f g t d)
+          (list (lambda (f g ta t d)
+                  (i386:accu->local (local:id local))))
+          (list (lambda (f g ta t d)
                   (i386:accu->global (+ (data-offset o g) d))))))))
 
-(define (base->ident-ref info)
+(define (base->ident info)
   (lambda (o)
     (let ((local (assoc-ref (.locals info) o)))
       (if local
-          (list (lambda (f g t d)
+          (list (lambda (f g ta t d)
+                  (i386:base->local (local:id local))))
+          (list (lambda (f g ta t d)
+                  (i386:base->global (+ (data-offset o g) d))))))))
+
+(define (base->ident-address info)
+  (lambda (o)
+    (let ((local (assoc-ref (.locals info) o)))
+      (if local
+          (list (lambda (f g ta t d)
                   (append
-                   (i386:local->accu local)
-                   (i386:byte-base->accu-ref))))
-          TODO:base->ident-ref-global))))
+                   (i386:local->accu (local:id local))
+                   (i386:byte-base->accu-address))))
+          TODO:base->ident-address-global))))
 
 (define (value->ident info)
   (lambda (o value)
     (let ((local (assoc-ref (.locals info) o)))
       (if local
-          (list (lambda (f g t d)
-                  (i386:value->local local value)))
-          (list (lambda (f g t d)
+          (list (lambda (f g ta t d)
+                  (i386:value->local (local:id local) value)))
+          (list (lambda (f g ta t d)
                   (i386:value->global (+ (data-offset o g) d) value)))))))
 
-(define (ident-address->accu info)
-  (lambda (o)
+(define (ident-add info)
+  (lambda (o n)
     (let ((local (assoc-ref (.locals info) o)))
       (if local
-          (list (lambda (f g t d)
-                  (i386:local-address->accu local)))
-          (list (lambda (f g t d)
-                  (i386:global->accu (+ (data-offset o g) d))))))))
+          (list (lambda (f g ta t d)
+                  (i386:local-add (local:id local) n)))
+          (list (lambda (f g ta t d)
+                  (i386:global-add (+ (data-offset o g) d) n)))))))
 
+;; FIXME: see ident->accu
 (define (ident->base info)
   (lambda (o)
     (let ((local (assoc-ref (.locals info) o)))
+      (stderr "ident->base: local[~a]: ~a\n" o (and local (local:id local)))
       (if local
-          (list (lambda (f g t d)
-                  (i386:local->base local)))
-          (list (lambda (f g t d)
-                  (i386:global->base (+ (data-offset o g) d))))))))
-
-(define (ident-ref->base info)
-  (lambda (o)
-    (let ((local (assoc-ref (.locals info) o)))
-      (if local
-          (list (lambda (f g t d)
-                  (i386:local-ref->base local)))
-          TODO:ident-ref->base))))
+          (list (lambda (f g ta t d)
+                  (i386:local->base (local:id local))))
+          (let ((global (assoc-ref (.globals info) o) ))
+            (if global
+                (let ((ptr (ident->pointer info o)))
+                (stderr "ident->accu PTR[~a]: ~a\n" o ptr)
+                (case ptr
+                  ((-1) (list (lambda (f g ta t d)
+                                (i386:global->base (+ (data-offset o g) d)))))
+                  (else (list (lambda (f g ta t d)
+                                (i386:global-address->base (+ (data-offset o g) d)))))))
+                (let ((constant (assoc-ref (.constants info) o)))
+                  (if constant
+                      (list (lambda (f g ta t d)
+                              (i386:value->base constant)))
+                      (list (lambda (f g ta t d)
+                              (i386:global->base (+ ta (function-offset o f)))))))))))))
 
 (define (expr->accu info)
   (lambda (o)
-    (pmatch o
-      ((p-expr (fixed ,value)) (cstring->number value))
-      ((p-expr (ident ,name)) (car ((ident->accu info) name)))
-      ((fctn-call . _) ((ast->info info) `(expr-stmt ,o)))
-      ((not (fctn-call . _)) ((ast->info info) o))
-      ((sub . _) ((ast->info info) o)) ;; FIXME: expr-stmt
-      ((neg (p-expr (fixed ,value))) (- (cstring->number value)))
-
-      ;; g_cells[10].type
-      ((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))))
-       (let* ((struct-type "scm") ;; FIXME
-              (struct (assoc-ref (.types info) struct-type))
-              (size (length struct))
-              (field-size 4) ;; FIXME:4, not fixed
-              (offset (* field-size (1- (length (member field (reverse struct) (lambda (a b) (equal? a (cdr b))))))))
-              (index (cstring->number index))
-              (text (.text info)))
+    (let ((text (.text info))
+          (locals (.locals info)))
+      ;;(stderr "expr->accu o=~a\n" o)
+      (pmatch o
+        ((p-expr (fixed ,value))
+         (clone info #:text (append text (value->accu (cstring->number value)))))
+        ((p-expr (ident ,name))
+         (clone info #:text (append text ((ident->accu info) name))))
+        ((fctn-call . _) ((ast->info info) `(expr-stmt ,o)))
+        ((not (fctn-call . _)) ((ast->info info) o))
+        ((neg (p-expr (fixed ,value)))
+         (clone info #:text (append text (value->accu (- (cstring->number value))))))
+        
+        ((initzer ,initzer) ((expr->accu info) initzer))
+        ((ref-to (p-expr (ident ,name)))
          (clone info #:text
-                (append text
-                        (list (lambda (f g t d)
+                (append (.text info)
+                        ((ident->accu info) name))))
+
+        ((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident ,name))))))
+         (let* (;;(type (assoc-ref (.types info) (list "struct" name)))
+                (type (list "struct" name))
+                (fields (or (type->description info type) '()))
+                (size (type->size info type)))
+           (stderr "SIZEOF: type=~s => ~s\n" type size)
+           (clone info #:text
+                  (append text
+                        (list (lambda (f g ta t d)
                                 (append
-                                 (i386:value->base index)
-                                 (i386:base->accu)
-                                 (if (> size 1) (i386:accu+accu) '())
-                                 (if (= size 3) (i386:accu+base) '())
-                                 (i386:accu-shl 2))))
+                                 (i386:value->accu size))))))))
+        
+        ((array-ref (p-expr (fixed ,value)) (p-expr (ident ,array)))
+         (let ((value (cstring->number value)))
+           (clone info #:text
+                  (append text
                         ((ident->base info) array)
-                        (list (lambda (f g t d)
-                                (i386:accu+base)))))))
+                        (list (lambda (f g ta t d)
+                                (append
+                                 (i386:value->accu value)
+                                 ;;(i386:byte-base-mem->accu) ;; FIXME: int/char
+                                 (i386:base-mem->accu)
+                                 )))))))
+
+        ;; f.field
+        ((d-sel (ident ,field) (p-expr (ident ,array)))
+         (let* ((type (ident->type info array))
+                (fields (type->description info type))
+                (field-size 4) ;; FIXME:4, not fixed
+                (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
+                (text (.text info)))
+           (clone info #:text
+                  (append text
+                          ((ident->accu info) array)
+                          (list (lambda (f g ta t d)
+                                  (i386:mem+n->accu offset)))))))
+
+        ;; g_cells[10].type
+        ((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))))
+         (let* ((type (ident->type info array))
+                (fields (or (type->description info type) '()))
+                (size (type->size info type))
+                (count (length fields))
+                (field-size 4) ;; FIXME:4, not fixed
+                (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
+                (index (cstring->number index))
+                (text (.text info)))
+           (clone info #:text
+                  (append text
+                          (list (lambda (f g ta t d)
+                                  (append
+                                   (i386:value->base index)
+                                   (i386:base->accu)
+                                   (if (> count 1) (i386:accu+accu) '())
+                                   (if (= count 3) (i386:accu+base) '())
+                                   (i386:accu-shl 2))))
+                          ((ident->base info) array)
+                          (list (lambda (f g ta t d)
+                                  (i386:base-mem+n->accu offset)))))))
+        
+        ;; g_cells[x].type
+        ((d-sel (ident ,field) (array-ref (p-expr (ident ,index)) (p-expr (ident ,array))))
+         (let* ((type (ident->type info array))
+                (fields (or (type->description info type) '()))
+                (size (type->size info type))
+                (count (length fields))
+                (field-size 4) ;; FIXME:4, not fixed
+                (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
+                      (text (.text info)))
+                 (clone info #:text
+                        (append text
+                                ((ident->base info) index)
+                                (list (lambda (f g ta t d)
+                                        (append
+                                         (i386:base->accu)
+                                         (if (> count 1) (i386:accu+accu) '())
+                                         (if (= count 3) (i386:accu+base) '())
+                                         (i386:accu-shl 2))))
+                                ((ident->base info) array)
+                                (list (lambda (f g ta t d)
+                                        (i386:base-mem+n->accu offset)))))))
+
+        ;; g_functions[g_cells[fn].cdr].arity
+        ;; INDEX0: g_cells[fn].cdr
+
+        ;;; index: (d-sel (ident ,cdr) (array-ref (p-expr (ident ,fn)) (p-expr (ident ,g_cells))))
+        ;;((d-sel (ident ,arity) (array-ref (d-sel (ident ,cdr) (array-ref (p-expr (ident ,fn)) (p-expr (ident ,g_cells)))) (p-expr (ident ,g_functions)))))
+        ((d-sel (ident ,field) (array-ref ,index (p-expr (ident ,array))))
+         (let* ((empty (clone info #:text '()))
+                (index ((expr->accu empty) index))
+                (type (ident->type info array))
+                (fields (or (type->description info type) '()))
+                (size (type->size info type))
+                (count (length fields))
+                (field-size 4) ;; FIXME:4, not fixed
+                (rest (or (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))
+                          barf
+                          '()))
+                (offset (* field-size (1- (length rest))))
+                (text (.text info)))
+           ;;(stderr "COUNT=~a\n" count)
+           (clone info #:text
+                  (append text
+                          (.text index)
+                          (list (lambda (f g ta t d)
+                                  (append
+                                   (i386:accu->base)
+                                   (if (> count 1) (i386:accu+accu) '())
+                                   (if (= count 3) (i386:accu+base) '())
+                                   (i386:accu-shl 2))))
+                          ((ident->base info) array)
+                          (list (lambda (f g ta t d)
+                                  (i386:base-mem+n->accu offset)))))))
+        
+        ;;; FIXME: FROM INFO ...only zero?!
+        ((p-expr (fixed ,value))
+         (let ((value (cstring->number value)))
+          (clone info #:text
+                 (append text
+                         (list (lambda (f g ta t d)
+                                 (i386:value->accu value)))))))
 
-      ;; g_cells[x].type
-      ((d-sel (ident ,field) (array-ref (p-expr (ident ,index)) (p-expr (ident ,array))))
-       (let* ((struct-type "scm") ;; FIXME
-              (struct (assoc-ref (.types info) struct-type))
-              (size (length struct))
-              (field-size 4) ;; FIXME:4, not fixed
-              (offset (* field-size (1- (length (member field (reverse struct) (lambda (a b) (equal? a (cdr b))))))))
-              (text (.text info)))
+        ((p-expr (char ,value))
+         (let ((value (char->integer (car (string->list value)))))
+          (clone info #:text
+                 (append text
+                         (list (lambda (f g ta t d)
+                                 (i386:value->accu value)))))))
+
+        ((p-expr (ident ,name))
          (clone info #:text
                 (append text
-                        ((ident->base info) index)
-                        (list (lambda (f g t d)
+                        ((ident->accu info) name))))
+
+        ((de-ref (p-expr (ident ,name)))
+         (stderr "de-ref: ~a\n" name)
+         (clone info #:text
+                (append text
+                        ((ident->accu info) name)
+                        (list (lambda (f g ta t d)
                                 (append
-                                 (i386:base->accu)
-                                 (if (> size 1) (i386:accu+accu) '())
-                                 (if (= size 3) (i386:accu+base) '())
-                                 (i386:accu-shl 2))))
-                        ((ident->base info) array)
-                        (list (lambda (f g t d)
-                                (i386:base-mem+n->accu offset)
-                                ;;(i386:accu+base)
-                                ))))))
+                                 (cond ((equal? name "functionx") (i386:mem->accu))
+                                       (else (i386:byte-mem->accu))))))))) ;; FIXME: type
 
-      (_
-       (format (current-error-port) "SKIP expr->accu=~s\n" o)
-       info)
-      )))
+        ;; GRR --> info again??!?
+        ((fctn-call . ,call)
+         ((ast->info info) `(expr-stmt ,o)))
+
+        ((cond-expr . ,cond-expr)
+         ((ast->info info) `(expr-stmt ,o)))
+
+        ;; FIXME
+        ;;((post-inc ,expr) ((ast->info info) `(expr-stmt ,o)))
+        ((post-inc (p-expr (ident ,name)))
+         (clone info #:text
+                (append text
+                        ((ident->accu info) name)
+                        ((ident-add info) name 1))))
+
+        ;; GRR --> info again??!?
+        ((post-inc ,expr) ((ast->info info) `(expr-stmt ,o)))
+        ((post-dec ,expr) ((ast->info info) `(expr-stmt ,o)))
+        ((pre-inc ,expr) ((ast->info info) `(expr-stmt ,o)))
+        ((pre-dec ,expr) ((ast->info info) `(expr-stmt ,o)))
+
+        ((add (p-expr (ident ,name)) ,b)
+         (let* ((empty (clone info #:text '()))
+                (base ((expr->base empty) b)))
+           (clone info #:text
+                  (append text
+                          (.text base)
+                          ((ident->accu info) name)
+                          (list (lambda (f g ta t d)
+                                  (i386:accu+base)))))))
+
+        ((add ,a ,b)
+         (let* ((empty (clone info #:text '()))
+                (accu ((expr->base empty) a))
+                (base ((expr->base empty) b)))
+           (clone info #:text
+                  (append text
+                          (.text accu)
+                          (.text base)
+                          (list (lambda (f g ta t d)
+                                  (i386:accu+base)))))))        
+
+        ((sub ,a ,b)
+         (let* ((empty (clone info #:text '()))
+                (accu ((expr->base empty) a))
+                (base ((expr->base empty) b)))
+           (clone info #:text
+                  (append text
+                          (.text accu)
+                          (.text base)
+                          (list (lambda (f g ta t d)
+                                  (i386:accu-base)))))))        
+
+        ((lshift ,a (p-expr (fixed ,value)))
+         (let* ((empty (clone info #:text '()))
+                (accu ((expr->base empty) a))
+                (value (cstring->number value)))
+           (clone info #:text
+                  (append text
+                          (.text accu)
+                          (list (lambda (f g ta t d)
+                                  (i386:accu-shl value)))))))
+
+        ((div ,a ,b)
+         (let* ((empty (clone info #:text '()))
+                (accu ((expr->accu empty) a))
+                (base ((expr->base empty) b)))
+           (clone info #:text
+                  (append text
+                          (.text accu)
+                          (.text base)
+                          (list (lambda (f g ta t d)
+                                  (i386:accu/base)))))))
+
+        ;;((cast (type-name (decl-spec-list (type-spec (typename "SCM"))) (abs-declr (declr-fctn (declr-scope (abs-declr (pointer))) (param-list (param-decl (decl-spec-list (type-spec (typename "SCM")))))))) (d-sel (ident "function") (array-ref (d-sel (ident "cdr") (array-ref (p-expr (ident "fn")) (p-expr (ident "g_cells")))) (p-expr (ident "functions"))))))
+        ((cast ,cast ,o)
+         ((expr->accu info) o))
+
+        (_
+         (format (current-error-port) "SKIP: expr->accu=~s\n" o)
+         barf
+         info)))))
+
+(define (expr->base info)
+  (lambda (o)
+    (let ((info ((expr->accu info) o)))
+      (clone info
+             #:text (append
+                     (list (lambda (f g ta t d)
+                             (i386:push-accu)))
+                     (.text info)
+                     (list (lambda (f g ta t d)
+                             (append
+                              (i386:accu->base)
+                              (i386:pop-accu)))))))))
 
 (define (expr->Xaccu info)
   (lambda (o)
     (pmatch o
       ;; g_cells[10].type
       ((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))))
-       (let* ((struct-type "scm") ;; FIXME
-              (struct (assoc-ref (.types info) struct-type))
-              (size (length struct))
+       (let* ((type (ident->type info array))
+              (fields (or (type->description info type) '()))
+              (size (type->size info type))
+              (count (length fields))
               (field-size 4) ;; FIXME:4, not fixed
-              (offset (* field-size (1- (length (member field (reverse struct) (lambda (a b) (equal? a (cdr b))))))))
+              (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
               (index (cstring->number index))
               (text (.text info)))
          (clone info #:text
                 (append text
-                        (list (lambda (f g t d)
+                        (list (lambda (f g ta t d)
                                 (append
                                  (i386:value->base index)
                                  (i386:base->accu)
-                                 (if (> size 1) (i386:accu+accu) '())
-                                 (if (= size 3) (i386:accu+base) '())
+                                 (if (> count 1) (i386:accu+accu) '())
+                                 (if (= count 3) (i386:accu+base) '())
                                  (i386:accu-shl 2))))
+                        ;; de-ref: g_cells, non: arena
+                        ;;((ident->base info) array)
                         ((ident->base info) array)
-                        (list (lambda (f g t d)
-                                (i386:accu+base)))))))
+                        (list (lambda (f g ta t d)
+                                (append
+                                 (i386:accu+base)
+                                 (i386:accu+value offset))))))))
 
       ;; g_cells[x].type
       ((d-sel (ident ,field) (array-ref (p-expr (ident ,index)) (p-expr (ident ,array))))
-       (let* ((struct-type "scm") ;; FIXME
-              (struct (assoc-ref (.types info) struct-type))
-              (size (length struct))
+       (let* ((type (ident->type info array))
+              (fields (or (type->description info type) '()))
+              (size (type->size info type))
+              (count (length fields))
               (field-size 4) ;; FIXME:4, not fixed
-              (offset (* field-size (1- (length (member field (reverse struct) (lambda (a b) (equal? a (cdr b))))))))
+              (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
               (text (.text info)))
          (clone info #:text
                 (append text
                         ((ident->base info) index)
-                        (list (lambda (f g t d)
+                        (list (lambda (f g ta t d)
                                 (append
                                  (i386:base->accu)
-                                 (if (> size 1) (i386:accu+accu) '())
-                                 (if (= size 3) (i386:accu+base) '())
+                                 (if (> count 1) (i386:accu+accu) '())
+                                 (if (= count 3) (i386:accu+base) '())
                                  (i386:accu-shl 2))))
+                        ;; de-ref: g_cells, non: arena
+                        ;;((ident->base info) array)
                         ((ident->base info) array)
-                        (list (lambda (f g t d)
-                                (i386:accu+base)))))))
+                        (list (lambda (f g ta t d)
+                                (append
+                                 (i386:accu+base)
+                                 (i386:accu+value offset))))))))
+
+      ;;((d-sel (ident "cdr") (p-expr (ident "scm_make_cell"))))
+      ((d-sel (ident ,field) (p-expr (ident ,name)))
+       (let* ((type (ident->type info name))
+              (fields (or (type->description info type) '()))
+              (field-size 4) ;; FIXME
+              (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
+              (text (.text info)))
+         (clone info #:text
+                (append text
+                        ((ident->accu info) name)
+                        (list (lambda (f g ta t d)
+                                (i386:accu+value offset)))))))
 
       (_
-       (format (current-error-port) "SKIP expr->Xaccu=~s\n" o)
+       (format (current-error-port) "SKIP: expr->Xaccu=~s\n" o)
+       barf
        info)
       )))
 
-(define (string->global string)
-  (cons string (append (string->list string) (list #\nul))))
-
-(define (ident->global name value)
-  (cons name (int->bv32 value)))
-
 (define (ident->constant name value)
   (cons name value))
 
-(define (ident->type name value)
-  (cons name value))
+(define (make-type name type size description)
+  (cons name (list type size description)))
+
+(define (enum->type name fields)
+  (make-type name 'enum 4 fields))
+
+(define (struct->type name fields)
+  (make-type name 'struct (* 4 (length fields)) fields)) ;; FIXME
+
+(define (decl->type o)
+  (pmatch o
+    ((fixed-type ,type) type)
+    ((struct-ref (ident ,name)) (list "struct" name))
+    ((decl (decl-spec-list (type-spec (struct-ref (ident ,name)))));; "scm"
+     (list "struct" name)) ;; FIXME
+    (_
+     ;;(stderr "SKIP: decl type=~s\n" o)
+     o)))
 
 (define (expr->global o)
   (pmatch o
     ((p-expr (string ,string)) (string->global string))
     (_ #f)))
 
-(define (dec->hex o)
-  (number->string o 16))
-
 (define (byte->hex o)
   (string->number (string-drop o 2) 16))
 
 
 (define (case->jump-info info)
   (define (jump n)
-    (list (lambda (f g t d) (i386:Xjump n))))
+    (list (lambda (f g ta t d) (i386:Xjump n))))
   (define (jump-nz n)
-    (list (lambda (f g t d) (i386:Xjump-nz n))))
+    (list (lambda (f g ta t d) (i386:Xjump-nz n))))
   (define (statement->info info body-length)
     (lambda (o)
       (pmatch o
                 (clause-length (length (text->list clause-text))))
            (clone info #:text (append
                                (.text info)
-                               (list (lambda (f g t d) (i386:accu-cmp-value value)))
+                               (list (lambda (f g ta t d) (i386:accu-cmp-value value)))
                                (jump-nz clause-length)
                                clause-text)
                   #:globals (.globals clause-info)))))
                 (clause-length (length (text->list clause-text))))
            (clone info #:text (append
                                (.text info)
-                               (list (lambda (f g t d) (i386:accu-cmp-value value)))
+                               (list (lambda (f g ta t d) (i386:accu-cmp-value value)))
                                (jump-nz clause-length)
                                clause-text)
                   #:globals (.globals clause-info)))))
              (info (clone info #:text '()))
              (info ((ast->info info) o))
              (jump-text (lambda (body-length)
-                          (list (lambda (f g t d) (type body-length))))))
+                          (list (lambda (f g ta t d) (type body-length))))))
        (lambda (body-length)
          (clone info #:text
                 (append text
                   (append text
                           (.text (a-jump (+ b-length body-length)))
                           (.text (b-jump body-length)))))))
+      ((or ,a ,b)
+       (let* ((text (.text info))
+              (info (clone info #:text '()))
+
+              (a-jump ((test->jump->info info) a))
+              (a-text (.text (a-jump 0)))
+              (a-length (length (text->list a-text)))
+
+              (jump-text (list (lambda (f g ta t d) (i386:Xjump 0))))
+              (jump-length (length (text->list jump-text)))
+
+              (b-jump ((test->jump->info info) b))
+              (b-text (.text (b-jump 0)))
+              (b-length (length (text->list b-text)))
+
+              (jump-text (list (lambda (f g ta t d) (i386:Xjump b-length)))))
+
+         (lambda (body-length)
+           (clone info #:text
+                  (append text
+                          (.text (a-jump jump-length))
+                          jump-text
+                          (.text (b-jump body-length)))))))
       ((array-ref . _) ((jump i386:jump-byte-z) o))
       ((de-ref _) ((jump i386:jump-byte-z) o))
       (_ ((jump i386:jump-z) o)))))
      (cons type name))
     ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ident ,name))))
      (cons type name))
+    ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list (param-decl (decl-spec-list (type-spec (void)))))))))
+     (cons type name)) ;; FIXME function / int
     (_ (stderr "struct-field: no match: ~a" o) barf)))
 
+(define (ast->type o)
+  (pmatch o
+    ((fixed-type ,type)
+     type)
+    ((struct-ref (ident ,type))
+     (list "struct" type))
+    (_ (stderr "SKIP: type=~s\n" o)
+       "int")))
+
+(define i386:type-alist
+  '(("char" . (builtin 1 #f))
+    ("int" . (builtin 4 #f))))
+
+(define (type->size info o)
+  ;; (stderr  "types=~s\n" (.types info))
+  ;; (stderr  "type->size o=~s => ~s\n" o   (cadr (assoc-ref (.types info) o)))
+  (cadr (assoc-ref (.types info) o)))
+
+(define (ident->decl info o)
+  ;; (stderr "ident->decl o=~s\n" o)
+  ;; (stderr "  types=~s\n" (.types info))
+  ;; (stderr "  local=~s\n" (assoc-ref (.locals info) o))
+  ;; (stderr "  global=~s\n" (assoc-ref (.globals info) o))
+  (or (assoc-ref (.locals info) o)
+      (assoc-ref (.globals info) o)
+      (begin
+        (stderr "NO IDENT: ~a\n" (assoc-ref (.functions info) o))
+        (assoc-ref (.functions info) o))))
+
+(define (ident->type info o)
+  (and=> (ident->decl info o) car))
+
+(define (ident->pointer info o)
+  (or (and=> (ident->decl info o) global:pointer) 0))
+
+(define (type->description info o)
+  ;; (stderr  "type->description =~s\n" o)  
+  ;; (stderr  "types=~s\n" (.types info))
+  ;; (stderr  "type->description o=~s ==> ~s\n" o  (caddr (assoc-ref (.types info) o)))
+  ;; (stderr  "  assoc ~a\n" (assoc-ref (.types info) o))
+  (caddr (assoc-ref (.types info) o)))
+
+(define (local? o) ;; formals < 0, locals > 0
+  (positive? (local:id o)))
+
 (define (ast->info info)
   (lambda (o)
     (let ((globals (.globals info))
           (locals (.locals info))
+          (constants (.constants info))
           (text (.text info)))
-      (define (add-local name)
-        (let ((locals (acons name (1+ (length (filter positive? (map cdr locals)))) locals)))
+      (define (add-local locals name type pointer)
+        (let* ((id (1+ (length (filter local? (map cdr locals)))))
+               (locals (cons (make-local name type pointer id) locals)))
           locals))
 
-      ;;(stderr "\nS=~a\n" o)
+      ;; (stderr "\n ast->info=~s\n" o)
       ;; (stderr "  globals[~a=>~a]: ~a\n" (length globals) (length (append-map cdr globals)) (map (lambda (s) (if (string? s) (string-delete #\newline s))) (map car globals)))
       ;; (stderr "  text=~a\n" text)
       ;; (stderr "   info=~a\n" info)
       ;; (stderr "   globals=~a\n" globals)
       (pmatch o
-        (((trans-unit . _) . _) ((ast-list->info info) o))
-        ((trans-unit . ,elements) ((ast-list->info info) elements))
+        (((trans-unit . _) . _)
+         ((ast-list->info info)  o))
+        ((trans-unit . ,elements)
+         ((ast-list->info info) elements))
         ((fctn-defn . _) ((function->info info) o))
         ((comment . _) info)
         ((cpp-stmt (define (name ,name) (repl ,value)))
-         (stderr "SKIP: #define ~s ~s\n" name value)
          info)
 
-        ;; ;
+        ((cast (type-name (decl-spec-list (type-spec (void)))) _)
+         info)
+
+        ;; FIXME: expr-stmt wrapper?
+        (trans-unit info)
         ((expr-stmt) info)
+        ((assn-expr . ,assn-expr)
+         ((ast->info info) `(expr-stmt ,o)))
+
+        ((d-sel . ,d-sel)
+         (let ((expr ((expr->accu info) `(d-sel ,@d-sel))))
+           expr))
 
         ((compd-stmt (block-item-list . ,statements)) ((ast-list->info info) statements))
         
         ((expr-stmt (fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)))
          (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
-                                   (clone info #:text (append text (list (lambda (f g t d) (asm->hex arg0))))))
+                                   (clone info #:text (append text (list (lambda (f g ta t d) (asm->hex arg0))))))
              (let* ((globals (append globals (filter-map expr->global expr-list)))
                     (info (clone info #:globals globals))
                     (args (map (expr->arg info) expr-list)))
-               (clone info #:text
-                      (append text (list (lambda (f g t d)
-                                           (apply i386:call (cons* f g t d
-                                                                   (+ t (function-offset name f)) args)))))
-                      #:globals globals))))
+               (if ;;#t ;;(assoc-ref globals name)
+                (not (equal? name "functionx"))
+                (clone info #:text
+                       (append text
+                               (list (lambda (f g ta t d)
+                                       (apply i386:call (cons* f g ta t d
+                                                               (+ t (function-offset name f)) args)))))
+                       #:globals globals)
+                (let* ((empty (clone info #:text '()))
+                       ;;(accu ((ident->accu info) name))
+                       (accu ((expr->accu empty) `(p-expr (ident ,name)))))
+                  (stderr "DINGES: ~a\n" o)
+                  (clone info #:text
+                         (append text
+                                 (list (lambda (f g ta t d)
+                                         '(#x90)))
+                                 ;;accu
+                                 (.text accu)
+                                 (list (lambda (f g ta t d)
+                                         '(#x90)))
+                                 (list (lambda (f g ta t d)
+                                         (apply i386:call-accu (cons* f g ta t d args)))))
+                         #:globals globals))))))
+
+        ;;((expr-stmt (fctn-call (d-sel (ident "function") (array-ref (d-sel (ident "cdr") (array-ref (p-expr (ident "fn")) (p-expr (ident "g_cells")))) (p-expr (ident "g_functions")))) (expr-list))))
+        ((expr-stmt (fctn-call ,function (expr-list . ,expr-list)))
+         (let* ((globals (append globals (filter-map expr->global expr-list)))
+                    (info (clone info #:globals globals))
+                    (args (map (expr->arg info) expr-list))
+                    (empty (clone info #:text '()))
+                    (accu ((expr->accu empty) function)))
+           (clone info #:text
+                  (append text
+                          (list (lambda (f g ta t d)
+                                  '(#x90)))
+                          (.text accu)
+                          (list (lambda (f g ta t d)
+                                  '(#x90)))
+                          (list (lambda (f g ta t d)
+                                  (apply i386:call-accu (cons* f g ta t d args)))))
+                  #:globals globals)))
 
         ((if ,test ,body)
          (let* ((text-length (length text))
                           body-text)
                   #:globals (.globals body-info))))
 
+        ((if ,test ,then ,else)
+         (let* ((text-length (length text))
+
+                (test-jump->info ((test->jump->info info) test))
+                (test+jump-info (test-jump->info 0))
+                (test-length (length (.text test+jump-info)))
+
+                (then-info ((ast->info test+jump-info) then))
+                (text-then-info (.text then-info))
+                (then-text (list-tail text-then-info test-length))
+                (then-jump-text (list (lambda (f g ta t d) (i386:Xjump 0))))
+                (then-jump-length (length (text->list then-jump-text)))
+                (then-length (+ (length (text->list then-text)) then-jump-length))
+
+                (else-info ((ast->info test+jump-info) else))
+                (text-else-info (.text else-info))
+                (else-text (list-tail text-else-info test-length))
+                (else-length (length (text->list else-text)))
+
+                (text+test-text (.text (test-jump->info (+ then-length then-jump-length))))
+                (test-text (list-tail text+test-text text-length))
+                (then-jump-text (list (lambda (f g ta t d) (i386:Xjump else-length)))))
+
+           (clone info #:text
+                  (append text
+                          test-text
+                          then-text
+                          then-jump-text
+                          else-text)
+                  #:globals (.globals then-info)))) ;; FIXME: else-globals
+
         ((expr-stmt (cond-expr ,test ,then ,else))
          (let* ((text-length (length text))
 
                 (then-text (list-tail text-then-info test-length))
                 (then-length (length (text->list then-text)))
 
-                (jump-text (list (lambda (f g t d) (i386:jump 0))))
+                (jump-text (list (lambda (f g ta t d) (i386:Xjump 0))))
                 (jump-length (length (text->list jump-text)))
+
                 (test+then+jump-info
                  (clone then-info
                         #:text (append (.text then-info) jump-text)))
 
                 (text+test-text (.text (test-jump->info (+ then-length jump-length))))
                 (test-text (list-tail text+test-text text-length))
-                (jump-text (list (lambda (f g t d) (i386:jump else-length)))))
+                (jump-text (list (lambda (f g ta t d) (i386:Xjump else-length)))))
 
            (clone info #:text
                   (append text
                   #:globals (.globals else-info))))
 
         ((switch ,expr (compd-stmt (block-item-list . ,cases)))
-         (let* ((accu ((expr->accu info) expr))
-                (expr (if (info? accu) accu ;; AAARGH
-                          (clone info #:text
-                                 (append text (list accu)))))
+         (let* ((expr ((expr->accu info) expr))
                 (empty (clone info #:text '()))
                 (case-infos (map (case->jump-info empty) cases))
                 (case-lengths (map (lambda (c-j) (length (text->list (.text (c-j 0))))) case-infos))
                 (test+jump-info (test-jump->info 0))
                 (test-length (length (text->list (.text test+jump-info))))
 
-                (skip-body-text (list (lambda (f g t d) (i386:jump (+ 2 body-length step-length))))) ;; FIXME: 2
+                (skip-body-text (list (lambda (f g ta t d)
+                                        (i386:Xjump (+ body-length step-length)))))
 
-                (jump-text (list (lambda (f g t d) (i386:jump (- (+ body-length step-length test-length))))))
+                (jump-text (list (lambda (f g ta t d)
+                                   (i386:Xjump (- (+ body-length step-length test-length))))))
                 (jump-length (length (text->list jump-text)))
 
                 (test-text (.text (test-jump->info jump-length))))
                 (test+jump-info (test-jump->info 0))
                 (test-length (length (text->list (.text test+jump-info))))
 
-
-                (skip-body-text (list (lambda (f g t d) (i386:jump (+ 2 body-length))))) ;; FIXME: 2
-
-                (jump-text (list (lambda (f g t d) (i386:jump (- (+ body-length test-length))))))
+                (skip-body-text (list (lambda (f g ta t d)
+                                        (i386:Xjump body-length))))
+                (jump-text (list (lambda (f g ta t d)
+                                   (i386:Xjump (- (+ body-length test-length))))))
                 (jump-length (length (text->list jump-text)))
 
                 (test-text (.text (test-jump->info jump-length))))
            ((ast->info info) statement)))
 
         ((goto (ident ,label))
-         (let ((offset (length (text->list text))))
+         (let ((offset (length (text->list text)))
+               (jump (lambda (n) (i386:Xjump n))))
            (clone info #:text
                   (append text
-                          (list (lambda (f g t d)
-                                  (i386:jump (- (label-offset (.function info) label f) offset))))))))
+                          (list (lambda (f g ta t d)
+                                  (jump (- (label-offset (.function info) label f) offset (length (jump 0))))))))))
 
+        ;;; FIXME: only zero?!
         ((p-expr (ident ,name))
          (clone info #:text
                 (append text
                         ((ident->accu info) name)
-                        (list (lambda (f g t d)
+                        (list (lambda (f g ta t d)
                                 (append
                                  (i386:accu-zero?)))))))
 
          (let ((value (cstring->number value)))
           (clone info #:text
                  (append text
-                         (list (lambda (f g t d)
+                         (list (lambda (f g ta t d)
                                  (append
                                   (i386:value->accu value)
                                   (i386:accu-zero?))))))))
          (clone info #:text
                 (append text
                         ((ident->accu info) name)
-                        (list (lambda (f g t d)
+                        (list (lambda (f g ta t d)
                                 (append
                                  (i386:byte-mem->accu)))))))
 
          (let ((info ((ast->info info) `(expr-stmt ,o))))
            (clone info #:text
                   (append (.text info)
-                          (list (lambda (f g t d)
+                          (list (lambda (f g ta t d)
                                   (i386:accu-zero?)))))))
 
         ;; FIXME
          (clone info #:text
                 (append text
                         ((ident->accu info) name)
-                        (list (lambda (f g t d)
+                        ((ident-add info) name 1)
+                        (list (lambda (f g ta t d)
                                 (append
-                                 (i386:local-add (assoc-ref locals name) 1)
                                  (i386:accu-zero?)))))))
         ((post-inc ,expr) ((ast->info info) `(expr-stmt ,o)))
         ((post-dec ,expr) ((ast->info info) `(expr-stmt ,o)))
 
         ;; i++
         ((expr-stmt (post-inc (p-expr (ident ,name))))
-         (clone info #:text
-                (append text (list (lambda (f g t d)
-                                     (i386:local-add (assoc-ref locals name) 1))))))
+         (clone info #:text (append text ((ident-add info) name 1))))
 
         ;; ++i
         ((expr-stmt (pre-inc (p-expr (ident ,name))))
+         (or (assoc-ref locals name) barf)
          (clone info #:text
-                (append text (list (lambda (f g t d)
-                                     (append
-                                      (i386:local-add (assoc-ref locals name) 1)
-                                      (i386:local->accu (assoc-ref locals name))
-                                      (i386:accu-zero?)))))))
+                (append text
+                        ((ident-add info) name 1)
+                        ((ident->accu info) name)
+                        (list (lambda (f g ta t d)
+                                (append
+                                 ;;(i386:local->accu (local:id (assoc-ref locals name)))
+                                 (i386:accu-zero?)))))))
 
         ;; i--
         ((expr-stmt (post-dec (p-expr (ident ,name))))
+         (or (assoc-ref locals name) barf)
          (clone info #:text
                 (append text
                         ((ident->accu info) name)
-                        (list (lambda (f g t d)
+                        ((ident-add info) name -1)
+                        (list (lambda (f g ta t d)
                                 (append
-                                 (i386:local-add (assoc-ref locals name) -1)
+                                 ;;(i386:local-add (local:id (assoc-ref locals name)) -1)
                                  (i386:accu-zero?)))))))
 
         ;; --i
         ((expr-stmt (pre-dec (p-expr (ident ,name))))
+         (or (assoc-ref locals name) barf)
          (clone info #:text
-                (append text (list (lambda (f g t d)
-                                     (append
-                                      (i386:local-add (assoc-ref locals name) -1)
-                                      (i386:local->accu (assoc-ref locals name))
-                                      (i386:accu-zero?)))))))
+                (append text
+                        ((ident-add info) name -1)
+                        ((ident->accu info) name)
+                        (list (lambda (f g ta t d)
+                                (append
+                                 ;;(i386:local-add (local:id (assoc-ref locals name)) -1)
+                                 ;;(i386:local->accu (local:id (assoc-ref locals name)))
+                                 (i386:accu-zero?)))))))
 
         ((not ,expr)
          (let* ((test-info ((ast->info info) expr)))
            (clone info #:text
                   (append (.text test-info)
-                          (list (lambda (f g t d)
+                          (list (lambda (f g ta t d)
                                   (append
                                    (i386:accu-not)
                                    (i386:accu-zero?)))))
                   #:globals (.globals test-info))))
 
-        ((eq (p-expr (ident ,a)) (p-expr (fixed ,b)))
-         (let ((b (cstring->number b)))
-           (clone info #:text
-                  (append text
-                          ((ident->base info) a)
-                          (list (lambda (f g t d)
-                                  (append
-                                   (i386:value->accu b)
-                                   (i386:sub-base))))))))
-
-        ((eq (p-expr (ident ,a)) (p-expr (char ,b)))
-         (let ((b (char->integer (car (string->list b)))))
-           (clone info #:text
-                  (append text
-                          ((ident->base info) a)
-                          (list (lambda (f g t d)
-                                  (append
-                                   (i386:value->accu b)
-                                   (i386:sub-base))))))))
-
-        ((eq (p-expr (ident ,a)) (neg (p-expr (fixed ,b))))
-         (let ((b (- (cstring->number b))))
-           (clone info #:text
-                  (append text
-                          ((ident->base info) a)
-                          (list (lambda (f g t d)
-                                  (append 
-                                   (i386:value->accu b)
-                                   (i386:sub-base))))))))
-
-        ((eq (fctn-call . ,call) (p-expr (fixed ,b)))
-         (let ((b (cstring->number b))
-               (info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
-           (clone info #:text
-                  (append text
-                          (.text info)
-                          (list (lambda (f g t d)
-                                  (append
-                                   (i386:value->base b)
-                                   (i386:sub-base))))))))
-
-        ((eq (fctn-call . ,call) (p-expr (char ,b)))
-         (let ((b (char->integer (car (string->list b))))
-               (info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
-           (clone info #:text
-                  (append text
-                          (.text info)
-                          (list (lambda (f g t d)
-                                  (append
-                                   (i386:value->base b)
-                                   (i386:sub-base))))))))
-
-        ((cast (type-name (decl-spec-list (type-spec (void)))) _)
-         info)
-
-        ((eq (fctn-call . ,call) (p-expr (ident ,b)))
-         (let ((info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
-           (clone info #:text
-                  (append text
-                          (.text info)
-                          ((ident->base info) b)
-                          (list (lambda (f g t d)
-                                  (append
-                                   (i386:sub-base))))))))
-
-        ((eq (de-ref (p-expr (ident ,a))) (de-ref (p-expr (ident ,b))))
+        ((eq ,a ,b)
+         (let* ((base ((expr->base info) a))
+                (empty (clone base #:text '()))
+                (accu ((expr->accu empty) b)))
            (clone info #:text
                   (append text
-                          ((ident->accu info) a)
-                          (list (lambda (f g t d)
-                                  (append
-                                   (i386:byte-mem->base)
-                                   (i386:local->accu (assoc-ref locals b))
-                                   (i386:byte-mem->accu)
-                                   (i386:byte-test-base)))))))
-
-        ((eq (de-ref (p-expr (ident ,a))) (p-expr (char ,b)))
-         (let ((b (char->integer (car (string->list b)))))
+                          (.text base)
+                          (.text accu)
+                          (list (lambda (f g ta t d)
+                                  (i386:sub-base)))))))
+
+        ((gt ,a ,b)
+         (let* ((base ((expr->base info) a))
+                (empty (clone base #:text '()))
+                (accu ((expr->accu empty) b)))
            (clone info #:text
                   (append text
-                          ((ident->accu info) a)
-                          (list (lambda (f g t d)
-                                  (append
-                                   (i386:byte-mem->base)
-                                   (i386:value->accu b)
-                                   (i386:byte-test-base))))))))
-
-        ((eq (d-sel (ident ,field) . ,d-sel) (p-expr (fixed ,b)))
-         (let* ((expr ((expr->Xaccu info) `(d-sel (ident ,field) ,@d-sel)))
-                (b (cstring->number b))
-
-                (struct-type "scm") ;; FIXME
-                (struct (assoc-ref (.types info) struct-type))
-                (size (length struct))
-                (field-size 4) ;; FIXME:4, not fixed
-                (offset (* field-size (1- (length (member field (reverse struct) (lambda (a b) (equal? a (cdr b)))))))))
-           (clone info #:text (append (.text expr)
-                                      (list (lambda (f g t d)
-                                              (append
-                                               (i386:mem+n->accu offset)
-                                               (i386:value->base b)
-                                               (i386:test-base))))))))
-
-        ((gt (p-expr (ident ,a)) (p-expr (fixed ,b)))
-         (let ((b (cstring->number b)))
-           (clone info #:text
-                  (append text
-                          ((ident->base info) a)
-                          (list (lambda (f g t d)
-                                  (append
-                                   (i386:value->accu b)
-                                   (i386:sub-base))))))))
-
-        ((gt (p-expr (ident ,a)) (neg (p-expr (fixed ,b))))
-         (let ((b (- (cstring->number b))))
-           (clone info #:text
-                  (append text
-                          ((ident->base info) a)
-                          (list (lambda (f g t d)
-                                  (append 
-                                   (i386:value->accu b)
-                                   (i386:sub-base))))))))        
-
-        
-        ((ne (p-expr (ident ,a)) (p-expr (fixed ,b)))
-         (let ((b (cstring->number b)))
+                          (.text base)
+                          (.text accu)
+                          (list (lambda (f g ta t d)
+                                  (i386:sub-base)))))))
+
+        ((ne ,a ,b)
+         (let* ((base ((expr->base info) a))
+                (empty (clone base #:text '()))
+                (accu ((expr->accu empty) b)))
            (clone info #:text
                   (append text
-                          ((ident->base info) a)
-                          (list (lambda (f g t d)
+                          (.text base)
+                          (.text accu)
+                          (list (lambda (f g ta t d)
                                   (append 
-                                   (i386:value->accu b)
                                    (i386:sub-base)
                                    (i386:xor-zf))))))))
 
-        ((ne (p-expr (ident ,a)) (p-expr (char ,b)))
-         (let ((b (char->integer (car (string->list b)))))
+        ((lt ,a ,b)
+         (let* ((base ((expr->base info) a))
+                (empty (clone base #:text '()))
+                (accu ((expr->accu empty) b)))
            (clone info #:text
                   (append text
-                          ((ident->base info) a)
-                          (list (lambda (f g t d)
-                                  (append 
-                                   (i386:value->accu b)
-                                   (i386:sub-base)
-                                   (i386:xor-zf))))))))        
-
-        ((ne (p-expr (ident ,a)) (neg (p-expr (fixed ,b))))
-         (let ((b (- (cstring->number b))))
+                          (.text base)
+                          (.text accu)
+                          (list (lambda (f g ta t d)
+                                  (i386:base-sub)))))))
+
+        ;; TODO: byte dinges
+        ((Xsub ,a ,b)
+         (let* ((base ((expr->base info) a))
+                (empty (clone base #:text '()))
+                (accu ((expr->accu empty) b)))
            (clone info #:text
                   (append text
-                          ((ident->base info) a)
-                          (list (lambda (f g t d)
-                                  (append
-                                   (i386:value->accu b)
-                                   (i386:sub-base)
-                                   (i386:xor-zf))))))))
+                          (.text base)
+                          (.text accu)
+                          (list (lambda (f g ta t d)
+                                  (i386:base-sub)))))))
 
-        ((ne (p-expr (ident ,a)) (p-expr (ident ,constant)))
-         (let ((b (assoc-ref (.constants info) constant)))
-           (clone info #:text
-                  (append text
-                          ((ident->base info) a)
-                          (list (lambda (f g t d)
-                                  (append
-                                   (i386:value->accu b)
-                                   (i386:sub-base)
-                                   (i386:xor-zf))))))))
-        
-        ((ne (fctn-call . ,call) (p-expr (fixed ,b)))
-         (let ((b (cstring->number b))
-               (info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
-           (clone info #:text
-                  (append text
-                          (.text info)
-                          (list (lambda (f g t d)
-                                  (append
-                                   (i386:value->base b)
-                                   (i386:sub-base)
-                                   (i386:xor-zf))))))))
-
-        ((ne (fctn-call . ,call) (p-expr (ident ,b)))
-         (let ((info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
-           (clone info #:text
-                  (append text
-                          (.text info)
-                          ((ident->base info) b)
-                          (list (lambda (f g t d)
-                                  (append
-                                   (i386:sub-base)
-                                   (i386:xor-zf))))))))
-
-        ((ne (de-ref (p-expr (ident ,a))) (de-ref (p-expr (ident ,b))))
-           (clone info #:text
-                  (append text
-                          ((ident->accu info) a)
-                          (list (lambda (f g t d)
-                                  (append
-                                   (i386:byte-mem->base)
-                                   (i386:local->accu (assoc-ref locals b))
-                                   (i386:byte-mem->accu)
-                                   (i386:byte-test-base)
-                                   (i386:xor-zf)))))))
-
-        ((ne (de-ref (p-expr (ident ,a))) (p-expr (char ,b)))
-         (let ((b (char->integer (car (string->list b)))))
-           (clone info #:text
-                  (append text
-                          ((ident->accu info) a)
-                          (list (lambda (f g t d)
-                                  (append
-                                   (i386:byte-mem->base)
-                                   (i386:value->accu b)
-                                   (i386:byte-test-base)
-                                   (i386:xor-zf))))))))
-
-        ;; CAR (x) != 1 // cell_nil
-        ((ne (d-sel . ,d-sel) (p-expr (fixed ,b)))
-         (let ((expr ((expr->accu info) `(d-sel ,@d-sel)))
-               (b (cstring->number b)))
-           (clone info #:text
-                  (append text
-                          (.text expr)
-                          (list (lambda (f g t d)
-                                  (append
-                                   (i386:value->base b)
-                                   (i386:sub-base)
-                                   (i386:xor-zf))))))))
-
-        ;; CAR (x) != PAIR
-        ((ne (d-sel . ,d-sel) (p-expr (ident ,constant)))
-         (let ((expr ((expr->accu info) `(d-sel ,@d-sel)))
-               (b (assoc-ref (.constants info) constant)))
-           (clone info #:text
-                  (append text
-                          (.text expr)
-                          (list (lambda (f g t d)
-                                  (append
-                                   (i386:value->base b)
-                                   (i386:sub-base)
-                                   (i386:xor-zf))))))))
-
-        ((lt (p-expr (ident ,a)) (p-expr (fixed ,b)))
-         (let ((b (cstring->number b)))
-           (clone info #:text
-                  (append text
-                          ((ident->base info) a)
-                          (list (lambda (f g t d)
-                                  (append 
-                                   (i386:value->accu b)
-                                   (i386:base-sub))))))))
-
-        ((sub (de-ref (p-expr (ident ,a))) (de-ref (p-expr (ident ,b))))
+        ((Xsub (de-ref (p-expr (ident ,a))) (de-ref (p-expr (ident ,b))))
          (clone info #:text
                 (append text
-                        (list (lambda (f g t d)
+                        (list (lambda (f g ta t d)
                                 (append
-                                 ;;(and (stderr "006\n") '())
-                                 (i386:local->accu (assoc-ref locals a))
+                                 (i386:local->accu (local:id (assoc-ref locals a)))
                                  (i386:byte-mem->base)
-                                 (i386:local->accu (assoc-ref locals b))
+                                 (i386:local->accu (local:id (assoc-ref locals b)))
                                  (i386:byte-mem->accu)
                                  (i386:byte-sub-base)))))))
 
-        ((array-ref (p-expr (fixed ,value)) (p-expr (ident ,name)))
+        ;; g_cells[0]
+        ((array-ref (p-expr (fixed ,value)) (p-expr (ident ,array)))
          (let ((value (cstring->number value)))
            (clone info #:text
                   (append text
-                          ((ident->base info) name)
-                          (list (lambda (f g t d)
-                                       (append
-                                        (i386:value->accu value)
-                                        (i386:byte-base-mem->accu)))))))) ; FIXME: type: char
+                        ((ident->base info) array)
+                        (list (lambda (f g ta t d)
+                                (append
+                                 (i386:value->accu value)
+                                 ;;(i386:byte-base-mem->accu)
+                                 (i386:base-mem->accu)
+                                 ))))))) ; FIXME: type: char
         
-        ((array-ref (p-expr (ident ,name)) (p-expr (ident ,index)))
+        ;; g_cells[a]
+        ((array-ref (p-expr (ident ,index)) (p-expr (ident ,array)))
          (clone info #:text
                 (append text
-                        ((ident->base info) name)
-                        ((ident->accu info) index)
-                        (list (lambda (f g t d)
-                                (i386:byte-base-mem->accu)))))) ; FIXME: type: char
+                        ((ident->base info) index)  ;; FIXME: chars! index*size
+                        ((ident->accu info) array)
+                        (list (lambda (f g ta t d)
+                                ;;(i386:byte-base-mem->accu)
+                                (i386:base-mem->accu)
+                                ))))) ; FIXME: type: char
         
         ((return ,expr)
          (let ((accu ((expr->accu info) expr)))
-           (if (info? accu)
-               (clone accu #:text
-                      (append (.text accu) (list (i386:ret (lambda _ '())))))
-               (clone info #:text
-                      (append text (list (i386:ret accu)))))))
+           (clone accu #:text
+                  (append (.text accu) (list (i386:ret (lambda _ '())))))))
 
         ;; int i;
         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name))))
-         (clone info #:locals (add-local name)))
-
-        ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (fixed ,value))))))
-         (let* ((locals (add-local name))
-                (info (clone info #:locals locals)))
-           (let ((value (cstring->number value)))
-             (clone info #:text
-                    (append text ((value->ident info) name value))))))
+         (if (.function info)
+             (clone info #:locals (add-local locals name type 0))
+             (clone info #:globals (append globals (list (ident->global name type 0 0))))))
 
         ;; int i = 0;
         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (fixed ,value))))))
-         (let* ((locals (add-local name))
-                (info (clone info #:locals locals))
-                (value (cstring->number value)))
-           (clone info #:text
-                  (append text
-                          ((value->ident info) name value)))))
+         (let ((value (cstring->number value)))
+           (if (.function info)
+               (let* ((locals (add-local locals name type 0))
+                      (info (clone info #:locals locals)))
+                 (clone info #:text
+                        (append text
+                                ((value->ident info) name value))))
+               (clone info #:globals (append globals (list (ident->global name type 0 value)))))))
 
         ;; char c = 'A';
         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (char ,value))))))
-         (let* ((locals (add-local name))
+         (if (not (.function info)) decl-barf0)
+         (let* ((locals (add-local locals name type 0))
                 (info (clone info #:locals locals))
                 (value (char->integer (car (string->list value)))))
            (clone info #:text
 
         ;; int i = -1;
         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (neg (p-expr (fixed ,value)))))))
-         (let* ((locals (add-local name))
+         (if (not (.function info)) decl-barf1)
+         (let* ((locals (add-local locals name type 0))
                 (info (clone info #:locals locals))
                 (value (- (cstring->number value))))
            (clone info #:text
 
         ;; int i = argc;
         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local))))))
-         (let* ((locals (add-local name))
+         (if (not (.function info)) decl-barf2)
+         (let* ((locals (add-local locals name type 0))
                 (info (clone info #:locals locals)))
            (clone info #:text
                   (append text
 
         ;; char *p = "t.c";
         ;;(decl (decl-spec-list (type-spec (fixed-type "char"))) (init-declr-list (init-declr (ptr-declr (pointer) (ident "p")) (initzer (p-expr (string "t.c\n"))))))
-        ((decl (decl-spec-list (type-spec (fixed-type _))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (string ,value))))))
-         (let* ((locals (add-local name))
+        ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (string ,value))))))
+         (if (not (.function info)) decl-barf3)
+         (let* ((locals (add-local locals name type 1))
                 (globals (append globals (list (string->global value))))
                 (info (clone info #:locals locals #:globals globals)))
            (clone info #:text
                   (append text
-                          (list (lambda (f g t d)
+                          (list (lambda (f g ta t d)
                                   (append
                                    (i386:global->accu (+ (data-offset value g) d)))))
                           ((accu->ident info) name)))))
         
         ;; char arena[20000];
-        ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (array-of (ident ,name) (p-expr (fixed ,count))))))
-         (let* ((globals (.globals info))
-                (count (cstring->number count))
-                (size 1) ;; FIXME
-                (array (list (ident->global name #xaaaaaaaa)))  ;;FIXME: deref?
-                (dummy (list (cons (string->list "dummy")
-                                   (string->list (make-string (* count size) #\nul))))))
-           (clone info #:globals (append globals array dummy))))
-
-        ;; struct scm* arena[200];
-        ((decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (array-of (ident ,name) (p-expr (fixed ,count))))))
-         (let* ((globals (.globals info))
-                (count (cstring->number count))
-                (size 12) ;; FIXME
-                (array (list (ident->global name #x58585858)))  ;;FIXME: deref?
-                (dummy (list (cons (string->list "dummy")
-                                   (string->list (make-string (* count size) #\nul))))))
-           (stderr "(* count size): ~a\n" (* count size))
-           (clone info #:globals (append globals array dummy))))
+        ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (array-of (ident ,name) (p-expr (fixed ,count))))))
+         (let ((type (ast->type type)))
+           (if (.function info)
+               TODO:decl-array 
+               (let* ((globals (.globals info))
+                      (count (cstring->number count))
+                      (size (type->size info type))
+                      ;;;;(array (make-global name type -1 (string->list (make-string (* count size) #\nul))))
+                      (array (make-global name type -1 (string->list (make-string (* count size) #\nul))))
+                      (globals (append globals (list array))))
+                 (clone info
+                        #:globals globals)))))
 
         ;;struct scm *g_cells = (struct scm*)arena;
         ((decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (cast (type-name (decl-spec-list (type-spec (struct-ref (ident ,=type)))) (abs-declr (pointer))) (p-expr (ident ,value)))))))
-         (let* ((locals (add-local name))
-                (info (clone info #:locals locals)))
-           (clone info #:text
-                  (append text
-                          ((ident->accu info) name)
-                          ((accu->ident info) value))))) ;; FIXME: deref?
+         ;;(stderr "0TYPE: ~s\n" type)
+         (if (.function info)
+             (let* ((locals (add-local locals name type 1))
+                    (info (clone info #:locals locals)))
+               (clone info #:text
+                      (append text
+                              ((ident->accu info) name)
+                              ((accu->ident info) value)))) ;; FIXME: deref?
+             (let* ((globals (append globals (list (ident->global name type 1 0))))
+                    (info (clone info #:globals globals)))
+               (clone info #:text
+                      (append text
+                              ((ident->accu info) name)
+                              ((accu->ident info) value)))))) ;; FIXME: deref?
 
-        ;; SCM g_stack = 0;
-        ((decl (decl-spec-list (type-spec (typename _))) (init-declr-list (init-declr (ident _) (initzer (p-expr (fixed _))))) (comment _))
-         ((ast->info info) (list-head o (- (length o) 1))))
+        ;; SCM tmp;
+        ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name))))
+         ;;(stderr  "1TYPE: ~s\n" type)
+         (if (.function info)
+             (clone info #:locals (add-local locals name type 0))
+             (clone info #:globals (append globals (list (ident->global name type 0 0))))))
 
-        ((decl (decl-spec-list (type-spec (typename _))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (fixed ,value))))))
+        ;; SCM g_stack = 0;
+        ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (fixed ,value))))))
+         ;;(stderr  "2TYPE: ~s\n" type)
          (if (.function info)
-             (let* ((locals (add-local name))
+             (let* ((locals (add-local locals name type 0))
                     (globals (append globals (list (string->global value))))
                     (info (clone info #:locals locals #:globals globals)))
                (clone info #:text
                       (append text
-                              (list (lambda (f g t d)
+                              (list (lambda (f g ta t d)
                                       (append
                                        (i386:global->accu (+ (data-offset value g) d)))))
                               ((accu->ident info) name))))
              (let* ((value (length (globals->data globals)))
-                    (globals (append globals (list (ident->global name value)))))
+                    (globals (append globals (list (ident->global name type 0 value)))))
                (clone info #:globals globals))))
 
+        ;; SCM g_stack = 0; // comment
+        ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident _) (initzer (p-expr (fixed _))))) (comment _))
+         ((ast->info info) (list-head o (- (length o) 1))))
+
         ;; SCM i = argc;
         ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local))))))
-         (let* ((locals (add-local name))
-               (info (clone info #:locals locals)))
-           (clone info #:text
-                  (append text
-                          ((ident->accu info) local)
-                          ((accu->ident info) name)))))
-        
+         ;;(stderr  "3TYPE: ~s\n" type)
+         (if (.function info)
+             (let* ((locals (add-local locals name type 0))
+                    (info (clone info #:locals locals)))
+               (clone info #:text
+                      (append text
+                              ((ident->accu info) local)
+                              ((accu->ident info) name))))
+             (let* ((globals (append globals (list (ident->global name type 0 0))))
+                    (info (clone info #:globals globals)))
+               (clone info #:text
+                      (append text
+                              ((ident->accu info) local)
+                              ((accu->ident info) name))))))
+
         ;; int i = f ();
         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (fctn-call . ,call)))))
-         (let* ((locals (add-local name))
+         ;;(stderr  "4TYPE: ~s\n" type)
+         (let* ((locals (add-local locals name type 0))
                 (info (clone info #:locals locals)))
            (let ((info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
              (clone info
                             ((accu->ident info) name))
                     #:locals locals))))
         
+        ;; 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)
+                          (list (lambda (f g ta t d)
+                                  (append
+                                   ;;(i386:value->base t)
+                                   ;;(i386:accu+base)
+                                   (i386:value->base ta)
+                                   (i386:accu+base)))))
+                  #:locals locals)))
+
         ;; SCM x = car (e);
-        ((decl (decl-spec-list (type-spec (typename _))) (init-declr-list (init-declr (ident ,name) (initzer (fctn-call . ,call)))))
-         (let* ((locals (add-local name))
+        ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name) (initzer (fctn-call . ,call)))))
+         ;;(stderr  "5TYPE: ~s\n" type)
+         (let* ((locals (add-local locals name type 0))
                 (info (clone info #:locals locals)))
            (let ((info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
              (clone info
 
         ;; char *p = (char*)g_cells;
         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (cast (type-name (decl-spec-list (type-spec (fixed-type ,=type))) (abs-declr (pointer))) (p-expr (ident ,value)))))))
-         (let* ((locals (add-local name))
-                (info (clone info #:locals locals)))
-           (clone info #:text
-                  (append text
-                          ((ident->accu info) value)
-                          ((accu->ident info) name)))))
+         ;;(stderr  "6TYPE: ~s\n" type)
+         (if (.function info)
+             (let* ((locals (add-local locals name type 1))
+                    (info (clone info #:locals locals)))
+               (clone info #:text
+                      (append text
+                              ((ident->accu info) value)
+                              ((accu->ident info) name))))
+             (let* ((globals (append globals (list (ident->global name type 1 0))))
+                    (here (data-offset name globals))
+                    (there (data-offset value globals)))
+               (clone info
+                      #:globals globals
+                      #:init (append (.init info)
+                                     (list (lambda (functions globals ta t d data)
+                                             (append
+                                              (list-head data here)
+                                              ;;; FIXME: type
+                                              ;;; char *x = arena;
+                                              (int->bv32 (+ d (data-offset value globals)))
+                                              ;;; char *y = x;
+                                              ;;;(list-head (list-tail data there) 4)
+                                              (list-tail data (+ here 4))))))))))
 
         ;; char *p = g_cells;
-        ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (ident ,value))))))
-         (let* ((locals (add-local name))
-                (info (clone info #:locals locals)))
-           (clone info #:text
-                  (append text
-                          ((ident->accu info) value)
-                          ((accu->ident info) name)))))
+        ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (ident ,value))))))
+         ;;(stderr  "7TYPE: ~s\n" type)
+         (let ((type (decl->type type)))
+           ;;(stderr "0DECL: ~s\n" type)
+           (if (.function info)
+               (let* ((locals (add-local locals name type  1))
+                      (info (clone info #:locals locals)))
+                 (clone info #:text
+                        (append text
+                                ((ident->accu info) value)
+                                ((accu->ident info) name))))
+               (let* ((globals (append globals (list (ident->global name type 1 0))))
+                      (here (data-offset name globals))
+                      (there (data-offset value globals)))
+                 (clone info
+                        #:globals globals
+                        #:init (append (.init info)
+                                       (list (lambda (functions globals ta t d data)
+                                               (append
+                                                (list-head data here)
+                                              ;;; FIXME: type
+                                              ;;; char *x = arena;p
+                                                (int->bv32 (+ d (data-offset value globals)))
+                                              ;;; char *y = x;
+                                              ;;;(list-head (list-tail data there) 4)
+                                                (list-tail data (+ here 4)))))))))))
 
         ;; enum 
         ((decl (decl-spec-list (type-spec (enum-def (ident ,name) (enum-def-list . ,fields)))))
-         (let ((type (ident->type name "enum"))
+         (let ((type (enum->type name fields))
                (constants (map ident->constant (map cadadr fields) (iota (length fields)))))
-           (clone info #:types (append (.types info) (list type))
+           (clone info
+                  #:types (append (.types info) (list type))
                   #:constants (append constants (.constants info)))))
 
         ;; struct
         ((decl (decl-spec-list (type-spec (struct-def (ident ,name) (field-list . ,fields)))))
-         (let* ((type (ident->type name (map struct-field fields))))
+         (let* ((type (struct->type (list "struct" name) (map struct-field fields))))
+           (stderr "type: ~a\n" type)
            (clone info #:types (append (.types info) (list type)))))
-        
-        ;; i = 0;
-        ((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (p-expr (fixed ,value))))
-         ;;(stderr "RET LOCAL[~a]: ~a\n" name (assoc-ref locals name))
-         (let ((value (cstring->number value)))
-           (clone info #:text (append text ((value->ident info) name value)))))
-
-        ;; i = 0; ...from for init FIXME
-        ((assn-expr (p-expr (ident ,name)) (op _) (p-expr (fixed ,value)))
-         (let ((value (cstring->number value)))
-           (clone info #:text (append text ((value->ident info) name value)))))
 
-        ;; i = i + 48;
-        ((expr-stmt (assn-expr (p-expr (ident ,a)) (op _) (add (p-expr (ident ,b)) (p-expr (fixed ,value)))))
-         (let ((value (cstring->number value)))
+        ;; *p++ = b;
+        ((expr-stmt (assn-expr (de-ref (post-inc (p-expr (ident ,name)))) (op ,op) ,b))
+         (when (not (equal? op "="))
+           (stderr "OOOPS0.0: op=~s\n" op)
+           barf)
+         (let* ((empty (clone info #:text '()))
+                (base ((expr->base empty) b)))
            (clone info #:text
                   (append text
-                          ((ident->base info) b)
-                          (list (lambda (f g t d)
-                                  (append
-                                   (i386:value->accu value)
-                                   (i386:accu+base))))
-                          ((accu->ident info) a)))))
+                          (.text base)
+                          ((base->ident-address info) name)
+                          ((ident-add info) name 1)))))
 
-        ;; c = 'A';
-        ((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (p-expr (char ,value))))
-         (let ((value (char->integer (car (string->list value)))))
-           (clone info #:text (append text ((value->ident info) name value)))))
+        ;; CAR (x) = 0
+        ;; TYPE (x) = PAIR;
+        ((expr-stmt (assn-expr (d-sel (ident ,field) . ,d-sel) (op ,op) ,b))
+         (when (not (equal? op "="))
+           (stderr "OOOPS0: op=~s\n" op)
+           barf)
+         (let* ((empty (clone info #:text '()))
+                (expr ((expr->Xaccu empty) `(d-sel (ident ,field) ,@d-sel))) ;; <-OFFSET
+                (base ((expr->base empty) b))
+                (type (list "struct" "scm")) ;; FIXME
+                (fields (type->description info type))
+                (size (type->size info type))
+                (field-size 4) ;; FIXME:4, not fixed
+                (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))                )
+           (clone info #:text (append text
+                                      (.text expr)
+                                      (list (lambda (f g ta t d)
+                                              '(#x90)))
+                                      (.text base)
+                                      (list (lambda (f g ta t d)
+                                              '(#x90)))
+                                      (list (lambda (f g ta t d)
+                                              ;;(i386:byte-base->accu-ref) ;; FIXME: size
+                                              (i386:base->accu-address)
+                                              ))))))
 
-        ((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (fctn-call . ,call)))
-         (let* ((info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
-           (clone info #:text (append (.text info) ((accu->ident info) name)))))
 
+        ;; i = 0;
+        ;; c = f ();
+        ;; i = i + 48;
         ;; p = g_cell;
-        ((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (p-expr (ident ,value))))
-         (clone info #:text
-                (append text
-                        ((ident->accu info) value)
-                        ((accu->ident info) name))))
-
+        ((expr-stmt (assn-expr (p-expr (ident ,name)) (op ,op) ,b))
+         (when (and (not (equal? op "="))
+                    (not (equal? op "+="))
+                    (not (equal? op "-=")))
+           (stderr "OOOPS1: op=~s\n" op)
+           barf)
+         (let* ((empty (clone info #:text '()))
+                (base ((expr->base empty) b)))
+           (clone info #:text (append text
+                                      (.text base)
+                                      (if (equal? op "=") '()
+                                          (append ((ident->accu info) name)
+                                                  (list (lambda (f g ta t d)
+                                                          (append
+                                                           (if (equal? op "+=")
+                                                               (i386:accu+base)
+                                                               (i386:accu-base))
+                                                           (i386:accu->base))))))
+                                      ;;assign:
+                                      ((base->ident info) name)))))
+        
         ;; *p = 0;
-        ((expr-stmt (assn-expr (de-ref (p-expr (ident ,name))) (op _) (p-expr (fixed ,value))))
-         (let ((value (cstring->number value)))
+        ((expr-stmt (assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b))
+         (when (not (equal? op "="))
+           (stderr "OOOPS2: op=~s\n" op)
+           barf)
+         (let* ((empty (clone info #:text '()))
+                (base ((expr->base empty) b)))
            (clone info #:text (append text
-                                      (list (lambda (f g t d)
-                                              (i386:value->base 0)))
-                                      ((base->ident-ref info) name)))))
-
-        ;; *p++ = c;
-        ((expr-stmt (assn-expr (de-ref (post-inc (p-expr (ident ,name)))) (op _) (p-expr (ident ,value))))
-         ;; (stderr "VALUE: ~a\n" value)
-         ;; (stderr "LOCALS: ~a\n" (.locals info))
-         ;; (stderr " ==> ~a\n" (assoc-ref (.locals info) value))
-         (clone info #:text
-                (append text
-                        ;;((ident-ref->base info) value)
-                        ((ident->base info) value)
-                        ((base->ident-ref info) name)
-                        (list (lambda (f g t d)
-                                (i386:local-add (assoc-ref locals name) 1))))))
-
-        ((d-sel . ,d-sel)
-         (let ((expr ((expr->accu info) `(d-sel ,@d-sel))))
-           expr))        
-
-        ;; i = CAR (x)
-        ((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (d-sel . ,d-sel)))
-         (let ((expr ((expr->accu info) `(d-sel ,@d-sel))))
-           (clone info #:text (append (.text expr)
-                                      ((accu->ident info) name)))))
-
-
-        ;; TYPE (x) = PAIR;
-        ((expr-stmt (assn-expr (d-sel (ident ,field) . ,d-sel) (op _) (p-expr (ident ,constant))))
-         (let* ((expr ((expr->Xaccu info) `(d-sel (ident ,field) ,@d-sel)))
-                (b (assoc-ref (.constants info) constant))
-
-                (struct-type "scm") ;; FIXME
-                (struct (assoc-ref (.types info) struct-type))
-                (size (length struct))
-                (field-size 4) ;; FIXME:4, not fixed
-                (offset (* field-size (1- (length (member field (reverse struct) (lambda (a b) (equal? a (cdr b)))))))))
-           (clone info #:text (append (.text expr)
-                                      (list (lambda (f g t d)
-                                              (i386:value->accu-ref+n offset b)))))))
-
-        ;; CAR (x) = 0
-        ((expr-stmt (assn-expr (d-sel (ident ,field) . ,d-sel) (op _) (p-expr (fixed ,value))))
-         (let* ((expr ((expr->Xaccu info) `(d-sel (ident ,field) ,@d-sel)))
-                (b (cstring->number value))
-                
-                (struct-type "scm") ;; FIXME
-                (struct (assoc-ref (.types info) struct-type))
-                (size (length struct))
-                (field-size 4) ;; FIXME:4, not fixed
-                (offset (* field-size (1- (length (member field (reverse struct) (lambda (a b) (equal? a (cdr b))))))))               )
-           (clone info #:text (append (.text expr)
-                                      (list (lambda (f g t d)
-                                              (i386:value->accu-ref+n offset b)))))))
+                                      (.text base)
+                                      ;;assign:
+                                      ((base->ident-address info) name)))))
 
         ;; g_cells[0] = 65;
-        ((expr-stmt (assn-expr (array-ref (p-expr (fixed ,index)) (p-expr (ident ,name))) (op _) (p-expr (fixed ,value))))
-         (let ((index (cstring->number index))
-               (value (cstring->number value)))
+        ((expr-stmt (assn-expr (array-ref (p-expr (fixed ,index)) (p-expr (ident ,name))) (op ,op) ,b))
+         (when (not (equal? op "="))
+           (stderr "OOOPS3: op=~s\n" op)
+           barf)
+         (let* ((index (cstring->number index))
+                (empty (clone info #:text '()))
+                (base ((expr->base empty) b)))
           (clone info #:text
                  (append text
-                         ((ident->base info) name)
-                         ((ident->accu info) index)
-                         (list (lambda (f g t d)
-                                 (i386:accu+base)
-                                 (i386:value->accu-ref value)))))))
+                         (.text base)
 
-        ((expr-stmt (assn-expr (array-ref (p-expr (fixed ,index)) (p-expr (ident ,name))) (op _) (p-expr (char ,value))))
-         (let ((index (cstring->number index))
-               (value (char->integer (car (string->list value)))))
-          (clone info #:text
-                 (append text
+                         (list (lambda (f g ta t d)
+                                 (i386:push-base)))
                          ((ident->base info) name)
-                         ((ident->accu info) index)
-                         (list (lambda (f g t d)
-                                 (i386:accu+base)
-                                 (i386:value->accu-ref value)))))))
+                         (list (lambda (f g ta t d)
+                                 (append
+                                  (i386:value->accu index)
+                                  (i386:accu+base))))
+                         (list (lambda (f g ta t d)
+                                 (i386:pop-base)))
+
+                         (list (lambda (f g ta t d)
+                                 (i386:base->accu-address)))))))
+
+        ;; g_cells[i] = c;
+        ((expr-stmt (assn-expr (array-ref (p-expr (ident ,index)) (p-expr (ident ,name))) (op ,op) ,b))
+         (when (not (equal? op "="))
+           (stderr "OOOPS4: op=~s\n" op)
+           barf)
+         (let* ((empty (clone info #:text '()))
+                (base ((expr->base empty) b)))
+           (clone info #:text
+                  (append text
+                          (.text base)
+
+                         (list (lambda (f g ta t d)
+                                 (i386:push-base)))
+                          ((ident->base info) name)
+                          ((ident->accu info) index)  ;; FIXME: chars! index*size
+                          (list (lambda (f g ta t d)
+                                  (i386:accu+base))) ; FIXME: type: char
+                         (list (lambda (f g ta t d)
+                                 (i386:pop-base)))
+
+                          (list (lambda (f g ta t d)
+                                  ;;(i386:byte-base->accu-address)
+                                  (i386:base->accu-address)
+                                  ))))))
+
+        ;; g_functions[g_function++] = g_foo;
+        ((expr-stmt (assn-expr (array-ref (post-inc (p-expr (ident ,index))) (p-expr (ident ,name))) (op ,op) ,b))
+         (when (not (equal? op "="))
+           (stderr "OOOPS5: op=~s\n" op)
+           barf)
+         (let* ((empty (clone info #:text '()))
+                (base ((expr->base empty) b)))
+           (clone info #:text
+                  (append text
+                          (.text base)
+
+                          (list (lambda (f g ta t d)
+                                 (i386:push-base)))
+                          ((ident->base info) name)
+                          ((ident->accu info) index)  ;; FIXME: chars! index*size
+                          (list (lambda (f g ta t d)
+                                  (i386:accu+base))) ; FIXME: type: char
+                          (list (lambda (f g ta t d)
+                                  (i386:pop-base)))
+
+                          (list (lambda (f g ta t d)
+                                  (append
+                                   (i386:base->accu-address))))
+
+                          ((ident-add info) index 1)
+                          ))))
+
+        ;; DECL
+        ;;
+        ;; struct f = {...};
+        ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ident ,name) (initzer (initzer-list . ,initzers)))))
+         (let* ((type (decl->type type))
+                ;;(foo (stderr "1DECL: ~s\n" type))
+                (fields (type->description info type))
+                (size (type->size info type))
+                (field-size 4))  ;; FIXME:4, not fixed
+           ;;(stderr  "7TYPE: ~s\n" type)
+           (if (.function info)
+               (let* ((locals (let loop ((fields (cdr fields)) (locals locals))
+                                (if (null? fields) locals
+                                    (loop (cdr fields) (add-local locals "foobar" "int" 0)))))
+                      (locals (add-local locals name type -1))
+                      (info (clone info #:locals locals))
+                      (empty (clone info #:text '())))
+                 (let loop ((fields (iota (length fields))) (initzers initzers) (info info))
+                   ;; (stderr "LOEP local initzers=~s\n" initzers)
+                   (if (null? fields) info
+                       (let ((offset (* field-size (car fields)))
+                             (initzer (car initzers)))
+                         (loop (cdr fields) (cdr initzers)
+                               (clone info #:text
+                                      (append
+                                       (.text info)
+                                       ((ident->accu info) name)
+                                       (list (lambda (f g ta t d)
+                                               (append
+                                                (i386:accu->base))))
+                                       (.text ((expr->accu empty) initzer))
+                                       (list (lambda (f g ta t d)
+                                               (i386:accu->base-address+n offset))))))))))
+               (let* ((global (make-global name type -1 (string->list (make-string size #\nul))))
+                      (globals (append globals (list global)))
+                      (here (data-offset name globals))
+                      (info (clone info #:globals globals))
+                      (field-size 4))
+                 (let loop ((fields (iota (length fields))) (initzers initzers) (info info))
+                   ;; (stderr "LOEP local initzers=~s\n" initzers)
+                   (if (null? fields) info
+                       (let ((offset (* field-size (car fields)))
+                             (initzer (car initzers)))
+                         (loop (cdr fields) (cdr initzers)
+                               (clone info #:init
+                                      (append
+                                       (.init info)
+                                       (list (lambda (functions globals ta t d data)
+                                               (append
+                                                (list-head data (+ here offset))
+                                                (initzer->data info functions globals ta t d (car initzers))
+                                                (list-tail data (+ here offset field-size)))))))))))))))
+
+        ((decl . _)
+         (format (current-error-port) "SKIP: decl statement=~s\n" o)
+         info)
 
         (_
-         (format (current-error-port) "SKIP statement=~s\n" o)
+         (format (current-error-port) "SKIP: statement=~s\n" o)
+         barf
          info)))))
 
+(define (initzer->data info functions globals ta t d o)
+  (pmatch o
+    ((initzer (p-expr (fixed ,value))) (int->bv32 (cstring->number value)))
+    ((initzer (ref-to (p-expr (ident ,name))))
+     ;;(stderr "INITZER[~a] => 0x~a\n" o (dec->hex (+ ta (function-offset name functions))))
+     (int->bv32 (+ ta (function-offset name functions))))
+    ((initzer (p-expr (ident ,name)))
+     (let ((value (assoc-ref (.constants info) name)))
+       (int->bv32 value)))
+    (_ (stderr "initzer->data:SKIP: ~s\n" o)
+       barf
+     (int->bv32 0))))
+
 (define (info->exe info)
   (display "dumping elf\n" (current-error-port))
-  (map write-any (make-elf (.functions info) (.globals info))))
+  (map write-any (make-elf (.functions info) (.globals info) (.init info))))
 
 (define (.formals o)
   (pmatch o
   (pmatch o
     ((param-list . ,formals)
      (let ((n (length formals)))
-       (list (lambda (f g t d)
+       (list (lambda (f g ta t d)
                (append
                 (i386:function-preamble)
                 (append-map (formal->text n) formals (iota n))
   (pmatch o
     ((param-list . ,formals)
      (let ((n (length formals)))
-       ;;(stderr "FORMALS: ~a ==> ~a\n" formals n)
-       (map cons (map .name formals) (iota n -2 -1))))
+       (map make-local (map .name formals) (map .type formals) (make-list n 0) (iota n -2 -1))))
     (_ (format (current-error-port) "formals->info: no match: ~a\n" o)
        barf)))
 
@@ -1638,7 +2114,9 @@ strcmp (char const* a, char const* b)
 
 (define (compile)
   (let* ((ast (mescc))
-         (info (make <info> #:functions i386:libc))
+         (info (make <info>
+                 #:functions i386:libc
+                 #:types i386:type-alist))
          (ast (append libc ast))
          (info ((ast->info info) ast))
          (info ((ast->info info) _start)))
index 499d56ecc9dcf55d30f175cb5f9e898af7743d45..4676eaece4057bc32750592094ad2bf51a5ce348 100644 (file)
  (mes
   (mes-use-module (srfi srfi-1))))
 
+(define (make-global name type pointer value)
+  (cons name (list type pointer value)))
+
+(define global:type car)
+(define global:pointer cadr)
+(define global:value caddr)
+
+(define (dec->hex o)
+  (cond ((number? o) (number->string o 16))
+        ((char? o) (number->string (char->integer o) 16))))
+
 (define (functions->lambdas functions)
   (append-map cdr functions))
 
-(define (lambda/label->list f g t d)
+(define (lambda/label->list f g ta t d)
   (lambda (l/l)
-    (if (not (procedure? l/l)) '() (l/l f g t d))))
+    (if (not (procedure? l/l)) '() (l/l f g ta t d))))
 
 (define (text->list o)
-  (append-map (lambda/label->list '() '() 0 0) o))
+  (append-map (lambda/label->list '() '() 0 0 0) o))
 
-(define (functions->text functions globals t d)
+(define (functions->text functions globals ta t d)
   (let loop ((lambdas/labels (functions->lambdas functions)) (text '()))
     (if (null? lambdas/labels) text
         (loop (cdr lambdas/labels)
-              (append text ((lambda/label->list functions globals (- (length text)) d) (car lambdas/labels)))))))
+              (append text ((lambda/label->list functions globals ta (- (length text)) d) (car lambdas/labels)))))))
+
+;; (define (functions->text functions globals ta t d)
+;;   (let loop ((functions functions) (text '()))
+;;     (if (null? functions) text
+;;         (loop (cdr functions)
+;;               (append '() ;;text
+;;                       (function->text functions globals ta t d text (car functions)))))))
+
+;; (define (function->text functions globals ta t d text function)
+;;   (format (current-error-port) "elf func=~a\n" (car function))
+;;   (let loop ((lambdas/labels (cdr function)) (text text))
+;;     (if (null? lambdas/labels) text
+;;         (loop (cdr lambdas/labels)
+;;               (append '() ;;text
+;;                       ((lambda/label->list functions globals ta (- (length text)) d) (car lambdas/labels)))))))
 
 (define (function-prefix name functions)
   (member name (reverse functions) (lambda (a b) (equal? (car b) name))))
@@ -55,7 +81,7 @@
     (lambda (name functions)
       (or (assoc-ref cache name)
           (let* ((prefix (function-prefix name functions))
-                 (offset (if prefix (length (functions->text (cdr prefix) '() 0 0))
+                 (offset (if prefix (length (functions->text (cdr prefix) '() 0 0 0))
                              0)))
             (if (or (equal? name "exit") (> offset 0)) (set! cache (assoc-set! cache name offset)))
             offset)))))
           (let loop ((text (cdr function-entry)))
             (if (or (equal? (car text) label) (null? text)) 0
                 (let* ((l/l (car text))
-                       (t ((lambda/label->list '() '() 0 0) l/l))
+                       (t ((lambda/label->list '() '() 0 0 0) l/l))
                        (n (length t)))
                   (+ (loop (cdr text)) n))))))))
 
 (define (globals->data globals)
-  (append-map cdr globals))
+  (append-map (compose global:value cdr) globals))
 
 (define (data-offset name globals)
   (let* ((prefix (member name (reverse globals)
index a4b0b8691c7639e6acaf52c88ceb3edfbfab5122..15394e2a6aa75344735424f908e41b5cb57758ed 100644 (file)
 (define-module (mes elf-util)
   #:use-module (srfi srfi-1)
   #:export (data-offset
+            dec->hex
             function-offset
             label-offset
             functions->lambdas
             functions->text
             lambda/label->list
             text->list
-            globals->data))
+            globals->data
+            make-global
+            global:type
+            global:pointer
+            global:value))
 
 (cond-expand
  (guile-2)
index 5e6f0bf26882dc2ea41b9b656818688b94897f38..9d748e16b7a81ded9966335dc4ea6f4c72c470ad 100644 (file)
@@ -46,7 +46,7 @@
 (define elf32-off int->bv32)
 (define elf32-word int->bv32)
 
-(define (make-elf functions globals)
+(define (make-elf functions globals init)
   (define vaddress #x08048000)
 
   (define ei-magic `(#x7f ,@(string->list "ELF")))
       (map car functions))))
 
   (define text-length
-    (length (functions->text functions globals 0 0)))
+    (length (functions->text functions globals 0 0 0)))
 
   (define data-offset
     (+ text-offset text-length))
   (define SHF-EXEC 4)
   (define SHF-STRINGS #x20)
 
-  (let* ((text (functions->text functions globals 0 data-address))
-         (data (globals->data globals))
+  (let* ((text (functions->text functions globals text-address 0 data-address))
+         (raw-data (globals->data globals))
+         (data (let loop ((data raw-data) (init init))
+                 (if (null? init) data
+                     (loop ((car init) functions globals text-address 0 data-address data) (cdr init)))))
          (entry (+ text-offset (function-offset "_start" functions)))
          (sym (sym functions globals))
          (str (str functions)))
     (define section-headers-offset
       (+ str-offset str-length))
 
-    (format (current-error-port) "ELF text=~a\n" text)
-    ;;(format (current-error-port) "ELF data=~a\n" data)
+    (format (current-error-port) "ELF text=~a\n" (map dec->hex text))
+    (format (current-error-port) "ELF raw-data=~a\n" (map dec->hex raw-data))
+    (format (current-error-port) "ELF data=~a\n" (map dec->hex data))
     (format (current-error-port) "text-offset=~a\n" text-offset)
     (format (current-error-port) "data-offset=~a\n" data-offset)
     (format (current-error-port) "_start=~a\n" (number->string entry 16))
index 1c6cab1a3a2bd6bbf783099c45efc9548728d696..75d1fca67d9d6c50d0b1d0e99674ec18aa6d5135 100644 (file)
@@ -31,8 +31,8 @@
 (define (i386:function-locals)
   '(#x83 #xec #x20))               ; sub    $0x10,%esp -- 8 local vars
 
-(define (i386:push-global-ref o)
-  (or o push-global-ref)
+(define (i386:push-global-address o)
+  (or o push-global-address)
   `(#x68 ,@(int->bv32 o)))              ; push  $0x<o>
 
 (define (i386:push-global o)
@@ -44,8 +44,8 @@
   (or n push-local)
   `(#xff #x75 ,(- 0 (* 4 n))))          ; pushl  0x<n>(%ebp)
 
-(define (i386:push-local-ref n)
-  (or n push-local-ref)
+(define (i386:push-local-address n)
+  (or n push-local-address)
   `(#x8d #x45 ,(- 0 (* 4 n))            ; lea 0x<n>(%ebp),%eax
          #x50))                         ; push %eax
 
          ;;#x0f #xbe #xc0                 ; movsbl %al,%eax ***FIXME BYTE****
          #x50))                         ; push   %eax
 
+(define (i386:pop-accu)
+  '(#x58))                              ; pop %eax
+
 (define (i386:push-accu)
-  `(#x50))                              ; push %eax
+  '(#x50))                              ; push %eax
+
+(define (i386:pop-base)
+  '(#x5a))                              ; pop %eax
+
+(define (i386:push-base)
+  '(#x52))                              ; push %eax
 
-(define (i386:push-arg f g t d)
+(define (i386:push-arg f g ta t d)
   (lambda (o)
     (or o push-arg)
     (cond ((number? o)
            `(#x68 ,@(int->bv32 o)))     ; push $<o>
           ((and (pair? o) (procedure? (car o)))
-           (append-map (lambda (p) (p f g t d)) o))
+           (append-map (lambda (p) (p f g ta t d)) o))
           ((pair? o) o)
-          ((procedure? o) (o f g t d))
+          ((procedure? o) (o f g ta t d))
           (_ barf))))
 
 (define (i386:ret . rest)
-  (lambda (f g t d)
+  (lambda (f g ta t d)
     `(
       ,@(cond ((null? rest) '())
               ((number? (car rest))
-               `(#xb8                     ; mov    $<>,%eax
+               `(#xb8                     ; mov    $<>,%eaxx
                  ,@(int->bv32 (car rest))))
               ((pair? (car rest)) (car rest))
               ((procedure? (car rest))
-               ((car rest) f g t d)))
+               ((car rest) f g ta t d)))
     #xc9                                ; leave
     #xc3                                ; ret
     )))
 (define (i386:accu->base)
   '(#x89 #xc2))                         ; mov    %eax,%edx
 
+(define (i386:accu->base-address)
+  '(#x89 #x02))                         ; mov    %eax,%(edx)
+
+(define (i386:byte-accu->base-address)
+  '(#x88 #x02))                         ; mov    %al,%(edx)
+
+(define (i386:accu->base-address+n n)
+  (or n accu->base-address+n)
+  `(#x89 #x42 ,n))                      ; mov    %eax,$0x<n>%(edx)
+
 (define (i386:accu->local n)
   (or n accu->local)
   `(#x89 #x45 ,(- 0 (* 4 n))))          ; mov    %eax,-<0xn>(%ebp)
 
+(define (i386:base->local n)
+  (or n base->local)
+  `(#x89 #x55 ,(- 0 (* 4 n))))          ; mov    %edx,-<0xn>(%ebp)
+
+(define (i386:base->global n)
+  (or n base->global)
+  `(#x89 #x15 ,@(int->bv32 n)))         ; mov    %edx,0x0
+
 (define (i386:accu->global n)
   (or n accu->global)
   `(#xa3 ,@(int->bv32 n)))              ; mov    %eax,0x0
 
+(define (i386:accu->global-address n)
+  (or n accu->global-address)
+  `(#x8b #x15 ,@(int->bv32 n)           ; mov    0x<n>,%edx
+         #x89 #x02 ))                   ; mov    %eax,(%edx)
+
 (define (i386:accu-zero?)
   '(#x85 #xc0))                         ; cmpl   %eax,%eax
 
           (i386:xor-zf)))
 
 (define (i386:accu-shl n)
+  (or n accu:shl n)
   `(#xc1 #xe0 ,n))                      ; shl    $0x8,%eax
 
 (define (i386:accu+accu)
 (define (i386:accu+base)
   `(#x01 #xd0))                         ; add    %edx,%eax
 
+(define (i386:accu+value v)
+  (or v accu+value)
+  `(#x05 ,@(int->bv32 v)))              ; add    %eax,%eax
+
+(define (i386:accu-base)
+  `(#x29 #xd0))                         ; sub    %edx,%eax
+
+;; (define (i386:accu/base)
+;;   '(#xf7 #xf2))                         ; div    %edx,%eax
+
+(define (i386:accu/base)
+  '(#x86 #xd3                           ; mov    %edx,%ebx
+    #x31 #xd2                           ; xor    %edx,%edx
+    #xf7 #xf3))                         ; div    %ebx
+
 (define (i386:base->accu)
   '(#x89 #xd0))                         ; mov    %edx,%eax
 
   (or n local->accu)
   `(#x8b #x45 ,(- 0 (* 4 n))))          ; mov    -<0xn>(%ebp),%eax
 
+(define (i386:local-address->accu n)
+  (or n ladd)
+  `(#x8d #x45 ,(- 0 (* 4 n))))          ; lea 0x<n>(%ebp),%eax
+
+(define (i386:local-ptr->accu n)
+  (or n local-ptr->accu)
+  `(#x89 #xe8                           ; mov    %ebp,%eax
+         #x83 #xc0 ,(- 0 (* 4 n))))     ; add    $0x<n>,%eax
+
 (define (i386:byte-local->accu n)
   (or n byte-local->accu)
   `(#x0f #xb6 #x45 ,(- 0 (* 4 n))))     ; movzbl 0x<n>(%ebp),%eax
   (or n local->base)
   `(#x8b #x55 ,(- 0 (* 4 n))))          ; mov    -<0xn>(%ebp),%edx
 
-;; (define (i386:local-ref->base n)
-;;   (or n local-ref->base)
-;;   `(#x8b #x15 ,@(int->bv32 (- 0 (* 4 n))))) ; mov    0x<n>,%edx
-
-(define (i386:local-ref->base n)
-  (or n local-ref->base)
+(define (i386:local-address->base n) ;; DE-REF
+  (or n local-address->base)
   `(#x8d #x55 ,(- 0 (* 4 n))))          ; lea    0x<n>(%ebp),%edx
 
-(define (i386:global-ref->base n)
-  (or n global->base)
-  `(#x8b #x15 ,@(int->bv32 n)))         ; mov    0x<n>,%edx
+(define (i386:local-ptr->base n)
+  (or n local-ptr->base)
+  `(#x89 #xea                           ; mov    %ebp,%edx
+         #x83 #xc2 ,(- 0 (* 4 n))))     ; add    $0x<n>,%edx
 
 (define (i386:global->base n)
   (or n global->base)
-  `(#xba ,@(int->bv32 n)))              ; mov    $<n>,%edx
+  `(#xba ,@(int->bv32 n)))              ; mov   $<n>,%edx
+
+(define (i386:global-address->accu n)
+  (or n global-address->accu)
+  `(#xa1 ,@(int->bv32 n)))              ; mov    0x<n>,%eax
+
+(define (i386:global-address->base n)
+  (or n global-address->base)
+  `(#x8b #x15 ,@(int->bv32 n)))         ; mov    0x<n>,%edx
 
 (define (i386:byte-base-mem->accu)
   '(#x01 #xd0                           ; add    %edx,%eax
   `(#x8b #x40 ,n))                      ; mov    0x<n>(%eax),%eax
 
 (define (i386:base-mem+n->accu n)
+  (or n base-mem+n->accu)
   `(#x01 #xd0                           ; add    %edx,%eax
          #x8b #x40 ,n))                 ; mov    <n>(%eax),%eax
 
-(define (i386:global->accu o)
-  (or o global->accu)
-  `(#xb8 ,@(int->bv32 o)))              ; mov    $<>,%eax
-
 (define (i386:value->accu v)
-  (or v value->accu)
+  (or v urg:value->accu)
   `(#xb8 ,@(int->bv32 v)))              ; mov    $<v>,%eax
 
-(define (i386:value->accu-ref v)
-  (or v value->accu-ref)
+(define (i386:value->accu-address v)
   `(#xc7 #x00 ,@(int->bv32 v)))         ; movl   $0x<v>,(%eax)
 
-(define (i386:value->accu-ref+n n v)
+(define (i386:value->accu-address+n n v)
+  (or v urg:value->accu-address+n)
   `(#xc7 #x40 ,n ,@(int->bv32 v)))      ; movl   $<v>,0x<n>(%eax)
 
-(define (i386:base->accu-ref)
+(define (i386:base->accu-address)
   '(#x89 #x10))                         ; mov    %edx,(%eax)
 
-(define (i386:byte-base->accu-ref)
+(define (i386:byte-base->accu-address)
   '(#x88 #x10))                         ; mov    %dl,(%eax)
 
+(define (i386:byte-base->accu-address+n n)
+  (or n byte-base->accu-address+n)
+  `(#x88 #x50 ,n))                      ; mov    %dl,0x<n>(%eax)
+
 (define (i386:value->base v)
+  (or v urg:value->base)
   `(#xba ,@(int->bv32 v)))              ; mov    $<v>,%edx
 
 (define (i386:local-add n v)
-  (or n ladd)
+  (or n urg:local-add)
   `(#x83 #x45 ,(- 0 (* 4 n)) ,v))       ; addl   $<v>,0x<n>(%ebp)
 
-(define (i386:local-address->accu n)
-  (or n ladd)
-  `(#x8d #x45 ,(- 0 (* 4 n))))          ; lea 0x<n>(%ebp),%eax
+(define (i386:global-add n v)
+  (or n urg:global-add)
+  `(#x83 #x05 ,@(int->bv32 n) ,v))      ; addl   $<v>,0x<n>
 
-(define (i386:local-address->accu n)
-  (or n ladd)
-  `(#x8d #x45 ,(- 0 (* 4 n))))          ; lea 0x<n>(%ebp),%eax
+(define (i386:global->accu o)
+  (or o urg:global->accu)
+  `(#xb8 ,@(int->bv32 o)))              ; mov    $<>,%eax
 
 (define (i386:value->global n v)
   (or n value->global)
          ,@(int->bv32 v)))
 
 (define (i386:local-test n v)
-  (or n lt)
+  (or n local-test)
   `(#x83 #x7d ,(- 0 (* 4 n)) ,v))       ; cmpl   $<v>,0x<n>(%ebp)
 
-(define (i386:call f g t d address . arguments)
-  (let* ((pushes (append-map (i386:push-arg f g t d) (reverse arguments)))
+(define (i386:call f g ta t d address . arguments)
+  (or address urg:call)
+  (let* ((pushes (append-map (i386:push-arg f g ta t d) (reverse arguments)))
          (s (length pushes))
          (n (length arguments)))
    `(
      #xe8 ,@(int->bv32 (- address 5 s)) ; call relative
      #x83 #xc4 ,(* n 4)                 ; add    $00,%esp
      )))
+
+(define (i386:call-accu f g ta t d . arguments)
+  ;;(or address urg:call)
+  (let* ((pushes (append-map (i386:push-arg f g ta t d) (reverse arguments)))
+         (s (length pushes))
+         (n (length arguments)))
+    `(
+      ,@(i386:push-accu)
+      ,@pushes    ; push args
+      ;;#xe8 ,@(int->bv32 (- address 5 s)) ; call relative
+      ;; FIXME: add t?/address
+      ;; #x50                               ; push %eax
+      ;; #xc3                               ; ret
+      ,@(i386:pop-accu)
+      ;; #x05 ,@(int->bv32 t)              ; add    <t>,%eax
+      ;; #x05 ,@(int->bv32 ta)             ; add    <ta>,%eax
+      #xff #xd0                         ; call   *%eax
+      #x83 #xc4 ,(* n 4)                ; add    $00,%esp
+      )))
  
 (define (i386:accu-not)
   `(#x0f #x94 #xc0                      ; sete %al
          #x0f #xb6 #xc0))               ; movzbl %al,%eax
 
 (define (i386:xor-accu v)
+  (or n urg:xor-accu)
   `(#x35 ,@(int->bv32 v)))             ;xor    $0xff,%eax
 
 (define (i386:xor-zf)
   '(#x85 #xc0))                         ; test   %eax,%eax
 
 (define (i386:Xjump n)
-  `(#xe9 ,@(int->bv32 n)))              ; jmp . + <n>
+  (or n urg:Xjump)
+  `(#xe9 ,@(int->bv32 (if (>= n 0) n (- n 5))))) ; jmp . + <n>
 
 (define (i386:Xjump-nz n)
+  (or n urg:Xjump-nz)
   `(#x0f #x85 ,@(int->bv32 n)))         ; jnz . + <n>
 
-(define (i386:jump n)  ;;FIXME: NEED THIS WEIRDNESS for t.c
-  `(#xeb ,(if (>= n 0) (- n 2) (- n 2))))   ; jmp <n>
-
-;; (define (i386:jump n)
-;;   `(#xeb ,(if (>= n 0) n (- n 2))))     ; jmp <n>
+(define (i386:jump n) ;;FIXME: NEED THIS WEIRDNESS for t.c
+  (when (or (> n #x80) (< n #x-80))
+    (format (current-error-port) "JUMP n=~a\n" n)
+    barf)
+  `(#xeb ,(if (>= n 0) (- n 2) (- n 2)))) ; jmp <n>
 
 (define (i386:jump-c n)
+  (or n jump-c)
   `(#x72 ,(if (>= n 0) n (- n 2))))     ; jc <n>
 
 (define (i386:jump-cz n)
+  (or n jump-cz)
   `(#x76 ,(if (>= n 0) n (- n 2))))     ; jna <n>
 
 (define (i386:jump-ncz n)
+  (or n jump-ncz)
   `(#x77 ,(if (>= n 0) n (- n 2))))     ; ja <n>
 
 (define (i386:jump-nc n)
+  (or n jump-nc)
   `(#x73 ,(if (>= n 0) n (- n 2))))     ; jnc <n>
 
 (define (i386:jump-z n)
+  (or n jump-z)
   `(#x74 ,(if (>= n 0) n (- n 2)))) ; jz <n>
 
 (define (i386:jump-nz n)
+  (or n jump-nz)
   `(#x75 ,(if (>= n 0) n (- n 2)))) ; jnz <n>
 
 (define (i386:test-jump-z n)
+  (or n jump-z)
   `(#x85 #xc0                           ; test   %eax,%eax
     #x74 ,(if (>= n 0) n (- n 4))))     ; jz <n>
 
 (define (i386:jump-byte-nz n)
+  (or n jump-byte-nz)
   `(#x84 #xc0                           ; test   %al,%al
     #x75 ,(if (>= n 0) n (- n 4))))     ; jne <n>
 
 (define (i386:jump-byte-z n)
+  (or n jump-byte-z)
   `(#x84 #xc0                           ; test   %al,%al
     #x74 ,(if (>= n 0) n (- n 4))))     ; jne <n>
 
   `(#x29 #xc2))                         ; sub    %eax,%edx
 
 ;;;\f libc bits
-(define (i386:exit f g t d)
+(define (i386:exit f g ta t d)
   `(
     #x5b                                ; pop    %ebx
     #x5b                                ; pop    %ebx
     #xcd #x80                           ; int    $0x80
     ))
 
-(define (i386:open f g t d)
+(define (i386:open f g ta t d)
   `(
     #x55                                ; push   %ebp
     #x89 #xe5                           ; mov    %esp,%ebp
     #xc3                                ; ret
     ))
 
-(define (i386:read f g t d)
+(define (i386:read f g ta t d)
   `(
     #x55                                ; push   %ebp
     #x89 #xe5                           ; mov    %esp,%ebp
     #xc3                                ; ret
     ))
 
-(define (i386:write f g t d)
+(define (i386:write f g ta t d)
   `(
     #x55                                ; push   %ebp
     #x89 #xe5                           ; mov    %esp,%ebp
index 1ecb61803322d728c93f280b1dce905a4f3153a2..a7036d9b71b0b8a8afd427b93e0e84160ccfa505 100644 (file)
             i386:accu-not
             i386:accu-cmp-value
             i386:accu->base
+            i386:accu->base-address
+            i386:accu->base-address+n
             i386:accu->global
+            i386:accu->global-address
             i386:accu->local
             i386:accu-non-zero?
             i386:accu-test
             i386:accu-zero?
             i386:accu+accu
             i386:accu+base
+            i386:accu+value
+            i386:accu/base
+            i386:accu-base
             i386:accu-shl
             i386:base-sub
             i386:base->accu
-            i386:base->accu-ref
+            i386:base->accu-address
+            i386:byte-accu->base-address
+            i386:base->global
+            i386:base->local
             i386:base-mem->accu
             i386:byte-base-sub
-            i386:byte-base->accu-ref
+            i386:byte-base->accu-address
+            i386:byte-base->accu-address+n
             i386:byte-base-mem->accu
+            i386:local-address->accu
             i386:byte-local->accu
             i386:byte-mem->accu
             i386:base-mem+n->accu
             i386:byte-test-base
             i386:byte-sub-base
             i386:call
+            i386:call-accu
             i386:formal
             i386:function-locals
             i386:function-preamble
+            i386:global-add
             i386:global->accu
             i386:global->base
+            i386:global-address->accu
+            i386:global-address->base
             i386:jump
             i386:jump
             i386:jump-byte-nz
             i386:local->base
             i386:local-add
             i386:local-address->accu
-            i386:local-ref->base
+            i386:local-ptr->accu
+            i386:local-ptr->base
+            i386:local-address->base
             i386:local-test
             i386:mem->accu
             i386:mem+n->accu
+            i386:pop-accu
             i386:push-accu
+            i386:pop-base
+            i386:push-base
             i386:push-global
-            i386:push-global-ref
+            i386:push-global-address
             i386:push-local
             i386:push-local-de-ref
-            i386:push-local-ref
+            i386:push-local-address
             i386:ret
             i386:ret-local
             i386:sub-base
             i386:test-base
             i386:test-jump-z
             i386:value->accu
-            i386:value->accu-ref
-            i386:value->accu-ref+n
+            i386:value->accu-address
+            i386:value->accu-address+n
             i386:value->global
             i386:value->local
             i386:value->base
index 88e1c37b6078e9426e020b0cba9427f9f7b0d648..14dab35d1d3913432ff07b83f5f051655fa6766b 100644 (file)
@@ -32,6 +32,9 @@
 #define NYACC_CDR nyacc_cdr
 #endif
 
+char arena[2000];
+//char buf0[400];
+
 int g_stdin = 0;
 
 #if __GNUC__
@@ -219,112 +222,92 @@ void
 assert_fail (char* s)
 {
   eputs ("assert fail:");
+#if __GNUC__
   eputs (s);
+#endif
   eputs ("\n");
+#if __GNUC__
   *((int*)0) = 0;
+#endif
 }
 
-#if __NYACC__ || FIXME_NYACC
-#define assert(x) ((x) ? (void)0 : assert_fail(0))
-// #else
-// NYACC
-// #define assert(x) ((x) ? (void)0 : assert_fail(#x))
+#if __GNUC__
+#define assert(x) ((x) ? (void)0 : assert_fail ("boo:" #x))
+#else
+//#define assert(x) ((x) ? (void)0 : assert_fail ("boo:" #x))
+#define assert(x) ((x) ? (void)0 : assert_fail (0))
 #endif
-#define false 0
-#define true 1
-typedef int bool;
-
-int ARENA_SIZE = 100000;
 
 typedef int SCM;
 
 #if __GNUC__
-bool g_debug = false;
+int g_debug = 0;
 #endif
 
 int g_free = 0;
 
 SCM g_symbols = 0;
 SCM g_stack = 0;
-SCM r0 = 0; // a/env
-SCM r1 = 0; // param 1
-SCM r2 = 0; // save 2+load/dump
-SCM r3 = 0; // continuation
+// a/env
+SCM r0 = 0;
+// param 1
+SCM r1 = 0;
+// save 2+load/dump
+SCM r2 = 0;
+// continuation
+SCM r3 = 0;
 
 #if __NYACC__ || FIXME_NYACC
-enum type_t {CHAR, CLOSURE, CONTINUATION, FUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, TSTRING, SYMBOL, VALUES, TVECTOR, BROKEN_HEART};
+enum type_t {CHAR, CLOSURE, CONTINUATION, TFUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, TSTRING, SYMBOL, VALUES, TVECTOR, BROKEN_HEART};
 #else
 enum type_t {CHAR, CLOSURE, CONTINUATION, FUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, STRING, SYMBOL, VALUES, VECTOR, BROKEN_HEART};
 #endif
+
+struct scm {
+  enum type_t type;
+  SCM car;
+  SCM cdr;
+};
+
 typedef int (*f_t) (void);
-typedef SCM (*function0_t) (void);
-typedef SCM (*function1_t) (SCM);
-typedef SCM (*function2_t) (SCM, SCM);
-typedef SCM (*function3_t) (SCM, SCM, SCM);
-typedef SCM (*functionn_t) (SCM);
-typedef struct function_struct {
-  // union {
-  //   f_t function;
-  //   function0_t function0;
-  //   function1_t function1;
-  //   function2_t function2;
-  //   function3_t function3;
-  //   functionn_t functionn;
-  // } data;
-  f_t function;
+struct function {
+  int (*function) (void);
   int arity;
-} function_t;
-struct scm;
+};
+
+struct scm *g_cells = arena;
+
+//scm *g_news = 0;
+
+// struct scm scm_nil = {SPECIAL, "()"};
+// struct scm scm_f = {SPECIAL, "#f"};
+// struct scm scm_t = {SPECIAL, "#t"};
+// struct scm_dot = {SPECIAL, "."};
+// struct scm_arrow = {SPECIAL, "=>"};
+// struct scm_undefined = {SPECIAL, "*undefined*"};
+// struct scm_unspecified = {SPECIAL, "*unspecified*"};
+// struct scm_closure = {SPECIAL, "*closure*"};
+// struct scm_circular = {SPECIAL, "*circular*"};
+// struct scm_begin = {SPECIAL, "*begin*"};
+
+// struct scm_vm_apply = {SPECIAL, "core:apply"};
+// struct scm_vm_apply2 = {SPECIAL, "*vm-apply2*"};
+
+// struct scm_vm_eval = {SPECIAL, "core:eval"};
+
+// struct scm_vm_begin = {SPECIAL, "*vm-begin*"};
+// //scm scm_vm_begin_read_input_file = {SPECIAL, "*vm-begin-read-input-file*"};
+// struct scm_vm_begin2 = {SPECIAL, "*vm-begin2*"};
+
+// struct scm_vm_return = {SPECIAL, "*vm-return*"};
+
+// //#include "mes.symbols.h"
 
-typedef struct scm {
-  enum type_t type;
-  union {
-    char const *name;
-    SCM string;
-    SCM car;
-    SCM ref;
-    int length;
-  } NYACC_CAR;
-  union {
-    int value;
-    int function;
-    SCM cdr;
-    SCM closure;
-    SCM continuation;
-    SCM macro;
-    SCM vector;
-    int hits;
-  } NYACC_CDR;
-} scm;
-
-scm scm_nil = {SPECIAL, "()"};
-scm scm_f = {SPECIAL, "#f"};
-scm scm_t = {SPECIAL, "#t"};
-scm scm_dot = {SPECIAL, "."};
-scm scm_arrow = {SPECIAL, "=>"};
-scm scm_undefined = {SPECIAL, "*undefined*"};
-scm scm_unspecified = {SPECIAL, "*unspecified*"};
-scm scm_closure = {SPECIAL, "*closure*"};
-scm scm_circular = {SPECIAL, "*circular*"};
-scm scm_begin = {SPECIAL, "*begin*"};
-
-scm scm_vm_apply = {SPECIAL, "core:apply"};
-scm scm_vm_apply2 = {SPECIAL, "*vm-apply2*"};
-
-scm scm_vm_eval = {SPECIAL, "core:eval"};
-
-scm scm_vm_begin = {SPECIAL, "*vm-begin*"};
-//scm scm_vm_begin_read_input_file = {SPECIAL, "*vm-begin-read-input-file*"};
-scm scm_vm_begin2 = {SPECIAL, "*vm-begin2*"};
-
-scm scm_vm_return = {SPECIAL, "*vm-return*"};
-
-//#include "mes.symbols.h"
 #define cell_nil 1
 #define cell_f 2
 #define cell_t 3
 #define cell_dot 4
-#define cell_arrow 5
+// #define cell_arrow 5
 #define cell_undefined 6
 #define cell_unspecified 7
 #define cell_closure 8
@@ -348,61 +331,62 @@ scm scm_vm_return = {SPECIAL, "*vm-return*"};
 
 #define cell_vm_return 63
 
-#if 0
-char arena[200];
-struct scm *g_cells = (struct scm*)arena;
-#else
-struct scm g_cells[200];
-#endif
-
-//scm *g_news = 0;
-
-
 SCM tmp;
 SCM tmp_num;
 SCM tmp_num2;
 
-function_t functions[200];
+int ARENA_SIZE = 200;
+struct function functions[2];
 int g_function = 0;
 
 
 SCM make_cell (SCM type, SCM car, SCM cdr);
-function_t fun_make_cell = {&make_cell, 3};
-scm scm_make_cell = {FUNCTION, "make-cell", 0};
+struct function fun_make_cell = {&make_cell, 3};
+struct scm scm_make_cell = {TFUNCTION,0,0};
+   //, "make-cell", 0};
 SCM cell_make_cell;
 
 SCM cons (SCM x, SCM y);
-function_t fun_cons = {&cons, 2};
-scm scm_cons = {FUNCTION, "cons", 0};
+struct function fun_cons = {&cons, 2};
+struct scm scm_cons = {TFUNCTION,0,0};
+  // "cons", 0};
 SCM cell_cons;
 
 SCM car (SCM x);
-function_t fun_car = {&car, 1};
-scm scm_car = {FUNCTION, "car", 0};
+struct function fun_car = {&car, 1};
+struct scm scm_car = {TFUNCTION,0,0};
+  // "car", 0};
 SCM cell_car;
 
 SCM cdr (SCM x);
-function_t fun_cdr = {&cdr, 1};
-scm scm_cdr = {FUNCTION, "cdr", 0};
+struct function fun_cdr = {&cdr, 1};
+struct scm scm_cdr = {TFUNCTION,0,0};
+// "cdr", 0};
 SCM cell_cdr;
 
 // SCM eq_p (SCM x, SCM y);
-// function_t fun_eq_p = {&eq_p, 2};
-// scm scm_eq_p = {FUNCTION, "eq?", 0};
+// struct function fun_eq_p = {&eq_p, 2};
+// scm scm_eq_p = {TFUNCTION,0,0};// "eq?", 0};
 // SCM cell_eq_p;
 
 #define TYPE(x) (g_cells[x].type)
 
 #define CAR(x) g_cells[x].car
-#define LENGTH(x) g_cells[x].length
-#define STRING(x) g_cells[x].string
+#define LENGTH(x) g_cells[x].car
+#define STRING(x) g_cells[x].car
 
 #define CDR(x) g_cells[x].cdr
-#define CLOSURE(x) g_cells[x].closure
+#if __GNUC__
+//#define CLOSURE(x) g_cells[x].closure
+#endif
 #define CONTINUATION(x) g_cells[x].cdr
-#define FUNCTION(x) functions[g_cells[x].function]
-#define VALUE(x) g_cells[x].value
-#define VECTOR(x) g_cells[x].vector
+#if __GNUC__
+//#define FUNCTION(x) functions[g_cells[x].function]
+#endif
+
+#define FUNCTION(x) functions[g_cells[x].cdr]
+#define VALUE(x) g_cells[x].cdr
+#define VECTOR(x) g_cells[x].cdr
 
 #define MAKE_CHAR(n) make_cell (tmp_num_ (CHAR), 0, tmp_num2_ (n))
 //#define MAKE_CONTINUATION(n) make_cell (tmp_num_ (CONTINUATION), n, g_stack)
@@ -443,7 +427,7 @@ make_cell (SCM type, SCM car, SCM cdr)
   if (VALUE (type) == CHAR || VALUE (type) == NUMBER) {
     if (car) CAR (x) = CAR (car);
     if (cdr) CDR(x) = CDR(cdr);
-  } else if (VALUE (type) == FUNCTION) {
+  } else if (VALUE (type) == TFUNCTION) {
     if (car) CAR (x) = car;
     if (cdr) CDR(x) = CDR(cdr);
   } else {
@@ -470,8 +454,13 @@ tmp_num2_ (int x)
 SCM
 cons (SCM x, SCM y)
 {
+#if  __GNUC__
   VALUE (tmp_num) = PAIR;
   return make_cell (tmp_num, x, y);
+#else
+  //FIXME GNUC
+  return 0;
+#endif
 }
 
 SCM
@@ -498,24 +487,33 @@ cdr (SCM x)
   return CDR(x);
 }
 
+// SCM
+// eq_p (SCM x, SCM y)
+// {
+//   return (x == y
+//           || ((TYPE (x) == KEYWORD && TYPE (y) == KEYWORD
+//                && STRING (x) == STRING (y)))
+//           || (TYPE (x) == CHAR && TYPE (y) == CHAR
+//               && VALUE (x) == VALUE (y))
+//           || (TYPE (x) == NUMBER && TYPE (y) == NUMBER
+//               && VALUE (x) == VALUE (y)))
+//     ? cell_t : cell_f;
+// }
+
 SCM
-eq_p (SCM x, SCM y)
+gc_push_frame ()
 {
-  return (x == y
-          || ((TYPE (x) == KEYWORD && TYPE (y) == KEYWORD
-               && STRING (x) == STRING (y)))
-          || (TYPE (x) == CHAR && TYPE (y) == CHAR
-              && VALUE (x) == VALUE (y))
-          || (TYPE (x) == NUMBER && TYPE (y) == NUMBER
-              && VALUE (x) == VALUE (y)))
-    ? cell_t : cell_f;
+  SCM frame = cons (r1, cons (r2, cons (r3, cons (r0, cell_nil))));
+  g_stack = cons (frame, g_stack);
+  return g_stack;
 }
 
 SCM
-gc_push_frame ()
+xgc_push_frame ()
 {
-  SCM frame = cons (r1, cons (r2, cons (r3, cons (r0, cell_nil))));
-  return g_stack = cons (frame, g_stack);
+  // SCM frame = cons (r1, cons (r2, cons (r3, cons (r0, cell_nil))));
+  // g_stack = cons (frame, g_stack);
+  return g_stack;
 }
 
 SCM
@@ -540,7 +538,8 @@ pairlis (SCM x, SCM y, SCM a)
 SCM
 assq (SCM x, SCM a)
 {
-  while (a != cell_nil && eq_p (x, CAAR (a)) == cell_f) a = CDR (a);
+  //while (a != cell_nil && eq_p (x, CAAR (a)) == cell_f) a = CDR (a);
+  while (a != cell_nil && x == CAAR (a)) a = CDR (a);
   return a != cell_nil ? car (a) : cell_f;
 }
 
@@ -565,6 +564,7 @@ assert_defined (SCM x, SCM e)
 SCM
 push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
 {
+  puts ("push_cc\n");
   SCM x = r3;
   r3 = c;
   r2 = p2;
@@ -575,6 +575,20 @@ push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
   return cell_unspecified;
 }
 
+SCM
+xpush_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
+{
+  puts ("push_cc\n");
+  SCM x = r3;
+  r3 = c;
+  r2 = p2;
+  xgc_push_frame ();
+  r1 = p1;
+  r0 = a;
+  r3 = x;
+  return cell_unspecified;
+}
+
 SCM caar (SCM x) {return car (car (x));}
 SCM cadr (SCM x) {return car (cdr (x));}
 SCM cdar (SCM x) {return cdr (car (x));}
@@ -597,9 +611,9 @@ eval_apply ()
     case cell_vm_evlis2: goto evlis2;
     case cell_vm_evlis3: goto evlis3;
 #endif
-    case cell_vm_apply: goto apply;
-    case cell_vm_apply2: goto apply2;
- case cell_vm_eval: goto eval;
+    case cell_vm_apply: {goto apply;}
+    case cell_vm_apply2: {goto apply2;}
+    case cell_vm_eval: {goto eval;}
 #if 0
 #if FIXED_PRIMITIVES
     case cell_vm_eval_car: goto eval_car;
@@ -612,9 +626,9 @@ eval_apply ()
     case cell_vm_eval2: goto eval2;
     case cell_vm_macro_expand: goto macro_expand;
 #endif
-    case cell_vm_begin: goto begin;
+    case cell_vm_begin: {goto begin;}
       ///case cell_vm_begin_read_input_file: goto begin_read_input_file;
-    case cell_vm_begin2: goto begin2;
+    case cell_vm_begin2: {goto begin2;}
 #if 0
     case cell_vm_if: goto vm_if;
     case cell_vm_if_expr: goto if_expr;
@@ -622,9 +636,8 @@ eval_apply ()
     case cell_vm_call_with_values2: goto call_with_values2;
     case cell_vm_return: goto vm_return;
 #endif
-    case cell_unspecified: return r1;
-    default:
-      assert (0);
+    case cell_unspecified: {return r1;}
+    default: {assert (0);}
     }
 
   SCM x = cell_nil;
@@ -646,7 +659,7 @@ eval_apply ()
  apply:
   switch (TYPE (car (r1)))
     {
-    case FUNCTION: {
+    case TFUNCTION: {
       //check_formals (car (r1), MAKE_NUMBER (FUNCTION (car (r1)).arity), cdr (r1));
       r1 = call (car (r1), cdr (r1)); /// FIXME: move into eval_apply
       goto vm_return;
@@ -823,7 +836,7 @@ eval_apply ()
         r1 = assert_defined (r1, assq_ref_env (r1, r0));
         goto vm_return;
       }
-    default: goto vm_return;
+    default: {goto vm_return;}
     }
 
 //   SCM macro;
@@ -937,7 +950,7 @@ call (SCM fn, SCM x)
   if ((FUNCTION (fn).arity > 1 || FUNCTION (fn).arity == -1)
       && x != cell_nil && TYPE (CDR (x)) == PAIR && TYPE (CADR (x)) == VALUES)
     x = cons (CAR (x), cons (CDADAR (x), CDR (x)));
-  function_t* f = &FUNCTION (fn);
+  struct function* f = &FUNCTION (fn);
   switch (FUNCTION (fn).arity)
     {
     // case 0: return FUNCTION (fn).function0 ();
@@ -945,11 +958,12 @@ call (SCM fn, SCM x)
     // case 2: return FUNCTION (fn).function2 (car (x), cadr (x));
     // case 3: return FUNCTION (fn).function3 (car (x), cadr (x), car (cddr (x)));
     // case -1: return FUNCTION (fn).functionn (x);
-    case 0: return (FUNCTION (fn).function) ();
-    case 1: return ((SCM(*)(SCM))(FUNCTION (fn).function)) (car (x));
-    case 2: return ((SCM(*)(SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x));
-    case 3: return ((SCM(*)(SCM,SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x), car (cddr (x)));
-    case -1: return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);
+    case 0: {return (FUNCTION (fn).function) ();}
+    case 1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (car (x));}
+    case 2: {return ((SCM(*)(SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x));}
+    case 3: {return ((SCM(*)(SCM,SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x), car (cddr (x)));}
+      //case -1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);}
+    default: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);}
     }
 
   return cell_unspecified;
@@ -987,7 +1001,7 @@ mes_g_stack (SCM a) ///((internal))
 
 //\f Environment setup
 SCM
-make_tmps (scm* cells)
+make_tmps (struct scm* cells)
 {
   tmp = g_free++;
   cells[tmp].type = CHAR;
@@ -995,6 +1009,7 @@ make_tmps (scm* cells)
   cells[tmp_num].type = NUMBER;
   tmp_num2 = g_free++;
   cells[tmp_num2].type = NUMBER;
+  return 0;
 }
 
 SCM
@@ -1066,67 +1081,68 @@ mes_symbols () ///((internal))
   //#include "mes.symbols.i"
 #else
 g_free++;
-g_cells[cell_nil] = scm_nil;
+// g_cells[cell_nil] = scm_nil;
 
 g_free++;
-g_cells[cell_f] = scm_f;
+// g_cells[cell_f] = scm_f;
 
 g_free++;
-g_cells[cell_t] = scm_t;
+// g_cells[cell_t] = scm_t;
 
 g_free++;
-g_cells[cell_dot] = scm_dot;
+// g_cells[cell_dot] = scm_dot;
 
 g_free++;
-g_cells[cell_arrow] = scm_arrow;
+// g_cells[cell_arrow] = scm_arrow;
 
 g_free++;
-g_cells[cell_undefined] = scm_undefined;
+// g_cells[cell_undefined] = scm_undefined;
 
 g_free++;
-g_cells[cell_unspecified] = scm_unspecified;
+// g_cells[cell_unspecified] = scm_unspecified;
 
 g_free++;
-g_cells[cell_closure] = scm_closure;
+// g_cells[cell_closure] = scm_closure;
 
 g_free++;
-g_cells[cell_circular] = scm_circular;
+// g_cells[cell_circular] = scm_circular;
 
 g_free++;
-g_cells[cell_begin] = scm_begin;
+// g_cells[cell_begin] = scm_begin;
 
 ///
 g_free = 44;
 g_free++;
-g_cells[cell_vm_apply] = scm_vm_apply;
+// g_cells[cell_vm_apply] = scm_vm_apply;
 
 g_free++;
-g_cells[cell_vm_apply2] = scm_vm_apply2;
+// g_cells[cell_vm_apply2] = scm_vm_apply2;
 
 g_free++;
-g_cells[cell_vm_eval] = scm_vm_eval;
+// g_cells[cell_vm_eval] = scm_vm_eval;
 
 ///
 g_free = 55;
 g_free++;
-g_cells[cell_vm_begin] = scm_vm_begin;
+// g_cells[cell_vm_begin] = scm_vm_begin;
 
 g_free++;
 // g_cells[cell_vm_begin_read_input_file] = scm_vm_begin_read_input_file;
 
 g_free++;
-g_cells[cell_vm_begin2] = scm_vm_begin2;
+// g_cells[cell_vm_begin2] = scm_vm_begin2;
 
 ///
 g_free = 62;
 g_free++;
-g_cells[cell_vm_return] = scm_vm_return;
+// g_cells[cell_vm_return] = scm_vm_return;
 
 #endif
 
   g_symbol_max = g_free;
   make_tmps (g_cells);
 
+  // FIXME GNUC
   g_symbols = 0;
   for (int i=1; i<g_symbol_max; i++)
     g_symbols = cons (i, g_symbols);
@@ -1136,21 +1152,22 @@ g_cells[cell_vm_return] = scm_vm_return;
 #if __GNUC__ && 0
   //#include "mes.symbol-names.i"
 #else
-g_cells[cell_nil].car = cstring_to_list (scm_nil.name);
-g_cells[cell_f].car = cstring_to_list (scm_f.name);
-g_cells[cell_t].car = cstring_to_list (scm_t.name);
-g_cells[cell_dot].car = cstring_to_list (scm_dot.name);
-g_cells[cell_arrow].car = cstring_to_list (scm_arrow.name);
-g_cells[cell_undefined].car = cstring_to_list (scm_undefined.name);
-g_cells[cell_unspecified].car = cstring_to_list (scm_unspecified.name);
-g_cells[cell_closure].car = cstring_to_list (scm_closure.name);
-g_cells[cell_circular].car = cstring_to_list (scm_circular.name);
-g_cells[cell_begin].car = cstring_to_list (scm_begin.name);
+// g_cells[cell_nil].car = cstring_to_list (scm_nil.name);
+// g_cells[cell_f].car = cstring_to_list (scm_f.name);
+// g_cells[cell_t].car = cstring_to_list (scm_t.name);
+// g_cells[cell_dot].car = cstring_to_list (scm_dot.name);
+// g_cells[cell_arrow].car = cstring_to_list (scm_arrow.name);
+// g_cells[cell_undefined].car = cstring_to_list (scm_undefined.name);
+// g_cells[cell_unspecified].car = cstring_to_list (scm_unspecified.name);
+// g_cells[cell_closure].car = cstring_to_list (scm_closure.name);
+// g_cells[cell_circular].car = cstring_to_list (scm_circular.name);
+// g_cells[cell_begin].car = cstring_to_list (scm_begin.name);
 #endif
 
   // a = acons (cell_symbol_mes_version, MAKE_STRING (cstring_to_list (VERSION)), a);
   // a = acons (cell_symbol_mes_prefix, MAKE_STRING (cstring_to_list (PREFIX)), a);
 
+  //FIXME GNUC
   a = acons (cell_symbol_dot, cell_dot, a); //
   a = acons (cell_symbol_begin, cell_begin, a);
   a = acons (cell_closure, a, a);
@@ -1170,8 +1187,10 @@ make_closure (SCM args, SCM body, SCM a)
 SCM
 mes_environment () ///((internal))
 {
-  SCM a = mes_symbols ();
-  return mes_g_stack (a);
+  SCM a = 0;
+  a = mes_symbols ();
+  a = mes_g_stack (a);
+  return a;
 }
 
 SCM
@@ -1192,22 +1211,39 @@ mes_builtins (SCM a)
 // #include "posix.environment.i"
 // #include "reader.environment.i"
 #else
-scm_make_cell.function = g_function;
+
+scm_make_cell.cdr = g_function;
 functions[g_function++] = fun_make_cell;
 cell_make_cell = g_free++;
-g_cells[cell_make_cell] = scm_make_cell;
-
-scm_cons.function = g_function;
+#if __GNUC__
+ puts ("WOOOT=");
+ puts (itoa (g_free));
+  //FIXME GNUC
+#else
+g_cells[16] = scm_make_cell;
+#endif
+scm_cons.cdr = g_function;
 functions[g_function++] = fun_cons;
 cell_cons = g_free++;
+#if __GNUC__
+  //FIXME GNUC
 g_cells[cell_cons] = scm_cons;
-
-scm_car.function = g_function;
+#else
+g_cells[17] = scm_cons;
+#endif
+scm_car.cdr = g_function;
 functions[g_function++] = fun_car;
 cell_car = g_free++;
+#if __GNUC__
+  //FIXME GNUC
 g_cells[cell_car] = scm_car;
-
-scm_cdr.function = g_function;
+#endif
+#if __GNUC__
+  //FIXME GNUC
+scm_cdr.cdr = g_function;
 functions[g_function++] = fun_cdr;
 cell_cdr = g_free++;
 g_cells[cell_cdr] = scm_cdr;
@@ -1227,6 +1263,7 @@ g_cells[cell_cdr] = scm_cdr;
 // scm_cdr.string = cstring_to_list (scm_cdr.name);
 // g_cells[cell_cdr].string = MAKE_STRING (scm_cdr.string);
 // a = acons (make_symbol (scm_cdr.string), cell_cdr, a);
+#endif
 #endif
   return a;
 }
@@ -1250,7 +1287,7 @@ bload_env (SCM a) ///((internal))
       *p++ = c;
       c = getchar ();
     }
-  g_free = (p-(char*)g_cells) / sizeof (scm);
+  g_free = (p-(char*)g_cells) / sizeof (struct scm);
   gc_peek_frame ();
   g_symbols = r1;
   g_stdin = STDIN;
@@ -1287,7 +1324,7 @@ fill ()
   CDR (12) = 1;
 
   TYPE (13) = CHAR;
-  CAR (11) = 0x58585858;
+  CAR (13) = 0x58585858;
   CDR (13) = 90;
 
   TYPE (14) = 0x58585858;
@@ -1303,18 +1340,20 @@ fill ()
   CAR (10) = 11;
   CDR (10) = 12;
 
-  TYPE (11) = FUNCTION;
+  TYPE (11) = TFUNCTION;
   CAR (11) = 0x58585858;
   // 0 = make_cell
   // 1 = cons
+  // 2 = car
   CDR (11) = 1;
 
   TYPE (12) = PAIR;
   CAR (12) = 13;
+  //CDR (12) = 1;
   CDR (12) = 14;
 
   TYPE (13) = NUMBER;
-  CAR (13) =0x58585858;
+  CAR (13) = 0x58585858;
   CDR (13) = 0;
 
   TYPE (14) = PAIR;
@@ -1326,9 +1365,7 @@ fill ()
   CDR (15) = 1;
 
 #endif
-  TYPE (16) = 0x3c3c3c3c;
-  CAR (16) = 0x2d2d2d2d;
-  CDR (16) = 0x2d2d2d2d;
+
   return 0;
 }
 
@@ -1345,7 +1382,7 @@ display_ (SCM x)
         putchar (VALUE (x));
         break;
       }
-    case FUNCTION:
+    case TFUNCTION:
       {
         //puts ("<function>\n");
         if (VALUE (x) == 0)
@@ -1408,29 +1445,29 @@ display_ (SCM x)
 SCM
 simple_bload_env (SCM a) ///((internal))
 {
-  //g_stdin = open ("module/mes/read-0-32.mo", 0);
-  g_stdin = open ("module/mes/hack-32.mo", 0);
+  puts ("reading: ");
+  char *mo = "module/mes/hack-32.mo";
+  puts (mo);
+  puts ("\n");
+  g_stdin = open (mo, 0);
   if (g_stdin < 0) {eputs ("no such file: module/mes/read-0-32.mo\n");return 1;} 
 
-  int c;
   char *p = (char*)g_cells;
-  char *q = (char*)g_cells;
-
-  puts ("q: ");
-  puts (q);
-  puts ("\n");
+  int c;
 
-#if __GNUC__
+#if 0
+  //__GNUC__
   puts ("fd: ");
   puts (itoa (g_stdin));
   puts ("\n");
 #endif
 
-#if __GNUC__
+#if 0
+  //__GNUC__
   assert (getchar () == 'M');
   assert (getchar () == 'E');
   assert (getchar () == 'S');
-  puts ("GOT MES!\n");
+  puts (" *GOT MES*\n");
   g_stack = getchar () << 8;
   g_stack += getchar ();
   puts ("stack: ");
@@ -1446,8 +1483,9 @@ simple_bload_env (SCM a) ///((internal))
   c = getchar ();
   putchar (c);
   if (c != 'S') exit (12);
-  puts ("\n");
-  puts ("GOT MES!\n");
+  puts (" *GOT MES*\n");
+
+  // skip stack
   getchar ();
   getchar ();
 #endif
@@ -1457,20 +1495,19 @@ simple_bload_env (SCM a) ///((internal))
     {
       *p++ = c;
       c = getchar ();
+      putchar (c);
     }
 
-  puts ("q: ");
-  puts (q);
-  puts ("\n");
-#if 1
-  //__GNUC__
+  puts ("read done\n");
+
   g_free = (p-(char*)g_cells) / sizeof (struct scm);
   // gc_peek_frame ();
   // g_symbols = r1;
   g_symbols = 1;
   g_stdin = STDIN;
   r0 = mes_builtins (r0);
-
+  
+#if __GNUC__
   puts ("cells read: ");
   puts (itoa (g_free));
   puts ("\n");
@@ -1478,33 +1515,31 @@ simple_bload_env (SCM a) ///((internal))
   puts ("symbols: ");
   puts (itoa (g_symbols));
   puts ("\n");
-  display_ (g_symbols);
+  // display_ (g_symbols);
+  // puts ("\n");
+#endif
+
+  display_ (10);
   puts ("\n");
 
   fill ();
-
   r2 = 10;
-  puts ("\n");
-  puts ("program: ");
+
+  if (TYPE (12) != PAIR)
+    exit (33);
+
+  puts ("program[");
+#if __GNUC__
   puts (itoa (r2));
-  puts ("\n");
-  display_ (r2);
-  puts ("\n");
-#else
-  display_ (10);
-  puts ("\n");
-  puts ("\n");
-  fill ();
-  display_ (10);
 #endif
+  puts ("]: ");
+
+  display_ (r2);
+  //display_ (14);
   puts ("\n");
-  g_stack = 20;
-  TYPE (20) = SYMBOL;
-  CAR (20) = 1;
 
   r0 = 1;
-  //g_free = 21;
-  r2 = 10;
+  //r2 = 10;
   return r2;
 }
 
@@ -1551,16 +1586,25 @@ stderr_ (SCM x)
 int
 main (int argc, char *argv[])
 {
-  puts ("mini-mes!\n");
+  puts ("Hello mini-mes!\n");
 #if __GNUC__
   //g_debug = getenv ("MES_DEBUG");
 #endif
   //if (getenv ("MES_ARENA")) ARENA_SIZE = atoi (getenv ("MES_ARENA"));
   if (argc > 1 && !strcmp (argv[1], "--help")) return eputs ("Usage: mes [--dump|--load] < FILE");
+#if __GNUC__
   if (argc > 1 && !strcmp (argv[1], "--version")) {eputs ("Mes ");return eputs (VERSION);};
+#else
+  if (argc > 1 && !strcmp (argv[1], "--version")) {eputs ("Mes ");return eputs ("0.4");};
+#endif
   g_stdin = STDIN;
-  r0 = mes_environment ();
 
+#if 1
+  r0 = mes_environment ();
+#else
+  puts ("FIXME: mes_environment ()\n");
+#endif
+  
 #if MES_MINI
   SCM program = simple_bload_env (r0);
 #else  
@@ -1588,7 +1632,6 @@ main (int argc, char *argv[])
       eputs ("]\n");
     }
 #endif
-  puts ("Hello mini-mes!\n");
   return 0;
 }
 
index 39884362c973e0c233fd1eab5e05c06099a7c9df..411b9185d89cc0672626ff731aefa29f88d02a7f 100644 (file)
@@ -87,34 +87,42 @@ strcmp (char const* a, char const* b)
   while (*a && *b && *a == *b) {a++;b++;}
   return *a - *b;
 }
-int test (char *p);
 #endif
 
-// struct scm {
-//   int type;
-//   int car;
-//   int cdr;
-// };
+struct scm {
+  int type;
+  int car;
+  int cdr;
+};
 
-char arena[20];
-char *g_cells = arena;
+char arena[200];
+struct scm *g_cells = arena;
+char *g_chars = arena;
+char buf[200];
 
-int
-main (int argc, char *argv[])
-{
-  char *p = "t.c\n";
-  puts ("t.c\n");
+int foo () {puts ("t: foo\n"); return 0;};
+int bar () {puts ("t: bar\n"); return 0;};
+struct function {
+  int (*function) (void);
+  int arity;
+};
+struct function g_fun = {&exit, 1};
+struct function g_foo = {&foo, 1};
+struct function g_bar = {&bar, 1};
 
-  if (argc > 1 && !strcmp (argv[1], "--help")) return 1;
-  puts ("t: if (argc > 1 && !strcmp (argv[1], \"--help\")\n");
+//void *functions[2];
+int functions[2];
 
-  // FIXME mescc?!
-  if (argc > 1) if (!strcmp (argv[1], "--help")) return 1;
+struct function g_functions[2];
+int g_function = 0;
 
-  return test (p);
-  return 22;
-}
+enum type_t {CHAR, CLOSURE, CONTINUATION, TFUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, TSTRING, SYMBOL, VALUES, TVECTOR, BROKEN_HEART};
+
+typedef int SCM;
+int g_free = 3;
+SCM tmp;
 
+#if 1
 int
 swits (int c)
 {
@@ -141,6 +149,128 @@ swits (int c)
   return x;
 }
 
+int g = 48;
+int
+get ()
+{
+  int i = g;
+  g++;
+  return i;
+}
+
+int
+read_test ()
+{
+  puts ("read test\n");
+  char *p = (char*)g_chars;
+  int i = 0;
+  puts ("t: read 0123456789\n");
+  int c = get ();
+  while (i < 10) {
+    *p++ = c;
+    putchar (c);
+    c = get ();
+    i++;
+  }
+  puts ("\n");
+  if (strcmp (g_chars, "0123456789")) return 1;
+  return 0;
+}
+
+int
+math_test ()
+{
+  int i;
+  puts ("t: 4/2=");
+  i = 4 / 2;
+  if (i!=2) return 1;
+  i += 48;
+  putchar (i);
+  puts ("\n");
+  return read_test ();
+}
+
+SCM
+make_tmps_test (struct scm* cells)
+{
+  puts ("t: tmp = g_free++\n");
+  tmp = g_free++;
+  puts ("t: cells[tmp].type = CHAR\n");
+  cells[tmp].type = CHAR;
+  return math_test();
+}
+
+#define TYPE(x) (g_cells[x].type)
+#define CAR(x) g_cells[x].car
+#define CDR(x) g_cells[x].cdr
+
+struct scm scm_fun = {TFUNCTION,0,0};
+SCM cell_fun;
+
+int
+struct_test ()
+{
+  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);
+
+  puts ("t: struct fun = {&exit, 1};\n");
+  struct function fun = {&exit, 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: fun.arity != 1;\n");
+  if (fun.arity != 1) return 1;
+
+  puts ("t: fun.function != exit;\n");
+  if (fun.function != &exit) return 1;
+
+  puts ("t: g_functions[g_function++] = g_foo;\n");
+  g_functions[g_function++] = g_foo;
+
+  int fn = 0;
+  puts ("t: g_functions[g_cells[fn].cdr].arity\n");
+  if (!g_functions[g_cells[fn].cdr].arity) return 1;
+
+  int (*functionx) (void) = 0;
+  functionx = g_functions[0].function;
+  puts ("t: *functionx == foo\n");
+  if (*functionx != foo) return 11;
+
+  puts ("t: (*functionx) () == foo\n");
+  if ((*functionx) () != 0) return 12;
+
+  fn++;
+  g_functions[0] = g_bar;
+  if (g_cells[fn].cdr != 0) return 13;
+  puts ("t: g_functions[g_cells[fn].cdr].function\n");
+  functionx = g_functions[g_cells[fn].cdr].function;
+  puts ("t: *functionx == bar\n");
+  if (*functionx != bar) return 15;
+  puts ("t: (*functionx) () == bar\n");
+  if ((*functionx) () != 0) return 16;
+
+  scm_fun.cdr = g_function;
+  g_functions[g_function++] = g_fun;
+  cell_fun = g_free++;
+  g_cells[cell_fun] = scm_fun;
+
+  return make_tmps_test  (g_cells);
+}
+
 int
 test (char *p)
 {
@@ -148,6 +278,10 @@ test (char *p)
   int t = 1;
   int one = 1;
   char c = 'C';
+  int i=0;
+
+  char *x = arena;
+  char *y = g_chars;
 
   puts ("t: if (0)\n");
   if (0) return 1;
@@ -194,34 +328,46 @@ test (char *p)
   puts ("t: if (t && !one)\n");
   if (t && !one) return 1;
 
-  int i=0;
+  puts ("t: if (f || !t)\n");
+  if (f || !t) return 1;
+
   puts ("t: if (i++)\n");
   if (i++) return 1;
 
   puts ("t: if (--i)\n");
   if (--i) return 1;
 
+  puts ("t: i += 2\n");
+  i += 2;
+  if (i != 2) return 1;
+
+  puts ("t: i -= 2\n");
+  i -= 2;
+  if (i != 0) return 1;
+
   puts ("t: (one == 1) ?\n");
   (one == 1) ? 1 : exit (1);
 
   puts ("t: (f) ?\n");
   (f) ? exit (1) : 1;
 
-  puts ("t: *g_cells != 'A'\n");
+  puts ("t: *g_chars != 'A'\n");
   arena[0] = 'A';
-  if (*g_cells != 'A') return 1;
+  if (*g_chars != 'A') return 1;
 
   puts ("t: *x != 'A'\n");
-  char *x = g_cells;
   if (*x != 'A') return 1;
 
+  puts ("t: *y != 'A'\n");
+  if (*y != 'A') return 1;
+
   puts ("t: *x != 'Q'\n");
-  g_cells[0] = 'Q';
+  g_chars[0] = 'Q';
   if (*x != 'Q') return 1;
 
   puts ("t: *x++ != 'C'\n");
   *x++ = c;
-  if (*g_cells != 'C') return 1;
+  if (*g_chars != 'C') return 1;
 
   puts ("t: switch 0\n");
   if (swits (0) != 0) return swits (0);
@@ -237,6 +383,10 @@ test (char *p)
   return 1;
  ok0:
   
+  puts ("t: if (0); return 1; else;\n");
+  if (0) return 1; else goto ok01;
+ ok01:
+
   puts ("t: if (t)\n");
   if (t) goto ok1;
   return 1;
@@ -291,6 +441,11 @@ test (char *p)
   return 1;
  ok8:
 
+  puts ("t: if (f || t)\n");
+  if (f || t) goto ok80;
+  return 1;
+ ok80:
+
   puts ("t: if (++i)\n");
   if (++i) goto ok9;
   return 1;
@@ -301,36 +456,59 @@ test (char *p)
   return 1;
  ok10:
 
-  puts ("t: *g_cells == 'B'\n");
+  puts ("t: *g_chars == 'B'\n");
   arena[0] = 'B';
-  if (*g_cells == 'B') goto ok11;
+  if (*g_chars == 'B') goto ok11;
   return 1;
- ok11:
 ok11:
 
   puts ("t: *x == 'B'\n");
-  x = g_cells;
+  x = arena;
   if (*x == 'B') goto ok12;
   return 1;
  ok12:
 
-  puts ("t: *x == 'R'\n");
-  g_cells[0] = 'R';
-  x = g_cells;
-  if (*x == 'R') goto ok13;
+  puts ("t: *y == 'B'\n");
+  y = g_chars;
+  if (*y == 'B') goto ok13;
   return 1;
  ok13:
 
+  puts ("t: *x == 'R'\n");
+  g_chars[0] = 'R';
+  if (*x == 'R') goto ok14;
+  return 1;
+ ok14:
+
   puts ("t: *x++ == 'C'\n");
   *x++ = c;
-  if (*g_cells == 'C') goto ok14;
+  if (*g_chars == 'C') goto ok15;
   return 1;
- ok14:
+ ok15:
 
-  puts ("t: for (i=0; i<4; ++i)\n");
-  for (i=0; i<4; ++i);
-  if (i != 4) return i;
+  puts ("t: for (i=1; i<5; ++i)\n");
+  for (i=1; i<5; ++i);
+  if (i != 5) return i;
 
-  return 0;
+  return struct_test ();
+}
+#endif
+
+int
+main (int argc, char *argv[])
+{
+  char *p = "t.c\n";
+  puts ("t.c\n");
+
+  if (argc > 1 && !strcmp (argv[1], "--help")) return 1;
+  puts ("t: if (argc > 1 && !strcmp (argv[1], \"--help\")\n");
+
+  // FIXME mescc?!
+  if (argc > 1) if (!strcmp (argv[1], "--help")) return 1;
+
+  return test (p);
+
+  return 22;
 }
 
 #if __GNUC__
index 5e7261b20961dbeb9c57d40de46ea7f1d59763ef..2804e6f20062f032b56d71a1ea32c3033dab3d1a 100644 (file)
@@ -31,6 +31,8 @@
 #define NYACC_CDR nyacc_cdr
 #endif
 
+char arena[200];
+
 int g_stdin = 0;
 
 #if __GNUC__
@@ -262,12 +264,10 @@ struct scm {
   SCM cdr;
 };
 
-#if 0
-char arena[200];
-struct scm *g_cells = (struct scm*)arena;
-#else
-struct scm g_cells[200];
-#endif
+//char arena[200];
+//struct scm *g_cells = arena;
+//struct scm *g_cells = (struct scm*)arena;
+struct scm *g_cells = arena;
 
 #define cell_nil 1
 #define cell_f 2
@@ -348,7 +348,7 @@ fill ()
   TYPE (9) = 0x2d2d2d2d;
   CAR (9) = 0x2d2d2d2d;
   CDR (9) = 0x3e3e3e3e;
-#if 0
+
   // (A(B))
   TYPE (10) = PAIR;
   CAR (10) = 11;
@@ -373,35 +373,7 @@ fill ()
   TYPE (14) = 0x58585858;
   CAR (14) = 0x58585858;
   CDR (14) = 0x58585858;
-#else
-  // (cons 0 1)
-  TYPE (10) = PAIR;
-  CAR (10) = 11;
-  CDR (10) = 12;
 
-  TYPE (11) = FUNCTION;
-  CAR (11) = 0x58585858;
-  // 0 = make_cell
-  // 1 = cons
-  CDR (11) = 1;
-
-  TYPE (12) = PAIR;
-  CAR (12) = 13;
-  CDR (12) = 14;
-
-  TYPE (13) = NUMBER;
-  CAR (13) =0x58585858;
-  CDR (13) = 0;
-
-  TYPE (14) = PAIR;
-  CAR (14) = 15;
-  CDR (14) = 1;
-
-  TYPE (15) = NUMBER;
-  CAR (15) = 0x58585858;
-  CDR (15) = 1;
-
-#endif
   TYPE (16) = 0x3c3c3c3c;
   CAR (16) = 0x2d2d2d2d;
   CDR (16) = 0x2d2d2d2d;
@@ -484,35 +456,18 @@ display_ (SCM x)
 SCM
 bload_env (SCM a) ///((internal))
 {
-  //g_stdin = open ("module/mes/read-0-32.mo", 0);
-  g_stdin = open ("module/mes/hack-32.mo", 0);
+  puts ("reading: ");
+  char *mo = "module/mes/hack-32.mo";
+  puts (mo);
+  puts ("\n");
+  g_stdin = open (mo, 0);
   if (g_stdin < 0) {eputs ("no such file: module/mes/read-0-32.mo\n");return 1;} 
 
-  int c;
+  // BOOM
+  //char *p = arena;
   char *p = (char*)g_cells;
-  char *q = (char*)g_cells;
-
-  puts ("q: ");
-  puts (q);
-  puts ("\n");
-
-#if __GNUC__
-  puts ("fd: ");
-  puts (itoa (g_stdin));
-  puts ("\n");
-#endif
+  int c;
 
-#if __GNUC__
-  assert (getchar () == 'M');
-  assert (getchar () == 'E');
-  assert (getchar () == 'S');
-  puts ("GOT MES!\n");
-  g_stack = getchar () << 8;
-  g_stack += getchar ();
-  puts ("stack: ");
-  puts (itoa (g_stack));
-  puts ("\n");
-#else
   c = getchar ();
   putchar (c);
   if (c != 'M') exit (10);
@@ -522,54 +477,30 @@ bload_env (SCM a) ///((internal))
   c = getchar ();
   putchar (c);
   if (c != 'S') exit (12);
-  puts ("\n");
-  puts ("GOT MES!\n");
+  puts (" *GOT MES*\n");
+
+  // skip stack
   getchar ();
   getchar ();
-#endif
 
   c = getchar ();
+  // int i = 0;
   while (c != -1)
     {
       *p++ = c;
+      //g_cells[i] = c;
+      // i++;
       c = getchar ();
+      //puts ("\nc:");
+      //putchar (c);
     }
 
-  puts ("q: ");
-  puts (q);
-  puts ("\n");
-#if 0
-  //__GNUC__
-  g_free = (p-(char*)g_cells) / sizeof (struct scm);
-  gc_peek_frame ();
-  g_symbols = r1;
-  g_stdin = STDIN;
-  r0 = mes_builtins (r0);
-
-  puts ("cells read: ");
-  puts (itoa (g_free));
-  puts ("\n");
-
-  puts ("symbols: ");
-  puts (itoa (g_symbols));
-  puts ("\n");
-  display_ (g_symbols);
-  puts ("\n");
-
-  r2 = 10;
-  puts ("\n");
-  puts ("program: ");
-  puts (itoa (r2));
-  puts ("\n");
-  display_ (r2);
-  puts ("\n");
-#else
-  display_ (10);
-  puts ("\n");
-  puts ("\n");
-  fill ();
+  puts ("read done\n");
   display_ (10);
-#endif
+  // puts ("\n");
+  // fill ();
+  // display_ (10);
+
   puts ("\n");
   return r2;
 }
@@ -577,52 +508,20 @@ bload_env (SCM a) ///((internal))
 int
 main (int argc, char *argv[])
 {
-  puts ("filled sexp:\n");
+  // if (argc > 1 && !strcmp (argv[1], "--help")) return eputs ("Usage: mes [--dump|--load] < FILE\n");
+  // if (argc > 1 && !strcmp (argv[1], "--version")) {eputs ("Mes ");eputs (VERSION);return eputs ("\n");};
+
+  // if (argc > 1 && !strcmp (argv[1], "--help")) return eputs ("Usage: mes [--dump|--load] < FILE\n");
+
+  // puts ("Hello tiny-mes!\n");
   fill ();
+  puts (g_cells);
+  puts ("\n");
+  // return 22;
   display_ (10);
   puts ("\n");
-
-#if __GNUC__
-  g_debug = (int)getenv ("MES_DEBUG");
-#endif
-  //if (getenv ("MES_ARENA")) ARENA_SIZE = atoi (getenv ("MES_ARENA"));
-
-  if (argc > 1 && !strcmp (argv[1], "--help")) return eputs ("Usage: mes [--dump|--load] < FILE\n");
-  if (argc > 1 && !strcmp (argv[1], "--version")) {eputs ("Mes ");eputs (VERSION);return eputs ("\n");};
-
-  if (argc > 1 && !strcmp (argv[1], "--help")) return eputs ("Usage: mes [--dump|--load] < FILE\n");
-
-
-#if __GNUC__
-  g_stdin = STDIN;
-  r0 = mes_environment ();
-#endif
-
-#if MES_MINI
-  puts ("Hello tiny-mes!\n");
   SCM program = bload_env (r0);
 
-#else
-  SCM program = (argc > 1 && !strcmp (argv[1], "--load"))
-    ? bload_env (r0) : load_env (r0);
-  if (argc > 1 && !strcmp (argv[1], "--dump")) return dump ();
-
-  push_cc (r2, cell_unspecified, r0, cell_unspecified);
-  r3 = cell_vm_begin;
-  r1 = eval_apply ();
-  stderr_ (r1);
-
-  eputs ("\n");
-  gc (g_stack);
-#endif
-#if __GNUC__
-  if (g_debug)
-    {
-      eputs ("\nstats: [");
-      eputs (itoa (g_free));
-      eputs ("]\n");
-    }
-#endif
   return 0;
 }