;;; Return a wired TN describing the N'th full call argument passing
;;; location.
-;;;
(!def-vm-support-routine standard-arg-location (n)
(declare (type unsigned-byte n))
(if (< n register-arg-count)
;;; otherwise use any legal location. Even in the non-standard case,
;;; this may be restricted by a desire to use a subroutine call
;;; instruction.
-;;;
(!def-vm-support-routine make-return-pc-passing-location (standard)
(if standard
(make-wired-tn *backend-t-primitive-type* register-arg-scn lra-offset)
(make-restricted-tn *backend-t-primitive-type* register-arg-scn)))
-;;; Make-Old-FP-Passing-Location -- Interface
-;;;
-;;; Similar to Make-Return-PC-Passing-Location, but makes a location to pass
-;;; Old-FP in. This is (obviously) wired in the standard convention, but is
-;;; totally unrestricted in non-standard conventions, since we can always fetch
-;;; it off of the stack using the arg pointer.
-;;;
+;;; This is similar to MAKE-RETURN-PC-PASSING-LOCATION, but makes a
+;;; location to pass OLD-FP in. This is (obviously) wired in the
+;;; standard convention, but is totally unrestricted in non-standard
+;;; conventions, since we can always fetch it off of the stack using
+;;; the arg pointer.
(!def-vm-support-routine make-old-fp-passing-location (standard)
(if standard
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset)
(make-normal-tn *fixnum-primitive-type*)))
-;;; Make-Old-FP-Save-Location, Make-Return-PC-Save-Location -- Interface
-;;;
-;;; Make the TNs used to hold Old-FP and Return-PC within the current
-;;; function. We treat these specially so that the debugger can find them at a
-;;; known location.
-;;;
+;;; Make the TNs used to hold OLD-FP and RETURN-PC within the current
+;;; function. We treat these specially so that the debugger can find
+;;; them at a known location.
(!def-vm-support-routine make-old-fp-save-location (env)
(specify-save-tn
(physenv-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env)
(make-wired-tn *fixnum-primitive-type*
control-stack-arg-scn
ocfp-save-offset)))
-;;;
(!def-vm-support-routine make-return-pc-save-location (env)
(specify-save-tn
(physenv-debug-live-tn (make-normal-tn *backend-t-primitive-type*) env)
(!def-vm-support-routine make-number-stack-pointer-tn ()
(make-normal-tn *fixnum-primitive-type*))
-;;; Make-Unknown-Values-Locations -- Interface
-;;;
-;;; Return a list of TNs that can be used to represent an unknown-values
+;;; Return a list of TNs that can be used to represent an unknown-values
;;; continuation within a function.
-;;;
(!def-vm-support-routine make-unknown-values-locations ()
(list (make-stack-pointer-tn)
(make-normal-tn *fixnum-primitive-type*)))
-
-;;; Select-Component-Format -- Interface
-;;;
-;;; This function is called by the Entry-Analyze phase, allowing
-;;; VM-dependent initialization of the IR2-Component structure. We push
+;;; This function is called by the ENTRY-ANALYZE phase, allowing
+;;; VM-dependent initialization of the IR2-COMPONENT structure. We push
;;; placeholder entries in the Constants to leave room for additional
;;; noise in the code object header.
-;;;
(!def-vm-support-routine select-component-format (component)
(declare (type component component))
(dotimes (i code-constants-offset)
(vector-push-extend nil
(ir2-component-constants (component-info component))))
(values))
-
\f
;;;; Frame hackery:
-;;; Return the number of bytes needed for the current non-descriptor stack
-;;; frame. Non-descriptor stack frames must be multiples of 16 bytes under
-;;; the PPC SVr4 ABI (though the EABI may be less restrictive.) Two words
-;;; are reserved for the stack backlink and saved LR (see SB!VM::NUMBER-STACK-
-;;; DISPLACEMENT.)
-;;;
-;;; Duh. PPC Linux (and VxWorks) adhere to the EABI.
-
;;; this is the first function in this file that differs materially from
;;; ../alpha/call.lisp
(defun bytes-needed-for-non-descriptor-stack-frame ()
- (logandc2 (+ 7 number-stack-displacement
- (* (sb-allocated-size 'non-descriptor-stack) sb!vm:n-word-bytes))
- 7))
+ (logandc2 (+ +stack-alignment-bytes+ number-stack-displacement
+ (* (sb-allocated-size 'non-descriptor-stack) n-word-bytes))
+ +stack-alignment-bytes+))
;;; Used for setting up the Old-FP in local call.
-;;;
(define-vop (current-fp)
(:results (val :scs (any-reg)))
(:generator 1
;;; Used for computing the caller's NFP for use in known-values return. Only
;;; works assuming there is no variable size stuff on the nstack.
-;;;
(define-vop (compute-old-nfp)
(:results (val :scs (any-reg)))
(:vop-var vop)
(when nfp
(inst addi val nfp (bytes-needed-for-non-descriptor-stack-frame))))))
-
(define-vop (xep-allocate-frame)
(:info start-lab copy-more-arg-follows)
(:ignore copy-more-arg-follows)
(emit-label start-lab)
;; Allocate function header.
(inst simple-fun-header-word)
- (dotimes (i (1- sb!vm:simple-fun-code-offset))
+ (dotimes (i (1- simple-fun-code-offset))
(inst word 0))
(let* ((entry-point (gen-label)))
(emit-label entry-point)
;;; Allocate a partial frame for passing stack arguments in a full call. Nargs
;;; is the number of arguments passed. If no stack arguments are passed, then
;;; we don't have to do anything.
-;;;
(define-vop (allocate-full-call-frame)
(:info nargs)
(:results (res :scs (any-reg)))
(move res csp-tn)
(inst addi csp-tn csp-tn (* nargs n-word-bytes)))))
-
;;; Emit code needed at the return-point from an unknown-values call
-;;; for a fixed number of values. Values is the head of the TN-Ref
+;;; for a fixed number of values. Values is the head of the TN-REF
;;; list for the locations that the values are to be received into.
;;; Nvals is the number of values that are to be received (should
;;; equal the length of Values).
;;;
-;;; Move-Temp is a Descriptor-Reg TN used as a temporary.
+;;; MOVE-TEMP is a DESCRIPTOR-REG TN used as a temporary.
;;;
;;; This code exploits the fact that in the unknown-values convention,
;;; a single value return returns at the return PC + 8, whereas a
((null remaining))
(let ((def (car remaining)))
(emit-label (car def))
- (when (null (cdr remaining))
- (inst b defaulting-done))
(store-stack-tn (cdr def) null-tn)))
+ (inst b defaulting-done)
(trace-table-entry trace-table-normal))))))
(inst compute-code-from-lra code-tn code-tn lra-label temp)))
\f
;;;; Unknown values receiving:
-;;; Receive-Unknown-Values -- Internal
-;;;
;;; Emit code needed at the return point for an unknown-values call for an
;;; arbitrary number of values.
;;;
;;; Args and Nargs are TNs wired to the named locations. We must
;;; explicitly allocate these TNs, since their lifetimes overlap with the
;;; results Start and Count (also, it's nice to be able to target them).
-;;;
(defun receive-unknown-values (args nargs start count lra-label temp)
(declare (type tn args nargs start count temp))
(let ((variable-values (gen-label))
(values))
-;;; VOP that can be inherited by unknown values receivers. The main thing this
-;;; handles is allocation of the result temporaries.
-;;;
+;;; VOP that can be inherited by unknown values receivers. The main
+;;; thing this handles is allocation of the result temporaries.
(define-vop (unknown-values-receiver)
(:results
(start :scs (any-reg))
;;; Note: we can't use normal load-tn allocation for the fixed args, since all
;;; registers may be tied up by the more operand. Instead, we use
;;; MAYBE-LOAD-STACK-TN.
-;;;
(define-vop (call-local)
(:args (fp)
(nfp)
;;; Note: we can't use normal load-tn allocation for the fixed args, since all
;;; registers may be tied up by the more operand. Instead, we use
;;; MAYBE-LOAD-STACK-TN.
-;;;
(define-vop (multiple-call-local unknown-values-receiver)
(:args (fp)
(nfp)
;;; Note: we can't use normal load-tn allocation for the fixed args, since all
;;; registers may be tied up by the more operand. Instead, we use
;;; MAYBE-LOAD-STACK-TN.
-;;;
(define-vop (known-call-local)
(:args (fp)
(nfp)
;;; Note: we can't use normal load-tn allocation for the fixed args, since all
;;; registers may be tied up by the more operand. Instead, we use
;;; MAYBE-LOAD-STACK-TN.
-;;;
(define-vop (known-return)
(:args (old-fp :target old-fp-temp)
(return-pc :target return-pc-temp)
;;; arguments, we don't bother allocating a partial frame, and instead set FP
;;; to SP just before the call.
-;;; Define-Full-Call -- Internal
-;;;
;;; This macro helps in the definition of full call VOPs by avoiding code
;;; replication in defining the cross-product VOPs.
;;;
-;;; Name is the name of the VOP to define.
+;;; NAME is the name of the VOP to define.
;;;
-;;; Named is true if the first argument is a symbol whose global function
+;;; NAMED is true if the first argument is a symbol whose global function
;;; definition is to be called.
;;;
-;;; Return is either :Fixed, :Unknown or :Tail:
-;;; -- If :Fixed, then the call is for a fixed number of values, returned in
+;;; RETURN is either :FIXED, :UNKNOWN or :TAIL:
+;;; -- If :FIXED, then the call is for a fixed number of values, returned in
;;; the standard passing locations (passed as result operands).
-;;; -- If :Unknown, then the result values are pushed on the stack, and the
+;;; -- If :UNKNOWN, then the result values are pushed on the stack, and the
;;; result values are specified by the Start and Count as in the
;;; unknown-values continuation representation.
-;;; -- If :Tail, then do a tail-recursive call. No values are returned.
+;;; -- If :TAIL, then do a tail-recursive call. No values are returned.
;;; The Old-Fp and Return-PC are passed as the second and third arguments.
;;;
;;; In non-tail calls, the pointer to the stack arguments is passed as the last
-;;; fixed argument. If Variable is false, then the passing locations are
-;;; passed as a more arg. Variable is true if there are a variable number of
-;;; arguments passed on the stack. Variable cannot be specified with :Tail
+;;; fixed argument. If VARIABLE is false, then the passing locations are
+;;; passed as a more arg. VARIABLE is true if there are a variable number of
+;;; arguments passed on the stack. VARIABLE cannot be specified with :TAIL
;;; return. TR variable argument call is implemented separately.
;;;
;;; In tail call with fixed arguments, the passing locations are passed as a
;;; more arg, but there is no new-FP, since the arguments have been set up in
;;; the current frame.
-;;;
(defmacro define-full-call (name named return variable)
(assert (not (and variable (eq return :tail))))
`(define-vop (,name
:from (:argument ,(if (eq return :tail) 0 1))
:to :eval)
lexenv))
- ;; alpha code suggests that function tn is not needed for named call
- (:temporary (:scs (descriptor-reg) :from (:argument 0) :to :eval)
- function)
+ ,@(unless named
+ '((:temporary (:scs (descriptor-reg) :from (:argument 0) :to :eval)
+ function)))
(:temporary (:sc any-reg :offset nargs-offset :to :eval)
nargs-pass)
(do-next-filler))
(constant
(loadw lexenv code-tn (tn-offset arg-fun)
- sb!vm:other-pointer-lowtag)
+ other-pointer-lowtag)
(do-next-filler)))
- (loadw function lexenv sb!vm:closure-fun-slot
- sb!vm:fun-pointer-lowtag)
+ (loadw function lexenv closure-fun-slot
+ fun-pointer-lowtag)
(do-next-filler)
(inst addi entry-point function
(- (ash simple-fun-code-offset word-shift)
(define-full-call multiple-call-variable nil :unknown t)
-;;; Defined separately, since needs special code that BLT's the arguments
-;;; down.
-;;;
+;;; Defined separately, since needs special code that BLT's the
+;;; arguments down.
(define-vop (tail-call-variable)
(:args
(args-arg :scs (any-reg) :target args)
\f
;;;; Unknown values return:
-
;;; Return a single value using the unknown-values convention.
-;;;
(define-vop (return-single)
(:args (old-fp :scs (any-reg))
(return-pc :scs (descriptor-reg))
;;; When there are stack values, we must initialize the argument pointer to
;;; point to the beginning of the values block (which is the beginning of the
;;; current frame.)
-;;;
(define-vop (return)
(:args
(old-fp :scs (any-reg))
(lisp-return return-pc lip)))
(trace-table-entry trace-table-normal)))
-;;; Do unknown-values return of an arbitrary number of values (passed on the
-;;; stack.) We check for the common case of a single return value, and do that
-;;; inline using the normal single value return convention. Otherwise, we
-;;; branch off to code that calls an assembly-routine.
-;;;
+;;; Do unknown-values return of an arbitrary number of values (passed
+;;; on the stack.) We check for the common case of a single return
+;;; value, and do that inline using the normal single value return
+;;; convention. Otherwise, we branch off to code that calls an
+;;; assembly-routine.
(define-vop (return-multiple)
(:args
(old-fp-arg :scs (any-reg) :to (:eval 1))
(move nvals nvals-arg)
(inst ba (make-fixup 'return-multiple :assembly-routine)))
(trace-table-entry trace-table-normal)))
-
-
\f
;;;; XEP hackery:
-
;;; We don't need to do anything special for regular functions.
-;;;
(define-vop (setup-environment)
(:info label)
(:ignore label)
))
;;; Get the lexical environment from its passing location.
-;;;
(define-vop (setup-closure-environment)
(:temporary (:sc descriptor-reg :offset lexenv-offset :target closure
:to (:result 0))
;;; Copy a more arg from the argument area to the end of the current frame.
;;; Fixed is the number of non-more arguments.
-;;;
(define-vop (copy-more-arg)
(:temporary (:sc any-reg :offset nl0-offset) result)
(:temporary (:sc any-reg :offset nl1-offset) count)
(emit-label loop)
;; *--dst = *--src, --count
- (inst addi src src (- sb!vm:n-word-bytes))
+ (inst addi src src (- n-word-bytes))
(inst addic. count count (- (fixnumize 1)))
(loadw temp src)
- (inst addi dst dst (- sb!vm:n-word-bytes))
+ (inst addi dst dst (- n-word-bytes))
(storew temp dst)
(inst bgt loop)
(emit-label done))))
-;;; More args are stored consecutively on the stack, starting immediately at
-;;; the context pointer. The context pointer is not typed, so the lowtag is 0.
-;;;
+;;; More args are stored consecutively on the stack, starting
+;;; immediately at the context pointer. The context pointer is not
+;;; typed, so the lowtag is 0.
(define-vop (more-arg word-index-ref)
(:variant 0 0)
(:translate %more-arg))
-
;;; Turn more arg (context, count) into a list.
-;;;
(define-vop (listify-rest-args)
(:args (context-arg :target context :scs (descriptor-reg))
(count-arg :target count :scs (any-reg)))
DONE))
-;;; Return the location and size of the more arg glob created by Copy-More-Arg.
-;;; Supplied is the total number of arguments supplied (originally passed in
-;;; NARGS.) Fixed is the number of non-rest arguments.
-;;;
-;;; We must duplicate some of the work done by Copy-More-Arg, since at that
-;;; time the environment is in a pretty brain-damaged state, preventing this
-;;; info from being returned as values. What we do is compute
-;;; supplied - fixed, and return a pointer that many words below the current
-;;; stack top.
+;;; Return the location and size of the more arg glob created by
+;;; COPY-MORE-ARG. SUPPLIED is the total number of arguments supplied
+;;; (originally passed in NARGS.) Fixed is the number of non-rest
+;;; arguments.
;;;
+;;; We must duplicate some of the work done by COPY-MORE-ARG, since at
+;;; that time the environment is in a pretty brain-damaged state,
+;;; preventing this info from being returned as values. What we do is
+;;; compute (- SUPPLIED FIXED), and return a pointer that many words
+;;; below the current stack top.
(define-vop (more-arg-context)
(:policy :fast-safe)
(:translate sb!c::%more-arg-context)
(inst subi count supplied (fixnumize fixed))
(inst sub context csp-tn count)))
-
-;;; Signal wrong argument count error if Nargs isn't = to Count.
-;;;
-#|
-(define-vop (verify-argument-count)
- (:policy :fast-safe)
- (:translate sb!c::%verify-argument-count)
- (:args (nargs :scs (any-reg)))
- (:arg-types positive-fixnum (:constant t))
- (:info count)
- (:vop-var vop)
- (:save-p :compute-only)
- (:generator 3
- (let ((err-lab
- (generate-error-code vop invalid-argument-count-error nargs)))
- (inst cmpwi nargs (fixnumize count))
- (inst bne err-lab))))
-|#
(define-vop (verify-arg-count)
(:policy :fast-safe)
(:translate sb!c::%verify-arg-count)
(:generator 3
(inst twi :ne nargs (fixnumize count))))
-
;;; Signal various errors.
-;;;
(macrolet ((frob (name error translate &rest args)
`(define-vop (,name)
,@(when translate
projects / sbcl.git / blobdiff