! Copyright (C) 2007, 2011 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: bootstrap.image.private kernel kernel.private namespaces
-system cpu.x86.assembler cpu.x86.assembler.operands layouts
-vocabs parser compiler.constants compiler.codegen.relocation
-sequences math math.private generic.single.private
-threads.private locals ;
+USING: bootstrap.image.private compiler.codegen.relocation
+compiler.constants cpu.x86.assembler cpu.x86.assembler.operands
+generic.single.private kernel kernel.private layouts math
+math.private namespaces threads.private ;
IN: bootstrap.x86
4 \ cell set
-: leaf-stack-frame-size ( -- n ) 4 bootstrap-cells ;
-: signal-handler-stack-frame-size ( -- n ) 12 bootstrap-cells ;
: stack-frame-size ( -- n ) 8 bootstrap-cells ;
: shift-arg ( -- reg ) ECX ;
: div-arg ( -- reg ) EAX ;
[
pic-tail-reg 0 MOV 0 rc-absolute-cell rel-here
0 JMP f rc-relative rel-word-pic-tail
-] jit-word-jump jit-define
+] JIT-WORD-JUMP jit-define
: jit-load-vm ( -- )
vm-reg 0 MOV 0 rc-absolute-cell rel-vm ;
ESP [] vm-reg MOV
0 CALL f f rc-relative rel-dlsym
jit-restore-context
-] jit-primitive jit-define
+] JIT-PRIMITIVE jit-define
: jit-jump-quot ( -- )
EAX quot-entry-point-offset [+] JMP ;
: 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 ECX EDX EBX EBP ESI EDI } ;
+ { EAX EBX ECX EDX EBP EDI ESI } ;
[
EAX ds-reg [] MOV
[ 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
[
temp1 0xffffffff CMP f rc-absolute-cell rel-literal
-] pic-check-tuple jit-define
+] PIC-CHECK-TUPLE jit-define
! Inline cache miss entry points
: jit-load-return-address ( -- )
]
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
- EBX ds-reg [] MOV
- EAX EBX MOV
- EBP ds-reg 4 [+] MOV
- EBP tag-bits get SAR
- EBP IMUL
- ds-reg [] EAX MOV
- [ JNO ]
- [
- EBX tag-bits get SAR
- jit-load-vm
-
- EBX 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
- jit-load-context
+
+ ! Updates the context to match the values in the data and retain
+ ! stack registers. reset_context can GC.
+ jit-save-context
+
+ ! Resets the context. The top two ds item are preserved.
vm-reg "reset_context" jit-call-1arg
- jit-save-quot-and-param
+ ! Switches to the same context I think, uses ctx-reg
ctx-reg jit-switch-context
- jit-push-param
- EAX EDX [] MOV
+ ! Pops the quotation from the stack and puts it in EAX.
+ EAX ds-reg [] MOV
+ ds-reg 4 SUB
+
+ ! Jump to the quotation in EAX.
jit-jump-quot ;
[
0 EAX MOVABS rc-absolute rel-safepoint
-] \ jit-safepoint jit-define
+] JIT-SAFEPOINT jit-define
+
+! # 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-start-context-and-delete
-] \ (start-context-and-delete) define-sub-primitive
+ 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
projects / factor.git / blobdiff