mescc: Cleanup mini-mes build and test.
[mes.git] / scaffold / tiny-mes.c
index 5e7261b20961dbeb9c57d40de46ea7f1d59763ef..3498e1c239573b7e89500b8d62845226fe6669a0 100644 (file)
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+#if __GNUC__
+#include "mlibc.c"
+#endif
+#define assert(x) ((x) ? (void)0 : assert_fail (#x))
+
 #define MES_MINI 1
 
 #if __GNUC__
 #define NYACC_CDR nyacc_cdr
 #endif
 
-int g_stdin = 0;
-
-#if __GNUC__
-typedef long size_t;
-void *malloc (size_t i);
-int open (char const *s, int mode);
-int read (int fd, void* buf, size_t n);
-void write (int fd, char const* s, int n);
-
-void
-exit (int code)
-{
-  asm (
-       "movl %0,%%ebx\n\t"
-       "movl $1,%%eax\n\t"
-       "int  $0x80"
-       : // no outputs "=" (r)
-       : "" (code)
-       );
-  // not reached
-  exit (0);
-}
-
-char const*
-getenv (char const* p)
-{
-  return 0;
-}
-
-int
-read (int fd, void* buf, size_t n)
-{
-  int r;
-  //syscall (SYS_write, fd, s, n));
-  asm (
-       "movl %1,%%ebx\n\t"
-       "movl %2,%%ecx\n\t"
-       "movl %3,%%edx\n\t"
-       "movl $0x3,%%eax\n\t"
-       "int  $0x80\n\t"
-       "mov %%eax,%0\n\t"
-       : "=r" (r)
-       : "" (fd), "" (buf), "" (n)
-       : "eax", "ebx", "ecx", "edx"
-       );
-  return r;
-}
-
-int
-open (char const *s, int mode)
-{
-  int r;
-  //syscall (SYS_open, mode));
-  asm (
-       "mov %1,%%ebx\n\t"
-       "mov %2,%%ecx\n\t"
-       "mov $0x5,%%eax\n\t"
-       "int $0x80\n\t"
-       "mov %%eax,%0\n\t"
-       : "=r" (r)
-       : "" (s), "" (mode)
-       : "eax", "ebx", "ecx"
-       );
-  return r;
-}
-
-int
-getchar ()
-{
-  char c;
-  int r = read (g_stdin, &c, 1);
-  if (r < 1) return -1;
-  return c;
-}
-
-void
-write (int fd, char const* s, int n)
-{
-  int r;
-  //syscall (SYS_write, fd, s, n));
-  asm (
-       "mov %0,%%ebx\n\t"
-       "mov %1,%%ecx\n\t"
-       "mov %2,%%edx\n\t"
-
-       "mov $0x4, %%eax\n\t"
-       "int $0x80\n\t"
-       : // no outputs "=" (r)
-       : "" (fd), "" (s), "" (n)
-       : "eax", "ebx", "ecx", "edx"
-       );
-}
-
-int
-putchar (int c)
-{
-  //write (STDOUT, s, strlen (s));
-  //int i = write (STDOUT, s, strlen (s));
-  write (1, (char*)&c, 1);
-  return 0;
-}
-
-void *
-malloc (size_t size)
-{
-  int *n;
-  int len = size + sizeof (size);
-  //n = mmap (0, len, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, 0, 0 );
-  *n = len;
-  return (void*)(n+1);
-}
-
-void
-free (void *p)
-{
-  int *n = (int*)p-1;
-  //munmap ((void*)p, *n);
-}
-
-#define EOF -1
-#define STDIN 0
-#define STDOUT 1
-#define STDERR 2
-
-size_t
-strlen (char const* s)
-{
-  int i = 0;
-  while (s[i]) i++;
-  return i;
-}
-
-int
-strcmp (char const* a, char const* b)
-{
-  while (*a && *b && *a == *b) {a++;b++;}
-  return *a - *b;
-}
-
-int
-puts (char const* s)
-{
-  //write (STDOUT, s, strlen (s));
-  //int i = write (STDOUT, s, strlen (s));
-  int i = strlen (s);
-  write (1, s, i);
-  return 0;
-}
-
-int
-eputs (char const* s)
-{
-  //write (STDERR, s, strlen (s));
-  //int i = write (STDERR, s, strlen (s));
-  int i = strlen (s);
-  write (2, s, i);
-  return 0;
-}
-
-char const*
-itoa (int x)
-{
-  static char buf[10];
-  char *p = buf+9;
-  *p-- = 0;
-
-  int sign = x < 0;
-  if (sign)
-    x = -x;
-  
-  do
-    {
-      *p-- = '0' + (x % 10);
-      x = x / 10;
-    } while (x);
-
-  if (sign)
-    *p-- = '-';
-
-  return p+1;
-}
-
-#endif
-
-void
-assert_fail (char* s)
-{
-  eputs ("assert fail:");
-#if __GNUC__
-  eputs (s);
-#endif
-  eputs ("\n");
-#if __GNUC__
-  *((int*)0) = 0;
-#endif
-}
-
-#if __GNUC__
-#define assert(x) ((x) ? (void)0 : assert_fail ("boo:" #x))
-#else
-//#define assert(x) ((x) ? (void)0 : assert_fail ("boo:" #x))
-#define assert(x) ((x) ? (void)0 : assert_fail (0))
-#endif
+char arena[200];
 
 typedef int SCM;
 
@@ -251,7 +54,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
@@ -262,12 +65,10 @@ struct scm {
   SCM cdr;
 };
 
-#if 0
-char arena[200];
-struct scm *g_cells = (struct scm*)arena;
-#else
-struct scm g_cells[200];
-#endif
+//char arena[200];
+//struct scm *g_cells = arena;
+//struct scm *g_cells = (struct scm*)arena;
+struct scm *g_cells = arena;
 
 #define cell_nil 1
 #define cell_f 2
@@ -348,7 +149,7 @@ fill ()
   TYPE (9) = 0x2d2d2d2d;
   CAR (9) = 0x2d2d2d2d;
   CDR (9) = 0x3e3e3e3e;
-#if 0
+
   // (A(B))
   TYPE (10) = PAIR;
   CAR (10) = 11;
@@ -373,35 +174,7 @@ fill ()
   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;
@@ -421,7 +194,7 @@ display_ (SCM x)
         putchar (VALUE (x));
         break;
       }
-    case FUNCTION:
+    case TFUNCTION:
       {
         //puts ("<function>\n");
         if (VALUE (x) == 0)
@@ -438,7 +211,7 @@ display_ (SCM x)
       {
         //puts ("<number>\n");
 #if __GNUC__
-        putchar (48 + VALUE (x));
+        puts (itoa (VALUE (x)));
 #else
         int i;
         i = VALUE (x);
@@ -471,10 +244,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;
       }
     }
@@ -484,35 +312,18 @@ display_ (SCM x)
 SCM
 bload_env (SCM a) ///((internal))
 {
-  //g_stdin = open ("module/mes/read-0-32.mo", 0);
-  g_stdin = open ("module/mes/hack-32.mo", 0);
-  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 ("reading: ");
+  char *mo = "module/mes/tiny-0-32.mo";
+  puts (mo);
   puts ("\n");
+  g_stdin = open (mo, 0);
+  if (g_stdin < 0) {eputs ("no such file: module/mes/tiny-0-32.mo\n");return 1;}
 
-#if __GNUC__
-  puts ("fd: ");
-  puts (itoa (g_stdin));
-  puts ("\n");
-#endif
+  // BOOM
+  //char *p = arena;
+  char *p = (char*)g_cells;
+  int c;
 
-#if __GNUC__
-  assert (getchar () == 'M');
-  assert (getchar () == 'E');
-  assert (getchar () == 'S');
-  puts ("GOT MES!\n");
-  g_stack = getchar () << 8;
-  g_stack += getchar ();
-  puts ("stack: ");
-  puts (itoa (g_stack));
-  puts ("\n");
-#else
   c = getchar ();
   putchar (c);
   if (c != 'M') exit (10);
@@ -522,11 +333,11 @@ bload_env (SCM a) ///((internal))
   c = getchar ();
   putchar (c);
   if (c != 'S') exit (12);
-  puts ("\n");
-  puts ("GOT MES!\n");
+  puts (" *GOT MES*\n");
+
+  // skip stack
   getchar ();
   getchar ();
-#endif
 
   c = getchar ();
   while (c != -1)
@@ -535,41 +346,9 @@ bload_env (SCM a) ///((internal))
       c = getchar ();
     }
 
-  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);
-
-  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 ();
+  puts ("read done\n");
   display_ (10);
-#endif
+
   puts ("\n");
   return r2;
 }
@@ -577,76 +356,17 @@ bload_env (SCM a) ///((internal))
 int
 main (int argc, char *argv[])
 {
-  puts ("filled sexp:\n");
   fill ();
+  char *p = arena;
+  puts (p);
+  puts ("\n");
   display_ (10);
   puts ("\n");
-
-#if __GNUC__
-  g_debug = (int)getenv ("MES_DEBUG");
-#endif
-  //if (getenv ("MES_ARENA")) ARENA_SIZE = atoi (getenv ("MES_ARENA"));
-
-  if (argc > 1 && !strcmp (argv[1], "--help")) return eputs ("Usage: mes [--dump|--load] < FILE\n");
-  if (argc > 1 && !strcmp (argv[1], "--version")) {eputs ("Mes ");eputs (VERSION);return eputs ("\n");};
-
-  if (argc > 1 && !strcmp (argv[1], "--help")) return eputs ("Usage: mes [--dump|--load] < FILE\n");
-
-
-#if __GNUC__
-  g_stdin = STDIN;
-  r0 = mes_environment ();
-#endif
-
-#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);
-  if (argc > 1 && !strcmp (argv[1], "--dump")) return dump ();
-
-  push_cc (r2, cell_unspecified, r0, cell_unspecified);
-  r3 = cell_vm_begin;
-  r1 = eval_apply ();
-  stderr_ (r1);
-
-  eputs ("\n");
-  gc (g_stack);
-#endif
-#if __GNUC__
-  if (g_debug)
-    {
-      eputs ("\nstats: [");
-      eputs (itoa (g_free));
-      eputs ("]\n");
-    }
-#endif
   return 0;
 }
 
 #if __GNUC__
-void
-_start ()
-{
-  int r;
-  asm (
-       "mov %%ebp,%%eax\n\t"
-       "addl $8,%%eax\n\t"
-       "push %%eax\n\t"
-
-       "mov %%ebp,%%eax\n\t"
-       "addl $4,%%eax\n\t"
-       "movzbl (%%eax),%%eax\n\t"
-       "push %%eax\n\t"
-
-       "call main\n\t"
-       "movl %%eax,%0\n\t"
-       : "=r" (r)
-       : //no inputs "" (&main)
-       );
-  exit (r);
-}
+#include "mstart.c"
 #endif
-