From 56658166b254d901670952bb183310063c148d3c Mon Sep 17 00:00:00 2001
From: Neil Jerram <neil@ossau.uklinux.net>
Date: Sat, 4 Feb 2006 14:36:06 +0000
Subject: [PATCH] * stack-catch.scm (stack-catch): Use catch pre-unwind handler
 instead of lazy-catch.

* boot-9.scm (error-catching-loop): Use catch pre-unwind handler
instead of lazy-catch.
---
 ice-9/ChangeLog       |  8 ++++++
 ice-9/boot-9.scm      | 57 ++++++++++++++++++++-----------------------
 ice-9/stack-catch.scm | 10 +++-----
 3 files changed, 38 insertions(+), 37 deletions(-)

diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index 25124c895..f50277983 100644
--- a/ice-9/ChangeLog
+++ b/ice-9/ChangeLog
@@ -1,3 +1,11 @@
+2006-02-04  Neil Jerram  <neil@ossau.uklinux.net>
+
+	* stack-catch.scm (stack-catch): Use catch pre-unwind handler
+	instead of lazy-catch.
+
+	* boot-9.scm (error-catching-loop): Use catch pre-unwind handler
+	instead of lazy-catch.
+
 2006-02-01  Ludovic Courtès  <ludovic.courtes@laas.fr>
 
         * deprecated.scm (make-uniform-array): Fill the returned vector with
diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index dd8ac4503..17826a096 100644
--- a/ice-9/boot-9.scm
+++ b/ice-9/boot-9.scm
@@ -2353,36 +2353,20 @@
 	     (catch #t
 
 		    (lambda ()
-		      (lazy-catch #t
-				  (lambda ()
-				    (call-with-unblocked-asyncs
-				     (lambda ()
-				       (with-traps
-					(lambda ()
-					  (first)
-
-					  ;; This line is needed because mark
-					  ;; doesn't do closures quite right.
-					  ;; Unreferenced locals should be
-					  ;; collected.
-					  ;;
-					  (set! first #f)
-					  (let loop ((v (thunk)))
-					    (loop (thunk)))
-					  #f)))))
-
-				  ;; Note that having just
-				  ;; `lazy-handler-dispatch' here is
-				  ;; connected with the mechanism that
-				  ;; produces a nice backtrace upon
-				  ;; error.  If, for example, this is
-				  ;; replaced with (lambda args (apply
-				  ;; lazy-handler-dispatch args)), the
-				  ;; stack cutting (in save-stack)
-				  ;; goes wrong and ends up saving no
-				  ;; stack at all, so there is no
-				  ;; backtrace.
-				  lazy-handler-dispatch))
+		      (call-with-unblocked-asyncs
+		       (lambda ()
+			 (with-traps
+			  (lambda ()
+			    (first)
+
+			    ;; This line is needed because mark
+			    ;; doesn't do closures quite right.
+			    ;; Unreferenced locals should be
+			    ;; collected.
+			    (set! first #f)
+			    (let loop ((v (thunk)))
+			      (loop (thunk)))
+			    #f)))))
 
 		    (lambda (key . args)
 		      (case key
@@ -2427,7 +2411,18 @@
 			   (cond ((= (length args) 4)
 				  (apply handle-system-error key args))
 				 (else
-				  (apply bad-throw key args))))))))))
+				  (apply bad-throw key args)))))))
+
+		    ;; Note that having just `lazy-handler-dispatch'
+		    ;; here is connected with the mechanism that
+		    ;; produces a nice backtrace upon error.  If, for
+		    ;; example, this is replaced with (lambda args
+		    ;; (apply lazy-handler-dispatch args)), the stack
+		    ;; cutting (in save-stack) goes wrong and ends up
+		    ;; saving no stack at all, so there is no
+		    ;; backtrace.
+		    lazy-handler-dispatch)))
+
 	(if next (loop next) status)))
     (set! set-batch-mode?! (lambda (arg)
 			     (cond (arg
diff --git a/ice-9/stack-catch.scm b/ice-9/stack-catch.scm
index 3d3b963f6..a706727f8 100644
--- a/ice-9/stack-catch.scm
+++ b/ice-9/stack-catch.scm
@@ -27,7 +27,7 @@ current stack state in the @var{the-last-stack} fluid, for the purpose
 of debugging or re-throwing of an error.  If thunk throws to the
 symbol @var{key}, then @var{handler} is invoked this way:\n
 @example
-(handler key args ...)
+ (handler key args ...)
 @end example\n
 @var{key} is a symbol or #t.\n
 @var{thunk} takes no arguments.  If @var{thunk} returns normally, that
@@ -38,8 +38,6 @@ up the call chain is invoked.\n
 If the key is @code{#t}, then a throw to @emph{any} symbol will match
 this call to @code{catch}."
   (catch key
-	 (lambda ()
-	   (lazy-catch key
-		       thunk
-		       lazy-handler-dispatch))
-	 handler))
+	 thunk
+	 handler
+	 lazy-handler-dispatch))
-- 
2.20.1