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)
33 (make-wired-tn *backend-t-primitive-type
* register-arg-scn lra-offset
)
34 (make-restricted-tn *backend-t-primitive-type
* register-arg-scn
)))
36 ;;; MAKE-OLD-FP-PASSING-LOCATION would be here, but the ARM backend
37 ;;; passes the OCFP in its save location.
39 ;;; Make the TNs used to hold OLD-FP and RETURN-PC within the current
40 ;;; function. We treat these specially so that the debugger can find
41 ;;; them at a known location.
42 (defun make-old-fp-save-location (env)
43 ;; Unlike the other backends, ARM function calling is designed to
44 ;; pass OLD-FP within the stack frame rather than in a register. As
45 ;; such, in order for lifetime analysis not to screw up, we need it
46 ;; to be a stack TN wired to the save offset, not a normal TN with a
48 (physenv-debug-live-tn (make-wired-tn *fixnum-primitive-type
*
52 (defun make-return-pc-save-location (env)
54 (physenv-debug-live-tn (make-normal-tn *backend-t-primitive-type
*) env
)
55 (make-wired-tn *backend-t-primitive-type
*
59 ;;; Make a TN for the standard argument count passing location. We
60 ;;; only need to make the standard location, since a count is never
61 ;;; passed when we are using non-standard conventions.
62 (defun make-arg-count-location ()
63 (make-wired-tn *fixnum-primitive-type
* immediate-arg-scn nargs-offset
))
66 ;;; Make a TN to hold the number-stack frame pointer. This is
67 ;;; allocated once per component, and is component-live.
70 (make-wired-tn *fixnum-primitive-type
* immediate-arg-scn nfp-offset
)))
72 (defun make-stack-pointer-tn ()
73 (make-normal-tn *fixnum-primitive-type
*))
75 (defun make-number-stack-pointer-tn ()
76 (make-normal-tn *fixnum-primitive-type
*))
78 ;;; Return a list of TNs that can be used to represent an unknown-values
79 ;;; continuation within a function.
80 (defun make-unknown-values-locations ()
81 (list (make-stack-pointer-tn)
82 (make-normal-tn *fixnum-primitive-type
*)))
84 ;;; This function is called by the ENTRY-ANALYZE phase, allowing
85 ;;; VM-dependent initialization of the IR2-COMPONENT structure. We push
86 ;;; placeholder entries in the Constants to leave room for additional
87 ;;; noise in the code object header.
88 (defun select-component-format (component)
89 (declare (type component component
))
90 (dotimes (i code-constants-offset
)
91 (vector-push-extend nil
92 (ir2-component-constants (component-info component
))))
97 ;;; Used for setting up the Old-FP in local call.
98 (define-vop (current-fp)
99 (:results
(val :scs
(any-reg)))
103 (define-vop (xep-allocate-frame)
104 (:info start-lab copy-more-arg-follows
)
106 (:temporary
(:scs
(any-reg)) temp
)
108 ;; Make sure the function is aligned, and drop a label pointing to this
110 (emit-alignment n-lowtag-bits
)
111 (trace-table-entry trace-table-fun-prologue
)
112 (emit-label start-lab
)
113 ;; Allocate function header.
114 (inst simple-fun-header-word
)
115 (dotimes (i (1- simple-fun-code-offset
))
117 (inst compute-code code-tn lip-tn start-lab temp
)
118 ;; Build our stack frames.
119 (unless copy-more-arg-follows
120 (inst add sp-tn fp-tn
121 (* n-word-bytes
(sb-allocated-size 'control-stack
)))
122 (let ((nfp-tn (current-nfp-tn vop
)))
124 (error "Don't know how to allocate number stack space"))))
125 (trace-table-entry trace-table-normal
)))
127 ;;; Allocate a partial frame for passing stack arguments in a full call. Nargs
128 ;;; is the number of arguments passed. If no stack arguments are passed, then
129 ;;; we don't have to do anything.
130 (define-vop (allocate-full-call-frame)
132 (:results
(res :scs
(any-reg)))
134 ;; Unlike most other backends, we store the "OCFP" at frame
135 ;; allocation time rather than at function-entry time, largely due
136 ;; to a lack of usable registers.
138 (inst add sp-tn sp-tn
(* (max 1 nargs
) n-word-bytes
))
139 (storew fp-tn res ocfp-save-offset
)))
141 ;;; Emit code needed at the return-point from an unknown-values call
142 ;;; for a fixed number of values. VALUES is the head of the TN-REF
143 ;;; list for the locations that the values are to be received into.
144 ;;; NVALS is the number of values that are to be received (should
145 ;;; equal the length of Values).
147 ;;; MOVE-TEMP is a DESCRIPTOR-REG TN used as a temporary.
149 ;;; This code exploits the fact that in the unknown-values convention,
150 ;;; a single value return returns with all of the condition flags
151 ;;; clear, whereas a return of other than one value returns with the
152 ;;; condition flags set.
154 ;;; If 0 or 1 values are expected, then we just emit an instruction to
155 ;;; reset the SP (which will only be executed when other than 1 value
158 ;;; In the general case, we have to do three things:
159 ;;; -- Default unsupplied register values. This need only be done when a
160 ;;; single value is returned, since register values are defaulted by the
161 ;;; callee in the non-single case.
162 ;;; -- Default unsupplied stack values. This needs to be done whenever there
163 ;;; are stack values.
164 ;;; -- Reset SP. This must be done whenever other than 1 value is returned,
165 ;;; regardless of the number of values desired.
167 (defun default-unknown-values (vop values nvals move-temp temp lra-label
)
168 (declare (type (or tn-ref null
) values
)
169 (type unsigned-byte nvals
) (type tn move-temp temp
))
170 (let ((expecting-values-on-stack (> nvals register-arg-count
))
171 (values-on-stack temp
))
172 ;; Pick off the single-value case first.
173 (sb!assem
:without-scheduling
()
174 (note-this-location vop
(if (<= nvals
1)
178 ;; Default register values for single-value return case.
179 ;; The callee returns with condition bits CLEAR in the
180 ;; single-value case.
183 (val (tn-ref-across values
) (tn-ref-across val
)))
184 ((= i
(min nvals register-arg-count
)))
185 (inst mov
:ne
(tn-ref-tn val
) null-tn
)))
187 ;; If we're not expecting values on the stack, all that
188 ;; remains is to clear the stack frame (for the multiple-
189 ;; value return case).
190 (unless expecting-values-on-stack
191 (inst mov
:eq sp-tn ocfp-tn
))
193 ;; If we ARE expecting values on the stack, we need to
194 ;; either move them to their result location or to set their
195 ;; result location to the default.
196 (when expecting-values-on-stack
198 ;; For the single-value return case, fake up NARGS and
199 ;; OCFP so that we don't screw ourselves with the
200 ;; defaulting and stack clearing logic.
201 (inst mov
:ne ocfp-tn sp-tn
)
202 (inst mov
:ne nargs-tn n-word-bytes
)
204 ;; Compute the number of stack values (may be negative if
205 ;; not all of the register values are populated).
206 (inst sub values-on-stack nargs-tn
(fixnumize register-arg-count
))
208 ;; For each expected stack value...
209 (do ((i register-arg-count
(1+ i
))
210 (val (do ((i 0 (1+ i
))
211 (val values
(tn-ref-across val
)))
212 ((= i register-arg-count
) val
))
213 (tn-ref-across val
)))
216 ;; ... Load it if there is a stack value available, or
217 ;; default it if there isn't.
218 (inst subs values-on-stack values-on-stack
4)
219 (loadw move-temp ocfp-tn i
0 :ge
)
220 (store-stack-tn (tn-ref-tn val
) move-temp
:ge
)
221 (store-stack-tn (tn-ref-tn val
) null-tn
:lt
))
223 ;; Deallocate the callee stack frame.
224 (move sp-tn ocfp-tn
)))
226 ;; And, finally, recompute the correct value for CODE-TN.
227 (inst compute-code code-tn lip-tn lra-label temp
))
231 ;;; This hook in the codegen pass lets us insert code before fall-thru entry
232 ;;; points, local-call entry points, and tail-call entry points. The default
234 (defun emit-block-header (start-label trampoline-label fall-thru-p alignp
)
235 (declare (ignore fall-thru-p alignp
))
236 (when trampoline-label
237 (emit-label trampoline-label
))
238 (emit-label start-label
))
243 ;;; We don't need to do anything special for regular functions.
245 (define-vop (setup-environment)
249 ;; Don't bother doing anything.
252 ;;; Get the lexical environment from its passing location.
253 (define-vop (setup-closure-environment)
254 (:temporary
(:sc descriptor-reg
:offset lexenv-offset
:target closure
257 (:results
(closure :scs
(descriptor-reg)))
262 (move closure lexenv
)))
264 ;;; Copy a more arg from the argument area to the end of the current frame.
265 ;;; Fixed is the number of non-more arguments.
266 (define-vop (copy-more-arg)
267 ;; The environment here-and-now is not properly initialized. The
268 ;; stack frame is not yet fully allocated, and even if it were most
269 ;; of the slots have live data in them that PACK does not know
270 ;; about, so we cannot afford a register spill. As far as the boxed
271 ;; registers go, the arg-passing registers (R0, R1, and R2) are
272 ;; live, LEXENV is live, and LRA is live. On the unboxed front,
273 ;; NARGS is live. FP has been set up by the caller, SP is
274 ;; protecting our stack arguments, but is otherwise not set up. NFP
275 ;; is not yet set up. CODE and NULL are set up. SP and NFP must be
276 ;; correctly set up by the time we're done, and OCFP and R8 are
277 ;; available for use as temporaries. If we were any more register
278 ;; constrained, we'd be spilling registers manually (rather than
279 ;; allowing PACK to do it for us). -- AJB, 2012-Oct-30
281 ;; Pack COUNT and DEST into the same register, being careful to tell
282 ;; PACK that their lifetimes do not overlap (we're lying to PACK, as
283 ;; COUNT is live both before and after DEST, but not while DEST is
285 (:temporary
(:sc any-reg
:offset ocfp-offset
:to
:eval
) count
)
286 (:temporary
(:sc any-reg
:offset ocfp-offset
:from
:eval
) dest
)
287 (:temporary
(:sc descriptor-reg
:offset r8-offset
) temp
)
290 ;; We open up with a LET to obtain a TN for NFP. We'll call it
291 ;; RESULT, to distinguish it from NFP-as-NFP and to roughly
292 ;; parallel the PPC implementation. We can't use a :TEMPORARY
293 ;; here because it would conflict with the existing NFP if there
294 ;; is a number-stack frame in play, but we only use it prior to
295 ;; actually setting up the "real" NFP.
296 (let ((result (make-random-tn :kind
:normal
297 :sc
(sc-or-lose 'any-reg
)
298 :offset nfp-offset
)))
299 ;; And we use ASSEMBLE here so that we get "implcit labels"
300 ;; rather than having to use GEN-LABEL and EMIT-LABEL.
302 ;; Compute the end of the fixed stack frame (start of the MORE
303 ;; arg area) into RESULT.
304 (inst add result fp-tn
305 (* n-word-bytes
(sb-allocated-size 'control-stack
)))
306 ;; Compute the end of the MORE arg area (and our overall frame
307 ;; allocation) into the stack pointer.
309 (inst cmp nargs-tn
0)
310 (inst add sp-tn result nargs-tn
)
313 (inst subs count nargs-tn
(fixnumize fixed
))
315 (inst add sp-tn result count
)))
317 (when (< fixed register-arg-count
)
318 ;; We must stop when we run out of stack args, not when we
319 ;; run out of more args.
320 (inst add result result
(fixnumize (- register-arg-count fixed
))))
322 ;; Initialize dest to be end of stack.
325 ;; We are copying at most (- NARGS FIXED) values, from last to
326 ;; first, in order to shift them out of the allocated part of
327 ;; the stack frame. The FIXED values remain where they are,
328 ;; as they are part of the allocated stack frame. Any
329 ;; remaining values are being moved to just beyond the end of
330 ;; the allocated stack frame, for a distance of (-
331 ;; (sb-allocated-size 'control-stack) fixed) words. There is
332 ;; a constant displacement of a single word in the loop below,
333 ;; because DEST points to the space AFTER the value being
337 (inst cmp dest result
)
338 (let ((delta (- (sb-allocated-size 'control-stack
) fixed
)))
339 (inst ldr
:gt temp
(@ dest
(- (* (1+ delta
) n-word-bytes
)))))
340 (inst str
:gt temp
(@ dest
(- n-word-bytes
) :pre-index
))
344 (when (< fixed register-arg-count
)
345 ;; Now we have to deposit any more args that showed up in registers.
346 (inst subs count nargs-tn
(fixnumize fixed
))
347 (do ((i fixed
(1+ i
)))
348 ((>= i register-arg-count
))
349 ;; Don't deposit any more than there are.
351 (inst subs count count
(fixnumize 1))
352 ;; Store it into the space reserved to it, by displacement
353 ;; from the frame pointer.
354 (storew (nth i
*register-arg-tns
*)
355 fp-tn
(+ (sb-allocated-size 'control-stack
)
359 ;; Now that we're done with the &MORE args, we can set up the
360 ;; number stack frame.
361 (let ((nfp-tn (current-nfp-tn vop
)))
363 (error "Don't know how to allocate number stack space")))))))
365 ;;; More args are stored consecutively on the stack, starting
366 ;;; immediately at the context pointer. The context pointer is not
367 ;;; typed, so the lowtag is 0.
368 (define-full-reffer more-arg
* 0 0 (descriptor-reg any-reg
) * %more-arg
)
370 ;;; Turn more arg (context, count) into a list.
371 (define-vop (listify-rest-args)
372 (:args
(context-arg :target context
:scs
(descriptor-reg))
373 (count-arg :target count
:scs
(any-reg)))
374 (:arg-types
* tagged-num
)
375 (:temporary
(:scs
(any-reg) :from
(:argument
0)) context
)
376 (:temporary
(:scs
(any-reg) :from
(:argument
1)) count
)
377 (:temporary
(:scs
(descriptor-reg) :from
:eval
) temp
)
378 (:temporary
(:scs
(any-reg) :from
:eval
) dst
)
379 (:temporary
(:sc non-descriptor-reg
:offset ocfp-offset
) pa-flag
)
380 (:results
(result :scs
(descriptor-reg)))
381 (:translate %listify-rest-args
)
385 (move context context-arg
)
386 (move count count-arg
)
387 ;; Check to see if there are any arguments.
389 (move result null-tn
)
392 ;; We need to do this atomically.
393 (pseudo-atomic (pa-flag)
394 ;; Allocate a cons (2 words) for each item.
395 (if (node-stack-allocate-p node
)
397 (error "Don't know how to stack-allocate an &REST list.")
401 (inst clrrwi result csp-tn n-lowtag-bits
)
402 (inst ori result result list-pointer-lowtag
)
404 (inst slwi temp count
1)
405 (inst add csp-tn csp-tn temp
))
407 (inst mov temp
(lsl count
1))
408 (allocation result temp list-pointer-lowtag
412 ;; FIXME: This entire loop is based on the PPC version, which is
413 ;; a poor fit for the ARM instruction set.
416 ;; Compute the next cons and store it in the current one.
418 (inst add dst dst
(* 2 n-word-bytes
))
419 (storew dst dst -
1 list-pointer-lowtag
)
424 (inst add context context n-word-bytes
)
426 ;; Dec count, and if != zero, go back for more.
427 (inst subs count count
(fixnumize 1))
428 ;; Store the value into the car of the current cons (in the delay
430 (storew temp dst
0 list-pointer-lowtag
)
433 ;; NIL out the last cons.
434 (storew null-tn dst
1 list-pointer-lowtag
))
437 ;;; Return the location and size of the more arg glob created by
438 ;;; Copy-More-Arg. Supplied is the total number of arguments supplied
439 ;;; (originally passed in NARGS.) Fixed is the number of non-rest
442 ;;; We must duplicate some of the work done by Copy-More-Arg, since at
443 ;;; that time the environment is in a pretty brain-damaged state,
444 ;;; preventing this info from being returned as values. What we do is
445 ;;; compute supplied - fixed, and return a pointer that many words
446 ;;; below the current stack top.
447 (define-vop (more-arg-context)
449 (:translate sb
!c
::%more-arg-context
)
450 (:args
(supplied :scs
(any-reg)))
451 (:arg-types tagged-num
(:constant fixnum
))
453 (:results
(context :scs
(descriptor-reg))
454 (count :scs
(any-reg)))
455 (:result-types t tagged-num
)
456 (:note
"more-arg-context")
458 (inst sub count supplied
(fixnumize fixed
))
459 (inst sub context sp-tn count
)))
461 (define-vop (verify-arg-count)
463 (:translate sb
!c
::%verify-arg-count
)
464 (:args
(nargs :scs
(any-reg)))
465 (:arg-types positive-fixnum
(:constant t
))
466 (:temporary
(:sc non-descriptor-reg
:offset ocfp-offset
) error-temp
)
469 (:save-p
:compute-only
)
472 (generate-error-code vop error-temp
473 'invalid-arg-count-error nargs
)))
474 (inst cmp nargs
(fixnumize count
))
475 (inst b
:ne err-lab
))))
477 ;;; Signal various errors.
478 (macrolet ((frob (name error translate
&rest args
)
481 `((:policy
:fast-safe
)
482 (:translate
,translate
)))
483 (:args
,@(mapcar #'(lambda (arg)
484 `(,arg
:scs
(any-reg descriptor-reg
)))
486 (:temporary
(:sc non-descriptor-reg
:offset ocfp-offset
) error-temp
)
488 (:save-p
:compute-only
)
490 (error-call vop error-temp
',error
,@args
)))))
491 (frob arg-count-error invalid-arg-count-error
492 sb
!c
::%arg-count-error nargs
)
493 (frob type-check-error object-not-type-error sb
!c
::%type-check-error
495 (frob layout-invalid-error layout-invalid-error sb
!c
::%layout-invalid-error
497 (frob odd-key-args-error odd-key-args-error
498 sb
!c
::%odd-key-args-error
)
499 (frob unknown-key-arg-error unknown-key-arg-error
500 sb
!c
::%unknown-key-arg-error key
)
501 (frob nil-fun-returned-error nil-fun-returned-error nil fun
))
505 ;;; There is something of a cross-product effect with full calls.
506 ;;; Different versions are used depending on whether we know the
507 ;;; number of arguments or the name of the called function, and
508 ;;; whether we want fixed values, unknown values, or a tail call.
510 ;;; In full call, the arguments are passed creating a partial frame on
511 ;;; the stack top and storing stack arguments into that frame. On
512 ;;; entry to the callee, this partial frame is pointed to by FP. If
513 ;;; there are no stack arguments, we don't bother allocating a partial
514 ;;; frame, and instead set FP to SP just before the call.
516 ;;; This macro helps in the definition of full call VOPs by avoiding code
517 ;;; replication in defining the cross-product VOPs.
519 ;;; Name is the name of the VOP to define.
521 ;;; Named is true if the first argument is a symbol whose global function
522 ;;; definition is to be called.
524 ;;; Return is either :Fixed, :Unknown or :Tail:
525 ;;; -- If :Fixed, then the call is for a fixed number of values, returned in
526 ;;; the standard passing locations (passed as result operands).
527 ;;; -- If :Unknown, then the result values are pushed on the stack, and the
528 ;;; result values are specified by the Start and Count as in the
529 ;;; unknown-values continuation representation.
530 ;;; -- If :Tail, then do a tail-recursive call. No values are returned.
531 ;;; The Old-Fp and Return-PC are passed as the second and third arguments.
533 ;;; In non-tail calls, the pointer to the stack arguments is passed as the last
534 ;;; fixed argument. If Variable is false, then the passing locations are
535 ;;; passed as a more arg. Variable is true if there are a variable number of
536 ;;; arguments passed on the stack. Variable cannot be specified with :Tail
537 ;;; return. TR variable argument call is implemented separately.
539 ;;; In tail call with fixed arguments, the passing locations are passed as a
540 ;;; more arg, but there is no new-FP, since the arguments have been set up in
541 ;;; the current frame.
542 (defmacro define-full-call
(name named return variable
)
543 (aver (not (and variable
(eq return
:tail
))))
545 ,@(when (eq return
:unknown
)
546 '(unknown-values-receiver)))
548 ,@(unless (eq return
:tail
)
549 '((new-fp :scs
(any-reg) :to
:eval
)))
552 '(name :target name-pass
)
553 '(arg-fun :target lexenv
))
555 ,@(when (eq return
:tail
)
556 '((return-pc :target return-pc-pass
)))
558 ,@(unless variable
'((args :more t
:scs
(descriptor-reg)))))
560 ,@(when (eq return
:fixed
)
561 '((:results
(values :more t
))))
563 (:save-p
,(if (eq return
:tail
) :compute-only t
))
565 ,@(unless (or (eq return
:tail
) variable
)
566 '((:move-args
:full-call
)))
569 (:info
,@(unless (or variable
(eq return
:tail
)) '(arg-locs))
570 ,@(unless variable
'(nargs))
571 ,@(when (eq return
:fixed
) '(nvals))
575 ,@(unless (or variable
(eq return
:tail
)) '(arg-locs))
576 ,@(unless variable
'(args)))
578 (:temporary
(:sc descriptor-reg
584 (:temporary
(:sc descriptor-reg
:offset lexenv-offset
585 :from
(:argument
,(if (eq return
:tail
) 0 1))
587 ,(if named
'name-pass
'lexenv
))
589 (:temporary
(:scs
(descriptor-reg) :from
(:argument
0) :to
:eval
)
591 (:temporary
(:sc any-reg
:offset nargs-offset
:to
:eval
)
595 (mapcar #'(lambda (name offset
)
596 `(:temporary
(:sc descriptor-reg
600 *register-arg-names
* *register-arg-offsets
*))
601 ,@(when (eq return
:fixed
)
602 '((:temporary
(:scs
(descriptor-reg) :from
:eval
) move-temp
)))
604 ,@(unless (eq return
:tail
)
605 '((:temporary
(:scs
(non-descriptor-reg)) temp
)
606 (:temporary
(:sc control-stack
:offset nfp-save-offset
) nfp-save
)))
608 (:generator
,(+ (if named
5 0)
610 (if (eq return
:tail
) 0 10)
612 (if (eq return
:unknown
) 25 0))
613 (trace-table-entry trace-table-call-site
)
614 (let* ((cur-nfp (current-nfp-tn vop
))
615 ,@(unless (eq return
:tail
)
616 '((lra-label (gen-label))))
617 (step-done-label (gen-label))
621 ,@(if (eq return
:tail
)
622 '((unless (location= return-pc
631 (flet ((do-next-filler ()
632 (let* ((next (pop filler
))
633 (what (if (consp next
) (car next
) next
)))
637 `((inst sub nargs-pass sp-tn new-fp
)
639 (mapcar #'(lambda (name)
642 *register-arg-names
*)))
643 '((inst mov nargs-pass
(fixnumize nargs
)))))
644 ,@(if (eq return
:tail
)
648 (inst mov return-pc-pass return-pc
))
650 (loadw return-pc-pass fp-tn
651 (tn-offset return-pc
)))))
653 (error "Don't know how to :FROB-NFP for TAIL call")))
655 (inst compute-lra return-pc-pass lra-label
))
657 (store-stack-tn nfp-save cur-nfp
))
659 (move fp-tn new-fp
))))
661 (insert-step-instrumenting (callable-tn)
662 ;; Conditionally insert a conditional trap:
663 (when step-instrumenting
664 ;; Get the symbol-value of SB!IMPL::*STEPPING*
665 #+(or) ;; Doesn't work for :TAIL case.
666 (load-symbol-value temp sb
!impl
::*stepping
*)
667 (error "Don't know how to STEP-INSTRUMENT a CALL"))))
672 (descriptor-reg (move name-pass name
))
674 (loadw name-pass fp-tn
(tn-offset name
))
677 (loadw name-pass code-tn
(tn-offset name
)
678 other-pointer-lowtag
)
680 (insert-step-instrumenting name-pass
)
681 (loadw function name-pass fdefn-raw-addr-slot
682 other-pointer-lowtag
)
685 (descriptor-reg (move lexenv arg-fun
))
687 (loadw lexenv fp-tn
(tn-offset arg-fun
))
690 (loadw lexenv code-tn
(tn-offset arg-fun
)
691 other-pointer-lowtag
)
693 (loadw function lexenv closure-fun-slot
696 (insert-step-instrumenting function
)))
702 (note-this-location vop
:call-site
)
703 (lisp-jump function
))
707 '((emit-return-pc lra-label
)
708 (default-unknown-values vop values nvals move-temp
711 (load-stack-tn cur-nfp nfp-save
))))
713 '((emit-return-pc lra-label
)
714 (note-this-location vop
:unknown-return
)
715 (receive-unknown-values values-start nvals start count
718 (load-stack-tn cur-nfp nfp-save
))))
720 (trace-table-entry trace-table-normal
))))
723 (define-full-call call nil
:fixed nil
)
724 (define-full-call call-named t
:fixed nil
)
725 (define-full-call tail-call nil
:tail nil
)
726 (define-full-call tail-call-named t
:tail nil
)
728 ;;;; Unknown values return:
730 ;;; Return a single value using the unknown-values convention.
731 (define-vop (return-single)
732 (:args
(old-fp :scs
(any-reg) :to
:eval
)
733 (return-pc :scs
(descriptor-reg))
738 (trace-table-entry trace-table-fun-epilogue
)
739 ;; Clear the number stack.
740 (let ((cur-nfp (current-nfp-tn vop
)))
742 (error "Don't know how to clear number stack space in RETURN-SINGLE")))
743 ;; Clear the control stack, and restore the frame pointer.
747 (lisp-return return-pc t
)
748 (trace-table-entry trace-table-normal
)))
750 ;;; Do unknown-values return of a fixed number of values. The Values are
751 ;;; required to be set up in the standard passing locations. Nvals is the
752 ;;; number of values returned.
754 ;;; If returning a single value, then deallocate the current frame, restore
755 ;;; FP and jump to the single-value entry at Return-PC + 8.
757 ;;; If returning other than one value, then load the number of values returned,
758 ;;; NIL out unsupplied values registers, restore FP and return at Return-PC.
759 ;;; When there are stack values, we must initialize the argument pointer to
760 ;;; point to the beginning of the values block (which is the beginning of the
764 (old-fp :scs
(any-reg))
765 (return-pc :scs
(descriptor-reg) :to
(:eval
1) :target lra
)
769 (:temporary
(:sc descriptor-reg
:offset r0-offset
:from
(:eval
0)) r0
)
770 (:temporary
(:sc descriptor-reg
:offset r1-offset
:from
(:eval
0)) r1
)
771 (:temporary
(:sc descriptor-reg
:offset r2-offset
:from
(:eval
0)) r2
)
772 (:temporary
(:sc descriptor-reg
:offset lra-offset
:from
(:eval
1)) lra
)
773 (:temporary
(:sc any-reg
:offset nargs-offset
) nargs
)
774 (:temporary
(:sc any-reg
:offset ocfp-offset
) val-ptr
)
777 (trace-table-entry trace-table-fun-epilogue
)
779 ;; Clear the number stack.
780 (let ((cur-nfp (current-nfp-tn vop
)))
782 (error "Don't know how to clear number stack in VOP RETURN")))
784 ;; Clear the control stack, and restore the frame pointer.
790 ;; Establish the values pointer and values count.
792 (inst mov nargs
(fixnumize nvals
))
793 ;; restore the frame pointer and clear as much of the control
794 ;; stack as possible.
796 (inst add sp-tn val-ptr
(* nvals n-word-bytes
))
797 ;; pre-default any argument register that need it.
798 (when (< nvals register-arg-count
)
799 (dolist (reg (subseq (list r0 r1 r2
) nvals
))
802 (lisp-return lra nil
)))
803 (trace-table-entry trace-table-normal
)))
805 ;;; Do unknown-values return of an arbitrary number of values (passed
806 ;;; on the stack.) We check for the common case of a single return
807 ;;; value, and do that inline using the normal single value return
808 ;;; convention. Otherwise, we branch off to code that calls an
809 ;;; assembly-routine.
810 (define-vop (return-multiple)
812 (old-fp-arg :scs
(any-reg) :to
(:eval
1))
813 (lra-arg :scs
(descriptor-reg) :to
(:eval
1))
814 (vals-arg :scs
(any-reg) :target vals
)
815 (nvals-arg :scs
(any-reg) :target nvals
))
816 (:temporary
(:sc any-reg
:offset lexenv-offset
:from
(:argument
0)) old-fp
)
817 (:temporary
(:sc descriptor-reg
:offset lra-offset
:from
(:argument
1)) lra
)
818 (:temporary
(:sc any-reg
:offset ocfp-offset
:from
(:argument
2)) vals
)
819 (:temporary
(:sc any-reg
:offset nargs-offset
:from
(:argument
3)) nvals
)
820 (:temporary
(:sc descriptor-reg
:offset r0-offset
) r0
)
823 (trace-table-entry trace-table-fun-epilogue
)
825 ;; Clear the number stack.
826 (let ((cur-nfp (current-nfp-tn vop
)))
828 (error "Don't know how to clear number stack.")
830 (inst addi nsp-tn cur-nfp
831 (- (bytes-needed-for-non-descriptor-stack-frame)
832 number-stack-displacement
))))
834 ;; Check for the single case.
835 (inst cmp nvals-arg
(fixnumize 1))
836 (inst b
:ne NOT-SINGLE
)
838 ;; Return with one value.
839 (inst ldr r0
(@ vals-arg
))
841 (move fp-tn old-fp-arg
)
842 (lisp-return lra-arg t
)
844 ;; Nope, not the single case.
846 (move old-fp old-fp-arg
)
848 (move nvals nvals-arg
)
849 (inst ldr pc-tn
(@ fixup
))
851 (inst word
(make-fixup 'return-multiple
:assembly-routine
))
853 (trace-table-entry trace-table-normal
)))