This text is a more in depth look at the code that evaluates expressions in lispBM. I hope that It can be of value to someone, just like the Lisperator code was useful to me.
This code is work in progress and some things look the way they do currently because there is some vague thought of a future direction it may go in. I will try to point out these extra complexities that currently have no direct purpose.
The goal is that the evaluator should have a certain set of properties.
Tail-calls and even infinite recursion (in tail-position) should be possible without ever-growing memory consumption.
At any point where heap space is allocated it must be possible to pause the computation, perform garbage collection (gc), and then pick up execution again where the computation was paused.
Evaluation should be correct in relation to environments (such that the body of a let is evaluated in an environment extended with the bindings). There are also other examples of where similar properties should hold, such as when lambdas are evaluated into closures.
Evaluating an expression should give the expected result.
Writing the code that does all 4 of the above is (at least to me) a bit tricky and I am not entirely sure that every path through the evaluator really maintains these properties yet. As problems shows up, they are addressed.
After writing down the overview of lispBM, some possible simplifications was spotted. While refactoring these I also noticed a case of violating property 1. The code that evaluates the PROGN functionality was written in a way that led to ever-growing memory use if involved in a infinite recursion. For example:
(define f
(lambda (x)
(progn (print "hello")
(f (+ x 1)))))But the problem was possible to fix. I will point out where I fell in the trap later.
Property 1, is tackled by implementing the evaluator in continuation passing style and as a while loop with explicitly managed state. For example, the explicit continuation stack keeps track of arguments to the continuation and which continuation to apply. Care has to be taken that the interactions with the stack happen in the correct order so that we do not end up with ever-growing stack usage. One way to put it is that nothing should be pushed onto the stack before a tail-call and then popped when finally the tail-call returns.
Property 2, is handled at each place where cons-cells are allocated. The exact details differ a little from one place to another, so I will point this out in the code further down. But in essence what it means is that the stack and the evaluation context is set to a previously known state and then the evaluation loop is re-entered with a perform gc flag set. The evaluator will then perform GC in the next iteration. When GC is done the next iteration of the evaluator will continue work with the evaluation context.
Property 3, is dealt with in the cases involving define, let and lambda. Either by making changes to the globally defined environment (in the case of define) or by updating the local environment that the evaluation context maintains.
Property 4, is loosely checked by a growing set of tests located under the tests directory.
There are also a set of flags, perform_gc, apply_continuation and done. These are set in the evaluator loop to signal to itself what it should be doing in the next iteration. done is set when there is an error that it is not possible to recover from. apply_continuation is set if the next iteration should pop information off the stack and process that. This happens for example when evaluation results in base type (such as a number). That number may be a part of an addition as in (+ 1 2). So in the next iteration of the loop the continuation will contain information about what to do with that number. The perform_gc flag is set (as hinted above), when heap is full and we cannot proceed unless gc is executed.
There a couple of often used functions throughout the eval_cps code that comes from other parts of lispBM. Many of these are called enc_X where X can be something like sym, i, u and so on. These functions encode values from the C world into lispBM VALUEs, for example enc_i turns a C integer into a lispBM VALUE representing a 28Bit integer. Similarly there are functions called dec_X that transform values in the other direction.
Now to the code! Evaluation makes use of almost everything else. So most of the lispBM header files are included.
#include "symrepr.h"
#include "heap.h"
#include "env.h"
#include "eval_cps.h"
#include "stack.h"
#include "fundamental.h"
#include "extensions.h"
#ifdef VISUALIZE_HEAP
#include "heap_vis.h"
#endifBelow are the new set of continuation functions (after changes applied since the earlier text on lispBM). There are now only 7 continuation functions instead of 9. The difference is that before there was the three continuations FUNCTION, FUNCTION_APP and ARG_LIST that are now replaced by just APPLICATION and APPLICATION_ARGS. There was also one continuation function that was no longer used at all and could be dropped.
#define DONE 1
#define SET_GLOBAL_ENV 2
#define BIND_TO_KEY_REST 3
#define IF 4
#define PROGN_REST 5
#define APPLICATION 6
#define APPLICATION_ARGS 7There is a little bit of global state maintained by the evaluator. It consists of the global environment (where things defined go) and the evaluation context. There are also some VALUEs, NIL and NONSENSE these symbols are just given names that are easier to write and stand out a bit as they are used quite frequently.
static VALUE eval_cps_global_env;
static VALUE NIL;
static VALUE NONSENSE;
eval_context_t *eval_context = NULL;Then there are a bunch of functions that handle evaluation contexts. These are not very important now. They are written in this way because of a vague plan to let the evaluator work on more than one context where each context represents a task. Since it is possible to pause the evaluation of a context it should be possible to also implement task switching by pausing one context and then activating another.
eval_context_t *eval_cps_get_current_context(void) {
return eval_context;
}
eval_context_t *eval_cps_new_context_inherit_env(VALUE program, VALUE curr_exp) {
eval_context_t *ctx = malloc(sizeof(eval_context_t));
ctx->program = program;
ctx->curr_exp = curr_exp;
ctx->curr_env = eval_context->curr_env; /* TODO: Copy environment */
ctx->K = stack_init(100, true);
ctx->next = eval_context;
eval_context = ctx;
return ctx;
}
void eval_cps_drop_top_context(void) {
eval_context_t *ctx = eval_context;
eval_context = eval_context->next;
stack_del(ctx->K);
free(ctx);
}The eval_cps_get_env is meant to be called by the REPL implementation in case it is interested in knowing the contents of the environment.
VALUE eval_cps_get_env(void) {
return eval_cps_global_env;
}The eval_cps_bi_eval function connects to the fundamental.c module and provides the fundamental function called eval.
VALUE eval_cps_bi_eval(VALUE exp) {
eval_context_t *ctx = eval_cps_get_current_context();
ctx->curr_exp = exp;
return run_eval(ctx);
}The eval_cps_init functions initializes the evaluation state. It takes an argument that decides whether or not the continuation stack is allowed to grow or if it will be of fixed size. The global environment is initialized and a single mapping is added that map nil to nil. The global evaluation context is allocated.
int eval_cps_init(bool grow_continuation_stack) {
int res = 1;
NIL = enc_sym(symrepr_nil());
NONSENSE = enc_sym(symrepr_nonsense());
eval_cps_global_env = NIL;
eval_context = (eval_context_t*)malloc(sizeof(eval_context_t));
eval_context->K = stack_init(100, grow_continuation_stack);
VALUE nil_entry = cons(NIL, NIL);
eval_cps_global_env = cons(nil_entry, eval_cps_global_env);
if (type_of(nil_entry) == VAL_TYPE_SYMBOL ||
type_of(eval_cps_global_env) == VAL_TYPE_SYMBOL) res = 0;
return res;
}The following function frees up the allocated state used by the evaluator.
void eval_cps_del(void) {
stack_del(eval_context->K);
free(eval_context);
}The function that is called from the REPL is called eval_cps_program and takes a list of expressions as argument. This function currently modifies the global evaluation context and then loops over the list of expressions and evaluates them from first to last using the run_eval function. the result of the last expression is returned to the caller.
VALUE eval_cps_program(VALUE lisp) {
eval_context_t *ctx = eval_cps_get_current_context();
ctx->program = lisp;
VALUE res = NIL;
VALUE curr = lisp;
if (symrepr_is_error(dec_sym(lisp))) return lisp;
while (type_of(curr) == PTR_TYPE_CONS) {
if (ctx->K->sp > 0) {
stack_clear(ctx->K); // clear stack if garbage left from failed previous evaluation
}
ctx->curr_exp = car(curr);
ctx->curr_env = NIL;
res = run_eval(ctx);
curr = cdr(curr);
}
return res;
}So now all the surrounding functions are covered, somewhat, and we can go in depth with the evaluation function, run_eval.
The run eval function starts out with pushing the DONE continuation onto the stack and defines some state needed throughout the evaluation:
VALUE run_eval(eval_context_t *ctx){
push_u32(ctx->K, enc_u(DONE));
VALUE r = NIL;
bool done = false;
bool perform_gc = false;
bool app_cont = false;
uint32_t non_gc = 0;The r value is what will hold the result of evaluating the expression. r also holds intermediate results throughout evaluation.
The done flag signals that evaluation is finished, either successfully or ended in an error.
The perform_gc flag, if set, indicates that this iteration of the evaluation loop will include a round of garbage collection.
The app_cont flag signals that a continuation should be applied at this point.
There is a counter non_gc that counts how many time the loop iterated without the garbage collector running. So if perform_gc is set and the counter is 0, we are really entirely out of memory. I think the counter should be replaced with a boolean flag that indicates if GC was run in the iteration before.
After defining up these bookkeeping variables, the loop that runs while (!done) is started.
while (!done) {
#ifdef VISUALIZE_HEAP
heap_vis_gen_image();
#endifheap_vis is a module of lispBM that can be used for debugging purposes. Every time heap_vis_gen_image() is called an image is generated that has one pixel per cons-cell on the heap. Different colors in this image represent things like free, marked and in use.
Next there is a check if this iteration will include a round of garbage collection.
if (perform_gc) {
if (non_gc == 0) {
done = true;
r = enc_sym(symrepr_merror());
continue;
}
non_gc = 0;
heap_perform_gc_aux(eval_cps_global_env,
ctx->curr_env,
ctx->curr_exp,
ctx->program,
r,
ctx->K->data,
ctx->K->sp);
perform_gc = false;
} else {
non_gc ++;
}If perform_gc is set, and we are not in the problematic case when gc was run last iteration, a call to heap_perform_gc_aux will happen. The arguments to this functions are the things that the mark phase should mark as being in use. This involves the continuation stack! The continuation stack can hold pointers to heap structures that are needed in the future and that are not pointed to by any environment.
If the app_cont flag is set, the execution path goes into a function called apply_continuation that takes all the status flags as well as the current intermediate result r as input. The apply_continuation function will pop the top off from the stack and use the value stored there to decide what continuation (from the list of defined continuations) to apply. The r value is given to this continuation but it may also pop additional arguments from the stack.
if (app_cont) {
r = apply_continuation(ctx, r, &done, &perform_gc, &app_cont);
continue;
}Now it is time for the big switch statement that evaluates each of the different language constructs. The value head is used later when the current expression is a list, depending on what the head of that list is evaluation will take different paths. The value variable is a temporary used throughout.
VALUE head;
VALUE value = enc_sym(symrepr_eerror());
switch (type_of(ctx->curr_exp)) {The first case deals with symbols. When a symbol is evaluated it is looked up in the environment, local and global. A symbol can, however, also refer to a fundamental function (such as +) or to an extension (user provided c function). If the symbol is not found in any environment and does not represent a fundamental or extension an evaluation error is returned and the done flag is set.
case VAL_TYPE_SYMBOL:
value = env_lookup(ctx->curr_exp, ctx->curr_env);
if (type_of(value) == VAL_TYPE_SYMBOL &&
dec_sym(value) == symrepr_not_found()) {
value = env_lookup(ctx->curr_exp, eval_cps_global_env);
if (type_of(value) == VAL_TYPE_SYMBOL &&
dec_sym(value) == symrepr_not_found()) {
if (is_fundamental(ctx->curr_exp)) {
value = ctx->curr_exp;
} else if (extensions_lookup(dec_sym(ctx->curr_exp)) == NULL) {
r = enc_sym(symrepr_eerror());
done = true;
continue;
} else {
value = ctx->curr_exp; // symbol representing extension
// evaluates to itself at this stage.
}
}
}
app_cont = true;
r = value;
break;Next the switch statement deals with the other basic types, numbers and arrays, that don't need further evaluation but rather just that they will be passed as argument to some continuation. This is done by setting the app_cont flag and setting r to the what we want passed to the continuation as argument.
case PTR_TYPE_BOXED_F:
case PTR_TYPE_BOXED_U:
case PTR_TYPE_BOXED_I:
case VAL_TYPE_I:
case VAL_TYPE_U:
case VAL_TYPE_CHAR:
case PTR_TYPE_ARRAY:
app_cont = true;
r = ctx->curr_exp;
break;The next two cases ref and stream are not implemented and are currently just vague ideas.
case PTR_TYPE_REF:
case PTR_TYPE_STREAM:
r = enc_sym(symrepr_eerror());
done = true;
break;So, if the expression is not a symbol or other basic type, it should be a list. The next case checks if the expression is a list and then depending on what the head of that list is the evaluation takes different paths.
case PTR_TYPE_CONS:
head = car(ctx->curr_exp);The head of the list is stored in the head variable for easy access.
if (type_of(head) == VAL_TYPE_SYMBOL) {
// Special form: QUOTE
if (dec_sym(head) == symrepr_quote()) {
r = car(cdr(ctx->curr_exp));
app_cont = true;
continue;
}The QUOTE case is easy. It corresponds to an expression such as for example '(+ 1 2), so r is set to (+ 1 2) and then the continuation is applied.
The define form takes two arguments, a symbol and an expression. The expression is evaluated and then the result of that evaluation is stored in a mapping from the symbol to the value in the environment. This will be the first case where a continuation is created. This function also performs a check to see that the programmer is not rebinding nil.
// Special form: DEFINE
if (dec_sym(head) == symrepr_define()) {
VALUE key = car(cdr(ctx->curr_exp));
VALUE val_exp = car(cdr(cdr(ctx->curr_exp)));
if (type_of(key) != VAL_TYPE_SYMBOL ||
key == NIL) {
done = true;
r = enc_sym(symrepr_eerror());
continue;
}
push_u32_2(ctx->K, key, enc_u(SET_GLOBAL_ENV));
ctx->curr_exp = val_exp;
continue;
}The key and val_exp variables are set to the arguments to define. Then at the end, the key and the continuation SET_GLOBAL_ENV are pushed to the continuation stack. The current expression is set to val_exp. This means that in the next iteration the evaluation loop will evaluate the val_exp. When evaluating val_exp is done, the continuation will be called with the result of that evaluation and an additional argument, the key, that is already on the stack. So when entering into the SET_GLOBAL_ENV continuation all the data is available to create the global binding.
The progn takes a sequence of expressions as arguments that are all supposed to be evaluated in turn, from the first to the last. The result of evaluating the last expression in the sequence is the result of the whole thing. There is a check for an empty sequence of expressions which results in nil otherwise a continuation is created in this case as well.
// Special form: PROGN
if (dec_sym(head) == symrepr_progn()) {
VALUE exps = cdr(ctx->curr_exp);
if (type_of(exps) == VAL_TYPE_SYMBOL && exps == NIL) {
r = enc_sym(symrepr_nil());
app_cont = true;
continue;
}
if (symrepr_is_error(exps)) {
r = exps;
done = true;
continue;
}
push_u32_2(ctx->K, cdr(exps), enc_u(PROGN_REST));
ctx->curr_exp = car(exps);
continue;
}The progn case sets up for the continuation by setting the current expression to the head of the sequence of expressions. the pointer to the rest of the list is pushed onto the stack as well as the PROGN_REST continuation. The PROGN_REST continuation thus has two arguments to work with once it gets called. The result of the previously evaluated expression (head) and the rest of the sequence. Later in this text we will see exactly what the continuation functions does in all of these cases.
The lambda case does not create a continuation but it is interesting for another reason. This is the first example of a case that allocates heap memory and thus must be pausable and restartable in the case that there is no free heap space.
// Special form: LAMBDA
if (dec_sym(head) == symrepr_lambda()) {
VALUE env_cpy = env_copy_shallow(ctx->curr_env);
if (type_of(env_cpy) == VAL_TYPE_SYMBOL &&
dec_sym(env_cpy) == symrepr_merror()) {
perform_gc = true;
app_cont = false;
continue; // perform gc and resume evaluation at same expression
}
VALUE env_end;
VALUE body;
VALUE params;
VALUE closure;
env_end = cons(env_cpy,NIL);
body = cons(car(cdr(cdr(ctx->curr_exp))), env_end);
params = cons(car(cdr(ctx->curr_exp)), body);
closure = cons(enc_sym(symrepr_closure()), params);
if (type_of(env_end) == VAL_TYPE_SYMBOL ||
type_of(body) == VAL_TYPE_SYMBOL ||
type_of(params) == VAL_TYPE_SYMBOL ||
type_of(closure) == VAL_TYPE_SYMBOL) {
perform_gc = true;
app_cont = false;
continue; // perform gc and resume evaluation at same expression
}
app_cont = true;
r = closure;
continue;
}The lambda starts out by doing a shallow copy of the local environment, this means that skeleton of the environment is traversed and copied but the copy will point to the same mappings as the original. So only enough new cons-cells are used to for the skeleton-structure of the environment, none for the data itself. This consing can fail with an memory error, symrepr_merror(), symbol as result in which case we are out of heap. In this case the perform_gc flag is set and app_cont is cleared. An important detail is that it does not alter the current expression which means that once the evaluation starts up again the current expression will still be the same lambda case. Thus evaluation will resume. There are more complicated cases of this where changes to the stack have been made and we have to restore this to proper state before continuing, this will appear later.
After copying the environment, a closure is created from the environment copy and the contents of the lambda. This again uses cons and allocates heap space and is followed by a similar check for a memory error. If it all works out though, app_cont is set and r is set to the closure and evaluation continues.
Now the if case:
// Special form: IF
if (dec_sym(head) == symrepr_if()) {
push_u32_3(ctx->K,
car(cdr(cdr(cdr(ctx->curr_exp)))), // Else branch
car(cdr(cdr(ctx->curr_exp))), // Then branch
enc_u(IF));
ctx->curr_exp = car(cdr(ctx->curr_exp));
continue;
}The if case sets up for a continuation that takes the then and else branch expressions as arguments. Then the current expression is set to be the boolean expression that is used to select then or else. So once the boolean has been evaluated we will enter into the continuation that can then set up the system for either evaluating the then or the else branch.
The let takes two arguments, a list of bindings to extend the local environment with and an expression to evaluate in the extended environment. So, to begin with these pieces are bound to variables orig_env, binds and exp for easy access.
// Special form: LET
if (dec_sym(head) == symrepr_let()) {
VALUE orig_env = ctx->curr_env;
VALUE binds = car(cdr(ctx->curr_exp)); // key value pairs.
VALUE exp = car(cdr(cdr(ctx->curr_exp))); // exp to evaluate in the new env.
VALUE curr = binds;
VALUE new_env = orig_env;
if (type_of(binds) != PTR_TYPE_CONS) {
// binds better be nil or there is a programmer error.
ctx->curr_exp = exp;
continue;
}
// Implements letrec by "preallocating" the key parts
while (type_of(curr) == PTR_TYPE_CONS) {
VALUE key = car(car(curr));
VALUE val = NIL;
VALUE binding;
binding = cons(key, val);
new_env = cons(binding, new_env);
if (type_of(binding) == VAL_TYPE_SYMBOL ||
type_of(new_env) == VAL_TYPE_SYMBOL) {
perform_gc = true;
app_cont = false;
continue;
}
curr = cdr(curr);
}
VALUE key0 = car(car(binds));
VALUE val0_exp = car(cdr(car(binds)));
push_u32_5(ctx->K, exp, cdr(binds), new_env,
key0, enc_u(BIND_TO_KEY_REST));
ctx->curr_exp = val0_exp;
ctx->curr_env = new_env;
continue;
}The kind of let implemented here allows bindings defined early in the list of bindings to be used in the definition of the later ones. This is accomplished by a two phase approach where first the environment containing the bindings is created using just the keys (and mapping each of the keys to nil). Then the expressions whose results are to be bound to the keys are evaluated one after the other, in order, in this new environment. Once an expression is evaluated the mapping for that key (that currently is nil) is updated. Of course it is not possible to use a later binding in a currently evaluated expression as that binding would return 'nil` rather than what it is supposed to.
So after setting up the environment with key - nil bindings, a continuation is created and the current expression is set to evaluate the first value to be bound.
Now we have dealt with all special forms (but one) the application form. Once getting to this point we just assume that if the current expression is a list, then it is a function application. This may turn out to be wrong (as it may also be a programmer mistake) in which case evaluation results in an error.
} // If head is symbol
push_u32_4(ctx->K,
ctx->curr_env,
enc_u(0),
cdr(ctx->curr_exp),
enc_u(APPLICATION_ARGS));
ctx->curr_exp = head; // evaluate the function
continue;This case creates a continuation that needs to have access to the current environment, a counter enc_u(0) (to count arguments), the list of arguments cdr(ctx->curr_exp) and the continuation itself is called APPLICATION_ARGS. The current expression is set to the head of the list. This will be evaluated next and will result in either a function object of some kind or an error. A function object could for example be a closure or a symbol pointing out a fundamental operation or an extension.
This concludes the evaluation function. The rest just checks for some serious errors and if the loop is exited r is returned as the result of evaluation.
default:
// BUG No applicable case!
done = true;
r = enc_sym(symrepr_eerror());
break;
}
} // while (!done)
return r;
}So far there have been a number of examples of the creation of continuations but what happens when these are applied is still untold. The apply_continuation function, that takes care of this continuation application, is about the same size as run_eval and really they interact at a quite deep level. run_eval calls apply_continuation and apply_continuation changes the evaluation context meaning it influences what the next iteration of the evaluation loop does.
VALUE apply_continuation(eval_context_t *ctx, VALUE arg, bool *done, bool *perform_gc, bool *app_cont){
VALUE k;
pop_u32(ctx->K, &k);
VALUE res;
*app_cont = false;apply_continuation starts out by popping of the top of the stack that should contain one of the continuation function identifiers defined close to the top of this document. The rest of the function is, just like the evaluation loop, a large switch statement.
switch(dec_u(k)) {
case DONE:
*done = true;
return arg;In case we have reached the DONE continuation, pushed onto the stack when entering run_eval, we are done, the done flag is set and the argument to the continuation arg is returned. arg corresponds to the variable r in the evaluator.
case SET_GLOBAL_ENV:
res = cont_set_global_env(ctx, arg, done, perform_gc);
if (!(*done))
*app_cont = true;
return res;The SET_GLOBAL_ENV continuation is broken out into a separate function. I cannot really decide if I should break all of these cases out into functions or not. The cont_set_global_env function is shown further down.
Now, the PROGN continuation is where a property one breaking mistake was made. Towards the end of the function there is a comment // allow for tail recursion right before a conditional that checks if the rest of the sequence of expressions is nil. If it is nil, we are currently in tail-call position and should not push anything to the stack that we have to potentially wait a long time before it is freed. Forgetting about this special case means a nil is pushed to the stack, only to be dealt with once the tail-call is handled.
case PROGN_REST: {
VALUE rest;
pop_u32(ctx->K, &rest);
if (type_of(rest) == VAL_TYPE_SYMBOL && rest == NIL) {
res = arg;
*app_cont = true;
return res;
}
if (symrepr_is_error(rest)) {
res = rest;
*done = true;
return res;
}
// allow for tail recursion
if (type_of(cdr(rest)) == VAL_TYPE_SYMBOL &&
cdr(rest) == NIL) {
ctx->curr_exp = car(rest);
return NONSENSE;
}
// Else create a continuation
push_u32_2(ctx->K, cdr(rest), enc_u(PROGN_REST));
ctx->curr_exp = car(rest);
return NONSENSE;
}The PROGN case sets up the head of the sequence of expressions to evaluated in the next iteration of the evaluation loop and pushes the rest of the sequence along with the same PROGN_REST continuation onto the stack.
The APPLICATION case is a bit long and messy but really tricky compared to the other cases. It just gets a bit messy because there are a number of things that can be applied. There are closures, fundamental operations and extensions and each of these get a special case in the APPLICATION continuation.
When entering into the APPLICATION case, all the arguments, a counter and the function are present of the stack. in the case of fundamental or extension operations this knowledge is utilized and a pointer to the first argument on the stack is passed to the function. When it comes to the closures however, the arguments are extracted from the stack and added to an augmented environment for the closures body to evaluate in.
It is important that after running a fundamental or an extension the stack is cleared, or we will fall into the property 1 issue again.
case APPLICATION: {
VALUE count;
pop_u32(ctx->K, &count);
UINT *fun_args = stack_ptr(ctx->K, dec_u(count)+1);
VALUE fun = fun_args[0];
if (type_of(fun) == PTR_TYPE_CONS) { // a closure (it better be)
VALUE args = NIL;
for (UINT i = dec_u(count); i > 0; i --) {
args = cons(fun_args[i], args);
if (type_of(args) == VAL_TYPE_SYMBOL) {
push_u32_2(ctx->K, count, enc_u(APPLICATION));
*perform_gc = true;
*app_cont = true;
return fun;
}
}
VALUE params = car(cdr(fun));
VALUE exp = car(cdr(cdr(fun)));
VALUE clo_env = car(cdr(cdr(cdr(fun))));
if (length(params) != length(args)) { // programmer error
*done = true;
return enc_sym(symrepr_eerror());
}
VALUE local_env = env_build_params_args(params, args, clo_env);
if (type_of(local_env) == VAL_TYPE_SYMBOL) {
if (dec_sym(local_env) == symrepr_merror() ) {
push_u32_2(ctx->K, count, enc_u(APPLICATION));
*perform_gc = true;
*app_cont = true;
return fun;
}
if (dec_sym(local_env) == symrepr_fatal_error()) {
return local_env;
}
}
stack_drop(ctx->K, dec_u(count)+1);
ctx->curr_exp = exp;
ctx->curr_env = local_env;
return NONSENSE;
} else if (type_of(fun) == VAL_TYPE_SYMBOL) {
VALUE res;
if (is_fundamental(fun)) {
res = fundamental_exec(&fun_args[1], dec_u(count), fun);
if (type_of(res) == VAL_TYPE_SYMBOL &&
dec_sym(res) == symrepr_eerror()) {
*done = true;
return res;
} else if (type_of(res) == VAL_TYPE_SYMBOL &&
dec_sym(res) == symrepr_merror()) {
push_u32_2(ctx->K, count, enc_u(APPLICATION));
*perform_gc = true;
*app_cont = true;
return fun;
}
stack_drop(ctx->K, dec_u(count) + 1);
*app_cont = true;
return res;
}
}
// It may be an extension
extension_fptr f = extensions_lookup(dec_sym(fun));
if (f == NULL) {
*done = true;
return enc_sym(symrepr_eerror());
}
VALUE ext_res = f(&fun_args[1] , dec_u(count));
if (type_of(ext_res) == VAL_TYPE_SYMBOL &&
(dec_sym(ext_res) == symrepr_merror())) {
push_u32_2(ctx->K, count, enc_u(APPLICATION));
*perform_gc = true;
*app_cont = true;
return fun;
}
stack_drop(ctx->K, dec_u(count) + 1);
*app_cont = true;
return ext_res;
}The `APPLICATION_ARGS' continuation handles evaluation of the list of arguments to a function.
case APPLICATION_ARGS: {
VALUE count;
VALUE env;
VALUE rest;
pop_u32_3(ctx->K, &rest, &count, &env);
push_u32(ctx->K, arg);
if (type_of(rest) == VAL_TYPE_SYMBOL &&
rest == NIL) {
// no more arguments
push_u32_2(ctx->K, count, enc_u(APPLICATION));
*app_cont = true;
return NONSENSE;
}
push_u32_4(ctx->K, env, enc_u(dec_u(count) + 1), cdr(rest), enc_u(APPLICATION_ARGS));
ctx->curr_exp = car(rest);
ctx->curr_env = env;
return NONSENSE;
}Here the current expression is set up to evaluate the head of the list of the rest of the arguments. A continuation is created for evaluating the rest of the arguments. When creating this continuation the number-of-arguments counter is incremented.
Each time APPLICATION_ARGS is entered the previously evaluated argument (or the function in case of the first call to APPLICATION_ARGS) is pushed onto the stack. This means that the stack is now also the vehicle for transport of arguments to the functions. When the list of arguments have been fully evaluated, the stack will contain the function, all of the arguments and the counter value and a APPLICATION continuation is created.
The BIND_TO_KEY_REST continuation, that is created in the let case of the evaluation loop, takes care of evaluating all the expressions to be bound to variables in the local environment.
case BIND_TO_KEY_REST:{
VALUE key;
VALUE env;
VALUE rest;
pop_u32_3(ctx->K, &key, &env, &rest);
env_modify_binding(env, key, arg);
if ( type_of(rest) == PTR_TYPE_CONS ){
VALUE keyn = car(car(rest));
VALUE valn_exp = car(cdr(car(rest)));
push_u32_4(ctx->K, cdr(rest), env, keyn, enc_u(BIND_TO_KEY_REST));
ctx->curr_exp = valn_exp;
ctx->curr_env = env;
return NONSENSE;
}
// Otherwise evaluate the expression in the populated env
VALUE exp;
pop_u32(ctx->K, &exp);
ctx->curr_exp = exp;
ctx->curr_env = env;
return NONSENSE;
}Each time BIND_TO_KEY_REST is called the environment is modified with the recently evaluated value. Once all bindings have been dealt with, the let body is set up to be evaluated within the newly formed local environment.
The IF continuation gets the result of evaluating the boolean condition as an argument. It then sets up for evaluation of either the then or the else branch in the evaluation loop.
case IF: {
VALUE then_branch;
VALUE else_branch;
pop_u32_2(ctx->K, &then_branch, &else_branch);
if (type_of(arg) == VAL_TYPE_SYMBOL && dec_sym(arg) == symrepr_true()) {
ctx->curr_exp = then_branch;
} else {
ctx->curr_exp = else_branch;
}
return NONSENSE;
}Now, if we do reach the end of this switch, something is very wrong and an error is return and evaluation is aborted.
} // end switch
*done = true;
return enc_sym(symrepr_eerror());
}
Back to that broken out function that sets the global environment. It does the work needed for the SET_GLOBAL_ENV continuation. The key to use is on the stack and the value is passed as argument to the continuation. Not we set up a new environment which is the key - val pair consed onto the old global environment. This consing (that is done inside of the env_set function) can fail as usual and we need to be able to be able to pause the computation and perform garbage collection. However, if all works out fine, the global variable eval_cps_global_env is updated with the value of the newly created one.
VALUE cont_set_global_env(eval_context_t *ctx, VALUE val, bool *done, bool *perform_gc){
VALUE key;
pop_u32(ctx->K, &key);
VALUE new_env = env_set(eval_cps_global_env,key,val);
if (type_of(new_env) == VAL_TYPE_SYMBOL) {
if (dec_sym(new_env) == symrepr_merror()) {
push_u32_2(ctx->K, key, enc_u(SET_GLOBAL_ENV));
*perform_gc = true;
return val;
}
if (dec_sym(new_env) == symrepr_fatal_error()) {
*done = true;
return new_env;
}
}
eval_cps_global_env = new_env;
return enc_sym(symrepr_true());
}In order to see what happens when we fail to honor property 1, the push_u32 function that is used in all functions that push onto the stack is augmented with a print statement. This print statement prints the stack pointer sp and the value that is being pushed onto the stack. This experiment is run with a stack that does not allow growing, this is checked internally in the function stack_grow and it will not reallocate the stack if this flag is set.
int push_u32(stack *s, UINT val) {
int res = 1;
s->data[s->sp] = val;
/* Added printf */
printf("Stack sp %d : ",s->sp); simple_print(val); printf("\n");
s->sp++;
if ( s->sp >= s->size) {
res = stack_grow(s);
}
return res;
}The PROGN_REST continuation is a good target to introduce this error in. Below is what it looks like with the code that makes it //allow for tail recursion.
case PROGN_REST: {
VALUE rest;
pop_u32(ctx->K, &rest);
if (type_of(rest) == VAL_TYPE_SYMBOL && rest == NIL) {
res = arg;
*app_cont = true;
return res;
}
if (symrepr_is_error(rest)) {
res = rest;
*done = true;
return res;
}
// allow for tail recursion
if (type_of(cdr(rest)) == VAL_TYPE_SYMBOL &&
cdr(rest) == NIL) {
ctx->curr_exp = car(rest);
return NONSENSE;
}
// Else create a continuation
push_u32_2(ctx->K, cdr(rest), enc_u(PROGN_REST));
ctx->curr_exp = car(rest);
return NONSENSE;
}So let's modify the code by removing that little block. Now it looks as follows.
case PROGN_REST: {
VALUE rest;
pop_u32(ctx->K, &rest);
if (type_of(rest) == VAL_TYPE_SYMBOL && rest == NIL) {
res = arg;
*app_cont = true;
return res;
}
if (symrepr_is_error(rest)) {
res = rest;
*done = true;
return res;
}
// Else create a continuation
push_u32_2(ctx->K, cdr(rest), enc_u(PROGN_REST));
ctx->curr_exp = car(rest);
return NONSENSE;
}Now if we build lispBM and the REPL with this faulty code and enter the following program which is a tail-recursive run-forever program.
(define f
(lambda (x)
(progn (print "hello")
(f (+ x 1)))))The following is the result:
Lisp REPL started!
Type :quit to exit.
:info for statistics.
# (define f (lambda (x) (progn (print "hello") (f (+ x 1)))))
Stack sp 0 : 1
Stack sp 1 : f
Stack sp 2 : 2
> t
# (f 0)
Stack sp 0 : 1
Stack sp 1 : nil
Stack sp 2 : 0
Stack sp 3 : (0 nil)
Stack sp 4 : 8
Stack sp 1 : (closure ((x nil) ((progn ((print ("hello" nil)) ((f ((+ (x (1 nil))) nil)) nil))) (nil nil))))
Stack sp 2 : nil
Stack sp 3 : 1
Stack sp 4 : nil
Stack sp 5 : 8
Stack sp 2 : 0
Stack sp 3 : 1
Stack sp 4 : 7
Stack sp 1 : ((f ((+ (x (1 nil))) nil)) nil)
Stack sp 2 : 6
Stack sp 3 : ((x 0) nil)
Stack sp 4 : 0
...
Stack sp 98 : 48
Stack sp 99 : 1
Stack sp 100 : 7
Stack sp 97 : ((f ((+ (x (1 nil))) nil)) nil)
Stack sp 98 : 6
Stack sp 99 : ((x 48) nil)
Stack sp 100 : 0
Stack sp 101 : ("hello" nil)
Stack sp 102 : 8
Segmentation fault
The stack just keeps growing until it hits about 100 elements (the size of the stack) and a segfault is triggered. We can also see that x has reached the value 48, so 48 iterations of the infinite recursion have been executed and I guess we can conclude that the stack is growing with approximately 2 element per iteration.
When the REPL runs with the fixed code and the same program it keeps running:
Stack sp 1 : (closure ((x nil) ((progn ((print ("hello" nil)) ((f ((+ (x (1 nil))) nil)) nil))) (nil nil))))
Stack sp 2 : ((x 3159) nil)
Stack sp 3 : 1
Stack sp 4 : nil
Stack sp 5 : 7
Stack sp 6 : ((x 3159) nil)
Stack sp 7 : 0
Stack sp 8 : (x (1 nil))
Stack sp 9 : 7
Stack sp 6 : +
Stack sp 7 : ((x 3159) nil)
Stack sp 8 : 1
Stack sp 9 : (1 nil)
Stack sp 10 : 7
Stack sp 7 : 3159
Stack sp 8 : ((x 3159) nil)
Stack sp 9 : 2
Stack sp 10 : nil
Stack sp 11 : 7
Stack sp 8 : 1
Stack sp 9 : 2
Stack sp 10 : 6
Stack sp 2 : 3160
Stack sp 3 : 1
Stack sp 4 : 6
Stack sp 1 : ((f ((+ (x (1 nil))) nil)) nil)
Stack sp 2 : 5
Stack sp 3 : ((x 3160) nil)
Stack sp 4 : 0
Stack sp 5 : ("hello" nil)
Stack sp 6 : 7
Stack sp 3 : print
Here execution was stopped after a short while with ctrl+c and we can see that the stack pointer is at most 11 and also that we have incremented x to 3160 by now. Looks a lot better!
Please contact me with questions, suggestions or feedback at blog (dot) joel (dot) svensson (at) gmail (dot) com or join the google group .
© Copyright 2020 Bo Joel Svensson
This page was generated using Pandoc.