core: Prepare for pointer cells.

* include/mes/cc.h: Prepare for pointer-based cells.
* include/mes/macros.h[POINTER_CELLS]: Alternative set of macros.
* include/mes/mes.h (struct scm)[POINTER_CELLS]: Alternative definition.
* src/gc.c (copy_cell, copy_news): New function.
* include/mes/mes.h: Declare them.

include/mes/cc.h

@@ -21,7 +21,11 @@
 #ifndef __MES_CC_H
 #define __MES_CC_H
 
+#if POINTER_CELLS
+typedef struct scm* SCM;
+#else
 typedef long SCM;
+#endif
 
 #if __MESC__
 typedef long FUNCTION;

include/mes/m2.h

@@ -53,7 +53,15 @@ struct timeval
 */
 
 #define struct_size 12
+
+#if POINTER_CELLS
+
+#define CELL(x) (x)
+
+#else
+
 #define CELL(x) ((x*struct_size)+g_cells)
+
 #define TYPE(x) ((x*struct_size)+g_cells)->type
 #define CAR(x) ((x*struct_size)+g_cells)->car
 #define CDR(x) ((x*struct_size)+g_cells)->cdr
@@ -95,4 +103,6 @@ struct timeval
 #define CADDR(x) CAR (CDR (CDR (x)))
 #define CDADAR(x) CAR (CDR (CAR (CDR (x))))
 
+#endif
+
 #endif /* __MES_M2_H */

include/mes/macros.h

@@ -21,6 +21,43 @@
 #ifndef __MES_MACROS_H
 #define __MES_MACROS_H
 
+#if POINTER_CELLS
+
+#define TYPE(x) g_cells[x - g_cells].type
+#define CAR(x) g_cells[x - g_cells].car
+#define CDR(x) g_cells[x - g_cells].cdr
+
+#define NTYPE(x) g_news[x - g_news].type
+#define NCAR(x) g_news[x - g_news].car
+#define NCDR(x) g_news[x - g_news].cdr
+
+#define STYPE(x) TYPE (g_stack_array[x])
+#define SCAR(x) CAR (g_stack_array[x])
+#define SCDR(x) CDR (g_stack_arraynews[x])
+
+#define BYTES(x) g_cells[x - g_cells].bytes
+#define LENGTH(x) g_cells[x - g_cells].length
+#define MACRO(x) g_cells[x - g_cells].macro
+#define PORT(x) g_cells[x - g_cells].port
+#define REF(x) g_cells[x - g_cells].ref
+#define VARIABLE(x) g_cells[x - g_cells].variable
+
+#define CLOSURE(x) g_cells[x - g_cells].closure
+#define CONTINUATION(x) g_cells[x - g_cells].continuation
+
+#define NAME(x) g_cells[x - g_cells].name
+#define STRING(x) g_cells[x - g_cells].string
+#define STRUCT(x) g_cells[x - g_cells].structure
+#define VALUE(x) g_cells[x - g_cells].value
+#define VECTOR(x) g_cells[x - g_cells].vector
+
+#define NLENGTH(x) g_news[x - g_news].length
+#define NVALUE(x) g_news[x - g_news].value
+#define NSTRING(x) g_news[x - g_news].string
+#define NVECTOR(x) g_news[x - g_news].vector
+
+#else
+
 #define TYPE(x) g_cells[x].type
 #define CAR(x) g_cells[x].car
 #define CDR(x) g_cells[x].cdr
@@ -29,6 +66,10 @@
 #define NCAR(x) g_news[x].car
 #define NCDR(x) g_news[x].cdr
 
+#define STYPE(x) TYPE (g_stack_array[x])
+#define SCAR(x) CAR (g_stack_array[x])
+#define SCDR(x) CDR (g_stack_array[x])
+
 #define BYTES(x) g_cells[x].car
 #define LENGTH(x) g_cells[x].car
 #define REF(x) g_cells[x].car
@@ -50,6 +91,8 @@
 #define NSTRING(x) g_news[x].cdr
 #define NVECTOR(x) g_news[x].cdr
 
+#endif
+
 #define CAAR(x) CAR (CAR (x))
 #define CADR(x) CAR (CDR (x))
 #define CDAR(x) CDR (CAR (x))

include/mes/mes.h

@@ -21,14 +21,35 @@
 #ifndef __MES_MES_H
 #define __MES_MES_H
 
+#define POINTER_CELLS 0
+
 #include <sys/types.h>
 #include "mes/cc.h"
 
 struct scm
 {
   long type;
-  SCM car;
+  union
-  SCM cdr;
+  {
+    SCM car;
+    char *bytes;
+    long length;
+    SCM ref;
+    SCM variable;
+    SCM macro;
+    long port;
+  };
+  union
+  {
+    SCM cdr;
+    SCM closure;
+    SCM continuation;
+    char *name;
+    SCM string;
+    SCM structure;
+    long value;
+    SCM vector;
+  };
 };
 
 /* mes */
@@ -61,8 +82,16 @@ long JAM_SIZE;
 long GC_SAFETY;
 long MAX_STRING;
 char *g_arena;
+SCM cell_arena;
+
+#if POINTER_CELLS
+SCM g_free;
+long g_stack;
+#else
 long g_free;
 SCM g_stack;
+#endif
+
 SCM *g_stack_array;
 struct scm *g_cells;
 struct scm *g_news;
@@ -80,6 +109,7 @@ SCM apply_builtin (SCM fn, SCM x);
 SCM builtin_name (SCM builtin);
 SCM cstring_to_list (char const *s);
 SCM cstring_to_symbol (char const *s);
+SCM cell_ref (SCM cell, long index);
 SCM fdisplay_ (SCM, int, int);
 SCM init_symbols ();
 SCM init_time (SCM a);
@@ -114,11 +144,14 @@ long length__ (SCM x);
 size_t bytes_cells (size_t length);
 void assert_max_string (size_t i, char const *msg, char *string);
 void assert_msg (int check, char *msg);
+void copy_cell (SCM to, SCM from);
 void gc_ ();
 void gc_init ();
 void gc_peek_frame ();
 void gc_pop_frame ();
 void gc_push_frame ();
+void gc_stats_ (char const* where);
+void init_symbols_ ();
 
 #include "mes/builtins.h"
 #include "mes/constants.h"

include/mes/symbols.h

@@ -143,4 +143,11 @@ SCM cell_symbol_test;
 // CONSTANT SYMBOL_MAX 119
 #define SYMBOL_MAX 119
 
+// CONSTANT CELL_UNSPECIFIED 7
+#define CELL_UNSPECIFIED 7
+
+// CONSTANT CELL_SYMBOL_RECORD_TYPE 88
+#define CELL_SYMBOL_RECORD_TYPE 88
+
+
 #endif /* __MES_SYMBOLS_H */

src/eval-apply.c

@@ -352,7 +352,7 @@ eval_apply ()
   int global_p;
   int macro_p;
   int t;
-  long c;
+  SCM c;
 
 eval_apply:
   if (R3 == cell_vm_evlis2)

src/gc.c

@@ -25,10 +25,25 @@
 #include <string.h>
 #include <stdlib.h>
 
+#if __M2_PLANET__
+#define M2_CELL_SIZE 12
+// CONSTANT M2_CELL_SIZE 12
+#else
+#define M2_CELL_SIZE 1
+// CONSTANT M2_CELL_SIZE 12
+#endif
+
 char *
 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
 }
 
 char *
@@ -48,7 +63,11 @@ gc_init ()
   MAX_ARENA_SIZE = 100000000;
   STACK_SIZE = 20000;
 
+#if POINTER_CELLS
+  JAM_SIZE = 1000;
+#else
   JAM_SIZE = 20000;
+#endif
   GC_SAFETY = 2000;
   MAX_STRING = 524288;
 
@@ -69,32 +88,60 @@ gc_init ()
     MAX_STRING = atoi (p);
 
   long arena_bytes = (ARENA_SIZE + JAM_SIZE) * sizeof (struct scm);
