core/mini-mes: Merge merge mes.c and mini-mes.c.
authorJan Nieuwenhuizen <janneke@gnu.org>
Mon, 10 Apr 2017 17:13:20 +0000 (19:13 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Mon, 10 Apr 2017 17:13:20 +0000 (19:13 +0200)
* mes.c:
* scaffold/mini-mes.c:
* gc.c:
* GNUmakefile:

GNUmakefile
gc.c
lib.c
mes.c
module/mes/read-0-32.mo
posix.c
reader.c
scaffold/mini-mes.c

index 413f4804b50eed94825474c32e16b8d5e812091a..49b817c502074e7fea7cfd40af3ab6967cb698cc 100644 (file)
@@ -29,6 +29,9 @@ CPPFLAGS+=-DMODULEDIR='"$(MODULEDIR)/"'
 CPPFLAGS+=-DPREFIX='"$(PREFIX)/"'
 CPPFLAGS+=-DVERSION='"$(VERSION)"'
 
+MINI_CPPFLAGS:=$(CPPFLAGS)
+CPPFLAGS+=-D_POSIX_SOURCE
+
 export BOOT
 ifneq ($(BOOT),)
 CPPFLAGS+=-DBOOT=1
@@ -162,7 +165,7 @@ mescc-check: t-check
 mini-%.h mini-%.i mini-%.environment.i mini-%.symbols.i: %.c build-aux/mes-snarf.scm GNUmakefile
        build-aux/mes-snarf.scm --mini $<
 
-mini-mes.h mini-mes.i mini-mes.environment.i mini-mes.symbols.i: scaffold/mini-mes.c build-aux/mes-snarf.scm GNUmakefile
+mini-mes.h mini-mes.i mini-mes.environment.i mini-mes.symbols.i: mes.c build-aux/mes-snarf.scm GNUmakefile
        build-aux/mes-snarf.scm --mini $<
 
 mini-mes: mini-mes.h mini-mes.i mini-mes.environment.i mini-mes.symbols.i
@@ -171,9 +174,9 @@ mini-mes: vector.c mini-vector.h mini-vector.i mini-vector.environment.i
 mini-mes: mlibc.c mstart.c
 mini-mes: GNUmakefile
 mini-mes: module/mes/read-0-32.mo
-mini-mes: scaffold/mini-mes.c
+mini-mes: mes.c
        rm -f $@
-       gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(CPPFLAGS) $<
+       gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(MINI_CPPFLAGS) $<
        rm -f mes.o
        chmod +x $@
 
@@ -187,7 +190,7 @@ guile-mini-mes: vector.c mini-vector.h mini-vector.i mini-vector.environment.i
 guile-mini-mes: mlibc.c mstart.c
 guile-mini-mes: GNUmakefile
 guile-mini-mes: module/mes/read-0-32.mo
-guile-mini-mes: scaffold/mini-mes.c
+guile-mini-mes: mes.c
        rm -f $@
        guile/mescc.scm $< > $@ || rm -f $@
        chmod +x $@
@@ -198,7 +201,7 @@ mes-mini-mes: vector.c mini-vector.h mini-vector.i mini-vector.environment.i
 mes-mini-mes: mlibc.c mstart.c
 mes-mini-mes: GNUmakefile
 mes-mini-mes: module/mes/read-0-32.mo
-mes-mini-mes: scaffold/mini-mes.c
+mes-mini-mes: mes.c
        rm -f $@
 #      MES_FLAGS= MES_DEBUG=1 scripts/mescc.mes $< > $@ || rm -f $@
        MES_FLAGS= MES_DEBUG=1 scripts/mescc.mes $< > $@
@@ -214,7 +217,7 @@ mes-hello: scaffold/hello.c
 
 cons-mes: module/mes/tiny-0-32.mo
 cons-mes: scaffold/cons-mes.c GNUmakefile
-       gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(CPPFLAGS) $<
+       gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(MINI_CPPFLAGS) $<
        chmod +x $@
 
 guile-cons-mes: module/mes/tiny-0-32.mo
@@ -225,7 +228,7 @@ guile-cons-mes: scaffold/cons-mes.c
 
 tiny-mes: module/mes/tiny-0-32.mo
 tiny-mes: scaffold/tiny-mes.c GNUmakefile
-       gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(CPPFLAGS) $<
+       gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(MINI_CPPFLAGS) $<
        chmod +x $@
 
 guile-tiny-mes: module/mes/tiny-0-32.mo
@@ -235,7 +238,7 @@ guile-tiny-mes: scaffold/tiny-mes.c
        chmod +x $@
 
 m: scaffold/m.c GNUmakefile
-       gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(CPPFLAGS) $<
+       gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(MINI_CPPFLAGS) $<
 #      gcc --std=gnu99 -g -o $@ $(CPPFLAGS) $<
        chmod +x $@
 
@@ -245,7 +248,7 @@ guile-m: scaffold/m.c
        chmod +x $@
 
 malloc: scaffold/malloc.c GNUmakefile
-       gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(CPPFLAGS) $<
+       gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(MINI_CPPFLAGS) $<
        chmod +x $@
 
 guile-malloc: scaffold/malloc.c
@@ -254,7 +257,7 @@ guile-malloc: scaffold/malloc.c
 
 micro-mes: scaffold/micro-mes.c GNUmakefile
        rm -f $@
-       gcc -nostdlib --std=gnu99 -m32 -o $@ $(CPPFLAGS) $<
+       gcc -nostdlib --std=gnu99 -m32 -o $@ $(MINI_CPPFLAGS) $<
        chmod +x $@
 
 guile-micro-mes: scaffold/micro-mes.c
@@ -263,7 +266,7 @@ guile-micro-mes: scaffold/micro-mes.c
 
 main: doc/examples/main.c GNUmakefile
        rm -f $@
-       gcc -nostdlib --std=gnu99 -m32 -o $@ $(CPPFLAGS) $<
+       gcc -nostdlib --std=gnu99 -m32 -o $@ $(MINI_CPPFLAGS) $<
        chmod +x $@
 
 guile-main: doc/examples/main.c
@@ -273,7 +276,7 @@ guile-main: doc/examples/main.c
 t: mlibc.c
 t: scaffold/t.c GNUmakefile
        rm -f $@
-       gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(CPPFLAGS) $<
+       gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(MINI_CPPFLAGS) $<
        chmod +x $@
 
 guile-t: scaffold/t.c
diff --git a/gc.c b/gc.c
index 26e4b252ce0bd0b9747887f950341404979998c9..fcf38118632fd0529b49432e820b056910486211 100644 (file)
--- a/gc.c
+++ b/gc.c
 SCM
 gc_up_arena () ///((internal))
 {
-#if _POSIX_SOURCE
   ARENA_SIZE *= 2;
   GC_SAFETY *= 2;
+#if _POSIX_SOURCE
   void *p = realloc (g_cells-1, 2*ARENA_SIZE*sizeof(struct scm));
 #else
-  ARENA_SIZE = ARENA_SIZE * 2;
-  GC_SAFETY = GC_SAFETY * 2;
-  //p = realloc (g_cells-1, 2*ARENA_SIZE*sizeof(struct scm));
-  int size = ARENA_SIZE * 2;
-  size = size * 12;
-  char *p = size;
-  p = realloc (g_cells-1, size);
-  g_cells = p;
+  char *p = g_cells;
+  p = realloc (p-sizeof (struct scm), 2*ARENA_SIZE*sizeof(struct scm));
 #endif
 
 #if _POSIX_SOURCE
   if (!p) error (cell_symbol_system_error, cons (MAKE_STRING (cstring_to_list (strerror (errno))), MAKE_NUMBER (g_free)));
   g_cells = (struct scm*)p;
   g_cells++;
-#else
-  //assert (p);
-  //g_cells = (struct scm*)p;
 #endif
   gc_init_news ();
   return 0;
@@ -54,16 +45,12 @@ gc_flip () ///((internal))
   struct scm *cells = g_cells;
   g_cells = g_news;
   g_news = cells;
-#if _POSIX_SOURCE
-  if (g_debug) fprintf (stderr, ";;;   => jam[%d]\n", g_free);
-#else
   if (g_debug)
     {
       eputs (";;;   => jam[");
       eputs (itoa (g_free));
       eputs ("]\n");
     }
-#endif
   return g_stack;
 }
 
@@ -144,9 +131,6 @@ gc_check ()
 SCM
 gc ()
 {
-#if _POSIX_SOURCE
-  if (g_debug) fprintf (stderr, ";;; gc[%d:%d]...", g_free, ARENA_SIZE - g_free);
-#else
   if (g_debug)
     {
       eputs (";;; gc[");
@@ -155,7 +139,6 @@ gc ()
       eputs (itoa (ARENA_SIZE - g_free));
       eputs ("]...");
     }
-#endif
   g_free = 1;
   if (g_cells < g_news && ARENA_SIZE < MAX_ARENA_SIZE) gc_up_arena ();
   for (int i=g_free; i<g_symbol_max; i++)
@@ -163,16 +146,12 @@ gc ()
   make_tmps (g_news);
   g_symbols = gc_copy (g_symbols);
   SCM new = gc_copy (g_stack);
-#if _POSIX_SOURCE
-  if (g_debug) fprintf (stderr, "new=%d\n", new);
-#else
   if (g_debug)
     {
       eputs ("new=");
       eputs (itoa (new));
       eputs ("\n");
     }
-#endif
   g_stack = new;
   return gc_loop (1);
 }
diff --git a/lib.c b/lib.c
index ae5232055e1c87b8d5f84687dfe6d1789ec90ab5..be37c7ac124a1f7bc0bee940ca17598f0576fd1f 100644 (file)
--- a/lib.c
+++ b/lib.c
@@ -57,7 +57,8 @@ fdputs (char const* s, int fd)
 #ifdef putc
 #undef putc
 #endif
-#define putc fdputc
+#define putc(x) fdputc(x, STDOUT)
+#define fputc fdputc
 int
 fdputc (int c, int fd)
 {
@@ -80,7 +81,7 @@ display_helper (SCM x, int cont, char* sep, int fd)
     case TCHAR:
       {
         fputs ("#\\", fd);
-        putc (VALUE (x), fd);
+        fputc (VALUE (x), fd);
         break;
       }
     case TFUNCTION:
@@ -131,7 +132,7 @@ display_helper (SCM x, int cont, char* sep, int fd)
         SCM t = CAR (x);
         while (t && t != cell_nil)
           {
-            putc (VALUE (CAR (t)), fd);
+            fputc (VALUE (CAR (t)), fd);
             t = CDR (t);
           }
         break;
diff --git a/mes.c b/mes.c
index 90110863ca3d37177c93f5c7b7602759ada72501..7bdbac6e018318e77461627c591e1e18082f0f46 100644 (file)
--- a/mes.c
+++ b/mes.c
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+#if !_POSIX_SOURCE
+#if !__MESC__
+#include "mlibc.c"
+#endif
+#define assert(x) ((x) ? (void)0 : assert_fail (#x))
+#else
 #define _GNU_SOURCE
-#if __GNUC__
-#define  __NYACC__ 0
-#define NYACC
-#define NYACC2
 #include <assert.h>
 #include <ctype.h>
 #include <errno.h>
 #include <string.h>
 #include <stdlib.h>
 #include <stdbool.h>
-#else
-typedef int bool;
-#define  __NYACC__ 1
-#define NYACC nyacc
-#define NYACC2 nyacc2
 #endif
 
-#define DEBUG 0
 #define FIXED_PRIMITIVES 1
 
 int ARENA_SIZE = 100000;
@@ -47,8 +43,38 @@ int MAX_ARENA_SIZE = 20000000;
 //int GC_SAFETY = ARENA_SIZE / 400;
 int GC_SAFETY = 250;
 
+char *g_arena = 0;
 typedef int SCM;
+
+int g_debug = 0;
+int g_free = 0;
+
+SCM g_continuations = 0;
+SCM g_symbols = 0;
+SCM g_stack = 0;
+// a/env
+SCM r0 = 0;
+// param 1
+SCM r1 = 0;
+// save 2+load/dump
+SCM r2 = 0;
+// continuation
+SCM r3 = 0;
+
 enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVECTOR, TBROKEN_HEART};
+
+#if !_POSIX_SOURCE
+struct scm {
+  enum type_t type;
+  SCM car;
+  SCM cdr;
+};
+struct function {
+  int (*function) (void);
+  int arity;
+  char *name;
+};
+#else
 typedef SCM (*function0_t) (void);
 typedef SCM (*function1_t) (SCM);
 typedef SCM (*function2_t) (SCM, SCM);
@@ -61,7 +87,7 @@ struct function {
     function2_t function2;
     function3_t function3;
     functionn_t functionn;
-  } NYACC;
+  };
   int arity;
   char const *name;
 };
