1.0.27.14: bias x86oid frame pointer
[sbcl.git] / src / assembly / x86 / assem-rtns.lisp
1 ;;;; the machine specific support routines needed by the file assembler
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
11
12 (in-package "SB!VM")
13 \f
14 ;;;; RETURN-MULTIPLE
15
16 ;;; For RETURN-MULTIPLE, we have to move the results from the end of
17 ;;; the frame for the function that is returning to the end of the
18 ;;; frame for the function being returned to.
19
20 #+sb-assembling ;; We don't want a vop for this one.
21 (define-assembly-routine
22     (return-multiple (:return-style :none))
23     (;; These are really arguments.
24      (:temp ecx unsigned-reg ecx-offset)
25      (:temp esi unsigned-reg esi-offset)
26
27      ;; These we need as temporaries.
28      (:temp eax unsigned-reg eax-offset)
29      (:temp ebx unsigned-reg ebx-offset)
30      (:temp edx unsigned-reg edx-offset)
31      (:temp edi unsigned-reg edi-offset))
32
33   ;; Pick off the cases where everything fits in register args.
34   (inst jecxz ZERO-VALUES)
35   (inst cmp ecx (fixnumize 1))
36   (inst jmp :e ONE-VALUE)
37   (inst cmp ecx (fixnumize 2))
38   (inst jmp :e TWO-VALUES)
39   (inst cmp ecx (fixnumize 3))
40   (inst jmp :e THREE-VALUES)
41
42   ;; As per the calling convention EBX is expected to point at the SP
43   ;; before the stack frame.
44   (inst lea ebx (make-ea :dword :base ebp-tn
45                          :disp (* sp->fp-offset n-word-bytes)))
46
47   ;; Save the count, the return address and restore the frame pointer,
48   ;; because the loop is going to destroy them.
49   (inst mov edx ecx)
50   (inst mov eax (make-ea :dword :base ebp-tn
51                          :disp (frame-byte-offset return-pc-save-offset)))
52   (inst mov ebp-tn (make-ea :dword :base ebp-tn
53                             :disp (frame-byte-offset ocfp-save-offset)))
54   ;; Blit the values down the stack. Note: there might be overlap, so
55   ;; we have to be careful not to clobber values before we've read
56   ;; them. Because the stack builds down, we are copying to a larger
57   ;; address. Therefore, we need to iterate from larger addresses to
58   ;; smaller addresses. pfw-this says copy ecx words from esi to edi
59   ;; counting down.
60   (inst shr ecx (1- n-lowtag-bits))
61   (inst std)                            ; count down
62   (inst sub esi n-word-bytes)
63   (inst lea edi (make-ea :dword :base ebx :disp (- n-word-bytes)))
64   (inst rep)
65   (inst movs :dword)
66   (inst cld)
67
68   ;; Restore the count.
69   (inst mov ecx edx)
70
71   ;; Set the stack top to the last result.
72   (inst lea esp-tn (make-ea :dword :base edi :disp n-word-bytes))
73
74   ;; Load the register args.
75   (loadw edx ebx -1)
76   (loadw edi ebx -2)
77   (loadw esi ebx -3)
78
79   ;; And back we go.
80   (inst stc)
81   (inst push eax)
82   (inst ret)
83
84   ;; Handle the register arg cases.
85   ZERO-VALUES
86   (inst lea ebx (make-ea :dword :base ebp-tn
87                          :disp (* sp->fp-offset n-word-bytes)))
88   (inst mov edx nil-value)
89   (inst mov edi edx)
90   (inst mov esi edx)
91   (inst mov esp-tn ebp-tn)
92   (inst stc)
93   (inst pop ebp-tn)
94   (inst ret)
95
96   ;; Note: we can get this, because the return-multiple vop doesn't
97   ;; check for this case when size > speed.
98   ONE-VALUE
99   (loadw edx esi -1)
100   (inst mov esp-tn ebp-tn)
101   (inst clc)
102   (inst pop ebp-tn)
103   (inst ret)
104
105   TWO-VALUES
106   (inst lea ebx (make-ea :dword :base ebp-tn
107                          :disp (* sp->fp-offset n-word-bytes)))
108   (loadw edx esi -1)
109   (loadw edi esi -2)
110   (inst mov esi nil-value)
111   (inst mov esp-tn ebp-tn)
112   (inst stc)
113   (inst pop ebp-tn)
114   (inst ret)
115
116   THREE-VALUES
117   (inst lea ebx (make-ea :dword :base ebp-tn
118                          :disp (* sp->fp-offset n-word-bytes)))
119   (loadw edx esi -1)
120   (loadw edi esi -2)
121   (loadw esi esi -3)
122   (inst mov esp-tn ebp-tn)
123   (inst stc)
124   (inst pop ebp-tn)
125   (inst ret))
126 \f
127 ;;;; TAIL-CALL-VARIABLE
128
129 ;;; For tail-call-variable, we have to copy the arguments from the end
130 ;;; of our stack frame (were args are produced) to the start of our
131 ;;; stack frame (were args are expected).
132 ;;;
133 ;;; We take the function to call in EAX and a pointer to the arguments in
134 ;;; ESI. EBP says the same over the jump, and the old frame pointer is
135 ;;; still saved in the first stack slot. The return-pc is saved in
136 ;;; the second stack slot, so we have to push it to make it look like
137 ;;; we actually called. We also have to compute ECX from the difference
138 ;;; between ESI and the stack top.
139 #+sb-assembling ;; No vop for this one either.
140 (define-assembly-routine
141     (tail-call-variable
142      (:return-style :none))
143
144     ((:temp eax unsigned-reg eax-offset)
145      (:temp ebx unsigned-reg ebx-offset)
146      (:temp ecx unsigned-reg ecx-offset)
147      (:temp edx unsigned-reg edx-offset)
148      (:temp edi unsigned-reg edi-offset)
149      (:temp esi unsigned-reg esi-offset))
150
151   ;; Calculate NARGS (as a fixnum)
152   (move ecx esi)
153   (inst sub ecx esp-tn)
154
155   ;; Check for all the args fitting the registers.
156   (inst cmp ecx (fixnumize 3))
157   (inst jmp :le REGISTER-ARGS)
158
159   ;; Save the OLD-FP and RETURN-PC because the blit is going to trash
160   ;; those stack locations. Save the ECX, because the loop is going to
161   ;; trash it.
162   (pushw ebp-tn (frame-word-offset ocfp-save-offset))
163   (loadw ebx ebp-tn (frame-word-offset return-pc-save-offset))
164   (inst push ecx)
165
166   ;; Do the blit. Because we are coping from smaller addresses to
167   ;; larger addresses, we have to start at the largest pair and work
168   ;; our way down.
169   (inst shr ecx (1- n-lowtag-bits))
170   (inst std)                            ; count down
171   (inst lea edi (make-ea :dword :base ebp-tn :disp (frame-byte-offset 0)))
172   (inst sub esi (fixnumize 1))
173   (inst rep)
174   (inst movs :dword)
175   (inst cld)
176
177   ;; Load the register arguments carefully.
178   (loadw edx ebp-tn (frame-word-offset ocfp-save-offset))
179
180   ;; Restore OLD-FP and ECX.
181   (inst pop ecx)
182   ;; Overwrites a1
183   (popw ebp-tn (frame-word-offset ocfp-save-offset))
184
185   ;; Blow off the stack above the arguments.
186   (inst lea esp-tn (make-ea :dword :base edi :disp n-word-bytes))
187
188   ;; remaining register args
189   (inst mov edi edx)
190   (loadw edx ebp-tn (frame-word-offset 0))
191   (loadw esi ebp-tn (frame-word-offset 2))
192
193   ;; Push the (saved) return-pc so it looks like we just called.
194   (inst push ebx)
195
196   ;; And jump into the function.
197   (inst jmp (make-ea-for-object-slot eax closure-fun-slot fun-pointer-lowtag))
198
199   ;; All the arguments fit in registers, so load them.
200   REGISTER-ARGS
201   (loadw edx esi -1)
202   (loadw edi esi -2)
203   (loadw esi esi -3)
204
205   ;; Clear most of the stack.
206   (inst lea esp-tn
207         (make-ea :dword :base ebp-tn :disp (* (- sp->fp-offset 3) n-word-bytes)))
208
209   ;; Push the return-pc so it looks like we just called.
210   (pushw ebp-tn (frame-word-offset return-pc-save-offset))
211
212   ;; And away we go.
213   (inst jmp (make-ea-for-object-slot eax closure-fun-slot fun-pointer-lowtag)))
214 \f
215 (define-assembly-routine (throw
216                           (:return-style :none))
217                          ((:arg target (descriptor-reg any-reg) edx-offset)
218                           (:arg start any-reg ebx-offset)
219                           (:arg count any-reg ecx-offset)
220                           (:temp catch any-reg eax-offset))
221
222   (declare (ignore start count))
223
224   (load-tl-symbol-value catch *current-catch-block*)
225
226   LOOP
227
228   (let ((error (generate-error-code nil 'unseen-throw-tag-error target)))
229     (inst or catch catch)               ; check for NULL pointer
230     (inst jmp :z error))
231
232   (inst cmp target (make-ea-for-object-slot catch catch-block-tag-slot 0))
233   (inst jmp :e EXIT)
234
235   (loadw catch catch catch-block-previous-catch-slot)
236   (inst jmp LOOP)
237
238   EXIT
239
240   ;; Here EAX points to catch block containing symbol pointed to by EDX.
241   (inst jmp (make-fixup 'unwind :assembly-routine)))
242
243 ;;;; non-local exit noise
244
245 #!-win32
246 (define-assembly-routine (unwind
247                           (:return-style :none)
248                           (:translate %continue-unwind)
249                           (:policy :fast-safe))
250                          ((:arg block (any-reg descriptor-reg) eax-offset)
251                           (:arg start (any-reg descriptor-reg) ebx-offset)
252                           (:arg count (any-reg descriptor-reg) ecx-offset)
253                           (:temp uwp unsigned-reg esi-offset))
254   (declare (ignore start count))
255
256   (let ((error (generate-error-code nil 'invalid-unwind-error)))
257     (inst or block block)               ; check for NULL pointer
258     (inst jmp :z error))
259
260   (load-tl-symbol-value uwp *current-unwind-protect-block*)
261
262   ;; Does *CURRENT-UNWIND-PROTECT-BLOCK* match the value stored in
263   ;; argument's CURRENT-UWP-SLOT?
264   (inst cmp uwp
265         (make-ea-for-object-slot block unwind-block-current-uwp-slot 0))
266   ;; If a match, return to context in arg block.
267   (inst jmp :e DO-EXIT)
268
269   ;; Not a match - return to *CURRENT-UNWIND-PROTECT-BLOCK* context.
270   ;; Important! Must save (and return) the arg 'block' for later use!!
271   (move edx-tn block)
272   (move block uwp)
273   ;; Set next unwind protect context.
274   (loadw uwp uwp unwind-block-current-uwp-slot)
275   ;; we're about to reload ebp anyway, so let's borrow it here as a
276   ;; temporary.  Hope this works
277   (store-tl-symbol-value uwp *current-unwind-protect-block* ebp-tn)
278
279   DO-EXIT
280
281   (loadw ebp-tn block unwind-block-current-cont-slot)
282
283   ;; Uwp-entry expects some things in known locations so that they can
284   ;; be saved on the stack: the block in edx-tn, start in ebx-tn, and
285   ;; count in ecx-tn.
286
287   (inst jmp (make-ea-for-object-slot block unwind-block-entry-pc-slot 0)))
288
289
290 ;;;; Win32 non-local exit noise
291
292 #!+win32
293 (define-assembly-routine (unwind
294                           (:return-style :none)
295                           (:policy :fast-safe))
296                          ((:arg block (any-reg descriptor-reg) eax-offset)
297                           (:arg start (any-reg descriptor-reg) ebx-offset)
298                           (:arg count (any-reg descriptor-reg) ecx-offset))
299   (declare (ignore start count))
300
301   (let ((error (generate-error-code nil 'invalid-unwind-error)))
302     (inst or block block)               ; check for NULL pointer
303     (inst jmp :z error))
304
305   ;; Save all our registers, as we're about to clobber them.
306   (inst pusha)
307
308   ;; Find the SEH frame surrounding our target.
309   (loadw ecx-tn block unwind-block-next-seh-frame-slot)
310
311   ;; This section copied from VOP CALL-OUT.
312   ;; Setup the NPX for C; all the FP registers need to be
313   ;; empty; pop them all.
314   (dotimes (i 8)
315     (inst fstp fr0-tn))
316
317   ;; I'm unlikely to ever forget this again.
318   (inst cld)
319
320   ;; Set up a bogus stack frame for RtlUnwind to pick its return
321   ;; address from.  (Yes, this is how RtlUnwind works.)
322   (inst push (make-fixup 'win32-unwind-tail :assembly-routine))
323   (inst push ebp-tn)
324   (inst mov ebp-tn esp-tn)
325
326   ;; Actually call out for the unwind.
327   (inst push 0)
328   (inst push 0)
329   (inst push 0)
330   (inst push ecx-tn)
331   (inst call (make-fixup "RtlUnwind@16" :foreign)))
332
333 ;; We want no VOP for this one and for it to only happen on Win32
334 ;; targets.  Hence the following disaster.
335 #!+#.(cl:if (cl:member sb-assembling cl:*features*) win32 '(or))
336 (define-assembly-routine
337     (win32-unwind-tail (:return-style :none))
338     ((:temp block unsigned-reg eax-offset))
339
340   ;; The unwind returns here.  Had to use a VOP for this because
341   ;; PUSH won't accept a label as an argument.
342
343   ;; Clean up the bogus stack frame we pushed for the unwind.
344   (inst pop ebp-tn)
345   (inst pop esi-tn) ;; Random scratch register.
346
347   ;; This section based on VOP CALL-OUT.
348   ;; Restore the NPX for lisp; ensure no regs are empty
349   (dotimes (i 8)
350     (inst fldz))
351
352   ;; Restore our regs.
353   (inst popa)
354
355   ;; By now we've unwound all the UWP frames required, so we
356   ;; just jump to our target block.
357   (loadw ebp-tn block unwind-block-current-cont-slot)
358
359   ;; Nlx-entry expects the arg start in ebx-tn and the arg count
360   ;; in ecx-tn.  Fortunately, that's where they are already.
361   (inst jmp (make-ea-for-object-slot block unwind-block-entry-pc-slot 0)))
362
363
364 ;;;; Win32 UWP block SEH interface.
365
366 ;; We want no VOP for this one and for it to only happen on Win32
367 ;; targets.  Hence the following disaster.
368 #!+#.(cl:if (cl:member sb-assembling cl:*features*) win32 '(or))
369 (define-assembly-routine
370     (uwp-seh-handler (:return-style :none))
371     ((:temp block unsigned-reg eax-offset))
372
373   ;; We get called for any exception which happens within our
374   ;; dynamic contour that isn't handled below us, and for
375   ;; unwinding.
376
377   ;; For the exceptions we just return ExceptionContinueSearch.
378
379   ;; Find the exception record.
380   (inst mov eax-tn (make-ea :dword :base esp-tn :disp 4))
381
382   ;; Check unwind flags.
383   (inst test (make-ea :byte :base eax-tn :disp 4) 6) ; EH_UNWINDING | EH_EXIT_UNWIND
384
385   ;; To see if we're unwinding or not.
386   (inst jmp :nz UNWINDING)
387
388   ;; We're not unwinding, so we're not interested.
389   (inst mov eax-tn 1) ;; exception-continue-search
390   (inst ret)
391
392   ;; For the unwinds we establish a basic environment as per
393   ;; call_into_lisp, but without the extra SEH frame (the theory
394   ;; being that we're already in a Lisp SEH context), and invoke
395   ;; our UWP block to unwind itself.
396
397   ;; FIXME: Do we need to establish an SEH frame anyway?  And do
398   ;; we need to do the same stack frame hackery for the debugger
399   ;; as we do for the main exception handler?
400
401   ;; When the UWP block calls %continue-unwind, we come back to
402   ;; the next assembly routine, below, which reinitializes for C
403   ;; and returns to the Win32 unwind machinery.
404
405   ;; If the UWP block sees fit to do a non-local exit, things
406   ;; Just Work, thanks to the Win32 API being sanely designed
407   ;; and our complying with it.
408
409   ;; We also must update *current-unwind-protect-block* before
410   ;; calling the cleanup function.
411
412   UNWINDING
413
414   ;; Save all registers (overkill)
415   (inst pusha)
416
417   ;; Establish our stack frame.
418   (inst mov ebp-tn esp-tn)
419
420   ;; This section based on VOP CALL-OUT.
421   ;; Restore the NPX for lisp; ensure no regs are empty
422   (dotimes (i 8)
423     (inst fldz))
424
425   ;; Find our unwind-block by way of our SEH frame.
426   (inst mov block (make-ea :dword :base ebp-tn :disp #x28))
427   (inst lea block (make-ea :dword :base block
428                            :disp (- (* unwind-block-next-seh-frame-slot
429                                        n-word-bytes))))
430
431   ;; Update *CURRENT-UNWIND-PROTECT-BLOCK*.
432   (loadw ebx-tn block unwind-block-current-uwp-slot)
433   (store-tl-symbol-value ebx-tn *current-unwind-protect-block* ecx-tn)
434
435   ;; Uwp-entry expects some things in known locations so that they can
436   ;; be saved on the stack: the block in edx-tn, start in ebx-tn, and
437   ;; count in ecx-tn.  We don't actually have any of that here, but we
438   ;; do need to have access to our own stack frame, so we hijack the
439   ;; known locations to cover our own state.
440
441   (inst xor ebx-tn ebx-tn)
442   (inst xor ecx-tn ecx-tn)
443   (inst mov ebx-tn ebp-tn)
444   (loadw ebp-tn block unwind-block-current-cont-slot)
445   (inst jmp (make-ea-for-object-slot block unwind-block-entry-pc-slot 0)))
446
447 #!+win32
448 (define-assembly-routine (continue-unwind
449                           (:return-style :none)
450                           (:translate %continue-unwind)
451                           (:policy :fast-safe))
452                          ((:arg block (any-reg descriptor-reg) eax-offset)
453                           (:arg start (any-reg descriptor-reg) ebx-offset)
454                           (:arg count (any-reg descriptor-reg) ecx-offset))
455   (declare (ignore block count))
456   ;; The args here are mostly ignored because we're using the
457   ;; win32 unwind mechanism and keep all that elsewhere.  The
458   ;; exception is START, which we use to pass the saved EBP for
459   ;; our exception handler.
460
461   ;; "All" we have to do here is reload our EBP, reestablish a C
462   ;; environment, and return ExceptionContinueSearch.  The OS
463   ;; handles the rest.
464
465   ;; Restore our frame pointer.
466   (inst mov esp-tn start)
467
468   ;; This section copied from VOP CALL-OUT.
469   ;; Setup the NPX for C; all the FP registers need to be
470   ;; empty; pop them all.
471   (dotimes (i 8)
472     (inst fstp fr0-tn))
473
474   ;; I'm unlikely to ever forget this again.
475   (inst cld)
476
477   ;; Restore our saved registers
478   (inst popa)
479
480   ;; And we're done.
481   (inst mov eax-tn 1) ;; exception-continue-search
482   (inst ret))