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 four are really arguments.
24 (:temp eax unsigned-reg rax-offset
)
25 (:temp ebx unsigned-reg rbx-offset
)
26 (:temp ecx unsigned-reg rcx-offset
)
27 (:temp esi unsigned-reg rsi-offset
)
29 ;; These we need as temporaries.
30 (:temp edx unsigned-reg rdx-offset
)
31 (:temp edi unsigned-reg rdi-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 ;; Save the count, because the loop is going to destroy it.
45 ;; Blit the values down the stack. Note: there might be overlap, so
46 ;; we have to be careful not to clobber values before we've read
47 ;; them. Because the stack builds down, we are coping to a larger
48 ;; address. Therefore, we need to iterate from larger addresses to
49 ;; smaller addresses. pfw-this says copy ecx words from esi to edi
51 (inst shr ecx
3) ; fixnum to raw word count
52 (inst std
) ; count down
54 (inst lea edi
(make-ea :qword
:base ebx
:disp
(- n-word-bytes
)))
61 ;; Set the stack top to the last result.
62 (inst lea rsp-tn
(make-ea :qword
:base edi
:disp n-word-bytes
))
64 ;; Load the register args.
73 ;; Handle the register arg cases.
76 (inst mov edx nil-value
)
82 ONE-VALUE
; Note: we can get this, because the return-multiple vop
83 ; doesn't check for this case when size > speed.
92 (inst mov esi nil-value
)
93 (inst lea rsp-tn
(make-ea :qword
:base ebx
:disp
(* -
2 n-word-bytes
)))
101 (inst lea rsp-tn
(make-ea :qword
:base ebx
:disp
(* -
3 n-word-bytes
)))
105 ;;;; TAIL-CALL-VARIABLE
107 ;;; For tail-call-variable, we have to copy the arguments from the end
108 ;;; of our stack frame (were args are produced) to the start of our
109 ;;; stack frame (were args are expected).
111 ;;; We take the function to call in EAX and a pointer to the arguments in
112 ;;; ESI. EBP says the same over the jump, and the old frame pointer is
113 ;;; still saved in the first stack slot. The return-pc is saved in
114 ;;; the second stack slot, so we have to push it to make it look like
115 ;;; we actually called. We also have to compute ECX from the difference
116 ;;; between ESI and the stack top.
117 #+sb-assembling
;; No vop for this one either.
118 (define-assembly-routine
120 (:return-style
:none
))
122 ((:temp eax unsigned-reg rax-offset
)
123 (:temp ebx unsigned-reg rbx-offset
)
124 (:temp ecx unsigned-reg rcx-offset
)
125 (:temp edx unsigned-reg rdx-offset
)
126 (:temp edi unsigned-reg rdi-offset
)
127 (:temp esi unsigned-reg rsi-offset
))
129 ;; Calculate NARGS (as a fixnum)
131 (inst sub ecx rsp-tn
)
133 ;; Check for all the args fitting the registers.
134 (inst cmp ecx
(fixnumize 3))
135 (inst jmp
:le REGISTER-ARGS
)
137 ;; Save the OLD-FP and RETURN-PC because the blit it going to trash
138 ;; those stack locations. Save the ECX, because the loop is going
141 (loadw ebx rbp-tn -
2)
144 ;; Do the blit. Because we are coping from smaller addresses to
145 ;; larger addresses, we have to start at the largest pair and work
147 (inst shr ecx
3) ; fixnum to raw words
148 (inst std
) ; count down
149 (inst lea edi
(make-ea :qword
:base rbp-tn
:disp
(- n-word-bytes
)))
150 (inst sub esi
(fixnumize 1))
154 ;; Load the register arguments carefully.
155 (loadw edx rbp-tn -
1)
157 ;; Restore OLD-FP and ECX.
159 (popw rbp-tn -
1) ; overwrites a0
161 ;; Blow off the stack above the arguments.
162 (inst lea rsp-tn
(make-ea :qword
:base edi
:disp n-word-bytes
))
164 ;; remaining register args
165 (loadw edi rbp-tn -
2)
166 (loadw esi rbp-tn -
3)
168 ;; Push the (saved) return-pc so it looks like we just called.
171 ;; And jump into the function.
173 (make-ea :byte
:base eax
174 :disp
(- (* closure-fun-slot n-word-bytes
)
175 fun-pointer-lowtag
)))
177 ;; All the arguments fit in registers, so load them.
183 ;; Clear most of the stack.
185 (make-ea :qword
:base rbp-tn
:disp
(* -
3 n-word-bytes
)))
187 ;; Push the return-pc so it looks like we just called.
188 (pushw rbp-tn -
2) ; XXX dan ?
191 (inst jmp
(make-ea :byte
:base eax
192 :disp
(- (* closure-fun-slot n-word-bytes
)
193 fun-pointer-lowtag
))))
195 (define-assembly-routine (throw
196 (:return-style
:none
))
197 ((:arg target
(descriptor-reg any-reg
) rdx-offset
)
198 (:arg start any-reg rbx-offset
)
199 (:arg count any-reg rcx-offset
)
200 (:temp catch any-reg rax-offset
))
202 (declare (ignore start count
))
204 (load-tl-symbol-value catch
*current-catch-block
*)
208 (let ((error (generate-error-code nil unseen-throw-tag-error target
)))
209 (inst or catch catch
) ; check for NULL pointer
212 (inst cmp target
(make-ea-for-object-slot catch catch-block-tag-slot
0))
215 (loadw catch catch catch-block-previous-catch-slot
)
220 ;; Here EAX points to catch block containing symbol pointed to by EDX.
221 (inst jmp
(make-fixup 'unwind
:assembly-routine
)))
223 ;;;; non-local exit noise
225 (define-assembly-routine (unwind
226 (:return-style
:none
)
227 (:translate %continue-unwind
)
228 (:policy
:fast-safe
))
229 ((:arg block
(any-reg descriptor-reg
) rax-offset
)
230 (:arg start
(any-reg descriptor-reg
) rbx-offset
)
231 (:arg count
(any-reg descriptor-reg
) rcx-offset
)
232 (:temp uwp unsigned-reg rsi-offset
))
233 (declare (ignore start count
))
235 (let ((error (generate-error-code nil invalid-unwind-error
)))
236 (inst or block block
) ; check for NULL pointer
239 (load-tl-symbol-value uwp
*current-unwind-protect-block
*)
241 ;; Does *CURRENT-UNWIND-PROTECT-BLOCK* match the value stored in
242 ;; argument's CURRENT-UWP-SLOT?
244 (make-ea-for-object-slot block unwind-block-current-uwp-slot
0))
245 ;; If a match, return to context in arg block.
246 (inst jmp
:e DO-EXIT
)
248 ;; Not a match - return to *CURRENT-UNWIND-PROTECT-BLOCK* context.
249 ;; Important! Must save (and return) the arg 'block' for later use!!
252 ;; Set next unwind protect context.
253 (loadw uwp uwp unwind-block-current-uwp-slot
)
254 ;; we're about to reload ebp anyway, so let's borrow it here as a
255 ;; temporary. Hope this works
256 (store-tl-symbol-value uwp
*current-unwind-protect-block
* rbp-tn
)
260 (loadw rbp-tn block unwind-block-current-cont-slot
)
262 ;; Uwp-entry expects some things in known locations so that they can
263 ;; be saved on the stack: the block in edx-tn, start in ebx-tn, and
266 (inst jmp
(make-ea :byte
:base block
267 :disp
(* unwind-block-entry-pc-slot n-word-bytes
))))