@@ -73,7 +99,7 @@ struct scm {
     SCM car;
     SCM ref;
     int length;
-  } NYACC;
+  };
   union {
     int value;
     int function;
@@ -83,8 +109,19 @@ struct scm {
     SCM macro;
     SCM vector;
     int hits;
-  } NYACC2;
+  };
 };
+#endif
+
+#if __MESC__
+//FIXME
+char *foobar = 0;
+struct scm *g_cells = foobar;
+struct scm *g_news = foobar;
+#else
+struct scm *g_cells = 0;
+struct scm *g_news = 0;
+#endif
 
 struct scm scm_nil = {TSPECIAL, "()",0};
 struct scm scm_f = {TSPECIAL, "#f",0};
@@ -166,14 +203,11 @@ struct scm scm_symbol_mesc = {TSYMBOL, "%mesc",0};
 
 struct scm scm_test = {TSYMBOL, "test",0};
 
-
-int g_free = 0;
-struct scm *g_cells;
-struct scm *g_news = 0;
-SCM g_symbol_max;
-bool g_debug = false;
-
+#if !_POSIX_SOURCE
+#include "mini-mes.symbols.h"
+#else
 #include "mes.symbols.h"
+#endif
 
 SCM tmp;
 SCM tmp_num;
@@ -182,14 +216,15 @@ SCM tmp_num2;
 struct function g_functions[200];
 int g_function = 0;
 
-SCM g_continuations = 0;
-SCM g_symbols = 0;
-SCM g_stack = 0;
-SCM r0 = 0; // a/env
-SCM r1 = 0; // param 1
-SCM r2 = 0; // save 2+load/dump
-SCM r3 = 0; // continuation
-
+#if !__GNUC__
+#include "mini-gc.h"
+#include "mini-lib.h"
+#include "mini-math.h"
+#include "mini-mes.h"
+#include "mini-posix.h"
+// #include "mini-reader.h"
+#include "mini-vector.h"
+#else
 #include "gc.h"
 #include "lib.h"
 #include "math.h"
@@ -197,15 +232,40 @@ SCM r3 = 0; // continuation
 #include "posix.h"
 #include "reader.h"
 #include "vector.h"
+#endif
 
+#define TYPE(x) g_cells[x].type
 #define CAR(x) g_cells[x].car
 #define CDR(x) g_cells[x].cdr
+
+#define NTYPE(x) g_news[x].type
+#define NCAR(x) g_news[x].car
+#define NCDR(x) g_news[x].cdr
+
+#if !_POSIX_SOURCE
+#define LENGTH(x) g_cells[x].car
+#define REF(x) g_cells[x].car
+#define STRING(x) g_cells[x].car
+
+#define CLOSURE(x) g_cells[x].cdr
+#define CONTINUATION(x) g_cells[x].cdr
+
+#define FUNCTION(x) g_functions[g_cells[x].cdr]
+#define MACRO(x) g_cells[x].cdr
+#define VALUE(x) g_cells[x].cdr
+#define VECTOR(x) g_cells[x].cdr
+
+#define NLENGTH(x) g_news[x].car
+
+#define NVALUE(x) g_news[x].cdr
+#define NVECTOR(x) g_news[x].cdr
+
+#else
 #define CONTINUATION(x) g_cells[x].cdr
 #define HITS(x) g_cells[x].hits
 #define LENGTH(x) g_cells[x].length
 #define NAME(x) g_cells[x].name
 #define STRING(x) g_cells[x].string
