diff --git a/src/c/debug.c b/src/c/debug.c index 6c4796d..a375dee 100644 --- a/src/c/debug.c +++ b/src/c/debug.c @@ -19,7 +19,7 @@ #include "io/io.h" #include "io/print.h" -// #include "memory/dump.h" +#include "memory/dump.h" int verbosity = 0; @@ -162,7 +162,7 @@ void debug_dump_object( struct pso_pointer pointer, int level, int indent ) { if ( level & verbosity ) { URL_FILE *ustderr = file_to_url_file( stderr ); fwide( stderr, 1 ); -// dump_object( ustderr, pointer ); + dump_object( pointer ); free( ustderr ); } #endif diff --git a/src/c/io/io.c b/src/c/io/io.c index 4636bc3..ffe5ae9 100644 --- a/src/c/io/io.c +++ b/src/c/io/io.c @@ -241,7 +241,7 @@ struct pso_pointer initialise_default_streams( struct pso_pointer ( frame_pointer, L"url" ), c_string_to_lisp_string ( frame_pointer, - L"::system:standard-output" ) ), + L"::system:standard-log" ) ), nil ) ) ); env = lisp_bind( make_frame diff --git a/src/c/io/read.c b/src/c/io/read.c index fa244c8..3331511 100644 --- a/src/c/io/read.c +++ b/src/c/io/read.c @@ -154,6 +154,7 @@ struct pso_pointer read_number( struct pso_pointer frame_pointer ) { } // else exception? #ifdef DEBUG debug_printf( DEBUG_IO, 0, L"\nRead number %ld\n", value ); + debug_dump_object(result, DEBUG_IO, 1); #endif 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_object( result, DEBUG_IO, 0); debug_print( L"`\n\t", DEBUG_IO, 0); - for ( struct pso_pointer cursor = result; !c_nilp(cursor); cursor = c_cdr(cursor)) { - wint_t c = pointer_to_object(cursor)->payload.string.character; - debug_printf( DEBUG_IO, 0, L"[Character %lc (%d)]", c, c); - } - debug_println(DEBUG_IO); -#endif + debug_dump_object(result, DEBUG_IO, 1); + #endif return result; } @@ -286,7 +283,8 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) { #ifdef DEBUG debug_print( L"Read expression: `", 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 return result; diff --git a/src/c/memory/dump.c b/src/c/memory/dump.c index 46d5c81..36a9755 100644 --- a/src/c/memory/dump.c +++ b/src/c/memory/dump.c @@ -22,6 +22,7 @@ #include #include "io/fopen.h" +#include "io/io.h" #include "io/print.h" #include "memory/pointer.h" #include "memory/pso.h" @@ -30,6 +31,8 @@ #include "memory/pso4.h" #include "memory/tags.h" +#include "ops/truth.h" +#include "ops/truth.h" #include "payloads/character.h" #include "payloads/cons.h" #include "payloads/exception.h" @@ -40,230 +43,267 @@ #include "payloads/symbol.h" #include "payloads/time.h" -//void dump_string_cell( URL_FILE *output, wchar_t *prefix, -// struct pso_pointer pointer ) { -// struct pso2* object = pointer_to_object( pointer ); -// if ( object->payload.string.character == 0 ) { -// url_fwprintf( output, -// L"\t\t%ls cell: termination; next at page %d offset %d, count %u\n", -// prefix, -// object->payload.string.cdr.page, -// object->payload.string.cdr.offset, object->header.count ); -// } else { -// url_fwprintf( output, -// L"\t\t%ls cell: character '%lc' (%d) with hash %d; next at page %d offset %d, count %u\n", -// prefix, -// ( wint_t ) object->payload.string.character, -// object->payload.string.character, -// object->payload.string.hash, -// object->payload.string.cdr.page, -// object->payload.string.cdr.offset, object->header.count ); -//// url_fwprintf( output, L"\t\t value: " ); -//// print( output, pointer ); -// url_fwprintf( output, L"\n" ); -// } -//} -// -// -//void dump_frame_context_fragment( URL_FILE *output, -// struct pso_pointer frame_pointer, -// uint arg) { -// if ( stackp(frame_pointer ) { -// struct pso4 *frame = pointer_to_pso4( frame_pointer ); -// -// url_fwprintf( output, L" <= " ); -//// print( frame->payload.stack_frame.arg[arg], output ); -// } -//} -// -//void dump_frame_context( URL_FILE *output, struct pso_pointer frame_pointer, -// int depth ) { -// if ( framep(frame_pointer) ) { -// struct pso4 *frame = pointer_to_pso4( frame_pointer ); -// -// url_fwprintf( output, L"\tContext: " ); -// -// int i = 0; -// for ( struct pso_pointer cursor = frame_pointer; -// i++ < depth && !nilp( cursor ); -// cursor = frame_get_previous( cursor ) ) { -// dump_frame_context_fragment( output, cursor, 0 ); -// } -// -// url_fwprintf( output, L"\n" ); -// } -//} -// -///** -// * Dump a stackframe to this stream for debugging -// * @param output the stream -// * @param frame_pointer the pointer to the frame -// */ -//void dump_frame( URL_FILE *output, struct pso_pointer frame_pointer ) { -// 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_frame_context( output, frame_pointer, 4 ); -// -// for ( int arg = 0; arg < frame->payload.stack_frame.args; arg++ ) { -// struct pso2* 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 ); -// -// print( output, frame->payload.stack_frame.arg[arg] ); -// url_fputws( L"\n", output ); -// } -// if ( !nilp( frame->more ) ) { -// url_fputws( L"More: \t", output ); -// print( output, frame->more ); -// 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); -// print( output, exep->payload.exception. ); -// 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; -// } -// } -//} -// -// -///** -// * dump the object at this pso_pointer to this output stream. -// * TODO: convert this into a proper Lisp function and move to ops -// */ -//struct pso_pointer dump_object( struct pso_pointer frame_pointer ) { -// struct pso_pointer result = nil; -// -// if (stackp(frame_pointer)) { -// struct pso4* frame = pointer_to_pso4( frame_pointer); -// -// struct pso_pointer pointer = fetch_arg( frame, 0); -// struct pso_pointer stream = fetch_arg( frame, 1); -// -// if (!writep(stream)) { -// stream = lisp_stdout; -// } -// -// struct pso2* object = pointer_to_object( pointer ); -// url_fwprintf( output, L"\t%3.3s (%d) of size class %d at page %d, offset %d count %u\n", -// object->header.tag.bytes.mnemonic[0], -// get_tag_value(pointer), -// object->header.tag.bytes.size_class, -// pointer.page, pointer.offset, -// object->header.count ); -// -// switch ( get_tag_value( pointer) ) { -// case CONSTV: -// url_fwprintf( output, -// 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); -// print( output, pointer ); -// url_fputws( L"\n", output ); -// break; -// case EXCEPTIONTV: -// url_fwprintf( output, L"\t\tException object: " ); -// dump_stack_trace( output, pointer ); -// break; -// case FREETV: -// url_fwprintf( output, -// L"\t\tFree object: next at page %d offset %d\n", -// object->payload.free.next.page, -// object->payload.free.next.offset); -// break; -// case INTEGERTV: -// url_fwprintf( output, L"\t\tInteger object: value %ld\n", -// object->payload.integer.value ); -// break; -// case KEYTV: -// dump_string_cell( output, L"Keyword", pointer ); -// break; -//// case LAMBDATV: -//// url_fwprintf( output, L"\t\t\u03bb object;\n\t\t args: " ); -//// print( output, object->payload.lambda.args ); -//// url_fwprintf( output, L";\n\t\t\tbody: " ); -//// print( output, object->payload.lambda.body ); -//// url_fputws( L"\n", output ); -//// break; -//// case NILTV: -//// break; -//// case NLAMBDATV: -//// url_fwprintf( output, L"\t\tn\u03bb object; \n\t\targs: " ); -//// print( output, object->payload.lambda.args ); -//// url_fwprintf( output, L";\n\t\t\tbody: " ); -//// print( output, object->payload.lambda.body ); -//// url_fputws( L"\n", output ); -//// break; -//// case RATIOTV: -//// url_fwprintf( output, -//// L"\t\tRational object: value %ld/%ld, count %u\n", -//// pointer_to_object( object->payload.ratio.dividend ). -//// payload.integer.value, -//// pointer_to_object( object->payload.ratio.divisor ). -//// payload.integer.value, object->count ); -//// break; -// case READTV: -// url_fputws( L"\t\tInput stream; metadata: ", output ); -//// print( output, object->payload.stream.meta ); -// url_fputws( L"\n", output ); -// break; -//// case REALTV: -//// url_fwprintf( output, L"\t\tReal object: value %Lf, count %u\n", -//// object->payload.real.value, object->count ); -//// break; -// case STRINGTV: -// dump_string_cell( output, L"String", pointer ); -// break; -// case SYMBOLTV: -// 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; -//} +void dump_string_cell( URL_FILE *output, wchar_t *prefix, + struct pso_pointer pointer ) { + struct pso2* object = pointer_to_object( pointer ); + if ( object->payload.string.character == 0 ) { + url_fwprintf( output, + L"\t\t%ls cell: termination; next at page %d offset %d, count %u\n", + prefix, + object->payload.string.cdr.page, + object->payload.string.cdr.offset, object->header.count ); + } else { + url_fwprintf( output, + L"\t\t%ls cell: character '%lc' (%d) with hash %d; next at page %d offset %d, count %u\n", + prefix, + ( wint_t ) object->payload.string.character, + object->payload.string.character, + object->payload.string.hash, + object->payload.string.cdr.page, + object->payload.string.cdr.offset, object->header.count ); + url_fwprintf( output, L"\t\t value: " ); + in_write( pointer, output, false, 0); + 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); + url_fwprintf( output, L"[%3.3s %lc (%d)]", tag, c, c); + } + } + + url_fwprintf( output, L"\n" ); + } +} + + +void dump_frame_context_fragment( URL_FILE *output, + struct pso_pointer frame_pointer, + uint arg) { + if ( stackp(frame_pointer )) { + struct pso4 *frame = pointer_to_pso4( frame_pointer ); + + url_fwprintf( output, L" <= " ); + in_write( frame->payload.stack_frame.arg[arg], output, false, 0 ); + } +} + +void dump_frame_context( URL_FILE *output, struct pso_pointer frame_pointer, + int depth ) { + if ( stackp(frame_pointer) ) { + struct pso4 *frame = pointer_to_pso4( frame_pointer ); + + url_fwprintf( output, L"\tContext: " ); + + int i = 0; + for ( struct pso_pointer cursor = frame_pointer; + i++ < depth && !c_nilp( cursor ); + cursor = pointer_to_pso4(cursor)->payload.stack_frame.previous ) { + dump_frame_context_fragment( output, cursor, 0 ); + } + + url_fwprintf( output, L"\n" ); + } +} + +/** + * Dump a stackframe to this stream for debugging + * @param output the stream + * @param frame_pointer the pointer to the frame + */ +void dump_frame( URL_FILE *output, struct pso_pointer frame_pointer ) { + if ( stackp(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_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 ); +// fflush(stderr); + + URL_FILE* output = pointer_to_object(stream)->payload.stream.stream; + + 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 ); + url_fwprintf( output, L"\t%3.3s (%d) of size class %d at page %d, offset %d count %u\n", + object->header.tag.bytes.mnemonic, + get_tag_value(pointer), + object->header.tag.bytes.size_class, + pointer.page, pointer.offset, + object->header.count ); + + switch ( get_tag_value( pointer) ) { + case CONSTV: + url_fwprintf( output, + 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 ); + url_fputws( L"\n", output ); + break; + case EXCEPTIONTV: + url_fwprintf( output, L"\t\tException object: " ); + dump_stack_trace( output, pointer ); + break; + case FREETV: + url_fwprintf( output, + L"\t\tFree object: next at page %d offset %d\n", + object->payload.free.next.page, + object->payload.free.next.offset); + break; + case INTEGERTV: + url_fwprintf( output, L"\t\tInteger object: value %ld\n", + object->payload.integer.value ); + break; + case KEYTV: + dump_string_cell( output, L"Keyword", pointer ); + break; + // case LAMBDATV: + // url_fwprintf( output, L"\t\t\u03bb object;\n\t\t args: " ); + // in_write( output, object->payload.lambda.args ); + // url_fwprintf( output, L";\n\t\t\tbody: " ); + // in_write( output, object->payload.lambda.body ); + // url_fputws( L"\n", output ); + // break; + // case NILTV: + // break; + // case NLAMBDATV: + // url_fwprintf( output, L"\t\tn\u03bb object; \n\t\targs: " ); + // in_write( output, object->payload.lambda.args ); + // url_fwprintf( output, L";\n\t\t\tbody: " ); + // in_write( output, object->payload.lambda.body ); + // url_fputws( L"\n", output ); + // break; + // case RATIOTV: + // url_fwprintf( output, + // L"\t\tRational object: value %ld/%ld, count %u\n", + // pointer_to_object( object->payload.ratio.dividend ). + // payload.integer.value, + // pointer_to_object( object->payload.ratio.divisor ). + // payload.integer.value, object->count ); + // break; + case READTV: + url_fputws( L"\t\tInput stream; metadata: ", output ); + in_write( object->payload.stream.meta, output, false, 0 ); + url_fputws( L"\n", output ); + break; + // case REALTV: + // url_fwprintf( output, L"\t\tReal object: value %Lf, count %u\n", + // object->payload.real.value, object->count ); + // break; + case STRINGTV: + dump_string_cell( output, L"String", pointer ); + break; + case SYMBOLTV: + 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 ); + in_write( object->payload.stream.meta, output, false, 0 ); + url_fputws( L"\n", output ); + break; + } + } + + return result; +} diff --git a/src/c/memory/dump.h b/src/c/memory/dump.h index 98583a6..d467c8d 100644 --- a/src/c/memory/dump.h +++ b/src/c/memory/dump.h @@ -11,7 +11,7 @@ #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_ */ diff --git a/src/c/memory/tags.h b/src/c/memory/tags.h index 268272e..63bf30b 100644 --- a/src/c/memory/tags.h +++ b/src/c/memory/tags.h @@ -130,6 +130,7 @@ bool check_type( struct pso_pointer p, char *s ); #define stackp(p) (check_tag(p, STACKTV)) #define streamp(p) (check_tag(p,READTV)||check_tag(p,WRITETV)) #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 timep(p) (check_tag(p,TIMETV)) // the version of truep in ops/truth.c is better than this, because it does not diff --git a/src/c/ops/assoc.c b/src/c/ops/assoc.c index 6b68a19..5dfdd63 100644 --- a/src/c/ops/assoc.c +++ b/src/c/ops/assoc.c @@ -45,13 +45,7 @@ struct pso_pointer search( struct pso_pointer key, debug_print( L"In search; key is: `", DEBUG_BIND, 0 ); debug_print_object( key, DEBUG_BIND, 0 ); debug_print( L"`\n", DEBUG_BIND, 0 ); - debug_print(L"", DEBUG_BIND, 2); - 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); - } - } + debug_dump_object(key, DEBUG_BIND, 1); #endif if ( consp( store ) ) { @@ -59,25 +53,17 @@ struct pso_pointer search( struct pso_pointer key, consp( cursor ) && found == false; cursor = c_cdr( cursor ) ) { struct pso_pointer pair = c_car( cursor ); #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_println( DEBUG_BIND); - debug_print(L"", DEBUG_BIND, 4); - 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); - + debug_print(L"`\n", DEBUG_BIND, 2); + debug_dump_object(c_car(pair), DEBUG_BIND, 2); #endif if ( consp( pair ) && c_equal( c_car( pair ), key ) ) { found = true; result = return_key ? c_car( pair ) : c_cdr( pair ); #ifdef DEBUG - debug_print( L" ...found!", DEBUG_BIND, 0 ); + debug_print( L" ...found!", DEBUG_BIND, 2 ); #endif } #ifdef DEBUG diff --git a/src/c/ops/dump.c b/src/c/ops/dump.c deleted file mode 100644 index c39b871..0000000 --- a/src/c/ops/dump.c +++ /dev/null @@ -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 - * Licensed under GPL version 2.0, or, at your option, any later version. - */ - -/* - * wide characters - */ -#include -#include - -#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; - } -} diff --git a/src/c/ops/dump.h b/src/c/ops/dump.h deleted file mode 100644 index e69de29..0000000 diff --git a/src/c/ops/eval_apply.c b/src/c/ops/eval_apply.c index 5ced0e2..0c5b19c 100644 --- a/src/c/ops/eval_apply.c +++ b/src/c/ops/eval_apply.c @@ -110,6 +110,7 @@ struct pso_pointer eval_form( struct pso_pointer frame_pointer ) { debug_print( L" returning: ", DEBUG_EVAL, 0 ); debug_print_object( result, DEBUG_EVAL, 0 ); debug_println( DEBUG_EVAL ); + debug_dump_object(result, DEBUG_EVAL, 1); 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_object( result, DEBUG_EVAL, 0 ); debug_println( DEBUG_EVAL ); + debug_dump_object( result, DEBUG_EVAL, 0 ); return result; }