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] ) ) {
result =
make_string( url_fgetwc
( pointer2cell( frame->arg[0] ).payload.
stream.stream ), NIL );
( pointer2cell( frame->arg[0] ).payload.stream.
stream ), NIL );
}
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:
url_fwprintf( output,
L"\t\tRational cell: value %ld/%ld, count %u\n",
pointer2cell( cell.payload.ratio.dividend ).
payload.integer.value,
pointer2cell( cell.payload.ratio.divisor ).
payload.integer.value, cell.count );
pointer2cell( cell.payload.ratio.dividend ).payload.
integer.value,
pointer2cell( cell.payload.ratio.divisor ).payload.
integer.value, cell.count );
break;
case READTV:
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 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 ) ) {
struct cons_space_object *cell = &pointer2cell( store );
switch ( cell->tag.value ) {
case CONSTV:
for ( struct cons_pointer next = store;
nilp( result ) && consp( next );
next = c_cdr( next) ) {
nilp( result ) && consp( next ); next = c_cdr( next ) ) {
if ( !nilp( next ) ) {
// struct cons_space_object entry =
// pointer2cell( c_car( next) );
if ( equal( key, c_car(next) ) ) {
if ( equal( key, c_car( next ) ) ) {
result = key;
}
}
@ -330,6 +333,10 @@ struct cons_pointer interned( struct cons_pointer key,
NIL );
}
debug_print( L"interned: returning `", DEBUG_BIND );
debug_print_object( result, DEBUG_BIND );
debug_print( L"`\n", DEBUG_BIND );
return result;
}
@ -441,19 +448,23 @@ struct cons_pointer hashmap_put( struct cons_pointer mapp,
map->payload.hashmap.buckets[bucket_no] );
}
debug_print(L"hashmap_put:\n", DEBUG_BIND);
debug_dump_object( mapp, DEBUG_BIND);
return mapp;
}
/**
* Return a new key/value store containing all the key/value pairs in this
* store with this key/value pair added to the front.
*/
/**
* If this store is modifiable, add this key value pair to it. Otherwise,
* 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 store ) {
struct cons_pointer result = NIL;
#ifdef DEBUG
bool deep = eq( store, oblist);
bool deep = eq( store, oblist );
debug_print_binding( key, value, deep, DEBUG_BIND );
if ( deep ) {
@ -461,9 +472,7 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
pointer2cell( store ).payload.vectorp.tag.bytes );
}
#endif
if ( nilp( value ) ) {
result = store;
} else if ( nilp( store ) || consp( store ) ) {
if ( nilp( store ) || consp( store ) ) {
result = make_cons( make_cons( key, value ), store );
} else if ( hashmapp( store ) ) {
result = hashmap_put( store, key, value );
@ -479,16 +488,8 @@ 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 = 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_object( key, 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;
} else {
result =
( *fn_cell.payload.
special.executable ) ( get_stack_frame
( next_pointer ),
next_pointer, env );
( *fn_cell.payload.special.
executable ) ( get_stack_frame( next_pointer ),
next_pointer, env );
debug_print( L"Special form returning: ", DEBUG_EVAL );
debug_print_object( result, DEBUG_EVAL );
debug_println( DEBUG_EVAL );
@ -850,9 +849,8 @@ struct cons_pointer
lisp_internedp( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ) {
struct cons_pointer result = internedp( frame->arg[0],
nilp( frame->
arg[1] ) ? oblist : frame->
arg[1] );
nilp( frame->arg[1] ) ? oblist :
frame->arg[1] );
if ( exceptionp( 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 message = frame->arg[0];
return exceptionp( message ) ? message : throw_exception( message,
frame->
previous );
frame->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 ( nilp( c_cdr( l1 ) ) ) {
return
make_string_like_thing( ( pointer2cell( l1 ).
payload.string.character ),
l2,
make_string_like_thing( ( pointer2cell( l1 ).payload.
string.character ), l2,
pointer2cell( l1 ).tag.value );
} else {
return
make_string_like_thing( ( pointer2cell( l1 ).
payload.string.character ),
make_string_like_thing( ( pointer2cell( l1 ).payload.
string.character ),
c_append( c_cdr( l1 ), l2 ),
pointer2cell( l1 ).tag.value );
}