diff --git a/src/racket/src/eval.c b/src/racket/src/eval.c index 71964beb21..1c7b38359c 100644 --- a/src/racket/src/eval.c +++ b/src/racket/src/eval.c @@ -2763,6 +2763,8 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands, DO_CHECK_FOR_BREAK(p, ); + /* See also _apply_native(), which effectively copies this code. */ + data = ((Scheme_Native_Closure *)obj)->code; /* Enlarge the runstack? This max_let_depth is in bytes instead of words. */ @@ -2781,7 +2783,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands, tmpv = obj; obj = NULL; /* save for space, since tmpv is ignored by the GC */ - v = data->code(tmpv, num_rands, rands); + v = data->start_code(tmpv, num_rands, rands); if (v == SCHEME_TAIL_CALL_WAITING) { /* [TC-SFS]; see schnapp.inc */ @@ -2885,7 +2887,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands, /* Chaperone is for function arguments */ VACATE_TAIL_BUFFER_USE_RUNSTACK(); UPDATE_THREAD_RSPTR(); - v = scheme_apply_chaperone(scheme_make_raw_pair(obj, orig_obj), num_rands, rands, NULL); + v = scheme_apply_chaperone(scheme_make_raw_pair(obj, orig_obj), num_rands, rands, NULL, 0); if (SAME_OBJ(v, SCHEME_TAIL_CALL_WAITING)) { /* Need to stay in this loop, because a tail-call result must @@ -2914,7 +2916,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands, /* Chaperone is for function arguments */ VACATE_TAIL_BUFFER_USE_RUNSTACK(); UPDATE_THREAD_RSPTR(); - v = scheme_apply_chaperone(obj, num_rands, rands, NULL); + v = scheme_apply_chaperone(obj, num_rands, rands, NULL, 0); } } else if (type == scheme_closed_prim_type) { GC_CAN_IGNORE Scheme_Closed_Primitive_Proc *prim; diff --git a/src/racket/src/fun.c b/src/racket/src/fun.c index c639e44a90..a50d848b8e 100644 --- a/src/racket/src/fun.c +++ b/src/racket/src/fun.c @@ -3023,7 +3023,7 @@ static Scheme_Object *do_chaperone_procedure(const char *name, const char *whati int is_impersonator, int argc, Scheme_Object *argv[]) { Scheme_Chaperone *px; - Scheme_Object *val = argv[0], *orig, *naya; + Scheme_Object *val = argv[0], *orig, *naya, *r; Scheme_Hash_Tree *props; if (SCHEME_CHAPERONEP(val)) @@ -3052,7 +3052,9 @@ static Scheme_Object *do_chaperone_procedure(const char *name, const char *whati px->val = val; px->prev = argv[0]; px->props = props; - px->redirects = argv[1]; + /* put procedure with known-good arity (to speed checking) in a mutable pair: */ + r = scheme_make_mutable_pair(argv[1], scheme_make_integer(-1)); + px->redirects = r; if (is_impersonator) SCHEME_CHAPERONE_FLAGS(px) |= SCHEME_CHAPERONE_IS_IMPERSONATOR; @@ -3081,10 +3083,10 @@ static Scheme_Object *apply_chaperone_k(void) p->ku.k.p2 = NULL; p->ku.k.p3 = NULL; - return scheme_apply_chaperone(o, p->ku.k.i1, argv, auto_val); + return scheme_apply_chaperone(o, p->ku.k.i1, argv, auto_val, p->ku.k.i2); } -static Scheme_Object *do_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object **argv, Scheme_Object *auto_val) +static Scheme_Object *do_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object **argv, Scheme_Object *auto_val, int checks) { #ifdef DO_STACK_CHECK { @@ -3098,25 +3100,56 @@ static Scheme_Object *do_apply_chaperone(Scheme_Object *o, int argc, Scheme_Obje p->ku.k.p2 = (void *)argv2; p->ku.k.p3 = (void *)auto_val; p->ku.k.i1 = argc; + p->ku.k.i2 = checks; return scheme_handle_stack_overflow(apply_chaperone_k); } } #endif - return scheme_apply_chaperone(o, argc, argv, auto_val); + return scheme_apply_chaperone(o, argc, argv, auto_val, checks); } -Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object **argv, Scheme_Object *auto_val) + +static Scheme_Object *_apply_native(Scheme_Object *obj, int num_rands, Scheme_Object **rands) +{ + Scheme_Native_Closure_Data *data; + GC_MAYBE_IGNORE_INTERIOR MZ_MARK_STACK_TYPE old_cont_mark_stack; + + data = ((Scheme_Native_Closure *)obj)->code; + + if ((uintptr_t)data->max_let_depth > ((uintptr_t)scheme_current_runstack - (uintptr_t)scheme_current_runstack_start)) { + return _scheme_apply_multi(obj, num_rands, rands); + } + + MZ_CONT_MARK_POS += 2; + old_cont_mark_stack = MZ_CONT_MARK_STACK; + + obj = data->start_code(obj, num_rands, rands); + + if (obj == SCHEME_TAIL_CALL_WAITING) + return force_values(obj, 1); + + MZ_CONT_MARK_STACK = old_cont_mark_stack; + MZ_CONT_MARK_POS -= 2; + + return obj; +} + +/* must be at least 3: */ +#define MAX_QUICK_CHAP_ARGV 5 + +Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object **argv, Scheme_Object *auto_val, int checks) +/* checks & 0x2 => no tail; checks == 0x3 => no tail or multiple; */ { const char *what; Scheme_Chaperone *px; - Scheme_Object *v, *a[1], *a2[3], **argv2, *post, *result_v, *orig_obj, *app_mark; + Scheme_Object *v, *a[1], *a2[MAX_QUICK_CHAP_ARGV], **argv2, *post, *result_v, *orig_obj, *app_mark; int c, i, need_restore = 0; - int need_pop_mark = 0; + int need_pop_mark; Scheme_Cont_Frame_Data cframe; if (argv == MZ_RUNSTACK) { - /* Pushing onto the runstack ensures that px->redirects won't + /* Pushing onto the runstack ensures that `(mcar px->redirects)' won't modify argv. */ if (MZ_RUNSTACK > MZ_RUNSTACK_START) { --MZ_RUNSTACK; @@ -3131,7 +3164,7 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object } if (SCHEME_RPAIRP(o)) { - /* An applicable struct, where a layout of struct chaperones + /* An applicable struct, where a layer of struct chaperones has been removed from the object to apply, but we will eventually need to extract the procedure from the original object. */ @@ -3148,17 +3181,28 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object what = "impersonator"; /* Ensure that the original procedure accepts `argc' arguments: */ - a[0] = px->prev; - if (!scheme_check_proc_arity(NULL, argc, 0, 0, a)) { - /* Apply the original procedure, in case the chaperone would accept - `argc' arguments (in addition to the original procedure's arity) - in case the methodness of the original procedure is different - from the chaperone, or in case the procedures have different names. */ - (void)_scheme_apply_multi(px->prev, argc, argv); - scheme_signal_error("internal error: unexpected success applying chaperoned/proxied procedure"); - return NULL; + if (argc != SCHEME_INT_VAL(SCHEME_CDR(px->redirects))) { + a[0] = px->prev; + if (!scheme_check_proc_arity(NULL, argc, 0, 0, a)) { + /* Apply the original procedure, in case the chaperone would accept + `argc' arguments (in addition to the original procedure's arity) + in case the methodness of the original procedure is different + from the chaperone, or in case the procedures have different names. */ + (void)_scheme_apply_multi(px->prev, argc, argv); + scheme_signal_error("internal error: unexpected success applying chaperoned/proxied procedure"); + return NULL; + } + /* record that argc is ok, on the grounds that the function is likely + to be applied to argc arguments again */ + SCHEME_CDR(px->redirects) = scheme_make_integer(argc); } + if (checks) { + scheme_push_continuation_frame(&cframe); + need_pop_mark = 1; + } else + need_pop_mark = 0; + if (px->props) { app_mark = scheme_hash_tree_get(px->props, scheme_app_mark_impersonator_property); /* app_mark should be (cons mark val) */ @@ -3170,22 +3214,35 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object if (app_mark) { v = scheme_extract_one_cc_mark(NULL, SCHEME_CAR(app_mark)); if (v) { - scheme_push_continuation_frame(&cframe); + if (!checks) + scheme_push_continuation_frame(&cframe); scheme_set_cont_mark(SCHEME_CAR(app_mark), v); - MZ_CONT_MARK_POS -= 2; - need_pop_mark = 1; - } else - need_pop_mark = 0; - } else - need_pop_mark = 0; + if (!checks) { + MZ_CONT_MARK_POS -= 2; + need_pop_mark = 1; + } + } + } - v = _scheme_apply_multi(px->redirects, argc, argv); + v = SCHEME_CAR(px->redirects); + if (SAME_TYPE(SCHEME_TYPE(v), scheme_native_closure_type)) + v = _apply_native(v, argc, argv); + else + v = _scheme_apply_multi(v, argc, argv); if (v == SCHEME_MULTIPLE_VALUES) { GC_CAN_IGNORE Scheme_Thread *p = scheme_current_thread; - if (SAME_OBJ(p->ku.multiple.array, p->values_buffer)) - p->values_buffer = NULL; c = p->ku.multiple.count; argv2 = p->ku.multiple.array; + if (SAME_OBJ(p->ku.multiple.array, p->values_buffer)) { + if (c <= MAX_QUICK_CHAP_ARGV) { + for (i = 0; i < c; i++) { + a2[i] = argv2[i]; + } + argv2 = a2; + } else { + p->values_buffer = NULL; + } + } } else { c = 1; a2[0] = v; @@ -3193,7 +3250,8 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object } if (need_pop_mark) { - MZ_CONT_MARK_POS += 2; + if (!checks) + MZ_CONT_MARK_POS += 2; scheme_pop_continuation_frame(&cframe); } @@ -3205,16 +3263,17 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object post = NULL; if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR)) { for (i = 0; i < argc; i++) { - if (!scheme_chaperone_of(argv2[i], argv[i])) { + if (!SAME_OBJ(argv2[i], argv[i]) + && !scheme_chaperone_of(argv2[i], argv[i])) { if (argc == 1) scheme_raise_exn(MZEXN_FAIL_CONTRACT, "procedure chaperone: %V: result: %V is not a chaperone of argument: %V", - px->redirects, + SCHEME_CAR(px->redirects), argv2[i], argv[i]); else scheme_raise_exn(MZEXN_FAIL_CONTRACT, "procedure chaperone: %V: %d%s result: %V is not a chaperone of argument: %V", - px->redirects, + SCHEME_CAR(px->redirects), i, scheme_number_suffix(i), argv2[i], argv[i]); } @@ -3224,7 +3283,7 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object scheme_raise_exn(MZEXN_FAIL_CONTRACT_ARITY, "procedure %s: %V: returned %d values, expected %d or %d", what, - px->redirects, + SCHEME_CAR(px->redirects), c, argc, argc + 1); return NULL; } @@ -3245,7 +3304,7 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object scheme_set_cont_mark(SCHEME_CAR(app_mark), SCHEME_CDR(app_mark)); if (auto_val) { if (SCHEME_CHAPERONEP(px->prev)) - return do_apply_chaperone(px->prev, c, argv2, auto_val); + return do_apply_chaperone(px->prev, c, argv2, auto_val, 0); else return argv2[0]; } else { @@ -3254,7 +3313,20 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object orig_obj = scheme_make_raw_pair(px->prev, orig_obj); else orig_obj = px->prev; - return scheme_tail_apply(orig_obj, c, argv2); + if (checks) { + /* cannot return a tail call */ + MZ_CONT_MARK_POS -= 2; + if (checks & 0x1) { + v = _scheme_apply(orig_obj, c, argv2); + } else if (SAME_TYPE(SCHEME_TYPE(orig_obj), scheme_native_closure_type)) { + v = _apply_native(orig_obj, c, argv2); + } else { + v = _scheme_apply_multi(orig_obj, c, argv2); + } + MZ_CONT_MARK_POS += 2; + return v; + } else + return scheme_tail_apply(orig_obj, c, argv2); } } else { /* First element is a filter for the result(s) */ @@ -3262,7 +3334,7 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object scheme_raise_exn(MZEXN_FAIL_CONTRACT, "procedure %s: %V: expected as first result, produced: %V", what, - px->redirects, + SCHEME_CAR(px->redirects), post); if (app_mark) { @@ -3275,7 +3347,7 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object if (auto_val) { if (SCHEME_CHAPERONEP(px->prev)) - result_v = do_apply_chaperone(px->prev, argc, argv2, auto_val); + result_v = do_apply_chaperone(px->prev, argc, argv2, auto_val, 0); else result_v = argv2[0]; v = auto_val; @@ -3285,16 +3357,25 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object orig_obj = scheme_make_raw_pair(px->prev, orig_obj); else orig_obj = px->prev; - v = _scheme_apply_multi(orig_obj, argc, argv2); + if (SAME_TYPE(SCHEME_TYPE(orig_obj), scheme_native_closure_type)) + v = _apply_native(orig_obj, argc, argv2); + else + v = _scheme_apply_multi(orig_obj, argc, argv2); result_v = NULL; } if (v == SCHEME_MULTIPLE_VALUES) { GC_CAN_IGNORE Scheme_Thread *p = scheme_current_thread; - if (SAME_OBJ(p->ku.multiple.array, p->values_buffer)) - p->values_buffer = NULL; - c = p->ku.multiple.count; - argv = p->ku.multiple.array; + if (checks & 0x1) { + scheme_wrong_return_arity(NULL, 1, p->ku.multiple.count, + p->ku.multiple.array, + NULL); + } else { + if (SAME_OBJ(p->ku.multiple.array, p->values_buffer)) + p->values_buffer = NULL; + c = p->ku.multiple.count; + argv = p->ku.multiple.array; + } } else { c = 1; a[0] = v; @@ -3328,7 +3409,8 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object if (c == argc) { if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR)) { for (i = 0; i < argc; i++) { - if (!scheme_chaperone_of(argv2[i], argv[i])) { + if (!SAME_OBJ(argv2[i], argv[i]) + && !scheme_chaperone_of(argv2[i], argv[i])) { if (argc == 1) scheme_raise_exn(MZEXN_FAIL_CONTRACT, "procedure-result chaperone: %V: result: %V is not a chaperone of original result: %V", diff --git a/src/racket/src/future.c b/src/racket/src/future.c index 42160e091c..9beb2b0dc1 100644 --- a/src/racket/src/future.c +++ b/src/racket/src/future.c @@ -1179,7 +1179,7 @@ static Scheme_Object *make_future(Scheme_Object *lambda) /* JIT the code if not already JITted */ if (ncd) { - if (ncd->code == scheme_on_demand_jit_code) + if (ncd->start_code == scheme_on_demand_jit_code) scheme_on_demand_generate_lambda(nc, 0, NULL, 0); if (ncd->max_let_depth > FUTURE_RUNSTACK_SIZE * sizeof(void*)) { @@ -1187,7 +1187,7 @@ static Scheme_Object *make_future(Scheme_Object *lambda) ft->status = PENDING_OVERSIZE; } - ft->code = (void*)ncd->code; + ft->code = (void*)ncd->start_code; } else ft->status = PENDING_OVERSIZE; @@ -1220,7 +1220,7 @@ Scheme_Object *scheme_future(int argc, Scheme_Object *argv[]) Scheme_Object *proc = argv[0]; if (SAME_TYPE(SCHEME_TYPE(proc), scheme_native_closure_type) && scheme_native_arity_check(proc, 0) - && (((Scheme_Native_Closure *)proc)->code->code != scheme_on_demand_jit_code) + && (((Scheme_Native_Closure *)proc)->code->start_code != scheme_on_demand_jit_code) && (((Scheme_Native_Closure *)proc)->code->max_let_depth < FUTURE_RUNSTACK_SIZE * sizeof(void*))) { /* try to alocate a future in the future thread */ future_t *ft; @@ -1232,7 +1232,7 @@ Scheme_Object *scheme_future(int argc, Scheme_Object *argv[]) ft->orig_lambda = proc; ft->status = PENDING; ft->cust = scheme_current_thread->current_ft->cust; - ft->code = ((Scheme_Native_Closure *)proc)->code->code; + ft->code = ((Scheme_Native_Closure *)proc)->code->start_code; mzrt_mutex_lock(fs->future_mutex); ft->id = ++fs->next_futureid; diff --git a/src/racket/src/jit.c b/src/racket/src/jit.c index 23844c6347..3f60580637 100644 --- a/src/racket/src/jit.c +++ b/src/racket/src/jit.c @@ -3039,7 +3039,7 @@ static int generate_function_getarg(mz_jit_state *jitter, int has_rest, int num_ typedef struct { Scheme_Closure_Data *data; - void *arity_code, *code, *tail_code, *code_end, **patch_depth; + void *arity_code, *start_code, *tail_code, *code_end, **patch_depth; int max_extra, max_depth, max_tail_depth; Scheme_Native_Closure *nc; int argc, argv_delta; @@ -3050,11 +3050,11 @@ static int do_generate_closure(mz_jit_state *jitter, void *_data) { Generate_Closure_Data *gdata = (Generate_Closure_Data *)_data; Scheme_Closure_Data *data = gdata->data; - void *code, *tail_code, *code_end, *arity_code; + void *start_code, *tail_code, *code_end, *arity_code; int i, r, cnt, has_rest, is_method, num_params, to_args, argc, argv_delta; Scheme_Object **argv; - code = jit_get_ip().ptr; + start_code = jit_get_ip().ptr; jitter->nc = gdata->nc; @@ -3062,7 +3062,7 @@ static int do_generate_closure(mz_jit_state *jitter, void *_data) argv = gdata->argv; argv_delta = gdata->argv_delta; - generate_function_prolog(jitter, code, + generate_function_prolog(jitter, start_code, /* max_extra_pushed may be wrong the first time around, but it will be right the last time around */ WORDS_TO_BYTES(data->max_let_depth + jitter->max_extra_pushed)); @@ -3075,7 +3075,7 @@ static int do_generate_closure(mz_jit_state *jitter, void *_data) CHECK_LIMIT(); /* A tail call with arity checking can start here. - (This is a little reundant checking when `code' is the + (This is a little reundant checking when `start_code' is the entry point, but that's the slow path anyway.) */ has_rest = ((SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST) ? 1 : 0); @@ -3370,7 +3370,7 @@ static int do_generate_closure(mz_jit_state *jitter, void *_data) if (jitter->retain_start) { gdata->arity_code = arity_code; - gdata->code = code; + gdata->start_code = start_code; gdata->tail_code = tail_code; gdata->max_extra = jitter->max_extra_pushed; gdata->max_depth = jitter->max_depth; @@ -3387,7 +3387,7 @@ static void on_demand_generate_lambda(Scheme_Native_Closure *nc, int argc, Schem Scheme_Native_Closure_Data *ndata = nc->code; Scheme_Closure_Data *data; Generate_Closure_Data gdata; - void *code, *tail_code, *arity_code; + void *start_code, *tail_code, *arity_code; int max_depth; data = ndata->u2.orig_code; @@ -3402,7 +3402,7 @@ static void on_demand_generate_lambda(Scheme_Native_Closure *nc, int argc, Schem scheme_delay_load_closure(data); /* So, check again whether we still need to generate: */ - if (ndata->code != scheme_on_demand_jit_code) + if (ndata->start_code != scheme_on_demand_jit_code) return; ndata->arity_code = sjc.in_progress_on_demand_jit_arity_code; /* => in progress */ @@ -3420,14 +3420,14 @@ static void on_demand_generate_lambda(Scheme_Native_Closure *nc, int argc, Schem SCHEME_NATIVE_CLOSURE_DATA_FLAGS(ndata) |= NATIVE_IS_SINGLE_RESULT; arity_code = gdata.arity_code; - code = gdata.code; + start_code = gdata.start_code; tail_code = gdata.tail_code; if (data->name) { - scheme_jit_add_symbol((uintptr_t)code, (uintptr_t)gdata.code_end - 1, data->name, 1); + scheme_jit_add_symbol((uintptr_t)start_code, (uintptr_t)gdata.code_end - 1, data->name, 1); } else { #ifdef MZ_USE_DWARF_LIBUNWIND - scheme_jit_add_symbol((uintptr_t)code, (uintptr_t)gdata.code_end - 1, scheme_null, 1); + scheme_jit_add_symbol((uintptr_t)start_code, (uintptr_t)gdata.code_end - 1, scheme_null, 1); #endif } @@ -3456,7 +3456,7 @@ static void on_demand_generate_lambda(Scheme_Native_Closure *nc, int argc, Schem jit_patch_movi(((jit_insn *)(*pd)), (void *)(intptr_t)max_depth); } - ndata->code = code; + ndata->start_code = start_code; ndata->u.tail_code = tail_code; ndata->arity_code = arity_code; ndata->u2.name = data->name; @@ -3477,7 +3477,7 @@ Scheme_Object **scheme_on_demand_with_args(Scheme_Object **in_argv, Scheme_Objec c = in_argv[0]; argc = in_argv[1]; - if (((Scheme_Native_Closure *)c)->code->code == scheme_on_demand_jit_code) + if (((Scheme_Native_Closure *)c)->code->start_code == scheme_on_demand_jit_code) scheme_on_demand_generate_lambda((Scheme_Native_Closure *)c, SCHEME_INT_VAL(argc), argv, argv_delta); return argv; @@ -3514,7 +3514,7 @@ static Scheme_Native_Closure_Data *create_native_lambda(Scheme_Closure_Data *dat ndata->iso.so.type = scheme_rt_native_code_plus_case; #endif } - ndata->code = scheme_on_demand_jit_code; + ndata->start_code = scheme_on_demand_jit_code; ndata->u.tail_code = sjc.on_demand_jit_arity_code; ndata->arity_code = sjc.on_demand_jit_arity_code; ndata->u2.orig_code = data; @@ -3726,17 +3726,17 @@ typedef struct { static int do_generate_case_lambda_dispatch(mz_jit_state *jitter, void *_data) { Generate_Case_Dispatch_Data *data = (Generate_Case_Dispatch_Data *)_data; - void *code, *arity_code; + void *start_code, *arity_code; - code = jit_get_ip().ptr; + start_code = jit_get_ip().ptr; - generate_function_prolog(jitter, code, data->ndata->max_let_depth); + generate_function_prolog(jitter, start_code, data->ndata->max_let_depth); CHECK_LIMIT(); if (generate_case_lambda_dispatch(jitter, data->c, data->ndata, 1)) { arity_code = jit_get_ip().ptr; if (generate_case_lambda_dispatch(jitter, data->c, data->ndata, 0)) { - data->ndata->code = code; + data->ndata->start_code = start_code; data->ndata->arity_code = arity_code; return 1; @@ -3791,7 +3791,7 @@ static void generate_case_lambda(Scheme_Case_Lambda *c, Scheme_Native_Closure_Da XFORM_NONGCING static int lambda_has_been_jitted(Scheme_Native_Closure_Data *ndata) /* called by scheme_native_arity_check(), which is not XFORMed */ { - return (ndata->code != scheme_on_demand_jit_code); + return (ndata->start_code != scheme_on_demand_jit_code); } int scheme_native_arity_check(Scheme_Object *closure, int argc) diff --git a/src/racket/src/jitcall.c b/src/racket/src/jitcall.c index b1b5320308..ed80267f2a 100644 --- a/src/racket/src/jitcall.c +++ b/src/racket/src/jitcall.c @@ -1454,12 +1454,12 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_ of the call. */ Scheme_Native_Closure *nc; nc = (Scheme_Native_Closure *)scheme_jit_closure((Scheme_Object *)data, NULL); - if (nc->code->code == scheme_on_demand_jit_code) { + if (nc->code->start_code == scheme_on_demand_jit_code) { if (nc->code->arity_code != sjc.in_progress_on_demand_jit_arity_code) { scheme_on_demand_generate_lambda(nc, 0, NULL, 0); } } - if (nc->code->code != scheme_on_demand_jit_code) { + if (nc->code->start_code != scheme_on_demand_jit_code) { if (nc->code->max_let_depth > jitter->max_tail_depth) jitter->max_tail_depth = nc->code->max_let_depth; diff --git a/src/racket/src/jitcommon.c b/src/racket/src/jitcommon.c index 4658fb68bf..b91a41f8d5 100644 --- a/src/racket/src/jitcommon.c +++ b/src/racket/src/jitcommon.c @@ -2596,8 +2596,8 @@ static int common10(mz_jit_state *jitter, void *_data) jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Native_Closure *)0x0)->code); jit_ldxi_i(JIT_R2, JIT_V1, &((Scheme_Native_Closure_Data *)0x0)->closure_size); (void)jit_blti_i(refslow, JIT_R2, 0); /* case lambda */ - jit_ldxi_p(JIT_R2, JIT_V1, &((Scheme_Native_Closure_Data *)0x0)->code); - jit_movi_p(JIT_V1, scheme_on_demand_jit_code); /* movi_p doesn't depends on actual address, which might change size */ + jit_ldxi_p(JIT_R2, JIT_V1, &((Scheme_Native_Closure_Data *)0x0)->start_code); + jit_movi_p(JIT_V1, scheme_on_demand_jit_code); /* movi_p doesn't depend on actual address, which might change size */ ref_nc = jit_beqr_p(jit_forward(), JIT_R2, JIT_V1); /* not yet JITted? */ jit_rshi_l(JIT_V1, JIT_R1, 1); jit_addi_l(JIT_V1, JIT_V1, 1); diff --git a/src/racket/src/schnapp.inc b/src/racket/src/schnapp.inc index c045d7ef66..b3b8e5c86c 100644 --- a/src/racket/src/schnapp.inc +++ b/src/racket/src/schnapp.inc @@ -62,6 +62,9 @@ Scheme_Object *PRIM_APPLY_NAME(Scheme_Object *rator, if (t == scheme_prim_type) { return PRIM_APPLY_NAME_FAST(rator, argc, argv); + } if ((t == scheme_proc_chaperone_type) + && (SCHEME_MPAIRP(((Scheme_Chaperone *)rator)->redirects))) { + return scheme_apply_chaperone(rator, argc, argv, NULL, PRIM_CHECK_MULTI | (PRIM_CHECK_VALUE << 1)); } } diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index 31965916be..f9556d0d8b 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -858,7 +858,8 @@ typedef struct Scheme_Chaperone { Scheme_Object *scheme_chaperone_vector_ref(Scheme_Object *o, int i); void scheme_chaperone_vector_set(Scheme_Object *o, int i, Scheme_Object *v); -Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object **argv, Scheme_Object *auto_val); +Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object **argv, + Scheme_Object *auto_val, int checks); Scheme_Hash_Tree *scheme_parse_chaperone_props(const char *who, int start_at, int argc, Scheme_Object **argv); @@ -2320,8 +2321,8 @@ typedef struct { typedef struct Scheme_Native_Closure_Data { Scheme_Inclhash_Object iso; /* type tag only set when needed, but flags always needed */ - Scheme_Closed_Prim *code; /* When not yet JITted, this is = to - scheme_on_demand_jit_code */ + Scheme_Closed_Prim *start_code; /* When not yet JITted, this is = to + scheme_on_demand_jit_code */ union { void *tail_code; /* For non-case-lambda */ mzshort *arities; /* For case-lambda */ diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c index 8951fbedf7..2a151f58b5 100644 --- a/src/racket/src/thread.c +++ b/src/racket/src/thread.c @@ -6852,7 +6852,7 @@ static Scheme_Object *extend_parameterization(int argc, Scheme_Object *argv[]) key = argv[i + 1]; if (SCHEME_CHAPERONEP(param)) { a[0] = key; - key = scheme_apply_chaperone(param, 1, a, scheme_void); + key = scheme_apply_chaperone(param, 1, a, scheme_void, 0); param = SCHEME_CHAPERONE_VAL(param); } a[0] = key;