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 ( -- )
|
: jit-call-quot ( -- )
|
||||||
EAX quot-entry-point-offset [+] CALL ;
|
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 )
|
: signal-handler-save-regs ( -- regs )
|
||||||
{ EAX EBX ECX EDX EBP EDI ESI } ;
|
{ EAX EBX ECX EDX EBP EDI ESI } ;
|
||||||
|
|
||||||
|
|
@ -111,69 +100,6 @@ IN: bootstrap.x86
|
||||||
[ jit-jump-quot ]
|
[ jit-jump-quot ]
|
||||||
\ (call) define-combinator-primitive
|
\ (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-load-vm
|
||||||
jit-save-context
|
jit-save-context
|
||||||
|
|
@ -233,29 +159,6 @@ IN: bootstrap.x86
|
||||||
]
|
]
|
||||||
jit-conditional ;
|
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
|
! Contexts
|
||||||
: jit-switch-context ( reg -- )
|
: jit-switch-context ( reg -- )
|
||||||
! Push a bogus return address so the GC can track this frame back
|
! 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 4 ADD
|
||||||
ds-reg [] EDX MOV ;
|
ds-reg [] EDX MOV ;
|
||||||
|
|
||||||
[ jit-set-context ] \ (set-context) define-sub-primitive
|
|
||||||
|
|
||||||
: jit-save-quot-and-param ( -- )
|
: jit-save-quot-and-param ( -- )
|
||||||
EDX ds-reg MOV
|
EDX ds-reg MOV
|
||||||
ds-reg 8 SUB ;
|
ds-reg 8 SUB ;
|
||||||
|
|
@ -335,18 +236,11 @@ IN: bootstrap.x86
|
||||||
EAX EDX [] MOV
|
EAX EDX [] MOV
|
||||||
jit-jump-quot ;
|
jit-jump-quot ;
|
||||||
|
|
||||||
[ jit-start-context ] \ (start-context) define-sub-primitive
|
|
||||||
|
|
||||||
: jit-delete-current-context ( -- )
|
: jit-delete-current-context ( -- )
|
||||||
jit-load-vm
|
jit-load-vm
|
||||||
jit-load-context
|
jit-load-context
|
||||||
vm-reg "delete_context" jit-call-1arg ;
|
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-start-context-and-delete ( -- )
|
||||||
jit-load-vm
|
jit-load-vm
|
||||||
|
|
||||||
|
|
@ -371,6 +265,109 @@ IN: bootstrap.x86
|
||||||
0 EAX MOVABS rc-absolute rel-safepoint
|
0 EAX MOVABS rc-absolute rel-safepoint
|
||||||
] JIT-SAFEPOINT jit-define
|
] JIT-SAFEPOINT jit-define
|
||||||
|
|
||||||
[
|
! # All x86.32 subprimitives
|
||||||
jit-start-context-and-delete
|
{
|
||||||
] \ (start-context-and-delete) define-sub-primitive
|
! ## 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 ;
|
: 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 )
|
: signal-handler-save-regs ( -- regs )
|
||||||
{ RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 } ;
|
{ 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 ]
|
[ jit-jump-quot ]
|
||||||
\ (call) define-combinator-primitive
|
\ (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
|
jit-save-context
|
||||||
arg2 vm-reg MOV
|
arg2 vm-reg MOV
|
||||||
|
|
@ -220,30 +149,6 @@ IN: bootstrap.x86
|
||||||
[ arg3 vm-reg MOV jit-call ]
|
[ arg3 vm-reg MOV jit-call ]
|
||||||
jit-conditional ; inline
|
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
|
! Contexts
|
||||||
: jit-switch-context ( reg -- )
|
: jit-switch-context ( reg -- )
|
||||||
! Push a bogus return address so the GC can track this frame back
|
! Push a bogus return address so the GC can track this frame back
|
||||||
|
|
@ -279,8 +184,6 @@ IN: bootstrap.x86
|
||||||
RSP 8 ADD
|
RSP 8 ADD
|
||||||
jit-push-param ;
|
jit-push-param ;
|
||||||
|
|
||||||
[ jit-set-context ] \ (set-context) define-sub-primitive
|
|
||||||
|
|
||||||
: jit-pop-quot-and-param ( -- )
|
: jit-pop-quot-and-param ( -- )
|
||||||
arg1 ds-reg [] MOV
|
arg1 ds-reg [] MOV
|
||||||
arg2 ds-reg -8 [+] MOV
|
arg2 ds-reg -8 [+] MOV
|
||||||
|
|
@ -299,16 +202,9 @@ IN: bootstrap.x86
|
||||||
jit-push-param
|
jit-push-param
|
||||||
jit-jump-quot ;
|
jit-jump-quot ;
|
||||||
|
|
||||||
[ jit-start-context ] \ (start-context) define-sub-primitive
|
|
||||||
|
|
||||||
: jit-delete-current-context ( -- )
|
: jit-delete-current-context ( -- )
|
||||||
vm-reg "delete_context" jit-call-1arg ;
|
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
|
! Resets the active context and instead the passed in quotation
|
||||||
! becomes the new code that it executes.
|
! becomes the new code that it executes.
|
||||||
: jit-start-context-and-delete ( -- )
|
: jit-start-context-and-delete ( -- )
|
||||||
|
|
@ -333,6 +229,109 @@ 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
|
||||||
|
|
||||||
[
|
! # All x86.64 subprimitives
|
||||||
jit-start-context-and-delete
|
{
|
||||||
] \ (start-context-and-delete) define-sub-primitive
|
! ## 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
|
USING: bootstrap.image.private compiler.codegen.relocation
|
||||||
compiler.constants compiler.units cpu.x86.assembler
|
compiler.constants compiler.units cpu.x86.assembler
|
||||||
cpu.x86.assembler.operands kernel kernel.private layouts locals
|
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 ;
|
slots.private strings.private vocabs ;
|
||||||
IN: bootstrap.x86
|
IN: bootstrap.x86
|
||||||
|
|
||||||
|
|
@ -117,25 +117,6 @@ big-endian off
|
||||||
POPF
|
POPF
|
||||||
signal-handler-save-regs reverse [ POP ] each ;
|
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
|
! load boolean
|
||||||
temp0 ds-reg [] MOV
|
temp0 ds-reg [] MOV
|
||||||
|
|
@ -303,172 +284,6 @@ big-endian off
|
||||||
] jit-conditional
|
] jit-conditional
|
||||||
] MEGA-LOOKUP jit-define
|
] 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
|
! Comparisons
|
||||||
: jit-compare ( insn -- )
|
: jit-compare ( insn -- )
|
||||||
! load t
|
! load t
|
||||||
|
|
@ -486,15 +301,6 @@ big-endian off
|
||||||
! store
|
! store
|
||||||
ds-reg [] temp1 MOV ;
|
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
|
! Math
|
||||||
: jit-math ( insn -- )
|
: jit-math ( insn -- )
|
||||||
! load second input
|
! load second input
|
||||||
|
|
@ -504,62 +310,6 @@ big-endian off
|
||||||
! compute result
|
! compute result
|
||||||
[ ds-reg [] temp0 ] dip execute( dst src -- ) ;
|
[ 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
|
|
||||||
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
|
|
||||||
|
|
||||||
[ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
|
|
||||||
|
|
||||||
[ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
|
|
||||||
|
|
||||||
[ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
|
|
||||||
|
|
||||||
[
|
|
||||||
! complement
|
|
||||||
ds-reg [] NOT
|
|
||||||
! clear tag bits
|
|
||||||
ds-reg [] tag-mask get XOR
|
|
||||||
] \ fixnum-bitnot define-sub-primitive
|
|
||||||
|
|
||||||
[
|
|
||||||
! load shift count
|
|
||||||
shift-arg ds-reg [] MOV
|
|
||||||
! untag shift count
|
|
||||||
shift-arg tag-bits get SAR
|
|
||||||
! adjust stack pointer
|
|
||||||
ds-reg bootstrap-cell SUB
|
|
||||||
! load value
|
|
||||||
temp3 ds-reg [] MOV
|
|
||||||
! make a copy
|
|
||||||
temp2 temp3 MOV
|
|
||||||
! compute positive shift value in temp2
|
|
||||||
temp2 CL SHL
|
|
||||||
shift-arg NEG
|
|
||||||
! compute negative shift value in temp3
|
|
||||||
temp3 CL SAR
|
|
||||||
temp3 tag-mask get bitnot AND
|
|
||||||
shift-arg 0 CMP
|
|
||||||
! if shift count was negative, move temp0 to temp2
|
|
||||||
temp2 temp3 CMOVGE
|
|
||||||
! push to stack
|
|
||||||
ds-reg [] temp2 MOV
|
|
||||||
] \ fixnum-shift-fast define-sub-primitive
|
|
||||||
|
|
||||||
: jit-fixnum-/mod ( -- )
|
: jit-fixnum-/mod ( -- )
|
||||||
! load second parameter
|
! load second parameter
|
||||||
temp1 ds-reg [] MOV
|
temp1 ds-reg [] MOV
|
||||||
|
|
@ -572,64 +322,296 @@ big-endian off
|
||||||
! divide
|
! divide
|
||||||
temp1 IDIV ;
|
temp1 IDIV ;
|
||||||
|
|
||||||
[
|
! # All x86 subprimitives
|
||||||
jit-fixnum-/mod
|
{
|
||||||
! adjust stack pointer
|
! ## Fixnums
|
||||||
ds-reg bootstrap-cell SUB
|
|
||||||
! push to stack
|
|
||||||
ds-reg [] mod-arg MOV
|
|
||||||
] \ fixnum-mod define-sub-primitive
|
|
||||||
|
|
||||||
[
|
! ### Add
|
||||||
jit-fixnum-/mod
|
{ fixnum+fast [ \ ADD jit-math ] }
|
||||||
! 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
|
|
||||||
|
|
||||||
[
|
! ### Bit stuff
|
||||||
jit-fixnum-/mod
|
{ fixnum-bitand [ \ AND jit-math ] }
|
||||||
! tag it
|
{ fixnum-bitnot [
|
||||||
div-arg tag-bits get SHL
|
! complement
|
||||||
! push to stack
|
ds-reg [] NOT
|
||||||
ds-reg [] mod-arg MOV
|
! clear tag bits
|
||||||
ds-reg bootstrap-cell neg [+] div-arg MOV
|
ds-reg [] tag-mask get XOR
|
||||||
] \ fixnum/mod-fast 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
|
||||||
|
shift-arg tag-bits get SAR
|
||||||
|
! adjust stack pointer
|
||||||
|
ds-reg bootstrap-cell SUB
|
||||||
|
! load value
|
||||||
|
temp3 ds-reg [] MOV
|
||||||
|
! make a copy
|
||||||
|
temp2 temp3 MOV
|
||||||
|
! compute positive shift value in temp2
|
||||||
|
temp2 CL SHL
|
||||||
|
shift-arg NEG
|
||||||
|
! compute negative shift value in temp3
|
||||||
|
temp3 CL SAR
|
||||||
|
temp3 tag-mask get bitnot AND
|
||||||
|
shift-arg 0 CMP
|
||||||
|
! if shift count was negative, move temp0 to temp2
|
||||||
|
temp2 temp3 CMOVGE
|
||||||
|
! push to stack
|
||||||
|
ds-reg [] temp2 MOV
|
||||||
|
] }
|
||||||
|
|
||||||
[
|
! ### Comparisons
|
||||||
temp0 ds-reg [] MOV
|
{ both-fixnums? [
|
||||||
ds-reg bootstrap-cell SUB
|
temp0 ds-reg [] MOV
|
||||||
temp0 ds-reg [] OR
|
ds-reg bootstrap-cell SUB
|
||||||
temp0 tag-mask get TEST
|
temp0 ds-reg [] OR
|
||||||
temp0 \ f type-number MOV
|
temp0 tag-mask get TEST
|
||||||
temp1 1 tag-fixnum MOV
|
temp0 \ f type-number MOV
|
||||||
temp0 temp1 CMOVE
|
temp1 1 tag-fixnum MOV
|
||||||
ds-reg [] temp0 MOV
|
temp0 temp1 CMOVE
|
||||||
] \ both-fixnums? define-sub-primitive
|
ds-reg [] temp0 MOV
|
||||||
|
] }
|
||||||
|
{ eq? [ \ CMOVE jit-compare ] }
|
||||||
|
{ fixnum> [ \ CMOVG jit-compare ] }
|
||||||
|
{ fixnum>= [ \ CMOVGE jit-compare ] }
|
||||||
|
{ fixnum< [ \ CMOVL jit-compare ] }
|
||||||
|
{ fixnum<= [ \ CMOVLE jit-compare ] }
|
||||||
|
|
||||||
[
|
! ### Div/mod
|
||||||
! load local number
|
{ fixnum-mod [
|
||||||
temp0 ds-reg [] MOV
|
jit-fixnum-/mod
|
||||||
! turn local number into offset
|
! adjust stack pointer
|
||||||
fixnum>slot@
|
ds-reg bootstrap-cell SUB
|
||||||
! load local value
|
! push to stack
|
||||||
temp0 rs-reg temp0 [+] MOV
|
ds-reg [] mod-arg MOV
|
||||||
! push to stack
|
] }
|
||||||
ds-reg [] temp0 MOV
|
{ fixnum/i-fast [
|
||||||
] \ get-local 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/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
|
||||||
! load local count
|
{ fixnum*fast [
|
||||||
temp0 ds-reg [] MOV
|
! load second input
|
||||||
! adjust stack pointer
|
temp0 ds-reg [] MOV
|
||||||
ds-reg bootstrap-cell SUB
|
! pop stack
|
||||||
! turn local number into offset
|
ds-reg bootstrap-cell SUB
|
||||||
fixnum>slot@
|
! load first input
|
||||||
! decrement retain stack pointer
|
temp1 ds-reg [] MOV
|
||||||
rs-reg temp0 SUB
|
! untag second input
|
||||||
] \ drop-locals define-sub-primitive
|
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
|
||||||
|
ds-reg bootstrap-cell SUB
|
||||||
|
! turn local number into offset
|
||||||
|
fixnum>slot@
|
||||||
|
! decrement retain stack pointer
|
||||||
|
rs-reg temp0 SUB
|
||||||
|
] }
|
||||||
|
{ 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
|
[ "bootstrap.x86" forget-vocab ] with-compilation-unit
|
||||||
|
|
|
||||||
|
|
@ -126,6 +126,9 @@ SYMBOL: special-objects
|
||||||
: 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 ;
|
||||||
|
|
||||||
|
: define-sub-primitives ( assoc -- )
|
||||||
|
[ swap define-sub-primitive ] assoc-each ;
|
||||||
|
|
||||||
: define-combinator-primitive ( quot non-tail-quot tail-quot word -- )
|
: define-combinator-primitive ( quot non-tail-quot tail-quot word -- )
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue