src/code/error.lisp

   1 ;;;; SBCL-specific parts of the condition system, i.e. parts which
   2 ;;;; don't duplicate/clobber functionality already provided by the
   3 ;;;; cross-compilation host Common Lisp
   4
   5 ;;;; This software is part of the SBCL system. See the README file for
   6 ;;;; more information.
   7 ;;;;
   8 ;;;; This software is derived from the CMU CL system, which was
   9 ;;;; written at Carnegie Mellon University and released into the
  10 ;;;; public domain. The software is in the public domain and is
  11 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  12 ;;;; files for more information.
  13
  14 (in-package "SB!KERNEL")
  15
  16 ;;; not sure this is the right place, but where else?
  17 (defun style-warn (format-control &rest format-arguments)
  18   (/show0 "entering STYLE-WARN")
  19   (/show format-control format-arguments)
  20   (with-sane-io-syntax
  21       (warn 'simple-style-warning
  22             :format-control format-control
  23             :format-arguments format-arguments)))
  24
  25 ;;; a utility for SIGNAL, ERROR, CERROR, WARN, COMPILER-NOTIFY and
  26 ;;; INVOKE-DEBUGGER: Parse the hairy argument conventions into a
  27 ;;; single argument that's directly usable by all the other routines.
  28 (defun coerce-to-condition (datum arguments default-type fun-name)
  29   (cond ((typep datum 'condition)
  30          (when (and arguments (not (eq fun-name 'cerror)))
  31            (cerror "Ignore the additional arguments."
  32                    'simple-type-error
  33                    :datum arguments
  34                    :expected-type 'null
  35                    :format-control "You may not supply additional arguments ~
  36                                     when giving ~S to ~S."
  37                    :format-arguments (list datum fun-name)))
  38          datum)
  39         ((symbolp datum) ; roughly, (SUBTYPEP DATUM 'CONDITION)
  40          (apply #'make-condition datum arguments))
  41         ((or (stringp datum) (functionp datum))
  42          (make-condition default-type
  43                          :format-control datum
  44                          :format-arguments arguments))
  45         (t
  46          (error 'simple-type-error
  47                 :datum datum
  48                 :expected-type '(or symbol string)
  49                 :format-control "bad argument to ~S: ~S"
  50                 :format-arguments (list fun-name datum)))))
  51
  52 (define-condition layout-invalid (type-error)
  53   ()
  54   (:report
  55    (lambda (condition stream)
  56      (format stream
  57              "~@<invalid structure layout: ~
  58               ~2I~_A test for class ~4I~_~S ~
  59               ~2I~_was passed the obsolete instance ~4I~_~S~:>"
  60              (classoid-proper-name (type-error-expected-type condition))
  61              (type-error-datum condition)))))
  62
  63 (define-condition case-failure (type-error)
  64   ((name :reader case-failure-name :initarg :name)
  65    (possibilities :reader case-failure-possibilities :initarg :possibilities))
  66   (:report
  67     (lambda (condition stream)
  68       (format stream "~@<~S fell through ~S expression. ~
  69                       ~:_Wanted one of ~:S.~:>"
  70               (type-error-datum condition)
  71               (case-failure-name condition)
  72               (case-failure-possibilities condition)))))
  73
  74 (define-condition compiled-program-error (program-error)
  75   ((message :initarg :message :reader program-error-message)
  76    (source :initarg :source :reader program-error-source))
  77   (:report (lambda (condition stream)
  78              (format stream "Execution of a form compiled with errors.~%~
  79                              Form:~%  ~A~%~
  80                              Compile-time error:~%  ~A"
  81                        (program-error-source condition)
  82                        (program-error-message condition)))))
  83
  84 (define-condition interpreted-program-error
  85     (program-error encapsulated-condition)
  86   ;; Unlike COMPILED-PROGRAM-ERROR, we don't need to dump these, so
  87   ;; storing the original condition and form is OK.
  88   ((form :initarg :form :reader program-error-form))
  89   (:report (lambda (condition stream)
  90              (format stream "~&Evaluation of~%  ~S~%~
  91                              caused error:~%  ~A~%"
  92                      (program-error-form condition)
  93                      (encapsulated-condition condition)))))
  94
  95 (define-condition simple-control-error (simple-condition control-error) ())
  96 (define-condition simple-file-error    (simple-condition file-error)    ())
  97 (define-condition simple-program-error (simple-condition program-error) ())
  98 (define-condition simple-stream-error  (simple-condition stream-error)  ())
  99 (define-condition simple-parse-error   (simple-condition parse-error)   ())
 100
 101 (define-condition character-coding-error (error) ())
 102 (define-condition character-encoding-error (character-coding-error)
 103   ((code :initarg :code :reader character-encoding-error-code)))
 104 (define-condition character-decoding-error (character-coding-error)
 105   ((octets :initarg :octets :reader character-decoding-error-octets)))
 106 (define-condition stream-encoding-error (stream-error character-encoding-error)
 107   ()
 108   (:report
 109    (lambda (c s)
 110      (let ((stream (stream-error-stream c))
 111            (code (character-encoding-error-code c)))
 112        (format s "~@<encoding error on stream ~S (~S ~S): ~2I~_~
 113                   the character with code ~D cannot be encoded.~@:>"
 114                stream ':external-format (stream-external-format stream)
 115                code)))))
 116 (define-condition stream-decoding-error (stream-error character-decoding-error)
 117   ()
 118   (:report
 119    (lambda (c s)
 120      (let ((stream (stream-error-stream c))
 121            (octets (character-decoding-error-octets c)))
 122        (format s "~@<decoding error on stream ~S (~S ~S): ~2I~_~
 123                   the octet sequence ~S cannot be decoded.~@:>"
 124                stream ':external-format (stream-external-format stream)
 125                octets)))))
 126
 127 (define-condition c-string-encoding-error (character-encoding-error)
 128   ((external-format :initarg :external-format :reader c-string-encoding-error-external-format))
 129   (:report
 130    (lambda (c s)
 131      (format s "~@<c-string encoding error (:external-format ~S): ~2I~_~
 132                   the character with code ~D cannot be encoded.~@:>"
 133                (c-string-encoding-error-external-format c)
 134                (character-encoding-error-code c)))))
 135
 136 (define-condition c-string-decoding-error (character-decoding-error)
 137   ((external-format :initarg :external-format :reader c-string-decoding-error-external-format))
 138   (:report
 139    (lambda (c s)
 140      (format s "~@<c-string decoding error (:external-format ~S): ~2I~_~
 141                   the octet sequence ~S cannot be decoded.~@:>"
 142              (c-string-decoding-error-external-format c)
 143              (character-decoding-error-octets c)))))
 144
 145 (define-condition control-stack-exhausted (storage-condition)
 146   ()
 147   (:report
 148     (lambda (condition stream)
 149       (declare (ignore condition))
 150       (format stream
 151              "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."))))
 152
 153 (define-condition heap-exhausted-error (storage-condition)
 154   ()
 155   (:report
 156    (lambda (condition stream)
 157      (declare (special *heap-exhausted-error-available-bytes*
 158                        *heap-exhausted-error-requested-bytes*))
 159      ;; See comments in interr.lisp -- there is a method to this madness.
 160      (if (and (boundp '*heap-exhausted-error-available-bytes*)
 161               (boundp '*heap-exhausted-error-requested-bytes*))
 162          (format stream
 163                  "Heap exhausted: ~D bytes available, ~D requested. PROCEED WITH CAUTION!"
 164                  *heap-exhausted-error-available-bytes*
 165                  *heap-exhausted-error-requested-bytes*)
 166          (print-unreadable-object (condition stream))))))
 167
 168 (define-condition system-condition (condition)
 169   ((address :initarg :address :reader system-condition-address :initform nil)
 170    (context :initarg :context :reader system-condition-context :initform nil)))
 171
 172 (define-condition memory-fault-error (system-condition error) ()
 173   (:report
 174    (lambda (condition stream)
 175      (format stream "Unhandled memory fault at #x~X."
 176              (system-condition-address condition)))))
 177
 178 (define-condition breakpoint-error (system-condition error) ()
 179   (:report
 180    (lambda (condition stream)
 181      (format stream "Unhandled breakpoint/trap at #x~X."
 182              (system-condition-address condition)))))
 183
 184 (define-condition interactive-interrupt (system-condition serious-condition) ()
 185   (:report
 186    (lambda (condition stream)
 187      (format stream "Interactive interrupt at #x~X."
 188              (system-condition-address condition)))))