From f6d7fcea1ea83689700b77cc891dfbf025e6ddfe Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 13 Feb 2026 12:50:02 +0000 Subject: [PATCH] Woohoo! Huge decrease in cells not cleaned up, with fixing one stupid bug. --- post-scarcity.cbp | 157 --------------------------------- post-scarcity.cscope_file_list | 58 ------------ post-scarcity.layout | 15 ---- src/arith/integer.c | 3 + src/init.c | 40 ++++++++- src/io/print.c | 8 +- src/memory/consspaceobject.c | 8 -- src/memory/hashmap.c | 4 +- src/ops/intern.c | 17 ++-- src/ops/lispops.c | 72 ++++++++------- src/ops/lispops.h | 2 + src/repl.c | 2 - 12 files changed, 93 insertions(+), 293 deletions(-) delete mode 100644 post-scarcity.cbp delete mode 100644 post-scarcity.cscope_file_list delete mode 100644 post-scarcity.layout diff --git a/post-scarcity.cbp b/post-scarcity.cbp deleted file mode 100644 index a1f42e0..0000000 --- a/post-scarcity.cbp +++ /dev/null @@ -1,157 +0,0 @@ - - - - - - diff --git a/post-scarcity.cscope_file_list b/post-scarcity.cscope_file_list deleted file mode 100644 index 6fbf5ec..0000000 --- a/post-scarcity.cscope_file_list +++ /dev/null @@ -1,58 +0,0 @@ -"/home/simon/workspace/post-scarcity/utils_src/readprintwc/readprintwc.c" -"/home/simon/workspace/post-scarcity/src/memory/vectorspace.c" -"/home/simon/workspace/post-scarcity/src/arith/peano.c" -"/home/simon/workspace/post-scarcity/src/init.c" -"/home/simon/workspace/post-scarcity/src/utils.h" -"/home/simon/workspace/post-scarcity/src/ops/intern.h" -"/home/simon/workspace/post-scarcity/src/arith/ratio.h" -"/home/simon/workspace/post-scarcity/src/io/io.c" -"/home/simon/workspace/post-scarcity/src/memory/conspage.h" -"/home/simon/workspace/post-scarcity/src/time/psse_time.h" -"/home/simon/workspace/post-scarcity/src/memory/cursor.h" -"/home/simon/workspace/post-scarcity/src/memory/dump.h" -"/home/simon/workspace/post-scarcity/src/ops/intern.c" -"/home/simon/workspace/post-scarcity/src/memory/lookup3.c" -"/home/simon/workspace/post-scarcity/src/io/fopen.h" -"/home/simon/workspace/post-scarcity/src/version.h" -"/home/simon/workspace/post-scarcity/src/memory/consspaceobject.h" -"/home/simon/workspace/post-scarcity/src/ops/meta.h" -"/home/simon/workspace/post-scarcity/src/arith/real.c" -"/home/simon/workspace/post-scarcity/src/ops/loop.c" -"/home/simon/workspace/post-scarcity/src/arith/integer.h" -"/home/simon/workspace/post-scarcity/src/time/psse_time.c" -"/home/simon/workspace/post-scarcity/src/memory/vectorspace.h" -"/home/simon/workspace/post-scarcity/src/memory/hashmap.c" -"/home/simon/workspace/post-scarcity/src/io/read.c" -"/home/simon/workspace/post-scarcity/src/ops/lispops.h" -"/home/simon/workspace/post-scarcity/src/ops/loop.h" -"/home/simon/workspace/post-scarcity/src/memory/stack.h" -"/home/simon/workspace/post-scarcity/utils_src/tagvalcalc/tagvalcalc.c" -"/home/simon/workspace/post-scarcity/src/debug.c" -"/home/simon/workspace/post-scarcity/src/io/read.h" -"/home/simon/workspace/post-scarcity/src/ops/meta.c" -"/home/simon/workspace/post-scarcity/src/memory/dump.c" -"/home/simon/workspace/post-scarcity/src/repl.c" -"/home/simon/workspace/post-scarcity/src/io/print.c" -"/home/simon/workspace/post-scarcity/src/memory/hashmap.h" -"/home/simon/workspace/post-scarcity/src/utils.c" -"/home/simon/workspace/post-scarcity/src/io/io.h" -"/home/simon/workspace/post-scarcity/src/memory/stack.c" -"/home/simon/workspace/post-scarcity/utils_src/debugflags/debugflags.c" -"/home/simon/workspace/post-scarcity/src/memory/consspaceobject.c" -"/home/simon/workspace/post-scarcity/src/memory/conspage.c" -"/home/simon/workspace/post-scarcity/src/memory/cursor.c" -"/home/simon/workspace/post-scarcity/src/arith/ratio.c" -"/home/simon/workspace/post-scarcity/Makefile" -"/home/simon/workspace/post-scarcity/src/arith/peano.h" -"/home/simon/workspace/post-scarcity/src/memory/lookup3.h" -"/home/simon/workspace/post-scarcity/src/arith/real.h" -"/home/simon/workspace/post-scarcity/src/ops/equal.c" -"/home/simon/workspace/post-scarcity/src/ops/lispops.c" -"/home/simon/workspace/post-scarcity/src/authorise.h" -"/home/simon/workspace/post-scarcity/src/io/print.h" -"/home/simon/workspace/post-scarcity/src/authorise.c" -"/home/simon/workspace/post-scarcity/src/debug.h" -"/home/simon/workspace/post-scarcity/src/arith/integer.c" -"/home/simon/workspace/post-scarcity/src/ops/equal.h" -"/home/simon/workspace/post-scarcity/src/repl.h" -"/home/simon/workspace/post-scarcity/src/io/fopen.c" diff --git a/post-scarcity.layout b/post-scarcity.layout deleted file mode 100644 index 98bd2b3..0000000 --- a/post-scarcity.layout +++ /dev/null @@ -1,15 +0,0 @@ - - - - - - - - - - - - - - - diff --git a/src/arith/integer.c b/src/arith/integer.c index e9d9b79..821b476 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -272,9 +272,12 @@ struct cons_pointer add_integers( struct cons_pointer a, return result; } +// TODO: I have really no idea what I was trying to do here, or why it could possibly be a good idea. struct cons_pointer base_partial( int depth ) { struct cons_pointer result = NIL; + debug_printf( DEBUG_ARITH, L"base_partial: depth = %d\n", depth); + for ( int i = 0; i < depth; i++ ) { result = acquire_integer( 0, result ); } diff --git a/src/init.c b/src/init.c index 45b534f..17f8d36 100644 --- a/src/init.c +++ b/src/init.c @@ -37,6 +37,34 @@ #include "io/fopen.h" #include "time/psse_time.h" +/** + * @brief If `pointer` is an exception, display that exception to stderr, + * decrement that exception, and return NIL; else return the pointer. + * + * @param pointer a cons pointer. + * @param location_descriptor a description of where the pointer was caught. + * @return struct cons_pointer + */ +struct cons_pointer check_exception( struct cons_pointer pointer, char * location_descriptor) { + struct cons_pointer result = NIL; + + struct cons_space_object * object = &pointer2cell( pointer); + + if ( exceptionp( pointer)) { + fprintf( stderr, "ERROR: Exception at %s: ", location_descriptor); + URL_FILE *ustderr = file_to_url_file( stderr ); + fwide( stderr, 1 ); + print( ustderr, object->payload.exception.payload ); + free( ustderr ); + + dec_ref( pointer); + } else { + result = pointer; + } + + return result; +} + /** * Bind this compiled `executable` function, as a Lisp function, to @@ -55,7 +83,8 @@ void bind_function( wchar_t *name, struct cons_pointer ( *executable ) n ), NIL ) ); - deep_bind( n, make_function( meta, executable ) ); + check_exception( deep_bind( n, make_function( meta, executable ) ), + "bind_function"); } /** @@ -72,14 +101,17 @@ void bind_special( wchar_t *name, struct cons_pointer ( *executable ) n ), NIL ) ); - deep_bind( n, make_special( meta, executable ) ); + check_exception(deep_bind( n, make_special( meta, executable ) ), + "bind_special"); } /** * Bind this `value` to this `name` in the `oblist`. */ struct cons_pointer bind_value( wchar_t *name, struct cons_pointer value ) { - return deep_bind( c_string_to_lisp_symbol( name ), value ); + return check_exception( + deep_bind( c_string_to_lisp_symbol( name ), value ), + "bind_value"); } void print_banner( ) { @@ -227,7 +259,7 @@ int main( int argc, char *argv[] ) { /* * the default prompt */ - bind_value( L"*prompt*", + prompt_name = bind_value( L"*prompt*", show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL ); /* * primitive function operations diff --git a/src/io/print.c b/src/io/print.c index 8f4b88e..f4aab9f 100644 --- a/src/io/print.c +++ b/src/io/print.c @@ -169,9 +169,11 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { print( output, cell.payload.function.meta ); url_fputwc( L'>', output ); break; - case INTEGERTV:{ + case INTEGERTV: + if ( nilp( cell.payload.integer.more)) { + url_fwprintf( output, L"%ld", cell.payload.integer.value); + } else { struct cons_pointer s = integer_to_string( pointer, 10 ); - inc_ref( s ); print_string_contents( output, s ); dec_ref( s ); } @@ -186,7 +188,6 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { make_cons( c_string_to_lisp_symbol( L"\u03bb" ), make_cons( cell.payload.lambda.args, cell.payload.lambda.body ) ); - inc_ref( to_print ); print( output, to_print ); @@ -203,7 +204,6 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { make_cons( c_string_to_lisp_symbol( L"n\u03bb" ), make_cons( cell.payload.lambda.args, cell.payload.lambda.body ) ); - inc_ref( to_print ); print( output, to_print ); diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index 8f9e2a8..81836f8 100644 --- a/src/memory/consspaceobject.c +++ b/src/memory/consspaceobject.c @@ -201,7 +201,6 @@ struct cons_pointer make_exception( struct cons_pointer message, struct cons_pointer pointer = allocate_cell( EXCEPTIONTV ); struct cons_space_object *cell = &pointer2cell( pointer ); - inc_ref( message ); inc_ref( frame_pointer ); cell->payload.exception.payload = message; cell->payload.exception.frame = frame_pointer; @@ -237,9 +236,6 @@ struct cons_pointer make_lambda( struct cons_pointer args, struct cons_pointer pointer = allocate_cell( LAMBDATV ); 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( args ); inc_ref( body ); cell->payload.lambda.args = args; @@ -256,9 +252,6 @@ struct cons_pointer make_nlambda( struct cons_pointer args, struct cons_pointer body ) { struct cons_pointer pointer = allocate_cell( NLAMBDATV ); - 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 */ - struct cons_space_object *cell = &pointer2cell( pointer ); inc_ref( args ); inc_ref( body ); @@ -312,7 +305,6 @@ struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail, pointer = allocate_cell( tag ); struct cons_space_object *cell = &pointer2cell( pointer ); - inc_ref( tail ); cell->payload.string.character = c; cell->payload.string.cdr.page = tail.page; /* \todo There's a problem here. Sometimes the offsets on diff --git a/src/memory/hashmap.c b/src/memory/hashmap.c index f2911e5..15b5550 100644 --- a/src/memory/hashmap.c +++ b/src/memory/hashmap.c @@ -87,9 +87,9 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame, &( map->payload ) )->n_buckets; map->payload.hashmap.buckets[bucket_no] = - inc_ref( make_cons( make_cons( key, val ), + make_cons( make_cons( key, val ), map->payload.hashmap. - buckets[bucket_no] ) ); + buckets[bucket_no] ); } } } diff --git a/src/ops/intern.c b/src/ops/intern.c index cafc294..3fb38d3 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -292,7 +292,7 @@ internedp( struct cons_pointer key, struct cons_pointer store ) { // if ( equal( key, entry.payload.cons.car ) ) { // result = entry.payload.cons.car; // } - if (!nilp( c_assoc( store, key))) { + if (!nilp( c_assoc( key, store))) { result = key; } } else { @@ -340,18 +340,23 @@ struct cons_pointer c_assoc( struct cons_pointer key, result = hashmap_get( entry_ptr, key ); break; default: - throw_exception( c_string_to_lisp_string - ( L"Store entry is of unknown type" ), - NIL ); + throw_exception( c_append( + c_string_to_lisp_string( L"Store entry is of unknown type: " ), + c_type( entry_ptr)), NIL); } } } } else if ( hashmapp( store ) ) { result = hashmap_get( store, key ); } else if ( !nilp( store ) ) { + debug_print( L"c_assoc; store is of unknown type `", DEBUG_BIND ); + debug_print_object( c_type( store), DEBUG_BIND ); + debug_print( L"`\n", DEBUG_BIND ); result = - throw_exception( c_string_to_lisp_string - ( L"Store is of unknown type" ), NIL ); + throw_exception( + c_append( + c_string_to_lisp_string( L"Store is of unknown type: " ), + c_type( store)), NIL ); } debug_print( L"c_assoc returning ", DEBUG_BIND ); diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 236a290..2f549e4 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -38,6 +38,13 @@ #include "memory/stack.h" #include "memory/vectorspace.h" +/** + * @brief the name of the symbol to which the prompt is bound; + * + * Set in init to `*prompt*` + */ +struct cons_pointer prompt_name; + /* * also to create in this section: * struct cons_pointer lisp_let( struct cons_pointer args, struct cons_pointer env, @@ -46,7 +53,6 @@ * and others I haven't thought of yet. */ - /** * Useful building block; evaluate this single form in the context of this * parent stack frame and this environment. @@ -1263,7 +1269,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame, struct cons_pointer input = get_default_stream( true, env ); struct cons_pointer output = get_default_stream( false, env ); - struct cons_pointer prompt_name = c_string_to_lisp_symbol( L"*prompt*" ); +// struct cons_pointer prompt_name = c_string_to_lisp_symbol( L"*prompt*" ); struct cons_pointer old_oblist = oblist; struct cons_pointer new_env = env; @@ -1558,43 +1564,35 @@ struct cons_pointer lisp_let( struct stack_frame *frame, } -// /** -// * Function; print the internal representation of the object indicated by `frame->arg[0]` to the -// * (optional, defaults to the value of `*out*` in the environment) stream indicated by `frame->arg[1]`. -// * -// * * (inspect expression) -// * * (inspect expression ) -// * -// * @param frame my stack frame. -// * @param frame_pointer a pointer to my stack_frame. -// * @param env the environment. -// * @return the value of the first argument - `expression`. -// */ -// struct cons_pointer lisp_inspect( struct stack_frame *frame, -// struct cons_pointer frame_pointer, -// struct cons_pointer env ) { -// debug_print( L"Entering print\n", DEBUG_IO ); -// URL_FILE *output; -// struct cons_pointer out_stream = writep( frame->arg[1] ) ? -// frame->arg[1] : get_default_stream( false, env ); +// struct cons_pointer c_concat( struct cons_pointer a, struct cons_pointer b) { +// struct cons_pointer result = b; -// if ( writep( out_stream ) ) { -// debug_print( L"lisp_print: setting output stream\n", DEBUG_IO ); -// debug_dump_object( out_stream, DEBUG_IO ); -// output = pointer2cell( out_stream ).payload.stream.stream; -// inc_ref( out_stream ); +// if ( nilp( b.tag.value)) { +// result = make_cons( a, b); // } else { -// output = file_to_url_file( stdout ); +// if ( ! nilp( a)) { +// if (a.tag.value == b.tag.value) { + +// struct cons_pointer tail = c_concat( c_cdr( a), b); + +// switch ( a.tag.value) { +// case CONSTV: +// result = make_cons( c_car( a), tail); +// break; +// case KEYTV: +// case STRINGTV: +// case SYMBOLTV: +// result = make_string_like_thing() + +// } + +// } else { +// // throw an exception +// } +// } // } + -// dump_object( output, frame->arg[0] ); -// url_fputws( L"\n", output ); -// if ( writep( out_stream ) ) { -// dec_ref( out_stream ); -// } else { -// free( output ); -// } - -// return frame->arg[0]; -// } +// return result; +// } \ No newline at end of file diff --git a/src/ops/lispops.h b/src/ops/lispops.h index da1f27e..ec84d61 100644 --- a/src/ops/lispops.h +++ b/src/ops/lispops.h @@ -22,6 +22,8 @@ #ifndef __psse_lispops_h #define __psse_lispops_h +extern struct cons_pointer prompt_name; + /* * utilities */ diff --git a/src/repl.c b/src/repl.c index b68fa1c..5295465 100644 --- a/src/repl.c +++ b/src/repl.c @@ -41,8 +41,6 @@ void repl( ) { struct cons_pointer frame_pointer = make_stack_frame( NIL, NIL, env ); if ( !nilp( frame_pointer ) ) { - inc_ref( frame_pointer ); - lisp_repl( get_stack_frame( frame_pointer ), frame_pointer, env ); dec_ref( frame_pointer );