From 96dad29f91480736011f9f5ff31174f3c5e4d698 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 28 Dec 2018 21:21:11 +0000 Subject: [PATCH] Good news: only one test failing. Bad news: it's nlambda. --- src/debug.c | 15 +++++++++ src/debug.h | 1 + src/memory/dump.c | 4 ++- src/memory/stack.c | 76 ++++++++++++++++++---------------------------- src/memory/stack.h | 4 ++- src/ops/intern.c | 6 ++++ src/ops/lispops.c | 42 +++++++++++-------------- src/repl.c | 22 ++++---------- 8 files changed, 80 insertions(+), 90 deletions(-) diff --git a/src/debug.c b/src/debug.c index 657998f..b21f4af 100644 --- a/src/debug.c +++ b/src/debug.c @@ -42,6 +42,21 @@ void debug_print( wchar_t *message, int level ) { #endif } +/** + * print a line feed to stderr, if `verbosity` matches `level`. + * `verbosity is a set of flags, see debug_print.h; so you can + * turn debugging on for only one part of the system. + */ +void debug_println( int level ) { +#ifdef DEBUG + if ( level & verbosity ) { + fwide( stderr, 1 ); + fputws( L"\n", stderr ); + } +#endif +} + + /** * `wprintf` adapted for the debug logging system. Print to stderr only * `verbosity` matches `level`. All other arguments as for `wprintf`. diff --git a/src/debug.h b/src/debug.h index 10d07c3..22f5591 100644 --- a/src/debug.h +++ b/src/debug.h @@ -25,6 +25,7 @@ extern int verbosity; void debug_print( wchar_t *message, int level ); +void debug_println( int level ); void debug_printf( int level, wchar_t * format, ...); void debug_print_object( struct cons_pointer pointer, int level ); void debug_dump_object( struct cons_pointer pointer, int level ); diff --git a/src/memory/dump.c b/src/memory/dump.c index 3129761..e88332a 100644 --- a/src/memory/dump.c +++ b/src/memory/dump.c @@ -62,11 +62,13 @@ void dump_object( FILE * output, struct cons_pointer pointer ) { switch ( cell.tag.value ) { case CONSTV: fwprintf( output, - L"\t\tCons cell: car at page %d offset %d, cdr at page %d offset %d, count %u\n", + L"\t\tCons cell: car at page %d offset %d, cdr at page %d offset %d, count %u :", cell.payload.cons.car.page, cell.payload.cons.car.offset, cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset, cell.count ); + print( output, pointer); + fputws( L"\n", output); break; case EXCEPTIONTV: fwprintf( output, L"\t\tException cell: " ); diff --git a/src/memory/stack.c b/src/memory/stack.c index a167244..f91d896 100644 --- a/src/memory/stack.c +++ b/src/memory/stack.c @@ -26,6 +26,18 @@ #include "stack.h" #include "vectorspace.h" +void set_reg(struct stack_frame * frame, int reg, struct cons_pointer value) { + debug_printf(DEBUG_STACK, L"Setting register %d to ", reg); + debug_print_object(value, DEBUG_STACK); + debug_println(DEBUG_STACK); + frame->arg[reg++] = value; + inc_ref(value); + if (reg > frame->args) { + frame->args = reg; + } +} + + /** * get the actual stackframe object from this `pointer`, or NULL if * `pointer` is not a stackframe pointer. @@ -53,32 +65,24 @@ struct stack_frame *get_stack_frame( struct cons_pointer pointer ) { * @return the new frame, or NULL if memory is exhausted. */ struct cons_pointer make_empty_frame( struct cons_pointer previous ) { - debug_print( L"Entering make_empty_frame\n", DEBUG_STACK ); + debug_print( L"Entering make_empty_frame\n", DEBUG_ALLOC ); struct cons_pointer result = make_vso( STACKFRAMETAG, sizeof( struct stack_frame ) ); - debug_dump_object( result, DEBUG_STACK ); + debug_dump_object( result, DEBUG_ALLOC ); - debug_printf( DEBUG_STACK, - L"make_empty_frame: got vector_space_object with size %lu, tag %4.4s\n", - pointer_to_vso( result )->header.size, - &pointer_to_vso( result )->header.tag.bytes ); +// debug_printf( DEBUG_STACK, +// L"make_empty_frame: got vector_space_object with size %lu, tag %4.4s\n", +// pointer_to_vso( result )->header.size, +// &pointer_to_vso( result )->header.tag.bytes ); if ( !nilp( result ) ) { - debug_print( L"make_empty_frame: about to call get_stack_frame\n", - DEBUG_STACK ); struct stack_frame *frame = get_stack_frame( result ); /* * TODO: later, pop a frame off a free-list of stack frames */ - debug_printf( DEBUG_STACK, - L"make_empty_frame: about to set previous to %4.4s\n", - &pointer2cell( previous ).tag.bytes ); frame->previous = previous; - debug_print( L"make_empty_frame: about to call inc_ref\n", - DEBUG_STACK ); - inc_ref( previous ); /* * clearing the frame with memset would probably be slightly quicker, but @@ -88,13 +92,12 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) { frame->function = NIL; frame->args = 0; - debug_print( L"make_empty_frame: about to initialise arg registers\n", - DEBUG_STACK ); for ( int i = 0; i < args_in_frame; i++ ) { - set_reg( frame, i, NIL ); + frame->arg[i] = NIL; } } - debug_print( L"Leaving make_empty_frame\n", DEBUG_STACK ); + debug_print( L"Leaving make_empty_frame\n", DEBUG_ALLOC ); + debug_dump_object( result, DEBUG_ALLOC); return result; } @@ -121,8 +124,7 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous, } else { struct stack_frame *frame = get_stack_frame( result ); - for ( frame->args = 0; frame->args < args_in_frame && consp( args ); - frame->args++ ) { + while ( frame->args < args_in_frame && consp( args )) { /* iterate down the arg list filling in the arg slots in the * frame. When there are no more slots, if there are still args, * stash them on more */ @@ -134,23 +136,7 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous, * processor to be evaled in parallel; but see notes here: * https://github.com/simon-brooke/post-scarcity/wiki/parallelism */ - struct cons_pointer arg_frame_pointer = make_empty_frame( result ); - inc_ref( arg_frame_pointer ); - - if ( nilp( arg_frame_pointer ) ) { - result = - make_exception( c_string_to_lisp_string - ( L"Memory exhausted." ), previous ); - break; - } else { - struct stack_frame *arg_frame = - get_stack_frame( arg_frame_pointer ); - debug_print( L"Setting argument 0 of arg_frame to ", DEBUG_STACK); - debug_print_object(cell.payload.cons.car, DEBUG_STACK); - set_reg( arg_frame, 0, cell.payload.cons.car ); - - struct cons_pointer val = - lisp_eval( arg_frame, arg_frame_pointer, env ); + struct cons_pointer val = eval_form(frame, result, cell.payload.cons.car, env); if ( exceptionp( val ) ) { result = val; break; @@ -160,11 +146,9 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous, set_reg( frame, frame->args, val ); } - dec_ref( arg_frame_pointer ); - args = cell.payload.cons.cdr; } - } + if ( !exceptionp( result ) ) { if ( consp( args ) ) { /* if we still have args, eval them and stick the values on `more` */ @@ -175,10 +159,10 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous, inc_ref( more ); } - debug_dump_object( result, DEBUG_STACK ); } } - debug_print( L"Leaving make_stack_frame\n", DEBUG_STACK ); + debug_print( L"make_stack_frame: returning\n", DEBUG_STACK ); + debug_dump_object( result, DEBUG_STACK ); return result; } @@ -206,8 +190,7 @@ struct cons_pointer make_special_frame( struct cons_pointer previous, } else { struct stack_frame *frame = get_stack_frame( result ); - for ( frame->args = 0; frame->args < args_in_frame && !nilp( args ); - frame->args++ ) { + while ( frame->args < args_in_frame && !nilp( args )) { /* iterate down the arg list filling in the arg slots in the * frame. When there are no more slots, if there are still args, * stash them on more */ @@ -222,11 +205,10 @@ struct cons_pointer make_special_frame( struct cons_pointer previous, frame->more = args; inc_ref( args ); } - - debug_dump_object( result, DEBUG_STACK ); } } - debug_print( L"Leaving make_special_frame\n", DEBUG_STACK ); + debug_print( L"make_special_frame: returning\n", DEBUG_STACK ); + debug_dump_object( result, DEBUG_STACK ); return result; } diff --git a/src/memory/stack.h b/src/memory/stack.h index b56f432..79cd1e2 100644 --- a/src/memory/stack.h +++ b/src/memory/stack.h @@ -39,7 +39,9 @@ * set a register in a stack frame. Alwaye use this macro to do so, • because that way we can be sure the inc_ref happens! */ -#define set_reg(frame,register,value){frame->arg[register]=value; inc_ref(value);} +//#define set_reg(frame,register,value){frame->arg[register]=value; inc_ref(value);} + +void set_reg(struct stack_frame * frame, int reg, struct cons_pointer value); struct stack_frame *get_stack_frame( struct cons_pointer pointer ); diff --git a/src/ops/intern.c b/src/ops/intern.c index 8dea7c8..27c745d 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -111,6 +111,12 @@ struct cons_pointer c_assoc( struct cons_pointer key, struct cons_pointer bind( struct cons_pointer key, struct cons_pointer value, struct cons_pointer store ) { + debug_print(L"Binding ", DEBUG_ALLOC); + debug_print_object(key, DEBUG_ALLOC); + debug_print(L" to ", DEBUG_ALLOC); + debug_print_object(value, DEBUG_ALLOC); + debug_println(DEBUG_ALLOC); + return make_cons( make_cons( key, value ), store ); } diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 43665e9..79195e4 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -94,6 +94,7 @@ struct cons_pointer eval_form( struct stack_frame *parent, struct stack_frame *next = get_stack_frame( next_pointer ); set_reg( next, 0, form ); + next->args = 1; result = lisp_eval( next, next_pointer, env ); @@ -253,25 +254,15 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, struct cons_pointer c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { - struct cons_pointer result = NIL; + debug_print(L"Entering c_apply\n", DEBUG_EVAL); + struct cons_pointer result = NIL; - /* construct a child frame and within it evaluate the first argument - the - * argument in the function position. */ - struct cons_pointer fn_frame_pointer = make_empty_frame( frame_pointer ); - inc_ref( fn_frame_pointer ); - struct stack_frame *fn_frame = get_stack_frame( fn_frame_pointer ); - - set_reg( fn_frame, 0, c_car( frame->arg[0] ) ); struct cons_pointer fn_pointer = - lisp_eval( fn_frame, fn_frame_pointer, env ); - - if ( !exceptionp( result ) ) { - /* if we're returning an exception, we should NOT free the - * stack frame. Corollary is, when we free an exception, we - * should free all the frames it's holding on to. */ - dec_ref( fn_frame_pointer ); - } + eval_form( frame, frame_pointer, c_car( frame->arg[0] ), env ); + if ( exceptionp( fn_pointer ) ) { + result = fn_pointer; + } else { struct cons_space_object fn_cell = pointer2cell( fn_pointer ); struct cons_pointer args = c_cdr( frame->arg[0] ); @@ -327,9 +318,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, struct stack_frame *next = get_stack_frame( frame_pointer ); result = eval_lambda( fn_cell, next, next_pointer, env ); - if ( !exceptionp( result ) ) { dec_ref( next_pointer ); - } } } break; @@ -341,15 +330,14 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, if ( exceptionp( next_pointer ) ) { result = next_pointer; } else { - struct stack_frame *next = - get_stack_frame( frame_pointer ); result = - ( *fn_cell.payload.special.executable ) ( next, + ( *fn_cell.payload.special.executable ) ( get_stack_frame( next_pointer ), next_pointer, env ); - if ( !exceptionp( result ) ) { - dec_ref( next_pointer ); - } + debug_print(L"Special form returning: ", DEBUG_EVAL); + debug_print_object(result, DEBUG_EVAL); + debug_println(DEBUG_EVAL); + dec_ref( next_pointer ); } } break; @@ -367,7 +355,11 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, result = throw_exception( message, frame_pointer ); } } - dec_ref( fn_frame_pointer ); + } + + debug_print(L"c_apply: returning: ", DEBUG_EVAL); + debug_print_object(result, DEBUG_EVAL); + debug_println(DEBUG_EVAL); return result; } diff --git a/src/repl.c b/src/repl.c index 04cf33c..e0170b6 100644 --- a/src/repl.c +++ b/src/repl.c @@ -52,16 +52,11 @@ struct cons_pointer repl_read( struct cons_pointer stream_pointer ) { * Dummy up a Lisp eval call with its own stack frame. */ struct cons_pointer repl_eval( struct cons_pointer input ) { - debug_print( L"Entered repl_eval\n", DEBUG_REPL ); + debug_print( L"Entered repl_eval\n", DEBUG_REPL ); struct cons_pointer result = NIL; - struct cons_pointer frame_pointer = make_stack_frame( NIL, make_cons( input, NIL ), oblist); - if ( !nilp( frame_pointer ) ) { - inc_ref(frame_pointer); - result = lisp_eval( get_stack_frame( frame_pointer ), frame_pointer, oblist ); + result = eval_form( NULL, NIL, input, oblist ); - dec_ref( frame_pointer ); - } debug_print( L"repl_eval: returning\n", DEBUG_REPL ); debug_dump_object( result, DEBUG_REPL ); @@ -73,15 +68,10 @@ struct cons_pointer repl_eval( struct cons_pointer input ) { */ struct cons_pointer repl_print( struct cons_pointer stream_pointer, struct cons_pointer value ) { - debug_print( L"Entered repl_print\n", DEBUG_REPL ); + debug_print( L"Entered repl_print\n", DEBUG_REPL ); debug_dump_object( value, DEBUG_REPL ); - struct cons_pointer result = NIL; - struct cons_pointer frame_pointer = make_stack_frame( NIL, make_cons( value, NIL ), oblist); - if ( !nilp( frame_pointer ) ) { - inc_ref(frame_pointer); - result = lisp_print( get_stack_frame( frame_pointer ), frame_pointer, oblist ); - dec_ref( frame_pointer ); - } + struct cons_pointer result = + print( pointer2cell( stream_pointer ).payload.stream.stream, value ); debug_print( L"repl_print: returning\n", DEBUG_REPL ); debug_dump_object( result, DEBUG_REPL ); @@ -98,7 +88,7 @@ struct cons_pointer repl_print( struct cons_pointer stream_pointer, void repl( FILE * in_stream, FILE * out_stream, FILE * error_stream, bool show_prompt ) { - debug_print( L"Entered repl\n", DEBUG_REPL ); + debug_print( L"Entered repl\n", DEBUG_REPL ); struct cons_pointer input_stream = make_read_stream( in_stream ); inc_ref( input_stream );