simon/post-scarcity
1
0
Fork 0
Code Issues 18 Pull requests Projects Releases Packages Wiki Activity Actions

Tactical commit: things in 'stack_ops' really didn't belong in ops; moving.

Browse source
This commit is contained in:
Simon Brooke 2026-05-05 17:21:16 +01:00
parent d2efc8ba78
commit 4d480798e8
10 changed files with 333 additions and 231 deletions
Download patch file Download diff file Expand all files Collapse all files

173
src/c/payloads/stack.c
View file

@ -26,6 +26,69 @@
#include "ops/list_ops.h"
#include "ops/stack_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.
@ -60,22 +123,11 @@ struct pso_pointer add_arg( struct pso_pointer frame_pointer, struct pso_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.
* @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 make_frame( int arg_count, struct pso_pointer previous,
... ) {
va_list args;
va_start( args, previous );
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! */
@ -94,13 +146,13 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer 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.env =
prev_frame->payload.stack_frame.env;
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.previous = inc_ref( previous );
new_frame->payload.stack_frame.env = nil;
debug_printf( DEBUG_ALLOC, 1, L"depth is %d...\n",
new_frame->payload.stack_frame.depth );
@ -136,6 +188,34 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
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
@ -158,60 +238,10 @@ struct pso_pointer make_frame_with_env( int arg_count,
va_list args;
va_start( args, 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 new_pointer = in_make_frame( arg_count, previous, args);
pointer_to_pso4(new_pointer)->payload.stack_frame.env = inc_ref( env);
#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;
} else {
new_frame->payload.stack_frame.depth = 0;
}
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;
new_frame->payload.stack_frame.env = env;
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 );
va_end(args);
return new_pointer;
}
@ -258,6 +288,7 @@ struct pso_pointer make_frame_with_arglist_and_env( struct pso_pointer
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",