/** * payloads/exception.c * * An exception; required three pointers, so use object of size class 3. * * (c) 2026 Simon Brooke * Licensed under GPL version 2.0, or, at your option, any later version. */ #include /* * wide characters */ #include #include #include "debug.h" #include "environment/privileged_keywords.h" #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 "payloads/stack.h" #include "ops/truth.h" #include "payloads/cons.h" #include #include #include #include /** * @brief allocate an exception object, and, if successful, return a pointer * to it. * * (exception message meta cause) * * 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. b * @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 frame_pointer ) { struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso_pointer message = fetch_arg( frame, 0 ); struct pso_pointer previous = frame->payload.stack_frame.previous; struct pso_pointer meta = fetch_arg( frame, 1 ); struct pso_pointer cause = fetch_arg( frame, 2 ); struct pso_pointer result = allocate( frame_pointer, EXCEPTIONTAG, 3 ); if ( exceptionp( result ) ) { struct pso3 *object = ( struct pso3 * ) pointer_to_object( result ); object->payload.exception.message = inc_ref( message ); object->payload.exception.stack = stackp( frame_pointer ) ? inc_ref( frame_pointer ) : nil; object->payload.exception.meta = ( consp( meta ) || hashtabp( meta ) ) ? inc_ref( meta ) : nil; object->payload.exception.cause = exceptionp( cause ) ? inc_ref( cause ) : nil; } return result; } /** * @brief When an exception is freed, all its pointers must be decremented. * * Lisp calling conventions; one expected arg, the pointer to the object to * be destroyed. */ 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 ); 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; } /** * Throw an exception with a cause. * `throw_exception` is a misnomer, because it doesn't obey the calling signature of a * lisp function; but it is nevertheless to be preferred to make_exception. A * real `throw_exception`, which does, will be needed. * object pointing to it. Then this should become a normal lisp function * which expects a normally bound frame and environment, such that * frame->payload.stack_frame.arg[0] is the payload, frame->payload.stack_frame.arg[1] is the cause, and frame->payload.stack_frame.arg[2] is the cons-space * pointer to the frame in which the exception occurred. */ struct pso_pointer throw_exception_with_cause( struct pso_pointer location, struct pso_pointer message, struct pso_pointer cause, struct pso_pointer frame_pointer ) { struct pso_pointer result = nil; #ifdef DEBUG debug_print( L"\nERROR: `", DEBUG_ANY, 0 ); debug_print_object( message, DEBUG_ANY, 0 ); debug_print( L"` at `", DEBUG_ANY, 0 ); debug_print_object( location, DEBUG_ANY, 0 ); debug_print( L"`\n", DEBUG_ANY, 0 ); if ( !c_nilp( cause ) ) { debug_print( L"\tCaused by: ", DEBUG_ANY, 0 ); debug_print_object( cause, DEBUG_ANY, 0 ); debug_print( L"`\n", DEBUG_ANY, 0 ); } #endif struct pso2 *cell = pointer_to_object( message ); if ( get_tag_value( message ) ) { result = message; } else { struct pso_pointer x_frame = inc_ref( make_frame( 2, frame_pointer, message, ( c_nilp( location ) ? nil : make_cons( frame_pointer, make_cons( frame_pointer, privileged_keyword_location, location ), nil ) ), cause ) ); result = push_local( frame_pointer, make_exception( x_frame ) ); } return result; } /** * Throw an exception. * `throw_exception` is a misnomer, because it doesn't obey the calling signature of a * lisp function; but it is nevertheless to be preferred to make_exception. A * real `throw_exception`, which does, will be needed. * object pointing to it. Then this should become a normal lisp function * which expects a normally bound frame and environment, such that * frame->payload.stack_frame.arg[0] is the payload, frame->payload.stack_frame.arg[1] is the cause, and frame->payload.stack_frame.arg[2] is the cons-space * pointer to the frame in which the exception occurred. */ struct pso_pointer throw_exception( struct pso_pointer location, struct pso_pointer payload, struct pso_pointer frame_pointer ) { return throw_exception_with_cause( location, payload, nil, frame_pointer ); }