diff --git a/GNUmakefile b/GNUmakefile index 791f8a70..c6b8d9a1 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -67,6 +67,8 @@ MES:=./mes # use module/mes/read-0.mes rather than C-core reader MES_FLAGS:=--load export MES_FLAGS +MES_DEBUG:=1 +export MES_DEBUG mes-check: all set -e; for i in $(TESTS); do ./$$i; done diff --git a/define.c b/define.c index 49b71f9b..dd661218 100644 --- a/define.c +++ b/define.c @@ -29,19 +29,19 @@ SCM vm_define_env () { SCM x; - SCM name = cadr (r1); - if (TYPE (name) != PAIR) + r2 = cadr (r1); + if (TYPE (r2) != PAIR) x = eval_env (caddr (r1), cons (cons (cadr (r1), cadr (r1)), r0)); else { - name = car (name); + r2 = car (r2); SCM p = pairlis (cadr (r1), cadr (r1), r0); cache_invalidate_range (p, r0); x = eval_env (make_lambda (cdadr (r1), cddr (r1)), p); } if (eq_p (car (r1), cell_symbol_define_macro) == cell_t) - x = make_macro (name, x); + x = make_macro (r2, x); - SCM entry = cons (name, x); + SCM entry = cons (r2, x); SCM aa = cons (entry, cell_nil); set_cdr_x (aa, cdr (r0)); set_cdr_x (r0, aa); diff --git a/mes.c b/mes.c index cfb2925b..f9176c37 100644 --- a/mes.c +++ b/mes.c @@ -32,7 +32,9 @@ #define QUASISYNTAX 0 #define ENV_CACHE 1 -int ARENA_SIZE = 200000000; +//int ARENA_SIZE = 200000000; +// 30101417 +int ARENA_SIZE = 30000000; int GC_SAFETY = 10000; int GC_FREE = 20000; @@ -89,7 +91,7 @@ int g_function = 0; #include "string.h" #include "type.h" -SCM symbols = 0; +SCM g_symbols = 0; SCM stack = 0; SCM r0 = 0; // a/env SCM r1 = 0; // param 1 @@ -451,7 +453,10 @@ vm_eval_env () #endif #if 1 //!BOOT if (car (r1) == cell_symbol_set_x) - return set_env_x (cadr (r1), eval_env (caddr (r1), r0), r0); + { + SCM x = eval_env (caddr (r1), r0); + return set_env_x (cadr (r1), x, r0); + } #else assert (car (r1) != cell_symbol_set_x); #endif @@ -525,6 +530,15 @@ vm_if_env () return cell_unspecified; } +SCM +vm_call_with_values_env () +{ + SCM v = apply_env (r1, cell_nil, r0); + if (TYPE (v) == VALUES) + v = CDR (v); + return apply_env (r2, v, r0); +} + SCM call (SCM fn, SCM x) { @@ -579,7 +593,6 @@ vm_call (function0_t f, SCM p1, SCM p2, SCM a) { cache_invalidate_range (r0, cell_nil); gc_stack (stack); - frame = car (stack); } SCM r = f (); @@ -624,6 +637,12 @@ if_env (SCM e, SCM a) return vm_call (vm_if_env, e, cell_undefined, a); } +SCM +call_with_values_env (SCM producer, SCM consumer, SCM a) +{ + return vm_call (vm_call_with_values_env, producer, consumer, a); +} + SCM append2 (SCM x, SCM y) { @@ -707,7 +726,7 @@ internal_make_symbol (SCM s) { g_cells[tmp_num].value = SYMBOL; SCM x = make_cell (tmp_num, s, 0); - symbols = cons (x, symbols); + g_symbols = cons (x, g_symbols); return x; } @@ -737,15 +756,6 @@ values (SCM x) ///((arity . n)) return v; } -SCM -call_with_values_env (SCM producer, SCM consumer, SCM a) -{ - SCM v = apply_env (producer, cell_nil, a); - if (TYPE (v) == VALUES) - v = CDR (v); - return apply_env (consumer, v, a); -} - SCM vector_length (SCM x) { @@ -867,8 +877,23 @@ integer_to_char (SCM x) return make_char (VALUE (x)); } +void +make_tmps (scm* cells) +{ + tmp = g_free.value++; + cells[tmp].type = CHAR; + tmp_num = g_free.value++; + cells[tmp_num].type = NUMBER; + tmp_num2 = g_free.value++; + cells[tmp_num2].type = NUMBER; + tmp_num3 = g_free.value++; + cells[tmp_num3].type = NUMBER; + tmp_num4 = g_free.value++; + cells[tmp_num4].type = NUMBER; +} + // Jam Collector -SCM g_start; +SCM g_symbol_max; scm * gc_news () { @@ -882,18 +907,21 @@ gc_news () return g_news; } +bool g_debug = false; + SCM gc () { - fprintf (stderr, "***gc[%d]...", g_free.value); + if (g_debug) fprintf (stderr, "***gc[%d]...", g_free.value); g_free.value = 1; if (!g_news) gc_news (); - for (int i=g_free.value; i jam[%d]\n", g_free.value); + if (g_debug) fprintf (stderr, " => jam[%d]\n", g_free.value); return stack; } @@ -1014,23 +1042,12 @@ mes_symbols () ///((internal)) #include "mes.symbols.i" - SCM symbol_max = g_free.value; + g_symbol_max = g_free.value; + make_tmps (g_cells); - tmp = g_free.value++; - tmp_num = g_free.value++; - g_cells[tmp_num].type = NUMBER; - tmp_num2 = g_free.value++; - g_cells[tmp_num2].type = NUMBER; - tmp_num3 = g_free.value++; - g_cells[tmp_num3].type = NUMBER; - tmp_num4 = g_free.value++; - g_cells[tmp_num4].type = NUMBER; - - g_start = g_free.value; - - symbols = 0; - for (int i=1; i 1 && !strcmp (argv[1], "--dump")) g_dump_p = true; if (argc > 1 && !strcmp (argv[1], "--help")) return puts ("Usage: mes < FILE\n"); if (argc > 1 && !strcmp (argv[1], "--version")) return puts ("Mes 0.2\n"); @@ -1217,6 +1235,6 @@ main (int argc, char *argv[]) display_ (stderr, load_env (a)); fputs ("", stderr); gc (stack); - fprintf (stderr, "\nstats: [%d]\n", g_free.value); + if (g_debug) fprintf (stderr, "\nstats: [%d]\n", g_free.value); return 0; } diff --git a/reader.c b/reader.c index 383283e8..f82ff649 100644 --- a/reader.c +++ b/reader.c @@ -270,7 +270,7 @@ list_of_char_equal_p (SCM a, SCM b) SCM internal_lookup_symbol (SCM s) { - SCM x = symbols; + SCM x = g_symbols; while (x) { // .string and .name is the same field; .name is used as a handy // static field initializer. A string can only be mistaken for a