core: gc: Prepare for pointer cells, M2-Planet.

* include/mes/mes.h (cell_zero): Declare.
* src/gc.c (gc_init): Initialize it.
(gc_init_news): Likewise.

include/m2/lib.h

@@ -30,6 +30,8 @@ int errno;
 // CONSTANT EOF 0xffffffff
 // CONSTANT __FILEDES_MAX 512
 
+char *itoa (int number);
+char *ltoa (long number);
 int __ungetc_p (int filedes);
 int eputs (char *s);
 int oputs (char *s);

include/mes/constants.h

@@ -23,10 +23,11 @@
 
 /* Cell types */
 
-// CONSTANT TBYTES         0
+// CONSTANT TCHAR          0
-#define TBYTES             0
+#define TCHAR              0
-// CONSTANT TCHAR          1
+
-#define TCHAR              1
+// CONSTANT TBYTES         1
+#define TBYTES             1
 // CONSTANT TCLOSURE       2
 #define TCLOSURE           2
 // CONSTANT TCONTINUATION  3

include/mes/mes.h

@@ -84,6 +84,7 @@ long GC_SAFETY;
 long MAX_STRING;
 char *g_arena;
 SCM cell_arena;
+SCM cell_zero;
 
 #if POINTER_CELLS
 SCM g_free;
@@ -144,6 +145,7 @@ char *news_bytes (SCM x);
 int peekchar ();
 int readchar ();
 int unreadchar ();
+long gc_free ();
 long length__ (SCM x);
 size_t bytes_cells (size_t length);
 void assert_max_string (size_t i, char const *msg, char *string);

kaem.run

@@ -79,6 +79,7 @@ M2-Planet                                       \
     -f lib/stdlib/realloc.c                     \
     -f lib/string/strcpy.c                      \
     -f lib/mes/itoa.c                           \
+    -f lib/mes/ltoa.c                           \
     -f lib/mes/fdungetc.c                       \
     -f lib/posix/setenv.c                       \
     -f lib/linux/access.c                       \

simple.make

@@ -119,6 +119,7 @@ M2_SOURCES =					\
  lib/stdlib/realloc.c				\
  lib/string/strcpy.c				\
  lib/mes/itoa.c					\
+ lib/mes/ltoa.c					\
  lib/mes/fdungetc.c				\
  lib/posix/setenv.c				\
  lib/linux/access.c				\
@@ -170,6 +171,7 @@ GCC_SOURCES =					\
  lib/mes/mes_open.c				\
  lib/mes/ntoab.c				\
  lib/mes/itoa.c					\
+ lib/mes/ltoa.c					\
  lib/mes/assert_msg.c
 
 mes-gcc: bin/mes-gcc

src/gc.c

@@ -39,8 +39,6 @@ cell_bytes (SCM x)
 #if POINTER_CELLS
   char *p = x;
   return p + (2 * sizeof (long));
-#elif __M2_PLANET__
-  CELL (x) + 8;
 #else
   return &CDR (x);
 #endif
@@ -49,7 +47,12 @@ cell_bytes (SCM x)
 char *
 news_bytes (SCM x)
 {
+#if POINTER_CELLS
+  char *p = x;
+  return p + (2 * sizeof (long));
+#else
   return &NCDR (x);
+#endif
 }
 
 void
