From 581d017b46a8a1884417a3470eac0b17341e5c98 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 May 2009 19:22:22 -0500 Subject: [PATCH 1/6] Working on inline caching for tail call sites --- basis/bootstrap/image/image.factor | 45 ++++++++++-------- basis/compiler/codegen/fixup/fixup.factor | 3 ++ basis/compiler/constants/constants.factor | 24 +++++----- basis/cpu/ppc/ppc.factor | 6 ++- basis/cpu/x86/32/32.factor | 2 + basis/cpu/x86/64/64.factor | 2 + basis/cpu/x86/bootstrap.factor | 2 + basis/cpu/x86/x86.factor | 9 +++- core/bootstrap/primitives.factor | 4 +- core/generic/hook/hook.factor | 2 - core/generic/single/single-tests.factor | 2 +- core/generic/single/single.factor | 8 +++- core/generic/standard/standard.factor | 13 ++++-- core/words/words.factor | 3 +- vm/code_block.cpp | 57 +++++++++++++++++------ vm/code_block.hpp | 8 ++-- vm/code_heap.cpp | 4 +- vm/cpu-x86.32.S | 5 +- vm/cpu-x86.64.S | 4 +- vm/cpu-x86.hpp | 21 ++++++--- vm/inline_cache.cpp | 35 ++++++++++---- vm/inline_cache.hpp | 3 +- vm/layouts.hpp | 4 +- vm/primitives.cpp | 1 + vm/run.hpp | 5 +- vm/words.cpp | 3 +- 26 files changed, 187 insertions(+), 88 deletions(-) diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index cad40b6384..675c50732d 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -168,6 +168,7 @@ SYMBOL: pic-check-tag SYMBOL: pic-check SYMBOL: pic-hit SYMBOL: pic-miss-word +SYMBOL: pic-miss-tail-word ! Megamorphic dispatch SYMBOL: mega-lookup @@ -193,25 +194,26 @@ SYMBOL: undefined-quot { 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 } @@ -351,7 +353,8 @@ M: f ' [ vocabulary>> , ] [ def>> , ] [ props>> , ] - [ direct-entry-def>> , ] ! direct-entry-def + [ pic-def>> , ] + [ pic-tail-def>> , ] [ drop 0 , ] ! count [ word-sub-primitive , ] [ drop 0 , ] ! xt @@ -524,6 +527,7 @@ M: quotation ' \ 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 @@ -559,6 +563,7 @@ M: quotation ' pic-check pic-hit pic-miss-word + pic-miss-tail-word mega-lookup mega-lookup-word mega-miss-word diff --git a/basis/compiler/codegen/fixup/fixup.factor b/basis/compiler/codegen/fixup/fixup.factor index b52bb51b26..d0c874feb0 100755 --- a/basis/compiler/codegen/fixup/fixup.factor +++ b/basis/compiler/codegen/fixup/fixup.factor @@ -59,6 +59,9 @@ SYMBOL: literal-table : 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 ; diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor index 886933b5cd..5e0ee98606 100644 --- a/basis/compiler/constants/constants.factor +++ b/basis/compiler/constants/constants.factor @@ -1,7 +1,7 @@ ! 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 @@ -14,14 +14,14 @@ CONSTANT: deck-bits 18 : 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 @@ -43,14 +43,12 @@ CONSTANT: rt-dlsym 1 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? ; diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index c239bacbc0..a11b0daa86 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -114,7 +114,11 @@ M: ppc stack-frame-size ( stack-frame -- i ) 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 ; diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 376edeb202..0a0ac4a53e 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -42,6 +42,8 @@ M:: x86.32 %dispatch ( src temp offset -- ) 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 ; diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 8cc69958a4..ad1b487e44 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -39,6 +39,8 @@ M: x86.64 param-reg-1 int-regs param-regs first ; 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 ; diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor index 4b409102c9..8d35d4ed8a 100644 --- a/basis/cpu/x86/bootstrap.factor +++ b/basis/cpu/x86/bootstrap.factor @@ -152,6 +152,8 @@ big-endian off ! ! ! 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 diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index d508d7740b..5ae9e1c489 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -23,6 +23,8 @@ HOOK: temp-reg-2 cpu ( -- reg ) 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 ; @@ -58,8 +60,13 @@ M: x86 stack-frame-size ( stack-frame -- i ) 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 ) diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 83276cd3f2..57bc61a005 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -231,7 +231,8 @@ bi "vocabulary" { "def" { "quotation" "quotations" } initial: [ ] } "props" - { "direct-entry-def" } + "pic-def" + "pic-tail-def" { "counter" { "fixnum" "math" } } { "sub-primitive" read-only } } define-builtin @@ -505,6 +506,7 @@ tuple { "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" (( -- )) } diff --git a/core/generic/hook/hook.factor b/core/generic/hook/hook.factor index fe5b62f6c0..5edbc54bd8 100644 --- a/core/generic/hook/hook.factor +++ b/core/generic/hook/hook.factor @@ -17,8 +17,6 @@ M: hook-combination picker 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 ; diff --git a/core/generic/single/single-tests.factor b/core/generic/single/single-tests.factor index c8cab970fd..e48d404b92 100644 --- a/core/generic/single/single-tests.factor +++ b/core/generic/single/single-tests.factor @@ -273,5 +273,5 @@ M: growable call-next-hooker call-next-method "growable " prepend ; [ ] [ "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 diff --git a/core/generic/single/single.factor b/core/generic/single/single.factor index d8fa04edd6..36a76153f9 100644 --- a/core/generic/single/single.factor +++ b/core/generic/single/single.factor @@ -238,10 +238,14 @@ M: f compile-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 ) diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor index bf801c4e47..b76bcaa582 100644 --- a/core/generic/standard/standard.factor +++ b/core/generic/standard/standard.factor @@ -3,7 +3,7 @@ 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 # ; @@ -38,17 +38,22 @@ M: standard-generic effective-method [ datastack ] dip [ "combination" word-prop #>> swap 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 ; 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 ; diff --git a/core/words/words.factor b/core/words/words.factor index 1976c1e4cd..c01cf13bcd 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -155,7 +155,8 @@ M: word reset-word [ subwords forget-all ] [ reset-word ] [ - f >>direct-entry-def + f >>pic-def + f >>pic-tail-def { "methods" "combination" diff --git a/vm/code_block.cpp b/vm/code_block.cpp index cd87da3801..1da16ad0a1 100755 --- a/vm/code_block.cpp +++ b/vm/code_block.cpp @@ -27,7 +27,8 @@ void iterate_relocations(code_block *compiled, relocation_iterator iter) { 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: @@ -171,9 +172,8 @@ void *object_xt(cell obj) } } -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 @@ -186,20 +186,42 @@ void *word_direct_xt(word *w) } } +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(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(obj)); + break; + case RT_XT_PIC: + xt = word_xt_pic(untag(obj)); + break; + case RT_XT_PIC_TAIL: + xt = word_xt_pic_tail(untag(obj)); + break; + default: + critical_error("Oops",type); + xt = NULL; + break; + } store_address_in_code_block(REL_CLASS(rel),offset,(cell)xt); } @@ -367,25 +389,30 @@ void relocate_code_block_step(relocation_entry rel, cell index, code_block *comp array *literals = untag(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(array_nth(literals,index))); + case RT_XT_PIC: + absolute_value = (cell)word_xt_pic(untag(ARG)); + break; + case RT_XT_PIC_TAIL: + absolute_value = (cell)word_xt_pic_tail(untag(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); @@ -394,13 +421,15 @@ void relocate_code_block_step(relocation_entry rel, cell index, code_block *comp 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); } diff --git a/vm/code_block.hpp b/vm/code_block.hpp index 85ae373845..b30de9d148 100644 --- a/vm/code_block.hpp +++ b/vm/code_block.hpp @@ -8,10 +8,12 @@ enum relocation_type { 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 */ diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index 77c78ad533..c8c7639930 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -26,8 +26,8 @@ void jit_compile_word(cell word_, cell def_, bool relocate) 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 */ diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S index 0c08ea7b46..a1ce83932e 100755 --- a/vm/cpu-x86.32.S +++ b/vm/cpu-x86.32.S @@ -60,9 +60,10 @@ DEF(bool,check_sse2,(void)): 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 diff --git a/vm/cpu-x86.64.S b/vm/cpu-x86.64.S index 5a70280ddf..0ace354308 100644 --- a/vm/cpu-x86.64.S +++ b/vm/cpu-x86.64.S @@ -73,8 +73,10 @@ DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, voi 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 diff --git a/vm/cpu-x86.hpp b/vm/cpu-x86.hpp index c0b4651811..9b6f2ed577 100755 --- a/vm/cpu-x86.hpp +++ b/vm/cpu-x86.hpp @@ -7,15 +7,19 @@ namespace factor 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 } @@ -31,6 +35,11 @@ inline static void set_call_target(cell return_address, void *target) *(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); diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp index 59632c4185..34d03e24f0 100755 --- a/vm/inline_cache.cpp +++ b/vm/inline_cache.cpp @@ -86,7 +86,11 @@ struct inline_cache_jit : public jit { 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) @@ -102,7 +106,11 @@ 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 generic_word(generic_word_); gc_root methods(methods_); @@ -136,20 +144,25 @@ void inline_cache_jit::compile_inline_cache(fixnum index, cell generic_word_, ce 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 generic_word(generic_word_); gc_root methods(methods_); gc_root 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; @@ -227,14 +240,18 @@ void *inline_cache_miss(cell return_address) 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; diff --git a/vm/inline_cache.hpp b/vm/inline_cache.hpp index 84334efc78..e2a6ae8cf9 100644 --- a/vm/inline_cache.hpp +++ b/vm/inline_cache.hpp @@ -8,7 +8,8 @@ void init_inline_caching(int max_size); 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); } diff --git a/vm/layouts.hpp b/vm/layouts.hpp index 8c96cf3187..f8d114210a 100755 --- a/vm/layouts.hpp +++ b/vm/layouts.hpp @@ -229,7 +229,9 @@ struct word : public object { /* 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 */ diff --git a/vm/primitives.cpp b/vm/primitives.cpp index f1c5468949..bd761625d8 100755 --- a/vm/primitives.cpp +++ b/vm/primitives.cpp @@ -147,6 +147,7 @@ const primitive_type primitives[] = { 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, diff --git a/vm/run.hpp b/vm/run.hpp index 829e25d2f7..48ebb8cf41 100755 --- a/vm/run.hpp +++ b/vm/run.hpp @@ -48,7 +48,7 @@ enum special_object { JIT_RETURN, JIT_PROFILING, JIT_PUSH_IMMEDIATE, - JIT_SAVE_STACK = 38, + JIT_SAVE_STACK, JIT_DIP_WORD, JIT_DIP, JIT_2DIP_WORD, @@ -60,7 +60,7 @@ enum special_object { JIT_EXECUTE_CALL, /* Polymorphic inline cache generation in inline_cache.c */ - PIC_LOAD = 48, + PIC_LOAD = 47, PIC_TAG, PIC_HI_TAG, PIC_TUPLE, @@ -69,6 +69,7 @@ enum special_object { PIC_CHECK, PIC_HIT, PIC_MISS_WORD, + PIC_MISS_TAIL_WORD, /* Megamorphic cache generation in dispatch.c */ MEGA_LOOKUP = 57, diff --git a/vm/words.cpp b/vm/words.cpp index 6e7c633c84..fa090c9cea 100644 --- a/vm/words.cpp +++ b/vm/words.cpp @@ -16,7 +16,8 @@ word *allot_word(cell vocab_, cell name_) 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; From 12a34d81f7ddcab3ef2df9edec41166ed69c8657 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 May 2009 20:04:49 -0500 Subject: [PATCH 2/6] JIT now supports multiple relocations per code template. This simplifies non-optimizing compiler backends --- basis/bootstrap/image/image.factor | 31 ++++++++++-------------------- basis/cpu/ppc/bootstrap.factor | 8 +------- basis/cpu/x86/32/bootstrap.factor | 6 ++---- basis/cpu/x86/64/bootstrap.factor | 5 +---- basis/cpu/x86/bootstrap.factor | 5 +---- vm/jit.cpp | 29 ++++++++++++---------------- vm/jit.hpp | 4 ++-- vm/quotations.cpp | 6 +++--- vm/run.hpp | 6 ++---- 9 files changed, 34 insertions(+), 66 deletions(-) diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index 675c50732d..7b39cee101 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -93,24 +93,19 @@ CONSTANT: -1-offset 9 SYMBOL: sub-primitives -SYMBOL: jit-define-rc -SYMBOL: jit-define-rt -SYMBOL: jit-define-offset +SYMBOL: jit-relocations -: compute-offset ( -- offset ) - building get length jit-define-rc get rc-absolute-cell = bootstrap-cell 4 ? - ; +: compute-offset ( rc -- offset ) + [ building get length ] dip rc-absolute-cell = bootstrap-cell 4 ? - ; : jit-rel ( rc rt -- ) - jit-define-rt set - jit-define-rc set - compute-offset jit-define-offset set ; + over compute-offset 3array jit-relocations get push-all ; -: make-jit ( quot -- quad ) +: make-jit ( quot -- jit-data ) [ + V{ } clone jit-relocations set call( -- ) - jit-define-rc get - jit-define-rt get - jit-define-offset get 3array + jit-relocations get >array ] B{ } make prefix ; : jit-define ( quot name -- ) @@ -142,8 +137,7 @@ SYMBOL: jit-word-jump SYMBOL: jit-word-call SYMBOL: jit-push-immediate SYMBOL: jit-if-word -SYMBOL: jit-if-1 -SYMBOL: jit-if-2 +SYMBOL: jit-if SYMBOL: jit-dip-word SYMBOL: jit-dip SYMBOL: jit-2dip-word @@ -156,7 +150,6 @@ SYMBOL: jit-execute-call SYMBOL: jit-epilog SYMBOL: jit-return SYMBOL: jit-profiling -SYMBOL: jit-save-stack ! PIC stubs SYMBOL: pic-load @@ -188,13 +181,11 @@ SYMBOL: undefined-quot { jit-word-jump 26 } { jit-word-call 27 } { jit-if-word 28 } - { jit-if-1 29 } - { jit-if-2 30 } + { jit-if 29 } { jit-epilog 33 } { jit-return 34 } { jit-profiling 35 } { jit-push-immediate 36 } - { jit-save-stack 37 } { jit-dip-word 38 } { jit-dip 39 } { jit-2dip-word 40 } @@ -539,8 +530,7 @@ M: quotation ' jit-word-call jit-push-immediate jit-if-word - jit-if-1 - jit-if-2 + jit-if jit-dip-word jit-dip jit-2dip-word @@ -553,7 +543,6 @@ M: quotation ' jit-epilog jit-return jit-profiling - jit-save-stack pic-load pic-tag pic-hi-tag diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor index 8001868e0c..768b919d4f 100644 --- a/basis/cpu/ppc/bootstrap.factor +++ b/basis/cpu/ppc/bootstrap.factor @@ -50,9 +50,6 @@ CONSTANT: rs-reg 14 0 6 LOAD32 rc-absolute-ppc-2/2 rt-stack-chain jit-rel 7 6 0 LWZ 1 7 0 STW -] jit-save-stack jit-define - -[ 0 6 LOAD32 rc-absolute-ppc-2/2 rt-primitive jit-rel 6 MTCTR BCTR @@ -68,11 +65,8 @@ CONSTANT: rs-reg 14 0 3 \ f tag-number CMPI 2 BEQ 0 B rc-relative-ppc-3 rt-xt jit-rel -] jit-if-1 jit-define - -[ 0 B rc-relative-ppc-3 rt-xt jit-rel -] jit-if-2 jit-define +] jit-if jit-define : jit->r ( -- ) 4 ds-reg 0 LWZ diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor index 660a428dfb..490d37ccbc 100644 --- a/basis/cpu/x86/32/bootstrap.factor +++ b/basis/cpu/x86/32/bootstrap.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007 Slava Pestov. +! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: bootstrap.image.private kernel namespaces system cpu.x86.assembler layouts vocabs parser compiler.constants ; @@ -26,9 +26,7 @@ IN: bootstrap.x86 temp0 0 [] MOV rc-absolute-cell rt-stack-chain jit-rel ! save stack pointer temp0 [] stack-reg MOV -] jit-save-stack jit-define - -[ + ! call the primitive 0 JMP rc-relative rt-primitive jit-rel ] jit-primitive jit-define diff --git a/basis/cpu/x86/64/bootstrap.factor b/basis/cpu/x86/64/bootstrap.factor index 8d1ed086e7..c5c7e63dbc 100644 --- a/basis/cpu/x86/64/bootstrap.factor +++ b/basis/cpu/x86/64/bootstrap.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007 Slava Pestov. +! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: bootstrap.image.private kernel namespaces system cpu.x86.assembler layouts vocabs parser compiler.constants math ; @@ -25,9 +25,6 @@ IN: bootstrap.x86 temp0 temp0 [] MOV ! save stack pointer temp0 [] stack-reg MOV -] jit-save-stack jit-define - -[ ! load XT temp1 0 MOV rc-absolute-cell rt-primitive jit-rel ! go diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor index 8d35d4ed8a..ee75281a9d 100644 --- a/basis/cpu/x86/bootstrap.factor +++ b/basis/cpu/x86/bootstrap.factor @@ -58,12 +58,9 @@ big-endian off temp0 \ f tag-number CMP ! jump to true branch if not equal 0 JNE rc-relative rt-xt jit-rel -] jit-if-1 jit-define - -[ ! jump to false branch if equal 0 JMP rc-relative rt-xt jit-rel -] jit-if-2 jit-define +] jit-if jit-define : jit->r ( -- ) rs-reg bootstrap-cell ADD diff --git a/vm/jit.cpp b/vm/jit.cpp index bb86506058..a3f222a953 100644 --- a/vm/jit.cpp +++ b/vm/jit.cpp @@ -23,24 +23,21 @@ jit::jit(cell type_, cell owner_) if(stack_traces_p()) literal(owner.value()); } -relocation_entry jit::rel_to_emit(cell code_template, bool *rel_p) +void jit::emit_relocation(cell code_template_) { - array *quadruple = untag(code_template); - cell rel_class = array_nth(quadruple,1); - cell rel_type = array_nth(quadruple,2); - cell offset = array_nth(quadruple,3); + gc_root code_template(code_template_); + cell capacity = array_capacity(code_template.untagged()); + for(cell i = 1; i < capacity; i += 3) + { + cell rel_class = array_nth(code_template.untagged(),i); + cell rel_type = array_nth(code_template.untagged(),i + 1); + cell offset = array_nth(code_template.untagged(),i + 2); - if(rel_class == F) - { - *rel_p = false; - return 0; - } - else - { - *rel_p = true; - return (untag_fixnum(rel_type) << 28) + relocation_entry new_entry + = (untag_fixnum(rel_type) << 28) | (untag_fixnum(rel_class) << 24) | ((code.count + untag_fixnum(offset))); + relocation.append_bytes(&new_entry,sizeof(relocation_entry)); } } @@ -49,9 +46,7 @@ void jit::emit(cell code_template_) { gc_root code_template(code_template_); - bool rel_p; - relocation_entry rel = rel_to_emit(code_template.value(),&rel_p); - if(rel_p) relocation.append_bytes(&rel,sizeof(relocation_entry)); + emit_relocation(code_template.value()); gc_root insns(array_nth(code_template.untagged(),0)); diff --git a/vm/jit.hpp b/vm/jit.hpp index 30b5163b4a..976be9ef3b 100644 --- a/vm/jit.hpp +++ b/vm/jit.hpp @@ -14,7 +14,7 @@ struct jit { jit(cell jit_type, cell owner); void compute_position(cell offset); - relocation_entry rel_to_emit(cell code_template, bool *rel_p); + void emit_relocation(cell code_template); void emit(cell code_template); void literal(cell literal) { literals.add(literal); } @@ -35,7 +35,7 @@ struct jit { void emit_subprimitive(cell word_) { gc_root word(word_); gc_root code_template(word->subprimitive); - if(array_nth(code_template.untagged(),1) != F) literal(T); + if(array_capacity(code_template.untagged()) > 1) literal(T); emit(code_template.value()); } diff --git a/vm/quotations.cpp b/vm/quotations.cpp index 555ecc6420..afd9fc3da2 100755 --- a/vm/quotations.cpp +++ b/vm/quotations.cpp @@ -165,7 +165,6 @@ void quotation_jit::iterate_quotation() /* Primitive calls */ if(primitive_call_p(i)) { - emit(userenv[JIT_SAVE_STACK]); emit_with(userenv[JIT_PRIMITIVE],obj.value()); i++; @@ -187,8 +186,9 @@ void quotation_jit::iterate_quotation() jit_compile(array_nth(elements.untagged(),i + 1),relocate); } - emit_with(userenv[JIT_IF_1],array_nth(elements.untagged(),i)); - emit_with(userenv[JIT_IF_2],array_nth(elements.untagged(),i + 1)); + literal(array_nth(elements.untagged(),i)); + literal(array_nth(elements.untagged(),i + 1)); + emit(userenv[JIT_IF]); i += 2; diff --git a/vm/run.hpp b/vm/run.hpp index 48ebb8cf41..2072580c79 100755 --- a/vm/run.hpp +++ b/vm/run.hpp @@ -42,14 +42,12 @@ enum special_object { JIT_WORD_JUMP, JIT_WORD_CALL, JIT_IF_WORD, - JIT_IF_1, - JIT_IF_2, + JIT_IF, JIT_EPILOG = 33, JIT_RETURN, JIT_PROFILING, JIT_PUSH_IMMEDIATE, - JIT_SAVE_STACK, - JIT_DIP_WORD, + JIT_DIP_WORD = 38, JIT_DIP, JIT_2DIP_WORD, JIT_2DIP, From 4915e1ced768d459b3ac20acc9d65ffaad340bea Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 May 2009 22:04:01 -0500 Subject: [PATCH 3/6] Clean up bootstrap.image, and implement new calling convention for tail calls; tail call sites now have PICs --- basis/bootstrap/image/image.factor | 172 ++++++--------------- basis/bootstrap/image/syntax/authors.txt | 1 + basis/bootstrap/image/syntax/syntax.factor | 14 ++ basis/cpu/x86/bootstrap.factor | 7 +- vm/cpu-x86.hpp | 2 + vm/inline_cache.cpp | 2 +- vm/jit.hpp | 8 +- vm/quotations.cpp | 11 +- vm/run.hpp | 5 +- 9 files changed, 93 insertions(+), 129 deletions(-) create mode 100644 basis/bootstrap/image/syntax/authors.txt create mode 100644 basis/bootstrap/image/syntax/syntax.factor diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index 7b39cee101..55e6a31491 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -9,7 +9,7 @@ classes.builtin classes.tuple classes.tuple.private vocabs vocabs.loader source-files definitions debugger quotations.private sequences.private combinators math.order math.private accessors slots.private generic.single.private compiler.units compiler.constants -fry ; +fry bootstrap.image.syntax ; IN: bootstrap.image : arch ( os cpu -- arch ) @@ -123,96 +123,59 @@ SYMBOL: big-endian ! Bootstrap architecture name SYMBOL: architecture -! Bootstrap global namesapce -SYMBOL: bootstrap-global +RESET ! Boot quotation, set in stage1.factor -SYMBOL: bootstrap-boot-quot +USERENV: bootstrap-boot-quot 20 + +! Bootstrap global namesapce +USERENV: bootstrap-global 21 ! JIT parameters -SYMBOL: jit-prolog -SYMBOL: jit-primitive-word -SYMBOL: jit-primitive -SYMBOL: jit-word-jump -SYMBOL: jit-word-call -SYMBOL: jit-push-immediate -SYMBOL: jit-if-word -SYMBOL: jit-if -SYMBOL: jit-dip-word -SYMBOL: jit-dip -SYMBOL: jit-2dip-word -SYMBOL: jit-2dip -SYMBOL: jit-3dip-word -SYMBOL: jit-3dip -SYMBOL: jit-execute-word -SYMBOL: jit-execute-jump -SYMBOL: jit-execute-call -SYMBOL: jit-epilog -SYMBOL: jit-return -SYMBOL: jit-profiling +USERENV: jit-prolog 23 +USERENV: jit-primitive-word 24 +USERENV: jit-primitive 25 +USERENV: jit-word-jump 26 +USERENV: jit-word-call 27 +USERENV: jit-word-special 28 +USERENV: jit-if-word 29 +USERENV: jit-if 30 +USERENV: jit-epilog 31 +USERENV: jit-return 32 +USERENV: jit-profiling 33 +USERENV: jit-push-immediate 34 +USERENV: jit-dip-word 35 +USERENV: jit-dip 36 +USERENV: jit-2dip-word 37 +USERENV: jit-2dip 38 +USERENV: jit-3dip-word 39 +USERENV: jit-3dip 40 +USERENV: jit-execute-word 41 +USERENV: jit-execute-jump 42 +USERENV: jit-execute-call 43 ! PIC stubs -SYMBOL: pic-load -SYMBOL: pic-tag -SYMBOL: pic-hi-tag -SYMBOL: pic-tuple -SYMBOL: pic-hi-tag-tuple -SYMBOL: pic-check-tag -SYMBOL: pic-check -SYMBOL: pic-hit -SYMBOL: pic-miss-word -SYMBOL: pic-miss-tail-word +USERENV: pic-load 47 +USERENV: pic-tag 48 +USERENV: pic-hi-tag 49 +USERENV: pic-tuple 50 +USERENV: pic-hi-tag-tuple 51 +USERENV: pic-check-tag 52 +USERENV: pic-check 53 +USERENV: pic-hit 54 +USERENV: pic-miss-word 55 +USERENV: pic-miss-tail-word 56 ! Megamorphic dispatch -SYMBOL: mega-lookup -SYMBOL: mega-lookup-word -SYMBOL: mega-miss-word +USERENV: mega-lookup 57 +USERENV: mega-lookup-word 58 +USERENV: mega-miss-word 59 ! Default definition for undefined words -SYMBOL: undefined-quot - -: userenvs ( -- assoc ) - H{ - { bootstrap-boot-quot 20 } - { bootstrap-global 21 } - { jit-prolog 23 } - { jit-primitive-word 24 } - { jit-primitive 25 } - { jit-word-jump 26 } - { jit-word-call 27 } - { jit-if-word 28 } - { jit-if 29 } - { jit-epilog 33 } - { jit-return 34 } - { jit-profiling 35 } - { jit-push-immediate 36 } - { 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 } - { undefined-quot 60 } - } ; inline +USERENV: undefined-quot 60 : userenv-offset ( symbol -- n ) - userenvs at header-size + ; + userenvs get at header-size + ; : emit ( cell -- ) image get push ; @@ -504,11 +467,7 @@ M: quotation ' class<=-cache class-not-cache classes-intersect-cache class-and-cache class-or-cache next-method-quot-cache } [ H{ } clone ] H{ } map>assoc assoc-union - bootstrap-global set - bootstrap-global emit-userenv ; - -: emit-boot-quot ( -- ) - bootstrap-boot-quot emit-userenv ; + bootstrap-global set ; : emit-jit-data ( -- ) \ if jit-if-word set @@ -521,43 +480,10 @@ M: quotation ' \ 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 - { - jit-prolog - jit-primitive-word - jit-primitive - jit-word-jump - jit-word-call - jit-push-immediate - jit-if-word - jit-if - jit-dip-word - jit-dip - jit-2dip-word - jit-2dip - jit-3dip-word - jit-3dip - jit-execute-word - jit-execute-jump - jit-execute-call - jit-epilog - jit-return - jit-profiling - pic-load - pic-tag - pic-hi-tag - pic-tuple - pic-hi-tag-tuple - pic-check-tag - pic-check - pic-hit - pic-miss-word - pic-miss-tail-word - mega-lookup - mega-lookup-word - mega-miss-word - undefined-quot - } [ emit-userenv ] each ; + [ undefined ] undefined-quot set ; + +: emit-userenvs ( -- ) + userenvs get keys [ emit-userenv ] each ; : fixup-header ( -- ) heap-size data-heap-size-offset fixup ; @@ -574,8 +500,8 @@ M: quotation ' emit-jit-data "Serializing global namespace..." print flush emit-global - "Serializing boot quotation..." print flush - emit-boot-quot + "Serializing user environment..." print flush + emit-userenvs "Performing word fixups..." print flush fixup-words "Performing header fixups..." print flush diff --git a/basis/bootstrap/image/syntax/authors.txt b/basis/bootstrap/image/syntax/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/basis/bootstrap/image/syntax/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/basis/bootstrap/image/syntax/syntax.factor b/basis/bootstrap/image/syntax/syntax.factor new file mode 100644 index 0000000000..29dc09717a --- /dev/null +++ b/basis/bootstrap/image/syntax/syntax.factor @@ -0,0 +1,14 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: parser kernel namespaces assocs words.symbol ; +IN: bootstrap.image.syntax + +SYMBOL: userenvs + +SYNTAX: RESET H{ } clone userenvs set-global ; + +SYNTAX: USERENV: + CREATE-WORD scan-word + [ swap userenvs get set-at ] + [ drop define-symbol ] + 2bi ; \ No newline at end of file diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor index ee75281a9d..06807ce9fb 100644 --- a/basis/cpu/x86/bootstrap.factor +++ b/basis/cpu/x86/bootstrap.factor @@ -42,13 +42,18 @@ big-endian off ] jit-push-immediate jit-define [ - 0 JMP rc-relative rt-xt jit-rel + temp3 0 MOV rc-absolute-cell rt-here jit-rel + 0 JMP rc-relative rt-xt-pic-tail jit-rel ] jit-word-jump jit-define [ 0 CALL rc-relative rt-xt-pic jit-rel ] jit-word-call jit-define +[ + 0 JMP rc-relative rt-xt jit-rel +] jit-word-special jit-define + [ ! load boolean temp0 ds-reg [] MOV diff --git a/vm/cpu-x86.hpp b/vm/cpu-x86.hpp index 9b6f2ed577..71a85b4e82 100755 --- a/vm/cpu-x86.hpp +++ b/vm/cpu-x86.hpp @@ -7,6 +7,8 @@ namespace factor inline static void flush_icache(cell start, cell len) {} +static const fixnum xt_tail_pic_offset = 2 * sizeof(cell) + 1; + static const unsigned char call_opcode = 0xe8; static const unsigned char jmp_opcode = 0xe9; diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp index 34d03e24f0..e9e098de70 100755 --- a/vm/inline_cache.cpp +++ b/vm/inline_cache.cpp @@ -144,7 +144,7 @@ void inline_cache_jit::compile_inline_cache(fixnum index, push(methods.value()); push(tag_fixnum(index)); push(cache_entries.value()); - word_jump(userenv[tail_call_p ? PIC_MISS_TAIL_WORD : PIC_MISS_WORD]); + word_special(userenv[tail_call_p ? PIC_MISS_TAIL_WORD : PIC_MISS_WORD]); } static code_block *compile_inline_cache(fixnum index, diff --git a/vm/jit.hpp b/vm/jit.hpp index 976be9ef3b..50b40eca30 100644 --- a/vm/jit.hpp +++ b/vm/jit.hpp @@ -25,13 +25,19 @@ struct jit { } void word_jump(cell word) { - emit_with(userenv[JIT_WORD_JUMP],word); + literal(tag_fixnum(xt_tail_pic_offset)); + literal(word); + emit(userenv[JIT_WORD_JUMP]); } void word_call(cell word) { emit_with(userenv[JIT_WORD_CALL],word); } + void word_special(cell word) { + emit_with(userenv[JIT_WORD_SPECIAL],word); + } + void emit_subprimitive(cell word_) { gc_root word(word_); gc_root code_template(word->subprimitive); diff --git a/vm/quotations.cpp b/vm/quotations.cpp index afd9fc3da2..32e5e37a79 100755 --- a/vm/quotations.cpp +++ b/vm/quotations.cpp @@ -152,7 +152,16 @@ void quotation_jit::iterate_quotation() { if(stack_frame) emit(userenv[JIT_EPILOG]); tail_call = true; - word_jump(obj.value()); + /* Inline cache misses are special-cased */ + if(obj.value() == userenv[PIC_MISS_WORD] + || obj.value() == userenv[PIC_MISS_TAIL_WORD]) + { + word_special(obj.value()); + } + else + { + word_jump(obj.value()); + } } else word_call(obj.value()); diff --git a/vm/run.hpp b/vm/run.hpp index 2072580c79..7527889efb 100755 --- a/vm/run.hpp +++ b/vm/run.hpp @@ -41,13 +41,14 @@ enum special_object { JIT_PRIMITIVE, JIT_WORD_JUMP, JIT_WORD_CALL, + JIT_WORD_SPECIAL, JIT_IF_WORD, JIT_IF, - JIT_EPILOG = 33, + JIT_EPILOG, JIT_RETURN, JIT_PROFILING, JIT_PUSH_IMMEDIATE, - JIT_DIP_WORD = 38, + JIT_DIP_WORD, JIT_DIP, JIT_2DIP_WORD, JIT_2DIP, From 318552ba605e92385b20c52bc483e6611046a7cb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 May 2009 22:44:30 -0500 Subject: [PATCH 4/6] Fix tail call PICs on x86-64 --- basis/cpu/x86/x86.factor | 6 +++++- vm/cpu-x86.hpp | 10 +++++++++- vm/quotations.cpp | 9 ++++++++- 3 files changed, 22 insertions(+), 3 deletions(-) diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 5ae9e1c489..e12cec9738 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -61,8 +61,12 @@ M: x86 stack-frame-size ( stack-frame -- i ) M: x86 %call ( word -- ) 0 CALL rc-relative rel-word-pic ; +: xt-tail-pic-offset ( -- n ) + #! See the comment in vm/cpu-x86.hpp + cell 4 + 1 + ; inline + M: x86 %jump ( word -- ) - pic-tail-reg 0 MOV 2 cells 1 + rc-absolute-cell rel-here + pic-tail-reg 0 MOV xt-tail-pic-offset rc-absolute-cell rel-here 0 JMP rc-relative rel-word-pic-tail ; M: x86 %jump-label ( label -- ) 0 JMP rc-relative label-fixup ; diff --git a/vm/cpu-x86.hpp b/vm/cpu-x86.hpp index 71a85b4e82..e5852f9ad9 100755 --- a/vm/cpu-x86.hpp +++ b/vm/cpu-x86.hpp @@ -7,7 +7,15 @@ namespace factor inline static void flush_icache(cell start, cell len) {} -static const fixnum xt_tail_pic_offset = 2 * sizeof(cell) + 1; +/* In the instruction sequence: + + MOV EBX,... + JMP blah + + the offset from the immediate operand to MOV to the instruction after + the jump is a cell for the immediate operand, 4 bytes for the JMP + destination, and one byte for the JMP opcode. */ +static const fixnum xt_tail_pic_offset = sizeof(cell) + 4 + 1; static const unsigned char call_opcode = 0xe8; static const unsigned char jmp_opcode = 0xe9; diff --git a/vm/quotations.cpp b/vm/quotations.cpp index 32e5e37a79..b049f528e4 100755 --- a/vm/quotations.cpp +++ b/vm/quotations.cpp @@ -152,7 +152,14 @@ void quotation_jit::iterate_quotation() { if(stack_frame) emit(userenv[JIT_EPILOG]); tail_call = true; - /* Inline cache misses are special-cased */ + /* Inline cache misses are special-cased. + The calling convention for tail + calls stores the address of the next + instruction in a register. However, + PIC miss stubs themselves tail-call + the inline cache miss primitive, and + we don't want to clobber the saved + address. */ if(obj.value() == userenv[PIC_MISS_WORD] || obj.value() == userenv[PIC_MISS_TAIL_WORD]) { From 51fff497089be54fc8c63c58e96d2162179c50c8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 May 2009 23:40:27 -0500 Subject: [PATCH 5/6] find-window: don't bomb if a world has no child. Reported by Joe Groff --- basis/ui/ui.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor index d07403836a..b73de68e26 100644 --- a/basis/ui/ui.factor +++ b/basis/ui/ui.factor @@ -145,7 +145,9 @@ SYMBOL: ui-thread PRIVATE> : find-window ( quot -- world ) - [ windows get values ] dip '[ gadget-child @ ] find-last nip ; inline + [ windows get values ] dip + '[ dup children>> [ ] [ nip first ] if-empty @ ] + find-last nip ; inline : ui-running? ( -- ? ) \ ui-running get-global ; From 741e97e57eb3b35b0627bf55667bd9f76c54ee71 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 May 2009 23:47:17 -0500 Subject: [PATCH 6/6] tools.trace: fix for call( --- basis/tools/trace/trace-tests.factor | 30 ++++++++++++++++++++++-- basis/tools/trace/trace.factor | 35 +++++++++++++++++----------- 2 files changed, 49 insertions(+), 16 deletions(-) diff --git a/basis/tools/trace/trace-tests.factor b/basis/tools/trace/trace-tests.factor index 74f7c40943..06511c7ada 100644 --- a/basis/tools/trace/trace-tests.factor +++ b/basis/tools/trace/trace-tests.factor @@ -1,4 +1,30 @@ IN: tools.trace.tests -USING: tools.trace tools.test sequences ; +USING: tools.trace tools.test tools.continuations kernel math combinators +sequences ; -[ { 3 2 1 } ] [ { 1 2 3 } [ reverse ] trace ] unit-test \ No newline at end of file +[ { 3 2 1 } ] [ { 1 2 3 } [ reverse ] trace ] unit-test + +GENERIC: method-breakpoint-test ( x -- y ) + +TUPLE: method-breakpoint-tuple ; + +M: method-breakpoint-tuple method-breakpoint-test break drop 1 2 + ; + +\ method-breakpoint-test don't-step-into + +[ 3 ] +[ [ T{ method-breakpoint-tuple } method-breakpoint-test ] trace ] unit-test + +: case-breakpoint-test ( -- x ) + 5 { [ break 1 + ] } case ; + +\ case-breakpoint-test don't-step-into + +[ 6 ] [ [ case-breakpoint-test ] trace ] unit-test + +: call(-breakpoint-test ( -- x ) + [ break 1 ] call( -- x ) 2 + ; + +\ call(-breakpoint-test don't-step-into + +[ 3 ] [ [ call(-breakpoint-test ] trace ] unit-test diff --git a/basis/tools/trace/trace.factor b/basis/tools/trace/trace.factor index e2c6bf864b..f7f0ae4a69 100644 --- a/basis/tools/trace/trace.factor +++ b/basis/tools/trace/trace.factor @@ -4,19 +4,21 @@ USING: concurrency.promises models tools.continuations kernel sequences concurrency.messaging locals continuations threads namespaces namespaces.private make assocs accessors io strings prettyprint math math.parser words effects summary io.styles classes -generic.math combinators.short-circuit ; +generic.math combinators.short-circuit kernel.private quotations ; IN: tools.trace -: callstack-depth ( callstack -- n ) - callstack>array length 2/ ; - -SYMBOL: end - SYMBOL: exclude-vocabs SYMBOL: include-vocabs exclude-vocabs { "math" "accessors" } swap set-global +array length 2/ ; + +SYMBOL: end + : include? ( vocab -- ? ) include-vocabs get dup [ member? ] [ 2drop t ] if ; @@ -65,15 +67,20 @@ M: trace-step summary [ CHAR: \s write ] [ number>string write ": " write ] bi ; +: trace-into? ( continuation -- ? ) + continuation-current into? ; + : trace-step ( continuation -- continuation' ) - dup continuation-current end eq? [ - [ print-depth ] - [ print-step ] - [ - dup continuation-current into? - [ continuation-step-into ] [ continuation-step ] if - ] tri - ] unless ; + dup call>> innermost-frame-executing quotation? [ + dup continuation-current end eq? [ + [ print-depth ] + [ print-step ] + [ dup trace-into? [ continuation-step-into ] [ continuation-step ] if ] + tri + ] unless + ] when ; + +PRIVATE> : trace ( quot -- data ) [ [ trace-step ] break-hook ] dip