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

Fixed assigning arguments to slots in the frame; also fixed a bug in bind...

Browse source 
But did that by switching away from using Lisp calling convention, because
that broke horribly. This is bad news and must be sorted out.
This commit is contained in:
Simon Brooke 2026-04-16 17:13:20 +01:00
parent cb3dcb352e
commit f915a9993f
14 changed files with 158 additions and 112 deletions
Download patch file Download diff file Expand all files Collapse all files

19
src/c/environment/environment.c
View file

@ -43,7 +43,7 @@ struct pso_pointer initialise_environment( uint32_t node ) {
struct pso_pointer result = initialise_memory( node );
if ( truep( result ) ) {
debug_print( L"Initialising `nil`... ", DEBUG_BOOTSTRAP, 0);
debug_print( L"Initialising `nil`... ", DEBUG_BOOTSTRAP, 0 );
struct pso_pointer n = allocate( NILTAG, 2 );
if ( ( n.page == 0 ) && ( n.offset == 0 ) ) {
@ -52,18 +52,18 @@ struct pso_pointer initialise_environment( uint32_t node ) {
object->payload.cons.cdr = nil;
nil = n;
lock_object( nil);
debug_print( L"success\n", DEBUG_BOOTSTRAP, 0);
lock_object( nil );
debug_print( L"success\n", DEBUG_BOOTSTRAP, 0 );
} else {
result =
make_exception( c_string_to_lisp_string
( L"Unexpected cell while allocating `nil`." ),
nil, n );
debug_print( L"fail\n", DEBUG_BOOTSTRAP, 0);
debug_print( L"fail\n", DEBUG_BOOTSTRAP, 0 );
}
}
if ( !exceptionp( result ) ) {
debug_print( L"Initialising `t`... ", DEBUG_BOOTSTRAP, 0);
debug_print( L"Initialising `t`... ", DEBUG_BOOTSTRAP, 0 );
struct pso_pointer n = allocate( TRUETAG, 2 );
// offset is in words, and size of a pso2 is four words
@ -73,14 +73,14 @@ struct pso_pointer initialise_environment( uint32_t node ) {
object->payload.cons.cdr = t;
t = n;
lock_object(t);
debug_print( L"success\n", DEBUG_BOOTSTRAP, 0);
lock_object( t );
debug_print( L"success\n", DEBUG_BOOTSTRAP, 0 );
} else {
result =
make_exception( c_string_to_lisp_string
( L"Unexpected cell while allocating `t`." ),
nil, n );
debug_print( L"fail\n", DEBUG_BOOTSTRAP, 0);
debug_print( L"fail\n", DEBUG_BOOTSTRAP, 0 );
}
}
if ( !exceptionp( result ) ) {
@ -88,7 +88,8 @@ struct pso_pointer initialise_environment( uint32_t node ) {
result = c_bind( c_string_to_lisp_symbol( L"t" ), t, result );
environment_initialised = true;
debug_print( L"\nEnvironment initialised successfully.\n", DEBUG_BOOTSTRAP, 0);
debug_print( L"\nEnvironment initialised successfully.\n",
DEBUG_BOOTSTRAP, 0 );
}
return result;

12
src/c/io/io.c
View file

@ -286,8 +286,8 @@ struct pso_pointer push_back_character( struct pso_pointer c,
if ( characterp( c ) && readp( r ) ) {
if ( url_ungetwc( ( wint_t )
( pointer_to_object( c )->payload.
character.character ),
( pointer_to_object( c )->payload.character.
character ),
pointer_to_object( r )->payload.stream.stream ) >=
0 ) {
result = t;
@ -315,8 +315,8 @@ lisp_close( struct pso_pointer frame_pointer, struct pso_pointer env ) {
if ( readp( fetch_arg( frame, 0 ) ) || writep( fetch_arg( frame, 0 ) ) ) {
if ( url_fclose
( pointer_to_object( fetch_arg( frame, 0 ) )->payload.stream.
stream )
( pointer_to_object( fetch_arg( frame, 0 ) )->payload.
stream.stream )
== 0 ) {
result = t;
}
@ -569,8 +569,8 @@ lisp_read_char( struct pso_pointer frame_pointer, struct pso_pointer env ) {
if ( readp( fetch_arg( frame, 0 ) ) ) {
result =
make_string( url_fgetwc
( pointer_to_object( fetch_arg( frame, 0 ) )->
payload.stream.stream ), nil );
( pointer_to_object( fetch_arg( frame, 0 ) )->payload.
stream.stream ), nil );
}
return result;

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

@ -146,7 +146,7 @@ struct pso_pointer read_symbol( struct pso_pointer frame_pointer,
}
url_ungetwc( c, input );
result = reverse( result );
result = c_reverse( result );
}
return result;
@ -208,7 +208,7 @@ struct pso_pointer read( struct pso_pointer frame_pointer,
break;
default:
struct pso_pointer next =
make_frame( frame_pointer, stream, readtable,
make_frame( 3, frame_pointer, stream, readtable,
make_character( c ) );
inc_ref( next );
if ( iswdigit( c ) ) {

2
src/c/memory/destroy.c
View file

@ -39,7 +39,7 @@
*/
struct pso_pointer destroy( struct pso_pointer p ) {
struct pso_pointer result = nil;
struct pso_pointer f = make_frame( nil, p );
struct pso_pointer f = make_frame( 1, nil, p );
inc_ref( f );
switch ( get_tag_value( p ) ) {

5
src/c/memory/memory.c
View file

@ -49,14 +49,13 @@ struct pso_pointer initialise_memory( uint32_t node ) {
if ( memory_initialised ) {
result =
make_exception( c_string_to_lisp_string
( L"Attenpt to reinitialise memory." ), nil,
nil );
( L"Attenpt to reinitialise memory." ), nil, nil );
} else {
for ( uint8_t i = 0; i <= MAX_SIZE_CLASS; i++ ) {
freelists[i] = nil;
}
#ifdef DEBUG
debug_print(L"Memory initialised", DEBUG_BOOTSTRAP, 0);
debug_print( L"Memory initialised", DEBUG_BOOTSTRAP, 0 );
#endif
memory_initialised = true;
}

88
src/c/memory/page.c
View file

@ -58,7 +58,8 @@ uint32_t npages_allocated = 0;
* This is boilerplate code and there must be some way of doing it better, but I don't
* know it. Macro?
*/
struct pso_pointer initialise_pso2_array(union page *page_addr, uint16_t page_index,
struct pso_pointer initialise_pso2_array( union page *page_addr,
uint16_t page_index,
uint8_t size_class,
struct pso_pointer freelist ) {
struct pso_pointer result = freelist;
@ -70,8 +71,7 @@ struct pso_pointer initialise_pso2_array(union page *page_addr, uint16_t page_in
// freelist when the first page is initiated, so we can grab that one for
// `nil` and the next on for `t`.
for ( int i = objs_in_page - 1; i >= 0; i-- ) {
struct pso2 *object =
( struct pso2 * ) &page_addr->pso2s[i];
struct pso2 *object = ( struct pso2 * ) &page_addr->pso2s[i];
object->header.tag.bytes.size_class = size_class;
strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
TAGLENGTH );
@ -84,12 +84,14 @@ struct pso_pointer initialise_pso2_array(union page *page_addr, uint16_t page_in
return result;
}
/**
* Initialise arrays for objects of different size classes, in this case class 3.
* This is boilerplate code and there must be some way of doing it better, but I don't
* know it. Macro?
*/
struct pso_pointer initialise_pso3_array(union page *page_addr, uint16_t page_index,
struct pso_pointer initialise_pso3_array( union page *page_addr,
uint16_t page_index,
uint8_t size_class,
struct pso_pointer freelist ) {
struct pso_pointer result = freelist;
@ -98,8 +100,7 @@ struct pso_pointer initialise_pso3_array(union page *page_addr, uint16_t page_in
int objs_in_page = PAGE_BYTES / obj_bytes;
for ( int i = objs_in_page - 1; i >= 0; i-- ) {
struct pso3 *object =
( struct pso3 * ) &page_addr->pso3s[i];
struct pso3 *object = ( struct pso3 * ) &page_addr->pso3s[i];
object->header.tag.bytes.size_class = size_class;
strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
TAGLENGTH );
@ -112,12 +113,14 @@ struct pso_pointer initialise_pso3_array(union page *page_addr, uint16_t page_in
return result;
}
/**
* Initialise arrays for objects of different size classes, in this case class 4.
* This is boilerplate code and there must be some way of doing it better, but I don't
* know it. Macro?
*/
struct pso_pointer initialise_pso4_array(union page *page_addr, uint16_t page_index,
struct pso_pointer initialise_pso4_array( union page *page_addr,
uint16_t page_index,
uint8_t size_class,
struct pso_pointer freelist ) {
struct pso_pointer result = freelist;
@ -126,8 +129,7 @@ struct pso_pointer initialise_pso4_array(union page *page_addr, uint16_t page_in
int objs_in_page = PAGE_BYTES / obj_bytes;
for ( int i = objs_in_page - 1; i >= 0; i-- ) {
struct pso4 *object =
( struct pso4 * ) &page_addr->pso4s[i];
struct pso4 *object = ( struct pso4 * ) &page_addr->pso4s[i];
object->header.tag.bytes.size_class = size_class;
strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
TAGLENGTH );
@ -140,12 +142,14 @@ struct pso_pointer initialise_pso4_array(union page *page_addr, uint16_t page_in
return result;
}
/**
* Initialise arrays for objects of different size classes, in this case class 5.
* This is boilerplate code and there must be some way of doing it better, but I don't
* know it. Macro?
*/
struct pso_pointer initialise_pso5_array(union page *page_addr, uint16_t page_index,
struct pso_pointer initialise_pso5_array( union page *page_addr,
uint16_t page_index,
uint8_t size_class,
struct pso_pointer freelist ) {
struct pso_pointer result = freelist;
@ -154,8 +158,7 @@ struct pso_pointer initialise_pso5_array(union page *page_addr, uint16_t page_in
int objs_in_page = PAGE_BYTES / obj_bytes;
for ( int i = objs_in_page - 1; i >= 0; i-- ) {
struct pso5 *object =
( struct pso5 * ) &page_addr->pso5s[i];
struct pso5 *object = ( struct pso5 * ) &page_addr->pso5s[i];
object->header.tag.bytes.size_class = size_class;
strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
TAGLENGTH );
@ -168,12 +171,14 @@ struct pso_pointer initialise_pso5_array(union page *page_addr, uint16_t page_in
return result;
}
/**
* Initialise arrays for objects of different size classes, in this case class 6.
* This is boilerplate code and there must be some way of doing it better, but I don't
* know it. Macro?
*/
struct pso_pointer initialise_pso6_array(union page *page_addr, uint16_t page_index,
struct pso_pointer initialise_pso6_array( union page *page_addr,
uint16_t page_index,
uint8_t size_class,
struct pso_pointer freelist ) {
struct pso_pointer result = freelist;
@ -182,8 +187,7 @@ struct pso_pointer initialise_pso6_array(union page *page_addr, uint16_t page_in
int objs_in_page = PAGE_BYTES / obj_bytes;
for ( int i = objs_in_page - 1; i >= 0; i-- ) {
struct pso6 *object =
( struct pso6 * ) &page_addr->pso6s[i];
struct pso6 *object = ( struct pso6 * ) &page_addr->pso6s[i];
object->header.tag.bytes.size_class = size_class;
strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
TAGLENGTH );
@ -196,12 +200,14 @@ struct pso_pointer initialise_pso6_array(union page *page_addr, uint16_t page_in
return result;
}
/**
* Initialise arrays for objects of different size classes, in this case class 7.
* This is boilerplate code and there must be some way of doing it better, but I don't
* know it. Macro?
*/
struct pso_pointer initialise_pso7_array(union page *page_addr, uint16_t page_index,
struct pso_pointer initialise_pso7_array( union page *page_addr,
uint16_t page_index,
uint8_t size_class,
struct pso_pointer freelist ) {
struct pso_pointer result = freelist;
@ -210,8 +216,7 @@ struct pso_pointer initialise_pso7_array(union page *page_addr, uint16_t page_in
int objs_in_page = PAGE_BYTES / obj_bytes;
for ( int i = objs_in_page - 1; i >= 0; i-- ) {
struct pso7 *object =
( struct pso7 * ) &page_addr->pso7s[i];
struct pso7 *object = ( struct pso7 * ) &page_addr->pso7s[i];
object->header.tag.bytes.size_class = size_class;
strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
TAGLENGTH );
@ -242,22 +247,46 @@ struct pso_pointer initialise_page( union page *page_addr, uint16_t page_index,
int obj_bytes = obj_size * sizeof( uint64_t );
int objs_in_page = PAGE_BYTES / obj_bytes;
debug_printf(DEBUG_ALLOC, 0,
debug_printf( DEBUG_ALLOC, 0,
L"Initialising page %d for objects of size class %d...",
page_index, size_class);
page_index, size_class );
switch (size_class) {
case 2: result=initialise_pso2_array(page_addr, page_index, size_class, freelist); break;
case 3: result=initialise_pso2_array(page_addr, page_index, size_class, freelist); break;
case 4: result=initialise_pso2_array(page_addr, page_index, size_class, freelist); break;
case 5: result=initialise_pso2_array(page_addr, page_index, size_class, freelist); break;
case 6: result=initialise_pso2_array(page_addr, page_index, size_class, freelist); break;
case 7: result=initialise_pso2_array(page_addr, page_index, size_class, freelist); break;
switch ( size_class ) {
case 2:
result =
initialise_pso2_array( page_addr, page_index, size_class,
freelist );
break;
case 3:
result =
initialise_pso2_array( page_addr, page_index, size_class,
freelist );
break;
case 4:
result =
initialise_pso2_array( page_addr, page_index, size_class,
freelist );
break;
case 5:
result =
initialise_pso2_array( page_addr, page_index, size_class,
freelist );
break;
case 6:
result =
initialise_pso2_array( page_addr, page_index, size_class,
freelist );
break;
case 7:
result =
initialise_pso2_array( page_addr, page_index, size_class,
freelist );
break;
default:
result = nil;
}
debug_print( nilp(result)? L"fail.\n" : L"success.\n", DEBUG_ALLOC, 0);
debug_print( nilp( result ) ? L"fail.\n" : L"success.\n", DEBUG_ALLOC, 0 );
return result;
}
@ -299,7 +328,8 @@ struct pso_pointer allocate_page( uint8_t size_class ) {
debug_printf( DEBUG_ALLOC, 0,
L"Initialised page %d; freelist for size class %x updated with head at page %d, offset %d.\n",
npages_allocated, size_class,
freelists[size_class].page, freelists[size_class].offset);
freelists[size_class].page,
freelists[size_class].offset );
npages_allocated++;
} else {

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

@ -43,7 +43,9 @@ struct pso_pointer allocate( char *tag, uint8_t size_class ) {
struct pso_pointer result = t;
#ifdef DEBUG
debug_printf( DEBUG_ALLOC, 0, L"Allocating object of size class %d with tag `%s`... ", size_class, tag);
debug_printf( DEBUG_ALLOC, 0,
L"Allocating object of size class %d with tag `%s`... ",
size_class, tag );
#endif
if ( size_class <= MAX_SIZE_CLASS ) {
@ -51,14 +53,14 @@ struct pso_pointer allocate( char *tag, uint8_t size_class ) {
result = allocate_page( size_class );
}
if (nilp(result)) {
if ( nilp( result ) ) {
fputws( L"FATAL: Page space exhausted\n", stderr );
exit(1); // TODO: we don't want to do this! Somehow, we need to
exit( 1 ); // TODO: we don't want to do this! Somehow, we need to
// recover a workable environment, ideally by throwing a pre-made
// exception.
}
if ( !exceptionp( result ) && !nilp(result)) {
if ( !exceptionp( result ) && !nilp( result ) ) {
result = freelists[size_class];
struct pso2 *object = pointer_to_object( result );
freelists[size_class] = object->payload.free.next;
@ -66,7 +68,8 @@ struct pso_pointer allocate( char *tag, uint8_t size_class ) {
strncpy( ( char * ) ( object->header.tag.bytes.mnemonic ), tag,
TAGLENGTH );
debug_printf( DEBUG_ALLOC, 0, L"at page %d, offset %d... ", result.page, result.offset);
debug_printf( DEBUG_ALLOC, 0, L"at page %d, offset %d... ",
result.page, result.offset );
/* the object ought already to have the right size class in its tag
* because it was popped off the freelist for that size class. */
@ -82,7 +85,8 @@ struct pso_pointer allocate( char *tag, uint8_t size_class ) {
} // TODO: else throw exception
#ifdef DEBUG
debug_print(exceptionp(result)? L"fail\n" : L"success\n", DEBUG_ALLOC, 0);
debug_print( exceptionp( result ) ? L"fail\n" : L"success\n", DEBUG_ALLOC,
0 );
#endif
return result;
@ -137,7 +141,8 @@ struct pso_pointer inc_ref( struct pso_pointer pointer ) {
struct pso_pointer dec_ref( struct pso_pointer pointer ) {
struct pso2 *object = pointer_to_object( pointer );
if ( !nilp(pointer) && object->header.count > 0 && object->header.count != MAXREFERENCE ) {
if ( !nilp( pointer ) && object->header.count > 0
&& object->header.count != MAXREFERENCE ) {
object->header.count--;
#ifdef DEBUG
debug_printf( DEBUG_ALLOC, 0,

12
src/c/ops/bind.c
View file

@ -40,15 +40,5 @@ struct pso_pointer lisp_bind(
struct pso_pointer c_bind( struct pso_pointer key,
struct pso_pointer value,
struct pso_pointer store ) {
struct pso_pointer result = nil;
struct pso_pointer next = make_frame( nil, key, value, store );
inc_ref( next );
result = lisp_bind(
#ifndef MANAGED_POINTER_ONLY
pointer_to_pso4( next ),
#endif
next, nil );
dec_ref( next );
return result;
return c_cons( c_cons( key, value ), store );
}

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

@ -35,7 +35,7 @@
* @return a sequence like the `sequence` passed, but reversed; or `nil` if
* the argument was not a sequence.
*/
struct pso_pointer reverse( struct pso_pointer sequence ) {
struct pso_pointer c_reverse( struct pso_pointer sequence ) {
struct pso_pointer result = nil;
for ( struct pso_pointer cursor = sequence; !nilp( sequence );

2
src/c/ops/reverse.h
View file

@ -16,6 +16,6 @@
#include "memory/pointer.h"
struct pso_pointer reverse( struct pso_pointer sequence );
struct pso_pointer c_reverse( struct pso_pointer sequence );
#endif

4
src/c/ops/string_ops.c
View file

@ -73,7 +73,7 @@ struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail,
char *tag ) {
struct pso_pointer pointer = nil;
if ( check_type( tail, tag ) || nilp(tail) ) {
if ( check_type( tail, tag ) || nilp( tail ) ) {
pointer = allocate( tag, CONS_SIZE_CLASS );
struct pso2 *cell = pointer_to_object( pointer );
@ -85,7 +85,7 @@ struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail,
debug_println( DEBUG_ALLOC );
} else {
// \todo should throw an exception!
struct pso2* tobj = pointer_to_object( tail);
struct pso2 *tobj = pointer_to_object( tail );
debug_printf( DEBUG_ALLOC, 0,
L"Warning: %3.3s cannot be prepended to %3.3s\n",
tag, tobj->header.tag.bytes.mnemonic );

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

@ -11,6 +11,8 @@
#include <stdarg.h>
#include "debug.h"
#include "memory/node.h"
#include "memory/pointer.h"
#include "memory/pso.h"
@ -20,6 +22,8 @@
#include "payloads/cons.h"
#include "ops/reverse.h"
/**
* @brief Construct a stack frame with this `previous` pointer, and arguments
* taken from the remaining arguments to this function, which should all be
@ -27,44 +31,60 @@
*
* @return a pso_pointer to the stack frame.
*/
struct pso_pointer make_frame( struct pso_pointer previous, ... ) {
struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
... ) {
va_list args;
va_start( args, previous );
int count = va_arg( args, int );
struct pso_pointer frame_pointer = allocate( STACKTAG, 4 );
struct pso4 *frame = ( struct pso4 * ) pointer_to_object( frame_pointer );
#ifdef DEBUG
debug_printf( DEBUG_ALLOC, 0,
L"\nAllocating stack frame with %d arguments at page %d, "
L"offset %d...\n",
arg_count, frame_pointer.page, frame_pointer.offset );
#endif
frame->payload.stack_frame.previous = previous;
// I *think* the count starts with the number of args, so there are
// one fewer actual args. Need to test to verify this!
count--;
int cursor = 0;
frame->payload.stack_frame.args = count;
if ( stackp( previous ) ) {
struct pso4 *op = pointer_to_pso4( previous );
frame->payload.stack_frame.depth = op->payload.stack_frame.depth + 1;
} else {
frame->payload.stack_frame.depth = 0;
}
for ( ; cursor < count && cursor < args_in_frame; cursor++ ) {
debug_printf( DEBUG_ALLOC, 1, L"depth is %d...\n",
frame->payload.stack_frame.depth );
int cursor = 0;
frame->payload.stack_frame.args = arg_count;
for ( ; cursor < arg_count && cursor < args_in_frame; cursor++ ) {
struct pso_pointer argument = va_arg( args, struct pso_pointer );
frame->payload.stack_frame.arg[cursor] = inc_ref( argument );
}
if ( cursor < count ) {
if ( cursor < arg_count ) {
struct pso_pointer more_args = nil;
for ( ; cursor < count; cursor++ ) {
for ( ; cursor < arg_count; cursor++ ) {
more_args =
c_cons( va_arg( args, struct pso_pointer ), more_args );
}
// should be frame->payload.stack_frame.more = reverse( more_args), but
// we don't have reverse yet. TODO: fix.
frame->payload.stack_frame.more = more_args;
frame->payload.stack_frame.more = c_reverse( more_args );
} else {
for ( ; cursor < args_in_frame; cursor++ ) {
frame->payload.stack_frame.arg[cursor] = nil;
}
}
debug_printf( DEBUG_ALLOC, 1,
L"Allocation of frame at page %d, offset %d completed.\n",
frame_pointer.page, frame_pointer.offset );
return frame_pointer;
}

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

@ -37,7 +37,8 @@ struct stack_frame_payload {
uint32_t depth;
};
struct pso_pointer make_frame( struct pso_pointer previous, ... );
struct pso_pointer make_frame( int arg_count, struct pso_pointer previous,
... );
struct pso_pointer destroy_stack_frame( struct pso_pointer fp,
struct pso_pointer env );