steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

bootstrap.image: attempt to remove the SPECIAL-OBJECT: table 

Instead of using newly defined words as keys to the special-objects
hash being built, you can reuse the constants in kernel.private
db4
Björn Lindqvist 2015-08-10 14:40:56 +02:00 committed by John Benediktsson
parent bdc4880b17
commit 9cf36e3dc2
5 changed files with 62 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
basis/bootstrap/assembler/x86.64.factor
View File

@ -44,7 +44,7 @@ IN: bootstrap.x86
[ [
pic-tail-reg 5 [RIP+] LEA pic-tail-reg 5 [RIP+] LEA
0 JMP f rc-relative rel-word-pic-tail 0 JMP f rc-relative rel-word-pic-tail
] jit-word-jump jit-define ] JIT-WORD-JUMP jit-define
: jit-load-vm ( -- ) : jit-load-vm ( -- )
! no-op on x86-64. in factor contexts vm-reg always contains the ! no-op on x86-64. in factor contexts vm-reg always contains the
@ -56,6 +56,9 @@ IN: bootstrap.x86
: jit-save-context ( -- ) : jit-save-context ( -- )
jit-load-context jit-load-context
! The reason for -8 I think is because we are anticipating a CALL
! instruction. After the call instruction, the contexts frame_top
! will point to the origin jump address.
R11 RSP -8 [+] LEA R11 RSP -8 [+] LEA
ctx-reg context-callstack-top-offset [+] R11 MOV ctx-reg context-callstack-top-offset [+] R11 MOV
ctx-reg context-datastack-offset [+] ds-reg MOV ctx-reg context-datastack-offset [+] ds-reg MOV
@ -75,7 +78,7 @@ IN: bootstrap.x86
RAX 0 MOV f f rc-absolute-cell rel-dlsym RAX 0 MOV f f rc-absolute-cell rel-dlsym
RAX CALL RAX CALL
jit-restore-context jit-restore-context
] jit-primitive jit-define ] JIT-PRIMITIVE jit-define
: jit-jump-quot ( -- ) : jit-jump-quot ( -- )
arg1 quot-entry-point-offset [+] JMP ; arg1 quot-entry-point-offset [+] JMP ;
@ -177,7 +180,7 @@ IN: bootstrap.x86
[ [
temp2 0xffffffff MOV f rc-absolute-cell rel-literal temp2 0xffffffff MOV f rc-absolute-cell rel-literal
temp1 temp2 CMP temp1 temp2 CMP
] pic-check-tuple jit-define ] PIC-CHECK-TUPLE jit-define
! Inline cache miss entry points ! Inline cache miss entry points
: jit-load-return-address ( -- ) : jit-load-return-address ( -- )
@ -328,7 +331,7 @@ IN: bootstrap.x86
[ [
0 [RIP+] EAX MOV rc-relative rel-safepoint 0 [RIP+] EAX MOV rc-relative rel-safepoint
] \ jit-safepoint jit-define ] JIT-SAFEPOINT jit-define
[ [
jit-start-context-and-delete jit-start-context-and-delete

34
basis/bootstrap/assembler/x86.factor
View File

@ -74,7 +74,7 @@ big-endian off
! See the comment for M\ x86.32 stack-cleanup in cpu.x86.32 ! See the comment for M\ x86.32 stack-cleanup in cpu.x86.32
0xffff RET f rc-absolute-2 rel-untagged 0xffff RET f rc-absolute-2 rel-untagged
] callback-stub jit-define ] CALLBACK-STUB jit-define
[ [
! load literal ! load literal
@ -83,11 +83,11 @@ big-endian off
ds-reg bootstrap-cell ADD ds-reg bootstrap-cell ADD
! store literal on datastack ! store literal on datastack
ds-reg [] temp0 MOV ds-reg [] temp0 MOV
] jit-push jit-define ] JIT-PUSH-IMMEDIATE jit-define
[ [
0 CALL f rc-relative rel-word-pic 0 CALL f rc-relative rel-word-pic
] jit-word-call jit-define ] JIT-WORD-CALL jit-define
! The *-signal-handler subprimitives are special-cased in vm/quotations.cpp ! The *-signal-handler subprimitives are special-cased in vm/quotations.cpp
! not to trigger generation of a stack frame, so they can ! not to trigger generation of a stack frame, so they can
@ -161,7 +161,7 @@ big-endian off
0 JNE f rc-relative rel-word 0 JNE f rc-relative rel-word
! jump to false branch if equal ! jump to false branch if equal
0 JMP f rc-relative rel-word 0 JMP f rc-relative rel-word
] jit-if jit-define ] JIT-IF jit-define
: jit->r ( -- ) : jit->r ( -- )
rs-reg bootstrap-cell ADD rs-reg bootstrap-cell ADD
@ -215,19 +215,19 @@ big-endian off
jit->r jit->r
0 CALL f rc-relative rel-word 0 CALL f rc-relative rel-word
jit-r> jit-r>
] jit-dip jit-define ] JIT-DIP jit-define
[ [
jit-2>r jit-2>r
0 CALL f rc-relative rel-word 0 CALL f rc-relative rel-word
jit-2r> jit-2r>
] jit-2dip jit-define ] JIT-2DIP jit-define
[ [
jit-3>r jit-3>r
0 CALL f rc-relative rel-word 0 CALL f rc-relative rel-word
jit-3r> jit-3r>
] jit-3dip jit-define ] JIT-3DIP jit-define
[ [
! load from stack ! load from stack
@ -243,17 +243,17 @@ big-endian off
temp0 ds-reg [] MOV temp0 ds-reg [] MOV
ds-reg bootstrap-cell SUB ds-reg bootstrap-cell SUB
temp0 word-entry-point-offset [+] JMP temp0 word-entry-point-offset [+] JMP
] jit-execute jit-define ] JIT-EXECUTE jit-define
[ [
stack-reg stack-frame-size bootstrap-cell - SUB stack-reg stack-frame-size bootstrap-cell - SUB
] jit-prolog jit-define ] JIT-PROLOG jit-define
[ [
stack-reg stack-frame-size bootstrap-cell - ADD stack-reg stack-frame-size bootstrap-cell - ADD
] jit-epilog jit-define ] JIT-EPILOG jit-define
[ 0 RET ] jit-return jit-define [ 0 RET ] JIT-RETURN jit-define
! ! ! Polymorphic inline caches ! ! ! Polymorphic inline caches
@ -262,9 +262,9 @@ big-endian off
! Load a value from a stack position ! Load a value from a stack position
[ [
temp1 ds-reg 0x7f [+] MOV f rc-absolute-1 rel-untagged temp1 ds-reg 0x7f [+] MOV f rc-absolute-1 rel-untagged
] pic-load jit-define ] PIC-LOAD jit-define
[ temp1 tag-mask get AND ] pic-tag jit-define [ temp1 tag-mask get AND ] PIC-TAG jit-define
[ [
temp0 temp1 MOV temp0 temp1 MOV
@ -273,13 +273,13 @@ big-endian off
[ JNE ] [ JNE ]
[ temp1 temp0 tuple-class-offset [+] MOV ] [ temp1 temp0 tuple-class-offset [+] MOV ]
jit-conditional jit-conditional
] pic-tuple jit-define ] PIC-TUPLE jit-define
[ [
temp1 0x7f CMP f rc-absolute-1 rel-untagged temp1 0x7f CMP f rc-absolute-1 rel-untagged
] pic-check-tag jit-define ] PIC-CHECK-TAG jit-define
[ 0 JE f rc-relative rel-word ] pic-hit jit-define [ 0 JE f rc-relative rel-word ] PIC-HIT jit-define
! ! ! Megamorphic caches ! ! ! Megamorphic caches
@ -315,7 +315,7 @@ big-endian off
temp0 word-entry-point-offset [+] JMP temp0 word-entry-point-offset [+] JMP
! fall-through on miss ! fall-through on miss
] jit-conditional ] jit-conditional
] mega-lookup jit-define ] MEGA-LOOKUP jit-define
! ! ! Sub-primitives ! ! ! Sub-primitives

