mescc: Support function call with enum value.
authorJan Nieuwenhuizen <janneke@gnu.org>
Fri, 17 Mar 2017 07:37:45 +0000 (08:37 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Fri, 17 Mar 2017 07:37:45 +0000 (08:37 +0100)
* doc/examples/mini-mes.c: Remove debug printing.
* module/language/c99/compiler.mes (push-global, push-local,
  push-global-address, push-local-address, push-local-de-ref): Return
  list of lambda.
  (push-ident): Support push constant.  Fixes mini-mes,
  cstring_to_list.
* doc/examples/t.c (test): Test it.

module/language/c99/compiler.mes
scaffold/mini-mes.c
scaffold/t.c

index cf4f602d82417d2d13936dcb925bc3d3663d502e..5eda922827c26d5fdfd12ac077e87db5673a7b08 100644 (file)
 
 (define (push-global globals)
   (lambda (o)
-    (lambda (f g ta t d)
-      (i386:push-global (+ (data-offset o g) d)))))
+    (list
+     (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)))))
+    (list
+     (lambda (f g ta t d)
+       (i386:push-local (local:id o))))))
 
 (define (push-global-address globals)
   (lambda (o)
+    (list
      (lambda (f g ta t d)
-       (i386:push-global-address (+ (data-offset o g) 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)))))
+    (list
+     (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)))))
+    (list
+     (lambda (f g ta t d)
+       (i386:push-local-de-ref (local:id o))))))
 
 (define (string->global string)
   (make-global (add-s:-prefix string) "string" 0 (append (string->list string) (list #\nul))))
   (lambda (o)
     (let ((local (assoc-ref (.locals info) o)))
       (if local ((push-local (.locals info)) local)
-          ((push-global (.globals info)) o))))) ;; FIXME: char*/int
+          (let ((global (assoc-ref (.globals info) o)))
+            (if global
+                ((push-global (.globals info)) o) ;; FIXME: char*/int
+                (let ((constant (assoc-ref (.constants info) o)))
+                  (if constant
+                      (list (lambda (f g ta t d)
+                              (append
+                               (i386:value->accu constant)
+                               (i386:push-accu))))
+                      TODO:push-function))))))))
 
 (define (push-ident-address info)
   (lambda (o)
 (define (expr->arg info) ;; FIXME: get Mes curried-definitions
   (lambda (o)
     (let ((text (.text info)))
+      ;;(stderr  "expr->arg o=~s\n" o)
       (pmatch o
         ((p-expr (fixed ,value))
          (let ((value (cstring->number value)))
                                           (i386:push-accu))))))))
 
         ((p-expr (string ,string))
-         (clone info #:text (append text (list ((push-global-address info) (add-s:-prefix string))))))
+         (clone info #:text (append text ((push-global-address info) (add-s:-prefix string)))))
 
         ((p-expr (ident ,name))
-         (clone info #:text (append text (list ((push-ident info) name)))))
+         (clone info #:text (append text ((push-ident info) name))))
 
         ;; g_cells[0]
         ((array-ref (p-expr (fixed ,index)) (p-expr (ident ,array)))
@@ -302,10 +317,10 @@ _)))))
                                          (i386:push-accu)))))))
 
         ((de-ref (p-expr (ident ,name)))
-         (clone info #:text (append text (list ((push-ident-de-ref info) name)))))
+         (clone info #:text (append text ((push-ident-de-ref info) name))))
 
         ((ref-to (p-expr (ident ,name)))
-         (clone info #:text (append text (list ((push-ident-address info) name)))))
+         (clone info #:text (append text ((push-ident-address info) name))))
 
         ;; f (car (x))
         ((fctn-call . ,call)
@@ -506,8 +521,8 @@ _)))))
                                  (i386:value->accu size))))))))
         
         ;; c+p expr->arg
-        ((array-ref (p-expr (fixed ,value)) (p-expr (ident ,array)))
-         (let* ((value (cstring->number value))
+        ((array-ref (p-expr (fixed ,index)) (p-expr (ident ,array)))
+         (let* ((index (cstring->number index))
                 (type (ident->type info array))
                 (size (type->size info type)))
            (clone info #:text
@@ -515,7 +530,7 @@ _)))))
                         ((ident->base info) array)
                         (list (lambda (f g ta t d)
                                 (append
-                                 (i386:value->accu value)
+                                 (i386:value->accu (* size index))
                                  (if (eq? size 1)
                                      (i386:byte-base-mem->accu)
                                      (i386:base-mem->accu)))))))))
@@ -789,6 +804,7 @@ _)))))
 (define (expr->accu* info)
   (lambda (o)
     (pmatch o
+      ;;(stderr "expr->accu* o=~s\n" o)
       ;; g_cells[10].type
       ((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))))
        (let* ((type (ident->type info array))
@@ -1129,7 +1145,7 @@ _)))))
                (locals (cons (make-local name type pointer id) locals)))
           locals))
 
