diff --git a/src/racket/src/fun.c b/src/racket/src/fun.c index 50ef6e77ca..93bff42e4a 100644 --- a/src/racket/src/fun.c +++ b/src/racket/src/fun.c @@ -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 diff --git a/src/racket/src/jit_ts.c b/src/racket/src/jit_ts.c index b883f358be..8e7a9aa79d 100644 --- a/src/racket/src/jit_ts.c +++ b/src/racket/src/jit_ts.c @@ -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 diff --git a/src/racket/src/jitcommon.c b/src/racket/src/jitcommon.c index f3793d1eb4..aad5437260 100644 --- a/src/racket/src/jitcommon.c +++ b/src/racket/src/jitcommon.c @@ -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); diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index 91398f10d8..0bdcbc4408 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -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, diff --git a/src/racket/src/struct.c b/src/racket/src/struct.c index 2deacb7434..70610075f8 100644 --- a/src/racket/src/struct.c +++ b/src/racket/src/struct.c @@ -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);