Garbage collection now much better, not good
There's clearly still a lot of things getting incremented but not decremented.
This commit is contained in:
parent
ad806de656
commit
7b126ea979
|
@ -2,3 +2,5 @@
|
|||
(lambda (n)
|
||||
(cond ((= n 1) 1)
|
||||
(t (* n (fact (- n 1)))))))
|
||||
|
||||
(fact 20)
|
||||
|
|
10
src/init.c
10
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 );
|
||||
}
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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 );
|
||||
|
|
|
@ -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 );
|
||||
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
10
src/repl.c
10
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 );
|
||||
}
|
||||
|
|
Loading…
Reference in a new issue