no more globals!

Each contexts keep a link to the heap which it is a part
of (when using the native GC), as well as a vector of
special globals that it needs quick access to (e.g. the
`quote' and `quasiquote', etc. symbols.  You can use this
to manage multiple completely unrelated VMs in the same
application, and everything will be thread-safe.

The old behavior is still available by editing config.h,
which now includes somewhat better descriptions of all
the settings.

README

@@ -43,16 +43,27 @@ The essential functions to remember are:
 
   #include <chibi/eval.h>
 
-  sexp_make_context(NULL, NULL, NULL)
+  sexp_make_eval_context(NULL, NULL, NULL)
-    returns a new context
+    returns a new context with a fresh stack and standard environment
 
-  sexp_eval(context, expr)
+  sexp_destroy_context(context)
-    evaluates an s-expression
+    free a context and all associated memory
+
+  sexp_eval(context, expr, env)
+    evaluates an s-expression in an environment
+    env can be NULL to use the context's default env
 
   sexp_eval_string(context, str)
     reads an s-expression from str and evaluates it
 
+  sexp_load(context, file, env)
+    read and eval all top-level forms from file
+
+  sexp_context_env(context)
+    a macro returning the environment associated with a context
+
   sexp_env_define(context, env, symbol, value)
+    define a variable in an environment
 
 A minimal module system is provided by default.  Currently you can
 load the following SRFIs with (import (srfi N)):

eval.c

@@ -8,14 +8,6 @@
 
 static int scheme_initialized_p = 0;
 
-sexp continuation_resumer, final_resumer;
-static sexp the_interaction_env_symbol;
-static sexp the_err_handler_symbol, the_compile_error_symbol;
-static sexp the_cur_in_symbol, the_cur_out_symbol, the_cur_err_symbol;
-
-#define sexp_current_error_port(ctx) sexp_env_global_ref(sexp_context_env(ctx),the_cur_out_symbol,SEXP_FALSE)
-#define sexp_debug(ctx, msg, obj) (sexp_write_string(ctx, msg, sexp_current_error_port(ctx)), sexp_write(ctx, obj, sexp_current_error_port(ctx)), sexp_write_char(ctx, '\n', sexp_current_error_port(ctx)))
-
 #if USE_DEBUG
 #include "opt/debug.c"
 #else
@@ -31,14 +23,14 @@ static sexp sexp_make_standard_env (sexp ctx, sexp version);
 
 static sexp sexp_compile_error (sexp ctx, char *message, sexp obj) {
   sexp exn;
-  sexp_gc_var2(irritants, msg);
+  sexp_gc_var3(sym, irritants, msg);
-  sexp_gc_preserve2(ctx, irritants, msg);
+  sexp_gc_preserve3(ctx, sym, irritants, msg);
   irritants = sexp_list1(ctx, obj);
   msg = sexp_c_string(ctx, message, -1);
-  exn = sexp_make_exception(ctx, the_compile_error_symbol, msg, irritants,
+  exn = sexp_make_exception(ctx, sym = sexp_intern(ctx, "compile"), msg, irritants,
                             SEXP_FALSE, (sexp_pairp(obj) ?
                                          sexp_pair_source(obj) : SEXP_FALSE));
-  sexp_gc_release2(ctx);
+  sexp_gc_release3(ctx);
   return exn;
 }
 
@@ -211,6 +203,12 @@ static void emit_push(sexp ctx, sexp obj) {
     sexp_push(ctx, sexp_bytecode_literals(sexp_context_bc(ctx)), obj);
 }
 
+static sexp finalize_bytecode (sexp ctx) {
+  emit(ctx, OP_RET);
+  shrink_bcode(ctx, sexp_context_pos(ctx));
+  return sexp_context_bc(ctx);
+}
+
 static sexp sexp_make_procedure (sexp ctx, sexp flags, sexp num_args,
                                  sexp bc, sexp vars) {
   sexp proc = sexp_alloc_type(ctx, procedure, SEXP_PROCEDURE);
@@ -280,51 +278,62 @@ static sexp sexp_make_lit(sexp ctx, sexp value) {
   return res;
 }
 
-#define SEXP_STACK_SIZE (sexp_sizeof(stack)+sizeof(sexp)*INIT_STACK_SIZE)
+/****************************** contexts ******************************/
 
-sexp sexp_make_context(sexp ctx, sexp stack, sexp env) {
+#define SEXP_STACK_SIZE (sexp_sizeof(stack)+sizeof(sexp)*SEXP_INIT_STACK_SIZE)
+
+void sexp_init_eval_context_globals (sexp ctx) {
+  ctx = sexp_make_child_context(ctx, NULL);
+  emit(ctx, OP_RESUMECC);
+  sexp_global(ctx, SEXP_G_RESUMECC_BYTECODE) = finalize_bytecode(ctx);
+  ctx = sexp_make_child_context(ctx, NULL);
+  emit(ctx, OP_DONE);
+  sexp_global(ctx, SEXP_G_FINAL_RESUMER)
+    = sexp_make_procedure(ctx,
+                          sexp_make_fixnum(0),
+                          sexp_make_fixnum(0),
+                          finalize_bytecode(ctx),
+                          sexp_make_vector(ctx, 0, SEXP_VOID));
+  sexp_bytecode_name(sexp_procedure_code(sexp_global(ctx, SEXP_G_FINAL_RESUMER)))
+    = sexp_intern(ctx, "final-resumer");
+}
+
+sexp sexp_make_eval_context (sexp ctx, sexp stack, sexp env) {
   sexp_gc_var1(res);
   if (ctx) sexp_gc_preserve1(ctx, res);
-  res = sexp_alloc_type(ctx, context, SEXP_CONTEXT);
+  res = sexp_make_context(ctx);
-  sexp_context_parent(res) = ctx;
+  sexp_context_bc(res)
-  sexp_context_lambda(res) = SEXP_FALSE;
+    = sexp_alloc_tagged(res, sexp_sizeof(bytecode)+SEXP_INIT_BCODE_SIZE,
-  sexp_context_fv(res) = SEXP_NULL;
+                        SEXP_BYTECODE);
-  sexp_context_saves(res) = 0;
+  sexp_bytecode_name(sexp_context_bc(res)) = SEXP_FALSE;
-  sexp_context_depth(res) = 0;
+  sexp_bytecode_length(sexp_context_bc(res)) = SEXP_INIT_BCODE_SIZE;
-  sexp_context_pos(res) = 0;
+  sexp_bytecode_literals(sexp_context_bc(res)) = SEXP_NULL;
-  sexp_context_tailp(res) = 1;
-  sexp_context_tracep(res) = 0;
   if ((! stack) || (stack == SEXP_FALSE)) {
-    stack = sexp_alloc_tagged(ctx, SEXP_STACK_SIZE, SEXP_STACK);
+    stack = sexp_alloc_tagged(res, SEXP_STACK_SIZE, SEXP_STACK);
-    sexp_stack_length(stack) = INIT_STACK_SIZE;
+    sexp_stack_length(stack) = SEXP_INIT_STACK_SIZE;
     sexp_stack_top(stack) = 0;
   }
   sexp_context_stack(res) = stack;
+  if (! ctx) sexp_init_eval_context_globals(res);
   sexp_context_env(res)
     = (env ? env : sexp_make_standard_env(res, sexp_make_fixnum(5)));
-  sexp_context_bc(res)
-    = sexp_alloc_tagged(ctx, sexp_sizeof(bytecode)+INIT_BCODE_SIZE,
-                        SEXP_BYTECODE);
-  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;
   if (ctx) sexp_gc_release1(ctx);
   return res;
 }
 
-sexp sexp_make_child_context(sexp context, sexp lambda) {
+sexp sexp_make_child_context (sexp ctx, sexp lambda) {
-  sexp ctx = sexp_make_context(context,
+  sexp res = sexp_make_eval_context(ctx,
-                               sexp_context_stack(context),
+                                    sexp_context_stack(ctx),
-                               sexp_context_env(context));
+                                    sexp_context_env(ctx));
-  sexp_context_parent(ctx) = context;
+  sexp_context_lambda(res) = lambda;
-  sexp_context_lambda(ctx) = lambda;
+  sexp_context_top(res) = sexp_context_top(ctx);
-  sexp_context_env(ctx) = sexp_context_env(context);
+  sexp_context_fv(res) = sexp_context_fv(ctx);
-  sexp_context_top(ctx) = sexp_context_top(context);
+  sexp_context_tracep(res) = sexp_context_tracep(ctx);
-  sexp_context_fv(ctx) = sexp_context_fv(context);
+  return res;
-  sexp_context_tracep(ctx) = sexp_context_tracep(context);
-  return ctx;
 }
 
+/**************************** identifiers *****************************/
+
 static sexp sexp_identifierp (sexp ctx, sexp x) {
   return sexp_make_boolean(sexp_idp(x));
 }
@@ -742,12 +751,6 @@ static void sexp_context_patch_label (sexp ctx, sexp_sint_t label) {
   *((sexp_sint_t*)data) = sexp_context_pos(ctx)-label;
 }
 
-static sexp finalize_bytecode (sexp ctx) {
-  emit(ctx, OP_RET);
-  shrink_bcode(ctx, sexp_context_pos(ctx));
-  return sexp_context_bc(ctx);
-}
-
 static void generate_lit (sexp ctx, sexp value) {
   emit_push(ctx, value);
 }
@@ -980,7 +983,7 @@ static void generate_lambda (sexp ctx, sexp lambda) {
   prev_lambda = sexp_context_lambda(ctx);
   prev_fv = sexp_lambdap(prev_lambda) ? sexp_lambda_fv(prev_lambda) : SEXP_NULL;
   fv = sexp_lambda_fv(lambda);
-  ctx2 = sexp_make_context(ctx, sexp_context_stack(ctx), sexp_context_env(ctx));
+  ctx2 = sexp_make_eval_context(ctx, sexp_context_stack(ctx), sexp_context_env(ctx));
   sexp_context_lambda(ctx2) = lambda;
   /* allocate space for local vars */
   for (ls=sexp_lambda_locals(lambda); sexp_pairp(ls); ls=sexp_cdr(ls))
@@ -1219,10 +1222,9 @@ sexp sexp_vm (sexp ctx, sexp proc) {
   self = proc;
 
  loop:
-#ifdef DEBUG_VM
+#if USE_DEBUG_VM
   if (sexp_context_tracep(ctx)) {
-    sexp_print_stack(ctx, stack, top, fp,
+    sexp_print_stack(ctx, stack, top, fp, SEXP_FALSE);
-                     sexp_env_global_ref(env, the_cur_err_symbol, SEXP_FALSE));
     fprintf(stderr, "%s\n", (*ip<=OP_NUM_OPCODES) ?
             reverse_opcode_names[*ip] : "UNKNOWN");
   }
@@ -1237,7 +1239,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
     stack[top+2] = self;
     stack[top+3] = sexp_make_fixnum(fp);
     top += 4;
-    self = sexp_env_global_ref(env, the_err_handler_symbol, SEXP_FALSE);
+    self = sexp_env_global_ref(env, sexp_global(ctx, SEXP_G_ERR_HANDLER_SYMBOL), SEXP_FALSE);
     bc = sexp_procedure_code(self);
     ip = sexp_bytecode_data(bc);
     cp = sexp_procedure_vars(self);
@@ -1267,8 +1269,10 @@ sexp sexp_vm (sexp ctx, sexp proc) {
     sexp_vector_set(tmp2,
                     sexp_make_fixnum(0),
                     sexp_save_stack(ctx, stack, top+4));
-    _ARG1 = sexp_make_procedure(ctx, sexp_make_fixnum(0),
+    _ARG1 = sexp_make_procedure(ctx,
-                                sexp_make_fixnum(1), continuation_resumer,
+                                sexp_make_fixnum(0),
+                                sexp_make_fixnum(1),
+                                sexp_global(ctx, SEXP_G_RESUMECC_BYTECODE),
                                 tmp2);
     top++;
     ip -= sizeof(sexp);
@@ -1302,7 +1306,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
     goto make_call;
   case OP_CALL:
 #if USE_CHECK_STACK
-    if (top+16 >= INIT_STACK_SIZE)
+    if (top+16 >= SEXP_INIT_STACK_SIZE)
       errx(70, "out of stack space at %ld", top);
 #endif
     i = sexp_unbox_fixnum(_WORD0);
@@ -1851,9 +1855,11 @@ sexp sexp_vm (sexp ctx, sexp proc) {
     if (sexp_flonump(_ARG1)) {
       if (sexp_flonum_value(_ARG1) != trunc(sexp_flonum_value(_ARG1))) {
         sexp_raise("inexact->exact: not an integer", sexp_list1(ctx, _ARG1));
+#if USE_BIGNUMS
       } else if ((sexp_flonum_value(_ARG1) > SEXP_MAX_FIXNUM)
                  || sexp_flonum_value(_ARG1) < SEXP_MIN_FIXNUM) {
         _ARG1 = sexp_double_to_bignum(ctx, sexp_flonum_value(_ARG1));
+#endif
       } else {
         _ARG1 = sexp_make_fixnum((sexp_sint_t)sexp_flonum_value(_ARG1));
       }
@@ -2015,14 +2021,13 @@ sexp sexp_load (sexp ctx, sexp source, sexp env) {
   sexp_gc_preserve4(ctx, ctx2, x, in, res);
   res = SEXP_VOID;
   in = sexp_open_input_file(ctx, source);
-  out = sexp_env_global_ref(env, the_cur_err_symbol, SEXP_FALSE);
+  out = sexp_current_error_port(ctx);
-  ctx2 = sexp_make_context(ctx, NULL, env);
+  ctx2 = sexp_make_eval_context(ctx, NULL, env);
   sexp_context_parent(ctx2) = ctx;
   tmp = sexp_env_bindings(env);
   sexp_context_tailp(ctx2) = 0;
   if (sexp_exceptionp(in)) {
-    if (sexp_not(out))
+    if (sexp_not(out)) out = sexp_current_error_port(ctx);
-      out = sexp_env_global_ref(sexp_context_env(ctx), the_cur_err_symbol, SEXP_FALSE);
     if (sexp_oportp(out))
       sexp_print_exception(ctx, in, out);
     res = in;
@@ -2124,8 +2129,10 @@ static sexp sexp_expt (sexp ctx, sexp x, sexp e) {
   if ((f > SEXP_MAX_FIXNUM) || sexp_flonump(x) || sexp_flonump(e)) {
     if (sexp_flonump(x) || sexp_flonump(e))
       res = sexp_make_flonum(ctx, f);
+#if USE_BIGNUMS
     else
       res = sexp_bignum_expt(ctx, sexp_fixnum_to_bignum(ctx, x), e);
+#endif
   } else
 #endif
     res = sexp_make_fixnum((sexp_sint_t)round(f));
@@ -2331,19 +2338,19 @@ static sexp sexp_make_standard_env (sexp ctx, sexp version) {
     sexp_env_define(ctx, e, sexp_intern(ctx, sexp_opcode_name(op)), op);
   }
   /* add io port and interaction env parameters */
-  sexp_env_define(ctx, e, the_cur_in_symbol,
+  sexp_env_define(ctx, e, sexp_global(ctx, SEXP_G_CUR_IN_SYMBOL),
                   sexp_make_input_port(ctx, stdin, SEXP_FALSE));
-  sexp_env_define(ctx, e, the_cur_out_symbol,
+  sexp_env_define(ctx, e, sexp_global(ctx, SEXP_G_CUR_OUT_SYMBOL),
                   sexp_make_output_port(ctx, stdout, SEXP_FALSE));
-  sexp_env_define(ctx, e, the_cur_err_symbol,
+  sexp_env_define(ctx, e, sexp_global(ctx, SEXP_G_CUR_ERR_SYMBOL),
                   sexp_make_output_port(ctx, stderr, SEXP_FALSE));
-  sexp_env_define(ctx, e, the_interaction_env_symbol, e);
+  sexp_env_define(ctx, e, sexp_global(ctx, SEXP_G_INTERACTION_ENV_SYMBOL), e);
   sexp_env_define(ctx, e, sexp_intern(ctx, "*module-directory*"),
                   sexp_c_string(ctx, sexp_module_dir, -1));
   /* add default exception handler */
-  err_cell = sexp_env_cell(e, the_cur_err_symbol);
+  err_cell = sexp_env_cell(e, sexp_global(ctx, SEXP_G_CUR_ERR_SYMBOL));
   perr_cell = sexp_env_cell(e, sexp_intern(ctx, "print-exception"));
-  ctx2 = sexp_make_context(ctx, sexp_context_stack(ctx), e);
+  ctx2 = sexp_make_eval_context(ctx, sexp_context_stack(ctx), e);
   sexp_context_tailp(ctx2) = 0;
   if (err_cell && perr_cell && sexp_opcodep(sexp_cdr(perr_cell))) {
     emit(ctx2, OP_GLOBAL_KNOWN_REF);
@@ -2361,7 +2368,7 @@ static sexp sexp_make_standard_env (sexp ctx, sexp version) {
                                     sexp_make_fixnum(0),
                                     finalize_bytecode(ctx2),
                                     tmp);
-  sexp_env_define(ctx2, e, the_err_handler_symbol, err_handler);
+  sexp_env_define(ctx2, e, sexp_global(ctx, SEXP_G_ERR_HANDLER_SYMBOL), err_handler);
   sexp_gc_release4(ctx);
   return e;
 }
@@ -2404,7 +2411,7 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
     stack[top] = sexp_make_fixnum(len);
     top++;
     stack[top++] = sexp_make_fixnum(0);
-    stack[top++] = final_resumer;
+    stack[top++] = sexp_global(ctx, SEXP_G_FINAL_RESUMER);
     stack[top++] = sexp_make_fixnum(0);
     sexp_context_top(ctx) = top;
     res = sexp_vm(ctx, proc);
@@ -2434,13 +2441,10 @@ sexp sexp_eval (sexp ctx, sexp obj, sexp env) {
   sexp res, ctx2;
   sexp_gc_var1(thunk);
   sexp_gc_preserve1(ctx, thunk);
-  ctx2 = sexp_make_context(ctx, NULL, (env ? env : sexp_context_env(ctx)));
+  ctx2 = sexp_make_eval_context(ctx, NULL, (env ? env : sexp_context_env(ctx)));
   thunk = sexp_compile(ctx2, obj);
   if (sexp_exceptionp(thunk)) {
-    sexp_print_exception(ctx2, thunk,
+    sexp_print_exception(ctx2, thunk, sexp_current_error_port(ctx));
-                         sexp_env_global_ref(sexp_context_env(ctx2),
-                                             the_cur_err_symbol,
-                                             SEXP_FALSE));
     res = thunk;
   } else {
     res = sexp_apply(ctx2, thunk, SEXP_NULL);
@@ -2460,34 +2464,8 @@ sexp sexp_eval_string (sexp ctx, char *str, sexp env) {
 }
 
 void sexp_scheme_init (void) {
-  sexp ctx;
   if (! scheme_initialized_p) {
     scheme_initialized_p = 1;
     sexp_init();
-    ctx = sexp_make_context(NULL, NULL, NULL);
-    the_compile_error_symbol = sexp_intern(ctx, "compile");
-    the_err_handler_symbol = sexp_intern(ctx, "*current-exception-handler*");
-    the_cur_in_symbol = sexp_intern(ctx, "*current-input-port*");
-    the_cur_out_symbol = sexp_intern(ctx, "*current-output-port*");
-    the_cur_err_symbol = sexp_intern(ctx, "*current-error-port*");
-    the_interaction_env_symbol = sexp_intern(ctx, "*interaction-environment*");
-#if USE_BOEHM
-    GC_add_roots((char*)&continuation_resumer,
-                 ((char*)&continuation_resumer)+sizeof(continuation_resumer)+1);
-    GC_add_roots((char*)&final_resumer,
-                 ((char*)&final_resumer)+sizeof(continuation_resumer)+1);
-    GC_add_roots((char*)&opcodes, ((char*)&opcodes)+sizeof(opcodes)+1);
-#endif
-    emit(ctx, OP_RESUMECC);
-    continuation_resumer = finalize_bytecode(ctx);
-    ctx = sexp_make_child_context(ctx, NULL);
-    emit(ctx, OP_DONE);
-    final_resumer = sexp_make_procedure(ctx,
-                                        sexp_make_fixnum(0),
-                                        sexp_make_fixnum(0),
-                                        finalize_bytecode(ctx),
-                                        sexp_make_vector(ctx, 0, SEXP_VOID));
-    sexp_bytecode_name(sexp_procedure_code(final_resumer))
-      = sexp_intern(ctx, "final-resumer");
   }
 }

gc.c

@@ -15,28 +15,14 @@
 #define sexp_heap_align(n) sexp_align(n, 4)
 #endif
 
-typedef struct sexp_free_list *sexp_free_list;
+#if USE_GLOBAL_HEAP
-struct sexp_free_list {
+static sexp_heap sexp_global_heap;
-  sexp_uint_t size;
+#endif
-  sexp_free_list next;
-};
-
-typedef struct sexp_heap *sexp_heap;
-struct sexp_heap {
-  sexp_uint_t size;
-  sexp_free_list free_list;
-  sexp_heap next;
-  char *data;
-};
-
-static sexp_heap heap;
 
 #if USE_DEBUG_GC
 static sexp* stack_base;
 #endif
 
-extern sexp continuation_resumer, final_resumer;
-
 static sexp_heap sexp_heap_last (sexp_heap h) {
   while (h->next) h = h->next;
   return h;
@@ -88,7 +74,7 @@ int stack_references_pointer_p (sexp ctx, sexp x) {
 
 sexp sexp_sweep (sexp ctx, size_t *sum_freed_ptr) {
   size_t freed, max_freed=0, sum_freed=0, size;
-  sexp_heap h = heap;
+  sexp_heap h = sexp_context_heap(ctx);
   sexp p;
   sexp_free_list q, r, s;
   char *end;
@@ -150,11 +136,11 @@ sexp sexp_sweep (sexp ctx, size_t *sum_freed_ptr) {
 
 sexp sexp_gc (sexp ctx, size_t *sum_freed) {
   sexp res;
+#if USE_GLOBAL_SYMBOLS
   int i;
-  sexp_mark(continuation_resumer);
-  sexp_mark(final_resumer);
   for (i=0; i<SEXP_SYMBOL_TABLE_SIZE; i++)
     sexp_mark(sexp_symbol_table[i]);
+#endif
   sexp_mark(ctx);
   res = sexp_sweep(ctx, sum_freed);
   return res;
@@ -179,7 +165,7 @@ sexp_heap sexp_make_heap (size_t size) {
 
 int sexp_grow_heap (sexp ctx, size_t size) {
   size_t cur_size, new_size;
-  sexp_heap h = sexp_heap_last(heap);
+  sexp_heap h = sexp_heap_last(sexp_context_heap(ctx));
   cur_size = h->size;
   new_size = sexp_heap_align(((cur_size > size) ? cur_size : size) * 2);
   h->next = sexp_make_heap(new_size);
@@ -189,7 +175,7 @@ int sexp_grow_heap (sexp ctx, size_t size) {
 void* sexp_try_alloc (sexp ctx, size_t size) {
   sexp_free_list ls1, ls2, ls3;
   sexp_heap h;
-  for (h=heap; h; h=h->next)
+  for (h=sexp_context_heap(ctx); h; h=h->next)
     for (ls1=h->free_list, ls2=ls1->next; ls2; ls1=ls2, ls2=ls2->next)
       if (ls2->size >= size) {
         if (ls2->size >= (size + SEXP_MINIMUM_OBJECT_SIZE)) {
@@ -214,7 +200,7 @@ void* sexp_alloc (sexp ctx, size_t size) {
   res = sexp_try_alloc(ctx, size);
   if (! res) {
     max_freed = sexp_unbox_fixnum(sexp_gc(ctx, &sum_freed));
-    h = sexp_heap_last(heap);
+    h = sexp_heap_last(sexp_context_heap(ctx));
     if (((max_freed < size)
          || ((h->size - sum_freed) < (h->size*(1 - SEXP_GROW_HEAP_RATIO))))
         && ((! SEXP_MAXIMUM_HEAP_SIZE) || (size < SEXP_MAXIMUM_HEAP_SIZE)))
@@ -227,8 +213,12 @@ void* sexp_alloc (sexp ctx, size_t size) {
 }
 
 void sexp_gc_init (void) {
+#if USE_GLOBAL_HEAP || USE_DEBUG_GC
   sexp_uint_t size = sexp_heap_align(SEXP_INITIAL_HEAP_SIZE);
-  heap = sexp_make_heap(size);
+#endif
+#if USE_GLOBAL_HEAP
+  sexp_global_heap = sexp_make_heap(size);
+#endif
 #if USE_DEBUG_GC
   /* the +32 is a hack, but this is just for debugging anyway */
   stack_base = ((sexp*)&size) + 32;

include/chibi/config.h

@@ -3,53 +3,109 @@
 /*  BSD-style license: http://synthcode.com/license.txt  */
 
 /* uncomment this to disable the module system */
+/*   Currently this just loads the config.scm from main and */
+/*   sets up an (import (module name)) macro. */
 /* #define USE_MODULES 0 */
 
 /* uncomment this to disable dynamic loading */
+/*   If enabled, you can LOAD .so files with a */
+/*   sexp_init_library(ctx, env) function provided. */
 /* #define USE_DL 0 */
 
 /* uncomment this to disable dynamic type definitions */
+/*   This enables register-simple-type and related */
+/*   opcodes for defining types, needed by the default */
+/*   implementation of (srfi 9). */
 /* #define USE_TYPE_DEFS 0 */
 
 /* uncomment this to use the Boehm conservative GC */
+/*   Conservative GCs make it easier to write extensions, */
+/*   since you don't have to keep track of intermediate */
+/*   variables, but can leak memory.  Boehm is also a */
+/*   very large library to link in.  You may want to */
+/*   enable this when debugging your own extensions, or */
+/*   if you suspect a bug in the native GC. */
 /* #define USE_BOEHM 1 */
 
 /* uncomment this to just malloc manually instead of any GC */
+/*   Mostly for debugging purposes, this is the no GC option. */
+/*   You can use the just with the read/write API and */
+/*   explicitly free sexps though. */
 /* #define USE_MALLOC 1 */
 
 /* uncomment this to add conservative checks to the native GC */
+/*   Please mail the author if enabling this makes a bug */
+/*   go away and you're not working on your own C extension. */
 /* #define USE_DEBUG_GC 1 */
 
-/* uncomment this if you only want fixnum support */
+/* uncomment this to make the heap common to all contexts */
+/*   By default separate contexts can have separate heaps, */
+/*   and are thus thread-safe and independant. */
+/* #define USE_GLOBAL_HEAP 1 */
+
+/* uncomment this to make the symbol table common to all contexts */
+/*   Will still be restricted to all contexts sharing the same */
+/*   heap, of course. */
+/* #define USE_GLOBAL_SYMBOLS 1 */
+
+/* uncomment this if you don't need flonum support */
+/*   This is only for EVAL - you'll still be able to read */
+/*   and write flonums directly through the sexp API. */
 /* #define USE_FLONUMS 0 */
 
 /* uncomment this if you want immediate flonums */
+/*   This is experimental, enablde at your own risk. */
 /* #define USE_IMMEDIATE_FLONUMS 1 */
 
 /* uncomment this if you don't want bignum support */
+/*   Bignums are implemented with a small, custom library  */
+/*   in opt/bignum.c. */
 /* #define USE_BIGNUMS 0 */
 
 /* uncomment this if you don't need extended math operations */
+/*   This includes the trigonometric and expt functions. */
+/*   Automatically disabled if you've disabled flonums. */
 /* #define USE_MATH 0 */
 
 /* uncomment this to disable warning about references to undefined variables */
+/*   This is something of a hack, but can be quite useful. */
+/*   It's very fast and doesn't involve any separate analysis */
+/*   passes. */
 /* #define USE_WARN_UNDEFS 0 */
 
 /* uncomment this to disable huffman-coded immediate symbols */
+/*   By default (this may change) small symbols are represented */
+/*   as immediates using a simple huffman encoding.  This keeps */
+/*   the symbol table small, and minimizes hashing when doing a */
+/*   lot of reading. */
 /* #define USE_HUFF_SYMS 0 */
 
 /* uncomment this to just use a single list for hash tables */
+/*   You can trade off some space in exchange for longer read */
+/*   times by disabling hashing and just putting all */
+/*   non-immediate symbols in a single list. */
 /* #define USE_HASH_SYMS 0 */
 
 /* uncomment this to disable string ports */
+/*   If disabled some basic functionality such as number->string */
+/*   will not be available by default. */
 /* #define USE_STRING_STREAMS 0 */
 
-/* uncomment this to enable stack overflow checks */
+/* uncomment this to disable stack overflow checks */
-/* #define USE_CHECK_STACK 1 */
+/*   By default stacks are fairly small, so it's good to leave */
+/*   this enabled. */
+/* #define USE_CHECK_STACK 0 */
 
 /* uncomment this to disable debugging utilities */
+/*   By default there's a `disasm' procedure you can use to */
+/*   view the compiled VM instructions of a procedure.  You can */
+/*   disable this if you don't need it. */
 /* #define USE_DEBUG 0 */
 
+/* #define USE_DEBUG_VM 0 */
+/*   Experts only. */
+/*   For *very* verbose output on every VM operation. */
+
 /************************************************************************/
 /*         DEFAULTS - DO NOT MODIFY ANYTHING BELOW THIS LINE            */
 /************************************************************************/
@@ -101,6 +157,22 @@
 #define USE_DEBUG_GC 0
 #endif
 
+#ifndef USE_GLOBAL_HEAP
+#if USE_BOEHM || USE_MALLOC
+#define USE_GLOBAL_HEAP 1
+#else
+#define USE_GLOBAL_HEAP 0
+#endif
+#endif
+
+#ifndef USE_GLOBAL_SYMBOLS
+#if USE_BOEHM || USE_MALLOC
+#define USE_GLOBAL_SYMBOLS 1
+#else
+#define USE_GLOBAL_SYMBOLS 0
+#endif
+#endif
+
 #ifndef USE_FLONUMS
 #define USE_FLONUMS 1
 #endif
@@ -114,7 +186,7 @@
 #endif
 
 #ifndef USE_MATH
-#define USE_MATH 1
+#define USE_MATH USE_FLONUMS
 #endif
 
 #ifndef USE_WARN_UNDEFS
@@ -133,6 +205,10 @@
 #define USE_DEBUG 1
 #endif
 
+#ifndef USE_DEBUG_VM
+#define USE_DEBUG_VM 0
+#endif
+
 #ifndef USE_STRING_STREAMS
 #define USE_STRING_STREAMS 1
 #endif

include/chibi/eval.h

@@ -9,13 +9,13 @@
 
 /************************* additional types ***************************/
 
-#define INIT_BCODE_SIZE 128
+#define SEXP_INIT_BCODE_SIZE 128
-#define INIT_STACK_SIZE 8192
+#define SEXP_INIT_STACK_SIZE 8192
 
 #define sexp_init_file "init.scm"
 #define sexp_config_file "config.scm"
 
-enum core_form_names {
+enum sexp_core_form_names {
   CORE_DEFINE = 1,
   CORE_SET,
   CORE_LAMBDA,
@@ -27,7 +27,7 @@ enum core_form_names {
   CORE_LETREC_SYNTAX
 };
 
-enum opcode_classes {
+enum sexp_opcode_classes {
   OPC_GENERIC = 1,
   OPC_TYPE_PREDICATE,
   OPC_PREDICATE,
@@ -42,7 +42,7 @@ enum opcode_classes {
   OPC_NUM_OP_CLASSES
 };
 
-enum opcode_names {
+enum sexp_opcode_names {
   OP_NOOP,
   OP_RAISE,
   OP_RESUMECC,
@@ -120,6 +120,8 @@ enum opcode_names {
 /**************************** prototypes ******************************/
 
 SEXP_API void sexp_scheme_init (void);
+SEXP_API sexp sexp_make_eval_context (sexp context, sexp stack, sexp env);
+SEXP_API sexp sexp_make_child_context (sexp context, sexp lambda);
 SEXP_API sexp sexp_apply (sexp context, sexp proc, sexp args);
 SEXP_API sexp sexp_eval (sexp context, sexp obj, sexp env);
 SEXP_API sexp sexp_eval_string (sexp context, char *str, sexp env);
@@ -127,7 +129,6 @@ SEXP_API sexp sexp_load (sexp context, sexp expr, sexp env);
 SEXP_API sexp sexp_make_env (sexp context);
 SEXP_API sexp sexp_env_copy (sexp context, sexp to, sexp from, sexp ls);
 SEXP_API void sexp_env_define (sexp context, sexp env, sexp sym, sexp val);
-SEXP_API sexp sexp_make_context (sexp context, sexp stack, sexp env);
 SEXP_API void sexp_warn_undefs (sexp ctx, sexp from, sexp to, sexp out);
 SEXP_API sexp sexp_make_opcode (sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc1);
 SEXP_API sexp sexp_make_foreign (sexp ctx, char *name, int num_args, int flags, sexp_proc1 f, sexp data);

include/chibi/sexp.h

@@ -127,6 +127,20 @@ typedef sexp (*sexp_proc5) (sexp, sexp, sexp, sexp, sexp);
 typedef sexp (*sexp_proc6) (sexp, sexp, sexp, sexp, sexp, sexp);
 typedef sexp (*sexp_proc7) (sexp, sexp, sexp, sexp, sexp, sexp, sexp);
 
+typedef struct sexp_free_list *sexp_free_list;
+struct sexp_free_list {
+  sexp_uint_t size;
+  sexp_free_list next;
+};
+
+typedef struct sexp_heap *sexp_heap;
+struct sexp_heap {
+  sexp_uint_t size;
+  sexp_free_list free_list;
+  sexp_heap next;
+  char *data;
+};
+
 struct sexp_gc_var_t {
   sexp *var;
   /* char *name; */
@@ -239,9 +253,10 @@ struct sexp_struct {
       sexp data[];
     } stack;
     struct {
+      sexp_heap heap;
       struct sexp_gc_var_t *saves;
       sexp_uint_t pos, depth, tailp, tracep;
-      sexp bc, lambda, stack, env, fv, parent;
+      sexp bc, lambda, stack, env, fv, parent, globals;
     } context;
   } value;
 };
@@ -561,8 +576,6 @@ SEXP_API sexp sexp_make_integer(sexp ctx, sexp_sint_t x);
 #define sexp_stack_top(x)     ((x)->value.stack.top)
 #define sexp_stack_data(x)    ((x)->value.stack.data)
 
-#define sexp_context_heap(x)    ((x)->value.context.heap)
-#define sexp_context_symbols(x) ((x)->value.context.symbols)
 #define sexp_context_env(x)     ((x)->value.context.env)
 #define sexp_context_stack(x)   ((x)->value.context.stack)
 #define sexp_context_depth(x)   ((x)->value.context.depth)
@@ -574,6 +587,21 @@ SEXP_API sexp sexp_make_integer(sexp ctx, sexp_sint_t x);
 #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)
+#define sexp_context_globals(x) ((x)->value.context.globals)
+
+#define sexp_global(ctx,x)      (sexp_vector_data(sexp_context_globals(ctx))[x])
+
+#if USE_GLOBAL_HEAP
+#define sexp_context_heap(ctx)  sexp_global_heap
+#else
+#define sexp_context_heap(ctx)  ((ctx)->value.context.heap)
+#endif
+
+#if USE_GLOBAL_SYMBOLS
+#define sexp_context_symbols(ctx) sexp_symbol_table
+#else
+#define sexp_context_symbols(ctx) sexp_vector_data(sexp_global(ctx, SEXP_G_SYMBOLS))
+#endif
 
 #define sexp_context_top(x)     (sexp_stack_top(sexp_context_stack(x)))
 
@@ -613,6 +641,25 @@ SEXP_API sexp sexp_make_integer(sexp ctx, sexp_sint_t x);
 
 /****************************** utilities *****************************/
 
+enum sexp_context_globals {
+#if ! USE_GLOBAL_SYMBOLS
+  SEXP_G_SYMBOLS,
+#endif
+  SEXP_G_QUOTE_SYMBOL,
+  SEXP_G_QUASIQUOTE_SYMBOL,
+  SEXP_G_UNQUOTE_SYMBOL,
+  SEXP_G_UNQUOTE_SPLICING_SYMBOL,
+  SEXP_G_EMPTY_VECTOR,
+  SEXP_G_CUR_IN_SYMBOL,
+  SEXP_G_CUR_OUT_SYMBOL,
+  SEXP_G_CUR_ERR_SYMBOL,
+  SEXP_G_ERR_HANDLER_SYMBOL,
+  SEXP_G_INTERACTION_ENV_SYMBOL,
+  SEXP_G_RESUMECC_BYTECODE,
+  SEXP_G_FINAL_RESUMER,
+  SEXP_G_NUM_GLOBALS
+};
+
 #define sexp_list1(x,a)        sexp_cons((x), (a), SEXP_NULL)
 
 #define sexp_push(ctx, ls, x)    ((ls) = sexp_cons((ctx), (x), (ls)))
@@ -668,6 +715,7 @@ SEXP_API sexp sexp_buffered_flush (sexp ctx, sexp p);
 #define sexp_newline(ctx, p) sexp_write_char(ctx, '\n', (p))
 
 SEXP_API struct sexp_struct *sexp_type_specs;
+SEXP_API sexp sexp_make_context(sexp ctx);
 SEXP_API sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag);
 SEXP_API sexp sexp_cons(sexp ctx, sexp head, sexp tail);
 SEXP_API sexp sexp_list2(sexp ctx, sexp a, sexp b);
@@ -710,10 +758,19 @@ SEXP_API sexp sexp_range_exception (sexp ctx, sexp obj, sexp start, sexp end);
 SEXP_API sexp sexp_print_exception(sexp ctx, sexp exn, sexp out);
 SEXP_API void sexp_init(void);
 
+#if USE_GLOBAL_HEAP
+#define sexp_destroy_context(ctx)
+#else
+SEXP_API void sexp_destroy_context(sexp ctx);
+#endif
+
 #if USE_TYPE_DEFS
 SEXP_API sexp sexp_register_type (sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp);
 SEXP_API sexp sexp_register_simple_type (sexp ctx, sexp name, sexp slots);
 #endif
 
+#define sexp_current_error_port(ctx) sexp_env_global_ref(sexp_context_env(ctx),sexp_global(ctx,SEXP_G_CUR_ERR_SYMBOL),SEXP_FALSE)
+#define sexp_debug(ctx, msg, obj) (sexp_write_string(ctx, msg, sexp_current_error_port(ctx)), sexp_write(ctx, obj, sexp_current_error_port(ctx)), sexp_write_char(ctx, '\n', sexp_current_error_port(ctx)))
+
 #endif /* ! SEXP_H */
 

main.c

@@ -128,7 +128,7 @@ void run_main (int argc, char **argv) {
   sexp_uint_t i, quit=0, init_loaded=0;
   sexp_gc_var1(str);
 
-  ctx = sexp_make_context(NULL, NULL, NULL);
+  ctx = sexp_make_eval_context(NULL, NULL, NULL);
   sexp_gc_preserve1(ctx, str);
   env = sexp_context_env(ctx);
   out = sexp_eval_string(ctx, "(current-output-port)", env);

opt/debug.c

@@ -65,9 +65,10 @@ static sexp sexp_disasm (sexp ctx, sexp bc, sexp out) {
   return SEXP_VOID;
 }
 
-#ifdef DEBUG_VM
+#if USE_DEBUG_VM
 static void sexp_print_stack (sexp ctx, sexp *stack, int top, int fp, sexp out) {
   int i;
+  if (! sexp_oport(out)) out = sexp_current_error_port(ctx);
   for (i=0; i<top; i++) {
     sexp_printf(ctx, out, "%s %02d: ", ((i==fp) ? "*" : " "), i);
     sexp_write(ctx, stack[i], out);

sexp.c

@@ -19,14 +19,6 @@ static struct sexp_huff_entry huff_table[] = {
 
 static int sexp_initialized_p = 0;
 
-static sexp the_dot_symbol;
-static sexp the_quote_symbol;
-static sexp the_quasiquote_symbol;
-static sexp the_unquote_symbol;
-static sexp the_unquote_splicing_symbol;
-static sexp the_read_error_symbol;
-static sexp the_empty_vector;
-
 sexp sexp_read_float_tail(sexp ctx, sexp in, sexp_uint_t whole, int negp);
 
 static char sexp_separators[] = {
@@ -51,7 +43,9 @@ static int is_separator(int c) {
   return 0<c && c<0x60 && sexp_separators[c];
 }
 
+#if USE_GLOBAL_SYMBOLS
 sexp sexp_symbol_table[SEXP_SYMBOL_TABLE_SIZE];
+#endif
 
 sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag) {
   sexp res = (sexp) sexp_alloc(ctx, size);
@@ -92,7 +86,7 @@ static struct sexp_struct _sexp_type_specs[] = {
   _DEF_TYPE(SEXP_SEQ, sexp_offsetof(seq, ls), 1, 1, 0, 0, sexp_sizeof(seq), 0, 0, "sequence"),
   _DEF_TYPE(SEXP_LIT, sexp_offsetof(lit, value), 1, 1, 0, 0, sexp_sizeof(lit), 0, 0, "literal"),
   _DEF_TYPE(SEXP_STACK, sexp_offsetof(stack, data), 1, 1, sexp_offsetof(stack, top), 1, sexp_sizeof(stack), offsetof(struct sexp_struct, value.stack.length), sizeof(sexp), "stack"),
-  _DEF_TYPE(SEXP_CONTEXT, sexp_offsetof(context, bc), 6, 6, 0, 0, sexp_sizeof(context), 0, 0, "context"),
+  _DEF_TYPE(SEXP_CONTEXT, sexp_offsetof(context, bc), 7, 7, 0, 0, sexp_sizeof(context), 0, 0, "context"),
 };
 #undef _DEF_TYPE
 
@@ -165,6 +159,83 @@ sexp sexp_register_simple_type (sexp ctx, sexp name, sexp slots) {
 
 #endif  /* ! USE_BOEHM */
 
+/****************************** contexts ******************************/
+
+void sexp_init_context_globals (sexp ctx) {
+  sexp_context_globals(ctx)
+    = sexp_make_vector(ctx, sexp_make_fixnum(SEXP_G_NUM_GLOBALS), SEXP_VOID);
+#if ! USE_GLOBAL_SYMBOLS
+  sexp_global(ctx, SEXP_G_SYMBOLS) = sexp_make_vector(ctx, sexp_make_fixnum(SEXP_SYMBOL_TABLE_SIZE), SEXP_NULL);
+#endif
+  sexp_global(ctx, SEXP_G_QUOTE_SYMBOL) = sexp_intern(ctx, "quote");
+  sexp_global(ctx, SEXP_G_QUASIQUOTE_SYMBOL) = sexp_intern(ctx, "quasiquote");
+  sexp_global(ctx, SEXP_G_UNQUOTE_SYMBOL) = sexp_intern(ctx, "unquote");
+  sexp_global(ctx, SEXP_G_UNQUOTE_SPLICING_SYMBOL) = sexp_intern(ctx, "unquote-splicing");
+  sexp_global(ctx, SEXP_G_CUR_IN_SYMBOL) = sexp_intern(ctx, "*current-input-port*");
+  sexp_global(ctx, SEXP_G_CUR_OUT_SYMBOL) = sexp_intern(ctx, "*current-output-port*");
+  sexp_global(ctx, SEXP_G_CUR_ERR_SYMBOL) = sexp_intern(ctx, "*current-error-port*");
+  sexp_global(ctx, SEXP_G_ERR_HANDLER_SYMBOL) = sexp_intern(ctx, "*current-exception-handler*");
+  sexp_global(ctx, SEXP_G_INTERACTION_ENV_SYMBOL) = sexp_intern(ctx, "*interaction-environment*");
+  sexp_global(ctx, SEXP_G_EMPTY_VECTOR) = sexp_alloc_type(ctx, vector, SEXP_VECTOR);
+  sexp_vector_length(sexp_global(ctx, SEXP_G_EMPTY_VECTOR)) = 0;
+}
+
+#if ! USE_GLOBAL_HEAP
+sexp sexp_bootstrap_context (void) {
+  sexp dummy_ctx, ctx;
+  sexp_heap heap = sexp_make_heap(sexp_heap_align(SEXP_INITIAL_HEAP_SIZE));
+  dummy_ctx = (sexp) malloc(sexp_sizeof(context));
+  sexp_pointer_tag(dummy_ctx) = SEXP_CONTEXT;
+  sexp_context_saves(dummy_ctx) = NULL;
+  sexp_context_heap(dummy_ctx) = heap;
+  ctx = sexp_alloc_type(dummy_ctx, context, SEXP_CONTEXT);
+  sexp_context_heap(dummy_ctx) = NULL;
+  sexp_context_heap(ctx) = heap;
+  return ctx;
+}
+#endif
+
+sexp sexp_make_context (sexp ctx) {
+  sexp_gc_var1(res);
+  if (ctx) sexp_gc_preserve1(ctx, res);
+#if ! USE_GLOBAL_HEAP
+  if (! ctx) res = sexp_bootstrap_context();
+  else
+#endif
+    {
+      res = sexp_alloc_type(ctx, context, SEXP_CONTEXT);
+#if ! USE_BOEHM && ! USE_MALLOC
+      sexp_context_heap(res) = sexp_context_heap(ctx);
+#endif
+    }
+  sexp_context_parent(res) = ctx;
+  sexp_context_lambda(res) = SEXP_FALSE;
+  sexp_context_fv(res) = SEXP_NULL;
+  sexp_context_saves(res) = 0;
+  sexp_context_depth(res) = 0;
+  sexp_context_pos(res) = 0;
+  sexp_context_tailp(res) = 1;
+  sexp_context_tracep(res) = 0;
+  if (ctx) {
+    sexp_context_globals(res) = sexp_context_globals(ctx);
+    sexp_gc_release1(ctx);
+  } else {
+    sexp_init_context_globals(res);
+  }
+  return res;
+}
+
+#if ! USE_GLOBAL_HEAP
+void sexp_destroy_context (sexp ctx) {
+  sexp_heap heap;
+  if (sexp_context_heap(ctx)) {
+    heap = sexp_context_heap(ctx);
+    sexp_context_heap(ctx) = NULL;
+    free(heap);
+  }
+}
+#endif
+
 /***************************** exceptions *****************************/
 
 sexp sexp_make_exception (sexp ctx, sexp kind, sexp message, sexp irritants,
@@ -275,16 +346,16 @@ sexp sexp_print_exception (sexp ctx, sexp exn, sexp out) {
 
 static sexp sexp_read_error (sexp ctx, char *msg, sexp irritants, sexp port) {
   sexp res;
-  sexp_gc_var3(name, str, irr);
+  sexp_gc_var4(sym, name, str, irr);
-  sexp_gc_preserve3(ctx, name, str, irr);
+  sexp_gc_preserve4(ctx, sym, name, str, irr);
   name = (sexp_port_name(port) ? sexp_port_name(port) : SEXP_FALSE);
   name = sexp_cons(ctx, name, sexp_make_fixnum(sexp_port_line(port)));
   str = sexp_c_string(ctx, msg, -1);
   irr = ((sexp_pairp(irritants) || sexp_nullp(irritants))
          ? irritants : sexp_list1(ctx, irritants));
-  res = sexp_make_exception(ctx, the_read_error_symbol,
+  res = sexp_make_exception(ctx, sym = sexp_intern(ctx, "read"),
                             str, irr, SEXP_FALSE, name);
-  sexp_gc_release3(ctx);
+  sexp_gc_release4(ctx);
   return res;
 }
 
@@ -386,7 +457,7 @@ sexp sexp_length (sexp ctx, sexp ls) {
 sexp sexp_equalp (sexp ctx, sexp a, sexp b) {
   sexp_uint_t size;
   sexp_sint_t i, len;
-  sexp t, tmp, *p, *q;
+  sexp t, *p, *q;
   char *p0, *q0;
 
  loop:
@@ -411,7 +482,7 @@ sexp sexp_equalp (sexp ctx, sexp a, sexp b) {
 
   if (sexp_pointer_tag(a) != sexp_pointer_tag(b)) {
 #if USE_BIGNUMS && ! USE_IMMEDIATE_FLONUMS
-    if (sexp_pointer_tag(a) == SEXP_FLONUM) {tmp=a; a=b; b=tmp;}
+    if (sexp_pointer_tag(a) == SEXP_FLONUM) {t=a; a=b; b=t;}
     if (sexp_pointer_tag(a) == SEXP_BIGNUM)
       return sexp_make_boolean((sexp_pointer_tag(b) == SEXP_FLONUM)
                                && sexp_fp_integerp(b)
@@ -577,7 +648,7 @@ sexp sexp_intern(sexp ctx, char *str) {
   bucket = 0;
 #endif
   len = strlen(str);
-  for (ls=sexp_symbol_table[bucket]; sexp_pairp(ls); ls=sexp_cdr(ls))
+  for (ls=sexp_context_symbols(ctx)[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);
 
@@ -585,7 +656,7 @@ sexp sexp_intern(sexp ctx, char *str) {
   sexp_gc_preserve1(ctx, sym);
   sym = sexp_alloc_type(ctx, symbol, SEXP_SYMBOL);
   sexp_symbol_string(sym) = sexp_c_string(ctx, str, len);
-  sexp_push(ctx, sexp_symbol_table[bucket], sym);
+  sexp_push(ctx, sexp_context_symbols(ctx)[bucket], sym);
   sexp_gc_release1(ctx);
   return sym;
 }
@@ -599,7 +670,7 @@ sexp sexp_string_to_symbol (sexp ctx, sexp str) {
 sexp sexp_make_vector(sexp ctx, sexp len, sexp dflt) {
   sexp v, *x;
   int i, clen = sexp_unbox_fixnum(len);
-  if (! clen) return the_empty_vector;
+  if (! clen) return sexp_global(ctx, SEXP_G_EMPTY_VECTOR);
   v = sexp_alloc_tagged(ctx, sexp_sizeof(vector) + clen*sizeof(sexp),
                         SEXP_VECTOR);
   x = sexp_vector_data(v);
@@ -1209,23 +1280,23 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
   case '\'':
     res = sexp_read(ctx, in);
     if (! sexp_exceptionp(res))
-      res = sexp_list2(ctx, the_quote_symbol, res);
+      res = sexp_list2(ctx, sexp_global(ctx, SEXP_G_QUOTE_SYMBOL), res);
     break;
   case '`':
     res = sexp_read(ctx, in);
     if (! sexp_exceptionp(res))
-      res = sexp_list2(ctx, the_quasiquote_symbol, res);
+      res = sexp_list2(ctx, sexp_global(ctx, SEXP_G_QUASIQUOTE_SYMBOL), res);
     break;
   case ',':
     if ((c1 = sexp_read_char(ctx, in)) == '@') {
       res = sexp_read(ctx, in);
       if (! sexp_exceptionp(res))
-        res = sexp_list2(ctx, the_unquote_splicing_symbol, res);
+        res = sexp_list2(ctx, sexp_global(ctx, SEXP_G_UNQUOTE_SPLICING_SYMBOL), res);
     } else {
       sexp_push_char(ctx, c1, in);
       res = sexp_read(ctx, in);
       if (! sexp_exceptionp(res))
-        res = sexp_list2(ctx, the_unquote_symbol, res);
+        res = sexp_list2(ctx, sexp_global(ctx, SEXP_G_UNQUOTE_SYMBOL), res);
     }
     break;
   case '"':
@@ -1472,28 +1543,24 @@ sexp sexp_write_to_string(sexp ctx, sexp obj) {
 }
 
 void sexp_init(void) {
+#if USE_GLOBAL_SYMBOLS
   int i;
-  sexp ctx;
+#endif
   if (! sexp_initialized_p) {
     sexp_initialized_p = 1;
 #if USE_BOEHM
     GC_init();
+#if USE_GLOBAL_SYMBOLS
     GC_add_roots((char*)&sexp_symbol_table,
                  ((char*)&sexp_symbol_table)+sizeof(sexp_symbol_table)+1);
+#endif
 #elif ! USE_MALLOC
     sexp_gc_init();
 #endif
+#if USE_GLOBAL_SYMBOLS
     for (i=0; i<SEXP_SYMBOL_TABLE_SIZE; i++)
       sexp_symbol_table[i] = SEXP_NULL;
-    ctx = sexp_alloc_type(NULL, context, SEXP_CONTEXT);
+#endif
-    the_dot_symbol = sexp_intern(ctx, ".");
-    the_quote_symbol = sexp_intern(ctx, "quote");
-    the_quasiquote_symbol = sexp_intern(ctx, "quasiquote");
-    the_unquote_symbol = sexp_intern(ctx, "unquote");
-    the_unquote_splicing_symbol = sexp_intern(ctx, "unquote-splicing");
-    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;
   }
 }