mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 14:21:10 +02:00
Code Activity

print the error more nicely when we enter the debugger

Browse source 
* module/system/vm/debug.scm (debug-pre-unwind-handler): Nicer printing
  of the error.
This commit is contained in:
Andy Wingo 2010-01-09 20:31:35 +01:00
parent 8217c9251a
commit 391d29029d
1 changed files with 10 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

15
module/system/vm/debug.scm
View file

@ -19,6 +19,7 @@
;;; Code: ;;; Code:
(define-module (system vm debug) (define-module (system vm debug)
#:use-module (system base pmatch)
#:use-module (system base syntax) #:use-module (system base syntax)
#:use-module (system vm vm) #:use-module (system vm vm)
#:use-module (system vm frame) #:use-module (system vm frame)
@ -366,10 +367,14 @@ With an argument, select a frame by index, then show it."
;; (state associated with vm ?) ;; (state associated with vm ?)
(define (debug-pre-unwind-handler key . args) (define (debug-pre-unwind-handler key . args)
;; herald (let ((stack (make-stack #t)))
(format #t "Throw to key `~a' with args `~s'. (pmatch args
Entering the debugger. Type `bt' for a backtrace or `c' to continue. ((,subr ,msg ,args . ,rest)
" key args) (format #t "Throw to key `~a':\n" key)
(run-debugger (stack-ref (make-stack #t) 1)) (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) (save-stack 1)
(apply throw key args)) (apply throw key args))