core: Number based cells.

* mes.c (scm_t): Change car, string, ref, cdr, macro, vector into g_cell index
  [WAS]: scm_t pointer.
* define.c: Update.
* lib.c: Update.
* math.c: Update.
* posix.c: Update.
* quasiquote.c: Update.
* string.c: Update.
* type.c: Update.
* build-aux/mes-snarf.mes Update.
* tests/gc-4.test: New test.
* tests/gc-5.test: New test.
* tests/gc-6.test: New test.

.gitignore

@@ -1,8 +1,9 @@
 *-
 *.cat
 *.environment.h
-*.environment.i
 *.go
+*.h
+*.i
 *.o
 *.symbols.i
 *~

GNUmakefile

@@ -23,14 +23,14 @@ include make/install.make
 all: mes
 
 mes.o: mes.c
-mes.o: mes.c mes.environment.h mes.environment.i mes.symbols.i
+mes.o: mes.c mes.h mes.i mes.environment.i mes.symbols.i
-mes.o: define.c define.environment.h define.environment.i
+mes.o: define.c define.h define.i define.environment.i
-mes.o: lib.c lib.environment.h lib.environment.i
+mes.o: lib.c lib.h lib.i lib.environment.i
-mes.o: math.c math.environment.h math.environment.i
+mes.o: math.c math.h math.i math.environment.i
-mes.o: posix.c posix.environment.h posix.environment.i
+mes.o: posix.c posix.h posix.i posix.environment.i
-mes.o: quasiquote.c quasiquote.environment.h quasiquote.environment.i
+mes.o: quasiquote.c quasiquote.h quasiquote.i quasiquote.environment.i
-mes.o: string.c string.environment.h string.environment.i
+mes.o: string.c string.h string.i string.environment.i
-mes.o: type.c type.environment.h type.environment.i
+mes.o: type.c type.h type.i type.environment.i
 
 clean:
 	rm -f mes mes.o *.environment.i *.symbols.i *.environment.h *.cat a.out
@@ -38,7 +38,7 @@ clean:
 distclean: clean
 	rm -f .config.make
 
-%.environment.h %.environment.i %.symbols.i: %.c build-aux/mes-snarf.scm
+%.h %.i %.environment.i %.symbols.i: %.c build-aux/mes-snarf.scm
 	build-aux/mes-snarf.scm $<
 
 check: all guile-check mes-check

build-aux/mes-snarf.scm

@@ -62,33 +62,50 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
         (regexp-replace "_p$" "?"))
        (.name f))))
 
+(define %builtin-prefix% "scm_")
 (define (function-builtin-name f)
   (string-append %builtin-prefix% (.name f)))
 
