SYMBOL: pic-check
SYMBOL: pic-hit
SYMBOL: pic-miss-word
+SYMBOL: pic-miss-tail-word
! Megamorphic dispatch
SYMBOL: mega-lookup
{ jit-return 34 }
{ jit-profiling 35 }
{ jit-push-immediate 36 }
- { jit-save-stack 38 }
- { jit-dip-word 39 }
- { jit-dip 40 }
- { jit-2dip-word 41 }
- { jit-2dip 42 }
- { jit-3dip-word 43 }
- { jit-3dip 44 }
- { jit-execute-word 45 }
- { jit-execute-jump 46 }
- { jit-execute-call 47 }
- { pic-load 48 }
- { pic-tag 49 }
- { pic-hi-tag 50 }
- { pic-tuple 51 }
- { pic-hi-tag-tuple 52 }
- { pic-check-tag 53 }
- { pic-check 54 }
- { pic-hit 55 }
- { pic-miss-word 56 }
+ { jit-save-stack 37 }
+ { jit-dip-word 38 }
+ { jit-dip 39 }
+ { jit-2dip-word 40 }
+ { jit-2dip 41 }
+ { jit-3dip-word 42 }
+ { jit-3dip 43 }
+ { jit-execute-word 44 }
+ { jit-execute-jump 45 }
+ { jit-execute-call 46 }
+ { pic-load 47 }
+ { pic-tag 48 }
+ { pic-hi-tag 49 }
+ { pic-tuple 50 }
+ { pic-hi-tag-tuple 51 }
+ { pic-check-tag 52 }
+ { pic-check 53 }
+ { pic-hit 54 }
+ { pic-miss-word 55 }
+ { pic-miss-tail-word 56 }
{ mega-lookup 57 }
{ mega-lookup-word 58 }
{ mega-miss-word 59 }
[ vocabulary>> , ]
[ def>> , ]
[ props>> , ]
- [ direct-entry-def>> , ] ! direct-entry-def
+ [ pic-def>> , ]
+ [ pic-tail-def>> , ]
[ drop 0 , ] ! count
[ word-sub-primitive , ]
[ drop 0 , ] ! xt
\ 3dip jit-3dip-word set
\ (execute) jit-execute-word set
\ inline-cache-miss \ pic-miss-word set
+ \ inline-cache-miss-tail \ pic-miss-tail-word set
\ mega-cache-lookup \ mega-lookup-word set
\ mega-cache-miss \ mega-miss-word set
[ undefined ] undefined-quot set
pic-check
pic-hit
pic-miss-word
+ pic-miss-tail-word
mega-lookup
mega-lookup-word
mega-miss-word
: rel-word-pic ( word class -- )
[ add-literal ] dip rt-xt-pic rel-fixup ;
+: rel-word-pic-tail ( word class -- )
+ [ add-literal ] dip rt-xt-pic-tail rel-fixup ;
+
: rel-primitive ( word class -- )
[ def>> first add-literal ] dip rt-primitive rel-fixup ;
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: math kernel layouts system strings words quotations byte-arrays
-alien arrays ;
+alien arrays literals sequences ;
IN: compiler.constants
! These constants must match vm/memory.h
: float-offset ( -- n ) 8 float tag-number - ; inline
: string-offset ( -- n ) 4 bootstrap-cells string tag-number - ; inline
: string-aux-offset ( -- n ) 2 bootstrap-cells string tag-number - ; inline
-: profile-count-offset ( -- n ) 7 bootstrap-cells \ word tag-number - ; inline
+: profile-count-offset ( -- n ) 8 bootstrap-cells \ word tag-number - ; inline
: byte-array-offset ( -- n ) 2 bootstrap-cells byte-array tag-number - ; inline
: alien-offset ( -- n ) 3 bootstrap-cells alien tag-number - ; inline
: underlying-alien-offset ( -- n ) bootstrap-cell alien tag-number - ; inline
: tuple-class-offset ( -- n ) bootstrap-cell tuple tag-number - ; inline
-: word-xt-offset ( -- n ) 9 bootstrap-cells \ word tag-number - ; inline
+: word-xt-offset ( -- n ) 10 bootstrap-cells \ word tag-number - ; inline
: quot-xt-offset ( -- n ) 5 bootstrap-cells quotation tag-number - ; inline
-: word-code-offset ( -- n ) 10 bootstrap-cells \ word tag-number - ; inline
+: word-code-offset ( -- n ) 11 bootstrap-cells \ word tag-number - ; inline
: array-start-offset ( -- n ) 2 bootstrap-cells array tag-number - ; inline
: compiled-header-size ( -- n ) 4 bootstrap-cells ; inline
CONSTANT: rt-dispatch 2
CONSTANT: rt-xt 3
CONSTANT: rt-xt-pic 4
-CONSTANT: rt-here 5
-CONSTANT: rt-this 6
-CONSTANT: rt-immediate 7
-CONSTANT: rt-stack-chain 8
-CONSTANT: rt-untagged 9
+CONSTANT: rt-xt-pic-tail 5
+CONSTANT: rt-here 6
+CONSTANT: rt-this 7
+CONSTANT: rt-immediate 8
+CONSTANT: rt-stack-chain 9
+CONSTANT: rt-untagged 10
: rc-absolute? ( n -- ? )
- [ rc-absolute-ppc-2/2 = ]
- [ rc-absolute-cell = ]
- [ rc-absolute = ]
- tri or or ;
+ ${ rc-absolute-ppc-2/2 rc-absolute-cell rc-absolute } member? ;
4 cells align ;
M: ppc %call ( word -- ) 0 BL rc-relative-ppc-3 rel-word-pic ;
-M: ppc %jump ( word -- ) 0 B rc-relative-ppc-3 rel-word ;
+
+M: ppc %jump ( word -- )
+ 0 3 LOAD32 rc-absolute-ppc-2/2 rel-here
+ 0 B rc-relative-ppc-3 rel-word-pic-tail ;
+
M: ppc %jump-label ( label -- ) B ;
M: ppc %return ( -- ) BLR ;
M: x86.32 param-reg-1 EAX ;
M: x86.32 param-reg-2 EDX ;
+M: x86.32 pic-tail-reg EBX ;
+
M: x86.32 reserved-area-size 0 ;
M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
M: x86.64 param-reg-2 int-regs param-regs second ;
: param-reg-3 ( -- reg ) int-regs param-regs third ; inline
+M: x86.64 pic-tail-reg RBX ;
+
M: int-regs return-reg drop RAX ;
M: float-regs return-reg drop XMM0 ;
! ! ! Polymorphic inline caches
+! The PIC and megamorphic code stubs are not permitted to touch temp3.
+
! Load a value from a stack position
[
temp1 ds-reg HEX: ffffffff [+] MOV rc-absolute rt-untagged jit-rel
HOOK: param-reg-1 cpu ( -- reg )
HOOK: param-reg-2 cpu ( -- reg )
+HOOK: pic-tail-reg cpu ( -- reg )
+
M: x86 %load-immediate MOV ;
M: x86 %load-reference swap 0 MOV rc-absolute-cell rel-immediate ;
align-stack ;
M: x86 %call ( word -- ) 0 CALL rc-relative rel-word-pic ;
-M: x86 %jump ( word -- ) 0 JMP rc-relative rel-word ;
+
+M: x86 %jump ( word -- )
+ pic-tail-reg 0 MOV 2 cells 1 + rc-absolute-cell rel-here
+ 0 JMP rc-relative rel-word-pic-tail ;
+
M: x86 %jump-label ( label -- ) 0 JMP rc-relative label-fixup ;
+
M: x86 %return ( -- ) 0 RET ;
: code-alignment ( align -- n )
"vocabulary"
{ "def" { "quotation" "quotations" } initial: [ ] }
"props"
- { "direct-entry-def" }
+ "pic-def"
+ "pic-tail-def"
{ "counter" { "fixnum" "math" } }
{ "sub-primitive" read-only }
} define-builtin
{ "load-locals" "locals.backend" (( ... n -- )) }
{ "check-datastack" "kernel.private" (( array in# out# -- ? )) }
{ "inline-cache-miss" "generic.single.private" (( generic methods index cache -- )) }
+ { "inline-cache-miss-tail" "generic.single.private" (( generic methods index cache -- )) }
{ "mega-cache-miss" "generic.single.private" (( methods index cache -- method )) }
{ "lookup-method" "generic.single.private" (( object methods -- method )) }
{ "reset-dispatch-stats" "generic.single" (( -- )) }
M: hook-combination dispatch# drop 0 ;
-M: hook-combination inline-cache-quot 2drop f ;
-
M: hook-combination mega-cache-quot
1quotation picker [ lookup-method (execute) ] surround ;
[ ] [ "IN: generic.single.tests GENERIC: xyz ( a -- b )" eval( -- ) ] unit-test
[ ] [ "IN: generic.single.tests MATH: xyz ( a b -- c )" eval( -- ) ] unit-test
-[ f ] [ "xyz" "generic.single.tests" lookup direct-entry-def>> ] unit-test
+[ f ] [ "xyz" "generic.single.tests" lookup pic-def>> ] unit-test
[ f ] [ "xyz" "generic.single.tests" lookup "decision-tree" word-prop ] unit-test
\ No newline at end of file
[ <engine> compile-engine ] bi
] tri ;
-HOOK: inline-cache-quot combination ( word methods -- quot/f )
+HOOK: inline-cache-quots combination ( word methods -- pic-quot/f pic-tail-quot/f )
+
+M: single-combination inline-cache-quots 2drop f f ;
: define-inline-cache-quot ( word methods -- )
- [ drop ] [ inline-cache-quot ] 2bi >>direct-entry-def drop ;
+ [ drop ] [ inline-cache-quots ] 2bi
+ [ >>pic-def ] [ >>pic-tail-def ] bi*
+ drop ;
HOOK: mega-cache-quot combination ( methods -- quot/f )
USING: accessors definitions generic generic.single kernel
namespaces words math math.order combinators sequences
generic.single.private quotations kernel.private
-assocs arrays layouts ;
+assocs arrays layouts make ;
IN: generic.standard
TUPLE: standard-combination < single-combination # ;
[ datastack ] dip [ "combination" word-prop #>> swap <reversed> nth ] keep
(effective-method) ;
-M: standard-combination inline-cache-quot ( word methods -- )
+: inline-cache-quot ( word methods miss-word -- quot )
+ [ [ literalize , ] [ , ] [ combination get #>> , { } , , ] tri* ] [ ] make ;
+
+M: standard-combination inline-cache-quots
#! 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.
- combination get #>> [ { } inline-cache-miss ] 3curry [ ] like ;
+ [ \ inline-cache-miss inline-cache-quot ]
+ [ \ inline-cache-miss-tail inline-cache-quot ]
+ 2bi ;
: make-empty-cache ( -- array )
mega-cache-size get f <array> ;
M: standard-combination mega-cache-quot
- combination get #>> make-empty-cache [ mega-cache-lookup ] 3curry [ ] like ;
+ combination get #>> make-empty-cache \ mega-cache-lookup [ ] 4sequence ;
M: standard-generic definer drop \ GENERIC# f ;
[ subwords forget-all ]
[ reset-word ]
[
- f >>direct-entry-def
+ f >>pic-def
+ f >>pic-tail-def
{
"methods"
"combination"
{
case RT_PRIMITIVE:
case RT_XT:
- case RT_XT_DIRECT:
+ case RT_XT_PIC:
+ case RT_XT_PIC_TAIL:
case RT_IMMEDIATE:
case RT_HERE:
case RT_UNTAGGED:
}
}
-void *word_direct_xt(word *w)
+static void *xt_pic(word *w, cell tagged_quot)
{
- cell tagged_quot = w->direct_entry_def;
if(tagged_quot == F || max_pic_size == 0)
return w->xt;
else
}
}
+void *word_xt_pic(word *w)
+{
+ return xt_pic(w,w->pic_def);
+}
+
+void *word_xt_pic_tail(word *w)
+{
+ return xt_pic(w,w->pic_tail_def);
+}
+
void update_word_references_step(relocation_entry rel, cell index, code_block *compiled)
{
relocation_type type = REL_TYPE(rel);
- if(type == RT_XT || type == RT_XT_DIRECT)
+ if(type == RT_XT || type == RT_XT_PIC || type == RT_XT_PIC_TAIL)
{
cell offset = REL_OFFSET(rel) + (cell)(compiled + 1);
array *literals = untag<array>(compiled->literals);
cell obj = array_nth(literals,index);
void *xt;
- if(type == RT_XT)
+ switch(type)
+ {
+ case RT_XT:
xt = object_xt(obj);
- else
- xt = word_direct_xt(untag<word>(obj));
+ break;
+ case RT_XT_PIC:
+ xt = word_xt_pic(untag<word>(obj));
+ break;
+ case RT_XT_PIC_TAIL:
+ xt = word_xt_pic_tail(untag<word>(obj));
+ break;
+ default:
+ critical_error("Oops",type);
+ xt = NULL;
+ break;
+ }
store_address_in_code_block(REL_CLASS(rel),offset,(cell)xt);
}
array *literals = untag<array>(compiled->literals);
fixnum absolute_value;
+#define ARG array_nth(literals,index)
+
switch(REL_TYPE(rel))
{
case RT_PRIMITIVE:
- absolute_value = (cell)primitives[untag_fixnum(array_nth(literals,index))];
+ absolute_value = (cell)primitives[untag_fixnum(ARG)];
break;
case RT_DLSYM:
absolute_value = (cell)get_rel_symbol(literals,index);
break;
case RT_IMMEDIATE:
- absolute_value = array_nth(literals,index);
+ absolute_value = ARG;
break;
case RT_XT:
- absolute_value = (cell)object_xt(array_nth(literals,index));
+ absolute_value = (cell)object_xt(ARG);
break;
- case RT_XT_DIRECT:
- absolute_value = (cell)word_direct_xt(untag<word>(array_nth(literals,index)));
+ case RT_XT_PIC:
+ absolute_value = (cell)word_xt_pic(untag<word>(ARG));
+ break;
+ case RT_XT_PIC_TAIL:
+ absolute_value = (cell)word_xt_pic_tail(untag<word>(ARG));
break;
case RT_HERE:
- absolute_value = offset + (short)untag_fixnum(array_nth(literals,index));
+ absolute_value = offset + (short)untag_fixnum(ARG);
break;
case RT_THIS:
absolute_value = (cell)(compiled + 1);
absolute_value = (cell)&stack_chain;
break;
case RT_UNTAGGED:
- absolute_value = untag_fixnum(array_nth(literals,index));
+ absolute_value = untag_fixnum(ARG);
break;
default:
critical_error("Bad rel type",rel);
return; /* Can't happen */
}
+#undef ARG
+
store_address_in_code_block(REL_CLASS(rel),offset,absolute_value);
}
RT_DLSYM,
/* a pointer to a compiled word reference */
RT_DISPATCH,
- /* a word's general entry point XT */
+ /* a word or quotation's general entry point */
RT_XT,
- /* a word's direct entry point XT */
- RT_XT_DIRECT,
+ /* a word's PIC entry point */
+ RT_XT_PIC,
+ /* a word's tail-call PIC entry point */
+ RT_XT_PIC_TAIL,
/* current offset */
RT_HERE,
/* current code block */
word->code = def->code;
- if(word->direct_entry_def != F)
- jit_compile(word->direct_entry_def,relocate);
+ if(word->pic_def != F) jit_compile(word->pic_def,relocate);
+ if(word->pic_tail_def != F) jit_compile(word->pic_tail_def,relocate);
}
/* Apply a function to every code block */
ret
DEF(F_FASTCALL void,primitive_inline_cache_miss,(void)):
- mov (%esp),%eax
+ mov (%esp),%ebx
+DEF(F_FASTCALL void,primitive_inline_cache_miss_tail,(void)):
sub $8,%esp
- push %eax
+ push %ebx
call MANGLE(inline_cache_miss)
add $12,%esp
jmp *%eax
ret /* return _with new stack_ */
DEF(F_FASTCALL void,primitive_inline_cache_miss,(void)):
- mov (%rsp),ARG0
+ mov (%rsp),%rbx
+DEF(F_FASTCALL void,primitive_inline_cache_miss_tail,(void)):
sub $STACK_PADDING,%rsp
+ mov %rbx,ARG0
call MANGLE(inline_cache_miss)
add $STACK_PADDING,%rsp
jmp *%rax
inline static void flush_icache(cell start, cell len) {}
+static const unsigned char call_opcode = 0xe8;
+static const unsigned char jmp_opcode = 0xe9;
+
+inline static unsigned char call_site_opcode(cell return_address)
+{
+ return *(unsigned char *)(return_address - 5);
+}
+
inline static void check_call_site(cell return_address)
{
- /* An x86 CALL instruction looks like so:
- |e8|..|..|..|..|
- where the ... are a PC-relative jump address.
- The return_address points to right after the
- instruction. */
#ifdef FACTOR_DEBUG
- assert(*(unsigned char *)(return_address - 5) == 0xe8);
+ unsigned char opcode = call_site_opcode(return_address);
+ assert(opcode == call_opcode || opcode == jmp_opcode);
#endif
}
*(int *)(return_address - 4) = ((cell)target - return_address);
}
+inline static bool tail_call_site_p(cell return_address)
+{
+ return call_site_opcode(return_address) == jmp_opcode;
+}
+
/* Defined in assembly */
VM_ASM_API void c_to_factor(cell quot);
VM_ASM_API void throw_impl(cell quot, stack_frame *rewind_to);
inline_cache_jit(cell generic_word_) : jit(PIC_TYPE,generic_word_) {};
void emit_check(cell klass);
- void compile_inline_cache(fixnum index, cell generic_word_, cell methods_, cell cache_entries_);
+ void compile_inline_cache(fixnum index,
+ cell generic_word_,
+ cell methods_,
+ cell cache_entries_,
+ bool tail_call_p);
};
void inline_cache_jit::emit_check(cell klass)
/* index: 0 = top of stack, 1 = item underneath, etc
cache_entries: array of class/method pairs */
-void inline_cache_jit::compile_inline_cache(fixnum index, cell generic_word_, cell methods_, cell cache_entries_)
+void inline_cache_jit::compile_inline_cache(fixnum index,
+ cell generic_word_,
+ cell methods_,
+ cell cache_entries_,
+ bool tail_call_p)
{
gc_root<word> generic_word(generic_word_);
gc_root<array> methods(methods_);
push(methods.value());
push(tag_fixnum(index));
push(cache_entries.value());
- word_jump(userenv[PIC_MISS_WORD]);
+ word_jump(userenv[tail_call_p ? PIC_MISS_TAIL_WORD : PIC_MISS_WORD]);
}
static code_block *compile_inline_cache(fixnum index,
- cell generic_word_,
- cell methods_,
- cell cache_entries_)
+ cell generic_word_,
+ cell methods_,
+ cell cache_entries_,
+ bool tail_call_p)
{
gc_root<word> generic_word(generic_word_);
gc_root<array> methods(methods_);
gc_root<array> cache_entries(cache_entries_);
inline_cache_jit jit(generic_word.value());
- jit.compile_inline_cache(index,generic_word.value(),methods.value(),cache_entries.value());
+ jit.compile_inline_cache(index,
+ generic_word.value(),
+ methods.value(),
+ cache_entries.value(),
+ tail_call_p);
code_block *code = jit.to_code_block();
relocate_code_block(code);
return code;
xt = compile_inline_cache(index,
generic_word.value(),
methods.value(),
- new_cache_entries.value()) + 1;
+ new_cache_entries.value(),
+ tail_call_site_p(return_address))->xt();
}
/* Install the new stub. */
set_call_target(return_address,xt);
#ifdef PIC_DEBUG
- printf("Updated call site 0x%lx with 0x%lx\n",return_address,(cell)xt);
+ printf("Updated %s call site 0x%lx with 0x%lx\n",
+ tail_call_site_p(return_address) ? "tail" : "non-tail",
+ return_address,
+ (cell)xt);
#endif
return xt;
PRIMITIVE(reset_inline_cache_stats);
PRIMITIVE(inline_cache_stats);
PRIMITIVE(inline_cache_miss);
+PRIMITIVE(inline_cache_miss_tail);
-extern "C" void *inline_cache_miss(cell return_address);
+VM_C_API void *inline_cache_miss(cell return_address);
}
/* TAGGED property assoc for library code */
cell props;
/* TAGGED alternative entry point for direct non-tail calls. Used for inline caching */
- cell direct_entry_def;
+ cell pic_def;
+ /* TAGGED alternative entry point for direct tail calls. Used for inline caching */
+ cell pic_tail_def;
/* TAGGED call count for profiling */
cell counter;
/* TAGGED machine code for sub-primitive */
primitive_load_locals,
primitive_check_datastack,
primitive_inline_cache_miss,
+ primitive_inline_cache_miss_tail,
primitive_mega_cache_miss,
primitive_lookup_method,
primitive_reset_dispatch_stats,
JIT_RETURN,
JIT_PROFILING,
JIT_PUSH_IMMEDIATE,
- JIT_SAVE_STACK = 38,
+ JIT_SAVE_STACK,
JIT_DIP_WORD,
JIT_DIP,
JIT_2DIP_WORD,
JIT_EXECUTE_CALL,
/* Polymorphic inline cache generation in inline_cache.c */
- PIC_LOAD = 48,
+ PIC_LOAD = 47,
PIC_TAG,
PIC_HI_TAG,
PIC_TUPLE,
PIC_CHECK,
PIC_HIT,
PIC_MISS_WORD,
+ PIC_MISS_TAIL_WORD,
/* Megamorphic cache generation in dispatch.c */
MEGA_LOOKUP = 57,
new_word->def = userenv[UNDEFINED_ENV];
new_word->props = F;
new_word->counter = tag_fixnum(0);
- new_word->direct_entry_def = F;
+ new_word->pic_def = F;
+ new_word->pic_tail_def = F;
new_word->subprimitive = F;
new_word->profiling = NULL;
new_word->code = NULL;
projects / factor.git / commitdiff