1 ;;;; the machine specific support routines needed by the file assembler
3 ;;;; This software is part of the SBCL system. See the README file for
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.
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.
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
)
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
))
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
)
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
)))
47 ;; Save the count, the return address and restore the frame pointer,
48 ;; because the loop is going to destroy them.
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
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
)))
71 ;; Set the stack top to the last result.
72 (inst lea esp-tn
(make-ea :dword
:base edi
:disp n-word-bytes
))
74 ;; Load the register args.
84 ;; Handle the register arg cases.
86 (inst lea ebx
(make-ea :dword
:base ebp-tn
87 :disp
(* sp-
>fp-offset n-word-bytes
)))
88 (inst mov edx nil-value
)
91 (inst mov esp-tn ebp-tn
)
96 ;; Note: we can get this, because the return-multiple vop doesn't
97 ;; check for this case when size > speed.
100 (inst mov esp-tn ebp-tn
)
106 (inst lea ebx
(make-ea :dword
:base ebp-tn
107 :disp
(* sp-
>fp-offset n-word-bytes
)))
110 (inst mov esi nil-value
)
111 (inst mov esp-tn ebp-tn
)
117 (inst lea ebx
(make-ea :dword
:base ebp-tn
118 :disp
(* sp-
>fp-offset n-word-bytes
)))
122 (inst mov esp-tn ebp-tn
)
127 ;;;; TAIL-CALL-VARIABLE
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).
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
142 (:return-style
:none
))
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
))
151 ;; Calculate NARGS (as a fixnum)
153 (inst sub ecx esp-tn
)
155 ;; Check for all the args fitting the registers.
156 (inst cmp ecx
(fixnumize 3))
157 (inst jmp
:le REGISTER-ARGS
)
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
162 (pushw ebp-tn
(frame-word-offset ocfp-save-offset
))
163 (loadw ebx ebp-tn
(frame-word-offset return-pc-save-offset
))
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
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))
177 ;; Load the register arguments carefully.
178 (loadw edx ebp-tn
(frame-word-offset ocfp-save-offset
))
180 ;; Restore OLD-FP and ECX.
183 (popw ebp-tn
(frame-word-offset ocfp-save-offset
))
185 ;; Blow off the stack above the arguments.
186 (inst lea esp-tn
(make-ea :dword
:base edi
:disp n-word-bytes
))
188 ;; remaining register args
190 (loadw edx ebp-tn
(frame-word-offset 0))
191 (loadw esi ebp-tn
(frame-word-offset 2))
193 ;; Push the (saved) return-pc so it looks like we just called.
196 ;; And jump into the function.
197 (inst jmp
(make-ea-for-object-slot eax closure-fun-slot fun-pointer-lowtag
))
199 ;; All the arguments fit in registers, so load them.
205 ;; Clear most of the stack.
207 (make-ea :dword
:base ebp-tn
:disp
(* (- sp-
>fp-offset
3) n-word-bytes
)))
209 ;; Push the return-pc so it looks like we just called.
210 (pushw ebp-tn
(frame-word-offset return-pc-save-offset
))
213 (inst jmp
(make-ea-for-object-slot eax closure-fun-slot fun-pointer-lowtag
)))
215 (define-assembly-routine (throw
216 (:return-style
:raw
))
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
))
222 (declare (ignore start count
))
224 (load-tl-symbol-value catch
*current-catch-block
*)
228 (let ((error (gen-label)))
229 (assemble (*elsewhere
*)
232 ;; Fake up a stack frame so that backtraces come out right.
234 (inst mov ebp-tn esp-tn
)
236 (emit-error-break nil error-trap
237 (error-number-or-lose 'unseen-throw-tag-error
)
239 (inst test catch catch
) ; check for NULL pointer
242 (inst cmp target
(make-ea-for-object-slot catch catch-block-tag-slot
0))
245 (loadw catch catch catch-block-previous-catch-slot
)
250 ;; Here EAX points to catch block containing symbol pointed to by EDX.
251 ;; An extra RET gets stuffed after the JMP, but oh well. You can't just change
252 ;; the :return-style to :none because that also affects the call sequence.
253 (inst jmp
(make-fixup 'unwind
:assembly-routine
)))
255 ;;;; non-local exit noise
258 (define-assembly-routine (unwind
259 (:return-style
:none
)
260 (:translate %continue-unwind
)
261 (:policy
:fast-safe
))
262 ((:arg block
(any-reg descriptor-reg
) eax-offset
)
263 (:arg start
(any-reg descriptor-reg
) ebx-offset
)
264 (:arg count
(any-reg descriptor-reg
) ecx-offset
)
265 (:temp uwp unsigned-reg esi-offset
))
266 (declare (ignore start count
))
268 (let ((error (generate-error-code nil
'invalid-unwind-error
)))
269 (inst test block block
) ; check for NULL pointer
272 (load-tl-symbol-value uwp
*current-unwind-protect-block
*)
274 ;; Does *CURRENT-UNWIND-PROTECT-BLOCK* match the value stored in
275 ;; argument's CURRENT-UWP-SLOT?
277 (make-ea-for-object-slot block unwind-block-current-uwp-slot
0))
278 ;; If a match, return to context in arg block.
279 (inst jmp
:e DO-EXIT
)
281 ;; Not a match - return to *CURRENT-UNWIND-PROTECT-BLOCK* context.
282 ;; Important! Must save (and return) the arg 'block' for later use!!
285 ;; Set next unwind protect context.
286 (loadw uwp uwp unwind-block-current-uwp-slot
)
287 ;; we're about to reload ebp anyway, so let's borrow it here as a
288 ;; temporary. Hope this works
289 (store-tl-symbol-value uwp
*current-unwind-protect-block
* ebp-tn
)
293 (loadw ebp-tn block unwind-block-current-cont-slot
)
295 ;; Uwp-entry expects some things in known locations so that they can
296 ;; be saved on the stack: the block in edx-tn, start in ebx-tn, and
299 (inst jmp
(make-ea-for-object-slot block unwind-block-entry-pc-slot
0)))
302 ;;;; Win32 non-local exit noise
305 (define-assembly-routine (unwind
306 (:return-style
:none
)
307 (:policy
:fast-safe
))
308 ((:arg block
(any-reg descriptor-reg
) eax-offset
)
309 (:arg start
(any-reg descriptor-reg
) ebx-offset
)
310 (:arg count
(any-reg descriptor-reg
) ecx-offset
))
311 (declare (ignore start count
))
313 (let ((error (generate-error-code nil
'invalid-unwind-error
)))
314 (inst test block block
) ; check for NULL pointer
317 ;; Save all our registers, as we're about to clobber them.
320 ;; Find the SEH frame surrounding our target.
321 (loadw ecx-tn block unwind-block-next-seh-frame-slot
)
323 ;; This section copied from VOP CALL-OUT.
324 ;; Setup the NPX for C; all the FP registers need to be
325 ;; empty; pop them all.
332 (inst mov ebp-tn esp-tn
)
334 ;; Actually call out for the unwind.
340 (inst call
(make-fixup "RtlUnwind" :foreign
))
343 ;; This section based on VOP CALL-OUT.
344 ;; Restore the NPX for lisp; ensure no regs are empty
351 ;; By now we've unwound all the UWP frames required, so we
352 ;; just jump to our target block.
353 (loadw ebp-tn block unwind-block-current-cont-slot
)
355 ;; Nlx-entry expects the arg start in ebx-tn and the arg count
356 ;; in ecx-tn. Fortunately, that's where they are already.
357 (inst jmp
(make-ea-for-object-slot block unwind-block-entry-pc-slot
0)))
359 ;;;; Win32 UWP block SEH interface.
361 ;; We want no VOP for this one and for it to only happen on Win32
362 ;; targets. Hence the following disaster.
363 #!+#.
(cl:if
(cl:member sb-assembling cl
:*features
*) win32
'(or))
364 (define-assembly-routine
365 (uwp-seh-handler (:return-style
:none
))
366 ((:temp block unsigned-reg eax-offset
))
368 ;; We get called for any exception which happens within our
369 ;; dynamic contour that isn't handled below us, and for
372 ;; For the exceptions we just return ExceptionContinueSearch.
374 ;; Find the exception record.
375 (inst mov eax-tn
(make-ea :dword
:base esp-tn
:disp
4))
377 ;; Check unwind flags.
378 (inst test
(make-ea :byte
:base eax-tn
:disp
4) 6) ; EH_UNWINDING | EH_EXIT_UNWIND
380 ;; To see if we're unwinding or not.
381 (inst jmp
:nz UNWINDING
)
383 ;; We're not unwinding, so we're not interested.
384 (inst mov eax-tn
1) ;; exception-continue-search
387 ;; For the unwinds we establish a basic environment as per
388 ;; call_into_lisp, but without the extra SEH frame (the theory
389 ;; being that we're already in a Lisp SEH context), and invoke
390 ;; our UWP block to unwind itself.
392 ;; FIXME: Do we need to establish an SEH frame anyway? And do
393 ;; we need to do the same stack frame hackery for the debugger
394 ;; as we do for the main exception handler?
396 ;; When the UWP block calls %continue-unwind, we come back to
397 ;; the next assembly routine, below, which reinitializes for C
398 ;; and returns to the Win32 unwind machinery.
400 ;; If the UWP block sees fit to do a non-local exit, things
401 ;; Just Work, thanks to the Win32 API being sanely designed
402 ;; and our complying with it.
404 ;; We also must update *current-unwind-protect-block* before
405 ;; calling the cleanup function.
409 ;; Save all registers (overkill)
412 ;; Establish our stack frame.
413 (inst mov ebp-tn esp-tn
)
415 ;; This section based on VOP CALL-OUT.
416 ;; Restore the NPX for lisp; ensure no regs are empty
420 ;; Find our unwind-block by way of our SEH frame.
421 (inst mov block
(make-ea :dword
:base ebp-tn
:disp
#x28
))
422 (inst lea block
(make-ea :dword
:base block
423 :disp
(- (* unwind-block-next-seh-frame-slot
426 ;; Update *CURRENT-UNWIND-PROTECT-BLOCK*.
427 (loadw ebx-tn block unwind-block-current-uwp-slot
)
428 (store-tl-symbol-value ebx-tn
*current-unwind-protect-block
* ecx-tn
)
430 ;; Uwp-entry expects some things in known locations so that they can
431 ;; be saved on the stack: the block in edx-tn, start in ebx-tn, and
432 ;; count in ecx-tn. We don't actually have any of that here, but we
433 ;; do need to have access to our own stack frame, so we hijack the
434 ;; known locations to cover our own state.
436 (inst xor ebx-tn ebx-tn
)
437 (inst xor ecx-tn ecx-tn
)
438 (inst mov ebx-tn ebp-tn
)
439 (loadw ebp-tn block unwind-block-current-cont-slot
)
440 (inst jmp
(make-ea-for-object-slot block unwind-block-entry-pc-slot
0)))
443 (define-assembly-routine (continue-unwind
444 (:return-style
:none
)
445 (:translate %continue-unwind
)
446 (:policy
:fast-safe
))
447 ((:arg block
(any-reg descriptor-reg
) eax-offset
)
448 (:arg start
(any-reg descriptor-reg
) ebx-offset
)
449 (:arg count
(any-reg descriptor-reg
) ecx-offset
))
450 (declare (ignore block count
))
451 ;; The args here are mostly ignored because we're using the
452 ;; win32 unwind mechanism and keep all that elsewhere. The
453 ;; exception is START, which we use to pass the saved EBP for
454 ;; our exception handler.
456 ;; "All" we have to do here is reload our EBP, reestablish a C
457 ;; environment, and return ExceptionContinueSearch. The OS
460 ;; Restore our frame pointer.
461 (inst mov esp-tn start
)
463 ;; This section copied from VOP CALL-OUT.
464 ;; Setup the NPX for C; all the FP registers need to be
465 ;; empty; pop them all.
469 ;; I'm unlikely to ever forget this again.
472 ;; Restore our saved registers
476 (inst mov eax-tn
1) ;; exception-continue-search