From eed4711fee3d3ef0a924e1fe537b7cc4e92701d1 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 22 Apr 2026 18:16:00 +0100 Subject: [PATCH] Another inconclusive session: still nothing works, still making progress. --- docs/State-of-play.md | 14 ++++ src/c/environment/environment.c | 23 +++--- src/c/io/io.c | 8 +- src/c/memory/node.c | 22 ++++-- src/c/memory/node.h | 6 +- src/c/memory/pso.c | 23 +++--- src/c/memory/pso.h | 2 +- src/c/memory/pso4.c | 5 +- src/c/memory/tags.h | 2 + src/c/ops/assoc.c | 4 +- src/c/ops/eq.c | 6 +- src/c/ops/eval_apply.c | 40 +++++----- src/c/ops/list_ops.c | 9 ++- src/c/ops/list_ops.h | 1 + src/c/ops/repl.c | 6 +- src/c/ops/reverse.c | 20 ++--- src/c/ops/string_ops.c | 18 ++--- src/c/ops/string_ops.h | 14 ++-- src/c/ops/truth.c | 75 +++++++++++------- src/c/ops/truth.h | 17 ++--- src/c/payloads/character.c | 7 +- src/c/payloads/character.h | 2 +- src/c/payloads/cons.c | 131 +++++++++++++++++--------------- src/c/payloads/cons.h | 21 ++++- src/c/payloads/exception.c | 21 +++-- src/c/payloads/exception.h | 5 +- src/c/payloads/integer.c | 2 +- src/c/payloads/integer.h | 2 +- src/c/payloads/psse_string.c | 5 +- src/c/payloads/read_stream.c | 2 +- src/c/payloads/read_stream.h | 2 +- src/c/payloads/stack.c | 19 ++--- src/c/payloads/stack.h | 11 ++- src/c/payloads/write_stream.c | 2 +- src/c/payloads/write_stream.h | 2 +- 35 files changed, 317 insertions(+), 232 deletions(-) diff --git a/docs/State-of-play.md b/docs/State-of-play.md index c79bf17..6796248 100644 --- a/docs/State-of-play.md +++ b/docs/State-of-play.md @@ -1,5 +1,19 @@ # State of Play +## 20260421 + +### To have `c_` functions or not to have `c_` functions? + +Up to now I've had a conscious design pattern of having C functions with names beginning with `c_` which were 'the simplest possible way of solving the problem in C', and C functions with names beginning `lisp_` which were (usually) wrappers around those functions designed to be callable from Lisp. The current current refactoring exercise — and the `0.1.0` design doctrine that I should only code in C things which are absolutely necessary to bootstrap the Lisp compiler — is calling into question the need for many of the `c_` functions. After all, the `lisp_` functions are callable from C, it's just a little more prolix. + +However, there is an overhead to calling a `lisp_` function: you have to generate a new stack frame, and there is a overhead, and consequently a time penalty. It may be in the long term it will be worth reviving `c_` functions for performance optimisation; but I think the priority for `0.1.X` is functionality, not performance. + +### Type checking stack frames + +Passing everything around as `pso_pointers` bypasses even C's rather lax type safety. Of course this doesn't matter for code written in Lisp, because it is the compiler's responsibility to mechanically make sure that **only** stack frames are passed into functions as stack frames. But if something else was passed in as a stack frame, the results probable wouldn't be pretty, and at least while I'm mostly running boostrap functions written in C, there is a risk. + +Type checking the stack frame every time a function is entered is an overhead that will grow big quickly. I'm inclined to not do it in production. But I think it's essential to do it during debugging. proposal [here](). + ## 20260420 Still on side projects, but those side-projects are giving me thinking time; diff --git a/src/c/environment/environment.c b/src/c/environment/environment.c index f80adc9..f15c382 100644 --- a/src/c/environment/environment.c +++ b/src/c/environment/environment.c @@ -41,10 +41,11 @@ bool environment_initialised = false; struct pso_pointer initialise_environment( uint32_t node ) { struct pso_pointer result = initialise_memory( node ); + struct pso_pointer frame = make_frame(0, nil); - if ( truep( result ) ) { + if ( c_truep( result ) ) { debug_print( L"Initialising `nil`... ", DEBUG_BOOTSTRAP, 0 ); - struct pso_pointer n = allocate( NILTAG, 2 ); + struct pso_pointer n = allocate( frame, NILTAG, 2 ); if ( ( n.page == 0 ) && ( n.offset == 0 ) ) { struct pso2 *object = pointer_to_object( n ); @@ -55,16 +56,13 @@ struct pso_pointer initialise_environment( uint32_t node ) { 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, nil, n ); + result = nil; debug_print( L"fail\n", DEBUG_BOOTSTRAP, 0 ); } } - if ( !exceptionp( result ) ) { + if ( !c_nilp( result ) ) { debug_print( L"Initialising `t`... ", DEBUG_BOOTSTRAP, 0 ); - struct pso_pointer n = allocate( TRUETAG, 2 ); + struct pso_pointer n = allocate( frame, TRUETAG, 2 ); // offset is in words, and size of a pso2 is four words if ( ( n.page == 0 ) && ( n.offset == 4 ) ) { @@ -76,19 +74,16 @@ struct pso_pointer initialise_environment( uint32_t node ) { 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, nil, n ); + result = nil; debug_print( L"fail\n", DEBUG_BOOTSTRAP, 0 ); } } if ( !exceptionp( result ) ) { - result = c_bind( c_string_to_lisp_symbol( L"nil" ), nil, nil ); + result = c_bind( c_string_to_lisp_symbol( frame, L"nil" ), nil, nil ); debug_print( L"Environment after binding `nil`: ", DEBUG_BOOTSTRAP, 0 ); debug_print_object( result, DEBUG_BOOTSTRAP, 0 ); - result = c_bind( c_string_to_lisp_symbol( L"t" ), t, result ); + result = c_bind( c_string_to_lisp_symbol( frame, L"t" ), t, result ); environment_initialised = true; debug_print( L"Environment after binding `t`: ", DEBUG_BOOTSTRAP, 0 ); diff --git a/src/c/io/io.c b/src/c/io/io.c index 1b8be37..f63264d 100644 --- a/src/c/io/io.c +++ b/src/c/io/io.c @@ -436,7 +436,7 @@ struct pso_pointer add_meta_string( struct pso_pointer meta, char32_t *key, return make_cons( make_cons - ( c_string_to_lisp_keyword( key ), + ( c_string_to_lisp_keyword( frame_pointer, key ), c_string_to_lisp_string( buffer ) ), meta ); } @@ -681,7 +681,7 @@ struct pso_pointer lisp_read_char( struct pso_pointer frame_pointer, struct pso_pointer stream_pointer = fetch_arg( frame, 0 ); if ( readp( stream_pointer ) ) { result = - make_string( url_fgetwc( stream_get_url_file( stream_pointer ) ), + make_string( frame_pointer, url_fgetwc( stream_get_url_file( stream_pointer ) ), nil ); } @@ -709,7 +709,7 @@ struct pso_pointer lisp_slurp( struct pso_pointer frame_pointer, if ( readp( fetch_arg( frame, 0 ) ) ) { URL_FILE *stream = stream_get_url_file( fetch_arg( frame, 0 ) ); - struct pso_pointer cursor = make_string( url_fgetwc( stream ), nil ); + struct pso_pointer cursor = make_string( frame_pointer, url_fgetwc( stream ), nil ); result = cursor; for ( wint_t c = url_fgetwc( stream ); !url_feof( stream ) && c != 0; @@ -721,7 +721,7 @@ struct pso_pointer lisp_slurp( struct pso_pointer frame_pointer, debug_println( DEBUG_IO ); struct pso2 *cell = pointer_to_object( cursor ); - cursor = make_string( ( char32_t ) c, nil ); + cursor = make_string( frame_pointer, ( char32_t ) c, nil ); cell->payload.string.cdr = cursor; } } diff --git a/src/c/memory/node.c b/src/c/memory/node.c index 42638a7..083536e 100644 --- a/src/c/memory/node.c +++ b/src/c/memory/node.c @@ -38,7 +38,6 @@ bool node_initialised = false; */ uint32_t node_index = 0; - /** * @brief The canonical `nil` pointer * @@ -52,6 +51,16 @@ struct pso_pointer nil = ( struct pso_pointer ) { 0, 0, 0 }; */ struct pso_pointer t = ( struct pso_pointer ) { 0, 0, 4 }; +/** + * @brief whether this node is in debugging mode or not. + */ +struct pso_pointer in_debugging_mode = +#ifdef DEBUG + ( struct pso_pointer ) { 0, 0, 4 }; +#else + ( struct pso_pointer ) { 0, 0, 0 }; +#endif + /** * @brief The root of the data space. */ @@ -62,23 +71,24 @@ struct pso_pointer oblist = ( struct pso_pointer ) { 0, 0, 0 }; * @brief Set up the basic informetion about this node. * * @param index - * @return struct pso_pointer + * @return struct pso_pointer the environment created during initialisation. */ struct pso_pointer initialise_node( uint32_t index ) { node_index = index; struct pso_pointer result = initialise_environment( index ); - if ( !nilp( result ) && !exceptionp( result ) ) { + if ( !c_nilp( result ) && !exceptionp( result ) ) { + node_initialised = true; if ( initialise_io( ) == 0 ) { result = initialise_default_streams( result ); } else { result = - make_exception( c_string_to_lisp_string - ( L"Failed to initialise default streams" ), - nil, nil, nil ); + make_exception( make_frame(1, nil, + c_string_to_lisp_string( nil, L"Failed to initialise default streams" ))); } } return result; } + diff --git a/src/c/memory/node.h b/src/c/memory/node.h index d8559f1..dc8f512 100644 --- a/src/c/memory/node.h +++ b/src/c/memory/node.h @@ -11,6 +11,7 @@ #ifndef __psse_memory_node_h #define __psse_memory_node_h +#include #include /** @@ -19,6 +20,8 @@ */ extern uint32_t node_index; +extern bool node_initialised; + /** * @brief The canonical `nil` pointer * @@ -27,10 +30,11 @@ extern struct pso_pointer nil; /** * @brief the canonical `t` (true) pointer. - * */ extern struct pso_pointer t; +extern struct pso_pointer in_debugging_mode; + extern struct pso_pointer oblist; struct pso_pointer initialise_node( int node_index ); diff --git a/src/c/memory/pso.c b/src/c/memory/pso.c index e856023..e0c4272 100644 --- a/src/c/memory/pso.c +++ b/src/c/memory/pso.c @@ -30,6 +30,7 @@ #include "memory/page.h" #include "memory/pointer.h" #include "memory/pso.h" +#include "memory/pso4.h" #include "memory/tags.h" #include "ops/truth.h" @@ -45,18 +46,14 @@ * for some objects (e.g. those cons cells on the locals list) this isn't * possible due to infinite recursion, but those special cases need to be * audited carefully. - * - * The stack frame pointer is DELIBERATELY a C pointer, not a Lisp pointer, - * because you are definitely not supposed to be calling this function from - * Lisp. Please do not! * - * @param stack_pointer C (NOT Lisp!) pointer to an active stack frame (or - * NULL, but only during initialisation). + * @param frame_pointer pointer to an active stack frame (or + * nil, but only during initialisation). * @param tag The tag. Only the first three bytes will be used; * @param size_class The size class for the object to be allocated; * @return struct pso_pointer a pointer to the newly allocated object */ -struct pso_pointer allocate( struct pso4 *stack_pointer, char *tag, +struct pso_pointer allocate( struct pso_pointer frame_pointer, char *tag, uint8_t size_class ) { // todo: issue #21: must have stack frame passed in. @@ -67,19 +64,19 @@ struct pso_pointer allocate( struct pso4 *stack_pointer, char *tag, #endif struct pso_pointer result = pop_freelist( size_class ); + struct pso4* frame = pointer_to_pso4(frame_pointer); - if ( !nilp( result ) ) { + if ( !c_nilp( result ) ) { strncpy( ( char * ) ( pointer_to_object( result )->header.tag. bytes.mnemonic ), tag, TAGLENGTH ); debug_printf( DEBUG_ALLOC, 0, L"at page %d, offset %d... ", result.page, result.offset ); - if ( stack_pointer != NULL && - ( stack_pointer->header.tag.value & 0xffffff ) == STACKTV ) { + if ( stackp(frame_pointer)) { struct pso_pointer locals = make_cons( result, - stack_pointer->payload. + frame->payload. stack_frame.locals ); - stack_pointer->payload.stack_frame.locals = locals; + frame->payload.stack_frame.locals = locals; } else if ( memory_initialised ) { fputws( L"WARNING: No stack frame passed to `allocate`.\n", @@ -151,7 +148,7 @@ 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 + if ( !c_nilp( pointer ) && object->header.count > 0 && object->header.count != MAXREFERENCE ) { object->header.count--; #ifdef DEBUG diff --git a/src/c/memory/pso.h b/src/c/memory/pso.h index 38a18f6..efb8075 100644 --- a/src/c/memory/pso.h +++ b/src/c/memory/pso.h @@ -16,7 +16,7 @@ #include "memory/pointer.h" #include "memory/pso4.h" -struct pso_pointer allocate( struct pso4 *stack_pointer, char *tag, +struct pso_pointer allocate( struct pso_pointer frame_pointer, char *tag, uint8_t size_class ); struct pso_pointer dec_ref( struct pso_pointer pointer ); diff --git a/src/c/memory/pso4.c b/src/c/memory/pso4.c index cfe6722..d68e1e2 100644 --- a/src/c/memory/pso4.c +++ b/src/c/memory/pso4.c @@ -12,7 +12,4 @@ #include "memory/pso2.h" #include "memory/pso4.h" -struct pso4 *pointer_to_pso4( struct pso_pointer p ) { - struct pso4 *result = - ( struct pso4 * ) pointer_to_object_of_size_class( p, 4 ); -} +struct pso4 *pointer_to_pso4( struct pso_pointer p ); diff --git a/src/c/memory/tags.h b/src/c/memory/tags.h index 5516de1..afea5f5 100644 --- a/src/c/memory/tags.h +++ b/src/c/memory/tags.h @@ -34,6 +34,7 @@ #define NAMESPACETAG "NSP" #define NILTAG "NIL" #define NLAMBDATAG "NLM" +#define PACKSTRTAG "PST" #define RATIOTAG "RAT" #define READTAG "RED" #define REALTAG "REA" @@ -61,6 +62,7 @@ #define NAMESPACETV 5264206 #define NILTV 4999502 #define NLAMBDATV 5065806 +#define PACKSTRTV 5526352 #define RATIOTV 5521746 #define READTV 4474194 #define REALTV 4277586 diff --git a/src/c/ops/assoc.c b/src/c/ops/assoc.c index 625912b..e9bc4cf 100644 --- a/src/c/ops/assoc.c +++ b/src/c/ops/assoc.c @@ -89,7 +89,7 @@ struct pso_pointer c_interned( struct pso_pointer key, * @return `true` if a pointer the key was found in the store.. */ bool c_internedp( struct pso_pointer key, struct pso_pointer store ) { - return !nilp( search( key, store, true ) ); + return !c_nilp( search( key, store, true ) ); } /** @@ -149,5 +149,5 @@ struct pso_pointer internedp( struct pso_pointer store = or( make_frame( 2, frame_pointer, fetch_arg( frame, 1 ), frame->payload.stack_frame.env)); - return c_internedp( key, store ); + return c_internedp( key, store ) ? t : nil; } diff --git a/src/c/ops/eq.c b/src/c/ops/eq.c index 5725ce4..60c5316 100644 --- a/src/c/ops/eq.c +++ b/src/c/ops/eq.c @@ -66,7 +66,7 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) { case KEYTV: case STRINGTV: case SYMBOLTV: - while ( result && !nilp( a ) && !nilp( b ) ) { + while ( result && !c_nilp( a ) && !c_nilp( b ) ) { if ( pointer_to_object( a )->payload.string.character == pointer_to_object( b )->payload.string.character ) { a = c_cdr( a ); @@ -75,7 +75,7 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) { result = false; } } - result = result && nilp( a ) && nilp( b ); + result = result && c_nilp( a ) && c_nilp( b ); break; default: result = false; @@ -109,7 +109,7 @@ struct pso_pointer eq( if ( frame->payload.stack_frame.args > 1 ) { for ( int b = 1; - ( truep( result ) ) && ( b < frame->payload.stack_frame.args ); + ( c_truep( result ) ) && ( b < frame->payload.stack_frame.args ); b++ ) { result = c_eq( fetch_arg( frame, 0 ), fetch_arg( frame, b ) ) ? t : nil; diff --git a/src/c/ops/eval_apply.c b/src/c/ops/eval_apply.c index 3ff6ce8..284a33b 100644 --- a/src/c/ops/eval_apply.c +++ b/src/c/ops/eval_apply.c @@ -57,9 +57,10 @@ struct pso_pointer eval( #ifdef MANAGED_POINTER_ONLY struct pso4 *frame = pointer_to_pso4( frame_pointer ); #endif - struct pso_pointer result = fetch_arg( frame, 0 ); + struct pso_pointer arg = fetch_arg( frame, 0 ); + struct pso_pointer result = nil; - switch ( get_tag_value( result ) ) { + switch ( get_tag_value( arg ) ) { // case CONSTV: // result = eval_cons( frame, frame_pointer, env); // break; @@ -67,9 +68,10 @@ struct pso_pointer eval( case KEYTV: case STRINGTV: // self evaluating + result = nil; break; case SYMBOLTV: - result = c_assoc( result, fetch_env(frame_pointer) ); + arg = c_assoc( arg, fetch_env(frame_pointer) ); break; // case LAMBDATV: // result = eval_lambda( frame, frame_pointer, env); @@ -81,34 +83,34 @@ struct pso_pointer eval( // result = eval_special( frame, frame_pointer, env); // break; default: - result = - make_exception( make_cons - ( frame, c_string_to_lisp_string - ( frame, + arg = + make_exception( + make_frame(1, frame_pointer, + make_cons( frame_pointer, + c_string_to_lisp_string( frame_pointer, L"Can't yet evaluate things of this type: " ), - result ), frame_pointer, make_cons( frame, + arg ), + make_cons( frame_pointer, make_cons - ( frame, + ( frame_pointer, c_string_to_lisp_keyword - ( frame, + ( frame_pointer, L"tag" ), get_tag_string - ( result ) ), + ( arg ) ), nil ), - nil ); + nil )); } - if ( exceptionp( result ) ) { + if ( exceptionp( arg ) ) { struct pso3 *x = - ( struct pso3 * ) pointer_to_object_with_tag_value( result, + ( struct pso3 * ) pointer_to_object_with_tag_value( arg, EXCEPTIONTV ); - if ( nilp( x->payload.exception.stack ) ) { - result = - make_exception( x->payload.exception.message, frame_pointer, - nil, result ); + if ( c_nilp( x->payload.exception.stack ) ) { + } } - return result; + return arg; } diff --git a/src/c/ops/list_ops.c b/src/c/ops/list_ops.c index a4dc20a..e253b44 100644 --- a/src/c/ops/list_ops.c +++ b/src/c/ops/list_ops.c @@ -12,18 +12,21 @@ #include "memory/pso2.h" #include "memory/pso4.h" +#include "ops/stack_ops.h" #include "payloads/stack.h" #include "ops/truth.h" struct pso_pointer length( struct pso_pointer frame_pointer) { - struct pso_pointer list = fetch_arg( frame_pointer, 0); + struct pso4* frame = pointer_to_pso4(frame_pointer); + + struct pso_pointer list = fetch_arg( frame, 0); int count = 0; - for ( struct pso_pointer cursor = list; !nilp( cursor); + for ( struct pso_pointer cursor = list; !c_nilp( cursor); cursor = cdr( make_frame( 1, frame_pointer, list))) { count++; } - return make_integer( pointer_to_pso4(frame_pointer), count); + return make_integer( frame_pointer, count); } diff --git a/src/c/ops/list_ops.h b/src/c/ops/list_ops.h index 502577f..3b1fcb1 100644 --- a/src/c/ops/list_ops.h +++ b/src/c/ops/list_ops.h @@ -18,4 +18,5 @@ #include "payloads/function.h" struct pso_pointer length( struct pso_pointer frame_pointer); + #endif diff --git a/src/c/ops/repl.c b/src/c/ops/repl.c index f470477..151b5b7 100644 --- a/src/c/ops/repl.c +++ b/src/c/ops/repl.c @@ -54,7 +54,7 @@ void c_repl( bool show_prompt ) { // TODO: NULL is not OK here, but will do until we have a REPL in Lisp. struct pso_pointer env = - consp( oblist ) ? oblist : make_cons( NULL, oblist, nil ); + consp( oblist ) ? oblist : make_cons( nil, oblist, nil ); struct pso_pointer input_stream = c_assoc( lisp_io_in, env ); struct pso_pointer output_stream = c_assoc( lisp_io_out, env ); @@ -77,7 +77,7 @@ void c_repl( bool show_prompt ) { /* bottom of stack */ struct pso_pointer frame_pointer = make_frame( 1, nil, input_stream ); - if ( nilp( frame_pointer ) ) + if ( c_nilp( frame_pointer ) ) break; struct pso_pointer input = read( #ifndef MANAGED_POINTER_ONLY @@ -86,7 +86,7 @@ void c_repl( bool show_prompt ) { frame_pointer, env ); frame_pointer = make_frame( 1, frame_pointer, input ); - if ( nilp( frame_pointer ) ) + if ( c_nilp( frame_pointer ) ) break; struct pso_pointer result = eval( diff --git a/src/c/ops/reverse.c b/src/c/ops/reverse.c index 7bf3bc2..65be27a 100644 --- a/src/c/ops/reverse.c +++ b/src/c/ops/reverse.c @@ -35,39 +35,41 @@ * @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 sequence ) { +struct pso_pointer c_reverse( struct pso_pointer frame_pointer, struct pso_pointer sequence ) { // todo: issue #21: must have stack frame passed in. struct pso_pointer result = nil; - for ( struct pso_pointer cursor = sequence; !nilp( sequence ); + 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 ) ) { case CONSTV: - result = make_cons( c_car( cursor ), result ); + result = make_cons( frame_pointer, c_car( cursor ), result ); break; case KEYTV: // TODO: should you be able to reverse keywords and symbols? result = - make_string_like_thing( object->payload.string.character, + make_string_like_thing( frame_pointer, object->payload.string.character, result, KEYTAG ); break; case STRINGTV: result = - make_string_like_thing( object->payload.string.character, + make_string_like_thing( frame_pointer, object->payload.string.character, result, STRINGTAG ); break; case SYMBOLTV: // TODO: should you be able to reverse keywords and symbols? result = - make_string_like_thing( object->payload.string.character, + make_string_like_thing( frame_pointer, object->payload.string.character, result, SYMBOLTAG ); break; default: result = - make_exception( make_cons( c_string_to_lisp_string - ( L"Invalid object in sequence" ), - cursor ), nil, nil, nil ); + make_exception( make_frame( 1, frame_pointer, + make_cons( frame_pointer, + c_string_to_lisp_string + ( frame_pointer, L"Invalid object in sequence" ), + cursor ) )); goto exit; break; } diff --git a/src/c/ops/string_ops.c b/src/c/ops/string_ops.c index bc199d1..7bdc88a 100644 --- a/src/c/ops/string_ops.c +++ b/src/c/ops/string_ops.c @@ -46,7 +46,7 @@ uint32_t calculate_hash( wint_t c, struct pso_pointer ptr ) { case KEYTV: case STRINGTV: case SYMBOLTV: - if ( nilp( cell->payload.string.cdr ) ) { + if ( c_nilp( cell->payload.string.cdr ) ) { result = ( uint32_t ) c; } else { result = @@ -69,12 +69,12 @@ uint32_t calculate_hash( wint_t c, struct pso_pointer ptr ) { * char32_t in larger pso classes, so this function may be only for strings * (and thus simpler). */ -struct pso_pointer make_string_like_thing( struct pso4 *frame_pointer, +struct pso_pointer make_string_like_thing( struct pso_pointer frame_pointer, wint_t c, struct pso_pointer tail, char *tag ) { struct pso_pointer pointer = tail; - if ( check_type( tail, tag ) || nilp( tail ) ) { + if ( check_type( tail, tag ) || c_nilp( tail ) ) { pointer = allocate( frame_pointer, tag, CONS_SIZE_CLASS ); struct pso2 *cell = pointer_to_object( pointer ); @@ -107,7 +107,7 @@ struct pso_pointer make_string_like_thing( struct pso4 *frame_pointer, * @param c the character to add (prepend); * @param tail the string which is being built. */ -struct pso_pointer make_string( struct pso4 *frame_pointer, wint_t c, +struct pso_pointer make_string( struct pso_pointer frame_pointer, wint_t c, struct pso_pointer tail ) { return make_string_like_thing( frame_pointer, c, tail, STRINGTAG ); } @@ -120,7 +120,7 @@ struct pso_pointer make_string( struct pso4 *frame_pointer, wint_t c, * @param c the character to add (prepend); * @param tail the keyword which is being built. */ -struct pso_pointer make_keyword( struct pso4 *frame_pointer, wint_t c, +struct pso_pointer make_keyword( struct pso_pointer frame_pointer, wint_t c, struct pso_pointer tail ) { return make_string_like_thing( frame_pointer, c, tail, KEYTAG ); } @@ -133,7 +133,7 @@ struct pso_pointer make_keyword( struct pso4 *frame_pointer, wint_t c, * @param c the character to add (prepend); * @param tail the symbol which is being built. */ -struct pso_pointer make_symbol( struct pso4 *frame_pointer, wint_t c, +struct pso_pointer make_symbol( struct pso_pointer frame_pointer, wint_t c, struct pso_pointer tail ) { return make_string_like_thing( frame_pointer, c, tail, SYMBOLTAG ); } @@ -142,7 +142,7 @@ struct pso_pointer make_symbol( struct pso4 *frame_pointer, wint_t c, /** * Return a lisp string representation of this wide character string. */ -struct pso_pointer c_string_to_lisp_string( struct pso4 *frame_pointer, +struct pso_pointer c_string_to_lisp_string( struct pso_pointer frame_pointer, char32_t *string ) { struct pso_pointer result = nil; @@ -164,7 +164,7 @@ struct pso_pointer c_string_to_lisp_string( struct pso4 *frame_pointer, * Return a lisp symbol representation of this wide character string. In * symbols, I am accepting only lower case characters. */ -struct pso_pointer c_string_to_lisp_symbol( struct pso4 *frame_pointer, +struct pso_pointer c_string_to_lisp_symbol( struct pso_pointer frame_pointer, char32_t *symbol ) { struct pso_pointer result = nil; @@ -183,7 +183,7 @@ struct pso_pointer c_string_to_lisp_symbol( struct pso4 *frame_pointer, * Return a lisp keyword representation of this wide character string. In * keywords, I am accepting only lower case characters and numbers. */ -struct pso_pointer c_string_to_lisp_keyword( struct pso4 *frame_pointer, +struct pso_pointer c_string_to_lisp_keyword( struct pso_pointer frame_pointer, char32_t *symbol ) { struct pso_pointer result = nil; diff --git a/src/c/ops/string_ops.h b/src/c/ops/string_ops.h index aeaf243..781901f 100644 --- a/src/c/ops/string_ops.h +++ b/src/c/ops/string_ops.h @@ -17,26 +17,26 @@ #include #include -struct pso_pointer make_string_like_thing( struct pso4 *frame_pointer, +struct pso_pointer make_string_like_thing( struct pso_pointer frame_pointer, wint_t c, struct pso_pointer tail, char *tag ); -struct pso_pointer make_string( struct pso4 *frame_pointer, wint_t c, +struct pso_pointer make_string( struct pso_pointer frame_pointer, wint_t c, struct pso_pointer tail ); -struct pso_pointer make_keyword( struct pso4 *frame_pointer, wint_t c, +struct pso_pointer make_keyword( struct pso_pointer frame_pointer, wint_t c, struct pso_pointer tail ); -struct pso_pointer make_symbol( struct pso4 *frame_pointer, wint_t c, +struct pso_pointer make_symbol( struct pso_pointer frame_pointer, wint_t c, struct pso_pointer tail ); -struct pso_pointer c_string_to_lisp_string( struct pso4 *frame_pointer, +struct pso_pointer c_string_to_lisp_string( struct pso_pointer frame_pointer, char32_t * string ); -struct pso_pointer c_string_to_lisp_keyword( struct pso4 *frame_pointer, +struct pso_pointer c_string_to_lisp_keyword( struct pso_pointer frame_pointer, char32_t * symbol ); -struct pso_pointer c_string_to_lisp_symbol( struct pso4 *frame_pointer, +struct pso_pointer c_string_to_lisp_symbol( struct pso_pointer frame_pointer, char32_t * symbol ); #endif diff --git a/src/c/ops/truth.c b/src/c/ops/truth.c index 7b0eb76..d9790e0 100644 --- a/src/c/ops/truth.c +++ b/src/c/ops/truth.c @@ -27,21 +27,10 @@ * @return true if `p` points to `nil`. * @return false otherwise. */ -bool nilp( struct pso_pointer p ) { +bool c_nilp(struct pso_pointer p) { return ( p.page == 0 && p.offset == 0 ); } -/** - * @brief Return `true` if `p` points to `nil`, else `false`. - * - * @param p a pointer - * @return true if `p` points to `nil`; - * @return false otherwise. - */ -bool not( struct pso_pointer p ) { - return !nilp( p ); -} - /** * @brief `true` if `p` points to `t`, else `false`. * @@ -56,52 +45,82 @@ bool not( struct pso_pointer p ) { * @return true if `p` points to `t`. * @return false otherwise. */ -bool truep( struct pso_pointer p ) { +bool c_truep( struct pso_pointer p ) { return ( p.page == 0 && p.offset == 4 ); } /** * @brief return `t` if the first argument in this frame is `nil`, else `t`. * - * @param frame The current stack frame; * @param frame_pointer A pointer to the current stack frame; - * @param env the evaluation environment. * @return `t` if the first argument in this frame is `nil`, else `t` */ -struct pso_pointer lisp_nilp( struct pso_pointer frame_pointer, - struct pso_pointer env ) { +struct pso_pointer nilp( struct pso_pointer frame_pointer ) { struct pso4 *frame = pointer_to_pso4( frame_pointer ); - return ( nilp( fetch_arg( frame, 0 ) ) ? t : nil ); + return ( c_nilp( fetch_arg( frame, 0 ) ) ? t : nil ); } /** * @brief return `t` if the first argument in this frame is `t`, else `nil`. * - * @param frame The current stack frame; * @param frame_pointer A pointer to the current stack frame; - * @param env the evaluation environment. * @return `t` if the first argument in this frame is `t`, else `nil`. */ -struct pso_pointer lisp_truep( struct pso_pointer frame_pointer, - struct pso_pointer env ) { +struct pso_pointer truep( struct pso_pointer frame_pointer ) { struct pso4 *frame = pointer_to_pso4( frame_pointer ); - return ( truep( fetch_arg( frame, 0 ) ) ? t : nil ); + return ( c_truep( fetch_arg( frame, 0 ) ) ? t : nil ); } /** * @brief return `t` if the first argument in this frame is not `nil`, else * `t`. * - * @param frame The current stack frame; * @param frame_pointer A pointer to the current stack frame; - * @param env the evaluation environment. * @return `t` if the first argument in this frame is not `nil`, else `t`. */ -struct pso_pointer lisp_not( struct pso_pointer frame_pointer, - struct pso_pointer env ) { +struct pso_pointer not( struct pso_pointer frame_pointer) { struct pso4 *frame = pointer_to_pso4( frame_pointer ); - return ( not( fetch_arg( frame, 0 ) ) ? t : nil ); + return ( !c_nilp( fetch_arg( frame, 0 ) ) ? t : nil ); +} + +/** + * @brief (and args...) + * + * @return `nil` if any `arg` is `nil`, else `t`. + */ +struct pso_pointer and( struct pso_pointer frame_pointer) { + struct pso4* frame = pointer_to_pso4( frame_pointer); + struct pso_pointer result = t; + + for (int arg = 0; c_truep(result) && arg < frame->payload.stack_frame.args; arg++) { + if (c_nilp(fetch_arg(frame, arg))) { + result = nil; + break; + } + } + + return result; +} + + +/** + * @brief (or args...) + * + * @return `t` if any `arg` is non-nil, else `nil`. + */ +struct pso_pointer or( struct pso_pointer frame_pointer) { + struct pso4* frame = pointer_to_pso4( frame_pointer); + struct pso_pointer result = nil; + + for (int arg = 0; c_truep(result) && arg < frame->payload.stack_frame.args; arg++) { + if (!c_nilp(fetch_arg(frame, arg))) { + result = t; + break; + } + } + + return result; } diff --git a/src/c/ops/truth.h b/src/c/ops/truth.h index 0fa0574..38de633 100644 --- a/src/c/ops/truth.h +++ b/src/c/ops/truth.h @@ -14,21 +14,18 @@ #include #include "memory/pointer.h" -#include "memory/pso4.h" -bool nilp( struct pso_pointer p ); +struct pso_pointer nilp( struct pso_pointer frame_pointer ); -struct pso_pointer lisp_nilp( struct pso_pointer frame_pointer, - struct pso_pointer env ); +struct pso_pointer not( struct pso_pointer frame_pointer ); -bool not( struct pso_pointer p ); +struct pso_pointer truep( struct pso_pointer frame_pointer ); -struct pso_pointer lisp_not( struct pso_pointer frame_pointer, - struct pso_pointer env ); +struct pso_pointer and( struct pso_pointer frame_pointer ); -bool truep( struct pso_pointer p ); +struct pso_pointer or( struct pso_pointer frame_pointer ); -struct pso_pointer lisp_truep( struct pso_pointer frame_pointer, - struct pso_pointer env ); +bool c_nilp(struct pso_pointer p); +bool c_truep(struct pso_pointer p); #endif diff --git a/src/c/payloads/character.c b/src/c/payloads/character.c index 962724c..88d5b0d 100644 --- a/src/c/payloads/character.c +++ b/src/c/payloads/character.c @@ -11,7 +11,6 @@ * wide characters */ #include -#include #include #include "memory/node.h" @@ -22,12 +21,12 @@ #include "ops/truth.h" -#include "payloads/character.h" +// #include "payloads/character.h" -struct pso_pointer make_character( struct pso4 *frame_pointer, wint_t c ) { +struct pso_pointer make_character( struct pso_pointer frame_pointer, wint_t c ) { struct pso_pointer result = allocate( frame_pointer, CHARACTERTAG, 2 ); - if ( !nilp( result ) ) { + if ( !c_nilp( result ) ) { pointer_to_object( result )->payload.character.character = ( char32_t ) c; } diff --git a/src/c/payloads/character.h b/src/c/payloads/character.h index a901642..2862bfe 100644 --- a/src/c/payloads/character.h +++ b/src/c/payloads/character.h @@ -38,5 +38,5 @@ struct character_payload { char32_t character; }; -struct pso_pointer make_character( struct pso4 *frame_pointer, wint_t c ); +struct pso_pointer make_character( struct pso_pointer frame_pointer, wint_t c ); #endif diff --git a/src/c/payloads/cons.c b/src/c/payloads/cons.c index 6963fbb..39b10a4 100644 --- a/src/c/payloads/cons.c +++ b/src/c/payloads/cons.c @@ -25,93 +25,97 @@ /** * @brief allocate a cons cell with this car and this cdr, and return a pointer * to it. - * + * * (cons object object) * * @param frame_pointer a pointer to a stack frame. * @return struct pso_pointer a pointer to the newly allocated cons cell. */ -struct pso_pointer cons( struct pso_pointer frame_pointer ) { - struct pso4 *frame = pointer_to_pso4( frame_pointer ); - struct pso_pointer result = allocate( frame, CONSTAG, 2 ); +struct pso_pointer cons(struct pso_pointer frame_pointer) { + struct pso4 *frame = pointer_to_pso4(frame_pointer); + struct pso_pointer result = allocate(frame_pointer, CONSTAG, 2); - if ( stackp( frame ) ) { - struct pso2 *object = pointer_to_object( result ); - object->payload.cons.car = - inc_ref( frame->payload.stack_frame.args[0] ); - object->payload.cons.cdr = - inc_ref( frame->payload.stack_frame.args[0] ); - } + struct pso2 *object = pointer_to_object(result); + object->payload.cons.car = inc_ref(fetch_arg(frame, 0)); + object->payload.cons.cdr = inc_ref(fetch_arg(frame, 1)); - return result; + return result; } +struct pso_pointer make_cons(struct pso_pointer frame_pointer, struct pso_pointer car, struct pso_pointer cdr){ + return cons( make_frame(2, frame_pointer, car, cdr)); +} /** * @brief return the car of this cons cell. - * + * * (car cell) * * @param frame_pointer a pointer to a stack frame. * @return the car of the indicated cell. * @exception if the pointer does not indicate a cons cell. */ -struct pso_pointer car( struct pso_pointer frame_pointer ) { - struct pso_pointer result = nil; - struct pso_pointer cons = fetch_arg( pointer_to_pso4( frame_pointer), 0); - struct pso2 *object = pointer_to_object( cons ); +struct pso_pointer car(struct pso_pointer frame_pointer) { + struct pso_pointer result = nil; + struct pso4 *frame = pointer_to_pso4(frame_pointer); + struct pso_pointer cons = fetch_arg(frame, 0); + struct pso2 *object = pointer_to_object(cons); - if ( consp( cons ) ) { - result = object->payload.cons.car; - } else { - result = - make_exception( make_frame( 2, frame_pointer, - c_string_to_lisp_string( frame_pointer, L"Invalid type for car" ), - make_cons( - make_cons( frame_pointer, - c_string_to_lisp_keyword( frame_pointer, L"type" ), - get_tag_string( cons )), nil))); + if (consp(cons)) { + result = object->payload.cons.car; + } else { + result = make_exception(make_frame( + 2, frame_pointer, + c_string_to_lisp_string(frame_pointer, L"Invalid type for car"), + make_cons(frame_pointer, make_cons( + frame_pointer, + c_string_to_lisp_keyword(frame_pointer, L"type"), + get_tag_string(cons)), + nil))); } - return result; + return result; } /** * @brief return the cdr of this cons (or other sequence) cell. - * + * * (cdr cell) * * @param frame_pointer a pointer to a stack frame. * @return the cdr of the indicated cell. * @exception if the pointer does not indicate a cons cell. */ -struct pso_pointer cdr( struct pso_pointer frame_pointer ) { - struct pso_pointer result = nil; - struct pso4 *sp = pointer_to_pso4(frame_pointer); - struct pso_pointer cons = fetch_arg(sp, 0); - struct pso2 *object = pointer_to_object( cons ); +struct pso_pointer cdr(struct pso_pointer frame_pointer) { + struct pso_pointer result = nil; + struct pso4 *frame = pointer_to_pso4(frame_pointer); + struct pso_pointer cons = fetch_arg(frame, 0); + struct pso2 *object = pointer_to_object(cons); - switch ( get_tag_value( p ) ) { - case CONSTV: - result = object->payload.cons.cdr; - break; - case KEYTV: - case STRINGTV: - case SYMBOLTV: - result = object->payload.string.cdr; - break; - default: - result = - make_exception( make_frame( 2, frame_pointer, - c_string_to_lisp_string( frame_pointer, L"Invalid type for cdr" ), - make_cons( - make_cons( frame_pointer, - c_string_to_lisp_keyword( frame_pointer, L"type" ), - get_tag_string( cons )), nil))); - break; - } + switch (get_tag_value(cons)) { + case CONSTV: + result = object->payload.cons.cdr; + break; + case KEYTV: + case STRINGTV: + case SYMBOLTV: + result = object->payload.string.cdr; + break; + default: + struct pso_pointer type_binding = + make_cons(frame_pointer, + c_string_to_lisp_keyword(frame_pointer, L"type"), + get_tag_string(cons)); + result = make_exception(make_frame( + 2, frame_pointer, + c_string_to_lisp_string(frame_pointer, L"Invalid type for cdr"), + make_cons(frame_pointer, + type_binding, + nil))); + break; + } - return result; + return result; } /** @@ -121,12 +125,15 @@ struct pso_pointer cdr( struct pso_pointer frame_pointer ) { * Lisp calling conventions; one expected arg, the pointer to the cell to * be destroyed. */ -struct pso_pointer destroy_cons( struct pso_pointer fp, - struct pso_pointer env ) { - if ( stackp( fp ) ) { - struct pso4 *frame = pointer_to_pso4( fp ); - struct pso_pointer p = frame->payload.stack_frame.arg[0]; - dec_ref( c_car( p ) ); - dec_ref( c_cdr( frame, p ) ); - } +struct pso_pointer destroy_cons(struct pso_pointer fp) { + if (stackp(fp)) { + struct pso4 *frame = pointer_to_pso4(fp); + struct pso_pointer p = frame->payload.stack_frame.arg[0]; + + if (check_tag(p, CONSTV)) { + struct pso2 *cons = pointer_to_object(p); + dec_ref(cons->payload.cons.car); + dec_ref(cons->payload.cons.cdr); + } + } } diff --git a/src/c/payloads/cons.h b/src/c/payloads/cons.h index 62fd5ff..540034c 100644 --- a/src/c/payloads/cons.h +++ b/src/c/payloads/cons.h @@ -33,7 +33,24 @@ struct pso_pointer cdr( struct pso_pointer frame_pointer ); struct pso_pointer cons( struct pso_pointer frame_pointer ); -struct pso_pointer destroy_cons( struct pso_pointer fp, - struct pso_pointer env ); +struct pso_pointer destroy_cons( struct pso_pointer frame_pointer); + +struct pso_pointer make_cons(struct pso_pointer frame_pointer, + struct pso_pointer car, + struct pso_pointer cdr); + +/** + * macro short-cuts for make_cons. + */ +// #define make_cons(frame_pointer,car,cdr) (cons(make_frame(2, frame_pointer, car, cdr))) + +/** + * Variant which assumes a convention that the frame pointer will always be + * called `frame_pointer` + */ +#define make_cons2(car,cdr) (cons(make_frame(2, frame_pointer, car, cdr))) + +#define c_car(p)(consp(p) ? pointer_to_object(p)->payload.cons.car : nil) +#define c_cdr(p)(consp(p) ? pointer_to_object(p)->payload.cons.cdr : nil) #endif diff --git a/src/c/payloads/exception.c b/src/c/payloads/exception.c index bf7a225..e184354 100644 --- a/src/c/payloads/exception.c +++ b/src/c/payloads/exception.c @@ -6,6 +6,13 @@ * (c) 2026 Simon Brooke * Licensed under GPL version 2.0, or, at your option, any later version. */ +#include + +/* + * wide characters + */ +#include +#include #include "memory/node.h" @@ -17,7 +24,12 @@ #include "payloads/exception.h" +#include "ops/stack_ops.h" #include "ops/truth.h" +#include +#include +#include +#include /** * @brief allocate an exception object, and, if successful, return a pointer @@ -31,8 +43,7 @@ * otherwise it will return a pointer to a new exception. * * @param message expected to be a string, but anything printable is accepted. - * @param frame the stack frame in which the exception was `thrown`, if any. - * @param meta metadata for this exception. Must be an assoc list, hashtable, +b * @param meta metadata for this exception. Must be an assoc list, hashtable, * or `nil` * @param cause the exception that caused this exception to be `thrown`. */ @@ -44,13 +55,13 @@ struct pso_pointer make_exception( struct pso_pointer frame_pointer) { struct pso_pointer cause = fetch_arg( frame, 2); struct pso_pointer result = - allocate( pointer_to_pso4( frame ), EXCEPTIONTAG, 3 ); + allocate( frame_pointer, EXCEPTIONTAG, 3 ); - if ( !nilp( result ) && !exceptionp( result ) ) { + if ( !c_nilp( result ) && !exceptionp( result ) ) { struct pso3 *object = ( struct pso3 * ) pointer_to_object( result ); object->payload.exception.message = message; - object->payload.exception.stack = stackp( frame ) ? frame : nil; + object->payload.exception.stack = stackp( frame_pointer ) ? frame_pointer : nil; object->payload.exception.meta = ( consp( meta ) || hashtabp( meta ) ) ? meta : nil; object->payload.exception.cause = exceptionp( cause ) ? cause : nil; diff --git a/src/c/payloads/exception.h b/src/c/payloads/exception.h index 110252d..27e7e08 100644 --- a/src/c/payloads/exception.h +++ b/src/c/payloads/exception.h @@ -26,10 +26,7 @@ struct exception_payload { struct pso_pointer cause; }; -struct pso_pointer make_exception( struct pso_pointer message, - struct pso_pointer frame_pointer, - struct pso_pointer meta, - struct pso_pointer cause ); +struct pso_pointer make_exception( struct pso_pointer frame_pointer ); struct pso_pointer destroy_exception( struct pso_pointer fp, struct pso_pointer env ); diff --git a/src/c/payloads/integer.c b/src/c/payloads/integer.c index 0c0e861..032005d 100644 --- a/src/c/payloads/integer.c +++ b/src/c/payloads/integer.c @@ -25,7 +25,7 @@ * @param more `nil`, or a pointer to the more significant cell(s) of this number. * *NOTE* that if `more` is not `nil`, `value` *must not* exceed `MAX_INTEGER`. */ -struct pso_pointer make_integer( struct pso4 *frame_pointer, int64_t value ) { +struct pso_pointer make_integer( struct pso_pointer frame_pointer, int64_t value ) { struct pso_pointer result = nil; debug_print( L"Entering make_integer\n", DEBUG_ALLOC, 0 ); diff --git a/src/c/payloads/integer.h b/src/c/payloads/integer.h index 9205ebc..b537388 100644 --- a/src/c/payloads/integer.h +++ b/src/c/payloads/integer.h @@ -25,6 +25,6 @@ struct integer_payload { __int128_t value; }; -struct pso_pointer make_integer( struct pso4 *frame_pointer, int64_t value ); +struct pso_pointer make_integer( struct pso_pointer frame_pointer, int64_t value ); #endif diff --git a/src/c/payloads/psse_string.c b/src/c/payloads/psse_string.c index ad23d19..f1a1fb8 100644 --- a/src/c/payloads/psse_string.c +++ b/src/c/payloads/psse_string.c @@ -16,6 +16,7 @@ #include "memory/node.h" #include "memory/pointer.h" #include "memory/pso.h" +#include "memory/pso2.h" #include "memory/pso4.h" #include "memory/tags.h" @@ -34,8 +35,8 @@ struct pso_pointer destroy_string( struct pso_pointer fp, struct pso4 *frame = pointer_to_pso4( fp ); struct pso_pointer p = frame->payload.stack_frame.arg[0]; - dec_ref( c_cdr( frame, p ) ); - } + dec_ref( c_cdr( p ) ); + } return nil; } diff --git a/src/c/payloads/read_stream.c b/src/c/payloads/read_stream.c index 1286335..9cdce09 100644 --- a/src/c/payloads/read_stream.c +++ b/src/c/payloads/read_stream.c @@ -25,7 +25,7 @@ * @param metadata a pointer to an associaton containing metadata on the stream. * @return a pointer to the new read stream. */ -struct pso_pointer make_read_stream( struct pso4 *frame_pointer, +struct pso_pointer make_read_stream( struct pso_pointer frame_pointer, URL_FILE *input, struct pso_pointer metadata ) { struct pso_pointer pointer = allocate( frame_pointer, READTAG, 2 ); diff --git a/src/c/payloads/read_stream.h b/src/c/payloads/read_stream.h index 23a04a7..c8dc33f 100644 --- a/src/c/payloads/read_stream.h +++ b/src/c/payloads/read_stream.h @@ -29,7 +29,7 @@ struct stream_payload { struct pso_pointer meta; }; -struct pso_pointer make_read_stream( struct pso4 *frame_pointer, +struct pso_pointer make_read_stream( struct pso_pointer frame_pointer, URL_FILE * input, struct pso_pointer metadata ); diff --git a/src/c/payloads/stack.c b/src/c/payloads/stack.c index 916c5c6..86c68b1 100644 --- a/src/c/payloads/stack.c +++ b/src/c/payloads/stack.c @@ -1,5 +1,5 @@ /** - * payloads/stack.h + * payloads/stack.c * * a Lisp stack frame. * @@ -23,6 +23,7 @@ #include "payloads/cons.h" #include "ops/reverse.h" +#include "ops/list_ops.h" /** * @brief Construct a stack frame with this `previous` pointer, and arguments @@ -43,7 +44,7 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer previous, struct pso4 *prev_frame = pointer_to_pso4( previous ); struct pso_pointer new_pointer = - allocate( pointer_to_pso4( previous ), STACKTAG, 4 ); + allocate( previous, STACKTAG, 4 ); struct pso4* new_frame = pointer_to_pso4(new_pointer); #ifdef DEBUG @@ -78,7 +79,7 @@ struct pso_pointer make_frame( int arg_count, struct pso_pointer previous, for ( ; cursor < arg_count; cursor++ ) { more_args = - make_cons( prev_frame, va_arg( args, struct pso_pointer ), + make_cons( previous, va_arg( args, struct pso_pointer ), more_args ); } @@ -117,7 +118,7 @@ struct pso_pointer make_frame_with_env( int arg_count, struct pso4 *prev_frame = pointer_to_pso4( previous ); struct pso_pointer new_pointer = - allocate( pointer_to_pso4( previous ), STACKTAG, 4 ); + allocate( previous, STACKTAG, 4 ); struct pso4* new_frame = pointer_to_pso4(new_pointer); #ifdef DEBUG @@ -152,7 +153,7 @@ struct pso_pointer make_frame_with_env( int arg_count, for ( ; cursor < arg_count; cursor++ ) { more_args = - make_cons( prev_frame, va_arg( args, struct pso_pointer ), + make_cons( previous, va_arg( args, struct pso_pointer ), more_args ); } @@ -184,10 +185,10 @@ struct pso_pointer make_frame_with_arglist_and_env( struct pso_pointer previous, struct pso_pointer env) { struct pso4 *prev_frame = pointer_to_pso4( previous ); struct pso_pointer new_pointer = - allocate( pointer_to_pso4( previous ), STACKTAG, 4 ); + allocate( previous, STACKTAG, 4 ); struct pso4* new_frame = pointer_to_pso4(new_pointer); - int arg_count = c_length(argvalues); - + struct pso_pointer arg_length = length(make_frame(1, previous, argvalues)); + int arg_count = integerp(arg_length) ? pointer_to_object(arg_length)->payload.integer.value : 0; #ifdef DEBUG debug_printf( DEBUG_ALLOC, 0, L"\nAllocating stack frame with %d arguments at page %d, " @@ -216,7 +217,7 @@ struct pso_pointer make_frame_with_arglist_and_env( struct pso_pointer previous, argvalues = cdr( make_frame( 1, previous, argvalues)); } if ( cursor < arg_count ) { - new_frame->payload.stack_frame.more = inc_ref( cursor); + new_frame->payload.stack_frame.more = inc_ref( argvalues); } else { for ( ; cursor < args_in_frame; cursor++ ) { new_frame->payload.stack_frame.arg[cursor] = nil; diff --git a/src/c/payloads/stack.h b/src/c/payloads/stack.h index dd2e8ae..a9e1a0d 100644 --- a/src/c/payloads/stack.h +++ b/src/c/payloads/stack.h @@ -43,9 +43,18 @@ struct stack_frame_payload { struct pso_pointer make_frame( int arg_count, struct pso_pointer previous, ... ); + struct pso_pointer make_frame_with_env( int arg_count, struct pso_pointer previous, - struct pso_pointer env, ... ) + struct pso_pointer env, ... ); + +struct pso_pointer make_frame_with_arglist_and_env( struct pso_pointer previous, + struct pso_pointer argvalues, + struct pso_pointer env); + +struct pso_pointer make_frame_with_arglist( struct pso_pointer previous, + struct pso_pointer argvalues); + struct pso_pointer destroy_stack_frame( struct pso_pointer fp, struct pso_pointer env ); diff --git a/src/c/payloads/write_stream.c b/src/c/payloads/write_stream.c index 1397e7a..85ce8eb 100644 --- a/src/c/payloads/write_stream.c +++ b/src/c/payloads/write_stream.c @@ -25,7 +25,7 @@ * @param metadata a pointer to an associaton containing metadata on the stream. * @return a pointer to the new read stream. */ -struct pso_pointer make_write_stream( struct pso4 *frame_pointer, +struct pso_pointer make_write_stream( struct pso_pointer frame_pointer, URL_FILE *output, struct pso_pointer metadata ) { struct pso_pointer pointer = allocate( frame_pointer, WRITETAG, 2 ); diff --git a/src/c/payloads/write_stream.h b/src/c/payloads/write_stream.h index 07e3b14..7dc7d36 100644 --- a/src/c/payloads/write_stream.h +++ b/src/c/payloads/write_stream.h @@ -13,7 +13,7 @@ /* write stream shares a payload with /see read_streem.h */ #include "io/fopen.h" -struct pso_pointer make_write_stream( struct pso4 *frame_pointer, +struct pso_pointer make_write_stream( struct pso_pointer frame_pointer, URL_FILE * output, struct pso_pointer metadata ); #endif