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

diff --git a/basis/compiler/codegen/fixup/fixup.factor b/basis/compiler/codegen/fixup/fixup.factor
index e22242d48e536d2b206a39e1eb1062af66ea17a7..45d87b3270b78466d2c0fc9db8a3565767372d23 100755 (executable)
--- a/basis/compiler/codegen/fixup/fixup.factor
+++ b/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 ;
 

diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor
index b3757bf008ae4ddf0966fbdd2bf518b77b53e66b..f7fe43016232a516b49cfa9ed177cf602f28d1d1 100644 (file)
--- a/basis/compiler/constants/constants.factor
+++ b/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 = ]

diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor
index ef88fe79fd338632c11f00df3f24c3e4aa19826f..9e49916d813148def829eb66e514dd1cb2d97583 100644 (file)
--- a/basis/cpu/ppc/bootstrap.factor
+++ b/basis/cpu/ppc/bootstrap.factor
@@ -60,7 +60,7 @@ CONSTANT: rs-reg 30
     BCTR\r
 ] jit-primitive jit-define\r
 \r
-[ 0 BL rc-relative-ppc-3 rt-xt jit-rel ] jit-word-call jit-define\r
+[ 0 BL rc-relative-ppc-3 rt-xt-direct jit-rel ] jit-word-call jit-define\r
 \r
 [ 0 B rc-relative-ppc-3 rt-xt ] jit-word-jump jit-define\r
 \r

diff --git a/basis/cpu/x86/assembler/assembler.factor b/basis/cpu/x86/assembler/assembler.factor
index 9b34875bc19fcc1b0e7cb9072ff60dc0cca32dea..728cd04e5543bc929dcd4d100f345c900615e4fd 100644 (file)
--- a/basis/cpu/x86/assembler/assembler.factor
+++ b/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 ;
 

diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor
index 77a34277ab64c2d400ca873fdc81a73eabbfd8b1..03a366198ed771babbedcd2ef4b220e8a1037dfd 100644 (file)
--- a/basis/cpu/x86/bootstrap.factor
+++ b/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
 
 [

diff --git a/core/words/words.factor b/core/words/words.factor
index 7ee9a7ca658282a91523186a3620cfed944a765a..1976c1e4cd295e5674bf3bf9fd39ffd9201c8baa 100755 (executable)
--- a/core/words/words.factor
+++ b/core/words/words.factor
@@ -155,6 +155,7 @@ M: word reset-word
     [ subwords forget-all ]
     [ reset-word ]
     [
+        f >>direct-entry-def
         {
             "methods"
             "combination"

diff --git a/vm/code_block.c b/vm/code_block.c
index 391c8cf56e2db1bbf61d4cfabca925d2ba6013b3..4ec800c66d20486a3513ba11ad87002dc35c804b 100644 (file)
--- a/vm/code_block.c
+++ b/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
+       {
+               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
-               return (CELL)untag_quotation(obj)->xt;
+       {
+               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;

diff --git a/vm/code_block.h b/vm/code_block.h
index cb8ebf5e19ea1d078aa03dcd03ed6fb0812d8232..b93e0eec7596717f82e610610899333547810aba 100644 (file)
--- a/vm/code_block.h
+++ b/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 */

diff --git a/vm/code_heap.c b/vm/code_heap.c
index f75fcb1ec52c9caeeb3e4f8cd23aa8480e2d1862..9d36ffb6dfce87dbfc0cb14f511997928836ab00 100755 (executable)
--- a/vm/code_heap.c
+++ b/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 */