380 lines
13 KiB
C
380 lines
13 KiB
C
/**
|
|
* payloads/stack.c
|
|
*
|
|
* a Lisp stack frame.
|
|
*
|
|
* Sits in a pso4.
|
|
*
|
|
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
|
* Licensed under GPL version 2.0, or, at your option, any later version.
|
|
*/
|
|
|
|
#include <stdarg.h>
|
|
|
|
#include "debug.h"
|
|
|
|
#include "memory/node.h"
|
|
#include "memory/pointer.h"
|
|
#include "memory/pso.h"
|
|
#include "memory/pso2.h"
|
|
#include "memory/pso4.h"
|
|
#include "memory/tags.h"
|
|
|
|
#include "payloads/cons.h"
|
|
#include "payloads/stack.h"
|
|
|
|
#include "ops/reverse.h"
|
|
#include "ops/list_ops.h"
|
|
|
|
/**
|
|
* @brief The maximum depth of stack before we throw an exception.
|
|
*
|
|
* `0` is interpeted as `unlimited`.
|
|
*/
|
|
uint32_t stack_limit = 0;
|
|
|
|
/**
|
|
* Fetch a pointer to the value of the local variable at this index.
|
|
*
|
|
* TODO: I think the first argument would be better as a pso_pointer.
|
|
*/
|
|
struct pso_pointer fetch_arg( struct pso4 *frame, unsigned int index ) {
|
|
struct pso_pointer result = nil;
|
|
|
|
// TODO check that the frame is indeed a frame!
|
|
if ( index < frame->payload.stack_frame.args ) {
|
|
result = frame->payload.stack_frame.arg[index];
|
|
} else {
|
|
struct pso_pointer p = frame->payload.stack_frame.more;
|
|
|
|
for ( int i = args_in_frame; i < index; i++ ) {
|
|
p = pointer_to_object( p )->payload.cons.cdr;
|
|
}
|
|
|
|
result = pointer_to_object( p )->payload.cons.car;
|
|
}
|
|
|
|
return result;
|
|
}
|
|
|
|
/**
|
|
* @brief Return the environment from the stack frame identified by this
|
|
* `frame_pointer`
|
|
*
|
|
* @param frame_pointer a pointer to a stack frame.
|
|
*/
|
|
struct pso_pointer fetch_env( struct pso_pointer frame_pointer ) {
|
|
return stackp( frame_pointer ) ?
|
|
pointer_to_pso4( frame_pointer )->payload.stack_frame.env : nil;
|
|
}
|
|
|
|
/**
|
|
* Push a binding (and therefore a reference) for this `local` onto the
|
|
* stack_frame indicated by this `frame_pointer`, thereby protecting the
|
|
* `local` from garbage collection until the frame itself is disposed of.
|
|
*
|
|
* This is a hack. For Lisp functions, where the stack frames are set up
|
|
* and torn down by eval/apply, it shouldn't be necessary.
|
|
*/
|
|
struct pso_pointer push_local( struct pso_pointer frame_pointer,
|
|
struct pso_pointer local ) {
|
|
if ( stackp( frame_pointer ) ) {
|
|
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
|
|
|
struct pso_pointer l = make_cons( frame_pointer, local,
|
|
frame->payload.stack_frame.locals );
|
|
frame->payload.stack_frame.locals = l;
|
|
}
|
|
|
|
return local;
|
|
}
|
|
|
|
/**
|
|
* @brief Add an argument to this (already initialised) stack frame, updating
|
|
* the args count.
|
|
*
|
|
* TODO: unit test this to death and back!
|
|
*
|
|
* @param frame_pointer a pointer to the frame to be modified.
|
|
* @param arg_pointer the pointer to the arg to be added.
|
|
*
|
|
* @return `nil` on success; potentially an exception on failure.
|
|
*/
|
|
struct pso_pointer add_arg( struct pso_pointer frame_pointer,
|
|
struct pso_pointer arg_pointer ) {
|
|
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
|
struct pso_pointer result = nil;
|
|
|
|
if ( frame->payload.stack_frame.args < args_in_frame ) {
|
|
frame->payload.stack_frame.arg[frame->payload.stack_frame.args++] =
|
|
push_local( frame_pointer, arg_pointer );
|
|
} else {
|
|
struct pso_pointer new_more = c_reverse( frame_pointer,
|
|
make_cons( frame_pointer,
|
|
arg_pointer,
|
|
c_reverse
|
|
( frame_pointer,
|
|
frame->payload.
|
|
stack_frame.
|
|
more ) ) );
|
|
if ( exceptionp( new_more ) ) {
|
|
result = new_more;
|
|
} else {
|
|
frame->payload.stack_frame.more =
|
|
push_local( frame_pointer, new_more );
|
|
}
|
|
}
|
|
|
|
return result;
|
|
}
|
|
|
|
/**
|
|
* @brief internal shared guts of make_frame variants. **Does not** set up the
|
|
* `env` pointer of the new frame -- callers are responsible for doing so.
|
|
*/
|
|
struct pso_pointer in_make_frame( int arg_count, struct pso_pointer previous,
|
|
va_list args ) {
|
|
/* NOTE! It is really important not to `push_local` the new_pointer here,
|
|
* since that would stop stack frames and all the temporary objects they
|
|
* curate ever being garbage collected! */
|
|
struct pso_pointer new_pointer = allocate( previous, STACKTAG, 4 );
|
|
struct pso4 *new_frame = pointer_to_pso4( new_pointer );
|
|
|
|
#ifdef DEBUG
|
|
debug_printf( DEBUG_ALLOC, 0,
|
|
L"\nAllocating stack frame with %d arguments at page %d, "
|
|
L"offset %d...\n",
|
|
arg_count, new_pointer.page, new_pointer.offset );
|
|
#endif
|
|
|
|
|
|
if ( stackp( previous ) ) {
|
|
struct pso4 *prev_frame = pointer_to_pso4( previous );
|
|
new_frame->payload.stack_frame.depth =
|
|
prev_frame->payload.stack_frame.depth + 1;
|
|
new_frame->payload.stack_frame.previous = inc_ref( previous );
|
|
} else {
|
|
new_frame->payload.stack_frame.depth = 0;
|
|
new_frame->payload.stack_frame.previous = nil;
|
|
}
|
|
|
|
new_frame->payload.stack_frame.env = nil;
|
|
|
|
debug_printf( DEBUG_ALLOC, 1, L"depth is %d...\n",
|
|
new_frame->payload.stack_frame.depth );
|
|
|
|
int cursor = 0;
|
|
new_frame->payload.stack_frame.args = arg_count;
|
|
|
|
for ( ; cursor < arg_count && cursor < args_in_frame; cursor++ ) {
|
|
struct pso_pointer argument = va_arg( args, struct pso_pointer );
|
|
|
|
new_frame->payload.stack_frame.arg[cursor] = inc_ref( argument );
|
|
}
|
|
if ( cursor < arg_count ) {
|
|
struct pso_pointer more_args = nil;
|
|
|
|
for ( ; cursor < arg_count; cursor++ ) {
|
|
more_args =
|
|
make_cons( previous, va_arg( args, struct pso_pointer ),
|
|
more_args );
|
|
}
|
|
|
|
new_frame->payload.stack_frame.more = c_reverse( previous, more_args );
|
|
} else {
|
|
for ( ; cursor < args_in_frame; cursor++ ) {
|
|
new_frame->payload.stack_frame.arg[cursor] = nil;
|
|
}
|
|
}
|
|
|
|
debug_printf( DEBUG_ALLOC, 1,
|
|
L"Allocation of stack frame at page %d, offset %d completed.\n",
|
|
new_pointer.page, new_pointer.offset );
|
|
|
|
return new_pointer;
|
|
}
|
|
|
|
/**
|
|
* @brief Construct a stack frame with this `previous` pointer, and arguments
|
|
* taken from the remaining arguments to this function, which should all be
|
|
* struct pso_pointer.
|
|
*
|
|
* @param arg_count the count of arguments to the Lisp function.
|
|
* @param previous the parent stack frame.
|
|
* @param ... the arguments to the Lisp function, all of which must be of type
|
|
* `struct pso_pointer`.
|
|
* @return struct pso_pointer a pointer to a populated stack frame which may be
|
|
* passed to the Lisp function.
|
|
*/
|
|
struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
|
|
... ) {
|
|
va_list args;
|
|
va_start( args, previous );
|
|
|
|
struct pso_pointer new_pointer =
|
|
in_make_frame( arg_count, previous, args );
|
|
struct pso4 *new_frame = pointer_to_pso4( new_pointer );
|
|
|
|
new_frame->payload.stack_frame.env = stackp( previous ) ?
|
|
inc_ref( pointer_to_pso4( previous )->payload.stack_frame.env ) : nil;
|
|
|
|
va_end( args );
|
|
|
|
return new_pointer;
|
|
}
|
|
|
|
/**
|
|
* @brief variant of make_frame with an explicit replacement environment, to
|
|
* be called by functions like `binding` which add bindings to their upstack
|
|
* environment.
|
|
*
|
|
* TODO: someone who really understood how C varargs functions work could save
|
|
* a lot of potentially error prone code by having this call `make_frame`, q.v.
|
|
*
|
|
* @param arg_count the count of arguments to the Lisp function.
|
|
* @param previous the parent stack frame.
|
|
* @param env the modified environment
|
|
* @param ... the arguments to the Lisp function, all of which must be of type
|
|
* `struct pso_pointer`.
|
|
* @return struct pso_pointer a pointer to a populated stack frame which may be
|
|
* passed to the Lisp function.
|
|
*/
|
|
struct pso_pointer make_frame_with_env( int arg_count,
|
|
struct pso_pointer previous,
|
|
struct pso_pointer env, ... ) {
|
|
va_list args;
|
|
va_start( args, env );
|
|
|
|
struct pso_pointer new_pointer =
|
|
in_make_frame( arg_count, previous, args );
|
|
pointer_to_pso4( new_pointer )->payload.stack_frame.env = inc_ref( env );
|
|
|
|
va_end( args );
|
|
|
|
return new_pointer;
|
|
}
|
|
|
|
/**
|
|
* @brief variant make_frame where arg values are available as a Lisp list,
|
|
* and an explicit (because modified) environment is to be passed..
|
|
*
|
|
* @param previous pointer to the previous stack frame.
|
|
* @param argvalues values for the arguments to be placed in the frame.
|
|
* @param end the environment to be linked in the new frame.
|
|
*
|
|
* @return pointer to the new frame.
|
|
*/
|
|
struct pso_pointer make_frame_with_arglist_and_env( struct pso_pointer
|
|
previous,
|
|
struct pso_pointer
|
|
argvalues,
|
|
struct pso_pointer env ) {
|
|
struct pso4 *prev_frame = pointer_to_pso4( previous );
|
|
/* NOTE! It is really important not to `push_local` the new_pointer here,
|
|
* since that would stop stack frames and all the temporary objects they
|
|
* curate ever being garbage collected! */
|
|
struct pso_pointer new_pointer = allocate( previous, STACKTAG, 4 );
|
|
struct pso4 *new_frame = pointer_to_pso4( new_pointer );
|
|
struct pso_pointer arg_length =
|
|
count( push_local( previous, make_frame( 1, previous, argvalues ) ) );
|
|
int arg_count =
|
|
integerp( arg_length ) ? pointer_to_object( arg_length )->payload.
|
|
integer.value : 0;
|
|
#ifdef DEBUG
|
|
debug_printf( DEBUG_ALLOC, 0,
|
|
L"\nAllocating stack frame with %d arguments at page %d, "
|
|
L"offset %d...\n",
|
|
arg_count, new_pointer.page, new_pointer.offset );
|
|
#endif
|
|
|
|
prev_frame->payload.stack_frame.previous = inc_ref( previous );
|
|
|
|
if ( stackp( previous ) ) {
|
|
new_frame->payload.stack_frame.depth =
|
|
prev_frame->payload.stack_frame.depth + 1;
|
|
new_frame->payload.stack_frame.env =
|
|
inc_ref( prev_frame->payload.stack_frame.env );
|
|
} else {
|
|
new_frame->payload.stack_frame.depth = 0;
|
|
new_frame->payload.stack_frame.env = nil;
|
|
}
|
|
|
|
debug_printf( DEBUG_ALLOC, 1, L"depth is %d...\n",
|
|
new_frame->payload.stack_frame.depth );
|
|
|
|
int cursor = 0;
|
|
new_frame->payload.stack_frame.args = arg_count;
|
|
|
|
for ( ; cursor < arg_count && cursor < args_in_frame; cursor++ ) {
|
|
|
|
new_frame->payload.stack_frame.arg[cursor] =
|
|
inc_ref( make_frame( 1, previous, car( argvalues ) ) );
|
|
argvalues = cdr( make_frame( 1, previous, argvalues ) );
|
|
}
|
|
if ( cursor < arg_count ) {
|
|
new_frame->payload.stack_frame.more = inc_ref( argvalues );
|
|
} else {
|
|
for ( ; cursor < args_in_frame; cursor++ ) {
|
|
new_frame->payload.stack_frame.arg[cursor] = nil;
|
|
}
|
|
}
|
|
|
|
debug_printf( DEBUG_ALLOC, 1,
|
|
L"Allocation of stack frame at page %d, offset %d completed.\n",
|
|
new_pointer.page, new_pointer.offset );
|
|
|
|
return new_pointer;
|
|
}
|
|
|
|
/**
|
|
* @brief variant make_frame where arg values are available as a Lisp list.
|
|
*
|
|
* @param previous pointer to the previous stack frame.
|
|
* @param argvalues values for the arguments to be placed in the frame.
|
|
*
|
|
* @return pointer to the new frame.
|
|
*/
|
|
struct pso_pointer make_frame_with_arglist( struct pso_pointer previous,
|
|
struct pso_pointer argvalues ) {
|
|
return make_frame_with_arglist_and_env( previous, argvalues,
|
|
pointer_to_pso4
|
|
( previous )->payload.
|
|
stack_frame.env );
|
|
}
|
|
|
|
|
|
/**
|
|
* @brief When a stack frame 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_stack_frame( struct pso_pointer fp,
|
|
struct pso_pointer env ) {
|
|
if ( stackp( fp ) ) {
|
|
struct pso4 *frame = pointer_to_pso4( fp );
|
|
|
|
dec_ref( frame->payload.stack_frame.previous );
|
|
dec_ref( frame->payload.stack_frame.function );
|
|
dec_ref( frame->payload.stack_frame.more );
|
|
dec_ref( frame->payload.stack_frame.locals );
|
|
dec_ref( frame->payload.stack_frame.env );
|
|
|
|
for ( int i = 0; i < args_in_frame; i++ ) {
|
|
dec_ref( frame->payload.stack_frame.arg[i] );
|
|
frame->payload.stack_frame.arg[i] = nil;
|
|
}
|
|
|
|
|
|
frame->payload.stack_frame.previous = nil;
|
|
frame->payload.stack_frame.function = nil;
|
|
frame->payload.stack_frame.more = nil;
|
|
frame->payload.stack_frame.locals = nil;
|
|
frame->payload.stack_frame.env = nil;
|
|
|
|
frame->payload.stack_frame.args = 0;
|
|
frame->payload.stack_frame.depth = 0;
|
|
}
|
|
|
|
return nil;
|
|
}
|