Add new relocation type for call sites which may be replaced by ICs

basis/compiler/codegen/fixup/fixup.factor

@@ -58,6 +58,9 @@ SYMBOL: literal-table
 : rel-word ( word class -- )
     [ add-literal ] dip rt-xt rel-fixup ;
 
+: rel-word-direct ( word class -- )
+    [ add-literal ] dip rt-xt-direct rel-fixup ;
+
 : rel-primitive ( word class -- )
     [ def>> first add-literal ] dip rt-primitive rel-fixup ;
 

basis/compiler/constants/constants.factor

@@ -41,10 +41,11 @@ CONSTANT: rt-primitive   0
 CONSTANT: rt-dlsym       1
 CONSTANT: rt-dispatch    2
 CONSTANT: rt-xt          3
-CONSTANT: rt-here        4
-CONSTANT: rt-this        5
-CONSTANT: rt-immediate   6
-CONSTANT: rt-stack-chain 7
+CONSTANT: rt-xt-direct   4
+CONSTANT: rt-here        5
+CONSTANT: rt-this        6
+CONSTANT: rt-immediate   7
+CONSTANT: rt-stack-chain 8
 
 : rc-absolute? ( n -- ? )
     [ rc-absolute-ppc-2/2 = ]

basis/cpu/ppc/bootstrap.factor

@@ -60,7 +60,7 @@ CONSTANT: rs-reg 30
     BCTR
 ] jit-primitive jit-define
 
-[ 0 BL rc-relative-ppc-3 rt-xt jit-rel ] jit-word-call jit-define
+[ 0 BL rc-relative-ppc-3 rt-xt-direct jit-rel ] jit-word-call jit-define
 
 [ 0 B rc-relative-ppc-3 rt-xt ] jit-word-jump jit-define
 

basis/cpu/x86/assembler/assembler.factor

@@ -316,7 +316,7 @@ M: operand JMP { BIN: 100 t HEX: ff } 1-operand ;
 GENERIC: CALL ( op -- )
 : (CALL) ( -- rel-class ) HEX: e8 , 0 4, rc-relative ;
 M: f CALL (CALL) 2drop ;
-M: callable CALL (CALL) rel-word ;
+M: callable CALL (CALL) rel-word-direct ;
 M: label CALL (CALL) label-fixup ;
 M: operand CALL { BIN: 010 t HEX: ff } 1-operand ;
 

basis/cpu/x86/bootstrap.factor

@@ -48,7 +48,7 @@ big-endian off
 ] jit-word-jump jit-define
 
 [
-    f CALL rc-relative rt-xt jit-rel
+    f CALL rc-relative rt-xt-direct jit-rel
 ] jit-word-call jit-define
 
 [

core/words/words.factor

@@ -155,6 +155,7 @@ M: word reset-word
     [ subwords forget-all ]
     [ reset-word ]
     [
+        f >>direct-entry-def
         {
             "methods"
             "combination"

vm/code_block.c

@@ -24,6 +24,7 @@ void iterate_relocations(F_CODE_BLOCK *compiled, RELOCATION_ITERATOR iter)
 			{
 			case RT_PRIMITIVE:
 			case RT_XT:
+			case RT_XT_DIRECT:
 			case RT_IMMEDIATE:
 			case RT_HERE:
 				index++;
@@ -153,14 +154,43 @@ void copy_literal_references(F_CODE_BLOCK *compiled)
 CELL object_xt(CELL obj)
 {
 	if(type_of(obj) == WORD_TYPE)
-		return (CELL)untag_word(obj)->xt;
+	{
+		F_WORD *word = untag_object(obj);
+		return (CELL)word->xt;
+	}
 	else
-		return (CELL)untag_quotation(obj)->xt;
+	{
+		F_QUOTATION *quot = untag_object(obj);
+		return (CELL)quot->xt;
+	}
+}
+
+CELL word_direct_xt(CELL obj)
+{
+#ifdef FACTOR_DEBUG
+	type_check(WORD_TYPE,obj);
+#endif
+	F_WORD *word = untag_object(obj);
+	CELL quot = word->direct_entry_def;
+	if(quot == F || max_pic_size == 0)
+		return (CELL)word->xt;
+	else
+	{
+		F_QUOTATION *untagged = untag_object(quot);
+#ifdef FACTOR_DEBUG
+		type_check(QUOTATION_TYPE,quot);
+#endif
+		if(untagged->compiledp == F)
+			return (CELL)word->xt;
+		else
+			return (CELL)untagged->xt;
+	}
 }
 
 void update_word_references_step(F_REL rel, CELL index, F_CODE_BLOCK *compiled)
 {
-	if(REL_TYPE(rel) == RT_XT)
+	F_RELTYPE type = REL_TYPE(rel);
+	if(type == RT_XT || type == RT_XT_DIRECT)
 	{
 		CELL offset = REL_OFFSET(rel) + (CELL)(compiled + 1);
 		F_ARRAY *literals = untag_object(compiled->literals);
@@ -319,6 +349,9 @@ void relocate_code_block_step(F_REL rel, CELL index, F_CODE_BLOCK *compiled)
 	case RT_XT:
 		absolute_value = object_xt(array_nth(literals,index));
 		break;
+	case RT_XT_DIRECT:
+		absolute_value = word_direct_xt(array_nth(literals,index));
+		break;
 	case RT_HERE:
 		absolute_value = offset + (short)to_fixnum(array_nth(literals,index));
 		break;

vm/code_block.h

@@ -5,8 +5,10 @@ typedef enum {
 	RT_DLSYM,
 	/* a pointer to a compiled word reference */
 	RT_DISPATCH,
-	/* a compiled word reference */
+	/* a word's general entry point XT */
 	RT_XT,
+	/* a word's direct entry point XT */
+	RT_XT_DIRECT,
 	/* current offset */
 	RT_HERE,
 	/* current code block */

vm/code_heap.c

@@ -22,6 +22,9 @@ void jit_compile_word(F_WORD *word, CELL def, bool relocate)
 	UNREGISTER_ROOT(def);
 
 	word->code = untag_quotation(def)->code;
+
+	if(word->direct_entry_def != F)
+		jit_compile(word->direct_entry_def,relocate);
 }
 
 /* Apply a function to every code block */