@@ -57,58 +60,81 @@ gc_init ()
 {
 #if SYSTEM_LIBC
   ARENA_SIZE = 100000000;       /* 2.3GiB */
-#else
+#elif ! __M2_PLANET__
   ARENA_SIZE = 300000;          /* 32b: 3MiB, 64b: 6 MiB */
+#else
+  ARENA_SIZE = 20000000;
 #endif
-  MAX_ARENA_SIZE = 100000000;
   STACK_SIZE = 20000;
 
-#if POINTER_CELLS
+#if !POINTER_CELLS
-  JAM_SIZE = 1000;
-#else
   JAM_SIZE = 20000;
+  MAX_ARENA_SIZE = 100000000;
+#elif !__M2_PLANET__
+  JAM_SIZE = 10;
+  MAX_ARENA_SIZE = 10000000;
+#else
+  JAM_SIZE = 10;
+  MAX_ARENA_SIZE = 20000000;
 #endif
   GC_SAFETY = 2000;
   MAX_STRING = 524288;
 
   char *p;
-  if (p = getenv ("MES_MAX_ARENA"))
+  p = getenv ("MES_MAX_ARENA");
+  if (p != 0)
     MAX_ARENA_SIZE = atoi (p);
-  if (p = getenv ("MES_ARENA"))
+  p = getenv ("MES_ARENA");
+  if (p != 0)
     ARENA_SIZE = atoi (p);
   JAM_SIZE = ARENA_SIZE / 10;
-  if (p = getenv ("MES_JAM"))
+  p = getenv ("MES_JAM");
+  if (p != 0)
     JAM_SIZE = atoi (p);
   GC_SAFETY = ARENA_SIZE / 100;
-  if (p = getenv ("MES_SAFETY"))
+  p = getenv ("MES_SAFETY");
+  if (p != 0)
     GC_SAFETY = atoi (p);
-  if (p = getenv ("MES_STACK"))
+  p = getenv ("MES_STACK");
+  if (p != 0)
     STACK_SIZE = atoi (p);
-  if (p = getenv ("MES_MAX_STRING"))
+  p = getenv ("MES_MAX_STRING");
+  if (p != 0)
     MAX_STRING = atoi (p);
 
   long arena_bytes = (ARENA_SIZE + JAM_SIZE) * sizeof (struct scm);
-#if POINTER_CELLS
+#if !POINTER_CELLS
-  void *a = malloc (arena_bytes + (STACK_SIZE * sizeof (SCM) * 2));
+  long alloc_bytes = arena_bytes + (STACK_SIZE * sizeof (SCM));
 #else
-  void *a = malloc (arena_bytes + (STACK_SIZE * sizeof (SCM)));
+  long alloc_bytes = (arena_bytes * 2) + (STACK_SIZE * sizeof (struct scm*));
 #endif
-  g_cells = a;
+  g_arena = malloc (alloc_bytes);
-  g_stack_array = a + arena_bytes;
+  g_cells = g_arena;
 
-#if POINTER_CELLS
+#if !POINTER_CELLS
+  g_stack_array = g_arena + arena_bytes;
+#else
+  g_stack_array = g_arena + (arena_bytes * 2);
+#endif
+
+#if !POINTER_CELLS
+  /* The vector that holds the arenea. */
+  cell_arena = -1;
+#else
   /* The vector that holds the arenea. */
   cell_arena = g_cells;
-#else
-  /* The vector that holds the arenea. */
-  cell_arena = 0;
 #endif
+
+  cell_zero = cell_arena + M2_CELL_SIZE;
+
+  g_cells = g_cells + M2_CELL_SIZE; /* Hmm? */
+
   TYPE (cell_arena) = TVECTOR;
   LENGTH (cell_arena) = 1000;
-  VECTOR (cell_arena) = 0;
+  VECTOR (cell_arena) = cell_zero;
-  g_cells = g_cells + M2_CELL_SIZE;
+
-  TYPE (cell_arena) = TCHAR;
+  TYPE (cell_zero) = TCHAR;
-  VALUE (cell_arena) = 'c';
+  VALUE (cell_zero) = 'c';
 
 #if !POINTER_CELLS
   g_free = 1;
@@ -116,7 +142,7 @@ gc_init ()
   g_free = g_cells + M2_CELL_SIZE;
 #endif
 
-  /* FIXME: remove MES_MAX_STRING, grow dynamically */
+  /* FIXME: remove MES_MAX_STRING, grow dynamically. */
   g_buf = malloc (MAX_STRING);
 }
 
@@ -124,7 +150,7 @@ long
 gc_free ()
 {
 #if POINTER_CELLS
-  return g_free - g_cells;
+  return (g_free - g_cells) / M2_CELL_SIZE;
 #else
   return g_free;
 #endif
@@ -133,14 +159,15 @@ gc_free ()
 void
 gc_stats_ (char const* where)
 {
-#if POINTER_CELLS
+#if !POINTER_CELLS
-  long i = g_free - g_cells;
-#else
   long i = g_free;
+#else
+  long i = g_free - g_cells;
+  i = i / M2_CELL_SIZE;
 #endif
   eputs (where);
   eputs (": [");
-  eputs (ntoab (i, 10, 0));
+  eputs (ltoa (i));
   eputs ("]\n");
 }
 
@@ -149,11 +176,13 @@ alloc (long n)
 {
   SCM x = g_free;
   g_free = g_free + (n * M2_CELL_SIZE);
-#if POINTER_CELLS
+#if !POINTER_CELLS
-  long i = g_free - g_cells;
-#else
   long i = g_free;
+#else
+  long i = g_free - g_cells;
+  i = i / M2_CELL_SIZE;
 #endif
+
   if (i > ARENA_SIZE)
     assert_msg (0, "alloc: out of memory");
   return x;
@@ -164,10 +193,11 @@ make_cell (long type, SCM car, SCM cdr)
 {
   SCM x = g_free;
   g_free = g_free + M2_CELL_SIZE;
-#if POINTER_CELLS
+#if !POINTER_CELLS
-  long i = g_free - g_cells;
-#else
   long i = g_free;
+#else
+  long i = g_free - g_cells;
+  i = i / M2_CELL_SIZE;
 #endif
   if (i > ARENA_SIZE)
     assert_msg (0, "alloc: out of memory");
@@ -289,17 +319,34 @@ make_string_port (SCM x)        /*:((internal)) */
 void
 gc_init_news ()
 {
-#if POINTER_CELLS
+#if !POINTER_CELLS
-  g_news = g_free;
-#else
   g_news = g_cells + g_free;
-  NTYPE (cell_arena) = TVECTOR;
+  SCM ncell_arena = cell_arena;
-  NLENGTH (cell_arena) = LENGTH (cell_arena - 1);
+#else
-  NVECTOR (cell_arena) = 0;
+  char* p = g_cells - M2_CELL_SIZE;
-  g_news = g_news + 1;
+  if (p == g_arena)
-  NTYPE (cell_arena) = TCHAR;
+    g_news = g_free;
-  NVALUE (cell_arena) = 'n';
+  else
+    g_news = g_arena;
+
+  SCM ncell_arena = g_news;
 #endif
+
+  SCM ncell_zero = ncell_arena + M2_CELL_SIZE;
+
+  g_news = g_news + M2_CELL_SIZE;
+
+  NTYPE (ncell_arena) = TVECTOR;
+  NLENGTH (ncell_arena) = LENGTH (cell_arena);
+
+#if !POINTER_CELLS
+  NVECTOR (ncell_arena) = 0;
+#else
+  NVECTOR (ncell_arena) = g_news;
+#endif
+
+  NTYPE (ncell_zero) = TCHAR;
+  NVALUE (ncell_zero) = 'n';
 }
 
 void
@@ -315,24 +362,32 @@ gc_up_arena ()
   else
     ARENA_SIZE = MAX_ARENA_SIZE - JAM_SIZE;
   long arena_bytes = (ARENA_SIZE + JAM_SIZE) * sizeof (struct scm);
-  void *p = realloc (g_cells - M2_CELL_SIZE, (arena_bytes + STACK_SIZE) * sizeof (SCM));
+#if !POINTER_CELLS
+  long stack_offset = arena_bytes;
+  long realloc_bytes = arena_bytes + (STACK_SIZE * sizeof (struct scm));
+#else
+  long stack_offset = (arena_bytes * 2);
+  long realloc_bytes = (arena_bytes * 2) + (STACK_SIZE * sizeof (struct scm));
+#endif
+  void *p = realloc (g_cells - M2_CELL_SIZE, realloc_bytes);
   if (p == 0)
     {
       eputs ("realloc failed, g_free=");
-      eputs (itoa (g_free));
+      eputs (ltoa (g_free));
       eputs (":");
-#if POINTER_CELLS
+#if !POINTER_CELLS
-      long i = g_free - g_cells;
-#else
       long i = g_free;
+#else
+      long i = g_free - g_cells;
+      i = i / M2_CELL_SIZE;
 #endif
-      eputs (itoa (ARENA_SIZE - i));
+      eputs (ltoa (ARENA_SIZE - i));
       eputs ("\n");
       assert_msg (0, "0");
       exit (1);
     }
   g_cells = p;
-  memcpy (p + arena_bytes, p + old_arena_bytes, STACK_SIZE * sizeof (SCM));
+  memcpy (p + stack_offset, p + old_arena_bytes, STACK_SIZE * sizeof (SCM));
   g_cells = g_cells + M2_CELL_SIZE;
 }
 
@@ -340,18 +395,22 @@ void
 gc_flip ()
 {
 #if POINTER_CELLS
-  //with pointers, nevva gonna wok
-  //memcpy (g_cells - 1, g_news - 1, (g_free - g_cells + 2) * sizeof (struct scm));
   g_cells = g_news;
+  cell_arena = g_news - M2_CELL_SIZE;
+  cell_zero = cell_arena + M2_CELL_SIZE;
+  cell_nil = cell_zero + M2_CELL_SIZE;
 #endif
+
   if (g_debug > 2)
     gc_stats_ (";;; => jam");
+
 #if POINTER_CELLS
-  // nothing
+  /* Nothing. */
+  return;
 #else
   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));
+  memcpy (g_cells, g_news, g_free * sizeof (struct scm));
 #endif
 }
 
@@ -387,10 +446,10 @@ gc_copy (SCM old)               /*:((internal)) */
           eputs (src);
           eputs ("\n");
           eputs ("    length: ");
