/[gcl]/gcl/clcs/handler.lisp
ViewVC logotype

Diff of /gcl/clcs/handler.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1.1.1 by wfs, Mon Dec 6 22:43:55 1999 UTC revision 1.2 by camm, Mon Oct 14 05:24:42 2002 UTC
# Line 13  Line 13 
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))
# Line 24  Line 25 
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))
# Line 124  Line 128 
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))

Legend:
Removed from v.1.1.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26