diff --git a/docs/State-of-play.md b/docs/State-of-play.md index 2faad50..c79bf17 100644 --- a/docs/State-of-play.md +++ b/docs/State-of-play.md @@ -21,6 +21,47 @@ I'm not ignoring the fact that a lot of stuff in `0.1.0` is still fundamentally I think this week is going to be mostly a thinking week — partly because the weather forecast is unusually benign, and it would be sensible get some outdoor work done. +### 21:30 + +Right, I have spent a lot of time hauling timber out of the wood today, but I've also done a substantial amount of coding, doing a sort of hybrid not-quite-standard-lisp calling convention; and I'm now convinced all this work is wrong and needs to be backed out, and I need to go for full on Lisp calling convention. + +So where I'm now calling `make_cons` as in this sample: + +```c +struct pso_pointer c_reverse( struct pso4* frame, struct pso_pointer sequence ) { + struct pso_pointer result = nil; + + for ( struct pso_pointer cursor = sequence; !nilp( sequence ); + cursor = c_cdr( cursor ) ) { + result = make_cons( frame, c_car( cursor ), result ); + } + + return result; +} +``` + +we would instead be doing this: + +```c +struct pso_pointer reverse( struct pso_pointer frame) { + struct pso_pointer sequence = fetch_arg( frame, 0); + struct pso_pointer result = nil; + + for ( struct pso_pointer cursor = sequence; !nilp( sequence ); + cursor = cdr( make_frame( 1, frame, cursor ) ) { + result = cons( make_frame( 2, frame, + car( make_frame( 1, frame, cursor )), + result); + } + + return result; +} +``` + +Note that instead of `c_reverse`, `c_cdr`, `c_car` this is using `reverse`, `cdr`, `car`. That's because these are actual Lisp functions, callable from Lisp, which don't have to be duplicated or wrapped in Lisp-compatible wrappers. + +This *has* to be the right way to go. + ## 20260415 OK, I have been diverted down a side-project on a side-project. I decided diff --git a/src/c/io/io.c b/src/c/io/io.c index db69b73..1b8be37 100644 --- a/src/c/io/io.c +++ b/src/c/io/io.c @@ -381,8 +381,8 @@ struct pso_pointer push_back_character( struct pso_pointer c, if ( characterp( c ) && readp( r ) ) { if ( url_ungetwc( ( wint_t ) - ( pointer_to_object( c )->payload. - character.character ), + ( pointer_to_object( c )->payload.character. + character ), pointer_to_object( r )->payload.stream.stream ) >= 0 ) { result = t; diff --git a/src/c/memory/pso.c b/src/c/memory/pso.c index f6a241c..e856023 100644 --- a/src/c/memory/pso.c +++ b/src/c/memory/pso.c @@ -69,17 +69,16 @@ struct pso_pointer allocate( struct pso4 *stack_pointer, char *tag, struct pso_pointer result = pop_freelist( size_class ); if ( !nilp( result ) ) { - strncpy( ( char * ) ( pointer_to_object( result )->header.tag.bytes. - mnemonic ), tag, TAGLENGTH ); + strncpy( ( char * ) ( pointer_to_object( result )->header.tag. + bytes.mnemonic ), tag, TAGLENGTH ); debug_printf( DEBUG_ALLOC, 0, L"at page %d, offset %d... ", result.page, result.offset ); if ( stack_pointer != NULL && ( stack_pointer->header.tag.value & 0xffffff ) == STACKTV ) { struct pso_pointer locals = make_cons( result, - stack_pointer-> - payload.stack_frame. - locals ); + stack_pointer->payload. + stack_frame.locals ); stack_pointer->payload.stack_frame.locals = locals; } else if ( memory_initialised ) { diff --git a/src/c/payloads/cons.c b/src/c/payloads/cons.c index 9af48b7..730c14b 100644 --- a/src/c/payloads/cons.c +++ b/src/c/payloads/cons.c @@ -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; } diff --git a/src/c/payloads/stack.c b/src/c/payloads/stack.c index 0b025ca..c2acfb2 100644 --- a/src/c/payloads/stack.c +++ b/src/c/payloads/stack.c @@ -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. * diff --git a/src/c/payloads/stack.h b/src/c/payloads/stack.h index e9ab776..dd2e8ae 100644 --- a/src/c/payloads/stack.h +++ b/src/c/payloads/stack.h @@ -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 );