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

Fix frame printing in the debugger.

Browse source 
* module/system/vm/debug.scm (location-string): New procedure.
  (print-frames): Use it.  This fixes cases where LINE is #f and makes a
  distinction between FILE = stdin and FILE is unknown.
This commit is contained in:
Ludovic Courtès 2010-01-08 16:12:12 +01:00
parent 795ab688ee
commit a589525d4e
1 changed files with 14 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1,6 +1,6 @@
;;; Guile VM debugging facilities ;;; Guile VM debugging facilities
;;; Copyright (C) 2001, 2009 Free Software Foundation, Inc. ;;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
;;; ;;;
;;; This library is free software; you can redistribute it and/or ;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public ;;; modify it under the terms of the GNU Lesser General Public
@ -109,6 +109,13 @@
out out
(lp (frame-previous frame) (cons frame out) (1- count))))))) (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)) (define* (print-frames frames #:optional (port (current-output-port))
#:key (start-index (1- (length frames))) (width 72) #:key (start-index (1- (length frames))) (width 72)
(full? #f)) (full? #f))
@ -116,12 +123,14 @@
(if (pair? frames) (if (pair? frames)
(let* ((frame (car frames)) (let* ((frame (car frames))
(source (frame-source frame)) (source (frame-source frame))
(file (and=> source source:file)) (file (and source
(line (and=> source source:line))) (or (source:file source) "<stdin>")))
(line (and=> source source:line))
(loc (location-string file line)))
(if (not (equal? file last-file)) (if (not (equal? file last-file))
(format port "~&In ~a:~&" (or file "current input"))) (format port "~&In ~a:~&" (or file "current input")))
(format port "~:[~5_~;~5d~]:~3d ~v:@y~%" line line i (format port "~a:~3d ~v:@y~%"
width (frame-call-representation frame)) loc i width (frame-call-representation frame))
(if full? (if full?
(print-locals frame #:width width (print-locals frame #:width width
#:per-line-prefix " ")) #:per-line-prefix " "))