src/code/condition-boot.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; This software is derived from the CMU CL system, which was
   5 ;;;; written at Carnegie Mellon University and released into the
   6 ;;;; public domain. The software is in the public domain and is
   7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
   8 ;;;; files for more information.
   9
  10 (in-package "SB!KERNEL")
  11
  12 (!defstruct-with-alternate-metaclass condition
  13   :slot-names (actual-initargs assigned-slots)
  14   :boa-constructor %make-condition-object
  15   :superclass-name t
  16   :metaclass-name condition-classoid
  17   :metaclass-constructor make-condition-classoid
  18   :dd-type structure)
  19
  20 ;;; Define just enough condition-classoids to get TYPEP
  21 ;;; to optimize into classoid-typep.
  22 (macrolet ((def (name direct-supers &rest inherits)
  23              `(eval-when (:compile-toplevel :execute)
  24                 ;; INHERITS is a list of symbols, unevaluated,
  25                 ;; excluding T which is assumed.
  26                 (%compiler-define-condition
  27                  ',name ',direct-supers
  28                  ,(make-layout
  29                    :classoid (make-undefined-classoid name)
  30                    :inherits (map 'vector #'find-layout (cons t inherits))
  31                    :depthoid -1
  32                    :length 3)
  33                  nil nil))))
  34   ;; These are grotesquely OAOO-violating, but on the bright side,
  35   ;; compilation will fail if the subsequent real definition differs,
  36   ;; so there's a built-in safety net.
  37   ;; As has been suggested in 'cross-condition', a DEF!CONDITION macro
  38   ;; might help, but still that's possibly not a complete solution,
  39   ;; because DEBUG-CONDITION is defined in a file with the :NOT-HOST flag.
  40   (def warning (condition) condition)
  41   (def style-warning (warning) condition warning)
  42   (def compiler-note (condition) condition)
  43   (def parse-unknown-type (condition) condition)
  44   (def parse-deprecated-type (condition) condition)
  45   (def serious-condition (condition) condition)
  46   (def error (serious-condition) condition serious-condition)
  47   (def sb!di:debug-condition (serious-condition) condition serious-condition)
  48   (def stream-error (error) condition serious-condition error)
  49   (def reference-condition (condition) condition)
  50   )