diff --git a/src/racket/src/eval.c b/src/racket/src/eval.c index f19f3611d1..3b3231553d 100644 --- a/src/racket/src/eval.c +++ b/src/racket/src/eval.c @@ -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) diff --git a/src/racket/src/fun.c b/src/racket/src/fun.c index f84fdc2f1e..831678f807 100644 --- a/src/racket/src/fun.c +++ b/src/racket/src/fun.c @@ -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)); } } } diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index d7e392bb42..dacaa8fec7 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -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 diff --git a/src/racket/src/syntax.c b/src/racket/src/syntax.c index 7c2e3fd76f..fa0a63d87e 100644 --- a/src/racket/src/syntax.c +++ b/src/racket/src/syntax.c @@ -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);