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
5 ;;;; This software is part of the SBCL system. See the README file for
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.
14 (in-package "SB!KERNEL")
16 (define-condition simple-style-warning
(simple-condition style-warning
) ())
18 ;;; not sure this is the right place, but where else?
19 (defun style-warn (format-control &rest format-arguments
)
20 (/show0
"entering STYLE-WARN")
21 (/show format-control format-arguments
)
22 (warn 'simple-style-warning
23 :format-control format-control
24 :format-arguments format-arguments
))
26 (define-condition sb
!kernel
:layout-invalid
(type-error)
29 (lambda (condition stream
)
31 "~@<invalid structure layout: ~
32 ~2I~_A test for class ~4I~_~S ~
33 ~2I~_was passed the obsolete instance ~4I~_~S~:>"
34 (sb!kernel
:class-proper-name
(type-error-expected-type condition
))
35 (type-error-datum condition
)))))
37 (define-condition case-failure
(type-error)
38 ((name :reader case-failure-name
:initarg
:name
)
39 (possibilities :reader case-failure-possibilities
:initarg
:possibilities
))
41 (lambda (condition stream
)
42 (format stream
"~@<~S fell through ~S expression. ~
43 ~:_Wanted one of ~:S.~:>"
44 (type-error-datum condition
)
45 (case-failure-name condition
)
46 (case-failure-possibilities condition
)))))
48 (define-condition simple-control-error
(simple-condition control-error
) ())
49 (define-condition simple-file-error
(simple-condition file-error
) ())
50 (define-condition simple-program-error
(simple-condition program-error
) ())
51 (define-condition simple-stream-error
(simple-condition stream-error
) ())
52 (define-condition simple-parse-error
(simple-condition parse-error
) ())
54 ;;; This condition is signalled whenever we make a UNKNOWN-TYPE so that
55 ;;; compiler warnings can be emitted as appropriate.
56 (define-condition parse-unknown-type
(condition)
57 ((specifier :reader parse-unknown-type-specifier
:initarg
:specifier
)))
59 (define-condition control-stack-exhausted
(storage-condition)
62 (lambda (condition stream
)
64 "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."))))