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

Got dump working, to try to investigate the assoc bug. Much better

Browse source 
dump output, but `assoc` still doesn't work for read symbols, and
we now have a segfault on exit.
This commit is contained in:
Simon Brooke 2026-05-06 12:23:46 +01:00
parent cf655e8020
commit c29a95b00d
10 changed files with 284 additions and 411 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/c/debug.c
View file

@ -19,7 +19,7 @@
#include "io/io.h" #include "io/io.h"
#include "io/print.h" #include "io/print.h"
// #include "memory/dump.h" #include "memory/dump.h"
int verbosity = 0; int verbosity = 0;
@ -162,7 +162,7 @@ void debug_dump_object( struct pso_pointer pointer, int level, int indent ) {
if ( level & verbosity ) { if ( level & verbosity ) {
URL_FILE *ustderr = file_to_url_file( stderr ); URL_FILE *ustderr = file_to_url_file( stderr );
fwide( stderr, 1 ); fwide( stderr, 1 );
// dump_object( ustderr, pointer ); dump_object( pointer );
free( ustderr ); free( ustderr );
} }
#endif #endif

2
src/c/io/io.c
View file

@ -241,7 +241,7 @@ struct pso_pointer initialise_default_streams( struct pso_pointer
( frame_pointer, L"url" ), ( frame_pointer, L"url" ),
c_string_to_lisp_string c_string_to_lisp_string
( frame_pointer, ( frame_pointer,
L"::system:standard-output" ) ), L"::system:standard-log" ) ),
nil ) ) ); nil ) ) );
env = env =
lisp_bind( make_frame lisp_bind( make_frame

10
src/c/io/read.c
View file

@ -154,6 +154,7 @@ struct pso_pointer read_number( struct pso_pointer frame_pointer ) {
} // else exception? } // else exception?
#ifdef DEBUG #ifdef DEBUG
debug_printf( DEBUG_IO, 0, L"\nRead number %ld\n", value ); debug_printf( DEBUG_IO, 0, L"\nRead number %ld\n", value );
debug_dump_object(result, DEBUG_IO, 1);
#endif #endif
return result; return result;
@ -189,12 +190,8 @@ struct pso_pointer read_symbol( struct pso_pointer frame_pointer ) {
debug_print( L"\nRead symbol `", DEBUG_IO, 0 ); debug_print( L"\nRead symbol `", DEBUG_IO, 0 );
debug_print_object( result, DEBUG_IO, 0); debug_print_object( result, DEBUG_IO, 0);
debug_print( L"`\n\t", DEBUG_IO, 0); debug_print( L"`\n\t", DEBUG_IO, 0);
for ( struct pso_pointer cursor = result; !c_nilp(cursor); cursor = c_cdr(cursor)) { debug_dump_object(result, DEBUG_IO, 1);
wint_t c = pointer_to_object(cursor)->payload.string.character; #endif
debug_printf( DEBUG_IO, 0, L"[Character %lc (%d)]", c, c);
}
debug_println(DEBUG_IO);
#endif
return result; return result;
} }
@ -287,6 +284,7 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) {
debug_print( L"Read expression: `", DEBUG_IO, 0 ); debug_print( L"Read expression: `", DEBUG_IO, 0 );
debug_print_object( result, DEBUG_IO, 0 ); debug_print_object( result, DEBUG_IO, 0 );
debug_print( L"`\n", DEBUG_IO, 0 ); debug_print( L"`\n", DEBUG_IO, 0 );
debug_dump_object(result, DEBUG_IO, 1);
#endif #endif
return result; return result;

492
src/c/memory/dump.c
View file

@ -22,6 +22,7 @@
#include <wctype.h> #include <wctype.h>
#include "io/fopen.h" #include "io/fopen.h"
#include "io/io.h"
#include "io/print.h" #include "io/print.h"
#include "memory/pointer.h" #include "memory/pointer.h"
#include "memory/pso.h" #include "memory/pso.h"
@ -30,6 +31,8 @@
#include "memory/pso4.h" #include "memory/pso4.h"
#include "memory/tags.h" #include "memory/tags.h"
#include "ops/truth.h"
#include "ops/truth.h"
#include "payloads/character.h" #include "payloads/character.h"
#include "payloads/cons.h" #include "payloads/cons.h"
#include "payloads/exception.h" #include "payloads/exception.h"
@ -40,230 +43,267 @@
#include "payloads/symbol.h" #include "payloads/symbol.h"
#include "payloads/time.h" #include "payloads/time.h"
//void dump_string_cell( URL_FILE *output, wchar_t *prefix, void dump_string_cell( URL_FILE *output, wchar_t *prefix,
// struct pso_pointer pointer ) { struct pso_pointer pointer ) {
// struct pso2* object = pointer_to_object( pointer ); struct pso2* object = pointer_to_object( pointer );
// if ( object->payload.string.character == 0 ) { if ( object->payload.string.character == 0 ) {
// url_fwprintf( output, url_fwprintf( output,
// L"\t\t%ls cell: termination; next at page %d offset %d, count %u\n", L"\t\t%ls cell: termination; next at page %d offset %d, count %u\n",
// prefix, prefix,
// object->payload.string.cdr.page, object->payload.string.cdr.page,
// object->payload.string.cdr.offset, object->header.count ); object->payload.string.cdr.offset, object->header.count );
// } else { } else {
// url_fwprintf( output, url_fwprintf( output,
// L"\t\t%ls cell: character '%lc' (%d) with hash %d; next at page %d offset %d, count %u\n", L"\t\t%ls cell: character '%lc' (%d) with hash %d; next at page %d offset %d, count %u\n",
// prefix, prefix,
// ( wint_t ) object->payload.string.character, ( wint_t ) object->payload.string.character,
// object->payload.string.character, object->payload.string.character,
// object->payload.string.hash, object->payload.string.hash,
// object->payload.string.cdr.page, object->payload.string.cdr.page,
// object->payload.string.cdr.offset, object->header.count ); object->payload.string.cdr.offset, object->header.count );
//// url_fwprintf( output, L"\t\t value: " ); url_fwprintf( output, L"\t\t value: " );
//// print( output, pointer ); in_write( pointer, output, false, 0);
// url_fwprintf( output, L"\n" ); if (stringlikep(pointer)) {
// } url_fwprintf( output, L"\n\t\t structure: " );
//} for ( struct pso_pointer cursor = pointer; !c_nilp(cursor); cursor = c_cdr(cursor)) {
// wint_t c = pointer_to_object(cursor)->payload.string.character;
// char* tag = (pointer_to_object(cursor)->header.tag.bytes.mnemonic);
//void dump_frame_context_fragment( URL_FILE *output, url_fwprintf( output, L"[%3.3s %lc (%d)]", tag, c, c);
// struct pso_pointer frame_pointer, }
// uint arg) { }
// if ( stackp(frame_pointer ) {
// struct pso4 *frame = pointer_to_pso4( frame_pointer ); url_fwprintf( output, L"\n" );
// }
// url_fwprintf( output, L" <= " ); }
//// print( frame->payload.stack_frame.arg[arg], output );
// }
//} void dump_frame_context_fragment( URL_FILE *output,
// struct pso_pointer frame_pointer,
//void dump_frame_context( URL_FILE *output, struct pso_pointer frame_pointer, uint arg) {
// int depth ) { if ( stackp(frame_pointer )) {
// if ( framep(frame_pointer) ) { struct pso4 *frame = pointer_to_pso4( frame_pointer );
// struct pso4 *frame = pointer_to_pso4( frame_pointer );
// url_fwprintf( output, L" <= " );
// url_fwprintf( output, L"\tContext: " ); in_write( frame->payload.stack_frame.arg[arg], output, false, 0 );
// }
// int i = 0; }
// for ( struct pso_pointer cursor = frame_pointer;
// i++ < depth && !nilp( cursor ); void dump_frame_context( URL_FILE *output, struct pso_pointer frame_pointer,
// cursor = frame_get_previous( cursor ) ) { int depth ) {
// dump_frame_context_fragment( output, cursor, 0 ); if ( stackp(frame_pointer) ) {
// } struct pso4 *frame = pointer_to_pso4( frame_pointer );
//
// url_fwprintf( output, L"\n" ); url_fwprintf( output, L"\tContext: " );
// }
//} int i = 0;
// for ( struct pso_pointer cursor = frame_pointer;
///** i++ < depth && !c_nilp( cursor );
// * Dump a stackframe to this stream for debugging cursor = pointer_to_pso4(cursor)->payload.stack_frame.previous ) {
// * @param output the stream dump_frame_context_fragment( output, cursor, 0 );
// * @param frame_pointer the pointer to the frame }
// */
//void dump_frame( URL_FILE *output, struct pso_pointer frame_pointer ) { url_fwprintf( output, L"\n" );
// if ( framep(frame_pointer) ) { }
// struct pso4 *frame = pointer_to_pso4( frame_pointer ); }
//
// url_fwprintf( output, L"Stack frame %d with %d arguments:\n", /**
// frame->payload.stack_frame.depth, frame->payload.stack_frame.args ); * Dump a stackframe to this stream for debugging
// dump_frame_context( output, frame_pointer, 4 ); * @param output the stream
// * @param frame_pointer the pointer to the frame
// for ( int arg = 0; arg < frame->payload.stack_frame.args; arg++ ) { */
// struct pso2* object = fetch_arg(frame, arg); void dump_frame( URL_FILE *output, struct pso_pointer frame_pointer ) {
// if ( stackp(frame_pointer) ) {
// url_fwprintf( output, L"\tArg %d:\t%3.3s\tcount: %10u\tvalue: ", struct pso4 *frame = pointer_to_pso4( frame_pointer );
// arg, object->header.tag.bytes.mnemonic[0], object->header.count );
// url_fwprintf( output, L"Stack frame %d with %d arguments:\n",
// print( output, frame->payload.stack_frame.arg[arg] ); frame->payload.stack_frame.depth, frame->payload.stack_frame.args );
dump_frame_context( output, frame_pointer, 4 );
for ( int arg = 0; arg < frame->payload.stack_frame.args; arg++ ) {
struct pso2* object = pointer_to_object( fetch_arg(frame, arg));
url_fwprintf( output, L"\tArg %d:\t%3.3s\tcount: %10u\tvalue: ",
arg, object->header.tag.bytes.mnemonic[0], object->header.count );
in_write( frame->payload.stack_frame.arg[arg], output, false, 0 );
url_fputws( L"\n", output );
}
if ( !c_nilp( frame->payload.stack_frame.more ) ) {
url_fputws( L"More: \t", output );
in_write( frame->payload.stack_frame.more, output, false, 0 );
url_fputws( L"\n", output );
}
}
}
void dump_stack_trace( URL_FILE *output, struct pso_pointer pointer ) {
if ( exceptionp( pointer ) ) {
struct pso3* exep = pointer_to_pso3( pointer);
in_write( exep->payload.exception.message, output, false, 0 );
url_fputws( L"\n", output );
dump_stack_trace( output,
exep->payload.exception.stack );
} else {
while ( stackp( pointer) ) {
dump_frame( output, pointer );
pointer = pointer_to_pso4( pointer )->payload.stack_frame.previous;
}
}
}
/**
* @brief dump an object to a stream.
*
* (dump object stream)
*
* dual role: can be invoked from Lisp with a frame pointer as
* a normal Lisp function, in which case args should be
*
* @param object a pointer to the object to be dumped;
* @param stream (optional) the stream to dump to (defaults to `*log*`)
*
* If invoked from C, the single argument should be a pointer to the object
* to be dumped.
*/
struct pso_pointer dump_object( struct pso_pointer frame_pointer ) {
struct pso_pointer result = nil;
struct pso_pointer stream = nil;
struct pso_pointer pointer = nil;
if (stackp(frame_pointer)) {
struct pso4* frame = pointer_to_pso4( frame_pointer);
pointer = fetch_arg( frame, 0);
stream = fetch_arg( frame, 1);
} else {
pointer = frame_pointer;
}
if (!writep(stream)) {
stream = lisp_stderr;
}
// URL_FILE* output = file_to_url_file(stderr);
// url_fputws( L"\ndump_object printing to output stream; metadata: ", output );
// in_write( pointer_to_object(stream)->payload.stream.meta, output, false, 0 );
// url_fputws( L"\n", output ); // url_fputws( L"\n", output );
// } // fflush(stderr);
// if ( !nilp( frame->more ) ) {
// url_fputws( L"More: \t", output ); URL_FILE* output = pointer_to_object(stream)->payload.stream.stream;
// print( output, frame->more );
// url_fputws( L"\n", output ); if (c_nilp(pointer)) {
// } // the object at (node, 0, 0) ought to have been initialised, but may not
// } // have been...
//} url_fputws(L"nil of size class 2 at page 0, offset 0, count xxxx\n", output );
// } else {
// struct pso2* object = pointer_to_object( pointer );
//void dump_stack_trace( URL_FILE *output, struct pso_pointer pointer ) { url_fwprintf( output, L"\t%3.3s (%d) of size class %d at page %d, offset %d count %u\n",
// if ( exceptionp( pointer ) ) { object->header.tag.bytes.mnemonic,
// struct pso3* exep = pointer_to_pso3( pointer); get_tag_value(pointer),
// print( output, exep->payload.exception. ); object->header.tag.bytes.size_class,
// url_fputws( L"\n", output ); pointer.page, pointer.offset,
// dump_stack_trace( output, object->header.count );
// exep->payload.exception.stack );
// } else { switch ( get_tag_value( pointer) ) {
// while ( stackp( pointer) ) { case CONSTV:
// dump_frame( output, pointer ); url_fwprintf( output,
// pointer = pointer_to_pso4( pointer )->payload.stack_frame.previous; L"\t\tCons object: car at page %d offset %d, cdr at page %d "
// } L"offset %d :",
// } object->payload.cons.car.page,
//} object->payload.cons.car.offset,
// object->payload.cons.cdr.page,
// object->payload.cons.cdr.offset);
///** in_write( pointer, output, false, 0 );
// * dump the object at this pso_pointer to this output stream. url_fputws( L"\n", output );
// * TODO: convert this into a proper Lisp function and move to ops break;
// */ case EXCEPTIONTV:
//struct pso_pointer dump_object( struct pso_pointer frame_pointer ) { url_fwprintf( output, L"\t\tException object: " );
// struct pso_pointer result = nil; dump_stack_trace( output, pointer );
// break;
// if (stackp(frame_pointer)) { case FREETV:
// struct pso4* frame = pointer_to_pso4( frame_pointer); url_fwprintf( output,
// L"\t\tFree object: next at page %d offset %d\n",
// struct pso_pointer pointer = fetch_arg( frame, 0); object->payload.free.next.page,
// struct pso_pointer stream = fetch_arg( frame, 1); object->payload.free.next.offset);
// break;
// if (!writep(stream)) { case INTEGERTV:
// stream = lisp_stdout; url_fwprintf( output, L"\t\tInteger object: value %ld\n",
// } object->payload.integer.value );
// break;
// struct pso2* object = pointer_to_object( pointer ); case KEYTV:
// url_fwprintf( output, L"\t%3.3s (%d) of size class %d at page %d, offset %d count %u\n", dump_string_cell( output, L"Keyword", pointer );
// object->header.tag.bytes.mnemonic[0], break;
// get_tag_value(pointer), // case LAMBDATV:
// object->header.tag.bytes.size_class, // url_fwprintf( output, L"\t\t\u03bb object;\n\t\t args: " );
// pointer.page, pointer.offset, // in_write( output, object->payload.lambda.args );
// object->header.count ); // url_fwprintf( output, L";\n\t\t\tbody: " );
// // in_write( output, object->payload.lambda.body );
// switch ( get_tag_value( pointer) ) { // url_fputws( L"\n", output );
// case CONSTV: // break;
// url_fwprintf( output, // case NILTV:
// L"\t\tCons object: car at page %d offset %d, cdr at page %d " // break;
// L"offset %d :", // case NLAMBDATV:
// object->payload.cons.car.page, // url_fwprintf( output, L"\t\tn\u03bb object; \n\t\targs: " );
// object->payload.cons.car.offset, // in_write( output, object->payload.lambda.args );
// object->payload.cons.cdr.page, // url_fwprintf( output, L";\n\t\t\tbody: " );
// object->payload.cons.cdr.offset); // in_write( output, object->payload.lambda.body );
// print( output, pointer ); // url_fputws( L"\n", output );
// url_fputws( L"\n", output ); // break;
// break; // case RATIOTV:
// case EXCEPTIONTV: // url_fwprintf( output,
// url_fwprintf( output, L"\t\tException object: " ); // L"\t\tRational object: value %ld/%ld, count %u\n",
// dump_stack_trace( output, pointer ); // pointer_to_object( object->payload.ratio.dividend ).
// break; // payload.integer.value,
// case FREETV: // pointer_to_object( object->payload.ratio.divisor ).
// url_fwprintf( output, // payload.integer.value, object->count );
// L"\t\tFree object: next at page %d offset %d\n", // break;
// object->payload.free.next.page, case READTV:
// object->payload.free.next.offset); url_fputws( L"\t\tInput stream; metadata: ", output );
// break; in_write( object->payload.stream.meta, output, false, 0 );
// case INTEGERTV: url_fputws( L"\n", output );
// url_fwprintf( output, L"\t\tInteger object: value %ld\n", break;
// object->payload.integer.value ); // case REALTV:
// break; // url_fwprintf( output, L"\t\tReal object: value %Lf, count %u\n",
// case KEYTV: // object->payload.real.value, object->count );
// dump_string_cell( output, L"Keyword", pointer ); // break;
// break; case STRINGTV:
//// case LAMBDATV: dump_string_cell( output, L"String", pointer );
//// url_fwprintf( output, L"\t\t\u03bb object;\n\t\t args: " ); break;
//// print( output, object->payload.lambda.args ); case SYMBOLTV:
//// url_fwprintf( output, L";\n\t\t\tbody: " ); dump_string_cell( output, L"Symbol", pointer );
//// print( output, object->payload.lambda.body ); break;
//// url_fputws( L"\n", output ); // case TRUETV:
//// break; // break;
//// case NILTV: // case VECTORPOINTTV:{
//// break; // url_fwprintf( output,
//// case NLAMBDATV: // L"\t\tPointer to vector-space object at %p\n",
//// url_fwprintf( output, L"\t\tn\u03bb object; \n\t\targs: " ); // object->payload.vectorp.address );
//// print( output, object->payload.lambda.args ); // struct vector_space_object *vso = object->payload.vectorp.address;
//// url_fwprintf( output, L";\n\t\t\tbody: " ); // url_fwprintf( output,
//// print( output, object->payload.lambda.body ); // L"\t\tVector space object of type %4.4s (%d), payload size "
//// url_fputws( L"\n", output ); // L"%d bytes\n",
//// break; // &vso->header.tag.bytes, vso->header.tag.value,
//// case RATIOTV: // vso->header.size );
//// url_fwprintf( output, //
//// L"\t\tRational object: value %ld/%ld, count %u\n", // switch ( vso->header.tag.value ) {
//// pointer_to_object( object->payload.ratio.dividend ). // case STACKFRAMETV:
//// payload.integer.value, // dump_frame( output, pointer );
//// pointer_to_object( object->payload.ratio.divisor ). // break;
//// payload.integer.value, object->count ); // case HASHTV:
//// break; // dump_map( output, pointer );
// case READTV: // break;
// url_fputws( L"\t\tInput stream; metadata: ", output ); // }
//// print( output, object->payload.stream.meta ); // }
// url_fputws( L"\n", output ); // break;
// break; case WRITETV:
//// case REALTV: url_fputws( L"\t\tOutput stream; metadata: ", output );
//// url_fwprintf( output, L"\t\tReal object: value %Lf, count %u\n", in_write( object->payload.stream.meta, output, false, 0 );
//// object->payload.real.value, object->count ); url_fputws( L"\n", output );
//// break; break;
// case STRINGTV: }
// dump_string_cell( output, L"String", pointer ); }
// break;
// case SYMBOLTV: return result;
// dump_string_cell( output, L"Symbol", pointer ); }
// break;
//// case TRUETV:
//// break;
//// case VECTORPOINTTV:{
//// url_fwprintf( output,
//// L"\t\tPointer to vector-space object at %p\n",
//// object->payload.vectorp.address );
//// struct vector_space_object *vso = object->payload.vectorp.address;
//// url_fwprintf( output,
//// L"\t\tVector space object of type %4.4s (%d), payload size "
//// L"%d bytes\n",
//// &vso->header.tag.bytes, vso->header.tag.value,
//// vso->header.size );
////
//// switch ( vso->header.tag.value ) {
//// case STACKFRAMETV:
//// dump_frame( output, pointer );
//// break;
//// case HASHTV:
//// dump_map( output, pointer );
//// break;
//// }
//// }
//// break;
// case WRITETV:
// url_fputws( L"\t\tOutput stream; metadata: ", output );
//// print( output, object->payload.stream.meta );
//// url_fputws( L"\n", output );
// break;
// }
// } // TODO: else exception
//
// return result;
//}

2
src/c/memory/dump.h
View file

@ -11,7 +11,7 @@
#define SRC_C_MEMORY_DUMP_H_ #define SRC_C_MEMORY_DUMP_H_
void dump_object( URL_FILE *output, struct pso_pointer pointer ); void dump_object( struct pso_pointer pointer );
#endif /* SRC_C_MEMORY_DUMP_H_ */ #endif /* SRC_C_MEMORY_DUMP_H_ */

1
src/c/memory/tags.h
View file

@ -130,6 +130,7 @@ bool check_type( struct pso_pointer p, char *s );
#define stackp(p) (check_tag(p, STACKTV)) #define stackp(p) (check_tag(p, STACKTV))
#define streamp(p) (check_tag(p,READTV)||check_tag(p,WRITETV)) #define streamp(p) (check_tag(p,READTV)||check_tag(p,WRITETV))
#define stringp(p) (check_tag(p,STRINGTV)) #define stringp(p) (check_tag(p,STRINGTV))
#define stringlikep(p) (check_tag(p,KEYTV)||check_tag(p,STRINGTV)||check_tag(p,SYMBOLTV))
#define symbolp(p) (check_tag(p,SYMBOLTV)) #define symbolp(p) (check_tag(p,SYMBOLTV))
#define timep(p) (check_tag(p,TIMETV)) #define timep(p) (check_tag(p,TIMETV))
// the version of truep in ops/truth.c is better than this, because it does not // the version of truep in ops/truth.c is better than this, because it does not

24
src/c/ops/assoc.c
View file

@ -45,13 +45,7 @@ struct pso_pointer search( struct pso_pointer key,
debug_print( L"In search; key is: `", DEBUG_BIND, 0 ); debug_print( L"In search; key is: `", DEBUG_BIND, 0 );
debug_print_object( key, DEBUG_BIND, 0 ); debug_print_object( key, DEBUG_BIND, 0 );
debug_print( L"`\n", DEBUG_BIND, 0 ); debug_print( L"`\n", DEBUG_BIND, 0 );
debug_print(L"", DEBUG_BIND, 2); debug_dump_object(key, DEBUG_BIND, 1);
if (symbolp(key)) {
for ( struct pso_pointer cursor = key; !c_nilp(cursor); cursor = c_cdr(cursor)) {
wint_t c = pointer_to_object(cursor)->payload.string.character;
debug_printf( DEBUG_BIND, 0, L"[Character %lc (%d)]", c, c);
}
}
#endif #endif
if ( consp( store ) ) { if ( consp( store ) ) {
@ -59,25 +53,17 @@ struct pso_pointer search( struct pso_pointer key,
consp( cursor ) && found == false; cursor = c_cdr( cursor ) ) { consp( cursor ) && found == false; cursor = c_cdr( cursor ) ) {
struct pso_pointer pair = c_car( cursor ); struct pso_pointer pair = c_car( cursor );
#ifdef DEBUG #ifdef DEBUG
debug_print( L"Checking ", DEBUG_BIND, 2 ); debug_print( L"Checking `", DEBUG_BIND, 1 );
debug_print_object( c_car( pair), DEBUG_BIND, 0 ); debug_print_object( c_car( pair), DEBUG_BIND, 0 );
debug_println( DEBUG_BIND); debug_print(L"`\n", DEBUG_BIND, 2);
debug_print(L"", DEBUG_BIND, 4); debug_dump_object(c_car(pair), DEBUG_BIND, 2);
if (symbolp(c_car( pair))) {
for ( struct pso_pointer cursor = c_car(pair); !c_nilp(cursor); cursor = c_cdr(cursor)) {
wint_t c = pointer_to_object(cursor)->payload.string.character;
debug_printf( DEBUG_BIND, 0, L"[Character %lc (%d)]", c, c);
}
}
debug_println(DEBUG_BIND);
#endif #endif
if ( consp( pair ) && c_equal( c_car( pair ), key ) ) { if ( consp( pair ) && c_equal( c_car( pair ), key ) ) {
found = true; found = true;
result = return_key ? c_car( pair ) : c_cdr( pair ); result = return_key ? c_car( pair ) : c_cdr( pair );
#ifdef DEBUG #ifdef DEBUG
debug_print( L" ...found!", DEBUG_BIND, 0 ); debug_print( L" ...found!", DEBUG_BIND, 2 );
#endif #endif
} }
#ifdef DEBUG #ifdef DEBUG

154
src/c/ops/dump.c
View file

@ -1,154 +0,0 @@
/*
* dump.c
*
* Dump representations of both cons space and vector space objects.
*
* TODO: This is going to be entirely rewritten and merged with `inspect.c`,
* q.v., which will be the main entrypoint to this code. What exists is
* technical debt but will work for now.
*
* (c) 2018 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
/*
* wide characters
*/
#include <wchar.h>
#include <wctype.h>
#include "memory/pointer.h"
#include "memory/pso2.h"
#include "memory/pso4.h"
#include "memory/tags.h"
#include "io/print.h"
#include "payloads/stack.h"
#include "payloads/lambda.h"
void dump_string_cell( struct pso_pointer frame_pointer, struct pso_pointer output, wchar_t *prefix,
struct pso_pointer pointer ) {
URL_FILE* os = pointer_to_object(output)->payload.stream.stream;
struct pso2 *cell = pointer_to_object( pointer );
if ( cell->payload.string.character == 0 ) {
url_fwprintf( os,
L"\t\t%ls cell: termination; next at page %d offset %d, count %u\n",
prefix,
cell->payload.string.cdr.page,
cell->payload.string.cdr.offset, cell->header.count );
} else {
url_fwprintf( os,
L"\t\t%ls cell: character '%lc' (%d) with hash %d; next at page %d offset %d, count %u\n",
prefix,
( wint_t ) cell->payload.string.character,
cell->payload.string.character,
cell->payload.string.hash,
cell->payload.string.cdr.page,
cell->payload.string.cdr.offset, cell->header.count );
url_fwprintf( os, L"\t\t value: " );
c_print( frame_pointer, pointer, output );
url_fwprintf( os, L"\n" );
}
}
/**
* dump the object at this pso_pointer to this output stream.
*/
void dump_object( struct pso_pointer frame_pointer, struct pso_pointer output, struct pso_pointer pointer ) {
URL_FILE* os = pointer_to_object(output)->payload.stream.stream;
struct pso2 *cell = pointer_to_object( pointer );
url_fwprintf( os, L"\t%3.3s (%d) at page %d, offset %d count %u\n",
cell->header.tag.bytes.mnemonic[0], get_tag_value( pointer ),
pointer.page, pointer.offset, cell->header.count );
switch ( get_tag_value( pointer ) ) {
case CONSTV:
url_fwprintf( os,
L"\t\tCons cell: car at page %d offset %d, cdr at page %d "
L"offset %d, count %u :",
cell->payload.cons.car.page,
cell->payload.cons.car.offset,
cell->payload.cons.cdr.page,
cell->payload.cons.cdr.offset );
c_print( frame_pointer, pointer, output );
url_fputws( L"\n", os );
break;
// case EXCEPTIONTV:
// url_fwprintf( os, L"\t\tException cell: " );
// dump_stack_trace( output, pointer );
// break;
case FREETV:
url_fwprintf( os,
L"\t\tFree cell: next at page %d offset %d\n",
cell->payload.cons.cdr.page,
cell->payload.cons.cdr.offset );
break;
// case HASHTV:
// dump_map( output, pointer );
// break;
case INTEGERTV:
url_fwprintf( os, L"\t\tInteger cell: value %ld, count %u\n",
cell->payload.integer.value, cell->header.count );
break;
case KEYTV:
dump_string_cell( frame_pointer, output, L"Keyword", pointer );
break;
case LAMBDATV:
url_fwprintf( os, L"\t\t\u03bb cell;\n\t\t args: " );
c_print( frame_pointer, cell->payload.lambda.args, output );
url_fwprintf( os, L";\n\t\t\tbody: " );
c_print( frame_pointer, cell->payload.lambda.body, output );
url_fputws( L"\n", os );
break;
case NILTV:
break;
case NLAMBDATV:
url_fwprintf( os, L"\t\tn\u03bb cell; \n\t\targs: " );
c_print( frame_pointer, cell->payload.lambda.args, output );
url_fwprintf( os, L";\n\t\t\tbody: " );
c_print( frame_pointer, cell->payload.lambda.body, output );
url_fputws( L"\n", os );
break;
// case RATIOTV:
// url_fwprintf( os,
// L"\t\tRational cell: value %ld/%ld, count %u\n",
// pointer_to_object( cell->payload.ratio.
// dividend ).payload.integer.value,
// pointer_to_object( cell->payload.ratio.
// divisor ).payload.integer.value,
// cell->header.count );
// break;
case READTV:
url_fputws( L"\t\tInput stream; metadata: ", os );
c_print( frame_pointer, cell->payload.stream.meta, output );
url_fputws( L"\n", os );
break;
case REALTV:
url_fwprintf( os, L"\t\tReal cell: value %Lf, count %u\n",
cell->payload.real.value, cell->header.count );
break;
// case STACKTV:
// dump_frame( frame_pointer, output, pointer );
// break;
case STRINGTV:
dump_string_cell( frame_pointer, output, L"String", pointer );
break;
case SYMBOLTV:
dump_string_cell( frame_pointer, output, L"Symbol", pointer );
break;
case TRUETV:
break;
case WRITETV:
url_fputws( L"\t\tOutput stream; metadata: ", os );
c_print( frame_pointer, cell->payload.stream.meta, output );
url_fputws( L"\n", os );
break;
default:
url_fwprintf(os, L"TODO: Cannot yet dump object of type %3.3s\n",
cell->header.tag.bytes.mnemonic[0]);
break;
}
}

0
src/c/ops/dump.h
View file

2
src/c/ops/eval_apply.c
View file

@ -110,6 +110,7 @@ struct pso_pointer eval_form( struct pso_pointer frame_pointer ) {
debug_print( L" returning: ", DEBUG_EVAL, 0 ); debug_print( L" returning: ", DEBUG_EVAL, 0 );
debug_print_object( result, DEBUG_EVAL, 0 ); debug_print_object( result, DEBUG_EVAL, 0 );
debug_println( DEBUG_EVAL ); debug_println( DEBUG_EVAL );
debug_dump_object(result, DEBUG_EVAL, 1);
return result; return result;
} }
@ -632,6 +633,7 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) {
debug_print( L"apply: returning: ", DEBUG_EVAL, 0 ); debug_print( L"apply: returning: ", DEBUG_EVAL, 0 );
debug_print_object( result, DEBUG_EVAL, 0 ); debug_print_object( result, DEBUG_EVAL, 0 );
debug_println( DEBUG_EVAL ); debug_println( DEBUG_EVAL );
debug_dump_object( result, DEBUG_EVAL, 0 );
return result; return result;
} }