core: Use array-based stack.

* 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.

diff --git a/scaffold/mini-mes.c b/scaffold/mini-mes.c
index 797b9d5f6f76ba922c2e9bc46b16129121a37b6e..18f8308f172b135928cc6372582b54a465c28e7d 100644 (file)
--- a/scaffold/mini-mes.c
+++ b/scaffold/mini-mes.c
@@ -34,6 +34,7 @@
 
 int ARENA_SIZE = 200000; // 32b: 2MiB, 64b: 4 MiB
 int MAX_ARENA_SIZE = 300000000;
 
 int ARENA_SIZE = 200000; // 32b: 2MiB, 64b: 4 MiB
 int MAX_ARENA_SIZE = 300000000;

+long STACK_SIZE = 20000;

 int JAM_SIZE = 20000;
 int GC_SAFETY = 2000;
 
 int JAM_SIZE = 20000;
 int GC_SAFETY = 2000;
 


@@ -48,6 +49,7 @@ SCM g_symbols = 0;
 SCM g_macros = 0;
 SCM g_ports = 0;
 SCM g_stack = 0;
 SCM g_macros = 0;
 SCM g_ports = 0;
 SCM g_stack = 0;

+SCM *g_stack_array = 0;

 // a/env
 SCM r0 = 0;
 // param 1
 // a/env
 SCM r0 = 0;
 // param 1

diff --git a/src/gc.c b/src/gc.c
index eb4163b9af77b099059f6e94708888bd0a8d1fd4..fc2cd5c38dae60fadc39e8b4c13874405d1762dd 100644 (file)
--- a/src/gc.c
+++ b/src/gc.c
@@ -23,6 +23,7 @@
 SCM
 gc_up_arena () ///((internal))
 {
 SCM
 gc_up_arena () ///((internal))
 {

+  long old_arena_bytes = (ARENA_SIZE+JAM_SIZE)*sizeof (struct scm);

   if (ARENA_SIZE >> 1 < MAX_ARENA_SIZE >> 2)
     {
       ARENA_SIZE <<= 1;
   if (ARENA_SIZE >> 1 < MAX_ARENA_SIZE >> 2)
     {
       ARENA_SIZE <<= 1;


@@ -31,7 +32,8 @@ gc_up_arena () ///((internal))
     }
   else
     ARENA_SIZE = MAX_ARENA_SIZE -JAM_SIZE;
     }
   else
     ARENA_SIZE = MAX_ARENA_SIZE -JAM_SIZE;

-  void *p = realloc (g_cells-1, (ARENA_SIZE+JAM_SIZE)*sizeof (struct scm));
+  long arena_bytes = (ARENA_SIZE+JAM_SIZE)*sizeof (struct scm);
+  void *p = realloc (g_cells-1, arena_bytes+STACK_SIZE*sizeof (SCM));

   if (!p)
     {
       eputs ("realloc failed, g_free=");
   if (!p)
     {
       eputs ("realloc failed, g_free=");


@@ -43,12 +45,13 @@ gc_up_arena () ///((internal))
       exit (1);
     }
   g_cells = (struct scm*)p;
       exit (1);
     }
   g_cells = (struct scm*)p;

+  memcpy (p + arena_bytes, p + old_arena_bytes, STACK_SIZE*sizeof (SCM));

   g_cells++;
 
   return 0;
 }
 
   g_cells++;
 
   return 0;
 }
 

-SCM
+void

 gc_flip () ///((internal))
 {
   if (g_debug > 2)
 gc_flip () ///((internal))
 {
   if (g_debug > 2)


@@ -60,7 +63,6 @@ gc_flip () ///((internal))
   if (g_free > JAM_SIZE)
     JAM_SIZE = g_free + g_free / 2;
   memcpy (g_cells-1, g_news-1, (g_free+2)*sizeof (struct scm));
   if (g_free > JAM_SIZE)
     JAM_SIZE = g_free + g_free / 2;
   memcpy (g_cells-1, g_news-1, (g_free+2)*sizeof (struct scm));

-  return g_stack;

 }
 
 SCM
 }
 
 SCM


@@ -96,7 +98,7 @@ gc_relocate_cdr (SCM new, SCM cdr) ///((internal))
   return cell_unspecified;
 }
 
   return cell_unspecified;
 }
 

-SCM
+void

 gc_loop (SCM scan) ///((internal))
 {
   SCM car;
 gc_loop (SCM scan) ///((internal))
 {
   SCM car;


@@ -132,7 +134,7 @@ gc_loop (SCM scan) ///((internal))
         }
       scan++;
     }
         }
       scan++;
     }

