From d6b850b5aaf36fa353232d73c7d9ca2d8f3efabf Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sun, 14 Jun 2009 23:41:00 +0900 Subject: [PATCH] fixing some gc var preservation bugs --- eval.c | 69 ++++++++++++++++++++++++++++++++++++++-------------------- gc.c | 34 +++++++++++++++++++++++++---- main.c | 8 ++++--- sexp.c | 9 +++----- 4 files changed, 84 insertions(+), 36 deletions(-) diff --git a/eval.c b/eval.c index 47627c0e..b7a8fe1b 100644 --- a/eval.c +++ b/eval.c @@ -264,7 +264,7 @@ static sexp sexp_make_context(sexp ctx, sexp stack, sexp env) { 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; - sexp_context_parent(res) = SEXP_FALSE; + sexp_context_parent(res) = ctx; sexp_context_lambda(res) = SEXP_FALSE; sexp_context_fv(res) = SEXP_NULL; sexp_context_saves(res) = 0; @@ -343,11 +343,12 @@ static sexp sexp_identifier_eq(sexp ctx, sexp e1, sexp id1, sexp e2, sexp id2) { static sexp sexp_compile_error(sexp ctx, char *message, sexp obj) { sexp exn; sexp_gc_var(ctx, irritants, s_irr); + sexp_gc_var(ctx, msg, s_msg); sexp_gc_preserve(ctx, irritants, s_irr); + sexp_gc_preserve(ctx, msg, s_msg); irritants = sexp_list1(ctx, obj); - exn = sexp_make_exception(ctx, the_compile_error_symbol, - sexp_c_string(ctx, message, -1), - irritants, + msg = sexp_c_string(ctx, message, -1); + exn = sexp_make_exception(ctx, the_compile_error_symbol, msg, irritants, SEXP_FALSE, SEXP_FALSE, SEXP_FALSE); sexp_gc_release(ctx, irritants, s_irr); return exn; @@ -919,8 +920,7 @@ static void generate_general_app (sexp ctx, sexp app) { /* push the arguments onto the stack */ sexp_context_tailp(ctx) = 0; - for (ls = sexp_reverse(ctx, sexp_cdr(app)); sexp_pairp(ls); - ls = sexp_cdr(ls)) + for (ls=sexp_reverse(ctx, sexp_cdr(app)); sexp_pairp(ls); ls=sexp_cdr(ls)) generate(ctx, sexp_car(ls)); /* push the operator onto the stack */ @@ -942,10 +942,12 @@ static void generate_app (sexp ctx, sexp app) { } static void generate_lambda (sexp ctx, sexp lambda) { - sexp ctx2, fv, ls, flags, bc, len, ref, prev_lambda, prev_fv; + sexp ctx2, fv, ls, flags, len, ref, prev_lambda, prev_fv; sexp_uint_t k; sexp_gc_var(ctx, tmp, s_tmp); + sexp_gc_var(ctx, bc, s_bc); sexp_gc_preserve(ctx, tmp, s_tmp); + sexp_gc_preserve(ctx, bc, s_bc); prev_lambda = sexp_context_lambda(ctx); prev_fv = sexp_lambdap(prev_lambda) ? sexp_lambda_fv(prev_lambda) : SEXP_NULL; fv = sexp_lambda_fv(lambda); @@ -969,9 +971,9 @@ static void generate_lambda (sexp ctx, sexp lambda) { } sexp_context_tailp(ctx2) = 1; generate(ctx2, sexp_lambda_body(lambda)); - flags = sexp_make_integer((sexp_listp(ctx, sexp_lambda_params(lambda)) + flags = sexp_make_integer((sexp_listp(ctx2, sexp_lambda_params(lambda)) == SEXP_FALSE) ? 1 : 0); - len = sexp_length(ctx, sexp_lambda_params(lambda)); + len = sexp_length(ctx2, sexp_lambda_params(lambda)); bc = finalize_bytecode(ctx2); sexp_bytecode_name(bc) = sexp_lambda_name(lambda); if (sexp_nullp(fv)) { @@ -1034,9 +1036,9 @@ static sexp insert_free_var (sexp ctx, sexp x, sexp fv) { static sexp union_free_vars (sexp ctx, sexp fv1, sexp fv2) { sexp_gc_var(ctx, res, s_res); - sexp_gc_preserve(ctx, res, s_res); if (sexp_nullp(fv2)) return fv1; + sexp_gc_preserve(ctx, res, s_res); for (res=fv2; sexp_pairp(fv1); fv1=sexp_cdr(fv1)) res = insert_free_var(ctx, sexp_car(fv1), res); sexp_gc_release(ctx, res, s_res); @@ -1107,7 +1109,7 @@ static sexp make_opcode_procedure (sexp ctx, sexp op, sexp_uint_t i) { sexp_gc_var(ctx, ref, s_ref); sexp_gc_var(ctx, refs, s_refs); if (i == sexp_opcode_num_args(op) && sexp_opcode_proc(op)) - return sexp_opcode_proc(op); + return sexp_opcode_proc(op); /* return before preserving */ sexp_gc_preserve(ctx, params, s_params); sexp_gc_preserve(ctx, ref, s_ref); sexp_gc_preserve(ctx, refs, s_refs); @@ -1176,7 +1178,7 @@ static sexp_uint_t sexp_restore_stack(sexp saved, sexp *current) { goto call_error_handler;} \ while (0) -sexp vm (sexp proc, sexp ctx) { +sexp vm (sexp ctx, sexp proc) { sexp bc = sexp_procedure_code(proc), cp = sexp_procedure_vars(proc); sexp env = sexp_context_env(ctx), *stack = sexp_stack_data(sexp_context_stack(ctx)); @@ -1199,6 +1201,7 @@ sexp vm (sexp proc, sexp ctx) { fprintf(stderr, "%s\n", (*ip<=71)?reverse_opcode_names[*ip]:"UNKNOWN"); } #endif + sexp_context_top(ctx) = top; /* debugging */ switch (*ip++) { case OP_NOOP: break; @@ -1324,40 +1327,47 @@ sexp vm (sexp proc, sexp ctx) { fp = top-4; break; case OP_FCALL0: + sexp_context_top(ctx) = top; _PUSH(((sexp_proc1)_UWORD0)(ctx)); ip += sizeof(sexp); sexp_check_exception(); break; case OP_FCALL1: + sexp_context_top(ctx) = top; _ARG1 = ((sexp_proc2)_UWORD0)(ctx, _ARG1); ip += sizeof(sexp); sexp_check_exception(); break; case OP_FCALL2: + sexp_context_top(ctx) = top; _ARG2 = ((sexp_proc3)_UWORD0)(ctx, _ARG1, _ARG2); top--; ip += sizeof(sexp); sexp_check_exception(); break; case OP_FCALL3: + sexp_context_top(ctx) = top; _ARG3 =((sexp_proc4)_UWORD0)(ctx, _ARG1, _ARG2, _ARG3); top -= 2; ip += sizeof(sexp); sexp_check_exception(); break; case OP_FCALL4: + sexp_context_top(ctx) = top; _ARG4 =((sexp_proc5)_UWORD0)(ctx, _ARG1, _ARG2, _ARG3, _ARG4); top -= 3; ip += sizeof(sexp); sexp_check_exception(); break; case OP_FCALL5: + sexp_context_top(ctx) = top; _ARG5 =((sexp_proc6)_UWORD0)(ctx, _ARG1, _ARG2, _ARG3, _ARG4, _ARG5); top -= 4; ip += sizeof(sexp); sexp_check_exception(); break; case OP_FCALL6: + sexp_context_top(ctx) = top; _ARG6 =((sexp_proc7)_UWORD0)(ctx, _ARG1, _ARG2, _ARG3, _ARG4, _ARG5, _ARG6); top -= 5; ip += sizeof(sexp); @@ -1440,10 +1450,12 @@ sexp vm (sexp proc, sexp ctx) { _ARG1 = sexp_make_integer(sexp_string_length(_ARG1)); break; case OP_MAKE_PROCEDURE: + sexp_context_top(ctx) = top; _ARG4 = sexp_make_procedure(ctx, _ARG1, _ARG2, _ARG3, _ARG4); top-=3; break; case OP_MAKE_VECTOR: + sexp_context_top(ctx) = top; _ARG2 = sexp_make_vector(ctx, _ARG1, _ARG2); top--; break; @@ -1702,6 +1714,7 @@ sexp vm (sexp proc, sexp ctx) { _ARG1 = SEXP_VOID; break; case OP_READ: + sexp_context_top(ctx) = top; _ARG1 = sexp_read(ctx, _ARG1); sexp_check_exception(); break; @@ -1791,12 +1804,12 @@ sexp sexp_load (sexp ctx, sexp source, sexp env) { sexp_gc_preserve(ctx, ctx2, s_ctx2); sexp_gc_preserve(ctx, x, s_x); sexp_gc_preserve(ctx, in, s_in); + in = sexp_open_input_file(ctx, source); + out = env_global_ref(env, the_cur_err_symbol, SEXP_FALSE); ctx2 = sexp_make_context(ctx, NULL, env); sexp_context_parent(ctx2) = ctx; - out = env_global_ref(env, the_cur_err_symbol, SEXP_FALSE); tmp = sexp_env_bindings(env); sexp_context_tailp(ctx2) = 0; - in = sexp_open_input_file(ctx, source); if (sexp_exceptionp(in)) { sexp_print_exception(ctx, in, out); res = in; @@ -1995,37 +2008,47 @@ sexp apply (sexp ctx, sexp proc, sexp args) { stack[top++] = sexp_make_integer(sexp_bytecode_data(final_resumer)); stack[top++] = sexp_make_vector(ctx, 0, SEXP_VOID); stack[top++] = sexp_make_integer(0); - return vm(proc, ctx); + return vm(ctx, proc); } sexp compile (sexp ctx, sexp x) { - sexp res; sexp_gc_var(ctx, ast, s_ast); sexp_gc_var(ctx, ctx2, s_ctx2); + sexp_gc_var(ctx, vec, s_vec); + sexp_gc_var(ctx, res, s_res); sexp_gc_preserve(ctx, ast, s_ast); sexp_gc_preserve(ctx, ctx2, s_ctx2); + sexp_gc_preserve(ctx, vec, s_vec); + sexp_gc_preserve(ctx, res, s_res); analyze_bind(ast, x, ctx); free_vars(ctx, ast, SEXP_NULL); /* should return SEXP_NULL */ ctx2 = sexp_make_context(ctx, sexp_context_stack(ctx), sexp_context_env(ctx)); + sexp_context_parent(ctx2) = ctx; generate(ctx2, ast); - res = sexp_make_procedure(ctx, sexp_make_integer(0), - sexp_make_integer(0), - finalize_bytecode(ctx2), - sexp_make_vector(ctx, 0, SEXP_VOID)); + res = finalize_bytecode(ctx2); + vec = sexp_make_vector(ctx, 0, SEXP_VOID); + res = sexp_make_procedure(ctx, sexp_make_integer(0), sexp_make_integer(0), + res, vec); sexp_gc_release(ctx, ast, s_ast); return res; } sexp eval_in_context (sexp ctx, sexp obj) { - sexp thunk = compile(ctx, obj); + sexp res; + sexp_gc_var(ctx, thunk, s_thunk); + sexp_gc_preserve(ctx, thunk, s_thunk); + thunk = compile(ctx, obj); if (sexp_exceptionp(thunk)) { sexp_print_exception(ctx, thunk, env_global_ref(sexp_context_env(ctx), the_cur_err_symbol, SEXP_FALSE)); - return thunk; + res = thunk; + } else { + res = apply(ctx, thunk, SEXP_NULL); } - return apply(ctx, thunk, SEXP_NULL); + sexp_gc_release(ctx, thunk, s_thunk); + return res; } sexp eval (sexp obj, sexp env) { diff --git a/gc.c b/gc.c index 88013873..66a3730c 100644 --- a/gc.c +++ b/gc.c @@ -638,17 +638,42 @@ void validate_gc_vars (sexp ctx) { } } -int validate_freed_pointer (sexp x) { +int validate_freed_pointer (sexp ctx, sexp x) { int freep = 1; sexp *p; + struct sexp_gc_var_t *saves, *prev=NULL; + char *v1, *v2; + for (p=&x; pnext) { + if (saves->var && prev && prev->var + && (((saves->var <= p) && (prev->var >= p)) + || ((saves->var >= p) && (prev->var <= p)))) { + v1 = saves->name; + v2 = prev->name; + break; + } + prev = saves; + } + if (v1 && v2) + fprintf(stderr, "reference to freed var %p at %p between %s and %s: ", + x, p, v1, v2); + else if (sexp_context_saves(ctx) && (p <= sexp_context_saves(ctx)->var)) + fprintf(stderr, "reference to freed var %p at %p after %s: ", + x, p, sexp_context_saves(ctx)->name); + else if (prev && (p >= prev->var)) + fprintf(stderr, "reference to freed var %p at %p before %s: ", + x, p, prev->name); + else + fprintf(stderr, "reference to freed var %p at %p: ", x, p); simple_write(x, 1, stderr); putc('\n', stderr); freep = 0; } } + return freep; } @@ -669,7 +694,7 @@ sexp sexp_sweep (sexp ctx) { fprintf(stderr, "sweep: p: %p <= q: %p\n", p, q); } size = sexp_align(sexp_allocated_bytes(p), 4); - if ((! sexp_gc_mark(p)) && validate_freed_pointer(p)) { + if ((! sexp_gc_mark(p))/* && validate_freed_pointer(ctx, p) */) { /* fprintf(stderr, "\x1B[31mfreeing %lu bytes @ %p (%x) ", size, p, sexp_pointer_tag(p)); */ /* simple_write(p, 1, stderr); */ /* fprintf(stderr, "\x1B[0m\n"); */ @@ -870,6 +895,7 @@ void sexp_gc_init () { sexp_car(next) = (sexp) (size - sexp_align(sexp_sizeof(pair), 4)); sexp_cdr(next) = SEXP_NULL; stack_base = &next + 32; - fprintf(stderr, "heap: %p - %p, next: %p\n", sexp_heap, sexp_heap_end, next); + fprintf(stderr, "heap: %p - %p, next: %p, stack_base: %p\n", + sexp_heap, sexp_heap_end, next, stack_base); } diff --git a/main.c b/main.c index a9d12e04..0061dffd 100644 --- a/main.c +++ b/main.c @@ -2,7 +2,9 @@ #include "eval.c" void repl (sexp ctx) { - sexp obj, tmp, res, env, in, out, err; + sexp tmp, res, env, in, out, err; + sexp_gc_var(ctx, obj, s_obj); + sexp_gc_preserve(ctx, obj, s_obj); env = sexp_context_env(ctx); sexp_context_tracep(ctx) = 1; in = env_global_ref(env, the_cur_in_symbol, SEXP_FALSE); @@ -29,6 +31,7 @@ void repl (sexp ctx) { } } } + sexp_gc_release(ctx, obj, s_obj); } void run_main (int argc, char **argv) { @@ -36,12 +39,11 @@ void run_main (int argc, char **argv) { sexp_uint_t i, quit=0, init_loaded=0; ctx = sexp_make_context(NULL, NULL, NULL); - env = sexp_make_standard_env(ctx, sexp_make_integer(5)); + env = sexp_context_env(ctx); env_define(ctx, env, the_interaction_env_symbol, env); out = env_global_ref(env, the_cur_out_symbol, SEXP_FALSE); err_cell = env_cell(env, the_cur_err_symbol); perr_cell = env_cell(env, sexp_intern(ctx, "print-exception")); - sexp_context_env(ctx) = env; sexp_context_tailp(ctx) = 0; if (err_cell && perr_cell && sexp_opcodep(sexp_cdr(perr_cell))) { emit(ctx, OP_GLOBAL_KNOWN_REF); diff --git a/sexp.c b/sexp.c index 60ba2ad8..72f5e503 100644 --- a/sexp.c +++ b/sexp.c @@ -49,10 +49,7 @@ sexp sexp_symbol_table[SEXP_SYMBOL_TABLE_SIZE]; sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag) { sexp res = (sexp) sexp_alloc(ctx, size); - if (! res) - errx(EX_OSERR, "out of memory: couldn't allocate %ld bytes for %ld", - size ,tag); - sexp_pointer_tag(res) = tag; + if (res) sexp_pointer_tag(res) = tag; return res; } @@ -482,8 +479,8 @@ sexp sexp_make_vector(sexp ctx, sexp len, sexp dflt) { sexp v, *x; int i, clen = sexp_unbox_integer(len); if (! clen) return the_empty_vector; - v = sexp_alloc(ctx, sexp_sizeof(vector) + clen*sizeof(sexp)); - sexp_pointer_tag(v) = SEXP_VECTOR; + v = sexp_alloc_tagged(ctx, sexp_sizeof(vector) + clen*sizeof(sexp), + SEXP_VECTOR); x = sexp_vector_data(v); for (i=0; i