core: Do not hold pointers during variable lookup.

If we want to make variable lookup extensible, we need to call into
Scheme code during lookup.  This might cause the garbage collector
to run, invalidating any pointer held by C code.  This change
updates call sites for variable lookup to avoid holding pointers
into Scheme data.

* src/eval-apply.c (expand_variable_): Store expressions and formals
in GC-managed registers.
(expand_variable): Initialize registers for 'expand_variable_'.
(eval_apply): When evaluating 'define' and 'define-macro' forms, do
not rely on local C variables after calls to 'lookup_binding' or
'expand_variable'.
This commit is contained in:
Timothy Sample 2022-04-23 10:48:01 -06:00
parent 22d89dfa97
commit 31b74c24bf
1 changed files with 48 additions and 20 deletions

View File

@ -266,67 +266,87 @@ formal_p (struct scm *x, struct scm *formals) /*:((internal)) */
return formals->type == TPAIR;
}
struct scm *
expand_variable_ (struct scm *x, struct scm *formals, int top_p) /*:((internal)) */
void
expand_variable_ (int top_p) /*:((internal)) */
{
struct scm *a;
struct scm *f;
struct scm *v;
while (x->type == TPAIR)
while (R1->type == TPAIR)
{
a = x->car;
a = R1->car;
if (a->type == TPAIR)
{
if (a->car == cell_symbol_lambda)
{
f = a->cdr->car;
formals = add_formals (formals, f);
R2 = add_formals (R2, f);
}
else if (a->car == cell_symbol_define || a->car == cell_symbol_define_macro)
{
f = a->cdr->car;
formals = add_formals (formals, f);
R2 = add_formals (R2, f);
}
if (a->car != cell_symbol_quote)
expand_variable_ (a, formals, 0);
{
/* Push this form onto the expansion stack. */
R3 = cons (cons (a, R2), R3);
}
}
else
{
if (a == cell_symbol_lambda)
{
f = x->cdr->car;
formals = add_formals (formals, f);
x = x->cdr;
f = R1->cdr->car;
R2 = add_formals (R2, f);
R1 = R1->cdr;
}
else if (a == cell_symbol_define || a == cell_symbol_define_macro)
{
f = x->cdr->car;
f = R1->cdr->car;
if (top_p != 0 && f->type == TPAIR)
f = f->cdr;
formals = add_formals (formals, f);
x = x->cdr;
R2 = add_formals (R2, f);
R1 = R1->cdr;
}
else if (a == cell_symbol_quote)
return cell_unspecified;
return;
else if (a->type == TSYMBOL
&& a != cell_symbol_current_environment
&& formal_p (x->car, formals) == 0)
&& formal_p (a, R2) == 0)
{
v = lookup_binding (a);
if (v != cell_f)
x->car = v;
R1->car = v;
}
}
x = x->cdr;
R1 = R1->cdr;
top_p = 0;
}
return cell_unspecified;
}
struct scm *
expand_variable (struct scm *x, struct scm *formals) /*:((internal)) */
{
return expand_variable_ (x, formals, 1);
gc_push_frame ();
R1 = x;
R2 = formals;
R3 = cell_nil;
expand_variable_ (1);
while (R3->type == TPAIR)
{
R1 = R3->car->car;
R2 = R3->car->cdr;
R3 = R3->cdr;
expand_variable_ (0);
}
gc_pop_frame ();
return cell_unspecified;
}
struct scm *
@ -657,7 +677,9 @@ eval:
}
else
{
R2 = name;
entry = lookup_binding (name);
name = R2;
if (entry == cell_f)
module_define_x (M0, name, cell_f);
}
@ -671,12 +693,18 @@ eval:
}
else
{
p = pairlis (R1->cdr->car, R1->cdr->car, R0);
formals = R1->cdr->car->cdr;
body = R1->cdr->cdr;
if (macro_p != 0 || global_p != 0)
expand_variable (body, formals);
/* The GC may have moved 'formals' and 'body' during
variable expansion, so get fresh pointers. */
formals = R1->cdr->car->cdr;
body = R1->cdr->cdr;
p = pairlis (R1->cdr->car, R1->cdr->car, R0);
R1 = cons (cell_symbol_lambda, cons (formals, body));
push_cc (R1, R2, p, cell_vm_eval_define);
goto eval;