mescc: Mini-mes runs (cons 0 1) dump.

* module/mes/libc-i386.mes (i386:Xjump-z, i386:Xjump-c,
  i386:Xjump-nc): New functions.
* module/mes/libc-i386.scm: Export them.
* module/language/c99/compiler.mes (case->jump-info, test-jump->info,
  ast->info): Use them.
* doc/examples/t.c: Test it.
* doc/examples/mini-mes.c: Run it.

module/language/c99/compiler.mes

@@ -813,17 +813,27 @@
 
       ((case (p-expr (fixed ,value)) (compd-stmt (block-item-list . ,elements)))
        (lambda (body-length)
+
+         (define (test->text value clause-length)
+           (append (list (lambda (f g ta t d) (i386:accu-cmp-value value)))
+                   (jump-nz clause-length)))
          (let* ((value (cstring->number value))
-                (text-length (length (.text info)))
+                (test-info
-                (clause-info (let loop ((elements elements) (info info))
+                 (clone info #:text (append (.text info) (test->text value 0))))
+                ;;(foo (stderr "000\n"))
+                (text-length (length (.text test-info)))
+                (clause-info (let loop ((elements elements) (info test-info))
+                               ;;(stderr "info text=~s\n" (map dec->hex (text->list (.text info))))
+                               ;;(stderr "case: ~s\n" (and (pair? elements) (car elements)))
                                (if (null? elements) info
                                    (loop (cdr elements) ((statement->info info body-length) (car elements))))))
+                ;;(foo (stderr "001\n"))
                 (clause-text (list-tail (.text clause-info) text-length))
                 (clause-length (length (text->list clause-text))))
+           ;;(stderr "text info:~s\n" (.text info))
            (clone info #:text (append
                                (.text info)
-                               (list (lambda (f g ta t d) (i386:accu-cmp-value value)))
+                               (test->text value clause-length)
-                               (jump-nz clause-length)
                                clause-text)
                   #:globals (.globals clause-info)))))
 
@@ -851,11 +861,11 @@
                         (jump-text body-length)))))))
   (lambda (o)
     (pmatch o
-      ((lt ,a ,b) ((jump i386:jump-nc) o))
+      ((lt ,a ,b) ((jump i386:Xjump-nc) o))
-      ((gt ,a ,b) ((jump i386:jump-nc) o))
+      ((gt ,a ,b) ((jump i386:Xjump-nc) o))
-      ((ne ,a ,b) ((jump i386:jump-nz) o))
+      ((ne ,a ,b) ((jump i386:Xjump-nz) o))
-      ((eq ,a ,b) ((jump i386:jump-nz) o))
+      ((eq ,a ,b) ((jump i386:Xjump-nz) o))
-      ((not _) ((jump i386:jump-z) o))
+      ((not _) ((jump i386:Xjump-z) o))
       ((and ,a ,b)
        (let* ((text (.text info))
               (info (clone info #:text '()))
@@ -898,7 +908,7 @@
                           (.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)))))
+      (_ ((jump i386:Xjump-z) o)))))
 
 (define (cstring->number s)
   (cond ((string-prefix? "0x" s) (string->number (string-drop s 2) 16))
@@ -1087,12 +1097,13 @@
                 (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))
+                (then+jump-info (clone then-info #:text (append text-then-info then-jump-text)))
+                (else-info ((ast->info then+jump-info) else))
                 (text-else-info (.text else-info))
-                (else-text (list-tail text-else-info test-length))
+                (else-text (list-tail text-else-info (length (.text then+jump-info))))
                 (else-length (length (text->list else-text)))
 
-                (text+test-text (.text (test-jump->info (+ then-length then-jump-length))))
+                (text+test-text (.text (test-jump->info then-length)))
                 (test-text (list-tail text+test-text text-length))
                 (then-jump-text (list (lambda (f g ta t d) (i386:Xjump else-length)))))
 
@@ -1102,7 +1113,8 @@
                           then-text
                           then-jump-text
                           else-text)
-                  #:globals (.globals then-info)))) ;; FIXME: else-globals
+                  #:globals (append (.globals then-info)
+                                    (list-tail (.globals else-info) (length globals))))))
 
         ((expr-stmt (cond-expr ,test ,then ,else))
          (let* ((text-length (length text))
@@ -1223,6 +1235,7 @@
            ((ast->info info) statement)))
 
         ((goto (ident ,label))
+         
          (let ((offset (length (text->list text)))
                (jump (lambda (n) (i386:Xjump n))))
            (clone info #:text

module/mes/libc-i386.mes

@@ -337,6 +337,10 @@
   (or n urg:Xjump-nz)
   `(#x0f #x85 ,@(int->bv32 n)))         ; jnz . + <n>
 
+(define (i386:Xjump-z n)
+  (or n urg:Xjump-z)
+  `(#x0f #x84 ,@(int->bv32 n)))         ; jz . + <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)
@@ -344,41 +348,67 @@
   `(#xeb ,(if (>= n 0) (- n 2) (- n 2)))) ; jmp <n>
 
 (define (i386:jump-c n)
-  (or n jump-c)
+  (when (or (> n #x80) (< n #x-80))
+    (format (current-error-port) "JUMP n=~a\n" n)
+    barf)
   `(#x72 ,(if (>= n 0) n (- n 2))))     ; jc <n>
 
+(define (i386:Xjump-c n)
+  (or n urg:Xjump-c)
+  `(#x0f #x82 ,@(int->bv32 n)))     ; jc <n>
+
 (define (i386:jump-cz n)
-  (or n jump-cz)
+  (when (or (> n #x80) (< n #x-80))
+    (format (current-error-port) "JUMP n=~a\n" n)
+    barf)
   `(#x76 ,(if (>= n 0) n (- n 2))))     ; jna <n>
 
 (define (i386:jump-ncz n)
-  (or n jump-ncz)
+  (when (or (> n #x80) (< n #x-80))
+    (format (current-error-port) "JUMP-ncz n=~a\n" n)
+    barf)
   `(#x77 ,(if (>= n 0) n (- n 2))))     ; ja <n>
 
 (define (i386:jump-nc n)
-  (or n jump-nc)
+  (when (or (> n #x80) (< n #x-80))
+    (format (current-error-port) "JUMP-nc n=~a\n" n)
+    barf)
   `(#x73 ,(if (>= n 0) n (- n 2))))     ; jnc <n>
 
+(define (i386:Xjump-nc n)
+  (or n urg:Xjump-nc)
+  `(#x0f #x83 ,@(int->bv32 n)))         ; jnc <n>
+
 (define (i386:jump-z n)
-  (or n jump-z)
+  (when (or (> n #x80) (< n #x-80))
+    (format (current-error-port) "JUMP-z n=~a\n" n)
+    barf)
   `(#x74 ,(if (>= n 0) n (- n 2)))) ; jz <n>
 
 (define (i386:jump-nz n)
-  (or n jump-nz)
+  (when (or (> n #x80) (< n #x-80))
+    (format (current-error-port) "JUMP-nz n=~a\n" n)
+    barf)
   `(#x75 ,(if (>= n 0) n (- n 2)))) ; jnz <n>
 
 (define (i386:test-jump-z n)
-  (or n jump-z)
+  (when (or (> n #x80) (< n #x-80))
+    (format (current-error-port) "JUMP-z n=~a\n" n)
+    barf)
   `(#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)
+  (when (or (> n #x80) (< n #x-80))
+    (format (current-error-port) "JUMP-byte-nz n=~a\n" n)
+    barf)
   `(#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)
+  (when (or (> n #x80) (< n #x-80))
+    (format (current-error-port) "JUMP-byte-z n=~a\n" n)
+    barf)
   `(#x84 #xc0                           ; test   %al,%al
     #x74 ,(if (>= n 0) n (- n 4))))     ; jne <n>
 

module/mes/libc-i386.scm

@@ -118,7 +118,10 @@
             i386:xor-zf
 
             i386:Xjump
+            i386:Xjump-c
+            i386:Xjump-nc
             i386:Xjump-nz
+            i386:Xjump-z
 
             ;; libc
             i386:exit

scaffold/mini-mes.c

@@ -340,25 +340,37 @@ struct function functions[2];
 int g_function = 0;
 
 
+#if __GNUC__
+//FIXME
 SCM make_cell (SCM type, SCM car, SCM cdr);
+#endif
 struct function fun_make_cell = {&make_cell, 3};
 struct scm scm_make_cell = {TFUNCTION,0,0};
    //, "make-cell", 0};
 SCM cell_make_cell;
 
+#if __GNUC__
+//FIXME
 SCM cons (SCM x, SCM y);
+#endif
 struct function fun_cons = {&cons, 2};
 struct scm scm_cons = {TFUNCTION,0,0};
   // "cons", 0};
 SCM cell_cons;
 
+#if __GNUC__
+//FIXME
 SCM car (SCM x);
+#endif
 struct function fun_car = {&car, 1};
 struct scm scm_car = {TFUNCTION,0,0};
   // "car", 0};
 SCM cell_car;
 
+#if __GNUC__
+//FIXME
 SCM cdr (SCM x);
+#endif
 struct function fun_cdr = {&cdr, 1};
 struct scm scm_cdr = {TFUNCTION,0,0};
 // "cdr", 0};
@@ -412,7 +424,10 @@ SCM cell_cdr;
 SCM
 alloc (int n)
 {
+#if __GNUC__
+  //FIXME GNUC
   assert (g_free + n < ARENA_SIZE);
+#endif
   SCM x = g_free;
   g_free += n;
   return x;
@@ -422,15 +437,20 @@ SCM
 make_cell (SCM type, SCM car, SCM cdr)
 {
   SCM x = alloc (1);
+#if __GNUC__
+  //FIXME GNUC
   assert (TYPE (type) == NUMBER);
+#endif
   TYPE (x) = VALUE (type);
   if (VALUE (type) == CHAR || VALUE (type) == NUMBER) {
     if (car) CAR (x) = CAR (car);
     if (cdr) CDR(x) = CDR(cdr);
-  } else if (VALUE (type) == TFUNCTION) {
+  }
+  else if (VALUE (type) == TFUNCTION) {
     if (car) CAR (x) = car;
     if (cdr) CDR(x) = CDR(cdr);
-  } else {
+  }
+  else {
     CAR (x) = car;
     CDR(x) = cdr;
   }
@@ -454,18 +474,23 @@ tmp_num2_ (int x)
 SCM
 cons (SCM x, SCM y)
 {
-#if  __GNUC__
+  puts ("cons x=");
+#if __GNUC__
+  puts (itoa (x));
+#endif
+  puts ("\n");
   VALUE (tmp_num) = PAIR;
   return make_cell (tmp_num, x, y);
-#else
-  //FIXME GNUC
-  return 0;
-#endif
 }
 
 SCM
 car (SCM x)
 {
+  puts ("car x=");
+#if __GNUC__
+  puts (itoa (x));
+#endif
+  puts ("\n");
 #if MES_MINI
   //Nyacc
   //assert ("!car");
@@ -478,6 +503,11 @@ car (SCM x)
 SCM
 cdr (SCM x)
 {
+  puts ("cdr x=");
+#if __GNUC__
+  puts (itoa (x));
+#endif
+  puts ("\n");
 #if MES_MINI
   //Nyacc
   //assert ("!cdr");
@@ -508,19 +538,14 @@ gc_push_frame ()
   return g_stack;
 }
 
-SCM
-xgc_push_frame ()
-{
-  // SCM frame = cons (r1, cons (r2, cons (r3, cons (r0, cell_nil))));
-  // g_stack = cons (frame, g_stack);
-  return g_stack;
-}
-
 SCM
 append2 (SCM x, SCM y)
 {
   if (x == cell_nil) return y;
+#if __GNUC__
+  //FIXME GNUC
   assert (TYPE (x) == PAIR);
+#endif
   return cons (car (x), append2 (cdr (x), y));
 }
 
@@ -543,6 +568,8 @@ assq (SCM x, SCM a)
   return a != cell_nil ? car (a) : cell_f;
 }
 
+#if __GNUC__
+  //FIXME GNUC
 SCM
 assq_ref_env (SCM x, SCM a)
 {
@@ -550,7 +577,10 @@ assq_ref_env (SCM x, SCM a)
   if (x == cell_f) return cell_undefined;
   return cdr (x);
 }
+#endif
 
+#if __GNUC__
+  //FIXME GNUC
 SCM
 assert_defined (SCM x, SCM e)
 {
@@ -560,11 +590,14 @@ assert_defined (SCM x, SCM e)
   exit (33);
   return e;
 }
+#endif
 
+#if 1
+  //FIXME GNUC
 SCM
 push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
 {
-  puts ("push_cc\n");
+  puts ("push cc\n");
   SCM x = r3;
   r3 = c;
   r2 = p2;
@@ -574,33 +607,24 @@ push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
   r3 = x;
   return cell_unspecified;
 }
-
+#endif
-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));}
 SCM cddr (SCM x) {return cdr (cdr (x));}
 
+#if __GNUC__
+//FIXME
 SCM call (SCM,SCM);
 SCM gc_pop_frame ();
+#endif
 
 SCM
 eval_apply ()
 {
  eval_apply:
+  puts ("eval_apply\n");
   // if (g_free + GC_SAFETY > ARENA_SIZE)
   //   gc_pop_frame (gc (gc_push_frame ()));
 
@@ -637,7 +661,10 @@ eval_apply ()
     case cell_vm_return: goto vm_return;
 #endif
     case cell_unspecified: {return r1;}
+#if __GNUC__
+      //FIXME GNUC
     default: {assert (0);}
+#endif
     }
 
   SCM x = cell_nil;
@@ -657,11 +684,22 @@ eval_apply ()
 // #endif
 
  apply:
+  puts ("apply\n");
   switch (TYPE (car (r1)))
     {
     case TFUNCTION: {
+      puts ("apply.function\n");
+      y = 0x22;
       //check_formals (car (r1), MAKE_NUMBER (FUNCTION (car (r1)).arity), cdr (r1));
+#if __GNUC__
       r1 = call (car (r1), cdr (r1)); /// FIXME: move into eval_apply
+#else
+      //FIXME
+      x = car (r1);
+      y = cdr (r1);
+      r1 = call (x, y);
+#endif
+      puts ("after call\n");
       goto vm_return;
     }
 //     case CLOSURE:
@@ -738,7 +776,10 @@ eval_apply ()
 //           }
 //       }
     }
+#if __GNUC__
+  //FIXME
   push_cc (car (r1), r1, r0, cell_vm_apply2);
+#endif
   goto eval;
  apply2:
   //check_apply (r1, car (r2));
@@ -885,7 +926,10 @@ eval_apply ()
         r1 = car (r1);
         goto eval;
       }
+#if __GNUC__
+    //FIXME
     push_cc (CAR (r1), r1, r0, cell_vm_begin2);
+#endif
     goto eval;
   begin2:
     x = r1;
@@ -934,34 +978,93 @@ eval_apply ()
 //   goto apply;
 // #endif
 
+  asm(".byte 0x90");
+  asm(".byte 0x90");
  vm_return:
+  asm(".byte 0x90");
+  asm(".byte 0x90");
+  asm(".byte 0x90");
+  asm(".byte 0x90");
+  asm(".byte 0x90");
+  asm(".byte 0x90");
+  asm(".byte 0x90");
+  asm(".byte 0x90");
+  asm(".byte 0x90");
+  // FIXME
+  puts ("vm-return00\n");
   x = r1;
   gc_pop_frame ();
+  puts ("vm-return01\n");
   r1 = x;
+
+  //FIXME:
+  r3 = cell_unspecified;
+  /// fIXME: must via eval-apply
+  return r1;
   goto eval_apply;
 }
 
 SCM
 call (SCM fn, SCM x)
 {
+  puts ("call\n");
+#if __GNUC__
+  //fn=11
+  //function1
+  puts ("fn=");
+  puts (itoa(fn)); 
+  puts ("\n");
+  puts ("function");
+  puts (itoa(g_cells[fn].cdr));
+  puts ("\n");
+#endif
+  if (fn != 11) {
+    puts("FN != 11\n");
+    return 11;
+  }
+  if (g_cells[11].cdr != 1) {
+    puts("fn.cdr != 11\n");
+    return 11;
+  }
+  
   if ((FUNCTION (fn).arity > 0 || FUNCTION (fn).arity == -1)
       && x != cell_nil && TYPE (CAR (x)) == VALUES)
     x = cons (CADAR (x), CDR (x));
+  puts ("00\n");
   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)));
-  struct function* f = &FUNCTION (fn);
+  //struct function* f = &FUNCTION (fn);
-  switch (FUNCTION (fn).arity)
+  puts ("01\n");
+  switch (2)///FIXME FUNCTION (fn).arity)
     {
     // case 0: return FUNCTION (fn).function0 ();
     // case 1: return FUNCTION (fn).function1 (car (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 0: {puts("02.0\n");return (FUNCTION (fn).function) ();}
-    case 1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (car (x));}
+    case 1: {puts("03.1\n");return ((SCM(*)(SCM))(FUNCTION (fn).function)) (car (x));}
+#if 0
+      //__GNUC__
     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)));}
+#else
+    case 2: {
+      puts ("04.2\n");
+      SCM p1 = car (x);
+      SCM p2 = cdr (x);
+      p2 = car (p2);
+      int (*functionx) (int,int) = (SCM(*)(SCM,SCM))FUNCTION (fn).function;
+      //return ((SCM(*)(SCM,SCM))(*FUNCTION (fn).function)) (p1, p2);
+      //return ((SCM(*)(SCM,SCM))(*functionx)) (p1, p2);
+      SCM p3;
+      p3 = 0x44;
+      puts ("05\n");
+      return cons (p1, p2);
+      return (*functionx) (p1, p2);
+    }
+#endif
+    case 3: {puts("05.3\n");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);}
     }
@@ -1142,7 +1245,6 @@ g_free++;
   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);
@@ -1167,8 +1269,7 @@ g_free++;
   // 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_dot, cell_dot, a); //
   a = acons (cell_symbol_begin, cell_begin, a);
   a = acons (cell_closure, a, a);
 
@@ -1218,7 +1319,9 @@ cell_make_cell = g_free++;
 #if __GNUC__
  puts ("WOOOT=");
  puts (itoa (g_free));
+ puts ("\n");
   //FIXME GNUC
+ g_cells[cell_make_cell] = scm_make_cell;
 #else
 g_cells[16] = scm_make_cell;
 #endif
@@ -1276,9 +1379,16 @@ bload_env (SCM a) ///((internal))
   //g_stdin = g_stdin ? g_stdin : fopen (PREFIX "module/mes/read-0.mo", "r");
 #endif
   char *p = (char*)g_cells;
+#if __GNUC__
+  //FIXME GNUC
   assert (getchar () == 'M');
   assert (getchar () == 'E');
   assert (getchar () == 'S');
+#else
+  getchar ();
+  getchar ();
+  getchar ();
+#endif
   g_stack = getchar () << 8;
   g_stack += getchar ();
   int c = getchar ();
@@ -1364,6 +1474,27 @@ fill ()
   CAR (15) = 0x58585858;
   CDR (15) = 1;
 
+  //g_stack@23
+  TYPE (19) = PAIR;
+  CAR (19) = 1;
+  CDR (19) = 1;
+
+  TYPE (20) = PAIR;
+  CAR (20) = 7;
+  CDR (20) = 19;
+
+  TYPE (21) = PAIR;
+  CAR (21) = 7;
+  CDR (21) = 20;
+
+  TYPE (22) = PAIR;
+  CAR (22) = 134;
+  CDR (22) = 21;
+
+  TYPE (23) = PAIR;
+  CAR (23) = 22;
+  CDR (23) = 137;
+
 #endif
 
   return 0;
@@ -1599,11 +1730,7 @@ main (int argc, char *argv[])
 #endif
   g_stdin = STDIN;
 
-#if 1
   r0 = mes_environment ();
-#else
-  puts ("FIXME: mes_environment ()\n");
-#endif
   
 #if MES_MINI
   SCM program = simple_bload_env (r0);
@@ -1613,7 +1740,57 @@ main (int argc, char *argv[])
   if (argc > 1 && !strcmp (argv[1], "--dump")) return dump ();
 #endif
 
+#if 0
+  //__GNUC__
+  //FIXME
   push_cc (r2, cell_unspecified, r0, cell_unspecified);
+  for (int x=19; x<26 ;x++)
+    {
+      puts(itoa(x));
+      puts(": type=");
+      puts(itoa(g_cells[x].type));
+      puts(" car=");
+      puts(itoa(g_cells[x].car));
+      puts(" cdr=");
+      puts(itoa(g_cells[x].cdr));
+      puts("\n");
+    }
+#else
+
+  g_stack = 23;
+  g_free = 24;
+  r1 = r2; //10: the-program
+  r2 = cell_unspecified;
+#endif
+
+#if __GNUC__
+  display_ (g_stack);
+
+  puts ("g_free=");
+  puts (itoa(g_free));
+  puts ("\n");
+
+  puts ("g_stack=");
+  puts (itoa(g_stack));
+  puts ("\n");
+
+  puts ("r0=");
+  puts (itoa(r0));
+  puts ("\n");
+
+  puts ("r1=");
+  puts (itoa(r1));
+  puts ("\n");
+
+  puts ("r2=");
+  puts (itoa(r2));
+  puts ("\n");
+
+  puts ("r3=");
+  puts (itoa(r3));
+  puts ("\n");
+#endif
+
   //r3 = cell_vm_begin;
   r3 = cell_vm_apply;
   r1 = eval_apply ();

scaffold/t.c

@@ -121,12 +121,24 @@ enum type_t {CHAR, CLOSURE, CONTINUATION, TFUNCTION, KEYWORD, MACRO, NUMBER, PAI
 typedef int SCM;
 int g_free = 3;
 SCM tmp;
+SCM tmp_num;
 
 #if 1
 int
 swits (int c)
 {
   int x = -1;
+
+  switch (c)
+    {
+    case 0: {goto next;}
+    case 1: {goto next;}
+    case 2: {goto next;}
+    default: {goto next;}
+    }
+
+  return 1;
+ next:
   switch (c)
     {
       case 0:
@@ -190,6 +202,51 @@ math_test ()
   return read_test ();
 }
 
+int ARENA_SIZE = 200;
+#define TYPE(x) (g_cells[x].type)
+#define CAR(x) g_cells[x].car
+#define CDR(x) g_cells[x].cdr
+#define VALUE(x) g_cells[x].cdr
+
+struct scm scm_fun = {TFUNCTION,0,0};
+SCM cell_fun;
+
+SCM
+alloc (int n)
+{
+  SCM x = g_free;
+  g_free += n;
+  return x;
+}
+
+SCM
+make_cell (SCM type, SCM car, SCM cdr)
+{
+  SCM x = alloc (1);
+  TYPE (x) = VALUE (type);
+  if (VALUE (type) == CHAR || VALUE (type) == NUMBER) {
+    if (car) CAR (x) = CAR (car);
+    if (cdr) CDR(x) = CDR(cdr);
+  }
+  else if (VALUE (type) == TFUNCTION) {
+    if (car) CAR (x) = car;
+    if (cdr) CDR(x) = CDR(cdr);
+  }
+  else {
+    CAR (x) = car;
+    CDR(x) = cdr;
+  }
+  return x;
+}
+
+SCM
+make_cell_test ()
+{
+  VALUE (tmp_num) = PAIR;
+  make_cell (tmp_num, 0, 1);
+  return math_test ();
+}
+
 SCM
 make_tmps_test (struct scm* cells)
 {
@@ -197,16 +254,12 @@ make_tmps_test (struct scm* cells)
   tmp = g_free++;
   puts ("t: cells[tmp].type = CHAR\n");
   cells[tmp].type = CHAR;
-  return math_test();
+  tmp_num = g_free++;
+  cells[tmp_num].type = NUMBER;
+
+  return make_cell_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 ()
 {
@@ -286,6 +339,18 @@ test (char *p)
   puts ("t: if (0)\n");
   if (0) return 1;
 
+  if (i)
+    return 1;
+  else
+    puts ("t: else 1\n");
+
+  if (i)
+    puts ("0");
+  else if (i == 1)
+    puts ("1");
+  else
+    puts ("t: else if 2\n");
+
   puts ("t: if (f)\n");
   if (f) return 1;
 
@@ -398,7 +463,8 @@ test (char *p)
  ok2:
 
   puts ("t: if (one < 2)\n");
-  if (one < 2) goto ok3;
+  //if (one < 2) goto ok3;
+  if (one < 0x44) goto ok3;
   return 1;
  ok3: