summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ice-9/ChangeLog8
-rw-r--r--ice-9/boot-9.scm57
-rw-r--r--ice-9/stack-catch.scm10
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))