Woohoo! Huge decrease in cells not cleaned up, with fixing one stupid bug.

This commit is contained in:
Simon Brooke 2026-02-13 12:50:02 +00:00
parent 004ff6737c
commit f6d7fcea1e
12 changed files with 93 additions and 293 deletions

View file

@ -1,157 +0,0 @@
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<CodeBlocks_project_file>
<FileVersion major="1" minor="6" />
<Project>
<Option title="post-scarcity" />
<Option makefile_is_custom="1" />
<Option pch_mode="2" />
<Option compiler="gcc" />
<Build>
<Target title="Debug">
<Option output="bin/Debug/post-scarcity" prefix_auto="1" extension_auto="1" />
<Option object_output="obj/Debug/" />
<Option type="1" />
<Option compiler="gcc" />
<Compiler>
<Add option="-g" />
</Compiler>
</Target>
<Target title="Release">
<Option output="bin/Release/post-scarcity" prefix_auto="1" extension_auto="1" />
<Option object_output="obj/Release/" />
<Option type="1" />
<Option compiler="gcc" />
<Compiler>
<Add option="-O2" />
</Compiler>
<Linker>
<Add option="-s" />
</Linker>
</Target>
</Build>
<Compiler>
<Add option="-Wall" />
</Compiler>
<Unit filename="Makefile" />
<Unit filename="src/arith/integer.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/arith/integer.h" />
<Unit filename="src/arith/peano.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/arith/peano.h" />
<Unit filename="src/arith/ratio.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/arith/ratio.h" />
<Unit filename="src/arith/real.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/arith/real.h" />
<Unit filename="src/authorise.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/authorise.h" />
<Unit filename="src/debug.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/debug.h" />
<Unit filename="src/init.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/io/fopen.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/io/fopen.h" />
<Unit filename="src/io/io.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/io/io.h" />
<Unit filename="src/io/print.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/io/print.h" />
<Unit filename="src/io/read.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/io/read.h" />
<Unit filename="src/memory/conspage.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/memory/conspage.h" />
<Unit filename="src/memory/consspaceobject.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/memory/consspaceobject.h" />
<Unit filename="src/memory/cursor.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/memory/cursor.h" />
<Unit filename="src/memory/dump.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/memory/dump.h" />
<Unit filename="src/memory/hashmap.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/memory/hashmap.h" />
<Unit filename="src/memory/lookup3.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/memory/lookup3.h" />
<Unit filename="src/memory/stack.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/memory/stack.h" />
<Unit filename="src/memory/vectorspace.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/memory/vectorspace.h" />
<Unit filename="src/ops/equal.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/ops/equal.h" />
<Unit filename="src/ops/intern.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/ops/intern.h" />
<Unit filename="src/ops/lispops.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/ops/lispops.h" />
<Unit filename="src/ops/loop.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/ops/loop.h" />
<Unit filename="src/ops/meta.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/ops/meta.h" />
<Unit filename="src/repl.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/repl.h" />
<Unit filename="src/time/psse_time.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/time/psse_time.h" />
<Unit filename="src/utils.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="src/utils.h" />
<Unit filename="src/version.h" />
<Unit filename="utils_src/debugflags/debugflags.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="utils_src/readprintwc/readprintwc.c">
<Option compilerVar="CC" />
</Unit>
<Unit filename="utils_src/tagvalcalc/tagvalcalc.c">
<Option compilerVar="CC" />
</Unit>
<Extensions>
<lib_finder disable_auto="1" />
</Extensions>
</Project>
</CodeBlocks_project_file>

View file

@ -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"

View file

@ -1,15 +0,0 @@
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<CodeBlocks_layout_file>
<FileVersion major="1" minor="0" />
<ActiveTarget name="Debug" />
<File name="Makefile" open="1" top="0" tabpos="1" split="0" active="1" splitpos="0" zoom_1="0" zoom_2="0">
<Cursor>
<Cursor1 position="642" topLine="5" />
</Cursor>
</File>
<File name="src/arith/integer.c" open="1" top="1" tabpos="2" split="0" active="1" splitpos="0" zoom_1="0" zoom_2="0">
<Cursor>
<Cursor1 position="3454" topLine="156" />
</Cursor>
</File>
</CodeBlocks_layout_file>

