From 4d480798e89c6b2f4c698c0e119be849b4da4273 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Tue, 5 May 2026 17:21:16 +0100 Subject: [PATCH] Tactical commit: things in 'stack_ops' really didn't belong in ops; moving. --- Makefile | 8 +- docs/State-of-play.md | 142 ++++++++++++++++++++++++++ src/c/environment/environment.c | 15 +-- src/c/io/read.c | 4 +- src/c/memory/pso.c | 81 +++++++++------ src/c/ops/reverse.c | 6 +- src/c/ops/stack_ops.c | 80 --------------- src/c/ops/stack_ops.h | 35 ------- src/c/payloads/stack.c | 173 +++++++++++++++++++------------- src/c/payloads/stack.h | 20 ++++ 10 files changed, 333 insertions(+), 231 deletions(-) delete mode 100644 src/c/ops/stack_ops.c delete mode 100644 src/c/ops/stack_ops.h diff --git a/Makefile b/Makefile index b6853b9..8609dfc 100644 --- a/Makefile +++ b/Makefile @@ -51,8 +51,14 @@ clean: coredumps: ulimit -c unlimited -repl: +repl: Makefile $(TARGET) $(TARGET) -ps1000 2> tmp/psse.log +run: Makefile $(TARGET) + $(TARGET) -ps1000v1023 2> tmp/psse.log + +install: Makefile $(TARGET) + cp $(TARGET) ~/bin + -include $(DEPS) diff --git a/docs/State-of-play.md b/docs/State-of-play.md index 39f44ff..60b6e10 100644 --- a/docs/State-of-play.md +++ b/docs/State-of-play.md @@ -1,5 +1,147 @@ # State of Play +## 20260505 + +### The stack frame corruption(?) bug + +I have a weird bug in `read_symbol`, which at present I'm not understanding. + +Stack frames in `0.1.0` are [paged space objects](https://www.journeyman.cc/blog/posts-output/2026-03-23-Paged-space-objects/), like all other objects; specifically they are objects of size class 4, which is to say they have a payload size of fourteen words. The first eight arguments to the function being called (which in most cases will be all the arguments) are held directly in the frame. + +`read_symbol` expects its arguments to be as follows (I'm numbering from zero here, although I consider that perverse and confusing, because the substrate language is C which uses numbering from zero:) + +| Argument | Expected value | Expected type | +| -------- | --------------- | ------------------------------------ | +| 0 | input stream | input stream | +| 1 | read table | store (cons, hashtable or namespace) | +| 2 | first character | character object | + +`read_symbol` then reads characters sequentially from the stream until it encounters a white-space character; for each character it reads, it creates a symbol object representing that character, and conses that object onto the list of the characters it has read so far. So if the user has typed + +> xyz + +the internal representation is now a sequence + +```lisp +(z y x) +``` + +Obviously, this now has to be reversed. So `read_symbol` then calls `reverse`. But wait! Because we're still in the bootstrap layer, the version of `read_symbol` I'm talking about is written in C. So *at the time of writing* it actually calls a wrapper function called `c_reverse` which builds the Lisp stack frame for `reverse` and then calls `reverse` with that stack frame. There was an earlier version of `c_reverse` which failed to create a new stack frame, and which would account for the bug I'm seeing; but that version has been replaced and the current version does certainly create the new stack frame: + +```c +/** + * @brief reverse a sequence. + * + * A sequence is a list or a string-like-thing. A dotted pair is not a + * sequence. + * + * @param sequence a pointer to a sequence. + * @return a sequence like the `sequence` passed, but reversed; or `nil` if + * the argument was not a sequence. + */ +struct pso_pointer c_reverse( struct pso_pointer frame_pointer, + struct pso_pointer sequence ) { + + struct pso_pointer result = nil; + + if ( stackp( frame_pointer ) ) { + result = reverse( make_frame(1, frame_pointer, sequence) ); + } + + return result; +} +``` + +So, I can see in the debugger that the sequence created in `read_symbol` is passed to `c_reverse` as the sequence argument; I can see it is put into the new frame as the first (index 0) argument; the new frame is directly passed into reverse. Reverse expects the argument in its stack frame to look like this: + +| Argument | Expected value | Expected type | +| -------- | -------------- | ------------------------------------------ | +| 0 | sequence | sequence (cons, keyword, string or symbol) | + + Reverse throws an exception: + +```lisp + +``` + +D'oh! And, of course, in trying to explain the bug, I've found the bug. It wasn't what I thought it was, so I was looking in the wrong place. It was this: + +```diff + struct pso_pointer sequence = + fetch_arg( pointer_to_pso4( frame_pointer ), 0 ); +- for ( struct pso_pointer cursor = sequence; !c_nilp( sequence ); ++ for ( struct pso_pointer cursor = sequence; !c_nilp( cursor ); + cursor = c_cdr( cursor ) ) { + struct pso2 *object = pointer_to_object( cursor ); + switch ( get_tag_value( cursor ) ) { + +``` + +I was checking for `nil` on the sequence, which obviously didn't change, not on the cursor, which did. D'oh! + +### About debuggers + +I switched to Eclipse for this session, because Eclipse has really good, really easy to use, debugger integration. But I don't, as I said yesterday, much like Eclipse. It is too helpful; it gets in the way too much. + +Zed, Gram, Gnome Builder and VS Codium (discussed yesterday) all claim to have debugger integration, and I'm pretty sure the debugger used in all cases is the [GNU debugger, `gdb`](https://sourceware.org/gdb/) (edited: I'm wrong. Zed, and so presumably also Gram, use [`lldb`](https://lldb.llvm.org/)). `Gdb` is an excellent debugger with a truly atrocious user interface, but fortunately there's a large range of tools which wrap more or less good user interfaces around `gdb`, of which I use (and like) ['seer'](https://github.com/epasveer/seer). However it's *much* more productive to have your debugger integrated with your editor. + +I've tried this morning to get each of these to enter a useful debugging session. It has taken some work. Gnome Builder fails (for me) because although selecting `Run with Debugger` from the `run` menu does start both a `psse` session and a `gdb` session, and although terminating the `psse` session does show `[Inferior 1 (process 248474) exited normally]` on the GDB console, when I attempt to set a breakpoint (you don't seem to be able to set on in the GUI), I get the following: + +``` +> break src/c/ops/eval_apply.c:784 +Make breakpoint pending on future shared library load? (y or [n]) [answered N; input not from terminal] +> n +Cannot execute this command without a live selected thread. +``` + +So there is something alive there, and probably with a bit of struggle I could make it work. + +Zed and Gram are much the same, because Gram is a fork of Zed. Zed appears(?) to copy VS Codium's (and thus VS Code's) approach to interacting with `gdb`. VS Codium *appears*(?) to need some sort of JSON configuration in `launch.json`. I've tried this: + +```json +{ + // Use IntelliSense to learn about possible attributes. + // Hover to view descriptions of existing attributes. + // For more information, visit: https://go.microsoft.com/fwlink/?linkid=830387 + "version": "0.2.0", + "configurations": [ + { + "name": "PSSE Debug (gdb Attach)", + "type": "cppdbg", + "request": "attach", + "program": "target/psse", + // "args": ["-p", "-s1000", "-v1023"], + "processId": "${command:pickProcess}", + "MIMode": "gdb", + "setupCommands": [ + { + "description": "Enable pretty-printing for gdb", + "text": "-enable-pretty-printing", + "ignoreFailures": true + } + ] + } + ] +} +``` + +It does not work, at least not in VS Codium. + +Zed's debugger [configuration documentation](https://zed.dev/docs/debugger) is better. Using it, I was able to compose this stanza: + +```json + { + "label": "PSSE Start debugger config", + "adapter": "CodeLLDB", + "request": "launch", + "program": "target/psse", + "cwd": "$ZED_WORKTREE_ROOT", + }, + +``` + +which successfully launches a debugger session. It's easy to set breakpoints in the editor windows; it's probably as easy to find your way around variables and stack frames as it is in Eclipse or Seer, once you get used to it (I haven't yet). I haven't yet worked out how to get it to automatically rebuild before running if it needs to do so, but I expect I shall. This is usable; but I shall need to get used to it. + ## 20260504 My monster, she builds! diff --git a/src/c/environment/environment.c b/src/c/environment/environment.c index 8ca6b42..69a88d6 100644 --- a/src/c/environment/environment.c +++ b/src/c/environment/environment.c @@ -36,7 +36,7 @@ bool environment_initialised = false; /** * @brief Initialise a minimal environment, so that Lisp can be bootstrapped. - * + * * @param node the index of the node we are initialising. * @return a proto-environment on success, else an exception. */ @@ -81,10 +81,11 @@ struct pso_pointer initialise_environment( uint32_t node ) { } } if ( !exceptionp( result ) ) { + frame_pointer = inc_ref( make_frame(0, nil)); result = lisp_bind( make_frame ( 3, frame_pointer, - c_string_to_lisp_symbol( frame_pointer, U"niU" ), nil, + c_string_to_lisp_symbol( frame_pointer, U"nil" ), nil, nil ) ); debug_print( U"Environment after binding `nil`: ", DEBUG_BOOTSTRAP, 0 ); @@ -101,14 +102,14 @@ struct pso_pointer initialise_environment( uint32_t node ) { debug_print( U"\nEnvironment initialised successfully.\n", DEBUG_BOOTSTRAP, 0 ); - } - initialise_privileged_keywords(frame_pointer); + initialise_privileged_keywords(frame_pointer); - result = initialise_function_bindings(push_local( - frame_pointer, make_frame_with_env(0, frame_pointer, result))); + result = inc_ref( initialise_function_bindings(push_local( + frame_pointer, make_frame_with_env(0, frame_pointer, result)))); - dec_ref(frame_pointer); + dec_ref(frame_pointer); + } return result; } diff --git a/src/c/io/read.c b/src/c/io/read.c index 5e64005..ff0f516 100644 --- a/src/c/io/read.c +++ b/src/c/io/read.c @@ -143,8 +143,8 @@ struct pso_pointer read_number( struct pso_pointer frame_pointer ) { ? 0 : pointer_to_object( character )->payload.character.character; URL_FILE *input = pointer_to_object( stream )->payload.stream.stream; - for ( ; iswdigit( c ); c = url_fgetwc( input ) ) { - value = ( value * base ) + ( ( int ) c - ( int ) L'0' ); + for ( ; iswdigit( c ) || c == L','; c = url_fgetwc( input ) ) { + if ( iswdigit( c ) ){value = ( value * base ) + ( ( int ) c - ( int ) L'0' );} } url_ungetwc( c, input ); diff --git a/src/c/memory/pso.c b/src/c/memory/pso.c index aff210b..e16fafb 100644 --- a/src/c/memory/pso.c +++ b/src/c/memory/pso.c @@ -60,6 +60,9 @@ void print_allocation_table( ) { } #endif +struct pso_pointer cheaty_allocate(struct pso_pointer frame_pointer, char *tag, + uint8_t size_class); + /** * @brief a means of creating a cons cell without using a stack frame, to * prevent runaway recursion. @@ -71,7 +74,7 @@ void print_allocation_table( ) { */ struct pso_pointer cheaty_make_cons( struct pso_pointer car, struct pso_pointer cdr ) { - struct pso_pointer result = allocate( nil, CONSTAG, 2 ); + struct pso_pointer result = cheaty_allocate( nil, CONSTAG, 2 ); struct pso2 *obj = pointer_to_object( result ); obj->payload.cons.car = car; @@ -80,6 +83,46 @@ struct pso_pointer cheaty_make_cons( struct pso_pointer car, return result; } +/** + * Special variant of allocate especially for cheaty_make_cons, so we don't + * get excessive spurius missing stack frame warnings. Not to be called + * outside this file! + */ +struct pso_pointer cheaty_allocate(struct pso_pointer frame_pointer, char *tag, + uint8_t size_class) { + struct pso_pointer result = pop_freelist( size_class ); +#ifdef DEBUG + debug_printf( DEBUG_ALLOC, 0, + L"\nAllocating object of size class %d with tag `%s`... ", + size_class, tag ); +#endif + + struct pso2 *obj = pointer_to_object( result ); + strncpy( ( char * ) ( obj->header.tag.bytes.mnemonic ), tag, TAGLENGTH ); + + debug_printf( DEBUG_ALLOC, 0, L"at page %d, offset %d... ", result.page, + result.offset ); + if ( stackp( frame_pointer ) ) { + struct pso4 *frame = pointer_to_pso4( frame_pointer ); + // You can't make a stack frame in the middle of making a stack + // frame. Infinite recursion. So we have to cheat. + struct pso_pointer locals = + cheaty_make_cons( result, frame->payload.stack_frame.locals ); + frame->payload.stack_frame.locals = locals; + } +#ifdef DEBUG + allocation_table[size_class][allocation_table_allocated]++; +#endif + +#ifdef DEBUG + debug_print( exceptionp( result ) ? L"fail\n" : L"success\n", DEBUG_ALLOC, + 0 ); +#endif + + return result; +} + + /** * @brief Allocate an object of this `size_class` with this `tag`. * @@ -100,42 +143,14 @@ struct pso_pointer cheaty_make_cons( struct pso_pointer car, */ struct pso_pointer allocate( struct pso_pointer frame_pointer, char *tag, uint8_t size_class ) { - struct pso_pointer result = pop_freelist( size_class ); - if ( memory_initialised && c_nilp( frame_pointer ) ) { fputws( L"\nWARNING: No stack frame passed to `allocate`.\n", stderr ); } -#ifdef DEBUG - debug_printf( DEBUG_ALLOC, 0, - L"\nAllocating object of size class %d with tag `%s`... ", - size_class, tag ); -#endif - struct pso2 *obj = pointer_to_object( result ); - strncpy( ( char * ) ( obj->header.tag.bytes.mnemonic ), tag, TAGLENGTH ); - - debug_printf( DEBUG_ALLOC, 0, L"at page %d, offset %d... ", result.page, - result.offset ); - if ( stackp( frame_pointer ) ) { - struct pso4 *frame = pointer_to_pso4( frame_pointer ); - // You can't make a stack frame in the middle of making a stack - // frame. Infinite recursion. So we have to cheat. - struct pso_pointer locals = - cheaty_make_cons( result, frame->payload.stack_frame.locals ); - frame->payload.stack_frame.locals = locals; - } -#ifdef DEBUG - allocation_table[size_class][allocation_table_allocated]++; -#endif - -#ifdef DEBUG - debug_print( exceptionp( result ) ? L"fail\n" : L"success\n", DEBUG_ALLOC, - 0 ); -#endif - - return result; + return cheaty_allocate(frame_pointer, tag, size_class); } + int payload_size( struct pso2 *object ) { // TODO: Unit tests DEFINITELY needed! int sc = object->header.tag.bytes.size_class; @@ -157,7 +172,7 @@ int payload_size( struct pso2 *object ) { */ struct pso_pointer inc_ref( struct pso_pointer pointer ) { if ( c_nilp( pointer ) || c_truep( pointer ) ) { - /* You can't do this and there's no point trying or cluttering the + /* You can't do this and there's no point trying or cluttering the logs. */ return pointer; } else if ( freep( pointer ) ) { @@ -204,7 +219,7 @@ struct pso_pointer inc_ref( struct pso_pointer pointer ) { */ struct pso_pointer dec_ref( struct pso_pointer pointer ) { if ( c_nilp( pointer ) || c_truep( pointer ) ) { - /* You can't do this and there's no point trying or cluttering the + /* You can't do this and there's no point trying or cluttering the logs. */ return pointer; } else if ( freep( pointer ) ) { diff --git a/src/c/ops/reverse.c b/src/c/ops/reverse.c index 296aaf3..c25a5b0 100644 --- a/src/c/ops/reverse.c +++ b/src/c/ops/reverse.c @@ -26,6 +26,7 @@ #include "ops/string_ops.h" #include "ops/truth.h" +#include "payloads/stack.h" /** * @brief reverse a sequence @@ -36,7 +37,7 @@ struct pso_pointer reverse( struct pso_pointer frame_pointer ) { struct pso_pointer result = nil; struct pso_pointer sequence = fetch_arg( pointer_to_pso4( frame_pointer ), 0 ); - for ( struct pso_pointer cursor = sequence; !c_nilp( sequence ); + for ( struct pso_pointer cursor = sequence; !c_nilp( cursor ); cursor = c_cdr( cursor ) ) { struct pso2 *object = pointer_to_object( cursor ); switch ( get_tag_value( cursor ) ) { @@ -104,7 +105,8 @@ struct pso_pointer c_reverse( struct pso_pointer frame_pointer, struct pso_pointer result = nil; if ( stackp( frame_pointer ) ) { - result = reverse( frame_pointer ); + result = reverse( make_frame(1, frame_pointer, sequence) ); } + return result; } diff --git a/src/c/ops/stack_ops.c b/src/c/ops/stack_ops.c deleted file mode 100644 index f1d14ea..0000000 --- a/src/c/ops/stack_ops.c +++ /dev/null @@ -1,80 +0,0 @@ -/** - * payloads/stack.c - * - * The execution stack. - * - * (c) 2026 Simon Brooke - * Licensed under GPL version 2.0, or, at your option, any later version. - */ - -#include "memory/node.h" -#include "memory/pointer.h" -#include "memory/pso2.h" -#include "memory/pso4.h" -#include "memory/tags.h" - -#include "payloads/cons.h" -#include "payloads/stack.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; -} diff --git a/src/c/ops/stack_ops.h b/src/c/ops/stack_ops.h deleted file mode 100644 index 059f61e..0000000 --- a/src/c/ops/stack_ops.h +++ /dev/null @@ -1,35 +0,0 @@ -/** - * ops/stack_ops.h - * - * Operations on a Lisp stack frame. - * - * (c) 2026 Simon Brooke - * Licensed under GPL version 2.0, or, at your option, any later version. - */ - -#ifndef __psse_ops_stack_ops_h -#define __psse_ops_stack_ops_h - -#include "memory/pointer.h" -#include "memory/pso4.h" - -/* - * number of arguments stored in a stack frame - */ -#define args_in_frame 8 - -/** - * @brief The maximum depth of stack before we throw an exception. - * - * `0` is interpeted as `unlimited`. - */ -extern uint32_t stack_limit; - -struct pso_pointer fetch_arg( struct pso4 *frame, unsigned int index ); - -struct pso_pointer fetch_env( struct pso_pointer frame_pointer ); - -struct pso_pointer push_local( struct pso_pointer frame_pointer, - struct pso_pointer local ); - -#endif diff --git a/src/c/payloads/stack.c b/src/c/payloads/stack.c index 75472f5..978f356 100644 --- a/src/c/payloads/stack.c +++ b/src/c/payloads/stack.c @@ -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", diff --git a/src/c/payloads/stack.h b/src/c/payloads/stack.h index d89d705..62f9a7b 100644 --- a/src/c/payloads/stack.h +++ b/src/c/payloads/stack.h @@ -41,6 +41,26 @@ struct stack_frame_payload { uint32_t depth; }; +/* + * number of arguments stored in a stack frame + */ +#define args_in_frame 8 + +/** + * @brief The maximum depth of stack before we throw an exception. + * + * `0` is interpeted as `unlimited`. + */ +extern uint32_t stack_limit; + +struct pso_pointer fetch_arg( struct pso4 *frame, unsigned int index ); + +struct pso_pointer fetch_env( struct pso_pointer frame_pointer ); + +struct pso_pointer push_local( struct pso_pointer frame_pointer, + struct pso_pointer local ); + + struct pso_pointer make_frame( int arg_count, struct pso_pointer previous, ... );