*CDR_PTR -> [0]

include/mes/macros.h

@@ -130,23 +130,23 @@
 
 #endif
 
-#define TYPE_PTR(x) &(TYPE (x))
+#define TYPE_PTR(x) (&(TYPE (x)))
-#define CAR_PTR(x) &(CAR (x))
+#define CAR_PTR(x) (&(CAR (x)))
-#define CDR_PTR(x) &(CDR (x))
+#define CDR_PTR(x) (&(CDR (x)))
 
-#define CONTINUATION_PTR(x) &(CONTINUATION (x))
+#define CONTINUATION_PTR(x) (&(CONTINUATION (x)))
-#define LENGTH_PTR(x) &(LENGTH (x))
+#define LENGTH_PTR(x) (&(LENGTH (x)))
-#define STRING_PTR(x) &(STRING (x))
+#define STRING_PTR(x) (&(STRING (x)))
-#define VALUE_PTR(x) &(VALUE (x))
+#define VALUE_PTR(x) (&(VALUE (x)))
-#define VECTOR_PTR(x) &(VECTOR (x))
+#define VECTOR_PTR(x) (&(VECTOR (x)))
 
-#define NTYPE_PTR(x) &(NTYPE (x))
+#define NTYPE_PTR(x) (&(NTYPE (x)))
-#define NCAR_PTR(x) &(NCAR (x))
+#define NCAR_PTR(x) (&(NCAR (x)))
-#define NCDR_PTR(x) &(NCDR (x))
+#define NCDR_PTR(x) (&(NCDR (x)))
 
-#define NLENGTH_PTR(x) &(NLENGTH (x))
+#define NLENGTH_PTR(x) (&(NLENGTH (x)))
-#define NVALUE_PTR(x) &(NVALUE (x))
+#define NVALUE_PTR(x) (&(NVALUE (x)))
-#define NVECTOR_PTR(x) &(NVECTOR (x))
+#define NVECTOR_PTR(x) (&(NVECTOR (x)))
 
 #define CAAR(x) CAR (CAR (x))
 #define CADR(x) CAR (CDR (x))

simple.make

@@ -57,6 +57,7 @@ MES_SOURCES =					\
  src/gc.c					\
  src/hash.c					\
  src/lib.c					\
+ src/m2.c					\
  src/math.c					\
  src/mes.c					\
  src/module.c					\
@@ -187,6 +188,7 @@ M2_PLANET_SOURCES =				\
 	| $(CC) -E -I include				\
 	    -D POINTER_CELLS=0				\
 	    -D __M2_PLANET__=1				\
+	    -D M2_FUNCTIONS=1				\
 	    -D 'MES_VERSION="git"'			\
 	    -D 'MES_PKGDATADIR="/usr/local/share/mes"'	\
 	    -D FUNCTION0=FUNCTION			\
@@ -213,6 +215,7 @@ M2_PLANET_SOURCES =				\
 	| $(CC) -E -I include				\
 	    -D POINTER_CELLS=0				\
 	    -D __M2_PLANET__=1				\
+	    -D M2_FUNCTIONS=1				\
 	    -D 'MES_VERSION="git"'			\
 	    -D 'MES_PKGDATADIR="/usr/local/share/mes"'	\
 	    -D FUNCTION0=FUNCTION			\

src/eval-apply.c

@@ -107,7 +107,7 @@ set_car_x (SCM x, SCM e)
 {
   if (TYPE (x) != TPAIR)
     error (cell_symbol_not_a_pair, cons (x, cstring_to_symbol ("set-car!")));
-  *CAR_PTR (x) = e;
+  CAR_PTR (x)[0] = e;
   return cell_unspecified;
 }
 
@@ -116,7 +116,7 @@ set_cdr_x (SCM x, SCM e)
 {
   if (TYPE (x) != TPAIR)
     error (cell_symbol_not_a_pair, cons (x, cstring_to_symbol ("set-cdr!")));
-  *CDR_PTR (x) = e;
+  CDR_PTR (x)[0] = e;
   return cell_unspecified;
 }
 
@@ -754,7 +754,7 @@ macro_expand:
       push_cc (CDDR (R1), R1, R0, cell_vm_macro_expand_lambda);
       goto macro_expand;
     macro_expand_lambda:
-      *CDR_PTR (CDR (R2)) = R1;
+      CDR_PTR (CDR (R2))[0] = R1;
       R1 = R2;
       goto vm_return;
     }
@@ -775,7 +775,7 @@ macro_expand:
       push_cc (CDDR (R1), R1, R0, cell_vm_macro_expand_define);
       goto macro_expand;
     macro_expand_define:
-      *CDR_PTR (CDR (R2)) = R1;
+      CDR_PTR (CDR (R2))[0] = R1;
       R1 = R2;
       if (CAR (R1) == cell_symbol_define_macro)
         {
@@ -792,7 +792,7 @@ macro_expand:
       push_cc (CDDR (R1), R1, R0, cell_vm_macro_expand_set_x);
       goto macro_expand;
     macro_expand_set_x:
-      *CDR_PTR (CDR (R2)) = R1;
+      CDR_PTR (CDR (R2))[0] = R1;
       R1 = R2;
       goto vm_return;
     }
@@ -828,7 +828,7 @@ macro_expand:
   goto macro_expand;
 
 macro_expand_car:
-  *CAR_PTR (R2) = R1;
+  CAR_PTR (R2)[0] = R1;
   R1 = R2;
   if (CDR (R1) == cell_nil)
     goto vm_return;
@@ -837,7 +837,7 @@ macro_expand_car:
   goto macro_expand;
 
 macro_expand_cdr:
-  *CDR_PTR (R2) = R1;
+  CDR_PTR (R2)[0] = R1;
   R1 = R2;
 
   goto vm_return;
@@ -855,7 +855,7 @@ begin:
               push_cc (program, R1, R0, cell_vm_begin_primitive_load);
               goto begin_expand;
             begin_primitive_load:
-              *CAR_PTR (R2) = R1;
+              CAR_PTR (R2)[0] = R1;
               R1 = R2;
             }
         }
@@ -924,7 +924,7 @@ begin_expand:
               R1 = x;
               set_current_input_port (input);
               R1 = cons (cell_symbol_begin, R1);
-              *CAR_PTR (R2) = R1;
+              CAR_PTR (R2)[0] = R1;
               R1 = R2;
               goto begin_expand_while;
               continue; /* FIXME: M2-PLanet */
@@ -936,7 +936,7 @@ begin_expand:
     begin_expand_macro:
       if (R1 != CAR (R2))
         {
-          *CAR_PTR (R2) = R1;
+          CAR_PTR (R2)[0] = R1;
           R1 = R2;
           goto begin_expand_while;
           continue; /* FIXME: M2-PLanet */
@@ -978,7 +978,7 @@ call_with_current_continuation:
   v = make_vector__ (STACK_SIZE - g_stack);
   for (i = g_stack; i < STACK_SIZE; i = i + 1)
     vector_set_x_ (v, i - g_stack, g_stack_array[i]);
-  *CONTINUATION_PTR (x) = v;
+  CONTINUATION_PTR (x)[0] = v;
   gc_pop_frame ();
   push_cc (cons (CAR (R1), cons (x, cell_nil)), x, R0, cell_vm_call_with_current_continuation2);
   goto apply;
@@ -986,7 +986,7 @@ call_with_current_continuation2:
   v = make_vector__ (STACK_SIZE - g_stack);
   for (i = g_stack; i < STACK_SIZE; i = i + 1)
     vector_set_x_ (v, i - g_stack, g_stack_array[i]);
-  *CONTINUATION_PTR (R2) = v;
+  CONTINUATION_PTR (R2)[0] = v;
   goto vm_return;
 
 call_with_values:

src/gc.c

@@ -64,14 +64,7 @@ struct scm *g_news;
 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_PTR (x);
-#endif
 }
 
 char *
@@ -131,12 +124,20 @@ gc_init ()                      /*:((internal)) */
   /* The vector that holds the arenea. */
   cell_arena = 0;
 #endif