View file

@ -272,9 +272,12 @@ struct cons_pointer add_integers( struct cons_pointer a,
return result; 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 base_partial( int depth ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
debug_printf( DEBUG_ARITH, L"base_partial: depth = %d\n", depth);
for ( int i = 0; i < depth; i++ ) { for ( int i = 0; i < depth; i++ ) {
result = acquire_integer( 0, result ); result = acquire_integer( 0, result );
} }

View file

@ -37,6 +37,34 @@
#include "io/fopen.h" #include "io/fopen.h"
#include "time/psse_time.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 * 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 ), n ),
NIL ) ); 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 ), n ),
NIL ) ); 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`. * Bind this `value` to this `name` in the `oblist`.
*/ */
struct cons_pointer bind_value( wchar_t *name, struct cons_pointer value ) { 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( ) { void print_banner( ) {
@ -227,7 +259,7 @@ int main( int argc, char *argv[] ) {
/* /*
* the default prompt * the default prompt
*/ */
bind_value( L"*prompt*", prompt_name = bind_value( L"*prompt*",
show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL ); show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL );
/* /*
* primitive function operations * primitive function operations

View file

@ -169,9 +169,11 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
print( output, cell.payload.function.meta ); print( output, cell.payload.function.meta );
url_fputwc( L'>', output ); url_fputwc( L'>', output );
break; 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 ); struct cons_pointer s = integer_to_string( pointer, 10 );
inc_ref( s );
print_string_contents( output, s ); print_string_contents( output, s );
dec_ref( 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( c_string_to_lisp_symbol( L"\u03bb" ),
make_cons( cell.payload.lambda.args, make_cons( cell.payload.lambda.args,
cell.payload.lambda.body ) ); cell.payload.lambda.body ) );
inc_ref( to_print );
print( output, 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( c_string_to_lisp_symbol( L"n\u03bb" ),
make_cons( cell.payload.lambda.args, make_cons( cell.payload.lambda.args,
cell.payload.lambda.body ) ); cell.payload.lambda.body ) );
inc_ref( to_print );
print( output, to_print ); print( output, to_print );

View file

@ -201,7 +201,6 @@ struct cons_pointer make_exception( struct cons_pointer message,
struct cons_pointer pointer = allocate_cell( EXCEPTIONTV ); struct cons_pointer pointer = allocate_cell( EXCEPTIONTV );
struct cons_space_object *cell = &pointer2cell( pointer ); struct cons_space_object *cell = &pointer2cell( pointer );
inc_ref( message );
inc_ref( frame_pointer ); inc_ref( frame_pointer );
cell->payload.exception.payload = message; cell->payload.exception.payload = message;
cell->payload.exception.frame = frame_pointer; 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_pointer pointer = allocate_cell( LAMBDATV );
struct cons_space_object *cell = &pointer2cell( pointer ); 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( args );
inc_ref( body ); inc_ref( body );
cell->payload.lambda.args = args; 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 body ) {
struct cons_pointer pointer = allocate_cell( NLAMBDATV ); 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 ); struct cons_space_object *cell = &pointer2cell( pointer );
inc_ref( args ); inc_ref( args );
inc_ref( body ); 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 ); pointer = allocate_cell( tag );
struct cons_space_object *cell = &pointer2cell( pointer ); struct cons_space_object *cell = &pointer2cell( pointer );
inc_ref( tail );
cell->payload.string.character = c; cell->payload.string.character = c;
cell->payload.string.cdr.page = tail.page; cell->payload.string.cdr.page = tail.page;
/* \todo There's a problem here. Sometimes the offsets on /* \todo There's a problem here. Sometimes the offsets on

View file

@ -87,9 +87,9 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame,
&( map->payload ) )->n_buckets; &( map->payload ) )->n_buckets;
map->payload.hashmap.buckets[bucket_no] = map->payload.hashmap.buckets[bucket_no] =
inc_ref( make_cons( make_cons( key, val ), make_cons( make_cons( key, val ),
map->payload.hashmap. map->payload.hashmap.
buckets[bucket_no] ) ); buckets[bucket_no] );
} }
} }
} }

View file

@ -292,7 +292,7 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
// if ( equal( key, entry.payload.cons.car ) ) { // if ( equal( key, entry.payload.cons.car ) ) {
// result = entry.payload.cons.car; // result = entry.payload.cons.car;
// } // }
if (!nilp( c_assoc( store, key))) { if (!nilp( c_assoc( key, store))) {
result = key; result = key;
} }
} else { } else {
@ -340,18 +340,23 @@ struct cons_pointer c_assoc( struct cons_pointer key,
result = hashmap_get( entry_ptr, key ); result = hashmap_get( entry_ptr, key );
break; break;
default: default:
throw_exception( c_string_to_lisp_string throw_exception( c_append(
( L"Store entry is of unknown type" ), c_string_to_lisp_string( L"Store entry is of unknown type: " ),
NIL ); c_type( entry_ptr)), NIL);
} }
} }
} }
} else if ( hashmapp( store ) ) { } else if ( hashmapp( store ) ) {
result = hashmap_get( store, key ); result = hashmap_get( store, key );
} else if ( !nilp( store ) ) { } 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 = result =
throw_exception( c_string_to_lisp_string throw_exception(
( L"Store is of unknown type" ), NIL ); 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 ); debug_print( L"c_assoc returning ", DEBUG_BIND );

View file

@ -38,6 +38,13 @@
#include "memory/stack.h" #include "memory/stack.h"
#include "memory/vectorspace.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: * also to create in this section:
* struct cons_pointer lisp_let( struct cons_pointer args, struct cons_pointer env, * 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. * and others I haven't thought of yet.
*/ */
/** /**
* Useful building block; evaluate this single form in the context of this * Useful building block; evaluate this single form in the context of this
* parent stack frame and this environment. * 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 input = get_default_stream( true, env );
struct cons_pointer output = get_default_stream( false, 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 old_oblist = oblist;
struct cons_pointer new_env = env; struct cons_pointer new_env = env;
@ -1558,43 +1564,35 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
} }
// /** // struct cons_pointer c_concat( struct cons_pointer a, struct cons_pointer b) {
// * Function; print the internal representation of the object indicated by `frame->arg[0]` to the // struct cons_pointer result = b;
// * (optional, defaults to the value of `*out*` in the environment) stream indicated by `frame->arg[1]`.
// *
// * * (inspect expression)
// * * (inspect expression <write-stream>)
// *
// * @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 );
// if ( writep( out_stream ) ) { // if ( nilp( b.tag.value)) {
// debug_print( L"lisp_print: setting output stream\n", DEBUG_IO ); // result = make_cons( a, b);
// debug_dump_object( out_stream, DEBUG_IO );
// output = pointer2cell( out_stream ).payload.stream.stream;
// inc_ref( out_stream );
// } else { // } 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;
// } // }

View file

@ -22,6 +22,8 @@
#ifndef __psse_lispops_h #ifndef __psse_lispops_h
#define __psse_lispops_h #define __psse_lispops_h
extern struct cons_pointer prompt_name;
/* /*
* utilities * utilities
*/ */

View file

@ -41,8 +41,6 @@ void repl( ) {
struct cons_pointer frame_pointer = make_stack_frame( NIL, NIL, env ); struct cons_pointer frame_pointer = make_stack_frame( NIL, NIL, env );
if ( !nilp( frame_pointer ) ) { if ( !nilp( frame_pointer ) ) {
inc_ref( frame_pointer );
lisp_repl( get_stack_frame( frame_pointer ), frame_pointer, env ); lisp_repl( get_stack_frame( frame_pointer ), frame_pointer, env );
dec_ref( frame_pointer ); dec_ref( frame_pointer );