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

Modified make_cons and make_frame to illustrate the pattern I

Browse source 
want to apply generally. This does not compile!
This commit is contained in:
Simon Brooke 2026-04-20 23:21:30 +01:00
parent 6148d3699f
commit aa5b34368e
6 changed files with 145 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

18
src/c/payloads/cons.c
View file

@ -30,15 +30,17 @@
* @param cdr the pointer which should form the cdr of this cons cell.
* @return struct pso_pointer a pointer to the newly allocated cons cell.
*/
struct pso_pointer make_cons( struct pso4 *frame_pointer,
struct pso_pointer car,
struct pso_pointer cdr ) {
// todo: issue #21: must have stack frame passed in.
struct pso_pointer result = allocate( frame_pointer, CONSTAG, 2 );
struct pso_pointer make_cons( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer result = allocate( frame, CONSTAG, 2 );
struct pso2 *object = pointer_to_object( result );
object->payload.cons.car = inc_ref( car );
object->payload.cons.cdr = inc_ref( cdr );
if ( stackp( frame ) ) {
struct pso2 *object = pointer_to_object( result );
object->payload.cons.car =
inc_ref( frame->payload.stack_frame.args[0] );
object->payload.cons.cdr =
inc_ref( frame->payload.stack_frame.args[0] );
}
return result;
}

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

@ -28,14 +28,18 @@
* @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.
*
* @return a pso_pointer to the stack frame.
*
* @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,
... ) {
// todo: issue #21: must have stack frame passed in.
struct pso_pointer env, ... ) {
va_list args;
va_start( args, previous );
va_start( args, env );
struct pso4 *frame = pointer_to_pso4( previous );
struct pso_pointer frame_pointer =
@ -53,6 +57,7 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
if ( stackp( previous ) ) {
struct pso4 *op = pointer_to_pso4( previous );
frame->payload.stack_frame.depth = op->payload.stack_frame.depth + 1;
frame->payload.stack_frame.env = op->payload.stack_frame.env;
} else {
frame->payload.stack_frame.depth = 0;
}
@ -91,6 +96,81 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
return frame_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 *frame = pointer_to_pso4( previous );
struct pso_pointer frame_pointer =
allocate( pointer_to_pso4( previous ), STACKTAG, 4 );
#ifdef DEBUG
debug_printf( DEBUG_ALLOC, 0,
L"\nAllocating stack frame with %d arguments at page %d, "
L"offset %d...\n",
arg_count, frame_pointer.page, frame_pointer.offset );
#endif
frame->payload.stack_frame.previous = previous;
if ( stackp( previous ) ) {
struct pso4 *op = pointer_to_pso4( previous );
frame->payload.stack_frame.depth = op->payload.stack_frame.depth + 1;
frame->payload.stack_frame.env = env;
} else {
frame->payload.stack_frame.depth = 0;
}
debug_printf( DEBUG_ALLOC, 1, L"depth is %d...\n",
frame->payload.stack_frame.depth );
int cursor = 0;
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 );
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( frame, va_arg( args, struct pso_pointer ),
more_args );
}
frame->payload.stack_frame.more = c_reverse( more_args );
} else {
for ( ; cursor < args_in_frame; cursor++ ) {
frame->payload.stack_frame.arg[cursor] = nil;
}
}
debug_printf( DEBUG_ALLOC, 1,
L"Allocation of frame at page %d, offset %d completed.\n",
frame_pointer.page, frame_pointer.offset );
return frame_pointer;
}
/**
* @brief When a stack frame is freed, all its pointers must be decremented.
*

4
src/c/payloads/stack.h
View file

@ -43,7 +43,9 @@ struct stack_frame_payload {
struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
... );
struct pso_pointer make_frame_with_env( int arg_count,
struct pso_pointer previous,
struct pso_pointer env, ... )
struct pso_pointer destroy_stack_frame( struct pso_pointer fp,
struct pso_pointer env );