From 2810fb8b1b56ab13434e1c422ec073dd46c31a20 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Mon, 28 Dec 2009 13:09:43 +0900 Subject: [PATCH] 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 | 28 +++++++++++++--------------- gc.c | 3 +++ include/chibi/config.h | 16 ---------------- include/chibi/eval.h | 2 +- include/chibi/sexp.h | 2 +- main.c | 41 +++++++++++++++++++++++++++++++++-------- opt/simplify.c | 2 +- sexp.c | 10 ++++++---- 8 files changed, 58 insertions(+), 46 deletions(-) diff --git a/eval.c b/eval.c index 9958998f..a8b7ed8e 100644 --- a/eval.c +++ b/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); diff --git a/gc.c b/gc.c index 7a5b409c..1130c15b 100644 --- a/gc.c +++ b/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 */ diff --git a/include/chibi/config.h b/include/chibi/config.h index ce14091a..a3301d22 100644 --- a/include/chibi/config.h +++ b/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 -#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__ diff --git a/include/chibi/eval.h b/include/chibi/eval.h index 297f2b70..60201c61 100644 --- a/include/chibi/eval.h +++ b/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); diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index 13854cfd..44b7cc7a 100644 --- a/include/chibi/sexp.h +++ b/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); diff --git a/main.c b/main.c index 55fa6dba..77d910b7 100644 --- a/main.c +++ 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(); } } diff --git a/opt/simplify.c b/opt/simplify.c index e01e4042..d70de633 100644 --- a/opt/simplify.c +++ b/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)) { diff --git a/sexp.c b/sexp.c index a0657df8..51e97c19 100644 --- a/sexp.c +++ b/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 {