-  *TYPE_PTR (cell_arena) = TVECTOR;
+
-  *LENGTH_PTR (cell_arena) = 1000;
+  eputs ("00\n");
-  *VECTOR_PTR (cell_arena) = 0;
+  TYPE_PTR (cell_arena)[0] = TVECTOR;
+  eputs ("01\n");
+  LENGTH_PTR (cell_arena)[0] = 1000;
+  eputs ("02\n");
+  VECTOR_PTR (cell_arena)[0] = 0;
+  eputs ("03\n");
+
   g_cells = g_cells + M2_CELL_SIZE;
-  *TYPE_PTR (cell_arena) = TCHAR;
+  TYPE_PTR (cell_arena)[0] = TCHAR;
-  *VALUE_PTR (cell_arena) = 'c';
+  eputs ("06\n");
+  VALUE_PTR (cell_arena)[0] = 'c';
+  eputs ("07\n");
 
   // FIXME: remove MES_MAX_STRING, grow dynamically
   g_buf = malloc (MAX_STRING);
@@ -195,26 +196,26 @@ make_cell (long type, SCM car, SCM cdr)
 #endif
   if (i > ARENA_SIZE)
     assert_msg (0, "alloc: out of memory");
-  *TYPE_PTR (x) = type;
+  TYPE_PTR (x)[0] = type;
-  *CAR_PTR (x) = car;
+  CAR_PTR (x)[0] = car;
-  *CDR_PTR (x) = cdr;
+  CDR_PTR (x)[0] = cdr;
   return x;
 }
 
 void
 copy_cell (SCM to, SCM from)
 {
-  *TYPE_PTR (to) = TYPE (from);
+  TYPE_PTR (to)[0] = TYPE (from);
-  *CAR_PTR (to) = CAR (from);
+  CAR_PTR (to)[0] = CAR (from);
-  *CDR_PTR (to) = CDR (from);
+  CDR_PTR (to)[0] = CDR (from);
 }
 
 void
 copy_news (SCM to, SCM from)
 {
-  *NTYPE_PTR (to) = TYPE (from);
+  NTYPE_PTR (to)[0] = TYPE (from);
-  *NCAR_PTR (to) = CAR (from);
+  NCAR_PTR (to)[0] = CAR (from);
-  *NCDR_PTR (to) = CDR (from);
+  NCDR_PTR (to)[0] = CDR (from);
 }
 
 void
@@ -246,8 +247,8 @@ make_bytes (char const *s, size_t length)
 {
   size_t size = bytes_cells (length);
   SCM x = alloc (size);
-  *TYPE_PTR (x) = TBYTES;
+  TYPE_PTR (x)[0] = TBYTES;
-  *LENGTH_PTR (x) = length;
+  LENGTH_PTR (x)[0] = length;
   char *p = cell_bytes (x);
   if (length == 0)
     p[0] = 0;
@@ -294,7 +295,7 @@ make_string (char const *s, size_t length)
     assert_max_string (length, "make_string", s);
   SCM x = make_cell (TSTRING, length, 0);
   SCM v = make_bytes (s, length);
-  *CDR_PTR (x) = v;
+  CDR_PTR (x)[0] = v;
   return x;
 }
 
@@ -317,12 +318,12 @@ gc_init_news ()                 /*:((internal)) */
   g_news = g_free;
 #else
   g_news = g_cells + g_free;
-  *NTYPE_PTR (cell_arena) = TVECTOR;
+  NTYPE_PTR (cell_arena)[0] = TVECTOR;
-  *NLENGTH_PTR (cell_arena) = 1000;
+  NLENGTH_PTR (cell_arena)[0] = 1000;
-  *NVECTOR_PTR (cell_arena) = 0;
+  NVECTOR_PTR (cell_arena)[0] = 0;
   g_news = g_news + 1;
-  *NTYPE_PTR (cell_arena) = TCHAR;
+  NTYPE_PTR (cell_arena)[0] = TCHAR;
-  *NVALUE_PTR (cell_arena) = 'n';
+  NVALUE_PTR (cell_arena)[0] = 'n';
 #endif
   return 0;
 }
@@ -392,7 +393,7 @@ gc_copy (SCM old)               /*:((internal)) */
   copy_news (new, old);
   if (NTYPE (new) == TSTRUCT || NTYPE (new) == TVECTOR)
     {
-      *NVECTOR_PTR (new) = g_free;
+      NVECTOR_PTR (new)[0] = g_free;
       long i;
       for (i = 0; i < LENGTH (old); i = i + 1)
         {
@@ -428,22 +429,22 @@ gc_copy (SCM old)               /*:((internal)) */
           eputs ("\n");
         }
     }