-          eputs (itoa (LENGTH (old)));
+          eputs (ltoa (LENGTH (old)));
           eputs ("\n");
           eputs ("    nlength: ");
-          eputs (itoa (NLENGTH (new)));
+          eputs (ltoa (NLENGTH (new)));
           eputs ("\n");
           eputs ("        ==> ");
           eputs (dest);
@@ -437,7 +496,7 @@ gc_loop (SCM scan)
           gc_relocate_car (scan, car);
         }
       /* *INDENT-OFF* */
-      if ((t == TCLOSURE
+      if (t == TCLOSURE
           || t == TCONTINUATION
           || t == TKEYWORD
           || t == TMACRO
@@ -450,7 +509,6 @@ gc_loop (SCM scan)
           || t == TVALUES
           /*|| t == TVECTOR handled by gc_copy */
           )
-          && NCDR (scan))   /* Allow for 0 terminated list of symbols. */
         /* *INDENT-ON* */
         {
           cdr = gc_copy (NCDR (scan));
@@ -467,12 +525,13 @@ gc_loop (SCM scan)
 SCM
 gc_check ()
 {
-#if POINTER_CELLS
+#if !POINTER_CELLS
-  if ((g_free - g_cells) + GC_SAFETY > ARENA_SIZE)
+  long used = g_free + GC_SAFETY;
 #else
-  if (g_free + GC_SAFETY > ARENA_SIZE)
+  long used = ((g_free - g_cells) / M2_CELL_SIZE) + GC_SAFETY;
 #endif
-    gc ();
+  if (used >= ARENA_SIZE)
+    return gc ();
   return cell_unspecified;
 }
 
@@ -486,59 +545,63 @@ gc_ ()
     {
       gc_stats_ (";;; gc");
       eputs (";;; free: [");
-#if POINTER_CELLS
+      eputs (ltoa (ARENA_SIZE - gc_free ()));
-      eputs (itoa (ARENA_SIZE - (g_free - g_cells)));
-#else
-      eputs (itoa (ARENA_SIZE - g_free));
-#endif
       eputs ("]...");
     }
-#if POINTER_CELLS
+#if !POINTER_CELLS
-  g_free = g_news;
-#else
   g_free = 1;
+#else
+  g_free = g_news + M2_CELL_SIZE;
 #endif
 
-  if (ARENA_SIZE < MAX_ARENA_SIZE && g_news > 0)
+  if (ARENA_SIZE < MAX_ARENA_SIZE && g_cells == g_arena + M2_CELL_SIZE)
     {
       if (g_debug == 2)
         eputs ("+");
       if (g_debug > 2)
         {
           eputs (" up[");
-          eputs (itoa (g_cells));
+          eputs (ltoa (g_cells));
           eputs (",");
-          eputs (itoa (g_news));
+          eputs (ltoa (g_news));
           eputs (":");
-          eputs (itoa (ARENA_SIZE));
+          eputs (ltoa (ARENA_SIZE));
           eputs (",");
-          eputs (itoa (MAX_ARENA_SIZE));
+          eputs (ltoa (MAX_ARENA_SIZE));
           eputs ("]...");
         }
       gc_up_arena ();
     }
 
+#if POINTER_CELLS
+  SCM save_gfree = g_free;
+#endif
   SCM s;
   for (s = cell_nil; s < g_symbol_max; s = s + M2_CELL_SIZE)
     gc_copy (s);
+
+#if POINTER_CELLS
+#if GC_TEST
+  cell_nil = save_gfree;
+#else
+  long save_gsymbols = g_symbols;
+  cell_nil = save_gfree;
+  g_symbols = 0;
+  g_free = save_gfree;
+  init_symbols_ ();
+  g_symbol_max = g_symbol;
+  g_symbols = save_gsymbols;
+#endif
+#endif
+
   g_symbols = gc_copy (g_symbols);
   g_macros = gc_copy (g_macros);
   g_ports = gc_copy (g_ports);
   M0 = gc_copy (M0);
   long i;
-  for (i = g_stack; i < STACK_SIZE; i = i + M2_CELL_SIZE)
+  for (i = g_stack; i < STACK_SIZE; i = i + 1)
     copy_stack (i, gc_copy (g_stack_array[i]));
-#if POINTER_CELLS
+
-  long save_gfree = g_free;
-  long save_gsymbols =g_symbols;
-  g_symbols = 0;
-  ///g_free = g_news + 1;
-  cell_nil = g_news; // hmm?
-  init_symbols_ ();
-  g_symbol_max = g_symbol;
-  g_free = save_gfree;
-  g_symbols = save_gsymbols;
-#endif
   gc_loop (cell_nil);
 }