/** * memory/dump.c * * Dump objects to the error stream for.debugging purposes. * H'mmm... I think it is probably a mistake to do this in C. I need * to get primitive print working, and primitive eval/applu, and then * switch to Lisp. * * (c) 2026 Simon Brooke * Licensed under GPL version 2.0, or, at your option, any later version. */ #include #include #include #include /* * wide characters */ #include #include #include "io/fopen.h" #include "io/io.h" #include "io/print.h" #include "memory/pointer.h" #include "memory/pso.h" #include "memory/pso2.h" #include "memory/pso3.h" #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" #include "payloads/free.h" #include "payloads/integer.h" #include "payloads/read_stream.h" #include "payloads/stack.h" #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: " ); 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 = writep(stream) ? pointer_to_object( stream )->payload.stream.stream : file_to_url_file(stderr); 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 CHARACTERTV: { wchar_t wc = pointer_to_object(pointer)->payload.character.character; url_fwprintf(output, L"\t\tCharacter object: character `%lc` (%d)\n", wc, wc); } break; 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; }