-      ;; (stderr "\n ast->info=~s\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)
@@ -1179,7 +1195,6 @@ _)))))
                        #:globals globals)
                 (let* ((empty (clone info #:text '()))
                        (accu ((expr->accu empty) `(p-expr (ident ,name)))))
-                  (stderr "DINGES: ~a\n" o)
                   (clone args-info #:text
                          (append text
                                  (.text accu)
@@ -2301,6 +2316,7 @@ strlen (char const* s)
 (define getchar
   (let* ((ast (with-input-from-string
                   "
+int g_stdin;
 int
 getchar ()
 {
index dcd2fcff1c04f31994b8272bb9dd2831b6933624..fed25893727f63dd7d3c5ae5bf85fdd5d35483ab 100644 (file)
@@ -616,7 +616,7 @@ call (SCM fn, SCM x)
 SCM
 assq (SCM x, SCM a)
 {
-  //FIXME: todo eq_p
+  //FIXME: eq_p
   //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;
@@ -1087,25 +1087,10 @@ SCM
 make_symbol_ (SCM s)
 {
   VALUE (tmp_num) = TSYMBOL;
-  ///FIXMESCM x = make_cell (tmp_num, s, 0);
+  ///FIXME SCM x = make_cell (tmp_num, s, 0);
   SCM x;
   x = make_cell (tmp_num, s, 0);
   puts ("MAKE SYMBOL: ");
-  // puts ("[s=");
-  // puts (itoa (s));
-  // puts (",s.car=");
-  // puts (itoa (CAR (s)));
-  // puts (",s.car.cdr=");
-  // //  puts (itoa (CDR (CAR (s))));
-  // putchar (CDR (CAR (s)));
-  // puts (",x=");
-  // puts (itoa (x));
-  // puts (",x.car=");
-  // puts (itoa (CAR (x)));
-  // puts ("]");
-
-
-  ////TYPE (x) = TSYMBOL;
   display_ (x);
   puts ("\n");
   g_symbols = cons (x, g_symbols);
@@ -1216,7 +1201,6 @@ display_ (SCM x)
       }
     case TFUNCTION:
       {
-#if 1
         puts ("#<procedure ");
         ///puts (FUNCTION (x).name ? FUNCTION (x).name : "?");
         char *p = "?";
@@ -1227,29 +1211,11 @@ display_ (SCM x)
         puts (itoa (CDR (x)));
         puts ("]>");
         break;
-#endif
-        // //puts ("<function>\n");
-        // if (VALUE (x) == 0)
-        //   puts ("make-cell");
-        // if (VALUE (x) == 1)
-        //   puts ("cons");
-        // if (VALUE (x) == 2)
-        //   puts ("car");
-        // if (VALUE (x) == 3)
-        //   puts ("cdr");
-        // break;
       }
     case TNUMBER:
       {
         //puts ("<number>\n");
-#if __GNUC__
         puts (itoa (VALUE (x)));
-#else
-        int i;
-        i = VALUE (x);
-        i = i + 48;
-        putchar (i);
-#endif
         break;
       }
     case TPAIR:
@@ -1260,16 +1226,8 @@ display_ (SCM x)
         if (x && x != cell_nil) display_ (CAR (x));
         if (CDR (x) && CDR (x) != cell_nil)
           {
-#if __GNUC__
             if (TYPE (CDR (x)) != TPAIR)
               puts (" . ");
-#else
-            int c;
-            c = CDR (x);
-            c = TYPE (c);
-            if (c != TPAIR)
-              puts (" . ");
-#endif
             display_ (CDR (x));
           }
         //if (cont != cell_f) puts (")");
@@ -1285,40 +1243,21 @@ display_ (SCM x)
           case 3: {puts ("#t"); break;}
           default:
             {
-#if __GNUC__
         puts ("<x:");
         puts (itoa (x));
         puts (">");
-#else
-        puts ("<x>");
-#endif
             }
           }
         break;
       }
     case TSYMBOL:
       {
-#if 0
-        puts ("<s:");
-        puts (itoa (x));
-        puts (">");
-#endif
         // FIXME
         ///SCM t = CAR (x);
         SCM t;
         t = CAR (x);
         while (t != cell_nil)
           {
-            //FIXME
-            //SCM xx = CAR (t);
-            // SCM xx;
-            // xx = CAR (t);
-            // puts ("[c:");
-            // puts (itoa (xx));
-            // puts (",");
-            // puts (itoa (VALUE (xx)));
-            // puts ("]");
-            // putchar (VALUE (xx));
             putchar (VALUE (CAR (t)));
             t = CDR (t);
           }
@@ -1327,15 +1266,11 @@ display_ (SCM x)
     default:
       {
         //puts ("<default>\n");
-#if 1
         puts ("<");
         puts (itoa (TYPE (x)));
         puts (":");
         puts (itoa (x));
         puts (">");
-#else
-        puts ("_");
-#endif
         break;
       }
     }
index 14d5138f45eca5c727c7592497ce44e4a16dfe57..6a179a387a6f2851659a2dbdaaf5b48f4de72ca0 100644 (file)
@@ -95,6 +95,7 @@ struct scm {
   int cdr;
 };
 
+int bla = 1234;
 char arena[84];
 struct scm *g_cells = arena;
 char *g_chars = arena;
@@ -593,6 +594,9 @@ test (char *p)
   puts ("t: add (inc (0), inc (1))\n");
   if (add (inc (0), inc (1)) != 3) return 1;
 
+  puts ("t: add (TSTRING, 3)\n");
+  if (add (TSTRING, 3) != 13) return 1;
+
   puts ("t: add (inc (inc (0)), inc (inc (1)))\n");
   if (add (inc (inc (0)), inc (inc (1))) != 5) return 1;