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.privatedb4
Björn Lindqvist
John Benediktsson
parent
bdc4880b17
commit
9cf36e3dc2
|
|
@ -44,7 +44,7 @@ IN: bootstrap.x86
|
|||
[
|
||||
pic-tail-reg 5 [RIP+] LEA
|
||||
0 JMP f rc-relative rel-word-pic-tail
|
||||
] jit-word-jump jit-define
|
||||
] JIT-WORD-JUMP jit-define
|
||||
|
||||
: jit-load-vm ( -- )
|
||||
! no-op on x86-64. in factor contexts vm-reg always contains the
|
||||
|
|
@ -56,6 +56,9 @@ IN: bootstrap.x86
|
|||
|
||||
: jit-save-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
|
||||
ctx-reg context-callstack-top-offset [+] R11 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 CALL
|
||||
jit-restore-context
|
||||
] jit-primitive jit-define
|
||||
] JIT-PRIMITIVE jit-define
|
||||
|
||||
: jit-jump-quot ( -- )
|
||||
arg1 quot-entry-point-offset [+] JMP ;
|
||||
|
|
@ -177,7 +180,7 @@ IN: bootstrap.x86
|
|||
[
|
||||
temp2 0xffffffff MOV f rc-absolute-cell rel-literal
|
||||
temp1 temp2 CMP
|
||||
] pic-check-tuple jit-define
|
||||
] PIC-CHECK-TUPLE jit-define
|
||||
|
||||
! Inline cache miss entry points
|
||||
: jit-load-return-address ( -- )
|
||||
|
|
@ -328,7 +331,7 @@ IN: bootstrap.x86
|
|||
|
||||
[
|
||||
0 [RIP+] EAX MOV rc-relative rel-safepoint
|
||||
] \ jit-safepoint jit-define
|
||||
] JIT-SAFEPOINT jit-define
|
||||
|
||||
[
|
||||
jit-start-context-and-delete
|
||||
|
|
|
|||
|
|
@ -74,7 +74,7 @@ big-endian off
|
|||
|
||||
! See the comment for M\ x86.32 stack-cleanup in cpu.x86.32
|
||||
0xffff RET f rc-absolute-2 rel-untagged
|
||||
] callback-stub jit-define
|
||||
] CALLBACK-STUB jit-define
|
||||
|
||||
[
|
||||
! load literal
|
||||
|
|
@ -83,11 +83,11 @@ big-endian off
|
|||
ds-reg bootstrap-cell ADD
|
||||
! store literal on datastack
|
||||
ds-reg [] temp0 MOV
|
||||
] jit-push jit-define
|
||||
] JIT-PUSH-IMMEDIATE jit-define
|
||||
|
||||
[
|
||||
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
|
||||
! 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
|
||||
! jump to false branch if equal
|
||||
0 JMP f rc-relative rel-word
|
||||
] jit-if jit-define
|
||||
] JIT-IF jit-define
|
||||
|
||||
: jit->r ( -- )
|
||||
rs-reg bootstrap-cell ADD
|
||||
|
|
@ -215,19 +215,19 @@ big-endian off
|
|||
jit->r
|
||||
0 CALL f rc-relative rel-word
|
||||
jit-r>
|
||||
] jit-dip jit-define
|
||||
] JIT-DIP jit-define
|
||||
|
||||
[
|
||||
jit-2>r
|
||||
0 CALL f rc-relative rel-word
|
||||
jit-2r>
|
||||
] jit-2dip jit-define
|
||||
] JIT-2DIP jit-define
|
||||
|
||||
[
|
||||
jit-3>r
|
||||
0 CALL f rc-relative rel-word
|
||||
jit-3r>
|
||||
] jit-3dip jit-define
|
||||
] JIT-3DIP jit-define
|
||||
|
||||
[
|
||||
! load from stack
|
||||
|
|
@ -243,17 +243,17 @@ big-endian off
|
|||
temp0 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell SUB
|
||||
temp0 word-entry-point-offset [+] JMP
|
||||
] jit-execute jit-define
|
||||
] JIT-EXECUTE jit-define
|
||||
|
||||
[
|
||||
stack-reg stack-frame-size bootstrap-cell - SUB
|
||||
] jit-prolog jit-define
|
||||
] JIT-PROLOG jit-define
|
||||
|
||||
[
|
||||
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
|
||||
|
||||
|
|
@ -262,9 +262,9 @@ big-endian off
|
|||
! Load a value from a stack position
|
||||
[
|
||||
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
|
||||
|
|
@ -273,13 +273,13 @@ big-endian off
|
|||
[ JNE ]
|
||||
[ temp1 temp0 tuple-class-offset [+] MOV ]
|
||||
jit-conditional
|
||||
] pic-tuple jit-define
|
||||
] PIC-TUPLE jit-define
|
||||
|
||||
[
|
||||
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
|
||||
|
||||
|
|
@ -315,7 +315,7 @@ big-endian off
|
|||
temp0 word-entry-point-offset [+] JMP
|
||||
! fall-through on miss
|
||||
] jit-conditional
|
||||
] mega-lookup jit-define
|
||||
] MEGA-LOOKUP jit-define
|
||||
|
||||
! ! ! Sub-primitives
|
||||
|
||||
|
|
|
|||
|
|
@ -17,9 +17,6 @@ ABOUT: "bootstrap.image"
|
|||
HELP: architecture
|
||||
{ $var-description "Bootstrap architecture name" } ;
|
||||
|
||||
HELP: bootstrap-startup-quot
|
||||
{ $var-description "This image's startup quotation or " { $link f } ". " } ;
|
||||
|
||||
HELP: define-sub-primitive
|
||||
{ $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." } ;
|
||||
|
|
|
|||
|
|
@ -106,6 +106,8 @@ CONSTANT: -1-offset 9
|
|||
|
||||
SYMBOL: sub-primitives
|
||||
|
||||
SYMBOL: bs-special-objects
|
||||
|
||||
:: jit-conditional ( test-quot false-quot -- )
|
||||
[ 0 test-quot call ] B{ } make length :> len
|
||||
building get length extra-offset get + len +
|
||||
|
|
@ -126,8 +128,8 @@ SYMBOL: sub-primitives
|
|||
: make-jit-no-params ( quot -- code )
|
||||
make-jit 2nip ;
|
||||
|
||||
: jit-define ( quot name -- )
|
||||
[ make-jit-no-params ] dip set ;
|
||||
: jit-define ( quot n -- )
|
||||
[ make-jit-no-params ] dip bs-special-objects get set-at ;
|
||||
|
||||
: define-sub-primitive ( quot word -- )
|
||||
[ make-jit 3array ] dip sub-primitives get set-at ;
|
||||
|
|
@ -143,7 +145,6 @@ SYMBOL: sub-primitives
|
|||
] dip
|
||||
sub-primitives get set-at ;
|
||||
|
||||
! The image being constructed; a vector of word-size integers
|
||||
SYMBOL: bootstrapping-image
|
||||
|
||||
! Image output format
|
||||
|
|
@ -151,68 +152,7 @@ SYMBOL: big-endian
|
|||
|
||||
SYMBOL: architecture
|
||||
|
||||
RESET
|
||||
|
||||
! 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 + ;
|
||||
H{ } clone bs-special-objects set-global
|
||||
|
||||
: emit ( cell -- ) bootstrapping-image get push ;
|
||||
|
||||
|
|
@ -268,9 +208,6 @@ GENERIC: ' ( obj -- ptr )
|
|||
0 emit ! pointer to bignum -1
|
||||
special-objects-size [ f ' emit ] times ;
|
||||
|
||||
: emit-special-object ( symbol -- )
|
||||
[ get ' ] [ special-object-offset ] bi fixup ;
|
||||
|
||||
! Bignums
|
||||
|
||||
: bignum-bits ( -- n ) bootstrap-cell-bits 2 - ;
|
||||
|
|
@ -509,32 +446,41 @@ M: quotation '
|
|||
class-and-cache class-or-cache next-method-quot-cache
|
||||
} [ H{ } clone global-box boa ] H{ } map>assoc assoc-union
|
||||
global-hashtable boa
|
||||
bootstrap-global set ;
|
||||
OBJ-GLOBAL bs-special-objects get set-at ;
|
||||
|
||||
: emit-jit-data ( -- )
|
||||
\ if jit-if-word set
|
||||
\ do-primitive jit-primitive-word set
|
||||
\ dip jit-dip-word set
|
||||
\ 2dip jit-2dip-word set
|
||||
\ 3dip jit-3dip-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
|
||||
\ declare jit-declare-word set
|
||||
\ c-to-factor c-to-factor-word set
|
||||
\ lazy-jit-compile lazy-jit-compile-word set
|
||||
\ unwind-native-frames unwind-native-frames-word set
|
||||
\ fpu-state fpu-state-word set
|
||||
\ set-fpu-state set-fpu-state-word set
|
||||
\ signal-handler signal-handler-word set
|
||||
\ leaf-signal-handler leaf-signal-handler-word set
|
||||
\ ffi-signal-handler ffi-signal-handler-word set
|
||||
\ ffi-leaf-signal-handler ffi-leaf-signal-handler-word set
|
||||
undefined-def undefined-quot set ;
|
||||
{
|
||||
{ JIT-IF-WORD if }
|
||||
{ JIT-PRIMITIVE-WORD do-primitive }
|
||||
{ JIT-DIP-WORD dip }
|
||||
{ JIT-2DIP-WORD 2dip }
|
||||
{ JIT-3DIP-WORD 3dip }
|
||||
{ PIC-MISS-WORD inline-cache-miss }
|
||||
{ PIC-MISS-TAIL-WORD inline-cache-miss-tail }
|
||||
{ MEGA-LOOKUP-WORD mega-cache-lookup }
|
||||
{ MEGA-MISS-WORD mega-cache-miss }
|
||||
{ JIT-DECLARE-WORD declare }
|
||||
{ C-TO-FACTOR-WORD c-to-factor }
|
||||
{ LAZY-JIT-COMPILE-WORD lazy-jit-compile }
|
||||
{ UNWIND-NATIVE-FRAMES-WORD unwind-native-frames }
|
||||
{ GET-FPU-STATE-WORD fpu-state }
|
||||
{ SET-FPU-STATE-WORD set-fpu-state }
|
||||
{ SIGNAL-HANDLER-WORD signal-handler }
|
||||
{ LEAF-SIGNAL-HANDLER-WORD leaf-signal-handler }
|
||||
{ FFI-SIGNAL-HANDLER-WORD ffi-signal-handler }
|
||||
{ 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 ( -- )
|
||||
special-objects get keys [ emit-special-object ] each ;
|
||||
bs-special-objects get [
|
||||
swap emit-special-object
|
||||
] assoc-each ;
|
||||
|
||||
: fixup-header ( -- )
|
||||
heap-size data-heap-size-offset fixup ;
|
||||
|
|
|
|||
|
|
@ -55,4 +55,5 @@ load-help? off
|
|||
] if
|
||||
] %
|
||||
] [ ] make
|
||||
bootstrap.image.private:bootstrap-startup-quot set
|
||||
OBJ-STARTUP-QUOT
|
||||
bootstrap.image.private:bs-special-objects get set-at
|
||||
|
|
|
|||
Loading…
Reference in New Issue