/* * stack.c * * The Lisp evaluation stack. * * Stack frames could be implemented in cons space; indeed, the stack * could simply be an assoc list consed onto the front of the environment. * But such a stack would be costly to search. The design sketched here, * with stack frames as special objects, SHOULD be substantially more * efficient, but does imply we need to generalise the idea of cons pages * with freelists to a more general 'equal sized object pages', so that * allocating/freeing stack frames can be more efficient. * * Stack frames are not yet a first class object; they have no VECP pointer * in cons space. * * (c) 2017 Simon Brooke * Licensed under GPL version 2.0, or, at your option, any later version. */ #include #include "consspaceobject.h" #include "conspage.h" #include "lispops.h" #include "print.h" #include "stack.h" /** * Make an empty stack frame, and return it. * @param previous the current top-of-stack; * @param env the environment in which evaluation happens. * @return the new frame. */ struct stack_frame *make_empty_frame( struct stack_frame *previous, struct cons_pointer env ) { struct stack_frame *result = malloc( sizeof( struct stack_frame ) ); /* * TODO: later, pop a frame off a free-list of stack frames */ result->previous = previous; /* * clearing the frame with memset would probably be slightly quicker, but * this is clear. */ result->more = NIL; result->function = NIL; for ( int i = 0; i < args_in_frame; i++ ) { result->arg[i] = NIL; } return result; } /** * Allocate a new stack frame with its previous pointer set to this value, * its arguments set up from these args, evaluated in this env. * @param previous the current top-of-stack; * @args the arguments to load into this frame; * @param env the environment in which evaluation happens. * @return the new frame. */ struct stack_frame *make_stack_frame( struct stack_frame *previous, struct cons_pointer args, struct cons_pointer env ) { struct stack_frame *result = make_empty_frame( previous, env ); for ( int i = 0; i < args_in_frame && consp( args ); i++ ) { /* iterate down the arg list filling in the arg slots in the * frame. When there are no more slots, if there are still args, * stash them on more */ struct cons_space_object cell = pointer2cell( args ); /* * TODO: if we were running on real massively parallel hardware, * each arg except the first should be handed off to another * processor to be evaled in parallel; but see notes here: * https://github.com/simon-brooke/post-scarcity/wiki/parallelism */ struct stack_frame *arg_frame = make_empty_frame( result, env ); arg_frame->arg[0] = cell.payload.cons.car; inc_ref( arg_frame->arg[0] ); struct cons_pointer val = lisp_eval( arg_frame, env ); if ( exceptionp( val ) ) { result->arg[0] = val; break; } else { result->arg[i] = val; } inc_ref( val ); free_stack_frame( arg_frame ); args = cell.payload.cons.cdr; } if ( consp( args ) ) { /* if we still have args, eval them and stick the values on `more` */ struct cons_pointer more = eval_forms( previous, args, env ); result->more = more; inc_ref( more ); } dump_frame( stderr, result ); return result; } /** * A 'special' frame is exactly like a normal stack frame except that the * arguments are unevaluated. * @param previous the previous stack frame; * @param args a list of the arguments to be stored in this stack frame; * @param env the execution environment; * @return a new special frame. */ struct stack_frame *make_special_frame( struct stack_frame *previous, struct cons_pointer args, struct cons_pointer env ) { struct stack_frame *result = make_empty_frame( previous, env ); for ( int i = 0; i < args_in_frame && !nilp( args ); i++ ) { /* iterate down the arg list filling in the arg slots in the * frame. When there are no more slots, if there are still args, * stash them on more */ struct cons_space_object cell = pointer2cell( args ); result->arg[i] = cell.payload.cons.car; inc_ref( result->arg[i] ); args = cell.payload.cons.cdr; } if ( consp( args ) ) { result->more = args; inc_ref( args ); } return result; } /** * Free this stack frame. */ void free_stack_frame( struct stack_frame *frame ) { /* * TODO: later, push it back on the stack-frame freelist */ for ( int i = 0; i < args_in_frame; i++ ) { dec_ref( frame->arg[i] ); } if ( !nilp( frame->more ) ) { dec_ref( frame->more ); } free( frame ); } /** * Dump a stackframe to this stream for debugging * @param output the stream * @param frame the frame */ void dump_frame( FILE * output, struct stack_frame *frame ) { fputws( L"Dumping stack frame\n", output ); for ( int arg = 0; arg < args_in_frame; arg++ ) { struct cons_space_object cell = pointer2cell( frame->arg[arg] ); fwprintf( output, L"Arg %d:\t%c%c%c%c\tcount: %10u\tvalue: ", arg, cell.tag.bytes[0], cell.tag.bytes[1], cell.tag.bytes[2], cell.tag.bytes[3], cell.count ); print( output, frame->arg[arg] ); fputws( L"\n", output ); } fputws( L"More: \t", output ); print( output, frame->more ); fputws( L"\n", output ); } /** * Fetch a pointer to the value of the local variable at this index. */ struct cons_pointer fetch_arg( struct stack_frame *frame, unsigned int index ) { struct cons_pointer result = NIL; if ( index < args_in_frame ) { result = frame->arg[index]; } else { struct cons_pointer p = frame->more; for ( int i = args_in_frame; i < index; i++ ) { p = pointer2cell( p ).payload.cons.cdr; } result = pointer2cell( p ).payload.cons.car; } return result; }