summaryrefslogtreecommitdiffstats
path: root/eval.c
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2015-11-05 05:25:21 -0800
committerKaz Kylheku <kaz@kylheku.com>2015-11-05 05:25:21 -0800
commit33719b3b1101faef84ca091540caffb652b9d0dd (patch)
tree03a82844d9b5d9d130325b72ae0d61d196fe7386 /eval.c
parent7deb862ac8925c4ced0246adbd79b353b88512d8 (diff)
downloadtxr-33719b3b1101faef84ca091540caffb652b9d0dd.tar.gz
txr-33719b3b1101faef84ca091540caffb652b9d0dd.tar.bz2
txr-33719b3b1101faef84ca091540caffb652b9d0dd.zip
Copy envs for middle-of-binding continuations.
When continuations are captured/restored in the middle of variable binding constructs, a hidden problem occurs. Binding constructs work by allocating an empty environment and then destructively extending it. Since the environment is not on the stack, but a referenced object, it doesn't get deep copied into a continuation. As the continuation is revived repeatedly, parts of the variable binding code are repeatedly re-executed, and keep pushing fresh bindings into the same environment object. Though the new bindings correctly shadow the old, the old bindings are there and potentially hang on to garbage. The solution taken here is to introduce a new kind of frame for handling the situation: a continuation copy handling frame. This frame allows functions to register objects to be copied more deeply if a continuation is captured/revived across them. * eval.c (copy_env): New static function. (copy_env_handler): New static function. (bind_args, bind_macro_params): Install continuation copy handling frame for cloning new_env. (struct bindings_helper_vars): New struct type. (copy_bh_env_handler): New static function. (bindings_helper): Install continuation copy handling frame for de and ne variables which hold environments. The variables are moved to a struct to facilitate access from the handler. * eval.h (copy_env): Declared. * unwind.c (uw_push_cont_copy): New function. (call_copy_handler): New static function. (revive_cont): When a continuation is being revived invoke the copying actions in its continuation copy handling frames, but not if it is only being temporarily revived for immediate unwinding. (capture_cont): After copying the continuation, invoke any continuation copying frames in the "parent": the original frames that were captured. * unwind.h (enum uw_frtype): New type, UW_CONT_COPY. (struct uw_cont_copy): New struct type. (union uw_frame): New member cp. (uw_push_cont_copy): Declared.
Diffstat (limited to 'eval.c')
-rw-r--r--eval.c82
1 files changed, 68 insertions, 14 deletions
diff --git a/eval.c b/eval.c
index 62841f6e..9a635371 100644
--- a/eval.c
+++ b/eval.c
@@ -114,6 +114,21 @@ val make_env(val vbindings, val fbindings, val up_env)
return env;
}
+val copy_env(val oenv)
+{
+ type_check(oenv, ENV);
+
+ {
+ val nenv = make_obj();
+
+ nenv->e.type = ENV;
+ nenv->e.fbindings = copy_alist(oenv->e.fbindings);
+ nenv->e.vbindings = copy_alist(oenv->e.vbindings);
+ nenv->e.up_env = oenv->e.up_env;
+ return nenv;
+ }
+}
+
/*
* Wrapper for performance reasons: don't make make_env
* process default arguments.
@@ -448,12 +463,21 @@ static val abbrev_ctx(val ctx_form)
return lit("");
}
+static void copy_env_handler(mem_t *ptr, int parent)
+{
+ val *penv = coerce(val *, ptr);
+ *penv = copy_env(*penv);
+}
+
static val bind_args(val env, val params, struct args *args, val ctx_form)
{
val new_env = make_env(nil, nil, env);
val optargs = nil;
val special_list = nil;
cnum index = 0;
+ uw_frame_t uw_cc;
+
+ uw_push_cont_copy(&uw_cc, coerce(mem_t *, &new_env), copy_env_handler);
for (; args_more(args, index) && consp(params); params = cdr(params)) {
val param = car(params);
@@ -564,6 +588,8 @@ static val bind_args(val env, val params, struct args *args, val ctx_form)
}
+ uw_pop_frame(&uw_cc);
+
return new_env;
twocol:
eval_error(ctx_form, lit("~s: multiple colons in parameter list"),
@@ -750,6 +776,9 @@ static val bind_macro_params(val env, val menv, val params, val form,
val whole = form;
val optargs = nil;
val specials = nil;
+ uw_frame_t uw_cc;
+
+ uw_push_cont_copy(&uw_cc, coerce(mem_t *, &new_env), copy_env_handler);
if (consp(params)) {
val head = car(params);
@@ -825,7 +854,7 @@ static val bind_macro_params(val env, val menv, val params, val form,
param, car(form),
loose_p, ctx_form);
if (!new_env)
- return nil;
+ goto nil_out;
}
} else {
err_sym = param;
@@ -838,7 +867,7 @@ static val bind_macro_params(val env, val menv, val params, val form,
if (form) {
if (loose_p == colon_k)
- return nil;
+ goto nil_out;
eval_error(ctx_form, lit("~s: atom ~s not matched by parameter list"),
car(ctx_form), form, nao);
}
@@ -848,7 +877,7 @@ static val bind_macro_params(val env, val menv, val params, val form,
eval_error(ctx_form, lit("~s: insufficient number of arguments"),
car(ctx_form), nao);
if (loose_p == colon_k)
- return nil;
+ goto nil_out;
}
noarg:
@@ -889,19 +918,25 @@ noarg:
goto nbind;
}
env_vbind_special(new_env, params, form, specials, ctx_form);
- return new_env;
+ goto out;
}
if (form) {
if (loose_p == colon_k)
- return nil;
+ goto nil_out;
eval_error(ctx_form,
lit("~s: extra form part ~s not matched by parameter list"),
car(ctx_form), form, nao);
}
+out:
+ uw_pop_frame(&uw_cc);
return new_env;
+nil_out:
+ uw_pop_frame(&uw_cc);
+ return nil;
+
nbind:
eval_error(ctx_form, lit("~s: ~s is not a bindable symbol"),
car(ctx_form), err_sym, nao);
@@ -1111,15 +1146,31 @@ static val op_unquote_error(val form, val env)
return second(form);
}
+struct bindings_helper_vars {
+ val de;
+ val ne;
+};
+
+static void copy_bh_env_handler(mem_t *ptr, int parent)
+{
+ struct bindings_helper_vars *pv = coerce(struct bindings_helper_vars *, ptr);
+ if (pv->de)
+ pv->de = copy_env(pv->de);
+ pv->ne = copy_env(pv->ne);
+}
static val bindings_helper(val vars, val env, val sequential,
val *env_out, val ret_new_bindings,
val ctx_form)
{
val iter;
- val de = if3(sequential, dyn_env, nil);
- val ne = if3(sequential, env, make_env(nil, nil, env));
+ struct bindings_helper_vars v;
list_collect_decl (new_bindings, ptail);
+ uw_frame_t uw_cc;
+ v.de = if3(sequential, dyn_env, nil);
+ v.ne = if3(sequential, env, make_env(nil, nil, env));
+
+ uw_push_cont_copy(&uw_cc, coerce(mem_t *, &v), copy_bh_env_handler);
for (iter = vars; iter; iter = cdr(iter)) {
val item = car(iter);
@@ -1127,33 +1178,36 @@ static val bindings_helper(val vars, val env, val sequential,
if (consp(item)) {
var = pop(&item);
- value = eval(pop(&item), if3(sequential, ne, env), ctx_form);
+ value = eval(pop(&item), if3(sequential, v.ne, env), ctx_form);
} else {
var = item;
}
if (var == special_s) {
val special = car(item);
- val binding = env_vbind(de = (de ? de : make_env(nil, nil, dyn_env)),
+ val binding = env_vbind(v.de = (v.de ? v.de
+ : make_env(nil, nil, dyn_env)),
special, value);
if (ret_new_bindings)
ptail = list_collect (ptail, binding);
} else if (bindable(var)) {
- val le = if3(sequential, make_env(nil, nil, ne), ne);
+ val le = if3(sequential, make_env(nil, nil, v.ne), v.ne);
val binding = env_vbind(le, var, value);
if (ret_new_bindings)
ptail = list_collect (ptail, binding);
- ne = le;
+ v.ne = le;
} else {
eval_error(ctx_form, lit("~s: ~s is not a bindable symbol"),
car(ctx_form), var, nao);
}
}
- if (de && de != dyn_env)
- dyn_env = de;
+ if (v.de && v.de != dyn_env)
+ dyn_env = v.de;
if (env_out)
- *env_out = ne;
+ *env_out = v.ne;
+
+ uw_pop_frame(&uw_cc);
return new_bindings;
}