mescc: Run module/base-0.mes.

* gc.c: New file.
* vector.c: New file.
* mes.c: Remove vector and gc functions, include vector.c, gc.c.
* GNUmakefile (mes.o): Add gc, vector dependencies.
* scaffold/mini-mes.c (eval_apply): Support primitive-load through
  read_input_file.
  (getenv_, open_input_file, current_input_port,
  set_current_input_port force_output, exit_, values, arity_, xassq,
  is_p, minus, plus, divide, modulo multiply, logior, ash): New function.
  (mes_symbols): Add symbols %gnuc, %mesc.
* scaffold/mini-mes.c (): New functions.
* scaffold/b-0.mes: New file.
* scaffold/t-0.mes: New file.

GNUmakefile

@@ -35,6 +35,8 @@ mes.o: lib.c lib.h lib.i lib.environment.i
 mes.o: math.c math.h math.i math.environment.i
 mes.o: posix.c posix.h posix.i posix.environment.i
 mes.o: reader.c reader.h reader.i reader.environment.i
+mes.o: gc.c gc.h gc.i gc.environment.i
+mes.o: vector.c vector.h vector.i vector.environment.i
 
 clean:
 	rm -f mes *.o *.environment.i *.symbols.i *.environment.h *.cat a.out

gc.c

@@ -0,0 +1,122 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of Mes.
+ *
+ * Mes is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * Mes is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+SCM
+gc_up_arena () ///((internal))
+{
+  ARENA_SIZE *= 2;
+  void *p = realloc (g_cells-1, 2*ARENA_SIZE*sizeof(struct scm));
+  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++;
+  gc_init_news ();
+}
+
+SCM
+gc_flip () ///((internal))
+{
+  struct scm *cells = g_cells;
+  g_cells = g_news;
+  g_news = cells;
+  if (g_debug) fprintf (stderr, " => jam[%d]\n", g_free);
+  return g_stack;
+}
+
+SCM
+gc_copy (SCM old) ///((internal))
+{
+  if (TYPE (old) == TBROKEN_HEART) return g_cells[old].car;
+  SCM new = g_free++;
+  g_news[new] = g_cells[old];
+  if (NTYPE (new) == TVECTOR)
+    {
+      g_news[new].vector = g_free;
+      for (int i=0; i<LENGTH (old); i++)
+        g_news[g_free++] = g_cells[VECTOR (old)+i];
+    }
+  g_cells[old].type = TBROKEN_HEART;
+  g_cells[old].car = new;
+  return new;
+}
+
+SCM
+gc_relocate_car (SCM new, SCM car) ///((internal))
+{
+  g_news[new].car = car;
+  return cell_unspecified;
+}
+
+SCM
+gc_relocate_cdr (SCM new, SCM cdr) ///((internal))
+{
+  g_news[new].cdr = cdr;
+  return cell_unspecified;
+}
+
+SCM
+gc_loop (SCM scan) ///((internal))
+{
+  while (scan < g_free)
+    {
+      if (NTYPE (scan) == TCLOSURE
+          || NTYPE (scan) == TCONTINUATION
+          || NTYPE (scan) == TFUNCTION
+          || NTYPE (scan) == TKEYWORD
+          || NTYPE (scan) == TMACRO
+          || NTYPE (scan) == TPAIR
+          || NTYPE (scan) == TREF
+          || scan == 1 // null
+          || NTYPE (scan) == TSPECIAL
+          || NTYPE (scan) == TSTRING
+          || NTYPE (scan) == TSYMBOL)
+        {
+          SCM car = gc_copy (g_news[scan].car);
+          gc_relocate_car (scan, car);
+        }
+      if ((NTYPE (scan) == TCLOSURE
+           || NTYPE (scan) == TCONTINUATION
+           || NTYPE (scan) == TMACRO
+           || NTYPE (scan) == TPAIR
+           || NTYPE (scan) == TVALUES)
+          && g_news[scan].cdr) // allow for 0 terminated list of symbols
+        {
+          SCM cdr = gc_copy (g_news[scan].cdr);
+          gc_relocate_cdr (scan, cdr);
+        }
+      scan++;
+    }
+  return gc_flip ();
+}
+
+SCM
+gc ()
+{
+  if (g_debug) fprintf (stderr, "***gc[%d]...", g_free);
+  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++)
+    gc_copy (i);
+  make_tmps (g_news);
+  g_symbols = gc_copy (g_symbols);
+  SCM new = gc_copy (g_stack);
+  if (g_debug) fprintf (stderr, "new=%d\n", new, g_stack);
+  g_stack = new;
+  return gc_loop (1);
+}

guile/mescc.scm

@@ -5,7 +5,7 @@ exec ${GUILE-guile} -L $(pwd)/guile -e '(mescc)' -s "$0" "$@"
 !#
 
 ;;; Mes --- The Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;

lib.c

@@ -18,13 +18,6 @@
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
-SCM
-xassq (SCM x, SCM a) ///for speed in core only
-{
-  while (a != cell_nil && x != CDAR (a)) a = CDR (a);
-  return a != cell_nil ? CAR (a) : cell_f;
-}
-
 //MINI_MES
 // SCM
 // length (SCM x)
@@ -80,7 +73,7 @@ append (SCM x) ///((arity . n))
 // }
 
 SCM
-assert_defined (SCM x, SCM e) ///(internal)
+assert_defined (SCM x, SCM e) ///((internal))
 {
   if (e == cell_undefined) return error (cell_symbol_unbound_variable, x);
   return e;
@@ -102,7 +95,7 @@ check_formals (SCM f, SCM formals, SCM args) ///((internal))
 }
 
 SCM
-check_apply (SCM f, SCM e)
+check_apply (SCM f, SCM e) ///((internal))
 {
   char const* type = 0;
   if (f == cell_f || f == cell_t) type = "bool";
@@ -242,3 +235,25 @@ bload_env (SCM a) ///((internal))
   r0 = mes_builtins (r0);
   return r2;
 }
+
+SCM
+values (SCM x) ///((arity . n))
+{
+  SCM v = cons (0, x);
+  TYPE (v) = TVALUES;
+  return v;
+}
+
+SCM
+arity_ (SCM x)
+{
+  assert (TYPE (x) == TFUNCTION);
+  return MAKE_NUMBER (FUNCTION (x).arity);
+}
+
+SCM
+xassq (SCM x, SCM a) ///for speed in core only
+{
+  while (a != cell_nil && x != CDAR (a)) a = CDR (a);
+  return a != cell_nil ? CAR (a) : cell_f;
+}

math.c

@@ -18,34 +18,33 @@
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
-//MINI_MES
+SCM
-// SCM
+greater_p (SCM x) ///((name . ">") (arity . n))
-// greater_p (SCM x) ///((name . ">") (arity . n))
+{
-// {
+  int n = INT_MAX;
-//   int n = INT_MAX;
+  while (x != cell_nil)
-//   while (x != cell_nil)
+    {
-//     {
+      assert (TYPE (car (x)) == TNUMBER);
-//       assert (TYPE (car (x)) == TNUMBER);
+      if (VALUE (car (x)) >= n) return cell_f;
-//       if (VALUE (car (x)) >= n) return cell_f;
+      n = VALUE (car (x));
-//       n = VALUE (car (x));
+      x = cdr (x);
-//       x = cdr (x);
+    }
-//     }
+  return cell_t;
-//   return cell_t;
+}
-// }
 
-// SCM
+SCM
-// less_p (SCM x) ///((name . "<") (arity . n))
+less_p (SCM x) ///((name . "<") (arity . n))
-// {
+{
-//   int n = INT_MIN;
+  int n = INT_MIN;
-//   while (x != cell_nil)
+  while (x != cell_nil)
-//     {
+    {
-//       assert (TYPE (car (x)) == TNUMBER);
+      assert (TYPE (car (x)) == TNUMBER);
-//       if (VALUE (car (x)) <= n) return cell_f;
+      if (VALUE (car (x)) <= n) return cell_f;
-//       n = VALUE (car (x));
+      n = VALUE (car (x));
-//       x = cdr (x);
+      x = cdr (x);
-//     }
+    }
-//   return cell_t;
+  return cell_t;
-// }
+}
 
 SCM
 is_p (SCM x) ///((name . "=") (arity . n))

mes.c

@@ -158,11 +158,17 @@ struct scm scm_vm_call_with_values2 = {TSPECIAL, "*vm-call-with-values2*",0};
 struct scm scm_vm_call_with_current_continuation2 = {TSPECIAL, "*vm-call-with-current-continuation2*",0};
 struct scm scm_vm_return = {TSPECIAL, "*vm-return*",0};
 
+struct scm scm_symbol_gnuc = {TSYMBOL, "%gnuc",0};
+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;
 
 #include "mes.symbols.h"
 
@@ -181,11 +187,13 @@ SCM r1 = 0; // param 1
 SCM r2 = 0; // save 2+load/dump
 SCM r3 = 0; // continuation
 
+#include "gc.h"
 #include "lib.h"
 #include "math.h"
 #include "mes.h"
 #include "posix.h"
 #include "reader.h"
+#include "vector.h"
 
 #define CAR(x) g_cells[x].car
 #define CDR(x) g_cells[x].cdr
@@ -362,6 +370,16 @@ error (SCM key, SCM x)
   assert (!"error");
 }
 
+SCM
+cstring_to_list (char const* s)
+{
+  SCM p = cell_nil;
+  int i = strlen (s);
+  while (i--)
+    p = cons (MAKE_CHAR (s[i]), p);
+  return p;
+}
+
 SCM
 append2 (SCM x, SCM y)
 {
@@ -874,16 +892,6 @@ apply (SCM f, SCM x, SCM a) ///((internal))
   return eval_apply ();
 }
 
-SCM
-cstring_to_list (char const* s)
-{
-  SCM p = cell_nil;
-  int i = strlen (s);
-  while (i--)
-    p = cons (MAKE_CHAR (s[i]), p);
-  return p;
-}
-
 SCM
 make_symbol_ (SCM s)
 {
@@ -954,325 +962,6 @@ acons (SCM key, SCM value, SCM alist)
   return cons (cons (key, value), alist);
 }
 
-// temp MINI_MES lib
-//posix.c
-FILE *g_stdin;
-int
-getchar ()
-{
-  return getc (g_stdin);
-}
-
-int
-ungetchar (int c)
-{
-  return ungetc (c, g_stdin);
-}
-
-int
-peekchar ()
-{
-  int c = getchar ();
-  ungetchar (c);
-  return c;
-}
-
-SCM
-peek_byte ()
-{
-  return MAKE_NUMBER (peekchar ());
-}
-
-SCM
-read_byte ()
-{
-  return MAKE_NUMBER (getchar ());
-}
-
-SCM
-unread_byte (SCM i)
-{
-  ungetchar (VALUE (i));
-  return i;
-}
-
-SCM
-write_byte (SCM x) ///((arity . n))
-{
-  SCM c = car (x);
-  SCM p = cdr (x);
-  int fd = 1;
-  if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER) fd = VALUE (car (p));
-  FILE *f = fd == 1 ? stdout : stderr;
-  assert (TYPE (c) == TNUMBER || TYPE (c) == TCHAR);
-  fputc (VALUE (c), f);
-  return c;
-}
-
-char const*
-string_to_cstring (SCM s)
-{
-  static char buf[1024];
-  char *p = buf;
-  s = STRING(s);
-  while (s != cell_nil)
-    {
-      *p++ = VALUE (car (s));
-      s = cdr (s);
-    }
-  *p = 0;
-  return buf;
-}
-
-int g_depth;
-
-#define gputs(x) fputs(x, stdout)
-
-SCM
-display_helper (SCM x, int cont, char* sep)
-{
-  gputs (sep);
-  if (g_depth == 0) return cell_unspecified;
-  //FIXME:
-  //g_depth--;
-  g_depth = g_depth - 1;
-  
-  // eputs ("<display>\n");
-  switch (TYPE (x))
-    {
-    case TCHAR:
-      {
-        //puts ("<char>\n");
-        gputs ("#\\");
-        putchar (VALUE (x));
-        break;
-      }
-    case TFUNCTION:
-      {
-        gputs ("#<procedure ");
-        ///gputs (FUNCTION (x).name ? FUNCTION (x).name : "?");
-        char *p = "?";
-        if (FUNCTION (x).name != 0)
-          p = FUNCTION (x).name;
-        gputs (p);
-        gputs ("[");
-        gputs (itoa (CDR (x)));
-        gputs (",");
-        gputs (itoa (x));
-        gputs ("]>");
-        break;
-      }
-    case TMACRO:
-      {
-        gputs ("#<macro ");
-        display_helper (cdr (x), cont, "");
-        gputs (">");
-        break;
-      }
-    case TNUMBER:
-      {
-        //gputs ("<number>\n");
-        gputs (itoa (VALUE (x)));
-        break;
-      }
-    case TPAIR:
-      {
-        if (!cont) gputs ("(");
-        if (x && x != cell_nil) display_ (CAR (x));
-        if (CDR (x) && TYPE (CDR (x)) == TPAIR)
-          display_helper (CDR (x), 1, " ");
-        else if (CDR (x) && CDR (x) != cell_nil)
-          {
-            if (TYPE (CDR (x)) != TPAIR)
-              gputs (" . ");
-            display_ (CDR (x));
-          }
-        if (!cont) gputs (")");
-        break;
-      }
-    case TSPECIAL:
-#if __NYACC__
-      // FIXME
-      //{}
-      {
-        SCM t = CAR (x);
-        while (t && t != cell_nil)
-          {
-            putchar (VALUE (CAR (t)));
-            t = CDR (t);
-          }
-        break;
-      }
-#endif
-    case TSTRING:
-#if __NYACC__
-      // FIXME
-      {}
-#endif
-    case TSYMBOL:
-      {
-        SCM t = CAR (x);
-        while (t && t != cell_nil)
-          {
-            putchar (VALUE (CAR (t)));
-            t = CDR (t);
-          }
-        break;
-      }
-    default:
-      {
-        //gputs ("<default>\n");
-        gputs ("<");
-        gputs (itoa (TYPE (x)));
-        gputs (":");
-        gputs (itoa (x));
-        gputs (">");
-        break;
-      }
-    }
-  return 0;
-}
-
-SCM
-display_ (SCM x)
-{
-  g_depth = 5;
-  return display_helper (x, 0, "");
-}
-
-SCM
-stderr_ (SCM x)
-{
-  SCM write;
-  if (TYPE (x) == TSTRING)
-    fprintf (stderr, string_to_cstring (x));
-  else if ((write = assq_ref_env (cell_symbol_write, r0)) != cell_undefined)
-    apply (assq_ref_env (cell_symbol_display, r0), cons (x, cons (MAKE_NUMBER (2), cell_nil)), r0);
-  else if (TYPE (x) == TSPECIAL || TYPE (x) == TSTRING || TYPE (x) == TSYMBOL)
-    fprintf (stderr, string_to_cstring (x));
-  else if (TYPE (x) == TNUMBER)
-    fprintf (stderr, "%d", VALUE (x));
-  else
-    fprintf (stderr, "display: undefined\n");
-  return cell_unspecified;
-}
-
-//math.c
-SCM
-greater_p (SCM x) ///((name . ">") (arity . n))
-{
-  int n = INT_MAX;
-  while (x != cell_nil)
-    {
-      assert (TYPE (car (x)) == TNUMBER);
-      if (VALUE (car (x)) >= n) return cell_f;
-      n = VALUE (car (x));
-      x = cdr (x);
-    }
-  return cell_t;
-}
-
-SCM
-less_p (SCM x) ///((name . "<") (arity . n))
-{
-  int n = INT_MIN;
-  while (x != cell_nil)
-    {
-      assert (TYPE (car (x)) == TNUMBER);
-      if (VALUE (car (x)) <= n) return cell_f;
-      n = VALUE (car (x));
-      x = cdr (x);
-    }
-  return cell_t;
-}
-
-// MINI_MES+
-SCM
-make_vector (SCM n)
-{
-  int k = VALUE (n);
-  g_cells[tmp_num].value = TVECTOR;
-  SCM v = alloc (k);
-  SCM x = make_cell (tmp_num, k, v);
-  for (int i=0; i<k; i++) g_cells[v+i] = g_cells[vector_entry (cell_unspecified)];
-  return x;
-}
-
-SCM
-arity_ (SCM x)
-{
-  assert (TYPE (x) == TFUNCTION);
-  return MAKE_NUMBER (FUNCTION (x).arity);
-}
-
-SCM
-values (SCM x) ///((arity . n))
-{
-  SCM v = cons (0, x);
-  TYPE (v) = TVALUES;
-  return v;
-}
-
-SCM
-vector_length (SCM x)
-{
-  assert (TYPE (x) == TVECTOR);
-  return MAKE_NUMBER (LENGTH (x));
-}
-
-SCM
-vector_ref (SCM x, SCM i)
-{
-  assert (TYPE (x) == TVECTOR);
-  assert (VALUE (i) < LENGTH (x));
-  SCM e = VECTOR (x) + VALUE (i);
-  if (TYPE (e) == TREF) e = g_cells[e].ref;
-  if (TYPE (e) == TCHAR) e = MAKE_CHAR (VALUE (e));
-  if (TYPE (e) == TNUMBER) e = MAKE_NUMBER (VALUE (e));
-  return e;
-}
-
-SCM
-vector_entry (SCM x) {
-  if (TYPE (x) == TPAIR || TYPE (x) == TSPECIAL || TYPE (x) == TSTRING || TYPE (x) == TSYMBOL || TYPE (x) == TVECTOR) x = MAKE_REF (x);
-  return x;
-}
-
-SCM
-vector_set_x (SCM x, SCM i, SCM e)
-{
-  assert (TYPE (x) == TVECTOR);
-  assert (VALUE (i) < LENGTH (x));
-  g_cells[VECTOR (x)+g_cells[i].value] = g_cells[vector_entry (e)];
-  return cell_unspecified;
-}
-
-SCM
-list_to_vector (SCM x)
-{
-  VALUE (tmp_num) = VALUE (length (x));
-  SCM v = make_vector (tmp_num);
-  SCM p = VECTOR (v);
-  while (x != cell_nil)
-    {
-      g_cells[p++] = g_cells[vector_entry (car (x))];
-      x = cdr (x);
-    }
-  return v;
-}
-
-SCM
-vector_to_list (SCM v)
-{
-  SCM x = cell_nil;
-  for (int i = 0; i < LENGTH (v); i++) {
-    SCM e = VECTOR (v)+i;
-    if (TYPE (e) == TREF) e = g_cells[e].ref;
-    x = append2 (x, cons (e, cell_nil));
-  }
-  return x;
-}
-
 void
 make_tmps (struct scm* cells)
 {
@@ -1284,116 +973,9 @@ make_tmps (struct scm* cells)
   cells[tmp_num2].type = TNUMBER;
 }
 
-// Jam Collector
-SCM g_symbol_max;
-bool g_debug = false;
-
-SCM
-gc_up_arena ()
-{
-  ARENA_SIZE *= 2;
-  void *p = realloc (g_cells-1, 2*ARENA_SIZE*sizeof(struct scm));
-  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++;
-  gc_init_news ();
-}
-
-SCM
-gc ()
-{
-  if (g_debug) fprintf (stderr, "***gc[%d]...", g_free);
-  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++)
-    gc_copy (i);
-  make_tmps (g_news);
-  g_symbols = gc_copy (g_symbols);
-  SCM new = gc_copy (g_stack);
-  if (g_debug) fprintf (stderr, "new=%d\n", new, g_stack);
-  g_stack = new;
-  return gc_loop (1);
-}
-
-SCM
-gc_loop (SCM scan)
-{
-  while (scan < g_free)
-    {
-      if (NTYPE (scan) == TCLOSURE
-          || NTYPE (scan) == TCONTINUATION
-          || NTYPE (scan) == TFUNCTION
-          || NTYPE (scan) == TKEYWORD
-          || NTYPE (scan) == TMACRO
-          || NTYPE (scan) == TPAIR
-          || NTYPE (scan) == TREF
-          || scan == 1 // null
-          || NTYPE (scan) == TSPECIAL
-          || NTYPE (scan) == TSTRING
-          || NTYPE (scan) == TSYMBOL)
-        {
-          SCM car = gc_copy (g_news[scan].car);
-          gc_relocate_car (scan, car);
-        }
-      if ((NTYPE (scan) == TCLOSURE
-           || NTYPE (scan) == TCONTINUATION
-           || NTYPE (scan) == TMACRO
-           || NTYPE (scan) == TPAIR
-           || NTYPE (scan) == TVALUES)
-          && g_news[scan].cdr) // allow for 0 terminated list of symbols
-        {
-          SCM cdr = gc_copy (g_news[scan].cdr);
-          gc_relocate_cdr (scan, cdr);
-        }
-      scan++;
-    }
-  return gc_flip ();
-}
-
-SCM
-gc_copy (SCM old)
-{
-  if (TYPE (old) == TBROKEN_HEART) return g_cells[old].car;
-  SCM new = g_free++;
-  g_news[new] = g_cells[old];
-  if (NTYPE (new) == TVECTOR)
-    {
-      g_news[new].vector = g_free;
-      for (int i=0; i<LENGTH (old); i++)
-        g_news[g_free++] = g_cells[VECTOR (old)+i];
-    }
-  g_cells[old].type = TBROKEN_HEART;
-  g_cells[old].car = new;
-  return new;
-}
-
-SCM
-gc_relocate_car (SCM new, SCM car)
-{
-  g_news[new].car = car;
-  return cell_unspecified;
-}
-
-SCM
-gc_relocate_cdr (SCM new, SCM cdr)
-{
-  g_news[new].cdr = cdr;
-  return cell_unspecified;
-}
-
-SCM
-gc_flip ()
-{
-  struct scm *cells = g_cells;
-  g_cells = g_news;
-  g_news = cells;
-  if (g_debug) fprintf (stderr, " => jam[%d]\n", g_free);
-  return g_stack;
-}
-
 // Environment setup
 SCM
-gc_init_cells ()
+gc_init_cells () ///((internal))
 {
   g_cells = (struct scm *)malloc (2*ARENA_SIZE*sizeof(struct scm));
   g_cells[0].type = TVECTOR;
@@ -1405,7 +987,7 @@ gc_init_cells ()
 }
 
 SCM
-gc_init_news ()
+gc_init_news () ///((internal))
 {
   g_news = g_cells-1 + ARENA_SIZE;
   g_news[0].type = TVECTOR;
@@ -1445,26 +1027,57 @@ mes_symbols () ///((internal))
   a = acons (cell_symbol_begin, cell_begin, a);
   a = acons (cell_symbol_call_with_current_continuation, cell_call_with_current_continuation, a);
   a = acons (cell_symbol_sc_expand, cell_f, a);
+
+#if __GNUC__
+  a = acons (cell_symbol_gnuc, cell_t, a);
+  a = acons (cell_symbol_mesc, cell_f, a);
+#else
+  a = acons (cell_symbol_gnuc, cell_f, a);
+  a = acons (cell_symbol_mesc, cell_t, a);
+#endif
+
   a = acons (cell_closure, a, a);
 
   return a;
 }
 
+#define gputs(x) fputs(x,stdout);
+
 SCM
 mes_builtins (SCM a) ///((internal))
 {
 #include "mes.i"
 
-#include "lib.i"
-#include "math.i"
 #include "posix.i"
+#include "math.i"
+#include "lib.i"
 #include "reader.i"
+#include "vector.i"
+#include "gc.i"
 
+#include "gc.environment.i"
 #include "lib.environment.i"
 #include "math.environment.i"
 #include "mes.environment.i"
 #include "posix.environment.i"
 #include "reader.environment.i"
+#include "vector.environment.i"
+
+  if (g_debug)
+    {
+      gputs ("functions: ");
+      gputs (itoa (g_function));
+      gputs ("\n");
+      for (int i = 0; i < g_function; i++)
+        {
+          gputs ("[");
+          gputs (itoa (i));
+          gputs ("]: ");
+          gputs (g_functions[i].name);
+          gputs ("\n");
+        }
+      gputs ("\n");
+    }
 
   return a;
 }
@@ -1488,17 +1101,18 @@ mes_environment () ///((internal))
 }
 
 FILE *g_stdin;
-#include "lib.c"
 #include "math.c"
 #include "posix.c"
+#include "lib.c"
 #include "reader.c"
+#include "gc.c"
+#include "vector.c"
 
 int
 main (int argc, char *argv[])
 {
 #if __GNUC__
   g_debug = getenv ("MES_DEBUG");
-#else
 #endif
   if (getenv ("MES_ARENA")) ARENA_SIZE = atoi (getenv ("MES_ARENA"));
   if (argc > 1 && !strcmp (argv[1], "--help")) return puts ("Usage: mes [--dump|--load] < FILE");

mlibc.c

@@ -26,6 +26,7 @@ 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);
 
+#define O_RDONLY 0
 #define INT_MIN -2147483648
 #define INT_MAX 2147483647
 
@@ -239,6 +240,7 @@ getchar ()
     i = ungetc_buf[ungetc_char--];
 
   if (i < 0) i += 256;
+
   return i;
 }
 

module/language/c99/compiler.mes

@@ -53,11 +53,12 @@
    #:inc-dirs (string-split (getenv "C_INCLUDE_PATH") #\:)
    #:cpp-defs '(
                 "__GNUC__=0"
-                "__MESCC__=1"
+                "__MESC__=1"
-                "__NYACC__=1"
+                "__NYACC__=1" ;; REMOVEME
                 "STDIN=0"
                 "STDOUT=1"
                 "STDERR=2"
+                "O_RDONLY=0"
 
                 "INT_MIN=-2147483648"
                 "INT_MAX=2147483647"

module/mes/display.mes

@@ -94,7 +94,8 @@
         (display "#<macro " port)
         (display (core:cdr x) port)
         (display ">" port))
-       ((number? x) (display (number->string x) port))
+       ((number? x)
+        (display (number->string x) port))
        ((pair? x)
         (if (not cont?) (write-char #\( port))
         (cond ((eq? (car x) '*circular*)

module/mes/libc.mes

@@ -91,6 +91,13 @@ getchar ()
      ungetc_char = ungetc_char - 1;
     }
   if (i < 0) i += 256;
+
+#if 0
+  puts (\"get: \");
+  putchar (i);
+  puts (\"\n\");
+#endif
+
   return i;
 }
 "

posix.c

@@ -18,40 +18,217 @@
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+#if !MINI_MES
 #include <fcntl.h>
 
-//MINI_MES
+FILE *g_stdin;
-// SCM
+int
-// write_byte (SCM x) ///((arity . n))
+getchar ()
-// {
+{
-//   SCM c = car (x);
+  return getc (g_stdin);
-//   SCM p = cdr (x);
+}
-//   int fd = 1;
+#endif
-//   if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER) fd = VALUE (car (p));
-//   FILE *f = fd == 1 ? stdout : stderr;
-//   assert (TYPE (c) == TNUMBER || TYPE (c) == TCHAR);
-//   fputc (VALUE (c), f);
-//   return c;
-// }
 
-char const* string_to_cstring (SCM);
+int
+ungetchar (int c)
+{
+  return ungetc (c, g_stdin);
+}
 
-// SCM
+int
-// stderr_ (SCM x)
+peekchar ()
-// {
+{
-//   SCM write;
+  int c = getchar ();
-//   if (TYPE (x) == TSTRING)
+  ungetchar (c);
-//     fprintf (stderr, string_to_cstring (x));
+  return c;
-//   else if ((write = assq_ref_env (cell_symbol_write, r0)) != cell_undefined)
+}
-//     apply (assq_ref_env (cell_symbol_display, r0), cons (x, cons (MAKE_NUMBER (2), cell_nil)), r0);
+
-//   else if (TYPE (x) == TSPECIAL || TYPE (x) == TSTRING || TYPE (x) == TSYMBOL)
+SCM
-//     fprintf (stderr, string_to_cstring (x));
+peek_byte ()
-//   else if (TYPE (x) == TNUMBER)
+{
-//     fprintf (stderr, "%d", VALUE (x));
+  return MAKE_NUMBER (peekchar ());
-//   else
+}
-//     fprintf (stderr, "display: undefined\n");
+
-//   return cell_unspecified;
+SCM
-// }
+read_byte ()
+{
+  return MAKE_NUMBER (getchar ());
+}
+
+SCM
+unread_byte (SCM i)
+{
+  ungetchar (VALUE (i));
+  return i;
+}
+
+SCM
+write_byte (SCM x) ///((arity . n))
+{
+  SCM c = car (x);
+  SCM p = cdr (x);
+  int fd = 1;
+  if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER) fd = VALUE (car (p));
+#if !MES_MINI
+  FILE *f = fd == 1 ? stdout : stderr;
+  fputc (VALUE (c), f);
+#else
+  char cc = VALUE (c);
+  write (1, (char*)&cc, fd);
+#endif
+#if __GNUC__
+  assert (TYPE (c) == TNUMBER || TYPE (c) == TCHAR);
+#endif
+  return c;
+}
+
+char const*
+string_to_cstring (SCM s)
+{
+  static char buf[1024];
+  char *p = buf;
+  s = STRING(s);
+  while (s != cell_nil)
+    {
+      *p++ = VALUE (car (s));
+      s = cdr (s);
+    }
+  *p = 0;
+  return buf;
+}
+
+int g_depth;
+
+SCM
+display_helper (SCM x, int cont, char* sep)
+{
+  gputs (sep);
+  if (g_depth == 0) return cell_unspecified;
+  //FIXME:
+  //g_depth--;
+  g_depth = g_depth - 1;
+  
+  // eputs ("<display>\n");
+  switch (TYPE (x))
+    {
+    case TCHAR:
+      {
+        //gputs ("<char>\n");
+        gputs ("#\\");
+        putchar (VALUE (x));
+        break;
+      }
+    case TFUNCTION:
+      {
+        gputs ("#<procedure ");
+        ///gputs (FUNCTION (x).name ? FUNCTION (x).name : "?");
+        char *p = "?";
+        if (FUNCTION (x).name != 0)
+          p = FUNCTION (x).name;
+        gputs (p);
+        gputs ("[");
+        gputs (itoa (CDR (x)));
+        gputs (",");
+        gputs (itoa (x));
+        gputs ("]>");
+        break;
+      }
+    case TMACRO:
+      {
+        gputs ("#<macro ");
+        display_helper (cdr (x), cont, "");
+        gputs (">");
+        break;
+      }
+    case TNUMBER:
+      {
+        //gputs ("<number>\n");
+        gputs (itoa (VALUE (x)));
+        break;
+      }
+    case TPAIR:
+      {
+        if (!cont) gputs ("(");
+        if (x && x != cell_nil) display_ (CAR (x));
+        if (CDR (x) && TYPE (CDR (x)) == TPAIR)
+          display_helper (CDR (x), 1, " ");
+        else if (CDR (x) && CDR (x) != cell_nil)
+          {
+            if (TYPE (CDR (x)) != TPAIR)
+              gputs (" . ");
+            display_ (CDR (x));
+          }
+        if (!cont) gputs (")");
+        break;
+      }
+    case TSPECIAL:
+#if __NYACC__
+      // FIXME
+      //{}
+      {
+        SCM t = CAR (x);
+        while (t && t != cell_nil)
+          {
+            putchar (VALUE (CAR (t)));
+            t = CDR (t);
+          }
+        break;
+      }
+#endif
+    case TSTRING:
+#if __NYACC__
+      // FIXME
+      {}
+#endif
+    case TSYMBOL:
+      {
+        SCM t = CAR (x);
+        while (t && t != cell_nil)
+          {
+            putchar (VALUE (CAR (t)));
+            t = CDR (t);
+          }
+        break;
+      }
+    default:
+      {
+        //gputs ("<default>\n");
+        gputs ("<");
+        gputs (itoa (TYPE (x)));
+        gputs (":");
+        gputs (itoa (x));
+        gputs (">");
+        break;
+      }
+    }
+  return 0;
+}
+
+SCM
+display_ (SCM x)
+{
+  g_depth = 5;
+  return display_helper (x, 0, "");
+}
+
+SCM
+stderr_ (SCM x)
+{
+  SCM write;
+  if (TYPE (x) == TSTRING)
+    eputs (string_to_cstring (x));
+#if __GNUC__
+  else if ((write = assq_ref_env (cell_symbol_write, r0)) != cell_undefined)
+    apply (assq_ref_env (cell_symbol_display, r0), cons (x, cons (MAKE_NUMBER (2), cell_nil)), r0);
+#endif
+  else if (TYPE (x) == TSPECIAL || TYPE (x) == TSTRING || TYPE (x) == TSYMBOL)
+    eputs (string_to_cstring (x));
+  else if (TYPE (x) == TNUMBER)
+    eputs (itoa (VALUE (x)));
+  else
+    eputs ("core:stderr: display undefined\n");
+  return cell_unspecified;
+}
 
 SCM
 getenv_ (SCM s) ///((name . "getenv"))
@@ -60,56 +237,6 @@ getenv_ (SCM s) ///((name . "getenv"))
   return p ? MAKE_STRING (cstring_to_list (p)) : cell_f;
 }
 
-// MINI_MES
-// int
-// getchar ()
-// {
-//   return getc (g_stdin);
-// }
-
-// int
-// ungetchar (int c)
-// {
-//   return ungetc (c, g_stdin);
-// }
-
-// int
-// peekchar ()
-// {
-//   int c = getchar ();
-//   ungetchar (c);
-//   return c;
-// }
-
-// SCM
-// peek_byte ()
-// {
-//   return MAKE_NUMBER (peekchar ());
-// }
-
-// SCM
-// read_byte ()
-// {
-//   return MAKE_NUMBER (getchar ());
-// }
-
-// SCM
-// unread_byte (SCM i)
-// {
-//   ungetchar (VALUE (i));
-//   return i;
-// }
-
-SCM
-force_output (SCM p) ///((arity . n))
-{
-  int fd = 1;
-  if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER) fd = VALUE (car (p));
-  FILE *f = fd == 1 ? stdout : stderr;
-  fflush (f);
-  return cell_unspecified;
-}
-
 SCM
 open_input_file (SCM file_name)
 {
@@ -128,3 +255,13 @@ set_current_input_port (SCM port)
   g_stdin = VALUE (port) ? fdopen (VALUE (port), "r") : stdin;
   return current_input_port ();
 }
+
+SCM
+force_output (SCM p) ///((arity . n))
+{
+  int fd = 1;
+  if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER) fd = VALUE (car (p));
+  FILE *f = fd == 1 ? stdout : stderr;
+  fflush (f);
+  return cell_unspecified;
+}

scaffold/b-0.mes

@@ -0,0 +1,15 @@
+;;; -*-scheme-*-
+(define (newline) (core:display "\n"))
+(core:display "b-00\n")
+(define save (current-input-port))
+(core:display "save=")(core:display save)(newline)
+(core:display "b-0111\n")
+(set-current-input-port (open-input-file "scaffold/t-0.mes"))
+;;(set-current-input-port (open-input-file "mes/t-0.mes"))
+(core:display "ipp=")(core:display (current-input-port))(newline)
+(core:display "b-02\n")
+(primitive-load)
+(core:display "b-03\n")
+(set-current-input-port save)
+(core:display "b-04\n")
+"42\n"

scaffold/mini-mes.c

@@ -23,7 +23,7 @@
 #endif
 #define assert(x) ((x) ? (void)0 : assert_fail (#x))
 
-#if __MESCC__
+#if __MESC__
 //void *g_malloc_base = 0;
 char *g_malloc_base = 0;
 // int ungetc_char = -1;
@@ -46,7 +46,7 @@ char *g_malloc_base = 0;
 
 
 //int ARENA_SIZE = 4000000;
-int ARENA_SIZE = 100000000;
+int ARENA_SIZE = 1000000000;
 char *arena = 0;
 
 typedef int SCM;
@@ -165,6 +165,9 @@ struct scm scm_vm_call_with_values2 = {TSPECIAL, "*vm-call-with-values2*",0};
 struct scm scm_vm_call_with_current_continuation2 = {TSPECIAL, "*vm-call-with-current-continuation2*",0};
 struct scm scm_vm_return = {TSPECIAL, "*vm-return*",0};
 
+struct scm scm_symbol_gnuc = {TSYMBOL, "%gnuc",0};
+struct scm scm_symbol_mesc = {TSYMBOL, "%mesc",0};
+
 struct scm scm_test = {TSYMBOL, "test",0};
 
 #include "mini-mes.symbols.h"
@@ -383,6 +386,20 @@ assert_defined (SCM x, SCM e) ///((internal))
   return e;
 }
 
+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++;
+    }
+  return p;
+}
+
 SCM
 check_formals (SCM f, SCM formals, SCM args) ///((internal))
 {
@@ -632,7 +649,7 @@ eval_apply ()
     case cell_vm_eval2: goto eval2;
     case cell_vm_macro_expand: goto macro_expand;
     case cell_vm_begin: goto begin;
-      ///case cell_vm_begin_read_input_file: goto begin_read_input_file;
+    case cell_vm_begin_read_input_file: goto begin_read_input_file;
     case cell_vm_begin2: goto begin2;
     case cell_vm_if: goto vm_if;
     case cell_vm_if_expr: goto if_expr;
@@ -1066,35 +1083,13 @@ lookup_ (SCM s, SCM a)
   return x ? x : make_symbol_ (s);
 }
 
-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++;
-    }
-  return p;
-}
-
 SCM
 acons (SCM key, SCM value, SCM alist)
 {
   return cons (cons (key, value), alist);
 }
 
-
+// Posix
-// MINI_MES: temp-lib
-
-// int
-// getchar ()
-// {
-//   return getc (g_stdin);
-// }
-
 int
 ungetchar (int c)
 {
@@ -1145,6 +1140,24 @@ write_byte (SCM x) ///((arity . n))
   return c;
 }
 
+char string_to_cstring_buf[1024];
+char const*
+string_to_cstring (SCM s)
+{
+  //static char buf[1024];
+  //char *p = buf;
+  char *p = string_to_cstring_buf;
+  s = STRING(s);
+  while (s != cell_nil)
+    {
+      *p++ = VALUE (car (s));
+      s = cdr (s);
+    }
+  *p = 0;
+  //return buf;
+  return string_to_cstring_buf;
+}
+
 int g_depth;
 
 SCM
@@ -1226,7 +1239,16 @@ display_helper (SCM x, int cont, char* sep)
     case TSTRING:
 #if __NYACC__
       // FIXME
-      {}
+      //{}
+      {
+        SCM t = CAR (x);
+        while (t && t != cell_nil)
+          {
+            putchar (VALUE (CAR (t)));
+            t = CDR (t);
+          }
+        break;
+      }
 #endif
     case TSYMBOL:
       {
@@ -1259,6 +1281,281 @@ display_ (SCM x)
   return display_helper (x, 0, "");
 }
 
+SCM
+stderr_ (SCM x)
+{
+  SCM write;
+  if (TYPE (x) == TSTRING)
+    eputs (string_to_cstring (x));
+#if __GNUC__
+  else if ((write = assq_ref_env (cell_symbol_write, r0)) != cell_undefined)
+    apply (assq_ref_env (cell_symbol_display, r0), cons (x, cons (MAKE_NUMBER (2), cell_nil)), r0);
+#endif
+  else if (TYPE (x) == TSPECIAL || TYPE (x) == TSTRING || TYPE (x) == TSYMBOL)
+    eputs (string_to_cstring (x));
+  else if (TYPE (x) == TNUMBER)
+    eputs (itoa (VALUE (x)));
+  else
+    eputs ("core:stderr: display undefined\n");
+  return cell_unspecified;
+}
+
+SCM
+getenv_ (SCM s) ///((name . "getenv"))
+{
+#if 0
+  char *p = getenv (string_to_cstring (s));
+  return p ? MAKE_STRING (cstring_to_list (p)) : cell_f;
+#else
+  return cell_t;
+#endif
+}
+
+SCM
+open_input_file (SCM file_name)
+{
+  return MAKE_NUMBER (open (string_to_cstring (file_name), O_RDONLY));
+  // char *s = string_to_cstring (file_name);
+  // int x = open (s, 0);
+  // return MAKE_NUMBER (x);
+}
+
+SCM
+current_input_port ()
+{
+  return MAKE_NUMBER (g_stdin);
+}
+
+SCM
+set_current_input_port (SCM port)
+{
+  g_stdin = VALUE (port) ? VALUE (port) : STDIN;
+  return current_input_port ();
+}
+
+SCM
+force_output (SCM p) ///((arity . n))
+{
+#if 0
+  //FIXME
+  int fd = 1;
+  if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER) fd = VALUE (car (p));
+  FILE *f = fd == 1 ? stdout : stderr;
+  fflush (f);
+#endif
+  return cell_unspecified;
+}
+
+// Math
+SCM
+greater_p (SCM x) ///((name . ">") (arity . n))
+{
+  int n = INT_MAX;
+  while (x != cell_nil)
+    {
+      assert (TYPE (car (x)) == TNUMBER);
+      if (VALUE (car (x)) >= n) return cell_f;
+      n = VALUE (car (x));
+      x = cdr (x);
+    }
+  return cell_t;
+}
+
+SCM
+less_p (SCM x) ///((name . "<") (arity . n))
+{
+  int n = INT_MIN;
+  while (x != cell_nil)
+    {
+      assert (TYPE (car (x)) == TNUMBER);
+#if __MESC__
+      //FIXME __GNUC__
+      if (n == INT_MIN);
+      else
+#endif
+      if (VALUE (car (x)) <= n) return cell_f;
+      n = VALUE (car (x));
+      x = cdr (x);
+    }
+  return cell_t;
+}
+
+SCM
+is_p (SCM x) ///((name . "=") (arity . n))
+{
+  if (x == cell_nil) return cell_t;
+  assert (TYPE (car (x)) == TNUMBER);
+  int n = VALUE (car (x));
+  x = cdr (x);
+  while (x != cell_nil)
+    {
+      if (VALUE (car (x)) != n) return cell_f;
+      x = cdr (x);
+    }
+  return cell_t;
+}
+
+SCM
+minus (SCM x) ///((name . "-") (arity . n))
+{
+  SCM a = car (x);
+  assert (TYPE (a) == TNUMBER);
+  int n = VALUE (a);
+  x = cdr (x);
+  if (x == cell_nil)
+    n = -n;
+  while (x != cell_nil)
+    {
+      assert (TYPE (car (x)) == TNUMBER);
+#if __GNUC__
+      n -= VALUE (car (x));
+#else
+      n = n - VALUE (car (x));
+#endif
+      x = cdr (x);
+    }
+  return MAKE_NUMBER (n);
+}
+
+SCM
+plus (SCM x) ///((name . "+") (arity . n))
+{
+  int n = 0;
+  while (x != cell_nil)
+    {
+      assert (TYPE (car (x)) == TNUMBER);
+#if __GNUC__
+      n += VALUE (car (x));
+#else
+      n = n + VALUE (car (x));
+#endif
+      x = cdr (x);
+    }
+  return MAKE_NUMBER (n);
+}
+
+SCM
+divide (SCM x) ///((name . "/") (arity . n))
+{
+  int n = 1;
+  if (x != cell_nil) {
+    assert (TYPE (car (x)) == TNUMBER);
+    n = VALUE (car (x));
+    x = cdr (x);
+  }
+  while (x != cell_nil)
+    {
+      assert (TYPE (car (x)) == TNUMBER);
+#if __GNUC__
+      n /= VALUE (car (x));
+#else
+      n = n / VALUE (car (x));
+#endif
+      x = cdr (x);
+    }
+  return MAKE_NUMBER (n);
+}
+
+SCM
+modulo (SCM a, SCM b)
+{
+  assert (TYPE (a) == TNUMBER);
+  assert (TYPE (b) == TNUMBER);
+  int x = VALUE (a);
+  while (x < 0) x += VALUE (b);
+  return MAKE_NUMBER (x % VALUE (b));
+}
+
+SCM
+multiply (SCM x) ///((name . "*") (arity . n))
+{
+  int n = 1;
+  while (x != cell_nil)
+    {
+      assert (TYPE (car (x)) == TNUMBER);
+#if __GNUC__
+      n *= VALUE (car (x));
+#else
+      n = n * VALUE (car (x));
+#endif
+      x = cdr (x);
+    }
+  return MAKE_NUMBER (n);
+}
+
+SCM
+logior (SCM x) ///((arity . n))
+{
+  int n = 0;
+  while (x != cell_nil)
+    {
+      assert (TYPE (car (x)) == TNUMBER);
+#if __GNUC__
+      n |= VALUE (car (x));
+#else
+      puts ("FIXME: logior\n");
+      //FIXME
+      //n = n | VALUE (car (x));
+#endif
+      x = cdr (x);
+    }
+  return MAKE_NUMBER (n);
+}
+
+SCM
+ash (SCM n, SCM count)
+{
+  assert (TYPE (n) == TNUMBER);
+  assert (TYPE (count) == TNUMBER);
+  int cn = VALUE (n);
+  int ccount = VALUE (count);
+#if __GNUC__
+  return MAKE_NUMBER ((ccount < 0) ? cn >> -ccount : cn << ccount);
+#else
+  //FIXME
+  assert (ccount >= 0);
+  return MAKE_NUMBER (cn << ccount);
+#endif
+}
+
+// Lib [rest of]
+
+SCM
+exit_ (SCM x) ///((name . "exit"))
+{
+  assert (TYPE (x) == TNUMBER);
+  exit (VALUE (x));
+}
+
+SCM
+append (SCM x) ///((arity . n))
+{
+  if (x == cell_nil) return cell_nil;
+  if (cdr (x) == cell_nil) return car (x);
+  return append2 (car (x), append (cdr (x)));
+}
+
+SCM
+values (SCM x) ///((arity . n))
+{
+  SCM v = cons (0, x);
+  TYPE (v) = TVALUES;
+  return v;
+}
+
+SCM
+arity_ (SCM x)
+{
+  assert (TYPE (x) == TFUNCTION);
+  return MAKE_NUMBER (FUNCTION (x).arity);
+}
+
+SCM
+xassq (SCM x, SCM a) ///for speed in core only
+{
+  while (a != cell_nil && x != CDAR (a)) a = CDR (a);
+  return a != cell_nil ? CAR (a) : cell_f;
+}
 
 // Jam Collector
 SCM g_symbol_max;
@@ -1319,6 +1616,15 @@ mes_symbols () ///((internal))
   a = acons (cell_symbol_begin, cell_begin, a);
   a = acons (cell_symbol_call_with_current_continuation, cell_call_with_current_continuation, a);
   a = acons (cell_symbol_sc_expand, cell_f, a);
+
+#if __GNUC__
+  a = acons (cell_symbol_gnuc, cell_t, a);
+  a = acons (cell_symbol_mesc, cell_f, a);
+#else
+  a = acons (cell_symbol_gnuc, cell_f, a);
+  a = acons (cell_symbol_mesc, cell_t, a);
+#endif
+
   a = acons (cell_closure, a, a);
 
   return a;
@@ -1377,104 +1683,42 @@ bload_env (SCM a) ///((internal))
   g_symbols = r1;
   g_stdin = STDIN;
   r0 = mes_builtins (r0);
-#if 1
+
-  puts ("symbols: ");
+#if __GNUC__
-  SCM s = g_symbols;
+  set_env_x (cell_symbol_gnuc, cell_t, r0);
-  while (s && s != cell_nil) {
+  set_env_x (cell_symbol_mesc, cell_f, r0);
-    display_ (CAR (s));
+#else
-    puts (" ");
+  set_env_x (cell_symbol_gnuc, cell_f, r0);
-    s = CDR (s);
+  set_env_x (cell_symbol_mesc, cell_t, r0);
-  }
+#endif
-  puts ("\n");
+
-  puts ("functions: ");
+  if (g_debug)
-  puts (itoa (g_function));
-  puts ("\n");
-  for (int i = 0; i < g_function; i++)
     {
-      puts ("[");
+      puts ("symbols: ");
-      puts (itoa (i));
+      SCM s = g_symbols;
-      puts ("]: ");
+      while (s && s != cell_nil) {
-      puts (g_functions[i].name);
+        display_ (CAR (s));
+        puts (" ");
+        s = CDR (s);
+      }
+      puts ("\n");
+      puts ("functions: ");
+      puts (itoa (g_function));
+      puts ("\n");
+      for (int i = 0; i < g_function; i++)
+        {
+          puts ("[");
+          puts (itoa (i));
+          puts ("]: ");
+          puts (g_functions[i].name);
+          puts ("\n");
+        }
+      display_ (r0);
       puts ("\n");
     }
-  display_ (r0);
-  puts ("\n");
-#endif
   return r2;
 }
 
-char string_to_cstring_buf[1024];
-char const*
-string_to_cstring (SCM s)
-{
-  //static char buf[1024];
-  //char *p = buf;
-  char *p = string_to_cstring_buf;
-  s = STRING(s);
-  while (s != cell_nil)
-    {
-      *p++ = VALUE (car (s));
-      s = cdr (s);
-    }
-  *p = 0;
-  //return buf;
-  return string_to_cstring_buf;
-}
-
-SCM
-stderr_ (SCM x)
-{
-  //SCM write;
-#if __NYACC__ || FIXME_NYACC
-  if (TYPE (x) == TSTRING)
-// #else
-//   if (TYPE (x) == STRING)
-#endif
-    eputs (string_to_cstring (x));
-  // else if ((write = assq_ref_env (cell_symbol_write, r0)) != cell_undefined)
-  //   apply (assq_ref_env (cell_symbol_display, r0), cons (x, cons (MAKE_NUMBER (2), cell_nil)), r0);
-#if __NYACC__ || FIXME_NYACC
-  else if (TYPE (x) == TSPECIAL || TYPE (x) == TSTRING || TYPE (x) == TSYMBOL)
-// #else
-//   else if (TYPE (x) == SPECIAL || TYPE (x) == STRING || TYPE (x) == SYMBOL)
-#endif
-    eputs (string_to_cstring (x));
-  else if (TYPE (x) == TNUMBER)
-    eputs (itoa (VALUE (x)));
-  else
-    eputs ("core:stderr: display undefined\n");
-  return cell_unspecified;
-}
-
-//math.c
-SCM
-greater_p (SCM x) ///((name . ">") (arity . n))
-{
-  int n = INT_MAX;
-  while (x != cell_nil)
-    {
-      assert (TYPE (car (x)) == TNUMBER);
-      if (VALUE (car (x)) >= n) return cell_f;
-      n = VALUE (car (x));
-      x = cdr (x);
-    }
-  return cell_t;
-}
-
-SCM
-less_p (SCM x) ///((name . "<") (arity . n))
-{
-  int n = INT_MIN;
-  while (x != cell_nil)
-    {
-      assert (TYPE (car (x)) == TNUMBER);
-      if (VALUE (car (x)) <= n) return cell_f;
-      n = VALUE (car (x));
-      x = cdr (x);
-    }
-  return cell_t;
-}
-
 int
 main (int argc, char *argv[])
 {
@@ -1502,9 +1746,12 @@ main (int argc, char *argv[])
 #endif
 
   push_cc (r2, cell_unspecified, r0, cell_unspecified);
-  eputs ("program: ");
+  if (g_debug)
-  display_ (r1);
+    {
-  eputs ("\n");
+      eputs ("program: ");
+      display_ (r1);
+      eputs ("\n");
+    }
   r3 = cell_vm_begin;
   r1 = eval_apply ();
   display_ (r1);

scaffold/t-0.mes

@@ -0,0 +1,2 @@
+;;; -*-scheme-*-
+(core:display "t00\n")

scaffold/t.c

@@ -184,6 +184,10 @@ math_test ()
   i += 48;
   putchar (i);
   puts ("\n");
+
+  puts ("t: 3*4=");
+  i = 3 * 4;
+  if (i!=12) return 1;
   return read_test ();
 }
 

vector.c

@@ -0,0 +1,90 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of Mes.
+ *
+ * Mes is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * Mes is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+SCM
+make_vector (SCM n)
+{
+  int k = VALUE (n);
+  g_cells[tmp_num].value = TVECTOR;
+  SCM v = alloc (k);
+  SCM x = make_cell (tmp_num, k, v);
+  for (int i=0; i<k; i++) g_cells[v+i] = g_cells[vector_entry (cell_unspecified)];
+  return x;
+}
+
+SCM
+vector_length (SCM x)
+{
+  assert (TYPE (x) == TVECTOR);
+  return MAKE_NUMBER (LENGTH (x));
+}
+
+SCM
+vector_ref (SCM x, SCM i)
+{
+  assert (TYPE (x) == TVECTOR);
+  assert (VALUE (i) < LENGTH (x));
+  SCM e = VECTOR (x) + VALUE (i);
+  if (TYPE (e) == TREF) e = g_cells[e].ref;
+  if (TYPE (e) == TCHAR) e = MAKE_CHAR (VALUE (e));
+  if (TYPE (e) == TNUMBER) e = MAKE_NUMBER (VALUE (e));
+  return e;
+}
+
+SCM
+vector_entry (SCM x) {
+  if (TYPE (x) == TPAIR || TYPE (x) == TSPECIAL || TYPE (x) == TSTRING || TYPE (x) == TSYMBOL || TYPE (x) == TVECTOR) x = MAKE_REF (x);
+  return x;
+}
+
+SCM
+vector_set_x (SCM x, SCM i, SCM e)
+{
+  assert (TYPE (x) == TVECTOR);
+  assert (VALUE (i) < LENGTH (x));
+  g_cells[VECTOR (x)+g_cells[i].value] = g_cells[vector_entry (e)];
+  return cell_unspecified;
+}
+
+SCM
+list_to_vector (SCM x)
+{
+  VALUE (tmp_num) = VALUE (length (x));
+  SCM v = make_vector (tmp_num);
+  SCM p = VECTOR (v);
+  while (x != cell_nil)
+    {
+      g_cells[p++] = g_cells[vector_entry (car (x))];
+      x = cdr (x);
+    }
+  return v;
+}
+
+SCM
+vector_to_list (SCM v)
+{
+  SCM x = cell_nil;
+  for (int i = 0; i < LENGTH (v); i++) {
+    SCM e = VECTOR (v)+i;
+    if (TYPE (e) == TREF) e = g_cells[e].ref;
+    x = append2 (x, cons (e, cell_nil));
+  }
+  return x;
+}