From 4efe9eab87d4b8c7902cb8d6e2ba65ffafc633bb Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Thu, 16 Apr 2026 22:28:35 +0100 Subject: [PATCH] Very close to a basic REPL now. --- archive/c/init.c | 2 +- archive/c/io/print.c | 28 ++++++++-------- archive/c/io/print.h | 2 +- archive/c/memory/dump.c | 16 ++++----- archive/c/memory/hashmap.c | 6 ++-- archive/c/memory/stack.c | 8 ++--- archive/c/ops/lispops.c | 4 +-- src/c/debug.c | 67 ++++++++++++++++++++++++++++++++------ src/c/io/io.c | 12 +++---- src/c/io/print.c | 2 +- src/c/io/print.h | 4 ++- src/c/memory/memory.c | 3 +- src/c/memory/node.c | 5 +++ src/c/memory/node.h | 2 ++ src/c/memory/tags.c | 6 ++-- src/c/memory/tags.h | 2 +- src/c/ops/eval_apply.c | 10 +++--- src/c/ops/reverse.c | 4 +-- src/c/ops/string_ops.c | 2 -- src/c/payloads/cons.c | 9 +++-- src/c/payloads/exception.c | 27 +++++++-------- src/c/payloads/exception.h | 4 +-- src/c/psse.c | 47 +++++++++++++++++++++++++- 23 files changed, 188 insertions(+), 84 deletions(-) diff --git a/archive/c/init.c b/archive/c/init.c index b0d18da..f8b1c1d 100644 --- a/archive/c/init.c +++ b/archive/c/init.c @@ -56,7 +56,7 @@ struct cons_pointer check_exception( struct cons_pointer pointer, fprintf( stderr, "ERROR: Exception at %s: ", location_descriptor ); URL_FILE *ustderr = file_to_url_file( stderr ); fwide( stderr, 1 ); - print( ustderr, object->payload.exception.payload ); + c_print( ustderr, object->payload.exception.payload ); free( ustderr ); dec_ref( pointer ); diff --git a/archive/c/io/print.c b/archive/c/io/print.c index d9d2998..c6e1611 100644 --- a/archive/c/io/print.c +++ b/archive/c/io/print.c @@ -72,7 +72,7 @@ print_list_contents( URL_FILE *output, struct cons_pointer pointer, if ( initial_space ) { url_fputwc( btowc( ' ' ), output ); } - print( output, cell->payload.cons.car ); + c_print( output, cell->payload.cons.car ); print_list_contents( output, cell->payload.cons.cdr, true ); break; @@ -80,7 +80,7 @@ print_list_contents( URL_FILE *output, struct cons_pointer pointer, break; default: url_fwprintf( output, L" . " ); - print( output, pointer ); + c_print( output, pointer ); } } @@ -99,9 +99,9 @@ void print_map( URL_FILE *output, struct cons_pointer map ) { for ( struct cons_pointer ks = hashmap_keys( map ); !nilp( ks ); ks = c_cdr( ks ) ) { struct cons_pointer key = c_car( ks ); - print( output, key ); + c_print( output, key ); url_fputwc( btowc( ' ' ), output ); - print( output, hashmap_get( map, key, false ) ); + c_print( output, hashmap_get( map, key, false ) ); if ( !nilp( c_cdr( ks ) ) ) { url_fputws( L", ", output ); @@ -153,7 +153,7 @@ void print_128bit( URL_FILE *output, __int128_t n ) { * Print the cons-space object indicated by `pointer` to the stream indicated * by `output`. */ -struct cons_pointer print( URL_FILE *output, struct cons_pointer pointer ) { +struct cons_pointer c_print( URL_FILE *output, struct cons_pointer pointer ) { struct cons_space_object cell = pointer2cell( pointer ); char *buffer; @@ -171,7 +171,7 @@ struct cons_pointer print( URL_FILE *output, struct cons_pointer pointer ) { break; case FUNCTIONTV: url_fputws( L"', output ); break; case INTEGERTV: @@ -190,7 +190,7 @@ struct cons_pointer print( URL_FILE *output, struct cons_pointer pointer ) { make_cons( cell.payload.lambda.args, cell.payload.lambda.body ) ); - print( output, to_print ); + c_print( output, to_print ); dec_ref( to_print ); url_fputwc( L'>', output ); @@ -206,20 +206,20 @@ struct cons_pointer print( URL_FILE *output, struct cons_pointer pointer ) { make_cons( cell.payload.lambda.args, cell.payload.lambda.body ) ); - print( output, to_print ); + c_print( output, to_print ); dec_ref( to_print ); url_fputwc( L'>', output ); } break; case RATIOTV: - print( output, cell.payload.ratio.dividend ); + c_print( output, cell.payload.ratio.dividend ); url_fputws( L"/", output ); - print( output, cell.payload.ratio.divisor ); + c_print( output, cell.payload.ratio.divisor ); break; case READTV: url_fwprintf( output, L"', output ); break; case REALTV: @@ -246,7 +246,7 @@ struct cons_pointer print( URL_FILE *output, struct cons_pointer pointer ) { break; case SPECIALTV: url_fwprintf( output, L"', output ); break; case TIMETV: @@ -264,7 +264,7 @@ struct cons_pointer print( URL_FILE *output, struct cons_pointer pointer ) { break; case WRITETV: url_fwprintf( output, L"', output ); break; default: @@ -312,7 +312,7 @@ lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer, debug_print( L"lisp_print: about to print\n", DEBUG_IO ); debug_dump_object( frame->arg[0], DEBUG_IO ); - result = print( output, frame->arg[0] ); + result = c_print( output, frame->arg[0] ); debug_print( L"lisp_print returning\n", DEBUG_IO ); debug_dump_object( result, DEBUG_IO ); diff --git a/archive/c/io/print.h b/archive/c/io/print.h index bde68fb..0d9aae8 100644 --- a/archive/c/io/print.h +++ b/archive/c/io/print.h @@ -16,7 +16,7 @@ #ifndef __print_h #define __print_h -struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ); +struct cons_pointer c_print( URL_FILE * output, struct cons_pointer pointer ); void println( URL_FILE * output ); struct cons_pointer lisp_print( struct stack_frame *frame, diff --git a/archive/c/memory/dump.c b/archive/c/memory/dump.c index 3a83866..24ac48b 100644 --- a/archive/c/memory/dump.c +++ b/archive/c/memory/dump.c @@ -48,7 +48,7 @@ void dump_string_cell( URL_FILE *output, wchar_t *prefix, cell.payload.string.cdr.page, cell.payload.string.cdr.offset, cell.count ); url_fwprintf( output, L"\t\t value: " ); - print( output, pointer ); + c_print( output, pointer ); url_fwprintf( output, L"\n" ); } } @@ -71,7 +71,7 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) { cell.payload.cons.car.offset, cell.payload.cons.cdr.page, cell.payload.cons.cdr.offset, cell.count ); - print( output, pointer ); + c_print( output, pointer ); url_fputws( L"\n", output ); break; case EXCEPTIONTV: @@ -97,18 +97,18 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) { break; case LAMBDATV: url_fwprintf( output, L"\t\t\u03bb cell;\n\t\t args: " ); - print( output, cell.payload.lambda.args ); + c_print( output, cell.payload.lambda.args ); url_fwprintf( output, L";\n\t\t\tbody: " ); - print( output, cell.payload.lambda.body ); + c_print( output, cell.payload.lambda.body ); url_fputws( L"\n", output ); break; case NILTV: break; case NLAMBDATV: url_fwprintf( output, L"\t\tn\u03bb cell; \n\t\targs: " ); - print( output, cell.payload.lambda.args ); + c_print( output, cell.payload.lambda.args ); url_fwprintf( output, L";\n\t\t\tbody: " ); - print( output, cell.payload.lambda.body ); + c_print( output, cell.payload.lambda.body ); url_fputws( L"\n", output ); break; case RATIOTV: @@ -121,7 +121,7 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) { break; case READTV: url_fputws( L"\t\tInput stream; metadata: ", output ); - print( output, cell.payload.stream.meta ); + c_print( output, cell.payload.stream.meta ); url_fputws( L"\n", output ); break; case REALTV: @@ -159,7 +159,7 @@ void dump_object( URL_FILE *output, struct cons_pointer pointer ) { break; case WRITETV: url_fputws( L"\t\tOutput stream; metadata: ", output ); - print( output, cell.payload.stream.meta ); + c_print( output, cell.payload.stream.meta ); url_fputws( L"\n", output ); break; } diff --git a/archive/c/memory/hashmap.c b/archive/c/memory/hashmap.c index eaabca4..96baf39 100644 --- a/archive/c/memory/hashmap.c +++ b/archive/c/memory/hashmap.c @@ -140,13 +140,13 @@ void dump_map( URL_FILE *output, struct cons_pointer pointer ) { &pointer_to_vso( pointer )->payload.hashmap; url_fwprintf( output, L"Hashmap with %d buckets:\n", payload->n_buckets ); url_fwprintf( output, L"\tHash function: " ); - print( output, payload->hash_fn ); + c_print( output, payload->hash_fn ); url_fwprintf( output, L"\n\tWrite ACL: " ); - print( output, payload->write_acl ); + c_print( output, payload->write_acl ); url_fwprintf( output, L"\n\tBuckets:" ); for ( int i = 0; i < payload->n_buckets; i++ ) { url_fwprintf( output, L"\n\t\t[%d]: ", i ); - print( output, payload->buckets[i] ); + c_print( output, payload->buckets[i] ); } url_fwprintf( output, L"\n" ); } diff --git a/archive/c/memory/stack.c b/archive/c/memory/stack.c index 0188e6b..9b8df3e 100644 --- a/archive/c/memory/stack.c +++ b/archive/c/memory/stack.c @@ -291,7 +291,7 @@ void dump_frame_context_fragment( URL_FILE *output, if ( frame != NULL ) { url_fwprintf( output, L" <= " ); - print( output, frame->arg[0] ); + c_print( output, frame->arg[0] ); } } @@ -332,12 +332,12 @@ void dump_frame( URL_FILE *output, struct cons_pointer frame_pointer ) { url_fwprintf( output, L"\tArg %d:\t%4.4s\tcount: %10u\tvalue: ", arg, cell.tag.bytes, cell.count ); - print( output, frame->arg[arg] ); + c_print( output, frame->arg[arg] ); url_fputws( L"\n", output ); } if ( !nilp( frame->more ) ) { url_fputws( L"More: \t", output ); - print( output, frame->more ); + c_print( output, frame->more ); url_fputws( L"\n", output ); } } @@ -345,7 +345,7 @@ void dump_frame( URL_FILE *output, struct cons_pointer frame_pointer ) { void dump_stack_trace( URL_FILE *output, struct cons_pointer pointer ) { if ( exceptionp( pointer ) ) { - print( output, pointer2cell( pointer ).payload.exception.payload ); + c_print( output, pointer2cell( pointer ).payload.exception.payload ); url_fputws( L"\n", output ); dump_stack_trace( output, pointer2cell( pointer ).payload.exception.frame ); diff --git a/archive/c/ops/lispops.c b/archive/c/ops/lispops.c index 2a8cc47..b0ab6c9 100644 --- a/archive/c/ops/lispops.c +++ b/archive/c/ops/lispops.c @@ -1526,7 +1526,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame, struct cons_pointer prompt = c_assoc( prompt_name, new_env ); if ( !nilp( prompt ) ) { - print( os, prompt ); + c_print( os, prompt ); } expr = lisp_read( get_stack_frame( frame_pointer ), frame_pointer, @@ -1541,7 +1541,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame, println( os ); - print( os, eval_form( frame, frame_pointer, expr, new_env ) ); + c_print( os, eval_form( frame, frame_pointer, expr, new_env ) ); dec_ref( expr ); } diff --git a/src/c/debug.c b/src/c/debug.c index ecef2dd..637d889 100644 --- a/src/c/debug.c +++ b/src/c/debug.c @@ -11,9 +11,14 @@ */ #include +#include #include "debug.h" +#include "io/fopen.h" +#include "io/io.h" +#include "io/print.h" + int verbosity = 0; @@ -45,14 +50,6 @@ void debug_print( wchar_t *message, int level, int indent ) { #endif } -void debug_print_object( struct pso_pointer object, int level, int indent ) { - // TODO: not yet implemented -} - -void debug_dump_object( struct pso_pointer object, int level, int indent ) { - // TODO: not yet implemented -} - /** * @brief print a 128 bit integer value to stderr, if `verbosity` matches `level`. * @@ -133,5 +130,55 @@ void debug_printf( int level, int indent, wchar_t *format, ... ) { #endif } -// debug_dump_object, debug_print_binding, debug_print_exception, debug_print_object, -// not yet implemented but probably will be. + +/** + * @brief print the object indicated by this `pointer` to stderr, if `verbosity` + * matches `level`. + * + * `verbosity` is a set of flags, see debug_print.h; so you can + * turn debugging on for only one part of the system. + */ +void debug_print_object( struct pso_pointer pointer, int level, int indent ) { +#ifdef DEBUG + if ( level & verbosity ) { + URL_FILE *ustderr = file_to_url_file( stderr ); + fwide( stderr, 1 ); + in_print( pointer, ustderr ); + free( ustderr ); + } +#endif +} + +/** + * @brief Like `dump_object`, q.v., but protected by the verbosity mechanism. + * + * `verbosity` is a set of flags, see debug_print.h; so you can + * turn debugging on for only one part of the system. + */ +void debug_dump_object( struct pso_pointer pointer, int level, int indent ) { +//#ifdef DEBUG +// if ( level & verbosity ) { +// URL_FILE *ustderr = file_to_url_file( stderr ); +// fwide( stderr, 1 ); +// dump_object( ustderr, pointer ); +// free( ustderr ); +// } +//#endif +} + +///** +// * Standardise printing of binding trace messages. +// */ +//void debug_print_binding( struct cons_pointer key, struct cons_pointer val, +// bool deep, int level, int indent ) { +//#ifdef DEBUG +// // wchar_t * depth = (deep ? L"Deep" : L"Shallow"); +// +// debug_print( ( deep ? L"Deep" : L"Shallow" ), level, indent ); +// debug_print( L" binding `", level, indent ); +// debug_print_object( key, level, indent ); +// debug_print( L"` to `", level, indent ); +// debug_print_object( val, level, indent ); +// debug_print( L"`\n", level, indent ); +//#endif +//} diff --git a/src/c/io/io.c b/src/c/io/io.c index 6b61591..2a897f7 100644 --- a/src/c/io/io.c +++ b/src/c/io/io.c @@ -286,8 +286,8 @@ struct pso_pointer push_back_character( struct pso_pointer c, if ( characterp( c ) && readp( r ) ) { if ( url_ungetwc( ( wint_t ) - ( pointer_to_object( c )->payload.character. - character ), + ( pointer_to_object( c )->payload. + character.character ), pointer_to_object( r )->payload.stream.stream ) >= 0 ) { result = t; @@ -315,8 +315,8 @@ lisp_close( struct pso_pointer frame_pointer, struct pso_pointer env ) { if ( readp( fetch_arg( frame, 0 ) ) || writep( fetch_arg( frame, 0 ) ) ) { if ( url_fclose - ( pointer_to_object( fetch_arg( frame, 0 ) )->payload. - stream.stream ) + ( pointer_to_object( fetch_arg( frame, 0 ) )->payload.stream. + stream ) == 0 ) { result = t; } @@ -569,8 +569,8 @@ lisp_read_char( struct pso_pointer frame_pointer, struct pso_pointer env ) { if ( readp( fetch_arg( frame, 0 ) ) ) { result = make_string( url_fgetwc - ( pointer_to_object( fetch_arg( frame, 0 ) )->payload. - stream.stream ), nil ); + ( pointer_to_object( fetch_arg( frame, 0 ) )-> + payload.stream.stream ), nil ); } return result; diff --git a/src/c/io/print.c b/src/c/io/print.c index e22d48b..365fb18 100644 --- a/src/c/io/print.c +++ b/src/c/io/print.c @@ -109,7 +109,7 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) { * @param stream if a pointer to an open write stream, print to there. * @return struct pso_pointer `nil`, or an exception if some erroe occurred. */ -struct pso_pointer print( struct pso_pointer p, struct pso_pointer stream ) { +struct pso_pointer c_print( struct pso_pointer p, struct pso_pointer stream ) { URL_FILE *output = writep( stream ) ? pointer_to_object( stream )->payload.stream.stream : file_to_url_file( stdout ); diff --git a/src/c/io/print.h b/src/c/io/print.h index eb728c3..0a969e0 100644 --- a/src/c/io/print.h +++ b/src/c/io/print.h @@ -14,6 +14,8 @@ #ifndef __psse_io_print_h #define __psse_io_print_h -struct pso_pointer print( struct pso_pointer p, struct pso_pointer stream ); +struct pso_pointer c_print( struct pso_pointer p, struct pso_pointer stream ); + +struct pso_pointer in_print( struct pso_pointer p, URL_FILE * output ); #endif diff --git a/src/c/memory/memory.c b/src/c/memory/memory.c index 7a44bc4..eaeecbd 100644 --- a/src/c/memory/memory.c +++ b/src/c/memory/memory.c @@ -49,7 +49,8 @@ struct pso_pointer initialise_memory( uint32_t node ) { if ( memory_initialised ) { result = make_exception( c_string_to_lisp_string - ( L"Attenpt to reinitialise memory." ), nil, nil, nil ); + ( L"Attenpt to reinitialise memory." ), nil, nil, + nil ); } else { for ( uint8_t i = 0; i <= MAX_SIZE_CLASS; i++ ) { freelists[i] = nil; diff --git a/src/c/memory/node.c b/src/c/memory/node.c index 4cc9db0..5bac51d 100644 --- a/src/c/memory/node.c +++ b/src/c/memory/node.c @@ -46,6 +46,11 @@ struct pso_pointer nil = ( struct pso_pointer ) { 0, 0, 0 }; */ struct pso_pointer t = ( struct pso_pointer ) { 0, 0, 4 }; +/** + * @brief The root of the data space. + */ +struct pso_pointer oblist = ( struct pso_pointer ) { 0, 0, 0 }; + /** * @brief Set up the basic informetion about this node. diff --git a/src/c/memory/node.h b/src/c/memory/node.h index fbc177a..5ce48cf 100644 --- a/src/c/memory/node.h +++ b/src/c/memory/node.h @@ -31,6 +31,8 @@ extern struct pso_pointer nil; */ extern struct pso_pointer t; +extern struct pso_pointer oblist; + struct pso_pointer initialise_node( uint32_t index ); #endif diff --git a/src/c/memory/tags.c b/src/c/memory/tags.c index a2fc880..8b956f1 100644 --- a/src/c/memory/tags.c +++ b/src/c/memory/tags.c @@ -31,12 +31,14 @@ uint32_t get_tag_value( struct pso_pointer p ) { * * @param p must be a struct pso_pointer, indicating the appropriate object. */ -struct pso_pointer get_tag_string( struct pso_pointer p) { +struct pso_pointer get_tag_string( struct pso_pointer p ) { struct pso_pointer result = nil; struct pso2 *object = pointer_to_object( p ); for ( int i = 2 - 1; i >= 0; i-- ) { - result = make_string( (wchar_t)(object->header.tag.bytes.mnemonic[i]), result ); + result = + make_string( ( wchar_t ) ( object->header.tag.bytes.mnemonic[i] ), + result ); } return result; diff --git a/src/c/memory/tags.h b/src/c/memory/tags.h index 5608c66..575c739 100644 --- a/src/c/memory/tags.h +++ b/src/c/memory/tags.h @@ -84,7 +84,7 @@ // #define get_tag_value(p)((pointer_to_object(p)->header.tag.value) & 0xffffff) uint32_t get_tag_value( struct pso_pointer p ); -struct pso_pointer get_tag_string( struct pso_pointer p); +struct pso_pointer get_tag_string( struct pso_pointer p ); /** * @brief check that the tag of the object indicated by this poiner has this diff --git a/src/c/ops/eval_apply.c b/src/c/ops/eval_apply.c index 91f47ea..aeb3577 100644 --- a/src/c/ops/eval_apply.c +++ b/src/c/ops/eval_apply.c @@ -87,8 +87,10 @@ struct pso_pointer eval( ( c_string_to_lisp_string ( L"Can't yet evaluate things of this type: " ), result ), frame_pointer, - c_cons( c_cons( c_string_to_lisp_keyword(L"tag"), - get_tag_string(result)), nil), nil ); + c_cons( c_cons + ( c_string_to_lisp_keyword( L"tag" ), + get_tag_string( result ) ), nil ), + nil ); } if ( exceptionp( result ) ) { @@ -98,8 +100,8 @@ struct pso_pointer eval( if ( nilp( x->payload.exception.stack ) ) { result = - make_exception( x->payload.exception.message, frame_pointer, nil, - result ); + make_exception( x->payload.exception.message, frame_pointer, + nil, result ); } } diff --git a/src/c/ops/reverse.c b/src/c/ops/reverse.c index 1f44127..5e51204 100644 --- a/src/c/ops/reverse.c +++ b/src/c/ops/reverse.c @@ -65,8 +65,8 @@ struct pso_pointer c_reverse( struct pso_pointer sequence ) { default: result = make_exception( c_cons( c_string_to_lisp_string - ( L"Invalid object in sequence" ), cursor), nil, - nil , nil); + ( L"Invalid object in sequence" ), + cursor ), nil, nil, nil ); goto exit; break; } diff --git a/src/c/ops/string_ops.c b/src/c/ops/string_ops.c index d00456a..b4dc31c 100644 --- a/src/c/ops/string_ops.c +++ b/src/c/ops/string_ops.c @@ -182,5 +182,3 @@ struct pso_pointer c_string_to_lisp_keyword( wchar_t *symbol ) { return result; } - - diff --git a/src/c/payloads/cons.c b/src/c/payloads/cons.c index e1586bf..20e5284 100644 --- a/src/c/payloads/cons.c +++ b/src/c/payloads/cons.c @@ -82,11 +82,10 @@ struct pso_pointer c_cdr( struct pso_pointer p ) { break; default: result = - make_exception( - c_cons( - c_string_to_lisp_string( L"Invalid type for cdr" ), - get_tag_string( p) ), - nil, nil, nil ); + make_exception( c_cons + ( c_string_to_lisp_string + ( L"Invalid type for cdr" ), + get_tag_string( p ) ), nil, nil, nil ); break; } diff --git a/src/c/payloads/exception.c b/src/c/payloads/exception.c index fa18350..8817894 100644 --- a/src/c/payloads/exception.c +++ b/src/c/payloads/exception.c @@ -36,17 +36,18 @@ */ struct pso_pointer make_exception( struct pso_pointer message, struct pso_pointer frame, - struct pso_pointer meta, + struct pso_pointer meta, struct pso_pointer cause ) { - struct pso_pointer result = allocate(EXCEPTIONTAG, 3); + struct pso_pointer result = allocate( EXCEPTIONTAG, 3 ); - if (!nilp(result) && !exceptionp(result)) { - struct pso3* object = (struct pso3*)pointer_to_object( result); + if ( !nilp( result ) && !exceptionp( result ) ) { + struct pso3 *object = ( struct pso3 * ) pointer_to_object( result ); - object->payload.exception.message = message; - object->payload.exception.stack = stackp(frame) ? frame : nil; - object->payload.exception.meta = (consp(meta) || hashtabp(meta)) ? meta : nil; - object->payload.exception.cause = exceptionp(cause) ? cause : nil; + object->payload.exception.message = message; + object->payload.exception.stack = stackp( frame ) ? frame : nil; + object->payload.exception.meta = ( consp( meta ) + || hashtabp( meta ) ) ? meta : nil; + object->payload.exception.cause = exceptionp( cause ) ? cause : nil; } return result; @@ -63,12 +64,12 @@ struct pso_pointer destroy_exception( struct pso_pointer fp, if ( stackp( fp ) ) { struct pso4 *frame = pointer_to_pso4( fp ); struct pso_pointer p = frame->payload.stack_frame.arg[0]; - struct pso3* object = (struct pso3*)pointer_to_object( p); + struct pso3 *object = ( struct pso3 * ) pointer_to_object( p ); - dec_ref( object->payload.exception.message); - dec_ref( object->payload.exception.stack); - dec_ref( object->payload.exception.meta); - dec_ref( object->payload.exception.cause); + dec_ref( object->payload.exception.message ); + dec_ref( object->payload.exception.stack ); + dec_ref( object->payload.exception.meta ); + dec_ref( object->payload.exception.cause ); } return nil; diff --git a/src/c/payloads/exception.h b/src/c/payloads/exception.h index 5670c81..110252d 100644 --- a/src/c/payloads/exception.h +++ b/src/c/payloads/exception.h @@ -16,7 +16,7 @@ * @brief An exception; required three pointers, so use object of size class 3. */ struct exception_payload { - /** @brief the exception message. Expected to be a string, but may be anything printable. */ + /** @brief the exception message. Expected to be a string, but may be anything printable. */ struct pso_pointer message; /** @brief the stack frame at which the exception was thrown. */ struct pso_pointer stack; @@ -28,7 +28,7 @@ struct exception_payload { struct pso_pointer make_exception( struct pso_pointer message, struct pso_pointer frame_pointer, - struct pso_pointer meta, + struct pso_pointer meta, struct pso_pointer cause ); struct pso_pointer destroy_exception( struct pso_pointer fp, diff --git a/src/c/psse.c b/src/c/psse.c index b234103..0c36395 100644 --- a/src/c/psse.c +++ b/src/c/psse.c @@ -12,13 +12,24 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ +#include +#include +#include +#include + +#include "debug.h" #include "psse.h" #include "io/io.h" #include "memory/node.h" +#include "memory/pso.h" +#include "memory/tags.h" #include "ops/stack_ops.h" #include "ops/truth.h" +#include "payloads/cons.h" +#include "payloads/stack.h" + void print_banner( ) { fwprintf( stdout, L"Post-Scarcity Software Environment version %s\n\n", VERSION ); @@ -54,6 +65,35 @@ void print_options( FILE *stream ) { #endif } +/** + * @brief Handle an interrupt signal. + * + * @param dummy + */ +void int_handler( int dummy ) { + wprintf( L"TODO: handle ctrl-C in a more interesting way\n" ); +} + +/** + * The read/eval/print loop. + */ +void repl( ) { + signal( SIGINT, int_handler ); + debug_print( L"Entered repl\n", DEBUG_REPL, 0 ); + + struct pso_pointer env = consp( oblist ) ? oblist : c_cons( oblist, nil ); + + /* bottom of stack */ + struct pso_pointer frame_pointer = make_frame( 1, nil, nil, env ); + + if ( !nilp( frame_pointer ) ) { +// lisp_repl( get_stack_frame( frame_pointer ), frame_pointer, env ); + + dec_ref( frame_pointer ); + } + + debug_print( L"Leaving repl\n", DEBUG_REPL, 0 ); +} /** * main entry point; parse command line arguments, initialise the environment, @@ -101,7 +141,12 @@ int main( int argc, char *argv[] ) { } } - if ( nilp( initialise_node( 0 ) ) ) { + oblist = initialise_node( 0 ); + debug_print( L"Oblist: ", DEBUG_BOOTSTRAP, 0 ); + debug_print_object( oblist, DEBUG_BOOTSTRAP, 0 ); + debug_println( DEBUG_BOOTSTRAP ); + + if ( nilp( oblist ) ) { fputs( "Failed to initialise node\n", stderr ); exit( 1 ); }