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 :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))
222 (declare (ignore start count))
224 (load-tl-symbol-value catch *current-catch-block*)
228 (let ((error (generate-error-code nil 'unseen-throw-tag-error target)))
229 (inst or catch catch) ; check for NULL pointer
232 (inst cmp target (make-ea-for-object-slot catch catch-block-tag-slot 0))
235 (loadw catch catch catch-block-previous-catch-slot)
240 ;; Here EAX points to catch block containing symbol pointed to by EDX.
241 (inst jmp (make-fixup 'unwind :assembly-routine)))
243 ;;;; non-local exit noise
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))
256 (let ((error (generate-error-code nil 'invalid-unwind-error)))
257 (inst or block block) ; check for NULL pointer
260 (load-tl-symbol-value uwp *current-unwind-protect-block*)
262 ;; Does *CURRENT-UNWIND-PROTECT-BLOCK* match the value stored in
263 ;; argument's CURRENT-UWP-SLOT?
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)
269 ;; Not a match - return to *CURRENT-UNWIND-PROTECT-BLOCK* context.
270 ;; Important! Must save (and return) the arg 'block' for later use!!
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)
281 (loadw ebp-tn block unwind-block-current-cont-slot)
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
287 (inst jmp (make-ea-for-object-slot block unwind-block-entry-pc-slot 0)))
290 ;;;; Win32 non-local exit noise
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))
301 (let ((error (generate-error-code nil 'invalid-unwind-error)))
302 (inst or block block) ; check for NULL pointer
305 ;; Save all our registers, as we're about to clobber them.
308 ;; Find the SEH frame surrounding our target.
309 (loadw ecx-tn block unwind-block-next-seh-frame-slot)
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.
317 ;; I'm unlikely to ever forget this again.
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))
324 (inst mov ebp-tn esp-tn)
326 ;; Actually call out for the unwind.
331 (inst call (make-fixup "RtlUnwind@16" :foreign)))
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))
340 ;; The unwind returns here. Had to use a VOP for this because
341 ;; PUSH won't accept a label as an argument.
343 ;; Clean up the bogus stack frame we pushed for the unwind.
345 (inst pop esi-tn) ;; Random scratch register.
347 ;; This section based on VOP CALL-OUT.
348 ;; Restore the NPX for lisp; ensure no regs are empty
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)
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)))
364 ;;;; Win32 UWP block SEH interface.
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))
373 ;; We get called for any exception which happens within our
374 ;; dynamic contour that isn't handled below us, and for
377 ;; For the exceptions we just return ExceptionContinueSearch.
379 ;; Find the exception record.
380 (inst mov eax-tn (make-ea :dword :base esp-tn :disp 4))
382 ;; Check unwind flags.
383 (inst test (make-ea :byte :base eax-tn :disp 4) 6) ; EH_UNWINDING | EH_EXIT_UNWIND
385 ;; To see if we're unwinding or not.
386 (inst jmp :nz UNWINDING)
388 ;; We're not unwinding, so we're not interested.
389 (inst mov eax-tn 1) ;; exception-continue-search
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.
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?
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.
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.
409 ;; We also must update *current-unwind-protect-block* before
410 ;; calling the cleanup function.
414 ;; Save all registers (overkill)
417 ;; Establish our stack frame.
418 (inst mov ebp-tn esp-tn)
420 ;; This section based on VOP CALL-OUT.
421 ;; Restore the NPX for lisp; ensure no regs are empty
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
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)
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.
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)))
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.
461 ;; "All" we have to do here is reload our EBP, reestablish a C
462 ;; environment, and return ExceptionContinueSearch. The OS
465 ;; Restore our frame pointer.
466 (inst mov esp-tn start)
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.
474 ;; I'm unlikely to ever forget this again.
477 ;; Restore our saved registers
481 (inst mov eax-tn 1) ;; exception-continue-search