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

faster paths for chaperone application

Browse Source
This commit is contained in:
Matthew Flatt 2011-12-14 02:13:05 -07:00
parent f7c506471b
commit 761a40d483
9 changed files with 166 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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;

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

@ -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,6 +3181,7 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object
what = "impersonator";
/* Ensure that the original procedure accepts `argc' arguments: */
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
@ -3158,6 +3192,16 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object
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);
@ -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) {
if (!checks)
scheme_push_continuation_frame(&cframe);
scheme_set_cont_mark(SCHEME_CAR(app_mark), v);
if (!checks) {
MZ_CONT_MARK_POS -= 2;
need_pop_mark = 1;
} else
need_pop_mark = 0;
} else
need_pop_mark = 0;
}
}
}
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,6 +3250,7 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object
}
if (need_pop_mark) {
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,6 +3313,19 @@ 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;
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 {
@ -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 <procedure> 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;
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 (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",

8
src/racket/src/future.c
View File

@ -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;

38
src/racket/src/jit.c
View File

@ -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)

4
src/racket/src/jitcall.c
View File

@ -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;

4
src/racket/src/jitcommon.c
View File

@ -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);

3
src/racket/src/schnapp.inc
View File

@ -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));
}
}

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

@ -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,7 +2321,7 @@ 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_Closed_Prim *start_code; /* When not yet JITted, this is = to
scheme_on_demand_jit_code */
union {
void *tail_code; /* For non-case-lambda */

2
src/racket/src/thread.c
View File

@ -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;