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

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

View file

@ -88,7 +88,8 @@ struct pso_pointer initialise_environment( uint32_t node ) {
result = c_bind( c_string_to_lisp_symbol( L"t" ), t, result ); result = c_bind( c_string_to_lisp_symbol( L"t" ), t, result );
environment_initialised = true; 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; return result;

View file

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

View file

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

View file

@ -39,7 +39,7 @@
*/ */
struct pso_pointer destroy( struct pso_pointer p ) { struct pso_pointer destroy( struct pso_pointer p ) {
struct pso_pointer result = nil; 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 ); inc_ref( f );
switch ( get_tag_value( p ) ) { switch ( get_tag_value( p ) ) {

View file

@ -49,8 +49,7 @@ struct pso_pointer initialise_memory( uint32_t node ) {
if ( memory_initialised ) { if ( memory_initialised ) {
result = result =
make_exception( c_string_to_lisp_string make_exception( c_string_to_lisp_string
( L"Attenpt to reinitialise memory." ), nil, ( L"Attenpt to reinitialise memory." ), nil, nil );
nil );
} else { } else {
for ( uint8_t i = 0; i <= MAX_SIZE_CLASS; i++ ) { for ( uint8_t i = 0; i <= MAX_SIZE_CLASS; i++ ) {
freelists[i] = nil; freelists[i] = nil;

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

View file

@ -43,7 +43,9 @@ struct pso_pointer allocate( char *tag, uint8_t size_class ) {
struct pso_pointer result = t; struct pso_pointer result = t;
#ifdef DEBUG #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 #endif
if ( size_class <= MAX_SIZE_CLASS ) { if ( size_class <= MAX_SIZE_CLASS ) {
@ -66,7 +68,8 @@ struct pso_pointer allocate( char *tag, uint8_t size_class ) {
strncpy( ( char * ) ( object->header.tag.bytes.mnemonic ), tag, strncpy( ( char * ) ( object->header.tag.bytes.mnemonic ), tag,
TAGLENGTH ); 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 /* the object ought already to have the right size class in its tag
* because it was popped off the freelist for that size class. */ * 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 } // TODO: else throw exception
#ifdef DEBUG #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 #endif
return result; 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 pso_pointer dec_ref( struct pso_pointer pointer ) {
struct pso2 *object = pointer_to_object( 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--; object->header.count--;
#ifdef DEBUG #ifdef DEBUG
debug_printf( DEBUG_ALLOC, 0, debug_printf( DEBUG_ALLOC, 0,

View file

@ -40,15 +40,5 @@ struct pso_pointer lisp_bind(
struct pso_pointer c_bind( struct pso_pointer key, struct pso_pointer c_bind( struct pso_pointer key,
struct pso_pointer value, struct pso_pointer value,
struct pso_pointer store ) { struct pso_pointer store ) {
struct pso_pointer result = nil; return c_cons( c_cons( key, value ), store );
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;
} }

View file

@ -35,7 +35,7 @@
* @return a sequence like the `sequence` passed, but reversed; or `nil` if * @return a sequence like the `sequence` passed, but reversed; or `nil` if
* the argument was not a sequence. * 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; struct pso_pointer result = nil;
for ( struct pso_pointer cursor = sequence; !nilp( sequence ); for ( struct pso_pointer cursor = sequence; !nilp( sequence );

View file

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

View file

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

View file

@ -37,7 +37,8 @@ struct stack_frame_payload {
uint32_t depth; 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 destroy_stack_frame( struct pso_pointer fp,
struct pso_pointer env ); struct pso_pointer env );