: 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 } ;
[ 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
]
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
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 ;
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
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
: 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 } ;
[ 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
[ 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
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
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 ( -- )
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
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
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
] 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
! 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
! 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
- 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 ( -- )
! load second parameter
temp1 ds-reg [] MOV
! 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
-
-[
- temp0 ds-reg [] MOV
- ds-reg bootstrap-cell SUB
- temp0 ds-reg [] OR
- temp0 tag-mask get TEST
- temp0 \ f type-number MOV
- temp1 1 tag-fixnum MOV
- temp0 temp1 CMOVE
- ds-reg [] temp0 MOV
-] \ both-fixnums? define-sub-primitive
-
-[
- ! 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
-] \ get-local define-sub-primitive
-
-[
- ! 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
-] \ drop-locals define-sub-primitive
+! # All x86 subprimitives
+{
+ ! ## Fixnums
+
+ ! ### Add
+ { fixnum+fast [ \ ADD jit-math ] }
+
+ ! ### Bit stuff
+ { fixnum-bitand [ \ AND jit-math ] }
+ { fixnum-bitnot [
+ ! complement
+ ds-reg [] NOT
+ ! clear tag bits
+ ds-reg [] tag-mask get XOR
+ ] }
+ { 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
+ { both-fixnums? [
+ temp0 ds-reg [] MOV
+ ds-reg bootstrap-cell SUB
+ temp0 ds-reg [] OR
+ temp0 tag-mask get TEST
+ temp0 \ f type-number MOV
+ temp1 1 tag-fixnum MOV
+ temp0 temp1 CMOVE
+ 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
+ { fixnum-mod [
+ jit-fixnum-/mod
+ ! adjust stack pointer
+ ds-reg bootstrap-cell SUB
+ ! push to stack
+ 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
+ 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
projects / factor.git / commitdiff