;;; single argument that's directly usable by all the other routines.
(defun coerce-to-condition (datum arguments default-type fun-name)
(cond ((typep datum 'condition)
;;; single argument that's directly usable by all the other routines.
(defun coerce-to-condition (datum arguments default-type fun-name)
(cond ((typep datum 'condition)
- datum)
- ((symbolp datum) ; roughly, (SUBTYPEP DATUM 'CONDITION)
- (apply #'make-condition datum arguments))
- ((or (stringp datum) (functionp datum))
- (make-condition default-type
- :format-control datum
- :format-arguments arguments))
- (t
- (error 'simple-type-error
- :datum datum
- :expected-type '(or symbol string)
- :format-control "bad argument to ~S: ~S"
- :format-arguments (list fun-name datum)))))
+ datum)
+ ((symbolp datum) ; roughly, (SUBTYPEP DATUM 'CONDITION)
+ (apply #'make-condition datum arguments))
+ ((or (stringp datum) (functionp datum))
+ (make-condition default-type
+ :format-control datum
+ :format-arguments arguments))
+ (t
+ (error 'simple-type-error
+ :datum datum
+ :expected-type '(or symbol string)
+ :format-control "bad argument to ~S: ~S"
+ :format-arguments (list fun-name datum)))))
(lambda (condition stream)
(format stream "~@<~S fell through ~S expression. ~
~:_Wanted one of ~:S.~:>"
(lambda (condition stream)
(format stream "~@<~S fell through ~S expression. ~
~:_Wanted one of ~:S.~:>"
- (type-error-datum condition)
- (case-failure-name condition)
- (case-failure-possibilities condition)))))
+ (type-error-datum condition)
+ (case-failure-name condition)
+ (case-failure-possibilities condition)))))
(define-condition compiled-program-error (program-error)
((message :initarg :message :reader program-error-message)
(source :initarg :source :reader program-error-source))
(:report (lambda (condition stream)
(define-condition compiled-program-error (program-error)
((message :initarg :message :reader program-error-message)
(source :initarg :source :reader program-error-source))
(:report (lambda (condition stream)
(define-condition simple-control-error (simple-condition control-error) ())
(define-condition simple-file-error (simple-condition file-error) ())
(define-condition simple-control-error (simple-condition control-error) ())
(define-condition simple-file-error (simple-condition file-error) ())
(define-condition character-coding-error (error) ())
(define-condition character-encoding-error (character-coding-error)
(define-condition character-coding-error (error) ())
(define-condition character-encoding-error (character-coding-error)
(define-condition character-decoding-error (character-coding-error)
((octets :initarg :octets :reader character-decoding-error-octets)))
(define-condition stream-encoding-error (stream-error character-encoding-error)
(define-condition character-decoding-error (character-coding-error)
((octets :initarg :octets :reader character-decoding-error-octets)))
(define-condition stream-encoding-error (stream-error character-encoding-error)
(format s "~@<encoding error on stream ~S (~S ~S): ~2I~_~
the character with code ~D cannot be encoded.~@:>"
stream ':external-format (stream-external-format stream)
(format s "~@<encoding error on stream ~S (~S ~S): ~2I~_~
the character with code ~D cannot be encoded.~@:>"
stream ':external-format (stream-external-format stream)
(format stream
"Control stack exhausted (no more space for function call frames). This is probably due to heavily nested or infinitely recursive function calls, or a tail call that SBCL cannot or has not optimized away."))))
(format stream
"Control stack exhausted (no more space for function call frames). This is probably due to heavily nested or infinitely recursive function calls, or a tail call that SBCL cannot or has not optimized away."))))
+(define-condition memory-fault-error (error)
+ ()
+ (:report
+ (lambda (condition stream)
+ (declare (ignore condition))
+ (format stream "memory fault"))))
\ No newline at end of file