post-scarcity/src/c/payloads/exception.c

/**
 *  payloads/exception.c
 *
 *  An exception; required three pointers, so use object of size class 3.
 *
 *  (c) 2026 Simon Brooke <simon@journeyman.cc>
 *  Licensed under GPL version 2.0, or, at your option, any later version.
 */
#include <stdlib.h>

/*
 * wide characters
 */
#include <wchar.h>
#include <wctype.h>


#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 <stdlib.h>
#include <stdlib.h>
#include <stdlib.h>
#include <stdlib.h>

/**
 * @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( U"\nERROR: `", DEBUG_ANY, 0 );
    debug_print_object( message, DEBUG_ANY, 0 );
    debug_print( U"` at `", DEBUG_ANY, 0 );
    debug_print_object( location, DEBUG_ANY, 0 );
    debug_print( U"`\n", DEBUG_ANY, 0 );
    if ( !c_nilp( cause ) ) {
        debug_print( U"\tCaused by: ", DEBUG_ANY, 0 );
        debug_print_object( cause, DEBUG_ANY, 0);
        debug_print( U"`\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 );
}