diff --git a/eval.c b/eval.c index aad0bd02..5ba4a3f0 100644 --- a/eval.c +++ b/eval.c @@ -2349,53 +2349,9 @@ sexp sexp_load_standard_ports (sexp ctx, sexp env, FILE* in, FILE* out, return SEXP_VOID; } -static const char* sexp_initial_features[] = { - sexp_platform, -#if SEXP_BSD - "bsd", -#endif -#if defined(_WIN32) || defined(__MINGW32__) - "windows", -#endif -#if SEXP_USE_DL - "dynamic-loading", -#endif -#if SEXP_USE_BIDIRECTIONAL_PORTS - "bidir-ports", -#endif -#if SEXP_USE_MODULES - "modules", -#endif -#if SEXP_USE_BOEHM - "boehm-gc", -#endif -#if SEXP_USE_UTF8_STRINGS - "full-unicode", -#endif -#if SEXP_USE_GREEN_THREADS - "threads", -#endif -#if SEXP_USE_NTP_GETTIME - "ntp", -#endif -#if SEXP_USE_AUTO_FORCE - "auto-force", -#endif -#if SEXP_USE_COMPLEX - "complex", -#endif -#if SEXP_USE_RATIOS - "ratios", -#endif - "r7rs", - "chibi", - NULL, -}; - sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) { int len; char init_file[128]; - const char** features; int endianess_check = 1; sexp_gc_var3(op, tmp, sym); sexp_gc_preserve3(ctx, op, tmp, sym); @@ -2404,9 +2360,7 @@ sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) { tmp=sexp_c_string(ctx, sexp_so_extension, -1)); tmp = SEXP_NULL; sexp_push(ctx, tmp, sym=sexp_intern(ctx, (*(unsigned char*) &endianess_check) ? "little-endian" : "big-endian", -1)); - for (features=sexp_initial_features; *features; features++) - sexp_push(ctx, tmp, sym=sexp_intern(ctx, *features, -1)); - sexp_env_define(ctx, e, sym=sexp_intern(ctx, "*features*", -1), tmp); + sexp_env_define(ctx, e, sym=sexp_intern(ctx, "*features*", -1), sexp_global(ctx, SEXP_G_FEATURES)); sexp_global(ctx, SEXP_G_OPTIMIZATIONS) = SEXP_NULL; #if SEXP_USE_SIMPLIFY op = sexp_make_foreign(ctx, "sexp_simplify", 1, 0, diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index 4104e953..b9c381f7 100755 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -1320,6 +1320,7 @@ enum sexp_context_globals { SEXP_G_SYMBOLS, #endif SEXP_G_TYPES, + SEXP_G_FEATURES, SEXP_G_NUM_TYPES, SEXP_G_OOM_ERROR, /* out of memory exception object */ SEXP_G_OOS_ERROR, /* out of stack exception object */ diff --git a/main.c b/main.c index 7cd94c4d..a4e1cf45 100644 --- a/main.c +++ b/main.c @@ -236,8 +236,8 @@ static sexp sexp_add_import_binding (sexp ctx, sexp env) { } static sexp sexp_load_standard_repl_env (sexp ctx, sexp env, sexp k, int bootp) { - sexp_gc_var1(e); - sexp_gc_preserve1(ctx, e); + sexp_gc_var3(e, ls, sym); + sexp_gc_preserve3(ctx, e, ls, sym); e = sexp_load_standard_env(ctx, env, k); if (!sexp_exceptionp(e)) { #if SEXP_USE_MODULES @@ -249,7 +249,7 @@ static sexp sexp_load_standard_repl_env (sexp ctx, sexp env, sexp k, int bootp) if (!sexp_exceptionp(e)) e = sexp_load_standard_params(ctx, e); } - sexp_gc_release1(ctx); + sexp_gc_release3(ctx); return e; } @@ -296,7 +296,7 @@ sexp run_main (int argc, char **argv) { sexp_sint_t i, j, c, quit=0, print=0, init_loaded=0, mods_loaded=0, fold_case=SEXP_DEFAULT_FOLD_CASE_SYMS; sexp_uint_t heap_size=0, heap_max_size=SEXP_MAXIMUM_HEAP_SIZE; - sexp out=SEXP_FALSE, ctx=NULL; + sexp out=SEXP_FALSE, ctx=NULL, ls; sexp_gc_var4(tmp, sym, args, env); args = SEXP_NULL; env = NULL; @@ -305,14 +305,14 @@ sexp run_main (int argc, char **argv) { for (i=1; i < argc && argv[i][0] == '-'; i++) { switch ((c=argv[i][1])) { case 'D': - mods_loaded = 1; - load_init(1); - tmp = sexp_env_ref(ctx, env, sym=sexp_intern(ctx, "*features*", -1), SEXP_NULL); - if (sexp_pairp(tmp)) { - sym = sexp_intern(ctx, ((argv[i][2] == '\0') ? argv[++i] : argv[i]+2), -1); - for (; sexp_pairp(sexp_cdr(tmp)); tmp=sexp_cdr(tmp)) + init_context(); + arg = (argv[i][2] == '\0') ? argv[++i] : argv[i]+2; + sym = sexp_intern(ctx, arg, -1); + ls = sexp_global(ctx, SEXP_G_FEATURES); + if (sexp_pairp(ls)) { + for (; sexp_pairp(sexp_cdr(ls)); ls=sexp_cdr(ls)) ; - sexp_cdr(tmp) = sexp_cons(ctx, sym, SEXP_NULL); + sexp_cdr(ls) = sexp_cons(ctx, sym, SEXP_NULL); } break; case 'e': diff --git a/sexp.c b/sexp.c index aba655fb..8b0cc939 100644 --- a/sexp.c +++ b/sexp.c @@ -381,9 +381,53 @@ sexp sexp_finalize_c_type (sexp ctx, sexp self, sexp_sint_t n, sexp obj) { /****************************** contexts ******************************/ +static const char* sexp_initial_features[] = { + sexp_platform, +#if SEXP_BSD + "bsd", +#endif +#if defined(_WIN32) || defined(__MINGW32__) + "windows", +#endif +#if SEXP_USE_DL + "dynamic-loading", +#endif +#if SEXP_USE_BIDIRECTIONAL_PORTS + "bidir-ports", +#endif +#if SEXP_USE_MODULES + "modules", +#endif +#if SEXP_USE_BOEHM + "boehm-gc", +#endif +#if SEXP_USE_UTF8_STRINGS + "full-unicode", +#endif +#if SEXP_USE_GREEN_THREADS + "threads", +#endif +#if SEXP_USE_NTP_GETTIME + "ntp", +#endif +#if SEXP_USE_AUTO_FORCE + "auto-force", +#endif +#if SEXP_USE_COMPLEX + "complex", +#endif +#if SEXP_USE_RATIOS + "ratios", +#endif + "r7rs", + "chibi", + NULL, +}; + void sexp_init_context_globals (sexp ctx) { - sexp type, *vec, print=NULL; + const char** features; int i; + sexp type, *vec, print=NULL; sexp_context_globals(ctx) = sexp_make_vector(ctx, sexp_make_fixnum(SEXP_G_NUM_GLOBALS), SEXP_VOID); #if ! SEXP_USE_GLOBAL_SYMBOLS @@ -415,6 +459,11 @@ void sexp_init_context_globals (sexp ctx) { sexp_global(ctx, SEXP_G_CONTINUABLE_SYMBOL) = sexp_intern(ctx, "continuable", -1); 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; + sexp_global(ctx, SEXP_G_FEATURES) = SEXP_NULL; + for (features=sexp_initial_features; *features; features++) { + sexp_push(ctx, sexp_global(ctx, SEXP_G_FEATURES), SEXP_FALSE); + sexp_car(sexp_global(ctx, SEXP_G_FEATURES)) = sexp_intern(ctx, *features, -1); + } sexp_global(ctx, SEXP_G_NUM_TYPES) = sexp_make_fixnum(SEXP_NUM_CORE_TYPES); sexp_global(ctx, SEXP_G_TYPES) = sexp_make_vector(ctx, sexp_make_fixnum(SEXP_INIT_NUM_TYPES), SEXP_VOID);