mescc: Display sexps better.

* module/mes/elf.mes (make-elf): Only display data sections smaller
  than 200 bytes.
* doc/examples/mini-mes.c (simple_bload_env): Read mini-0-32.mes.
* doc/examples/cons-mes.c (display_): Support symbols and specials.
* doc/examples/tiny-mes.c: Likewise.
* lib.c:
* mes.c:

diff --git a/lib.c b/lib.c
index fa0df77d0ae7f24297ab02cb888d32945ad95d90..cc09ea3a0a2b13856ad4ec5199e291fada120e1f 100644 (file)
--- a/lib.c
+++ b/lib.c
@@ -154,6 +154,10 @@ FILE *g_stdin;
 int
 dump ()
 {
+  fputs ("program r2=", stderr);
+  stderr_ (r2);
+  fputs ("\n", stderr);
+
   r1 = g_symbols;
   gc_push_frame ();
   gc ();
@@ -201,8 +205,13 @@ SCM
 load_env (SCM a) ///((internal))
 {
   r0 = a;
-  g_stdin = fopen ("module/mes/read-0.mes", "r");
-  g_stdin = g_stdin ? g_stdin : fopen (PREFIX "module/mes/read-0.mes", "r");
+  if (getenv ("MES_MINI"))
+    g_stdin = fopen ("mini-0.mes", "r");
+  else
+    {
+      g_stdin = fopen ("module/mes/read-0.mes", "r");
+      g_stdin = g_stdin ? g_stdin : fopen (PREFIX "module/mes/read-0.mes", "r");
+    }
   if (!g_function) r0 = mes_builtins (r0);
   r2 = read_input_file_env (r0);
   g_stdin = stdin;
@@ -212,8 +221,13 @@ load_env (SCM a) ///((internal))
 SCM
 bload_env (SCM a) ///((internal))
 {
+#if MES_MINI
+  g_stdin = fopen ("mini-0.mo", "r");
+#else
   g_stdin = fopen ("module/mes/read-0.mo", "r");
   g_stdin = g_stdin ? g_stdin : fopen (PREFIX "module/mes/read-0.mo", "r");
+#endif
+
   char *p = (char*)g_cells;
   assert (getchar () == 'M');
   assert (getchar () == 'E');

diff --git a/mes.c b/mes.c
index cc53d4a1184ae2d6b7021b93a05ca8830eed0d74..00d6244c34e5e72974c6e6f406767c6afa42696f 100644 (file)
--- a/mes.c
+++ b/mes.c
@@ -139,7 +139,7 @@ scm scm_vm_apply = {SPECIAL, "core:apply"};
 scm scm_vm_apply2 = {SPECIAL, "*vm-apply2*"};
 scm scm_vm_eval = {SPECIAL, "core:eval"};
 
-#if FIXED_PRIMITIVES
+#if 1 //FIXED_PRIMITIVES
 scm scm_vm_eval_car = {SPECIAL, "*vm-eval-car*"};
 scm scm_vm_eval_cdr = {SPECIAL, "*vm-eval-cdr*"};
 scm scm_vm_eval_cons = {SPECIAL, "*vm-eval-cons*"};

diff --git a/module/mes/elf.mes b/module/mes/elf.mes
index fa35bfa52e37c0dc719e104b699af4a160db0f35..dcb52f6bfce8ef3f7def3169c78e14073354da5c 100644 (file)
--- a/module/mes/elf.mes
+++ b/module/mes/elf.mes
@@ -273,8 +273,10 @@
       (+ str-offset str-length))
 
     (format (current-error-port) "ELF text=~a\n" (map dec->hex text))
-    (format (current-error-port) "ELF raw-data=~a\n" (map dec->hex raw-data))
-    (format (current-error-port) "ELF data=~a\n" (map dec->hex data))
+    (if (< (length raw-data) 200)
+        (format (current-error-port) "ELF raw-data=~a\n" (map dec->hex raw-data)))
+    (if (< (length data) 200)
+        (format (current-error-port) "ELF data=~a\n" (map dec->hex data)))
     (format (current-error-port) "text-offset=~a\n" text-offset)
     (format (current-error-port) "data-offset=~a\n" data-offset)
     (format (current-error-port) "_start=~a\n" (number->string entry 16))

diff --git a/scaffold/cons-mes.c b/scaffold/cons-mes.c
index 5a4c95dea05f6da2ff3afd124efb57ce926151ec..c579988c1cd649d40e66a113b31fee031cd848f6 100644 (file)
--- a/scaffold/cons-mes.c
+++ b/scaffold/cons-mes.c
@@ -1037,7 +1037,7 @@ display_ (SCM x)
       {
         //puts ("<number>\n");
 #if __GNUC__
-        putchar (48 + VALUE (x));
+        puts (itoa (VALUE (x)));
 #else
         int i;
         i = VALUE (x);
@@ -1070,10 +1070,65 @@ display_ (SCM x)
         puts (")");
         break;
       }
+    case SPECIAL:
+      {
+        switch (x)
+          {
+          case 1: {puts ("()"); break;}
+          case 2: {puts ("#f"); break;}
+          case 3: {puts ("#t"); break;}
+          default:
+            {
+#if __GNUC__
+        puts ("<x:");
+        puts (itoa (x));
+        puts (">");
+#else
+        puts ("<x>");
+#endif
+            }
+          }
+        break;
+      }
+    case SYMBOL:
+      {
+        switch (x)
+          {
+          case 11: {puts (" . "); break;}
+          case 12: {puts ("lambda"); break;}
+          case 13: {puts ("begin"); break;}
+          case 14: {puts ("if"); break;}
+          case 15: {puts ("quote"); break;}
+          case 37: {puts ("car"); break;}
+          case 38: {puts ("cdr"); break;}
+          case 39: {puts ("null?"); break;}
+          case 40: {puts ("eq?"); break;}
+          case 41: {puts ("cons"); break;}
+          default:
+            {
+#if __GNUC__
+        puts ("<s:");
+        puts (itoa (x));
+        puts (">");
+#else
+        puts ("<s>");
+#endif
+            }
+          }
+        break;
+      }
     default:
       {
         //puts ("<default>\n");
+#if __GNUC__
+        puts ("<");
+        puts (itoa (TYPE (x)));
+        puts (":");
+        puts (itoa (x));
+        puts (">");
+#else
         puts ("_");
+#endif
         break;
       }
     }

diff --git a/scaffold/mini-mes.c b/scaffold/mini-mes.c
index 1b924cc53e067224a241d4088b7909908af01063..794cd992d41bec0fb911f2ad96f275af838659ed 100644 (file)
--- a/scaffold/mini-mes.c
+++ b/scaffold/mini-mes.c
@@ -19,7 +19,7 @@
  */
 
 #define MES_MINI 1
-#define FIXED_PRIMITIVES 0
+#define FIXED_PRIMITIVES 1
 
 #if __GNUC__
 #define FIXME_NYACC 1
@@ -340,6 +340,12 @@ struct scm *g_cells = arena;
 #define cell_symbol_primitive_load 24
 #define cell_symbol_read_input_file 25
 
+#define cell_symbol_car 37
+#define cell_symbol_cdr 38
+#define cell_symbol_null_p 39
+#define cell_symbol_eq_p 40
+#define cell_symbol_cons 41
+
 #define cell_vm_evlis 42
 #define cell_vm_evlis2 43
 #define cell_vm_evlis3 44
@@ -379,8 +385,12 @@ int g_function = 0;
 SCM make_cell (SCM type, SCM car, SCM cdr);
 #endif
 struct function fun_make_cell = {&make_cell, 3};
+
+#if __GNUC__
+struct scm scm_make_cell = {TFUNCTION, "make-cell", 0};
+#else
 struct scm scm_make_cell = {TFUNCTION,0,0};
-   //, "make-cell", 0};
+#endif
 SCM cell_make_cell;
 
 #if __GNUC__
@@ -388,8 +398,11 @@ SCM cell_make_cell;
 SCM cons (SCM x, SCM y);
 #endif
 struct function fun_cons = {&cons, 2};
-struct scm scm_cons = {TFUNCTION,0,0};
-  // "cons", 0};
+#if __GNUC__
+struct scm scm_cons = {TFUNCTION,"cons", 0};
+#else
+struct scm scm_make_cell = {TFUNCTION,0,0};
+#endif
 SCM cell_cons;
 
 #if __GNUC__
@@ -397,8 +410,11 @@ SCM cell_cons;
 SCM car (SCM x);
 #endif
 struct function fun_car = {&car, 1};
-struct scm scm_car = {TFUNCTION,0,0};
-  // "car", 0};
+#if __GNUC__
+struct scm scm_car = {TFUNCTION,"car", 0};
+#else
+struct scm scm_make_cell = {TFUNCTION,0,0};
+#endif
 SCM cell_car;
 
 #if __GNUC__
@@ -406,8 +422,11 @@ SCM cell_car;
 SCM cdr (SCM x);
 #endif
 struct function fun_cdr = {&cdr, 1};
-struct scm scm_cdr = {TFUNCTION,0,0};
-// "cdr", 0};
+#if __GNUC__
+struct scm scm_cdr = {TFUNCTION,"cdr", 0};
+#else
+struct scm scm_make_cell = {TFUNCTION,0,0};
+#endif
 SCM cell_cdr;
 
 // SCM eq_p (SCM x, SCM y);
@@ -462,11 +481,13 @@ alloc (int n)
   return x;
 }
 
+#define DEBUG 0
+
 SCM
 make_cell (SCM type, SCM car, SCM cdr)
 {
   SCM x = alloc (1);
-#if __GNUC__
+#if DEBUG
   puts ("make_cell type=");
   puts (itoa (type));
   puts ("\n");
@@ -474,7 +495,17 @@ make_cell (SCM type, SCM car, SCM cdr)
   puts (itoa (TYPE (type)));
   puts ("\n");
 #endif
-  assert (TYPE (type) == NUMBER);
+  if  (TYPE (type) != NUMBER)
+    {
+      puts ("type != NUMBER\n");
+      if (TYPE (type) < 10) puts ("type < 10\n");
+      if (TYPE (type) < 20) puts ("type < 20\n");
+      if (TYPE (type) < 30) puts ("type < 30\n");
+      if (TYPE (type) < 40) puts ("type < 40\n");
+      if (TYPE (type) < 50) puts ("type < 50\n");
+      if (TYPE (type) < 60) puts ("type < 60\n");
+    }
+  //assert (TYPE (type) == NUMBER);
   TYPE (x) = VALUE (type);
   if (VALUE (type) == CHAR || VALUE (type) == NUMBER) {
     if (car) CAR (x) = CAR (car);
@@ -508,11 +539,11 @@ tmp_num2_ (int x)
 SCM
 cons (SCM x, SCM y)
 {
+#if DEBUG
   puts ("cons x=");
-#if __GNUC__
   puts (itoa (x));
-#endif
   puts ("\n");
+#endif
   VALUE (tmp_num) = PAIR;
   return make_cell (tmp_num, x, y);
 }
@@ -520,11 +551,11 @@ cons (SCM x, SCM y)
 SCM
 car (SCM x)
 {
+#if DEBUG
   puts ("car x=");
-#if __GNUC__
   puts (itoa (x));
-#endif
   puts ("\n");
+#endif
 #if MES_MINI
   //Nyacc
   //assert ("!car");
@@ -537,11 +568,11 @@ car (SCM x)
 SCM
 cdr (SCM x)
 {
+#if DEBUG
   puts ("cdr x=");
-#if __GNUC__
   puts (itoa (x));
-#endif
   puts ("\n");
+#endif
 #if MES_MINI
   //Nyacc
   //assert ("!cdr");
@@ -551,6 +582,12 @@ cdr (SCM x)
   return CDR(x);
 }
 
+SCM
+null_p (SCM x)
+{
+  return x == cell_nil ? cell_t : cell_f;
+}
+
 // SCM
 // eq_p (SCM x, SCM y)
 // {
@@ -679,16 +716,47 @@ SCM call (SCM,SCM);
 SCM gc_pop_frame ();
 #endif
 
+SCM
+cons_eval_apply ()
+{
+  puts ("e/a: enter\n");
+ eval_apply:
+  // if (g_free + GC_SAFETY > ARENA_SIZE)
+  //   gc_pop_frame (gc (gc_push_frame ()));
+
+  switch (r3)
+    {
+    case cell_vm_apply: {goto apply;}
+    case cell_unspecified: {return r1;}
+    }
+
+  SCM x = cell_nil;
+  SCM y = cell_nil;
+
+ apply:
+  puts ("e/a: apply\n");
+  switch (TYPE (car (r1)))
+    {
+    case TFUNCTION: {
+      puts ("apply.function\n");
+      //check_formals (car (r1), MAKE_NUMBER (FUNCTION (car (r1)).arity), cdr (r1));
+      r1 = call (car (r1), cdr (r1));
+      goto vm_return;
+    }
+    }
+ vm_return:
+  x = r1;
+  gc_pop_frame ();
+  r1 = x;
+  goto eval_apply;
+}
+
 SCM
 eval_apply ()
 {
-  puts ("e/a: fixme\n");
+  puts ("e/a: enter\n");
  eval_apply:
-  asm (".byte 0x90");
-  asm (".byte 0x90");
-  asm (".byte 0x90");
-  asm (".byte 0x90");
-  puts ("eval_apply\n");
+  puts ("e/a: eval_apply\n");
   // if (g_free + GC_SAFETY > ARENA_SIZE)
   //   gc_pop_frame (gc (gc_push_frame ()));
 
@@ -725,6 +793,7 @@ eval_apply ()
   SCM x = cell_nil;
   SCM y = cell_nil;
  evlis:
+  puts ("e/a: evlis\n");
   if (r1 == cell_nil) goto vm_return;
   if (TYPE (r1) != PAIR) goto eval;
   push_cc (car (r1), r1, r0, cell_vm_evlis2);
@@ -737,7 +806,7 @@ eval_apply ()
   goto vm_return;
 
  apply:
-  puts ("apply\n");
+  puts ("e/a: apply\n");
   switch (TYPE (car (r1)))
     {
     case TFUNCTION: {
@@ -825,6 +894,7 @@ eval_apply ()
   goto apply;
 
  eval:
+  puts ("e/a: eval\n");
   switch (TYPE (r1))
     {
     case PAIR:
@@ -939,12 +1009,16 @@ eval_apply ()
   goto vm_return;
 #endif
  begin:
+  puts ("e/a: begin\n");
   x = cell_unspecified;
   while (r1 != cell_nil) {
     if (TYPE (r1) == PAIR && TYPE (CAR (r1)) == PAIR)
       {
         if (caar (r1) == cell_symbol_begin)
-          r1 = append2 (cdar (r1), cdr (r1));
+          {
+            puts ("begin00\n");
+            r1 = append2 (cdar (r1), cdr (r1));
+          }
         else if (caar (r1) == cell_symbol_primitive_load)
           {
             push_cc (cons (cell_symbol_read_input_file, cell_nil), r1, r0, cell_vm_begin_read_input_file);
@@ -953,11 +1027,13 @@ eval_apply ()
             r1 = append2 (r1, cdr (r2));
           }
       }
+    puts ("begin01\n");
     if (CDR (r1) == cell_nil)
       {
         r1 = car (r1);
         goto eval;
       }
+    puts ("begin02\n");
     push_cc (CAR (r1), r1, r0, cell_vm_begin2);
     goto eval;
   begin2:
@@ -1012,12 +1088,17 @@ eval_apply ()
   goto apply;
 
  vm_return:
+  puts ("e/a: vm-return\n");
   x = r1;
   gc_pop_frame ();
   r1 = x;
   goto eval_apply;
 }
 
+#if __GNUC__
+SCM display_ (SCM);
+#endif
+
 SCM
 call (SCM fn, SCM x)
 {
@@ -1028,6 +1109,23 @@ call (SCM fn, SCM x)
   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)));
+
+  puts ("fn=");
+  display_ (fn);
+#if __GNUC__
+  puts (itoa (fn));
+  puts (" .type=");
+  puts (itoa (TYPE (fn)));
+  puts (" .cdr=");
+  puts (itoa (CDR (fn)));
+#endif
+  puts ("\n");
+
+  puts ("arity=");
+#if __GNUC__
+  puts (itoa (FUNCTION (fn).arity));
+#endif
+  puts ("\n");
   switch (FUNCTION (fn).arity)
     {
     // case 0: return FUNCTION (fn).function0 ();
@@ -1054,7 +1152,8 @@ gc_peek_frame ()
 {
   SCM frame = car (g_stack);
   r1 = car (frame);
-#if __GNUC__
+#if 1
+  //GNUC
   r2 = cadr (frame);
   r3 = car (cddr (frame));
   r0 = cadr (cddr (frame));
@@ -1316,6 +1415,11 @@ cell_make_cell = g_free++;
  
 scm_cons.cdr = g_function;
 g_functions[g_function++] = fun_cons;
+#if __GNUC__
+ puts ("BUILTIN cons=");
+ puts (itoa (g_free));
+ puts ("\n");
+#endif
 cell_cons = g_free++;
 g_cells[cell_cons] = scm_cons;
  
@@ -1329,21 +1433,38 @@ g_functions[g_function++] = fun_cdr;
 cell_cdr = g_free++;
 g_cells[cell_cdr] = scm_cdr;
 
-// scm_make_cell.string = cstring_to_list (scm_make_cell.name);
-// g_cells[cell_make_cell].string = MAKE_STRING (scm_make_cell.string);
-// a = acons (make_symbol (scm_make_cell.string), cell_make_cell, a);
-
-// scm_cons.string = cstring_to_list (scm_cons.name);
-// g_cells[cell_cons].string = MAKE_STRING (scm_cons.string);
-// a = acons (make_symbol (scm_cons.string), cell_cons, a);
+//scm_make_cell.string = cstring_to_list (scm_make_cell.name);
+//g_cells[cell_make_cell].string = MAKE_STRING (scm_make_cell.string);
+//a = acons (make_symbol (scm_make_cell.string), cell_make_cell, a);
+ puts ("00\n");
+scm_make_cell.car = cstring_to_list (scm_make_cell.car);
+ puts ("01\n");
+g_cells[cell_make_cell].car = MAKE_STRING (scm_make_cell.car);
+ puts ("02\n");
+ a = acons (make_symbol (scm_make_cell.car), cell_make_cell, a);
+ puts ("03\n");
+
+ //scm_cons.string = cstring_to_list (scm_cons.name);
+//g_cells[cell_cons].string = MAKE_STRING (scm_cons.string);
+//a = acons (make_symbol (scm_cons.string), cell_cons, a);
+scm_cons.car = cstring_to_list (scm_cons.car);
+g_cells[cell_cons].car = MAKE_STRING (scm_cons.car);
+a = acons (make_symbol (scm_cons.car), cell_cons, a);
+
+//scm_car.string = cstring_to_list (scm_car.name);
+//g_cells[cell_car].string = MAKE_STRING (scm_car.string);
+//a = acons (make_symbol (scm_cons.string), cell_cons, a);
+scm_car.car = cstring_to_list (scm_car.car);
+g_cells[cell_car].car = MAKE_STRING (scm_car.car);
+a = acons (make_symbol (scm_cons.car), cell_cons, a);
+
+//scm_cdr.string = cstring_to_list (scm_cdr.name);
+//g_cells[cell_cdr].string = MAKE_STRING (scm_cdr.string);
+//a = acons (make_symbol (scm_cdr.string), cell_cdr, a);
+scm_cdr.car = cstring_to_list (scm_cdr.car);
+g_cells[cell_cdr].car = MAKE_STRING (scm_cdr.car);
+a = acons (make_symbol (scm_cdr.car), cell_cdr, a);
 
-// scm_car.string = cstring_to_list (scm_car.name);
-// g_cells[cell_car].string = MAKE_STRING (scm_car.string);
-// a = acons (make_symbol (scm_car.string), cell_car, a);
-
-// scm_cdr.string = cstring_to_list (scm_cdr.name);
-// g_cells[cell_cdr].string = MAKE_STRING (scm_cdr.string);
-// a = acons (make_symbol (scm_cdr.string), cell_cdr, a);
 #endif
   return a;
 }
@@ -1501,7 +1622,7 @@ display_ (SCM x)
       {
         //puts ("<number>\n");
 #if __GNUC__
-        putchar (48 + VALUE (x));
+        puts (itoa (VALUE (x)));
 #else
         int i;
         i = VALUE (x);
@@ -1534,10 +1655,65 @@ display_ (SCM x)
         puts (")");
         break;
       }
+    case SPECIAL:
+      {
+        switch (x)
+          {
+          case 1: {puts ("()"); break;}
+          case 2: {puts ("#f"); break;}
+          case 3: {puts ("#t"); break;}
+          default:
+            {
+#if __GNUC__
+        puts ("<x:");
+        puts (itoa (x));
+        puts (">");
+#else
+        puts ("<x>");
+#endif
+            }
+          }
+        break;
+      }
+    case SYMBOL:
+      {
+        switch (x)
+          {
+          case 11: {puts (" . "); break;}
+          case 12: {puts ("lambda"); break;}
+          case 13: {puts ("begin"); break;}
+          case 14: {puts ("if"); break;}
+          case 15: {puts ("quote"); break;}
+          case 37: {puts ("car"); break;}
+          case 38: {puts ("cdr"); break;}
+          case 39: {puts ("null?"); break;}
+          case 40: {puts ("eq?"); break;}
+          case 41: {puts ("cons"); break;}
+          default:
+            {
+#if __GNUC__
+        puts ("<s:");
+        puts (itoa (x));
+        puts (">");
+#else
+        puts ("<s>");
+#endif
+            }
+          }
+        break;
+      }
     default:
       {
         //puts ("<default>\n");
+#if __GNUC__
+        puts ("<");
+        puts (itoa (TYPE (x)));
+        puts (":");
+        puts (itoa (x));
+        puts (">");
+#else
         puts ("_");
+#endif
         break;
       }
     }
@@ -1553,7 +1729,7 @@ simple_bload_env (SCM a) ///((internal))
 #if CONS
   char *mo = "module/mes/hack-32.mo";
 #else
-  char *mo = "cons-32.mo";
+  char *mo = "mini-0-32.mo";
 #endif
 
   puts (mo);
@@ -1583,25 +1759,10 @@ simple_bload_env (SCM a) ///((internal))
   puts ("\n");
 #endif
 
-// #if !CONS
-//   //FIXME: skip one cell
-//   for  (int q=0; q < 12; q++)
-//     getchar ();
-// #endif
-
-  int i = 0;
   c = getchar ();
   while (c != -1)
     {
-#if __GNUC__
-      puts ("\ni=");
-      puts (itoa (i));
-      puts (" ");
-      puts (itoa (c));
-      puts (" ");
-#endif
       putchar (c);
-      i++;
       *p++ = c;
       c = getchar ();
     }
@@ -1609,23 +1770,14 @@ simple_bload_env (SCM a) ///((internal))
   puts ("read done\n");
 
   g_free = (p-(char*)g_cells) / sizeof (struct scm);
-
-#if !CONS
   gc_peek_frame ();
-#endif
-
-  // URG
-  // r0 = 628;
-  // r1 = 67;
-  // r2 = 389;
+  g_symbols = r1;
 
 #if __GNUC__
   puts ("XXcells read: ");
   puts (itoa (g_free));
   puts ("\n");
 
-  g_symbols = r1;
-
   eputs ("r0=");
   eputs (itoa (r0));
   eputs ("\n");
@@ -1687,8 +1839,9 @@ simple_bload_env (SCM a) ///((internal))
 #endif
   puts ("]: ");
 
-  // display_ (r2);
-  // puts ("\n");
+  display_ (r2);
+  //stderr_ (r2);
+  puts ("\n");
 
   return r2;
 }
@@ -1759,12 +1912,13 @@ main (int argc, char *argv[])
   if (argc > 1 && !strcmp (argv[1], "--dump")) return dump ();
 #endif
 
+  //if  (r2 != 10) r2 = CAR (r2);
   push_cc (r2, cell_unspecified, r0, cell_unspecified);
 
 #if __GNUC__
-  puts ("stack: ");
-  display_ (g_stack);
-  puts ("\n");
+  // puts ("stack: ");
+  // display_ (g_stack);
+  // puts ("\n");
 
   puts ("g_free=");
   puts (itoa(g_free));
@@ -1791,11 +1945,32 @@ main (int argc, char *argv[])
   puts ("\n");
 #endif
 
+#if 0
+  // SKIP DINGES!
+  if  (r1 != 10) r1 = CAR (r1);
+  puts ("r1=");
+  display_ (r1);
+  puts ("\n");
+  r3 = cell_vm_apply;
+  //r1 = cons_eval_apply ();
+  r1 = eval_apply ();
+#else
   r3 = cell_vm_begin;
-  //r3 = cell_vm_apply;
   r1 = eval_apply ();
-  stderr_ (r1);
-  //display_ (r1);
+#endif
+
+#if __GNUC__
+  puts ("result r1=");
+  puts (itoa (r1));
+  puts ("\n");
+
+  puts ("result r1.type=");
+  puts (itoa (TYPE (r1)));
+  puts ("\n");
+#endif
+
+  //stderr_ (r1);
+  display_ (r1);
 
   eputs ("\n");
 #if !MES_MINI

diff --git a/scaffold/tiny-mes.c b/scaffold/tiny-mes.c
index 956380a76ad753812f70bd23e331010a41ac50a0..b7591a6ef021c2045a45917d4b58c2057ce642d3 100644 (file)
--- a/scaffold/tiny-mes.c
+++ b/scaffold/tiny-mes.c
@@ -253,7 +253,7 @@ SCM r2 = 0; // save 2+load/dump
 SCM r3 = 0; // continuation
 
 #if __NYACC__ || FIXME_NYACC
-enum type_t {CHAR, CLOSURE, CONTINUATION, FUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, TSTRING, SYMBOL, VALUES, TVECTOR, BROKEN_HEART};
+enum type_t {CHAR, CLOSURE, CONTINUATION, TFUNCTION, 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
@@ -393,7 +393,7 @@ display_ (SCM x)
         putchar (VALUE (x));
         break;
       }
-    case FUNCTION:
+    case TFUNCTION:
       {
         //puts ("<function>\n");
         if (VALUE (x) == 0)
@@ -410,7 +410,7 @@ display_ (SCM x)
       {
         //puts ("<number>\n");
 #if __GNUC__
-        putchar (48 + VALUE (x));
+        puts (itoa (VALUE (x)));
 #else
         int i;
         i = VALUE (x);
@@ -443,10 +443,65 @@ display_ (SCM x)
         puts (")");
         break;
       }
+    case SPECIAL:
+      {
+        switch (x)
+          {
+          case 1: {puts ("()"); break;}
+          case 2: {puts ("#f"); break;}
+          case 3: {puts ("#t"); break;}
+          default:
+            {
+#if __GNUC__
+        puts ("<x:");
+        puts (itoa (x));
+        puts (">");
+#else
+        puts ("<x>");
+#endif
+            }
+          }
+        break;
+      }
+    case SYMBOL:
+      {
+        switch (x)
+          {
+          case 11: {puts (" . "); break;}
+          case 12: {puts ("lambda"); break;}
+          case 13: {puts ("begin"); break;}
+          case 14: {puts ("if"); break;}
+          case 15: {puts ("quote"); break;}
+          case 37: {puts ("car"); break;}
+          case 38: {puts ("cdr"); break;}
+          case 39: {puts ("null?"); break;}
+          case 40: {puts ("eq?"); break;}
+          case 41: {puts ("cons"); break;}
+          default:
+            {
+#if __GNUC__
+        puts ("<s:");
+        puts (itoa (x));
+        puts (">");
+#else
+        puts ("<s>");
+#endif
+            }
+          }
+        break;
+      }
     default:
       {
         //puts ("<default>\n");
+#if __GNUC__
+        puts ("<");
+        puts (itoa (TYPE (x)));
+        puts (":");
+        puts (itoa (x));
+        puts (">");
+#else
         puts ("_");
+#endif
         break;
       }
     }
@@ -501,7 +556,8 @@ int
 main (int argc, char *argv[])
 {
   fill ();
-  puts (g_cells);
+  char *p = arena;
+  puts (p);
   puts ("\n");
   display_ (10);
   puts ("\n");