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 : stack-frame-size ( -- n ) 8 bootstrap-cells ;
12 : shift-arg ( -- reg ) ECX ;
13 : div-arg ( -- reg ) EAX ;
14 : mod-arg ( -- reg ) EDX ;
15 : temp0 ( -- reg ) EAX ;
16 : temp1 ( -- reg ) ECX ;
17 : temp2 ( -- reg ) EBX ;
18 : temp3 ( -- reg ) EDX ;
19 : pic-tail-reg ( -- reg ) EDX ;
20 : stack-reg ( -- reg ) ESP ;
21 : frame-reg ( -- reg ) EBP ;
22 : vm-reg ( -- reg ) EBX ;
23 : ctx-reg ( -- reg ) EBP ;
24 : nv-regs ( -- seq ) { ESI EDI EBX } ;
25 : volatile-regs ( -- seq ) { EAX ECX EDX } ;
26 : nv-reg ( -- reg ) ESI ;
27 : ds-reg ( -- reg ) ESI ;
28 : rs-reg ( -- reg ) EDI ;
29 : link-reg ( -- reg ) EBX ;
30 : fixnum>slot@ ( -- ) temp0 2 SAR ;
31 : rex-length ( -- n ) 0 ;
32 : red-zone-size ( -- n ) 0 ;
34 : jit-call ( name -- )
35 0 CALL f rc-relative rel-dlsym ;
37 :: jit-call-1arg ( arg1s name -- )
41 :: jit-call-2arg ( arg1s arg2s name -- )
46 :: jit-call-3arg ( arg1s arg2s arg3s name -- )
53 pic-tail-reg 0 MOV 0 rc-absolute-cell rel-here
54 0 JMP f rc-relative rel-word-pic-tail
55 ] JIT-WORD-JUMP jit-define
58 vm-reg 0 MOV 0 rc-absolute-cell rel-vm ;
60 : jit-load-context ( -- )
61 ! VM pointer must be in vm-reg already
62 ctx-reg vm-reg vm-context-offset [+] MOV ;
64 : jit-save-context ( -- )
67 ctx-reg context-callstack-top-offset [+] ECX MOV
68 ctx-reg context-datastack-offset [+] ds-reg MOV
69 ctx-reg context-retainstack-offset [+] rs-reg MOV ;
71 : jit-restore-context ( -- )
72 ds-reg ctx-reg context-datastack-offset [+] MOV
73 rs-reg ctx-reg context-retainstack-offset [+] MOV ;
76 ! ctx-reg is preserved across the call because it is
77 ! non-volatile in the C ABI
82 0 CALL f f rc-relative rel-dlsym
84 ] JIT-PRIMITIVE jit-define
86 : jit-jump-quot ( -- )
87 EAX quot-entry-point-offset [+] JMP ;
89 : jit-call-quot ( -- )
90 EAX quot-entry-point-offset [+] CALL ;
92 : signal-handler-save-regs ( -- regs )
93 { EAX EBX ECX EDX EBP EDI ESI } ;
97 ds-reg bootstrap-cell SUB
101 \ (call) define-combinator-primitive
107 ! Call VM, quotation reference is in EAX
108 EAX vm-reg "lazy_jit_compile" jit-call-2arg
112 \ lazy-jit-compile define-combinator-primitive
115 temp1 0xffffffff CMP f rc-absolute-cell rel-literal
116 ] PIC-CHECK-TUPLE jit-define
118 ! Inline cache miss entry points
119 : jit-load-return-address ( -- )
120 pic-tail-reg ESP stack-frame-size bootstrap-cell - [+] MOV ;
122 ! These are always in tail position with an existing stack
123 ! frame, and the stack. The frame setup takes this into account.
124 : jit-inline-cache-miss ( -- )
128 ESP [] pic-tail-reg MOV
129 0 CALL rc-relative rel-inline-cache-miss
130 jit-restore-context ;
132 [ jit-load-return-address jit-inline-cache-miss ]
135 \ inline-cache-miss define-combinator-primitive
137 [ jit-inline-cache-miss ]
140 \ inline-cache-miss-tail define-combinator-primitive
142 ! Overflowing fixnum arithmetic
143 : jit-overflow ( insn func -- )
150 [ [ EBX EDX ] dip call( dst src -- ) ] dip
163 : jit-switch-context ( reg -- )
164 ! Push a bogus return address so the GC can track this frame back
168 ! Make the new context the current one
170 vm-reg vm-context-offset [+] ctx-reg MOV
172 ! Load new stack pointer
173 ESP ctx-reg context-callstack-top-offset [+] MOV
175 ! Windows-specific setup
176 ctx-reg jit-update-tib
178 ! Load new ds, rs registers
179 jit-restore-context ;
181 : jit-set-context ( -- )
182 ! Load context and parameter from datastack
184 EAX EAX alien-offset [+] MOV
185 EDX ds-reg -4 [+] MOV
188 ! Save ds, rs registers
192 ! Make the new context active
193 EAX jit-switch-context
195 ! Windows-specific setup
196 ctx-reg jit-update-seh
198 ! Twiddle stack for return
201 ! Store parameter to datastack
205 : jit-save-quot-and-param ( -- )
209 : jit-push-param ( -- )
214 : jit-start-context ( -- )
215 ! Create the new context in return-reg
218 vm-reg "new_context" jit-call-1arg
220 jit-save-quot-and-param
222 ! Make the new context active
225 EAX jit-switch-context
229 ! Windows-specific setup
232 ! Push a fake return address
235 ! Jump to initial quotation
239 : jit-delete-current-context ( -- )
242 vm-reg "delete_context" jit-call-1arg ;
244 : jit-start-context-and-delete ( -- )
247 ! Updates the context to match the values in the data and retain
248 ! stack registers. reset_context can GC.
251 ! Resets the context. The top two ds item are preserved.
252 vm-reg "reset_context" jit-call-1arg
254 ! Switches to the same context I think, uses ctx-reg
255 ctx-reg jit-switch-context
257 ! Pops the quotation from the stack and puts it in EAX.
261 ! Jump to the quotation in EAX.
265 0 EAX MOVABS rc-absolute rel-safepoint
266 ] JIT-SAFEPOINT jit-define
268 ! # All x86.32 subprimitives
271 { (set-context) [ jit-set-context ] }
272 { (set-context-and-delete) [
273 jit-delete-current-context
276 { (start-context) [ jit-start-context ] }
277 { (start-context-and-delete) [ jit-start-context-and-delete ] }
283 vm-reg EAX "begin_callback" jit-call-2arg
288 vm-reg "end_callback" jit-call-1arg
290 { unwind-native-frames [
291 ! unwind-native-frames is marked as "special" in
292 ! vm/quotations.cpp so it does not have a standard prolog Load
293 ! ds and rs registers
298 ! clear the fault flag
299 vm-reg vm-fault-flag-offset [+] 0 MOV
301 ! Windows-specific setup
302 ctx-reg jit-update-seh
305 EAX ESP bootstrap-cell [+] MOV
306 EDX ESP 2 bootstrap-cells [+] MOV
308 ! Unwind stack frames
315 { fixnum+ [ [ ADD ] "overflow_fixnum_add" jit-overflow ] }
316 { fixnum- [ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] }
331 ECX EBP vm-reg "overflow_fixnum_multiply" jit-call-3arg
345 ESP stack-frame-size [+] FLDCW
348 ! Load callstack object
350 ds-reg bootstrap-cell SUB
351 ! Get ctx->callstack_bottom
354 temp0 ctx-reg context-callstack-bottom-offset [+] MOV
355 ! Get top of callstack object -- 'src' for memcpy
356 temp1 temp3 callstack-top-offset [+] LEA
357 ! Get callstack length, in bytes --- 'len' for memcpy
358 temp2 temp3 callstack-length-offset [+] MOV
359 temp2 tag-bits get SHR
360 ! Compute new stack pointer -- 'dst' for memcpy
362 ! Install new stack pointer
368 "factor_memcpy" jit-call
370 ! Return with new callstack
373 } define-sub-primitives