1 ! Copyright (C) 2007, 2011 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: bootstrap.image.private compiler.codegen.relocation
4 compiler.constants cpu.x86.assembler cpu.x86.assembler.operands
5 generic.single.private kernel kernel.private layouts locals math
6 math.private namespaces threads.private ;
11 : shift-arg ( -- reg ) RCX ;
12 : div-arg ( -- reg ) RAX ;
13 : mod-arg ( -- reg ) RDX ;
14 : temp0 ( -- reg ) RAX ;
15 : temp1 ( -- reg ) RCX ;
16 : temp2 ( -- reg ) RDX ;
17 : temp3 ( -- reg ) RBX ;
18 : pic-tail-reg ( -- reg ) RBX ;
19 : return-reg ( -- reg ) RAX ;
20 : nv-reg ( -- reg ) RBX ;
21 : stack-reg ( -- reg ) RSP ;
22 : frame-reg ( -- reg ) RBP ;
23 : link-reg ( -- reg ) R11 ;
24 : ctx-reg ( -- reg ) R12 ;
25 : vm-reg ( -- reg ) R13 ;
26 : ds-reg ( -- reg ) R14 ;
27 : rs-reg ( -- reg ) R15 ;
28 : fixnum>slot@ ( -- ) temp0 1 SAR ;
29 : rex-length ( -- n ) 1 ;
31 : jit-call ( name -- )
32 RAX 0 MOV f rc-absolute-cell rel-dlsym
35 :: jit-call-1arg ( arg1s name -- )
39 :: jit-call-2arg ( arg1s arg2s name -- )
45 pic-tail-reg 5 [RIP+] LEA
46 0 JMP f rc-relative rel-word-pic-tail
47 ] JIT-WORD-JUMP jit-define
50 ! no-op on x86-64. in factor contexts vm-reg always contains the
54 : jit-load-context ( -- )
55 ctx-reg vm-reg vm-context-offset [+] MOV ;
57 : jit-save-context ( -- )
59 ! The reason for -8 I think is because we are anticipating a CALL
60 ! instruction. After the call instruction, the contexts frame_top
61 ! will point to the origin jump address.
63 ctx-reg context-callstack-top-offset [+] R11 MOV
64 ctx-reg context-datastack-offset [+] ds-reg MOV
65 ctx-reg context-retainstack-offset [+] rs-reg MOV ;
67 ! ctx-reg must already have been loaded
68 : jit-restore-context ( -- )
69 ds-reg ctx-reg context-datastack-offset [+] MOV
70 rs-reg ctx-reg context-retainstack-offset [+] MOV ;
73 ! ctx-reg is preserved across the call because it is non-volatile
78 RAX 0 MOV f f rc-absolute-cell rel-dlsym
81 ] JIT-PRIMITIVE jit-define
83 : jit-jump-quot ( -- )
84 arg1 quot-entry-point-offset [+] JMP ;
86 : jit-call-quot ( -- ) arg1 quot-entry-point-offset [+] CALL ;
90 vm-reg "begin_callback" jit-call-1arg
96 vm-reg "end_callback" jit-call-1arg
97 ] \ c-to-factor define-sub-primitive
99 : signal-handler-save-regs ( -- regs )
100 { RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 } ;
104 ds-reg bootstrap-cell SUB
108 \ (call) define-combinator-primitive
111 ! Unwind stack frames
114 ! Load VM pointer into vm-reg, since we're entering from
116 vm-reg 0 MOV 0 rc-absolute-cell rel-vm
118 ! Load ds and rs registers
122 ! Clear the fault flag
123 vm-reg vm-fault-flag-offset [+] 0 MOV
127 ] \ unwind-native-frames define-sub-primitive
135 ] \ fpu-state define-sub-primitive
139 RSP [] arg1 16-bit-version-of MOV
142 ] \ set-fpu-state define-sub-primitive
145 ! Load callstack object
147 ds-reg bootstrap-cell SUB
148 ! Get ctx->callstack_bottom
150 arg1 ctx-reg context-callstack-bottom-offset [+] MOV
151 ! Get top of callstack object -- 'src' for memcpy
152 arg2 arg4 callstack-top-offset [+] LEA
153 ! Get callstack length, in bytes --- 'len' for memcpy
154 arg3 arg4 callstack-length-offset [+] MOV
155 arg3 tag-bits get SHR
156 ! Compute new stack pointer -- 'dst' for memcpy
158 ! Install new stack pointer
160 ! Call memcpy; arguments are now in the correct registers
161 ! Create register shadow area for Win64
163 "factor_memcpy" jit-call
164 ! Tear down register shadow area
166 ! Return with new callstack
168 ] \ set-callstack define-sub-primitive
173 "lazy_jit_compile" jit-call
176 [ return-reg quot-entry-point-offset [+] CALL ]
178 \ lazy-jit-compile define-combinator-primitive
181 temp2 0xffffffff MOV f rc-absolute-cell rel-literal
183 ] PIC-CHECK-TUPLE jit-define
185 ! Inline cache miss entry points
186 : jit-load-return-address ( -- )
187 RBX RSP stack-frame-size bootstrap-cell - [+] MOV ;
189 ! These are always in tail position with an existing stack
190 ! frame, and the stack. The frame setup takes this into account.
191 : jit-inline-cache-miss ( -- )
195 RAX 0 MOV rc-absolute-cell rel-inline-cache-miss
198 jit-restore-context ;
200 [ jit-load-return-address jit-inline-cache-miss ]
203 \ inline-cache-miss define-combinator-primitive
205 [ jit-inline-cache-miss ]
208 \ inline-cache-miss-tail define-combinator-primitive
210 ! Overflowing fixnum arithmetic
211 : jit-overflow ( insn func -- )
215 arg2 ds-reg 8 [+] MOV
217 [ [ arg3 arg2 ] dip call ] dip
220 [ arg3 vm-reg MOV jit-call ]
221 jit-conditional ; inline
223 [ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
225 [ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
239 arg1 tag-bits get SAR
242 "overflow_fixnum_multiply" jit-call
245 ] \ fixnum* define-sub-primitive
248 : jit-switch-context ( reg -- )
249 ! Push a bogus return address so the GC can track this frame back
253 ! Make the new context the current one
255 vm-reg vm-context-offset [+] ctx-reg MOV
257 ! Load new stack pointer
258 RSP ctx-reg context-callstack-top-offset [+] MOV
260 ! Load new ds, rs registers
263 ctx-reg jit-update-tib ;
265 : jit-pop-context-and-param ( -- )
267 arg1 arg1 alien-offset [+] MOV
268 arg2 ds-reg -8 [+] MOV
271 : jit-push-param ( -- )
275 : jit-set-context ( -- )
276 jit-pop-context-and-param
278 arg1 jit-switch-context
282 [ jit-set-context ] \ (set-context) define-sub-primitive
284 : jit-pop-quot-and-param ( -- )
286 arg2 ds-reg -8 [+] MOV
289 : jit-start-context ( -- )
290 ! Create the new context in return-reg. Have to save context
291 ! twice, first before calling new_context() which may GC,
292 ! and again after popping the two parameters from the stack.
294 vm-reg "new_context" jit-call-1arg
296 jit-pop-quot-and-param
298 return-reg jit-switch-context
302 [ jit-start-context ] \ (start-context) define-sub-primitive
304 : jit-delete-current-context ( -- )
305 vm-reg "delete_context" jit-call-1arg ;
308 jit-delete-current-context
310 ] \ (set-context-and-delete) define-sub-primitive
312 ! Resets the active context and instead the passed in quotation
313 ! becomes the new code that it executes.
314 : jit-start-context-and-delete ( -- )
315 ! Updates the context to match the values in the data and retain
316 ! stack registers. reset_context can GC.
319 ! Resets the context. The top two ds items are preserved.
320 vm-reg "reset_context" jit-call-1arg
322 ! Switches to the same context I think.
323 ctx-reg jit-switch-context
325 ! Pops the quotation from the stack and puts it in arg1.
329 ! Jump to quotation arg1
333 0 [RIP+] EAX MOV rc-relative rel-safepoint
334 ] JIT-SAFEPOINT jit-define
337 jit-start-context-and-delete
338 ] \ (start-context-and-delete) define-sub-primitive