1 ;;;; the definition of non-local exit for the x86 VM
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.
17 ;;; Make an environment-live stack TN for saving the SP for NLX entry.
18 (def-vm-support-routine make-nlx-sp-tn (env)
20 (make-representation-tn *fixnum-primitive-type* any-reg-sc-number)
23 ;;; Make a TN for the argument count passing location for a non-local entry.
24 (def-vm-support-routine make-nlx-entry-argument-start-location ()
25 (make-wired-tn *fixnum-primitive-type* any-reg-sc-number ebx-offset))
27 (defun catch-block-ea (tn)
28 (assert (sc-is tn catch-block))
29 (make-ea :dword :base ebp-tn
30 :disp (- (* (+ (tn-offset tn) catch-block-size) word-bytes))))
33 ;;;; Save and restore dynamic environment.
35 ;;;; These VOPs are used in the reentered function to restore the
36 ;;;; appropriate dynamic environment. Currently we only save the
37 ;;;; Current-Catch, the eval stack pointer, and the alien stack
40 ;;;; We don't need to save/restore the current unwind-protect, since
41 ;;;; unwind-protects are implicitly processed during unwinding.
43 ;;;; We don't need to save the BSP, because that is handled automatically.
45 ;;; Return a list of TNs that can be used to snapshot the dynamic state for
46 ;;; use with the Save/Restore-Dynamic-Environment VOPs.
47 (def-vm-support-routine make-dynamic-state-tns ()
48 (make-n-tns 3 *backend-t-primitive-type*))
50 (define-vop (save-dynamic-state)
51 (:results (catch :scs (descriptor-reg))
52 (eval :scs (descriptor-reg))
53 (alien-stack :scs (descriptor-reg)))
55 (load-symbol-value catch sb!impl::*current-catch-block*)
56 (load-symbol-value eval sb!impl::*eval-stack-top*)
57 (load-symbol-value alien-stack *alien-stack*)))
59 (define-vop (restore-dynamic-state)
60 (:args (catch :scs (descriptor-reg))
61 (eval :scs (descriptor-reg))
62 (alien-stack :scs (descriptor-reg)))
64 (store-symbol-value catch sb!impl::*current-catch-block*)
65 (store-symbol-value eval sb!impl::*eval-stack-top*)
66 (store-symbol-value alien-stack *alien-stack*)))
68 (define-vop (current-stack-pointer)
69 (:results (res :scs (any-reg control-stack)))
73 (define-vop (current-binding-pointer)
74 (:results (res :scs (any-reg descriptor-reg)))
76 (load-symbol-value res *binding-stack-pointer*)))
78 ;;;; unwind block hackery
80 ;;; Compute the address of the catch block from its TN, then store into the
81 ;;; block the current Fp, Env, Unwind-Protect, and the entry PC.
82 (define-vop (make-unwind-block)
85 (:temporary (:sc unsigned-reg) temp)
86 (:results (block :scs (any-reg)))
88 (inst lea block (catch-block-ea tn))
89 (load-symbol-value temp sb!impl::*current-unwind-protect-block*)
90 (storew temp block unwind-block-current-uwp-slot)
91 (storew ebp-tn block unwind-block-current-cont-slot)
92 (storew (make-fixup nil :code-object entry-label)
93 block catch-block-entry-pc-slot)))
95 ;;; Like Make-Unwind-Block, except that we also store in the specified tag, and
96 ;;; link the block into the Current-Catch list.
97 (define-vop (make-catch-block)
99 (tag :scs (descriptor-reg) :to (:result 1)))
101 (:results (block :scs (any-reg)))
102 (:temporary (:sc descriptor-reg) temp)
104 (inst lea block (catch-block-ea tn))
105 (load-symbol-value temp sb!impl::*current-unwind-protect-block*)
106 (storew temp block unwind-block-current-uwp-slot)
107 (storew ebp-tn block unwind-block-current-cont-slot)
108 (storew (make-fixup nil :code-object entry-label)
109 block catch-block-entry-pc-slot)
110 (storew tag block catch-block-tag-slot)
111 (load-symbol-value temp sb!impl::*current-catch-block*)
112 (storew temp block catch-block-previous-catch-slot)
113 (store-symbol-value block sb!impl::*current-catch-block*)))
115 ;;; Just set the current unwind-protect to TN's address. This instantiates an
116 ;;; unwind block as an unwind-protect.
117 (define-vop (set-unwind-protect)
119 (:temporary (:sc unsigned-reg) new-uwp)
121 (inst lea new-uwp (catch-block-ea tn))
122 (store-symbol-value new-uwp sb!impl::*current-unwind-protect-block*)))
124 (define-vop (unlink-catch-block)
125 (:temporary (:sc unsigned-reg) block)
127 (:translate %catch-breakup)
129 (load-symbol-value block sb!impl::*current-catch-block*)
130 (loadw block block catch-block-previous-catch-slot)
131 (store-symbol-value block sb!impl::*current-catch-block*)))
133 (define-vop (unlink-unwind-protect)
134 (:temporary (:sc unsigned-reg) block)
136 (:translate %unwind-protect-breakup)
138 (load-symbol-value block sb!impl::*current-unwind-protect-block*)
139 (loadw block block unwind-block-current-uwp-slot)
140 (store-symbol-value block sb!impl::*current-unwind-protect-block*)))
143 (define-vop (nlx-entry)
144 ;; Note: we can't list an sc-restriction, 'cause any load vops would
145 ;; be inserted before the return-pc label.
149 (:results (values :more t))
150 (:temporary (:sc descriptor-reg) move-temp)
152 (:save-p :force-to-stack)
156 (note-this-location vop :non-local-entry)
157 (cond ((zerop nvals))
159 (let ((no-values (gen-label)))
160 (inst mov (tn-ref-tn values) nil-value)
161 (inst jecxz no-values)
162 (loadw (tn-ref-tn values) start -1)
163 (emit-label no-values)))
165 (collect ((defaults))
167 (tn-ref values (tn-ref-across tn-ref)))
169 (let ((default-lab (gen-label))
170 (tn (tn-ref-tn tn-ref)))
171 (defaults (cons default-lab tn))
173 (inst cmp count (fixnumize i))
174 (inst jmp :le default-lab)
176 ((descriptor-reg any-reg)
177 (loadw tn start (- (1+ i))))
179 (loadw move-temp start (- (1+ i)))
180 (inst mov tn move-temp)))))
181 (let ((defaulting-done (gen-label)))
182 (emit-label defaulting-done)
183 (assemble (*elsewhere*)
184 (dolist (def (defaults))
185 (emit-label (car def))
186 (inst mov (cdr def) nil-value))
187 (inst jmp defaulting-done))))))
188 (inst mov esp-tn sp)))
190 (define-vop (nlx-entry-multiple)
194 ;; Again, no SC restrictions for the args, 'cause the loading would
195 ;; happen before the entry label.
197 (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 2)) ecx)
198 (:temporary (:sc unsigned-reg :offset esi-offset) esi)
199 (:temporary (:sc unsigned-reg :offset edi-offset) edi)
200 (:results (result :scs (any-reg) :from (:argument 0))
201 (num :scs (any-reg control-stack)))
202 (:save-p :force-to-stack)
206 (note-this-location vop :non-local-entry)
208 (inst lea esi (make-ea :dword :base source :disp (- word-bytes)))
209 ;; The 'top' arg contains the %esp value saved at the time the
210 ;; catch block was created and points to where the thrown values
215 (inst sub edi word-bytes)
216 (move ecx count) ; fixnum words == bytes
218 (inst shr ecx word-shift) ; word count for <rep movs>
219 ;; If we got zero, we be done.
227 ;; Reset the CSP at last moved arg.
228 (inst lea esp-tn (make-ea :dword :base edi :disp word-bytes))))
231 ;;; This VOP is just to force the TNs used in the cleanup onto the stack.
232 (define-vop (uwp-entry)
234 (:save-p :force-to-stack)
235 (:results (block) (start) (count))
236 (:ignore block start count)
240 (note-this-location vop :non-local-entry)))