From 83537391a63b7bca9a3c756e6e265024b1d04b79 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Thu, 16 Apr 2026 21:33:48 +0100 Subject: [PATCH] Written the constructor for exceptions; in the process, added a metadata slot as a first class slot of exceptions. --- .gitignore | 1 + src/c/environment/environment.c | 4 ++-- src/c/memory/memory.c | 2 +- src/c/memory/tags.c | 20 ++++++++++++++++ src/c/memory/tags.h | 7 ++++-- src/c/ops/eval_apply.c | 7 +++--- src/c/ops/reverse.c | 6 ++--- src/c/ops/string_ops.c | 2 ++ src/c/payloads/cons.c | 8 ++++--- src/c/payloads/exception.c | 41 +++++++++++++++++++++++++++++---- src/c/payloads/exception.h | 7 ++++-- 11 files changed, 85 insertions(+), 20 deletions(-) diff --git a/.gitignore b/.gitignore index a9d1e3e..300398f 100644 --- a/.gitignore +++ b/.gitignore @@ -55,3 +55,4 @@ post-scarcity.kdev4 \.zig-cache/ sq/ tmp/ +utils_src/a.out diff --git a/src/c/environment/environment.c b/src/c/environment/environment.c index fea9f13..309818e 100644 --- a/src/c/environment/environment.c +++ b/src/c/environment/environment.c @@ -58,7 +58,7 @@ struct pso_pointer initialise_environment( uint32_t node ) { result = make_exception( c_string_to_lisp_string ( L"Unexpected cell while allocating `nil`." ), - nil, n ); + nil, nil, n ); debug_print( L"fail\n", DEBUG_BOOTSTRAP, 0 ); } } @@ -79,7 +79,7 @@ struct pso_pointer initialise_environment( uint32_t node ) { result = make_exception( c_string_to_lisp_string ( L"Unexpected cell while allocating `t`." ), - nil, n ); + nil, nil, n ); debug_print( L"fail\n", DEBUG_BOOTSTRAP, 0 ); } } diff --git a/src/c/memory/memory.c b/src/c/memory/memory.c index f88a9d6..7a44bc4 100644 --- a/src/c/memory/memory.c +++ b/src/c/memory/memory.c @@ -49,7 +49,7 @@ 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 ); + ( 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/tags.c b/src/c/memory/tags.c index 6e4a7c5..a2fc880 100644 --- a/src/c/memory/tags.c +++ b/src/c/memory/tags.c @@ -13,15 +13,35 @@ #include #include +#include "memory/node.h" #include "memory/pointer.h" #include "memory/pso2.h" +#include "ops/string_ops.h" + uint32_t get_tag_value( struct pso_pointer p ) { struct pso2 *object = pointer_to_object( p ); return object->header.tag.value & 0xffffff; } +/** + * @brief Return the tag of the object indicated by this pointer as a Lisp + * string. + * + * @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 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 ); + } + + return result; +} + /** * @brief check that the tag of the object indicated by this poiner has this * value. diff --git a/src/c/memory/tags.h b/src/c/memory/tags.h index 524e805..5608c66 100644 --- a/src/c/memory/tags.h +++ b/src/c/memory/tags.h @@ -84,6 +84,8 @@ // #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); + /** * @brief check that the tag of the object indicated by this poiner has this * value. @@ -98,16 +100,17 @@ bool check_tag( struct pso_pointer p, uint32_t v ); bool check_type( struct pso_pointer p, char *s ); -#define characterp(p) (check_tag(p, CHARACTERTV)) +#define characterp(p) (check_tag(p, CHARACTERTV)) #define consp(p) (check_tag(p, CONSTV)) #define exceptionp(p) (check_tag(p, EXCEPTIONTV)) #define freep(p) (check_tag(p, FREETV)) #define functionp(p) (check_tag(p, FUNCTIONTV)) +#define hashtabp(p) (check_tag(p, HASHTV)) #define integerp(p) (check_tag(p, INTEGERTV)) #define keywordp(p) (check_tag(p, KEYTV)) #define lambdap(p) (check_tag(p,LAMBDATV)) #define loopp(p) (check_tag(p,LOOPTV)) -#define namespacep(p)(check_tag(p,NAMESPACETV)) +#define namespacep(p) (check_tag(p,NAMESPACETV)) // the version of nilp in ops/truth.c is better than this, because it does not // require a fetch, and will see nils curated by other nodes as nil. // #define nilp(p) (check_tag(p,NILTV)) diff --git a/src/c/ops/eval_apply.c b/src/c/ops/eval_apply.c index b46aa99..91f47ea 100644 --- a/src/c/ops/eval_apply.c +++ b/src/c/ops/eval_apply.c @@ -86,7 +86,9 @@ struct pso_pointer eval( make_exception( c_cons ( c_string_to_lisp_string ( L"Can't yet evaluate things of this type: " ), - result ), frame_pointer, nil ); + result ), frame_pointer, + c_cons( c_cons( c_string_to_lisp_keyword(L"tag"), + get_tag_string(result)), nil), nil ); } if ( exceptionp( result ) ) { @@ -95,9 +97,8 @@ struct pso_pointer eval( EXCEPTIONTV ); if ( nilp( x->payload.exception.stack ) ) { - inc_ref( result ); result = - make_exception( x->payload.exception.message, frame_pointer, + 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 c5fa7e0..1f44127 100644 --- a/src/c/ops/reverse.c +++ b/src/c/ops/reverse.c @@ -64,9 +64,9 @@ struct pso_pointer c_reverse( struct pso_pointer sequence ) { break; default: result = - make_exception( c_string_to_lisp_string - ( L"Invalid object in sequence" ), nil, - nil ); + make_exception( c_cons( c_string_to_lisp_string + ( 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 b4dc31c..d00456a 100644 --- a/src/c/ops/string_ops.c +++ b/src/c/ops/string_ops.c @@ -182,3 +182,5 @@ 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 5e8a4ea..e1586bf 100644 --- a/src/c/payloads/cons.c +++ b/src/c/payloads/cons.c @@ -82,9 +82,11 @@ 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" ), p ), 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 1b38a76..fa18350 100644 --- a/src/c/payloads/exception.c +++ b/src/c/payloads/exception.c @@ -11,16 +11,45 @@ #include "memory/node.h" #include "memory/pointer.h" #include "memory/pso.h" +#include "memory/pso3.h" #include "memory/pso4.h" #include "memory/tags.h" #include "payloads/exception.h" +#include "ops/truth.h" + +/** + * @brief allocate an exception object, and, if successful, return a pointer + * to it. + * + * Throwing an exception while generating an exception is meaningless. If + * allocation fails utterly (i.e. out of heap, out of page space) this will + * have to return `nil`, which might give rise to hard to trace bugs. But + * otherwise it will return a pointer to a new exception. + * + * @param message expected to be a string, but anything printable is accepted. + * @param frame the stack frame in which the exception was `thrown`, if any. + * @param meta metadata for this exception. Must be an assoc list, hashtable, + * or `nil` + * @param cause the exception that caused this exception to be `thrown`. + */ struct pso_pointer make_exception( struct pso_pointer message, - struct pso_pointer frame_pointer, + struct pso_pointer frame, + struct pso_pointer meta, struct pso_pointer cause ) { - // TODO: not yet implemented - return nil; + struct pso_pointer result = allocate(EXCEPTIONTAG, 3); + + 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; + } + + return result; } /** @@ -34,8 +63,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); - // TODO: decrement every pointer indicated by an exception. + 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 5b865e2..5670c81 100644 --- a/src/c/payloads/exception.h +++ b/src/c/payloads/exception.h @@ -16,16 +16,19 @@ * @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. */ + /** @brief the stack frame at which the exception was thrown. */ struct pso_pointer stack; + /** a store (assoc list or hashtable (or `nil` of metadata */ + struct pso_pointer meta; /** @brief the cause; expected to be another exception, or (usually) `nil`. */ struct pso_pointer cause; }; struct pso_pointer make_exception( struct pso_pointer message, struct pso_pointer frame_pointer, + struct pso_pointer meta, struct pso_pointer cause ); struct pso_pointer destroy_exception( struct pso_pointer fp,