1 ;;;; the VM definition of function call for the ARM
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.
14 ;;;; Interfaces to IR2 conversion:
16 ;;; Return a wired TN describing the N'th full call argument passing
18 (defun standard-arg-location (n)
19 (declare (type unsigned-byte n
))
20 (if (< n register-arg-count
)
21 (make-wired-tn *backend-t-primitive-type
* register-arg-scn
22 (elt *register-arg-offsets
* n
))
23 (make-wired-tn *backend-t-primitive-type
* control-stack-arg-scn n
)))
26 ;;; Make a passing location TN for a local call return PC. If
27 ;;; standard is true, then use the standard (full call) location,
28 ;;; otherwise use any legal location. Even in the non-standard case,
29 ;;; this may be restricted by a desire to use a subroutine call
31 (defun make-return-pc-passing-location (standard)
32 (declare (ignore standard
))
33 (make-wired-tn *backend-t-primitive-type
* control-stack-sc-number
36 ;;; This is similar to MAKE-RETURN-PC-PASSING-LOCATION, but makes a
37 ;;; location to pass OLD-FP in.
39 ;;; This is wired in both the standard and the local-call conventions,
40 ;;; because we want to be able to assume it's always there. Besides,
41 ;;; the ARM doesn't have enough registers to really make it profitable
42 ;;; to pass it in a register.
43 (defun make-old-fp-passing-location (standard)
44 (declare (ignore standard
))
45 (make-wired-tn *fixnum-primitive-type
* control-stack-sc-number
48 ;;; Make the TNs used to hold OLD-FP and RETURN-PC within the current
49 ;;; function. We treat these specially so that the debugger can find
50 ;;; them at a known location.
51 (defun make-old-fp-save-location (env)
52 ;; Unlike the other backends, ARM function calling is designed to
53 ;; pass OLD-FP within the stack frame rather than in a register. As
54 ;; such, in order for lifetime analysis not to screw up, we need it
55 ;; to be a stack TN wired to the save offset, not a normal TN with a
57 (physenv-debug-live-tn (make-wired-tn *fixnum-primitive-type
*
61 (defun make-return-pc-save-location (physenv)
62 (physenv-debug-live-tn
63 (make-wired-tn *backend-t-primitive-type
* control-stack-sc-number
67 ;;; Make a TN for the standard argument count passing location. We
68 ;;; only need to make the standard location, since a count is never
69 ;;; passed when we are using non-standard conventions.
70 (defun make-arg-count-location ()
71 (make-wired-tn *fixnum-primitive-type
* immediate-arg-scn nargs-offset
))
74 ;;; Make a TN to hold the number-stack frame pointer. This is
75 ;;; allocated once per component, and is component-live.
78 (make-wired-tn *fixnum-primitive-type
* immediate-arg-scn nfp-offset
)))
80 (defun make-stack-pointer-tn ()
81 (make-normal-tn *fixnum-primitive-type
*))
83 (defun make-number-stack-pointer-tn ()
84 (make-normal-tn *fixnum-primitive-type
*))
86 ;;; Return a list of TNs that can be used to represent an unknown-values
87 ;;; continuation within a function.
88 (defun make-unknown-values-locations ()
89 (list (make-stack-pointer-tn)
90 (make-normal-tn *fixnum-primitive-type
*)))
92 ;;; This function is called by the ENTRY-ANALYZE phase, allowing
93 ;;; VM-dependent initialization of the IR2-COMPONENT structure. We push
94 ;;; placeholder entries in the Constants to leave room for additional
95 ;;; noise in the code object header.
96 (defun select-component-format (component)
97 (declare (type component component
))
98 (dotimes (i code-constants-offset
)
99 (vector-push-extend nil
100 (ir2-component-constants (component-info component
))))
105 ;;; Return the number of bytes needed for the current non-descriptor
106 ;;; stack frame. What's this "PMAX" that almost every other backend
107 ;;; mentions, and why does it need 8-byte granularity?
108 (defun bytes-needed-for-non-descriptor-stack-frame ()
109 (* (sb-allocated-size 'non-descriptor-stack
)
112 ;;; Used for setting up the Old-FP in local call.
113 (define-vop (current-fp)
114 (:results
(val :scs
(any-reg)))
118 ;;; Used for computing the caller's NFP for use in known-values return. Only
119 ;;; works assuming there is no variable size stuff on the nstack.
120 (define-vop (compute-old-nfp)
121 (:results
(val :scs
(any-reg)))
124 (let ((nfp (current-nfp-tn vop
)))
126 ;; FIXME-ARM: taken form MIPS is this correct? (phs)
127 (inst add val nfp
(bytes-needed-for-non-descriptor-stack-frame))))))
129 ;;; Accessing a slot from an earlier stack frame is definite hackery.
130 (define-vop (ancestor-frame-ref)
131 (:args
(frame-pointer :scs
(descriptor-reg))
132 (variable-home-tn :load-if nil
))
133 (:results
(value :scs
(descriptor-reg any-reg
)))
136 (aver (sc-is variable-home-tn control-stack
))
137 (loadw value frame-pointer
(tn-offset variable-home-tn
))))
138 (define-vop (ancestor-frame-set)
139 (:args
(frame-pointer :scs
(descriptor-reg))
140 (value :scs
(descriptor-reg any-reg
)))
141 (:results
(variable-home-tn :load-if nil
))
144 (aver (sc-is variable-home-tn control-stack
))
145 (storew value frame-pointer
(tn-offset variable-home-tn
))))
147 (define-vop (xep-allocate-frame)
148 (:info start-lab copy-more-arg-follows
)
150 (:temporary
(:scs
(non-descriptor-reg)) temp
)
151 (:temporary
(:scs
(interior-reg)) lip
)
153 ;; Make sure the function is aligned, and drop a label pointing to this
155 (emit-alignment n-lowtag-bits
)
156 (trace-table-entry trace-table-fun-prologue
)
157 (emit-label start-lab
)
158 ;; Allocate function header.
159 (inst simple-fun-header-word
)
160 (dotimes (i (1- simple-fun-code-offset
))
162 (inst compute-code code-tn lip start-lab temp
)
163 ;; Build our stack frames.
164 (unless copy-more-arg-follows
165 (inst add temp cfp-tn
166 (* n-word-bytes
(sb-allocated-size 'control-stack
)))
168 (let ((nfp-tn (current-nfp-tn vop
)))
170 (let* ((nbytes (bytes-needed-for-non-descriptor-stack-frame)))
171 (inst sub nfp-tn nsp-tn nbytes
)
172 (move nsp-tn nfp-tn
)))))
173 (trace-table-entry trace-table-normal
)))
175 (define-vop (allocate-frame)
176 (:results
(res :scs
(any-reg))
177 (nfp :scs
(any-reg)))
180 (trace-table-entry trace-table-fun-prologue
)
182 (inst add nfp res
(* (max 1 (sb-allocated-size 'control-stack
))
185 (when (ir2-physenv-number-stack-p callee
)
186 (let* ((nbytes (bytes-needed-for-non-descriptor-stack-frame)))
187 (inst sub nfp nsp-tn nbytes
)
188 (inst mov nsp-tn nfp
)))
189 (trace-table-entry trace-table-normal
)))
191 ;;; Allocate a partial frame for passing stack arguments in a full call. Nargs
192 ;;; is the number of arguments passed. If no stack arguments are passed, then
193 ;;; we don't have to do anything.
194 (define-vop (allocate-full-call-frame)
196 (:results
(res :scs
(any-reg)))
197 (:temporary
(:sc any-reg
) csp-temp
)
199 ;; Unlike most other backends, we store the "OCFP" at frame
200 ;; allocation time rather than at function-entry time, largely due
201 ;; to a lack of usable registers.
203 (inst add csp-temp res
(* (max 1 nargs
) n-word-bytes
))
205 (storew cfp-tn res ocfp-save-offset
)))
207 ;;; Emit code needed at the return-point from an unknown-values call
208 ;;; for a fixed number of values. VALUES is the head of the TN-REF
209 ;;; list for the locations that the values are to be received into.
210 ;;; NVALS is the number of values that are to be received (should
211 ;;; equal the length of Values).
213 ;;; MOVE-TEMP is a DESCRIPTOR-REG TN used as a temporary.
215 ;;; This code exploits the fact that in the unknown-values convention,
216 ;;; a single value return returns with all of the condition flags
217 ;;; clear, whereas a return of other than one value returns with the
218 ;;; condition flags set.
220 ;;; If 0 or 1 values are expected, then we just emit an instruction to
221 ;;; reset the SP (which will only be executed when other than 1 value
224 ;;; In the general case, we have to do three things:
225 ;;; -- Default unsupplied register values. This need only be done when a
226 ;;; single value is returned, since register values are defaulted by the
227 ;;; callee in the non-single case.
228 ;;; -- Default unsupplied stack values. This needs to be done whenever there
229 ;;; are stack values.
230 ;;; -- Reset SP. This must be done whenever other than 1 value is returned,
231 ;;; regardless of the number of values desired.
233 (defun default-unknown-values (vop values nvals move-temp temp lip lra-label
)
234 (declare (type (or tn-ref null
) values
)
235 (type unsigned-byte nvals
) (type tn move-temp temp
))
236 (let ((expecting-values-on-stack (> nvals register-arg-count
))
237 (values-on-stack temp
))
238 (inst compute-code code-tn lip lra-label temp
)
239 ;; Pick off the single-value case first.
240 (sb!assem
:without-scheduling
()
241 (note-this-location vop
(if (<= nvals
1)
245 ;; Default register values for single-value return case.
246 ;; The callee returns with condition bits CLEAR in the
247 ;; single-value case.
250 (val (tn-ref-across values
) (tn-ref-across val
)))
251 ((= i
(min nvals register-arg-count
)))
252 (inst mov
:ne
(tn-ref-tn val
) null-tn
)))
254 ;; If we're not expecting values on the stack, all that
255 ;; remains is to clear the stack frame (for the multiple-
256 ;; value return case).
257 (unless expecting-values-on-stack
258 (store-csp ocfp-tn
:eq
))
260 ;; If we ARE expecting values on the stack, we need to
261 ;; either move them to their result location or to set their
262 ;; result location to the default.
263 (when expecting-values-on-stack
265 ;; For the single-value return case, fake up NARGS and
266 ;; OCFP so that we don't screw ourselves with the
267 ;; defaulting and stack clearing logic.
268 (load-csp ocfp-tn
:ne
)
269 (inst mov
:ne nargs-tn n-word-bytes
)
271 ;; Compute the number of stack values (may be negative if
272 ;; not all of the register values are populated).
273 (inst sub values-on-stack nargs-tn
(fixnumize register-arg-count
))
275 ;; For each expected stack value...
276 (do ((i register-arg-count
(1+ i
))
277 (val (do ((i 0 (1+ i
))
278 (val values
(tn-ref-across val
)))
279 ((= i register-arg-count
) val
))
280 (tn-ref-across val
)))
283 ;; ... Load it if there is a stack value available, or
284 ;; default it if there isn't.
285 (inst subs values-on-stack values-on-stack
4)
286 (loadw move-temp ocfp-tn i
0 :ge
)
287 (store-stack-tn (tn-ref-tn val
) move-temp
:ge
)
288 (store-stack-tn (tn-ref-tn val
) null-tn
:lt
))
290 ;; Deallocate the callee stack frame.
291 (store-csp ocfp-tn
))))
294 ;;;; Unknown values receiving:
296 ;;; Emit code needed at the return point for an unknown-values call for an
297 ;;; arbitrary number of values.
299 ;;; We do the single and non-single cases with no shared code: there doesn't
300 ;;; seem to be any potential overlap, and receiving a single value is more
301 ;;; important efficiency-wise.
303 ;;; When there is a single value, we just push it on the stack, returning
304 ;;; the old SP and 1.
306 ;;; When there is a variable number of values, we move all of the argument
307 ;;; registers onto the stack, and return Args and Nargs.
309 ;;; Args and Nargs are TNs wired to the named locations. We must
310 ;;; explicitly allocate these TNs, since their lifetimes overlap with the
311 ;;; results Start and Count (also, it's nice to be able to target them).
312 (defun receive-unknown-values (args nargs start count lra-label temp lip
)
313 (declare (type tn args nargs start count temp
))
314 (inst compute-code code-tn lip lra-label temp
)
316 (inst add
:ne temp nargs n-word-bytes
)
318 (inst str
:ne
(first *register-arg-tns
*) (@ nargs
))
319 (inst mov
:ne start nargs
)
320 (inst mov
:ne count
(fixnumize 1))
321 (do ((arg *register-arg-tns
* (rest arg
))
324 (storew (first arg
) args i
0 :eq
))
325 (move start args
:eq
)
326 (move count nargs
:eq
)
330 ;;; VOP that can be inherited by unknown values receivers. The main
331 ;;; thing this handles is allocation of the result temporaries.
332 (define-vop (unknown-values-receiver)
334 (start :scs
(any-reg))
335 (count :scs
(any-reg)))
336 (:temporary
(:sc descriptor-reg
:offset ocfp-offset
337 :from
:eval
:to
(:result
0))
339 (:temporary
(:sc any-reg
:offset nargs-offset
340 :from
:eval
:to
(:result
1))
342 (:temporary
(:scs
(non-descriptor-reg)) temp
))
344 ;;; This hook in the codegen pass lets us insert code before fall-thru entry
345 ;;; points, local-call entry points, and tail-call entry points. The default
347 (defun emit-block-header (start-label trampoline-label fall-thru-p alignp
)
348 (declare (ignore fall-thru-p alignp
))
349 (when trampoline-label
350 (emit-label trampoline-label
))
351 (emit-label start-label
))
356 ;;; We don't need to do anything special for regular functions.
358 (define-vop (setup-environment)
362 ;; Don't bother doing anything.
365 ;;; Get the lexical environment from its passing location.
366 (define-vop (setup-closure-environment)
367 (:temporary
(:sc descriptor-reg
:offset lexenv-offset
:target closure
370 (:results
(closure :scs
(descriptor-reg)))
375 (move closure lexenv
)))
377 ;;; Copy a more arg from the argument area to the end of the current frame.
378 ;;; Fixed is the number of non-more arguments.
379 (define-vop (copy-more-arg)
380 ;; The environment here-and-now is not properly initialized. The
381 ;; stack frame is not yet fully allocated, and even if it were most
382 ;; of the slots have live data in them that PACK does not know
383 ;; about, so we cannot afford a register spill. As far as the boxed
384 ;; registers go, the arg-passing registers (R0, R1, and R2) are
385 ;; live, LEXENV is live, and LRA is live. On the unboxed front,
386 ;; NARGS is live. FP has been set up by the caller, SP is
387 ;; protecting our stack arguments, but is otherwise not set up. NFP
388 ;; is not yet set up. CODE and NULL are set up. SP and NFP must be
389 ;; correctly set up by the time we're done, and OCFP and R8 are
390 ;; available for use as temporaries. If we were any more register
391 ;; constrained, we'd be spilling registers manually (rather than
392 ;; allowing PACK to do it for us). -- AJB, 2012-Oct-30
394 ;; Pack COUNT and DEST into the same register, being careful to tell
395 ;; PACK that their lifetimes do not overlap (we're lying to PACK, as
396 ;; COUNT is live both before and after DEST, but not while DEST is
398 (:temporary
(:sc any-reg
:offset ocfp-offset
:to
:eval
) count
)
399 (:temporary
(:sc any-reg
:offset ocfp-offset
:from
:eval
) dest
)
400 (:temporary
(:sc descriptor-reg
:offset r8-offset
) temp
)
403 ;; We open up with a LET to obtain a TN for NFP. We'll call it
404 ;; RESULT, to distinguish it from NFP-as-NFP and to roughly
405 ;; parallel the PPC implementation. We can't use a :TEMPORARY
406 ;; here because it would conflict with the existing NFP if there
407 ;; is a number-stack frame in play, but we only use it prior to
408 ;; actually setting up the "real" NFP.
409 (let ((result (make-random-tn :kind
:normal
410 :sc
(sc-or-lose 'any-reg
)
411 :offset nfp-offset
)))
412 ;; And we use ASSEMBLE here so that we get "implcit labels"
413 ;; rather than having to use GEN-LABEL and EMIT-LABEL.
415 ;; Compute the end of the fixed stack frame (start of the MORE
416 ;; arg area) into RESULT.
417 (inst add result cfp-tn
418 (* n-word-bytes
(sb-allocated-size 'control-stack
)))
419 ;; Compute the end of the MORE arg area (and our overall frame
420 ;; allocation) into the stack pointer.
422 (inst cmp nargs-tn
0)
423 (inst add temp result nargs-tn
)
427 (inst subs count nargs-tn
(fixnumize fixed
))
428 (store-csp result
:le
)
430 (inst add temp result count
)
433 (when (< fixed register-arg-count
)
434 ;; We must stop when we run out of stack args, not when we
435 ;; run out of more args.
436 (inst add result result
(fixnumize (- register-arg-count fixed
))))
438 ;; Initialize dest to be end of stack.
441 ;; We are copying at most (- NARGS FIXED) values, from last to
442 ;; first, in order to shift them out of the allocated part of
443 ;; the stack frame. The FIXED values remain where they are,
444 ;; as they are part of the allocated stack frame. Any
445 ;; remaining values are being moved to just beyond the end of
446 ;; the allocated stack frame, for a distance of (-
447 ;; (sb-allocated-size 'control-stack) fixed) words. There is
448 ;; a constant displacement of a single word in the loop below,
449 ;; because DEST points to the space AFTER the value being
453 (inst cmp dest result
)
454 (let ((delta (- (sb-allocated-size 'control-stack
) fixed
)))
455 (inst ldr
:gt temp
(@ dest
(- (* (1+ delta
) n-word-bytes
)))))
456 (inst str
:gt temp
(@ dest
(- n-word-bytes
) :pre-index
))
460 (when (< fixed register-arg-count
)
461 ;; Now we have to deposit any more args that showed up in registers.
462 (inst subs count nargs-tn
(fixnumize fixed
))
463 (do ((i fixed
(1+ i
)))
464 ((>= i register-arg-count
))
465 ;; Don't deposit any more than there are.
467 (inst subs count count
(fixnumize 1))
468 ;; Store it into the space reserved to it, by displacement
469 ;; from the frame pointer.
470 (storew (nth i
*register-arg-tns
*)
471 cfp-tn
(+ (sb-allocated-size 'control-stack
)
475 ;; Now that we're done with the &MORE args, we can set up the
476 ;; number stack frame.
477 (let ((nfp-tn (current-nfp-tn vop
)))
479 (inst sub nfp-tn nsp-tn
480 (bytes-needed-for-non-descriptor-stack-frame))
481 (move nsp-tn nfp-tn
)))))))
483 ;;; More args are stored consecutively on the stack, starting
484 ;;; immediately at the context pointer. The context pointer is not
485 ;;; typed, so the lowtag is 0.
486 (define-full-reffer more-arg
* 0 0 (descriptor-reg any-reg
) * %more-arg
)
488 ;;; Turn more arg (context, count) into a list.
489 (define-vop (listify-rest-args)
490 (:args
(context-arg :target context
:scs
(descriptor-reg))
491 (count-arg :target count
:scs
(any-reg)))
492 (:arg-types
* tagged-num
)
493 (:temporary
(:scs
(any-reg) :from
(:argument
0)) context
)
494 (:temporary
(:scs
(any-reg) :from
(:argument
1)) count
)
495 (:temporary
(:scs
(descriptor-reg) :from
:eval
) temp
)
496 (:temporary
(:scs
(any-reg) :from
:eval
) dst
)
497 (:temporary
(:sc non-descriptor-reg
:offset ocfp-offset
) pa-flag
)
498 (:results
(result :scs
(descriptor-reg)))
499 (:translate %listify-rest-args
)
503 (move context context-arg
)
504 (move count count-arg
)
505 ;; Check to see if there are any arguments.
507 (move result null-tn
)
510 ;; We need to do this atomically.
511 (pseudo-atomic (pa-flag)
512 ;; Allocate a cons (2 words) for each item.
513 (if (node-stack-allocate-p node
)
515 (error "Don't know how to stack-allocate an &REST list.")
519 (inst clrrwi result csp-tn n-lowtag-bits
)
520 (inst ori result result list-pointer-lowtag
)
522 (inst slwi temp count
1)
523 (inst add csp-tn csp-tn temp
))
525 (inst mov temp
(lsl count
1))
526 (allocation result temp list-pointer-lowtag
530 ;; FIXME: This entire loop is based on the PPC version, which is
531 ;; a poor fit for the ARM instruction set.
534 ;; Compute the next cons and store it in the current one.
536 (inst add dst dst
(* 2 n-word-bytes
))
537 (storew dst dst -
1 list-pointer-lowtag
)
542 (inst add context context n-word-bytes
)
544 ;; Dec count, and if != zero, go back for more.
545 (inst subs count count
(fixnumize 1))
546 ;; Store the value into the car of the current cons (in the delay
548 (storew temp dst
0 list-pointer-lowtag
)
551 ;; NIL out the last cons.
552 (storew null-tn dst
1 list-pointer-lowtag
))
555 ;;; Return the location and size of the more arg glob created by
556 ;;; Copy-More-Arg. Supplied is the total number of arguments supplied
557 ;;; (originally passed in NARGS.) Fixed is the number of non-rest
560 ;;; We must duplicate some of the work done by Copy-More-Arg, since at
561 ;;; that time the environment is in a pretty brain-damaged state,
562 ;;; preventing this info from being returned as values. What we do is
563 ;;; compute supplied - fixed, and return a pointer that many words
564 ;;; below the current stack top.
565 (define-vop (more-arg-context)
567 (:translate sb
!c
::%more-arg-context
)
568 (:args
(supplied :scs
(any-reg)))
569 (:arg-types tagged-num
(:constant fixnum
))
571 (:results
(context :scs
(descriptor-reg))
572 (count :scs
(any-reg)))
573 (:result-types t tagged-num
)
574 (:note
"more-arg-context")
576 (inst sub count supplied
(fixnumize fixed
))
578 (inst sub context context count
)))
580 (define-vop (verify-arg-count)
582 (:translate sb
!c
::%verify-arg-count
)
583 (:args
(nargs :scs
(any-reg)))
584 (:arg-types positive-fixnum
(:constant t
))
587 (:save-p
:compute-only
)
590 (generate-error-code vop
'invalid-arg-count-error nargs
)))
591 (inst cmp nargs
(fixnumize count
))
592 (inst b
:ne err-lab
))))
594 ;;; Signal various errors.
595 (macrolet ((frob (name error translate
&rest args
)
598 `((:policy
:fast-safe
)
599 (:translate
,translate
)))
600 (:args
,@(mapcar #'(lambda (arg)
601 `(,arg
:scs
(any-reg descriptor-reg
)))
604 (:save-p
:compute-only
)
606 (error-call vop
',error
,@args
)))))
607 (frob arg-count-error invalid-arg-count-error
608 sb
!c
::%arg-count-error nargs
)
609 (frob type-check-error object-not-type-error sb
!c
::%type-check-error
611 (frob layout-invalid-error layout-invalid-error sb
!c
::%layout-invalid-error
613 (frob odd-key-args-error odd-key-args-error
614 sb
!c
::%odd-key-args-error
)
615 (frob unknown-key-arg-error unknown-key-arg-error
616 sb
!c
::%unknown-key-arg-error key
)
617 (frob nil-fun-returned-error nil-fun-returned-error nil fun
))
619 ;;;; Local call with unknown values convention return:
621 ;;; Non-TR local call for a fixed number of values passed according to the
622 ;;; unknown values convention.
624 ;;; Args are the argument passing locations, which are specified only to
625 ;;; terminate their lifetimes in the caller.
627 ;;; Values are the return value locations (wired to the standard passing
630 ;;; Save is the save info, which we can ignore since saving has been done.
631 ;;; Return-PC is the TN that the return PC should be passed in.
632 ;;; Target is a continuation pointing to the start of the called function.
633 ;;; Nvals is the number of values received.
635 ;;; Note: we can't use normal load-tn allocation for the fixed args, since all
636 ;;; registers may be tied up by the more operand. Instead, we use
637 ;;; MAYBE-LOAD-STACK-TN.
638 (define-vop (call-local)
642 (:results
(values :more t
))
644 (:move-args
:local-call
)
645 (:info arg-locs callee target nvals
)
647 (:temporary
(:scs
(descriptor-reg) :from
(:eval
0)) move-temp
)
648 (:temporary
(:scs
(non-descriptor-reg)) temp
)
649 (:temporary
(:sc control-stack
:offset nfp-save-offset
) nfp-save
)
650 (:temporary
(:sc any-reg
:offset ocfp-offset
:from
(:eval
0)) ocfp
)
651 (:temporary
(:scs
(interior-reg)) lip
)
652 (:ignore arg-locs args ocfp
)
654 (trace-table-entry trace-table-call-site
)
655 (let ((label (gen-label))
656 (cur-nfp (current-nfp-tn vop
)))
658 (store-stack-tn nfp-save cur-nfp
))
659 (let ((callee-nfp (callee-nfp-tn callee
)))
661 (maybe-load-stack-tn callee-nfp nfp
)))
662 (maybe-load-stack-tn cfp-tn fp
)
663 (inst compute-lra lip lip label
)
664 (store-stack-tn (callee-return-pc-tn callee
) lip
)
665 (note-this-location vop
:call-site
)
667 (emit-return-pc label
)
668 (default-unknown-values vop values nvals move-temp temp lip label
)
669 ;; alpha uses (maybe-load-stack-nfp-tn cur-nfp nfp-save temp)
670 ;; instead of the clause below
672 (load-stack-tn cur-nfp nfp-save
)))
673 (trace-table-entry trace-table-normal
)))
676 ;;; Non-TR local call for a variable number of return values passed according
677 ;;; to the unknown values convention. The results are the start of the values
678 ;;; glob and the number of values received.
680 ;;; Note: we can't use normal load-tn allocation for the fixed args, since all
681 ;;; registers may be tied up by the more operand. Instead, we use
682 ;;; MAYBE-LOAD-STACK-TN.
683 (define-vop (multiple-call-local unknown-values-receiver
)
688 (:move-args
:local-call
)
689 (:info save callee target
)
692 (:temporary
(:sc control-stack
:offset nfp-save-offset
) nfp-save
)
693 (:temporary
(:scs
(non-descriptor-reg)) temp
)
694 (:temporary
(:scs
(interior-reg)) lip
)
696 (trace-table-entry trace-table-call-site
)
697 (let ((label (gen-label))
698 (cur-nfp (current-nfp-tn vop
)))
700 (store-stack-tn nfp-save cur-nfp
))
701 (let ((callee-nfp (callee-nfp-tn callee
)))
702 ;; alpha doesn't test this before the maybe-load
704 (maybe-load-stack-tn callee-nfp nfp
)))
705 (maybe-load-stack-tn cfp-tn fp
)
706 (inst compute-lra lip lip label
)
707 (store-stack-tn (callee-return-pc-tn callee
) lip
)
708 (note-this-location vop
:call-site
)
710 (emit-return-pc label
)
711 (note-this-location vop
:unknown-return
)
712 (receive-unknown-values values-start nvals start count label temp lip
)
714 (load-stack-tn cur-nfp nfp-save
)))
715 (trace-table-entry trace-table-normal
)))
717 ;;;; Local call with known values return:
719 ;;; Non-TR local call with known return locations. Known-value return works
720 ;;; just like argument passing in local call.
722 ;;; Note: we can't use normal load-tn allocation for the fixed args, since all
723 ;;; registers may be tied up by the more operand. Instead, we use
724 ;;; MAYBE-LOAD-STACK-TN.
725 (define-vop (known-call-local)
729 (:results
(res :more t
))
730 (:move-args
:local-call
)
732 (:info save callee target
)
733 (:ignore args res save
)
735 (:temporary
(:sc control-stack
:offset nfp-save-offset
) nfp-save
)
736 (:temporary
(:scs
(interior-reg)) lip
)
738 (trace-table-entry trace-table-call-site
)
739 (let ((label (gen-label))
740 (cur-nfp (current-nfp-tn vop
)))
742 (store-stack-tn nfp-save cur-nfp
))
743 (let ((callee-nfp (callee-nfp-tn callee
)))
745 (maybe-load-stack-tn callee-nfp nfp
)))
746 (maybe-load-stack-tn cfp-tn fp
)
747 (inst compute-lra lip lip label
)
748 (store-stack-tn (callee-return-pc-tn callee
) lip
)
749 (note-this-location vop
:call-site
)
751 (emit-return-pc label
)
752 (note-this-location vop
:known-return
)
754 (load-stack-tn cur-nfp nfp-save
)))
755 (trace-table-entry trace-table-normal
)))
757 ;;; Return from known values call. We receive the return locations as
758 ;;; arguments to terminate their lifetimes in the returning function. We
759 ;;; restore FP and CSP and jump to the Return-PC.
761 ;;; Note: we can't use normal load-tn allocation for the fixed args, since all
762 ;;; registers may be tied up by the more operand. Instead, we use
763 ;;; MAYBE-LOAD-STACK-TN.
764 (define-vop (known-return)
765 (:args
(old-fp :target old-fp-temp
)
766 (return-pc :target return-pc-temp
)
768 (:temporary
(:sc any-reg
:from
(:argument
0)) old-fp-temp
)
769 (:temporary
(:sc descriptor-reg
:from
(:argument
1)) return-pc-temp
)
770 (:move-args
:known-return
)
772 (:ignore val-locs vals
)
775 (trace-table-entry trace-table-fun-epilogue
)
776 (maybe-load-stack-tn old-fp-temp old-fp
)
777 (maybe-load-stack-tn return-pc-temp return-pc
)
779 (let ((cur-nfp (current-nfp-tn vop
)))
781 (inst add cur-nfp cur-nfp
(bytes-needed-for-non-descriptor-stack-frame))
782 (move nsp-tn cur-nfp
)))
783 (move cfp-tn old-fp-temp
)
784 (lisp-return return-pc-temp
:known
)
785 (trace-table-entry trace-table-normal
)))
789 ;;; There is something of a cross-product effect with full calls.
790 ;;; Different versions are used depending on whether we know the
791 ;;; number of arguments or the name of the called function, and
792 ;;; whether we want fixed values, unknown values, or a tail call.
794 ;;; In full call, the arguments are passed creating a partial frame on
795 ;;; the stack top and storing stack arguments into that frame. On
796 ;;; entry to the callee, this partial frame is pointed to by FP. If
797 ;;; there are no stack arguments, we don't bother allocating a partial
798 ;;; frame, and instead set FP to SP just before the call.
800 ;;; This macro helps in the definition of full call VOPs by avoiding code
801 ;;; replication in defining the cross-product VOPs.
803 ;;; Name is the name of the VOP to define.
805 ;;; Named is true if the first argument is a symbol whose global function
806 ;;; definition is to be called.
808 ;;; Return is either :Fixed, :Unknown or :Tail:
809 ;;; -- If :Fixed, then the call is for a fixed number of values, returned in
810 ;;; the standard passing locations (passed as result operands).
811 ;;; -- If :Unknown, then the result values are pushed on the stack, and the
812 ;;; result values are specified by the Start and Count as in the
813 ;;; unknown-values continuation representation.
814 ;;; -- If :Tail, then do a tail-recursive call. No values are returned.
815 ;;; The Old-Fp and Return-PC are passed as the second and third arguments.
817 ;;; In non-tail calls, the pointer to the stack arguments is passed as the last
818 ;;; fixed argument. If Variable is false, then the passing locations are
819 ;;; passed as a more arg. Variable is true if there are a variable number of
820 ;;; arguments passed on the stack. Variable cannot be specified with :Tail
821 ;;; return. TR variable argument call is implemented separately.
823 ;;; In tail call with fixed arguments, the passing locations are passed as a
824 ;;; more arg, but there is no new-FP, since the arguments have been set up in
825 ;;; the current frame.
826 (defmacro define-full-call
(name named return variable
)
827 (aver (not (and variable
(eq return
:tail
))))
829 ,@(when (eq return
:unknown
)
830 '(unknown-values-receiver)))
832 ,@(unless (eq return
:tail
)
833 '((new-fp :scs
(any-reg) :to
:eval
)))
836 '(name :target name-pass
)
837 '(arg-fun :target lexenv
))
839 ,@(when (eq return
:tail
)
843 ,@(unless variable
'((args :more t
:scs
(descriptor-reg)))))
845 ,@(when (eq return
:fixed
)
846 '((:results
(values :more t
))))
848 (:save-p
,(if (eq return
:tail
) :compute-only t
))
850 ,@(unless (or (eq return
:tail
) variable
)
851 '((:move-args
:full-call
)))
854 (:info
,@(unless (or variable
(eq return
:tail
)) '(arg-locs))
855 ,@(unless variable
'(nargs))
856 ,@(when (eq return
:fixed
) '(nvals))
860 ,@(when (eq return
:fixed
) '(ocfp-temp))
861 ,@(unless (or variable
(eq return
:tail
)) '(arg-locs))
862 ,@(unless variable
'(args))
863 ,@(when (eq return
:tail
) '(old-fp)))
865 (:temporary
(:sc descriptor-reg
:offset lexenv-offset
866 :from
(:argument
,(if (eq return
:tail
) 0 1))
868 ,(if named
'name-pass
'lexenv
))
870 (:temporary
(:scs
(descriptor-reg) :from
(:argument
0) :to
:eval
)
872 (:temporary
(:sc any-reg
:offset nargs-offset
:to
:eval
)
876 (mapcar #'(lambda (name offset
)
877 `(:temporary
(:sc descriptor-reg
881 *register-arg-names
* *register-arg-offsets
*))
882 ,@(when (eq return
:fixed
)
883 '((:temporary
(:scs
(descriptor-reg) :from
:eval
) move-temp
)
884 (:temporary
(:sc non-descriptor-reg
:from
:eval
:offset ocfp-offset
) ocfp-temp
)))
886 ,@(unless (eq return
:tail
)
887 '((:temporary
(:scs
(non-descriptor-reg)) temp
)
888 (:temporary
(:sc control-stack
:offset nfp-save-offset
) nfp-save
)))
890 (:temporary
(:scs
(interior-reg)) lip
)
892 (:generator
,(+ (if named
5 0)
894 (if (eq return
:tail
) 0 10)
896 (if (eq return
:unknown
) 25 0))
897 (trace-table-entry trace-table-call-site
)
898 (let* ((cur-nfp (current-nfp-tn vop
))
899 ,@(unless (eq return
:tail
)
900 '((lra-label (gen-label))))
904 ,@(if (eq return
:tail
)
905 '((unless (location= return-pc
906 (make-random-tn :kind
:normal
907 :sc
(sc-or-lose 'control-stack
)
908 :offset lra-save-offset
))
916 (flet ((do-next-filler ()
917 (let* ((next (pop filler
))
918 (what (if (consp next
) (car next
) next
)))
922 `((load-csp nargs-pass
)
923 (inst sub nargs-pass nargs-pass new-fp
)
925 (mapcar #'(lambda (name)
928 *register-arg-names
*))
929 (storew cfp-tn new-fp ocfp-save-offset
))
930 '((inst mov nargs-pass
(fixnumize nargs
)))))
931 ,@(if (eq return
:tail
)
933 (error "RETURN-PC not in its passing location"))
935 (inst add cur-nfp cur-nfp
(bytes-needed-for-non-descriptor-stack-frame))
936 (move nsp-tn cur-nfp
)))
938 (inst compute-lra lip lip lra-label
)
939 (inst str lip
(@ new-fp
(* lra-save-offset
942 (store-stack-tn nfp-save cur-nfp
))
944 (move cfp-tn new-fp
))))
946 (insert-step-instrumenting (callable-tn)
947 ;; Conditionally insert a conditional trap:
948 (when step-instrumenting
950 ;; Get the symbol-value of SB!IMPL::*STEPPING*
951 ;; KLUDGE: ... into LIP. Either it's NIL or it
952 ;; isn't, and even taking a stray interrupt and
953 ;; GC can't screw that up.
954 (load-symbol-value lip sb
!impl
::*stepping
*)
955 (inst cmp lip null-tn
)
956 ;; If it's not null, trap.
957 (inst b
:eq step-done-label
)
958 ;; CONTEXT-PC will be pointing here when the
959 ;; interrupt is handled, not after the
961 (note-this-location vop
:step-before-vop
)
962 ;; Best-guess at a usable trap. x86oids don't
963 ;; have much more than this, SPARC, MIPS, PPC
964 ;; and HPPA encode (TN-OFFSET CALLABLE-TN),
965 ;; Alpha ignores stepping entirely.
967 (inst byte single-step-around-trap
)
968 (inst byte
(tn-offset callable-tn
))
969 (emit-alignment word-shift
)
976 (descriptor-reg (move name-pass name
))
978 (loadw name-pass cfp-tn
(tn-offset name
))
981 (loadw name-pass code-tn
(tn-offset name
)
982 other-pointer-lowtag
)
984 (insert-step-instrumenting name-pass
)
985 (loadw function name-pass fdefn-raw-addr-slot
986 other-pointer-lowtag
)
989 (descriptor-reg (move lexenv arg-fun
))
991 (loadw lexenv cfp-tn
(tn-offset arg-fun
))
994 (loadw lexenv code-tn
(tn-offset arg-fun
)
995 other-pointer-lowtag
)
997 (loadw function lexenv closure-fun-slot
1000 (insert-step-instrumenting function
)))
1006 (note-this-location vop
:call-site
)
1007 (lisp-jump function
))
1011 '((emit-return-pc lra-label
)
1012 (default-unknown-values vop values nvals move-temp
1015 (load-stack-tn cur-nfp nfp-save
))))
1017 '((emit-return-pc lra-label
)
1018 (note-this-location vop
:unknown-return
)
1019 (receive-unknown-values values-start nvals start count
1022 (load-stack-tn cur-nfp nfp-save
))))
1024 (trace-table-entry trace-table-normal
))))
1027 (define-full-call call nil
:fixed nil
)
1028 (define-full-call call-named t
:fixed nil
)
1029 (define-full-call multiple-call nil
:unknown nil
)
1030 (define-full-call multiple-call-named t
:unknown nil
)
1031 (define-full-call tail-call nil
:tail nil
)
1032 (define-full-call tail-call-named t
:tail nil
)
1034 (define-full-call call-variable nil
:fixed t
)
1035 (define-full-call multiple-call-variable nil
:unknown t
)
1037 ;;; Defined separately, since needs special code that BLT's the
1039 (define-vop (tail-call-variable)
1041 (args-arg :scs
(any-reg) :target args
)
1042 (function-arg :scs
(descriptor-reg) :target lexenv
)
1043 (old-fp-arg :scs
(any-reg) :load-if nil
)
1044 (lra-arg :scs
(descriptor-reg) :load-if nil
))
1045 (:temporary
(:sc any-reg
:offset nl2-offset
:from
(:argument
0)) args
)
1046 (:temporary
(:sc any-reg
:offset lexenv-offset
:from
(:argument
1)) lexenv
)
1047 (:temporary
(:sc interior-reg
) lip
)
1048 (:ignore old-fp-arg lra-arg
)
1051 ;; Move these into the passing locations if they are not already there.
1052 (move args args-arg
)
1053 (move lexenv function-arg
)
1054 ;; Clear the number stack if anything is there.
1055 (let ((cur-nfp (current-nfp-tn vop
)))
1057 (inst add cur-nfp cur-nfp
(bytes-needed-for-non-descriptor-stack-frame))
1058 (move nsp-tn cur-nfp
)))
1059 (let ((fixup-lab (gen-label)))
1060 (assemble (*elsewhere
*)
1061 (emit-label fixup-lab
)
1062 (inst word
(make-fixup 'tail-call-variable
:assembly-routine
)))
1063 (inst load-from-label pc-tn lip fixup-lab
))))
1065 ;;;; Unknown values return:
1067 ;;; Return a single value using the unknown-values convention.
1068 (define-vop (return-single)
1069 (:args
(old-fp :scs
(any-reg) :to
:eval
)
1070 (return-pc :scs
(descriptor-reg))
1075 (trace-table-entry trace-table-fun-epilogue
)
1076 ;; Clear the number stack.
1077 (let ((cur-nfp (current-nfp-tn vop
)))
1079 (inst add cur-nfp cur-nfp
(bytes-needed-for-non-descriptor-stack-frame))
1080 (move nsp-tn cur-nfp
)))
1081 ;; Clear the control stack, and restore the frame pointer.
1083 (move cfp-tn old-fp
)
1085 (lisp-return return-pc
:single-value
)
1086 (trace-table-entry trace-table-normal
)))
1088 ;;; Do unknown-values return of a fixed number of values. The Values are
1089 ;;; required to be set up in the standard passing locations. Nvals is the
1090 ;;; number of values returned.
1092 ;;; If returning a single value, then deallocate the current frame, restore
1093 ;;; FP and jump to the single-value entry at Return-PC + 8.
1095 ;;; If returning other than one value, then load the number of values returned,
1096 ;;; NIL out unsupplied values registers, restore FP and return at Return-PC.
1097 ;;; When there are stack values, we must initialize the argument pointer to
1098 ;;; point to the beginning of the values block (which is the beginning of the
1100 (define-vop (return)
1102 (old-fp :scs
(any-reg))
1103 (return-pc :scs
(descriptor-reg) :to
(:eval
1) :target lra
)
1107 (:temporary
(:sc descriptor-reg
:offset r0-offset
:from
(:eval
0)) r0
)
1108 (:temporary
(:sc descriptor-reg
:offset r1-offset
:from
(:eval
0)) r1
)
1109 (:temporary
(:sc descriptor-reg
:offset r2-offset
:from
(:eval
0)) r2
)
1110 (:temporary
(:sc descriptor-reg
:offset lexenv-offset
:from
(:eval
1)) lra
)
1111 (:temporary
(:sc any-reg
:offset nargs-offset
) nargs
)
1112 (:temporary
(:sc any-reg
:offset ocfp-offset
) val-ptr
)
1115 (trace-table-entry trace-table-fun-epilogue
)
1116 (move lra return-pc
)
1117 ;; Clear the number stack.
1118 (let ((cur-nfp (current-nfp-tn vop
)))
1120 (inst add cur-nfp cur-nfp
1121 (bytes-needed-for-non-descriptor-stack-frame))
1122 (move nsp-tn cur-nfp
)))
1124 ;; Clear the control stack, and restore the frame pointer.
1126 (move cfp-tn old-fp
)
1128 (lisp-return lra
:single-value
))
1130 ;; Establish the values pointer.
1131 (move val-ptr cfp-tn
)
1132 ;; restore the frame pointer and clear as much of the control
1133 ;; stack as possible.
1134 (move cfp-tn old-fp
)
1135 (inst add nargs val-ptr
(* nvals n-word-bytes
))
1137 ;; Establish the values count.
1138 (inst mov nargs
(fixnumize nvals
))
1139 ;; pre-default any argument register that need it.
1140 (when (< nvals register-arg-count
)
1141 (dolist (reg (subseq (list r0 r1 r2
) nvals
))
1142 (move reg null-tn
)))
1144 (lisp-return lra
:multiple-values
)))
1145 (trace-table-entry trace-table-normal
)))
1147 ;;; Do unknown-values return of an arbitrary number of values (passed
1148 ;;; on the stack.) We check for the common case of a single return
1149 ;;; value, and do that inline using the normal single value return
1150 ;;; convention. Otherwise, we branch off to code that calls an
1151 ;;; assembly-routine.
1152 (define-vop (return-multiple)
1154 (old-fp-arg :scs
(any-reg) :to
(:eval
1))
1155 (lra-arg :scs
(descriptor-reg) :to
(:eval
1))
1156 (vals-arg :scs
(any-reg) :target vals
)
1157 (nvals-arg :scs
(any-reg) :target nvals
))
1158 (:temporary
(:sc any-reg
:offset nl2-offset
:from
(:argument
0)) old-fp
)
1159 (:temporary
(:sc descriptor-reg
:offset lexenv-offset
:from
(:argument
1)) lra
)
1160 (:temporary
(:sc any-reg
:offset ocfp-offset
:from
(:argument
2)) vals
)
1161 (:temporary
(:sc any-reg
:offset nargs-offset
:from
(:argument
3)) nvals
)
1162 (:temporary
(:sc descriptor-reg
:offset r0-offset
) r0
)
1165 (trace-table-entry trace-table-fun-epilogue
)
1167 ;; Clear the number stack.
1168 (let ((cur-nfp (current-nfp-tn vop
)))
1170 (inst add cur-nfp cur-nfp
1171 (bytes-needed-for-non-descriptor-stack-frame))
1172 (move nsp-tn cur-nfp
)))
1174 ;; Check for the single case.
1175 (inst cmp nvals-arg
(fixnumize 1))
1176 (inst b
:ne NOT-SINGLE
)
1178 ;; Return with one value.
1179 (inst ldr r0
(@ vals-arg
))
1181 (move cfp-tn old-fp-arg
)
1182 (lisp-return lra-arg
:single-value
)
1184 ;; Nope, not the single case.
1186 (move old-fp old-fp-arg
)
1187 (move vals vals-arg
)
1188 (move nvals nvals-arg
)
1189 (inst ldr pc-tn
(@ fixup
))
1191 (inst word
(make-fixup 'return-multiple
:assembly-routine
))
1193 (trace-table-entry trace-table-normal
)))
1197 (define-vop (step-instrument-before-vop)
1198 (:temporary
(:scs
(descriptor-reg)) stepping
)
1199 (:policy
:fast-safe
)
1202 (load-symbol-value stepping sb
!impl
::*stepping
*)
1203 ;; If it's not NIL, trap.
1204 (inst cmp stepping null-tn
)
1206 ;; CONTEXT-PC will be pointing here when the interrupt is handled,
1207 ;; not after the BREAK.
1208 (note-this-location vop
:step-before-vop
)
1209 ;; A best-guess effort at a debug trap suitable for a
1210 ;; single-step-before-trap.
1212 (inst byte single-step-before-trap
)
1213 (emit-alignment word-shift
)