Eliminate 3 instructions from PIC fast path

basis/bootstrap/image/image.factor

@@ -163,6 +163,7 @@ SYMBOL: jit-declare-word
 SYMBOL: jit-save-stack
 
 ! PIC stubs
+SYMBOL: pic-load
 SYMBOL: pic-tag
 SYMBOL: pic-hi-tag
 SYMBOL: pic-tuple
@@ -204,13 +205,14 @@ SYMBOL: undefined-quot
         { jit-execute-word 45 }
         { jit-execute-jump 46 }
         { jit-execute-call 47 }
-        { pic-tag 48 }
+        { pic-load 48 }
-        { pic-hi-tag 49 }
+        { pic-tag 49 }
-        { pic-tuple 50 }
+        { pic-hi-tag 50 }
-        { pic-hi-tag-tuple 51 }
+        { pic-tuple 51 }
-        { pic-check 52 }
+        { pic-hi-tag-tuple 52 }
-        { pic-hit 53 }
+        { pic-check 53 }
-        { pic-miss-word 54 }
+        { pic-hit 54 }
+        { pic-miss-word 55 }
         { undefined-quot 60 }
     } ; inline
 
@@ -554,6 +556,7 @@ M: quotation '
         jit-profiling
         jit-declare-word
         jit-save-stack
+        pic-load
         pic-tag
         pic-hi-tag
         pic-tuple

basis/compiler/constants/constants.factor

@@ -46,6 +46,7 @@ CONSTANT: rt-here        5
 CONSTANT: rt-this        6
 CONSTANT: rt-immediate   7
 CONSTANT: rt-stack-chain 8
+CONSTANT: rt-untagged    9
 
 : rc-absolute? ( n -- ? )
     [ rc-absolute-ppc-2/2 = ]

basis/cpu/x86/bootstrap.factor

@@ -172,17 +172,21 @@ big-endian off
 
 ! ! ! Polymorphic inline caches
 
-! The 'make' trick lets us compute the jump distance for the conditional branches there
+! Load a value from a stack position
+[
+    temp0 ds-reg HEX: ffffffff [+] MOV rc-absolute rt-untagged jit-rel
+] pic-load jit-define
 
 ! Tag
 : make-pic-tag ( -- )
-    ds-reg bootstrap-cell SUB
     temp1 temp0 MOV
     temp1 tag-mask get AND
     temp1 tag-bits get SHL ;
 
 [ make-pic-tag ] pic-tag jit-define
 
+! The 'make' trick lets us compute the jump distance for the conditional branches there
+
 ! Hi-tag
 [
     make-pic-tag

core/generic/standard/standard.factor

@@ -27,6 +27,7 @@ CONSTANT: simple-combination T{ standard-combination f 0 }
         { 0 [ [ dup ] ] }
         { 1 [ [ over ] ] }
         { 2 [ [ pick ] ] }
+        [ 1- (picker) [ dip swap ] curry ]
     } case ;
 
 M: standard-combination picker
@@ -42,7 +43,7 @@ M: standard-combination direct-entry-def ( word methods -- )
     #! Direct calls to the generic word (not tail calls or indirect calls)
     #! will jump to the inline cache entry point instead of the megamorphic
     #! dispatch entry point.
-    picker first [ [ f inline-cache-miss ] 3curry ] keep prefix ;
+    combination get #>> [ f inline-cache-miss ] 3curry [ ] like ;
 
 M: standard-generic definer drop \ GENERIC# f ;
 

vm/code_block.c

@@ -27,6 +27,7 @@ void iterate_relocations(F_CODE_BLOCK *compiled, RELOCATION_ITERATOR iter)
 			case RT_XT_DIRECT:
 			case RT_IMMEDIATE:
 			case RT_HERE:
+			case RT_UNTAGGED:
 				index++;
 				break;
 			case RT_DLSYM:
@@ -374,6 +375,9 @@ void relocate_code_block_step(F_REL rel, CELL index, F_CODE_BLOCK *compiled)
 	case RT_STACK_CHAIN:
 		absolute_value = (CELL)&stack_chain;
 		break;
+	case RT_UNTAGGED:
+		absolute_value = to_fixnum(array_nth(literals,index));
+		break;
 	default:
 		critical_error("Bad rel type",rel);
 		return; /* Can't happen */

vm/code_block.h

