Skip to content
Snippets Groups Projects
Commit 5011a30d authored by dtc's avatar dtc
Browse files

Switch the implementation of handler-case to use tagbody rather than

catch/throw, as the compiler lossage in the closure over tags has been fixed.
parent 0aec8f46
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.54 1999/01/09 11:12:17 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.55 2000/07/11 04:19:45 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -978,6 +978,10 @@ ...@@ -978,6 +978,10 @@
;;;; HANDLER-CASE and IGNORE-ERRORS. ;;;; HANDLER-CASE and IGNORE-ERRORS.
#|
;;; Version used in older versions of CMUCL which had lossage closing over
;;; tags.
;;;
(defmacro handler-case (form &rest cases) (defmacro handler-case (form &rest cases)
"(HANDLER-CASE form "(HANDLER-CASE form
{ (type ([var]) body) }* ) { (type ([var]) body) }* )
...@@ -1005,7 +1009,7 @@ ...@@ -1005,7 +1009,7 @@
`(let ((,outer-tag (cons nil nil)) `(let ((,outer-tag (cons nil nil))
(,inner-tag (cons nil nil)) (,inner-tag (cons nil nil))
,var ,tag-var) ,var ,tag-var)
,var ;ignoreable (declare (ignorable ,var))
(catch ,outer-tag (catch ,outer-tag
(catch ,inner-tag (catch ,inner-tag
(throw ,outer-tag (throw ,outer-tag
...@@ -1031,10 +1035,11 @@ ...@@ -1031,10 +1035,11 @@
,@body)) ,@body))
body)))) body))))
annotated-cases)))))))) annotated-cases))))))))
#| |#
This macro doesn't work in our system due to lossage in closing over tags.
The previous version sets up unique run-time tags.
;;; This macro doesn't work in older version of CMUCL system due to lossage
;;; in closing over tags. The previous version sets up unique run-time tags.
;;;
(defmacro handler-case (form &rest cases) (defmacro handler-case (form &rest cases)
"(HANDLER-CASE form "(HANDLER-CASE form
{ (type ([var]) body) }* ) { (type ([var]) body) }* )
...@@ -1059,7 +1064,7 @@ The previous version sets up unique run-time tags. ...@@ -1059,7 +1064,7 @@ The previous version sets up unique run-time tags.
cases))) cases)))
`(block ,tag `(block ,tag
(let ((,var nil)) (let ((,var nil))
,var ;ignorable (declare (ignorable ,var))
(tagbody (tagbody
(handler-bind (handler-bind
,(mapcar #'(lambda (annotated-case) ,(mapcar #'(lambda (annotated-case)
...@@ -1086,7 +1091,6 @@ The previous version sets up unique run-time tags. ...@@ -1086,7 +1091,6 @@ The previous version sets up unique run-time tags.
(t (t
`(progn ,@body))))))) `(progn ,@body)))))))
annotated-cases)))))))) annotated-cases))))))))
|#
(defmacro ignore-errors (&rest forms) (defmacro ignore-errors (&rest forms)
"Executes forms after establishing a handler for all error conditions that "Executes forms after establishing a handler for all error conditions that
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment