mes: use array-based stack. WIP: will not survice gc.

* src/mes.c (STACK_SIZE)[MES_ARRAY_STACK]: New variable.
  (g_stack_array): New variable.
  (g_stack): Change type to SCM*.
* (gc_push_frame)[MES_ARRAY_STACK]: Use g_stack_array, g_stack.
  (gc_peek_frame): Likewise.
  (gc_pop_frame): Likewise.
* src/gc.c (gc_check): Likewise.
  (gc): Likewise.

make.scm

@@ -418,6 +418,7 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
 (add-target (bin.gcc "src/mes.c" #:dependencies gcc-snarf-targets
                      #:defines `("MES_C_READER=1"
                                  "MES_C_DEFINE=1"
+                                 "MES_ARRAY_STACK=1"
                                  "MES_FIXED_PRIMITIVES=1"
                                  "MES_FULL=1"
                                  "POSIX=1"
@@ -430,6 +431,7 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
                      #:dependencies mes-snarf-targets
                      #:defines `("MES_C_READER=1"
                                  "MES_C_DEFINE=1"
+                                 "MES_ARRAY_STACK=1"
                                  "MES_FIXED_PRIMITIVES=1"
                                  "MES_FULL=1"
                                  ,(string-append "VERSION=\"" %version "\"")
@@ -440,6 +442,7 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
 (add-target (bin.mescc "src/mes.c" #:dependencies mes-snarf-targets
                        #:defines `("MES_C_READER=1"
                                    "MES_C_DEFINE=1"
+                                   "MES_ARRAY_STACK=1"
                                    "MES_FIXED_PRIMITIVES=1"
                                    "MES_FULL=1"
                                    ,(string-append "VERSION=\"" %version "\"")

module/mes/fluids.mes

@@ -58,6 +58,10 @@
                                    (set! v (car rest))))) ',module)
            ',fluid))))
 
+(define-macro (make-fluid . default)
+  (core:display "FIXME: disabled fluids\n")
+  (lambda (x) x))
+
 (define (fluid-ref fluid)
   (fluid))
 

src/gc.c

@@ -125,8 +125,15 @@ gc_loop (SCM scan) ///((internal))
 SCM
 gc_check ()
 {
+#if !MES_ARRAY_STACK
   if (g_free + GC_SAFETY > ARENA_SIZE)
     gc_pop_frame (gc (gc_push_frame ()));
+#else
+#endif
+  if (g_free + GC_SAFETY > ARENA_SIZE)
+    {
+      gc ();
+    }
   return cell_unspecified;
 }
 
@@ -148,6 +155,8 @@ gc ()
     gc_copy (i);
   make_tmps (g_news);
   g_symbols = gc_copy (g_symbols);
+
+#if !MES_ARRAY_STACK
   SCM new = gc_copy (g_stack);
   if (g_debug > 1)
     {
@@ -156,5 +165,8 @@ gc ()
       eputs ("\n");
     }
   g_stack = new;
+#else
+#endif
+
   return gc_loop (1);
 }

src/mes.c

@@ -30,6 +30,9 @@ int ARENA_SIZE = 10000000;
 int ARENA_SIZE = 100000;
 #endif
 int MAX_ARENA_SIZE = 20000000;
+#if MES_ARRAY_STACK
+int STACK_SIZE = 10000;
+#endif
 
 //int GC_SAFETY_DIV = 400;
 //int GC_SAFETY = ARENA_SIZE / 400;
@@ -44,6 +47,7 @@ int g_free = 0;
 SCM g_continuations = 0;
 SCM g_symbols = 0;
 SCM g_stack = 0;
+SCM *g_stack_array = 0;
 // a/env
 SCM r0 = 0;
 // param 1
@@ -584,9 +588,52 @@ check_apply (SCM f, SCM e) ///((internal))
 SCM
 gc_push_frame () ///((internal))
 {
+#if !MES_ARRAY_STACK
   SCM frame = cons (r1, cons (r2, cons (r3, cons (r0, cell_nil))));
   g_stack = cons (frame, g_stack);
   return g_stack;
+#else
+  if (g_stack < 4)
+    assert (!"STACK FULL");
+  g_stack_array[--g_stack] = r0;
+  g_stack_array[--g_stack] = r1;
+  g_stack_array[--g_stack] = r2;
+  g_stack_array[--g_stack] = r3;
+  return g_stack;
+#endif
+}
+
+SCM
+gc_peek_frame () ///((internal))
+{
+#if !MES_ARRAY_STACK
+  SCM frame = CAR (g_stack);
+  r1 = CAR (frame);
+  r2 = CADR (frame);
+  r3 = CAR (CDDR (frame));
+  r0 = CADR (CDDR (frame));
+  return frame;
+#else
+  r3 = g_stack_array[g_stack];
+  r2 = g_stack_array[g_stack+1];
+  r1 = g_stack_array[g_stack+2];
+  r0 = g_stack_array[g_stack+3];
+  return r0;
+#endif
+}
+
+SCM
+gc_pop_frame () ///((internal))
+{
+#if !MES_ARRAY_STACK
+  SCM frame = gc_peek_frame ();
+  g_stack = CDR (g_stack);
+  return frame;
+#else
+  gc_peek_frame ();
+  g_stack += 4;
+  return r0;
+#endif
 }
 
 SCM
@@ -731,25 +778,6 @@ push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
   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 ()
 {
@@ -1129,12 +1157,22 @@ apply (SCM f, SCM x, SCM a) ///((internal))
 SCM
 mes_g_stack (SCM a) ///((internal))
 {
+#if !MES_ARRAY_STACK
   r0 = a;
   r1 = MAKE_CHAR (0);
   r2 = MAKE_CHAR (0);
   r3 = MAKE_CHAR (0);
   g_stack = cons (cell_nil, cell_nil);
   return r0;
+#else
+  //g_stack = g_free + ARENA_SIZE;
+  g_stack = STACK_SIZE;
+  r0 = a;
+  r1 = MAKE_CHAR (0);
+  r2 = MAKE_CHAR (0);
+  r3 = MAKE_CHAR (0);
+  return r0;
+#endif
 }
 
 // Environment setup
@@ -1162,6 +1200,9 @@ SCM
 gc_init_cells () ///((internal))
 {
   g_cells = (struct scm *)malloc (2*ARENA_SIZE*sizeof (struct scm));
+#if MES_ARRAY_STACK
+  g_stack_array = (SCM *)malloc (STACK_SIZE);
+#endif
 
   TYPE (0) = TVECTOR;
   LENGTH (0) = 1000;
@@ -1466,6 +1507,7 @@ main (int argc, char *argv[])
   if (g_debug) {eputs (";;; MODULEDIR=");eputs (MODULEDIR);eputs ("\n");}
   if (p = getenv ("MES_MAX_ARENA")) MAX_ARENA_SIZE = atoi (p);
   if (p = getenv ("MES_ARENA")) ARENA_SIZE = atoi (p);
+  if (p = getenv ("MES_STACK")) STACK_SIZE = atoi (p);
   if (argc > 1 && !strcmp (argv[1], "--help")) return puts ("Usage: mes [--dump|--load] < FILE\n");
   if (argc > 1 && !strcmp (argv[1], "--version")) {puts ("Mes ");puts (VERSION);puts ("\n");return 0;};
   g_stdin = STDIN;
@@ -1491,7 +1533,7 @@ main (int argc, char *argv[])
   r1 = eval_apply ();
   display_error_ (r1);
   eputs ("\n");
-  gc (g_stack);
+  gc ();
   if (g_debug)
     {
       eputs ("\nstats: [");