mescc: Support any expression as arg.

* module/language/c99/compiler.mes (expr->arg): Also push parameter,
  always return info.
  (ast->info): Loop over args.  Fixes using function calls in arguments.
* module/mes/libc-i386.mes (i386:push-arg): Remove.
  (i386:call, i386:call-accu): Remove arguments parameter.
* doc/examples/t.c: Test it.

module/language/c99/compiler.mes

@@ -176,18 +176,33 @@
                           (text text))
                          (make <info> #:types types #:constants constants #:functions functions #:globals globals #:init init #:locals locals #:function function #:text text))))))
 
-(define (push-global-address globals)
-  (lambda (o)
-     (lambda (f g ta t d)
-      (i386:push-global-address (+ (data-offset o g) d)))))
-
 (define (push-global globals)
   (lambda (o)
     (lambda (f g ta t d)
       (i386:push-global (+ (data-offset o g) d)))))
 
+(define (push-local locals)
+  (lambda (o)
+    (lambda (f g ta t d)
+      (i386:push-local (local:id o)))))
+
+(define (push-global-address globals)
+  (lambda (o)
+     (lambda (f g ta t d)
+       (i386:push-global-address (+ (data-offset o g) d)))))
+
+(define (push-local-address locals)
+  (lambda (o)
+    (lambda (f g ta t d)
+      (i386:push-local-address (local:id o)))))
+
 (define push-global-de-ref push-global)
 
+(define (push-local-de-ref locals)
+  (lambda (o)
+    (lambda (f g ta t d)
+      (i386:push-local-de-ref (local:id o)))))
+
 (define (string->global string)
   (make-global string "string" 0 (append (string->list string) (list #\nul))))
 
@@ -203,97 +218,118 @@
 (define (push-ident info)
   (lambda (o)
     (let ((local (assoc-ref (.locals info) o)))
-      (if local (i386:push-local (local:id local))
+      (if local ((push-local (.locals info)) local)
           ((push-global (.globals info)) o))))) ;; FIXME: char*/int
 
 (define (push-ident-address info)
   (lambda (o)
     (let ((local (assoc-ref (.locals info) o)))
-      (if local (i386:push-local-address (local:id local))
+      (if local ((push-local-address (.locals info)) local)
           ((push-global-address (.globals info)) o)))))
 
 (define (push-ident-de-ref info)
   (lambda (o)
     (let ((local (assoc-ref (.locals info) o)))
-      (if local (i386:push-local-de-ref (local:id local))
+      (if local ((push-local-de-ref (.locals info)) local)
           ((push-global-de-ref (.globals info)) o)))))
 
 (define (expr->arg info) ;; FIXME: get Mes curried-definitions
   (lambda (o)
-    (pmatch o
+    (let ((text (.text info)))
-      ((p-expr (fixed ,value)) (cstring->number value))
+      (pmatch o
-      ((neg (p-expr (fixed ,value))) (- (cstring->number value)))
+        ((p-expr (fixed ,value))
-      ((p-expr (string ,string)) ((push-global-address info) string))
+         (let ((value (cstring->number value)))
-      ((p-expr (ident ,name))
+           (clone info #:text (append text
-       ((push-ident info) name))
+                                      (list
+                                       (lambda (f g ta t d)
+                                         (append
+                                          (i386:value->accu value)
+                                          (i386:push-accu))))))))
 
-      ;; g_cells[0]
+        ((neg (p-expr (fixed ,value)))
-      ((array-ref (p-expr (fixed ,index)) (p-expr (ident ,array)))
+         (let ((value (- (cstring->number value))))
-       (let ((index (cstring->number index))
+           (clone info #:text (append text
-             (size 4)) ;; FIXME: type: int
+                                      (list
-         (append
+                                       (lambda (f g ta t d)
-          ((ident->base info) array)
+                                         (append
-          (list
+                                          (i386:value->accu value)
-           (lambda (f g ta t d)
+                                          (i386:push-accu))))))))
-             (append
-              (i386:value->accu (* size index)) ;; FIXME: type: int
-              (i386:base-mem->accu)             ;; FIXME: type: int
-              (i386:push-accu)                  ;; hmm
-              ))))))
 
-      ;; g_cells[i]
+        ((p-expr (string ,string))
-      ((array-ref (p-expr (ident ,index)) (p-expr (ident ,array)))
+         (clone info #:text (append text (list ((push-global-address info) string)))))
-       (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)))
+        ((p-expr (ident ,name))
-       (lambda (f g ta t d)
+         (clone info #:text (append text (list ((push-ident info) name)))))
-         ((push-ident-de-ref info) name)))
 
-      ((ref-to (p-expr (ident ,name)))
+        ;; g_cells[0]
-       (lambda (f g ta t d)
+        ((array-ref (p-expr (fixed ,index)) (p-expr (ident ,array)))
-         ((push-ident-address info) name)))
+         (let ((index (cstring->number index))
+               (size 4)) ;; FIXME: type: int
+           (clone info
+                  #:text (append text
+                                 ((ident->base info) array)
+                                 (list
+                                  (lambda (f g ta t d)
+                                    (append
+                                     (i386:value->accu (* size index)) ;; FIXME: type: int
+                                     (i386:base-mem->accu) ;; FIXME: type: int
+                                     (i386:push-accu))))))))
 
-      ;; f (car (x))
+        ;; g_cells[i]
-      ((fctn-call . ,call)
+        ((array-ref (p-expr (ident ,index)) (p-expr (ident ,array)))
-       (let* ((empty (clone info #:text '()))
+         (let ((index (cstring->number index))
-              (info ((ast->info empty) o)))
+               (size 4)) ;; FIXME: type: int
-         (append (.text info)
+           (clone info #:text (append text
-                 (list
+                                      ((ident->base info) array)
-                  (lambda (f g ta t d)
+                                      ((ident->accu info) array)
-                    (i386:push-accu))))))
+                                      (list
+                                       (lambda (f g ta t d)
+                                         (i386:base-mem->accu)))
+                                      (list
+                                       (lambda (f g ta t d)
+                                         (i386:push-accu)))))))
 
-      ;; f (CAR (x))
+        ((de-ref (p-expr (ident ,name)))
-      ((d-sel . ,d-sel)
+         (clone info #:text (append text (list ((push-ident-de-ref info) name)))))
-       (let* ((empty (clone info #:text '()))
-              (expr ((expr->accu empty) `(d-sel ,@d-sel))))
-         (append (.text expr)
-                 (list (lambda (f g ta t d)
-                         (i386:push-accu))))))
 
-      ;; f (0 + x)
+        ((ref-to (p-expr (ident ,name)))
-      ;;; aargh
+         (clone info #:text (append text (list ((push-ident-address info) name)))))
-      ;;;((add (p-expr (fixed ,value)) (d-sel (ident cdr) (array-ref (p-expr (ident x)) (p-expr (ident g_cells))))))
 
-      ((cast (type-name (decl-spec-list (type-spec (fixed-type _)))
+        ;; f (car (x))
-                        (abs-declr (pointer)))
+        ((fctn-call . ,call)
-             ,cast)
+         (let* (;;(empty (clone info #:text '()))
-       ((expr->arg info) cast))
+                ;;(info ((ast->info empty) o))
-      (_
+                (info ((ast->info info) o))
-       (format (current-error-port) "SKIP: expr->arg=~s\n" o)
+                (text (.text info)))
-       barf
+           (clone info
-       0))))
+                  #:text (append text
+                                 (list
+                                  (lambda (f g ta t d)
+                                    (i386:push-accu)))))))
+
+        ;; f (CAR (x))
+        ((d-sel . ,d-sel)
+         (let* (;;(empty (clone info #:text '()))
+                ;;(expr ((expr->accu empty) `(d-sel ,@d-sel)))
+                (expr ((expr->accu info) `(d-sel ,@d-sel)))
+                (text (.text expr)))
+           (clone info
+                  #:text (append text
+                                 (list (lambda (f g ta t d)
+                                         (i386:push-accu)))))))
+
+        ;; f (0 + x)
+;;; aargh
+;;;((add (p-expr (fixed ,value)) (d-sel (ident cdr) (array-ref (p-expr (ident x)) (p-expr (ident g_cells))))))
+
+        ((cast (type-name (decl-spec-list (type-spec (fixed-type _)))
+                          (abs-declr (pointer)))
+               ,cast)
+         ((expr->arg info) cast))
+        (_
+         (format (current-error-port) "SKIP: expr->arg=~s\n" o)
+         barf
+         0)))))
 
 ;; FIXME: see ident->base
 (define (ident->accu info)
@@ -1019,47 +1055,46 @@
                                    (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)))
+                    (text-length (length text))
+                    (args-info (let loop ((expressions (reverse expr-list)) (info info))
+                                 (if (null? expressions) info
+                                     (loop (cdr expressions) ((expr->arg info) (car expressions))))))
+                    (text (.text args-info))
+                    (n (length expr-list)))
                (if ;;#t ;;(assoc-ref globals name)
                 (not (equal? name "functionx"))
-                (clone info #:text
+                (clone args-info #:text
                        (append text
                                (list (lambda (f g ta t d)
-                                       (apply i386:call (cons* f g ta t d
+                                       (i386:call f g ta t d (+ t (function-offset name f)) n))))
-                                                               (+ 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
+                  (clone args-info #:text
                          (append text
-                                 (list (lambda (f g ta t d)
-                                         '(#x90)))
-                                 ;;accu
                                  (.text accu)
                                  (list (lambda (f g ta t d)
-                                         '(#x90)))
+                                         (i386:call-accu f g ta t d n))))
-                                 (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))
+                (info (clone info #:globals globals))
-                    (args (map (expr->arg info) expr-list))
+                (text-length (length text))
-                    (empty (clone info #:text '()))
+                (args-info (let loop ((expressions (reverse expr-list)) (info info))
-                    (accu ((expr->accu empty) function)))
+                             (if (null? expressions) info
+                                 (loop (cdr expressions) ((expr->arg info) (car expressions))))))
+                (text (.text args-info))
+                (n (length 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)))
+                                  (i386:call-accu f g ta t d n))))
-                          (list (lambda (f g ta t d)
-                                  (apply i386:call-accu (cons* f g ta t d args)))))
                   #:globals globals)))
 
         ((if ,test ,body)
@@ -1716,11 +1751,7 @@
                 (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)

module/mes/libc-i386.mes

@@ -68,17 +68,6 @@
 (define (i386:push-base)
   '(#x52))                              ; push %eax
 
-(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 ta t d)) o))
-          ((pair? o) o)
-          ((procedure? o) (o f g ta t d))
-          (_ barf))))
-
 (define (i386:ret . rest)
   (lambda (f g ta t d)
     `(
@@ -280,36 +269,17 @@
   (or n local-test)
   `(#x83 #x7d ,(- 0 (* 4 n)) ,v))       ; cmpl   $<v>,0x<n>(%ebp)
 
-(define (i386:call f g ta t d address . arguments)
+(define (i386:call f g ta t d address n)
   (or address urg:call)
-  (let* ((pushes (append-map (i386:push-arg f g ta t d) (reverse arguments)))
+  `(#xe8 ,@(int->bv32 (- address 5))    ; call   relative $00
-         (s (length pushes))
+         #x83 #xc4 ,(* n 4)))           ; add    $00,%esp
-         (n (length arguments)))
+
-   `(
+(define (i386:call-accu f g ta t d n)
-     ,@pushes                           ; push args
+  `(,@(i386:push-accu)
-     #xe8 ,@(int->bv32 (- address 5 s)) ; call relative
+    ,@(i386:pop-accu)
-     #x83 #xc4 ,(* n 4)                 ; add    $00,%esp
+    #xff #xd0                           ; call   *%eax
-     )))
+    #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

module/mes/libc-i386.scm

@@ -117,13 +117,16 @@
             i386:xor-accu
             i386:xor-zf
 
+            ;; long jump
+            i386:Xjump
             i386:Xjump
-            i386:XXjump
             i386:Xjump-c
             i386:Xjump-nc
             i386:Xjump-nz
             i386:Xjump-z
 
+            i386:XXjump
+
             ;; libc
             i386:exit
             i386:open

scaffold/mini-mes.c

@@ -609,10 +609,21 @@ push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
 }
 #endif
 
+#if __GNUC__
 SCM caar (SCM x) {return car (car (x));}
 SCM cadr (SCM x) {return car (cdr (x));}
 SCM cdar (SCM x) {return cdr (car (x));}
 SCM cddr (SCM x) {return cdr (cdr (x));}
+#else
+SCM cadr (SCM x) {
+  x = cdr (x);
+  return car (x);
+}
+SCM cddr (SCM x) {
+  x = cdr (x);
+  return cdr (x);
+}
+#endif
 
 #if __GNUC__
 //FIXME
@@ -625,6 +636,10 @@ eval_apply ()
 {
   puts ("e/a: fixme\n");
  eval_apply:
+  asm (".byte 0x90");
+  asm (".byte 0x90");
+  asm (".byte 0x90");
+  asm (".byte 0x90");
   puts ("eval_apply\n");
   // if (g_free + GC_SAFETY > ARENA_SIZE)
   //   gc_pop_frame (gc (gc_push_frame ()));
@@ -987,11 +1002,6 @@ eval_apply ()
   gc_pop_frame ();
   puts ("vm-return01\n");
   r1 = x;
-
-  //FIXME:
-  r3 = cell_unspecified;
-  /// fIXME: must via eval-apply
-  return r1;
   goto eval_apply;
 }
 
@@ -1069,9 +1079,24 @@ gc_peek_frame ()
 {
   SCM frame = car (g_stack);
   r1 = car (frame);
+#if __GNUC__
   r2 = cadr (frame);
   r3 = car (cddr (frame));
   r0 = cadr (cddr (frame));
+#else
+  r2 = cdr (frame);
+  r2 = car (r2);
+
+  r3 = cdr (frame);
+  r3 = cdr (r3);
+  r3 = car (r3);
+
+  r0 = cdr (frame);
+  r0 = cdr (r0);
+  r0 = cdr (r0);
+  r0 = cdr (r0);
+  r0 = car (r0);
+#endif
   return frame;
 }
 

scaffold/t.c

@@ -124,6 +124,19 @@ SCM tmp;
 SCM tmp_num;
 
 #if 1
+
+int
+add (int a, int b)
+{
+  return a + b;
+}
+
+int
+inc (int i)
+{
+  return i + 1;
+}
+
 int
 label (int c)
 {
@@ -444,6 +457,24 @@ test (char *p)
   *x++ = c;
   if (*g_chars != 'C') return 1;
 
+  puts ("t: inc (0)\n");
+  if (inc (0) != 1) return 1;
+
+  puts ("t: inc (inc (0))\n");
+  if (inc (inc (0)) != 2) return 1;
+
+  puts ("t: inc (inc (inc (0)))\n");
+  if (inc (inc (inc (0))) != 3) return 1;
+
+  puts ("t: add (1, 2)\n");
+  if (add (1, 2) != 3) return 1;
+
+  puts ("t: add (inc (0), inc (1))\n");
+  if (add (inc (0), inc (1)) != 3) return 1;
+
+  puts ("t: add (inc (inc (0)), inc (inc (1)))\n");
+  if (add (inc (inc (0)), inc (inc (1))) != 5) return 1;
+
   puts ("t: goto label\n");
   if (label (1) != 0) return 1;
 
@@ -576,21 +607,6 @@ test (char *p)
 int
 main (int argc, char *argv[])
 {
- //  main:
- //  puts ("t.c\n");
- //  if (argc == 0x22) return 11;
- //  argc = 0x22;
- //  goto main;
- //  switch (0)
- //    {
- //    case 0: {goto next;}
- //    // case 1: {goto next;}
- //    // case 2: {goto next;}
- //    // default: {goto next;}
- //    }
-
- //  return 1;
- // next:
   char *p = "t.c\n";
   puts ("t.c\n");