Simon Brooke
f7eabb9b62
as the focus ot this prototype is supposed to be building things in Lisp, I've started deliberately copying stuff that mostly works directly from the 0.0.6 branch into this branch. After all, if it's going to be replaced in Lisp, it doesn't have to be the most elegant C.
293 lines
9.9 KiB
C
293 lines
9.9 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 "ops/reverse.h"
|
|
#include "ops/list_ops.h"
|
|
|
|
/**
|
|
* @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 = 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.env =
|
|
prev_frame->payload.stack_frame.env;
|
|
} else {
|
|
new_frame->payload.stack_frame.depth = 0;
|
|
}
|
|
|
|
new_frame->payload.stack_frame.previous = inc_ref( previous );
|
|
|
|
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( 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 variant of make_frame with an explicit replacement environment, to
|
|
* be called by functions like `binding` which add bindings to their upstack
|
|
* environment.
|
|
*
|
|
* @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 pso4 *prev_frame = pointer_to_pso4( previous );
|
|
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
|
|
|
|
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( 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 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 );
|
|
struct pso_pointer new_pointer = allocate( previous, STACKTAG, 4 );
|
|
struct pso4 *new_frame = pointer_to_pso4( new_pointer );
|
|
struct pso_pointer arg_length =
|
|
length( 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;
|
|
}
|
|
|
|
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.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;
|
|
}
|