[Guile-commits] GNU Guile branch, master, updated. release_1-9-6-110-g391d290

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=391d29029d69704bc6bd541d80209532e582c3c0

The branch, master has been updated
       via  391d29029d69704bc6bd541d80209532e582c3c0 (commit)
       via  8217c9251acef6f09fa04e1ead5eaa69b6909284 (commit)
      from  0af34a3f833a3e90edc18223b91fcafebc786275 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 391d29029d69704bc6bd541d80209532e582c3c0
Author: Andy Wingo <address@hidden>
Date:   Sat Jan 9 20:31:35 2010 +0100

    print the error more nicely when we enter the debugger
    
    * module/system/vm/debug.scm (debug-pre-unwind-handler): Nicer printing
      of the error.

commit 8217c9251acef6f09fa04e1ead5eaa69b6909284
Author: Andy Wingo <address@hidden>
Date:   Sat Jan 9 20:21:37 2010 +0100

    make backtraces prettier
    
    * module/system/vm/debug.scm (print-frames): Clean up a bit, reverting
      part of the previous change. (The problem was that in the else branch
      of the conditional, it didn't consume an arg.)
    
      In the future I would like to preserve the clean look of the
      backtraces. It's easier to read that way.

-----------------------------------------------------------------------

Summary of changes:
 module/system/vm/debug.scm |   38 ++++++++++++++++++--------------------
 1 files changed, 18 insertions(+), 20 deletions(-)

diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm
index 1b8afe2..938dca7 100644
--- a/module/system/vm/debug.scm
+++ b/module/system/vm/debug.scm
@@ -19,6 +19,7 @@
 ;;; Code:
 
 (define-module (system vm debug)
+  #:use-module (system base pmatch)
   #:use-module (system base syntax)
   #:use-module (system vm vm)
   #:use-module (system vm frame)
@@ -109,13 +110,6 @@
           out
           (lp (frame-previous frame) (cons frame out) (1- count)))))))
 
-(define (location-string file line)
-  (cond ((and file line)
-         (format #f "~:[~5_~;~5d~]" file line))
-        (file
-         (format #f "~:[~5_~" file))
-        (else "<unknown-location>")))
-
 (define* (print-frames frames #:optional (port (current-output-port))
                        #:key (start-index (1- (length frames))) (width 72)
                        (full? #f))
@@ -124,17 +118,17 @@
         (let* ((frame (car frames))
                (source (frame-source frame))
                (file (and source
-                         (or (source:file source) "<stdin>")))
-               (line (and=> source source:line))
-               (loc  (location-string file line)))
-          (if (not (equal? file last-file))
-              (format port "~&In ~a:~&" (or file "current input")))
-          (format port "~a:~3d ~v:@y~%"
-                  loc i width (frame-call-representation frame))
+                          (or (source:file source)
+                              "current input")))
+               (line (and=> source source:line)))
+          (if (and file (not (equal? file last-file)))
+              (format port "~&In ~a:~&" file))
+          (format port "~:[~*~6_~;~5d:~]~3d ~v:@y~%" line line
+                  i width (frame-call-representation frame))
           (if full?
               (print-locals frame #:width width
                             #:per-line-prefix "     "))
-          (lp (cdr frames) (1- i) file)))))
+          (lp (cdr frames) (1- i) (or file last-file))))))
 
 
 ;;;
@@ -373,10 +367,14 @@ With an argument, select a frame by index, then show it."
 ;; (state associated with vm ?)
 
 (define (debug-pre-unwind-handler key . args)
-  ;; herald
-  (format #t "Throw to key `~a' with args `~s'.
-Entering the debugger. Type `bt' for a backtrace or `c' to continue.
-" key args)
-  (run-debugger (stack-ref (make-stack #t) 1))
+  (let ((stack (make-stack #t)))
+    (pmatch args
+      ((,subr ,msg ,args . ,rest)
+       (format #t "Throw to key `~a':\n" key)
+       (display-error stack (current-output-port) subr msg args rest))
+      (else
+       (format #t "Throw to key `~a' with args `~s'." key args)))
+    (format #t "Entering the debugger. Type `bt' for a backtrace or `c' to 
continue.\n")
+    (run-debugger (stack-ref stack 1)))
   (save-stack 1)
   (apply throw key args))


hooks/post-receive
-- 
GNU Guile