;;; 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 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
(list (make-stack-pointer-tn)
(make-normal-tn *fixnum-primitive-type*)))
-;;; This function is called by the Entry-Analyze phase, allowing
+;;; 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
+;;; push placeholder entries in the CONSTANTS to leave room for
;;; additional noise in the code object header.
-;;;
-;;; For the x86 the first constant is a pointer to a list of fixups,
-;;; or NIL if the code object has none.
(!def-vm-support-routine select-component-format (component)
(declare (type component component))
+ ;; The 1+ here is because for the x86 the first constant is a
+ ;; pointer to a list of fixups, or NIL if the code object has none.
+ ;; (If I understand correctly, the fixups are needed at GC copy
+ ;; time because the X86 code isn't relocatable.)
+ ;;
+ ;; KLUDGE: It'd be cleaner to have the fixups entry be a named
+ ;; element of the CODE (aka component) primitive object. However,
+ ;; it's currently a large, tricky, error-prone chore to change
+ ;; the layout of any primitive object, so for the foreseeable future
+ ;; we'll just live with this ugliness. -- WHN 2002-01-02
(dotimes (i (1+ code-constants-offset))
(vector-push-extend nil
(ir2-component-constants (component-info component))))
(: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))
(: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.
;;; 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))
(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