simon/post-scarcity
1
0
Fork 0
Code Issues 7 Pull requests Projects Releases Packages Wiki Activity Actions

More debugging output. Getting desperate!

Browse source
This commit is contained in:
Simon Brooke 2026-02-28 12:24:59 +00:00
parent 72548097cf
commit 54f6f023c6
4 changed files with 36 additions and 39 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/io/io.c
View file

@ -508,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
if ( readp( frame->arg[0] ) ) { if ( readp( frame->arg[0] ) ) {
result = result =
make_string( url_fgetwc make_string( url_fgetwc
( pointer2cell( frame->arg[0] ).payload. ( pointer2cell( frame->arg[0] ).payload.stream.
stream.stream ), NIL ); stream ), NIL );
} }
return result; return result;

8
src/memory/dump.c
View file

@ -114,10 +114,10 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
case RATIOTV: case RATIOTV:
url_fwprintf( output, url_fwprintf( output,
L"\t\tRational cell: value %ld/%ld, count %u\n", L"\t\tRational cell: value %ld/%ld, count %u\n",
pointer2cell( cell.payload.ratio.dividend ). pointer2cell( cell.payload.ratio.dividend ).payload.
payload.integer.value, integer.value,
pointer2cell( cell.payload.ratio.divisor ). pointer2cell( cell.payload.ratio.divisor ).payload.
payload.integer.value, cell.count ); integer.value, cell.count );
break; break;
case READTV: case READTV:
url_fputws( L"\t\tInput stream; metadata: ", output ); url_fputws( L"\t\tInput stream; metadata: ", output );

39
src/ops/intern.c
View file

