JIT: inline char->integer' and integer->char'

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)

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;

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;

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

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

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

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