;;; 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* descriptor-reg-sc-number
(make-wired-tn (primitive-type-or-lose 'system-area-pointer)
sap-stack-sc-number return-pc-save-offset))
-;;; Similar to Make-Return-PC-Passing-Location, but makes a location
-;;; to pass Old-FP in.
+;;; This is similar to MAKE-RETURN-PC-PASSING-LOCATION, but makes a
+;;; location to pass OLD-FP in.
;;;
;;; This is wired in both the standard and the local-call conventions,
;;; because we want to be able to assume it's always there. Besides,
(make-wired-tn *fixnum-primitive-type* control-stack-sc-number
ocfp-save-offset))
-;;; Make the TNs used to hold Old-FP and Return-PC within the current
+;;; 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.
;;;
;;; Without using a save-tn - which does not make much sense if it is
-;;; wire to the stack?
-(!def-vm-support-routine make-old-fp-save-location (env)
+;;; wired to the stack?
+(!def-vm-support-routine make-old-fp-save-location (physenv)
(physenv-debug-live-tn (make-wired-tn *fixnum-primitive-type*
control-stack-sc-number
ocfp-save-offset)
- env))
-
-(!def-vm-support-routine make-return-pc-save-location (env)
+ physenv))
+(!def-vm-support-routine make-return-pc-save-location (physenv)
(physenv-debug-live-tn
(make-wired-tn (primitive-type-or-lose 'system-area-pointer)
sap-stack-sc-number return-pc-save-offset)
- env))
+ physenv))
;;; 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* any-reg-sc-number ecx-offset))
;;; Make a TN to hold the number-stack frame pointer. This is allocated
(:vop-var vop)
(:generator 1
(align n-lowtag-bits)
- (trace-table-entry trace-table-function-prologue)
+ (trace-table-entry trace-table-fun-prologue)
(emit-label start-lab)
;; Skip space for the function header.
(inst simple-fun-header-word)
(inst sub esp-tn (* (max nargs 3) n-word-bytes))))
\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-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 + 2, whereas a
(let ((defaults (defaults)))
(when defaults
(assemble (*elsewhere*)
- (trace-table-entry trace-table-function-prologue)
+ (trace-table-entry trace-table-fun-prologue)
(emit-label default-stack-slots)
(dolist (default defaults)
(emit-label (car default))
(done (gen-label)))
(inst jmp-short variable-values)
- (inst mov start esp-tn)
- (inst push (first *register-arg-tns*))
+ (cond ((location= start (first *register-arg-tns*))
+ (inst push (first *register-arg-tns*))
+ (inst lea start (make-ea :dword :base esp-tn :disp 4)))
+ (t (inst mov start esp-tn)
+ (inst push (first *register-arg-tns*))))
(inst mov count (fixnumize 1))
(inst jmp done)
(:ignore val-locs vals)
(:vop-var vop)
(:generator 6
- (trace-table-entry trace-table-function-epilogue)
+ (trace-table-entry trace-table-fun-epilogue)
;; Save the return-pc in a register 'cause the frame-pointer is
;; going away. Note this not in the usual stack location so we
;; can't use RET
(:ignore val-locs vals)
(:vop-var vop)
(:generator 6
- (trace-table-entry trace-table-function-epilogue)
+ (trace-table-entry trace-table-fun-epilogue)
#+nil (format t "*known-return: old-fp ~S, tn-kind ~S; ~S ~S~%"
old-fp (sb!c::tn-kind old-fp) (sb!c::tn-save-tn old-fp)
(sb!c::tn-kind (sb!c::tn-save-tn old-fp)))
#+nil (format t "*known-return: return-pc ~S, tn-kind ~S; ~S ~S~%"
- return-pc (sb!c::tn-kind return-pc) (sb!c::tn-save-tn return-pc)
+ return-pc (sb!c::tn-kind return-pc)
+ (sb!c::tn-save-tn return-pc)
(sb!c::tn-kind (sb!c::tn-save-tn return-pc)))
;; return-pc may be either in a register or on the stack.
(inst pop ebp-tn))
(t
- (cerror "Continue any-way"
- "VOP return-local doesn't work if old-fp (in slot %s) is not in slot 0"
+ (cerror "Continue anyway"
+ "VOP return-local doesn't work if old-fp (in slot ~
+ ~S) is not in slot 0"
(tn-offset old-fp)))))
((any-reg descriptor-reg)
;;; 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
;; doing the call. Therefore, we have to tell the
;; lifetime stuff that we need to use them.
,@(when variable
- (mapcar #'(lambda (name offset)
- `(:temporary (:sc descriptor-reg
- :offset ,offset
- :from (:argument 0)
- :to :eval)
- ,name))
+ (mapcar (lambda (name offset)
+ `(:temporary (:sc descriptor-reg
+ :offset ,offset
+ :from (:argument 0)
+ :to :eval)
+ ,name))
*register-arg-names* *register-arg-offsets*))
,@(when (eq return :tail)
(:temporary (:sc unsigned-reg) ret)
(:ignore value)
(:generator 6
- (trace-table-entry trace-table-function-epilogue)
+ (trace-table-entry trace-table-fun-epilogue)
(move ret return-pc)
;; Clear the control stack
(move ofp old-fp)
:from :eval) a2)
(:generator 6
- (trace-table-entry trace-table-function-epilogue)
+ (trace-table-entry trace-table-fun-epilogue)
;; Establish the values pointer and values count.
(move ebx ebp-tn)
(if (zerop nvals)
(:node-var node)
(:generator 13
- (trace-table-entry trace-table-function-epilogue)
+ (trace-table-entry trace-table-fun-epilogue)
;; Load the return-pc.
(move eax return-pc)
(unless (policy node (> space speed))
;;; Turn more arg (context, count) into a list.
+(defoptimizer (%listify-rest-args stack-allocate-result) ((&rest args))
+ t)
+
(define-vop (listify-rest-args)
(:translate %listify-rest-args)
(:policy :safe)
(:generator 20
(let ((enter (gen-label))
(loop (gen-label))
- (done (gen-label)))
+ (done (gen-label))
+ (stack-allocate-p (node-stack-allocate-p node)))
(move src context)
(move ecx count)
;; Check to see whether there are no args, and just return NIL if so.
(inst mov result nil-value)
(inst jecxz done)
(inst lea dst (make-ea :dword :index ecx :scale 2))
- (pseudo-atomic
- (allocation dst dst node)
+ (maybe-pseudo-atomic stack-allocate-p
+ (allocation dst dst node stack-allocate-p)
(inst lea dst (make-ea :byte :base dst :disp list-pointer-lowtag))
;; Convert the count into a raw value, so that we can use the
;; LOOP instruction.
(inst sub count (fixnumize fixed)))))
;;; Signal wrong argument count error if NARGS isn't equal to COUNT.
-(define-vop (verify-argument-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))
(:info count)
(: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)))
(if (zerop count)
(inst test nargs nargs) ; smaller instruction
(inst cmp nargs (fixnumize count)))
(inst jmp :ne err-lab))))
;;; Various other error signallers.
-(macrolet ((frob (name error translate &rest args)
+(macrolet ((def (name error translate &rest args)
`(define-vop (,name)
,@(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 type-check-error object-not-type-error sb!c::%type-check-error
+ (def arg-count-error invalid-arg-count-error
+ sb!c::%arg-count-error nargs)
+ (def 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
+ (def 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))
+ (def odd-key-args-error odd-key-args-error
+ sb!c::%odd-key-args-error)
+ (def unknown-key-arg-error unknown-key-arg-error
+ sb!c::%unknown-key-arg-error key)
+ (def nil-fun-returned-error nil-fun-returned-error nil fun))
projects / sbcl.git / blobdiff