mescc: Fixes for goto.

* module/mes/libc-i386.mes (XXjump): New function.
* module/mes/libc-i386.scm: Export it.
* module/language/c99/compiler.mes (case->jump-info, ast->info): Use it.
* scaffold/t.c: Test it.
* GNUmakefile (cons-mes): New target.
* scaffold/cons-mes.c: New file.
* scaffold/mini-mes.c:

GNUmakefile

@@ -118,6 +118,11 @@ mini-mes: scaffold/mini-mes.c GNUmakefile
 	gcc -nostdlib --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $<
 	chmod +x $@
 
+cons-mes: scaffold/cons-mes.c GNUmakefile
+	rm -f $@
+	gcc -nostdlib --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $<
+	chmod +x $@
+
 tiny-mes: scaffold/tiny-mes.c GNUmakefile
 	rm -f $@
 	gcc -nostdlib --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $<

module/language/c99/compiler.mes

@@ -797,17 +797,22 @@
     (pmatch o
       ((case (p-expr (ident ,constant)) (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 (assoc-ref (.constants info) constant))
-                (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))))
+                (text-length (length (.text test-info)))
+                (clause-info (let loop ((elements elements) (info test-info))
                                (if (null? elements) info
                                    (loop (cdr elements) ((statement->info info body-length) (car elements))))))
                 (clause-text (list-tail (.text clause-info) text-length))
                 (clause-length (length (text->list clause-text))))
            (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)))))
 
@@ -820,17 +825,12 @@
          (let* ((value (cstring->number value))
                 (test-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)
                                (test->text value clause-length)
@@ -1236,12 +1236,12 @@
 
         ((goto (ident ,label))
          
-         (let ((offset (length (text->list text)))
+         (let* ((jump (lambda (n) (i386:XXjump n)))
-               (jump (lambda (n) (i386:Xjump n))))
+                (offset (+ (length (jump 0)) (length (text->list text)))))
            (clone info #:text
                   (append text
                           (list (lambda (f g ta t d)
-                                  (jump (- (label-offset (.function info) label f) offset (length (jump 0))))))))))
+                                  (jump (- (label-offset (.function info) label f) offset))))))))
 
         ;;; FIXME: only zero?!
         ((p-expr (ident ,name))

module/mes/libc-i386.mes

@@ -333,6 +333,10 @@
   (or n urg:Xjump)
   `(#xe9 ,@(int->bv32 (if (>= n 0) n (- n 5))))) ; jmp . + <n>
 
+(define (i386:XXjump n)
+  (or n urg:XXjump)
+  `(#xe9 ,@(int->bv32 n)))              ; jmp . + <n>
+
 (define (i386:Xjump-nz n)
   (or n urg:Xjump-nz)
   `(#x0f #x85 ,@(int->bv32 n)))         ; jnz . + <n>

module/mes/libc-i386.scm

@@ -118,6 +118,7 @@
             i386:xor-zf
 
             i386:Xjump
+            i386:XXjump
             i386:Xjump-c
             i386:Xjump-nc
             i386:Xjump-nz

scaffold/mini-mes.c

@@ -623,6 +623,7 @@ SCM gc_pop_frame ();
 SCM
 eval_apply ()
 {
+  puts ("e/a: fixme\n");
  eval_apply:
   puts ("eval_apply\n");
   // if (g_free + GC_SAFETY > ARENA_SIZE)
@@ -700,6 +701,7 @@ eval_apply ()
       r1 = call (x, y);
 #endif
       puts ("after call\n");
+      y = 0x44;
       goto vm_return;
     }
 //     case CLOSURE:
@@ -978,18 +980,7 @@ 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;
@@ -1054,11 +1045,12 @@ call (SCM fn, SCM x)
       SCM p1 = car (x);
       SCM p2 = cdr (x);
       p2 = car (p2);
+      //return ((SCM(*)(SCM,SCM))(FUNCTION (fn).function)) (p1, 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;
+      //p3 = 0x44;
       puts ("05\n");
       return cons (p1, p2);
       return (*functionx) (p1, p2);
@@ -1741,9 +1733,9 @@ main (int argc, char *argv[])
 #endif
 
 #if 0
-  //__GNUC__
   //FIXME
   push_cc (r2, cell_unspecified, r0, cell_unspecified);
+#if __GNUC__
   for (int x=19; x<26 ;x++)
     {
       puts(itoa(x));
@@ -1755,8 +1747,8 @@ main (int argc, char *argv[])
       puts(itoa(g_cells[x].cdr));
       puts("\n");
     }
+#endif
 #else
-
   g_stack = 23;
   g_free = 24;
   r1 = r2; //10: the-program

scaffold/t.c

@@ -124,6 +124,16 @@ SCM tmp;
 SCM tmp_num;
 
 #if 1
+int
+label (int c)
+{
+ label:
+  if (c == 0) return c;
+  c--;
+  goto label;
+  return 1;
+}
+
 int
 swits (int c)
 {
@@ -131,7 +141,7 @@ swits (int c)
 
   switch (c)
     {
-    case 0: {goto next;}
+    case CHAR: {goto next;}
     case 1: {goto next;}
     case 2: {goto next;}
     default: {goto next;}
@@ -434,6 +444,9 @@ test (char *p)
   *x++ = c;
   if (*g_chars != 'C') return 1;
 
+  puts ("t: goto label\n");
+  if (label (1) != 0) return 1;
+
   puts ("t: switch 0\n");
   if (swits (0) != 0) return swits (0);
 
@@ -563,6 +576,21 @@ 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");