-#define TYPE(x) g_cells[x].type
 #define CLOSURE(x) g_cells[x].closure
 #define MACRO(x) g_cells[x].macro
 #define REF(x) g_cells[x].ref
@@ -213,15 +273,17 @@ SCM r3 = 0; // continuation
 #define VECTOR(x) g_cells[x].vector
 #define FUNCTION(x) g_functions[g_cells[x].function]
 
-#define NTYPE(x) g_news[x].type
-
-#define NCAR(x) g_news[x].car
 #define NLENGTH(x) g_news[x].length
 
-#define NCDR(x) g_news[x].cdr
 #define NVALUE(x) g_news[x].value
 #define NVECTOR(x) g_news[x].vector
+#endif
 
+#define MAKE_CHAR(n) make_cell_ (tmp_num_ (TCHAR), 0, tmp_num2_ (n))
+#define MAKE_CONTINUATION(n) make_cell_ (tmp_num_ (TCONTINUATION), n, g_stack)
+#define MAKE_NUMBER(n) make_cell_ (tmp_num_ (TNUMBER), 0, tmp_num2_ (n))
+#define MAKE_REF(n) make_cell_ (tmp_num_ (TREF), n, 0)
+#define MAKE_STRING(x) make_cell_ (tmp_num_ (TSTRING), x, 0)
 
 #define CAAR(x) CAR (CAR (x))
 #define CADR(x) CAR (CDR (x))
@@ -229,43 +291,41 @@ SCM r3 = 0; // continuation
 #define CDDR(x) CDR (CDR (x))
 #define CADAR(x) CAR (CDR (CAR (x)))
 #define CADDR(x) CAR (CDR (CDR (x)))
-#define CDDDR(x) CDR (CDR (CDR (x)))
 #define CDADAR(x) CAR (CDR (CAR (CDR (x))))
 
-#define MAKE_CHAR(n) make_cell_ (tmp_num_ (TCHAR), 0, tmp_num2_ (n))
-#define MAKE_CONTINUATION(n) make_cell_ (tmp_num_ (TCONTINUATION), n, g_stack)
-#define MAKE_NUMBER(n) make_cell_ (tmp_num_ (TNUMBER), 0, tmp_num2_ (n))
-#define MAKE_REF(n) make_cell_ (tmp_num_ (TREF), n, 0)
-#define MAKE_STRING(x) make_cell_ (tmp_num_ (TSTRING), x, 0)
-
+#if 0
 SCM vm_call (function0_t f, SCM p1, SCM a);
+#endif
+
+#if _POSIX_SOURCE
 char const* itoa(int);
+int fdputs (char const*, int);
+#define eputs(s) fdputs(s, 2)
+#endif
 
-#define eputs(s) fputs(s, stderr)
+SCM
+alloc (int n)
+{
+  assert (g_free + n < ARENA_SIZE);
+  SCM x = g_free;
+  g_free += n;
+  return x;
+}
 
 SCM
 tmp_num_ (int x)
 {
-  g_cells[tmp_num].value = x;
+  VALUE (tmp_num) = x;
   return tmp_num;
 }
 
 SCM
 tmp_num2_ (int x)
 {
-  g_cells[tmp_num2].value = x;
+  VALUE (tmp_num2) = x;
   return tmp_num2;
 }
 
-SCM
-alloc (int n)
-{
-  assert (g_free + n < ARENA_SIZE);
-  SCM x = g_free;
-  g_free += n;
-  return x;
-}
-
 SCM
 make_cell_ (SCM type, SCM car, SCM cdr)
 {
@@ -274,21 +334,23 @@ make_cell_ (SCM type, SCM car, SCM cdr)
   TYPE (x) = VALUE (type);
   if (VALUE (type) == TCHAR || VALUE (type) == TNUMBER) {
     if (car) CAR (x) = CAR (car);
-    if (cdr) CDR (x) = CDR (cdr);
-  } else if (VALUE (type) == TFUNCTION) {
+    if (cdr) CDR(x) = CDR(cdr);
+  }
+  else if (VALUE (type) == TFUNCTION) {
     if (car) CAR (x) = car;
-    if (cdr) CDR (x) = CDR (cdr);
-  } else {
+    if (cdr) CDR(x) = CDR(cdr);
+  }
+  else {
     CAR (x) = car;
-    CDR (x) = cdr;
+    CDR(x) = cdr;
   }
   return x;
 }
 
 SCM
-make_symbol_ (SCM s)
+make_symbol_ (SCM s) ///((internal))
 {
-  g_cells[tmp_num].value = TSYMBOL;
+  VALUE (tmp_num) = TSYMBOL;
   SCM x = make_cell_ (tmp_num, s, 0);
   g_symbols = cons (x, g_symbols);
   return x;
@@ -356,7 +418,7 @@ arity_ (SCM x)
 SCM
 cons (SCM x, SCM y)
 {
-  g_cells[tmp_num].value = TPAIR;
+  VALUE (tmp_num) = TPAIR;
   return make_cell_ (tmp_num, x, y);
 }
 
@@ -413,7 +475,6 @@ acons (SCM key, SCM value, SCM alist)
   return cons (cons (key, value), alist);
 }
 
-// MIMI_MES lib.c?
 SCM
 length (SCM x)
 {
@@ -439,7 +500,7 @@ error (SCM key, SCM x)
   eputs (": ");
   display_error_ (x);
   eputs ("\n");
-  assert (!"error");
+  exit (1);
 }
 
 SCM
@@ -452,6 +513,68 @@ cstring_to_list (char const* s)
   return p;
 }
 
+// \f extra lib
+SCM
+assert_defined (SCM x, SCM e) ///((internal))
+{
+  if (e == cell_undefined) return error (cell_symbol_unbound_variable, x);
+  return e;
+}
+
+SCM
+check_formals (SCM f, SCM formals, SCM args) ///((internal))
+{
+  int flen = (TYPE (formals) == TNUMBER) ? VALUE (formals) : VALUE (length (formals));
+  int alen = VALUE (length (args));
+  if (alen != flen && alen != -1 && flen != -1)
+    {
+      char *s = "apply: wrong number of arguments; expected: ";
+      eputs (s);
+      eputs (itoa (flen));
+      eputs (", got: ");
+      eputs (itoa (alen));
+      eputs ("\n");
+      display_error_ (f);
+      SCM e = MAKE_STRING (cstring_to_list (s));
+      return error (cell_symbol_wrong_number_of_args, cons (e, f));
+    }
+  return cell_unspecified;
+}
+
+SCM
+check_apply (SCM f, SCM e) ///((internal))
+{
+  char* type = 0;
+  if (f == cell_f || f == cell_t) type = "bool";
+  if (f == cell_nil) type = "nil";
+  if (f == cell_unspecified) type = "*unspecified*";
+  if (f == cell_undefined) type = "*undefined*";
+  if (TYPE (f) == TCHAR) type = "char";
+  if (TYPE (f) == TNUMBER) type = "number";
+  if (TYPE (f) == TSTRING) type = "string";
+
+  if (type)
+    {
+      char *s = "cannot apply: ";
+      eputs (s);
+      eputs (type);
+      eputs ("[");
+      display_error_ (e);
+      eputs ("]\n");
+      SCM e = MAKE_STRING (cstring_to_list (s));
+      return error (cell_symbol_wrong_type_arg, cons (e, f));
+    }
+  return cell_unspecified;
+}
+
+SCM
+gc_push_frame () ///((internal))
+{
+  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)
 {
@@ -482,11 +605,20 @@ call (SCM fn, SCM x)
     x = cons (CAR (x), cons (CDADAR (x), CDR (x)));
   switch (FUNCTION (fn).arity)
     {
+#if __MESC__
+    case 0: return (FUNCTION (fn).function) ();
+    case 1: return ((SCM(*)(SCM))(FUNCTION (fn).function)) (CAR (x));
+    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)));
+    case -1: return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);
+    default: return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);
+#else
     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);
+#endif
     }
 
   return cell_unspecified;
@@ -495,6 +627,8 @@ call (SCM fn, SCM x)
 SCM
 assq (SCM x, SCM a)
 {
+  //FIXME: move into fast-non eq_p-ing assq core:assq?
+  //while (a != cell_nil && x != CAAR (a)) a = CDR (a);
   while (a != cell_nil && eq_p (x, CAAR (a)) == cell_f) a = CDR (a);
   return a != cell_nil ? CAR (a) : cell_f;
 }
@@ -523,8 +657,6 @@ set_cdr_x (SCM x, SCM e)
   return cell_unspecified;
 }
 
-SCM assert_defined (SCM, SCM);
-
 SCM
 set_env_x (SCM x, SCM e, SCM a)
 {
@@ -543,7 +675,7 @@ call_lambda (SCM e, SCM x, SCM aa, SCM a) ///((internal))
 }
 
 SCM
-make_closure_ (SCM args, SCM body, SCM a) ///((internal))xs
+make_closure_ (SCM args, SCM body, SCM a) ///((internal))
 {
   return make_cell_ (tmp_num_ (TCLOSURE), cell_f, cons (cons (cell_circular, a), cons (args, body)));
 }
@@ -557,11 +689,37 @@ lookup_macro_ (SCM x, SCM a) ///((internal))
   return cell_f;
 }
 
-SCM check_apply (SCM, SCM);
-SCM check_formals (SCM, SCM, SCM);
-SCM push_cc (SCM, SCM, SCM, SCM);
-SCM gc_pop_frame ();
-SCM gc_push_frame ();
+SCM
+push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
+{
+  SCM x = r3;
+  r3 = c;
+  r2 = p2;
+  gc_push_frame ();
+  r1 = p1;
+  r0 = a;
+  r3 = x;
+  return cell_unspecified;
+}
+
+SCM
+gc_peek_frame () ///((internal))
+{
+  SCM frame = CAR (g_stack);
+  r1 = CAR (frame);
+  r2 = CADR (frame);
+  r3 = CAR (CDDR (frame));
+  r0 = CADR (CDDR (frame));
+  return frame;
+}
+
+SCM
+gc_pop_frame () ///((internal))
+{
+  SCM frame = gc_peek_frame (g_stack);
+  g_stack = cdr (g_stack);
+  return frame;
+}
 
 SCM
 eval_apply ()
@@ -895,53 +1053,27 @@ eval_apply ()
 }
 
 SCM
-gc_peek_frame () ///((internal))
-{
-  SCM frame = car (g_stack);
-  r1 = car (frame);
-  r2 = CADR (frame);
-  r3 = car (CDDR (frame));
-  r0 = CADR (CDDR (frame));
-  return frame;
-}
-
-SCM
-gc_pop_frame () ///((internal))
-{
-  SCM frame = gc_peek_frame (g_stack);
-  g_stack = cdr (g_stack);
-  return frame;
-}
-
-SCM
-gc_push_frame () ///((internal))
+apply (SCM f, SCM x, SCM a) ///((internal))
 {
-  SCM frame = cons (r1, cons (r2, cons (r3, cons (r0, cell_nil))));
-  return g_stack = cons (frame, g_stack);
+  push_cc (cons (f, x), cell_unspecified, r0, cell_unspecified);
+  r3 = cell_vm_apply;
+  return eval_apply ();
 }
 
 SCM
-push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
+mes_g_stack (SCM a) ///((internal))
 {
-  SCM x = r3;
-  r3 = c;
-  r2 = p2;
-  gc_push_frame ();
-  r1 = p1;
   r0 = a;
-  r3 = x;
-  return cell_unspecified;
+  r1 = MAKE_CHAR (0);
+  r2 = MAKE_CHAR (0);
+  r3 = MAKE_CHAR (0);
+  g_stack = cons (cell_nil, cell_nil);
+  return r0;
 }
 
-SCM
-apply (SCM f, SCM x, SCM a) ///((internal))
-{
-  push_cc (cons (f, x), cell_unspecified, r0, cell_unspecified);
-  r3 = cell_vm_apply;
-  return eval_apply ();
-}
+//\f Environment setup
 
-void
+SCM
 make_tmps (struct scm* cells)
 {
   tmp = g_free++;
@@ -950,31 +1082,57 @@ make_tmps (struct scm* cells)
   cells[tmp_num].type = TNUMBER;
   tmp_num2 = g_free++;
   cells[tmp_num2].type = TNUMBER;
+  return 0;
 }
 
-//\f Environment setup
+#include "posix.c"
+#include "math.c"
+#include "lib.c"
+
+//\f Jam Collector
+SCM g_symbol_max;
+
 SCM
 gc_init_cells () ///((internal))
 {
-  g_cells = (struct scm *)malloc (2*ARENA_SIZE*sizeof(struct scm));
-  g_cells[0].type = TVECTOR;
-  g_cells[0].length = 1000;
-  g_cells[0].vector = 0;
+  g_cells = (struct scm *)malloc (2*ARENA_SIZE*sizeof (struct scm));
+
+  TYPE (0) = TVECTOR;
+  LENGTH (0) = 1000;
+  VECTOR (0) = 0;
+#if __MESC__
+  g_cells += sizeof (struct scm);
+#else
   g_cells++;
-  g_cells[0].type = TCHAR;
-  g_cells[0].value = 'c';
+#endif
+  TYPE (0) = TCHAR;
+  VALUE (0) = 'c';
+  return 0;
 }
 
 SCM
 gc_init_news () ///((internal))
 {
+#if __MESC__
+  char *p = g_cells;
+  p -= sizeof (struct scm);
+  p += ARENA_SIZE * sizeof (struct scm);
+  g_news = p;
+#else
   g_news = g_cells-1 + ARENA_SIZE;
-  g_news[0].type = TVECTOR;
-  g_news[0].length = 1000;
-  g_news[0].vector = 0;
+#endif
+
+  NTYPE (0) = TVECTOR;
+  NLENGTH (0) = 1000;
+  NVECTOR (0) = 0;
+#if __MESC__
+  g_news += sizeof (struct scm);
+#else
   g_news++;
-  g_news[0].type = TCHAR;
-  g_news[0].value = 'n';
+#endif
+  NTYPE (0) = TCHAR;
+  NVALUE (0) = 'n';
+  return 0;
 }
 
 SCM
@@ -983,7 +1141,11 @@ mes_symbols () ///((internal))
   gc_init_cells ();
   gc_init_news ();
 
+#if !_POSIX_SOURCE
+#include "mini-mes.symbols.i"
+#else
 #include "mes.symbols.i"
+#endif
 
   g_symbol_max = g_free;
   make_tmps (g_cells);
@@ -994,14 +1156,15 @@ mes_symbols () ///((internal))
 
   SCM a = cell_nil;
 
+#if !_POSIX_SOURCE
+#include "mini-mes.symbol-names.i"
+#else
 #include "mes.symbol-names.i"
+#endif
 
   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);
 
-#if BOOT
-  a = acons (cell_symbol_label, cell_t, a);
-#endif
   a = acons (cell_symbol_dot, cell_dot, a);
   a = acons (cell_symbol_begin, cell_begin, a);
   a = acons (cell_symbol_call_with_values, cell_symbol_call_with_values, a);
@@ -1022,9 +1185,35 @@ mes_symbols () ///((internal))
   return a;
 }
 
+SCM
+mes_environment () ///((internal))
+{
+  SCM a = mes_symbols ();
+  return mes_g_stack (a);
+}
+
 SCM
 mes_builtins (SCM a) ///((internal))
 {
+#if !__GNUC__
+#include "mini-mes.i"
+
+// Do not sort: Order of these includes define builtins
+#include "mini-posix.i"
+#include "mini-math.i"
+#include "mini-lib.i"
+#include "mini-vector.i"
+#include "mini-gc.i"
+// #include "mini-reader.i"
+
+#include "mini-gc.environment.i"
+#include "mini-lib.environment.i"
+#include "mini-math.environment.i"
+#include "mini-mes.environment.i"
+#include "mini-posix.environment.i"
+// #include "mini-reader.environment.i"
+#include "mini-vector.environment.i"
+#else
 #include "mes.i"
 
 // Do not sort: Order of these includes define builtins
@@ -1042,100 +1231,27 @@ mes_builtins (SCM a) ///((internal))
 #include "posix.environment.i"
 #include "reader.environment.i"
 #include "vector.environment.i"
+#endif
 
   if (g_debug)
     {
-      fputs ("functions: ", stderr);
-      fputs (itoa (g_function), stderr);
-      fputs ("\n", stderr);
+      fputs ("functions: ", STDERR);
+      fputs (itoa (g_function), STDERR);
+      fputs ("\n", STDERR);
       for (int i = 0; i < g_function; i++)
         {
-          fputs ("[", stderr);
-          fputs (itoa (i), stderr);
-          fputs ("]: ", stderr);
-          fputs (g_functions[i].name, stderr);
-          fputs ("\n", stderr);
+          fputs ("[", STDERR);
+          fputs (itoa (i), STDERR);
+          fputs ("]: ", STDERR);
+          fputs (g_functions[i].name, STDERR);
+          fputs ("\n", STDERR);
         }
-      fputs ("\n", stderr);
+      fputs ("\n", STDERR);
     }
 
   return a;
 }
 
