* 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.

diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index 25124c8..f502779 100644 (file)
--- 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 dd8ac45..17826a0 100644 (file)
--- 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 3d3b963..a706727 100644 (file)
--- 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))