diff --git a/racket/src/racket/src/jit.h b/racket/src/racket/src/jit.h index f9a7c222ed..a7f929ad11 100644 --- a/racket/src/racket/src/jit.h +++ b/racket/src/racket/src/jit.h @@ -344,6 +344,7 @@ struct scheme_jit_common_record { void *bad_char_to_integer_code, *slow_integer_to_char_code; void *slow_cpointer_tag_code, *slow_set_cpointer_tag_code; void *values_code; + void *symbol_interned_p_code; void *list_p_code, *list_p_branch_code; void *list_length_code; void *list_ref_code, *list_tail_code; diff --git a/racket/src/racket/src/jit_ts.c b/racket/src/racket/src/jit_ts.c index 1b151c78a9..08fd39775f 100644 --- a/racket/src/racket/src/jit_ts.c +++ b/racket/src/racket/src/jit_ts.c @@ -116,6 +116,7 @@ define_ts__v(chaperone_set_mark, FSRC_MARKS) define_ts_ss_s(scheme_chaperone_get_immediate_cc_mark, FSRC_MARKS) define_ts_iS_s(scheme_checked_char_to_integer, FSRC_MARKS) define_ts_iS_s(scheme_checked_integer_to_char, FSRC_MARKS) +define_ts_iS_s(scheme_checked_symbol_interned_p, FSRC_MARKS) # ifndef CAN_INLINE_ALLOC define_ts_iSi_s(scheme_build_list_offset, FSRC_OTHER) # endif @@ -272,6 +273,7 @@ define_ts_s_s(scheme_box, FSRC_OTHER) # define ts_scheme_struct_setter scheme_struct_setter # define ts_scheme_checked_char_to_integer scheme_checked_char_to_integer # define ts_scheme_checked_integer_to_char scheme_checked_integer_to_char +# define ts_scheme_checked_symbol_interned_p scheme_checked_symbol_interned_p # define ts_scheme_check_not_undefined scheme_check_not_undefined # define ts_scheme_check_assign_not_undefined scheme_check_assign_not_undefined # define ts_scheme_foreign_ptr_ref scheme_foreign_ptr_ref diff --git a/racket/src/racket/src/jitcommon.c b/racket/src/racket/src/jitcommon.c index 01b6dd9e43..8eda1235c5 100644 --- a/racket/src/racket/src/jitcommon.c +++ b/racket/src/racket/src/jitcommon.c @@ -3446,6 +3446,29 @@ static int common11(mz_jit_state *jitter, void *_data) CHECK_LIMIT(); } + /* symbol_interned_p_code */ + /* R0 has non-symbol argument */ + { + GC_CAN_IGNORE jit_insn *refr USED_ONLY_FOR_FUTURES; + + sjc.symbol_interned_p_code = jit_get_ip(); + + mz_prolog(JIT_R2); + + jit_subi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(1)); + JIT_UPDATE_THREAD_RSPTR(); + jit_str_p(JIT_RUNSTACK, JIT_R0); + CHECK_LIMIT(); + jit_movi_i(JIT_R0, 1); + mz_prepare(2); + jit_pusharg_p(JIT_RUNSTACK); + jit_pusharg_i(JIT_R0); + mz_finish_prim_lwe(ts_scheme_checked_symbol_interned_p, refr); /* doesn't return */ + + scheme_jit_register_sub_func(jitter, sjc.symbol_interned_p_code, scheme_false); + CHECK_LIMIT(); + } + return 1; } diff --git a/racket/src/racket/src/jitinline.c b/racket/src/racket/src/jitinline.c index 0952f1ecf0..f4f3b6890d 100644 --- a/racket/src/racket/src/jitinline.c +++ b/racket/src/racket/src/jitinline.c @@ -1423,6 +1423,47 @@ int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in return 1; } else if (IS_NAMED_PRIM(rator, "char-whitespace?")) { generate_inlined_char_category_test(jitter, app, SCHEME_ISSPACE_BIT, for_branch, branch_short, dest); + return 1; + } else if (IS_NAMED_PRIM(rator, "symbol-interned?")) { + GC_CAN_IGNORE jit_insn *ref1, *reffail, *ref_no; + + mz_runstack_skipped(jitter, 1); + scheme_generate_non_tail(app->rand, jitter, 0, 1, 0); + CHECK_LIMIT(); + mz_runstack_unskipped(jitter, 1); + + mz_rs_sync(); + + __START_SHORT_JUMPS__(branch_short); + + __START_INNER_TINY__(branch_short); + ref1 = jit_bmci_ul(jit_forward(), JIT_R0, 0x1); + __END_INNER_TINY__(branch_short); + reffail = jit_get_ip(); + (void)jit_calli(sjc.symbol_interned_p_code); + + __START_INNER_TINY__(branch_short); + mz_patch_branch(ref1); + (void)mz_bnei_t(reffail, JIT_R0, scheme_symbol_type, JIT_R2); + __END_INNER_TINY__(branch_short); + + jit_ldxi_s(JIT_R2, JIT_R0, &MZ_OPT_HASH_KEY(&((Scheme_Symbol *)0x0)->iso)); + + if (for_branch) { + ref_no = jit_bmsi_ul(jit_forward(), JIT_R2, 0x3); + scheme_add_branch_false(for_branch, ref_no); + scheme_branch_for_true(jitter, for_branch); + } else { + (void)jit_movi_p(dest, scheme_false); + __START_INNER_TINY__(branch_short); + ref_no = jit_bmsi_ul(jit_forward(), JIT_R2, 0x3); + (void)jit_movi_p(dest, scheme_true); + mz_patch_branch(ref_no); + __END_INNER_TINY__(branch_short); + } + + __END_SHORT_JUMPS__(branch_short); + return 1; } else if (IS_NAMED_PRIM(rator, "list?") || IS_NAMED_PRIM(rator, "list-pair?")) { diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 6b62bb9010..3237b88a5b 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -3732,6 +3732,7 @@ Scheme_Object *scheme_checked_make_flrectangular (int argc, Scheme_Object *argv[ Scheme_Object *scheme_procedure_arity_includes(int argc, Scheme_Object *argv[]); Scheme_Object *scheme_checked_char_to_integer(int argc, Scheme_Object *argv[]); Scheme_Object *scheme_checked_integer_to_char(int argc, Scheme_Object *argv[]); +Scheme_Object *scheme_checked_symbol_interned_p(int argc, Scheme_Object *argv[]); Scheme_Object *scheme_checked_make_vector(int argc, Scheme_Object *argv[]); Scheme_Object *scheme_checked_hash_ref(int argc, Scheme_Object *argv[]); Scheme_Object *scheme_checked_hash_count(int argc, Scheme_Object *argv[]); diff --git a/racket/src/racket/src/symbol.c b/racket/src/racket/src/symbol.c index 1c60822da8..0796fed251 100644 --- a/racket/src/racket/src/symbol.c +++ b/racket/src/racket/src/symbol.c @@ -72,7 +72,6 @@ READ_ONLY Scheme_Object *scheme_keyword_p_proc; static Scheme_Object *symbol_lt (int argc, Scheme_Object *argv[]); static Scheme_Object *symbol_p_prim (int argc, Scheme_Object *argv[]); static Scheme_Object *symbol_unreadable_p_prim (int argc, Scheme_Object *argv[]); -static Scheme_Object *symbol_interned_p_prim (int argc, Scheme_Object *argv[]); static Scheme_Object *string_to_symbol_prim (int argc, Scheme_Object *argv[]); static Scheme_Object *string_to_uninterned_symbol_prim (int argc, Scheme_Object *argv[]); static Scheme_Object *string_to_unreadable_symbol_prim (int argc, Scheme_Object *argv[]); @@ -343,8 +342,10 @@ scheme_init_symbol (Scheme_Startup_Env *env) p = scheme_make_folding_prim(symbol_unreadable_p_prim, "symbol-unreadable?", 1, 1, 1); scheme_addto_prim_instance("symbol-unreadable?", p, env); - - p = scheme_make_folding_prim(symbol_interned_p_prim, "symbol-interned?", 1, 1, 1); + + p = scheme_make_folding_prim(scheme_checked_symbol_interned_p, "symbol-interned?", 1, 1, 1); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED + | SCHEME_PRIM_PRODUCES_BOOL); scheme_addto_prim_instance("symbol-interned?", p, env); ADD_FOLDING_PRIM("symbol