bootstrap.assembler: new word define-sub-primitives
This way all sub primitives can be declared at once which imo is cleaner.locals-and-roots
Björn Lindqvist
parent
292e95f867
commit
df3852f54a
|
|
@ -89,17 +89,6 @@ IN: bootstrap.x86
|
|||
: jit-call-quot ( -- )
|
||||
EAX quot-entry-point-offset [+] CALL ;
|
||||
|
||||
[
|
||||
jit-load-vm
|
||||
EAX EBP 8 [+] MOV
|
||||
vm-reg EAX "begin_callback" jit-call-2arg
|
||||
|
||||
jit-call-quot
|
||||
|
||||
jit-load-vm
|
||||
vm-reg "end_callback" jit-call-1arg
|
||||
] \ c-to-factor define-sub-primitive
|
||||
|
||||
: signal-handler-save-regs ( -- regs )
|
||||
{ EAX EBX ECX EDX EBP EDI ESI } ;
|
||||
|
||||
|
|
@ -111,69 +100,6 @@ IN: bootstrap.x86
|
|||
[ jit-jump-quot ]
|
||||
\ (call) define-combinator-primitive
|
||||
|
||||
! unwind-native-frames is marked as "special" in vm/quotations.cpp
|
||||
! so it does not have a standard prolog
|
||||
[
|
||||
! Load ds and rs registers
|
||||
jit-load-vm
|
||||
jit-load-context
|
||||
jit-restore-context
|
||||
|
||||
! clear the fault flag
|
||||
vm-reg vm-fault-flag-offset [+] 0 MOV
|
||||
|
||||
! Windows-specific setup
|
||||
ctx-reg jit-update-seh
|
||||
|
||||
! Load arguments
|
||||
EAX ESP bootstrap-cell [+] MOV
|
||||
EDX ESP 2 bootstrap-cells [+] MOV
|
||||
|
||||
! Unwind stack frames
|
||||
ESP EDX MOV
|
||||
|
||||
jit-jump-quot
|
||||
] \ unwind-native-frames define-sub-primitive
|
||||
|
||||
[
|
||||
ESP 2 SUB
|
||||
ESP [] FNSTCW
|
||||
FNINIT
|
||||
AX ESP [] MOV
|
||||
ESP 2 ADD
|
||||
] \ fpu-state define-sub-primitive
|
||||
|
||||
[
|
||||
ESP stack-frame-size [+] FLDCW
|
||||
] \ set-fpu-state define-sub-primitive
|
||||
|
||||
[
|
||||
! Load callstack object
|
||||
temp3 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell SUB
|
||||
! Get ctx->callstack_bottom
|
||||
jit-load-vm
|
||||
jit-load-context
|
||||
temp0 ctx-reg context-callstack-bottom-offset [+] MOV
|
||||
! Get top of callstack object -- 'src' for memcpy
|
||||
temp1 temp3 callstack-top-offset [+] LEA
|
||||
! Get callstack length, in bytes --- 'len' for memcpy
|
||||
temp2 temp3 callstack-length-offset [+] MOV
|
||||
temp2 tag-bits get SHR
|
||||
! Compute new stack pointer -- 'dst' for memcpy
|
||||
temp0 temp2 SUB
|
||||
! Install new stack pointer
|
||||
ESP temp0 MOV
|
||||
! Call memcpy
|
||||
temp2 PUSH
|
||||
temp1 PUSH
|
||||
temp0 PUSH
|
||||
"factor_memcpy" jit-call
|
||||
ESP 12 ADD
|
||||
! Return with new callstack
|
||||
0 RET
|
||||
] \ set-callstack define-sub-primitive
|
||||
|
||||
[
|
||||
jit-load-vm
|
||||
jit-save-context
|
||||
|
|
@ -233,29 +159,6 @@ IN: bootstrap.x86
|
|||
]
|
||||
jit-conditional ;
|
||||
|
||||
[ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
|
||||
|
||||
[ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
|
||||
|
||||
[
|
||||
ds-reg 4 SUB
|
||||
jit-load-vm
|
||||
jit-save-context
|
||||
ECX ds-reg [] MOV
|
||||
EAX ECX MOV
|
||||
EBP ds-reg 4 [+] MOV
|
||||
EBP tag-bits get SAR
|
||||
! clobbers EDX
|
||||
EBP IMUL
|
||||
ds-reg [] EAX MOV
|
||||
[ JNO ]
|
||||
[
|
||||
ECX tag-bits get SAR
|
||||
ECX EBP vm-reg "overflow_fixnum_multiply" jit-call-3arg
|
||||
]
|
||||
jit-conditional
|
||||
] \ fixnum* define-sub-primitive
|
||||
|
||||
! Contexts
|
||||
: jit-switch-context ( reg -- )
|
||||
! Push a bogus return address so the GC can track this frame back
|
||||
|
|
@ -299,8 +202,6 @@ IN: bootstrap.x86
|
|||
ds-reg 4 ADD
|
||||
ds-reg [] EDX MOV ;
|
||||
|
||||
[ jit-set-context ] \ (set-context) define-sub-primitive
|
||||
|
||||
: jit-save-quot-and-param ( -- )
|
||||
EDX ds-reg MOV
|
||||
ds-reg 8 SUB ;
|
||||
|
|
@ -335,18 +236,11 @@ IN: bootstrap.x86
|
|||
EAX EDX [] MOV
|
||||
jit-jump-quot ;
|
||||
|
||||
[ jit-start-context ] \ (start-context) define-sub-primitive
|
||||
|
||||
: jit-delete-current-context ( -- )
|
||||
jit-load-vm
|
||||
jit-load-context
|
||||
vm-reg "delete_context" jit-call-1arg ;
|
||||
|
||||
[
|
||||
jit-delete-current-context
|
||||
jit-set-context
|
||||
] \ (set-context-and-delete) define-sub-primitive
|
||||
|
||||
: jit-start-context-and-delete ( -- )
|
||||
jit-load-vm
|
||||
|
||||
|
|
@ -371,6 +265,109 @@ IN: bootstrap.x86
|
|||
0 EAX MOVABS rc-absolute rel-safepoint
|
||||
] JIT-SAFEPOINT jit-define
|
||||
|
||||
[
|
||||
jit-start-context-and-delete
|
||||
] \ (start-context-and-delete) define-sub-primitive
|
||||
! # All x86.32 subprimitives
|
||||
{
|
||||
! ## Contexts
|
||||
{ (set-context) [ jit-set-context ] }
|
||||
{ (set-context-and-delete) [
|
||||
jit-delete-current-context
|
||||
jit-set-context
|
||||
] }
|
||||
{ (start-context) [ jit-start-context ] }
|
||||
{ (start-context-and-delete) [ jit-start-context-and-delete ] }
|
||||
|
||||
! ## Entry points
|
||||
{ c-to-factor [
|
||||
jit-load-vm
|
||||
EAX EBP 8 [+] MOV
|
||||
vm-reg EAX "begin_callback" jit-call-2arg
|
||||
|
||||
jit-call-quot
|
||||
|
||||
jit-load-vm
|
||||
vm-reg "end_callback" jit-call-1arg
|
||||
] }
|
||||
{ unwind-native-frames [
|
||||
! unwind-native-frames is marked as "special" in
|
||||
! vm/quotations.cpp so it does not have a standard prolog Load
|
||||
! ds and rs registers
|
||||
jit-load-vm
|
||||
jit-load-context
|
||||
jit-restore-context
|
||||
|
||||
! clear the fault flag
|
||||
vm-reg vm-fault-flag-offset [+] 0 MOV
|
||||
|
||||
! Windows-specific setup
|
||||
ctx-reg jit-update-seh
|
||||
|
||||
! Load arguments
|
||||
EAX ESP bootstrap-cell [+] MOV
|
||||
EDX ESP 2 bootstrap-cells [+] MOV
|
||||
|
||||
! Unwind stack frames
|
||||
ESP EDX MOV
|
||||
|
||||
jit-jump-quot
|
||||
] }
|
||||
|
||||
! ## Math
|
||||
{ fixnum+ [ [ ADD ] "overflow_fixnum_add" jit-overflow ] }
|
||||
{ fixnum- [ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] }
|
||||
{ fixnum* [
|
||||
ds-reg 4 SUB
|
||||
jit-load-vm
|
||||
jit-save-context
|
||||
ECX ds-reg [] MOV
|
||||
EAX ECX MOV
|
||||
EBP ds-reg 4 [+] MOV
|
||||
EBP tag-bits get SAR
|
||||
! clobbers EDX
|
||||
EBP IMUL
|
||||
ds-reg [] EAX MOV
|
||||
[ JNO ]
|
||||
[
|
||||
ECX tag-bits get SAR
|
||||
ECX EBP vm-reg "overflow_fixnum_multiply" jit-call-3arg
|
||||
]
|
||||
jit-conditional
|
||||
] }
|
||||
|
||||
! ## Misc
|
||||
{ fpu-state [
|
||||
ESP 2 SUB
|
||||
ESP [] FNSTCW
|
||||
FNINIT
|
||||
AX ESP [] MOV
|
||||
ESP 2 ADD
|
||||
] }
|
||||
{ set-fpu-state [
|
||||
ESP stack-frame-size [+] FLDCW
|
||||
] }
|
||||
{ set-callstack [
|
||||
! Load callstack object
|
||||
temp3 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell SUB
|
||||
! Get ctx->callstack_bottom
|
||||
jit-load-vm
|
||||
jit-load-context
|
||||
temp0 ctx-reg context-callstack-bottom-offset [+] MOV
|
||||
! Get top of callstack object -- 'src' for memcpy
|
||||
temp1 temp3 callstack-top-offset [+] LEA
|
||||
! Get callstack length, in bytes --- 'len' for memcpy
|
||||
temp2 temp3 callstack-length-offset [+] MOV
|
||||
temp2 tag-bits get SHR
|
||||
! Compute new stack pointer -- 'dst' for memcpy
|
||||
temp0 temp2 SUB
|
||||
! Install new stack pointer
|
||||
ESP temp0 MOV
|
||||
! Call memcpy
|
||||
temp2 PUSH
|
||||
temp1 PUSH
|
||||
temp0 PUSH
|
||||
"factor_memcpy" jit-call
|
||||
ESP 12 ADD
|
||||
! Return with new callstack
|
||||
0 RET
|
||||
] }
|
||||
} define-sub-primitives
|
||||
|
|
|
|||
|
|
@ -85,17 +85,6 @@ IN: bootstrap.x86
|
|||
|
||||
: jit-call-quot ( -- ) arg1 quot-entry-point-offset [+] CALL ;
|
||||
|
||||
[
|
||||
arg2 arg1 MOV
|
||||
vm-reg "begin_callback" jit-call-1arg
|
||||
|
||||
! call the quotation
|
||||
arg1 return-reg MOV
|
||||
jit-call-quot
|
||||
|
||||
vm-reg "end_callback" jit-call-1arg
|
||||
] \ c-to-factor define-sub-primitive
|
||||
|
||||
: signal-handler-save-regs ( -- regs )
|
||||
{ RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 } ;
|
||||
|
||||
|
|
@ -107,66 +96,6 @@ IN: bootstrap.x86
|
|||
[ jit-jump-quot ]
|
||||
\ (call) define-combinator-primitive
|
||||
|
||||
[
|
||||
! Unwind stack frames
|
||||
RSP arg2 MOV
|
||||
|
||||
! Load VM pointer into vm-reg, since we're entering from
|
||||
! C code
|
||||
vm-reg 0 MOV 0 rc-absolute-cell rel-vm
|
||||
|
||||
! Load ds and rs registers
|
||||
jit-load-context
|
||||
jit-restore-context
|
||||
|
||||
! Clear the fault flag
|
||||
vm-reg vm-fault-flag-offset [+] 0 MOV
|
||||
|
||||
! Call quotation
|
||||
jit-jump-quot
|
||||
] \ unwind-native-frames define-sub-primitive
|
||||
|
||||
[
|
||||
RSP 2 SUB
|
||||
RSP [] FNSTCW
|
||||
FNINIT
|
||||
AX RSP [] MOV
|
||||
RSP 2 ADD
|
||||
] \ fpu-state define-sub-primitive
|
||||
|
||||
[
|
||||
RSP 2 SUB
|
||||
RSP [] arg1 16-bit-version-of MOV
|
||||
RSP [] FLDCW
|
||||
RSP 2 ADD
|
||||
] \ set-fpu-state define-sub-primitive
|
||||
|
||||
[
|
||||
! Load callstack object
|
||||
arg4 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell SUB
|
||||
! Get ctx->callstack_bottom
|
||||
jit-load-context
|
||||
arg1 ctx-reg context-callstack-bottom-offset [+] MOV
|
||||
! Get top of callstack object -- 'src' for memcpy
|
||||
arg2 arg4 callstack-top-offset [+] LEA
|
||||
! Get callstack length, in bytes --- 'len' for memcpy
|
||||
arg3 arg4 callstack-length-offset [+] MOV
|
||||
arg3 tag-bits get SHR
|
||||
! Compute new stack pointer -- 'dst' for memcpy
|
||||
arg1 arg3 SUB
|
||||
! Install new stack pointer
|
||||
RSP arg1 MOV
|
||||
! Call memcpy; arguments are now in the correct registers
|
||||
! Create register shadow area for Win64
|
||||
RSP 32 SUB
|
||||
"factor_memcpy" jit-call
|
||||
! Tear down register shadow area
|
||||
RSP 32 ADD
|
||||
! Return with new callstack
|
||||
0 RET
|
||||
] \ set-callstack define-sub-primitive
|
||||
|
||||
[
|
||||
jit-save-context
|
||||
arg2 vm-reg MOV
|
||||
|
|
@ -220,30 +149,6 @@ IN: bootstrap.x86
|
|||
[ arg3 vm-reg MOV jit-call ]
|
||||
jit-conditional ; inline
|
||||
|
||||
[ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
|
||||
|
||||
[ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
|
||||
|
||||
[
|
||||
ds-reg 8 SUB
|
||||
jit-save-context
|
||||
RCX ds-reg [] MOV
|
||||
RBX ds-reg 8 [+] MOV
|
||||
RBX tag-bits get SAR
|
||||
RAX RCX MOV
|
||||
RBX IMUL
|
||||
ds-reg [] RAX MOV
|
||||
[ JNO ]
|
||||
[
|
||||
arg1 RCX MOV
|
||||
arg1 tag-bits get SAR
|
||||
arg2 RBX MOV
|
||||
arg3 vm-reg MOV
|
||||
"overflow_fixnum_multiply" jit-call
|
||||
]
|
||||
jit-conditional
|
||||
] \ fixnum* define-sub-primitive
|
||||
|
||||
! Contexts
|
||||
: jit-switch-context ( reg -- )
|
||||
! Push a bogus return address so the GC can track this frame back
|
||||
|
|
@ -279,8 +184,6 @@ IN: bootstrap.x86
|
|||
RSP 8 ADD
|
||||
jit-push-param ;
|
||||
|
||||
[ jit-set-context ] \ (set-context) define-sub-primitive
|
||||
|
||||
: jit-pop-quot-and-param ( -- )
|
||||
arg1 ds-reg [] MOV
|
||||
arg2 ds-reg -8 [+] MOV
|
||||
|
|
@ -299,16 +202,9 @@ IN: bootstrap.x86
|
|||
jit-push-param
|
||||
jit-jump-quot ;
|
||||
|
||||
[ jit-start-context ] \ (start-context) define-sub-primitive
|
||||
|
||||
: jit-delete-current-context ( -- )
|
||||
vm-reg "delete_context" jit-call-1arg ;
|
||||
|
||||
[
|
||||
jit-delete-current-context
|
||||
jit-set-context
|
||||
] \ (set-context-and-delete) define-sub-primitive
|
||||
|
||||
! Resets the active context and instead the passed in quotation
|
||||
! becomes the new code that it executes.
|
||||
: jit-start-context-and-delete ( -- )
|
||||
|
|
@ -333,6 +229,109 @@ IN: bootstrap.x86
|
|||
0 [RIP+] EAX MOV rc-relative rel-safepoint
|
||||
] JIT-SAFEPOINT jit-define
|
||||
|
||||
[
|
||||
jit-start-context-and-delete
|
||||
] \ (start-context-and-delete) define-sub-primitive
|
||||
! # All x86.64 subprimitives
|
||||
{
|
||||
! ## Contexts
|
||||
{ (set-context) [ jit-set-context ] }
|
||||
{ (set-context-and-delete) [
|
||||
jit-delete-current-context
|
||||
jit-set-context
|
||||
] }
|
||||
{ (start-context) [ jit-start-context ] }
|
||||
{ (start-context-and-delete) [ jit-start-context-and-delete ] }
|
||||
|
||||
! ## Entry points
|
||||
{ c-to-factor [
|
||||
arg2 arg1 MOV
|
||||
vm-reg "begin_callback" jit-call-1arg
|
||||
|
||||
! call the quotation
|
||||
arg1 return-reg MOV
|
||||
jit-call-quot
|
||||
|
||||
vm-reg "end_callback" jit-call-1arg
|
||||
] }
|
||||
{ unwind-native-frames [
|
||||
! unwind-native-frames is marked as "special" in
|
||||
! vm/quotations.cpp so it does not have a standard prolog
|
||||
! Unwind stack frames
|
||||
RSP arg2 MOV
|
||||
|
||||
! Load VM pointer into vm-reg, since we're entering from
|
||||
! C code
|
||||
vm-reg 0 MOV 0 rc-absolute-cell rel-vm
|
||||
|
||||
! Load ds and rs registers
|
||||
jit-load-context
|
||||
jit-restore-context
|
||||
|
||||
! Clear the fault flag
|
||||
vm-reg vm-fault-flag-offset [+] 0 MOV
|
||||
|
||||
! Call quotation
|
||||
jit-jump-quot
|
||||
] }
|
||||
|
||||
! ## Math
|
||||
{ fixnum+ [ [ ADD ] "overflow_fixnum_add" jit-overflow ] }
|
||||
{ fixnum- [ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] }
|
||||
{ fixnum* [
|
||||
ds-reg 8 SUB
|
||||
jit-save-context
|
||||
RCX ds-reg [] MOV
|
||||
RBX ds-reg 8 [+] MOV
|
||||
RBX tag-bits get SAR
|
||||
RAX RCX MOV
|
||||
RBX IMUL
|
||||
ds-reg [] RAX MOV
|
||||
[ JNO ]
|
||||
[
|
||||
arg1 RCX MOV
|
||||
arg1 tag-bits get SAR
|
||||
arg2 RBX MOV
|
||||
arg3 vm-reg MOV
|
||||
"overflow_fixnum_multiply" jit-call
|
||||
]
|
||||
jit-conditional
|
||||
] }
|
||||
|
||||
! ## Misc
|
||||
{ fpu-state [
|
||||
RSP 2 SUB
|
||||
RSP [] FNSTCW
|
||||
FNINIT
|
||||
AX RSP [] MOV
|
||||
RSP 2 ADD
|
||||
] }
|
||||
{ set-fpu-state [
|
||||
RSP 2 SUB
|
||||
RSP [] arg1 16-bit-version-of MOV
|
||||
RSP [] FLDCW
|
||||
RSP 2 ADD
|
||||
] }
|
||||
{ set-callstack [
|
||||
! Load callstack object
|
||||
arg4 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell SUB
|
||||
! Get ctx->callstack_bottom
|
||||
jit-load-context
|
||||
arg1 ctx-reg context-callstack-bottom-offset [+] MOV
|
||||
! Get top of callstack object -- 'src' for memcpy
|
||||
arg2 arg4 callstack-top-offset [+] LEA
|
||||
! Get callstack length, in bytes --- 'len' for memcpy
|
||||
arg3 arg4 callstack-length-offset [+] MOV
|
||||
arg3 tag-bits get SHR
|
||||
! Compute new stack pointer -- 'dst' for memcpy
|
||||
arg1 arg3 SUB
|
||||
! Install new stack pointer
|
||||
RSP arg1 MOV
|
||||
! Call memcpy; arguments are now in the correct registers
|
||||
! Create register shadow area for Win64
|
||||
RSP 32 SUB
|
||||
"factor_memcpy" jit-call
|
||||
! Tear down register shadow area
|
||||
RSP 32 ADD
|
||||
! Return with new callstack
|
||||
0 RET
|
||||
] }
|
||||
} define-sub-primitives
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: bootstrap.image.private compiler.codegen.relocation
|
||||
compiler.constants compiler.units cpu.x86.assembler
|
||||
cpu.x86.assembler.operands kernel kernel.private layouts locals
|
||||
locals.backend math math.private namespaces sequences
|
||||
locals.backend math math.private memory namespaces sequences
|
||||
slots.private strings.private vocabs ;
|
||||
IN: bootstrap.x86
|
||||
|
||||
|
|
@ -117,25 +117,6 @@ big-endian off
|
|||
POPF
|
||||
signal-handler-save-regs reverse [ POP ] each ;
|
||||
|
||||
[| |
|
||||
jit-signal-handler-prolog
|
||||
jit-save-context
|
||||
temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
|
||||
temp0 CALL
|
||||
jit-signal-handler-epilog
|
||||
0 RET
|
||||
] \ signal-handler define-sub-primitive
|
||||
|
||||
[| |
|
||||
jit-signal-handler-prolog
|
||||
jit-save-context
|
||||
temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
|
||||
temp0 CALL
|
||||
jit-signal-handler-epilog
|
||||
! Pop the fake leaf frame along with our return address
|
||||
leaf-stack-frame-size bootstrap-cell - RET
|
||||
] \ leaf-signal-handler define-sub-primitive
|
||||
|
||||
[
|
||||
! load boolean
|
||||
temp0 ds-reg [] MOV
|
||||
|
|
@ -303,172 +284,6 @@ big-endian off
|
|||
] jit-conditional
|
||||
] MEGA-LOOKUP jit-define
|
||||
|
||||
! ! ! Sub-primitives
|
||||
|
||||
! Objects
|
||||
[
|
||||
! load from stack
|
||||
temp0 ds-reg [] MOV
|
||||
! compute tag
|
||||
temp0 tag-mask get AND
|
||||
! tag the tag
|
||||
temp0 tag-bits get SHL
|
||||
! push to stack
|
||||
ds-reg [] temp0 MOV
|
||||
] \ tag define-sub-primitive
|
||||
|
||||
[
|
||||
! load slot number
|
||||
temp0 ds-reg [] MOV
|
||||
! adjust stack pointer
|
||||
ds-reg bootstrap-cell SUB
|
||||
! load object
|
||||
temp1 ds-reg [] MOV
|
||||
! turn slot number into offset
|
||||
fixnum>slot@
|
||||
! mask off tag
|
||||
temp1 tag-bits get SHR
|
||||
temp1 tag-bits get SHL
|
||||
! load slot value
|
||||
temp0 temp1 temp0 [+] MOV
|
||||
! push to stack
|
||||
ds-reg [] temp0 MOV
|
||||
] \ slot define-sub-primitive
|
||||
|
||||
[
|
||||
! load string index from stack
|
||||
temp0 ds-reg bootstrap-cell neg [+] MOV
|
||||
temp0 tag-bits get SHR
|
||||
! load string from stack
|
||||
temp1 ds-reg [] MOV
|
||||
! load character
|
||||
temp0 8-bit-version-of temp0 temp1 string-offset [++] MOV
|
||||
temp0 temp0 8-bit-version-of MOVZX
|
||||
temp0 tag-bits get SHL
|
||||
! store character to stack
|
||||
ds-reg bootstrap-cell SUB
|
||||
ds-reg [] temp0 MOV
|
||||
] \ string-nth-fast define-sub-primitive
|
||||
|
||||
! Shufflers
|
||||
[
|
||||
ds-reg bootstrap-cell SUB
|
||||
] \ drop define-sub-primitive
|
||||
|
||||
[
|
||||
ds-reg 2 bootstrap-cells SUB
|
||||
] \ 2drop define-sub-primitive
|
||||
|
||||
[
|
||||
ds-reg 3 bootstrap-cells SUB
|
||||
] \ 3drop define-sub-primitive
|
||||
|
||||
[
|
||||
ds-reg 4 bootstrap-cells SUB
|
||||
] \ 4drop define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell ADD
|
||||
ds-reg [] temp0 MOV
|
||||
] \ dup define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
temp1 ds-reg bootstrap-cell neg [+] MOV
|
||||
ds-reg 2 bootstrap-cells ADD
|
||||
ds-reg [] temp0 MOV
|
||||
ds-reg bootstrap-cell neg [+] temp1 MOV
|
||||
] \ 2dup define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
temp1 ds-reg -1 bootstrap-cells [+] MOV
|
||||
temp3 ds-reg -2 bootstrap-cells [+] MOV
|
||||
ds-reg 3 bootstrap-cells ADD
|
||||
ds-reg [] temp0 MOV
|
||||
ds-reg -1 bootstrap-cells [+] temp1 MOV
|
||||
ds-reg -2 bootstrap-cells [+] temp3 MOV
|
||||
] \ 3dup define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
temp1 ds-reg -1 bootstrap-cells [+] MOV
|
||||
temp2 ds-reg -2 bootstrap-cells [+] MOV
|
||||
temp3 ds-reg -3 bootstrap-cells [+] MOV
|
||||
ds-reg 4 bootstrap-cells ADD
|
||||
ds-reg [] temp0 MOV
|
||||
ds-reg -1 bootstrap-cells [+] temp1 MOV
|
||||
ds-reg -2 bootstrap-cells [+] temp2 MOV
|
||||
ds-reg -3 bootstrap-cells [+] temp3 MOV
|
||||
] \ 4dup define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell SUB
|
||||
ds-reg [] temp0 MOV
|
||||
] \ nip define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
ds-reg 2 bootstrap-cells SUB
|
||||
ds-reg [] temp0 MOV
|
||||
] \ 2nip define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg -1 bootstrap-cells [+] MOV
|
||||
ds-reg bootstrap-cell ADD
|
||||
ds-reg [] temp0 MOV
|
||||
] \ over define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg -2 bootstrap-cells [+] MOV
|
||||
ds-reg bootstrap-cell ADD
|
||||
ds-reg [] temp0 MOV
|
||||
] \ pick define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
temp1 ds-reg -1 bootstrap-cells [+] MOV
|
||||
ds-reg [] temp1 MOV
|
||||
ds-reg bootstrap-cell ADD
|
||||
ds-reg [] temp0 MOV
|
||||
] \ dupd define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
temp1 ds-reg bootstrap-cell neg [+] MOV
|
||||
ds-reg bootstrap-cell neg [+] temp0 MOV
|
||||
ds-reg [] temp1 MOV
|
||||
] \ swap define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg -1 bootstrap-cells [+] MOV
|
||||
temp1 ds-reg -2 bootstrap-cells [+] MOV
|
||||
ds-reg -2 bootstrap-cells [+] temp0 MOV
|
||||
ds-reg -1 bootstrap-cells [+] temp1 MOV
|
||||
] \ swapd define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
temp1 ds-reg -1 bootstrap-cells [+] MOV
|
||||
temp3 ds-reg -2 bootstrap-cells [+] MOV
|
||||
ds-reg -2 bootstrap-cells [+] temp1 MOV
|
||||
ds-reg -1 bootstrap-cells [+] temp0 MOV
|
||||
ds-reg [] temp3 MOV
|
||||
] \ rot define-sub-primitive
|
||||
|
||||
[
|
||||
temp0 ds-reg [] MOV
|
||||
temp1 ds-reg -1 bootstrap-cells [+] MOV
|
||||
temp3 ds-reg -2 bootstrap-cells [+] MOV
|
||||
ds-reg -2 bootstrap-cells [+] temp0 MOV
|
||||
ds-reg -1 bootstrap-cells [+] temp3 MOV
|
||||
ds-reg [] temp1 MOV
|
||||
] \ -rot define-sub-primitive
|
||||
|
||||
[ jit->r ] \ load-local define-sub-primitive
|
||||
|
||||
! Comparisons
|
||||
: jit-compare ( insn -- )
|
||||
! load t
|
||||
|
|
@ -486,15 +301,6 @@ big-endian off
|
|||
! store
|
||||
ds-reg [] temp1 MOV ;
|
||||
|
||||
: define-jit-compare ( insn word -- )
|
||||
[ [ jit-compare ] curry ] dip define-sub-primitive ;
|
||||
|
||||
\ CMOVE \ eq? define-jit-compare
|
||||
\ CMOVGE \ fixnum>= define-jit-compare
|
||||
\ CMOVLE \ fixnum<= define-jit-compare
|
||||
\ CMOVG \ fixnum> define-jit-compare
|
||||
\ CMOVL \ fixnum< define-jit-compare
|
||||
|
||||
! Math
|
||||
: jit-math ( insn -- )
|
||||
! load second input
|
||||
|
|
@ -504,39 +310,36 @@ big-endian off
|
|||
! compute result
|
||||
[ ds-reg [] temp0 ] dip execute( dst src -- ) ;
|
||||
|
||||
[ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
|
||||
|
||||
[ \ SUB jit-math ] \ fixnum-fast define-sub-primitive
|
||||
|
||||
[
|
||||
! load second input
|
||||
temp0 ds-reg [] MOV
|
||||
! pop stack
|
||||
ds-reg bootstrap-cell SUB
|
||||
! load first input
|
||||
: jit-fixnum-/mod ( -- )
|
||||
! load second parameter
|
||||
temp1 ds-reg [] MOV
|
||||
! untag second input
|
||||
temp0 tag-bits get SAR
|
||||
! multiply
|
||||
temp0 temp1 IMUL2
|
||||
! push result
|
||||
ds-reg [] temp0 MOV
|
||||
] \ fixnum*fast define-sub-primitive
|
||||
! load first parameter
|
||||
div-arg ds-reg bootstrap-cell neg [+] MOV
|
||||
! make a copy
|
||||
mod-arg div-arg MOV
|
||||
! sign-extend
|
||||
mod-arg bootstrap-cell-bits 1 - SAR
|
||||
! divide
|
||||
temp1 IDIV ;
|
||||
|
||||
[ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
|
||||
! # All x86 subprimitives
|
||||
{
|
||||
! ## Fixnums
|
||||
|
||||
[ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
|
||||
! ### Add
|
||||
{ fixnum+fast [ \ ADD jit-math ] }
|
||||
|
||||
[ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
|
||||
|
||||
[
|
||||
! ### Bit stuff
|
||||
{ fixnum-bitand [ \ AND jit-math ] }
|
||||
{ fixnum-bitnot [
|
||||
! complement
|
||||
ds-reg [] NOT
|
||||
! clear tag bits
|
||||
ds-reg [] tag-mask get XOR
|
||||
] \ fixnum-bitnot define-sub-primitive
|
||||
|
||||
[
|
||||
] }
|
||||
{ fixnum-bitor [ \ OR jit-math ] }
|
||||
{ fixnum-bitxor [ \ XOR jit-math ] }
|
||||
{ fixnum-shift-fast [
|
||||
! load shift count
|
||||
shift-arg ds-reg [] MOV
|
||||
! untag shift count
|
||||
|
|
@ -558,48 +361,10 @@ big-endian off
|
|||
temp2 temp3 CMOVGE
|
||||
! push to stack
|
||||
ds-reg [] temp2 MOV
|
||||
] \ fixnum-shift-fast define-sub-primitive
|
||||
] }
|
||||
|
||||
: jit-fixnum-/mod ( -- )
|
||||
! load second parameter
|
||||
temp1 ds-reg [] MOV
|
||||
! load first parameter
|
||||
div-arg ds-reg bootstrap-cell neg [+] MOV
|
||||
! make a copy
|
||||
mod-arg div-arg MOV
|
||||
! sign-extend
|
||||
mod-arg bootstrap-cell-bits 1 - SAR
|
||||
! divide
|
||||
temp1 IDIV ;
|
||||
|
||||
[
|
||||
jit-fixnum-/mod
|
||||
! adjust stack pointer
|
||||
ds-reg bootstrap-cell SUB
|
||||
! push to stack
|
||||
ds-reg [] mod-arg MOV
|
||||
] \ fixnum-mod define-sub-primitive
|
||||
|
||||
[
|
||||
jit-fixnum-/mod
|
||||
! adjust stack pointer
|
||||
ds-reg bootstrap-cell SUB
|
||||
! tag it
|
||||
div-arg tag-bits get SHL
|
||||
! push to stack
|
||||
ds-reg [] div-arg MOV
|
||||
] \ fixnum/i-fast define-sub-primitive
|
||||
|
||||
[
|
||||
jit-fixnum-/mod
|
||||
! tag it
|
||||
div-arg tag-bits get SHL
|
||||
! push to stack
|
||||
ds-reg [] mod-arg MOV
|
||||
ds-reg bootstrap-cell neg [+] div-arg MOV
|
||||
] \ fixnum/mod-fast define-sub-primitive
|
||||
|
||||
[
|
||||
! ### Comparisons
|
||||
{ both-fixnums? [
|
||||
temp0 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell SUB
|
||||
temp0 ds-reg [] OR
|
||||
|
|
@ -608,20 +373,60 @@ big-endian off
|
|||
temp1 1 tag-fixnum MOV
|
||||
temp0 temp1 CMOVE
|
||||
ds-reg [] temp0 MOV
|
||||
] \ both-fixnums? define-sub-primitive
|
||||
] }
|
||||
{ eq? [ \ CMOVE jit-compare ] }
|
||||
{ fixnum> [ \ CMOVG jit-compare ] }
|
||||
{ fixnum>= [ \ CMOVGE jit-compare ] }
|
||||
{ fixnum< [ \ CMOVL jit-compare ] }
|
||||
{ fixnum<= [ \ CMOVLE jit-compare ] }
|
||||
|
||||
[
|
||||
! load local number
|
||||
temp0 ds-reg [] MOV
|
||||
! turn local number into offset
|
||||
fixnum>slot@
|
||||
! load local value
|
||||
temp0 rs-reg temp0 [+] MOV
|
||||
! ### Div/mod
|
||||
{ fixnum-mod [
|
||||
jit-fixnum-/mod
|
||||
! adjust stack pointer
|
||||
ds-reg bootstrap-cell SUB
|
||||
! push to stack
|
||||
ds-reg [] temp0 MOV
|
||||
] \ get-local define-sub-primitive
|
||||
ds-reg [] mod-arg MOV
|
||||
] }
|
||||
{ fixnum/i-fast [
|
||||
jit-fixnum-/mod
|
||||
! adjust stack pointer
|
||||
ds-reg bootstrap-cell SUB
|
||||
! tag it
|
||||
div-arg tag-bits get SHL
|
||||
! push to stack
|
||||
ds-reg [] div-arg MOV
|
||||
] }
|
||||
{ fixnum/mod-fast [
|
||||
jit-fixnum-/mod
|
||||
! tag it
|
||||
div-arg tag-bits get SHL
|
||||
! push to stack
|
||||
ds-reg [] mod-arg MOV
|
||||
ds-reg bootstrap-cell neg [+] div-arg MOV
|
||||
] }
|
||||
|
||||
[
|
||||
! ### Mul
|
||||
{ fixnum*fast [
|
||||
! load second input
|
||||
temp0 ds-reg [] MOV
|
||||
! pop stack
|
||||
ds-reg bootstrap-cell SUB
|
||||
! load first input
|
||||
temp1 ds-reg [] MOV
|
||||
! untag second input
|
||||
temp0 tag-bits get SAR
|
||||
! multiply
|
||||
temp0 temp1 IMUL2
|
||||
! push result
|
||||
ds-reg [] temp0 MOV
|
||||
] }
|
||||
|
||||
! ### Sub
|
||||
{ fixnum-fast [ \ SUB jit-math ] }
|
||||
|
||||
! ## Locals
|
||||
{ drop-locals [
|
||||
! load local count
|
||||
temp0 ds-reg [] MOV
|
||||
! adjust stack pointer
|
||||
|
|
@ -630,6 +435,183 @@ big-endian off
|
|||
fixnum>slot@
|
||||
! decrement retain stack pointer
|
||||
rs-reg temp0 SUB
|
||||
] \ drop-locals define-sub-primitive
|
||||
] }
|
||||
{ get-local [
|
||||
! load local number
|
||||
temp0 ds-reg [] MOV
|
||||
! turn local number into offset
|
||||
fixnum>slot@
|
||||
! load local value
|
||||
temp0 rs-reg temp0 [+] MOV
|
||||
! push to stack
|
||||
ds-reg [] temp0 MOV
|
||||
] }
|
||||
{ load-local [ jit->r ] }
|
||||
|
||||
! ## Objects
|
||||
{ slot [
|
||||
! load slot number
|
||||
temp0 ds-reg [] MOV
|
||||
! adjust stack pointer
|
||||
ds-reg bootstrap-cell SUB
|
||||
! load object
|
||||
temp1 ds-reg [] MOV
|
||||
! turn slot number into offset
|
||||
fixnum>slot@
|
||||
! mask off tag
|
||||
temp1 tag-bits get SHR
|
||||
temp1 tag-bits get SHL
|
||||
! load slot value
|
||||
temp0 temp1 temp0 [+] MOV
|
||||
! push to stack
|
||||
ds-reg [] temp0 MOV
|
||||
] }
|
||||
{ string-nth-fast [
|
||||
! load string index from stack
|
||||
temp0 ds-reg bootstrap-cell neg [+] MOV
|
||||
temp0 tag-bits get SHR
|
||||
! load string from stack
|
||||
temp1 ds-reg [] MOV
|
||||
! load character
|
||||
temp0 8-bit-version-of temp0 temp1 string-offset [++] MOV
|
||||
temp0 temp0 8-bit-version-of MOVZX
|
||||
temp0 tag-bits get SHL
|
||||
! store character to stack
|
||||
ds-reg bootstrap-cell SUB
|
||||
ds-reg [] temp0 MOV
|
||||
] }
|
||||
{ tag [
|
||||
! load from stack
|
||||
temp0 ds-reg [] MOV
|
||||
! compute tag
|
||||
temp0 tag-mask get AND
|
||||
! tag the tag
|
||||
temp0 tag-bits get SHL
|
||||
! push to stack
|
||||
ds-reg [] temp0 MOV
|
||||
] }
|
||||
|
||||
! ## Shufflers
|
||||
|
||||
! ### Drops
|
||||
{ drop [ ds-reg bootstrap-cell SUB ] }
|
||||
{ 2drop [ ds-reg 2 bootstrap-cells SUB ] }
|
||||
{ 3drop [ ds-reg 3 bootstrap-cells SUB ] }
|
||||
{ 4drop [ ds-reg 4 bootstrap-cells SUB ] }
|
||||
|
||||
! ### Dups
|
||||
{ dup [
|
||||
temp0 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell ADD
|
||||
ds-reg [] temp0 MOV
|
||||
] }
|
||||
{ 2dup [
|
||||
temp0 ds-reg [] MOV
|
||||
temp1 ds-reg bootstrap-cell neg [+] MOV
|
||||
ds-reg 2 bootstrap-cells ADD
|
||||
ds-reg [] temp0 MOV
|
||||
ds-reg bootstrap-cell neg [+] temp1 MOV
|
||||
] }
|
||||
{ 3dup [
|
||||
temp0 ds-reg [] MOV
|
||||
temp1 ds-reg -1 bootstrap-cells [+] MOV
|
||||
temp3 ds-reg -2 bootstrap-cells [+] MOV
|
||||
ds-reg 3 bootstrap-cells ADD
|
||||
ds-reg [] temp0 MOV
|
||||
ds-reg -1 bootstrap-cells [+] temp1 MOV
|
||||
ds-reg -2 bootstrap-cells [+] temp3 MOV
|
||||
] }
|
||||
{ 4dup [
|
||||
temp0 ds-reg [] MOV
|
||||
temp1 ds-reg -1 bootstrap-cells [+] MOV
|
||||
temp2 ds-reg -2 bootstrap-cells [+] MOV
|
||||
temp3 ds-reg -3 bootstrap-cells [+] MOV
|
||||
ds-reg 4 bootstrap-cells ADD
|
||||
ds-reg [] temp0 MOV
|
||||
ds-reg -1 bootstrap-cells [+] temp1 MOV
|
||||
ds-reg -2 bootstrap-cells [+] temp2 MOV
|
||||
ds-reg -3 bootstrap-cells [+] temp3 MOV
|
||||
] }
|
||||
{ dupd [
|
||||
temp0 ds-reg [] MOV
|
||||
temp1 ds-reg -1 bootstrap-cells [+] MOV
|
||||
ds-reg [] temp1 MOV
|
||||
ds-reg bootstrap-cell ADD
|
||||
ds-reg [] temp0 MOV
|
||||
] }
|
||||
|
||||
! ### Misc shufflers
|
||||
{ over [
|
||||
temp0 ds-reg -1 bootstrap-cells [+] MOV
|
||||
ds-reg bootstrap-cell ADD
|
||||
ds-reg [] temp0 MOV
|
||||
] }
|
||||
{ pick [
|
||||
temp0 ds-reg -2 bootstrap-cells [+] MOV
|
||||
ds-reg bootstrap-cell ADD
|
||||
ds-reg [] temp0 MOV
|
||||
] }
|
||||
|
||||
! ### Nips
|
||||
{ nip [
|
||||
temp0 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell SUB
|
||||
ds-reg [] temp0 MOV
|
||||
] }
|
||||
{ 2nip [
|
||||
temp0 ds-reg [] MOV
|
||||
ds-reg 2 bootstrap-cells SUB
|
||||
ds-reg [] temp0 MOV
|
||||
] }
|
||||
|
||||
! ### Swaps
|
||||
{ -rot [
|
||||
temp0 ds-reg [] MOV
|
||||
temp1 ds-reg -1 bootstrap-cells [+] MOV
|
||||
temp3 ds-reg -2 bootstrap-cells [+] MOV
|
||||
ds-reg -2 bootstrap-cells [+] temp0 MOV
|
||||
ds-reg -1 bootstrap-cells [+] temp3 MOV
|
||||
ds-reg [] temp1 MOV
|
||||
] }
|
||||
{ rot [
|
||||
temp0 ds-reg [] MOV
|
||||
temp1 ds-reg -1 bootstrap-cells [+] MOV
|
||||
temp3 ds-reg -2 bootstrap-cells [+] MOV
|
||||
ds-reg -2 bootstrap-cells [+] temp1 MOV
|
||||
ds-reg -1 bootstrap-cells [+] temp0 MOV
|
||||
ds-reg [] temp3 MOV
|
||||
] }
|
||||
{ swap [
|
||||
temp0 ds-reg [] MOV
|
||||
temp1 ds-reg bootstrap-cell neg [+] MOV
|
||||
ds-reg bootstrap-cell neg [+] temp0 MOV
|
||||
ds-reg [] temp1 MOV
|
||||
] }
|
||||
{ swapd [
|
||||
temp0 ds-reg -1 bootstrap-cells [+] MOV
|
||||
temp1 ds-reg -2 bootstrap-cells [+] MOV
|
||||
ds-reg -2 bootstrap-cells [+] temp0 MOV
|
||||
ds-reg -1 bootstrap-cells [+] temp1 MOV
|
||||
] }
|
||||
|
||||
! ## Signal handling
|
||||
{ leaf-signal-handler [
|
||||
jit-signal-handler-prolog
|
||||
jit-save-context
|
||||
temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
|
||||
temp0 CALL
|
||||
jit-signal-handler-epilog
|
||||
! Pop the fake leaf frame along with our return address
|
||||
leaf-stack-frame-size bootstrap-cell - RET
|
||||
] }
|
||||
{ signal-handler [
|
||||
jit-signal-handler-prolog
|
||||
jit-save-context
|
||||
temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
|
||||
temp0 CALL
|
||||
jit-signal-handler-epilog
|
||||
0 RET
|
||||
] }
|
||||
} define-sub-primitives
|
||||
|
||||
[ "bootstrap.x86" forget-vocab ] with-compilation-unit
|
||||
|
|
|
|||
|
|
@ -126,6 +126,9 @@ SYMBOL: special-objects
|
|||
: define-sub-primitive ( quot word -- )
|
||||
[ make-jit 3array ] dip sub-primitives get set-at ;
|
||||
|
||||
: define-sub-primitives ( assoc -- )
|
||||
[ swap define-sub-primitive ] assoc-each ;
|
||||
|
||||
: define-combinator-primitive ( quot non-tail-quot tail-quot word -- )
|
||||
[
|
||||
[
|
||||
|
|
|
|||
Loading…
Reference in New Issue