suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix bytecode validator to accept letrec-bound flonum-consuming functions

Browse Source 
Closes PR 11009
This commit is contained in:
Matthew Flatt 2010-06-30 22:02:44 -06:00
parent e4cd5329fb
commit 159daa43aa
4 changed files with 119 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
src/racket/src/eval.c
View File

@ -11723,7 +11723,7 @@ void scheme_validate_code(Mz_CPort *port, Scheme_Object *code,
depth, delta, delta,
num_toplevels, num_stxes, num_lifts,
NULL, 0, 0,
vc, 1, 0);
vc, 1, 0, NULL);
}
} else {
scheme_validate_expr(port, code,
@ -11731,7 +11731,7 @@ void scheme_validate_code(Mz_CPort *port, Scheme_Object *code,
depth, delta, delta,
num_toplevels, num_stxes, num_lifts,
NULL, 0, 0,
vc, 1, 0);
vc, 1, 0, NULL);
}
}
@ -11744,6 +11744,7 @@ static Scheme_Object *validate_k(void)
int *args = (int *)(((void **)p->ku.k.p5)[0]);
Scheme_Object *app_rator = (Scheme_Object *)(((void **)p->ku.k.p5)[1]);
Validate_TLS tls = (Validate_TLS)(((void **)p->ku.k.p5)[2]);
Scheme_Hash_Tree *procs = (Scheme_Hash_Tree *)(((void **)p->ku.k.p5)[3]);
struct Validate_Clearing *vc = (struct Validate_Clearing *)p->ku.k.p4;
p->ku.k.p1 = NULL;
@ -11756,11 +11757,14 @@ static Scheme_Object *validate_k(void)
args[0], args[1], args[2],
args[3], args[4], args[5],
app_rator, args[6], args[7], vc, args[8],
args[9]);
args[9], procs);
return scheme_true;
}
/* FIXME: need to validate that a flonum is provided when a
procedure expects a flonum */
int scheme_validate_rator_wants_box(Scheme_Object *app_rator, int pos,
int hope,
Validate_TLS tls,
@ -11862,7 +11866,7 @@ static int argument_to_arity_error(Scheme_Object *app_rator, int proc_with_refs_
void scheme_validate_closure(Mz_CPort *port, Scheme_Object *expr,
char *closure_stack, Validate_TLS tls,
int num_toplevels, int num_stxes, int num_lifts,
int self_pos_in_closure)
int self_pos_in_closure, Scheme_Hash_Tree *procs)
{
Scheme_Closure_Data *data = (Scheme_Closure_Data *)expr;
int i, sz, cnt, base, base2;
@ -11904,21 +11908,29 @@ void scheme_validate_closure(Mz_CPort *port, Scheme_Object *expr,
}
scheme_validate_expr(port, data->code, new_stack, tls, sz, sz, base, num_toplevels, num_stxes, num_lifts,
NULL, 0, 0, vc, 1, 0);
NULL, 0, 0, vc, 1, 0, procs);
}
static Scheme_Hash_Tree *as_nonempty_procs(Scheme_Hash_Tree *procs)
{
if (!procs)
procs = scheme_make_hash_tree(0);
return procs;
}
static void validate_unclosed_procedure(Mz_CPort *port, Scheme_Object *expr,
char *stack, Validate_TLS tls,
int depth, int delta,
int num_toplevels, int num_stxes, int num_lifts,
Scheme_Object *app_rator, int proc_with_refs_ok,
int self_pos)
int self_pos, Scheme_Hash_Tree *procs)
{
Scheme_Closure_Data *data = (Scheme_Closure_Data *)expr;
int i, cnt, q, p, sz, base, vld, self_pos_in_closure = -1, typed_arg = 0;
int i, cnt, q, p, sz, base, stack_delta, vld, self_pos_in_closure = -1, typed_arg = 0;
mzshort *map;
char *closure_stack;
Scheme_Object *proc;
Scheme_Hash_Tree *new_procs = NULL;
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS) {
sz = data->closure_size + data->num_params;
@ -11953,6 +11965,7 @@ static void validate_unclosed_procedure(Mz_CPort *port, Scheme_Object *expr,
cnt = data->closure_size;
base = base - cnt;
stack_delta = data->max_let_depth - sz;
for (i = 0; i < cnt; i++) {
q = map[i];
@ -11979,6 +11992,14 @@ static void validate_unclosed_procedure(Mz_CPort *port, Scheme_Object *expr,
vld = VALID_NOT;
closure_stack[i + base] = vld;
if (procs) {
proc = scheme_hash_tree_get(procs, scheme_make_integer(p));
if (proc)
new_procs = scheme_hash_tree_set(as_nonempty_procs(new_procs),
scheme_make_integer(i + base + stack_delta),
proc);
}
}
if (typed_arg) {
@ -11990,7 +12011,7 @@ static void validate_unclosed_procedure(Mz_CPort *port, Scheme_Object *expr,
if (SCHEME_RPAIRP(data->code)) {
/* Delay validation */
Scheme_Object *vec;
vec = scheme_make_vector(7, NULL);
vec = scheme_make_vector(8, NULL);
SCHEME_VEC_ELS(vec)[0] = SCHEME_CAR(data->code);
SCHEME_VEC_ELS(vec)[1] = (Scheme_Object *)closure_stack;
SCHEME_VEC_ELS(vec)[2] = (Scheme_Object *)tls;
@ -11998,9 +12019,11 @@ static void validate_unclosed_procedure(Mz_CPort *port, Scheme_Object *expr,
SCHEME_VEC_ELS(vec)[4] = scheme_make_integer(num_stxes);
SCHEME_VEC_ELS(vec)[5] = scheme_make_integer(num_lifts);
SCHEME_VEC_ELS(vec)[6] = scheme_make_integer(self_pos_in_closure);
SCHEME_VEC_ELS(vec)[7] = new_procs ? (Scheme_Object *)new_procs : scheme_false;
SCHEME_CAR(data->code) = vec;
} else
scheme_validate_closure(port, expr, closure_stack, tls, num_toplevels, num_stxes, num_lifts, self_pos_in_closure);
scheme_validate_closure(port, expr, closure_stack, tls, num_toplevels, num_stxes, num_lifts,
self_pos_in_closure, new_procs);
}
static void check_self_call_valid(Scheme_Object *rator, Mz_CPort *port, struct Validate_Clearing *vc,
@ -12047,7 +12070,7 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
Scheme_Object *app_rator, int proc_with_refs_ok,
int result_ignored,
struct Validate_Clearing *vc, int tailpos,
int need_flonum)
int need_flonum, Scheme_Hash_Tree *procs)
{
Scheme_Type type;
int did_one = 0, vc_merge = 0, vc_merge_start = 0;
@ -12077,10 +12100,11 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
args[8] = tailpos;
args[9] = need_flonum;
pr = MALLOC_N(void*, 3);
pr = MALLOC_N(void*, 4);
pr[0] = (void *)args;
pr[1] = (void *)app_rator;
pr[2] = (void *)tls;
pr[3] = (void *)procs;
p->ku.k.p5 = (void *)pr;
@ -12197,6 +12221,11 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
stack[p] = VALID_VAL_NOCLEAR;
}
}
if (procs && !proc_with_refs_ok) {
if (scheme_hash_tree_get(procs, scheme_make_integer(p)))
scheme_ill_formed_code(port);
}
}
break;
case scheme_local_unbox_type:
@ -12237,7 +12266,7 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
f = scheme_syntax_validaters[p];
f((Scheme_Object *)SCHEME_IPTR_VAL(expr), port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, vc, tailpos);
num_toplevels, num_stxes, num_lifts, vc, tailpos, procs);
}
break;
case scheme_application_type:
@ -12256,7 +12285,7 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
for (i = 0; i < n; i++) {
scheme_validate_expr(port, app->args[i], stack, tls, depth, letlimit, delta, num_toplevels, num_stxes, num_lifts,
i ? app->args[0] : NULL, i + 1, 0, vc, 0, 0);
i ? app->args[0] : NULL, i + 1, 0, vc, 0, 0, procs);
}
if (tailpos)
@ -12275,9 +12304,9 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
stack[delta] = VALID_NOT;
scheme_validate_expr(port, app->rator, stack, tls, depth, letlimit, delta, num_toplevels, num_stxes, num_lifts,
NULL, 1, 0, vc, 0, 0);
NULL, 1, 0, vc, 0, 0, procs);
scheme_validate_expr(port, app->rand, stack, tls, depth, letlimit, delta, num_toplevels, num_stxes, num_lifts,
app->rator, 2, 0, vc, 0, 0);
app->rator, 2, 0, vc, 0, 0, procs);
if (tailpos)
check_self_call_valid(app->rator, port, vc, delta, stack);
@ -12296,11 +12325,11 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
stack[delta+1] = VALID_NOT;
scheme_validate_expr(port, app->rator, stack, tls, depth, letlimit, delta, num_toplevels, num_stxes, num_lifts,
NULL, 1, 0, vc, 0, 0);
NULL, 1, 0, vc, 0, 0, procs);
scheme_validate_expr(port, app->rand1, stack, tls, depth, letlimit, delta, num_toplevels, num_stxes, num_lifts,
app->rator, 2, 0, vc, 0, 0);
app->rator, 2, 0, vc, 0, 0, procs);
scheme_validate_expr(port, app->rand2, stack, tls, depth, letlimit, delta, num_toplevels, num_stxes, num_lifts,
app->rator, 3, 0, vc, 0, 0);
app->rator, 3, 0, vc, 0, 0, procs);
if (tailpos)
check_self_call_valid(app->rator, port, vc, delta, stack);
@ -12318,7 +12347,7 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
for (i = 0; i < cnt - 1; i++) {
scheme_validate_expr(port, seq->array[i], stack, tls, depth, letlimit, delta, num_toplevels, num_stxes, num_lifts,
NULL, 0, 1, vc, 0, 0);
NULL, 0, 1, vc, 0, 0, procs);
}
expr = seq->array[cnt - 1];
@ -12334,7 +12363,7 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
b = (Scheme_Branch_Rec *)expr;
scheme_validate_expr(port, b->test, stack, tls, depth, letlimit, delta, num_toplevels, num_stxes, num_lifts,
NULL, 0, 0, vc, 0, 0);
NULL, 0, 0, vc, 0, 0, procs);
/* This is where letlimit is useful. It prevents let-assignment in the
"then" branch that could permit bad code in the "else" branch (or the
same thing with either branch affecting later code in a sequence). */
@ -12342,7 +12371,7 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
vc_pos = vc->stackpos;
vc_ncpos = vc->ncstackpos;
scheme_validate_expr(port, b->tbranch, stack, tls, depth, letlimit, delta, num_toplevels, num_stxes, num_lifts,
NULL, 0, result_ignored, vc, tailpos, 0);
NULL, 0, result_ignored, vc, tailpos, 0, procs);
/* Rewind clears and noclears, but also save the clears,
so that the branches' effects can be merged. */
@ -12379,9 +12408,9 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
no_flo(need_flonum, port);
scheme_validate_expr(port, wcm->key, stack, tls, depth, letlimit, delta, num_toplevels, num_stxes, num_lifts,
NULL, 0, 0, vc, 0, 0);
NULL, 0, 0, vc, 0, 0, procs);
scheme_validate_expr(port, wcm->val, stack, tls, depth, letlimit, delta, num_toplevels, num_stxes, num_lifts,
NULL, 0, 0, vc, 0, 0);
NULL, 0, 0, vc, 0, 0, procs);
expr = wcm->body;
goto top;
}
@ -12408,7 +12437,7 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
no_flo(need_flonum, port);
validate_unclosed_procedure(port, expr, stack, tls,
depth, delta, num_toplevels, num_stxes, num_lifts,
app_rator, proc_with_refs_ok, -1);
app_rator, proc_with_refs_ok, -1, procs);
}
break;
case scheme_let_value_type:
@ -12417,7 +12446,7 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
int q, p, c, i;
scheme_validate_expr(port, lv->value, stack, tls, depth, letlimit, delta, num_toplevels, num_stxes, num_lifts,
NULL, 0, 0, vc, 0, 0);
NULL, 0, 0, vc, 0, 0, procs);
/* memset(stack, VALID_NOT, delta); <-- seems unnecessary (and slow) */
c = lv->count;
@ -12489,12 +12518,17 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
scheme_ill_formed_code(port);
#endif
stack[delta + i] = VALID_VAL;
if (SCHEME_CLOSURE_DATA_FLAGS(((Scheme_Closure_Data *)l->procs[i])) & CLOS_HAS_TYPED_ARGS) {
procs = scheme_hash_tree_set(as_nonempty_procs(procs),
scheme_make_integer(delta + i),
l->procs[i]);
}
}
for (i = 0; i < c; i++) {
validate_unclosed_procedure(port, l->procs[i], stack, tls,
depth, delta, num_toplevels, num_stxes, num_lifts,
NULL, 0, i);
NULL, 1, i, procs);
}
expr = l->body;
@ -12511,7 +12545,7 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
stack[delta] = VALID_UNINIT;
scheme_validate_expr(port, lo->value, stack, tls, depth, letlimit, delta, num_toplevels, num_stxes, num_lifts,
NULL, 0, 0, vc, 0, SCHEME_LET_EVAL_TYPE(lo) & LET_ONE_FLONUM);
NULL, 0, 0, vc, 0, SCHEME_LET_EVAL_TYPE(lo) & LET_ONE_FLONUM, procs);
#if !CAN_RESET_STACK_SLOT
if (stack[delta] != VALID_UNINIT)
@ -12553,7 +12587,7 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
for (i = 0; i < seq->count; i++) {
scheme_validate_expr(port, seq->array[i], stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts,
NULL, 0, 0, vc, 0, 0);
NULL, 0, 0, vc, 0, 0, procs);
}
} else if (need_flonum) {
if (!SCHEME_FLOATP(expr))
@ -12590,7 +12624,7 @@ void scheme_validate_toplevel(Scheme_Object *expr, Mz_CPort *port,
depth, delta, delta,
num_toplevels, num_stxes, num_lifts,
NULL, skip_refs_check ? 1 : 0, 0,
make_clearing_stack(), 0, 0);
make_clearing_stack(), 0, 0, NULL);
}
void scheme_validate_boxenv(int p, Mz_CPort *port, char *stack, int depth, int delta, int letlimit)

