JIT-inline immutable?

pkgs/racket-test-core/tests/racket/optimize.rktl

@@ -42,6 +42,7 @@
 							 procedure? symbol? keyword?
 							 string? bytes?
 							 vector? box?
+                                                         immutable?
 							 eof-object?
                                                          exact-integer?
                                                          exact-nonnegative-integer?
@@ -229,6 +230,19 @@
     (un #t 'thing? a-rock)
     (un #t 'thing? chap-rock)
     (un #t 'thing? struct:rock)
+    (un #f 'immutable? (vector 1 2 3))
+    (un #t 'immutable? (vector-immutable 1 2 3))
+    (un #f 'immutable? (box 1))
+    (un #t 'immutable? (box-immutable 1))
+    (un #f 'immutable? (bytes 1 2 3))
+    (un #t 'immutable? (bytes->immutable-bytes (bytes 1 2 3)))
+    (un #f 'immutable? (string #\1 #\2 #\3))
+    (un #f 'immutable? (make-hash))
+    (un #f 'immutable? (make-hasheq))
+    (un #f 'immutable? (make-weak-hasheq))
+    (un #t 'immutable? #hash())
+    (un #t 'immutable? #hasheq())
+    (un #t 'immutable? #hasheqv())
 
     (bin #f 'eq? 0 10)
     (bin-exact #t 'eq? 10 10)

racket/src/racket/src/jitinline.c

@@ -370,6 +370,100 @@ static int generate_inlined_type_test(mz_jit_state *jitter, Scheme_App2_Rec *app
   return 1;
 }
 
+static int generate_inlined_immutable_test(mz_jit_state *jitter, Scheme_App2_Rec *app,
+                                           Branch_Info *for_branch, int branch_short,
+                                           int dest)
+{
+  GC_CAN_IGNORE jit_insn *ref, *ref2, *ref3, *ref4, *ref5;
+  GC_CAN_IGNORE jit_insn *ref6, *ref7, *ref8, *ref9;
+  int reg_valid;
+
+  LOG_IT(("inlined %s\n", ((Scheme_Primitive_Proc *)app->rator)->name));
+
+  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);
+
+  reg_valid = 0;
+  if (for_branch) {
+    reg_valid = mz_CURRENT_REG_STATUS_VALID();
+    scheme_prepare_branch_jump(jitter, for_branch);
+    CHECK_LIMIT();
+  }
+
+  ref = jit_bmsi_ul(jit_forward(), JIT_R0, 0x1);
+  jit_ldxi_s(JIT_R1, JIT_R0, &((Scheme_Object *)0x0)->type);
+  __START_INNER_TINY__(branch_short);
+  ref3 = jit_bnei_i(jit_forward(), JIT_R1, scheme_chaperone_type);
+  jit_ldxi_p(JIT_R1, JIT_R0, (intptr_t)&((Scheme_Chaperone *)0x0)->val);
+  jit_ldxi_s(JIT_R1, JIT_R1, &((Scheme_Object *)0x0)->type);
+  mz_patch_branch(ref3);
+  __END_INNER_TINY__(branch_short);
+  CHECK_LIMIT();
+
+  /* check for immutable hash: */
+  __START_INNER_TINY__(branch_short);
+  ref3 = jit_blti_i(jit_forward(), JIT_R1, scheme_hash_tree_type);
+  __END_INNER_TINY__(branch_short);
+  ref4 = jit_blei_i(jit_forward(), JIT_R1, scheme_hash_tree_indirection_type);
+  __START_INNER_TINY__(branch_short);
+  mz_patch_branch(ref3);
+  __END_INNER_TINY__(branch_short);
+  
+  ref5 = jit_beqi_i(jit_forward(), JIT_R1, scheme_vector_type);
+  ref6 = jit_beqi_i(jit_forward(), JIT_R1, scheme_char_string_type);
+  ref7 = jit_beqi_i(jit_forward(), JIT_R1, scheme_byte_string_type);
+  ref8 = jit_bnei_i(jit_forward(), JIT_R1, scheme_box_type);
+  CHECK_LIMIT();
+    
+  /* still need to check for "immutable" flag */
+  mz_patch_branch(ref5);
+  mz_patch_branch(ref6);
+  mz_patch_branch(ref7);
+  jit_ldxi_s(JIT_R2, JIT_R0, &MZ_OPT_HASH_KEY((Scheme_Inclhash_Object *)0x0));
+  ref9 = jit_bmci_ul(jit_forward(), JIT_R2, 0x1);
+
+  /* is immutable if we get here */
+  mz_patch_branch(ref4);
+  
+  if (for_branch) {
+    scheme_add_branch_false(for_branch, ref);
+    scheme_add_branch_false(for_branch, ref8);
+    scheme_add_branch_false(for_branch, ref9);
+
+    /* In case true is a fall-through, note that the test 
+       didn't disturb R0: */
+    mz_SET_R0_STATUS_VALID(reg_valid);
+
+    scheme_branch_for_true(jitter, for_branch);
+  } else {
+    (void)jit_movi_p(dest, scheme_true);
+    __START_INNER_TINY__(branch_short);
+    ref2 = jit_jmpi(jit_forward());
+    __END_INNER_TINY__(branch_short);
+  
+    mz_patch_branch(ref);
+    mz_patch_branch(ref8);
+    mz_patch_branch(ref9);
+
+    (void)jit_movi_p(dest, scheme_false);
+    __START_INNER_TINY__(branch_short);
+    mz_patch_ucbranch(ref2);
+    __END_INNER_TINY__(branch_short);
+  }
+
+  __END_SHORT_JUMPS__(branch_short);
+
+  return 1;
+}
+
 static Scheme_Object *extract_struct_constant(mz_jit_state *jitter, Scheme_Object *rator)
 {
   if (SCHEME_PROCP(rator))
@@ -1083,6 +1177,9 @@ int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
   } else if (IS_NAMED_PRIM(rator, "odd?")) {
     scheme_generate_arith(jitter, rator, app->rand, NULL, 1, 0, CMP_ODDP, 0, for_branch, branch_short, 0, 0, NULL, dest);
     return 1;
+  } else if (IS_NAMED_PRIM(rator, "immutable?")) {
+    generate_inlined_immutable_test(jitter, app, for_branch, branch_short, dest);
+    return 1;
   } else if (IS_NAMED_PRIM(rator, "list?")
              || IS_NAMED_PRIM(rator, "list-pair?")) {
     int for_list_pair = 0;

racket/src/racket/src/list.c

@@ -319,7 +319,8 @@ scheme_init_list (Scheme_Env *env)
   scheme_add_global_constant ("list-pair?", p, env);
 
   p = scheme_make_folding_prim(immutablep, "immutable?", 1, 1, 1);
-  SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE);
+  SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
+                                                            | SCHEME_PRIM_IS_OMITABLE);
   scheme_add_global_constant("immutable?", p, env);
 
   p = scheme_make_immed_prim(length_prim, "length", 1, 1);