diff --git a/collects/tests/racket/optimize.rktl b/collects/tests/racket/optimize.rktl index f11cc3b6fd..3c8e4440b4 100644 --- a/collects/tests/racket/optimize.rktl +++ b/collects/tests/racket/optimize.rktl @@ -635,6 +635,17 @@ (bin-exact #f 'char=? #\a #\b) (bin-exact #f 'char=? #\u1034 #\a) + (un-exact #\space 'integer->char 32) + (un-exact #\nul 'integer->char 0) + (un-exact #\uFF 'integer->char 255) + (un-exact #\u100 'integer->char 256) + (un-exact #\U10000 'integer->char #x10000) + + (un-exact 32 'char->integer #\space) + (un-exact 0 'char->integer #\nul) + (un-exact 255 'char->integer #\uFF) + (un-exact #x10000 'char->integer #\U10000) + (bin-exact 'a 'vector-ref #(a b c) 0 #t) (bin-exact 'b 'vector-ref #(a b c) 1) (bin-exact 'c 'vector-ref #(a b c) 2) diff --git a/src/racket/src/char.c b/src/racket/src/char.c index 067ea93ca0..088849f5a2 100644 --- a/src/racket/src/char.c +++ b/src/racket/src/char.c @@ -54,8 +54,6 @@ static Scheme_Object *char_punctuation (int argc, Scheme_Object *argv[]); static Scheme_Object *char_upper_case (int argc, Scheme_Object *argv[]); static Scheme_Object *char_lower_case (int argc, Scheme_Object *argv[]); static Scheme_Object *char_title_case (int argc, Scheme_Object *argv[]); -static Scheme_Object *char_to_integer (int argc, Scheme_Object *argv[]); -static Scheme_Object *integer_to_char (int argc, Scheme_Object *argv[]); static Scheme_Object *char_upcase (int argc, Scheme_Object *argv[]); static Scheme_Object *char_downcase (int argc, Scheme_Object *argv[]); static Scheme_Object *char_titlecase (int argc, Scheme_Object *argv[]); @@ -126,8 +124,14 @@ void scheme_init_char (Scheme_Env *env) GLOBAL_FOLDING_PRIM("char-title-case?", char_title_case, 1, 1, 1, env); GLOBAL_FOLDING_PRIM("char-lower-case?", char_lower_case, 1, 1, 1, env); GLOBAL_FOLDING_PRIM("char-title-case?", char_title_case, 1, 1, 1, env); - GLOBAL_FOLDING_PRIM("char->integer", char_to_integer, 1, 1, 1, env); - GLOBAL_FOLDING_PRIM("integer->char", integer_to_char, 1, 1, 1, env); + + p = scheme_make_folding_prim(scheme_checked_char_to_integer, "char->integer", 1, 1, 1); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED); + scheme_add_global_constant("char->integer", p, env); + p = scheme_make_folding_prim(scheme_checked_integer_to_char, "integer->char", 1, 1, 1); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED); + scheme_add_global_constant("integer->char", p, env); + GLOBAL_FOLDING_PRIM("char-upcase", char_upcase, 1, 1, 1, env); GLOBAL_FOLDING_PRIM("char-downcase", char_downcase, 1, 1, 1, env); GLOBAL_FOLDING_PRIM("char-titlecase", char_titlecase, 1, 1, 1, env); @@ -224,8 +228,8 @@ GEN_CHAR_TEST(char_upper_case, "char-upper-case?", scheme_isupper) GEN_CHAR_TEST(char_lower_case, "char-lower-case?", scheme_islower) GEN_CHAR_TEST(char_title_case, "char-title-case?", scheme_istitle) -static Scheme_Object * -char_to_integer (int argc, Scheme_Object *argv[]) +Scheme_Object * +scheme_checked_char_to_integer (int argc, Scheme_Object *argv[]) { mzchar c; @@ -237,8 +241,8 @@ char_to_integer (int argc, Scheme_Object *argv[]) return scheme_make_integer_value(c); } -static Scheme_Object * -integer_to_char (int argc, Scheme_Object *argv[]) +Scheme_Object * +scheme_checked_integer_to_char (int argc, Scheme_Object *argv[]) { if (SCHEME_INTP(argv[0])) { intptr_t v; diff --git a/src/racket/src/jit.h b/src/racket/src/jit.h index 1a52a59d6f..7681c64a86 100644 --- a/src/racket/src/jit.h +++ b/src/racket/src/jit.h @@ -301,6 +301,7 @@ struct scheme_jit_common_record { void *struct_constr_nary_code, *struct_constr_nary_tail_code, *struct_constr_nary_multi_code; void *bad_app_vals_target; void *app_values_slow_code, *app_values_multi_slow_code, *app_values_tail_slow_code; + void *bad_char_to_integer_code, *slow_integer_to_char_code; void *values_code; void *list_p_code, *list_p_branch_code; void *list_length_code; diff --git a/src/racket/src/jit_ts.c b/src/racket/src/jit_ts.c index a5cd8c7574..5cee7b486c 100644 --- a/src/racket/src/jit_ts.c +++ b/src/racket/src/jit_ts.c @@ -102,6 +102,8 @@ define_ts_iSs_s(scheme_struct_getter, FSRC_MARKS) define_ts_iSs_s(scheme_struct_setter, FSRC_MARKS) define_ts_iS_s(scheme_box_cas, FSRC_MARKS) define_ts__v(chaperone_set_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) #endif #ifdef JITCALL_TS_PROCS @@ -232,4 +234,6 @@ define_ts_s_s(scheme_box, FSRC_OTHER) # 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 +# define ts_scheme_checked_char_to_integer scheme_checked_char_to_integer +# define ts_scheme_checked_integer_to_char scheme_checked_integer_to_char #endif diff --git a/src/racket/src/jitcommon.c b/src/racket/src/jitcommon.c index 4b18477442..de5cdc3641 100644 --- a/src/racket/src/jitcommon.c +++ b/src/racket/src/jitcommon.c @@ -3011,6 +3011,63 @@ static int common10(mz_jit_state *jitter, void *_data) return 1; } +static int common11(mz_jit_state *jitter, void *_data) +{ + /* bad_char_to_integer_code */ + /* R0 has argument */ + { + GC_CAN_IGNORE jit_insn *refr; + + sjc.bad_char_to_integer_code = jit_get_ip().ptr; + + 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_char_to_integer, refr); + /* doesn't return */ + CHECK_LIMIT(); + + scheme_jit_register_sub_func(jitter, sjc.bad_char_to_integer_code, scheme_false); + CHECK_LIMIT(); + } + + /* slow_integer_to_char_code */ + /* R0 has argument */ + { + GC_CAN_IGNORE jit_insn *refr; + + sjc.slow_integer_to_char_code = jit_get_ip().ptr; + + 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_integer_to_char, refr); + jit_retval(JIT_R0); + jit_addi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(1)); + + mz_epilog(JIT_R2); + + scheme_jit_register_sub_func(jitter, sjc.slow_integer_to_char_code, scheme_false); + CHECK_LIMIT(); + } + + return 1; +} + int scheme_do_generate_common(mz_jit_state *jitter, void *_data) { if (!common0(jitter, _data)) return 0; @@ -3028,6 +3085,7 @@ int scheme_do_generate_common(mz_jit_state *jitter, void *_data) if (!common8_5(jitter, _data)) return 0; if (!common9(jitter, _data)) return 0; if (!common10(jitter, _data)) return 0; + if (!common11(jitter, _data)) return 0; return 1; } diff --git a/src/racket/src/jitinline.c b/src/racket/src/jitinline.c index 51a58bb083..55d26b1e3e 100644 --- a/src/racket/src/jitinline.c +++ b/src/racket/src/jitinline.c @@ -1827,6 +1827,65 @@ int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in jit_retval(dest); #endif + return 1; + } else if (IS_NAMED_PRIM(rator, "char->integer")) { + GC_CAN_IGNORE jit_insn *ref, *reffail; + + 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_TINY_JUMPS__(1); + + ref = jit_bmci_ul(jit_forward(), JIT_R0, 0x1); + reffail = _jit.x.pc; + __END_TINY_JUMPS__(1); + (void)jit_calli(sjc.bad_char_to_integer_code); + __START_TINY_JUMPS__(1); + mz_patch_branch(ref); + (void)mz_bnei_t(reffail, JIT_R0, scheme_char_type, JIT_R1); + __END_TINY_JUMPS__(1); + + (void)jit_ldxi_i(JIT_R0, JIT_R0, &SCHEME_CHAR_VAL(0x0)); + CHECK_LIMIT(); + + jit_fixnum_l(JIT_R0, JIT_R0); + + return 1; + } else if (IS_NAMED_PRIM(rator, "integer->char")) { + GC_CAN_IGNORE jit_insn *ref, *refslow, *refdone; + + 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_TINY_JUMPS__(1); + + ref = jit_bmsi_ul(jit_forward(), JIT_R0, 0x1); + refslow = _jit.x.pc; + __END_TINY_JUMPS__(1); + (void)jit_calli(sjc.slow_integer_to_char_code); + refdone = jit_jmpi(jit_forward()); + __START_TINY_JUMPS__(1); + mz_patch_branch(ref); + (void)jit_blti_l(refslow, JIT_R0, scheme_make_integer(0)); + (void)jit_bgti_l(refslow, JIT_R0, scheme_make_integer(255)); + + jit_rshi_l(JIT_R0, JIT_R0, 1); + jit_lshi_l(JIT_R2, JIT_R0, JIT_LOG_WORD_SIZE); + (void)jit_movi_p(JIT_R0, scheme_char_constants); + jit_ldxr_p(JIT_R0, JIT_R0, JIT_R2); + CHECK_LIMIT(); + + mz_patch_ucbranch(refdone); + __END_TINY_JUMPS__(1); + return 1; } else if (IS_NAMED_PRIM(rator, "future?")) { generate_inlined_type_test(jitter, app, scheme_future_type, scheme_future_type, 1, for_branch, branch_short, need_sync, dest); diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index 3b8cfa9ce7..0e3e600188 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -3892,6 +3892,8 @@ Scheme_Object *scheme_checked_flreal_part (int argc, Scheme_Object *argv[]); Scheme_Object *scheme_checked_flimag_part (int argc, Scheme_Object *argv[]); 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_chaperone_vector_copy(Scheme_Object *obj); Scheme_Object *scheme_chaperone_hash_table_copy(Scheme_Object *obj);