13 |
,@FORMS)) |
,@FORMS)) |
14 |
|
|
15 |
(DEFVAR *BREAK-ON-SIGNALS* NIL) |
(DEFVAR *BREAK-ON-SIGNALS* NIL) |
16 |
|
(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)) |
25 |
(LET ((CLUSTER (POP *HANDLER-CLUSTERS*))) |
(LET ((CLUSTER (POP *HANDLER-CLUSTERS*))) |
26 |
(DOLIST (HANDLER CLUSTER) |
(DOLIST (HANDLER CLUSTER) |
27 |
(WHEN (TYPEP CONDITION (CAR HANDLER)) |
(WHEN (TYPEP CONDITION (CAR HANDLER)) |
28 |
(FUNCALL (CDR HANDLER) CONDITION) |
(progn |
29 |
|
(setf *HANDLER-RESTART-CLUSTERS* *RESTART-CLUSTERS*) |
30 |
|
(FUNCALL (CDR HANDLER) CONDITION) |
31 |
|
(setf *HANDLER-RESTART-CLUSTERS* nil)) |
32 |
(RETURN NIL) ;? |
(RETURN NIL) ;? |
33 |
)))) |
)))) |
34 |
NIL)) |
NIL)) |
128 |
`(RETURN-FROM ,TAG |
`(RETURN-FROM ,TAG |
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*)) |
133 |
,@BODY)) |
,@BODY)) |
134 |
((NOT (CDR BODY)) |
((NOT (CDR BODY)) |
135 |
(CAR BODY)) |
(CAR BODY)) |