abbreviating ARGUMENT as ARG...
...s/error-argument/error-arg/
...s/argument-count/arg-count/
...s/bogus-argument/bogus-arg/
...s/key-argument/key-arg/
...s/constant-argument/constant-arg/
also changed ARGUMENT to ARGS in the context of ARG-COUNT-ERROR
** reserved DO-FOO-style names for iteration macros
** s/ARGUMENT/ARG/
** perhaps s/DEF-FROB/DEF/ or s/DEF-FROB/DEFINE/
+ ** merged SB-C-CALL into SB-ALIEN
* Perhaps rename "cold" stuff (e.g. SB-COLD and src/cold/) to "boot".
* pending patches and bug reports that go in (or else get handled
somehow, rejected/logged/whatever) before 0.7.0:
"ALLOC-ALIEN-STACK-SPACE" "ALLOC-NUMBER-STACK-SPACE"
"ALLOCATE-CODE-OBJECT" "ALLOCATE-FRAME"
"ALLOCATE-DYNAMIC-CODE-OBJECT" "ALLOCATE-FULL-CALL-FRAME"
- "ANY" "ARGUMENT-COUNT-ERROR" "ASSEMBLE-FILE"
+ "ANY" "ARG-COUNT-ERROR" "ASSEMBLE-FILE"
"ATTRIBUTES" "ATTRIBUTES-INTERSECTION" "ATTRIBUTES-UNION"
"ATTRIBUTES=" "BIND"
"CALL" "CALL-LOCAL" "CALL-NAMED" "CALL-OUT" "CALL-VARIABLE"
"TN-REF-TN" "TN-REF-VOP" "TN-REF-WRITE-P" "TN-SC" "TN-VALUE"
"TRACE-TABLE-ENTRY" "TYPE-CHECK-ERROR" "UNBIND" "UNBIND-TO-HERE"
"UNSAFE" "UNWIND" "UWP-ENTRY"
- "VERIFY-ARGUMENT-COUNT" "WRITE-PACKED-BIT-VECTOR"
+ "VERIFY-ARG-COUNT" "WRITE-PACKED-BIT-VECTOR"
"WRITE-VAR-INTEGER" "WRITE-VAR-STRING" "XEP-ALLOCATE-FRAME"
"LABEL-ID" "FIXUP" "FIXUP-FLAVOR" "FIXUP-NAME" "FIXUP-OFFSET"
"FIXUP-P" "MAKE-FIXUP"
"VM-SUPPORT-ROUTINES-MAKE-OLD-FP-PASSING-LOCATION"
"VM-SUPPORT-ROUTINES-MAKE-OLD-FP-SAVE-LOCATION"
"VM-SUPPORT-ROUTINES-MAKE-RETURN-PC-SAVE-LOCATION"
- "VM-SUPPORT-ROUTINES-MAKE-ARGUMENT-COUNT-LOCATION"
+ "VM-SUPPORT-ROUTINES-MAKE-ARG-COUNT-LOCATION"
"VM-SUPPORT-ROUTINES-MAKE-NFP-TN"
"VM-SUPPORT-ROUTINES-MAKE-STACK-POINTER-TN"
"VM-SUPPORT-ROUTINES-MAKE-NUMBER-STACK-POINTER-TN"
;; certainly doesn't belong in public extensions
;; FIXME: maybe belongs in %KERNEL with other typesystem stuff?
- "CONSTANT-ARGUMENT"
+ "CONSTANT-ARG"
;; various internal defaults
"*DEFAULT-PACKAGE-USE-LIST*"
"BIT-BASH-NOT"
"BIT-BASH-ORC1" "BIT-BASH-ORC2" "BIT-BASH-SET"
"BIT-BASH-XOR"
- "BIT-INDEX" "BOGUS-ARGUMENT-TO-VALUES-LIST-ERROR"
+ "BIT-INDEX" "BOGUS-ARG-TO-VALUES-LIST-ERROR"
"BOOLE-CODE"
"BYTE-SPECIFIER"
"%BYTE-BLT"
"INTERNAL-ERROR" "INTERNAL-TIME"
"INTERSECTION-TYPE" "INTERSECTION-TYPE-P"
"INTERSECTION-TYPE-TYPES"
- "INVALID-ARGUMENT-COUNT-ERROR" "INVALID-ARRAY-INDEX-ERROR"
+ "INVALID-ARG-COUNT-ERROR" "INVALID-ARRAY-INDEX-ERROR"
"INVALID-UNWIND-ERROR" "IRRATIONAL"
"JUST-DUMP-IT-NORMALLY"
"KEY-INFO" "KEY-INFO-NAME"
"OBJECT-NOT-TYPE-ERROR"
"OBJECT-NOT-UNSIGNED-BYTE-32-ERROR"
"OBJECT-NOT-VECTOR-ERROR" "OBJECT-NOT-WEAK-POINTER-ERROR"
- "ODD-KEY-ARGUMENTS-ERROR"
+ "ODD-KEY-ARGS-ERROR"
"OUTPUT-OBJECT" "OUTPUT-UGLY-OBJECT"
"PACKAGE-DOC-STRING"
"PACKAGE-HASHTABLE-SIZE" "PACKAGE-HASHTABLE-FREE"
"UNBOUND-SYMBOL-ERROR" "UNBOXED-ARRAY"
"UNDEFINED-SYMBOL-ERROR" "UNION-TYPE" "UNION-TYPE-P"
"UNION-TYPE-TYPES" "UNKNOWN-ERROR"
- "UNKNOWN-KEY-ARGUMENT-ERROR"
+ "UNKNOWN-KEY-ARG-ERROR"
"UNKNOWN-TYPE" "UNKNOWN-TYPE-P"
"UNKNOWN-TYPE-SPECIFIER" "UNSEEN-THROW-TAG-ERROR"
"UNSIGNED-BYTE-32-P"
"IMMEDIATE-SC-NUMBER" "*INITIAL-DYNAMIC-SPACE-FREE-POINTER*"
"INSTANCE-HEADER-WIDETAG" "INSTANCE-POINTER-LOWTAG"
"INSTANCE-SLOTS-OFFSET" "INSTANCE-USAGE"
- "INTERIOR-REG-SC-NUMBER" "INTERNAL-ERROR-ARGUMENTS"
+ "INTERIOR-REG-SC-NUMBER" "INTERNAL-ERROR-ARGS"
"INTERRUPTED-FLAG" "LIST-ALLOCATED-OBJECTS" "LIST-POINTER-LOWTAG"
"LONG-FLOAT-BIAS" "LONG-FLOAT-DIGITS" "LONG-FLOAT-EXPONENT-BYTE"
"LONG-FLOAT-HIDDEN-BIT" "LONG-FLOAT-NORMAL-EXPONENT-MAX"
0)
\f
-;;;; INTERNAL-ERROR-ARGUMENTS
+;;;; INTERNAL-ERROR-ARGS
;;; Given a (POSIX) signal context, extract the internal error
;;; arguments from the instruction stream. This is e.g.
;;; (pc)
;;; (example from undefined_tramp: "(gdb) x/40ub 0x10148" for yourself
;;; to replicate)
-(defun internal-error-arguments (context)
+(defun internal-error-args (context)
(declare (type (alien (* os-context-t)) context))
(let ((pc (context-pc context)))
(declare (type system-area-pointer pc))
(define-condition namestring-parse-error (parse-error)
((complaint :reader namestring-parse-error-complaint :initarg :complaint)
- (arguments :reader namestring-parse-error-arguments :initarg :arguments
- :initform nil)
+ (args :reader namestring-parse-error-args :initarg :args :initform nil)
(namestring :reader namestring-parse-error-namestring :initarg :namestring)
(offset :reader namestring-parse-error-offset :initarg :offset))
(:report
(format stream
"parse error in namestring: ~?~% ~A~% ~V@T^"
(namestring-parse-error-complaint condition)
- (namestring-parse-error-arguments condition)
+ (namestring-parse-error-args condition)
(namestring-parse-error-namestring condition)
(namestring-parse-error-offset condition)))))
("List/string utility" "LENGTH/LIST" "SXHASH" "BIT-BASH" "$LENGTH$")
("Alien operations" "SAP" "ALLOC-NUMBER-STACK" "$CALL-OUT$")
("Function call/return" "CALL" "RETURN" "ALLOCATE-FRAME"
- "COPY-MORE-ARG" "LISTIFY-REST-ARG" "VERIFY-ARGUMENT-COUNT")
+ "COPY-MORE-ARG" "LISTIFY-REST-ARG" "VERIFY-ARG-COUNT")
("Allocation" "MAKE-" "ALLOC" "$CONS$" "$LIST$" "$LIST*$")
("Float conversion" "%SINGLE-FLOAT" "%DOUBLE-FLOAT" "-BITS$")
("Complex type predicate" "P$")))
;; when multiple values were specified for the return.
(returns (missing-arg) :type ctype))
-;;; The CONSTANT-TYPE structure represents a use of the
-;;; CONSTANT-ARGUMENT "type specifier", which is only meaningful in
-;;; function argument type specifiers used within the compiler. (It
-;;; represents something that the compiler knows to be a constant.)
+;;; The CONSTANT-TYPE structure represents a use of the CONSTANT-ARG
+;;; "type specifier", which is only meaningful in function argument
+;;; type specifiers used within the compiler. (It represents something
+;;; that the compiler knows to be a constant.)
(defstruct (constant-type
(:include ctype
(class-info (type-class-or-lose 'constant)))
:datum object
:expected-type 'coerceable-to-fun))
-(deferr invalid-argument-count-error (nargs)
+(deferr invalid-arg-count-error (nargs)
(error 'simple-program-error
:format-control "invalid number of arguments: ~S"
:format-arguments (list nargs)))
-(deferr bogus-argument-to-values-list-error (list)
+(deferr bogus-arg-to-values-list-error (list)
(error 'simple-type-error
:datum list
:expected-type 'list
:datum object
:expected-type (layout-class layout)))
-(deferr odd-key-arguments-error ()
+(deferr odd-key-args-error ()
(error 'simple-program-error
:format-control "odd number of &KEY arguments"))
-(deferr unknown-key-argument-error (key-name)
+(deferr unknown-key-arg-error (key-name)
(error 'simple-program-error
:format-control "unknown &KEY argument: ~S"
:format-arguments (list key-name)))
\f
;;;; INTERNAL-ERROR signal handler
-(defvar *internal-error-arguments*)
+(defvar *internal-error-args*)
(defun internal-error (context continuable)
(declare (type system-area-pointer context))
(sb!alien:sap-alien context (* os-context-t)))))
(/show0 "about to bind ERROR-NUMBER and ARGUMENTS")
(multiple-value-bind (error-number arguments)
- (sb!vm:internal-error-arguments alien-context)
- (/show0 "back from INTERNAL-ERROR-ARGUMENTS, ERROR-NUMBER=..")
+ (sb!vm:internal-error-args alien-context)
+ (/show0 "back from INTERNAL-ERROR-ARGS, ERROR-NUMBER=..")
(/hexstr error-number)
(/show0 "cold/low ARGUMENTS=..")
(/hexstr arguments)
\f
(define-condition format-error (error)
((complaint :reader format-error-complaint :initarg :complaint)
- (arguments :reader format-error-arguments :initarg :arguments :initform nil)
+ (args :reader format-error-args :initarg :args :initform nil)
(control-string :reader format-error-control-string
:initarg :control-string
:initform *default-format-error-control-string*)
~?~@[~% ~A~% ~V@T^~]"
(format-error-print-banner condition)
(format-error-complaint condition)
- (format-error-arguments condition)
+ (format-error-args condition)
(format-error-control-string condition)
(format-error-offset condition)))
\f
'format-error
:complaint
"too many parameters, expected no more than ~W"
- :arguments (list ,(length specs))
+ :args (list ,(length specs))
:offset (caar ,params)))
,,@body)))
`(progn
(error 'format-error
:complaint "Index ~W out of bounds. Should have been ~
between 0 and ~W."
- :arguments (list ,posn (length orig-args))
+ :args (list ,posn (length orig-args))
:offset ,(1- end)))))
(if colonp
(expand-bind-defaults ((n 1)) params
:complaint
"Index ~W is out of bounds; should have been ~
between 0 and ~W."
- :arguments
- (list new-posn (length orig-args))
+ :args (list new-posn (length orig-args))
:offset ,(1- end)))))))
(if params
(expand-bind-defaults ((n 1)) params
(error 'format-error
:complaint
"~A~%while processing indirect format string:"
- :arguments (list condition)
+ :args (list condition)
:print-banner nil
:control-string ,string
:offset ,(1- end)))))
(error 'format-error
:complaint
"~A~%while processing indirect format string:"
- :arguments (list condition)
+ :args (list condition)
:print-banner nil
:control-string ,string
:offset ,(1- end)))))
:complaint
"cannot include format directives inside the ~
~:[suffix~;prefix~] segment of ~~<...~~:>"
- :arguments (list prefix-p)
+ :args (list prefix-p)
:offset (1- (format-directive-end directive)))
(apply #'concatenate 'string list)))))
(case (length segments)
;; FIND-UNDELETED-PACKAGE-OR-LOSE?
(error 'format-error
:complaint "no package named ~S"
- :arguments (list package-name)))
+ :args (list package-name)))
(intern (if first-colon
(subseq name (1+ first-colon))
name)
(!define-type-class constant :inherits values)
(!define-type-method (constant :unparse) (type)
- `(constant-argument ,(type-specifier (constant-type-type type))))
+ `(constant-arg ,(type-specifier (constant-type-type type))))
(!define-type-method (constant :simple-=) (type1 type2)
(type= (constant-type-type type1) (constant-type-type type2)))
-(!def-type-translator constant-argument (type)
+(!def-type-translator constant-arg (type)
(make-constant-type :type (specifier-type type)))
;;; Given a LAMBDA-LIST-like values type specification and an ARGS-TYPE
(in-package "SB!KERNEL")
;;; We save space in macro definitions by calling this function.
-(defun arg-count-error (error-kind name arg lambda-list minimum maximum)
+(defun arg-count-error (error-kind name args lambda-list minimum maximum)
(let (#-sb-xc-host
(sb!debug:*stack-top-hint* (nth-value 1 (find-caller-name-and-frame))))
(error 'arg-count-error
:kind error-kind
:name name
- :argument arg
+ :args args
:lambda-list lambda-list
- :minimum minimum :maximum maximum)))
+ :minimum minimum
+ :maximum maximum)))
(define-condition defmacro-lambda-list-bind-error (error)
((kind :reader defmacro-lambda-list-bind-error-kind
(defmacro-bogus-sublist-error-lambda-list condition)))))
(define-condition arg-count-error (defmacro-lambda-list-bind-error)
- ((argument :reader arg-count-error-argument :initarg :argument)
+ ((args :reader arg-count-error-args :initarg :args)
(lambda-list :reader arg-count-error-lambda-list
:initarg :lambda-list)
(minimum :reader arg-count-error-minimum :initarg :minimum)
(format stream
"invalid number of elements in:~% ~:S~%~
to satisfy lambda list:~% ~:S~%"
- (arg-count-error-argument condition)
+ (arg-count-error-args condition)
(arg-count-error-lambda-list condition))
(cond ((null (arg-count-error-maximum condition))
(format stream "at least ~W expected"
(arg-count-error-minimum condition)
(arg-count-error-maximum condition))))
(format stream ", but ~W found"
- (length (arg-count-error-argument condition))))))
+ (length (arg-count-error-args condition))))))
(define-condition defmacro-ll-broken-key-list-error
(defmacro-lambda-list-bind-error)
`(,error-fun 'arg-count-error
:kind ',error-kind
,@(when name `(:name ',name))
- :argument ,path-0
+ :args ,path-0
:lambda-list ',lambda-list
:minimum ,minimum
,@(unless restp
(error 'format-error
:complaint
"too many parameters, expected no more than ~W"
- :arguments (list ,(length specs))
+ :args (list ,(length specs))
:offset (caar ,params)))
,@body))))
(error 'format-error
:complaint "Index ~W is out of bounds. (It should ~
have been between 0 and ~W.)"
- :arguments (list posn (length orig-args))))))
+ :args (list posn (length orig-args))))))
(if colonp
(interpret-bind-defaults ((n 1)) params
(do ((cur-posn 0 (1+ cur-posn))
:complaint
"Index ~W is out of bounds. (It should
have been between 0 and ~W.)"
- :arguments
+ :args
(list new-posn (length orig-args))))))))
(interpret-bind-defaults ((n 1)) params
(dotimes (i n)
(error 'format-error
:complaint
"~A~%while processing indirect format string:"
- :arguments (list condition)
+ :args (list condition)
:print-banner nil
:control-string string
:offset (1- end)))))
'format-error
:complaint
"~A~%while processing indirect format string:"
- :arguments (list condition)
+ :args (list condition)
:print-banner nil
:control-string string
:offset (1- end)))))
(error 'namestring-parse-error
:complaint "logical namestring character which ~
is not alphanumeric or hyphen:~% ~S"
- :arguments (list ch)
+ :args (list ch)
:namestring word :offset i))))
word))
(error 'namestring-parse-error
:complaint "double asterisk inside of logical ~
word: ~S"
- :arguments (list chunk)
+ :args (list chunk)
:namestring namestring
:offset (+ (cdar chunks) pos)))
(pattern (subseq chunk last-pos pos)))
(unless (member ch '(#\; #\: #\.))
(error 'namestring-parse-error
:complaint "illegal character for logical pathname:~% ~S"
- :arguments (list ch)
+ :args (list ch)
:namestring namestr
:offset i))
(chunks (cons ch i)))))
(unless (and chunks (simple-string-p (caar chunks)))
(error 'namestring-parse-error
:complaint "expecting ~A, got ~:[nothing~;~S~]."
- :arguments (list what (caar chunks) (caar chunks))
+ :args (list what (caar chunks) (caar chunks))
:namestring namestr
:offset (if chunks (cdar chunks) end)))
(caar chunks))
(unless (eql (caar chunks) #\.)
(error 'namestring-parse-error
:complaint "expecting a dot, got ~S."
- :arguments (list (caar chunks))
+ :args (list (caar chunks))
:namestring namestr
:offset (cdar chunks)))
(if type
(error 'namestring-parse-error
:complaint "expected a positive integer, ~
got ~S"
- :arguments (list str)
+ :args (list str)
:namestring namestr
:offset (+ pos (cdar chunks))))
(setq version res)))))
0)
\f
-;;;; INTERNAL-ERROR-ARGUMENTS
+;;;; INTERNAL-ERROR-ARGS
;;; Given a (POSIX) signal context, extract the internal error
;;; arguments from the instruction stream.
-(defun internal-error-arguments (context)
+(defun internal-error-args (context)
(declare (type (alien (* os-context-t)) context))
- (/show0 "entering INTERNAL-ERROR-ARGUMENTS, CONTEXT=..")
+ (/show0 "entering INTERNAL-ERROR-ARGS, CONTEXT=..")
(/hexstr context)
(let ((pc (context-pc context)))
(declare (type system-area-pointer pc))
;;; 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))
(inst subq csp-tn count context)))
;;; 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))
(: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
(: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 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))
(inst and list lowtag-mask ndescr)
(inst xor ndescr list-pointer-lowtag ndescr)
(inst beq ndescr loop)
- (error-call vop bogus-argument-to-values-list-error list)
+ (error-call vop bogus-arg-to-values-list-error list)
DONE
(inst subq csp-tn start count)))
'(bit-not bit-array-1
(make-array (length bit-array-1) :element-type 'bit)))
(deftransform bit-not ((bit-array-1 result-bit-array)
- (bit-vector (constant-argument t)))
+ (bit-vector (constant-arg t)))
'(bit-not bit-array-1 bit-array-1))
-;;; FIXME: What does (CONSTANT-ARGUMENT T) mean? Is it the same thing
-;;; as (CONSTANT-ARGUMENT (MEMBER T)), or does it mean any constant
+;;; FIXME: What does (CONSTANT-ARG T) mean? Is it the same thing
+;;; as (CONSTANT-ARG (MEMBER T)), or does it mean any constant
;;; value?
\f
;;; Pick off some constant cases.
make-old-fp-passing-location
make-old-fp-save-location
make-return-pc-save-location
- make-argument-count-location
+ make-arg-count-location
make-nfp-tn
make-stack-pointer-tn
make-number-stack-pointer-tn
(defknown ,ufun (real) integer (movable foldable flushable))
(deftransform ,fun ((x &optional by)
(* &optional
- (constant-argument (member 1))))
+ (constant-arg (member 1))))
'(let ((res (,ufun x)))
(values res (- x res)))))))
(define-frobs truncate %unary-truncate)
(defknown %more-arg-context (t t) (values t index) (flushable))
(defknown %more-arg (t index) t)
(defknown %more-arg-values (t index index) * (flushable))
-(defknown %verify-argument-count (index index) (values))
-(defknown %argument-count-error (t) nil)
+(defknown %verify-arg-count (index index) (values))
+(defknown %arg-count-error (t) nil)
(defknown %unknown-values () *)
(defknown %catch (t t) t)
(defknown %unwind-protect (t t) t)
(defknown %%primitive (t t &rest t) *)
(defknown %pop-values (t) t)
(defknown %type-check-error (t t) nil)
-(defknown %odd-key-arguments-error () nil)
-(defknown %unknown-key-argument-error (t) nil)
+(defknown %odd-key-args-error () nil)
+(defknown %unknown-key-arg-error (t) nil)
(defknown (%ldb %mask-field) (bit-index bit-index integer) unsigned-byte
(movable foldable flushable explicit-check))
(defknown (%dpb %deposit-field) (integer bit-index bit-index integer) integer
"An attempt was made to use an undefined FDEFINITION.")
(object-not-coerceable-to-fun
"Object is not coerceable to type FUNCTION.")
- (invalid-argument-count
+ (invalid-arg-count
"invalid argument count")
- (bogus-argument-to-values-list
+ (bogus-arg-to-values-list
"bogus argument to VALUES-LIST")
(unbound-symbol
"An attempt was made to use an undefined SYMBOL-VALUE.")
"division by zero")
(object-not-type
"Object is of the wrong type.")
- (odd-key-arguments
+ (odd-key-args
"odd number of &KEY arguments")
- (unknown-key-argument
+ (unknown-key-arg
"unknown &KEY argument")
nil
nil
(body
`(when (oddp ,n-count)
- (%odd-key-arguments-error)))
+ (%odd-key-args-error)))
(body
`(locally
(unless allowp
(body `(when (and ,n-losep (not ,n-allowp))
- (%unknown-key-argument-error ,n-losep)))))))
+ (%unknown-key-arg-error ,n-losep)))))))
(let ((ep (ir1-convert-lambda-body
`((let ,(temps)
(let ((vars (lambda-vars fun))
(n 0))
(when (leaf-refs (first vars))
- (emit-move node block (make-argument-count-location)
+ (emit-move node block (make-arg-count-location)
(leaf-info (first vars))))
(dolist (arg (rest vars))
(when (leaf-refs arg)
(2info (nlx-info-info info))
(top-loc (ir2-nlx-info-save-sp 2info))
(start-loc (make-nlx-entry-argument-start-location))
- (count-loc (make-argument-count-location))
+ (count-loc (make-arg-count-location))
(target (ir2-nlx-info-target 2info)))
(ecase (cleanup-kind (nlx-info-cleanup info))
(declare (type index ,n-supplied))
,(if (policy *lexenv* (zerop safety))
`(declare (ignore ,n-supplied))
- `(%verify-argument-count ,n-supplied ,nargs))
+ `(%verify-arg-count ,n-supplied ,nargs))
(%funcall ,fun ,@temps))))
(optional-dispatch
(let* ((min (optional-dispatch-min-args fun))
(%more-arg-context ,n-supplied ,max)
(%funcall ,more ,@temps ,n-context ,n-count))))))
(t
- (%argument-count-error ,n-supplied)))))))))
+ (%arg-count-error ,n-supplied)))))))))
;;; Make an external entry point (XEP) for FUN and return it. We
;;; convert the result of MAKE-XEP-LAMBDA in the correct environment,
;;; Flush calls to various arith functions that convert to the
;;; identity function or a constant.
(macrolet ((def-frob (name identity result)
- `(deftransform ,name ((x y) (* (constant-argument (member ,identity)))
+ `(deftransform ,name ((x y) (* (constant-arg (member ,identity)))
* :when :both)
"fold identity operations"
',result)))
;;; These are restricted to rationals, because (- 0 0.0) is 0.0, not -0.0, and
;;; (* 0 -4.0) is -0.0.
-(deftransform - ((x y) ((constant-argument (member 0)) rational) *
+(deftransform - ((x y) ((constant-arg (member 0)) rational) *
:when :both)
"convert (- 0 x) to negate"
'(%negate y))
-(deftransform * ((x y) (rational (constant-argument (member 0))) *
+(deftransform * ((x y) (rational (constant-arg (member 0))) *
:when :both)
"convert (* x 0) to 0"
0)
;;;
;;; If y is not constant, not zerop, or is contagious, or a positive
;;; float +0.0 then give up.
-(deftransform + ((x y) (t (constant-argument t)) * :when :both)
+(deftransform + ((x y) (t (constant-arg t)) * :when :both)
"fold zero arg"
(let ((val (continuation-value y)))
(unless (and (zerop val)
;;;
;;; If y is not constant, not zerop, or is contagious, or a negative
;;; float -0.0 then give up.
-(deftransform - ((x y) (t (constant-argument t)) * :when :both)
+(deftransform - ((x y) (t (constant-arg t)) * :when :both)
"fold zero arg"
(let ((val (continuation-value y)))
(unless (and (zerop val)
;;; Fold (OP x +/-1)
(macrolet ((def-frob (name result minus-result)
- `(deftransform ,name ((x y) (t (constant-argument real))
+ `(deftransform ,name ((x y) (t (constant-arg real))
* :when :both)
"fold identity operations"
(let ((val (continuation-value y)))
;;; Fold (expt x n) into multiplications for small integral values of
;;; N; convert (expt x 1/2) to sqrt.
-(deftransform expt ((x y) (t (constant-argument real)) *)
+(deftransform expt ((x y) (t (constant-arg real)) *)
"recode as multiplication or sqrt"
(let ((val (continuation-value y)))
;; If Y would cause the result to be promoted to the same type as
;;; Perhaps we should have to prove that the denominator is nonzero before
;;; doing them? -- WHN 19990917
(macrolet ((def-frob (name)
- `(deftransform ,name ((x y) ((constant-argument (integer 0 0)) integer)
+ `(deftransform ,name ((x y) ((constant-arg (integer 0 0)) integer)
* :when :both)
"fold zero arg"
0)))
(def-frob /))
(macrolet ((def-frob (name)
- `(deftransform ,name ((x y) ((constant-argument (integer 0 0)) integer)
+ `(deftransform ,name ((x y) ((constant-arg (integer 0 0)) integer)
* :when :both)
"fold zero arg"
'(values 0 0))))
;;; If FIND-CLASS is called on a constant class, locate the CLASS-CELL
;;; at load time.
-(deftransform find-class ((name) ((constant-argument symbol)) *
+(deftransform find-class ((name) ((constant-arg symbol)) *
:when :both)
(let* ((name (continuation-value name))
(cell (find-class-cell name)))
(primitive-type-type
type)))
(rest x))))
- (:constant `(constant-argument ,(third x)))))))
+ (:constant `(constant-arg ,(third x)))))))
`(,@(mapcar #'frob types)
,@(when more-types
`(&rest ,(frob more-types)))))))
;;; 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
(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)))
(:save-p :compute-only)
(:generator 1000
(error-call vop ,error ,@args)))))
- (def argument-count-error invalid-argument-count-error
- sb!c::%argument-count-error nargs)
+ (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)
(def layout-invalid-error layout-invalid-error sb!c::%layout-invalid-error
object layout)
- (def odd-key-arguments-error odd-key-arguments-error
- sb!c::%odd-key-arguments-error)
- (def unknown-key-argument-error unknown-key-argument-error
- sb!c::%unknown-key-argument-error key)
+ (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))
(inst and al-tn lowtag-mask)
(inst cmp al-tn list-pointer-lowtag)
(inst jmp :e loop)
- (error-call vop bogus-argument-to-values-list-error list)
+ (error-call vop bogus-arg-to-values-list-error list)
DONE
(inst mov count start) ; start is high address
\f
(defun analyze-lambda-list (lambda-list)
(flet (;; FIXME: Is this redundant with SB-C::MAKE-KEYWORD-FOR-ARG?
- (parse-key-argument (arg)
+ (parse-key-arg (arg)
(if (listp arg)
(if (listp (car arg))
(caar arg)
(ecase state
(required (incf nrequired))
(optional (incf noptional))
- (key (push (parse-key-argument x) keywords)
+ (key (push (parse-key-arg x) keywords)
(push x keyword-parameters))
(rest (incf nrest)))))
(when (and restp (zerop nrest))
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre7.135"
+"0.pre7.136"
projects / sbcl.git / commitdiff