JIT-inline list-ref' and list-tail'

src/racket/src/jit.h

@@ -243,6 +243,7 @@ struct scheme_jit_common_record {
   void *values_code;
   void *list_p_code, *list_p_branch_code;
   void *list_length_code;
+  void *list_ref_code, *list_tail_code;
   void *finish_tail_call_code, *finish_tail_call_fixup_code;
   void *module_run_start_code, *module_exprun_start_code, *module_start_start_code;
   void *box_flonum_from_stack_code;

src/racket/src/jit_ts.c

@@ -85,6 +85,8 @@ define_ts_sis_v(scheme_struct_set, FSRC_MARKS)
 define_ts_iS_s(scheme_extract_checked_procedure, FSRC_MARKS)
 define_ts_iS_s(scheme_procedure_arity_includes, FSRC_MARKS)
 define_ts_ssi_s(vector_check_chaperone_of, FSRC_OTHER)
+define_ts_iS_s(scheme_checked_list_ref, FSRC_MARKS)
+define_ts_iS_s(scheme_checked_list_tail, FSRC_MARKS)
 #endif
 
 #ifdef JITCALL_TS_PROCS

src/racket/src/jitcommon.c

@@ -2368,6 +2368,93 @@ static int common8(mz_jit_state *jitter, void *_data)
   return 1;
 }
 
+static int common8_5(mz_jit_state *jitter, void *_data)
+{
+  int i;
+
+  /* list_{ref,tail}_code */
+  /* first argument is in R0, second in R1 */
+  for (i = 0; i < 2; i++) {
+    void *code;
+    GC_CAN_IGNORE jit_insn *refslow, *refloop, *refdone, *ref, *refr;
+
+    code = jit_get_ip().ptr;
+    if (i == 0)
+      sjc.list_tail_code = code;
+    else
+      sjc.list_ref_code = code;
+
+    mz_prolog(JIT_R2);
+    
+    __START_SHORT_JUMPS__(1);
+    
+    /* Save original arguments: */
+    jit_movr_p(JIT_V1, JIT_R0);
+    mz_set_local_p(JIT_R1, JIT_LOCAL3);
+
+    ref = jit_bmsi_l(jit_forward(), JIT_R1, 0x1);
+
+    refslow = _jit.x.pc;
+    
+    jit_subi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(2));
+    JIT_UPDATE_THREAD_RSPTR();
+    mz_get_local_p(JIT_R1, JIT_LOCAL3);
+    jit_stxi_p(WORDS_TO_BYTES(1), JIT_RUNSTACK, JIT_R1);
+    jit_str_p(JIT_RUNSTACK, JIT_V1);
+    CHECK_LIMIT();
+    jit_movi_i(JIT_R0, 2);
+    mz_prepare(2);
+    jit_pusharg_p(JIT_RUNSTACK);
+    jit_pusharg_i(JIT_R0);
+    __END_SHORT_JUMPS__(1);
+    if (i == 0) {
+      mz_finish_prim_lwe(ts_scheme_checked_list_tail, refr);
+    } else {
+      mz_finish_prim_lwe(ts_scheme_checked_list_ref, refr);
+    }
+    __START_SHORT_JUMPS__(1);
+    jit_retval(JIT_R0);
+    jit_addi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(2));
+    JIT_UPDATE_THREAD_RSPTR();
+    CHECK_LIMIT();
+    mz_epilog(JIT_R2);
+
+    mz_patch_branch(ref);
+
+    /* Handle simple cases: small fixnum index */
+    jit_rshi_l(JIT_R1, JIT_R1, 1);
+    (void)jit_blti_l(refslow, JIT_R1, 0);
+    (void)jit_bgti_l(refslow, JIT_R1, 10000);
+    
+    refloop = _jit.x.pc;
+    if (i == 0) {
+      refdone = jit_beqi_l(jit_forward(), JIT_R1, 0);
+    } else
+      refdone = NULL;
+    (void)jit_bmsi_l(refslow, JIT_R0, 0x1);
+    (void)mz_bnei_t(refslow, JIT_R0, scheme_pair_type, JIT_R2);
+    if (i == 1) {
+      refdone = jit_beqi_l(jit_forward(), JIT_R1, 0);
+    }
+    jit_subi_l(JIT_R1, JIT_R1, 1);
+    jit_ldxi_p(JIT_R0, JIT_R0, (intptr_t)&SCHEME_CDR(0x0));
+    (void)jit_jmpi(refloop);
+
+    mz_patch_branch(refdone);
+    if (i == 1) {
+      jit_ldxi_p(JIT_R0, JIT_R0, (intptr_t)&SCHEME_CAR(0x0));
+    }
+    mz_epilog(JIT_R2);
+    CHECK_LIMIT();
+
+    __END_SHORT_JUMPS__(1);
+
+    scheme_jit_register_sub_func(jitter, code, scheme_false);
+  }
+
+  return 1;
+}
+
 static int common9(mz_jit_state *jitter, void *_data)
 {
   int i;
@@ -2551,6 +2638,7 @@ int scheme_do_generate_common(mz_jit_state *jitter, void *_data)
   if (!common6(jitter, _data)) return 0;
   if (!common7(jitter, _data)) return 0;
   if (!common8(jitter, _data)) return 0;
+  if (!common8_5(jitter, _data)) return 0;
   if (!common9(jitter, _data)) return 0;
   if (!common10(jitter, _data)) return 0;
   return 1;

src/racket/src/jitinline.c

@@ -2326,6 +2326,16 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
       jit_lshi_l(JIT_R0, JIT_R0, 0x1);
       jit_ori_l(JIT_R0, JIT_R0, 0x1);
 
+      return 1;
+    } else if (IS_NAMED_PRIM(rator, "list-ref")
+               || IS_NAMED_PRIM(rator, "list-tail")) {
+      generate_two_args(app->rand1, app->rand2, jitter, 1, 2);
+
+      if (IS_NAMED_PRIM(rator, "list-ref"))
+        (void)jit_calli(sjc.list_ref_code);
+      else
+        (void)jit_calli(sjc.list_tail_code);
+
       return 1;
     } else if (IS_NAMED_PRIM(rator, "set-mcar!")
                || IS_NAMED_PRIM(rator, "set-mcdr!")) {

src/racket/src/list.c

@@ -51,8 +51,6 @@ static Scheme_Object *immutablep (int argc, Scheme_Object *argv[]);
 static Scheme_Object *length_prim (int argc, Scheme_Object *argv[]);
 static Scheme_Object *append_prim (int argc, Scheme_Object *argv[]);
 static Scheme_Object *reverse_prim (int argc, Scheme_Object *argv[]);
-static Scheme_Object *list_tail_prim (int argc, Scheme_Object *argv[]);
-static Scheme_Object *list_ref_prim (int argc, Scheme_Object *argv[]);
 static Scheme_Object *memv (int argc, Scheme_Object *argv[]);
 static Scheme_Object *memq (int argc, Scheme_Object *argv[]);
 static Scheme_Object *member (int argc, Scheme_Object *argv[]);
@@ -264,16 +262,15 @@ scheme_init_list (Scheme_Env *env)
 						     "reverse",
 						     1, 1),
 			      env);