-  *TYPE_PTR (old) = TBROKEN_HEART;
+  TYPE_PTR (old)[0] = TBROKEN_HEART;
-  *CAR_PTR (old) = new;
+  CAR_PTR (old)[0] = new;
   return new;
 }
 
 SCM
 gc_relocate_car (SCM new, SCM car)      /*:((internal)) */
 {
-  *NCAR_PTR (new) = car;
+  NCAR_PTR (new)[0] = car;
   return cell_unspecified;
 }
 
 SCM
 gc_relocate_cdr (SCM new, SCM cdr)      /*:((internal)) */
 {
-  *NCDR_PTR (new) = cdr;
+  NCDR_PTR (new)[0] = cdr;
   return cell_unspecified;
 }
 

src/m2.c

@@ -21,6 +21,14 @@
 //#include "mes/mes.h"
 #include "mes/m2.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 M2_FUNCTIONS
 
 SCM
@@ -33,8 +41,8 @@ TYPE (SCM x)
 SCM *
 TYPE_PTR (SCM x)
 {
-  struct scm *s = &g_cells[x];
+  char *p = g_cells + (x * M2_CELL_SIZE);
-  return &s->type;
+  return p;
 }
 
 SCM
@@ -47,8 +55,8 @@ CAR (SCM x)
 SCM *
 CAR_PTR (SCM x)
 {
-  struct scm *s = &g_cells[x];
+  char *p = g_cells + (x * M2_CELL_SIZE);
-  return &s->car;
+  return p + sizeof (long);
 }
 
 SCM
@@ -61,8 +69,8 @@ CDR (SCM x)
 SCM *
 CDR_PTR (SCM x)
 {
-  struct scm *s = &g_cells[x];
+  char *p = g_cells + (x * M2_CELL_SIZE);
-  return &s->cdr;
+  return p + sizeof (long) + sizeof (long);
 }
 
 SCM
@@ -75,8 +83,8 @@ NTYPE (SCM x)
 SCM *
 NTYPE_PTR (SCM x)
 {
-  struct scm *s = &g_news[x];
+  char *p = g_news + (x * M2_CELL_SIZE);
-  return &s->type;
+  return p;
 }
 
 SCM
@@ -89,8 +97,8 @@ NCAR (SCM x)
 SCM *
 NCAR_PTR (SCM x)
 {
-  struct scm *s = &g_news[x];
+  char *p = g_news + (x * M2_CELL_SIZE);
-  return &s->car;
+  return p + sizeof (long);
 }
 
 SCM
@@ -103,8 +111,8 @@ NCDR (SCM x)
 SCM *
 NCDR_PTR (SCM x)
 {
-  struct scm *s = &g_news[x];
+  char *p = g_news + (x * M2_CELL_SIZE);
-  return &s->cdr;
+  return p + sizeof (long) + sizeof (long);
 }
 
 SCM
@@ -124,8 +132,8 @@ LENGTH (SCM x)
 SCM *
 LENGTH_PTR (SCM x)
 {
-  struct scm *s = &g_cells[x];
+  char *p = g_cells + (x * M2_CELL_SIZE);
-  return &s->car;
+  return p + sizeof (long);
 }
 
 SCM
@@ -159,8 +167,8 @@ CONTINUATION (SCM x)
 SCM *
 CONTINUATION_PTR (SCM x)
 {
-  struct scm *s = &g_cells[x];
+  char *p = g_cells + (x * M2_CELL_SIZE);
-  return &s->cdr;
+  return p  + sizeof (long) + sizeof (long);
 }
 
 SCM
@@ -194,8 +202,8 @@ STRING (SCM x)
 SCM *
 STRING_PTR (SCM x)
 {
-  struct scm *s = &g_cells[x];
+  char *p = g_cells + (x * M2_CELL_SIZE);
-  return &s->cdr;
+  return p  + sizeof (long) + sizeof (long);
 }
 
 SCM
