[Guile-commits] GNU Guile branch, master, updated. release_1-9-6-58-g0c2a05c

[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=0c2a05c3213da8b1269af37d65af3f8bffdb01c2

The branch, master has been updated
       via  0c2a05c3213da8b1269af37d65af3f8bffdb01c2 (commit)
       via  7abb7efd319526bb2260fdcc35440a31dfd5cf51 (commit)
       via  9274c3dd4058b3f63ba97570fc2f1598debbc03d (commit)
       via  2d8c757cf10a22ba708b44e6305f4dbae29b7297 (commit)
      from  1c5e812258da4b002d309f969d722c86004ecf94 (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 0c2a05c3213da8b1269af37d65af3f8bffdb01c2
Author: Andy Wingo <address@hidden>
Date:   Tue Dec 29 21:19:05 2009 +0100

    debugger's backtrace implemented in scheme
    
    * module/system/vm/debug.scm (print-locals): Factor out to a function.
      (collect-frames, print-frames): Implement the guts of `backtrace' in
      Scheme.
      (debugger-repl): Add #:width and #:full? options to `backtrace'.
      Backtrace uses the backtrace code implemented in scheme.

commit 7abb7efd319526bb2260fdcc35440a31dfd5cf51
Author: Andy Wingo <address@hidden>
Date:   Tue Dec 29 21:17:07 2009 +0100

    frames.c no longer exports frame-source -- frame.scm does so already
    
    * libguile/frames.c (scm_frame_source): No longer exported to Scheme
      via init's call to scm_init_frames; in fact just calls the Scheme
      version. Perhaps this function is on its way out, though :)

commit 9274c3dd4058b3f63ba97570fc2f1598debbc03d
Author: Andy Wingo <address@hidden>
Date:   Tue Dec 29 21:15:08 2009 +0100

    ~:@y allows for truncation to an absolute maximum width
    
    * module/ice-9/format.scm (format): Allow ~:@y to interpret the width as
      the maximum width, inclusive of whatever else has already been output.
    * doc/ref/misc-modules.texi (Formatted Output): Document this.

commit 2d8c757cf10a22ba708b44e6305f4dbae29b7297
Author: Andy Wingo <address@hidden>
Date:   Tue Dec 29 14:35:10 2009 +0100

    integers at debugger select frames
    
    * module/system/vm/debug.scm (debugger-repl): Fix implementation of
      frame-at-index. Allow integers as commands, as a shorthand for "frame
      N".

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

Summary of changes:
 doc/ref/misc-modules.texi  |    5 +++
 libguile/frames.c          |   21 ++++-------
 module/ice-9/format.scm    |   16 +++++++--
 module/system/vm/debug.scm |   84 +++++++++++++++++++++++++++++++++----------
 4 files changed, 89 insertions(+), 37 deletions(-)

diff --git a/doc/ref/misc-modules.texi b/doc/ref/misc-modules.texi
index 1449292..a6bb6c3 100644
--- a/doc/ref/misc-modules.texi
+++ b/doc/ref/misc-modules.texi
@@ -648,6 +648,11 @@ necessary.
 within @var{width} columns (79 by default), on a single line. The
 output will be truncated if necessary.
 
address@hidden:@@y} is like @nicode{~@@y}, except the @var{width} parameter
+is interpreted to be the maximum column to which to output. That is to
+say, if you are at column 10, and @nicode{~60:@@y} is seen, the datum
+will be truncated to 50 columns.
+
 @item @nicode{~?}
 @itemx @nicode{~k}
 Sub-format.  No parameters.
diff --git a/libguile/frames.c b/libguile/frames.c
index 5d390ab..5077d8e 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -97,24 +97,17 @@ SCM_DEFINE (scm_frame_arguments, "frame-arguments", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_frame_source, "frame-source", 1, 0, 0,
-           (SCM frame),
-           "")
-#define FUNC_NAME s_scm_frame_source
+SCM
+scm_frame_source (SCM frame)
 {
-  SCM *fp;
-  struct scm_objcode *bp;
+  static SCM var = SCM_BOOL_F;
   
-  SCM_VALIDATE_VM_FRAME (1, frame);
-
-  fp = SCM_VM_FRAME_FP (frame);
-  bp = SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp));
+  if (scm_is_false (var))
+    var = scm_c_module_lookup (scm_c_resolve_module ("system vm frame"),
+                               "frame-source");
 
-  return scm_c_program_source (SCM_FRAME_PROGRAM (fp),
-                               SCM_VM_FRAME_IP (frame)
-                              - SCM_C_OBJCODE_BASE (bp));
+  return scm_call_1 (SCM_VARIABLE_REF (var), frame);
 }
-#undef FUNC_NAME
 
 /* The number of locals would be a simple thing to compute, if it weren't for
    the presence of not-yet-active frames on the stack. So we have a cheap
diff --git a/module/ice-9/format.scm b/module/ice-9/format.scm
index 2d12dbf..133f8e4 100644
--- a/module/ice-9/format.scm
+++ b/module/ice-9/format.scm
@@ -487,13 +487,23 @@
                                         (car params)
                                         79)))
                          (case modifier
-                           ((colon colon-at)
-                            (format:error "illegal modifier in ~~?"))
                            ((at)
                             (format:out-str
                              (with-output-to-string 
                                (lambda ()
-                                 (truncated-print (next-arg) #:width width)))))
+                                 (truncated-print (next-arg)
+                                                  #:width width)))))
+                           ((colon-at)
+                            (format:out-str
+                             (with-output-to-string 
+                               (lambda ()
+                                 (truncated-print (next-arg)
+                                                  #:width
+                                                  (max (- width
+                                                          format:output-col)
+                                                       1))))))
+                           ((colon)
+                            (format:error "illegal modifier in ~~?"))
                            (else
                             (pretty-print (next-arg) format:port
                                           #:width width)
diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm
index be232c4..c2175c5 100644
--- a/module/system/vm/debug.scm
+++ b/module/system/vm/debug.scm
@@ -72,6 +72,62 @@
         (args (cons tok out) (next))))))
   (cmd (next)))
 
+(define* (print-locals frame #:optional (port (current-output-port))
+                       #:key (width 72) (per-line-prefix ""))
+  (let ((bindings (frame-bindings frame)))
+    (cond
+     ((null? bindings)
+      (format port "~aNo local variables.~%" per-line-prefix))
+     (else
+      (format port "~aLocal variables:~%" per-line-prefix)
+      (for-each
+       (lambda (binding)
+         (format port "~a~4d ~a~:[~; (boxed)~] = ~v:@y\n"
+                 per-line-prefix
+                 (binding:index binding)
+                 (binding:name binding)
+                 (binding:boxed? binding)
+                 width
+                 (let ((x (frame-local-ref frame (binding:index binding))))
+                   (if (binding:boxed? binding)
+                       (variable-ref x)
+                       x))))
+       (frame-bindings frame))))))
+
+(define* (collect-frames frame #:key count)
+  (cond
+   ((not count)
+    (let lp ((frame frame) (out '()))
+      (if (not frame)
+          out
+          (lp (frame-previous frame) (cons frame out)))))
+   ;; should also have a from-end option, either via negative count or
+   ;; another kwarg
+   ((>= count 0)
+    (let lp ((frame frame) (out '()) (count count))
+      (if (or (not frame) (zero? count))
+          out
+          (lp (frame-previous frame) (cons frame out) (1- count)))))))
+
+(define* (print-frames frames #:optional (port (current-output-port))
+                       #:key (start-index (1- (length frames))) (width 72)
+                       (full? #f))
+  (let lp ((frames frames) (i start-index) (last-file ""))
+    (if (pair? frames)
+        (let* ((frame (car frames))
+               (source (frame-source frame))
+               (file (and=> source source:file))
+               (line (and=> source source:line)))
+          (if (not (equal? file last-file))
+              (format port "~&In ~a:~&" (or file "current input")))
+          (format port "~:[~5_~;~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)))))
+
+
 ;;;
 ;;; Debugger
 ;;;
@@ -113,7 +169,7 @@
         (cond
          ((not walk) #f)
          ((zero? idx) walk)
-         (else (lp (1+ idx) (frame-previous walk))))))
+         (else (lp (1- idx) (frame-previous walk))))))
     (define (show-frame)
       ;;      #2  0x009600e0 in do_std_select (args=0xbfffd9e0) at 
threads.c:1668
       ;;      1668         select (select_args->nfds,
@@ -150,9 +206,12 @@
                            (unspecified? (car vals)))))
             (for-each print vals)))
 
-      (define-command ((commands backtrace bt) #:optional count)
+      (define-command ((commands backtrace bt) #:optional count
+                       #:key (width 72) full?)
         "Print a backtrace of all stack frames, or innermost COUNT frames."
-        (display-backtrace (make-stack top) (current-output-port) #f count))
+        (print-frames (collect-frames top #:count count)
+                      #:width width
+                      #:full? full?))
       
       (define-command ((commands up) #:optional (count 1))
         "Select and print stack frames that called this one.
@@ -210,17 +269,7 @@ With an argument, select a frame by index, then show it."
       
       (define-command ((commands locals))
         "Show locally-bound variables in the selected frame."
-        (for-each
-         (lambda (binding)
-           (format #t "~4d: ~a~:[~; (boxed)~]: address@hidden"
-                   (binding:index binding)
-                   (binding:name binding)
-                   (binding:boxed? binding)
-                   (let ((x (frame-local-ref cur (binding:index binding))))
-                     (if (binding:boxed? binding)
-                         (variable-ref x)
-                         x))))
-         (frame-bindings cur)))
+        (print-locals cur))
       
       (define-command ((commands quit q continue cont c))
         "Quit the debugger and let the program continue executing."
@@ -272,10 +321,8 @@ With an argument, select a frame by index, then show it."
                     (format (current-error-port)
                             "Invalid arguments to ~a. Try `help ~a'.~%"
                             (procedure-name proc) (procedure-name proc)))))))
-         
-         #;
          ((and (integer? cmd) (exact? cmd))
-          (nth cmd))
+          (frame cmd))
          ((eof-object? cmd)
           (newline)
           (throw 'quit))
@@ -301,9 +348,6 @@ With an argument, select a frame by index, then show it."
 ;; things this debugger should do:
 ;;
 ;; eval expression in context of frame
-;; up/down stack for inspecting
-;; print procedure and args for frame
-;; print local variables for frame
 ;; set local variable in frame
 ;; display backtrace
 ;; display full backtrace


hooks/post-receive
-- 
GNU Guile