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

Ran a 'make format', because !'m close to being able to merge this feature.

Browse source
This commit is contained in:
Simon Brooke 2026-05-06 16:45:56 +01:00
parent 5e64a33965
commit 80049f2272
52 changed files with 936 additions and 843 deletions
Download patch file Download diff file Expand all files Collapse all files

7
src/c/environment/environment.c
View file

@ -105,8 +105,11 @@ struct pso_pointer initialise_environment( uint32_t node ) {
initialise_privileged_keywords( frame_pointer );
result = inc_ref( 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 );
}

66
src/c/environment/function_bindings.c
View file

@ -65,14 +65,19 @@ bind_function(struct pso_pointer frame_pointer, wchar_t *name, wchar_t *doc,
struct pso_pointer n = c_string_to_lisp_symbol( frame_pointer, name );
struct pso_pointer d = c_string_to_lisp_string( frame_pointer, doc );
struct pso_pointer meta = make_cons(
frame_pointer,
make_cons(frame_pointer, privileged_keyword_layer, privileged_keyword_bootstrap),
struct pso_pointer meta = make_cons( frame_pointer,
make_cons( frame_pointer,
make_cons(frame_pointer, privileged_keyword_name, n),
privileged_keyword_layer,
privileged_keyword_bootstrap ),
make_cons( frame_pointer,
make_cons( frame_pointer,
privileged_keyword_documentation, d),
privileged_keyword_name,
n ),
make_cons( frame_pointer,
make_cons
( frame_pointer,
privileged_keyword_documentation,
d ),
nil ) ) );
struct pso_pointer r = make_function( frame_pointer, meta, executable );
@ -81,7 +86,8 @@ bind_function(struct pso_pointer frame_pointer, wchar_t *name, wchar_t *doc,
if ( !exceptionp( r ) ) {
debug_print( L"... bound\n", DEBUG_BOOTSTRAP, 0 );
result =
make_cons(frame_pointer, make_cons(frame_pointer, n, r), result);
make_cons( frame_pointer, make_cons( frame_pointer, n, r ),
result );
} else {
debug_print( L"... failed to bind\n", DEBUG_BOOTSTRAP, 0 );
}
@ -100,14 +106,19 @@ bind_special(struct pso_pointer frame_pointer, wchar_t *name, wchar_t *doc,
struct pso_pointer n = c_string_to_lisp_symbol( frame_pointer, name );
struct pso_pointer d = c_string_to_lisp_string( frame_pointer, doc );
struct pso_pointer meta = make_cons(
frame_pointer,
make_cons(frame_pointer, privileged_keyword_bootstrap, nil),
struct pso_pointer meta = make_cons( frame_pointer,
make_cons( frame_pointer,
make_cons(frame_pointer, privileged_keyword_name, n),
privileged_keyword_bootstrap,
nil ),
make_cons( frame_pointer,
make_cons( frame_pointer,
privileged_keyword_documentation, d),
privileged_keyword_name,
n ),
make_cons( frame_pointer,
make_cons
( frame_pointer,
privileged_keyword_documentation,
d ),
nil ) ) );
struct pso_pointer r = make_special( frame_pointer, meta, executable );
@ -116,7 +127,8 @@ bind_special(struct pso_pointer frame_pointer, wchar_t *name, wchar_t *doc,
if ( !exceptionp( r ) ) {
debug_print( L"... bound\n", DEBUG_BOOTSTRAP, 0 );
result =
make_cons(frame_pointer, make_cons(frame_pointer, n, r), result);
make_cons( frame_pointer, make_cons( frame_pointer, n, r ),
result );
} else {
debug_print( L"... failed to bind\n", DEBUG_BOOTSTRAP, 0 );
}
@ -149,8 +161,7 @@ struct function_data function_initialisers[] = {
L"(slurp stream): read the whole contents of this `stream`, "
L"which may "
L"be an open stream open for reading or a URL, into a string, and return "
L"the "
L"string.",
L"the " L"string.",
&lisp_slurp},
#endif
#ifdef __psse_io_peek_h
@ -272,8 +283,7 @@ struct function_data function_initialisers[] = {
&nilp},
{L"not",
L"(not expression): returns `t` unless `expression` evaluates to `nil`, "
L"else "
L"`nil`.",
L"else " L"`nil`.",
&not},
{L"or",
L"(or expressions...): returns `nil` if every one of these `expressions...` "
@ -285,7 +295,8 @@ struct function_data function_initialisers[] = {
&truep},
#endif
{L"END MARKER", L"END MARKER", NULL}};
{L"END MARKER", L"END MARKER", NULL}
};
/* right, the problem with all those pretty '#ifdefs' which might allow us to
* simply switch functions on and off just by including or not including .h
@ -311,7 +322,8 @@ struct function_data special_initialisers[] = {
L"evaluation.",
&quote},
#endif
{L"END MARKER", L"END MARKER", NULL}};
{L"END MARKER", L"END MARKER", NULL}
};
struct pso_pointer
initialise_function_bindings( struct pso_pointer frame_pointer ) {
@ -319,16 +331,22 @@ initialise_function_bindings(struct pso_pointer frame_pointer) {
for ( int i = 0; function_initialisers[i].executable != NULL; i++ ) {
struct pso_pointer b = c_car( bind_function( frame_pointer,
function_initialisers[i].name,
function_initialisers[i].documentation,
function_initialisers[i].executable));
function_initialisers[i].
name,
function_initialisers[i].
documentation,
function_initialisers[i].
executable ) );
result = make_cons( frame_pointer, b, result );
}
for ( int i = 0; special_initialisers[i].executable != NULL; i++ ) {
struct pso_pointer b = c_car( bind_special( frame_pointer,
special_initialisers[i].name,
special_initialisers[i].documentation,
special_initialisers[i].executable));
special_initialisers[i].
name,
special_initialisers[i].
documentation,
special_initialisers[i].
executable ) );
result = make_cons( frame_pointer, b, result );
}

3
src/c/environment/privileged_keywords.c
View file

@ -63,7 +63,8 @@ struct pso_pointer privileged_keyword_user;
#define load_and_lock(var,val)(var = lock_object(c_string_to_lisp_keyword(frame_pointer, val)))
struct pso_pointer initialise_privileged_keywords(struct pso_pointer frame_pointer) {
struct pso_pointer initialise_privileged_keywords( struct pso_pointer
frame_pointer ) {
load_and_lock( privileged_keyword_bootstrap, PK_BOOTSTRAP );
load_and_lock( privileged_keyword_documentation, PK_DOCUMENTATION );
load_and_lock( privileged_keyword_layer, PK_LAYER );

8
src/c/io/io.c
View file

@ -371,8 +371,8 @@ struct pso_pointer push_back_character( struct pso_pointer c,
struct pso_pointer result = nil;
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;
@ -398,8 +398,8 @@ struct pso_pointer lisp_close( struct pso_pointer frame_pointer) {
struct pso_pointer result = nil;
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;
}

3
src/c/io/io.h
View file

@ -25,7 +25,8 @@
extern CURLSH *io_share;
int initialise_io( );
struct pso_pointer initialise_default_streams(struct pso_pointer frame_pointer,
struct pso_pointer initialise_default_streams( struct pso_pointer
frame_pointer,
struct pso_pointer env );
#define C_IO_IN L"*in*"

1
src/c/io/peek.c
View file

@ -39,4 +39,3 @@ struct pso_pointer peek(struct pso_pointer frame_pointer) {
}
return result;
}

19
src/c/io/print.c
View file

@ -83,8 +83,7 @@ struct pso_pointer print_string_like_thing( struct pso_pointer p,
if ( keywordp( p ) || stringp( p ) || symbolp( p ) ) {
for ( struct pso_pointer cursor = p; !c_nilp( cursor );
cursor = pointer_to_object( cursor )->payload.string.cdr ) {
wchar_t wc =
pointer_to_object( cursor )->payload.string.character;
wchar_t wc = pointer_to_object( cursor )->payload.string.character;
write_char( wc, output, escape );
}
@ -189,7 +188,8 @@ struct pso_pointer in_write( struct pso_pointer p, URL_FILE *output,
} else {
url_fputws( L"<broken exception :-( >", output );
}
} break;
}
break;
case FUNCTIONTV:{
struct pso2 *function = pointer_to_object( p );
url_fputws( L"<function: ", output );
@ -282,12 +282,16 @@ struct pso_pointer write( struct pso_pointer frame_pointer ) {
}
struct pso_pointer c_write( struct pso_pointer frame_pointer,
struct pso_pointer object, struct pso_pointer stream,
bool escape, bool nl_before, bool nl_after) {
struct pso_pointer object,
struct pso_pointer stream, bool escape,
bool nl_before, bool nl_after ) {
struct pso_pointer next_pointer =
push_local(frame_pointer, make_frame(5, frame_pointer, object, stream, escape ? t : nil,
push_local( frame_pointer,
make_frame( 5, frame_pointer, object, stream,
escape ? t : nil,
nl_before ? t : nil, nl_after ? t : nil ) );
struct pso_pointer result = push_local(frame_pointer, write(next_pointer));
struct pso_pointer result =
push_local( frame_pointer, write( next_pointer ) );
return result;
}
@ -333,4 +337,3 @@ struct pso_pointer princ( struct pso_pointer frame_pointer ) {
return result;
}

5
src/c/io/print.h
View file

@ -27,8 +27,9 @@ struct pso_pointer in_write( struct pso_pointer p, URL_FILE * output,
bool escape, int indent );
struct pso_pointer c_write( struct pso_pointer frame_pointer,
struct pso_pointer object, struct pso_pointer stream,
bool escape, bool nl_before, bool nl_after);
struct pso_pointer object,
struct pso_pointer stream, bool escape,
bool nl_before, bool nl_after );
#define c_print(f,o,s)(c_write(f,o,s,true,true,false))
#define c_princ(f,o,s)(c_write(f,o,s,false,true,false))

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

@ -146,7 +146,9 @@ struct pso_pointer read_number( struct pso_pointer frame_pointer ) {
URL_FILE *input = pointer_to_object( stream )->payload.stream.stream;
for ( ; iswdigit( c ) || c == L','; c = url_fgetwc( input ) ) {
if ( iswdigit( c ) ){value = ( value * base ) + ( ( int ) c - ( int ) L'0' );}
if ( iswdigit( c ) ) {
value = ( value * base ) + ( ( int ) c - ( int ) L'0' );
}
}
url_ungetwc( c, input );
@ -185,7 +187,6 @@ struct pso_pointer read_symbol( struct pso_pointer frame_pointer ) {
url_ungetwc( c, input );
result = c_reverse( frame_pointer, result );
}
#ifdef DEBUG
debug_print( L"\nRead symbol `", DEBUG_IO, 0 );
debug_print_object( result, DEBUG_IO, 0 );

39
src/c/memory/dump.c
View file

@ -51,7 +51,8 @@ void dump_string_cell( URL_FILE *output, wchar_t *prefix,
L"\t\t%ls cell: termination; next at page %d offset %d, count %u\n",
prefix,
object->payload.string.cdr.page,
object->payload.string.cdr.offset, object->header.count );
object->payload.string.cdr.offset,
object->header.count );
} else {
url_fwprintf( output,
L"\t\t%ls cell: character '%lc' (%d) with hash %d; next at page %d offset %d, count %u\n",
@ -60,14 +61,18 @@ void dump_string_cell( URL_FILE *output, wchar_t *prefix,
object->payload.string.character,
object->payload.string.hash,
object->payload.string.cdr.page,
object->payload.string.cdr.offset, object->header.count );
object->payload.string.cdr.offset,
object->header.count );
url_fwprintf( output, L"\t\t value: " );
in_write( pointer, output, false, 0 );
if ( stringlikep( pointer ) ) {
url_fwprintf( output, L"\n\t\t structure: " );
for ( struct pso_pointer cursor = pointer; !c_nilp(cursor); cursor = c_cdr(cursor)) {
wint_t c = pointer_to_object(cursor)->payload.string.character;
char* tag = (pointer_to_object(cursor)->header.tag.bytes.mnemonic);
for ( struct pso_pointer cursor = pointer; !c_nilp( cursor );
cursor = c_cdr( cursor ) ) {
wint_t c =
pointer_to_object( cursor )->payload.string.character;
char *tag =
( pointer_to_object( cursor )->header.tag.bytes.mnemonic );
url_fwprintf( output, L"[%3.3s %lc (%d)]", tag, c, c );
}
}
@ -98,7 +103,8 @@ void dump_frame_context( URL_FILE *output, struct pso_pointer frame_pointer,
int i = 0;
for ( struct pso_pointer cursor = frame_pointer;
i++ < depth && !c_nilp( cursor );
cursor = pointer_to_pso4(cursor)->payload.stack_frame.previous ) {
cursor =
pointer_to_pso4( cursor )->payload.stack_frame.previous ) {
dump_frame_context_fragment( output, cursor, 0 );
}
@ -116,14 +122,16 @@ void dump_frame( URL_FILE *output, struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
url_fwprintf( output, L"Stack frame %d with %d arguments:\n",
frame->payload.stack_frame.depth, frame->payload.stack_frame.args );
frame->payload.stack_frame.depth,
frame->payload.stack_frame.args );
dump_frame_context( output, frame_pointer, 4 );
for ( int arg = 0; arg < frame->payload.stack_frame.args; arg++ ) {
struct pso2 *object = pointer_to_object( fetch_arg( frame, arg ) );
url_fwprintf( output, L"\tArg %d:\t%3.3s\tcount: %10u\tvalue: ",
arg, object->header.tag.bytes.mnemonic[0], object->header.count );
arg, object->header.tag.bytes.mnemonic[0],
object->header.count );
in_write( frame->payload.stack_frame.arg[arg], output, false, 0 );
url_fputws( L"\n", output );
@ -142,8 +150,7 @@ void dump_stack_trace( URL_FILE *output, struct pso_pointer pointer ) {
struct pso3 *exep = pointer_to_pso3( pointer );
in_write( exep->payload.exception.message, output, false, 0 );
url_fputws( L"\n", output );
dump_stack_trace( output,
exep->payload.exception.stack );
dump_stack_trace( output, exep->payload.exception.stack );
} else {
while ( stackp( pointer ) ) {
dump_frame( output, pointer );
@ -184,7 +191,6 @@ struct pso_pointer dump_object( struct pso_pointer frame_pointer ) {
if ( !writep( stream ) ) {
stream = lisp_stderr;
}
// URL_FILE* output = file_to_url_file(stderr);
// url_fputws( L"\ndump_object printing to output stream; metadata: ", output );
// in_write( pointer_to_object(stream)->payload.stream.meta, output, false, 0 );
@ -196,15 +202,16 @@ struct pso_pointer dump_object( struct pso_pointer frame_pointer ) {
if ( c_nilp( pointer ) ) {
// the object at (node, 0, 0) ought to have been initialised, but may not
// have been...
url_fputws(L"nil of size class 2 at page 0, offset 0, count xxxx\n", output );
url_fputws( L"nil of size class 2 at page 0, offset 0, count xxxx\n",
output );
} else {
struct pso2 *object = pointer_to_object( pointer );
url_fwprintf( output, L"\t%3.3s (%d) of size class %d at page %d, offset %d count %u\n",
url_fwprintf( output,
L"\t%3.3s (%d) of size class %d at page %d, offset %d count %u\n",
object->header.tag.bytes.mnemonic,
get_tag_value( pointer ),
object->header.tag.bytes.size_class,
pointer.page, pointer.offset,
object->header.count );
object->header.tag.bytes.size_class, pointer.page,
pointer.offset, object->header.count );
switch ( get_tag_value( pointer ) ) {
case CONSTV:

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

@ -60,8 +60,8 @@ void print_allocation_table( ) {
}
#endif
struct pso_pointer cheaty_allocate(struct pso_pointer frame_pointer, char *tag,
uint8_t size_class);
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
@ -88,8 +88,8 @@ struct pso_pointer cheaty_make_cons( struct pso_pointer car,
* 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 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,
@ -189,8 +189,10 @@ struct pso_pointer inc_ref( struct pso_pointer pointer ) {
L"\nIncremented object of type %3.3s, size class %d, "
L"at page %u, offset %u to count %u", ( ( char * )
&
( object->header.tag.
bytes.mnemonic
( object->
header.
tag.bytes.
mnemonic
[0] ) ),
( int ) object->header.tag.bytes.size_class,
pointer.page, pointer.offset, object->header.count );

15
src/c/ops/assoc.c
View file

@ -117,14 +117,13 @@ bool c_internedp( struct pso_pointer key, struct pso_pointer store ) {
*
* @return a pointer to the value of the key in the store, or nil if not found
*/
struct pso_pointer assoc(
struct pso_pointer frame_pointer ) {
struct pso_pointer assoc( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer key = fetch_arg( frame, 0 );
struct pso_pointer store = or( make_frame( 2, frame_pointer,
fetch_arg( frame, 1 ),
frame->payload.
stack_frame.env ) );
frame->payload.stack_frame.
env ) );
return c_assoc( key, store );
}
@ -145,8 +144,8 @@ struct pso_pointer interned(
struct pso_pointer key = fetch_arg( frame, 0 );
struct pso_pointer store = or( make_frame( 2, frame_pointer,
fetch_arg( frame, 1 ),
frame->payload.
stack_frame.env ) );
frame->payload.stack_frame.
env ) );
return c_interned( key, store );
}
@ -167,8 +166,8 @@ struct pso_pointer internedp(
struct pso_pointer key = fetch_arg( frame, 0 );
struct pso_pointer store = or( make_frame( 2, frame_pointer,
fetch_arg( frame, 1 ),
frame->payload.
stack_frame.env ) );
frame->payload.stack_frame.
env ) );
return c_internedp( key, store ) ? t : nil;
}

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

