Still in progress. Nothing workds.

This commit is contained in:
Simon Brooke 2026-04-21 14:43:09 +01:00
parent aa5b34368e
commit ef59563e25
14 changed files with 206 additions and 180 deletions

View file

@ -37,63 +37,63 @@
* passed to the Lisp function.
*/
struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
struct pso_pointer env, ... ) {
... ) {
va_list args;
va_start( args, env );
va_start( args, previous );
struct pso4 *frame = pointer_to_pso4( previous );
struct pso_pointer frame_pointer =
struct pso4 *prev_frame = pointer_to_pso4( previous );
struct pso_pointer new_pointer =
allocate( pointer_to_pso4( 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, frame_pointer.page, frame_pointer.offset );
arg_count, new_pointer.page, new_pointer.offset );
#endif
frame->payload.stack_frame.previous = previous;
prev_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 = op->payload.stack_frame.env;
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 {
frame->payload.stack_frame.depth = 0;
new_frame->payload.stack_frame.depth = 0;
}
debug_printf( DEBUG_ALLOC, 1, L"depth is %d...\n",
frame->payload.stack_frame.depth );
new_frame->payload.stack_frame.depth );
int cursor = 0;
frame->payload.stack_frame.args = arg_count;
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 );
frame->payload.stack_frame.arg[cursor] = inc_ref( argument );
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( frame, va_arg( args, struct pso_pointer ),
make_cons( prev_frame, va_arg( args, struct pso_pointer ),
more_args );
}
frame->payload.stack_frame.more = c_reverse( more_args );
new_frame->payload.stack_frame.more = c_reverse( more_args );
} else {
for ( ; cursor < args_in_frame; cursor++ ) {
frame->payload.stack_frame.arg[cursor] = nil;
new_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 );
L"Allocation of stack frame at page %d, offset %d completed.\n",
new_pointer.page, new_pointer.offset );
return frame_pointer;
return new_pointer;
}
/**
@ -115,59 +115,131 @@ struct pso_pointer make_frame_with_env( int arg_count,
va_list args;
va_start( args, env );
struct pso4 *frame = pointer_to_pso4( previous );
struct pso_pointer frame_pointer =
struct pso4 *prev_frame = pointer_to_pso4( previous );
struct pso_pointer new_pointer =
allocate( pointer_to_pso4( 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, frame_pointer.page, frame_pointer.offset );
arg_count, new_pointer.page, new_pointer.offset );
#endif
frame->payload.stack_frame.previous = previous;
prev_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;
new_frame->payload.stack_frame.depth = prev_frame->payload.stack_frame.depth + 1;
new_frame->payload.stack_frame.env = env;
} else {
frame->payload.stack_frame.depth = 0;
new_frame->payload.stack_frame.depth = 0;
}
debug_printf( DEBUG_ALLOC, 1, L"depth is %d...\n",
frame->payload.stack_frame.depth );
new_frame->payload.stack_frame.depth );
int cursor = 0;
frame->payload.stack_frame.args = arg_count;
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 );
frame->payload.stack_frame.arg[cursor] = inc_ref( argument );
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( frame, va_arg( args, struct pso_pointer ),
make_cons( prev_frame, va_arg( args, struct pso_pointer ),
more_args );
}
frame->payload.stack_frame.more = c_reverse( more_args );
new_frame->payload.stack_frame.more = c_reverse( more_args );
} else {
for ( ; cursor < args_in_frame; cursor++ ) {
frame->payload.stack_frame.arg[cursor] = nil;
new_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 );
L"Allocation of stack frame at page %d, offset %d completed.\n",
new_pointer.page, new_pointer.offset );
return frame_pointer;
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( pointer_to_pso4( previous ), STACKTAG, 4 );
struct pso4* new_frame = pointer_to_pso4(new_pointer);
int arg_count = c_length(argvalues);
#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 = 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( cursor);
} 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);
}