From c21a762413c71f4345fbf65b099fc6493ed2fd27 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 29 Dec 2018 20:03:06 +0000 Subject: [PATCH] Much better GC, still a few things being missed. --- .gitignore | 2 ++ src/arith/peano.c | 1 + src/init.c | 34 ++++++++++++++++++++++++++-------- src/memory/conspage.c | 1 + src/ops/lispops.c | 8 +++++++- src/ops/print.c | 24 ++++++++++++++++++------ 6 files changed, 55 insertions(+), 15 deletions(-) diff --git a/.gitignore b/.gitignore index 0742055..b428e03 100644 --- a/.gitignore +++ b/.gitignore @@ -30,3 +30,5 @@ log* \.settings/language\.settings\.xml utils_src/readprintwc/out + +*.dump diff --git a/src/arith/peano.c b/src/arith/peano.c index d040e28..a52f314 100644 --- a/src/arith/peano.c +++ b/src/arith/peano.c @@ -567,6 +567,7 @@ struct cons_pointer lisp_divide( struct struct cons_pointer one = make_integer( 1 ); struct cons_pointer ratio = make_ratio( frame_pointer, frame->arg[0], one ); + inc_ref( ratio ); result = divide_ratio_ratio( frame_pointer, ratio, frame->arg[1] ); diff --git a/src/init.c b/src/init.c index 65a6b84..9cbe701 100644 --- a/src/init.c +++ b/src/init.c @@ -30,15 +30,35 @@ void bind_function( wchar_t *name, struct cons_pointer ( *executable ) ( struct stack_frame *, struct cons_pointer, struct cons_pointer ) ) { - deep_bind( c_string_to_lisp_symbol( name ), - make_function( NIL, executable ) ); + struct cons_pointer n = c_string_to_lisp_symbol( name ); + inc_ref(n); + + /* TODO: where a function is not compiled from source, we could cache + * the name on the source pointer. Would make stack frames potentially + * more readable and aid debugging generally. */ + deep_bind( n, make_function( NIL, executable ) ); + + dec_ref(n); } void bind_special( wchar_t *name, struct cons_pointer ( *executable ) ( struct stack_frame *, struct cons_pointer, struct cons_pointer ) ) { - deep_bind( c_string_to_lisp_symbol( name ), - make_special( NIL, executable ) ); + struct cons_pointer n = c_string_to_lisp_symbol( name ); + inc_ref(n); + + deep_bind( n, make_special( NIL, executable ) ); + + dec_ref(n); +} + +void bind_value( wchar_t *name, struct cons_pointer value) { + struct cons_pointer n = c_string_to_lisp_symbol( name ); + inc_ref(n); + + deep_bind( n, value ); + + dec_ref(n); } int main( int argc, char *argv[] ) { @@ -87,8 +107,8 @@ int main( int argc, char *argv[] ) { /* * privileged variables (keywords) */ - deep_bind( c_string_to_lisp_symbol( L"nil" ), NIL ); - deep_bind( c_string_to_lisp_symbol( L"t" ), TRUE ); + bind_value( L"nil" , NIL ); + bind_value( L"t" , TRUE ); /* * primitive function operations @@ -139,8 +159,6 @@ int main( int argc, char *argv[] ) { repl( stdin, stdout, stderr, show_prompt ); debug_print(L"Freeing oblist\n", DEBUG_BOOTSTRAP); - debug_printf(DEBUG_BOOTSTRAP, L"Oblist has %u references\n", pointer2cell(oblist).count); - debug_dump_object(oblist, DEBUG_BOOTSTRAP); dec_ref(oblist); debug_dump_object(oblist, DEBUG_BOOTSTRAP); diff --git a/src/memory/conspage.c b/src/memory/conspage.c index 4fa1108..eee6d2d 100644 --- a/src/memory/conspage.c +++ b/src/memory/conspage.c @@ -145,6 +145,7 @@ void free_cell( struct cons_pointer pointer ) { break; case EXCEPTIONTV: dec_ref( cell->payload.exception.message ); + dec_ref( cell->payload.exception.frame ); break; case FUNCTIONTV: dec_ref( cell->payload.function.source ); diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 1d9f2d3..d94a2ff 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -198,7 +198,6 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, debug_println(DEBUG_LAMBDA); struct cons_pointer new_env = env; - inc_ref(new_env); struct cons_pointer names = cell.payload.lambda.args; struct cons_pointer body = cell.payload.lambda.body; @@ -214,6 +213,8 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, names = c_cdr( names ); } + inc_ref(new_env); + /* TODO: if there's more than `args_in_frame` arguments, bind those too. */ } else if ( symbolp( names ) ) { /* if `names` is a symbol, rather than a list of symbols, @@ -232,6 +233,7 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, } new_env = bind( names, vals, new_env ); + inc_ref(new_env); } while ( !nilp( body ) ) { @@ -242,6 +244,10 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, debug_print_object(sexpr, DEBUG_LAMBDA); debug_println( DEBUG_LAMBDA); + /* if a result is not the terminal result in the lambda, it's a + * side effect, and needs to be GCed */ + if (!nilp(result)) dec_ref(result); + result = eval_form( frame, frame_pointer, sexpr, new_env ); } diff --git a/src/ops/print.c b/src/ops/print.c index 6b971ef..6c0c6e7 100644 --- a/src/ops/print.c +++ b/src/ops/print.c @@ -130,20 +130,32 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) { } fwprintf( output, L"%ld%", cell.payload.integer.value ); break; - case LAMBDATV: - print( output, make_cons( c_string_to_lisp_symbol( L"lambda" ), + case LAMBDATV: { + struct cons_pointer to_print = make_cons( c_string_to_lisp_symbol( L"lambda" ), make_cons( cell.payload.lambda.args, cell.payload. - lambda.body ) ) ); + lambda.body )); + inc_ref(to_print); + + print( output, to_print ); + + dec_ref(to_print); + } break; case NILTV: fwprintf( output, L"nil" ); break; - case NLAMBDATV: - print( output, make_cons( c_string_to_lisp_symbol( L"nlambda" ), + case NLAMBDATV: { + struct cons_pointer to_print = make_cons( c_string_to_lisp_symbol( L"nlambda" ), make_cons( cell.payload.lambda.args, cell.payload. - lambda.body ) ) ); + lambda.body )); + inc_ref(to_print); + + print( output, to_print ); + + dec_ref(to_print); + } break; case RATIOTV: print( output, cell.payload.ratio.dividend );