Compare commits
No commits in common. "1cfd333e26690fb2e25563788fd9da91edef5ae7" and "f895a8e3594c4b903aca4a221cd63d1da621b38c" have entirely different histories.
1cfd333e26
...
f895a8e359
38 changed files with 317 additions and 542 deletions
10
Makefile
10
Makefile
|
|
@ -51,14 +51,8 @@ clean:
|
|||
coredumps:
|
||||
ulimit -c unlimited
|
||||
|
||||
repl: Makefile $(TARGET)
|
||||
$(TARGET) -p -s1000 -v1023 2> tmp/psse.log
|
||||
|
||||
run: Makefile $(TARGET)
|
||||
$(TARGET) -p -s1000 -v1023 2> tmp/psse.log
|
||||
|
||||
install: Makefile $(TARGET)
|
||||
cp $(TARGET) ~/bin
|
||||
repl:
|
||||
$(TARGET) -ps1000 2> tmp/psse.log
|
||||
|
||||
|
||||
-include $(DEPS)
|
||||
|
|
|
|||
|
|
@ -1,147 +1,5 @@
|
|||
# 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
|
||||
<exception: ("Invalid object in sequence")>
|
||||
```
|
||||
|
||||
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!
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@
|
|||
|
||||
#include "payloads/psse_string.h"
|
||||
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "ops/truth.h"
|
||||
#include "payloads/stack.h"
|
||||
|
||||
|
|
@ -81,11 +81,10 @@ 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"nil" ), nil,
|
||||
c_string_to_lisp_symbol( frame_pointer, U"niU" ), nil,
|
||||
nil ) );
|
||||
debug_print( U"Environment after binding `nil`: ", DEBUG_BOOTSTRAP,
|
||||
0 );
|
||||
|
|
@ -102,14 +101,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 = inc_ref( initialise_function_bindings(push_local(
|
||||
frame_pointer, make_frame_with_env(0, frame_pointer, result))));
|
||||
result = 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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -18,12 +18,6 @@
|
|||
|
||||
#include "debug.h"
|
||||
#include "environment/privileged_keywords.h"
|
||||
|
||||
#include "io/io.h"
|
||||
#include "io/peek.h"
|
||||
#include "io/print.h"
|
||||
#include "io/read.h"
|
||||
|
||||
#include "memory/node.h"
|
||||
#include "memory/pointer.h"
|
||||
#include "memory/tags.h"
|
||||
|
|
@ -41,7 +35,7 @@
|
|||
#include "ops/quote.h"
|
||||
#include "ops/repl.h"
|
||||
#include "ops/reverse.h"
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "ops/string_ops.h"
|
||||
#include "ops/truth.h"
|
||||
|
||||
|
|
@ -139,54 +133,6 @@ struct function_data {
|
|||
|
||||
/** initialisers for functions */
|
||||
struct function_data function_initialisers[] = {
|
||||
#ifdef _psse_io_io_h
|
||||
{U"close", U"(close stream): close `stream`.", &lisp_close},
|
||||
{U"open",
|
||||
U"(open stream), (open stream write?): open `stream`; if `write?` is "
|
||||
U"present and is non-nil, open for writing, else for reading.",
|
||||
&lisp_open},
|
||||
{U"slurp",
|
||||
U"(slurp stream): read the whole contents of this `stream`, "
|
||||
U"which may "
|
||||
U"be an open stream open for reading or a URL, into a string, and return "
|
||||
U"the "
|
||||
U"string.",
|
||||
&lisp_slurp},
|
||||
#endif
|
||||
#ifdef __psse_io_peek_h
|
||||
{U"peek",
|
||||
U"(peek stream): return the next character which may be read from "
|
||||
U"`stream`, without removing it.",
|
||||
&peek},
|
||||
#endif
|
||||
#ifdef __psse_io_print_h
|
||||
{U"print",
|
||||
U"(print object), (print object stream) print this `object` in a format "
|
||||
U"suitable to be read by `read`, q.v.; if `stream` is specified and is a "
|
||||
U"stream open for writing, to that stream.",
|
||||
&print},
|
||||
{U"princ",
|
||||
U"(princ object), (princ object stream) print this `object` in a format "
|
||||
U"more suited to human readers; if `stream` is specified and is a stream "
|
||||
U"open for writing, to that stream.",
|
||||
&print},
|
||||
#endif
|
||||
#ifdef __psse_io_read_h
|
||||
{U"read",
|
||||
U"(read stream) read one complete Lisp expression from `stream`, and "
|
||||
U"return that expression unevaluated.",
|
||||
&read},
|
||||
{U"read-character",
|
||||
U"(read_character stream): read a single character from `stream` and "
|
||||
U"return it.",
|
||||
&read_character},
|
||||
{U"read_number",
|
||||
U"(read-number stream): read a number from `stream` and return it.",
|
||||
&read_number},
|
||||
{U"read_symbol",
|
||||
U"(read-symbol stream): read a symbol from `stream` and return it.",
|
||||
&read_symbol},
|
||||
#endif
|
||||
#ifdef __psse_ops_assoc_h
|
||||
{U"assoc",
|
||||
U"(assoc key store): search `store` for the value associated with "
|
||||
|
|
|
|||
|
|
@ -47,7 +47,7 @@
|
|||
|
||||
#include "ops/assoc.h"
|
||||
#include "ops/bind.h"
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "ops/string_ops.h"
|
||||
#include "ops/truth.h"
|
||||
|
||||
|
|
@ -393,7 +393,8 @@ struct pso_pointer push_back_character( struct pso_pointer c,
|
|||
* @param env my environment.
|
||||
* @return T if the stream was successfully closed, else nil.
|
||||
*/
|
||||
struct pso_pointer lisp_close( struct pso_pointer frame_pointer) {
|
||||
struct pso_pointer lisp_close( struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
struct pso_pointer result = nil;
|
||||
if ( readp( fetch_arg( frame, 0 ) ) || writep( fetch_arg( frame, 0 ) ) ) {
|
||||
|
|
@ -590,10 +591,14 @@ URL_FILE *stream_get_url_file( struct pso_pointer s ) {
|
|||
*
|
||||
* * (open url)
|
||||
*
|
||||
* @param frame my stack frame.
|
||||
* @param frame_pointer a pointer to my stack frame.
|
||||
* @return a stream open on the URL indicated by the first argument.
|
||||
* @param env my environment.
|
||||
* @return a string of one character, namely the next available character
|
||||
* on my stream, if any, else nil.
|
||||
*/
|
||||
struct pso_pointer lisp_open( struct pso_pointer frame_pointer) {
|
||||
struct pso_pointer lisp_open( struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
struct pso_pointer result = nil;
|
||||
if ( stringp( fetch_arg( frame, 0 ) ) ) {
|
||||
|
|
@ -645,13 +650,18 @@ struct pso_pointer lisp_open( struct pso_pointer frame_pointer) {
|
|||
* Function: return a string representing all characters from the stream
|
||||
* indicated by arg 0; further arguments are ignored.
|
||||
*
|
||||
* TODO: it should be possible to optionally pass a string URL to this function,
|
||||
*
|
||||
* * (slurp stream)
|
||||
*
|
||||
* @param frame my stack frame.
|
||||
* @param frame_pointer a pointer to my stack frame.
|
||||
* @return return a string representing all characters from the stream
|
||||
* indicated by arg 0
|
||||
* @param env my environment.
|
||||
* @return a string of one character, namely the next available character
|
||||
* on my stream, if any, else nil.
|
||||
*/
|
||||
struct pso_pointer lisp_slurp( struct pso_pointer frame_pointer) {
|
||||
struct pso_pointer lisp_slurp( struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
struct pso_pointer result = nil;
|
||||
if ( readp( fetch_arg( frame, 0 ) ) ) {
|
||||
|
|
|
|||
|
|
@ -11,8 +11,8 @@
|
|||
#ifndef __psse_io_io_h
|
||||
#define __psse_io_io_h
|
||||
|
||||
#include <curl/curl.h>
|
||||
#include <stdbool.h>
|
||||
#include <curl/curl.h>
|
||||
|
||||
/*
|
||||
* wide characters
|
||||
|
|
@ -24,11 +24,12 @@
|
|||
|
||||
extern CURLSH *io_share;
|
||||
|
||||
int initialise_io();
|
||||
struct pso_pointer initialise_default_streams(struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env);
|
||||
int initialise_io( );
|
||||
struct pso_pointer initialise_default_streams( struct pso_pointer
|
||||
frame_pointer,
|
||||
struct pso_pointer env );
|
||||
|
||||
#define C_IO_IN L"*in*"
|
||||
#define C_IO_IN L"*in*"
|
||||
#define C_IO_OUT L"*out*"
|
||||
#define C_IO_LOG L"*log*"
|
||||
#define C_IO_READBASE L"*read_base*"
|
||||
|
|
@ -49,19 +50,25 @@ extern struct pso_pointer lisp_stderr;
|
|||
|
||||
extern struct pso_pointer lisp_io_prompt;
|
||||
|
||||
URL_FILE *file_to_url_file(FILE *f);
|
||||
wint_t url_fgetwc(URL_FILE *input);
|
||||
wint_t url_ungetwc(wint_t wc, URL_FILE *input);
|
||||
|
||||
struct pso_pointer push_back_character(struct pso_pointer c,
|
||||
struct pso_pointer r);
|
||||
|
||||
struct pso_pointer get_default_stream(bool inputp, struct pso_pointer env);
|
||||
URL_FILE *file_to_url_file( FILE * f );
|
||||
wint_t url_fgetwc( URL_FILE * input );
|
||||
wint_t url_ungetwc( wint_t wc, URL_FILE * input );
|
||||
|
||||
URL_FILE *stream_get_url_file(struct pso_pointer s);
|
||||
|
||||
struct pso_pointer lisp_close(struct pso_pointer frame_pointer);
|
||||
struct pso_pointer lisp_open(struct pso_pointer frame_pointer);
|
||||
struct pso_pointer lisp_slurp(struct pso_pointer frame_pointer);
|
||||
struct pso_pointer push_back_character( struct pso_pointer c,
|
||||
struct pso_pointer r );
|
||||
|
||||
struct pso_pointer get_default_stream( bool inputp, struct pso_pointer env );
|
||||
|
||||
URL_FILE *stream_get_url_file( struct pso_pointer s );
|
||||
|
||||
struct pso_pointer
|
||||
lisp_close( struct pso_pointer frame_pointer, struct pso_pointer env );
|
||||
struct pso_pointer
|
||||
lisp_open( struct pso_pointer frame_pointer, struct pso_pointer env );
|
||||
struct pso_pointer
|
||||
lisp_slurp( struct pso_pointer frame_pointer, struct pso_pointer env );
|
||||
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -1,42 +0,0 @@
|
|||
/**
|
||||
* io/peek.c
|
||||
*
|
||||
* Post Scarcity Software Environment: peek.
|
||||
*
|
||||
* look at the next character on the input stream, without consuming it.
|
||||
*
|
||||
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#include <curl/curl.h>
|
||||
|
||||
#include "io/fopen.h"
|
||||
#include "io/io.h"
|
||||
|
||||
#include "memory/node.h"
|
||||
#include "memory/pointer.h"
|
||||
#include "memory/pso2.h"
|
||||
|
||||
#include "payloads/character.h"
|
||||
|
||||
/**
|
||||
* @brief look at the next character on the input stream, without consuming it.
|
||||
*
|
||||
* (peek stream)
|
||||
*/
|
||||
struct pso_pointer peek(struct pso_pointer frame_pointer) {
|
||||
struct pso_pointer result = nil;
|
||||
struct pso_pointer input =
|
||||
pointer_to_pso4(frame_pointer)->payload.stack_frame.arg[0];
|
||||
|
||||
if (readp(input)) {
|
||||
URL_FILE *stream = pointer_to_object(input)->payload.stream.stream;
|
||||
wint_t c = url_fgetwc(stream);
|
||||
url_ungetwc(c, stream);
|
||||
|
||||
result = make_character(frame_pointer, c);
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
|
|
@ -1,20 +0,0 @@
|
|||
/**
|
||||
* io/peek.c
|
||||
*
|
||||
* Post Scarcity Software Environment: peek.
|
||||
*
|
||||
* peek basic Lisp objects..This is :bootstrap layer peek; it needs to be
|
||||
* able to peek characters, symbols, integers, lists and dotted pairs. I
|
||||
* don't think it needs to be able to peek anything else.
|
||||
*
|
||||
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#ifndef __psse_io_peek_h
|
||||
#define __psse_io_peek_h
|
||||
#include <stdbool.h>
|
||||
|
||||
struct pso_pointer peek( struct pso_pointer frame_pointer );
|
||||
|
||||
#endif
|
||||
|
|
@ -44,7 +44,7 @@
|
|||
#include "payloads/exception.h"
|
||||
#include "payloads/integer.h"
|
||||
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "ops/truth.h"
|
||||
|
||||
struct pso_pointer in_write( struct pso_pointer p, URL_FILE * output,
|
||||
|
|
@ -295,8 +295,6 @@ struct pso_pointer c_write(struct pso_pointer frame_pointer,
|
|||
/**
|
||||
* @brief Simple print for bootstrap layer.
|
||||
*
|
||||
* (print object stream)
|
||||
*
|
||||
* @param p pointer to the object to print.
|
||||
* @param stream if a pointer to an open write stream, print to there.
|
||||
* @return struct pso_pointer `nil`, or an exception if some erroe occurred.
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@
|
|||
|
||||
#include "ops/assoc.h"
|
||||
#include "ops/reverse.h"
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "ops/string_ops.h"
|
||||
#include "ops/truth.h"
|
||||
|
||||
|
|
@ -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 == L','; c = url_fgetwc( input ) ) {
|
||||
if ( iswdigit( c ) ){value = ( value * base ) + ( ( int ) c - ( int ) L'0' );}
|
||||
for ( ; iswdigit( c ); c = url_fgetwc( input ) ) {
|
||||
value = ( value * base ) + ( ( int ) c - ( int ) L'0' );
|
||||
}
|
||||
|
||||
url_ungetwc( c, input );
|
||||
|
|
|
|||
|
|
@ -23,12 +23,11 @@
|
|||
#include "memory/pso2.h"
|
||||
#include "memory/tags.h"
|
||||
|
||||
#include "ops/truth.h"
|
||||
#include "payloads/exception.h"
|
||||
#include "payloads/stack.h"
|
||||
|
||||
#include "ops/bind.h"
|
||||
#include "ops/string_ops.h"
|
||||
#include "ops/truth.h"
|
||||
|
||||
/**
|
||||
* @brief Freelists for each size class.
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@
|
|||
#include "payloads/exception.h"
|
||||
|
||||
#include "ops/eq.h"
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "ops/string_ops.h"
|
||||
#include "ops/truth.h"
|
||||
|
||||
|
|
|
|||
|
|
@ -60,9 +60,6 @@ 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.
|
||||
|
|
@ -74,7 +71,7 @@ struct pso_pointer cheaty_allocate(struct pso_pointer frame_pointer, char *tag,
|
|||
*/
|
||||
struct pso_pointer cheaty_make_cons( struct pso_pointer car,
|
||||
struct pso_pointer cdr ) {
|
||||
struct pso_pointer result = cheaty_allocate( nil, CONSTAG, 2 );
|
||||
struct pso_pointer result = allocate( nil, CONSTAG, 2 );
|
||||
struct pso2 *obj = pointer_to_object( result );
|
||||
|
||||
obj->payload.cons.car = car;
|
||||
|
|
@ -83,46 +80,6 @@ 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`.
|
||||
*
|
||||
|
|
@ -143,14 +100,42 @@ struct pso_pointer cheaty_allocate(struct pso_pointer frame_pointer, char *tag,
|
|||
*/
|
||||
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
|
||||
|
||||
return cheaty_allocate(frame_pointer, tag, size_class);
|
||||
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;
|
||||
}
|
||||
|
||||
|
||||
int payload_size( struct pso2 *object ) {
|
||||
// TODO: Unit tests DEFINITELY needed!
|
||||
int sc = object->header.tag.bytes.size_class;
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@
|
|||
#include "memory/header.h"
|
||||
|
||||
#include "payloads/free.h"
|
||||
#include "payloads/stack_payload.h"
|
||||
#include "payloads/stack.h"
|
||||
|
||||
/**
|
||||
* @brief A paged space object of size class 4, 16 words total, 14 words
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@
|
|||
#include "payloads/stack.h"
|
||||
|
||||
#include "ops/eq.h"
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "ops/truth.h"
|
||||
|
||||
/**
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@
|
|||
#include "memory/pso4.h"
|
||||
#include "memory/tags.h"
|
||||
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
|
||||
#include "payloads/cons.h"
|
||||
#include "payloads/function.h"
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@
|
|||
|
||||
#include "ops/eval_apply.h"
|
||||
#include "ops/progn.h"
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "ops/string_ops.h"
|
||||
#include "ops/truth.h"
|
||||
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@
|
|||
#include "memory/tags.h"
|
||||
#include "io/print.h"
|
||||
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "payloads/lambda.h"
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@
|
|||
#include "payloads/function.h"
|
||||
#include "payloads/integer.h"
|
||||
#include "payloads/stack.h"
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "ops/truth.h"
|
||||
|
||||
/**
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@
|
|||
#include "ops/eval_apply.h"
|
||||
#include "ops/progn.h"
|
||||
#include "ops/reverse.h"
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "ops/string_ops.h"
|
||||
#include "ops/truth.h"
|
||||
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@
|
|||
#include "memory/pso4.h"
|
||||
#include "memory/tags.h"
|
||||
#include "ops/inspect.h"
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
|
||||
/**
|
||||
* Function: dump/
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@
|
|||
#include "memory/pso2.h"
|
||||
#include "memory/pso4.h"
|
||||
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
|
||||
#include "payloads/cons.h"
|
||||
#include "payloads/integer.h"
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@
|
|||
|
||||
#include "ops/eval_apply.h"
|
||||
#include "ops/reverse.h"
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "ops/truth.h"
|
||||
|
||||
#include "payloads/cons.h"
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@
|
|||
#include "memory/tags.h"
|
||||
|
||||
#include "ops/eval_apply.h"
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
|
||||
#include "payloads/cons.h"
|
||||
#include "payloads/stack.h"
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@
|
|||
#include "memory/pointer.h"
|
||||
#include "memory/pso4.h"
|
||||
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
|
||||
/**
|
||||
* @brief Special form: protect an expression from evaluation.
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@
|
|||
|
||||
#include "ops/assoc.h"
|
||||
#include "ops/eval_apply.h"
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "ops/truth.h"
|
||||
|
||||
/**
|
||||
|
|
|
|||
|
|
@ -19,14 +19,13 @@
|
|||
#include "memory/pso4.h"
|
||||
#include "memory/tags.h"
|
||||
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "payloads/cons.h"
|
||||
#include "payloads/exception.h"
|
||||
#include "payloads/psse_string.h"
|
||||
|
||||
#include "ops/string_ops.h"
|
||||
#include "ops/truth.h"
|
||||
#include "payloads/stack.h"
|
||||
|
||||
/**
|
||||
* @brief reverse a sequence
|
||||
|
|
@ -37,7 +36,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( cursor );
|
||||
for ( struct pso_pointer cursor = sequence; !c_nilp( sequence );
|
||||
cursor = c_cdr( cursor ) ) {
|
||||
struct pso2 *object = pointer_to_object( cursor );
|
||||
switch ( get_tag_value( cursor ) ) {
|
||||
|
|
@ -105,8 +104,7 @@ struct pso_pointer c_reverse( struct pso_pointer frame_pointer,
|
|||
struct pso_pointer result = nil;
|
||||
|
||||
if ( stackp( frame_pointer ) ) {
|
||||
result = reverse( make_frame(1, frame_pointer, sequence) );
|
||||
result = reverse( frame_pointer );
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
|
|
|||
80
src/c/ops/stack_ops.c
Normal file
80
src/c/ops/stack_ops.c
Normal file
|
|
@ -0,0 +1,80 @@
|
|||
/**
|
||||
* payloads/stack.c
|
||||
*
|
||||
* The execution stack.
|
||||
*
|
||||
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
||||
* 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;
|
||||
}
|
||||
35
src/c/ops/stack_ops.h
Normal file
35
src/c/ops/stack_ops.h
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
/**
|
||||
* ops/stack_ops.h
|
||||
*
|
||||
* Operations on a Lisp stack frame.
|
||||
*
|
||||
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
||||
* 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
|
||||
|
|
@ -14,7 +14,7 @@
|
|||
#include "memory/node.h"
|
||||
#include "memory/pointer.h"
|
||||
#include "memory/pso4.h"
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
|
||||
/**
|
||||
* @brief true if `p` points to `nil`, else false.
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@
|
|||
#include "payloads/cons.h"
|
||||
#include "payloads/exception.h"
|
||||
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "ops/string_ops.h"
|
||||
|
||||
/**
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@
|
|||
|
||||
#include "payloads/exception.h"
|
||||
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "ops/truth.h"
|
||||
#include "payloads/cons.h"
|
||||
#include <stdlib.h>
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@
|
|||
#include "ops/string_ops.h"
|
||||
#include "payloads/cons.h"
|
||||
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/stack_ops.h"
|
||||
|
||||
|
||||
/**
|
||||
|
|
|
|||
|
|
@ -12,9 +12,6 @@
|
|||
#include <curl/curl.h>
|
||||
|
||||
#include "io/fopen.h"
|
||||
#include "io/io.h"
|
||||
|
||||
#include "memory/node.h"
|
||||
#include "memory/pointer.h"
|
||||
#include "memory/pso.h"
|
||||
#include "memory/pso2.h"
|
||||
|
|
|
|||
|
|
@ -21,73 +21,10 @@
|
|||
#include "memory/tags.h"
|
||||
|
||||
#include "payloads/cons.h"
|
||||
#include "payloads/stack.h"
|
||||
|
||||
#include "ops/reverse.h"
|
||||
#include "ops/list_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;
|
||||
}
|
||||
#include "ops/stack_ops.h"
|
||||
|
||||
/**
|
||||
* @brief Add an argument to this (already initialised) stack frame, updating
|
||||
|
|
@ -123,11 +60,22 @@ struct pso_pointer add_arg( struct pso_pointer frame_pointer, struct pso_pointer
|
|||
}
|
||||
|
||||
/**
|
||||
* @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.
|
||||
* @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 in_make_frame( int arg_count, struct pso_pointer previous,
|
||||
va_list args ) {
|
||||
struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
|
||||
... ) {
|
||||
va_list args;
|
||||
va_start( args, 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! */
|
||||
|
|
@ -146,13 +94,13 @@ struct pso_pointer in_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.previous = inc_ref( previous );
|
||||
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 = nil;
|
||||
}
|
||||
|
||||
new_frame->payload.stack_frame.env = nil;
|
||||
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 );
|
||||
|
|
@ -188,34 +136,6 @@ struct pso_pointer in_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
|
||||
|
|
@ -238,10 +158,60 @@ struct pso_pointer make_frame_with_env( int arg_count,
|
|||
va_list args;
|
||||
va_start( args, env );
|
||||
|
||||
struct pso_pointer new_pointer = in_make_frame( arg_count, previous, args);
|
||||
pointer_to_pso4(new_pointer)->payload.stack_frame.env = inc_ref( 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 );
|
||||
|
||||
va_end(args);
|
||||
#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 );
|
||||
|
||||
return new_pointer;
|
||||
}
|
||||
|
|
@ -288,7 +258,6 @@ 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",
|
||||
|
|
|
|||
|
|
@ -13,7 +13,6 @@
|
|||
#define __psse_payloads_stack_h
|
||||
|
||||
#include "memory/pointer.h"
|
||||
#include "payloads/stack_payload.h"
|
||||
|
||||
/*
|
||||
* number of arguments stored in a stack frame
|
||||
|
|
@ -21,19 +20,26 @@
|
|||
#define args_in_frame 8
|
||||
|
||||
/**
|
||||
* @brief The maximum depth of stack before we throw an exception.
|
||||
*
|
||||
* `0` is interpeted as `unlimited`.
|
||||
* A stack frame.
|
||||
*/
|
||||
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 stack_frame_payload {
|
||||
/** the previous frame. */
|
||||
struct pso_pointer previous;
|
||||
/** first 8 arument bindings. */
|
||||
struct pso_pointer arg[args_in_frame];
|
||||
/** list of any further argument bindings. */
|
||||
struct pso_pointer more;
|
||||
/** the function to be called. */
|
||||
struct pso_pointer function;
|
||||
/** the execute-time environment */
|
||||
struct pso_pointer env;
|
||||
/** a list of objects created in the context of this frame */
|
||||
struct pso_pointer locals;
|
||||
/** the number of arguments provided. */
|
||||
uint32_t args;
|
||||
/** the depth of the stack below this frame */
|
||||
uint32_t depth;
|
||||
};
|
||||
|
||||
struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
|
||||
... );
|
||||
|
|
|
|||
|
|
@ -1,45 +0,0 @@
|
|||
/**
|
||||
* payloads/stack_payload.h
|
||||
*
|
||||
* payload struct itself separated out from functions which interrogate it
|
||||
* to avoid circularity with pso4.
|
||||
*
|
||||
* Sits in a pso4.
|
||||
*
|
||||
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#ifndef __psse_payloads_stack_payload_h
|
||||
#define __psse_payloads_stack_payload_h
|
||||
|
||||
#include "memory/pointer.h"
|
||||
|
||||
/*
|
||||
* number of arguments stored in a stack frame
|
||||
*/
|
||||
#define args_in_frame 8
|
||||
|
||||
/**
|
||||
* A stack frame.
|
||||
*/
|
||||
struct stack_frame_payload {
|
||||
/** the previous frame. */
|
||||
struct pso_pointer previous;
|
||||
/** first 8 arument bindings. */
|
||||
struct pso_pointer arg[args_in_frame];
|
||||
/** list of any further argument bindings. */
|
||||
struct pso_pointer more;
|
||||
/** the function to be called. */
|
||||
struct pso_pointer function;
|
||||
/** the execute-time environment */
|
||||
struct pso_pointer env;
|
||||
/** a list of objects created in the context of this frame */
|
||||
struct pso_pointer locals;
|
||||
/** the number of arguments provided. */
|
||||
uint32_t args;
|
||||
/** the depth of the stack below this frame */
|
||||
uint32_t depth;
|
||||
};
|
||||
|
||||
#endif
|
||||
|
|
@ -27,6 +27,7 @@
|
|||
#include "memory/tags.h"
|
||||
|
||||
#include "ops/repl.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "ops/string_ops.h"
|
||||
#include "ops/truth.h"
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue