string and vector data is now packed, no longer allocing arbitrary

blocks of untagged data, string and vector reads use an initial
buffer to reduce allocations

eval.c

@@ -240,10 +240,13 @@ static sexp sexp_make_context(sexp ctx, sexp *stack, sexp env) {
   sexp_bytecode_name(sexp_context_bc(res)) = SEXP_FALSE;
   sexp_bytecode_length(sexp_context_bc(res)) = INIT_BCODE_SIZE;
   sexp_bytecode_literals(sexp_context_bc(res)) = SEXP_NULL;
+  sexp_context_parent(res) = SEXP_FALSE;
   sexp_context_lambda(res) = SEXP_FALSE;
   sexp_context_stack(res) = stack;
   sexp_context_env(res) = env;
   sexp_context_fv(res) = SEXP_NULL;
+  sexp_context_saves(res).var = 0;
+  sexp_context_saves(res).next = 0;
   sexp_context_depth(res) = 0;
   sexp_context_pos(res) = 0;
   sexp_context_top(res) = 0;
@@ -256,6 +259,7 @@ static sexp sexp_child_context(sexp context, sexp lambda) {
   sexp ctx = sexp_make_context(context,
                                sexp_context_stack(context),
                                sexp_context_env(context));
+  sexp_context_parent(ctx) = context;
   sexp_context_lambda(ctx) = lambda;
   sexp_context_env(ctx) = sexp_context_env(context);
   sexp_context_top(ctx) = sexp_context_top(context);
@@ -311,7 +315,8 @@ static sexp sexp_identifier_eq(sexp ctx, sexp e1, sexp id1, sexp e2, sexp id2) {
 
 static sexp sexp_compile_error(sexp ctx, char *message, sexp obj) {
   return sexp_make_exception(ctx, the_compile_error_symbol,
-                             sexp_c_string(ctx, message), sexp_list1(ctx, obj),
+                             sexp_c_string(ctx, message, -1),
+                             sexp_list1(ctx, obj),
                              SEXP_FALSE, SEXP_FALSE, SEXP_FALSE);
 }
 
@@ -985,7 +990,7 @@ static sexp make_opcode_procedure (sexp ctx, sexp op, sexp_uint_t i, sexp env,
     sexp_push(context, refs, sexp_make_ref(context, sexp_car(ls), env_cell(env, sexp_car(ls))));
   generate_opcode_app(sexp_cons(context, op, sexp_reverse(context, refs)), context);
   bc = finalize_bytecode(context);
-  sexp_bytecode_name(bc) = sexp_c_string(ctx, sexp_opcode_name(op));
+  sexp_bytecode_name(bc) = sexp_c_string(ctx, sexp_opcode_name(op), -1);
   res = sexp_make_procedure(ctx, sexp_make_integer(0), sexp_make_integer(i),
                             bc, SEXP_VOID);
   if (i == sexp_opcode_num_args(op))

gc.c

@@ -55,12 +55,74 @@ void sexp_mark (sexp x) {
     goto loop;
   case SEXP_VECTOR:
     data = sexp_vector_data(x);
-    for (i=sexp_vector_length(x)-1; i>=0; i--)
+    for (i=sexp_vector_length(x)-1; i>0; i--)
       sexp_mark(data[i]);
+    x = data[i];
+    goto loop;
+  case SEXP_BYTECODE:
+    x = sexp_bytecode_literals(x);
+    goto loop;
+  case SEXP_ENV:
+    sexp_mark(sexp_env_lambda(x));
+    sexp_mark(sexp_env_bindings(x));
+    x = sexp_env_parent(x);
+    if (x) goto loop; else break;
+  case SEXP_PROCEDURE:
+    sexp_mark(sexp_procedure_code(x));
+    x = sexp_procedure_vars(x);
+    goto loop;
+  case SEXP_MACRO:
+    sexp_mark(sexp_macro_proc(x));
+    x = sexp_macro_env(x);
+    goto loop;
+  case SEXP_SYNCLO:
+    sexp_mark(sexp_synclo_free_vars(x));
+    sexp_mark(sexp_synclo_expr(x));
+    x = sexp_synclo_env(x);
+    goto loop;
+  case SEXP_OPCODE:
+    if (sexp_opcode_proc(x)) sexp_mark(sexp_opcode_proc(x));
+    if (sexp_opcode_default(x)) sexp_mark(sexp_opcode_default(x));
+    if (sexp_opcode_data(x)) sexp_mark(sexp_opcode_data(x));
+    break;
+  case SEXP_IPORT:
+  case SEXP_OPORT:
+    x = sexp_port_cookie(x);
+    if (x) goto loop; else break;
+  case SEXP_LAMBDA:
+    sexp_mark(sexp_lambda_name(x));
+    sexp_mark(sexp_lambda_params(x));
+    sexp_mark(sexp_lambda_locals(x));
+    sexp_mark(sexp_lambda_defs(x));
+    sexp_mark(sexp_lambda_flags(x));
+    sexp_mark(sexp_lambda_body(x));
+    sexp_mark(sexp_lambda_fv(x));
+    sexp_mark(sexp_lambda_sv(x));
+    x = sexp_lambda_body(x);
+    goto loop;
+  case SEXP_CND:
+    sexp_mark(sexp_cnd_test(x));
+    sexp_mark(sexp_cnd_fail(x));
+    x = sexp_cnd_pass(x);
+    goto loop;
+  case SEXP_SET:
+    sexp_mark(sexp_set_var(x));
+    x = sexp_set_value(x);
+    goto loop;
+  case SEXP_REF:
+    sexp_mark(sexp_ref_name(x));
+    x = sexp_ref_cell(x);
+    goto loop;
+  case SEXP_SEQ:
+    x = sexp_seq_ls(x);
+    goto loop;
+  case SEXP_LIT:
+    x = sexp_lit_value(x);
+    goto loop;
   }
 }
 
-sexp sexp_sweep () {
+sexp sexp_sweep (sexp ctx) {
   sexp_uint_t freed=0, size;
   sexp p=(sexp)sexp_heap, f1=sexp_free_list, f2;
   while ((char*)p<sexp_heap_end) {
@@ -82,16 +144,21 @@ sexp sexp_sweep () {
 
 sexp sexp_gc (sexp ctx) {
   int i;
+  struct sexp_gc_var_t *saves;
   sexp *stack = sexp_context_stack(ctx);
-  fprintf(stderr, "garbage collecting\n");
+  fprintf(stderr, "************* garbage collecting *************\n");
+  for (i=0; i<SEXP_SYMBOL_TABLE_SIZE; i++)
+    sexp_mark(sexp_symbol_table[i]);
   for (i=0; i<sexp_context_top(ctx); i++)
     sexp_mark(stack[i]);
-/*   for ( ; ctx; ctx=sexp_context_(ctx)) { */
-/*     sexp_gc_mark(ctx) = 1; */
-/*     sexp_gc_mark(sexp_context_bc(ctx)) = 1; */
-/*     sexp_mark(sexp_context_env(ctx)); */
-/*   } */
-  return sexp_sweep();
+  for ( ; ctx; ctx=sexp_context_parent(ctx)) {
+    sexp_gc_mark(ctx) = 1;
+    if (sexp_context_bc(ctx)) sexp_mark(sexp_context_bc(ctx));
+    sexp_mark(sexp_context_env(ctx));
+    for (saves=&(sexp_context_saves(ctx)); saves; saves=saves->next)
+      if (saves->var) sexp_mark(*(saves->var));
+  }
+  return sexp_sweep(ctx);
 }
 
 void *sexp_alloc (sexp ctx, size_t size) {

main.c

@@ -66,7 +66,7 @@ void run_main (int argc, char **argv) {
     case 'e':
     case 'p':
       if (! init_loaded++)
-        sexp_load(context, sexp_c_string(context, sexp_init_file), env);
+        sexp_load(context, sexp_c_string(context, sexp_init_file, -1), env);
       res = sexp_read_from_string(context, argv[i+1]);
       if (! sexp_exceptionp(res))
         res = eval_in_context(res, context);
@@ -82,8 +82,8 @@ void run_main (int argc, char **argv) {
 #endif
     case 'l':
       if (! init_loaded++)
-        sexp_load(context, sexp_c_string(context, sexp_init_file), env);
-      sexp_load(context, sexp_c_string(context, argv[++i]), env);
+        sexp_load(context, sexp_c_string(context, sexp_init_file, -1), env);
+      sexp_load(context, sexp_c_string(context, argv[++i], -1), env);
       break;
     case 'q':
       init_loaded = 1;
@@ -95,10 +95,10 @@ void run_main (int argc, char **argv) {
 
   if (! quit) {
     if (! init_loaded)
-      sexp_load(context, sexp_c_string(context, sexp_init_file), env);
+      sexp_load(context, sexp_c_string(context, sexp_init_file, -1), env);
     if (i < argc)
       for ( ; i < argc; i++)
-        sexp_load(context, sexp_c_string(context, argv[i]), env);
+        sexp_load(context, sexp_c_string(context, argv[i], -1), env);
     else
       repl(context);
   }

sexp.c

@@ -45,13 +45,7 @@ static int is_separator(int c) {
   return 0<c && c<0x60 && sexp_separators[c];
 }
 
-#if USE_HASH_SYMS
-#define SEXP_SYMBOL_TABLE_SIZE 389
-#else
-#define SEXP_SYMBOL_TABLE_SIZE 1
-#endif
-
-static sexp symbol_table[SEXP_SYMBOL_TABLE_SIZE];
+sexp sexp_symbol_table[SEXP_SYMBOL_TABLE_SIZE];
 
 sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag) {
   sexp res = (sexp) sexp_alloc(ctx, size);
@@ -109,7 +103,7 @@ sexp sexp_make_exception (sexp ctx, sexp kind, sexp message, sexp irritants,
 
 sexp sexp_user_exception (sexp ctx, sexp self, char *message, sexp irritants) {
   return sexp_make_exception(ctx, sexp_intern(ctx, "user"),
-                             sexp_c_string(ctx, message),
+                             sexp_c_string(ctx, message, -1),
                              ((sexp_pairp(irritants) || sexp_nullp(irritants))
                               ? irritants : sexp_list1(ctx, irritants)),
                              self, SEXP_FALSE, SEXP_FALSE);
@@ -117,13 +111,14 @@ sexp sexp_user_exception (sexp ctx, sexp self, char *message, sexp irritants) {
 
 sexp sexp_type_exception (sexp ctx, char *message, sexp obj) {
   return sexp_make_exception(ctx, sexp_intern(ctx, "type"),
-                             sexp_c_string(ctx, message), sexp_list1(ctx, obj),
+                             sexp_c_string(ctx, message, -1),
+                             sexp_list1(ctx, obj),
                              SEXP_FALSE, SEXP_FALSE, SEXP_FALSE);
 }
 
 sexp sexp_range_exception (sexp ctx, sexp obj, sexp start, sexp end) {
   return sexp_make_exception(ctx, sexp_intern(ctx, "range"),
-                             sexp_c_string(ctx, "bad index range"),
+                             sexp_c_string(ctx, "bad index range", -1),
                              sexp_list3(ctx, obj, start, end),
                              SEXP_FALSE, SEXP_FALSE, SEXP_FALSE);
 }
@@ -180,11 +175,11 @@ sexp sexp_print_exception (sexp ctx, sexp exn, sexp out) {
   return SEXP_VOID;
 }
 
-static sexp sexp_read_error (sexp ctx, char *message, sexp irritants, sexp port) {
+static sexp sexp_read_error (sexp ctx, char *msg, sexp irritants, sexp port) {
   sexp name = (sexp_port_name(port)
-               ? sexp_c_string(ctx, sexp_port_name(port)) : SEXP_FALSE);
+               ? sexp_c_string(ctx, sexp_port_name(port), -1) : SEXP_FALSE);
   return sexp_make_exception(ctx, the_read_error_symbol,
-                             sexp_c_string(ctx, message),
+                             sexp_c_string(ctx, msg, -1),
                              irritants, SEXP_FALSE, name,
                              sexp_make_integer(sexp_port_line(port)));
 }
@@ -322,23 +317,21 @@ sexp sexp_make_flonum(sexp ctx, double f) {
 }
 
 sexp sexp_make_string(sexp ctx, sexp len, sexp ch) {
-  char *cstr;
-  sexp s = sexp_alloc_type(ctx, string, SEXP_STRING);
   sexp_sint_t clen = sexp_unbox_integer(len);
+  sexp s = sexp_alloc_atomic(ctx, sexp_sizeof(string)+clen+1);
+  sexp_pointer_tag(s) = SEXP_STRING;
   if (clen < 0) return sexp_type_exception(ctx, "negative length", len);
-  cstr = sexp_alloc(ctx, clen+1);
-  if (sexp_charp(ch))
-    memset(cstr, sexp_unbox_character(ch), clen);
-  cstr[clen] = '\0';
   sexp_string_length(s) = clen;
-  sexp_string_data(s) = cstr;
+  if (sexp_charp(ch))
+    memset(sexp_string_data(s), sexp_unbox_character(ch), clen);
+  sexp_string_data(s)[clen] = '\0';
   return s;
 }
 
-sexp sexp_c_string(sexp ctx, char *str) {
-  sexp_uint_t len = strlen(str);
+sexp sexp_c_string(sexp ctx, char *str, sexp_sint_t slen) {
+  sexp_sint_t len = ((slen >= 0) ? slen : strlen(str));
   sexp s = sexp_make_string(ctx, sexp_make_integer(len), SEXP_VOID);
-  memcpy(sexp_string_data(s), str, len);
+  memcpy(sexp_string_data(s), str, len+1);
   return s;
 }
 
@@ -361,22 +354,26 @@ sexp sexp_substring (sexp ctx, sexp str, sexp start, sexp end) {
   res = sexp_make_string(ctx, sexp_fx_sub(end, start), SEXP_VOID);
   memcpy(sexp_string_data(res),
          sexp_string_data(str)+sexp_unbox_integer(start),
-         sexp_string_length(res));
+         sexp_string_length(res)+1);
   return res;
 }
 
+#if USE_HASH_SYMS
+
 #define FNV_PRIME 16777619
 #define FNV_OFFSET_BASIS 2166136261uL
 
-sexp_uint_t sexp_string_hash(char *str, sexp_uint_t acc) {
+static sexp_uint_t sexp_string_hash(char *str, sexp_uint_t acc) {
   while (*str) {acc *= FNV_PRIME; acc ^= *str++;}
   return acc;
 }
 
+#endif
+
 sexp sexp_intern(sexp ctx, char *str) {
   struct huff_entry he;
   sexp_uint_t len, res=FNV_OFFSET_BASIS, space=3, newbits, bucket;
-  char c, *mystr, *p=str;
+  char c, *p=str;
   sexp sym, ls;
 
 #if USE_HUFF_SYMS
@@ -400,18 +397,14 @@ sexp sexp_intern(sexp ctx, char *str) {
   bucket = 0;
 #endif
   len = strlen(str);
-  for (ls=symbol_table[bucket]; sexp_pairp(ls); ls=sexp_cdr(ls))
-    if (strncmp(str, sexp_symbol_data(sexp_car(ls)), len) == 0)
+  for (ls=sexp_symbol_table[bucket]; sexp_pairp(ls); ls=sexp_cdr(ls))
+    if (! strncmp(str, sexp_string_data(sexp_symbol_string(sexp_car(ls))), len))
       return sexp_car(ls);
 
   /* not found, make a new symbol */
   sym = sexp_alloc_type(ctx, symbol, SEXP_SYMBOL);
-  mystr = sexp_alloc(ctx, len+1);
-  memcpy(mystr, str, len+1);
-  mystr[len]=0;
-  sexp_symbol_length(sym) = len;
-  sexp_symbol_data(sym) = mystr;
-  sexp_push(ctx, symbol_table[bucket], sym);
+  sexp_symbol_string(sym) = sexp_c_string(ctx, str, len);
+  sexp_push(ctx, sexp_symbol_table[bucket], sym);
   return sym;
 }
 
@@ -423,12 +416,12 @@ sexp sexp_make_vector(sexp ctx, sexp len, sexp dflt) {
   sexp v, *x;
   int i, clen = sexp_unbox_integer(len);
   if (! clen) return the_empty_vector;
-  v = sexp_alloc_type(ctx, vector, SEXP_VECTOR);
-  x = (sexp*) sexp_alloc(ctx, clen*sizeof(sexp));
+  v = sexp_alloc(ctx, sexp_sizeof(vector) + clen*sizeof(sexp));
+  sexp_pointer_tag(v) = SEXP_VECTOR;
+  x = sexp_vector_data(v);
   for (i=0; i<clen; i++)
     x[i] = dflt;
   sexp_vector_length(v) = clen;
-  sexp_vector_data(v) = x;
   return v;
 }
 
@@ -705,8 +698,8 @@ void sexp_write (sexp obj, sexp out) {
       sexp_write_char('"', out);
       break;
     case SEXP_SYMBOL:
-      i = sexp_symbol_length(obj);
-      str = sexp_symbol_data(obj);
+      i = sexp_string_length(sexp_symbol_string(obj));
+      str = sexp_string_data(sexp_symbol_string(obj));
       for ( ; i>0; str++, i--) {
         if ((str[0] == '\\') || is_separator(str[0]))
           sexp_write_char('\\', out);
@@ -763,70 +756,67 @@ void sexp_write (sexp obj, sexp out) {
   }
 }
 
-char* sexp_read_string(sexp ctx, sexp in) {
-  char *buf, *tmp, *res;
-  int c, i=0, size=128;
+#define INIT_STRING_BUFFER_SIZE 128
 
-  buf = sexp_alloc(ctx, size);
+sexp sexp_read_string(sexp ctx, sexp in) {
+  int c, i=0, size=INIT_STRING_BUFFER_SIZE;
+  char initbuf[INIT_STRING_BUFFER_SIZE];
+  char *buf=initbuf, *tmp;
+  sexp res;
 
   for (c = sexp_read_char(in); c != '"'; c = sexp_read_char(in)) {
-    if (c == EOF) {
-      sexp_free(ctx, buf);
-      return NULL;
-    }
     if (c == '\\') {
       c = sexp_read_char(in);
-      switch (c) {
-      case 'n': c = '\n'; break;
-      case 't': c = '\t'; break;
+      switch (c) {case 'n': c = '\n'; break; case 't': c = '\t'; break;}
+    }
+    if (c == EOF) {
+      res = sexp_read_error(ctx, "premature end of string", SEXP_NULL, in);
+      break;
     }
     buf[i++] = c;
-    } else {
-      buf[i++] = c;
-    }
-    if (i >= size) {
-      tmp = sexp_alloc(ctx, 2*size);
+    if (i >= size) {       /* expand buffer w/ malloc(), later free() it */
+      tmp = malloc(size*2);
       memcpy(tmp, buf, i);
-      sexp_free(ctx, buf);
+      if (size != INIT_STRING_BUFFER_SIZE) free(buf);
       buf = tmp;
+      size *= 2;
     }
   }
 
-  buf[i++] = '\0';
-  res = sexp_alloc(ctx, i);
-  memcpy(res, buf, i);
-  sexp_free(ctx, buf);
+  buf[i] = '\0';
+  res = sexp_c_string(ctx, buf, i);
+  if (size != INIT_STRING_BUFFER_SIZE) free(buf);
   return res;
 }
 
-char* sexp_read_symbol(sexp ctx, sexp in, int init) {
-  char *buf, *tmp, *res;
-  int c, i=0, size=128;
-
-  buf = sexp_alloc(ctx, size);
+sexp sexp_read_symbol(sexp ctx, sexp in, int init, int internp) {
+  int c, i=0, size=INIT_STRING_BUFFER_SIZE;
+  char initbuf[INIT_STRING_BUFFER_SIZE];
+  char *buf=initbuf, *tmp;
+  sexp res;
 
   if (init != EOF)
     buf[i++] = init;
 
-  while (1) {
-    c=sexp_read_char(in);
+  for (c = sexp_read_char(in); c != '"'; c = sexp_read_char(in)) {
+    if (c == '\\') c = sexp_read_char(in);
     if (c == EOF || is_separator(c)) {
       sexp_push_char(c, in);
       break;
     }
     buf[i++] = c;
-    if (i >= size) {
-      tmp = sexp_alloc(ctx, 2*size);
+    if (i >= size) {       /* expand buffer w/ malloc(), later free() it */
+      tmp = malloc(size*2);
       memcpy(tmp, buf, i);
-      sexp_free(ctx, buf);
+      if (size != INIT_STRING_BUFFER_SIZE) free(buf);
       buf = tmp;
+      size *= 2;
     }
   }
 
-  buf[i++] = '\0';
-  res = sexp_alloc(ctx, i);
-  memcpy(res, buf, i);
-  sexp_free(ctx, buf);
+  buf[i] = '\0';
+  res = (internp ? sexp_intern(ctx, buf) : sexp_c_string(ctx, buf, i));
+  if (size != INIT_STRING_BUFFER_SIZE) free(buf);
   return res;
 }
 
@@ -929,12 +919,7 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
     }
     break;
   case '"':
-    str = sexp_read_string(ctx, in);
-    if (! str)
-      res = sexp_read_error(ctx, "premature end of string", SEXP_NULL, in);
-    else
-      res = sexp_c_string(ctx, str);
-    sexp_free(ctx, str);
+    res = sexp_read_string(ctx, in);
     break;
   case '(':
     res = SEXP_NULL;
@@ -1007,11 +992,14 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
       goto scan_loop;
     case '\\':
       c1 = sexp_read_char(in);
-      str = sexp_read_symbol(ctx, in, c1);
-      if (str[0] == '\0')
+      res = sexp_read_symbol(ctx, in, c1, 0);
+      if (sexp_stringp(res)) {
+        str = sexp_string_data(res);
+        if (sexp_string_length(res) == 0)
           res =
-          sexp_read_error(ctx, "unexpected end of character literal", SEXP_NULL, in);
-      if (str[1] == '\0') {
+            sexp_read_error(ctx, "unexpected end of character literal",
+                            SEXP_NULL, in);
+        if (sexp_string_length(res) == 1) {
           res = sexp_make_character(c1);
         } else if ((c1 == 'x' || c1 == 'X') &&
                    isxdigit(str[0]) && isxdigit(str[1]) && str[2] == '\0') {
@@ -1027,11 +1015,11 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
             res = sexp_make_character('\t');
           else {
             res = sexp_read_error(ctx, "unknown character name",
-                                sexp_list1(ctx, sexp_c_string(ctx, str)),
+                                  sexp_list1(ctx, sexp_c_string(ctx, str, -1)),
                                   in);
           }
         }
-      sexp_free(ctx, str);
+      }
       break;
     case '(':
       sexp_push_char(c1, in);
@@ -1061,9 +1049,7 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
       res = sexp_read_float_tail(ctx, in, 0);
     } else {
       sexp_push_char(c1, in);
-      str = sexp_read_symbol(ctx, in, '.');
-      res = sexp_intern(ctx, str);
-      sexp_free(ctx, str);
+      res = sexp_read_symbol(ctx, in, '.', 1);
     }
     break;
   case ')':
@@ -1086,9 +1072,7 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
       }
     } else {
       sexp_push_char(c2, in);
-      str = sexp_read_symbol(ctx, in, c1);
-      res = sexp_intern(ctx, str);
-      sexp_free(ctx, str);
+      res = sexp_read_symbol(ctx, in, c1, 1);
     }
     break;
   case '0': case '1': case '2': case '3': case '4':
@@ -1097,9 +1081,7 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
     res = sexp_read_number(ctx, in, 10);
     break;
   default:
-    str = sexp_read_symbol(ctx, in, c1);
-    res = sexp_intern(ctx, str);
-    sexp_free(ctx, str);
+    res = sexp_read_symbol(ctx, in, c1, 1);
     break;
   }
   return res;
@@ -1116,7 +1098,7 @@ sexp sexp_read (sexp ctx, sexp in) {
 
 #if USE_STRING_STREAMS
 sexp sexp_read_from_string(sexp ctx, char *str) {
-  sexp s = sexp_c_string(ctx, str);
+  sexp s = sexp_c_string(ctx, str, -1);
   sexp in = sexp_make_input_string_port(ctx, s);
   sexp res = sexp_read(ctx, in);
   sexp_free(ctx, s);
@@ -1132,13 +1114,13 @@ void sexp_init() {
     sexp_initialized_p = 1;
 #if USE_BOEHM
     GC_init();
-    GC_add_roots((char*)&symbol_table,
-                 ((char*)&symbol_table)+sizeof(symbol_table)+1);
+    GC_add_roots((char*)&sexp_symbol_table,
+                 ((char*)&sexp_symbol_table)+sizeof(sexp_symbol_table)+1);
 #elif ! USE_MALLOC
     sexp_gc_init();
 #endif
     for (i=0; i<SEXP_SYMBOL_TABLE_SIZE; i++)
-      symbol_table[i] = SEXP_NULL;
+      sexp_symbol_table[i] = SEXP_NULL;
     ctx = sexp_alloc_type(NULL, context, SEXP_CONTEXT);
     the_dot_symbol = sexp_intern(ctx, ".");
     the_quote_symbol = sexp_intern(ctx, "quote");
@@ -1148,7 +1130,6 @@ void sexp_init() {
     the_read_error_symbol = sexp_intern(ctx, "read");
     the_empty_vector = sexp_alloc_type(ctx, vector, SEXP_VECTOR);
     sexp_vector_length(the_empty_vector) = 0;
-    sexp_vector_data(the_empty_vector) = NULL;
   }
 }
 

sexp.h

@@ -44,6 +44,12 @@
 #define SEXP_MAX_INT ((1<<29)-1)
 #define SEXP_MIN_INT (-(1<<29))
 
+#if USE_HASH_SYMS
+#define SEXP_SYMBOL_TABLE_SIZE 389
+#else
+#define SEXP_SYMBOL_TABLE_SIZE 1
+#endif
+
 enum sexp_types {
   SEXP_OBJECT,
   SEXP_FIXNUM,
@@ -80,6 +86,11 @@ typedef long sexp_sint_t;
 typedef char sexp_tag_t;
 typedef struct sexp_struct *sexp;
 
+struct sexp_gc_var_t {
+  sexp *var;
+  struct sexp_gc_var_t *next;
+};
+
 struct sexp_struct {
   sexp_tag_t tag;
   char immutablep;
@@ -92,15 +103,14 @@ struct sexp_struct {
     } pair;
     struct {
       sexp_uint_t length;
-      sexp *data;
+      sexp data[];
     } vector;
     struct {
       sexp_uint_t length;
-      char *data;
+      char data[];
     } string;
     struct {
-      sexp_uint_t length;
-      char *data;
+      sexp string;
     } symbol;
     struct {
       FILE *stream;
@@ -168,31 +178,49 @@ struct sexp_struct {
     } lit;
     /* compiler state */
     struct {
-      sexp bc, lambda, *stack, env, fv;
+      sexp bc, lambda, *stack, env, fv, parent;
+      struct sexp_gc_var_t saves;
       sexp_uint_t pos, top, depth, tailp, tracep;
     } context;
   } value;
 };
 
 #if USE_BOEHM
+
+#define sexp_gc_var(ctx, x, y)       sexp x;
+#define sexp_gc_release(ctx, x, y)
+
 #include "gc/include/gc.h"
 #define sexp_alloc(ctx, size)        GC_malloc(size)
 #define sexp_alloc_atomic(ctx, size) GC_malloc_atomic(size)
 #define sexp_realloc(ctx, x, size)   GC_realloc(x, size)
 #define sexp_free(ctx, x)
 #define sexp_deep_free(ctx, x)
-#elif USE_MALLOC
+
+#else
+
+#define sexp_gc_var(ctx, x, y) \
+  sexp x = SEXP_FALSE;                                          \
+  struct sexp_gc_var_t y = {&x, &(sexp_context_saves(cxt))};    \
+  sexp_context_saves(cxt) = &y;
+
+#define sexp_gc_release(ctx, x, y)   (sexp_context_saves(cxt) = y.next)
+
+#if USE_MALLOC
 #define sexp_alloc(ctx, size)        malloc(size)
 #define sexp_alloc_atomic(ctx, size) malloc(size)
 #define sexp_realloc(ctx, x, size)   realloc(x, size)
 #define sexp_free(ctx, x)            free(x)
 void sexp_deep_free(sexp ctx, sexp obj);
+
 #else  /* native gc */
 void *sexp_alloc(sexp ctx, size_t size);
 #define sexp_alloc_atomic            sexp_alloc
 void *sexp_realloc(sexp ctx, sexp x, size_t size);
 #define sexp_free(ctx, x)
 #define sexp_deep_free(ctx, x)
+
+#endif
 #endif
 
 #define sexp_align(n, bits) (((n)+(1<<(bits))-1)&(((sexp_uint_t)-1)-((1<<(bits))-1)))
@@ -291,8 +319,7 @@ void *sexp_realloc(sexp ctx, sexp x, size_t size);
 #define sexp_string_ref(x, i) (sexp_make_character(sexp_string_data(x)[sexp_unbox_integer(i)]))
 #define sexp_string_set(x, i, v) (sexp_string_data(x)[sexp_unbox_integer(i)] = sexp_unbox_character(v))
 
-#define sexp_symbol_length(x)  ((x)->value.symbol.length)
-#define sexp_symbol_data(x)    ((x)->value.symbol.data)
+#define sexp_symbol_string(x)  ((x)->value.symbol.string)
 
 #define sexp_port_stream(p)    ((p)->value.port.stream)
 #define sexp_port_name(p)      ((p)->value.port.name)
@@ -375,6 +402,8 @@ void *sexp_realloc(sexp ctx, sexp x, size_t size);
 #define sexp_context_pos(x)     ((x)->value.context.pos)
 #define sexp_context_top(x)     ((x)->value.context.top)
 #define sexp_context_lambda(x)  ((x)->value.context.lambda)
+#define sexp_context_parent(x)  ((x)->value.context.parent)
+#define sexp_context_saves(x)   ((x)->value.context.saves)
 #define sexp_context_tailp(x)   ((x)->value.context.tailp)
 #define sexp_context_tracep(x)  ((x)->value.context.tailp)
 
@@ -440,19 +469,18 @@ sexp sexp_append2(sexp ctx, sexp a, sexp b);
 sexp sexp_memq(sexp ctx, sexp x, sexp ls);
 sexp sexp_assq(sexp ctx, sexp x, sexp ls);
 sexp sexp_length(sexp ctx, sexp ls);
-sexp sexp_c_string(sexp ctx, char *str);
+sexp sexp_c_string(sexp ctx, char *str, sexp_sint_t slen);
 sexp sexp_make_string(sexp ctx, sexp len, sexp ch);
 sexp sexp_substring (sexp ctx, sexp str, sexp start, sexp end);
 sexp sexp_make_flonum(sexp ctx, double f);
-sexp_uint_t sexp_string_hash(char *str, sexp_uint_t acc);
 sexp sexp_intern(sexp ctx, char *str);
 sexp sexp_string_to_symbol(sexp ctx, sexp str);
 sexp sexp_make_vector(sexp ctx, sexp len, sexp dflt);
 sexp sexp_list_to_vector(sexp ctx, sexp ls);
 sexp sexp_vector(sexp ctx, int count, ...);
 void sexp_write(sexp obj, sexp out);
-char* sexp_read_string(sexp ctx, sexp in);
-char* sexp_read_symbol(sexp ctx, sexp in, int init);
+sexp sexp_read_string(sexp ctx, sexp in);
+sexp sexp_read_symbol(sexp ctx, sexp in, int init, int internp);
 sexp sexp_read_number(sexp ctx, sexp in, int base);
 sexp sexp_read_raw(sexp ctx, sexp in);
 sexp sexp_read(sexp ctx, sexp in);