-SCM
-mes_g_stack (SCM a) ///((internal))
-{
-  r0 = a;
-  r1 = MAKE_CHAR (0);
-  r2 = MAKE_CHAR (0);
-  r3 = MAKE_CHAR (0);
-  g_stack = cons (cell_nil, cell_nil);
-  return r0;
-}
-
-SCM
-mes_environment () ///((internal))
-{
-  SCM a = mes_symbols ();
-  return mes_g_stack (a);
-}
-
-int g_stdin;
-#include "posix.c"
-#include "math.c"
-#include "lib.c"
-#include "reader.c"
-#include "gc.c"
-#include "vector.c"
-
-// \f extra lib
-SCM
-assert_defined (SCM x, SCM e) ///((internal))
-{
-  if (e == cell_undefined) return error (cell_symbol_unbound_variable, x);
-  return e;
-}
-
-SCM
-check_formals (SCM f, SCM formals, SCM args) ///((internal))
-{
-  int flen = (TYPE (formals) == TNUMBER) ? VALUE (formals) : VALUE (length (formals));
-  int alen = VALUE (length (args));
-  if (alen != flen && alen != -1 && flen != -1)
-    {
-      char buf[1024];
-      sprintf (buf, "apply: wrong number of arguments; expected: %d, got: %d: ", flen, alen);
-      SCM e = MAKE_STRING (cstring_to_list (buf));
-      return error (cell_symbol_wrong_number_of_args, cons (e, f));
-    }
-  return cell_unspecified;
-}
-
-SCM
-check_apply (SCM f, SCM e) ///((internal))
-{
-  char const* type = 0;
-  if (f == cell_f || f == cell_t) type = "bool";
-  if (f == cell_nil) type = "nil";
-  if (f == cell_unspecified) type = "*unspecified*";
-  if (f == cell_undefined) type = "*undefined*";
-  if (TYPE (f) == TCHAR) type = "char";
-  if (TYPE (f) == TNUMBER) type = "number";
-  if (TYPE (f) == TSTRING) type = "string";
-
-  if (type)
-    {
-      char buf[1024];
-      sprintf (buf, "cannot apply: %s:", type);
-      fprintf (stderr, " [");
-      display_error_ (e);
-      fprintf (stderr, "]\n");
-      SCM e = MAKE_STRING (cstring_to_list (buf));
-      return error (cell_symbol_wrong_type_arg, cons (e, f));
-    }
-  return cell_unspecified;
-}
-
 SCM
 load_env (SCM a) ///((internal))
 {
@@ -1151,19 +1267,25 @@ load_env (SCM a) ///((internal))
 SCM
 bload_env (SCM a) ///((internal))
 {
-#if MES_MINI
-  g_stdin = fopen ("module/mes/read-0-32.mo", O_RDONLY);
+#if __MESC__
+  char *mo = "mes/read-0-32.mo";
+  g_stdin = open ("module/mes/read-0-32.mo", O_RDONLY);
+  g_stdin = g_stdin >= 0 ? g_stdin : open (MODULEDIR "mes/read-0-32.mo", O_RDONLY);
 #else
+  char *mo ="mes/read-0.mo";
   g_stdin = open ("module/mes/read-0.mo", O_RDONLY);
   g_stdin = g_stdin >= 0 ? g_stdin : open (MODULEDIR "mes/read-0.mo", O_RDONLY);
 #endif
 
-  char *p = (char*)g_cells;
+  if (g_stdin < 0) {eputs ("no such file: ");eputs (mo);eputs ("\n");return 1;} 
   assert (getchar () == 'M');
   assert (getchar () == 'E');
   assert (getchar () == 'S');
+  eputs ("*GOT MES*\n");
   g_stack = getchar () << 8;
   g_stack += getchar ();
+
+  char *p = (char*)g_cells;
   int c = getchar ();
   while (c != EOF)
     {
@@ -1175,41 +1297,95 @@ bload_env (SCM a) ///((internal))
   g_symbols = r1;
   g_stdin = STDIN;
   r0 = mes_builtins (r0);
+
+#if __GNUC__
+  set_env_x (cell_symbol_gnuc, cell_t, r0);
+  set_env_x (cell_symbol_mesc, cell_f, r0);
+#else
+  set_env_x (cell_symbol_gnuc, cell_f, r0);
+  set_env_x (cell_symbol_mesc, cell_t, r0);
+#endif
+
+  if (g_debug)
+    {
+      eputs ("symbols: ");
+      SCM s = g_symbols;
+      while (s && s != cell_nil) {
+        display_error_ (CAR (s));
+        eputs (" ");
+        s = CDR (s);
+      }
+      eputs ("\n");
+      eputs ("functions: ");
+      eputs (itoa (g_function));
+      eputs ("\n");
+      for (int i = 0; i < g_function; i++)
+        {
+          eputs ("[");
+          eputs (itoa (i));
+          eputs ("]: ");
+          eputs (g_functions[i].name);
+          eputs ("\n");
+        }
+      //display_error_ (r0);
+      //puts ("\n");
+    }
   return r2;
 }
 
+#include "vector.c"
+#include "gc.c"
+#if _POSIX_SOURCE
+#include "reader.c"
+#endif
+
 int
 main (int argc, char *argv[])
 {
 #if __GNUC__
   g_debug = getenv ("MES_DEBUG");
   if (g_debug) {eputs ("MODULEDIR=");eputs (MODULEDIR);eputs ("\n");}
-#endif
   if (getenv ("MES_ARENA")) ARENA_SIZE = atoi (getenv ("MES_ARENA"));
   if (getenv ("MES_MAX_ARENA")) MAX_ARENA_SIZE = atoi (getenv ("MES_MAX_ARENA"));
+#endif
   if (argc > 1 && !strcmp (argv[1], "--help")) return puts ("Usage: mes [--dump|--load] < FILE");
   if (argc > 1 && !strcmp (argv[1], "--version")) {puts ("Mes ");puts (VERSION);return 0;};
   g_stdin = STDIN;
   r0 = mes_environment ();
 
+#if __MESC__
+  SCM program = bload_env (r0);
+  g_debug = 1;
+#else
   SCM program = (argc > 1 && !strcmp (argv[1], "--load"))
     ? bload_env (r0) : load_env (r0);
   if (argc > 1 && !strcmp (argv[1], "--dump")) return dump ();
+#endif
 
   SCM lst = cell_nil;
-  for (int i=argc; i; i--) lst = cons (MAKE_STRING (cstring_to_list (argv[i-1])), lst);
+  for (int i=argc-1; i>=0; i--) lst = cons (MAKE_STRING (cstring_to_list (argv[i])), lst);
   r0 = acons (cell_symbol_argv, lst, r0);
-
-  if (g_debug) {eputs ("program: "); display_error_ (r2); eputs ("\n");}
   push_cc (r2, cell_unspecified, r0, cell_unspecified);
+  if (g_debug)
+    {
+      eputs ("program: ");
+      display_error_ (r1);
+      eputs ("\n");
+    }
   r3 = cell_vm_begin;
   r1 = eval_apply ();
   display_error_ (r1);
-  fputs ("", stdout);
+  eputs ("\n");
   gc (g_stack);
-#if __GNUC__
-  if (g_debug) fprintf (stderr, "\nstats: [%d]\n", g_free);
-#else
-#endif
+  if (g_debug)
+    {
+      eputs ("\nstats: [");
+      eputs (itoa (g_free));
+      eputs ("]\n");
+    }
   return 0;
 }
+
+#if !_POSIX_SOURCE && !__MESC__
+#include "mstart.c"
+#endif
index c9bb893fb8221563b994d82cb686c26d201adc74..cbb5ec86f4c8022f77e61dca6a9897304e0a6651 100644 (file)
Binary files a/module/mes/read-0-32.mo and b/module/mes/read-0-32.mo differ
diff --git a/posix.c b/posix.c
index 6d9d0587e656a91478b00e2e82d90d36c39b10c9..f7e64467be94f0237d51aefa8d9381b18682b04a 100644 (file)
--- a/posix.c
+++ b/posix.c
@@ -110,14 +110,8 @@ write_byte (SCM x) ///((arity . n))
   SCM p = cdr (x);
   int fd = 1;
   if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER) fd = VALUE (car (p));
-#if 0
-  //_POSIX_SOURCE
-  FILE *f = fd == 1 ? stdout : stderr;
-  fputc (VALUE (c), f);
-#else
   char cc = VALUE (c);
-  write (1, (char*)&cc, fd);
-#endif
+  write (fd, (char*)&cc, 1);
   assert (TYPE (c) == TNUMBER || TYPE (c) == TCHAR);
   return c;
 }
@@ -173,13 +167,5 @@ set_current_input_port (SCM port)
 SCM
 force_output (SCM p) ///((arity . n))
 {
-#if 0
-  int fd = 1;
-  if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER) fd = VALUE (car (p));
-#if _POSIX_SOURCE
-  FILE *f = fd == 1 ? stdout : stderr;
-  fflush (f);
-#endif
-#endif
   return cell_unspecified;
 }
index 0e8b8ea0dee22d1eb13bdae797dfe32c3bfc806b..c07fcd7922fde02e82edde84eb003f563f227bc3 100644 (file)
--- a/reader.c
+++ b/reader.c
@@ -123,20 +123,20 @@ lookup_ (SCM s, SCM a)
 int
 dump ()
 {
-  fputs ("program r2=", stderr);
+  eputs ("program r2=");
   display_error_ (r2);
-  fputs ("\n", stderr);
+  eputs ("\n");
 
   r1 = g_symbols;
   gc_push_frame ();
   gc ();
   gc_peek_frame ();
   char *p = (char*)g_cells;
-  fputc ('M', stdout);
-  fputc ('E', stdout);
-  fputc ('S', stdout);
-  fputc (g_stack >> 8, stdout);
-  fputc (g_stack % 256, stdout);
+  putc ('M');
+  putc ('E');
+  putc ('S');
+  putc (g_stack >> 8);
+  putc (g_stack % 256);
   // See HACKING, simple crafted dump for tiny-mes.c
   if (getenv ("MES_TINY"))
     {
@@ -167,6 +167,6 @@ dump ()
       g_free = 15;
     }
   for (int i=0; i<g_free * sizeof(struct scm); i++)
-    fputc (*p++, stdout);
+    putc (*p++);
   return 0;
 }
index 4ddbc1af3fcd2f647f5320e12de6c71e0feef369..39685e33b731f9311c9669c536020eb33906b832 100644 (file)
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
-#if __GNUC__
+#if !__MESC__
 #include "mlibc.c"
 #endif
 #define assert(x) ((x) ? (void)0 : assert_fail (#x))
 
-#define MES_MINI 1
 #define FIXED_PRIMITIVES 1
 
 #define MES_GC 1
@@ -35,7 +34,7 @@ int ARENA_SIZE = 1000000000;
 int MAX_ARENA_SIZE = 40000000;
 int GC_SAFETY = 10000;
 
-char *arena = 0;
+char *g_arena = 0;
 
 typedef int SCM;
 
@@ -61,22 +60,20 @@ struct scm {
   SCM car;
   SCM cdr;
 };
-
 struct function {
   int (*function) (void);
   int arity;
   char *name;
 };
 
+#if __MESC__
 //FIXME
 char *foobar = 0;
-
-#if __GNUC__
-struct scm *g_cells = 0;
-struct scm *g_news = 0;
-#else
 struct scm *g_cells = foobar;
 struct scm *g_news = foobar;
+#else
+struct scm *g_cells = 0;
+struct scm *g_news = 0;
 #endif
 
 struct scm scm_nil = {TSPECIAL, "()",0};
@@ -176,15 +173,18 @@ int g_function = 0;
 // #include "mini-reader.h"
 #include "mini-vector.h"
 
+#define TYPE(x) g_cells[x].type
+#define CAR(x) g_cells[x].car
+#define CDR(x) g_cells[x].cdr
 
-#define TYPE(x) (g_cells[x].type)
+#define NTYPE(x) g_news[x].type
+#define NCAR(x) g_news[x].car
+#define NCDR(x) g_news[x].cdr
 
-#define CAR(x) g_cells[x].car
 #define LENGTH(x) g_cells[x].car
 #define REF(x) g_cells[x].car
 #define STRING(x) g_cells[x].car
 
-#define CDR(x) g_cells[x].cdr
 #define CLOSURE(x) g_cells[x].cdr
 #define CONTINUATION(x) g_cells[x].cdr
 
@@ -193,12 +193,8 @@ int g_function = 0;
 #define VALUE(x) g_cells[x].cdr
 #define VECTOR(x) g_cells[x].cdr
 
-#define NTYPE(x) g_news[x].type
-
-#define NCAR(x) g_news[x].car
 #define NLENGTH(x) g_news[x].car
 
-#define NCDR(x) g_news[x].cdr
 #define NVALUE(x) g_news[x].cdr
 #define NVECTOR(x) g_news[x].cdr
 
@@ -206,6 +202,7 @@ int g_function = 0;
 #define MAKE_CONTINUATION(n) make_cell_ (tmp_num_ (TCONTINUATION), n, g_stack)
 #define MAKE_NUMBER(n) make_cell_ (tmp_num_ (TNUMBER), 0, tmp_num2_ (n))
 #define MAKE_REF(n) make_cell_ (tmp_num_ (TREF), n, 0)
+#define MAKE_STRING(x) make_cell_ (tmp_num_ (TSTRING), x, 0)
 
 #define CAAR(x) CAR (CAR (x))
 #define CADR(x) CAR (CDR (x))
@@ -215,8 +212,6 @@ int g_function = 0;
 #define CADDR(x) CAR (CDR (CDR (x)))
 #define CDADAR(x) CAR (CDR (CAR (CDR (x))))
 
-#define MAKE_STRING(x) make_cell_ (tmp_num_ (TSTRING), x, 0)
-
 SCM
 alloc (int n)
 {
@@ -226,8 +221,6 @@ alloc (int n)
   return x;
 }
 
-#define DEBUG 0
-
 SCM
 tmp_num_ (int x)
 {
@@ -263,7 +256,6 @@ make_cell_ (SCM type, SCM car, SCM cdr)
   return x;
 }
 
-
 SCM
 make_symbol_ (SCM s) ///((internal))
 {
@@ -273,6 +265,18 @@ make_symbol_ (SCM s) ///((internal))
   return x;
 }
 
+SCM
+list_of_char_equal_p (SCM a, SCM b) ///((internal))
+{
+  while (a != cell_nil && b != cell_nil && VALUE (car (a)) == VALUE (car (b))) {
+    assert (TYPE (car (a)) == TCHAR);
+    assert (TYPE (car (b)) == TCHAR);
+    a = cdr (a);
+    b = cdr (b);
+  }
+  return (a == cell_nil && b == cell_nil) ? cell_t : cell_f;
+}
+
 SCM
 lookup_symbol_ (SCM s)
 {
@@ -286,18 +290,6 @@ lookup_symbol_ (SCM s)
   return x;
 }
 
