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 ;;; Accessing a slot from an earlier stack frame is definite hackery.
119 (define-vop (ancestor-frame-ref)
120 (:args
(frame-pointer :scs
(descriptor-reg))
121 (variable-home-tn :load-if nil
))
122 (:results
(value :scs
(descriptor-reg any-reg
)))
125 (aver (sc-is variable-home-tn control-stack
))
126 (loadw value frame-pointer
(tn-offset variable-home-tn
))))
127 (define-vop (ancestor-frame-set)
128 (:args
(frame-pointer :scs
(descriptor-reg))
129 (value :scs
(descriptor-reg any-reg
)))
130 (:results
(variable-home-tn :load-if nil
))
133 (aver (sc-is variable-home-tn control-stack
))
134 (storew value frame-pointer
(tn-offset variable-home-tn
))))
136 (define-vop (xep-allocate-frame)
137 (:info start-lab copy-more-arg-follows
)
139 (:temporary
(:scs
(any-reg)) temp
)
140 (:temporary
(:scs
(interior-reg)) lip
)
142 ;; Make sure the function is aligned, and drop a label pointing to this
144 (emit-alignment n-lowtag-bits
)
145 (trace-table-entry trace-table-fun-prologue
)
146 (emit-label start-lab
)
147 ;; Allocate function header.
148 (inst simple-fun-header-word
)
149 (dotimes (i (1- simple-fun-code-offset
))
151 (inst compute-code code-tn lip start-lab temp
)
152 ;; Build our stack frames.
153 (unless copy-more-arg-follows
154 (inst add csp-tn cfp-tn
155 (* n-word-bytes
(sb-allocated-size 'control-stack
)))
156 (let ((nfp-tn (current-nfp-tn vop
)))
158 (let* ((nbytes (bytes-needed-for-non-descriptor-stack-frame)))
159 (load-symbol-value nfp-tn
*number-stack-pointer
*)
160 (inst sub nfp-tn nfp-tn nbytes
)
161 (store-symbol-value nfp-tn
*number-stack-pointer
*)))))
162 (trace-table-entry trace-table-normal
)))
164 (define-vop (allocate-frame)
165 (:results
(res :scs
(any-reg))
166 (nfp :scs
(any-reg)))
170 (trace-table-entry trace-table-fun-prologue
)
172 (inst add csp-tn csp-tn
(* (max 1 (sb-allocated-size 'control-stack
))
174 (when (ir2-physenv-number-stack-p callee
)
175 (let* ((nbytes (bytes-needed-for-non-descriptor-stack-frame)))
176 (load-symbol-value nfp
*number-stack-pointer
*)
177 (inst sub nfp nfp nbytes
)
178 (store-symbol-value nfp
*number-stack-pointer
*)))
179 (trace-table-entry trace-table-normal
)))
181 ;;; Allocate a partial frame for passing stack arguments in a full call. Nargs
182 ;;; is the number of arguments passed. If no stack arguments are passed, then
183 ;;; we don't have to do anything.
184 (define-vop (allocate-full-call-frame)
186 (:results
(res :scs
(any-reg)))
188 ;; Unlike most other backends, we store the "OCFP" at frame
189 ;; allocation time rather than at function-entry time, largely due
190 ;; to a lack of usable registers.
192 (inst add csp-tn csp-tn
(* (max 1 nargs
) n-word-bytes
))
193 (storew cfp-tn res ocfp-save-offset
)))
195 ;;; Emit code needed at the return-point from an unknown-values call
196 ;;; for a fixed number of values. VALUES is the head of the TN-REF
197 ;;; list for the locations that the values are to be received into.
198 ;;; NVALS is the number of values that are to be received (should
199 ;;; equal the length of Values).
201 ;;; MOVE-TEMP is a DESCRIPTOR-REG TN used as a temporary.
203 ;;; This code exploits the fact that in the unknown-values convention,
204 ;;; a single value return returns with all of the condition flags
205 ;;; clear, whereas a return of other than one value returns with the
206 ;;; condition flags set.
208 ;;; If 0 or 1 values are expected, then we just emit an instruction to
209 ;;; reset the SP (which will only be executed when other than 1 value
212 ;;; In the general case, we have to do three things:
213 ;;; -- Default unsupplied register values. This need only be done when a
214 ;;; single value is returned, since register values are defaulted by the
215 ;;; callee in the non-single case.
216 ;;; -- Default unsupplied stack values. This needs to be done whenever there
217 ;;; are stack values.
218 ;;; -- Reset SP. This must be done whenever other than 1 value is returned,
219 ;;; regardless of the number of values desired.
221 (defun default-unknown-values (vop values nvals move-temp temp lip lra-label
)
222 (declare (type (or tn-ref null
) values
)
223 (type unsigned-byte nvals
) (type tn move-temp temp
))
224 (let ((expecting-values-on-stack (> nvals register-arg-count
))
225 (values-on-stack temp
))
226 ;; Pick off the single-value case first.
227 (sb!assem
:without-scheduling
()
228 (note-this-location vop
(if (<= nvals
1)
232 ;; Default register values for single-value return case.
233 ;; The callee returns with condition bits CLEAR in the
234 ;; single-value case.
237 (val (tn-ref-across values
) (tn-ref-across val
)))
238 ((= i
(min nvals register-arg-count
)))
239 (inst mov
:ne
(tn-ref-tn val
) null-tn
)))
241 ;; If we're not expecting values on the stack, all that
242 ;; remains is to clear the stack frame (for the multiple-
243 ;; value return case).
244 (unless expecting-values-on-stack
245 (inst mov
:eq csp-tn ocfp-tn
))
247 ;; If we ARE expecting values on the stack, we need to
248 ;; either move them to their result location or to set their
249 ;; result location to the default.
250 (when expecting-values-on-stack
252 ;; For the single-value return case, fake up NARGS and
253 ;; OCFP so that we don't screw ourselves with the
254 ;; defaulting and stack clearing logic.
255 (inst mov
:ne ocfp-tn csp-tn
)
256 (inst mov
:ne nargs-tn n-word-bytes
)
258 ;; Compute the number of stack values (may be negative if
259 ;; not all of the register values are populated).
260 (inst sub values-on-stack nargs-tn
(fixnumize register-arg-count
))
262 ;; For each expected stack value...
263 (do ((i register-arg-count
(1+ i
))
264 (val (do ((i 0 (1+ i
))
265 (val values
(tn-ref-across val
)))
266 ((= i register-arg-count
) val
))
267 (tn-ref-across val
)))
270 ;; ... Load it if there is a stack value available, or
271 ;; default it if there isn't.
272 (inst subs values-on-stack values-on-stack
4)
273 (loadw move-temp ocfp-tn i
0 :ge
)
274 (store-stack-tn (tn-ref-tn val
) move-temp
:ge
)
275 (store-stack-tn (tn-ref-tn val
) null-tn
:lt
))
277 ;; Deallocate the callee stack frame.
278 (move csp-tn ocfp-tn
)))
280 ;; And, finally, recompute the correct value for CODE-TN.
281 (inst compute-code code-tn lip lra-label temp
))
284 ;;;; Unknown values receiving:
286 ;;; Emit code needed at the return point for an unknown-values call for an
287 ;;; arbitrary number of values.
289 ;;; We do the single and non-single cases with no shared code: there doesn't
290 ;;; seem to be any potential overlap, and receiving a single value is more
291 ;;; important efficiency-wise.
293 ;;; When there is a single value, we just push it on the stack, returning
294 ;;; the old SP and 1.
296 ;;; When there is a variable number of values, we move all of the argument
297 ;;; registers onto the stack, and return Args and Nargs.
299 ;;; Args and Nargs are TNs wired to the named locations. We must
300 ;;; explicitly allocate these TNs, since their lifetimes overlap with the
301 ;;; results Start and Count (also, it's nice to be able to target them).
302 (defun receive-unknown-values (args nargs start count lra-label temp lip
)
303 (declare (type tn args nargs start count temp
))
304 (inst compute-code code-tn lip lra-label temp
)
305 (inst str
:eq
(first *register-arg-tns
*) (@ csp-tn n-word-bytes
:post-index
))
306 (inst sub
:eq start csp-tn
4)
307 (inst mov
:eq count
(fixnumize 1))
308 (do ((arg *register-arg-tns
* (rest arg
))
311 (storew (first arg
) args i
0 :ne
))
312 (move start args
:ne
)
313 (move count nargs
:ne
)
317 ;;; VOP that can be inherited by unknown values receivers. The main
318 ;;; thing this handles is allocation of the result temporaries.
319 (define-vop (unknown-values-receiver)
321 (start :scs
(any-reg))
322 (count :scs
(any-reg)))
323 (:temporary
(:sc descriptor-reg
:offset ocfp-offset
324 :from
:eval
:to
(:result
0))
326 (:temporary
(:sc any-reg
:offset nargs-offset
327 :from
:eval
:to
(:result
1))
329 (:temporary
(:scs
(non-descriptor-reg)) temp
))
331 ;;; This hook in the codegen pass lets us insert code before fall-thru entry
332 ;;; points, local-call entry points, and tail-call entry points. The default
334 (defun emit-block-header (start-label trampoline-label fall-thru-p alignp
)
335 (declare (ignore fall-thru-p alignp
))
336 (when trampoline-label
337 (emit-label trampoline-label
))
338 (emit-label start-label
))
343 ;;; We don't need to do anything special for regular functions.
345 (define-vop (setup-environment)
349 ;; Don't bother doing anything.
352 ;;; Get the lexical environment from its passing location.
353 (define-vop (setup-closure-environment)
354 (:temporary
(:sc descriptor-reg
:offset lexenv-offset
:target closure
357 (:results
(closure :scs
(descriptor-reg)))
362 (move closure lexenv
)))
364 ;;; Copy a more arg from the argument area to the end of the current frame.
365 ;;; Fixed is the number of non-more arguments.
366 (define-vop (copy-more-arg)
367 ;; The environment here-and-now is not properly initialized. The
368 ;; stack frame is not yet fully allocated, and even if it were most
369 ;; of the slots have live data in them that PACK does not know
370 ;; about, so we cannot afford a register spill. As far as the boxed
371 ;; registers go, the arg-passing registers (R0, R1, and R2) are
372 ;; live, LEXENV is live, and LRA is live. On the unboxed front,
373 ;; NARGS is live. FP has been set up by the caller, SP is
374 ;; protecting our stack arguments, but is otherwise not set up. NFP
375 ;; is not yet set up. CODE and NULL are set up. SP and NFP must be
376 ;; correctly set up by the time we're done, and OCFP and R8 are
377 ;; available for use as temporaries. If we were any more register
378 ;; constrained, we'd be spilling registers manually (rather than
379 ;; allowing PACK to do it for us). -- AJB, 2012-Oct-30
381 ;; Pack COUNT and DEST into the same register, being careful to tell
382 ;; PACK that their lifetimes do not overlap (we're lying to PACK, as
383 ;; COUNT is live both before and after DEST, but not while DEST is
385 (:temporary
(:sc any-reg
:offset ocfp-offset
:to
:eval
) count
)
386 (:temporary
(:sc any-reg
:offset ocfp-offset
:from
:eval
) dest
)
387 (:temporary
(:sc descriptor-reg
:offset r8-offset
) temp
)
390 ;; We open up with a LET to obtain a TN for NFP. We'll call it
391 ;; RESULT, to distinguish it from NFP-as-NFP and to roughly
392 ;; parallel the PPC implementation. We can't use a :TEMPORARY
393 ;; here because it would conflict with the existing NFP if there
394 ;; is a number-stack frame in play, but we only use it prior to
395 ;; actually setting up the "real" NFP.
396 (let ((result (make-random-tn :kind
:normal
397 :sc
(sc-or-lose 'any-reg
)
398 :offset nfp-offset
)))
399 ;; And we use ASSEMBLE here so that we get "implcit labels"
400 ;; rather than having to use GEN-LABEL and EMIT-LABEL.
402 ;; Compute the end of the fixed stack frame (start of the MORE
403 ;; arg area) into RESULT.
404 (inst add result cfp-tn
405 (* n-word-bytes
(sb-allocated-size 'control-stack
)))
406 ;; Compute the end of the MORE arg area (and our overall frame
407 ;; allocation) into the stack pointer.
409 (inst cmp nargs-tn
0)
410 (inst add csp-tn result nargs-tn
)
413 (inst subs count nargs-tn
(fixnumize fixed
))
415 (inst add csp-tn result count
)))
417 (when (< fixed register-arg-count
)
418 ;; We must stop when we run out of stack args, not when we
419 ;; run out of more args.
420 (inst add result result
(fixnumize (- register-arg-count fixed
))))
422 ;; Initialize dest to be end of stack.
425 ;; We are copying at most (- NARGS FIXED) values, from last to
426 ;; first, in order to shift them out of the allocated part of
427 ;; the stack frame. The FIXED values remain where they are,
428 ;; as they are part of the allocated stack frame. Any
429 ;; remaining values are being moved to just beyond the end of
430 ;; the allocated stack frame, for a distance of (-
431 ;; (sb-allocated-size 'control-stack) fixed) words. There is
432 ;; a constant displacement of a single word in the loop below,
433 ;; because DEST points to the space AFTER the value being
437 (inst cmp dest result
)
438 (let ((delta (- (sb-allocated-size 'control-stack
) fixed
)))
439 (inst ldr
:gt temp
(@ dest
(- (* (1+ delta
) n-word-bytes
)))))
440 (inst str
:gt temp
(@ dest
(- n-word-bytes
) :pre-index
))
444 (when (< fixed register-arg-count
)
445 ;; Now we have to deposit any more args that showed up in registers.
446 (inst subs count nargs-tn
(fixnumize fixed
))
447 (do ((i fixed
(1+ i
)))
448 ((>= i register-arg-count
))
449 ;; Don't deposit any more than there are.
451 (inst subs count count
(fixnumize 1))
452 ;; Store it into the space reserved to it, by displacement
453 ;; from the frame pointer.
454 (storew (nth i
*register-arg-tns
*)
455 cfp-tn
(+ (sb-allocated-size 'control-stack
)
459 ;; Now that we're done with the &MORE args, we can set up the
460 ;; number stack frame.
461 (let ((nfp-tn (current-nfp-tn vop
)))
463 (load-symbol-value nfp-tn
*number-stack-pointer
*)
464 (inst sub nfp-tn nfp-tn
465 (bytes-needed-for-non-descriptor-stack-frame))
466 (store-symbol-value nfp-tn
*number-stack-pointer
*)))))))
468 ;;; More args are stored consecutively on the stack, starting
469 ;;; immediately at the context pointer. The context pointer is not
470 ;;; typed, so the lowtag is 0.
471 (define-full-reffer more-arg
* 0 0 (descriptor-reg any-reg
) * %more-arg
)
473 ;;; Turn more arg (context, count) into a list.
474 (define-vop (listify-rest-args)
475 (:args
(context-arg :target context
:scs
(descriptor-reg))
476 (count-arg :target count
:scs
(any-reg)))
477 (:arg-types
* tagged-num
)
478 (:temporary
(:scs
(any-reg) :from
(:argument
0)) context
)
479 (:temporary
(:scs
(any-reg) :from
(:argument
1)) count
)
480 (:temporary
(:scs
(descriptor-reg) :from
:eval
) temp
)
481 (:temporary
(:scs
(any-reg) :from
:eval
) dst
)
482 (:temporary
(:sc non-descriptor-reg
:offset ocfp-offset
) pa-flag
)
483 (:results
(result :scs
(descriptor-reg)))
484 (:translate %listify-rest-args
)
488 (move context context-arg
)
489 (move count count-arg
)
490 ;; Check to see if there are any arguments.
492 (move result null-tn
)
495 ;; We need to do this atomically.
496 (pseudo-atomic (pa-flag)
497 ;; Allocate a cons (2 words) for each item.
498 (if (node-stack-allocate-p node
)
500 (error "Don't know how to stack-allocate an &REST list.")
504 (inst clrrwi result csp-tn n-lowtag-bits
)
505 (inst ori result result list-pointer-lowtag
)
507 (inst slwi temp count
1)
508 (inst add csp-tn csp-tn temp
))
510 (inst mov temp
(lsl count
1))
511 (allocation result temp list-pointer-lowtag
515 ;; FIXME: This entire loop is based on the PPC version, which is
516 ;; a poor fit for the ARM instruction set.
519 ;; Compute the next cons and store it in the current one.
521 (inst add dst dst
(* 2 n-word-bytes
))
522 (storew dst dst -
1 list-pointer-lowtag
)
527 (inst add context context n-word-bytes
)
529 ;; Dec count, and if != zero, go back for more.
530 (inst subs count count
(fixnumize 1))
531 ;; Store the value into the car of the current cons (in the delay
533 (storew temp dst
0 list-pointer-lowtag
)
536 ;; NIL out the last cons.
537 (storew null-tn dst
1 list-pointer-lowtag
))
540 ;;; Return the location and size of the more arg glob created by
541 ;;; Copy-More-Arg. Supplied is the total number of arguments supplied
542 ;;; (originally passed in NARGS.) Fixed is the number of non-rest
545 ;;; We must duplicate some of the work done by Copy-More-Arg, since at
546 ;;; that time the environment is in a pretty brain-damaged state,
547 ;;; preventing this info from being returned as values. What we do is
548 ;;; compute supplied - fixed, and return a pointer that many words
549 ;;; below the current stack top.
550 (define-vop (more-arg-context)
552 (:translate sb
!c
::%more-arg-context
)
553 (:args
(supplied :scs
(any-reg)))
554 (:arg-types tagged-num
(:constant fixnum
))
556 (:results
(context :scs
(descriptor-reg))
557 (count :scs
(any-reg)))
558 (:result-types t tagged-num
)
559 (:note
"more-arg-context")
561 (inst sub count supplied
(fixnumize fixed
))
562 (inst sub context csp-tn count
)))
564 (define-vop (verify-arg-count)
566 (:translate sb
!c
::%verify-arg-count
)
567 (:args
(nargs :scs
(any-reg)))
568 (:arg-types positive-fixnum
(:constant t
))
569 (:temporary
(:sc non-descriptor-reg
:offset ocfp-offset
) error-temp
)
572 (:save-p
:compute-only
)
575 (generate-error-code vop error-temp
576 'invalid-arg-count-error nargs
)))
577 (inst cmp nargs
(fixnumize count
))
578 (inst b
:ne err-lab
))))
580 ;;; Signal various errors.
581 (macrolet ((frob (name error translate
&rest args
)
584 `((:policy
:fast-safe
)
585 (:translate
,translate
)))
586 (:args
,@(mapcar #'(lambda (arg)
587 `(,arg
:scs
(any-reg descriptor-reg
)))
589 (:temporary
(:sc non-descriptor-reg
:offset ocfp-offset
) error-temp
)
591 (:save-p
:compute-only
)
593 (error-call vop error-temp
',error
,@args
)))))
594 (frob arg-count-error invalid-arg-count-error
595 sb
!c
::%arg-count-error nargs
)
596 (frob type-check-error object-not-type-error sb
!c
::%type-check-error
598 (frob layout-invalid-error layout-invalid-error sb
!c
::%layout-invalid-error
600 (frob odd-key-args-error odd-key-args-error
601 sb
!c
::%odd-key-args-error
)
602 (frob unknown-key-arg-error unknown-key-arg-error
603 sb
!c
::%unknown-key-arg-error key
)
604 (frob nil-fun-returned-error nil-fun-returned-error nil fun
))
606 ;;;; Local call with unknown values convention return:
608 ;;; Non-TR local call for a fixed number of values passed according to the
609 ;;; unknown values convention.
611 ;;; Args are the argument passing locations, which are specified only to
612 ;;; terminate their lifetimes in the caller.
614 ;;; Values are the return value locations (wired to the standard passing
617 ;;; Save is the save info, which we can ignore since saving has been done.
618 ;;; Return-PC is the TN that the return PC should be passed in.
619 ;;; Target is a continuation pointing to the start of the called function.
620 ;;; Nvals is the number of values received.
622 ;;; Note: we can't use normal load-tn allocation for the fixed args, since all
623 ;;; registers may be tied up by the more operand. Instead, we use
624 ;;; MAYBE-LOAD-STACK-TN.
625 (define-vop (call-local)
629 (:results
(values :more t
))
631 (:move-args
:local-call
)
632 (:info arg-locs callee target nvals
)
634 (:temporary
(:scs
(descriptor-reg) :from
(:eval
0)) move-temp
)
635 (:temporary
(:scs
(non-descriptor-reg)) temp
)
636 (:temporary
(:sc control-stack
:offset nfp-save-offset
) nfp-save
)
637 (:temporary
(:sc any-reg
:offset ocfp-offset
:from
(:eval
0)) ocfp
)
638 (:temporary
(:scs
(interior-reg)) lip
)
639 (:ignore arg-locs args ocfp
)
641 (trace-table-entry trace-table-call-site
)
642 (let ((label (gen-label))
643 (cur-nfp (current-nfp-tn vop
)))
645 (store-stack-tn nfp-save cur-nfp
))
646 (let ((callee-nfp (callee-nfp-tn callee
)))
648 (maybe-load-stack-tn callee-nfp nfp
)))
649 (maybe-load-stack-tn cfp-tn fp
)
650 (inst compute-lra lip lip label
)
651 (store-stack-tn (callee-return-pc-tn callee
) lip
)
652 (note-this-location vop
:call-site
)
654 (emit-return-pc label
)
655 (default-unknown-values vop values nvals move-temp temp lip label
)
656 ;; alpha uses (maybe-load-stack-nfp-tn cur-nfp nfp-save temp)
657 ;; instead of the clause below
659 (load-stack-tn cur-nfp nfp-save
)))
660 (trace-table-entry trace-table-normal
)))
663 ;;; Non-TR local call for a variable number of return values passed according
664 ;;; to the unknown values convention. The results are the start of the values
665 ;;; glob and the number of values received.
667 ;;; Note: we can't use normal load-tn allocation for the fixed args, since all
668 ;;; registers may be tied up by the more operand. Instead, we use
669 ;;; MAYBE-LOAD-STACK-TN.
670 (define-vop (multiple-call-local unknown-values-receiver
)
675 (:move-args
:local-call
)
676 (:info save callee target
)
679 (:temporary
(:sc control-stack
:offset nfp-save-offset
) nfp-save
)
680 (:temporary
(:scs
(non-descriptor-reg)) temp
)
681 (:temporary
(:scs
(interior-reg)) lip
)
683 (trace-table-entry trace-table-call-site
)
684 (let ((label (gen-label))
685 (cur-nfp (current-nfp-tn vop
)))
687 (store-stack-tn nfp-save cur-nfp
))
688 (let ((callee-nfp (callee-nfp-tn callee
)))
689 ;; alpha doesn't test this before the maybe-load
691 (maybe-load-stack-tn callee-nfp nfp
)))
692 (maybe-load-stack-tn cfp-tn fp
)
693 (inst compute-lra lip lip label
)
694 (note-this-location vop
:call-site
)
696 (emit-return-pc label
)
697 (note-this-location vop
:unknown-return
)
698 (receive-unknown-values values-start nvals start count label temp lip
)
700 (load-stack-tn cur-nfp nfp-save
)))
701 (trace-table-entry trace-table-normal
)))
703 ;;;; Local call with known values return:
705 ;;; Non-TR local call with known return locations. Known-value return works
706 ;;; just like argument passing in local call.
708 ;;; Note: we can't use normal load-tn allocation for the fixed args, since all
709 ;;; registers may be tied up by the more operand. Instead, we use
710 ;;; MAYBE-LOAD-STACK-TN.
711 (define-vop (known-call-local)
715 (:results
(res :more t
))
716 (:move-args
:local-call
)
718 (:info save callee target
)
719 (:ignore args res save
)
721 (:temporary
(:sc control-stack
:offset nfp-save-offset
) nfp-save
)
722 (:temporary
(:scs
(non-descriptor-reg)) temp
)
723 (:temporary
(:scs
(interior-reg)) lip
)
725 (trace-table-entry trace-table-call-site
)
726 (let ((label (gen-label))
727 (cur-nfp (current-nfp-tn vop
)))
729 (store-stack-tn nfp-save cur-nfp
))
730 (let ((callee-nfp (callee-nfp-tn callee
)))
732 (maybe-load-stack-tn callee-nfp nfp
)))
733 (maybe-load-stack-tn cfp-tn fp
)
734 (inst compute-lra lip lip label
)
735 (store-stack-tn (callee-return-pc-tn callee
) lip
)
736 (note-this-location vop
:call-site
)
738 (emit-return-pc label
)
739 (note-this-location vop
:known-return
)
741 (load-stack-tn cur-nfp nfp-save
)))
742 (trace-table-entry trace-table-normal
)))
744 ;;; Return from known values call. We receive the return locations as
745 ;;; arguments to terminate their lifetimes in the returning function. We
746 ;;; restore FP and CSP and jump to the Return-PC.
748 ;;; Note: we can't use normal load-tn allocation for the fixed args, since all
749 ;;; registers may be tied up by the more operand. Instead, we use
750 ;;; MAYBE-LOAD-STACK-TN.
751 (define-vop (known-return)
752 (:args
(old-fp :target old-fp-temp
)
753 (return-pc :target return-pc-temp
)
755 (:temporary
(:sc any-reg
:from
(:argument
0)) old-fp-temp
)
756 (:temporary
(:sc descriptor-reg
:from
(:argument
1)) return-pc-temp
)
757 (:move-args
:known-return
)
759 (:ignore val-locs vals
)
762 (trace-table-entry trace-table-fun-epilogue
)
763 (maybe-load-stack-tn old-fp-temp old-fp
)
764 (maybe-load-stack-tn return-pc-temp return-pc
)
766 (let ((cur-nfp (current-nfp-tn vop
)))
768 (inst add cur-nfp cur-nfp
(bytes-needed-for-non-descriptor-stack-frame))
769 (store-symbol-value cur-nfp
*number-stack-pointer
*)))
770 (move cfp-tn old-fp-temp
)
771 (lisp-return return-pc-temp
:known
)
772 (trace-table-entry trace-table-normal
)))
776 ;;; There is something of a cross-product effect with full calls.
777 ;;; Different versions are used depending on whether we know the
778 ;;; number of arguments or the name of the called function, and
779 ;;; whether we want fixed values, unknown values, or a tail call.
781 ;;; In full call, the arguments are passed creating a partial frame on
782 ;;; the stack top and storing stack arguments into that frame. On
783 ;;; entry to the callee, this partial frame is pointed to by FP. If
784 ;;; there are no stack arguments, we don't bother allocating a partial
785 ;;; frame, and instead set FP to SP just before the call.
787 ;;; This macro helps in the definition of full call VOPs by avoiding code
788 ;;; replication in defining the cross-product VOPs.
790 ;;; Name is the name of the VOP to define.
792 ;;; Named is true if the first argument is a symbol whose global function
793 ;;; definition is to be called.
795 ;;; Return is either :Fixed, :Unknown or :Tail:
796 ;;; -- If :Fixed, then the call is for a fixed number of values, returned in
797 ;;; the standard passing locations (passed as result operands).
798 ;;; -- If :Unknown, then the result values are pushed on the stack, and the
799 ;;; result values are specified by the Start and Count as in the
800 ;;; unknown-values continuation representation.
801 ;;; -- If :Tail, then do a tail-recursive call. No values are returned.
802 ;;; The Old-Fp and Return-PC are passed as the second and third arguments.
804 ;;; In non-tail calls, the pointer to the stack arguments is passed as the last
805 ;;; fixed argument. If Variable is false, then the passing locations are
806 ;;; passed as a more arg. Variable is true if there are a variable number of
807 ;;; arguments passed on the stack. Variable cannot be specified with :Tail
808 ;;; return. TR variable argument call is implemented separately.
810 ;;; In tail call with fixed arguments, the passing locations are passed as a
811 ;;; more arg, but there is no new-FP, since the arguments have been set up in
812 ;;; the current frame.
813 (defmacro define-full-call
(name named return variable
)
814 (aver (not (and variable
(eq return
:tail
))))
816 ,@(when (eq return
:unknown
)
817 '(unknown-values-receiver)))
819 ,@(unless (eq return
:tail
)
820 '((new-fp :scs
(any-reg) :to
:eval
)))
823 '(name :target name-pass
)
824 '(arg-fun :target lexenv
))
826 ,@(when (eq return
:tail
)
830 ,@(unless variable
'((args :more t
:scs
(descriptor-reg)))))
832 ,@(when (eq return
:fixed
)
833 '((:results
(values :more t
))))
835 (:save-p
,(if (eq return
:tail
) :compute-only t
))
837 ,@(unless (or (eq return
:tail
) variable
)
838 '((:move-args
:full-call
)))
841 (:info
,@(unless (or variable
(eq return
:tail
)) '(arg-locs))
842 ,@(unless variable
'(nargs))
843 ,@(when (eq return
:fixed
) '(nvals))
847 ,@(unless (or variable
(eq return
:tail
)) '(arg-locs))
848 ,@(unless variable
'(args))
849 ,@(when (eq return
:tail
) '(old-fp)))
851 (:temporary
(:sc descriptor-reg
:offset lexenv-offset
852 :from
(:argument
,(if (eq return
:tail
) 0 1))
854 ,(if named
'name-pass
'lexenv
))
856 (:temporary
(:scs
(descriptor-reg) :from
(:argument
0) :to
:eval
)
858 (:temporary
(:sc any-reg
:offset nargs-offset
:to
:eval
)
862 (mapcar #'(lambda (name offset
)
863 `(:temporary
(:sc descriptor-reg
867 *register-arg-names
* *register-arg-offsets
*))
868 ,@(when (eq return
:fixed
)
869 '((:temporary
(:scs
(descriptor-reg) :from
:eval
) move-temp
)))
871 ,@(unless (eq return
:tail
)
872 '((:temporary
(:scs
(non-descriptor-reg)) temp
)
873 (:temporary
(:scs
(interior-reg)) lip
)
874 (:temporary
(:sc control-stack
:offset nfp-save-offset
) nfp-save
)))
876 (:generator
,(+ (if named
5 0)
878 (if (eq return
:tail
) 0 10)
880 (if (eq return
:unknown
) 25 0))
881 (trace-table-entry trace-table-call-site
)
882 (let* ((cur-nfp (current-nfp-tn vop
))
883 ,@(unless (eq return
:tail
)
884 '((lra-label (gen-label))))
885 (step-done-label (gen-label))
889 ,@(if (eq return
:tail
)
890 '((unless (location= return-pc
891 (make-random-tn :kind
:normal
892 :sc
(sc-or-lose 'control-stack
)
893 :offset lra-save-offset
))
901 (flet ((do-next-filler ()
902 (let* ((next (pop filler
))
903 (what (if (consp next
) (car next
) next
)))
907 `((inst sub nargs-pass csp-tn new-fp
)
909 (mapcar #'(lambda (name)
912 *register-arg-names
*)))
913 '((inst mov nargs-pass
(fixnumize nargs
)))))
914 ,@(if (eq return
:tail
)
916 (error "RETURN-PC not in its passing location"))
918 (inst add cur-nfp cur-nfp
(bytes-needed-for-non-descriptor-stack-frame))
919 (store-symbol-value cur-nfp
*number-stack-pointer
*)))
921 (inst compute-lra lip lip lra-label
)
922 (inst str lip
(@ new-fp
(* lra-save-offset
925 (store-stack-tn nfp-save cur-nfp
))
927 (move cfp-tn new-fp
))))
929 (insert-step-instrumenting (callable-tn)
930 ;; Conditionally insert a conditional trap:
931 (when step-instrumenting
932 ;; Get the symbol-value of SB!IMPL::*STEPPING*
933 #+(or) ;; Doesn't work for :TAIL case.
934 (load-symbol-value temp sb
!impl
::*stepping
*)
935 (error "Don't know how to STEP-INSTRUMENT a CALL"))))
940 (descriptor-reg (move name-pass name
))
942 (loadw name-pass cfp-tn
(tn-offset name
))
945 (loadw name-pass code-tn
(tn-offset name
)
946 other-pointer-lowtag
)
948 (insert-step-instrumenting name-pass
)
949 (loadw function name-pass fdefn-raw-addr-slot
950 other-pointer-lowtag
)
953 (descriptor-reg (move lexenv arg-fun
))
955 (loadw lexenv cfp-tn
(tn-offset arg-fun
))
958 (loadw lexenv code-tn
(tn-offset arg-fun
)
959 other-pointer-lowtag
)
961 (loadw function lexenv closure-fun-slot
964 (insert-step-instrumenting function
)))
970 (note-this-location vop
:call-site
)
971 (lisp-jump function
))
975 '((emit-return-pc lra-label
)
976 (default-unknown-values vop values nvals move-temp
979 (load-stack-tn cur-nfp nfp-save
))))
981 '((emit-return-pc lra-label
)
982 (note-this-location vop
:unknown-return
)
983 (receive-unknown-values values-start nvals start count
986 (load-stack-tn cur-nfp nfp-save
))))
988 (trace-table-entry trace-table-normal
))))
991 (define-full-call call nil
:fixed nil
)
992 (define-full-call call-named t
:fixed nil
)
993 (define-full-call multiple-call nil
:unknown nil
)
994 (define-full-call multiple-call-named t
:unknown nil
)
995 (define-full-call tail-call nil
:tail nil
)
996 (define-full-call tail-call-named t
:tail nil
)
998 (define-full-call call-variable nil
:fixed t
)
999 (define-full-call multiple-call-variable nil
:unknown t
)
1001 ;;; Defined separately, since needs special code that BLT's the
1003 (define-vop (tail-call-variable)
1005 (args-arg :scs
(any-reg) :target args
)
1006 (function-arg :scs
(descriptor-reg) :target lexenv
)
1007 (old-fp-arg :scs
(any-reg) :load-if nil
)
1008 (lra-arg :scs
(descriptor-reg) :load-if nil
))
1009 (:temporary
(:sc any-reg
:offset nl2-offset
:from
(:argument
0)) args
)
1010 (:temporary
(:sc any-reg
:offset lexenv-offset
:from
(:argument
1)) lexenv
)
1011 (:temporary
(:sc any-reg
) temp
)
1012 (:temporary
(:sc interior-reg
) lip
)
1013 (:ignore old-fp-arg lra-arg
)
1016 ;; Move these into the passing locations if they are not already there.
1017 (move args args-arg
)
1018 (move lexenv function-arg
)
1019 ;; Clear the number stack if anything is there.
1020 (let ((cur-nfp (current-nfp-tn vop
)))
1022 (inst add cur-nfp cur-nfp
(bytes-needed-for-non-descriptor-stack-frame))
1023 (store-symbol-value cur-nfp
*number-stack-pointer
*)))
1024 (let ((fixup-lab (gen-label)))
1025 (assemble (*elsewhere
*)
1026 (emit-label fixup-lab
)
1027 (inst word
(make-fixup 'tail-call-variable
:assembly-routine
)))
1028 (inst load-from-label pc-tn lip fixup-lab
))))
1030 ;;;; Unknown values return:
1032 ;;; Return a single value using the unknown-values convention.
1033 (define-vop (return-single)
1034 (:args
(old-fp :scs
(any-reg) :to
:eval
)
1035 (return-pc :scs
(descriptor-reg))
1040 (trace-table-entry trace-table-fun-epilogue
)
1041 ;; Clear the number stack.
1042 (let ((cur-nfp (current-nfp-tn vop
)))
1044 (inst add cur-nfp cur-nfp
(bytes-needed-for-non-descriptor-stack-frame))
1045 (store-symbol-value cur-nfp
*number-stack-pointer
*)))
1046 ;; Clear the control stack, and restore the frame pointer.
1047 (move csp-tn cfp-tn
)
1048 (move cfp-tn old-fp
)
1050 (lisp-return return-pc
:single-value
)
1051 (trace-table-entry trace-table-normal
)))
1053 ;;; Do unknown-values return of a fixed number of values. The Values are
1054 ;;; required to be set up in the standard passing locations. Nvals is the
1055 ;;; number of values returned.
1057 ;;; If returning a single value, then deallocate the current frame, restore
1058 ;;; FP and jump to the single-value entry at Return-PC + 8.
1060 ;;; If returning other than one value, then load the number of values returned,
1061 ;;; NIL out unsupplied values registers, restore FP and return at Return-PC.
1062 ;;; When there are stack values, we must initialize the argument pointer to
1063 ;;; point to the beginning of the values block (which is the beginning of the
1065 (define-vop (return)
1067 (old-fp :scs
(any-reg))
1068 (return-pc :scs
(descriptor-reg) :to
(:eval
1) :target lra
)
1072 (:temporary
(:sc descriptor-reg
:offset r0-offset
:from
(:eval
0)) r0
)
1073 (:temporary
(:sc descriptor-reg
:offset r1-offset
:from
(:eval
0)) r1
)
1074 (:temporary
(:sc descriptor-reg
:offset r2-offset
:from
(:eval
0)) r2
)
1075 (:temporary
(:sc descriptor-reg
:offset lexenv-offset
:from
(:eval
1)) lra
)
1076 (:temporary
(:sc any-reg
:offset nargs-offset
) nargs
)
1077 (:temporary
(:sc any-reg
:offset ocfp-offset
) val-ptr
)
1080 (trace-table-entry trace-table-fun-epilogue
)
1081 (move lra return-pc
)
1082 ;; Clear the number stack.
1083 (let ((cur-nfp (current-nfp-tn vop
)))
1085 (inst add cur-nfp cur-nfp
1086 (bytes-needed-for-non-descriptor-stack-frame))
1087 (store-symbol-value cur-nfp
*number-stack-pointer
*)))
1089 ;; Clear the control stack, and restore the frame pointer.
1090 (move csp-tn cfp-tn
)
1091 (move cfp-tn old-fp
)
1093 (lisp-return lra
:single-value
))
1095 ;; Establish the values pointer and values count.
1096 (move val-ptr cfp-tn
)
1097 (inst mov nargs
(fixnumize nvals
))
1098 ;; restore the frame pointer and clear as much of the control
1099 ;; stack as possible.
1100 (move cfp-tn old-fp
)
1101 (inst add csp-tn val-ptr
(* nvals n-word-bytes
))
1102 ;; pre-default any argument register that need it.
1103 (when (< nvals register-arg-count
)
1104 (dolist (reg (subseq (list r0 r1 r2
) nvals
))
1105 (move reg null-tn
)))
1107 (lisp-return lra
:multiple-values
)))
1108 (trace-table-entry trace-table-normal
)))
1110 ;;; Do unknown-values return of an arbitrary number of values (passed
1111 ;;; on the stack.) We check for the common case of a single return
1112 ;;; value, and do that inline using the normal single value return
1113 ;;; convention. Otherwise, we branch off to code that calls an
1114 ;;; assembly-routine.
1115 (define-vop (return-multiple)
1117 (old-fp-arg :scs
(any-reg) :to
(:eval
1))
1118 (lra-arg :scs
(descriptor-reg) :to
(:eval
1))
1119 (vals-arg :scs
(any-reg) :target vals
)
1120 (nvals-arg :scs
(any-reg) :target nvals
))
1121 (:temporary
(:sc any-reg
:offset nl2-offset
:from
(:argument
0)) old-fp
)
1122 (:temporary
(:sc descriptor-reg
:offset lexenv-offset
:from
(:argument
1)) lra
)
1123 (:temporary
(:sc any-reg
:offset ocfp-offset
:from
(:argument
2)) vals
)
1124 (:temporary
(:sc any-reg
:offset nargs-offset
:from
(:argument
3)) nvals
)
1125 (:temporary
(:sc descriptor-reg
:offset r0-offset
) r0
)
1128 (trace-table-entry trace-table-fun-epilogue
)
1130 ;; Clear the number stack.
1131 (let ((cur-nfp (current-nfp-tn vop
)))
1133 (inst add cur-nfp cur-nfp
1134 (bytes-needed-for-non-descriptor-stack-frame))
1135 (store-symbol-value cur-nfp
*number-stack-pointer
*)))
1137 ;; Check for the single case.
1138 (inst cmp nvals-arg
(fixnumize 1))
1139 (inst b
:ne NOT-SINGLE
)
1141 ;; Return with one value.
1142 (inst ldr r0
(@ vals-arg
))
1143 (move csp-tn cfp-tn
)
1144 (move cfp-tn old-fp-arg
)
1145 (lisp-return lra-arg
:single-value
)
1147 ;; Nope, not the single case.
1149 (move old-fp old-fp-arg
)
1150 (move vals vals-arg
)
1151 (move nvals nvals-arg
)
1152 (inst ldr pc-tn
(@ fixup
))
1154 (inst word
(make-fixup 'return-multiple
:assembly-routine
))
1156 (trace-table-entry trace-table-normal
)))