From 4a5ff5cb15e7ed09115f53be91e0fde7b97368cd Mon Sep 17 00:00:00 2001
From: jjgarcia <jjgarcia>
Date: Sat, 20 Oct 2001 15:57:52 +0000
Subject: [PATCH] A bug in the compiler lead to wrong output for CATCH forms in
 which the tag is not constant.

---
 src/CHANGELOG        |  3 +++
 src/cmp/cmpcatch.lsp | 23 +++++++++++------------
 src/cmp/cmpexit.lsp  |  4 +---
 3 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/src/CHANGELOG b/src/CHANGELOG
index bdbad6ec4..47c78c459 100644
--- a/src/CHANGELOG
+++ b/src/CHANGELOG
@@ -813,6 +813,9 @@ ECLS 0.5
   - The compiler would not restore the value of a special variable which
     is used in MULTIPLE-VALUE-BIND.
 
+  - The compiler produced wrong code for CATCH forms in which the tag
+    is not constant.
+
 * System design and portability:
 
   - Remove function_entry_table.
diff --git a/src/cmp/cmpcatch.lsp b/src/cmp/cmpcatch.lsp
index 67e0a56c6..606439402 100644
--- a/src/cmp/cmpcatch.lsp
+++ b/src/cmp/cmpcatch.lsp
@@ -22,16 +22,17 @@
   (list 'CATCH info tag args))
 
 (defun c2catch (tag body)
-  (let ((*destination* '(PUSH-CATCH-FRAME)))
-    (c2expr* tag))
-  (let ((*unwind-exit* (cons 'FRAME *unwind-exit*)))
-    (unwind-exit 'VALUES)
-    (wt-nl "} else {")
-    (c2expr body)
-    (wt-nl "}")))
-
-(defun set-push-catch-frame (loc)
-  (wt-nl "if (frs_push(FRS_CATCH," loc ")!=0){"))
+  (let* ((*lcl* *lcl*)
+	 (tag-lcl (list 'LCL (next-lcl))))
+    (wt-nl "{ cl_object " tag-lcl ";")
+    (let* ((*destination* tag-lcl))
+      (c2expr* tag))
+    (let* ((*unwind-exit* (cons 'FRAME *unwind-exit*)))
+      (wt-nl "if (frs_push(FRS_CATCH," tag-lcl ")!=0){")
+      (unwind-exit 'VALUES)
+      (wt-nl "} else {")
+      (c2expr body)
+      (wt-nl "}}"))))
 
 (defun c1unwind-protect (args &aux (info (make-info :sp-change t)) form)
   (incf *setjmps*)
@@ -91,5 +92,3 @@
 (setf (get 'UNWIND-PROTECT 'C2) 'c2unwind-protect)
 (setf (get 'THROW 'C1SPECIAL) 'c1throw)
 (setf (get 'THROW 'C2) 'c2throw)
-
-(setf (get 'PUSH-CATCH-FRAME 'SET-LOC) 'set-push-catch-frame)
diff --git a/src/cmp/cmpexit.lsp b/src/cmp/cmpexit.lsp
index 13baafceb..b67c15f89 100644
--- a/src/cmp/cmpexit.lsp
+++ b/src/cmp/cmpexit.lsp
@@ -56,9 +56,7 @@
 			    ;; no need for temporary if we can use
 			    ;; *destination* directly
 			    (consp *destination*)
-			    (member (car *destination*)
-				    '(VAR BIND PUSH-CATCH-FRAME)
-				    :test #'eq))
+			    (member (car *destination*) '(VAR BIND) :test #'eq))
 		       (let* ((*temp* *temp*)
 			      (temp (list 'TEMP (next-temp))))
 			 (let ((*destination* temp))