Working on the member? bug. No fix, but some improvements in debug message format.

The bug is actually either in `cond` or in `cdr`, but I'm finding it extremely hard
to trace.
This commit is contained in:
Simon Brooke 2026-03-18 11:53:48 +00:00
parent 109d400f00
commit 54a99b6796
3 changed files with 24 additions and 17 deletions

View file

@ -37,7 +37,7 @@ uint32_t stack_limit = 0;
* because that way we can be sure the inc_ref happens! * because that way we can be sure the inc_ref happens!
*/ */
void set_reg( struct stack_frame *frame, int reg, struct cons_pointer value ) { void set_reg( struct stack_frame *frame, int reg, struct cons_pointer value ) {
debug_printf( DEBUG_STACK, L"Setting register %d to ", reg ); debug_printf( DEBUG_STACK, L"\tSetting register %d to ", reg );
debug_print_object( value, DEBUG_STACK ); debug_print_object( value, DEBUG_STACK );
debug_println( DEBUG_STACK ); debug_println( DEBUG_STACK );
dec_ref( frame->arg[reg] ); /* if there was anything in that slot dec_ref( frame->arg[reg] ); /* if there was anything in that slot
@ -63,10 +63,10 @@ struct stack_frame *get_stack_frame( struct cons_pointer pointer ) {
if ( vectorpointp( pointer ) && stackframep( vso ) ) { if ( vectorpointp( pointer ) && stackframep( vso ) ) {
result = ( struct stack_frame * ) &( vso->payload ); result = ( struct stack_frame * ) &( vso->payload );
debug_printf( DEBUG_STACK, // debug_printf( DEBUG_STACK,
L"get_stack_frame: all good, returning %p\n", result ); // L"\nget_stack_frame: all good, returning %p\n", result );
} else { } else {
debug_print( L"get_stack_frame: fail, returning NULL\n", DEBUG_STACK ); debug_print( L"\nget_stack_frame: fail, returning NULL\n", DEBUG_STACK );
} }
return result; return result;
@ -133,6 +133,8 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
if ( stack_limit == 0 || stack_limit > depth ) { if ( stack_limit == 0 || stack_limit > depth ) {
result = in_make_empty_frame( previous, depth ); result = in_make_empty_frame( previous, depth );
} else { } else {
debug_printf( DEBUG_STACK,
L"WARNING: Exceeded stack limit of %d\n", stack_limit);
result = result =
make_exception( c_string_to_lisp_string make_exception( c_string_to_lisp_string
( L"Stack limit exceeded." ), previous ); ( L"Stack limit exceeded." ), previous );
@ -182,9 +184,10 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous,
result = val; result = val;
break; break;
} else { } else {
debug_printf( DEBUG_STACK, L"Setting argument %d to ", debug_printf( DEBUG_STACK, L"\tSetting argument %d to ",
frame->args ); frame->args );
debug_print_object( cell.payload.cons.car, DEBUG_STACK ); debug_print_object( cell.payload.cons.car, DEBUG_STACK );
debug_print(L"\n", DEBUG_STACK);
set_reg( frame, frame->args, val ); set_reg( frame, frame->args, val );
} }
@ -325,7 +328,7 @@ void dump_frame( URL_FILE *output, struct cons_pointer frame_pointer ) {
for ( int arg = 0; arg < frame->args; arg++ ) { for ( int arg = 0; arg < frame->args; arg++ ) {
struct cons_space_object cell = pointer2cell( frame->arg[arg] ); struct cons_space_object cell = pointer2cell( frame->arg[arg] );
url_fwprintf( output, L"Arg %d:\t%4.4s\tcount: %10u\tvalue: ", url_fwprintf( output, L"\tArg %d:\t%4.4s\tcount: %10u\tvalue: ",
arg, cell.tag.bytes, cell.count ); arg, cell.tag.bytes, cell.count );
print( output, frame->arg[arg] ); print( output, frame->arg[arg] );

View file

@ -1261,11 +1261,15 @@ struct cons_pointer eval_cond_clause( struct cons_pointer clause,
env ) ); env ) );
#ifdef DEBUG #ifdef DEBUG
debug_print( L"\n\t\tclause succeeded; returning: ", DEBUG_EVAL ); debug_print( L"\n\t\tCond clause ", DEBUG_EVAL);
debug_print_object( clause, DEBUG_EVAL);
debug_print( L" succeeded; returning: ", DEBUG_EVAL );
debug_print_object( result, DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL );
debug_println( DEBUG_EVAL ); debug_println( DEBUG_EVAL );
} else { } else {
debug_print( L"\n\t\tclause failed.\n", DEBUG_EVAL ); debug_print( L"\n\t\tCond clause ", DEBUG_EVAL);
debug_print_object( clause, DEBUG_EVAL);
debug_print( L" failed.\n", DEBUG_EVAL );
#endif #endif
} }
} else { } else {

View file

@ -3,7 +3,7 @@
result=0 result=0
expected='t' expected='t'
output=`target/psse <<EOF output=`target/psse $1 <<EOF
(progn (progn
(set! nil? (lambda (o) (= (type o) "NIL "))) (set! nil? (lambda (o) (= (type o) "NIL ")))
(set! member? (set! member?
@ -17,7 +17,7 @@ output=`target/psse <<EOF
EOF` EOF`
actual=`echo $output | tail -1` actual=`echo $output | tail -1`
echo -n "$?: (member? 1 '(1 2 3 4))... " echo -n "$0 $1: (member? 1 '(1 2 3 4))... "
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
@ -28,7 +28,7 @@ else
fi fi
expected='t' expected='t'
output=`target/psse <<EOF output=`target/psse $1 <<EOF
(progn (progn
(set! nil? (lambda (o) (= (type o) "NIL "))) (set! nil? (lambda (o) (= (type o) "NIL ")))
(set! member? (set! member?
@ -42,7 +42,7 @@ output=`target/psse <<EOF
EOF` EOF`
actual=`echo $output | tail -1` actual=`echo $output | tail -1`
echo -n "$?: (member? 4 '(1 2 3 4))... " echo -n "$0: (member? 4 '(1 2 3 4))... "
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
@ -54,7 +54,7 @@ fi
expected='nil' expected='nil'
output=`target/psse <<EOF output=`target/psse $1 <<EOF
(progn (progn
(set! nil? (lambda (o) (= (type o) "NIL "))) (set! nil? (lambda (o) (= (type o) "NIL ")))
(set! member? (set! member?
@ -68,7 +68,7 @@ output=`target/psse <<EOF
EOF` EOF`
actual=`echo $output | tail -1` actual=`echo $output | tail -1`
echo -n "$?: (member? 5 '(1 2 3 4))... " echo -n "$0: (member? 5 '(1 2 3 4))... "
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
@ -79,13 +79,13 @@ else
fi fi
expected='nil' expected='nil'
output=`target/psse -s100<<EOF output=`target/psse $1 -s100<<EOF
(progn (progn
(set! nil? (lambda (o) (= (type o) "NIL "))) (set! nil? (lambda (o) (= (type o) "NIL ")))
(set! member? (set! member?
(lambda (lambda
(item collection) (item collection)
(print (list "in member?: " 'item item 'collection collection)) ;; (print (list "in member?: " 'item item 'collection collection))
(cond (cond
((nil? collection) nil) ((nil? collection) nil)
((= item (car collection)) t) ((= item (car collection)) t)
@ -94,7 +94,7 @@ output=`target/psse -s100<<EOF
EOF` EOF`
actual=`echo $output | tail -1` actual=`echo $output | tail -1`
echo -n "$?: (member? 5 '(1 2 3 4)) with stack limit... " echo -n "$0: (member? 5 '(1 2 3 4)) with stack limit... "
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then