;;; Return a wired TN describing the N'th full call argument passing
;;; location.
-;;;
-(!def-vm-support-routine standard-argument-location (n)
+(!def-vm-support-routine standard-arg-location (n)
(declare (type unsigned-byte n))
(if (< n register-arg-count)
(make-wired-tn *backend-t-primitive-type*
;;; is true, then use the standard (full call) location, 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)
- #!+gengc (declare (ignore standard))
- #!-gengc
(if standard
(make-wired-tn *backend-t-primitive-type* register-arg-scn lra-offset)
- (make-restricted-tn *backend-t-primitive-type* register-arg-scn))
- #!+gengc
- (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ra-offset))
+ (make-restricted-tn *backend-t-primitive-type* register-arg-scn)))
-;;; This is similar to Make-Return-PC-Passing-Location, but makes a
-;;; location to pass Old-FP in. This is (obviously) wired in the
+;;; 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)
;;; debugger can find them at a known location.
(!def-vm-support-routine make-old-fp-save-location (env)
(specify-save-tn
- (environment-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env)
+ (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)
- (let ((ptype #!-gengc *backend-t-primitive-type*
- #!+gengc *fixnum-primitive-type*))
+ (let ((ptype *backend-t-primitive-type*))
(specify-save-tn
- (environment-debug-live-tn (make-normal-tn ptype) env)
- (make-wired-tn ptype control-stack-arg-scn
- #!-gengc lra-save-offset #!+gengc ra-save-offset))))
+ (physenv-debug-live-tn (make-normal-tn ptype) env)
+ (make-wired-tn ptype control-stack-arg-scn lra-save-offset))))
;;; Make a TN for the standard argument count passing location. We
;;; only need to make the standard location, since a count is never
;;; passed when we are using non-standard conventions.
-(!def-vm-support-routine make-argument-count-location ()
+(!def-vm-support-routine make-arg-count-location ()
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn nargs-offset))
(make-normal-tn *fixnum-primitive-type*)))
-;;; 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
+;;; 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))
;;; bytes on the PMAX.
(defun bytes-needed-for-non-descriptor-stack-frame ()
(* (logandc2 (1+ (sb-allocated-size 'non-descriptor-stack)) 1)
- word-bytes))
+ n-word-bytes))
;;; This is used for setting up the Old-FP in local call.
(define-vop (current-fp)
(:generator 1
;; Make sure the function is aligned, and drop a label pointing to
;; this function header.
- (align lowtag-bits)
- (trace-table-entry trace-table-function-prologue)
+ (align n-lowtag-bits)
+ (trace-table-entry trace-table-fun-prologue)
(emit-label start-lab)
;; Allocate function header.
- (inst function-header-word)
- (dotimes (i (1- function-code-offset))
+ (inst simple-fun-header-word)
+ (dotimes (i (1- simple-fun-code-offset))
(inst lword 0))
;; The start of the actual code.
;; Compute CODE from the address of this entry point.
;; collector won't forget about us if we call anyone else.
)
;; Build our stack frames.
- (inst lda csp-tn (* word-bytes (sb-allocated-size 'control-stack)) cfp-tn)
+ (inst lda
+ csp-tn
+ (* n-word-bytes (sb-allocated-size 'control-stack))
+ cfp-tn)
(let ((nfp (current-nfp-tn vop)))
(when nfp
(inst subq nsp-tn (bytes-needed-for-non-descriptor-stack-frame)
(nfp :scs (any-reg)))
(:info callee)
(:generator 2
- (trace-table-entry trace-table-function-prologue)
+ (trace-table-entry trace-table-fun-prologue)
(move csp-tn res)
- (inst lda csp-tn (* word-bytes (sb-allocated-size 'control-stack)) csp-tn)
- (when (ir2-environment-number-stack-p callee)
+ (inst lda
+ csp-tn
+ (* n-word-bytes (sb-allocated-size 'control-stack))
+ csp-tn)
+ (when (ir2-physenv-number-stack-p callee)
(inst subq nsp-tn (bytes-needed-for-non-descriptor-stack-frame)
nsp-tn)
(move nsp-tn nfp))
(trace-table-entry trace-table-normal)))
;;; Allocate a partial frame for passing stack arguments in a full
-;;; call. Nargs is the number of arguments passed. If no stack
+;;; 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)
(:generator 2
(when (> nargs register-arg-count)
(move csp-tn res)
- (inst lda csp-tn (* nargs word-bytes) csp-tn))))
-
+ (inst lda csp-tn (* nargs n-word-bytes) csp-tn))))
-\f
;;; 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 ocfp-tn csp-tn)
(inst nop))
(when lra-label
- #!-gengc (inst compute-code-from-lra code-tn code-tn lra-label temp)
- #!+gengc (inst compute-code-from-ra code-tn ra-tn lra-label temp)))
+ (inst compute-code-from-lra code-tn code-tn lra-label temp)))
(let ((regs-defaulted (gen-label))
(defaulting-done (gen-label))
(default-stack-vals (gen-label)))
(defaults (cons default-lab tn))
(inst blt temp default-lab)
- (inst ldl move-temp (* i word-bytes) ocfp-tn)
+ (inst ldl move-temp (* i n-word-bytes) ocfp-tn)
(inst subq temp (fixnumize 1) temp)
(store-stack-tn tn move-temp)))
((null remaining))
(let ((def (car remaining)))
(emit-label (car def))
- (when (null (cdr remaining))
- (inst br zero-tn defaulting-done))
- (store-stack-tn (cdr def) null-tn)))))))
+ (store-stack-tn (cdr def) null-tn)))
+ (inst br zero-tn defaulting-done)))))
(when lra-label
- #!-gengc (inst compute-code-from-lra code-tn code-tn lra-label temp)
- #!+gengc (inst compute-code-from-ra code-tn ra-tn lra-label temp))))
+ (inst compute-code-from-lra code-tn code-tn lra-label temp))))
(values))
\f
;;;; unknown values receiving
(inst nop))
(when lra-label
- #!-gengc (inst compute-code-from-lra code-tn code-tn lra-label temp)
- #!+gengc (inst compute-code-from-ra code-tn ra-tn lra-label temp))
+ (inst compute-code-from-lra code-tn code-tn lra-label temp))
(inst addq csp-tn 4 csp-tn)
(storew (first *register-arg-tns*) csp-tn -1)
(inst subq csp-tn 4 start)
(assemble (*elsewhere*)
(emit-label variable-values)
(when lra-label
- #!-gengc (inst compute-code-from-lra code-tn code-tn lra-label temp)
- #!+gengc (inst compute-code-from-ra code-tn ra-tn lra-label temp))
+ (inst compute-code-from-lra code-tn code-tn lra-label temp))
(do ((arg *register-arg-tns* (rest arg))
(i 0 (1+ i)))
((null arg))
(:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)
(:temporary (:scs (non-descriptor-reg)) temp)
(:generator 5
- (let (#!-gengc (label (gen-label))
+ (let ((label (gen-label))
(cur-nfp (current-nfp-tn vop)))
(when cur-nfp
(store-stack-tn nfp-save cur-nfp))
(return-pc :target return-pc-temp)
(vals :more t))
(:temporary (:sc any-reg :from (:argument 0)) ocfp-temp)
- (:temporary (:sc #!-gengc descriptor-reg #!+gengc any-reg
- :from (:argument 1))
+ (:temporary (:sc any-reg :from (:argument 1))
return-pc-temp)
- #!-gengc (:temporary (:scs (interior-reg)) lip)
+ (:temporary (:scs (interior-reg)) lip)
(:move-args :known-return)
(:info val-locs)
(:ignore val-locs vals)
(:vop-var vop)
(:generator 6
- (trace-table-entry trace-table-function-epilogue)
+ (trace-table-entry trace-table-fun-epilogue)
(maybe-load-stack-tn ocfp-temp ocfp)
(maybe-load-stack-tn return-pc-temp return-pc)
(move cfp-tn csp-tn)
(when cur-nfp
(inst addq cur-nfp (bytes-needed-for-non-descriptor-stack-frame)
nsp-tn)))
- (inst subq return-pc-temp (- other-pointer-type word-bytes) lip)
+ (inst subq return-pc-temp (- other-pointer-lowtag n-word-bytes) lip)
(move ocfp-temp cfp-tn)
(inst ret zero-tn lip 1)
(trace-table-entry trace-table-normal)))
-
\f
-;;;; Full call:
+;;;; full call:
;;;;
;;;; There is something of a cross-product effect with full calls.
;;;; Different versions are used depending on whether we know the
;;; 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
-;;; the standard passing locations (passed as result operands).
-;;; -- 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
+;;; 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 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 Ocfp 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 return. TR variable argument call
+;;; cannot be specified with :TAIL return. TR variable argument call
;;; is implemented separately.
;;;
;;; In tail call with fixed arguments, the passing locations are
nargs-pass)
,@(when variable
- (mapcar #'(lambda (name offset)
- `(:temporary (:sc descriptor-reg
- :offset ,offset
- :to :eval)
- ,name))
+ (mapcar (lambda (name offset)
+ `(:temporary (:sc descriptor-reg
+ :offset ,offset
+ :to :eval)
+ ,name))
register-arg-names *register-arg-offsets*))
,@(when (eq return :fixed)
'((:temporary (:scs (descriptor-reg) :from :eval) move-temp)))
,@(if variable
`((inst subq csp-tn new-fp nargs-pass)
,@(let ((index -1))
- (mapcar #'(lambda (name)
- `(inst ldl ,name
- ,(ash (incf index)
- word-shift)
- new-fp))
+ (mapcar (lambda (name)
+ `(inst ldl ,name
+ ,(ash (incf index)
+ word-shift)
+ new-fp))
register-arg-names)))
'((inst li (fixnumize nargs) nargs-pass))))
,@(if (eq return :tail)
(constant
(inst ldl name-pass
(- (ash (tn-offset name) word-shift)
- other-pointer-type) code-tn)
+ other-pointer-lowtag) code-tn)
(do-next-filler)))
(inst ldl entry-point
(- (ash fdefn-raw-addr-slot word-shift)
- other-pointer-type) name-pass)
+ other-pointer-lowtag) name-pass)
(do-next-filler))
`((sc-case arg-fun
(descriptor-reg (move arg-fun lexenv))
(constant
(inst ldl lexenv
(- (ash (tn-offset arg-fun) word-shift)
- other-pointer-type) code-tn)
+ other-pointer-lowtag) code-tn)
(do-next-filler)))
#!-gengc
(inst ldl function
- (- (ash closure-function-slot word-shift)
- function-pointer-type) lexenv)
+ (- (ash closure-fun-slot word-shift)
+ fun-pointer-lowtag) lexenv)
#!-gengc
(do-next-filler)
#!-gengc
(inst addq function
- (- (ash function-code-offset word-shift)
- function-pointer-type) entry-point)
+ (- (ash simple-fun-code-offset word-shift)
+ fun-pointer-lowtag) entry-point)
#!+gengc
(inst ldl entry-point
(- (ash closure-entry-point-slot word-shift)
- function-pointer-type) lexenv)
+ fun-pointer-lowtag) lexenv)
#!+gengc
(do-next-filler)))
(loop
(:vop-var vop)
(:generator 6
;; Clear the number stack.
- (trace-table-entry trace-table-function-epilogue)
+ (trace-table-entry trace-table-fun-epilogue)
(let ((cur-nfp (current-nfp-tn vop)))
(when cur-nfp
(inst addq cur-nfp (bytes-needed-for-non-descriptor-stack-frame)
#!-gengc (lisp-return return-pc lip :offset 2)
#!+gengc
(progn
- (inst addq return-pc (* 2 word-bytes) temp)
+ (inst addq return-pc (* 2 n-word-bytes) temp)
(unless (location= ra return-pc)
(inst move ra return-pc))
(inst ret zero-tn temp 1))
(:vop-var vop)
(:generator 6
;; Clear the number stack.
- (trace-table-entry trace-table-function-epilogue)
+ (trace-table-entry trace-table-fun-epilogue)
(let ((cur-nfp (current-nfp-tn vop)))
(when cur-nfp
(inst addq cur-nfp (bytes-needed-for-non-descriptor-stack-frame)
;; restore the frame pointer and clear as much of the control
;; stack as possible.
(move ocfp cfp-tn)
- (inst addq val-ptr (* nvals word-bytes) csp-tn)
+ (inst addq val-ptr (* nvals n-word-bytes) csp-tn)
;; pre-default any argument register that need it.
(when (< nvals register-arg-count)
(dolist (reg (subseq (list a0 a1 a2 a3 a4 a5) nvals))
(:vop-var vop)
(:generator 13
- (trace-table-entry trace-table-function-epilogue)
+ (trace-table-entry trace-table-fun-epilogue)
(let ((not-single (gen-label)))
;; Clear the number stack.
(let ((cur-nfp (current-nfp-tn vop)))
(move lexenv closure)))
;;; Copy a &MORE arg from the argument area to the end of the current
-;;; frame. FIXED is the number of non-more arguments.
+;;; 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)
(do-regs (gen-label))
(done (gen-label)))
(when (< fixed register-arg-count)
- ;; Save a pointer to the results so we can fill in register args.
- ;; We don't need this if there are more fixed args than reg args.
+ ;; Save a pointer to the results so we can fill in register
+ ;; args. We don't need this if there are more fixed args than
+ ;; reg args.
(move csp-tn result))
;; Allocate the space on the stack.
(cond ((zerop fixed)
(inst ble count done)
(inst addq csp-tn count csp-tn)))
(when (< fixed register-arg-count)
- ;; We must stop when we run out of stack args, not when we run out of
- ;; more args.
+ ;; We must stop when we run out of stack args, not when we run
+ ;; out of &MORE args.
(inst subq nargs-tn (fixnumize register-arg-count) count))
;; Initialize dst to be end of stack.
(move csp-tn dst)
;; Everything of interest in registers.
(inst ble count do-regs)
- ;; Initialize src to be end of args.
+ ;; Initialize SRC to be end of args.
(inst addq cfp-tn nargs-tn src)
(emit-label loop)
;; *--dst = *--src, --count
- (inst subq src word-bytes src)
+ (inst subq src n-word-bytes src)
(inst subq count (fixnumize 1) count)
(loadw temp src)
- (inst subq dst word-bytes dst)
+ (inst subq dst n-word-bytes dst)
(storew temp dst)
(inst bgt count loop)
(emit-label do-regs)
(when (< fixed register-arg-count)
- ;; Now we have to deposit any more args that showed up in registers.
- ;; We know there is at least one more arg, otherwise we would have
- ;; branched to done up at the top.
+ ;; Now we have to deposit any more args that showed up in
+ ;; registers. We know there is at least one &MORE arg,
+ ;; otherwise we would have branched to DONE up at the top.
(inst subq nargs-tn (fixnumize (1+ fixed)) count)
(do ((i fixed (1+ i)))
((>= i register-arg-count))
(inst subq count (fixnumize 1) count)))
(emit-label done))))
-;;; &More args are stored consecutively on the stack, starting
+;;; &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-full-reffer more-arg * 0 0 (descriptor-reg any-reg) * %more-arg)
(define-vop (listify-rest-args)
(:args (context-arg :target context :scs (descriptor-reg))
(count-arg :target count :scs (any-reg)))
- (:arg-types * tagged-num)
+ (:info dx)
+ (:ignore dx)
+ (:arg-types * tagged-num (:constant t))
(:temporary (:scs (any-reg) :from (:argument 0)) context)
(:temporary (:scs (any-reg) :from (:argument 1)) count)
(:temporary (:scs (descriptor-reg) :from :eval) temp dst)
;; We need to do this atomically.
(pseudo-atomic ()
;; Allocate a cons (2 words) for each item.
- (inst bis alloc-tn list-pointer-type result)
+ (inst bis alloc-tn list-pointer-lowtag result)
(move result dst)
(inst sll count 1 temp)
(inst addq alloc-tn temp alloc-tn)
;; Store the current cons in the cdr of the previous cons.
(emit-label loop)
- (inst addq dst (* 2 word-bytes) dst)
- (storew dst dst -1 list-pointer-type)
+ (inst addq dst (* 2 n-word-bytes) dst)
+ (storew dst dst -1 list-pointer-lowtag)
(emit-label enter)
;; Grab one value.
(loadw temp context)
- (inst addq context word-bytes context)
+ (inst addq context n-word-bytes context)
;; Store the value in the car (in delay slot)
- (storew temp dst 0 list-pointer-type)
+ (storew temp dst 0 list-pointer-lowtag)
- ;; Dec count, and if != zero, go back for more.
+ ;; Decrement count, and if != zero, go back for more.
(inst subq count (fixnumize 1) count)
(inst bne count loop)
;; NIL out the last cons.
- (storew null-tn dst 1 list-pointer-type))
+ (storew null-tn dst 1 list-pointer-lowtag))
(emit-label done))))
;;; Return the location and size of the &MORE arg glob created by
-;;; Copy-More-Arg. Supplied is the total number of arguments supplied
+;;; 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
+;;; 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
(inst subq supplied (fixnumize fixed) count)
(inst subq csp-tn count context)))
-
-;;; Signal wrong argument count error if Nargs isn't equal to Count.
-(define-vop (verify-argument-count)
+;;; Signal wrong argument count error if NARGS isn't equal to COUNT.
+(define-vop (verify-arg-count)
(:policy :fast-safe)
- (:translate sb!c::%verify-argument-count)
+ (:translate sb!c::%verify-arg-count)
(:args (nargs :scs (any-reg)))
(:arg-types positive-fixnum (:constant t))
(:temporary (:scs (any-reg) :type fixnum) temp)
(:save-p :compute-only)
(:generator 3
(let ((err-lab
- (generate-error-code vop invalid-argument-count-error nargs)))
+ (generate-error-code vop invalid-arg-count-error nargs)))
(cond ((zerop count)
(inst bne nargs err-lab))
(t
,@(when translate
`((:policy :fast-safe)
(:translate ,translate)))
- (:args ,@(mapcar #'(lambda (arg)
- `(,arg :scs (any-reg descriptor-reg)))
+ (:args ,@(mapcar (lambda (arg)
+ `(,arg :scs (any-reg descriptor-reg)))
args))
(:vop-var vop)
(:save-p :compute-only)
(:generator 1000
(error-call vop ,error ,@args)))))
- (frob argument-count-error invalid-argument-count-error
- sb!c::%argument-count-error nargs)
+ (frob arg-count-error invalid-arg-count-error
+ sb!c::%arg-count-error nargs)
(frob type-check-error object-not-type-error sb!c::%type-check-error
object type)
(frob layout-invalid-error layout-invalid-error sb!c::%layout-invalid-error
object layout)
- (frob odd-key-arguments-error odd-key-arguments-error
- sb!c::%odd-key-arguments-error)
- (frob unknown-key-argument-error unknown-key-argument-error
- sb!c::%unknown-key-argument-error key)
- (frob nil-function-returned-error nil-function-returned-error nil fun))
+ (frob odd-key-args-error odd-key-args-error
+ sb!c::%odd-key-args-error)
+ (frob unknown-key-arg-error unknown-key-arg-error
+ sb!c::%unknown-key-arg-error key)
+ (frob nil-fun-returned-error nil-fun-returned-error nil fun))
projects / sbcl.git / blobdiff