mescc: Read and display sexp dumped by mes.

* lib.c (dump)[MES_HACK]: Dump small hello-world sexp, to be handled by
* doc/examples/tiny-mes.c (display_): New function.
* module/mes/libc-i386.mes (i386:accu->base, i386:mem->accu,
  i386:mem+n->accu): New functions.
* module/mes/libc-i386.scm: Export them.
* GNUmakefile (mes-32): New target.

GNUmakefile

@@ -90,6 +90,14 @@ module/mes/read-0.mo: module/mes/read-0.mes mes
 
 dump: module/mes/read-0.mo
 
+mes-32:
+	rm -f mes mes.o
+	guix environment --system=i686-linux --ad-hoc gcc-toolchain -- bash -c 'make mes CC=i686-unknown-linux-gnu-gcc LIBRARY_PATH=$${PATH%%/bin:*}/lib'
+	mv mes mes-32
+
+module/mes/hack-32.mo: mes-32
+	MES_HACK=1 ./mes-32 --dump < module/mes/read-0.mes > module/mes/hack-32.mo
+
 guile-check:
 	set -e; for i in $(TESTS); do\
 		$(GUILE) -s <(cat $(MES-0) module/mes/test.mes $$i);\

lib.c

@@ -139,6 +139,34 @@ dump ()
   fputc ('S', stdout);
   fputc (g_stack >> 8, stdout);
   fputc (g_stack % 256, stdout);
+  if (getenv ("MES_HACK"))
+    {
+      TYPE (9) = 0x2d2d2d2d;
+      CAR (9) = 0x2d2d2d2d;
+      CDR (9) = 0x3e3e3e3e;
+
+      TYPE (10) = PAIR;
+      CAR (10) = 11;
+      CDR (10) = 12;
+
+      TYPE (11) = CHAR;
+      CAR (11) = 0x58585858;
+      CDR (11) = 65;
+
+      TYPE (12) = PAIR;
+      CAR (12) = 13;
+      CDR (12) = 1;
+
+      TYPE (13) = CHAR;
+      CAR (11) = 0x58585858;
+      CDR (13) = 66;
+
+      TYPE (14) = 0x3c3c3c3c;
+      CAR (14) = 0x2d2d2d2d;
+      CDR (14) = 0x2d2d2d2d;
+
+      g_free = 15;
+    }
   for (int i=0; i<g_free * sizeof(scm); i++)
     fputc (*p++, stdout);
   return 0;

module/language/c99/compiler.mes

@@ -930,17 +930,19 @@
 
         ((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)))
+                (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)
-                                              (i386:value->accu-ref+n offset b)))))))
+                                              (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)))

module/mes/libc-i386.mes

@@ -84,9 +84,12 @@
     #xc3                                ; ret
     )))
 
+(define (i386:accu->base)
+  '(#x89 #xc2))                         ; mov    %eax,%edx
+
 (define (i386:accu->local n)
   (or n accu->local)
-  `(#x89 #x45 ,(- 0 (* 4 n))))          ; mov    ,%eax,-<0xn>(%ebp)
+  `(#x89 #x45 ,(- 0 (* 4 n))))          ; mov    %eax,-<0xn>(%ebp)
 
 (define (i386:accu->global n)
   (or n accu->global)
@@ -153,6 +156,12 @@
   '(#x01 #xd0                           ; add    %edx,%eax
          #x8b #x00))                    ; mov    (%eax),%eax
 
+(define (i386:mem->accu)
+  '(#x8b #x00))                         ; mov    (%eax),%eax
+
+(define (i386:mem+n->accu n)
+  `(#x8b #x40 ,n))                      ; mov    0x<n>(%eax),%eax
+
 (define (i386:base-mem+n->accu n)
   `(#x01 #xd0                           ; add    %edx,%eax
          #x8b #x40 ,n))                 ; mov    <n>(%eax),%eax

module/mes/libc-i386.scm

@@ -30,6 +30,7 @@
   #:export (
             i386:accu-not
             i386:accu-cmp-value
+            i386:accu->base
             i386:accu->global
             i386:accu->local
             i386:accu-non-zero?
@@ -74,6 +75,8 @@
             i386:local-address->accu
             i386:local-ref->base
             i386:local-test
+            i386:mem->accu
+            i386:mem+n->accu
             i386:push-accu
             i386:push-global
             i386:push-global-ref

scaffold/t.c

@@ -147,6 +147,7 @@ test (char *p)
   int f = 0;
   int t = 1;
   int one = 1;
+  char c = 'C';
 
   puts ("t: if (0)\n");
   if (0) return 1;
@@ -206,11 +207,22 @@ test (char *p)
   puts ("t: (f) ?\n");
   (f) ? exit (1) : 1;
 
+  puts ("t: *g_cells != 'A'\n");
+  arena[0] = 'A';
+  if (*g_cells != 'A') return 1;
+
+  puts ("t: *x != 'A'\n");
+  char *x = g_cells;
+  if (*x != 'A') return 1;
+
   puts ("t: *x != 'Q'\n");
   g_cells[0] = 'Q';
-  char *x = g_cells;
   if (*x != 'Q') return 1;
 
+  puts ("t: *x++ != 'C'\n");
+  *x++ = c;
+  if (*g_cells != 'C') return 1;
+
   puts ("t: switch 0\n");
   if (swits (0) != 0) return swits (0);
 
@@ -281,12 +293,39 @@ test (char *p)
 
   puts ("t: if (++i)\n");
   if (++i) goto ok9;
+  return 1;
  ok9:
 
   puts ("t: if (i--)\n");
   if (i--) goto ok10;
+  return 1;
  ok10:
 
+  puts ("t: *g_cells == 'B'\n");
+  arena[0] = 'B';
+  if (*g_cells == 'B') goto ok11;
+  return 1;
+ ok11:
+
+  puts ("t: *x == 'B'\n");
+  x = g_cells;
+  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;
+  return 1;
+ ok13:
+
+  puts ("t: *x++ == 'C'\n");
+  *x++ = c;
+  if (*g_cells == 'C') goto ok14;
+  return 1;
+ ok14:
+
   puts ("t: for (i=0; i<4; ++i)\n");
   for (i=0; i<4; ++i);
   if (i != 4) return i;

scaffold/tiny-mes.c

@@ -219,9 +219,13 @@ void
 assert_fail (char* s)
 {
   eputs ("assert fail:");
+#if __GNUC__
   eputs (s);
+#endif
   eputs ("\n");
+#if __GNUC__
   *((int*)0) = 0;
+#endif
 }
 
 #if __GNUC__
@@ -246,56 +250,36 @@ SCM r1 = 0; // param 1
 SCM r2 = 0; // save 2+load/dump
 SCM r3 = 0; // continuation
 
-typedef int SCM;
 #if __NYACC__ || FIXME_NYACC
 enum type_t {CHAR, CLOSURE, CONTINUATION, FUNCTION, 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
-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 {
-    function0_t function0;
-    function1_t function1;
-    function2_t function2;
-    function3_t function3;
-    functionn_t functionn;
-  } data;
-  int arity;
-} function_t;
-struct scm;
 
-typedef struct scm_struct {
+struct scm {
   enum type_t type;
-  union {
+  SCM car;
-    char const *name;
+  SCM cdr;
-    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;
 
-char arena[200000];
+#if 0
-scm *g_cells = (scm*)arena;
+char arena[200];
+struct scm *g_cells = (struct scm*)arena;
+#else
+struct scm g_cells[200];
+#endif
+
+#define cell_nil 1
+#define cell_f 2
+#define cell_t 3
+
+#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].value
+#define VALUE(x) g_cells[x].cdr
 
 SCM
 car (SCM x)
@@ -350,57 +334,254 @@ mes_builtins (SCM a)
   return a;
 }
 
+SCM
+fill ()
+{
+  TYPE (0) = 0x6c6c6168;
+  CAR (0) = 0x6a746f6f;
+  CDR (0) = 0x00002165;
+
+  TYPE (1) = SYMBOL;
+  CAR (1) = 0x2d2d2d2d;
+  CDR (1) = 0x3e3e3e3e;
+
+  TYPE (9) = 0x2d2d2d2d;
+  CAR (9) = 0x2d2d2d2d;
+  CDR (9) = 0x3e3e3e3e;
+#if 0
+  // (A(B))
+  TYPE (10) = PAIR;
+  CAR (10) = 11;
+  CDR (10) = 12;
+
+  TYPE (11) = CHAR;
+  CAR (11) = 0x58585858;
+  CDR (11) = 89;
+
+  TYPE (12) = PAIR;
+  CAR (12) = 13;
+  CDR (12) = 1;
+
+  TYPE (13) = CHAR;
+  CAR (11) = 0x58585858;
+  CDR (13) = 90;
+
+  TYPE (14) = 0x58585858;
+  CAR (14) = 0x58585858;
+  CDR (14) = 0x58585858;
+
+  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;
+  return 0;
+}
+
+SCM
+display_ (SCM x)
+{
+  //puts ("<display>\n");
+  switch (TYPE (x))
+    {
+    case CHAR:
+      {
+        //puts ("<char>\n");
+        puts ("#\\");
+        putchar (VALUE (x));
+        break;
+      }
+    case FUNCTION:
+      {
+        //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 NUMBER:
+      {
+        //puts ("<number>\n");
+#if __GNUC__
+        putchar (48 + VALUE (x));
+#else
+        int i;
+        i = VALUE (x);
+        i = i + 48;
+        putchar (i);
+#endif
+        break;
+      }
+    case PAIR:
+      {
+        //puts ("<pair>\n");
+        //if (cont != cell_f) puts "(");
+        puts ("(");
+        if (x && x != cell_nil) display_ (CAR (x));
+        if (CDR (x) && CDR (x) != cell_nil)
+          {
+#if __GNUC__
+            if (TYPE (CDR (x)) != PAIR)
+              puts (" . ");
+#else
+            int c;
+            c = CDR (x);
+            c = TYPE (c);
+            if (c != PAIR)
+              puts (" . ");
+#endif
+            display_ (CDR (x));
+          }
+        //if (cont != cell_f) puts (")");
+        puts (")");
+        break;
+      }
+    default:
+      {
+        //puts ("<default>\n");
+        puts ("_");
+        break;
+      }
+    }
+  return 0;
+}
+
 SCM
 bload_env (SCM a) ///((internal))
 {
-  puts ("bload_env\n");
+  //g_stdin = open ("module/mes/read-0-32.mo", 0);
-  g_stdin = open ("module/mes/read-0.mo", 0);
+  g_stdin = open ("module/mes/hack-32.mo", 0);
-  if (g_stdin < 0) {eputs ("no such file: module/mes/read-0.mo\n");return 1;} 
+  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");
+
 #if __GNUC__
   puts ("fd: ");
   puts (itoa (g_stdin));
   puts ("\n");
-  //g_stdin = g_stdin ? g_stdin : fopen (PREFIX "module/mes/read-0.mo", "r");
 #endif
-  char *p = (char*)g_cells;
 
-  // int x;
+#if __GNUC__
-  // x = getchar ();
-  // if (x == 'M') puts ("M");
-  // x = getchar ();
-  // if (x == 'E') puts ("E");
-  // x = getchar ();
-  // if (x == 'S') puts ("S");
-  
   assert (getchar () == 'M');
   assert (getchar () == 'E');
   assert (getchar () == 'S');
-  puts ("GOT MES\n");
+  puts ("GOT MES!\n");
   g_stack = getchar () << 8;
   g_stack += getchar ();
-  int c = getchar ();
+  puts ("stack: ");
+  puts (itoa (g_stack));
+  puts ("\n");
+#else
+  c = getchar ();
+  putchar (c);
+  if (c != 'M') exit (10);
+  c = getchar ();
+  putchar (c);
+  if (c != 'E') exit (11);
+  c = getchar ();
+  putchar (c);
+  if (c != 'S') exit (12);
+  puts ("\n");
+  puts ("GOT MES!\n");
+  getchar ();
+  getchar ();
+#endif
+
+  c = getchar ();
   while (c != -1)
     {
       *p++ = c;
       c = getchar ();
     }
-  g_free = (p-(char*)g_cells) / sizeof (scm);
+
+  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);
 
-#if __GNUC__
   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 ();
+  display_ (10);
 #endif
+  puts ("\n");
   return r2;
 }
 
 int
 main (int argc, char *argv[])
 {
+  puts ("filled sexp:\n");
+  fill ();
+  display_ (10);
+  puts ("\n");
+
 #if __GNUC__
   g_debug = (int)getenv ("MES_DEBUG");
 #endif
@@ -420,6 +601,7 @@ main (int argc, char *argv[])
 #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);
@@ -467,3 +649,4 @@ _start ()
   exit (r);
 }
 #endif
+