13 |
,@FORMS)) |
,@FORMS)) |
14 |
|
|
15 |
(DEFVAR *BREAK-ON-SIGNALS* NIL) |
(DEFVAR *BREAK-ON-SIGNALS* NIL) |
16 |
(defvar *HANDLER-RESTART-CLUSTERS* nil) |
;(defvar *HANDLER-RESTART-CLUSTERS* nil) |
17 |
|
|
18 |
(DEFUN SIGNAL (DATUM &REST ARGUMENTS) |
(DEFUN SIGNAL (DATUM &REST ARGUMENTS) |
19 |
(LET ((CONDITION (COERCE-TO-CONDITION DATUM ARGUMENTS 'SIMPLE-CONDITION 'SIGNAL)) |
(LET ((CONDITION (COERCE-TO-CONDITION DATUM ARGUMENTS 'SIMPLE-CONDITION 'SIGNAL)) |
26 |
(DOLIST (HANDLER CLUSTER) |
(DOLIST (HANDLER CLUSTER) |
27 |
(WHEN (TYPEP CONDITION (CAR HANDLER)) |
(WHEN (TYPEP CONDITION (CAR HANDLER)) |
28 |
(progn |
(progn |
29 |
(setf *HANDLER-RESTART-CLUSTERS* *RESTART-CLUSTERS*) |
; (setf *HANDLER-RESTART-CLUSTERS* *RESTART-CLUSTERS*) |
30 |
(FUNCALL (CDR HANDLER) CONDITION) |
(FUNCALL (CDR HANDLER) CONDITION) |
31 |
(setf *HANDLER-RESTART-CLUSTERS* nil)) |
; (setf *HANDLER-RESTART-CLUSTERS* nil)) |
32 |
(RETURN NIL) ;? |
(RETURN NIL) ;? |
33 |
)))) |
)))) |
34 |
NIL)) |
NIL)) |
129 |
,(COND ((CADDR ANNOTATED-CASE) |
,(COND ((CADDR ANNOTATED-CASE) |
130 |
`(LET ((,(CAADDR ANNOTATED-CASE) |
`(LET ((,(CAADDR ANNOTATED-CASE) |
131 |
,VAR) |
,VAR) |
132 |
(*RESTART-CLUSTERS* *HANDLER-RESTART-CLUSTERS*)) |
; (*RESTART-CLUSTERS* *HANDLER-RESTART-CLUSTERS*)) |
133 |
|
) |
134 |
,@BODY)) |
,@BODY)) |
135 |
((NOT (CDR BODY)) |
((NOT (CDR BODY)) |
136 |
(CAR BODY)) |
(CAR BODY)) |