Micro-optimize verify-arg-count on x86oids and ARM64.
[sbcl.git] / src / compiler / arm64 / call.lisp
blobb1d6148ebb5b5c2b1f15df05696456eddb4758cd
1 ;;;; the VM definition of function call for the ARM
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.
12 (in-package "SB!VM")
14 (defconstant arg-count-sc (make-sc-offset immediate-arg-scn nargs-offset))
15 (defconstant closure-sc (make-sc-offset descriptor-reg-sc-number lexenv-offset))
17 ;;; Make a passing location TN for a local call return PC. If
18 ;;; standard is true, then use the standard (full call) location,
19 ;;; otherwise use any legal location. Even in the non-standard case,
20 ;;; this may be restricted by a desire to use a subroutine call
21 ;;; instruction.
22 (defun make-return-pc-passing-location (standard)
23 (declare (ignore standard))
24 (make-wired-tn *backend-t-primitive-type* control-stack-sc-number
25 lra-save-offset))
27 (defconstant return-pc-passing-offset
28 (make-sc-offset control-stack-sc-number lra-save-offset))
30 ;;; This is similar to MAKE-RETURN-PC-PASSING-LOCATION, but makes a
31 ;;; location to pass OLD-FP in.
32 ;;;
33 ;;; This is wired in both the standard and the local-call conventions,
34 ;;; because we want to be able to assume it's always there. Besides,
35 ;;; the ARM doesn't have enough registers to really make it profitable
36 ;;; to pass it in a register.
37 (defun make-old-fp-passing-location (standard)
38 (declare (ignore standard))
39 (make-wired-tn *fixnum-primitive-type* control-stack-sc-number
40 ocfp-save-offset))
42 (defconstant old-fp-passing-offset
43 (make-sc-offset control-stack-sc-number ocfp-save-offset))
45 ;;; Make the TNs used to hold OLD-FP and RETURN-PC within the current
46 ;;; function. We treat these specially so that the debugger can find
47 ;;; them at a known location.
48 (defun make-old-fp-save-location (env)
49 ;; Unlike the other backends, ARM function calling is designed to
50 ;; pass OLD-FP within the stack frame rather than in a register. As
51 ;; such, in order for lifetime analysis not to screw up, we need it
52 ;; to be a stack TN wired to the save offset, not a normal TN with a
53 ;; wired SAVE-TN.
54 (physenv-debug-live-tn (make-wired-tn *fixnum-primitive-type*
55 control-stack-arg-scn
56 ocfp-save-offset)
57 env))
58 (defun make-return-pc-save-location (physenv)
59 (physenv-debug-live-tn
60 (make-wired-tn *backend-t-primitive-type* control-stack-sc-number
61 lra-save-offset)
62 physenv))
64 ;;; Make a TN for the standard argument count passing location. We
65 ;;; only need to make the standard location, since a count is never
66 ;;; passed when we are using non-standard conventions.
67 (defun make-arg-count-location ()
68 (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nargs-offset))
70 ;;;; Frame hackery:
72 ;;; Return the number of bytes needed for the current non-descriptor
73 ;;; stack frame.
74 (defun bytes-needed-for-non-descriptor-stack-frame ()
75 (logandc2 (+ (* (sb-allocated-size 'non-descriptor-stack) n-word-bytes)
76 +number-stack-alignment-mask+)
77 +number-stack-alignment-mask+))
79 ;;; Used for setting up the Old-FP in local call.
80 (define-vop (current-fp)
81 (:results (val :scs (any-reg)))
82 (:generator 1
83 (move val cfp-tn)))
85 ;;; Used for computing the caller's NFP for use in known-values return. Only
86 ;;; works assuming there is no variable size stuff on the nstack.
87 (define-vop (compute-old-nfp)
88 (:results (val :scs (any-reg)))
89 (:vop-var vop)
90 (:generator 1
91 (let ((nfp (current-nfp-tn vop)))
92 (when nfp
93 ;; FIXME-ARM: taken form MIPS is this correct? (phs)
94 (inst add val nfp (bytes-needed-for-non-descriptor-stack-frame))))))
96 ;;; Accessing a slot from an earlier stack frame is definite hackery.
97 (define-vop (ancestor-frame-ref)
98 (:args (frame-pointer :scs (descriptor-reg))
99 (variable-home-tn :load-if nil))
100 (:results (value :scs (descriptor-reg any-reg)))
101 (:policy :fast-safe)
102 (:generator 4
103 (aver (sc-is variable-home-tn control-stack))
104 (load-stack-offset value frame-pointer variable-home-tn)))
106 (define-vop (ancestor-frame-set)
107 (:args (frame-pointer :scs (descriptor-reg))
108 (value :scs (descriptor-reg any-reg)))
109 (:results (variable-home-tn :load-if nil))
110 (:policy :fast-safe)
111 (:generator 4
112 (aver (sc-is variable-home-tn control-stack))
113 (store-stack-offset value frame-pointer variable-home-tn)))
115 (define-vop (xep-allocate-frame)
116 (:info start-lab)
117 (:temporary (:scs (non-descriptor-reg)) temp)
118 (:temporary (:scs (interior-reg)) lip)
119 (:generator 1
120 ;; Make sure the function is aligned, and drop a label pointing to this
121 ;; function header.
122 (emit-alignment n-lowtag-bits)
123 (emit-label start-lab)
124 ;; Allocate function header.
125 (inst simple-fun-header-word)
126 (dotimes (i (1- simple-fun-code-offset))
127 (inst dword 0))
128 (inst compute-code code-tn lip start-lab temp)))
130 (define-vop (xep-setup-sp)
131 (:vop-var vop)
132 (:generator 1
133 (inst add csp-tn cfp-tn
134 (add-sub-immediate (* n-word-bytes (sb-allocated-size 'control-stack))))
135 (let ((nfp-tn (current-nfp-tn vop)))
136 (when nfp-tn
137 (let ((nbytes (bytes-needed-for-non-descriptor-stack-frame)))
138 (inst sub nfp-tn nsp-tn nbytes)
139 (inst mov-sp nsp-tn nfp-tn))))))
141 (define-vop (allocate-frame)
142 (:results (res :scs (any-reg))
143 (nfp :scs (any-reg)))
144 (:info callee)
145 (:generator 2
146 (move res csp-tn)
147 (inst add csp-tn csp-tn (add-sub-immediate
148 (* (max 1 (sb-allocated-size 'control-stack)) n-word-bytes)))
149 (when (ir2-physenv-number-stack-p callee)
150 (inst sub nfp nsp-tn (add-sub-immediate
151 (bytes-needed-for-non-descriptor-stack-frame)))
152 (inst mov-sp nsp-tn nfp))))
154 ;;; Allocate a partial frame for passing stack arguments in a full call. Nargs
155 ;;; is the number of arguments passed. If no stack arguments are passed, then
156 ;;; we don't have to do anything.
157 (define-vop (allocate-full-call-frame)
158 (:info nargs)
159 (:results (res :scs (any-reg)))
160 (:generator 2
161 ;; Unlike most other backends, we store the "OCFP" at frame
162 ;; allocation time rather than at function-entry time, largely due
163 ;; to a lack of usable registers.
164 ;; Our minimum caller frame size is two words, one for the frame
165 ;; link and one for the LRA.
166 (move res csp-tn)
167 (inst add csp-tn csp-tn (add-sub-immediate (* (max 2 nargs) n-word-bytes)))
168 (storew cfp-tn res ocfp-save-offset)))
170 ;;; Emit code needed at the return-point from an unknown-values call
171 ;;; for a fixed number of values. VALUES is the head of the TN-REF
172 ;;; list for the locations that the values are to be received into.
173 ;;; NVALS is the number of values that are to be received (should
174 ;;; equal the length of Values).
176 ;;; MOVE-TEMP is a DESCRIPTOR-REG TN used as a temporary.
178 ;;; This code exploits the fact that in the unknown-values convention,
179 ;;; a single value return returns with all of the condition flags
180 ;;; clear, whereas a return of other than one value returns with the
181 ;;; condition flags set.
183 ;;; If 0 or 1 values are expected, then we just emit an instruction to
184 ;;; reset the SP (which will only be executed when other than 1 value
185 ;;; is returned.)
187 ;;; In the general case, we have to do three things:
188 ;;; -- Default unsupplied register values. This need only be done when a
189 ;;; single value is returned, since register values are defaulted by the
190 ;;; callee in the non-single case.
191 ;;; -- Default unsupplied stack values. This needs to be done whenever there
192 ;;; are stack values.
193 ;;; -- Reset SP. This must be done whenever other than 1 value is returned,
194 ;;; regardless of the number of values desired.
196 (defun default-unknown-values (vop values nvals move-temp temp lip lra-label)
197 (declare (type (or tn-ref null) values)
198 (type unsigned-byte nvals) (type tn move-temp temp))
199 (let ((expecting-values-on-stack (> nvals register-arg-count))
200 (values-on-stack temp))
201 (note-this-location vop (if (<= nvals 1)
202 :single-value-return
203 :unknown-return))
204 (inst compute-code code-tn lip lra-label temp)
205 ;; Pick off the single-value case first.
206 (sb!assem:without-scheduling ()
208 ;; Default register values for single-value return case.
209 ;; The callee returns with condition bits CLEAR in the
210 ;; single-value case.
211 (when values
212 (do ((i 1 (1+ i))
213 (val (tn-ref-across values) (tn-ref-across val)))
214 ((= i (min nvals register-arg-count)))
215 (inst csel (tn-ref-tn val) null-tn (tn-ref-tn val) :ne)))
217 ;; If we're not expecting values on the stack, all that
218 ;; remains is to clear the stack frame (for the multiple-
219 ;; value return case).
220 (unless expecting-values-on-stack
221 (inst csel csp-tn ocfp-tn csp-tn :eq))
223 ;; If we ARE expecting values on the stack, we need to
224 ;; either move them to their result location or to set their
225 ;; result location to the default.
226 (when expecting-values-on-stack
228 ;; For the single-value return case, fake up NARGS and
229 ;; OCFP so that we don't screw ourselves with the
230 ;; defaulting and stack clearing logic.
231 (inst csel ocfp-tn csp-tn ocfp-tn :ne)
232 (inst mov tmp-tn (fixnumize 1))
233 (inst csel nargs-tn tmp-tn nargs-tn :ne)
235 ;; Compute the number of stack values (may be negative if
236 ;; not all of the register values are populated).
237 (inst sub values-on-stack nargs-tn (fixnumize register-arg-count))
239 ;; For each expected stack value...
240 (do ((i register-arg-count (1+ i))
241 (val (do ((i 0 (1+ i))
242 (val values (tn-ref-across val)))
243 ((= i register-arg-count) val))
244 (tn-ref-across val)))
245 ((null val))
246 (assemble ()
247 ;; ... Load it if there is a stack value available, or
248 ;; default it if there isn't.
249 (inst subs values-on-stack values-on-stack (fixnumize 1))
250 (inst b :lt NONE)
251 (loadw move-temp ocfp-tn i 0)
252 NONE
253 (inst csel move-temp null-tn move-temp :lt)
254 (store-stack-tn (tn-ref-tn val) move-temp)))
255 ;; Deallocate the callee stack frame.
256 (move csp-tn ocfp-tn))))
257 (values))
259 ;;;; Unknown values receiving:
261 ;;; Emit code needed at the return point for an unknown-values call for an
262 ;;; arbitrary number of values.
264 ;;; We do the single and non-single cases with no shared code: there doesn't
265 ;;; seem to be any potential overlap, and receiving a single value is more
266 ;;; important efficiency-wise.
268 ;;; When there is a single value, we just push it on the stack, returning
269 ;;; the old SP and 1.
271 ;;; When there is a variable number of values, we move all of the argument
272 ;;; registers onto the stack, and return Args and Nargs.
274 ;;; Args and Nargs are TNs wired to the named locations. We must
275 ;;; explicitly allocate these TNs, since their lifetimes overlap with the
276 ;;; results Start and Count (also, it's nice to be able to target them).
277 (defun receive-unknown-values (args nargs start count lra-label temp lip)
278 (declare (type tn args nargs start count temp))
279 (assemble ()
280 (inst compute-code code-tn lip lra-label temp)
281 (inst b :eq MULTIPLE)
282 (move start csp-tn)
283 (inst add csp-tn csp-tn n-word-bytes)
284 (inst str (first *register-arg-tns*) (@ start))
285 (inst mov count (fixnumize 1))
286 (inst b DONE)
287 MULTIPLE
288 #.(assert (evenp register-arg-count))
289 (do ((arg *register-arg-tns* (cddr arg))
290 (i 0 (+ i 2)))
291 ((null arg))
292 (inst stp (first arg) (second arg)
293 (@ args (* i n-word-bytes))))
294 (move start args)
295 (move count nargs)
296 DONE))
298 ;;; VOP that can be inherited by unknown values receivers. The main
299 ;;; thing this handles is allocation of the result temporaries.
300 (define-vop (unknown-values-receiver)
301 (:results
302 (start :scs (any-reg) :from (:save 0))
303 (count :scs (any-reg) :from (:save 1)))
304 (:temporary (:sc any-reg :offset ocfp-offset
305 :from :eval :to :save)
306 values-start)
307 (:temporary (:sc any-reg :offset nargs-offset
308 :from :eval :to :save)
309 nvals))
311 ;;; This hook in the codegen pass lets us insert code before fall-thru entry
312 ;;; points, local-call entry points, and tail-call entry points. The default
313 ;;; does nothing.
314 (defun emit-block-header (start-label trampoline-label fall-thru-p alignp)
315 (declare (ignore fall-thru-p alignp))
316 (when trampoline-label
317 (emit-label trampoline-label))
318 (emit-label start-label))
321 ;;;; XEP hackery:
323 ;;; Get the lexical environment from its passing location.
324 (define-vop (setup-closure-environment)
325 (:temporary (:sc descriptor-reg :offset lexenv-offset :target closure
326 :to (:result 0))
327 lexenv)
328 (:results (closure :scs (descriptor-reg)))
329 (:info label)
330 (:ignore label)
331 (:generator 6
332 ;; Get result.
333 (move closure lexenv)))
335 ;;; Copy a more arg from the argument area to the end of the current frame.
336 ;;; Fixed is the number of non-more arguments.
337 (define-vop (copy-more-arg)
338 ;; The environment here-and-now is not properly initialized. The
339 ;; stack frame is not yet fully allocated, and even if it were most
340 ;; of the slots have live data in them that PACK does not know
341 ;; about, so we cannot afford a register spill. As far as the boxed
342 ;; registers go, the arg-passing registers (R0, R1, and R2) are
343 ;; live, LEXENV is live, and LRA is live. On the unboxed front,
344 ;; NARGS is live. FP has been set up by the caller, SP is
345 ;; protecting our stack arguments, but is otherwise not set up. NFP
346 ;; is not yet set up. CODE and NULL are set up. SP and NFP must be
347 ;; correctly set up by the time we're done, and OCFP and R8 are
348 ;; available for use as temporaries. If we were any more register
349 ;; constrained, we'd be spilling registers manually (rather than
350 ;; allowing PACK to do it for us). -- AJB, 2012-Oct-30
351 (:vop-var vop)
352 ;; Pack COUNT and DEST into the same register, being careful to tell
353 ;; PACK that their lifetimes do not overlap (we're lying to PACK, as
354 ;; COUNT is live both before and after DEST, but not while DEST is
355 ;; live).
356 (:temporary (:sc any-reg :offset ocfp-offset :to :eval) count)
357 (:temporary (:sc any-reg :offset ocfp-offset :from :eval) dest)
358 (:temporary (:sc descriptor-reg :offset r8-offset) temp)
359 (:info fixed)
360 (:generator 20
361 ;; We open up with a LET to obtain a TN for NFP. We'll call it
362 ;; RESULT, to distinguish it from NFP-as-NFP and to roughly
363 ;; parallel the PPC implementation. We can't use a :TEMPORARY
364 ;; here because it would conflict with the existing NFP if there
365 ;; is a number-stack frame in play, but we only use it prior to
366 ;; actually setting up the "real" NFP.
367 (let ((result (make-random-tn :kind :normal
368 :sc (sc-or-lose 'any-reg)
369 :offset nfp-offset)))
370 ;; And we use ASSEMBLE here so that we get "implcit labels"
371 ;; rather than having to use GEN-LABEL and EMIT-LABEL.
372 (assemble ()
373 ;; Compute the end of the fixed stack frame (start of the MORE
374 ;; arg area) into RESULT.
375 (inst add result cfp-tn (add-sub-immediate
376 (* n-word-bytes (sb-allocated-size 'control-stack))))
377 ;; Compute the end of the MORE arg area (and our overall frame
378 ;; allocation) into the stack pointer.
379 (cond ((zerop fixed)
380 (inst add dest result (lsl nargs-tn (- word-shift n-fixnum-tag-bits)))
381 (move csp-tn dest)
382 (inst cbz nargs-tn done))
384 (inst subs count nargs-tn (fixnumize fixed))
385 (inst csel csp-tn result csp-tn :le)
386 (inst b :le DONE)
387 (inst add dest result (lsl count (- word-shift n-fixnum-tag-bits)))
388 (move csp-tn dest)))
390 (when (< fixed register-arg-count)
391 ;; We must stop when we run out of stack args, not when we
392 ;; run out of more args.
393 (inst add result result (* (- register-arg-count fixed) n-word-bytes)))
395 ;; We are copying at most (- NARGS FIXED) values, from last to
396 ;; first, in order to shift them out of the allocated part of
397 ;; the stack frame. The FIXED values remain where they are,
398 ;; as they are part of the allocated stack frame. Any
399 ;; remaining values are being moved to just beyond the end of
400 ;; the allocated stack frame, for a distance of (-
401 ;; (sb-allocated-size 'control-stack) fixed) words. There is
402 ;; a constant displacement of a single word in the loop below,
403 ;; because DEST points to the space AFTER the value being
404 ;; moved.
406 LOOP
407 (let ((delta (- (sb-allocated-size 'control-stack) fixed)))
408 (cond ((zerop delta)) ;; nothing to move
409 ((plusp delta) ;; copy backward
410 (inst cmp dest result)
411 (inst b :le DO-REGS)
412 (inst ldr temp (@ dest (load-store-offset
413 (- (* (1+ delta) n-word-bytes)))))
414 (inst str temp (@ dest (- n-word-bytes) :pre-index))
415 (inst b LOOP))
416 (t ;; copy forward
417 (inst cmp dest result)
418 (inst b :le DO-REGS)
419 (inst ldr temp (@ result (load-store-offset
420 (- (* delta n-word-bytes)))))
421 (inst str temp (@ result n-word-bytes :post-index))
422 (inst b LOOP))))
424 DO-REGS
425 (when (< fixed register-arg-count)
426 ;; Now we have to deposit any more args that showed up in registers.
427 (inst subs count nargs-tn (fixnumize fixed))
428 (do ((i fixed (1+ i)))
429 ((>= i register-arg-count))
430 ;; Don't deposit any more than there are.
431 (inst b :eq DONE)
432 (inst subs count count (fixnumize 1))
433 ;; Store it into the space reserved to it, by displacement
434 ;; from the frame pointer.
435 (storew (nth i *register-arg-tns*)
436 cfp-tn (+ (sb-allocated-size 'control-stack)
437 (- i fixed)))))
438 DONE
440 ;; Now that we're done with the &MORE args, we can set up the
441 ;; number stack frame.
442 (let ((nfp-tn (current-nfp-tn vop)))
443 (when nfp-tn
444 (inst sub nfp-tn nsp-tn (add-sub-immediate (bytes-needed-for-non-descriptor-stack-frame)))
445 (inst mov-sp nsp-tn nfp-tn)))))))
447 ;;; More args are stored consecutively on the stack, starting
448 ;;; immediately at the context pointer. The context pointer is not
449 ;;; typed, so the lowtag is 0.
450 (define-full-reffer more-arg * 0 0 (descriptor-reg any-reg) * %more-arg)
452 ;;; Turn more arg (context, count) into a list.
453 (define-vop (listify-rest-args)
454 (:args (context-arg :target context :scs (descriptor-reg))
455 (count-arg :target count :scs (any-reg)))
456 (:arg-types * tagged-num)
457 (:temporary (:scs (any-reg) :from (:argument 0)) context)
458 (:temporary (:scs (any-reg) :from (:argument 1)) count)
459 (:temporary (:scs (descriptor-reg) :from :eval) temp)
460 (:temporary (:scs (any-reg) :from :eval) dst)
461 (:temporary (:sc non-descriptor-reg) pa-flag)
462 (:temporary (:scs (interior-reg)) lip)
463 (:results (result :scs (descriptor-reg)))
464 (:translate %listify-rest-args)
465 (:policy :safe)
466 (:node-var node)
467 (:generator 20
468 (move context context-arg)
469 (move count count-arg)
470 ;; Check to see if there are any arguments.
471 (move result null-tn)
472 (inst cbz count DONE)
474 ;; We need to do this atomically.
475 (pseudo-atomic (pa-flag)
476 ;; Allocate a cons (2 words) for each item.
477 (let* ((dx-p (node-stack-allocate-p node))
478 (size (cond (dx-p
479 (lsl count (1+ (- word-shift n-fixnum-tag-bits))))
481 (inst lsl temp count (1+ (- word-shift n-fixnum-tag-bits)))
482 temp))))
483 (allocation dst size list-pointer-lowtag
484 :flag-tn pa-flag
485 :stack-allocate-p dx-p
486 :lip lip))
487 (move result dst)
489 (inst b ENTER)
491 ;; Compute the next cons and store it in the current one.
492 LOOP
493 (inst add dst dst (* 2 n-word-bytes))
494 (storew dst dst -1 list-pointer-lowtag)
496 ;; Grab one value.
497 ENTER
498 (inst ldr temp (@ context n-word-bytes :post-index))
500 ;; Dec count, and if != zero, go back for more.
501 (inst subs count count (fixnumize 1))
502 ;; Store the value into the car of the current cons.
503 (storew temp dst 0 list-pointer-lowtag)
504 (inst b :gt LOOP)
506 ;; NIL out the last cons.
507 (storew null-tn dst 1 list-pointer-lowtag))
508 DONE))
510 ;;; Return the location and size of the more arg glob created by
511 ;;; Copy-More-Arg. Supplied is the total number of arguments supplied
512 ;;; (originally passed in NARGS.) Fixed is the number of non-rest
513 ;;; arguments.
515 ;;; We must duplicate some of the work done by Copy-More-Arg, since at
516 ;;; that time the environment is in a pretty brain-damaged state,
517 ;;; preventing this info from being returned as values. What we do is
518 ;;; compute supplied - fixed, and return a pointer that many words
519 ;;; below the current stack top.
520 (define-vop (more-arg-context)
521 (:policy :fast-safe)
522 (:translate sb!c::%more-arg-context)
523 (:args (supplied :scs (any-reg)))
524 (:arg-types tagged-num (:constant fixnum))
525 (:info fixed)
526 (:results (context :scs (descriptor-reg))
527 (count :scs (any-reg)))
528 (:result-types t tagged-num)
529 (:note "more-arg-context")
530 (:generator 5
531 (inst sub count supplied (fixnumize fixed))
532 (inst sub context csp-tn (lsl count (- word-shift n-fixnum-tag-bits)))))
534 (define-vop (verify-arg-count)
535 (:policy :fast-safe)
536 (:args (nargs :scs (any-reg)))
537 (:arg-types positive-fixnum (:constant t) (:constant t))
538 (:info min max)
539 (:vop-var vop)
540 (:save-p :compute-only)
541 (:generator 3
542 (let ((err-lab
543 (generate-error-code vop 'invalid-arg-count-error)))
544 (labels ((load-immediate (x)
545 (add-sub-immediate (fixnumize x)))
546 (check-min ()
547 (cond ((= min 1)
548 (inst cbz nargs err-lab))
549 ((plusp min)
550 (inst cmp nargs (load-immediate min))
551 (inst b :lo err-lab)))))
552 (cond ((eql max 0)
553 (inst cbnz nargs err-lab))
554 ((not min)
555 (inst cmp nargs (load-immediate max))
556 (inst b :ne err-lab))
557 (max
558 (check-min)
559 (inst cmp nargs (load-immediate max))
560 (inst b :hi err-lab))
562 (check-min)))))))
564 ;;;; Local call with unknown values convention return:
566 ;;; Non-TR local call for a fixed number of values passed according to the
567 ;;; unknown values convention.
569 ;;; Args are the argument passing locations, which are specified only to
570 ;;; terminate their lifetimes in the caller.
572 ;;; Values are the return value locations (wired to the standard passing
573 ;;; locations).
575 ;;; Save is the save info, which we can ignore since saving has been done.
576 ;;; Return-PC is the TN that the return PC should be passed in.
577 ;;; Target is a continuation pointing to the start of the called function.
578 ;;; Nvals is the number of values received.
580 ;;; Note: we can't use normal load-tn allocation for the fixed args, since all
581 ;;; registers may be tied up by the more operand. Instead, we use
582 ;;; MAYBE-LOAD-STACK-TN.
583 (define-vop (call-local)
584 (:args (fp)
585 (nfp)
586 (args :more t))
587 (:results (values :more t))
588 (:save-p t)
589 (:move-args :local-call)
590 (:info arg-locs callee target nvals)
591 (:vop-var vop)
592 (:temporary (:scs (descriptor-reg) :from (:eval 0)) move-temp)
593 (:temporary (:scs (non-descriptor-reg)) temp)
594 (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)
595 (:temporary (:sc any-reg :offset ocfp-offset :from (:eval 0)) ocfp)
596 (:temporary (:scs (interior-reg)) lip)
597 (:ignore arg-locs args ocfp)
598 (:generator 5
599 (let ((label (gen-label))
600 (cur-nfp (current-nfp-tn vop)))
601 (when cur-nfp
602 (store-stack-tn nfp-save cur-nfp))
603 (let ((callee-nfp (callee-nfp-tn callee)))
604 (when callee-nfp
605 (maybe-load-stack-tn callee-nfp nfp)))
606 (maybe-load-stack-tn cfp-tn fp)
607 (inst compute-lra lip lip label)
608 (store-stack-tn (callee-return-pc-tn callee) lip)
609 (note-this-location vop :call-site)
610 (inst b target)
611 (emit-return-pc label)
612 (default-unknown-values vop values nvals move-temp temp lip label)
613 ;; alpha uses (maybe-load-stack-nfp-tn cur-nfp nfp-save temp)
614 ;; instead of the clause below
615 (when cur-nfp
616 (load-stack-tn cur-nfp nfp-save)))))
619 ;;; Non-TR local call for a variable number of return values passed according
620 ;;; to the unknown values convention. The results are the start of the values
621 ;;; glob and the number of values received.
623 ;;; Note: we can't use normal load-tn allocation for the fixed args, since all
624 ;;; registers may be tied up by the more operand. Instead, we use
625 ;;; MAYBE-LOAD-STACK-TN.
626 (define-vop (multiple-call-local unknown-values-receiver)
627 (:args (fp)
628 (nfp)
629 (args :more t))
630 (:save-p t)
631 (:move-args :local-call)
632 (:info save callee target)
633 (:ignore args save)
634 (:vop-var vop)
635 (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)
636 (:temporary (:scs (non-descriptor-reg)) temp)
637 (:temporary (:scs (interior-reg)) lip)
638 (:generator 20
639 (let ((label (gen-label))
640 (cur-nfp (current-nfp-tn vop)))
641 (when cur-nfp
642 (store-stack-tn nfp-save cur-nfp))
643 (let ((callee-nfp (callee-nfp-tn callee)))
644 ;; alpha doesn't test this before the maybe-load
645 (when callee-nfp
646 (maybe-load-stack-tn callee-nfp nfp)))
647 (maybe-load-stack-tn cfp-tn fp)
648 (inst compute-lra lip lip label)
649 (store-stack-tn (callee-return-pc-tn callee) lip)
650 (note-this-location vop :call-site)
651 (inst b target)
652 (emit-return-pc label)
653 (note-this-location vop :unknown-return)
654 (receive-unknown-values values-start nvals start count label temp lip)
655 (when cur-nfp
656 (load-stack-tn cur-nfp nfp-save)))))
658 ;;;; Local call with known values return:
660 ;;; Non-TR local call with known return locations. Known-value return works
661 ;;; just like argument passing in local call.
663 ;;; Note: we can't use normal load-tn allocation for the fixed args, since all
664 ;;; registers may be tied up by the more operand. Instead, we use
665 ;;; MAYBE-LOAD-STACK-TN.
666 (define-vop (known-call-local)
667 (:args (fp)
668 (nfp)
669 (args :more t))
670 (:results (res :more t))
671 (:move-args :local-call)
672 (:save-p t)
673 (:info save callee target)
674 (:ignore args res save)
675 (:vop-var vop)
676 (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)
677 (:temporary (:scs (interior-reg)) lip)
678 (:generator 5
679 (let ((label (gen-label))
680 (cur-nfp (current-nfp-tn vop)))
681 (when cur-nfp
682 (store-stack-tn nfp-save cur-nfp))
683 (let ((callee-nfp (callee-nfp-tn callee)))
684 (when callee-nfp
685 (maybe-load-stack-tn callee-nfp nfp)))
686 (maybe-load-stack-tn cfp-tn fp)
687 (inst compute-lra lip lip label)
688 (store-stack-tn (callee-return-pc-tn callee) lip)
689 (note-this-location vop :call-site)
690 (inst b target)
691 (emit-return-pc label)
692 (note-this-location vop :known-return)
693 (when cur-nfp
694 (load-stack-tn cur-nfp nfp-save)))))
696 ;;; Return from known values call. We receive the return locations as
697 ;;; arguments to terminate their lifetimes in the returning function. We
698 ;;; restore FP and CSP and jump to the Return-PC.
700 ;;; Note: we can't use normal load-tn allocation for the fixed args, since all
701 ;;; registers may be tied up by the more operand. Instead, we use
702 ;;; MAYBE-LOAD-STACK-TN.
703 (define-vop (known-return)
704 (:args (old-fp :target old-fp-temp)
705 (return-pc :target return-pc-temp)
706 (vals :more t))
707 (:temporary (:sc any-reg :from (:argument 0)) old-fp-temp)
708 (:temporary (:sc descriptor-reg :from (:argument 1)) return-pc-temp)
709 (:temporary (:scs (interior-reg)) lip)
710 (:move-args :known-return)
711 (:info val-locs)
712 (:ignore val-locs vals)
713 (:vop-var vop)
714 (:generator 6
715 (maybe-load-stack-tn old-fp-temp old-fp)
716 (maybe-load-stack-tn return-pc-temp return-pc)
717 (move csp-tn cfp-tn)
718 (let ((cur-nfp (current-nfp-tn vop)))
719 (when cur-nfp
720 (inst add cur-nfp cur-nfp (add-sub-immediate
721 (bytes-needed-for-non-descriptor-stack-frame)))
722 (inst mov-sp nsp-tn cur-nfp)))
723 (move cfp-tn old-fp-temp)
724 (lisp-return return-pc-temp lip :known)))
726 ;;;; Full call:
728 ;;; There is something of a cross-product effect with full calls.
729 ;;; Different versions are used depending on whether we know the
730 ;;; number of arguments or the name of the called function, and
731 ;;; whether we want fixed values, unknown values, or a tail call.
733 ;;; In full call, the arguments are passed creating a partial frame on
734 ;;; the stack top and storing stack arguments into that frame. On
735 ;;; entry to the callee, this partial frame is pointed to by FP. If
736 ;;; there are no stack arguments, we don't bother allocating a partial
737 ;;; frame, and instead set FP to SP just before the call.
739 ;;; This macro helps in the definition of full call VOPs by avoiding code
740 ;;; replication in defining the cross-product VOPs.
742 ;;; Name is the name of the VOP to define.
744 ;;; Named is true if the first argument is a symbol whose global function
745 ;;; definition is to be called.
747 ;;; Return is either :Fixed, :Unknown or :Tail:
748 ;;; -- If :Fixed, then the call is for a fixed number of values, returned in
749 ;;; the standard passing locations (passed as result operands).
750 ;;; -- If :Unknown, then the result values are pushed on the stack, and the
751 ;;; result values are specified by the Start and Count as in the
752 ;;; unknown-values continuation representation.
753 ;;; -- If :Tail, then do a tail-recursive call. No values are returned.
754 ;;; The Old-Fp and Return-PC are passed as the second and third arguments.
756 ;;; In non-tail calls, the pointer to the stack arguments is passed as the last
757 ;;; fixed argument. If Variable is false, then the passing locations are
758 ;;; passed as a more arg. Variable is true if there are a variable number of
759 ;;; arguments passed on the stack. Variable cannot be specified with :Tail
760 ;;; return. TR variable argument call is implemented separately.
762 ;;; In tail call with fixed arguments, the passing locations are passed as a
763 ;;; more arg, but there is no new-FP, since the arguments have been set up in
764 ;;; the current frame.
765 (defmacro define-full-call (name named return variable)
766 (aver (not (and variable (eq return :tail))))
767 `(define-vop (,name
768 ,@(when (eq return :unknown)
769 '(unknown-values-receiver)))
770 (:args
771 ,@(unless (eq return :tail)
772 '((new-fp :scs (any-reg) :to :eval)))
774 ,(if named
775 '(name :target name-pass)
776 '(arg-fun :target lexenv))
778 ,@(when (eq return :tail)
779 '((old-fp)
780 (return-pc)))
782 ,@(unless variable '((args :more t :scs (descriptor-reg)))))
784 ,@(when (eq return :fixed)
785 '((:results (values :more t))))
787 (:save-p ,(if (eq return :tail) :compute-only t))
789 ,@(unless (or (eq return :tail) variable)
790 '((:move-args :full-call)))
792 (:vop-var vop)
793 (:info ,@(unless (or variable (eq return :tail)) '(arg-locs))
794 ,@(unless variable '(nargs))
795 ,@(when (eq return :fixed) '(nvals))
796 step-instrumenting)
798 (:ignore
799 ,@(when (eq return :fixed) '(ocfp-temp))
800 ,@(unless (or variable (eq return :tail)) '(arg-locs))
801 ,@(unless variable '(args))
802 ,@(when (eq return :tail) '(old-fp)))
804 (:temporary (:sc descriptor-reg :offset lexenv-offset
805 :from (:argument ,(if (eq return :tail) 0 1))
806 :to :eval)
807 ,(if named 'name-pass 'lexenv))
809 (:temporary (:scs (descriptor-reg) :to :eval)
810 function)
811 (:temporary (:sc any-reg :offset nargs-offset :to :eval)
812 nargs-pass)
814 ,@(when variable
815 (mapcar #'(lambda (name offset)
816 `(:temporary (:sc descriptor-reg
817 :offset ,offset
818 :to :result)
819 ,name))
820 *register-arg-names* *register-arg-offsets*))
821 ,@(when (eq return :fixed)
822 '((:temporary (:scs (descriptor-reg) :from :eval) move-temp)
823 (:temporary (:sc any-reg :from :eval :offset ocfp-offset) ocfp-temp)))
825 ,@(unless (eq return :tail)
826 '((:temporary (:scs (non-descriptor-reg)) temp)
827 (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)))
829 (:temporary (:scs (interior-reg)) lip)
831 (:generator ,(+ (if named 5 0)
832 (if variable 19 1)
833 (if (eq return :tail) 0 10)
835 (if (eq return :unknown) 25 0))
836 (let* ((cur-nfp (current-nfp-tn vop))
837 ,@(unless (eq return :tail)
838 '((lra-label (gen-label))))
839 (filler
840 (remove nil
841 (list ,@(if (eq return :tail)
842 '(:load-nargs
843 (unless (location= return-pc
844 (make-random-tn :kind :normal
845 :sc (sc-or-lose 'control-stack)
846 :offset lra-save-offset))
847 :load-return-pc)
848 (when cur-nfp
849 :frob-nfp))
850 '(:load-nargs
851 :comp-lra
852 (when cur-nfp
853 :frob-nfp)
854 :load-fp))))))
855 (flet ((do-next-filler ()
856 (let* ((next (pop filler))
857 (what (if (consp next) (car next) next)))
858 (ecase what
859 (:load-nargs
860 ,@(if variable
861 `((move nargs-pass csp-tn)
862 ;; The variable args are on the stack
863 ;; and become the frame, but there may
864 ;; be <4 args and 2 stack slots are
865 ;; assumed allocate on the call. So
866 ;; need to ensure there are at least 2
867 ;; slots. This just adds 2 more.
868 (inst add csp-tn nargs-pass (* 2 n-word-bytes))
869 (inst sub nargs-pass nargs-pass new-fp)
870 (inst asr nargs-pass nargs-pass (- word-shift n-fixnum-tag-bits))
871 ,@(do ((arg *register-arg-names* (cddr arg))
872 (i 0 (+ i 2))
873 (insts))
874 ((null arg) (nreverse insts))
875 #.(assert (evenp register-arg-count))
876 (push `(inst ldp ,(first arg) ,(second arg)
877 (@ new-fp ,(* i n-word-bytes)))
878 insts))
879 (storew cfp-tn new-fp ocfp-save-offset))
880 '((inst mov nargs-pass (fixnumize nargs)))))
881 ,@(if (eq return :tail)
882 '((:load-return-pc
883 (error "RETURN-PC not in its passing location"))
884 (:frob-nfp
885 (inst add cur-nfp cur-nfp (add-sub-immediate
886 (bytes-needed-for-non-descriptor-stack-frame)))
887 (inst mov-sp nsp-tn cur-nfp)))
888 `((:comp-lra
889 (inst compute-lra lip lip lra-label)
890 (inst str lip (@ new-fp (* lra-save-offset
891 n-word-bytes))))
892 (:frob-nfp
893 (store-stack-tn nfp-save cur-nfp))
894 (:load-fp
895 (move cfp-tn new-fp))))
896 ((nil)))))
897 (insert-step-instrumenting (callable-tn)
898 ;; Conditionally insert a conditional trap:
899 (when step-instrumenting
900 (assemble ()
901 #!-sb-thread
902 (load-symbol-value tmp-tn sb!impl::*stepping*)
903 #!+sb-thread
904 (loadw tmp-tn thread-tn thread-stepping-slot)
905 (inst cbz tmp-tn step-done-label)
906 ;; CONTEXT-PC will be pointing here when the
907 ;; interrupt is handled, not after the
908 ;; DEBUG-TRAP.
909 (note-this-location vop :step-before-vop)
910 ;; Best-guess at a usable trap. x86oids don't
911 ;; have much more than this, SPARC, MIPS, PPC
912 ;; and HPPA encode (TN-OFFSET CALLABLE-TN),
913 ;; Alpha ignores stepping entirely.
914 (inst brk single-step-around-trap)
915 (inst byte (tn-offset callable-tn))
916 (emit-alignment 2)
918 STEP-DONE-LABEL))))
921 ,@(if named
922 `((sc-case name
923 (descriptor-reg (move name-pass name))
924 (control-stack
925 (load-stack-tn name-pass name)
926 (do-next-filler))
927 (constant
928 (load-constant vop name name-pass)
929 (do-next-filler)))
930 (do-next-filler)
931 (insert-step-instrumenting name-pass))
932 `((sc-case arg-fun
933 (descriptor-reg (move lexenv arg-fun))
934 (control-stack
935 (load-stack-tn lexenv arg-fun)
936 (do-next-filler))
937 (constant
938 (load-constant vop arg-fun lexenv)
939 (do-next-filler)))
940 (loadw function lexenv closure-fun-slot
941 fun-pointer-lowtag)
942 (do-next-filler)
943 (insert-step-instrumenting lip)))
944 (loop
945 (if filler
946 (do-next-filler)
947 (return)))
948 ,@(if named
949 ;; raw-addr is an untagged pointer to the function,
950 ;; need to pair it up with the tagged pointer for the GC to see
951 `((loadw function name-pass fdefn-fun-slot
952 other-pointer-lowtag)
953 (loadw lip name-pass fdefn-raw-addr-slot
954 other-pointer-lowtag))
955 `((inst add lip function
956 (- (ash simple-fun-code-offset word-shift)
957 fun-pointer-lowtag))))
959 (note-this-location vop :call-site)
960 (inst br lip))
962 ,@(ecase return
963 (:fixed
964 '((emit-return-pc lra-label)
965 (default-unknown-values vop values nvals move-temp
966 temp lip lra-label)
967 (when cur-nfp
968 (load-stack-tn cur-nfp nfp-save))))
969 (:unknown
970 '((emit-return-pc lra-label)
971 (note-this-location vop :unknown-return)
972 (receive-unknown-values values-start nvals start count
973 lra-label temp lip)
974 (when cur-nfp
975 (load-stack-tn cur-nfp nfp-save))))
976 (:tail))))))
978 (define-full-call call nil :fixed nil)
979 (define-full-call call-named t :fixed nil)
980 (define-full-call multiple-call nil :unknown nil)
981 (define-full-call multiple-call-named t :unknown nil)
982 (define-full-call tail-call nil :tail nil)
983 (define-full-call tail-call-named t :tail nil)
985 (define-full-call call-variable nil :fixed t)
986 (define-full-call multiple-call-variable nil :unknown t)
988 ;;; Defined separately, since needs special code that BLT's the
989 ;;; arguments down.
990 (define-vop (tail-call-variable)
991 (:args
992 (args-arg :scs (any-reg) :target args)
993 (function-arg :scs (descriptor-reg) :target lexenv)
994 (old-fp-arg :scs (any-reg) :load-if nil)
995 (lra-arg :scs (descriptor-reg) :load-if nil))
996 (:temporary (:sc any-reg :offset nl2-offset :from (:argument 0)) args)
997 (:temporary (:sc descriptor-reg :offset lexenv-offset :from (:argument 1)) lexenv)
998 (:temporary (:scs (interior-reg)) lip)
999 (:ignore old-fp-arg lra-arg)
1000 (:vop-var vop)
1001 (:generator 75
1002 ;; Move these into the passing locations if they are not already there.
1003 (move args args-arg)
1004 (move lexenv function-arg)
1005 ;; Clear the number stack if anything is there.
1006 (let ((cur-nfp (current-nfp-tn vop)))
1007 (when cur-nfp
1008 (inst add cur-nfp cur-nfp (add-sub-immediate
1009 (bytes-needed-for-non-descriptor-stack-frame)))
1010 (inst mov-sp nsp-tn cur-nfp)))
1011 (load-inline-constant tmp-tn '(:fixup tail-call-variable :assembly-routine) lip)
1012 (inst br tmp-tn)))
1014 ;;;; Unknown values return:
1016 ;;; Return a single value using the unknown-values convention.
1017 (define-vop (return-single)
1018 (:args (old-fp :scs (any-reg) :to :eval)
1019 (return-pc :scs (descriptor-reg))
1020 (value))
1021 (:temporary (:scs (interior-reg)) lip)
1022 (:ignore value)
1023 (:vop-var vop)
1024 (:generator 6
1025 ;; Clear the number stack.
1026 (let ((cur-nfp (current-nfp-tn vop)))
1027 (when cur-nfp
1028 (inst add cur-nfp cur-nfp (add-sub-immediate
1029 (bytes-needed-for-non-descriptor-stack-frame)))
1030 (inst mov-sp nsp-tn cur-nfp)))
1031 ;; Clear the control stack, and restore the frame pointer.
1032 (move csp-tn cfp-tn)
1033 (move cfp-tn old-fp)
1035 ;; Out of here.
1036 (lisp-return return-pc lip :single-value)))
1038 ;;; Do unknown-values return of a fixed number of values. The Values are
1039 ;;; required to be set up in the standard passing locations. Nvals is the
1040 ;;; number of values returned.
1042 ;;; If returning a single value, then deallocate the current frame, restore
1043 ;;; FP and jump to the single-value entry at Return-PC + 8.
1045 ;;; If returning other than one value, then load the number of values returned,
1046 ;;; NIL out unsupplied values registers, restore FP and return at Return-PC.
1047 ;;; When there are stack values, we must initialize the argument pointer to
1048 ;;; point to the beginning of the values block (which is the beginning of the
1049 ;;; current frame.)
1050 (define-vop (return)
1051 (:args
1052 (old-fp :scs (any-reg))
1053 (return-pc :scs (descriptor-reg) :to (:eval 1))
1054 (values :more t))
1055 (:ignore values)
1056 (:info nvals)
1057 (:temporary (:sc descriptor-reg :offset r0-offset :from (:eval 0)) r0)
1058 (:temporary (:sc descriptor-reg :offset r1-offset :from (:eval 0)) r1)
1059 (:temporary (:sc descriptor-reg :offset r2-offset :from (:eval 0)) r2)
1060 (:temporary (:sc descriptor-reg :offset r3-offset :from (:eval 0)) r3)
1061 (:temporary (:sc interior-reg) lip)
1062 (:temporary (:sc any-reg :offset nargs-offset) nargs)
1063 (:temporary (:sc any-reg :offset ocfp-offset) val-ptr)
1064 (:vop-var vop)
1065 (:generator 6
1066 ;; Clear the number stack.
1067 (let ((cur-nfp (current-nfp-tn vop)))
1068 (when cur-nfp
1069 (inst add cur-nfp cur-nfp (add-sub-immediate
1070 (bytes-needed-for-non-descriptor-stack-frame)))
1071 (inst mov-sp nsp-tn cur-nfp)))
1072 (cond ((= nvals 1)
1073 ;; Clear the control stack, and restore the frame pointer.
1074 (move csp-tn cfp-tn)
1075 (move cfp-tn old-fp)
1076 ;; Out of here.
1077 (lisp-return return-pc lip :single-value))
1079 ;; Establish the values pointer.
1080 (move val-ptr cfp-tn)
1081 ;; restore the frame pointer and clear as much of the control
1082 ;; stack as possible.
1083 (move cfp-tn old-fp)
1084 (inst add csp-tn val-ptr (add-sub-immediate (* nvals n-word-bytes)))
1085 ;; Establish the values count.
1086 (load-immediate-word nargs (fixnumize nvals))
1087 ;; pre-default any argument register that need it.
1088 (when (< nvals register-arg-count)
1089 (dolist (reg (subseq (list r0 r1 r2 r3) nvals))
1090 (move reg null-tn)))
1091 ;; And away we go.
1092 (lisp-return return-pc lip :multiple-values)))))
1094 ;;; Do unknown-values return of an arbitrary number of values (passed
1095 ;;; on the stack.) We check for the common case of a single return
1096 ;;; value, and do that inline using the normal single value return
1097 ;;; convention. Otherwise, we branch off to code that calls an
1098 ;;; assembly-routine.
1099 (define-vop (return-multiple)
1100 (:args
1101 (old-fp-arg :scs (any-reg) :to (:eval 1))
1102 (lra-arg :scs (descriptor-reg) :to (:eval 1))
1103 (vals-arg :scs (any-reg) :target vals)
1104 (nvals-arg :scs (any-reg) :target nvals))
1105 (:temporary (:sc any-reg :offset nl2-offset :from (:argument 0)) old-fp)
1106 (:temporary (:sc descriptor-reg :offset r6-offset :from (:argument 1)) lra)
1107 (:temporary (:sc any-reg :offset nl1-offset :from (:argument 2)) vals)
1108 (:temporary (:sc any-reg :offset nargs-offset :from (:argument 3)) nvals)
1109 (:temporary (:sc descriptor-reg :offset r0-offset) r0)
1110 (:temporary (:sc interior-reg) lip)
1111 (:vop-var vop)
1112 (:generator 13
1113 (move lra lra-arg)
1114 ;; Clear the number stack.
1115 (let ((cur-nfp (current-nfp-tn vop)))
1116 (when cur-nfp
1117 (inst add cur-nfp cur-nfp (add-sub-immediate
1118 (bytes-needed-for-non-descriptor-stack-frame)))
1119 (inst mov-sp nsp-tn cur-nfp)))
1121 ;; Check for the single case.
1122 (inst cmp nvals-arg (fixnumize 1))
1123 (inst b :ne NOT-SINGLE)
1125 ;; Return with one value.
1126 (inst ldr r0 (@ vals-arg))
1127 (move csp-tn cfp-tn)
1128 (move cfp-tn old-fp-arg)
1129 (lisp-return lra lip :single-value)
1131 NOT-SINGLE
1132 (move old-fp old-fp-arg)
1133 (move vals vals-arg)
1134 (move nvals nvals-arg)
1135 (load-inline-constant tmp-tn '(:fixup return-multiple :assembly-routine) lip)
1136 (inst br tmp-tn)))
1138 ;;; Single-stepping
1140 (define-vop (step-instrument-before-vop)
1141 (:policy :fast-safe)
1142 (:vop-var vop)
1143 (:generator 3
1144 #!-sb-thread
1145 (load-symbol-value tmp-tn sb!impl::*stepping*)
1146 #!+sb-thread
1147 (loadw tmp-tn thread-tn thread-stepping-slot)
1148 (inst cbz tmp-tn DONE)
1149 ;; CONTEXT-PC will be pointing here when the interrupt is handled,
1150 ;; not after the BREAK.
1151 (note-this-location vop :step-before-vop)
1152 ;; A best-guess effort at a debug trap suitable for a
1153 ;; single-step-before-trap.
1154 (inst brk single-step-before-trap)
1155 DONE))