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
31 files changed:
** reserved DO-FOO-style names for iteration macros
** s/ARGUMENT/ARG/
** perhaps s/DEF-FROB/DEF/ or s/DEF-FROB/DEFINE/
** 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:
* 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"
"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"
"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"
"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"
"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-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"
"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?
;; certainly doesn't belong in public extensions
;; FIXME: maybe belongs in %KERNEL with other typesystem stuff?
;; various internal defaults
"*DEFAULT-PACKAGE-USE-LIST*"
;; various internal defaults
"*DEFAULT-PACKAGE-USE-LIST*"
"BIT-BASH-NOT"
"BIT-BASH-ORC1" "BIT-BASH-ORC2" "BIT-BASH-SET"
"BIT-BASH-XOR"
"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"
"BOOLE-CODE"
"BYTE-SPECIFIER"
"%BYTE-BLT"
"INTERNAL-ERROR" "INTERNAL-TIME"
"INTERSECTION-TYPE" "INTERSECTION-TYPE-P"
"INTERSECTION-TYPE-TYPES"
"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"
"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"
"OBJECT-NOT-TYPE-ERROR"
"OBJECT-NOT-UNSIGNED-BYTE-32-ERROR"
"OBJECT-NOT-VECTOR-ERROR" "OBJECT-NOT-WEAK-POINTER-ERROR"
- "ODD-KEY-ARGUMENTS-ERROR"
"OUTPUT-OBJECT" "OUTPUT-UGLY-OBJECT"
"PACKAGE-DOC-STRING"
"PACKAGE-HASHTABLE-SIZE" "PACKAGE-HASHTABLE-FREE"
"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"
"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"
"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"
"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"
"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"
-;;;; INTERNAL-ERROR-ARGUMENTS
+;;;; INTERNAL-ERROR-ARGS
;;; Given a (POSIX) signal context, extract the internal error
;;; arguments from the instruction stream. This is e.g.
;;; 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)
;;; (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))
(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)
(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
(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)
(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)))))
(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"
("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$")))
("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))
;; 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)))
(defstruct (constant-type
(:include ctype
(class-info (type-class-or-lose 'constant)))
:datum object
:expected-type 'coerceable-to-fun))
: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)))
(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
(error 'simple-type-error
:datum list
:expected-type 'list
:datum object
:expected-type (layout-class layout)))
: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"))
(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)))
(error 'simple-program-error
:format-control "unknown &KEY argument: ~S"
:format-arguments (list key-name)))
\f
;;;; INTERNAL-ERROR signal handler
\f
;;;; INTERNAL-ERROR signal handler
-(defvar *internal-error-arguments*)
+(defvar *internal-error-args*)
(defun internal-error (context continuable)
(declare (type system-area-pointer context))
(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!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)
(/hexstr error-number)
(/show0 "cold/low ARGUMENTS=..")
(/hexstr arguments)
\f
(define-condition format-error (error)
((complaint :reader format-error-complaint :initarg :complaint)
\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*)
(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)
~?~@[~% ~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-control-string condition)
(format-error-offset condition)))
\f
'format-error
:complaint
"too many parameters, expected no more than ~W"
'format-error
:complaint
"too many parameters, expected no more than ~W"
- :arguments (list ,(length specs))
+ :args (list ,(length specs))
:offset (caar ,params)))
,,@body)))
`(progn
:offset (caar ,params)))
,,@body)))
`(progn
(error 'format-error
:complaint "Index ~W out of bounds. Should have been ~
between 0 and ~W."
(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
: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."
: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
:offset ,(1- end)))))))
(if params
(expand-bind-defaults ((n 1)) params
(error 'format-error
:complaint
"~A~%while processing indirect format string:"
(error 'format-error
:complaint
"~A~%while processing indirect format string:"
- :arguments (list condition)
:print-banner nil
:control-string ,string
:offset ,(1- end)))))
:print-banner nil
:control-string ,string
:offset ,(1- end)))))
(error 'format-error
:complaint
"~A~%while processing indirect format string:"
(error 'format-error
:complaint
"~A~%while processing indirect format string:"
- :arguments (list condition)
:print-banner nil
:control-string ,string
:offset ,(1- end)))))
:print-banner nil
:control-string ,string
:offset ,(1- end)))))
:complaint
"cannot include format directives inside the ~
~:[suffix~;prefix~] segment of ~~<...~~:>"
:complaint
"cannot include format directives inside the ~
~:[suffix~;prefix~] segment of ~~<...~~:>"
- :arguments (list prefix-p)
:offset (1- (format-directive-end directive)))
(apply #'concatenate 'string list)))))
(case (length segments)
: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"
;; 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)
(intern (if first-colon
(subseq name (1+ first-colon))
name)
(!define-type-class constant :inherits values)
(!define-type-method (constant :unparse) (type)
(!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)))
(!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
(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.
(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
(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
- :minimum minimum :maximum maximum)))
+ :minimum minimum
+ :maximum maximum)))
(define-condition defmacro-lambda-list-bind-error (error)
((kind :reader defmacro-lambda-list-bind-error-kind
(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)
(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)
(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~%"
(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-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"
(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)
(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))
`(,error-fun 'arg-count-error
:kind ',error-kind
,@(when name `(:name ',name))
:lambda-list ',lambda-list
:minimum ,minimum
,@(unless restp
:lambda-list ',lambda-list
:minimum ,minimum
,@(unless restp
(error 'format-error
:complaint
"too many parameters, expected no more than ~W"
(error 'format-error
:complaint
"too many parameters, expected no more than ~W"
- :arguments (list ,(length specs))
+ :args (list ,(length specs))
:offset (caar ,params)))
,@body))))
:offset (caar ,params)))
,@body))))
(error 'format-error
:complaint "Index ~W is out of bounds. (It should ~
have been between 0 and ~W.)"
(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))
(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.)"
:complaint
"Index ~W is out of bounds. (It should
have been between 0 and ~W.)"
(list new-posn (length orig-args))))))))
(interpret-bind-defaults ((n 1)) params
(dotimes (i n)
(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:"
(error 'format-error
:complaint
"~A~%while processing indirect format string:"
- :arguments (list condition)
:print-banner nil
:control-string string
:offset (1- end)))))
:print-banner nil
:control-string string
:offset (1- end)))))
'format-error
:complaint
"~A~%while processing indirect format string:"
'format-error
:complaint
"~A~%while processing indirect format string:"
- :arguments (list condition)
:print-banner nil
:control-string string
:offset (1- end)))))
:print-banner nil
:control-string string
:offset (1- end)))))
(error 'namestring-parse-error
:complaint "logical namestring character which ~
is not alphanumeric or hyphen:~% ~S"
(error 'namestring-parse-error
:complaint "logical namestring character which ~
is not alphanumeric or hyphen:~% ~S"
:namestring word :offset i))))
word))
:namestring word :offset i))))
word))
(error 'namestring-parse-error
:complaint "double asterisk inside of logical ~
word: ~S"
(error 'namestring-parse-error
:complaint "double asterisk inside of logical ~
word: ~S"
- :arguments (list chunk)
:namestring namestring
:offset (+ (cdar chunks) pos)))
(pattern (subseq chunk last-pos pos)))
: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"
(unless (member ch '(#\; #\: #\.))
(error 'namestring-parse-error
:complaint "illegal character for logical pathname:~% ~S"
:namestring namestr
:offset i))
(chunks (cons ch i)))))
: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~]."
(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))
:namestring namestr
:offset (if chunks (cdar chunks) end)))
(caar chunks))
(unless (eql (caar chunks) #\.)
(error 'namestring-parse-error
:complaint "expecting a dot, got ~S."
(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
:namestring namestr
:offset (cdar chunks)))
(if type
(error 'namestring-parse-error
:complaint "expected a positive integer, ~
got ~S"
(error 'namestring-parse-error
:complaint "expected a positive integer, ~
got ~S"
:namestring namestr
:offset (+ pos (cdar chunks))))
(setq version res)))))
:namestring namestr
:offset (+ pos (cdar chunks))))
(setq version res)))))
-;;;; INTERNAL-ERROR-ARGUMENTS
+;;;; INTERNAL-ERROR-ARGS
;;; Given a (POSIX) signal context, extract the internal error
;;; arguments from the instruction stream.
;;; 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))
(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))
(/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.
;;; 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-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.
(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)
- (: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)
(: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
(: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
(cond ((zerop count)
(inst bne nargs err-lab))
(t
(:save-p :compute-only)
(:generator 1000
(error-call vop ,error ,@args)))))
(: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 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))
(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)
(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)))
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-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))
'(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.
;;; value?
\f
;;; Pick off some constant cases.
make-old-fp-passing-location
make-old-fp-save-location
make-return-pc-save-location
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
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
(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)
'(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 %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 %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 %%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
(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.")
"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 argument 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.")
"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.")
"division by zero")
(object-not-type
"Object is of the wrong type.")
"odd number of &KEY arguments")
"odd number of &KEY arguments")
"unknown &KEY argument")
nil
nil
"unknown &KEY argument")
nil
nil
(body
`(when (oddp ,n-count)
(body
`(when (oddp ,n-count)
- (%odd-key-arguments-error)))
+ (%odd-key-args-error)))
(unless allowp
(body `(when (and ,n-losep (not ,n-allowp))
(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 ((ep (ir1-convert-lambda-body
`((let ,(temps)
(let ((vars (lambda-vars fun))
(n 0))
(when (leaf-refs (first vars))
(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)
(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))
(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))
(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))
(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))
(%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
(%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,
;;; 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)
;;; 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)))
* :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.
;;; 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))
: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)
: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.
;;;
;;; 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)
"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.
;;;
;;; 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 zero arg"
(let ((val (continuation-value y)))
(unless (and (zerop val)
;;; Fold (OP x +/-1)
(macrolet ((def-frob (name result minus-result)
;;; 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)))
* :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.
;;; 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
"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)
;;; 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)))
* :when :both)
"fold zero arg"
0)))
(def-frob /))
(macrolet ((def-frob (name)
(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))))
* :when :both)
"fold zero arg"
'(values 0 0))))
;;; If FIND-CLASS is called on a constant class, locate the CLASS-CELL
;;; at load time.
;;; 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)))
:when :both)
(let* ((name (continuation-value name))
(cell (find-class-cell name)))
(primitive-type-type
type)))
(rest x))))
(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)))))))
`(,@(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.
;;; 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
(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.
(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)
- (: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)
(:args (nargs :scs (any-reg)))
(:arg-types positive-fixnum (:constant t))
(:info count)
(:save-p :compute-only)
(:generator 3
(let ((err-lab
(: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)))
(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)))))
(: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 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))
(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)
(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
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?
\f
(defun analyze-lambda-list (lambda-list)
(flet (;; FIXME: Is this redundant with SB-C::MAKE-KEYWORD-FOR-ARG?
- (parse-key-argument (arg)
(if (listp arg)
(if (listp (car arg))
(caar arg)
(if (listp arg)
(if (listp (car arg))
(caar arg)
(ecase state
(required (incf nrequired))
(optional (incf noptional))
(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))
(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".)
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)