diff --git a/lisp/fact.lisp b/lisp/fact.lisp index 2f578a6..de1f12b 100644 --- a/lisp/fact.lisp +++ b/lisp/fact.lisp @@ -2,3 +2,5 @@ (lambda (n) (cond ((= n 1) 1) (t (* n (fact (- n 1))))))) + +(fact 20) diff --git a/src/init.c b/src/init.c index 4a2032d..65a6b84 100644 --- a/src/init.c +++ b/src/init.c @@ -133,8 +133,18 @@ int main( int argc, char *argv[] ) { bind_special( L"quote", &lisp_quote ); bind_special( L"set!", &lisp_set_shriek ); + debug_print(L"Initialised oblist\n", DEBUG_BOOTSTRAP); + debug_dump_object(oblist, DEBUG_BOOTSTRAP); + 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); + + if ( dump_at_end ) { dump_pages( stdout ); } diff --git a/src/memory/conspage.c b/src/memory/conspage.c index 3c32126..4fa1108 100644 --- a/src/memory/conspage.c +++ b/src/memory/conspage.c @@ -169,7 +169,7 @@ void free_cell( struct cons_pointer pointer ) { /* for vector space pointers, free the actual vector-space * object. Dangerous! */ debug_printf( DEBUG_ALLOC, - L"About to free vector-space object at %ld\n", + L"About to free vector-space object at 0x%lx\n", cell->payload.vectorp.address ); struct vector_space_object *vso = cell->payload.vectorp.address; @@ -181,7 +181,7 @@ void free_cell( struct cons_pointer pointer ) { free( ( void * ) cell->payload.vectorp.address ); debug_printf( DEBUG_ALLOC, - L"Freed vector-space object at %ld\n", + L"Freed vector-space object at 0x%lx\n", cell->payload.vectorp.address ); break; diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index 31927d8..6f89742 100644 --- a/src/memory/consspaceobject.c +++ b/src/memory/consspaceobject.c @@ -95,7 +95,7 @@ struct cons_pointer make_exception( struct cons_pointer message, struct cons_pointer pointer = allocate_cell( EXCEPTIONTAG ); struct cons_space_object *cell = &pointer2cell( pointer ); - inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do this, but if I don't the cell gets freed */ +// inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do this, but if I don't the cell gets freed */ inc_ref( message ); inc_ref( frame_pointer ); diff --git a/src/ops/intern.c b/src/ops/intern.c index e36437d..29848a7 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -128,8 +128,11 @@ bind( struct cons_pointer key, struct cons_pointer value, struct cons_pointer deep_bind( struct cons_pointer key, struct cons_pointer value ) { debug_print( L"Entering deep_bind\n", DEBUG_BIND ); + struct cons_pointer old = oblist; oblist = bind( key, value, oblist ); + inc_ref(oblist); + dec_ref(old); debug_print( L"Leaving deep_bind\n", DEBUG_BIND ); diff --git a/src/ops/lispops.c b/src/ops/lispops.c index b0a1a7e..1d9f2d3 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -194,9 +194,11 @@ struct cons_pointer eval_lambda( struct cons_space_object cell, struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { struct cons_pointer result = NIL; - debug_print( L"eval_lambda called\n", DEBUG_EVAL ); + debug_print( L"eval_lambda called\n", DEBUG_LAMBDA ); + 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; @@ -236,11 +238,19 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, struct cons_pointer sexpr = c_car( body ); body = c_cdr( body ); - debug_print( L"In lambda: ", DEBUG_LAMBDA ); + debug_print( L"In lambda: evaluating ", DEBUG_LAMBDA ); + debug_print_object(sexpr, DEBUG_LAMBDA); + debug_println( DEBUG_LAMBDA); result = eval_form( frame, frame_pointer, sexpr, new_env ); } + dec_ref(new_env); + + debug_print( L"eval_lambda returning: \n", DEBUG_LAMBDA ); + debug_print_object( result, DEBUG_LAMBDA); + debug_println(DEBUG_LAMBDA); + return result; } diff --git a/src/repl.c b/src/repl.c index 7914fd4..d07df94 100644 --- a/src/repl.c +++ b/src/repl.c @@ -112,9 +112,17 @@ repl( FILE * in_stream, FILE * out_stream, FILE * error_stream, } break; } else { - repl_print( output_stream, repl_eval( input ) ); + struct cons_pointer val = repl_eval( input ); + inc_ref(val); + repl_print( output_stream, val ); + dec_ref(val); } + dec_ref( input ); } + + dec_ref(input_stream); + dec_ref(output_stream); + debug_print( L"Leaving repl\n", DEBUG_REPL ); }