-SCM
-list_of_char_equal_p (SCM a, SCM b) ///((internal))
-{
-  while (a != cell_nil && b != cell_nil && VALUE (car (a)) == VALUE (car (b))) {
-    assert (TYPE (car (a)) == TCHAR);
-    assert (TYPE (car (b)) == TCHAR);
-    a = cdr (a);
-    b = cdr (b);
-  }
-  return (a == cell_nil && b == cell_nil) ? cell_t : cell_f;
-}
-
 SCM
 type_ (SCM x)
 {
@@ -342,25 +334,15 @@ cons (SCM x, SCM y)
 SCM
 car (SCM x)
 {
-#if MES_MINI
-  //Nyacc
-  //assert ("!car");
-#else
   if (TYPE (x) != TPAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_car));
-#endif
   return CAR (x);
 }
 
 SCM
 cdr (SCM x)
 {
-#if MES_MINI
-  //Nyacc
-  //assert ("!cdr");
-#else
   if (TYPE (x) != TPAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_cdr));
-#endif
-  return CDR(x);
+  return CDR (x);
 }
 
 SCM
@@ -415,6 +397,8 @@ length (SCM x)
   return MAKE_NUMBER (n);
 }
 
+SCM apply (SCM, SCM, SCM);
+
 SCM
 error (SCM key, SCM x)
 {
@@ -423,37 +407,29 @@ error (SCM key, SCM x)
     return apply (throw, cons (key, cons (x, cell_nil)), r0);
   display_error_ (key);
   eputs (": ");
-  display_ (x);
-  eputs ("\n");
-  assert (0);
-}
-
-SCM
-assert_defined (SCM x, SCM e) ///((internal))
-{
-  if (e != cell_undefined) return e;
-  // error (cell_symbol_unbound_variable, x);
-  eputs ("unbound variable: ");
   display_error_ (x);
   eputs ("\n");
-  exit (33);
-  return e;
+  exit (1);
 }
 
 SCM
 cstring_to_list (char const* s)
 {
-  char *x = s;
   SCM p = cell_nil;
   int i = strlen (s);
   while (i--)
-    {
-      p = cons (MAKE_CHAR (s[i]), p);
-      x++;
-    }
+    p = cons (MAKE_CHAR (s[i]), p);
   return p;
 }
 
+// \f extra lib
+SCM
+assert_defined (SCM x, SCM e) ///((internal))
+{
+  if (e == cell_undefined) return error (cell_symbol_unbound_variable, x);
+  return e;
+}
+
 SCM
 check_formals (SCM f, SCM formals, SCM args) ///((internal))
 {
@@ -461,17 +437,14 @@ check_formals (SCM f, SCM formals, SCM args) ///((internal))
   int alen = VALUE (length (args));
   if (alen != flen && alen != -1 && flen != -1)
     {
-      // FIXME
-      //char buf[1024];
-      char buf = "TODO:check_formals";
-      // sprintf (buf, "apply: wrong number of arguments; expected: %d, got: %d: ", flen, alen);
-      eputs ("apply: wrong number of arguments; expected: ");
+      char *s = "apply: wrong number of arguments; expected: ";
+      eputs (s);
       eputs (itoa (flen));
       eputs (", got: ");
       eputs (itoa (alen));
       eputs ("\n");
       display_error_ (f);
-      SCM e = MAKE_STRING (cstring_to_list (buf));
+      SCM e = MAKE_STRING (cstring_to_list (s));
       return error (cell_symbol_wrong_number_of_args, cons (e, f));
     }
   return cell_unspecified;
@@ -480,7 +453,6 @@ check_formals (SCM f, SCM formals, SCM args) ///((internal))
 SCM
 check_apply (SCM f, SCM e) ///((internal))
 {
-  //char const* type = 0;
   char* type = 0;
   if (f == cell_f || f == cell_t) type = "bool";
   if (f == cell_nil) type = "nil";
@@ -492,19 +464,13 @@ check_apply (SCM f, SCM e) ///((internal))
 
   if (type)
     {
-      //FIXME
-      //char buf[1024];
-      char buf = "TODO:check_apply";
-      // sprintf (buf, "cannot apply: %s:", type);
-      // fprintf (stderr, " [");
-      // display_error_ (e);
-      // fprintf (stderr, "]\n");
-      eputs ("cannot apply: ");
+      char *s = "cannot apply: ";
+      eputs (s);
       eputs (type);
       eputs ("[");
       display_error_ (e);
       eputs ("]\n");
-      SCM e = MAKE_STRING (cstring_to_list (buf));
+      SCM e = MAKE_STRING (cstring_to_list (s));
       return error (cell_symbol_wrong_type_arg, cons (e, f));
     }
   return cell_unspecified;
@@ -518,14 +484,6 @@ gc_push_frame () ///((internal))
   return g_stack;
 }
 
-SCM
-apply (SCM f, SCM x, SCM a) ///((internal))
-{
-  push_cc (cons (f, x), cell_unspecified, r0, cell_unspecified);
-  r3 = cell_vm_apply;
-  return eval_apply ();
-}
-
 SCM
 append2 (SCM x, SCM y)
 {
@@ -545,8 +503,6 @@ pairlis (SCM x, SCM y, SCM a)
                pairlis (cdr (x), cdr (y), a));
 }
 
-SCM display_ (SCM);
-
 SCM
 call (SCM fn, SCM x)
 {
@@ -558,12 +514,20 @@ call (SCM fn, SCM x)
     x = cons (CAR (x), cons (CDADAR (x), CDR (x)));
   switch (FUNCTION (fn).arity)
     {
-    case 0: {return (FUNCTION (fn).function) ();}
-    case 1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (CAR (x));}
-    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)));}
-    case -1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);}
-    default: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);}
+#if __MESC__
+    case 0: return (FUNCTION (fn).function) ();
+    case 1: return ((SCM(*)(SCM))(FUNCTION (fn).function)) (CAR (x));
+    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)));
+    case -1: return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);
+    default: return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);
+#else
+    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);
+#endif
     }
 
   return cell_unspecified;
@@ -575,7 +539,7 @@ assq (SCM x, SCM a)
   //FIXME: move into fast-non eq_p-ing assq core:assq?
   //while (a != cell_nil && x != CAAR (a)) a = CDR (a);
   while (a != cell_nil && eq_p (x, CAAR (a)) == cell_f) a = CDR (a);
-  return a != cell_nil ? car (a) : cell_f;
+  return a != cell_nil ? CAR (a) : cell_f;
 }
 
 SCM
@@ -583,7 +547,7 @@ assq_ref_env (SCM x, SCM a)
 {
   x = assq (x, a);
   if (x == cell_f) return cell_undefined;
-  return cdr (x);
+  return CDR (x);
 }
 
 SCM
@@ -597,7 +561,7 @@ set_car_x (SCM x, SCM e)
 SCM
 set_cdr_x (SCM x, SCM e)
 {
-  //if (TYPE (x) != TPAIR) error (cell_symbol_not_a_pair, cons (x, cell_set_cdr_x));
+  if (TYPE (x) != TPAIR) error (cell_symbol_not_a_pair, cons (x, cell_set_cdr_x));
   CDR (x) = e;
   return cell_unspecified;
 }
@@ -606,7 +570,7 @@ SCM
 set_env_x (SCM x, SCM e, SCM a)
 {
   SCM p = assert_defined (x, assq (x, a));
-  //if (TYPE (p) != TPAIR)  error (cell_symbol_not_a_pair, cons (p, x));
+  if (TYPE (p) != TPAIR) error (cell_symbol_not_a_pair, cons (p, x));
   return set_cdr_x (p, e);
 }
 
@@ -614,7 +578,6 @@ SCM
 call_lambda (SCM e, SCM x, SCM aa, SCM a) ///((internal))
 {
   SCM cl = cons (cons (cell_closure, x), x);
-  cl = cons (cons (cell_closure, x), x);
   r1 = e;
   r0 = cl;
   return cell_unspecified;
@@ -631,7 +594,7 @@ lookup_macro_ (SCM x, SCM a) ///((internal))
 {
   if (TYPE (x) != TSYMBOL) return cell_f;
   SCM m = assq_ref_env (x, a);
- if (TYPE (m) == TMACRO) return MACRO (m);
 if (TYPE (m) == TMACRO) return MACRO (m);
   return cell_f;
 }
 
@@ -648,16 +611,30 @@ push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
   return cell_unspecified;
 }
 
