| blob | 3f487d33ebd4055ff28ad88547f822bb14558c6e |
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
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.
16 ;;; a utility for SIGNAL, ERROR, CERROR, WARN, COMPILER-NOTIFY and
17 ;;; INVOKE-DEBUGGER: Parse the hairy argument conventions into a
18 ;;; single argument that's directly usable by all the other routines.
25 ;; An invalid layout will drop into the (MAKE-CONDITION) branch
26 ;; which rightly fails because ALLOCATE-CONDITION asserts that
27 ;; the first argument is a condition-designator, which it won't be.
31 'simple-type-error
35 when giving ~S to ~S."
37 datum)
40 :format-control datum
45 ;;; This condition inherits from the hosts's classes when compiling
46 ;;; the cross-compiler and the target's when cross-compiling.
52 \f
53 ;;;; HANDLER-BIND
58 ;; Type specifiers in BINDINGS which name classoids are parsed
59 ;; into the classoid, otherwise are translated local TYPEP wrappers.
60 ;;
61 ;; As a further optimization, it is possible to eliminate some runtime
62 ;; consing (which is a speed win if not a space win, since it's dx already)
63 ;; in special cases such as (HANDLER-BIND ((WARNING #'MUFFLE-WARNING)) ...).
64 ;; If all bindings are optimizable, then the runtime cost of making them
65 ;; is one dx cons cell for the whole cluster.
66 ;; Otherwise it takes 1+2N cons cells where N is the number of bindings.
67 ;;
70 ;; If possible, render HANDLER as a load-time constant so that
71 ;; consing the test and handler is also load-time constant.
76 ;; The CLHS writeup of HANDLER-BIND says "Exceptional Situations: None."
77 ;; which might suggest that it's not an error if #'HANDLER is un-fboundp
78 ;; on entering the body, but we should check in safe code.
81 ;; This takes care of CONTINUE,ABORT,MUFFLE-WARNING.
82 ;; #' will be evaluated in the null environment.
84 t))
87 ;; Referencing #'F is enough to get a compile-time warning about unknown
88 ;; functions, but the use itself is flushable, so employ SAFE-FDEFN-FUN.
96 t))))
102 ;; If the resultant list is (LIST (L-T-V ...) (L-T-V ...) ...)
103 ;; then pull the L-T-V outside.
105 items)
116 ;; Simplify a singleton AND or OR.
121 ;; Compute the test expression
123 ;; Every signal is necesarily a CONDITION, so
124 ;; whether you wrote T or CONDITION, this is
125 ;; always an eligible handler.
128 ;; (SATISFIES F) => #'F but never a local definition of F.
129 ;; The predicate is used only if needed - it's not an error if not
130 ;; fboundp (though dangerously stupid) - so reference #'F for the
131 ;; compiler to see the use of the name. But (KLUDGE): since the
132 ;; ref is to force a compile-time effect, the interpreter should not
133 ;; see that form, because there is no way for it to perform an
134 ;; unsafe ref, and it wouldn't signal a style-warning anyway.
136 ;; FIXME: if you've locally flet NAME (why would you do that?)
137 ;; then this does not notice the use of the global function.
142 ;; It's debatable whether we need to go through
143 ;; a classoid-cell instead of just using
144 ;; load-time-value on FIND-CLASS, but the extra
145 ;; indirection is safer, and no slower than
146 ;; what TYPEP does.
152 ;; If the supplied handler is spelled (LAMBDA ...) or
153 ;; #'(LAMBDA ...), then insert a declaration to elide
154 ;; arg checking.
155 ;;
156 ;; KLUDGE: This should really be done in a cleaner way.
162 handler))))
169 handler))))))))
178 "(HANDLER-BIND ( {(type handler)}* ) body)
180 Executes body in a dynamic context where the given handler bindings are in
181 effect. Each handler must take the condition being signalled as an argument.
182 The bindings are searched first to last in the event of a signalled
183 condition."
184 ;; Bindings which meet specific criteria can be established with
185 ;; slightly less runtime overhead than in general.
186 ;; To allow the optimization, TYPE must be either be (SATISFIES P)
187 ;; or a symbol naming a condition class at compile time,
188 ;; and HANDLER must be a global function specified as either 'F or #'F.
191 ;; Need to catch FP errors here!
194 ;;;; HANDLER-CASE and IGNORE-ERRORS.
196 "(HANDLER-CASE form { (type ([var]) body) }* )
198 Execute FORM in a context with handlers established for the condition types. A
199 peculiar property allows type to be :NO-ERROR. If such a clause occurs, and
200 form returns normally, all its values are passed to this clause as if by
201 MULTIPLE-VALUE-CALL. The :NO-ERROR clause accepts more than one var
202 specification."
223 ll))
228 ,@declarations
230 local-funs))
232 cases)))
244 annotated-cases)
257 body)))
260 ;; Need to catch FP errors here!
269 "Execute FORMS handling ERROR conditions, returning the result of the last
270 form, or (VALUES NIL the-ERROR-that-was-caught) if an ERROR was handled."
274 ;;; Condition slot access - needs DYNAMIC-SPACE-OBJ-P which needs misc-aliens
275 ;;; which isn't available in target-error.
276 #-sb-xc-host
279 ;; Force new conses to the heap if instance is arena-allocated
281 alist
294 ;; Shared code for CONDITION-SLOT-VALUE and CONDITION-SLOT-BOUNDP.
295 ;; First look for a slot with :CLASS allocation
303 ;; find the slot definition or else signal an error
315 ;; This is a stupid argument order. Shouldn't NEW-VALUE be first ?
322 ;; Apparently this does not care that there might not exist a slot named NAME
323 ;; in the class, at least in this function. It seems to be handled
324 ;; at a higher level of the slot access protocol.
338 value)))