-! Copyright (C) 2007, 2010 Slava Pestov.
+! Copyright (C) 2007, 2011 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel kernel.private namespaces
-system layouts vocabs parser compiler.constants math
-math.private cpu.x86.assembler cpu.x86.assembler.operands
-sequences generic.single.private ;
+system layouts vocabs parser compiler.constants
+compiler.codegen.relocation math math.private cpu.x86.assembler
+cpu.x86.assembler.operands sequences generic.single.private
+threads.private locals ;
IN: bootstrap.x86
8 \ cell set
: shift-arg ( -- reg ) RCX ;
: div-arg ( -- reg ) RAX ;
: mod-arg ( -- reg ) RDX ;
-: temp0 ( -- reg ) RDI ;
-: temp1 ( -- reg ) RSI ;
+: temp0 ( -- reg ) RAX ;
+: temp1 ( -- reg ) RCX ;
: temp2 ( -- reg ) RDX ;
: temp3 ( -- reg ) RBX ;
+: pic-tail-reg ( -- reg ) RBX ;
: return-reg ( -- reg ) RAX ;
-: safe-reg ( -- reg ) RAX ;
+: nv-reg ( -- reg ) RBX ;
: stack-reg ( -- reg ) RSP ;
: frame-reg ( -- reg ) RBP ;
+: link-reg ( -- reg ) R11 ;
: ctx-reg ( -- reg ) R12 ;
: vm-reg ( -- reg ) R13 ;
: ds-reg ( -- reg ) R14 ;
: fixnum>slot@ ( -- ) temp0 1 SAR ;
: rex-length ( -- n ) 1 ;
+: jit-call ( name -- )
+ RAX 0 MOV f rc-absolute-cell rel-dlsym
+ RAX CALL ;
+
[
! load entry point
- safe-reg 0 MOV rc-absolute-cell rt-this jit-rel
- ! save stack frame size
- stack-frame-size PUSH
- ! push entry point
- safe-reg PUSH
+ RAX 0 MOV rc-absolute-cell rel-this
! alignment
- RSP stack-frame-size 3 bootstrap-cells - SUB
+ RSP stack-frame-size bootstrap-cell - SUB
+ ! store entry point
+ RSP stack-frame-size 3 bootstrap-cells - [+] RAX MOV
+ ! store stack frame size
+ RSP stack-frame-size 2 bootstrap-cells - [+] stack-frame-size MOV
] jit-prolog jit-define
+[
+ pic-tail-reg 5 [RIP+] LEA
+ 0 JMP f rc-relative rel-word-pic-tail
+] jit-word-jump jit-define
+
: jit-load-context ( -- )
ctx-reg vm-reg vm-context-offset [+] MOV ;
: jit-save-context ( -- )
jit-load-context
- safe-reg RSP -8 [+] LEA
- ctx-reg context-callstack-top-offset [+] safe-reg MOV
+ R11 RSP -8 [+] LEA
+ ctx-reg context-callstack-top-offset [+] R11 MOV
ctx-reg context-datastack-offset [+] ds-reg MOV
ctx-reg context-retainstack-offset [+] rs-reg MOV ;
: jit-restore-context ( -- )
- jit-load-context
ds-reg ctx-reg context-datastack-offset [+] MOV
rs-reg ctx-reg context-retainstack-offset [+] MOV ;
[
+ ! ctx-reg is preserved across the call because it is non-volatile
+ ! in the C ABI
jit-save-context
! call the primitive
arg1 vm-reg MOV
- RAX 0 MOV rc-absolute-cell rt-dlsym jit-rel
+ RAX 0 MOV f f rc-absolute-cell rel-dlsym
RAX CALL
jit-restore-context
] jit-primitive jit-define
+: jit-jump-quot ( -- ) arg1 quot-entry-point-offset [+] JMP ;
+
+: jit-call-quot ( -- ) arg1 quot-entry-point-offset [+] CALL ;
+
[
- jit-restore-context
- ! save ctx->callstack_bottom
- safe-reg stack-reg stack-frame-size 8 - [+] LEA
- ctx-reg context-callstack-bottom-offset [+] safe-reg MOV
+ arg2 arg1 MOV
+ arg1 vm-reg MOV
+ "begin_callback" jit-call
+
! call the quotation
- arg1 quot-entry-point-offset [+] CALL
- jit-save-context
+ arg1 return-reg MOV
+ jit-call-quot
+
+ arg1 vm-reg MOV
+ "end_callback" jit-call
] \ 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-signal-handler-prolog ( -- frame-size )
+ signal-handler-save-regs :> save-regs
+ save-regs length 1 + bootstrap-cells 16 align stack-frame-size + :> frame-size
+ ! minus a cell each for flags, return address
+ ! use LEA so we don't dirty flags
+ RSP RSP frame-size 2 bootstrap-cells - neg [+] LEA
+ save-regs [| r i | RSP i bootstrap-cells [+] r MOV ] each-index
+ PUSHF
+ ! Now that the registers are saved, we can make the stack frame
+ RAX 0 MOV rc-absolute-cell rel-this
+ RSP frame-size 3 bootstrap-cells - [+] RAX MOV
+ RSP frame-size 2 bootstrap-cells - [+] frame-size MOV
+ frame-size ;
+
+:: jit-signal-handler-epilog ( frame-size -- )
+ POPF
+ signal-handler-save-regs
+ [| r i | r RSP i bootstrap-cells [+] MOV ] each-index
+ RSP RSP frame-size 2 bootstrap-cells - [+] LEA ;
+
[
arg1 ds-reg [] MOV
ds-reg bootstrap-cell SUB
]
-[ arg1 quot-entry-point-offset [+] CALL ]
-[ arg1 quot-entry-point-offset [+] JMP ]
+[ jit-call-quot ]
+[ jit-jump-quot ]
\ (call) define-combinator-primitive
[
- ! Clear x87 stack, but preserve rounding mode and exception flags
- RSP 2 SUB
- RSP [] FNSTCW
- FNINIT
- RSP [] FLDCW
-
! 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 jit-vm
+ 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
- arg1 quot-entry-point-offset [+] JMP
+ 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
! Call memcpy; arguments are now in the correct registers
! Create register shadow area for Win64
RSP 32 SUB
- safe-reg 0 MOV "factor_memcpy" f rc-absolute-cell jit-dlsym
- safe-reg CALL
+ "factor_memcpy" jit-call
! Tear down register shadow area
RSP 32 ADD
! Return with new callstack
[
jit-save-context
arg2 vm-reg MOV
- safe-reg 0 MOV "lazy_jit_compile" f rc-absolute-cell jit-dlsym
- safe-reg CALL
+ "lazy_jit_compile" jit-call
+ arg1 return-reg MOV
]
[ return-reg quot-entry-point-offset [+] CALL ]
-[ return-reg quot-entry-point-offset [+] JMP ]
+[ jit-jump-quot ]
\ lazy-jit-compile define-combinator-primitive
+[
+ temp2 0xffffffff MOV f rc-absolute-cell rel-literal
+ temp1 temp2 CMP
+] pic-check-tuple jit-define
+
! Inline cache miss entry points
: jit-load-return-address ( -- )
RBX RSP stack-frame-size bootstrap-cell - [+] MOV ;
jit-save-context
arg1 RBX MOV
arg2 vm-reg MOV
- RAX 0 MOV "inline_cache_miss" f rc-absolute-cell jit-dlsym
+ RAX 0 MOV rc-absolute-cell rel-inline-cache-miss
RAX CALL
+ jit-load-context
jit-restore-context ;
[ jit-load-return-address jit-inline-cache-miss ]
[ [ arg3 arg2 ] dip call ] dip
ds-reg [] arg3 MOV
[ JNO ]
- [
- arg3 vm-reg MOV
- RAX 0 MOV f rc-absolute-cell jit-dlsym
- RAX CALL
- ]
+ [ arg3 vm-reg MOV jit-call ]
jit-conditional ; inline
[ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
arg1 tag-bits get SAR
arg2 RBX MOV
arg3 vm-reg MOV
- RAX 0 MOV "overflow_fixnum_multiply" f rc-absolute-cell jit-dlsym
- RAX CALL
+ "overflow_fixnum_multiply" jit-call
]
jit-conditional
] \ fixnum* define-sub-primitive
-<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >>
-call
+! Contexts
+: jit-switch-context ( reg -- )
+ ! Reset return value since its bogus right now, to avoid
+ ! confusing the GC
+ RSP -8 [+] 0 MOV
+
+ ! Make the new context the current one
+ ctx-reg swap MOV
+ vm-reg vm-context-offset [+] ctx-reg MOV
+
+ ! Load new stack pointer
+ RSP ctx-reg context-callstack-top-offset [+] MOV
+
+ ! Load new ds, rs registers
+ jit-restore-context
+
+ ctx-reg jit-update-tib ;
+
+: jit-pop-context-and-param ( -- )
+ arg1 ds-reg [] MOV
+ arg1 arg1 alien-offset [+] MOV
+ arg2 ds-reg -8 [+] MOV
+ ds-reg 16 SUB ;
+
+: jit-push-param ( -- )
+ ds-reg 8 ADD
+ ds-reg [] arg2 MOV ;
+
+: jit-set-context ( -- )
+ jit-pop-context-and-param
+ jit-save-context
+ arg1 jit-switch-context
+ 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
+ ds-reg 16 SUB ;
+
+: jit-start-context ( -- )
+ ! Create the new context in return-reg. Have to save context
+ ! twice, first before calling new_context() which may GC,
+ ! and again after popping the two parameters from the stack.
+ jit-save-context
+ arg1 vm-reg MOV
+ "new_context" jit-call
+
+ jit-pop-quot-and-param
+ jit-save-context
+ return-reg jit-switch-context
+ jit-push-param
+ jit-jump-quot ;
+
+[ jit-start-context ] \ (start-context) define-sub-primitive
+
+: jit-delete-current-context ( -- )
+ jit-load-context
+ arg1 vm-reg MOV
+ arg2 ctx-reg MOV
+ "delete_context" jit-call ;
+
+[
+ jit-delete-current-context
+ jit-set-context
+] \ (set-context-and-delete) define-sub-primitive
+
+: jit-start-context-and-delete ( -- )
+ jit-load-context
+ arg1 vm-reg MOV
+ arg2 ctx-reg MOV
+ "reset_context" jit-call
+
+ jit-pop-quot-and-param
+ ctx-reg jit-switch-context
+ jit-push-param
+ jit-jump-quot ;
+
+[
+ 0 [RIP+] EAX MOV rc-relative rel-safepoint
+] \ jit-safepoint jit-define
+
+[
+ jit-start-context-and-delete
+] \ (start-context-and-delete) define-sub-primitive
projects / factor.git / blobdiff