@ -35,4 +35,3 @@ struct pso_pointer lisp_bind( struct pso_pointer frame_pointer ) {
return cons( make_frame( 2, frame_pointer, binding, store ) );
}

14
src/c/ops/cond.c
View file

@ -41,13 +41,16 @@ struct pso_pointer eval_cond_clause( struct pso_pointer clause,
#endif
if ( consp( clause ) ) {
struct pso_pointer test_frame = push_local( frame_pointer, make_frame(1, frame_pointer, c_car(clause)));
struct pso_pointer test_frame =
push_local( frame_pointer,
make_frame( 1, frame_pointer, c_car( clause ) ) );
struct pso_pointer val = lisp_eval( test_frame );
if ( !c_nilp( val ) ) {
result =
make_cons( frame_pointer, t,
c_progn( frame, frame_pointer, c_cdr( clause ), env ) );
c_progn( frame, frame_pointer, c_cdr( clause ),
env ) );
#ifdef DEBUG
debug_print( L"\n\t\tCond clause ", DEBUG_EVAL, 0 );
@ -62,9 +65,10 @@ struct pso_pointer eval_cond_clause( struct pso_pointer clause,
#endif
}
} else {
result = throw_exception( c_string_to_lisp_symbol( frame_pointer, L"cond" ),
c_string_to_lisp_string
(frame_pointer, L"Arguments to `cond` must be lists" ),
result =
throw_exception( c_string_to_lisp_symbol( frame_pointer, L"cond" ),
c_string_to_lisp_string( frame_pointer,
L"Arguments to `cond` must be lists" ),
frame_pointer );
}

181
src/c/ops/eval_apply.c
View file

@ -159,7 +159,8 @@ struct pso_pointer lisp_try( struct pso_pointer frame_pointer) {
struct pso_pointer result = nil;
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer body_frame =
push_local( frame_pointer, make_frame( 1, frame_pointer, fetch_arg( frame, 0 ) ) );
push_local( frame_pointer,
make_frame( 1, frame_pointer, fetch_arg( frame, 0 ) ) );
result = push_local( frame_pointer, lisp_progn( body_frame ) );
@ -167,16 +168,19 @@ struct pso_pointer lisp_try( struct pso_pointer frame_pointer) {
// TODO: need to put the exception into the environment!
struct pso_pointer catch_frame =
push_local( frame_pointer, make_frame_with_env( 1, frame_pointer,
make_cons( frame_pointer,
make_cons( frame_pointer,
make_cons
( frame_pointer,
make_cons
( frame_pointer,
c_string_to_lisp_symbol
( frame_pointer,
L"*exception*" ),
result ),
fetch_env
( frame_pointer ) ),
frame->payload.stack_frame.
arg[1] ) );
frame->payload.
stack_frame.arg
[1] ) );
result = push_local( frame_pointer, lisp_progn( catch_frame ) );
}
@ -235,10 +239,10 @@ struct pso_pointer compose_body( struct pso_pointer frame_pointer ) {
* @param env the environment in which it is to be intepreted.
* @return an interpretable function with these `args` and this `body`.
*/
struct pso_pointer
lisp_lambda( struct pso_pointer frame_pointer ) {
struct pso_pointer lisp_lambda( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
return make_lambda( frame_pointer, fetch_arg(frame, 0), compose_body( frame_pointer ) );
return make_lambda( frame_pointer, fetch_arg( frame, 0 ),
compose_body( frame_pointer ) );
}
/**
@ -253,18 +257,17 @@ lisp_lambda( struct pso_pointer frame_pointer ) {
* @return an interpretable special form with these `args` and this `body`.
*/
struct pso_pointer
lisp_nlambda( struct pso_pointer frame_pointer,
struct pso_pointer env ) {
lisp_nlambda( struct pso_pointer frame_pointer, struct pso_pointer env ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
return make_nlambda( frame_pointer, fetch_arg(frame, 0), compose_body( frame_pointer ) );
return make_nlambda( frame_pointer, fetch_arg( frame, 0 ),
compose_body( frame_pointer ) );
}
/**
* Evaluate a lambda or nlambda expression.
*/
struct pso_pointer
eval_lambda( struct pso_pointer frame_pointer ) {
struct pso_pointer eval_lambda( struct pso_pointer frame_pointer ) {
struct pso_pointer result = nil;
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso2 *lambda = pointer_to_object( fetch_arg( frame, 0 ) );
@ -299,12 +302,12 @@ eval_lambda( struct pso_pointer frame_pointer ) {
/* if `names` is a symbol, rather than a list of symbols,
* then bind a list of the values of args to that symbol. */
/* \todo eval all the things in frame->payload.stack_frame.more */
struct pso_pointer more_frame = inc_ref(
make_frame(1, frame_pointer,
frame->payload.stack_frame.more));
struct pso_pointer more_frame = inc_ref( make_frame( 1, frame_pointer,
frame->payload.
stack_frame.
more ) );
struct pso_pointer vals =
eval_forms( more_frame );
struct pso_pointer vals = eval_forms( more_frame );
for ( int i = args_in_frame - 1; i >= 0; i-- ) {
struct pso_pointer next =
@ -421,10 +424,12 @@ struct pso_pointer make_fn_frame(struct pso_pointer previous,
int args = 0;
struct pso_pointer cursor;
for ( cursor = arg_list; consp(cursor) && args < args_in_frame; cursor = c_cdr(cursor)) {
for ( cursor = arg_list; consp( cursor ) && args < args_in_frame;
cursor = c_cdr( cursor ) ) {
// Reusing a frame like this is a bit of an abuse but will save allocation churn.
next_frame->payload.stack_frame.arg[0] = c_car( cursor );
new_frame->payload.stack_frame.arg[args++] = inc_ref( lisp_eval( next_pointer) );
new_frame->payload.stack_frame.arg[args++] =
inc_ref( lisp_eval( next_pointer ) );
}
if ( consp( cursor ) ) {
struct pso_pointer more = nil;
@ -438,7 +443,8 @@ struct pso_pointer make_fn_frame(struct pso_pointer previous,
args++;
}
new_frame->payload.stack_frame.more = push_local( previous, c_reverse( previous, more));
new_frame->payload.stack_frame.more =
push_local( previous, c_reverse( previous, more ) );
}
new_frame->payload.stack_frame.args = args;
@ -468,9 +474,11 @@ struct pso_pointer make_special_frame(struct pso_pointer previous,
int args = 0;
struct pso_pointer cursor;
for ( cursor = arg_list; consp(cursor) && args < args_in_frame; cursor = c_cdr(cursor)) {
for ( cursor = arg_list; consp( cursor ) && args < args_in_frame;
cursor = c_cdr( cursor ) ) {
// Reusing a frame like this is a bit of an abuse but will save allocation churn.
new_frame->payload.stack_frame.arg[args++] = inc_ref( c_car(cursor) );
new_frame->payload.stack_frame.arg[args++] =
inc_ref( c_car( cursor ) );
}
if ( consp( cursor ) ) {
@ -493,7 +501,10 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) {
debug_print( L"Entering apply\n", DEBUG_EVAL, 0 );
struct pso_pointer result = nil;
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer fn_frame = inc_ref( make_frame(1, frame_pointer, c_car( frame->payload.stack_frame.arg[0] )));
struct pso_pointer fn_frame =
inc_ref( make_frame
( 1, frame_pointer,
c_car( frame->payload.stack_frame.arg[0] ) ) );
struct pso_pointer fn_pointer =
push_local( frame_pointer, eval_form( fn_frame ) );
@ -514,19 +525,15 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) {
case FUNCTIONTV:
{
struct pso_pointer next_pointer =
inc_ref( make_fn_frame( frame_pointer, fn_pointer, args ));
inc_ref( make_fn_frame
( frame_pointer, fn_pointer, args ) );
if ( exceptionp( next_pointer ) ) {
result = next_pointer;
} else {
result = push_local( frame_pointer,
maybe_fixup_exception_location( ( *
( fn_cell->
payload.
function.
executable ) )
(next_pointer ),
fn_pointer ));
maybe_fixup_exception_location( ( *( fn_cell->payload.function.executable ) )
( next_pointer ), fn_pointer ) );
dec_ref( next_pointer );
}
}
@ -534,12 +541,14 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) {
case KEYTV:{
struct pso_pointer map_frame =
inc_ref(make_frame(1, frame_pointer, c_car(args)));
result = push_local(
frame_pointer,
inc_ref( make_frame
( 1, frame_pointer, c_car( args ) ) );
result =
push_local( frame_pointer,
c_assoc( fn_pointer,
maybe_fixup_exception_location(
eval_form(map_frame), fn_pointer)));
maybe_fixup_exception_location
( eval_form( map_frame ),
fn_pointer ) ) );
} break;
case LAMBDATV:
@ -551,8 +560,7 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) {
result = next_pointer;
} else {
struct pso4 *next = pointer_to_pso4( next_pointer );
result =
eval_lambda( next_pointer );
result = eval_lambda( next_pointer );
if ( !exceptionp( result ) ) {
dec_ref( next_pointer );
}
@ -580,8 +588,7 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) {
result = next_pointer;
} else {
struct pso4 *next = pointer_to_pso4( next_pointer );
result =
eval_lambda( next_pointer );
result = eval_lambda( next_pointer );
dec_ref( next_pointer );
}
}
@ -596,10 +603,7 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) {
result = next_pointer;
} else {
result = maybe_fixup_exception_location( ( *
( fn_cell->
payload.
special.
executable ) )
( fn_cell->payload.special.executable ) )
( next_pointer ), fn_pointer );
debug_print( L"Special form returning: ", DEBUG_EVAL,
0 );
@ -623,8 +627,9 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) {
c_string_to_lisp_string( frame_pointer, buffer );
free( buffer );
result =
throw_exception( c_string_to_lisp_symbol( frame_pointer, L"apply" ),
message, frame_pointer );
throw_exception( c_string_to_lisp_symbol
( frame_pointer, L"apply" ), message,
frame_pointer );
}
}
@ -655,8 +660,7 @@ struct pso_pointer lisp_apply( struct pso_pointer frame_pointer) {
* * If a special form, passes the cdr of expression to the special form as argument.
* @exception if `expression` is a symbol which is not bound in `env`.
*/
struct pso_pointer
lisp_eval( struct pso_pointer frame_pointer ) {
struct pso_pointer lisp_eval( struct pso_pointer frame_pointer ) {
debug_print( L"Eval: ", DEBUG_EVAL, 0 );
debug_dump_object( frame_pointer, DEBUG_EVAL, 0 );
@ -669,8 +673,10 @@ lisp_eval( struct pso_pointer frame_pointer ) {
case CONSTV:{
struct pso_pointer next_pointer =
push_local( frame_pointer, make_frame( 2, frame_pointer,
c_car(result), c_cdr(result)));
result = push_local(frame_pointer, lisp_apply(next_pointer));
c_car( result ),
c_cdr( result ) ) );
result =
push_local( frame_pointer, lisp_apply( next_pointer ) );
} break;
case SYMBOLTV:
@ -682,15 +688,18 @@ lisp_eval( struct pso_pointer frame_pointer ) {
debug_dump_object( fetch_env( frame_pointer ), DEBUG_EVAL, 0 );
#endif
struct pso_pointer canonical =
c_interned( frame->payload.stack_frame.arg[0], fetch_env(frame_pointer) );
c_interned( frame->payload.stack_frame.arg[0],
fetch_env( frame_pointer ) );
if ( c_nilp( canonical ) ) {
struct pso_pointer message =
make_cons( frame_pointer, c_string_to_lisp_string
( frame_pointer, L"Attempt to take value of unbound symbol." ),
( frame_pointer,
L"Attempt to take value of unbound symbol." ),
frame->payload.stack_frame.arg[0] );
result =
throw_exception( c_string_to_lisp_symbol( frame_pointer, L"eval" ),
message, frame_pointer );
throw_exception( c_string_to_lisp_symbol
( frame_pointer, L"eval" ), message,
frame_pointer );
} else {
result = c_assoc( canonical, env );
// inc_ref( result );
@ -737,17 +746,22 @@ lisp_quote( struct pso4 *frame, struct pso_pointer frame_pointer,
* @param pointer a pointer to the object whose type is requested.
* @return As a Lisp string, the tag of the object which is at that pointer.
*/
struct pso_pointer c_type( struct pso_pointer frame_pointer, struct pso_pointer pointer ) {
struct pso_pointer c_type( struct pso_pointer frame_pointer,
struct pso_pointer pointer ) {
/* Strings read by `read` have the null character termination. This means
* that for the same printable string, the hashcode is different from
* strings made with NIL termination. The question is which should be
* fixed, and actually that's probably strings read by `read`. However,
* for now, it was easier to add a null character here. */
struct pso_pointer result = make_symbol( frame_pointer, ( wchar_t ) 0, nil );
struct pso_pointer result =
make_symbol( frame_pointer, ( wchar_t ) 0, nil );
struct pso2 *cell = pointer_to_object( pointer );
for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
result = make_symbol( frame_pointer, ( wchar_t ) cell->header.tag.bytes.mnemonic[i], result );
result =
make_symbol( frame_pointer,
( wchar_t ) cell->header.tag.bytes.mnemonic[i],
result );
}
return result;
@ -761,9 +775,9 @@ struct pso_pointer c_type( struct pso_pointer frame_pointer, struct pso_pointer
*
* @return As a Lisp symbol, the tag of `expression`.
*/
struct pso_pointer
lisp_type( struct pso_pointer frame_pointer ) {
return c_type( frame_pointer, fetch_arg( pointer_to_pso4( frame_pointer), 0) );
struct pso_pointer lisp_type( struct pso_pointer frame_pointer ) {
return c_type( frame_pointer,
fetch_arg( pointer_to_pso4( frame_pointer ), 0 ) );
}
@ -782,9 +796,9 @@ lisp_type( struct pso_pointer frame_pointer ) {
struct pso_pointer lisp_source( struct pso_pointer frame_pointer ) {
struct pso_pointer result = nil;
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso2 *cell =
pointer_to_object( fetch_arg( frame, 0) );
struct pso_pointer source_key = c_string_to_lisp_keyword( frame_pointer, L"source" );
struct pso2 *cell = pointer_to_object( fetch_arg( frame, 0 ) );
struct pso_pointer source_key =
c_string_to_lisp_keyword( frame_pointer, L"source" );
switch ( get_tag_value( fetch_arg( frame, 0 ) ) ) {
case FUNCTIONTV:
result = c_assoc( source_key, cell->payload.function.meta );
@ -794,14 +808,16 @@ struct pso_pointer lisp_source( struct pso_pointer frame_pointer) {
break;
case LAMBDATV:
result = make_cons( frame_pointer,
c_string_to_lisp_symbol( frame_pointer, L"λ" ),
c_string_to_lisp_symbol( frame_pointer,
L"λ" ),
make_cons( frame_pointer,
cell->payload.lambda.args,
cell->payload.lambda.body ) );
break;
case NLAMBDATV:
result = make_cons( frame_pointer,
c_string_to_lisp_symbol( frame_pointer, L"nλ" ),
c_string_to_lisp_symbol( frame_pointer,
L"nλ" ),
make_cons( frame_pointer,
cell->payload.lambda.args,
cell->payload.lambda.body ) );
@ -849,20 +865,25 @@ struct pso_pointer lisp_let( struct pso_pointer frame_pointer ) {
struct pso_pointer pair = c_car( cursor );
struct pso_pointer symbol = c_car( pair );
struct pso_pointer next_pointer = push_local( frame_pointer, make_frame_with_env( 0, frame_pointer, bindings));
struct pso_pointer next_pointer =
push_local( frame_pointer,
make_frame_with_env( 0, frame_pointer, bindings ) );
if ( symbolp( symbol ) ) {
add_arg( next_pointer, c_cdr( pair ) );
struct pso_pointer val =
eval_form( next_pointer );
struct pso_pointer val = eval_form( next_pointer );
// debug_print_binding( symbol, val, false, DEBUG_BIND );
bindings = make_cons( frame_pointer, make_cons( frame_pointer, symbol, val ), bindings );
bindings =
make_cons( frame_pointer,
make_cons( frame_pointer, symbol, val ), bindings );
} else {
result =
throw_exception( c_string_to_lisp_symbol( frame_pointer, L"let" ),
c_string_to_lisp_string( frame_pointer, L"Let: cannot bind, not a symbol" ),
throw_exception( c_string_to_lisp_symbol
( frame_pointer, L"let" ),
c_string_to_lisp_string( frame_pointer,
L"Let: cannot bind, not a symbol" ),
frame_pointer );
break;
}
@ -871,17 +892,21 @@ struct pso_pointer lisp_let( struct pso_pointer frame_pointer ) {
if ( !exceptionp( result ) ) {
debug_print( L"\nlet: bindings complete.\n", DEBUG_BIND, 0 );
struct pso_pointer progn_pointer = make_frame_with_env( 0, frame_pointer, bindings);
struct pso_pointer progn_pointer =
make_frame_with_env( 0, frame_pointer, bindings );
struct pso4 *progn_frame = pointer_to_pso4( progn_pointer );
int a = 1;
for ( ; a < frame->payload.stack_frame.args && a < args_in_frame; a++ ) {
progn_frame->payload.stack_frame.arg[a-1] = fetch_arg( frame, a);
progn_frame->payload.stack_frame.arg[a - 1] =
fetch_arg( frame, a );
progn_frame->payload.stack_frame.args++;
}
if ( a < frame->payload.stack_frame.args ) {
progn_frame->payload.stack_frame.arg[a-1] = fetch_arg( frame, a);
progn_frame->payload.stack_frame.more = c_cdr( frame->payload.stack_frame.more);
progn_frame->payload.stack_frame.arg[a - 1] =
fetch_arg( frame, a );
progn_frame->payload.stack_frame.more =
c_cdr( frame->payload.stack_frame.more );
}
result = lisp_progn( progn_pointer );
@ -904,8 +929,8 @@ struct pso_pointer lisp_and( struct pso4 *frame,
bool accumulator = true;
struct pso_pointer result = frame->payload.stack_frame.more;
for ( int a = 0; accumulator == true && a < frame->payload.stack_frame.args;
a++ ) {
for ( int a = 0;
accumulator == true && a < frame->payload.stack_frame.args; a++ ) {
accumulator = truthy( fetch_arg( frame, a ) );
}
#

5
src/c/ops/keys.c
View file

@ -45,6 +45,7 @@ struct pso_pointer c_keys(struct pso_pointer frame_pointer,
struct pso_pointer lisp_keys( struct pso_pointer frame_pointer ) {
return c_keys( frame_pointer, pointer_to_pso4(frame_pointer)->payload.stack_frame.arg[0] );
return c_keys( frame_pointer,
pointer_to_pso4( frame_pointer )->payload.stack_frame.
arg[0] );
}

1
src/c/ops/list_ops.c
View file

@ -33,4 +33,3 @@ struct pso_pointer count( struct pso_pointer frame_pointer ) {
return acquire_integer( frame_pointer, c );
}

25
src/c/ops/mapcar.c
View file

@ -31,24 +31,33 @@ struct pso_pointer lisp_mapcar( struct pso_pointer frame_pointer ) {
debug_dump_object( frame_pointer, DEBUG_EVAL, 0 );
int i = 0;
for ( struct pso_pointer c = frame->payload.stack_frame.arg[1]; c_truep( c );
c = c_cdr( c ) ) {
struct pso_pointer expr =
push_local( frame_pointer,
make_cons( frame_pointer, frame->payload.stack_frame.arg[0],
make_cons( frame_pointer, c_car( c ), nil ) ) );
for ( struct pso_pointer c = frame->payload.stack_frame.arg[1];
c_truep( c ); c = c_cdr( c ) ) {
struct pso_pointer expr = push_local( frame_pointer,
make_cons( frame_pointer,
frame->payload.
stack_frame.arg[0],
make_cons
( frame_pointer,
c_car( c ),
nil ) ) );
debug_printf( DEBUG_EVAL, 0, L"Mapcar %d, evaluating ", i );
debug_print_object( expr, DEBUG_EVAL, 0 );
debug_println( DEBUG_EVAL );
struct pso_pointer r = lisp_eval( push_local( frame_pointer, make_frame(1, frame_pointer, expr)));
struct pso_pointer r =
lisp_eval( push_local
( frame_pointer,
make_frame( 1, frame_pointer, expr ) ) );
if ( exceptionp( r ) ) {
result = r;
break;
} else {
result = push_local( frame_pointer, make_cons( frame_pointer, r, result ));
result =
push_local( frame_pointer,
make_cons( frame_pointer, r, result ) );
}
debug_printf( DEBUG_EVAL, 0, L"Mapcar %d, result is ", i++ );
debug_print_object( result, DEBUG_EVAL, 0 );

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

@ -60,8 +60,7 @@ c_progn( struct pso4 *frame, struct pso_pointer frame_pointer,
* @return the value of the last `expression` of the sequence which is my single
* argument.
*/
struct pso_pointer
lisp_progn( struct pso_pointer frame_pointer) {
struct pso_pointer lisp_progn( struct pso_pointer frame_pointer ) {
struct pso_pointer result = nil;
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer next_pointer =
@ -76,7 +75,8 @@ lisp_progn( struct pso_pointer frame_pointer) {
}
if ( consp( frame->payload.stack_frame.more ) ) {
result = c_progn(frame, frame_pointer, frame->payload.stack_frame.more,
result =
c_progn( frame, frame_pointer, frame->payload.stack_frame.more,
fetch_env( frame_pointer ) );
}

3
src/c/ops/progn.h
View file

@ -15,7 +15,8 @@
#include "memory/pointer.h"
#include "memory/pso4.h"
struct pso_pointer c_progn(struct pso4 *frame, struct pso_pointer frame_pointer,
struct pso_pointer c_progn( struct pso4 *frame,
struct pso_pointer frame_pointer,
struct pso_pointer expressions,
struct pso_pointer env );

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

@ -49,25 +49,25 @@ struct pso_pointer reverse( struct pso_pointer frame_pointer ) {
case KEYTV:
result = push_local( frame_pointer,
make_string_like_thing( frame_pointer,
object->payload.
string.character,
result,
object->
payload.string.
character, result,
KEYTAG ) );
break;
case STRINGTV:
result = push_local( frame_pointer,
make_string_like_thing( frame_pointer,
object->payload.
string.character,
result,
object->
payload.string.
character, result,
STRINGTAG ) );
break;
case SYMBOLTV:
result = push_local( frame_pointer,
make_string_like_thing( frame_pointer,
object->payload.
string.character,
result,
object->
payload.string.
character, result,
SYMBOLTAG ) );
break;
default:

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

@ -146,8 +146,8 @@ char *lisp_string_to_c_string( struct pso_pointer s ) {
int i = 0;
for ( struct pso_pointer c = s; !c_nilp( c ); c = c_cdr( c ) ) {
buffer[i++] =
( wchar_t ) ( pointer_to_object( c )->payload.
string.character );
( wchar_t ) ( pointer_to_object( c )->payload.string.
character );
}
mbstate_t ps;

11
src/c/payloads/exception.c
View file

@ -130,13 +130,13 @@ struct pso_pointer throw_exception_with_cause( struct pso_pointer location,
if ( get_tag_value( message ) ) {
result = message;
} else {
struct pso_pointer x_frame = inc_ref(make_frame(
2, frame_pointer, message,
struct pso_pointer x_frame =
inc_ref( make_frame( 2, frame_pointer, message,
( c_nilp( location )
? nil
: make_cons(frame_pointer,
? nil : make_cons( frame_pointer,
make_cons( frame_pointer,
privileged_keyword_location, location),
privileged_keyword_location,
location ),
nil ) ),
cause ) );
@ -162,4 +162,3 @@ throw_exception( struct pso_pointer location,
struct pso_pointer frame_pointer ) {
return throw_exception_with_cause( location, payload, nil, frame_pointer );
}

9
src/c/payloads/function.c
View file

@ -12,9 +12,12 @@
#include "memory/pso2.h"
#include "memory/tags.h"
struct pso_pointer make_function(
struct pso_pointer frame_pointer, struct pso_pointer meta,
struct pso_pointer (*executable)(struct pso_pointer frame_pointer)) {
struct pso_pointer make_function( struct pso_pointer frame_pointer,
struct pso_pointer meta,
struct pso_pointer ( *executable ) ( struct
pso_pointer
frame_pointer ) )
{
struct pso_pointer result = allocate( frame_pointer, FUNCTIONTAG, 2 );
struct pso2 *object = pointer_to_object( result );

8
src/c/payloads/function.h
View file

@ -39,8 +39,10 @@ struct function_payload {
struct pso_pointer ( *executable ) ( struct pso_pointer frame_pointer );
};
struct pso_pointer make_function(
struct pso_pointer frame_pointer, struct pso_pointer meta,
struct pso_pointer (*executable)(struct pso_pointer frame_pointer));
struct pso_pointer make_function( struct pso_pointer frame_pointer,
struct pso_pointer meta,
struct pso_pointer ( *executable ) ( struct
pso_pointer
frame_pointer ) );
#endif

3
src/c/payloads/lambda.c
View file

@ -15,7 +15,8 @@
struct pso_pointer make_lambda_like_thing( struct pso_pointer frame_pointer,
struct pso_pointer args,
struct pso_pointer body, char *tag) {
struct pso_pointer body,
char *tag ) {
struct pso_pointer result = allocate( frame_pointer, tag, 2 );
struct pso2 *object = pointer_to_object( result );

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

@ -32,7 +32,8 @@ struct lambda_payload {
struct pso_pointer make_lambda_like_thing( struct pso_pointer frame_pointer,
struct pso_pointer args,
struct pso_pointer body, char *tag);
struct pso_pointer body,
char *tag );
#define make_lambda(f,a,b) (make_lambda_like_thing( f, a, b, LAMBDATAG))
#endif

9
src/c/payloads/special.c
View file

@ -12,9 +12,12 @@
#include "memory/pso2.h"
#include "memory/tags.h"
struct pso_pointer make_special(
struct pso_pointer frame_pointer, struct pso_pointer meta,
struct pso_pointer (*executable)(struct pso_pointer frame_pointer)) {
struct pso_pointer make_special( struct pso_pointer frame_pointer,
struct pso_pointer meta,
struct pso_pointer ( *executable ) ( struct
pso_pointer
frame_pointer ) )
{
struct pso_pointer result = allocate( frame_pointer, SPECIALTAG, 2 );
struct pso2 *object = pointer_to_object( result );

8
src/c/payloads/special.h
View file

@ -22,8 +22,10 @@
* \see NLAMBDATAG.
*/
struct pso_pointer make_special(
struct pso_pointer frame_pointer, struct pso_pointer meta,
struct pso_pointer (*executable)(struct pso_pointer frame_pointer));
struct pso_pointer make_special( struct pso_pointer frame_pointer,
struct pso_pointer meta,
struct pso_pointer ( *executable ) ( struct
pso_pointer
frame_pointer ) );
#endif

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

@ -100,17 +100,23 @@ struct pso_pointer push_local( struct pso_pointer frame_pointer,
*
* @return `nil` on success; potentially an exception on failure.
*/
struct pso_pointer add_arg( struct pso_pointer frame_pointer, struct pso_pointer arg_pointer) {
struct pso_pointer add_arg( struct pso_pointer frame_pointer,
struct pso_pointer arg_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer result = nil;
if ( frame->payload.stack_frame.args < args_in_frame ) {
frame->payload.stack_frame.arg[frame->payload.stack_frame.args++] = push_local(frame_pointer, arg_pointer);
frame->payload.stack_frame.arg[frame->payload.stack_frame.args++] =
push_local( frame_pointer, arg_pointer );
} else {
struct pso_pointer new_more = c_reverse( frame_pointer,
make_cons( frame_pointer,
arg_pointer,
c_reverse( frame_pointer, frame->payload.stack_frame.more)));
c_reverse
( frame_pointer,
frame->payload.
stack_frame.
more ) ) );
if ( exceptionp( new_more ) ) {
result = new_more;
} else {
@ -205,7 +211,8 @@ 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 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 ) ?
@ -238,7 +245,8 @@ struct pso_pointer make_frame_with_env( int arg_count,
va_list args;
va_start( args, env );
struct pso_pointer new_pointer = in_make_frame( arg_count, previous, args);
struct pso_pointer new_pointer =
in_make_frame( arg_count, previous, args );
pointer_to_pso4( new_pointer )->payload.stack_frame.env = inc_ref( env );
va_end( args );
@ -270,8 +278,8 @@ struct pso_pointer make_frame_with_arglist_and_env( struct pso_pointer
struct pso_pointer arg_length =
count( push_local( previous, make_frame( 1, previous, argvalues ) ) );
int arg_count =
integerp( arg_length ) ? pointer_to_object( arg_length )->
payload.integer.value : 0;
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, "
@ -330,8 +338,8 @@ struct pso_pointer make_frame_with_arglist( struct pso_pointer previous,
struct pso_pointer argvalues ) {
return make_frame_with_arglist_and_env( previous, argvalues,
pointer_to_pso4
( previous )->payload.stack_frame.
env );
( previous )->payload.
stack_frame.env );
}

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

@ -54,6 +54,7 @@ struct pso_pointer make_frame_with_arglist( struct pso_pointer previous,
struct pso_pointer destroy_stack_frame( struct pso_pointer fp,
struct pso_pointer env );
struct pso_pointer add_arg( struct pso_pointer frame_pointer, struct pso_pointer arg_pointer);
struct pso_pointer add_arg( struct pso_pointer frame_pointer,
struct pso_pointer arg_pointer );
#endif