fix bytecode validation for LHS of a define-values created for lifting

svn: r3936
This commit is contained in:
Matthew Flatt 2006-08-02 19:20:40 +00:00
parent cd03877fae
commit cbae980a66
3 changed files with 84 additions and 78 deletions

View File

@ -3642,7 +3642,7 @@ Scheme_Object *scheme_check_immediate_macro(Scheme_Object *first,
SCHEME_EXPAND_OBSERVE_ENTER_CHECK(rec[drec].observer, first);
check_top:
while (1) {
*current_val = NULL;
if (SCHEME_STX_PAIRP(first)) {
@ -3718,8 +3718,7 @@ Scheme_Object *scheme_check_immediate_macro(Scheme_Object *first,
return first;
}
}
goto check_top;
}
}
static Scheme_Object *
@ -7951,7 +7950,8 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
void scheme_validate_toplevel(Scheme_Object *expr, Mz_CPort *port,
char *stack, Scheme_Hash_Table *ht, Scheme_Object **tls,
int depth, int delta,
int num_toplevels, int num_stxes, int num_lifts)
int num_toplevels, int num_stxes, int num_lifts,
int skip_refs_check)
{
if (!SAME_TYPE(scheme_toplevel_type, SCHEME_TYPE(expr)))
scheme_ill_formed_code(port);
@ -7959,7 +7959,7 @@ void scheme_validate_toplevel(Scheme_Object *expr, Mz_CPort *port,
scheme_validate_expr(port, expr, stack, ht, tls,
depth, delta, delta,
num_toplevels, num_stxes, num_lifts,
NULL, 0);
NULL, skip_refs_check ? 1 : 0);
}
void scheme_validate_boxenv(int p, Mz_CPort *port, char *stack, int depth, int delta)

View File

@ -2017,7 +2017,8 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
void scheme_validate_toplevel(Scheme_Object *expr, Mz_CPort *port,
char *stack, Scheme_Hash_Table *ht, Scheme_Object **tls,
int depth, int delta,
int num_toplevels, int num_stxes, int num_lifts);
int num_toplevels, int num_stxes, int num_lifts,
int skip_refs_check);
void scheme_validate_boxenv(int pos, Mz_CPort *port,
char *stack, int depth, int delta);

View File

@ -809,7 +809,8 @@ static void define_values_validate(Scheme_Object *data, Mz_CPort *port,
for (; SCHEME_PAIRP(vars); vars = SCHEME_CDR(vars)) {
scheme_validate_toplevel(SCHEME_CAR(vars), port, stack, ht, tls, depth, delta,
num_toplevels, num_stxes, num_lifts);
num_toplevels, num_stxes, num_lifts,
1);
}
if (!SCHEME_NULLP(vars))
@ -1361,7 +1362,8 @@ static void set_validate(Scheme_Object *data, Mz_CPort *port,
num_toplevels, num_stxes, num_lifts,
NULL, 0);
scheme_validate_toplevel(tl, port, stack, ht, tls, depth, delta,
num_toplevels, num_stxes, num_lifts);
num_toplevels, num_stxes, num_lifts,
0);
}
static Scheme_Object *
@ -1678,7 +1680,8 @@ static void ref_validate(Scheme_Object *tl, Mz_CPort *port,
int num_toplevels, int num_stxes, int num_lifts)
{
scheme_validate_toplevel(tl, port, stack, ht, tls, depth, delta,
num_toplevels, num_stxes, num_lifts);
num_toplevels, num_stxes, num_lifts,
0);
}
static Scheme_Object *
@ -4232,7 +4235,9 @@ static void do_define_syntaxes_validate(Scheme_Object *data, Mz_CPort *port,
scheme_ill_formed_code(port);
}
scheme_validate_toplevel(dummy, port, stack, ht, tls, depth, delta, num_toplevels, num_stxes, num_lifts);
scheme_validate_toplevel(dummy, port, stack, ht, tls, depth, delta,
num_toplevels, num_stxes, num_lifts,
0);
if (!for_stx) {
scheme_validate_code(port, val, ht, sdepth, rp->num_toplevels, rp->num_stxes, rp->num_lifts);