5
src/racket/src/fun.c
View File

@ -983,7 +983,10 @@ void scheme_delay_load_closure(Scheme_Closure_Data *data)
SCHEME_INT_VAL(SCHEME_VEC_ELS(vinfo)[3]),
SCHEME_INT_VAL(SCHEME_VEC_ELS(vinfo)[4]),
SCHEME_INT_VAL(SCHEME_VEC_ELS(vinfo)[5]),
SCHEME_INT_VAL(SCHEME_VEC_ELS(vinfo)[6]));
SCHEME_INT_VAL(SCHEME_VEC_ELS(vinfo)[6]),
(SCHEME_TRUEP(SCHEME_VEC_ELS(vinfo)[7])
? (Scheme_Hash_Tree *)SCHEME_VEC_ELS(vinfo)[7]
: NULL));
}
}
}

7
src/racket/src/schpriv.h
View File

@ -2117,7 +2117,8 @@ typedef void (*Scheme_Syntax_Validater)(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos);
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
typedef struct Scheme_Object *(*Scheme_Syntax_Executer)(struct Scheme_Object *data);
@ -2676,7 +2677,7 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
int num_toplevels, int num_stxes, int num_lifts,
Scheme_Object *app_rator, int proc_with_refs_ok,
int result_ignored, struct Validate_Clearing *vc,
int tailpos, int need_flonum);
int tailpos, int need_flonum, Scheme_Hash_Tree *procs);
void scheme_validate_toplevel(Scheme_Object *expr, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int delta,
@ -2693,7 +2694,7 @@ int scheme_validate_rator_wants_box(Scheme_Object *app_rator, int pos,
void scheme_validate_closure(Mz_CPort *port, Scheme_Object *expr,
char *new_stack, Validate_TLS tls,
int num_toplevels, int num_stxes, int num_lifts,
int self_pos_in_closure);
int self_pos_in_closure, Scheme_Hash_Tree *procs);
#define TRACK_ILL_FORMED_CATCH_LINES 1
#if TRACK_ILL_FORMED_CATCH_LINES

76
src/racket/src/syntax.c
View File

@ -163,52 +163,62 @@ static void define_values_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos);
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
static void ref_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos);
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
static void set_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos);
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
static void define_syntaxes_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos);
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
static void define_for_syntaxes_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos);
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
static void case_lambda_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos);
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
static void begin0_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos);
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
static void apply_values_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos);
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
static void splice_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos);
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
static void bangboxenv_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos);
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
static Scheme_Object *define_values_jit(Scheme_Object *data);
static Scheme_Object *ref_jit(Scheme_Object *data);
@ -885,7 +895,8 @@ static void define_values_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos)
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs)
{
int i, size;
Scheme_Object *val, *only_var;
@ -993,7 +1004,7 @@ static void define_values_validate(Scheme_Object *data, Mz_CPort *port,
scheme_validate_expr(port, val, stack, tls,
depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts,
NULL, !!only_var, 0, vc, 0, 0);
NULL, !!only_var, 0, vc, 0, 0, NULL);
}
static Scheme_Object *
@ -1524,7 +1535,8 @@ static void set_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos)
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs)
{
Scheme_Object *val, *tl;
@ -1538,7 +1550,7 @@ static void set_validate(Scheme_Object *data, Mz_CPort *port,
scheme_validate_expr(port, val, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts,
NULL, 0, 0, vc, 0, 0);
NULL, 0, 0, vc, 0, 0, procs);
scheme_validate_toplevel(tl, port, stack, tls, depth, delta,
num_toplevels, num_stxes, num_lifts,
0);
@ -1885,7 +1897,8 @@ static void ref_validate(Scheme_Object *tl, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos)
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs)
{
scheme_validate_toplevel(tl, port, stack, tls, depth, delta,
num_toplevels, num_stxes, num_lifts,
@ -2160,7 +2173,8 @@ static void apply_values_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos)
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs)
{
Scheme_Object *f, *e;
@ -2170,11 +2184,11 @@ static void apply_values_validate(Scheme_Object *data, Mz_CPort *port,
scheme_validate_expr(port, f, stack, tls,
depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts,
NULL, 0, 0, vc, 0, 0);
NULL, 0, 0, vc, 0, 0, procs);
scheme_validate_expr(port, e, stack, tls,
depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts,
NULL, 0, 0, vc, 0, 0);
NULL, 0, 0, vc, 0, 0, procs);
}
/**********************************************************************/
@ -2324,7 +2338,8 @@ static Scheme_Object *case_lambda_jit(Scheme_Object *expr)
static void case_lambda_validate(Scheme_Object *data, Mz_CPort *port, char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos)
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs)
{
Scheme_Case_Lambda *seq = (Scheme_Case_Lambda *)data;
Scheme_Object *e;
@ -2340,7 +2355,7 @@ static void case_lambda_validate(Scheme_Object *data, Mz_CPort *port, char *stac
scheme_ill_formed_code(port);
scheme_validate_expr(port, e, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts,
NULL, 0, 0, vc, 0, 0);
NULL, 0, 0, vc, 0, 0, procs);
}
}
@ -2723,7 +2738,8 @@ static void bangboxenv_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos)
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs)
{
if (!SCHEME_PAIRP(data))
scheme_ill_formed_code(port);
@ -2732,7 +2748,7 @@ static void bangboxenv_validate(Scheme_Object *data, Mz_CPort *port,
scheme_validate_expr(port, SCHEME_CDR(data), stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts,
NULL, 0, 0, vc, tailpos, 0);
NULL, 0, 0, vc, tailpos, 0, procs);
}
/**********************************************************************/
@ -4923,7 +4939,8 @@ static void begin0_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos)
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs)
{
Scheme_Sequence *seq = (Scheme_Sequence *)data;
int i;
@ -4936,7 +4953,7 @@ static void begin0_validate(Scheme_Object *data, Mz_CPort *port,
scheme_validate_expr(port, seq->array[i], stack, tls,
depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts,
NULL, 0, i > 0, vc, 0, 0);
NULL, 0, i > 0, vc, 0, 0, procs);
}
}
@ -5279,12 +5296,13 @@ static void splice_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos)
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs)
{
scheme_validate_expr(port, data, stack, tls,
depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts,
NULL, 0, 0, vc, 0, 0);
NULL, 0, 0, vc, 0, 0, procs);
}
/**********************************************************************/
@ -5607,7 +5625,8 @@ static void define_syntaxes_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos)
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs)
{
do_define_syntaxes_validate(data, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, 0);
@ -5617,7 +5636,8 @@ static void define_for_syntaxes_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
struct Validate_Clearing *vc, int tailpos)
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs)
{
do_define_syntaxes_validate(data, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, 1);