3
basis/bootstrap/image/image-docs.factor
View File

@ -17,9 +17,6 @@ ABOUT: "bootstrap.image"
HELP: architecture HELP: architecture
{ $var-description "Bootstrap architecture name" } ; { $var-description "Bootstrap architecture name" } ;
HELP: bootstrap-startup-quot
{ $var-description "This image's startup quotation or " { $link f } ". " } ;
HELP: define-sub-primitive HELP: define-sub-primitive
{ $values { "quot" quotation } { "word" word } } { $values { "quot" quotation } { "word" word } }
{ $description "Defines a sub primitive by running the quotation which is supposed to output assembler code. The word is then used to call the assembly." } ; { $description "Defines a sub primitive by running the quotation which is supposed to output assembler code. The word is then used to call the assembly." } ;

126
basis/bootstrap/image/image.factor
View File

@ -106,6 +106,8 @@ CONSTANT: -1-offset 9
SYMBOL: sub-primitives SYMBOL: sub-primitives
SYMBOL: bs-special-objects
:: jit-conditional ( test-quot false-quot -- ) :: jit-conditional ( test-quot false-quot -- )
[ 0 test-quot call ] B{ } make length :> len [ 0 test-quot call ] B{ } make length :> len
building get length extra-offset get + len + building get length extra-offset get + len +
@ -126,8 +128,8 @@ SYMBOL: sub-primitives
: make-jit-no-params ( quot -- code ) : make-jit-no-params ( quot -- code )
make-jit 2nip ; make-jit 2nip ;
: jit-define ( quot name -- ) : jit-define ( quot n -- )
[ make-jit-no-params ] dip set ; [ make-jit-no-params ] dip bs-special-objects get set-at ;
: define-sub-primitive ( quot word -- ) : define-sub-primitive ( quot word -- )
[ make-jit 3array ] dip sub-primitives get set-at ; [ make-jit 3array ] dip sub-primitives get set-at ;
@ -143,7 +145,6 @@ SYMBOL: sub-primitives
] dip ] dip
sub-primitives get set-at ; sub-primitives get set-at ;
! The image being constructed; a vector of word-size integers
SYMBOL: bootstrapping-image SYMBOL: bootstrapping-image
! Image output format ! Image output format
@ -151,68 +152,7 @@ SYMBOL: big-endian
SYMBOL: architecture SYMBOL: architecture
RESET H{ } clone bs-special-objects set-global
! Boot quotation, set in stage1.factor
SPECIAL-OBJECT: bootstrap-startup-quot 20
! Bootstrap global namesapce
SPECIAL-OBJECT: bootstrap-global 21
! JIT parameters
SPECIAL-OBJECT: jit-prolog 23
SPECIAL-OBJECT: jit-primitive-word 24
SPECIAL-OBJECT: jit-primitive 25
SPECIAL-OBJECT: jit-word-jump 26
SPECIAL-OBJECT: jit-word-call 27
SPECIAL-OBJECT: jit-if-word 28
SPECIAL-OBJECT: jit-if 29
SPECIAL-OBJECT: jit-safepoint 30
SPECIAL-OBJECT: jit-epilog 31
SPECIAL-OBJECT: jit-return 32
SPECIAL-OBJECT: jit-profiling 33
SPECIAL-OBJECT: jit-push 34
SPECIAL-OBJECT: jit-dip-word 35
SPECIAL-OBJECT: jit-dip 36
SPECIAL-OBJECT: jit-2dip-word 37
SPECIAL-OBJECT: jit-2dip 38
SPECIAL-OBJECT: jit-3dip-word 39
SPECIAL-OBJECT: jit-3dip 40
SPECIAL-OBJECT: jit-execute 41
SPECIAL-OBJECT: jit-declare-word 42
SPECIAL-OBJECT: c-to-factor-word 43
SPECIAL-OBJECT: lazy-jit-compile-word 44
SPECIAL-OBJECT: unwind-native-frames-word 45
SPECIAL-OBJECT: fpu-state-word 46
SPECIAL-OBJECT: set-fpu-state-word 47
SPECIAL-OBJECT: signal-handler-word 48
SPECIAL-OBJECT: leaf-signal-handler-word 49
SPECIAL-OBJECT: ffi-signal-handler-word 50
SPECIAL-OBJECT: ffi-leaf-signal-handler-word 51
SPECIAL-OBJECT: callback-stub 53
! PIC stubs
SPECIAL-OBJECT: pic-load 54
SPECIAL-OBJECT: pic-tag 55
SPECIAL-OBJECT: pic-tuple 56
SPECIAL-OBJECT: pic-check-tag 57
SPECIAL-OBJECT: pic-check-tuple 58
SPECIAL-OBJECT: pic-hit 59
SPECIAL-OBJECT: pic-miss-word 60
SPECIAL-OBJECT: pic-miss-tail-word 61
! Megamorphic dispatch
SPECIAL-OBJECT: mega-lookup 62
SPECIAL-OBJECT: mega-lookup-word 63
SPECIAL-OBJECT: mega-miss-word 64
! Default definition for undefined words
SPECIAL-OBJECT: undefined-quot 65
: special-object-offset ( symbol -- n )
special-objects get at header-size + ;
: emit ( cell -- ) bootstrapping-image get push ; : emit ( cell -- ) bootstrapping-image get push ;
@ -268,9 +208,6 @@ GENERIC: ' ( obj -- ptr )
0 emit ! pointer to bignum -1 0 emit ! pointer to bignum -1
special-objects-size [ f ' emit ] times ; special-objects-size [ f ' emit ] times ;
: emit-special-object ( symbol -- )
[ get ' ] [ special-object-offset ] bi fixup ;
! Bignums ! Bignums
: bignum-bits ( -- n ) bootstrap-cell-bits 2 - ; : bignum-bits ( -- n ) bootstrap-cell-bits 2 - ;
@ -509,32 +446,41 @@ M: quotation '
class-and-cache class-or-cache next-method-quot-cache class-and-cache class-or-cache next-method-quot-cache
} [ H{ } clone global-box boa ] H{ } map>assoc assoc-union } [ H{ } clone global-box boa ] H{ } map>assoc assoc-union
global-hashtable boa global-hashtable boa
bootstrap-global set ; OBJ-GLOBAL bs-special-objects get set-at ;
: emit-jit-data ( -- ) : emit-jit-data ( -- )
\ if jit-if-word set {
\ do-primitive jit-primitive-word set { JIT-IF-WORD if }
\ dip jit-dip-word set { JIT-PRIMITIVE-WORD do-primitive }
\ 2dip jit-2dip-word set { JIT-DIP-WORD dip }
\ 3dip jit-3dip-word set { JIT-2DIP-WORD 2dip }
\ inline-cache-miss pic-miss-word set { JIT-3DIP-WORD 3dip }
\ inline-cache-miss-tail pic-miss-tail-word set { PIC-MISS-WORD inline-cache-miss }
\ mega-cache-lookup mega-lookup-word set { PIC-MISS-TAIL-WORD inline-cache-miss-tail }
\ mega-cache-miss mega-miss-word set { MEGA-LOOKUP-WORD mega-cache-lookup }
\ declare jit-declare-word set { MEGA-MISS-WORD mega-cache-miss }
\ c-to-factor c-to-factor-word set { JIT-DECLARE-WORD declare }
\ lazy-jit-compile lazy-jit-compile-word set { C-TO-FACTOR-WORD c-to-factor }
\ unwind-native-frames unwind-native-frames-word set { LAZY-JIT-COMPILE-WORD lazy-jit-compile }
\ fpu-state fpu-state-word set { UNWIND-NATIVE-FRAMES-WORD unwind-native-frames }
\ set-fpu-state set-fpu-state-word set { GET-FPU-STATE-WORD fpu-state }
\ signal-handler signal-handler-word set { SET-FPU-STATE-WORD set-fpu-state }
\ leaf-signal-handler leaf-signal-handler-word set { SIGNAL-HANDLER-WORD signal-handler }
\ ffi-signal-handler ffi-signal-handler-word set { LEAF-SIGNAL-HANDLER-WORD leaf-signal-handler }
\ ffi-leaf-signal-handler ffi-leaf-signal-handler-word set { FFI-SIGNAL-HANDLER-WORD ffi-signal-handler }
undefined-def undefined-quot set ; { FFI-LEAF-SIGNAL-HANDLER-WORD ffi-leaf-signal-handler }
}
\ OBJ-UNDEFINED undefined-def 2array suffix [
swap execute( -- x ) bs-special-objects get set-at
] assoc-each ;
: emit-special-object ( obj idx -- )
[ ' ] [ header-size + ] bi* fixup ;
: emit-special-objects ( -- ) : emit-special-objects ( -- )
special-objects get keys [ emit-special-object ] each ; bs-special-objects get [
swap emit-special-object
] assoc-each ;
: fixup-header ( -- ) : fixup-header ( -- )
heap-size data-heap-size-offset fixup ; heap-size data-heap-size-offset fixup ;

3
core/bootstrap/stage1.factor
View File

@ -55,4 +55,5 @@ load-help? off
] if ] if
] % ] %
] [ ] make ] [ ] make
bootstrap.image.private:bootstrap-startup-quot set OBJ-STARTUP-QUOT
bootstrap.image.private:bs-special-objects get set-at