+;;;; 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.
+
+(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 io-timeout (stream-error)
+ ((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 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 reader-package-error (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 (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 error-stream) error-stream
+ (reader-error-format-control condition)
+ (reader-error-format-arguments condition)
+ (reader-impossible-number-error-error condition))))))
+
+(define-condition timeout (serious-condition) ())
+\f