+
+(define-condition format-args-mismatch (reference-condition)
+ ()
+ (:default-initargs :references (list '(:ansi-cl :section (22 3 10 2)))))
+
+(define-condition format-too-few-args-warning
+ (format-args-mismatch simple-warning)
+ ())
+(define-condition format-too-many-args-warning
+ (format-args-mismatch simple-style-warning)
+ ())
+
+(define-condition extension-failure (reference-condition simple-error)
+ ())
+
+(define-condition structure-initarg-not-keyword
+ (reference-condition simple-style-warning)
+ ()
+ (:default-initargs :references (list '(:ansi-cl :section (2 4 8 13)))))
+
+#!+sb-package-locks
+(progn
+
+(define-condition package-lock-violation (reference-condition package-error)
+ ((format-control :initform nil :initarg :format-control
+ :reader package-error-format-control)
+ (format-arguments :initform nil :initarg :format-arguments
+ :reader package-error-format-arguments))
+ (:report
+ (lambda (condition stream)
+ (let ((control (package-error-format-control condition)))
+ (if control
+ (apply #'format stream
+ (format nil "~~@<Lock on package ~A violated when ~A.~~:@>"
+ (package-name (package-error-package condition))
+ control)
+ (package-error-format-arguments condition))
+ (format stream "~@<Lock on package ~A violated.~:@>"
+ (package-name (package-error-package condition)))))))
+ ;; no :default-initargs -- reference-stuff provided by the
+ ;; signalling form in target-package.lisp
+ #!+sb-doc
+ (:documentation
+ "Subtype of CL:PACKAGE-ERROR. A subtype of this error is signalled
+when a package-lock is violated."))
+
+(define-condition package-locked-error (package-lock-violation) ()
+ #!+sb-doc
+ (:documentation
+ "Subtype of SB-EXT:PACKAGE-LOCK-VIOLATION. An error of this type is
+signalled when an operation on a package violates a package lock."))
+
+(define-condition symbol-package-locked-error (package-lock-violation)
+ ((symbol :initarg :symbol :reader package-locked-error-symbol))
+ #!+sb-doc
+ (:documentation
+ "Subtype of SB-EXT:PACKAGE-LOCK-VIOLATION. An error of this type is
+signalled when an operation on a symbol violates a package lock. The
+symbol that caused the violation is accessed by the function
+SB-EXT:PACKAGE-LOCKED-ERROR-SYMBOL."))
+
+) ; progn
+
+(define-condition undefined-alien-error (cell-error) ()
+ (:report
+ (lambda (condition stream)
+ (if (slot-boundp condition 'name)
+ (format stream "Undefined alien: ~S" (cell-error-name condition))
+ (format stream "Undefined alien symbol.")))))
+
+(define-condition undefined-alien-variable-error (undefined-alien-error) ()
+ (:report
+ (lambda (condition stream)
+ (declare (ignore condition))
+ (format stream "Attempt to access an undefined alien variable."))))
+
+(define-condition undefined-alien-function-error (undefined-alien-error) ()
+ (:report
+ (lambda (condition stream)
+ (declare (ignore condition))
+ (format stream "Attempt to call an undefined alien function."))))
+
+\f
+;;;; various other (not specified by ANSI) CONDITIONs
+;;;;
+;;;; These might logically belong in other files; they're here, after
+;;;; setup of CONDITION machinery, only because that makes it easier to
+;;;; get cold init to work.
+
+;;; OAOOM warning: see cross-condition.lisp
+(define-condition encapsulated-condition (condition)
+ ((condition :initarg :condition :reader encapsulated-condition)))
+
+(define-condition values-type-error (type-error)
+ ()
+ (:report
+ (lambda (condition stream)
+ (format stream
+ "~@<The values set ~2I~:_[~{~S~^ ~}] ~I~_is not of type ~2I~_~S.~:>"
+ (type-error-datum condition)
+ (type-error-expected-type condition)))))
+
+;;; KLUDGE: a condition for floating point errors when we can't or
+;;; won't figure out what type they are. (In FreeBSD and OpenBSD we
+;;; don't know how, at least as of sbcl-0.6.7; in Linux we probably
+;;; know how but the old code was broken by the conversion to POSIX
+;;; signal handling and hasn't been fixed as of sbcl-0.6.7.)
+;;;
+;;; FIXME: Perhaps this should also be a base class for all
+;;; floating point exceptions?
+(define-condition floating-point-exception (arithmetic-error)
+ ((flags :initarg :traps
+ :initform nil
+ :reader floating-point-exception-traps))
+ (:report (lambda (condition stream)
+ (format stream
+ "An arithmetic error ~S was signalled.~%"
+ (type-of condition))
+ (let ((traps (floating-point-exception-traps condition)))
+ (if traps
+ (format stream
+ "Trapping conditions are: ~%~{ ~S~^~}~%"
+ traps)
+ (write-line
+ "No traps are enabled? How can this be?"
+ stream))))))
+
+(define-condition index-too-large-error (type-error)
+ ()
+ (:report
+ (lambda (condition stream)
+ (format stream
+ "The index ~S is too large."
+ (type-error-datum condition)))))
+
+(define-condition bounding-indices-bad-error (reference-condition type-error)
+ ((object :reader bounding-indices-bad-object :initarg :object))
+ (:report
+ (lambda (condition stream)
+ (let* ((datum (type-error-datum condition))
+ (start (car datum))
+ (end (cdr datum))
+ (object (bounding-indices-bad-object condition)))
+ (etypecase object
+ (sequence
+ (format stream
+ "The bounding indices ~S and ~S are bad ~
+ for a sequence of length ~S."
+ start end (length object)))
+ (array
+ ;; from WITH-ARRAY-DATA
+ (format stream
+ "The START and END parameters ~S and ~S are ~
+ bad for an array of total size ~S."
+ start end (array-total-size object)))))))
+ (:default-initargs
+ :references
+ (list '(:ansi-cl :glossary "bounding index designator")
+ '(:ansi-cl :issue "SUBSEQ-OUT-OF-BOUNDS:IS-AN-ERROR"))))
+
+(define-condition nil-array-accessed-error (reference-condition type-error)
+ ()
+ (:report (lambda (condition stream)
+ (declare (ignore condition))
+ (format stream
+ "An attempt to access an array of element-type ~
+ NIL was made. Congratulations!")))
+ (:default-initargs
+ :references (list '(:ansi-cl :function sb!xc:upgraded-array-element-type)
+ '(:ansi-cl :section (15 1 2 1))
+ '(:ansi-cl :section (15 1 2 2)))))
+
+(define-condition namestring-parse-error (parse-error)
+ ((complaint :reader namestring-parse-error-complaint :initarg :complaint)
+ (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
+ (lambda (condition stream)
+ (format stream
+ "parse error in namestring: ~?~% ~A~% ~V@T^"
+ (namestring-parse-error-complaint condition)
+ (namestring-parse-error-args condition)
+ (namestring-parse-error-namestring condition)
+ (namestring-parse-error-offset condition)))))
+
+(define-condition simple-package-error (simple-condition package-error) ())
+
+(define-condition simple-reader-package-error (simple-reader-error) ())
+
+(define-condition reader-eof-error (end-of-file)
+ ((context :reader reader-eof-error-context :initarg :context))
+ (:report
+ (lambda (condition stream)
+ (format stream
+ "unexpected end of file on ~S ~A"
+ (stream-error-stream condition)
+ (reader-eof-error-context condition)))))
+
+(define-condition reader-impossible-number-error (simple-reader-error)
+ ((error :reader reader-impossible-number-error-error :initarg :error))
+ (:report
+ (lambda (condition stream)
+ (let ((error-stream (stream-error-stream condition)))
+ (format stream
+ "READER-ERROR ~@[at ~W ~]on ~S:~%~?~%Original error: ~A"
+ (file-position-or-nil-for-error error-stream) error-stream
+ (simple-condition-format-control condition)
+ (simple-condition-format-arguments condition)
+ (reader-impossible-number-error-error condition))))))
+
+(define-condition timeout (serious-condition)
+ ((seconds :initarg :seconds :initform nil :reader timeout-seconds))
+ (:report (lambda (condition stream)
+ (format stream "Timeout occurred~@[ after ~A seconds~]."
+ (timeout-seconds condition)))))
+
+(define-condition io-timeout (stream-error timeout)
+ ((direction :reader io-timeout-direction :initarg :direction))
+ (:report
+ (lambda (condition stream)
+ (declare (type stream stream))
+ (format stream
+ "I/O timeout ~(~A~)ing ~S."
+ (io-timeout-direction condition)
+ (stream-error-stream condition)))))
+
+(define-condition deadline-timeout (timeout) ()
+ (:report (lambda (condition stream)
+ (format stream "A deadline was reached after ~A seconds."
+ (timeout-seconds condition)))))
+
+(define-condition declaration-type-conflict-error (reference-condition
+ simple-error)
+ ()
+ (:default-initargs
+ :format-control "symbol ~S cannot be both the name of a type and the name of a declaration"
+ :references (list '(:ansi-cl :section (3 8 21)))))
+
+;;; Single stepping conditions
+
+(define-condition step-condition ()
+ ((form :initarg :form :reader step-condition-form))
+
+ #!+sb-doc
+ (:documentation "Common base class of single-stepping conditions.
+STEP-CONDITION-FORM holds a string representation of the form being
+stepped."))
+
+#!+sb-doc
+(setf (fdocumentation 'step-condition-form 'function)
+ "Form associated with the STEP-CONDITION.")
+
+(define-condition step-form-condition (step-condition)
+ ((args :initarg :args :reader step-condition-args))
+ (:report
+ (lambda (condition stream)
+ (let ((*print-circle* t)
+ (*print-pretty* t)
+ (*print-readably* nil))
+ (format stream
+ "Evaluating call:~%~< ~@;~A~:>~%~
+ ~:[With arguments:~%~{ ~S~%~}~;With unknown arguments~]~%"
+ (list (step-condition-form condition))
+ (eq (step-condition-args condition) :unknown)
+ (step-condition-args condition)))))
+ #!+sb-doc
+ (:documentation "Condition signalled by code compiled with
+single-stepping information when about to execute a form.
+STEP-CONDITION-FORM holds the form, STEP-CONDITION-PATHNAME holds the
+pathname of the original file or NIL, and STEP-CONDITION-SOURCE-PATH
+holds the source-path to the original form within that file or NIL.
+Associated with this condition are always the restarts STEP-INTO,
+STEP-NEXT, and STEP-CONTINUE."))
+
+#!+sb-doc
+(setf (fdocumentation 'step-condition-source-path 'function)
+ "Source-path of the original form associated with the
+STEP-FORM-CONDITION or NIL."
+ (fdocumentation 'step-condition-pathname 'function)
+ "Pathname of the original source-file associated with the
+STEP-FORM-CONDITION or NIL.")
+
+(define-condition step-result-condition (step-condition)
+ ((result :initarg :result :reader step-condition-result)))
+
+#!+sb-doc
+(setf (fdocumentation 'step-condition-result 'function)
+ "Return values associated with STEP-VALUES-CONDITION as a list,
+or the variable value associated with STEP-VARIABLE-CONDITION.")
+
+(define-condition step-values-condition (step-result-condition)
+ ()
+ #!+sb-doc
+ (:documentation "Condition signalled by code compiled with
+single-stepping information after executing a form.
+STEP-CONDITION-FORM holds the form, and STEP-CONDITION-RESULT holds
+the values returned by the form as a list. No associated restarts."))
+
+(define-condition step-finished-condition (step-condition)
+ ()
+ (:report
+ (lambda (condition stream)
+ (declare (ignore condition))
+ (format stream "Returning from STEP")))
+ #!+sb-doc
+ (:documentation "Condition signaled when STEP returns."))
+