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

Tactical commit: things in 'stack_ops' really didn't belong in ops; moving.

Browse source
This commit is contained in:
Simon Brooke 2026-05-05 17:21:16 +01:00
parent d2efc8ba78
commit 4d480798e8
10 changed files with 333 additions and 231 deletions
Download patch file Download diff file Expand all files Collapse all files

15
src/c/environment/environment.c
View file

@ -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;
}

4
src/c/io/read.c
View file

@ -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 );

81
src/c/memory/pso.c
View file

@ -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 ) ) {

6
src/c/ops/reverse.c
View file

@ -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;
}

80
src/c/ops/stack_ops.c
View file

@ -1,80 +0,0 @@
/**
* 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
View file

@ -1,35 +0,0 @@
/**
* 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

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

@ -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",

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

@ -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,
... );