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

streamline chaperoned struct field reference

Browse Source 
The usual techniques: shortcut around generic scheme_apply() for
chaperone-triggered slow path, shortcut around scheme_apply() for
application of a native-code interposition function,  and shortcut
`chaperone-of?' test by trying `eq?' first.
This commit is contained in:
Matthew Flatt 2012-04-07 09:28:49 -06:00
parent 2bdcdbb197
commit 5a04be6445
5 changed files with 105 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3151,6 +3151,11 @@ static Scheme_Object *_apply_native(Scheme_Object *obj, int num_rands, Scheme_Ob
return obj;
}
Scheme_Object *_scheme_apply_native(Scheme_Object *obj, int num_rands, Scheme_Object **rands)
{
return _apply_native(obj, num_rands, rands);
}
/* must be at least 3: */
#define MAX_QUICK_CHAP_ARGV 5

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

@ -88,6 +88,8 @@ define_ts_iS_s(scheme_procedure_arity_includes, FSRC_MARKS)
define_ts_ssi_s(vector_check_chaperone_of, FSRC_MARKS)
define_ts_iS_s(scheme_checked_list_ref, FSRC_MARKS)
define_ts_iS_s(scheme_checked_list_tail, FSRC_MARKS)
define_ts_iSs_s(scheme_struct_getter, FSRC_MARKS)
define_ts_iSs_s(scheme_struct_setter, FSRC_MARKS)
#endif
#ifdef JITCALL_TS_PROCS
@ -207,4 +209,6 @@ define_ts_s_s(scheme_box, FSRC_OTHER)
# define ts_vector_check_chaperone_of vector_check_chaperone_of
# define ts_scheme_checked_list_ref scheme_checked_list_ref
# define ts_scheme_checked_list_tail scheme_checked_list_tail
# define ts_scheme_struct_getter scheme_struct_getter
# define ts_scheme_struct_setter scheme_struct_setter
#endif

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