-  scheme_add_global_constant ("list-tail",
+
-			      scheme_make_immed_prim(list_tail_prim,
+  p = scheme_make_immed_prim(scheme_checked_list_tail, "list-tail", 2, 2);
-						     "list-tail",
+  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
-						     2, 2),
+  scheme_add_global_constant ("list-tail", p, env);
-			      env);
+
-  scheme_add_global_constant ("list-ref",
+  p = scheme_make_immed_prim(scheme_checked_list_ref, "list-ref", 2, 2);
-			      scheme_make_immed_prim(list_ref_prim,
+  SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
-						     "list-ref",
+  scheme_add_global_constant ("list-ref",p, env);
-						     2, 2),
+
-			      env);
   scheme_add_global_constant ("memq",
 			      scheme_make_immed_prim(memq,
 						     "memq",
@@ -1330,14 +1327,14 @@ do_list_ref(char *name, int takecar, int argc, Scheme_Object *argv[])
     return lst;
 }
 
-static Scheme_Object *
+Scheme_Object *
-list_tail_prim(int argc, Scheme_Object *argv[])
+scheme_checked_list_tail(int argc, Scheme_Object *argv[])
 {
   return do_list_ref("list-tail", 0, argc, argv);
 }
 
-static Scheme_Object *
+Scheme_Object *
-list_ref_prim(int argc, Scheme_Object *argv[])
+scheme_checked_list_ref(int argc, Scheme_Object *argv[])
 {
   return do_list_ref("list-ref", 1, argc, argv);
 }

src/racket/src/schpriv.h

@@ -3485,6 +3485,8 @@ Scheme_Object *scheme_checked_cadr(int argc, Scheme_Object **argv);
 Scheme_Object *scheme_checked_cdar(int argc, Scheme_Object **argv);
 Scheme_Object *scheme_checked_cddr(int argc, Scheme_Object **argv);
 Scheme_Object *scheme_checked_length(Scheme_Object *v);
+Scheme_Object *scheme_checked_list_tail(int argc, Scheme_Object **argv);
+Scheme_Object *scheme_checked_list_ref(int argc, Scheme_Object **argv);
 Scheme_Object *scheme_checked_mcar(int argc, Scheme_Object **argv);
 Scheme_Object *scheme_checked_mcdr(int argc, Scheme_Object **argv);
 Scheme_Object *scheme_checked_set_mcar (int argc, Scheme_Object *argv[]);