@ -278,19 +278,22 @@ struct cons_pointer interned( struct cons_pointer key,
struct cons_pointer store ) { struct cons_pointer store ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
debug_print( L"interned: Checking for interned value of `", DEBUG_BIND );
debug_print_object( key, DEBUG_BIND );
debug_print( L"`\n", DEBUG_BIND );
if ( symbolp( key ) || keywordp( key ) ) { if ( symbolp( key ) || keywordp( key ) ) {
struct cons_space_object *cell = &pointer2cell( store ); struct cons_space_object *cell = &pointer2cell( store );
switch ( cell->tag.value ) { switch ( cell->tag.value ) {
case CONSTV: case CONSTV:
for ( struct cons_pointer next = store; for ( struct cons_pointer next = store;
nilp( result ) && consp( next ); nilp( result ) && consp( next ); next = c_cdr( next ) ) {
next = c_cdr( next) ) {
if ( !nilp( next ) ) { if ( !nilp( next ) ) {
// struct cons_space_object entry = // struct cons_space_object entry =
// pointer2cell( c_car( next) ); // pointer2cell( c_car( next) );
if ( equal( key, c_car(next) ) ) { if ( equal( key, c_car( next ) ) ) {
result = key; result = key;
} }
} }
@ -330,6 +333,10 @@ struct cons_pointer interned( struct cons_pointer key,
NIL ); NIL );
} }
debug_print( L"interned: returning `", DEBUG_BIND );
debug_print_object( result, DEBUG_BIND );
debug_print( L"`\n", DEBUG_BIND );
return result; return result;
} }
@ -441,19 +448,23 @@ struct cons_pointer hashmap_put( struct cons_pointer mapp,
map->payload.hashmap.buckets[bucket_no] ); map->payload.hashmap.buckets[bucket_no] );
} }
debug_print(L"hashmap_put:\n", DEBUG_BIND);
debug_dump_object( mapp, DEBUG_BIND);
return mapp; return mapp;
} }
/** /**
* Return a new key/value store containing all the key/value pairs in this * If this store is modifiable, add this key value pair to it. Otherwise,
* store with this key/value pair added to the front. * return a new key/value store containing all the key/value pairs in this
*/ * store with this key/value pair added to the front.
*/
struct cons_pointer set( struct cons_pointer key, struct cons_pointer value, struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
struct cons_pointer store ) { struct cons_pointer store ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
#ifdef DEBUG #ifdef DEBUG
bool deep = eq( store, oblist); bool deep = eq( store, oblist );
debug_print_binding( key, value, deep, DEBUG_BIND ); debug_print_binding( key, value, deep, DEBUG_BIND );
if ( deep ) { if ( deep ) {
@ -461,9 +472,7 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
pointer2cell( store ).payload.vectorp.tag.bytes ); pointer2cell( store ).payload.vectorp.tag.bytes );
} }
#endif #endif
if ( nilp( value ) ) { if ( nilp( store ) || consp( store ) ) {
result = store;
} else if ( nilp( store ) || consp( store ) ) {
result = make_cons( make_cons( key, value ), store ); result = make_cons( make_cons( key, value ), store );
} else if ( hashmapp( store ) ) { } else if ( hashmapp( store ) ) {
result = hashmap_put( store, key, value ); result = hashmap_put( store, key, value );
@ -479,16 +488,8 @@ struct cons_pointer
deep_bind( struct cons_pointer key, struct cons_pointer value ) { deep_bind( struct cons_pointer key, struct cons_pointer value ) {
debug_print( L"Entering deep_bind\n", DEBUG_BIND ); debug_print( L"Entering deep_bind\n", DEBUG_BIND );
struct cons_pointer old = oblist;
oblist = set( key, value, oblist ); oblist = set( key, value, oblist );
// The oblist is not now an assoc list, and I don't think it will be again.
// if ( consp( oblist ) ) {
// inc_ref( oblist );
// dec_ref( old );
// }
debug_print( L"deep_bind returning ", DEBUG_BIND ); debug_print( L"deep_bind returning ", DEBUG_BIND );
debug_print_object( key, DEBUG_BIND ); debug_print_object( key, DEBUG_BIND );
debug_println( DEBUG_BIND ); debug_println( DEBUG_BIND );

24
src/ops/lispops.c
View file

@ -446,10 +446,9 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
result = next_pointer; result = next_pointer;
} else { } else {
result = result =
( *fn_cell.payload. ( *fn_cell.payload.special.
special.executable ) ( get_stack_frame executable ) ( get_stack_frame( next_pointer ),
( next_pointer ), next_pointer, env );
next_pointer, env );
debug_print( L"Special form returning: ", DEBUG_EVAL ); debug_print( L"Special form returning: ", DEBUG_EVAL );
debug_print_object( result, DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL );
debug_println( DEBUG_EVAL ); debug_println( DEBUG_EVAL );
@ -850,9 +849,8 @@ struct cons_pointer
lisp_internedp( struct stack_frame *frame, struct cons_pointer frame_pointer, lisp_internedp( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ) { struct cons_pointer env ) {
struct cons_pointer result = internedp( frame->arg[0], struct cons_pointer result = internedp( frame->arg[0],
nilp( frame-> nilp( frame->arg[1] ) ? oblist :
arg[1] ) ? oblist : frame-> frame->arg[1] );
arg[1] );
if ( exceptionp( result ) ) { if ( exceptionp( result ) ) {
struct cons_pointer old = result; struct cons_pointer old = result;
@ -1313,8 +1311,7 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ) { struct cons_pointer env ) {
struct cons_pointer message = frame->arg[0]; struct cons_pointer message = frame->arg[0];
return exceptionp( message ) ? message : throw_exception( message, return exceptionp( message ) ? message : throw_exception( message,
frame-> frame->previous );
previous );
} }
/** /**
@ -1497,14 +1494,13 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) { if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
if ( nilp( c_cdr( l1 ) ) ) { if ( nilp( c_cdr( l1 ) ) ) {
return return
make_string_like_thing( ( pointer2cell( l1 ). make_string_like_thing( ( pointer2cell( l1 ).payload.
payload.string.character ), string.character ), l2,
l2,
pointer2cell( l1 ).tag.value ); pointer2cell( l1 ).tag.value );
} else { } else {
return return
make_string_like_thing( ( pointer2cell( l1 ). make_string_like_thing( ( pointer2cell( l1 ).payload.
payload.string.character ), string.character ),
c_append( c_cdr( l1 ), l2 ), c_append( c_cdr( l1 ), l2 ),
pointer2cell( l1 ).tag.value ); pointer2cell( l1 ).tag.value );
} }