-(define (function->source f)
+(define %cell-prefix% "cell_")
-  (format #f "a = add_environment (a, ~S, &~a);\n" (function-scm-name f) (function-builtin-name f)))
+(define (function-cell-name f)
+  (string-append %cell-prefix% (.name f)))
 
-(define (symbol->source s)
+(define (function->source f i)
-  (format #f "symbols = cons (&~a, symbols);\n" s))
+  (string-append
+   (format #f "cell_~a = g_free.value++;\n" (.name f))
+   (format #f "g_cells[cell_~a] = ~a;\n" (.name f) (function-builtin-name f))))
 
-(define %builtin-prefix% "scm_")
+(define (function->environment f i)
-(define (function->header f)
+  (string-append
+   (format #f "a = add_environment (a, ~S, ~a);\n" (function-scm-name f) (function-cell-name f))))
+
+(define %start 1)
+(define (symbol->header s i)
+  (format #f "SCM cell_~a;\n" s))
+
+(define (symbol->source s i)
+  (string-append
+   (format #f "cell_~a = g_free.value++;\n" s)
+   (format #f "g_cells[cell_~a] = scm_~a;\n" s s)))
+
+(define (function->header f i)
   (let* ((arity (or (assoc-ref (.annotation f) 'arity)
                     (if (string-null? (.formals f)) 0
                         (length (string-split (.formals f) #\,)))))
          (n (if (eq? arity 'n) -1 arity)))
-    (string-append (format #f "scm *~a (~a);\n" (.name f) (.formals f))
+    (string-append (format #f "SCM ~a (~a);\n" (.name f) (.formals f))
                    (format #f "function fun_~a = {.function~a=&~a, .arity=~a};\n" (.name f) arity (.name f) n)
-                   (format #f "scm ~a = {FUNCTION, .name=~S, .function=&fun_~a};\n" (function-builtin-name f) (function-scm-name f) (.name f)))))
+                   (format #f "scm ~a = {FUNCTION, .name=~S, .function=&fun_~a};\n" (function-builtin-name f) (function-scm-name f) (.name f))
+                   (format #f "SCM cell_~a = ~a;\n" (.name f) i))))
 
 (define (snarf-symbols string)
-  (let* ((matches (append (list-matches "\nscm ([a-z_0-9]+) = [{](SCM)," string)
+  (let* ((matches (append (list-matches "\nscm scm_([a-z_0-9]+) = [{](SPECIAL)," string)
-                          (list-matches "\nscm ([a-z_0-9]+) = [{](SYMBOL)," string))))
+                          (list-matches "\nscm scm_([a-z_0-9]+) = [{](SYMBOL)," string))))
     (map (cut match:substring <> 1) matches)))
 
 (define (snarf-functions string)
   (let* ((matches (list-matches
-                   "\nscm [*]\n?([a-z0-9_]+) [(]((scm *[^,)]+|, )*)[)][^\n(]*([^\n]*)"
+                   "\nSCM[ \n]?([a-z0-9_]+) [(]((SCM ?[^,)]+|, )*)[)][^\n(]*([^\n]*)"
                    string)))
     (map (lambda (m)
            (make <function>
@@ -115,15 +132,21 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
          (symbols (snarf-symbols string))
          (base-name (basename file-name ".c"))
          (header (make <file>
-                   #:name (string-append base-name ".environment.h")
+                   #:name (string-append base-name ".h")
-                   #:content (string-join (map function->header functions) "")))
+                   #:content (string-join (map function->header functions (iota (length functions) (+ %start (length symbols)))) "")))
+         (source (make <file>
+                        #:name (string-append base-name ".i")
+                        #:content (string-join (map function->source (filter (negate no-environment?) functions) (iota (length functions) (+ (length symbols) %start))) "")))
          (environment (make <file>
                         #:name (string-append base-name ".environment.i")
-                        #:content (string-join (map function->source (filter (negate no-environment?) functions)) "")))
+                        #:content (string-join (map function->environment (filter (negate no-environment?) functions) (iota (length functions) (+ (length symbols) %start))) "")))
-         (symbols (make <file>
+         (symbols.h (make <file>
-                    #:name (string-append base-name ".symbols.i")
+                      #:name (string-append base-name ".symbols.h")
-                    #:content (string-join (map symbol->source symbols) ""))))
+                      #:content (string-join (map symbol->header symbols (iota (length symbols) %start)) "")))
-    (list header environment symbols)))
+         (symbols.i (make <file>
+                      #:name (string-append base-name ".symbols.i")
+                      #:content (string-join (map symbol->source symbols (iota (length symbols))) ""))))
+    (list header source environment symbols.h symbols.i)))
 
 (define (file-write file)
   (with-output-to-file (.name file) (lambda () (display (.content file)))))

define.c

@@ -19,42 +19,42 @@
  */
 
 #if !BOOT
-scm *
+SCM
-define_env (scm *e, scm *a)
+define_env (SCM e, SCM a)
 {
-  return vm_call (vm_define_env, e, &scm_undefined, a);
+  return vm_call (vm_define_env, e, cell_undefined, a);
 }
 
-scm *
+SCM
 vm_define_env ()
 {
-  scm *x;
+  SCM x;
-  scm *name = cadr (r1);
+  SCM name = cadr (r1);
-  if (name->type != PAIR)
+  if (type (name) != PAIR)
     x = eval_env (caddr (r1), cons (cons (cadr (r1), cadr (r1)), r0));
   else {
     name = car (name);
-    scm *p = pairlis (cadr (r1), cadr (r1), r0);
+    SCM p = pairlis (cadr (r1), cadr (r1), r0);
     cache_invalidate_range (p, r0);
     x = eval_env (make_lambda (cdadr (r1), cddr (r1)), p);
   }
-  if (eq_p (car (r1), &symbol_define_macro) == &scm_t)
+  if (eq_p (car (r1), cell_symbol_define_macro) == cell_t)
     x = make_macro (name, x);
-  
+
-  scm *entry = cons (name, x);
+  SCM entry = cons (name, x);
-  scm *aa = cons (entry, &scm_nil);
+  SCM aa = cons (entry, cell_nil);
   set_cdr_x (aa, cdr (r0));
   set_cdr_x (r0, aa);
-  scm *cl = assq (&scm_closure, r0);
+  SCM cl = assq (cell_closure, r0);
   set_cdr_x (cl, aa);
   return entry;
 }
 #else // BOOT
-scm*define_env (scm *r1, scm *a){}
+SCM define_env (SCM r1, SCM a){}
-scm*vm_define_env (scm *r1, scm *a){}
+SCM vm_define_env (SCM r1, SCM a){}
 #endif
 
-scm *
+SCM
-define_macro (scm *r1, scm *a)
+define_macro (SCM r1, SCM a)
 {
 }

lib.c

@@ -18,24 +18,24 @@
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
-scm *caar (scm *x) {return car (car (x));}
+SCM caar (SCM x) {return car (car (x));}
-scm *cadr (scm *x) {return car (cdr (x));}
+SCM cadr (SCM x) {return car (cdr (x));}
-scm *cdar (scm *x) {return cdr (car (x));}
+SCM cdar (SCM x) {return cdr (car (x));}
-scm *cddr (scm *x) {return cdr (cdr (x));}
+SCM cddr (SCM x) {return cdr (cdr (x));}
-scm *caaar (scm *x) {return car (car (car (x)));}
+SCM caaar (SCM x) {return car (car (car (x)));}
-scm *caadr (scm *x) {return car (car (cdr (x)));}
+SCM caadr (SCM x) {return car (car (cdr (x)));}
-scm *caddr (scm *x) {return car (cdr (cdr (x)));}
+SCM caddr (SCM x) {return car (cdr (cdr (x)));}
-scm *cdadr (scm *x) {return cdr (car (cdr (x)));}
+SCM cdadr (SCM x) {return cdr (car (cdr (x)));}
-scm *cadar (scm *x) {return car (cdr (car (x)));}
+SCM cadar (SCM x) {return car (cdr (car (x)));}
-scm *cddar (scm *x) {return cdr (cdr (car (x)));}
+SCM cddar (SCM x) {return cdr (cdr (car (x)));}
-scm *cdddr (scm *x) {return cdr (cdr (cdr (x)));}
+SCM cdddr (SCM x) {return cdr (cdr (cdr (x)));}
-scm *cadddr (scm *x) {return car (cdr (cdr (cdr (x))));}
+SCM cadddr (SCM x) {return car (cdr (cdr (cdr (x))));}
 
-scm *
+SCM
-length (scm *x)
+length (SCM x)
 {
   int n = 0;
-  while (x != &scm_nil)
+  while (x != cell_nil)
     {
       n++;
       x = cdr (x);
@@ -43,59 +43,59 @@ length (scm *x)
   return make_number (n);
 }
 
-scm *
+SCM
-last_pair (scm *x)
+last_pair (SCM x)
 {
-  while (x != &scm_nil && cdr (x) != &scm_nil)
+  while (x != cell_nil && cdr (x) != cell_nil)
     x = cdr (x);
   return x;
 }
 
-scm *
+SCM
-list (scm *x) ///((arity . n))
+list (SCM x) ///((arity . n))
 {
   return x;
 }
 
-scm *
+SCM
-list_ref (scm *x, scm *k)
+list_ref (SCM x, SCM k)
 {
-  assert (x->type == PAIR);
+  assert (type (x) == PAIR);
-  assert (k->type == NUMBER);
+  assert (type (k) == NUMBER);
-  int n = k->value;
+  int n = value (k);
-  while (n-- && x->cdr != &scm_nil) x = x->cdr;
+  while (n-- && g_cells[x].cdr != cell_nil) x = g_cells[x].cdr;
-  return x != &scm_nil ? x->car : &scm_undefined;
+  return x != cell_nil ? car (x) : cell_undefined;
 }
 
-scm *
+SCM
-vector_to_list (scm *v)
+vector_to_list (SCM v)
 {
-  scm *x = &scm_nil;
+  SCM x = cell_nil;
-  for (int i = 0; i < v->length; i++) {
+  for (int i = 0; i < LENGTH (v); i++) {
-    scm *e = &v->vector[i];
+    SCM e = VECTOR (v)+i;
-    if (e->type == REF) e = e->ref;
+    if (type (e) == REF) e = g_cells[e].ref;
-    x = append2 (x, cons (e, &scm_nil));
+    x = append2 (x, cons (e, cell_nil));
   }
   return x;
 }
 
-scm *
+SCM
-integer_to_char (scm *x)
+integer_to_char (SCM x)
 {
-  assert (x->type == NUMBER);
+  assert (type (x) == NUMBER);
-  return make_char (x->value);
+  return make_char (value (x));
 }
 
-scm *
+SCM
-char_to_integer (scm *x)
+char_to_integer (SCM x)
 {
-  assert (x->type == CHAR);
+  assert (type (x) == CHAR);
-  return make_number (x->value);
+  return make_number (value (x));
 }
 
-scm *
+SCM
-builtin_exit (scm *x)
+builtin_exit (SCM x)
 {
-  assert (x->type == NUMBER);
+  assert (type (x) == NUMBER);
-  exit (x->value);
+  exit (value (x));
 }

math.c

@@ -18,127 +18,127 @@
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
-scm *
+SCM
-greater_p (scm *x) ///((name . ">") (arity . n))
+greater_p (SCM x) ///((name . ">") (arity . n))
 {
   int n = INT_MAX;
-  while (x != &scm_nil)
+  while (x != cell_nil)
     {
-      assert (x->car->type == NUMBER);
+      assert (g_cells[car (x)].type == NUMBER);
-      if (x->car->value >= n) return &scm_f;
+      if (value (car (x)) >= n) return cell_f;
-      n = x->car->value;
+      n = value (car (x));
       x = cdr (x);
     }
-  return &scm_t;
+  return cell_t;
 }
 
-scm *
+SCM
-less_p (scm *x) ///((name . "<") (arity . n))
+less_p (SCM x) ///((name . "<") (arity . n))
 {
   int n = INT_MIN;
-  while (x != &scm_nil)
+  while (x != cell_nil)
     {
-      assert (x->car->type == NUMBER);
+      assert (g_cells[car (x)].type == NUMBER);
-      if (x->car->value <= n) return &scm_f;
+      if (value (car (x)) <= n) return cell_f;
-      n = x->car->value;
+      n = value (car (x));
       x = cdr (x);
     }
-  return &scm_t;
+  return cell_t;
 }
 
-scm *
+SCM
-is_p (scm *x) ///((name . "=") (arity . n))
+is_p (SCM x) ///((name . "=") (arity . n))
 {
-  if (x == &scm_nil) return &scm_t;
+  if (x == cell_nil) return cell_t;
-  assert (x->car->type == NUMBER);
+  assert (g_cells[car (x)].type == NUMBER);
-  int n = x->car->value;
+  int n = value (car (x));
   x = cdr (x);
-  while (x != &scm_nil)
+  while (x != cell_nil)
     {
-      if (x->car->value != n) return &scm_f;
+      if (value (car (x)) != n) return cell_f;
       x = cdr (x);
     }
-  return &scm_t;
+  return cell_t;
 }
 
-scm *
+SCM
-minus (scm *x) ///((name . "-") (arity . n))
+minus (SCM x) ///((name . "-") (arity . n))
 {
-  scm *a = car (x);
+  SCM a = car (x);
-  assert (a->type == NUMBER);
+  assert (g_cells[a].type == NUMBER);
-  int n = a->value;
+  int n = value (a);
   x = cdr (x);
-  if (x == &scm_nil)
+  if (x == cell_nil)
     n = -n;
-  while (x != &scm_nil)
+  while (x != cell_nil)
     {
-      assert (x->car->type == NUMBER);
+      assert (g_cells[car (x)].type == NUMBER);
-      n -= x->car->value;
+      n -= value (car (x));
       x = cdr (x);
     }
   return make_number (n);
 }
 
-scm *
+SCM
-plus (scm *x) ///((name . "+") (arity . n))
+plus (SCM x) ///((name . "+") (arity . n))
 {
   int n = 0;
-  while (x != &scm_nil)
+  while (x != cell_nil)
     {
-      assert (x->car->type == NUMBER);
+      assert (g_cells[car (x)].type == NUMBER);
-      n += x->car->value;
+      n += value (car (x));
       x = cdr (x);
     }
   return make_number (n);
 }
 
-scm *
+SCM
-divide (scm *x) ///((name . "/") (arity . n))
+divide (SCM x) ///((name . "/") (arity . n))
 {
   int n = 1;
-  if (x != &scm_nil) {
+  if (x != cell_nil) {
-    assert (x->car->type == NUMBER);
+    assert (g_cells[car (x)].type == NUMBER);
-    n = x->car->value;
+    n = value (car (x));
     x = cdr (x);
   }
-  while (x != &scm_nil)
+  while (x != cell_nil)
     {
-      assert (x->car->type == NUMBER);
+      assert (g_cells[car (x)].type == NUMBER);
-      n /= x->car->value;
+      n /= value (car (x));
       x = cdr (x);
     }
   return make_number (n);
 }
 
-scm *
+SCM
-modulo (scm *a, scm *b)
+modulo (SCM a, SCM b)
 {
-  assert (a->type == NUMBER);
+  assert (g_cells[a].type == NUMBER);
-  assert (b->type == NUMBER);
+  assert (g_cells[b].type == NUMBER);
-  return make_number (a->value % b->value);
+  return make_number (value (a) % value (b));
 }
 
-scm *
+SCM
-multiply (scm *x) ///((name . "*") (arity . n))
+multiply (SCM x) ///((name . "*") (arity . n))
 {
   int n = 1;
-  while (x != &scm_nil)
+  while (x != cell_nil)
     {
-      assert (x->car->type == NUMBER);
+      assert (g_cells[car (x)].type == NUMBER);
-      n *= x->car->value;
+      n *= value (car (x));
       x = cdr (x);
     }
   return make_number (n);
 }
 
-scm *
+SCM
-logior (scm *x) ///((arity . n))
+logior (SCM x) ///((arity . n))
 {
   int n = 0;
-  while (x != &scm_nil)
+  while (x != cell_nil)
     {
-      assert (x->car->type == NUMBER);
+      assert (g_cells[car (x)].type == NUMBER);
-      n |= x->car->value;
+      n |= value (car (x));
       x = cdr (x);
     }
   return make_number (n);

posix.c

@@ -21,34 +21,34 @@
 #include <fcntl.h>
 
 char const*
-string_to_cstring (scm *s)
+string_to_cstring (SCM s)
 {
   static char buf[1024];
   char *p = buf;
-  s = s->string;
+  s = STRING (s);
-  while (s != &scm_nil)
+  while (s != cell_nil)
     {
-      *p++ = s->car->value;
+      *p++ = value (car (s));
-      s = s->cdr;
+      s = cdr (s);
     }
   *p = 0;
   return buf;
 }
 
-scm *
+SCM
-open_input_file (scm *file_name)
+open_input_file (SCM file_name)
 {
   return make_number (open (string_to_cstring (file_name), O_RDONLY));
 }
 
-scm *
+SCM
 current_input_port ()
 {
   return make_number (fileno (g_stdin));
 }
 
-scm *
+SCM
-set_current_input_port (scm *port)
+set_current_input_port (SCM port)
 {
-  g_stdin = fdopen (port->value, "r");
+  g_stdin = fdopen (value (port), "r");
 }

quasiquote.c

@@ -19,35 +19,35 @@
  */
 
 #if QUASIQUOTE
-scm *add_environment (scm *a, char const *name, scm *x);
+SCM add_environment (SCM a, char const *name, SCM x);
 
-scm *
+SCM
-unquote (scm *x) ///((no-environment))
+unquote (SCM x) ///((no-environment))
 {
-  return cons (&symbol_unquote, x);
+  return cons (cell_symbol_unquote, x);
 }
 
-scm *
+SCM
-unquote_splicing (scm *x) ///((no-environment))
+unquote_splicing (SCM x) ///((no-environment))
 {
-  return cons (&symbol_unquote_splicing, x);
+  return cons (cell_symbol_unquote_splicing, x);
 }
 
-scm *
+SCM
-eval_quasiquote (scm *e, scm *a)
+eval_quasiquote (SCM e, SCM a)
 {
-  return vm_call (vm_eval_quasiquote, e, &scm_undefined, a);
+  return vm_call (vm_eval_quasiquote, e, cell_undefined, a);
 }
 
-scm *
+SCM
 vm_eval_quasiquote ()
 {
-  if (r1 == &scm_nil) return r1;
+  if (r1 == cell_nil) return r1;
-  else if (atom_p (r1) == &scm_t) return r1;
+  else if (atom_p (r1) == cell_t) return r1;
-  else if (eq_p (car (r1), &symbol_unquote) == &scm_t)
+  else if (eq_p (car (r1), cell_symbol_unquote) == cell_t)
     return eval_env (cadr (r1), r0);
-  else if (r1->type == PAIR && r1->car->type == PAIR
+  else if (type (r1) == PAIR && g_cells[car (r1)].type == PAIR
-           && eq_p (caar (r1), &symbol_unquote_splicing) == &scm_t)
+           && eq_p (caar (r1), cell_symbol_unquote_splicing) == cell_t)
     {
       r2 = eval_env (cadar (r1), r0);
       return append2 (r2, eval_quasiquote (cdr (r1), r0));
@@ -56,71 +56,71 @@ vm_eval_quasiquote ()
   return cons (r2, eval_quasiquote (cdr (r1), r0));
 }
 
-scm *
+SCM
-the_unquoters = &scm_nil;
+the_unquoters = 0;
 
-scm *
+SCM
-add_unquoters (scm *a)
+add_unquoters (SCM a)
 {
-  if (the_unquoters == &scm_nil)
+  if (the_unquoters == 0)
-    the_unquoters = cons (cons (&symbol_unquote, &scm_unquote),
+    the_unquoters = cons (cons (cell_symbol_unquote, cell_unquote),
-                          cons (cons (&symbol_unquote_splicing, &scm_unquote_splicing),
+                          cons (cons (cell_symbol_unquote_splicing, cell_unquote_splicing),
-                                &scm_nil));
+                                cell_nil));
   return append2 (the_unquoters, a);
 }
 #else // !QUASIQUOTE
 
-scm*add_unquoters (scm *a){}
+SCM add_unquoters (SCM a){}
-scm*eval_quasiquote (scm *e, scm *a){}
+SCM eval_quasiquote (SCM e, SCM a){}
 
 #endif // QUASIQUOTE
 
 #if QUASISYNTAX
-scm *
+SCM
-syntax (scm *x)
+syntax (SCM x)
 {
-  return cons (&symbol_syntax, x);
+  return cons (cell_symbol_syntax, x);
 }
 
-scm *
+SCM
-unsyntax (scm *x) ///((no-environment))
+unsyntax (SCM x) ///((no-environment))
 {
-  return cons (&symbol_unsyntax, x);
+  return cons (cell_symbol_unsyntax, x);
 }
 
-scm *
+SCM
-unsyntax_splicing (scm *x) ///((no-environment))
+unsyntax_splicing (SCM x) ///((no-environment))
 {
-  return cons (&symbol_unsyntax_splicing, x);
+  return cons (cell_symbol_unsyntax_splicing, x);
 }
 
-scm *
+SCM
-eval_quasisyntax (scm *e, scm *a)
+eval_quasisyntax (SCM e, SCM a)
 {
-  if (e == &scm_nil) return e;
+  if (e == cell_nil) return e;
-  else if (atom_p (e) == &scm_t) return e;
+  else if (atom_p (e) == cell_t) return e;
-  else if (eq_p (car (e), &symbol_unsyntax) == &scm_t)
+  else if (eq_p (car (e), cell_symbol_unsyntax) == cell_t)
     return eval_env (cadr (e), a);
-  else if (e->type == PAIR && e->car->type == PAIR
+  else if (g_cells[e].type == PAIR && g_cells[car (e)].type == PAIR
-           && eq_p (caar (e), &symbol_unsyntax_splicing) == &scm_t)
+           && eq_p (caar (e), cell_symbol_unsyntax_splicing) == cell_t)
       return append2 (eval_env (cadar (e), a), eval_quasisyntax (cdr (e), a));
   return cons (eval_quasisyntax (car (e), a), eval_quasisyntax (cdr (e), a));
 }
 
-scm *
+SCM
-add_unsyntaxers (scm *a)
+add_unsyntaxers (SCM a)
 {
-  a = cons (cons (&symbol_unsyntax, &scm_unsyntax), a);
+  a = cons (cons (cell_symbol_unsyntax, cell_unsyntax), a);
-  a = cons (cons (&symbol_unsyntax_splicing, &scm_unsyntax_splicing), a);
+  a = cons (cons (cell_symbol_unsyntax_splicing, cell_unsyntax_splicing), a);
   return a;
 }
 
 #else // !QUASISYNTAX
-scm*syntax (scm *x){}
+SCM syntax (SCM x){}
-scm*unsyntax (scm *x){}
+SCM unsyntax (SCM x){}
-scm*unsyntax_splicing (scm *x){}
+SCM unsyntax_splicing (SCM x){}
-scm*add_unsyntaxers (scm *a){}
+SCM add_unsyntaxers (SCM a){}
-scm*eval_unsyntax (scm *e, scm *a){}
+SCM eval_unsyntax (SCM e, SCM a){}
-scm*eval_quasisyntax (scm *e, scm *a){}
+SCM eval_quasisyntax (SCM e, SCM a){}
 
 #endif // !QUASISYNTAX

string.c

@@ -18,78 +18,78 @@
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
-scm *
+SCM
-string (scm *x) ///((arity . n))
+string (SCM x) ///((arity . n))
 {
   return make_string (x);
 }
 
-scm *
+SCM
-string_append (scm *x) ///((arity . n))
+string_append (SCM x) ///((arity . n))
 {
-  scm *p = &scm_nil;
+  SCM p = cell_nil;
-  while (x != &scm_nil)
+  while (x != cell_nil)
     {
-      scm *s = car (x);
+      SCM s = car (x);
-      assert (s->type == STRING);
+      assert (g_cells[s].type == STRING);
-      p = append2 (p, s->string);
+      p = append2 (p, STRING (s));
       x = cdr (x);
     }
   return make_string (p);
 }
 
-scm *
+SCM
-list_to_string (scm *x)
+list_to_string (SCM x)
 {
   return make_string (x);
 }
 
-scm *
+SCM
-string_length (scm *x)
+string_length (SCM x)
 {
-  assert (x->type == STRING);
+  assert (g_cells[x].type == STRING);
-  return make_number (length (x->string)->value);
+  return make_number (value (length (STRING (x))));
 }
 
-scm *
+SCM
-string_ref (scm *x, scm *k)
+string_ref (SCM x, SCM k)
 {
-  assert (x->type == STRING);
+  assert (g_cells[x].type == STRING);
-  assert (k->type == NUMBER);
+  assert (g_cells[k].type == NUMBER);
-  scm n = {NUMBER, .value=k->value};
+  g_cells[tmp_num].value = value (k);
-  return make_char (list_ref (x->string, &n)->value);
+  return make_char (value (list_ref (STRING (x), tmp_num)));
 }
 
-scm *
+SCM
-substring (scm *x) ///((arity . n))
+substring (SCM x) ///((arity . n))
 {
-  assert (x->type == PAIR);
+  assert (g_cells[x].type == PAIR);
-  assert (x->car->type == STRING);
+  assert (g_cells[car (x)].type == STRING);
-  scm *s = x->car->string;
+  SCM s = g_cells[car (x)].string;
-  assert (x->cdr->car->type == NUMBER);
+  assert (g_cells[cadr (x)].type == NUMBER);
-  int start = x->cdr->car->value;
+  int start = g_cells[cadr (x)].value;
-  int end = length (s)->value;
+  int end = g_cells[length (s)].value;
-  if (x->cdr->cdr->type == PAIR) {
+  if (g_cells[cddr (x)].type == PAIR) {
-    assert (x->cdr->cdr->car->type == NUMBER);
+    assert (g_cells[caddr (x)].type == NUMBER);
-    assert (x->cdr->cdr->car->value <= end);
+    assert (g_cells[caddr (x)].value <= end);
-    end = x->cdr->cdr->car->value;
+    end = g_cells[caddr (x)].value;
   }
   int n = end - start;
-  while (start--) s = s->cdr;
+  while (start--) s = cdr (s);
-  scm *p = &scm_nil;
+  SCM p = cell_nil;
-  while (n-- && s != &scm_nil) {
+  while (n-- && s != cell_nil) {
-    p = append2 (p, cons (make_char (s->car->value), &scm_nil));
+    p = append2 (p, cons (make_char (g_cells[car (s)].value), cell_nil));
-    s = s->cdr;
+    s = cdr (s);
   }
   return make_string (p);
 }
 
-scm *
+SCM
-number_to_string (scm *x)
+number_to_string (SCM x)
 {
-  assert (x->type == NUMBER);
+  assert (g_cells[x].type == NUMBER);
-  int n = x->value;
+  int n = value (x);
-  scm *p = n < 0 ? cons (make_char ('-'), &scm_nil) : &scm_nil;
+  SCM p = n < 0 ? cons (make_char ('-'), cell_nil) : cell_nil;
   do {
     p = cons (make_char (n % 10 + '0'), p);
     n = n / 10;
@@ -97,16 +97,16 @@ number_to_string (scm *x)
   return make_string (p);
 }
 
-scm *
+SCM
-string_to_symbol (scm *x)
+string_to_symbol (SCM x)
 {
-  assert (x->type == STRING);
+  assert (g_cells[x].type == STRING);
-  return make_symbol (x->string);
+  return make_symbol (STRING (x));
 }
 
-scm *
+SCM
-symbol_to_string (scm *x)
+symbol_to_string (SCM x)
 {
-  assert (x->type == SYMBOL);
+  assert (g_cells[x].type == SYMBOL);
-  return make_string (x->string);
+  return make_string (STRING (x));
 }

tests/base.test

@@ -1,5 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
+set -x
 echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@"
 #paredit:||
 exit $?

tests/gc-0.test

@@ -1,6 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@"
+echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/..//mes "$@"
 #paredit:||
 exit $?
 !#
@@ -30,12 +30,68 @@ exit $?
 (define pair (gc-make-cell 3 zero one)) 
 (define zero-list (gc-make-cell 3 zero '()))
 (define v (gc-make-vector 1))
+(display v) (newline)
 (vector-set! v 0 88)
 (define zero-v-list (gc-make-cell 3 v zero-list))
 (define list (gc-make-cell 3 (gc-make-cell 3 zero one) zero-v-list))
 (display "list: ") (display list) (newline)
-(display "cells:") (display %the-cells) (newline)
+(display "v: ") (display v) (newline)
-(gc list)
+(gc)
-(display "gc done\n")
+(display "list: ") (display list) (newline)
-(display "scm old:") (display %new-cells) (newline)
+(display "v: ") (display v) (newline)
-(display "scm cells:") (display %the-cells) (newline)
+(gc)
+(display "list: ") (display list) (newline)
+(display "v: ") (display v) (newline)
+(gc)
+(display "list: ") (display list) (newline)
+(display "v: ") (display v) (newline)
+(gc)
+(display "list: ") (display list) (newline)
+(display "v: ") (display v) (newline)
+(gc)
+(display "list: ") (display list) (newline)
+(display "v: ") (display v) (newline)
+(gc)
+(display "list: ") (display list) (newline)
+(display "v: ") (display v) (newline)
+(gc)
+(display "list: ") (display list) (newline)
+(display "v: ") (display v) (newline)
+(gc)
+(display "list: ") (display list) (newline)
+(display "v: ") (display v) (newline)
+(gc)
+(display "list: ") (display list) (newline)
+(display "v: ") (display v) (newline)
+(gc)
+(display "list: ") (display list) (newline)
+(display "v: ") (display v) (newline)
+(gc)
+(display "list: ") (display list) (newline)
+(display "v: ") (display v) (newline)
+(gc)
+(display "list: ") (display list) (newline)
+(display "v: ") (display v) (newline)
+(gc)
+(display "list: ") (display list) (newline)
+(display "v: ") (display v) (newline)
+(gc)
+(display "list: ") (display list) (newline)
+(display "v: ") (display v) (newline)
+(gc)
+(display "list: ") (display list) (newline)
+(display "v: ") (display v) (newline)
+(gc)
+(display "list: ") (display list) (newline)
+(display "v: ") (display v) (newline)
+(gc)
+(display "list: ") (display list) (newline)
+(display "v: ") (display v) (newline)
+;; (display "list: ") (display list) (newline)
+;; (display "v: ") (display v) (newline)
+;;(gc-show)
+;;(display "cells:") (display %the-cells) (newline)
+;;(gc list)
+;; (display "gc done\n")
+;; (display "scm old:") (display %new-cells) (newline)
+;; (display "scm cells:") (display %the-cells) (newline)

tests/gc-1.test

@@ -1,6 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@"
+echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@"
 #paredit:||
 exit $?
 !#

tests/gc-2.test

@@ -1,7 +1,7 @@
 #! /bin/sh
 # -*-scheme-*-
 set -x
-echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@"
+echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@"
 #paredit:||
 exit $?
 !#

tests/gc-2a.test

@@ -1,7 +1,7 @@
 #! /bin/sh
 # -*-scheme-*-
 set -x
-echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@"
+echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@"
 #paredit:||
 exit $?
 !#

tests/gc-3.test

@@ -1,7 +1,7 @@
 #! /bin/sh
 # -*-scheme-*-
 set -x
-echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@"
+echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@"
 #paredit:||
 exit $?
 !#
@@ -33,8 +33,8 @@ exit $?
 ;; (display (eq? *top-begin-define-a* '*top-begin-define-a*))
 ;; (newline)
 
-(display 'HALLO) (newline)
+;; (display 'HALLO) (newline)
-(display 'foo-test:) (newline)
+;; (display 'foo-test:) (newline)
 (display 1)(newline)
 (display 2)(newline)
 (display 3)(newline)
@@ -56,28 +56,28 @@ exit $?
 (display 18)(newline)
 (display 19)(newline)
 
-(display 20)(newline)
+;; (display 20)(newline)
-(display 21)(newline)
+;; (display 21)(newline)
-(display 22)(newline)
+;; (display 22)(newline)
-(display 23)(newline)
+;; (display 23)(newline)
-(display 24)(newline)
+;; (display 24)(newline)
-(display 25)(newline)
+;; (display 25)(newline)
-(display 26)(newline)
+;; (display 26)(newline)
-(display 27)(newline)
+;; (display 27)(newline)
-(display 28)(newline)
+;; (display 28)(newline)
-(display 29)(newline)
+;; (display 29)(newline)
-(display 30)(newline)
+;; (display 30)(newline)
 
-(display 31)(newline)
+;; (display 31)(newline)
-(display 32)(newline)
+;; (display 32)(newline)
-(display 33)(newline)
+;; (display 33)(newline)
-(display 34)(newline)
+;; (display 34)(newline)
-(display 35)(newline)
+;; (display 35)(newline)
-(display 36)(newline)
+;; (display 36)(newline)
-(display 37)(newline)
+;; (display 37)(newline)
-(display 38)(newline)
+;; (display 38)(newline)
-(display 39)(newline)
+;; (display 39)(newline)
-(display 40)(newline)
+;; (display 40)(newline)
 
 ;; (display 41)(newline)
 ;; (display 42)(newline)

tests/gc-4.test

@@ -0,0 +1,38 @@
+#! /bin/sh
+# -*-scheme-*-
+echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/..//mes "$@"
+#paredit:||
+exit $?
+!#
+
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(define v #(0 1 2))
+(display "v: ") (display v) (newline)
+(gc)
+(display "v: ") (display v) (newline)
+(gc)
+(display "v: ") (display v) (newline)
+(gc)
+(display "v: ") (display v) (newline)
+(gc)
+(display "v: ") (display v) (newline)
+

tests/gc-5.test

@@ -0,0 +1,37 @@
+#! /bin/sh
+# -*-scheme-*-
+echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/..//mes "$@"
+#paredit:||
+exit $?
+!#
+
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(define v (values 0 1 2))
+(display "v: ") (display v) (newline)
+(gc)
+(display "v: ") (display v) (newline)
+(gc)
+(display "v: ") (display v) (newline)
+(gc)
+(display "v: ") (display v) (newline)
+(gc)
+(display "v: ") (display v) (newline)

tests/gc-6.test

@@ -0,0 +1,47 @@
+#! /bin/sh
+# -*-scheme-*-
+echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/..//mes "$@"
+#paredit:||
+exit $?
+!#
+
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define (cwv)
+  (display "cwvf=") (display call-with-values-env) (newline)
+  (call-with-values (lambda () (values 1 2 3))
+    (lambda (a b c) (+ a b c))))
+(display "cwv:") (display cwv) (newline)
+(display "cdr cwv:") (display (cdr cwv)) (newline)
+(display "(cwv):") (display (cwv)) (newline)
+;;(display "current-module:") (display (current-module)) (newline)
+(gc)
+(display "cwv:") (display cwv) (newline)
+(display "cdr cwv:") (display (cdr cwv)) (newline)
+;;(display "current-module:") (display (current-module)) (newline)
+(display "(cwv):") (display (cwv)) (newline)
+(gc)
+(display "cwv:") (display cwv) (newline)
+(display "cdr cwv:") (display (cdr cwv)) (newline)
+(display "(cwv):") (display (cwv call-with-values-env)) (newline)
+(gc)
+'dun

tests/gc.test

@@ -1,6 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@"
+echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@"
 #paredit:||
 exit $?
 !#

type.c

@@ -20,84 +20,83 @@
 
 #if !TYPE0
 
-scm *
+SCM
-char_p (scm *x)
+char_p (SCM x)
 {
-  return x->type == CHAR ? &scm_t : &scm_f;
+  return type (x) == CHAR ? cell_t : cell_f;
 }
 
-scm *
+SCM
-macro_p (scm *x)
+macro_p (SCM x)
 {
-  return x->type == MACRO ? &scm_t : &scm_f;
+  return type (x) == MACRO ? cell_t : cell_f;
 }
 
-scm *
+SCM
-number_p (scm *x)
+number_p (SCM x)
 {
-  return x->type == NUMBER ? &scm_t : &scm_f;
+  return type (x) == NUMBER ? cell_t : cell_f;
 }
 
-scm *
+SCM
-pair_p (scm *x)
+pair_p (SCM x)
 {
-  return x->type == PAIR ? &scm_t : &scm_f;
+  return type (x) == PAIR ? cell_t : cell_f;
 }
 
-scm *
+SCM
-ref_p (scm *x)
+ref_p (SCM x)
 {
-  return x->type == REF ? &scm_t : &scm_f;
+  return type (x) == REF ? cell_t : cell_f;
 }
 
-scm *
+SCM
-string_p (scm *x)
+string_p (SCM x)
 {
-  return x->type == STRING ? &scm_t : &scm_f;
+  return type (x) == STRING ? cell_t : cell_f;
 }
 
-scm *
+SCM
-symbol_p (scm *x)
+symbol_p (SCM x)
 {
-  return x->type == SYMBOL ? &scm_t : &scm_f;
+  return type (x) == SYMBOL ? cell_t : cell_f;
 }
 
-scm *
+SCM
-vector_p (scm *x)
+vector_p (SCM x)
 {
-  return x->type == VECTOR ? &scm_t : &scm_f;
+  return type (x) == VECTOR ? cell_t : cell_f;
 }
 
-scm *
+SCM
-builtin_p (scm *x)
+builtin_p (SCM x)
 {
-  return x->type == FUNCTION ? &scm_t : &scm_f;
+  return type (x) == FUNCTION ? cell_t : cell_f;
 }
 
 // Non-types
-scm *
+SCM
-null_p (scm *x)
+null_p (SCM x)
 {
-  return x == &scm_nil ? &scm_t : &scm_f;
+  return x == cell_nil ? cell_t : cell_f;
 }
 
-scm *
+SCM
-atom_p (scm *x)
+atom_p (SCM x)
 {
-  return (x->type == PAIR ? &scm_f : &scm_t);
+  return (type (x) == PAIR ? cell_f : cell_t);
 }
 
-scm *
+SCM
-boolean_p (scm *x)
+boolean_p (SCM x)
 {
-  return (x == &scm_t || x == &scm_f) ? &scm_t : &scm_f;
+  return (x == cell_t || x == cell_f) ? cell_t : cell_f;
 }
 #endif
 
-scm*make_number (int);
+SCM make_number (int);
-scm *
+SCM
-mes_type_of (scm *x)
+mes_type_of (SCM x)
 {
-  return make_number (x->type);
+  return make_number (type (x));
 }
-