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

Getting closer to tracking down the member bug, but cannot use debugger on laptop screen.

Browse source
This commit is contained in:
Simon Brooke 2026-03-16 15:26:12 +00:00
parent d42ece5711
commit de50a30be2
11 changed files with 89 additions and 55 deletions
Download patch file Download diff file Expand all files Collapse all files

43
src/init.c
View file

@ -47,11 +47,12 @@
*/
struct cons_pointer check_exception( struct cons_pointer pointer,
char *location_descriptor ) {
struct cons_pointer result = NIL;
struct cons_space_object *object = &pointer2cell( pointer );
struct cons_pointer result = pointer;
if ( exceptionp( pointer ) ) {
struct cons_space_object * object = &pointer2cell( pointer);
result = NIL;
fprintf( stderr, "ERROR: Exception at %s: ", location_descriptor );
URL_FILE *ustderr = file_to_url_file( stderr );
fwide( stderr, 1 );
@ -59,27 +60,21 @@ struct cons_pointer check_exception( struct cons_pointer pointer,
free( ustderr );
dec_ref( pointer );
} else {
result = pointer;
}
return result;
}
struct cons_pointer init_documentation_symbol = NIL;
struct cons_pointer init_name_symbol = NIL;
struct cons_pointer init_primitive_symbol = NIL;
void maybe_bind_init_symbols( ) {
if ( nilp( init_documentation_symbol ) ) {
init_documentation_symbol =
if ( nilp( privileged_keyword_documentation ) ) {
privileged_keyword_documentation =
c_string_to_lisp_keyword( L"documentation" );
}
if ( nilp( init_name_symbol ) ) {
init_name_symbol = c_string_to_lisp_keyword( L"name" );
if ( nilp( privileged_keyword_name ) ) {
privileged_keyword_name = c_string_to_lisp_keyword( L"name" );
}
if ( nilp( init_primitive_symbol ) ) {
init_primitive_symbol = c_string_to_lisp_keyword( L"primitive" );
if ( nilp( privileged_keyword_primitive ) ) {
privileged_keyword_primitive = c_string_to_lisp_keyword( L"primitive" );
}
if ( nilp( privileged_symbol_nil ) ) {
privileged_symbol_nil = c_string_to_lisp_symbol( L"nil" );
@ -102,9 +97,9 @@ void maybe_bind_init_symbols( ) {
}
void free_init_symbols( ) {
dec_ref( init_documentation_symbol );
dec_ref( init_name_symbol );
dec_ref( init_primitive_symbol );
dec_ref( privileged_keyword_documentation );
dec_ref( privileged_keyword_name );
dec_ref( privileged_keyword_primitive );
}
/**
@ -124,10 +119,10 @@ struct cons_pointer bind_function( wchar_t *name,
struct cons_pointer d = c_string_to_lisp_string( doc );
struct cons_pointer meta =
make_cons( make_cons( init_primitive_symbol, TRUE ),
make_cons( make_cons( init_name_symbol, n ),
make_cons( make_cons( privileged_keyword_primitive, TRUE ),
make_cons( make_cons( privileged_keyword_name, n ),
make_cons( make_cons
( init_documentation_symbol, d ),
( privileged_keyword_documentation, d ),
NIL ) ) );
struct cons_pointer r =
@ -153,10 +148,10 @@ struct cons_pointer bind_special( wchar_t *name,
struct cons_pointer d = c_string_to_lisp_string( doc );
struct cons_pointer meta =
make_cons( make_cons( init_primitive_symbol, TRUE ),
make_cons( make_cons( init_name_symbol, n ),
make_cons( make_cons( privileged_keyword_primitive, TRUE ),
make_cons( make_cons( privileged_keyword_name, n ),
make_cons( make_cons
( init_documentation_symbol, d ),
( privileged_keyword_documentation, d ),
NIL ) ) );
struct cons_pointer r =

20
src/memory/consspaceobject.c
View file

@ -45,6 +45,26 @@ struct cons_pointer privileged_keyword_payload = NIL;
*/
struct cons_pointer privileged_keyword_cause = NIL;
/**
* @brief keywords used in documentation: `:documentation`. Instantiated in
* `init.c`, q. v.
*
*/
struct cons_pointer privileged_keyword_documentation = NIL;
/**
* @brief keywords used in documentation: `:name`. Instantiated in
* `init.c`, q. v.
*/
struct cons_pointer privileged_keyword_name = NIL;
/**
* @brief keywords used in documentation: `:primitive`. Instantiated in
* `init.c`, q. v.
*/
struct cons_pointer privileged_keyword_primitive = NIL;
/**
* True if the value of the tag on the cell at this `pointer` is this `value`,
* or, if the tag of the cell is `VECP`, if the value of the tag of the

18
src/memory/consspaceobject.h
View file

@ -74,6 +74,24 @@ extern struct cons_pointer privileged_keyword_payload;
*/
extern struct cons_pointer privileged_keyword_cause;
/**
* @brief keywords used in documentation: `:documentation`. Instantiated in
* `init.c`, q. v.
*/
extern struct cons_pointer privileged_keyword_documentation;
/**
* @brief keywords used in documentation: `:name`. Instantiated in
* `init.c`, q. v.
*/
extern struct cons_pointer privileged_keyword_name;
/**
* @brief keywords used in documentation: `:primitive`. Instantiated in
* `init.c`, q. v.
*/
extern struct cons_pointer privileged_keyword_primitive;
/**
* An unallocated cell on the free list - should never be encountered by a Lisp
* function.

31
src/ops/lispops.c
View file

@ -91,7 +91,7 @@ struct cons_pointer eval_form( struct stack_frame *parent,
{
struct cons_pointer next_pointer =
make_empty_frame( parent_pointer );
// inc_ref( next_pointer );
if ( exceptionp( next_pointer ) ) {
result = next_pointer;
} else {
@ -275,7 +275,6 @@ eval_lambda( struct cons_space_object *cell, struct stack_frame *frame,
names = c_cdr( names );
}
// inc_ref( new_env );
/* \todo if there's more than `args_in_frame` arguments, bind those too. */
} else if ( symbolp( names ) ) {
@ -296,7 +295,6 @@ eval_lambda( struct cons_space_object *cell, struct stack_frame *frame,
}
new_env = set( names, vals, new_env );
// inc_ref( new_env );
}
while ( !nilp( body ) ) {
@ -311,9 +309,7 @@ eval_lambda( struct cons_space_object *cell, struct stack_frame *frame,
/* if a result is not the terminal result in the lambda, it's a
* side effect, and needs to be GCed */
if ( !nilp( result ) ) {
dec_ref( result );
}
dec_ref( result );
result = eval_form( frame, frame_pointer, sexpr, new_env );
@ -322,6 +318,7 @@ eval_lambda( struct cons_space_object *cell, struct stack_frame *frame,
}
}
// TODO: I think we do need to dec_ref everything on new_env back to env
// dec_ref( new_env );
debug_print( L"eval_lambda returning: \n", DEBUG_LAMBDA );
@ -346,8 +343,6 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
struct cons_pointer payload =
pointer2cell( result ).payload.exception.payload;
/* TODO: should name_key also be a privileged keyword? */
struct cons_pointer name_key = c_string_to_lisp_keyword( L"name" );
switch ( get_tag_value( payload ) ) {
case NILTV:
@ -358,7 +353,7 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
payload ) ) ) {
pointer2cell( result ).payload.exception.payload =
set( privileged_keyword_location,
c_assoc( name_key,
c_assoc( privileged_keyword_name,
fn_cell->payload.function.meta ),
payload );
}
@ -367,15 +362,13 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
default:
pointer2cell( result ).payload.exception.payload =
make_cons( make_cons( privileged_keyword_location,
c_assoc( name_key,
c_assoc( privileged_keyword_name,
fn_cell->payload.function.
meta ) ),
make_cons( make_cons
( privileged_keyword_payload,
payload ), NIL ) );
}
dec_ref( name_key );
}
return result;
@ -415,7 +408,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer exep = NIL;
struct cons_pointer next_pointer =
make_stack_frame( frame_pointer, args, env );
// inc_ref( next_pointer );
if ( exceptionp( next_pointer ) ) {
result = next_pointer;
} else {
@ -446,7 +439,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer exep = NIL;
struct cons_pointer next_pointer =
make_stack_frame( frame_pointer, args, env );
// inc_ref( next_pointer );
if ( exceptionp( next_pointer ) ) {
result = next_pointer;
} else {
@ -475,7 +468,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
{
struct cons_pointer next_pointer =
make_special_frame( frame_pointer, args, env );
// inc_ref( next_pointer );
if ( exceptionp( next_pointer ) ) {
result = next_pointer;
} else {
@ -492,7 +485,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
{
struct cons_pointer next_pointer =
make_special_frame( frame_pointer, args, env );
// inc_ref( next_pointer );
if ( exceptionp( next_pointer ) ) {
result = next_pointer;
} else {
@ -580,7 +573,7 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer,
message, frame_pointer );
} else {
result = c_assoc( canonical, env );
inc_ref( result );
// inc_ref( result );
}
}
break;
@ -1196,7 +1189,7 @@ c_progn( struct stack_frame *frame, struct cons_pointer frame_pointer,
while ( consp( expressions ) ) {
struct cons_pointer r = result;
inc_ref( r );
result = eval_form( frame, frame_pointer, c_car( expressions ), env );
dec_ref( r );
@ -1227,7 +1220,6 @@ lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer,
for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ); i++ ) {
struct cons_pointer r = result;
inc_ref( r );
result = eval_form( frame, frame_pointer, frame->arg[i], env );
@ -1672,7 +1664,6 @@ struct cons_pointer lisp_mapcar( struct stack_frame *frame,
for ( struct cons_pointer c = frame->arg[1]; truep( c ); c = c_cdr( c ) ) {
struct cons_pointer expr =
make_cons( frame->arg[0], make_cons( c_car( c ), NIL ) );
inc_ref( expr );
debug_printf( DEBUG_EVAL, L"Mapcar %d, evaluating ", i );
debug_print_object( expr, DEBUG_EVAL );