@@ -215,8 +223,8 @@ VALUE (SCM x)
 SCM *
 VALUE_PTR (SCM x)
 {
-  struct scm *s = &g_cells[x];
+  char *p = g_cells + (x * M2_CELL_SIZE);
-  return &s->cdr;
+  return p  + sizeof (long) + sizeof (long);
 }
 
 SCM
@@ -229,8 +237,8 @@ VECTOR (SCM x)
 SCM *
 VECTOR_PTR (SCM x)
 {
-  struct scm *s = &g_cells[x];
+  char *p = g_cells + (x * M2_CELL_SIZE);
-  return &s->cdr;
+  return p  + sizeof (long) + sizeof (long);
 }
 
 SCM
@@ -243,43 +251,42 @@ NLENGTH (SCM x)
 SCM *
 NLENGTH_PTR (SCM x)
 {
-  struct scm *s = &g_news[x];
+  char *p = g_cells + (x * M2_CELL_SIZE);
-  return &s->car;
+  return p  + sizeof (long);
 }
 
 SCM
 NVALUE (SCM x)
 {
-  struct scm *s = &g_news[x];
+  return (x * M2_CELL_SIZE) + g_news + sizeof (long) + sizeof (long);
-  return s->cdr;
 }
 
 SCM *
 NVALUE_PTR (SCM x)
 {
-  struct scm *s = &g_news[x];
+  char *p = g_news + (x * M2_CELL_SIZE);
-  return &s->cdr;
+  return p + sizeof (long) + sizeof (long);
 }
 
 SCM
 NSTRING (SCM x)
 {
-  struct scm *s = &g_news[x];
+  char *p = g_news + (x * M2_CELL_SIZE);
-  return s->cdr;
+  return p + sizeof (long) + sizeof (long);
 }
 
 SCM
 NVECTOR (SCM x)
 {
-  struct scm *s = &g_news[x];
+  char *p = g_news + (x * M2_CELL_SIZE);
-  return s->cdr;
+  return p + sizeof (long) + sizeof (long);
 }
 
 SCM *
 NVECTOR_PTR (SCM x)
 {
-  struct scm *s = &g_news[x];
+  char *p = g_news + (x * M2_CELL_SIZE);
-  return &s->cdr;
+  return p + sizeof (long) + sizeof (long);
 }
 
 SCM

src/mes.c

@@ -149,7 +149,7 @@ SCM
 values (SCM x)                  /*:((arity . n)) */
 {
   SCM v = cons (0, x);
-  *TYPE_PTR (v) = TVALUES;
+  TYPE_PTR (v)[0] = TVALUES;
   return v;
 }
 
@@ -235,7 +235,7 @@ reverse_x_ (SCM x, SCM t)
   while (x != cell_nil)
     {
       t = CDR (x);
-      *CDR_PTR (x) = r;
+      CDR_PTR (x)[0] = r;
       r = x;
       x = t;
     }

src/posix.c

@@ -62,7 +62,7 @@ readchar ()
   char const *p = cell_bytes (STRING (string));
   int c = p[0];
   p = p + 1;
-  *STRING_PTR (port) = make_string (p, length - 1);
+  STRING_PTR (port)[0] = make_string (p, length - 1);
   return c;
 }
 
@@ -79,7 +79,7 @@ unreadchar (int c)
   string = make_string (p, length + 1);
   p = cell_bytes (STRING (string));
   p[0] = c;
-  *STRING_PTR (port) = string;
+  STRING_PTR (port)[0] = string;
   return c;
 }
 

src/symbols.c

@@ -40,15 +40,15 @@ long g_symbol;
 SCM
 init_symbol (SCM x, long type, char const *name)
 {
-  *TYPE_PTR (x) = type;
+  TYPE_PTR (x)[0] = type;
   if (g_symbols == 0)
     g_free = g_free + M2_CELL_SIZE;
   else
     {
       int length = strlen (name);
       SCM string = make_string (name, length);
-      *CAR_PTR (x) = length;
+      CAR_PTR (x)[0] = length;
-      *CDR_PTR (x) = STRING (string);
+      CDR_PTR (x)[0] = STRING (string);
       hash_set_x (g_symbols, string, x);
     }
   g_symbol = g_symbol + M2_CELL_SIZE;