-  return gc_flip ();
+  gc_flip ();

 }
 
 SCM
 }
 
 SCM


@@ -200,14 +202,8 @@ gc_ () ///((internal))
   g_symbols = gc_copy (g_symbols);
   g_macros = gc_copy (g_macros);
   g_ports = gc_copy (g_ports);
   g_symbols = gc_copy (g_symbols);
   g_macros = gc_copy (g_macros);
   g_ports = gc_copy (g_ports);

-  SCM new = gc_copy (g_stack);
-  if (g_debug > 3)
-    {
-      eputs ("new=");
-      eputs (itoa (new));
-      eputs ("\n");
-    }
-  g_stack = new;
+  for (long i=g_stack; i<STACK_SIZE; i++)
+    g_stack_array[i]= gc_copy (g_stack_array[i]);

   gc_loop (1);
 }
 
   gc_loop (1);
 }
 

diff --git a/src/mes.c b/src/mes.c
index ec868091415caf942297300e3c2b0cff8f41399b..9e570b946812a1288eca85e8f14cf61d6402c094 100644 (file)
--- a/src/mes.c
+++ b/src/mes.c
@@ -26,11 +26,12 @@
 
 //#define MES_MINI 1
 #if POSIX
 
 //#define MES_MINI 1
 #if POSIX

-long ARENA_SIZE = 100000000; // 64b: 4GiB
+long ARENA_SIZE = 100000000;

 #else
 long ARENA_SIZE = 200000; // 32b: 2MiB, 64b: 4 MiB
 #endif
 long MAX_ARENA_SIZE = 100000000;
 #else
 long ARENA_SIZE = 200000; // 32b: 2MiB, 64b: 4 MiB
 #endif
 long MAX_ARENA_SIZE = 100000000;

+long STACK_SIZE = 20000;

 
 long JAM_SIZE = 20000;
 long GC_SAFETY = 2000;
 
 long JAM_SIZE = 20000;
 long GC_SAFETY = 2000;


@@ -44,6 +45,7 @@ long g_free = 0;
 SCM g_continuations = 0;
 SCM g_symbols = 0;
 SCM g_stack = 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
 // a/env
 SCM r0 = 0;
 // param 1


@@ -667,11 +669,35 @@ check_apply (SCM f, SCM e) ///((internal))
 SCM
 gc_push_frame () ///((internal))
 {
 SCM
 gc_push_frame () ///((internal))
 {

-  SCM frame = cons (r1, cons (r2, cons (r3, cons (r0, cons (m0, cell_nil)))));
-  g_stack = cons (frame, g_stack);
+  if (g_stack < 5)
+    assert (!"STACK FULL");
+  g_stack_array[--g_stack] = m0;
+  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;
 }
 
   return g_stack;
 }
 

+SCM
+gc_peek_frame () ///((internal))
+{
+  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];
+  m0 = g_stack_array[g_stack+4];
+  return m0;
+}
+
+SCM
+gc_pop_frame () ///((internal))
+{
+  gc_peek_frame ();
+  g_stack += 5;
+  return m0;
+}
+

 SCM
 append2 (SCM x, SCM y)
 {
 SCM
 append2 (SCM x, SCM y)
 {


@@ -920,26 +946,6 @@ push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
   return cell_unspecified;
 }
 
   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));
-  m0 = CAR (CDDR (CDDR (frame)));
-  return frame;
-}
-
-SCM
-gc_pop_frame () ///((internal))
-{
-  SCM frame = gc_peek_frame (g_stack);
-  g_stack = CDR (g_stack);
-  return frame;
-}
-

 char const* string_to_cstring (SCM s);
 
 SCM
 char const* string_to_cstring (SCM s);
 
 SCM


@@ -1036,6 +1042,8 @@ expand_variable (SCM x, SCM formals) ///((internal))
 
 SCM struct_ref_ (SCM x, long i);
 SCM vector_ref_ (SCM x, long i);
 
 SCM struct_ref_ (SCM x, long i);
 SCM vector_ref_ (SCM x, long i);

+SCM make_vector__ (long k);
+SCM vector_set_x_ (SCM x, long i, SCM e);

 
 SCM
 eval_apply ()
 
 SCM
 eval_apply ()


@@ -1053,6 +1061,7 @@ eval_apply ()
   SCM p;
   SCM program;
   SCM sc_expand;
   SCM p;
   SCM program;
   SCM sc_expand;