@ -1324,6 +1324,67 @@ static int common3(mz_jit_state *jitter, void *_data)
return 1;
}
static int gen_struct_slow(mz_jit_state *jitter, int kind, int ok_proc,
int for_branch, int multi_ok,
GC_CAN_IGNORE jit_insn **_bref5,
GC_CAN_IGNORE jit_insn **_bref6)
{
GC_CAN_IGNORE jit_insn *bref5, *bref6, *refrts;
jit_subi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES((kind == 3) ? 2 : 1));
CHECK_RUNSTACK_OVERFLOW();
JIT_UPDATE_THREAD_RSPTR();
jit_str_p(JIT_RUNSTACK, JIT_R1);
if (kind == 3) {
restore_struct_temp(jitter, JIT_V1);
jit_stxi_p(WORDS_TO_BYTES(1), JIT_RUNSTACK, JIT_V1);
}
jit_movi_i(JIT_V1, ((kind == 3) ? 2 : 1));
jit_prepare(3);
if (!ok_proc) {
jit_pusharg_p(JIT_RUNSTACK);
jit_pusharg_i(JIT_V1);
jit_pusharg_p(JIT_R0);
if (multi_ok) {
(void)mz_finish_lwe(ts__scheme_apply_multi_from_native, refrts);
} else {
(void)mz_finish_lwe(ts__scheme_apply_from_native, refrts);
}
} else {
/* The proc is a setter or getter, but the argument is
bad or chaperoned. We can take a shortcut by using
scheme_struct_getter() or scheme_struct_setter() instead
of going through scheme_apply(). */
jit_pusharg_p(JIT_R0);
jit_pusharg_p(JIT_RUNSTACK);
jit_pusharg_i(JIT_V1);
if (kind == 2)
(void)mz_finish_lwe(ts_scheme_struct_getter, refrts);
else
(void)mz_finish_lwe(ts_scheme_struct_setter, refrts);
}
jit_retval(JIT_R0);
VALIDATE_RESULT(JIT_R0);
jit_addi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES((kind == 3) ? 2 : 1));
JIT_UPDATE_THREAD_RSPTR();
if (!for_branch) {
mz_epilog(JIT_V1);
bref5 = NULL;
bref6 = NULL;
} else {
/* Need to check for true or false. */
bref5 = jit_beqi_p(jit_forward(), JIT_R0, scheme_false);
bref6 = jit_jmpi(jit_forward());
}
if (_bref5) {
*_bref5 = bref5;
*_bref6 = bref6;
}
return 1;
}
static int common4(mz_jit_state *jitter, void *_data)
{
int i, ii, iii;
@ -1476,8 +1537,8 @@ static int common4(mz_jit_state *jitter, void *_data)
for (i = 0; i < 4; i++) {
void *code;
int kind, for_branch;
GC_CAN_IGNORE jit_insn *ref, *ref2, *ref3, *refslow, *bref1, *bref2, *refretry;
GC_CAN_IGNORE jit_insn *bref3, *bref4, *bref5, *bref6, *bref8, *ref9, *refrts;
GC_CAN_IGNORE jit_insn *ref, *ref2, *ref3, *refslow, *refslow2, *bref1, *bref2, *refretry;
GC_CAN_IGNORE jit_insn *bref3, *bref4, *bref5, *bref6, *bref8, *ref9;
if ((ii == 1) && (i == 1)) continue; /* no multi variant of pred branch */
@ -1521,42 +1582,19 @@ static int common4(mz_jit_state *jitter, void *_data)
ref = jit_bmci_ul(jit_forward(), JIT_R0, 0x1);
CHECK_LIMIT();
/* Slow path: non-struct proc, or argument type is
bad for a getter. */
/* Slow path: non-struct proc. */
refslow = _jit.x.pc;
jit_subi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES((kind == 3) ? 2 : 1));
CHECK_RUNSTACK_OVERFLOW();
JIT_UPDATE_THREAD_RSPTR();
jit_str_p(JIT_RUNSTACK, JIT_R1);
if (kind == 3) {
restore_struct_temp(jitter, JIT_V1);
jit_stxi_p(WORDS_TO_BYTES(1), JIT_RUNSTACK, JIT_V1);
}
jit_movi_i(JIT_V1, ((kind == 3) ? 2 : 1));
jit_prepare(3);
jit_pusharg_p(JIT_RUNSTACK);
jit_pusharg_i(JIT_V1);
jit_pusharg_p(JIT_R0);
if (ii == 1) {
(void)mz_finish_lwe(ts__scheme_apply_multi_from_native, refrts);
} else {
(void)mz_finish_lwe(ts__scheme_apply_from_native, refrts);
}
jit_retval(JIT_R0);
VALIDATE_RESULT(JIT_R0);
jit_addi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES((kind == 3) ? 2 : 1));
JIT_UPDATE_THREAD_RSPTR();
if (!for_branch) {
mz_epilog(JIT_V1);
bref5 = NULL;
bref6 = NULL;
} else {
/* Need to check for true or false. */
bref5 = jit_beqi_p(jit_forward(), JIT_R0, scheme_false);
bref6 = jit_jmpi(jit_forward());
}
gen_struct_slow(jitter, kind, 0, for_branch, ii == 1, &bref5, &bref6);
CHECK_LIMIT();
if ((kind == 2) || (kind == 3)) {
/* Slow path: argument type is bad for a getter/setter. */
refslow2 = _jit.x.pc;
gen_struct_slow(jitter, kind, 1, 0, 0, NULL, NULL);
CHECK_LIMIT();
} else
refslow2 = refslow;
/* Continue trying fast path: check proc */
mz_patch_branch(ref);
(void)mz_bnei_t(refslow, JIT_R0, scheme_prim_type, JIT_R2);
@ -1587,12 +1625,12 @@ static int common4(mz_jit_state *jitter, void *_data)
mz_patch_branch(ref3);
__END_INNER_TINY__(1);
} else {
(void)jit_bmsi_ul(refslow, JIT_R1, 0x1);
(void)jit_bmsi_ul(refslow2, JIT_R1, 0x1);
jit_ldxi_s(JIT_R2, JIT_R1, &((Scheme_Object *)0x0)->type);
__START_INNER_TINY__(1);
ref2 = jit_beqi_i(jit_forward(), JIT_R2, scheme_structure_type);
__END_INNER_TINY__(1);
(void)jit_bnei_i(refslow, JIT_R2, scheme_proc_struct_type);
(void)jit_bnei_i(refslow2, JIT_R2, scheme_proc_struct_type);
bref1 = bref2 = NULL;
}
__START_INNER_TINY__(1);
@ -1622,7 +1660,7 @@ static int common4(mz_jit_state *jitter, void *_data)
if (kind == 1) {
bref3 = jit_bltr_i(jit_forward(), JIT_R2, JIT_V1);
} else {
(void)jit_bltr_i(refslow, JIT_R2, JIT_V1);
(void)jit_bltr_i(refslow2, JIT_R2, JIT_V1);
bref3 = NULL;
}
CHECK_LIMIT();
@ -1670,7 +1708,7 @@ static int common4(mz_jit_state *jitter, void *_data)
mz_epilog(JIT_V1);
}
} else {
(void)jit_bner_p(refslow, JIT_R2, JIT_V1);
(void)jit_bner_p(refslow2, JIT_R2, JIT_V1);
bref4 = NULL;
__START_INNER_TINY__(1);
mz_patch_branch(bref8);

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

@ -844,6 +844,9 @@ Scheme_Object *scheme_prefab_struct_key(Scheme_Object *s);
Scheme_Object *scheme_make_serialized_struct_instance(Scheme_Object *s, int num_slots);
#endif
Scheme_Object *scheme_struct_getter(int argc, Scheme_Object **args, Scheme_Object *prim);
Scheme_Object *scheme_struct_setter(int argc, Scheme_Object **args, Scheme_Object *prim);
Scheme_Object *scheme_extract_checked_procedure(int argc, Scheme_Object **argv);
Scheme_Object *scheme_rename_struct_proc(Scheme_Object *p, Scheme_Object *sym);
@ -2128,6 +2131,8 @@ Scheme_Object *scheme_eval_linked_expr_multi_with_dynamic_state(Scheme_Object *o
Scheme_Object *_scheme_apply_to_list (Scheme_Object *rator, Scheme_Object *rands);
Scheme_Object *_scheme_tail_apply_to_list (Scheme_Object *rator, Scheme_Object *rands);
Scheme_Object *_scheme_apply_native(Scheme_Object *obj, int num_rands, Scheme_Object **rands);
Scheme_Object *scheme_internal_read(Scheme_Object *port, Scheme_Object *stxsrc, int crc, int cantfail,
int recur, int expose_comment, int pre_char, Scheme_Object *readtable,
Scheme_Object *magic_sym, Scheme_Object *magic_val,

22
src/racket/src/struct.c
View File

@ -1933,10 +1933,13 @@ static Scheme_Object *chaperone_struct_ref(const char *who, Scheme_Object *o, in
a[0] = px->prev;
a[1] = orig;
red = SCHEME_VEC_ELS(px->redirects)[PRE_REDIRECTS + i];
o = _scheme_apply(red, 2, a);
if (SAME_TYPE(SCHEME_TYPE(red), scheme_native_closure_type))
o = _scheme_apply_native(red, 2, a);
else
o = _scheme_apply(red, 2, a);
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR))
if (!scheme_chaperone_of(o, orig))
if (!SAME_OBJ(o, orig) && !scheme_chaperone_of(o, orig))
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: chaperone produced a result: %V that is not a chaperone of the original result: %V",
who,
@ -1978,10 +1981,13 @@ static void chaperone_struct_set(const char *who, Scheme_Object *o, int i, Schem
if (SCHEME_TRUEP(red)) {
a[0] = o;
a[1] = v;
v = _scheme_apply(red, 2, a);
if (SAME_TYPE(SCHEME_TYPE(red), scheme_native_closure_type))
v = _scheme_apply_native(red, 2, a);
else
v = _scheme_apply(red, 2, a);
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR))
if (!scheme_chaperone_of(v, a[1]))
if (!SAME_OBJ(v, a[1]) && !scheme_chaperone_of(v, a[1]))
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: chaperone produced a result: %V that is not a chaperone of the original result: %V",
who,
@ -2315,7 +2321,7 @@ static int parse_pos(const char *who, Struct_Proc_Info *i, Scheme_Object **args,
return pos;
}
static Scheme_Object *struct_getter(int argc, Scheme_Object **args, Scheme_Object *prim)
Scheme_Object *scheme_struct_getter(int argc, Scheme_Object **args, Scheme_Object *prim)
{
Scheme_Structure *inst;
int pos;
@ -2349,7 +2355,7 @@ static Scheme_Object *struct_getter(int argc, Scheme_Object **args, Scheme_Objec
return scheme_struct_ref(args[0], pos);
}
static Scheme_Object *struct_setter(int argc, Scheme_Object **args, Scheme_Object *prim)
Scheme_Object *scheme_struct_setter(int argc, Scheme_Object **args, Scheme_Object *prim)
{
Scheme_Structure *inst;
int pos;
@ -3765,7 +3771,7 @@ make_struct_proc(Scheme_Struct_Type *struct_type,
a[0] = (Scheme_Object *)i;
if ((proc_type == SCHEME_GETTER) || (proc_type == SCHEME_GEN_GETTER)) {
p = scheme_make_folding_prim_closure(struct_getter,
p = scheme_make_folding_prim_closure(scheme_struct_getter,
1, a,
func_name,
1 + need_pos, 1 + need_pos, 0);
@ -3777,7 +3783,7 @@ make_struct_proc(Scheme_Struct_Type *struct_type,
This avoids keep lots of useless accessors.
if (need_pos) struct_type->accessor = p; */
} else {
p = scheme_make_folding_prim_closure(struct_setter,
p = scheme_make_folding_prim_closure(scheme_struct_setter,
1, a,
func_name,
2 + need_pos, 2 + need_pos, 0);