-SCM gc_pop_frame (); //((internal))
+SCM
+gc_peek_frame () ///((internal))
+{
+  SCM frame = CAR (g_stack);
+  r1 = CAR (frame);
+  r2 = CADR (frame);
+  r3 = CAR (CDDR (frame));
+  r0 = CADR (CDDR (frame));
+  return frame;
+}
+
+SCM
+gc_pop_frame () ///((internal))
+{
+  SCM frame = gc_peek_frame (g_stack);
+  g_stack = cdr (g_stack);
+  return frame;
+}
 
 SCM
 eval_apply ()
 {
  eval_apply:
-#if MES_GC
-  if (g_free + GC_SAFETY > ARENA_SIZE)
-    gc_pop_frame (gc (gc_push_frame ()));
-#endif
+  gc_check ();
   switch (r3)
     {
     case cell_vm_evlis: goto evlis;
@@ -686,12 +663,14 @@ eval_apply ()
     case cell_vm_call_with_values2: goto call_with_values2;
     case cell_vm_return: goto vm_return;
     case cell_unspecified: return r1;
-    default: assert (0);
+    default:
+      assert (0);
     }
 
   SCM x = cell_nil;
   SCM y = cell_nil;
  evlis:
+  gc_check ();
   if (r1 == cell_nil) goto vm_return;
   if (TYPE (r1) != TPAIR) goto eval;
   push_cc (car (r1), r1, r0, cell_vm_evlis2);
@@ -704,6 +683,7 @@ eval_apply ()
   goto vm_return;
 
  apply:
+  gc_check ();
   switch (TYPE (car (r1)))
     {
     case TFUNCTION: {
@@ -713,13 +693,13 @@ eval_apply ()
     }
     case TCLOSURE:
       {
-        SCM cl = CLOSURE (CAR (r1));
+        SCM cl = CLOSURE (car (r1));
         SCM formals = CADR (cl);
         SCM body = CDDR (cl);
         SCM aa = CDAR (cl);
-        aa = CDR (aa);
-        check_formals (CAR (r1), formals, CDR (r1));
-        SCM p = pairlis (formals, CDR (r1), aa);
+        aa = cdr (aa);
+        check_formals (car (r1), formals, cdr (r1));
+        SCM p = pairlis (formals, cdr (r1), aa);
         call_lambda (body, p, aa, r0);
         goto begin;
       }
@@ -791,6 +771,7 @@ eval_apply ()
   goto apply;
 
  eval:
+  gc_check ();
   switch (TYPE (r1))
     {
     case TPAIR:
@@ -879,7 +860,7 @@ eval_apply ()
         r1 = assert_defined (r1, assq_ref_env (r1, r0));
         goto vm_return;
       }
-    default: {goto vm_return;}
+    default: goto vm_return;
     }
 
   SCM macro;
@@ -904,9 +885,11 @@ eval_apply ()
         }
     }
   goto vm_return;
+
  begin:
   x = cell_unspecified;
   while (r1 != cell_nil) {
+    gc_check ();
     if (TYPE (r1) == TPAIR && TYPE (CAR (r1)) == TPAIR)
       {
         if (CAAR (r1) == cell_symbol_begin)
@@ -979,22 +962,11 @@ eval_apply ()
 }
 
 SCM
-gc_peek_frame () ///((internal))
-{
-  SCM frame = CAR (g_stack);
-  r1 = CAR (frame);
-  r2 = CADR (frame);
-  r3 = CAR (CDDR (frame));
-  r0 = CADR (CDDR (frame));
-  return frame;
-}
-
-SCM
-gc_pop_frame () ///((internal))
+apply (SCM f, SCM x, SCM a) ///((internal))
 {
-  SCM frame = gc_peek_frame (g_stack);
-  g_stack = cdr (g_stack);
-  return frame;
+  push_cc (cons (f, x), cell_unspecified, r0, cell_unspecified);
+  r3 = cell_vm_apply;
+  return eval_apply ();
 }
 
 SCM
@@ -1009,6 +981,7 @@ mes_g_stack (SCM a) ///((internal))
 }
 
 //\f Environment setup
+
 SCM
 make_tmps (struct scm* cells)
 {
@@ -1039,13 +1012,13 @@ gc_init_cells () ///((internal))
   size = size * 2;
 #endif
 #if __GNUC__
-  arena = (char*)malloc (size);
+  g_arena = (char*)malloc (size);
 #else
   char *p = 0;
   p = malloc (size);
-  arena = p;
+  g_arena = p;
 #endif
-  g_cells = arena;
+  g_cells = g_arena;
   return 0;
   //g_cells = (scm *)malloc (2*ARENA_SIZE*sizeof(scm));
 
@@ -1094,8 +1067,6 @@ gc_init_news () ///((internal))
   return 0;
 }
 
-// INIT NEWS
-
 SCM
 mes_symbols () ///((internal))
 {
@@ -1104,7 +1075,7 @@ mes_symbols () ///((internal))
   gc_init_news ();
 #endif
 
-  #include "mini-mes.symbols.i"
+#include "mini-mes.symbols.i"
 
   g_symbol_max = g_free;
   make_tmps (g_cells);
@@ -1115,7 +1086,7 @@ mes_symbols () ///((internal))
 
   SCM a = cell_nil;
 
-  #include "mini-mes.symbol-names.i"
+#include "mini-mes.symbol-names.i"
 
   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);
@@ -1143,16 +1114,14 @@ mes_symbols () ///((internal))
 SCM
 mes_environment () ///((internal))
 {
-  SCM a = 0;
-  a = mes_symbols ();
-  a = mes_g_stack (a);
-  return a;
+  SCM a = mes_symbols ();
+  return mes_g_stack (a);
 }
 
 SCM
 mes_builtins (SCM a) ///((internal))
 {
-  #include "mini-mes.i"
+#include "mini-mes.i"
 
 // Do not sort: Order of these includes define builtins
 #include "mini-posix.i"
@@ -1188,7 +1157,7 @@ bload_env (SCM a) ///((internal))
 
   char *p = (char*)g_cells;
   int c = getchar ();
-  while (c != -1)
+  while (c != EOF)
     {
       *p++ = c;
       c = getchar ();
@@ -1243,25 +1212,18 @@ main (int argc, char *argv[])
   eputs ("Hello mini-mes!\n");
 #if _POSIX_SOURCE
   g_debug = getenv ("MES_DEBUG");
-  eputs ("g_debug=");
-  eputs (itoa (g_debug));
-  eputs ("\n");
+  if (g_debug) {eputs ("MODULEDIR=");eputs (MODULEDIR);eputs ("\n");}
   if (getenv ("MES_ARENA")) ARENA_SIZE = atoi (getenv ("MES_ARENA"));
 #endif
   g_debug = 1;
-  if (argc > 1 && !strcmp (argv[1], "--help")) return eputs ("Usage: mes [--dump|--load] < FILE");
-#if __GNUC__
-  if (argc > 1 && !strcmp (argv[1], "--version")) {eputs ("Mes ");return eputs (VERSION);};
-#else
-  if (argc > 1 && !strcmp (argv[1], "--version")) {eputs ("Mes ");return eputs ("0.4");};
-#endif
+  if (argc > 1 && !strcmp (argv[1], "--help")) return puts ("Usage: mes [--dump|--load] < FILE");
+  if (argc > 1 && !strcmp (argv[1], "--version")) {puts ("Mes ");puts (VERSION);return 0;};
   g_stdin = STDIN;
-
   r0 = mes_environment ();
-  
-#if MES_MINI
+
+#if __MESC__
   SCM program = bload_env (r0);
-#else  
+#else
   SCM program = (argc > 1 && !strcmp (argv[1], "--load"))
     ? bload_env (r0) : load_env (r0);
   if (argc > 1 && !strcmp (argv[1], "--dump")) return dump ();
@@ -1281,10 +1243,7 @@ main (int argc, char *argv[])
   r1 = eval_apply ();
   display_error_ (r1);
   eputs ("\n");
-
-#if !MES_MINI
   gc (g_stack);
-#endif
   if (g_debug)
     {
       eputs ("\nstats: [");