+#if POINTER_CELLS
+  void *a = malloc (arena_bytes + STACK_SIZE * sizeof (SCM) * 2);
+#else
   void *a = malloc (arena_bytes + STACK_SIZE * sizeof (SCM));
+#endif
   g_cells = a;
   g_stack_array = a + arena_bytes;
 
-  TYPE (0) = TVECTOR;
+#if POINTER_CELLS
-  LENGTH (0) = 1000;
+  /* The vector that holds the arenea. */
-  VECTOR (0) = 0;
+  cell_arena = g_cells;
+#else
+  /* The vector that holds the arenea. */
+  cell_arena = 0;
+#endif
+  TYPE (cell_arena) = TVECTOR;
+  LENGTH (cell_arena) = 1000;
+  VECTOR (cell_arena) = 0;
   g_cells = g_cells + 1;
-  TYPE (0) = TCHAR;
+  TYPE (cell_arena) = TCHAR;
-  VALUE (0) = 'c';
+  VALUE (cell_arena) = 'c';
+
+#if !POINTER_CELLS
+  g_free = 1;
+#else
+  g_free = g_cells + M2_CELL_SIZE;
+#endif
 
   /* FIXME: remove MES_MAX_STRING, grow dynamically */
   g_buf = malloc (MAX_STRING);
 }
 
-SCM
+long
-gc_init_news ()                 /*:((internal)) */
+gc_free ()
 {
-  g_news = g_cells + g_free;
+#if POINTER_CELLS
-  NTYPE (0) = TVECTOR;
+  return g_free - g_cells;
-  NLENGTH (0) = 1000;
+#else
-  NVECTOR (0) = 0;
+  return g_free;
-  g_news = g_news + 1;
+#endif
-  NTYPE (0) = TCHAR;
+}
-  NVALUE (0) = 'n';
+
-  return 0;
+void
+gc_stats_ (char const* where)
+{
+#if POINTER_CELLS
+  long i = g_free - g_cells;
+#else
+  long i = g_free;
+#endif
+  eputs (where);
+  eputs (": [");
+  eputs (ntoab (i, 10, 0));
+  eputs ("]\n");
 }
 
 SCM
@@ -102,7 +149,12 @@ alloc (long n)
 {
   SCM x = g_free;
   g_free = g_free + n;
-  if (g_free > ARENA_SIZE)
+#if POINTER_CELLS
+  long i = g_free - g_cells;
+#else
+  long i = g_free;
+#endif
+  if (i > ARENA_SIZE)
     assert_msg (0, "alloc: out of memory");
   return x;
 }
@@ -112,7 +164,12 @@ make_cell (long type, SCM car, SCM cdr)
 {
   SCM x = g_free;
   g_free = g_free + 1;
-  if (g_free > ARENA_SIZE)
+#if POINTER_CELLS
+  long i = g_free - g_cells;
+#else
+  long i = g_free;
+#endif
+  if (i > ARENA_SIZE)
     assert_msg (0, "alloc: out of memory");
   TYPE (x) = type;
   CAR (x) = car;
@@ -120,6 +177,34 @@ make_cell (long type, SCM car, SCM cdr)
   return x;
 }
 
+void
+copy_cell (SCM to, SCM from)
+{
+  TYPE (to) = TYPE (from);
+  CAR (to) = CAR (from);
+  CDR (to) = CDR (from);
+}
+
+void
+copy_news (SCM to, SCM from)
+{
+  NTYPE (to) = TYPE (from);
+  NCAR (to) = CAR (from);
+  NCDR (to) = CDR (from);
+}
+
+void
+copy_stack (long index, SCM from)
+{
+  g_stack_array[index] = from;
+}
+
+SCM
+cell_ref (SCM cell, long index)
+{
+  return cell + index;
+}
+
 SCM
 cons (SCM x, SCM y)
 {
@@ -139,12 +224,7 @@ make_bytes (char const *s, size_t length)
   SCM x = alloc (size);
   TYPE (x) = TBYTES;
   LENGTH (x) = length;
-#if __M2_PLANET__
+  char *p = cell_bytes (x);
-  char *p = &g_cells[x];
-  p = p + 2 * sizeof (SCM);
-#else
-  char *p = &CDR (x);
-#endif
   if (length == 0)
     p[0] = 0;
   else
@@ -206,6 +286,22 @@ make_string_port (SCM x)        /*:((internal)) */
   return make_cell (TPORT, -length__ (g_ports) - 2, x);
 }
 
+void
+gc_init_news ()
+{
+#if POINTER_CELLS
+  g_news = g_free;
+#else
+  g_news = g_cells + g_free;
+  NTYPE (cell_arena) = TVECTOR;
+  NLENGTH (cell_arena) = 1000;
+  NVECTOR (cell_arena) = 0;
+  g_news = g_news + 1;
+  NTYPE (cell_arena) = TCHAR;
+  NVALUE (cell_arena) = 'n';
+#endif
+}
+
 void
 gc_up_arena ()
 {
@@ -225,7 +321,12 @@ gc_up_arena ()
       eputs ("realloc failed, g_free=");
       eputs (itoa (g_free));
       eputs (":");
-      eputs (itoa (ARENA_SIZE - g_free));
+#if POINTER_CELLS
+      long i = g_free - g_cells;
+#else
+      long i = g_free;
+#endif
+      eputs (itoa (ARENA_SIZE - i));
       eputs ("\n");
       assert_msg (0, "0");
       exit (1);
@@ -238,15 +339,20 @@ gc_up_arena ()
 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;
+#endif
   if (g_debug > 2)
-    {
+    gc_stats_ (";;; => jam");
-      eputs (";;;   => jam[");
+#if POINTER_CELLS
-      eputs (itoa (g_free));
+  // nothing
-      eputs ("]\n");
+#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));
+#endif
 }
 
 SCM
@@ -256,14 +362,14 @@ gc_copy (SCM old)               /*:((internal)) */
     return CAR (old);
   SCM new = g_free;
   g_free = g_free + 1;
-  g_news[new] = g_cells[old];
+  copy_news (new, old);
   if (NTYPE (new) == TSTRUCT || NTYPE (new) == TVECTOR)
     {
       NVECTOR (new) = g_free;
       long i;
       for (i = 0; i < LENGTH (old); i = i + 1)
         {
-          g_news[g_free] = g_cells[VECTOR (old) + i];
+          copy_news (g_free, cell_ref (VECTOR (old), i));
           g_free = g_free + 1;
         }
     }
@@ -271,7 +377,7 @@ gc_copy (SCM old)               /*:((internal)) */
     {
       char const *src = cell_bytes (old);
       char *dest = news_bytes (new);
-      size_t length = NLENGTH (new);
+      size_t length = NLENGTH (old);
       memcpy (dest, src, length);
       g_free = g_free + bytes_cells (length) - 1;
 
@@ -311,7 +417,7 @@ gc_relocate_cdr (SCM new, SCM cdr)      /*:((internal)) */
 }
 
 void
-gc_loop (SCM scan)              /*:((internal)) */
+gc_loop (SCM scan)
 {
   SCM car;
   SCM cdr;
@@ -351,9 +457,9 @@ gc_loop (SCM scan)              /*:((internal)) */
           gc_relocate_cdr (scan, cdr);
         }
       if (t == TBYTES)
-        scan = scan + bytes_cells (NLENGTH (scan));
+        scan = scan + (bytes_cells (NLENGTH (scan)) * M2_CELL_SIZE);
       else
-        scan = scan + 1;
+        scan = scan + M2_CELL_SIZE;
     }
   gc_flip ();
 }
@@ -361,7 +467,11 @@ gc_loop (SCM scan)              /*:((internal)) */
 SCM
 gc_check ()
 {
+#if POINTER_CELLS
+  if ((g_free - g_cells) + GC_SAFETY > ARENA_SIZE)
+#else
   if (g_free + GC_SAFETY > ARENA_SIZE)
+#endif
     gc ();
   return cell_unspecified;
 }
