This is broken, but the stack limit feature works. Some debugging needed.

This commit is contained in:
Simon Brooke 2026-03-13 23:42:57 +00:00
parent 2536e76617
commit d1ce893633
12 changed files with 164 additions and 111 deletions

View file

@ -92,18 +92,21 @@ 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 {
struct stack_frame *next = get_stack_frame( next_pointer );
set_reg( next, 0, form );
next->args = 1;
struct stack_frame *next = get_stack_frame( next_pointer );
set_reg( next, 0, form );
next->args = 1;
result = lisp_eval( next, next_pointer, env );
result = lisp_eval( next, next_pointer, env );
if ( !exceptionp( result ) ) {
/* if we're returning an exception, we should NOT free the
* stack frame. Corollary is, when we free an exception, we
* should free all the frames it's holding on to. */
dec_ref( next_pointer );
if ( !exceptionp( result ) ) {
/* if we're returning an exception, we should NOT free the
* stack frame. Corollary is, when we free an exception, we
* should free all the frames it's holding on to. */
dec_ref( next_pointer );
}
}
}
break;
@ -365,8 +368,8 @@ struct cons_pointer maybe_fixup_exception_location( struct cons_pointer r,
pointer2cell( result ).payload.exception.payload =
make_cons( make_cons( privileged_keyword_location,
c_assoc( name_key,
fn_cell->payload.
function.meta ) ),
fn_cell->payload.function.
meta ) ),
make_cons( make_cons
( privileged_keyword_payload,
payload ), NIL ) );
@ -420,10 +423,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
get_stack_frame( next_pointer );
result = maybe_fixup_exception_location( ( *
( fn_cell->
payload.
function.
executable ) )
( fn_cell->payload.function.executable ) )
( next,
next_pointer,
env ),
@ -497,10 +497,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
result = next_pointer;
} else {
result = maybe_fixup_exception_location( ( *
( fn_cell->
payload.
special.
executable ) )
( fn_cell->payload.special.executable ) )
( get_stack_frame( next_pointer ), next_pointer, env ), fn_pointer );
debug_print( L"Special form returning: ", DEBUG_EVAL );
debug_print_object( result, DEBUG_EVAL );
@ -1339,9 +1336,10 @@ lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer,
* pointer to the frame in which the exception occurred.
*/
struct cons_pointer throw_exception_with_cause( struct cons_pointer location,
struct cons_pointer message,
struct cons_pointer cause,
struct cons_pointer frame_pointer ) {
struct cons_pointer message,
struct cons_pointer cause,
struct cons_pointer
frame_pointer ) {
struct cons_pointer result = NIL;
#ifdef DEBUG
@ -1350,10 +1348,9 @@ struct cons_pointer throw_exception_with_cause( struct cons_pointer location,
debug_print( L"` at `", 511 );
debug_print_object( location, 511 );
debug_print( L"`\n", 511 );
if (!nilp( cause)) {
debug_print( L"\tCaused by: ", 511)
;
debug_print_object( cause, 511);
if ( !nilp( cause ) ) {
debug_print( L"\tCaused by: ", 511 );
debug_print_object( cause, 511 );
debug_print( L"`\n", 511 );
}
#endif
@ -1368,10 +1365,12 @@ struct cons_pointer throw_exception_with_cause( struct cons_pointer location,
location ),
make_cons( make_cons
( privileged_keyword_payload,
message ),
(nilp( cause) ? NIL :
make_cons( make_cons( privileged_keyword_cause,
cause), NIL)) ) ), frame_pointer );
message ),
( nilp( cause ) ? NIL :
make_cons( make_cons
( privileged_keyword_cause,
cause ), NIL ) ) ) ),
frame_pointer );
}
return result;
@ -1392,7 +1391,7 @@ struct cons_pointer
throw_exception( struct cons_pointer location,
struct cons_pointer payload,
struct cons_pointer frame_pointer ) {
return throw_exception_with_cause( location, payload, NIL, frame_pointer);
return throw_exception_with_cause( location, payload, NIL, frame_pointer );
}
/**
@ -1418,10 +1417,9 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ) {
struct cons_pointer message = frame->arg[0];
return exceptionp( message ) ? message : throw_exception_with_cause( message,
frame->arg[1],
frame->arg[2],
frame->previous );
return exceptionp( message ) ? message :
throw_exception_with_cause( message, frame->arg[1], frame->arg[2],
frame->previous );
}
/**
@ -1623,13 +1621,14 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
if ( nilp( c_cdr( l1 ) ) ) {
return
make_string_like_thing( ( pointer2cell( l1 ).payload.
string.character ), l2,
make_string_like_thing( ( pointer2cell( l1 ).
payload.string.character ),
l2,
pointer2cell( l1 ).tag.value );
} else {
return
make_string_like_thing( ( pointer2cell( l1 ).payload.
string.character ),
make_string_like_thing( ( pointer2cell( l1 ).
payload.string.character ),
c_append( c_cdr( l1 ), l2 ),
pointer2cell( l1 ).tag.value );
}