/[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.2 by camm, Mon Oct 14 05:24:42 2002 UTC revision 1.3 by camm, Tue Oct 22 21:45:12 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)  ;(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 26  Line 26 
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))
# Line 129  Line 129 
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))

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

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