From 1351c2dba5ce54aeeae41cb2322ad39cd29510b0 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Tue, 26 May 2009 21:47:45 +0200
Subject: [PATCH] fix backtraces with compiled boot-9

* module/ice-9/boot-9.scm (default-pre-unwind-handler): Since we were
  tail-called by pre-unwind-handler-dispatch, we can't use
  pre-unwind-handler-dispatch as a narrowing argument. Instead just
  narrow by one frame.
  (pre-unwind-handler-dispatch): Deprecate.
  (error-catching-loop): Remove crack comment and code, and just use
  default-pre-unwind-handler as our pre-unwind handler.

* module/ice-9/stack-catch.scm (stack-catch):
* module/system/repl/repl.scm (call-with-backtrace): Use
  default-pre-unwind-handler directly.
---
 module/ice-9/boot-9.scm      | 17 +++++------------
 module/ice-9/stack-catch.scm |  2 +-
 module/system/repl/repl.scm  |  2 +-
 3 files changed, 7 insertions(+), 14 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index fa05de6d1..26ce1a905 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2443,11 +2443,12 @@ module '(ice-9 q) '(make-q q-length))}."
 (define (set-repl-prompt! v) (set! scm-repl-prompt v))
 
 (define (default-pre-unwind-handler key . args)
-  (save-stack pre-unwind-handler-dispatch)
+  (save-stack 1)
   (apply throw key args))
 
-(define (pre-unwind-handler-dispatch key . args)
-  (apply default-pre-unwind-handler key args))
+(begin-deprecated
+ (define (pre-unwind-handler-dispatch key . args)
+   (apply default-pre-unwind-handler key args)))
 
 (define abort-hook (make-hook))
 
@@ -2524,15 +2525,7 @@ module '(ice-9 q) '(make-q q-length))}."
 				 (else
 				  (apply bad-throw key args)))))))
 
-		    ;; Note that having just `pre-unwind-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 pre-unwind-handler-dispatch args)), the stack
-		    ;; cutting (in save-stack) goes wrong and ends up
-		    ;; saving no stack at all, so there is no
-		    ;; backtrace.
-		    pre-unwind-handler-dispatch)))
+                    default-pre-unwind-handler)))
 
 	(if next (loop next) status)))
     (set! set-batch-mode?! (lambda (arg)
diff --git a/module/ice-9/stack-catch.scm b/module/ice-9/stack-catch.scm
index 2f4b3d145..a54267617 100644
--- a/module/ice-9/stack-catch.scm
+++ b/module/ice-9/stack-catch.scm
@@ -40,4 +40,4 @@ this call to @code{catch}."
   (catch key
 	 thunk
 	 handler
-	 pre-unwind-handler-dispatch))
+	 default-pre-unwind-handler))
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index ebf2b93d4..0a06e3dd0 100644
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -89,7 +89,7 @@
   (catch #t
          (lambda () (%start-stack #t thunk))
          default-catch-handler
-         pre-unwind-handler-dispatch))
+         default-pre-unwind-handler))
 
 (define-macro (with-backtrace form)
   `(call-with-backtrace (lambda () ,form)))