@@ -16,7 +16,9 @@ typedef enum {
 	/* immediate literal */
 	RT_IMMEDIATE,
 	/* address of stack_chain var */
-	RT_STACK_CHAIN
+	RT_STACK_CHAIN,
+	/* untagged fixnum literal */
+	RT_UNTAGGED,
 } F_RELTYPE;
 
 typedef enum {

vm/inline_cache.c

@@ -50,17 +50,15 @@ static void update_pic_count(CELL type)
 	pic_counts[type - PIC_TAG]++;
 }
 
-/* picker: one of dup, over, pick
+/* index: 0 = top of stack, 1 = item underneath, etc
    cache_entries: array of class/method pairs */
-static F_CODE_BLOCK *compile_inline_cache(CELL picker, CELL generic_word, CELL methods, CELL cache_entries)
+static F_CODE_BLOCK *compile_inline_cache(F_FIXNUM index, CELL generic_word, CELL methods, CELL cache_entries)
 {
 #ifdef FACTOR_DEBUG
-	type_check(WORD_TYPE,picker);
 	type_check(WORD_TYPE,generic_word);
 	type_check(ARRAY_TYPE,cache_entries);
 #endif
 
-	REGISTER_ROOT(picker);
 	REGISTER_ROOT(generic_word);
 	REGISTER_ROOT(methods);
 	REGISTER_ROOT(cache_entries);
@@ -73,7 +71,7 @@ static F_CODE_BLOCK *compile_inline_cache(CELL picker, CELL generic_word, CELL m
 	jit_init(&jit,WORD_TYPE,generic_word);
 
 	/* Generate machine code to determine the object's class. */
-	jit_emit_subprimitive(&jit,untag_object(picker));
+	jit_emit_with(&jit,userenv[PIC_LOAD],tag_fixnum(-index * CELLS));
 	jit_emit(&jit,userenv[inline_cache_type]);
 
 	/* Generate machine code to check, in turn, if the class is one of the cached entries. */
@@ -93,12 +91,10 @@ static F_CODE_BLOCK *compile_inline_cache(CELL picker, CELL generic_word, CELL m
 	   this function being called again.
 
 	   The inline-cache-miss primitive call receives enough information to
-	   reconstruct the PIC. We also execute the picker again, so that the
+	   reconstruct the PIC. */
-	   object being dispatched on can be popped from the top of the stack. */
-	jit_emit_subprimitive(&jit,untag_object(picker));
 	jit_push(&jit,generic_word);
 	jit_push(&jit,methods);
-	jit_push(&jit,picker);
+	jit_push(&jit,tag_fixnum(index));
 	jit_push(&jit,cache_entries);
 	jit_word_jump(&jit,userenv[PIC_MISS_WORD]);
 
@@ -110,7 +106,6 @@ static F_CODE_BLOCK *compile_inline_cache(CELL picker, CELL generic_word, CELL m
 	UNREGISTER_ROOT(cache_entries);
 	UNREGISTER_ROOT(methods);
 	UNREGISTER_ROOT(generic_word);
-	UNREGISTER_ROOT(picker);
 
 	return code;
 }
@@ -159,10 +154,10 @@ XT inline_cache_miss(CELL return_address)
 	check_code_pointer(return_address);
 
 	CELL cache_entries = dpop();
-	CELL picker = dpop();
+	F_FIXNUM index = untag_fixnum_fast(dpop());
 	CELL methods = dpop();
 	CELL generic_word = dpop();
-	CELL object = dpop();
+	CELL object = get(ds - index * CELLS);
 
 	XT xt;
 
@@ -176,17 +171,15 @@ XT inline_cache_miss(CELL return_address)
 	{
 		REGISTER_ROOT(generic_word);
 		REGISTER_ROOT(cache_entries);
-		REGISTER_ROOT(picker);
 		REGISTER_ROOT(methods);
 
 		CELL class = object_class(object);
 		CELL method = lookup_method(object,methods);
 
 		cache_entries = add_inline_cache_entry(cache_entries,class,method);
-		xt = compile_inline_cache(picker,generic_word,methods,cache_entries) + 1;
+		xt = compile_inline_cache(index,generic_word,methods,cache_entries) + 1;
 
 		UNREGISTER_ROOT(methods);
-		UNREGISTER_ROOT(picker);
 		UNREGISTER_ROOT(cache_entries);
 		UNREGISTER_ROOT(generic_word);
 	}

vm/run.h

@@ -61,7 +61,8 @@ typedef enum {
 	JIT_EXECUTE_CALL,
 
 	/* Used by polymorphic inline cache generation in inline_cache.c */
-	PIC_TAG             = 48,
+	PIC_LOAD            = 48,
+	PIC_TAG,
 	PIC_HI_TAG,
 	PIC_TUPLE,
 	PIC_HI_TAG_TUPLE,