sexp_make(_eval)_context now takes an extra parameter to specify the

initial heap size (available as the -h option on the command line).

eval.c

@@ -62,8 +62,8 @@ sexp sexp_env_cell (sexp env, sexp key) {
   return sexp_env_cell_loc(env, key, NULL);
 }
 
-static sexp sexp_env_cell_create_loc (sexp ctx, sexp env, sexp key,
-                                      sexp value, sexp *varenv) {
+static sexp sexp_env_cell_create (sexp ctx, sexp env, sexp key,
+                                  sexp value, sexp *varenv) {
   sexp_gc_var1(cell);
   cell = sexp_env_cell_loc(env, key, varenv);
   if (! cell) {
@@ -78,10 +78,6 @@ static sexp sexp_env_cell_create_loc (sexp ctx, sexp env, sexp key,
   return cell;
 }
 
-static sexp sexp_env_cell_create (sexp ctx, sexp env, sexp key, sexp value) {
-  return sexp_env_cell_create_loc(ctx, env, key, value, NULL);
-}
-
 sexp sexp_env_ref (sexp env, sexp key, sexp dflt) {
   sexp cell = sexp_env_cell(env, key);
   return (cell ? sexp_cdr(cell) : dflt);
@@ -348,10 +344,10 @@ void sexp_init_eval_context_globals (sexp ctx) {
   sexp_gc_release2(ctx);
 }
 
-sexp sexp_make_eval_context (sexp ctx, sexp stack, sexp env) {
+sexp sexp_make_eval_context (sexp ctx, sexp stack, sexp env, sexp_uint_t size) {
   sexp_gc_var1(res);
   if (ctx) sexp_gc_preserve1(ctx, res);
-  res = sexp_make_context(ctx);
+  res = sexp_make_context(ctx, size);
   sexp_context_bc(res) = sexp_alloc_bytecode(res, SEXP_INIT_BCODE_SIZE);
   sexp_bytecode_name(sexp_context_bc(res)) = SEXP_FALSE;
   sexp_bytecode_length(sexp_context_bc(res)) = SEXP_INIT_BCODE_SIZE;
@@ -371,7 +367,8 @@ sexp sexp_make_eval_context (sexp ctx, sexp stack, sexp env) {
 sexp sexp_make_child_context (sexp ctx, sexp lambda) {
   sexp res = sexp_make_eval_context(ctx,
                                     sexp_context_stack(ctx),
-                                    sexp_context_env(ctx));
+                                    sexp_context_env(ctx),
+                                    0);
   sexp_context_lambda(res) = lambda;
   sexp_context_top(res) = sexp_context_top(ctx);
   sexp_context_fv(res) = sexp_context_fv(ctx);
@@ -478,7 +475,7 @@ static sexp analyze_var_ref (sexp ctx, sexp x, sexp *varenv) {
         env = sexp_synclo_env(x);
       x = sexp_synclo_expr(x);
     }
-    cell = sexp_env_cell_create_loc(ctx, env, x, SEXP_UNDEF, varenv);
+    cell = sexp_env_cell_create(ctx, env, x, SEXP_UNDEF, varenv);
   }
   if (sexp_macrop(sexp_cdr(cell)) || sexp_corep(sexp_cdr(cell)))
     res = sexp_compile_error(ctx, "invalid use of syntax as value", x);
@@ -606,7 +603,7 @@ static sexp analyze_define (sexp ctx, sexp x) {
       res = SEXP_VOID;
     } else {
       if (sexp_synclop(name)) name = sexp_synclo_expr(name);
-      sexp_env_cell_create(ctx, env, name, SEXP_VOID);
+      sexp_env_cell_create(ctx, env, name, SEXP_VOID, NULL);
       if (sexp_pairp(sexp_cadr(x))) {
         tmp = sexp_cons(ctx, sexp_cdadr(x), sexp_cddr(x));
         tmp = sexp_cons(ctx, SEXP_VOID, tmp);
@@ -1041,7 +1038,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_eval_context(ctx, sexp_context_stack(ctx), sexp_context_env(ctx));
+  ctx2 = sexp_make_eval_context(ctx, sexp_context_stack(ctx), sexp_context_env(ctx), 0);
   sexp_context_lambda(ctx2) = lambda;
   /* allocate space for local vars */
   for (ls=sexp_lambda_locals(lambda); sexp_pairp(ls); ls=sexp_cdr(ls))
@@ -2090,7 +2087,7 @@ sexp sexp_load (sexp ctx, sexp source, sexp env) {
   res = SEXP_VOID;
   in = sexp_open_input_file(ctx, source);
   out = sexp_current_error_port(ctx);
-  ctx2 = sexp_make_eval_context(ctx, NULL, env);
+  ctx2 = sexp_make_eval_context(ctx, NULL, env, 0);
   sexp_context_parent(ctx2) = ctx;
   tmp = sexp_env_bindings(env);
   sexp_context_tailp(ctx2) = 0;
@@ -2437,7 +2434,7 @@ sexp sexp_make_primitive_env (sexp ctx, sexp version) {
     op = sexp_copy_opcode(ctx, &opcodes[i]);
     if (sexp_opcode_opt_param_p(op) && sexp_opcode_data(op)) {
       sym = sexp_intern(ctx, (char*)sexp_opcode_data(op));
-      sexp_opcode_data(op) = sexp_env_cell_create(ctx, e, sym, SEXP_VOID);
+      sexp_opcode_data(op) = sexp_env_cell_create(ctx, e, sym, SEXP_VOID, NULL);
     }
     sexp_env_define(ctx, e, sexp_intern(ctx, sexp_opcode_name(op)), op);
   }
@@ -2685,7 +2682,8 @@ sexp sexp_eval (sexp ctx, sexp obj, sexp env) {
   top = sexp_context_top(ctx);
   ctx2 = sexp_make_eval_context(ctx,
                                 sexp_context_stack(ctx),
-                                (env ? env : sexp_context_env(ctx)));
+                                (env ? env : sexp_context_env(ctx)),
+                                0);
   res = sexp_compile(ctx2, obj);
   if (! sexp_exceptionp(res))
     res = sexp_apply(ctx2, res, SEXP_NULL);

gc.c

@@ -16,6 +16,9 @@
 #ifndef SEXP_MAXIMUM_HEAP_SIZE
 #define SEXP_MAXIMUM_HEAP_SIZE 0
 #endif
+#ifndef SEXP_MINIMUM_HEAP_SIZE
+#define SEXP_MINIMUM_HEAP_SIZE 512*1024
+#endif
 
 /* if after GC more than this percentage of memory is still in use, */
 /* and we've not exceeded the maximum size, grow the heap */

include/chibi/config.h

@@ -280,26 +280,10 @@
 #endif
 
 #ifdef PLAN9
-
-#define errx(code, msg, ...) exits(msg)
-#define exit_normally() exits(NULL)
-#define exit_failure() exits("ERROR")
 #define strcasecmp cistrcmp
 #define strncasecmp cistrncmp
 #define round(x) floor((x)+0.5)
 #define trunc(x) floor((x)+0.5*(((x)<0)?1:0))
-
-#else
-
-#define exit_normally() exit(0)
-#define exit_failure() exit(EXIT_FAILURE)
-#if HAVE_ERR_H
-#include <err.h>
-#else
-/* requires msg be a string literal, and at least one argument */
-#define errx(code, msg, ...) (fprintf(stderr,msg"\n",__VA_ARGS__), exit(code))
-#endif
-
 #endif
 
 #ifdef __MINGW32__

include/chibi/eval.h

@@ -122,7 +122,7 @@ enum sexp_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_eval_context (sexp context, sexp stack, sexp env, sexp_uint_t size);
 SEXP_API sexp sexp_make_child_context (sexp context, sexp lambda);
 SEXP_API sexp sexp_analyze (sexp context, sexp x);
 SEXP_API sexp sexp_apply (sexp context, sexp proc, sexp args);

include/chibi/sexp.h

@@ -793,7 +793,7 @@ SEXP_API sexp sexp_buffered_flush (sexp ctx, sexp p);
 
 #define sexp_newline(ctx, p) sexp_write_char(ctx, '\n', (p))
 
-SEXP_API sexp sexp_make_context(sexp ctx);
+SEXP_API sexp sexp_make_context(sexp ctx, sexp_uint_t size);
 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);

main.c

@@ -10,6 +10,12 @@
 #define sexp_import_prefix "(import ("
 #define sexp_import_suffix "))"
 
+#ifdef PLAN9
+#define exit_failure() exits("ERROR")
+#else
+#define exit_failure() exit(1)
+#endif
+
 static void repl (sexp ctx) {
   sexp in, out, err;
   sexp_gc_var4(obj, tmp, res, env);
@@ -60,17 +66,20 @@ static sexp check_exception (sexp ctx, sexp res) {
   return res;
 }
 
-#define sexp_load_init() if (! init_loaded++) check_exception(ctx, sexp_load_standard_env(ctx, env, SEXP_FIVE))
+#define sexp_load_init() if (! init_loaded++) do {                      \
+      ctx = sexp_make_eval_context(NULL, NULL, NULL, heap_size);        \
+      env = sexp_context_env(ctx);                                      \
+      check_exception(ctx, sexp_load_standard_env(ctx, env, SEXP_FIVE)); \
+      sexp_gc_preserve2(ctx, str, args);                                \
+    } while (0)
 
 void run_main (int argc, char **argv) {
   char *arg, *impmod, *p;
-  sexp env, out=NULL, res=SEXP_VOID, ctx;
+  sexp env, out=NULL, res=SEXP_VOID, ctx=NULL;
   sexp_sint_t i, len, quit=0, print=0, init_loaded=0;
+  sexp_uint_t heap_size=0;
   sexp_gc_var2(str, args);
 
-  ctx = sexp_make_eval_context(NULL, NULL, NULL);
-  sexp_gc_preserve2(ctx, str, args);
-  env = sexp_context_env(ctx);
   out = SEXP_FALSE;
   args = SEXP_NULL;
 
@@ -113,8 +122,13 @@ void run_main (int argc, char **argv) {
       free(impmod);
       break;
     case 'q':
-      sexp_load_standard_parameters(ctx, env);
-      init_loaded = 1;
+      if (! ctx) {
+        ctx = sexp_make_eval_context(NULL, NULL, NULL, heap_size);
+        env = sexp_context_env(ctx);
+        sexp_gc_preserve2(ctx, str, args);
+      }
+      if (! init_loaded++)
+        sexp_load_standard_parameters(ctx, env);
       break;
     case 'A':
       arg = ((argv[i][2] == '\0') ? argv[++i] : argv[i]+2);
@@ -129,8 +143,19 @@ void run_main (int argc, char **argv) {
         args = sexp_cons(ctx, str=sexp_c_string(ctx,argv[argc],-1), args);
       argc++;
       break;
+    case 'h':
+      heap_size = atol(argv[++i]);
+      len = strlen(argv[i]);
+      if (heap_size && isalpha(argv[i][len-1])) {
+        switch (tolower(argv[i][len-1])) {
+        case 'k': heap_size *= 1024; break;
+        case 'm': heap_size *= (1024*1024); break;
+        }
+      }
+      break;
     default:
-      errx(1, "unknown option: %s", argv[i]);
+      fprintf(stderr, "unknown option: %s\n", argv[i]);
+      exit_failure();
     }
   }
 

opt/simplify.c

@@ -30,7 +30,7 @@ static sexp simplify (sexp ctx, sexp ast, sexp init_substs, sexp lambda) {
           }
         }
         if (check) {
-          ctx2 = sexp_make_eval_context(ctx, NULL, sexp_context_env(ctx));
+          ctx2 = sexp_make_eval_context(ctx, NULL, sexp_context_env(ctx), 0);
           generate(ctx2, app);
           app = finalize_bytecode(ctx2);
           if (! sexp_exceptionp(app)) {

sexp.c

@@ -242,9 +242,11 @@ void sexp_init_context_globals (sexp ctx) {
 }
 
 #if ! SEXP_USE_GLOBAL_HEAP
-sexp sexp_bootstrap_context (void) {
+sexp sexp_bootstrap_context (sexp_uint_t size) {
   sexp dummy_ctx, ctx;
-  sexp_heap heap = sexp_make_heap(sexp_heap_align(SEXP_INITIAL_HEAP_SIZE));
+  sexp_heap heap;
+  if (size < SEXP_MINIMUM_HEAP_SIZE) size = SEXP_INITIAL_HEAP_SIZE;
+  heap = sexp_make_heap(sexp_heap_align(size));
   dummy_ctx = (sexp) malloc(sexp_sizeof(context));
   sexp_pointer_tag(dummy_ctx) = SEXP_CONTEXT;
   sexp_context_saves(dummy_ctx) = NULL;
@@ -257,11 +259,11 @@ sexp sexp_bootstrap_context (void) {
 }
 #endif
 
-sexp sexp_make_context (sexp ctx) {
+sexp sexp_make_context (sexp ctx, sexp_uint_t size) {
   sexp_gc_var1(res);
   if (ctx) sexp_gc_preserve1(ctx, res);
 #if ! SEXP_USE_GLOBAL_HEAP
-  if (! ctx) res = sexp_bootstrap_context();
+  if (! ctx) res = sexp_bootstrap_context(size);
   else
 #endif
     {