@@ -374,13 +484,20 @@ gc_ ()
     eputs (".");
   if (g_debug > 2)
     {
-      eputs (";;; gc[");
+      gc_stats_ (";;; gc");
-      eputs (itoa (g_free));
+      eputs (";;; free: [");
-      eputs (":");
+#if POINTER_CELLS
+      eputs (itoa (ARENA_SIZE - (g_free - g_cells)));
+#else
       eputs (itoa (ARENA_SIZE - g_free));
+#endif
       eputs ("]...");
     }
+#if POINTER_CELLS
+  g_free = g_news;
+#else
   g_free = 1;
+#endif
 
   if (ARENA_SIZE < MAX_ARENA_SIZE && g_news > 0)
     {
@@ -401,16 +518,28 @@ gc_ ()
       gc_up_arena ();
     }
 
-  long i;
+  SCM s;
-  for (i = g_free; i < g_symbol_max; i = i + 1)
+  for (s = cell_nil; s < g_symbol_max; s = s + 1)
-    gc_copy (i);
+    gc_copy (s);
   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 + 1)
-    g_stack_array[i] = gc_copy (g_stack_array[i]);
+    copy_stack (i, gc_copy (g_stack_array[i]));
-  gc_loop (1);
+#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);
 }
 
 SCM

src/hash.c

@@ -29,7 +29,7 @@ hash_cstring (char const *s, long size)
   int hash = s[0] * 37;
   if (s[0] != 0 && s[1] != 0)
     hash = hash + s[1] * 43;
-  assert_msg (size, "size");
+  assert_msg (size != 0, "size");
   hash = hash % size;
   return hash;
 }

src/lib.c

@@ -131,7 +131,7 @@ memq (SCM x, SCM a)
   int t = TYPE (x);
   if (t == TCHAR || t == TNUMBER)
     {
-      SCM v = VALUE (x);
+      long v = VALUE (x);
       while (a != cell_nil && v != VALUE (CAR (a)))
         a = CDR (a);
     }

src/mes.c

@@ -224,7 +224,7 @@ assq (SCM x, SCM a)
       a = CDR (a);
   else if (t == TCHAR || t == TNUMBER)
     {
-      SCM v = VALUE (x);
+      long v = VALUE (x);
       while (a != cell_nil && v != VALUE (CAAR (a)))
         a = CDR (a);
     }
@@ -399,7 +399,6 @@ init (char **envp)
     g_debug = atoi (p);
   open_boot ();
   gc_init ();
-  g_ports = 1;
 }
 
 int
@@ -420,11 +419,7 @@ main (int argc, char **argv, char **envp)
   push_cc (R2, cell_unspecified, R0, cell_unspecified);
 
   if (g_debug > 2)
-    {
+    gc_stats_ ("\n gc boot");
-      eputs ("\ngc stats: [");
-      eputs (itoa (g_free));
-      eputs ("]\n");
-    }
   if (g_debug > 3)
     {
       eputs ("program: ");
@@ -443,25 +438,22 @@ main (int argc, char **argv, char **envp)
       if (g_debug > 5)
         module_printer (M0);
 
-      eputs ("\ngc stats: [");
+      if (g_debug < 3)
-      eputs (itoa (g_free));
+        gc_stats_ ("\ngc run");
       MAX_ARENA_SIZE = 0;
 
       gc (g_stack);
-      eputs (" => ");
+      if (g_debug < 3)
-      eputs (itoa (g_free));
+        gc_stats_ (" => ");
-      eputs ("]\n");
-      eputs ("\n");
 
       if (g_debug > 5)
         {
-          eputs ("ports:");
+          eputs ("\nports:");
           write_error_ (g_ports);
           eputs ("\n");
         }
       eputs ("\n");
-
-
     }
+
   return 0;
 }

src/struct.c