+  SCM v;

   SCM x;
   int global_p;
   int macro_p;
   SCM x;
   int global_p;
   int macro_p;


@@ -1135,8 +1144,14 @@ eval_apply ()
     }
   else if (t == TCONTINUATION)
     {
     }
   else if (t == TCONTINUATION)
     {

+      v = CONTINUATION (CAR (r1));
+      if (LENGTH (v))
+        {
+          for (t=0; t < LENGTH (v); t++)
+            g_stack_array[STACK_SIZE-LENGTH (v)+t] = vector_ref_ (v, t);
+          g_stack = STACK_SIZE-LENGTH (v);
+        }

       x = r1;
       x = r1;

-      g_stack = CONTINUATION (CAR (r1));

       gc_pop_frame ();
       r1 = CADR (x);
       goto eval_apply;
       gc_pop_frame ();
       r1 = CADR (x);
       goto eval_apply;


@@ -1581,11 +1596,18 @@ eval_apply ()
  call_with_current_continuation:
   gc_push_frame ();
   x = MAKE_CONTINUATION (g_continuations++);
  call_with_current_continuation:
   gc_push_frame ();
   x = MAKE_CONTINUATION (g_continuations++);

+  v = make_vector__ (STACK_SIZE-g_stack);
+  for (t=g_stack; t < STACK_SIZE; t++)
+    vector_set_x_ (v, t-g_stack, g_stack_array[t]);
+  CONTINUATION (x) = v;

   gc_pop_frame ();
   push_cc (cons (CAR (r1), cons (x, cell_nil)), x, r0, cell_vm_call_with_current_continuation2);
   goto apply;
  call_with_current_continuation2:
   gc_pop_frame ();
   push_cc (cons (CAR (r1), cons (x, cell_nil)), x, r0, cell_vm_call_with_current_continuation2);
   goto apply;
  call_with_current_continuation2:

-  CONTINUATION (r2) = g_stack;
+  v = make_vector__ (STACK_SIZE-g_stack);
+  for (t=g_stack; t < STACK_SIZE; t++)
+    vector_set_x_ (v, t-g_stack, g_stack_array[t]);
+  CONTINUATION (r2) = v;

   goto vm_return;
 
  call_with_values:
   goto vm_return;
 
  call_with_values:


@@ -1615,12 +1637,13 @@ apply (SCM f, SCM x, SCM a) ///((internal))
 SCM
 mes_g_stack (SCM a) ///((internal))
 {
 SCM
 mes_g_stack (SCM a) ///((internal))
 {

-  //r0 = a;
+  //g_stack = g_free + ARENA_SIZE;
+  g_stack = STACK_SIZE;
+  r0 = a;

   r1 = MAKE_CHAR (0);
   r2 = MAKE_CHAR (0);
   r3 = MAKE_CHAR (0);
   r1 = MAKE_CHAR (0);
   r2 = MAKE_CHAR (0);
   r3 = MAKE_CHAR (0);

-  g_stack = cons (cell_nil, cell_nil);
-  return a;
+  return r0;

 }
 
 //\f Environment setup
 }
 
 //\f Environment setup


@@ -1637,7 +1660,11 @@ SCM g_symbol_max;
 SCM
 gc_init_cells () ///((internal))
 {
 SCM
 gc_init_cells () ///((internal))
 {

-  g_cells = (struct scm *)malloc ((ARENA_SIZE+JAM_SIZE)*sizeof (struct scm));
+  long arena_bytes = (ARENA_SIZE+JAM_SIZE)*sizeof (struct scm);
+  void *p = malloc (arena_bytes+STACK_SIZE*sizeof (SCM));
+  g_cells = (struct scm *)p;
+  g_stack_array = (SCM*)(p + arena_bytes);
+

   TYPE (0) = TVECTOR;
   LENGTH (0) = 1000;
   VECTOR (0) = 0;
   TYPE (0) = TVECTOR;
   LENGTH (0) = 1000;
   VECTOR (0) = 0;


@@ -2470,6 +2497,8 @@ main (int argc, char *argv[])
   GC_SAFETY = ARENA_SIZE / 100;
   if (p = getenv ("MES_SAFETY"))
     GC_SAFETY = atoi (p);
   GC_SAFETY = ARENA_SIZE / 100;
   if (p = getenv ("MES_SAFETY"))
     GC_SAFETY = atoi (p);

+  if (p = getenv ("MES_STACK"))
+    STACK_SIZE = atoi (p);

   g_stdin = STDIN;
   g_stdout = STDOUT;
 
   g_stdin = STDIN;
   g_stdout = STDOUT;