@@ -27,14 +27,8 @@ make_struct (SCM type, SCM fields, SCM printer)
   long size = 2 + length__ (fields);
   SCM v = alloc (size);
   SCM x = make_cell (TSTRUCT, size, v);
-  SCM vt = vector_entry (type);
+  copy_cell (v, vector_entry (type));
-  TYPE (v) = TYPE (vt);
+  copy_cell (cell_ref (v, 1), vector_entry (printer));
-  CAR (v) = CAR (vt);
-  CDR (v) = CDR (vt);
-  SCM vp = vector_entry (printer);
-  TYPE (v + 1) = TYPE (vp);
-  CAR (v + 1) = CAR (vp);
-  CDR (v + 1) = CDR (vp);
   long i;
   for (i = 2; i < size; i = i + 1)
     {
@@ -44,10 +38,7 @@ make_struct (SCM type, SCM fields, SCM printer)
           e = CAR (fields);
           fields = CDR (fields);
         }
-      SCM ve = vector_entry (e);
+      copy_cell (cell_ref (v, i), vector_entry (e));
-      TYPE (v + i) = TYPE (ve);
-      CAR (v + i) = CAR (ve);
-      CDR (v + i) = CDR (ve);
     }
   return x;
 }
@@ -64,7 +55,7 @@ struct_ref_ (SCM x, long i)
 {
   assert_msg (TYPE (x) == TSTRUCT, "TYPE (x) == TSTRUCT");
   assert_msg (i < LENGTH (x), "i < LENGTH (x)");
-  SCM e = STRUCT (x) + i;
+  SCM e = cell_ref (STRUCT (x), i);
   if (TYPE (e) == TREF)
     e = REF (e);
   if (TYPE (e) == TCHAR)
@@ -79,7 +70,7 @@ struct_set_x_ (SCM x, long i, SCM e)
 {
   assert_msg (TYPE (x) == TSTRUCT, "TYPE (x) == TSTRUCT");
   assert_msg (i < LENGTH (x), "i < LENGTH (x)");
-  g_cells[STRUCT (x) + i] = g_cells[vector_entry (e)];
+  copy_cell (cell_ref (STRUCT (x), i), vector_entry (e));
   return cell_unspecified;
 }
 

src/symbol.c

@@ -23,32 +23,42 @@
 
 #include <string.h>
 
+#if __M2_PLANET__
+#define M2_CELL_SIZE 12
+// CONSTANT M2_CELL_SIZE 12
+#else
+#define M2_CELL_SIZE 1
+// CONSTANT M2_CELL_SIZE 12
+#endif
+
+#if POINTER_CELLS
+SCM g_symbol;
+#else
 long g_symbol;
+#endif
 
 SCM
 init_symbol (SCM x, long type, char const *name)
 {
   TYPE (x) = type;
-  int length = strlen (name);
+  if (!g_symbols)
-  SCM string = make_string (name, length);
+    g_free = g_free + M2_CELL_SIZE;
-  CAR (x) = length;
+  else
-  CDR (x) = STRING (string);
+    {
-  hash_set_x (g_symbols, string, x);
+      int length = strlen (name);
-  g_symbol = g_symbol + 1;
+      SCM string = make_string (name, length);
+      CAR (x) = length;
+      CDR (x) = STRING (string);
+      hash_set_x (g_symbols, string, x);
+    }
+  g_symbol = g_symbol + M2_CELL_SIZE;
   return x;
 }
 
-SCM
+void
-init_symbols ()                  /*:((internal)) */
+init_symbols_ ()                  /*:((internal)) */
 {
-  g_free = SYMBOL_MAX + 1;
+  g_symbol = cell_nil;
-  g_symbol_max = g_free;
-  g_symbols = make_hash_table_ (500);
-
-  int size = VALUE (struct_ref_ (g_symbols, 3));
-
-  g_symbol = 1;
-  cell_nil = 1;
   cell_nil = init_symbol (g_symbol, TSPECIAL, "()");
   cell_f = init_symbol (g_symbol, TSPECIAL, "#f");
   cell_t = init_symbol (g_symbol, TSPECIAL, "#t");
@@ -167,8 +177,34 @@ init_symbols ()                  /*:((internal)) */
   cell_type_vector = init_symbol (g_symbol, TSYMBOL, "<cell:vector>");
   cell_type_broken_heart = init_symbol (g_symbol, TSYMBOL, "<cell:broken-heart>");
   cell_symbol_test = init_symbol (g_symbol, TSYMBOL, "%%test");
+}
 
-  assert_msg (g_symbol == SYMBOL_MAX, "i == SYMBOL_MAX");
+SCM
+init_symbols ()                  /*:((internal)) */
+{
+#if POINTER_CELLS
+  g_free = g_cells + M2_CELL_SIZE;
+#else
+  g_free = 1;
+#endif
+
+  g_symbols = 0;
+  cell_nil = g_free;
+  init_symbols_ ();
+
+#if POINTER_CELLS
+  assert_msg ("UNSPEC", cell_unspecified - g_cells == CELL_UNSPECIFIED);
+  assert_msg ("RECORD-TYPE", cell_symbol_record_type - g_cells == CELL_SYMBOL_RECORD_TYPE);
+  g_symbol_max = g_symbol;
+#else
+  assert_msg ("UNSPEC", cell_unspecified == CELL_UNSPECIFIED);
+  assert_msg ("RECORD-TYPE", cell_symbol_record_type == CELL_SYMBOL_RECORD_TYPE);
+  g_symbol_max = g_symbol;
+#endif
+
+  g_symbols = make_hash_table_ (500);
+  init_symbols_ ();
+  g_ports = cell_nil;
 
   SCM a = cell_nil;
   a = acons (cell_symbol_call_with_values, cell_symbol_call_with_values, a);

src/vector.c

@@ -28,7 +28,8 @@ make_vector__ (long k)
   SCM x = make_cell (TVECTOR, k, v);
   long i;
   for (i = 0; i < k; i = i + 1)
-    g_cells[v + i] = g_cells[vector_entry (cell_unspecified)];
+    copy_cell (cell_ref (v, i), vector_entry (cell_unspecified));
+
   return x;
 }
 
@@ -50,7 +51,7 @@ vector_ref_ (SCM x, long i)
 {
   assert_msg (TYPE (x) == TVECTOR, "TYPE (x) == TVECTOR");
   assert_msg (i < LENGTH (x), "i < LENGTH (x)");
-  SCM e = VECTOR (x) + i;
+  SCM e = cell_ref (VECTOR (x), i);
   if (TYPE (e) == TREF)
     e = REF (e);
   if (TYPE (e) == TCHAR)
@@ -79,7 +80,7 @@ vector_set_x_ (SCM x, long i, SCM e)
 {
   assert_msg (TYPE (x) == TVECTOR, "TYPE (x) == TVECTOR");
   assert_msg (i < LENGTH (x), "i < LENGTH (x)");
-  g_cells[VECTOR (x) + i] = g_cells[vector_entry (e)];
+  copy_cell (cell_ref (VECTOR (x), i), vector_entry (e));
   return cell_unspecified;
 }
 
@@ -92,12 +93,11 @@ vector_set_x (SCM x, SCM i, SCM e)
 SCM
 list_to_vector (SCM x)
 {
-
   SCM v = make_vector__ (length__ (x));
   SCM p = VECTOR (v);
   while (x != cell_nil)
     {
-      g_cells[p] = g_cells[vector_entry (car (x))];
+      copy_cell (p, vector_entry (car (x)));
       p = p + 1;
       x = cdr (x);
     }
@@ -111,7 +111,7 @@ vector_to_list (SCM v)
   long i;
   for (i = LENGTH (v); i; i = i - 1)
     {
-      SCM e = VECTOR (v) + i - 1;
+      SCM e = cell_ref (VECTOR (v), i - 1);
       if (TYPE (e) == TREF)
         e = REF (e);
       x = cons (e, x);