[Guile-commits] GNU Guile branch, master, updated. release_1-9-12-59-g3db15dc

[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=3db15dce0012c5f384fa9b1628b35913aa0b62ba

The branch, master has been updated
       via  3db15dce0012c5f384fa9b1628b35913aa0b62ba (commit)
       via  665196884f6b16b6202c35dcabe0f2303ea6ebdf (commit)
       via  1241f6944bd6743bedbe21323b5907a07ecba4e2 (commit)
       via  957205339a1ff1910e421d7bc43fcdfe6a802b25 (commit)
       via  6263b8722e33ed08b19b95046b881526a68c4dd3 (commit)
       via  abb4b5cbbd38a30a85568a13f98590427ad11bf5 (commit)
      from  25361a80fe3c78456e22a5fb0139d7207d472050 (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 3db15dce0012c5f384fa9b1628b35913aa0b62ba
Author: Andy Wingo <address@hidden>
Date:   Thu Sep 23 17:28:15 2010 +0200

    another trap printing tweak
    
    * module/system/vm/trap-state.scm (add-trap-at-procedure-call!):
      (add-trace-at-procedure-call!): Breakpoint / tracepoint name tweaks.

commit 665196884f6b16b6202c35dcabe0f2303ea6ebdf
Author: Andy Wingo <address@hidden>
Date:   Thu Sep 23 17:26:12 2010 +0200

    list-traps just returns trap identifiers, not names
    
    * module/system/vm/trap-state.scm (list-traps): Just return the integers
      identifying the traps; people can use trap-name to get the names.
    
    * module/system/repl/command.scm (traps): Adapt.

commit 1241f6944bd6743bedbe21323b5907a07ecba4e2
Author: Andy Wingo <address@hidden>
Date:   Thu Sep 23 17:25:30 2010 +0200

    trace printing tweak
    
    * module/system/vm/trap-state.scm (add-trace-at-procedure-call!): Tweak
      to the #:prefix string.

commit 957205339a1ff1910e421d7bc43fcdfe6a802b25
Author: Andy Wingo <address@hidden>
Date:   Thu Sep 23 17:20:57 2010 +0200

    more uniform break / tracepoint printing in repl
    
    * module/system/repl/command.scm (break, tracepoint): In the message,
      use the trap-name.

commit 6263b8722e33ed08b19b95046b881526a68c4dd3
Author: Andy Wingo <address@hidden>
Date:   Thu Sep 23 17:18:50 2010 +0200

    add trap-name procedure
    
    * module/system/vm/trap-state.scm (trap-name): New proc.

commit abb4b5cbbd38a30a85568a13f98590427ad11bf5
Author: Andy Wingo <address@hidden>
Date:   Thu Sep 23 17:17:16 2010 +0200

    tracepoints print their trap number
    
    * module/system/vm/trace.scm (print-application, print-return): Add a
      prefix before the printout.
      (trace-calls-to-procedure, trace-calls-in-procedure): Add prefix
      keyword args.
    
    * module/system/vm/trap-state.scm (add-trace-at-procedure-call!): Give a
      useful prefix for tracepoint printouts.

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

Summary of changes:
 module/system/repl/command.scm  |   10 +++++-----
 module/system/vm/trace.scm      |   30 ++++++++++++++++--------------
 module/system/vm/trap-state.scm |   18 +++++++++++-------
 3 files changed, 32 insertions(+), 26 deletions(-)

diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 4973b91..a052b93 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -578,7 +578,7 @@ Starts a recursive prompt when PROCEDURE is called."
     (if (not (procedure? proc))
         (error "Not a procedure: ~a" proc)
         (let ((idx (add-trap-at-procedure-call! proc)))
-          (format #t "Added breakpoint ~a at ~a.~%" idx proc)))))
+          (format #t "Trap ~a: ~a.~%" idx (trap-name idx))))))
 
 (define-meta-command (tracepoint repl (form))
   "tracepoint PROCEDURE
@@ -590,19 +590,19 @@ called, and its return value(s) when it returns."
     (if (not (procedure? proc))
         (error "Not a procedure: ~a" proc)
         (let ((idx (add-trace-at-procedure-call! proc)))
-          (format #t "Added tracepoint ~a at ~a.~%" idx proc)))))
+          (format #t "Trap ~a: ~a.~%" idx (trap-name idx))))))
 
 (define-meta-command (traps repl)
   "traps
 Show the set of currently attached traps.
 
-Show the set of currently attached traps (breakpoints)."
+Show the set of currently attached traps (breakpoints and tracepoints)."
   (let ((traps (list-traps)))
     (if (null? traps)
-        (format #t "No traps enabled.~%")
+        (format #t "No traps set.~%")
         (for-each (lambda (idx name)
                     (format #t "  ~a: ~a~a~%"
-                            idx name
+                            idx (trap-name idx)
                             (if (trap-enabled? idx) "" " (disabled)")))
                   (map car traps) (map cdr traps)))))
 
diff --git a/module/system/vm/trace.scm b/module/system/vm/trace.scm
index 097e3e8..0c878e3 100644
--- a/module/system/vm/trace.scm
+++ b/module/system/vm/trace.scm
@@ -43,43 +43,45 @@
            (frame-local-ref frame (+ (- len nvalues) i)))
          (iota nvalues))))
   
-(define (print-application frame depth width)
-  (format (current-error-port) "~a~v:@y\n"
-          (make-string depth #\|)
+(define (print-application frame depth width prefix)
+  (format (current-error-port) "~a~a~v:@y\n"
+          prefix (make-string depth #\|)
           (max (- width depth) 1)
           (frame-call-representation frame)))
 
-(define (print-return frame depth width)
+(define (print-return frame depth width prefix)
   (let* ((len (frame-num-locals frame))
          (nvalues (frame-local-ref frame (1- len))))
     (cond
      ((= nvalues 1)
-      (format (current-error-port) "~a~v:@y\n"
-              (make-string depth #\|)
+      (format (current-error-port) "~a~a~v:@y\n"
+              prefix (make-string depth #\|)
               width (frame-local-ref frame (- len 2))))
      (else
       ;; this should work, but there appears to be a bug
       ;; "~a~d values:~:{ ~v:@y~}\n"
-      (format (current-error-port) "~a~d values:~{ ~a~}\n"
-              (make-string depth #\|)
+      (format (current-error-port) "~a ~a~d values:~{ ~a~}\n"
+              prefix (make-string depth #\|)
               nvalues
               (map (lambda (val)
                      (format #f "~v:@y" width val))
                    (frame-return-values frame)))))))
   
-(define* (trace-calls-to-procedure proc #:key (width 80) (vm (the-vm)))
+(define* (trace-calls-to-procedure proc #:key (width 80) (vm (the-vm))
+                                   (prefix "trace: "))
   (define (apply-handler frame depth)
-    (print-application frame depth width))
+    (print-application frame depth width prefix))
   (define (return-handler frame depth)
-    (print-return frame depth width))
+    (print-return frame depth width prefix))
   (trap-calls-to-procedure proc apply-handler return-handler
                            #:vm vm))
 
-(define* (trace-calls-in-procedure proc #:key (width 80) (vm (the-vm)))
+(define* (trace-calls-in-procedure proc #:key (width 80) (vm (the-vm))
+                                   (prefix "trace: "))
   (define (apply-handler frame depth)
-    (print-application frame depth width))
+    (print-application frame depth width prefix))
   (define (return-handler frame depth)
-    (print-return frame depth width))
+    (print-return frame depth width prefix))
   (trap-calls-in-dynamic-extent proc apply-handler return-handler
                                 #:vm vm))
 
diff --git a/module/system/vm/trap-state.scm b/module/system/vm/trap-state.scm
index fea46d2..ca6bb3e 100644
--- a/module/system/vm/trap-state.scm
+++ b/module/system/vm/trap-state.scm
@@ -28,6 +28,7 @@
   #:use-module (system vm trace)
   #:export (list-traps
             trap-enabled?
+            trap-name
             enable-trap!
             disable-trap!
             delete-trap!
@@ -156,10 +157,11 @@
             (set-vm-trace-level! (the-vm) 0))))))
 
 (define* (list-traps #:optional (trap-state (the-trap-state)))
-  (map (lambda (wrapper)
-         (cons (trap-wrapper-index wrapper)
-               (trap-wrapper-name wrapper)))
-       (trap-state-wrappers trap-state)))
+  (map trap-wrapper-index (trap-state-wrappers trap-state)))
+
+(define* (trap-name idx #:optional (trap-state (the-trap-state)))
+  (and=> (wrapper-at-index trap-state idx)
+         trap-wrapper-name))
 
 (define* (trap-enabled? idx #:optional (trap-state (the-trap-state)))
   (and=> (wrapper-at-index trap-state idx)
@@ -192,17 +194,19 @@
      trap-state
      (make-trap-wrapper
       idx #t trap
-      (format #f "breakpoint at ~a" proc)))))
+      (format #f "Breakpoint at ~a" proc)))))
 
 (define* (add-trace-at-procedure-call! proc
                                        #:optional (trap-state 
(the-trap-state)))
   (let* ((idx (next-index! trap-state))
-         (trap (trace-calls-to-procedure proc)))
+         (trap (trace-calls-to-procedure
+                proc
+                #:prefix (format #f "Trap ~a: " idx))))
     (add-trap-wrapper!
      trap-state
      (make-trap-wrapper
       idx #t trap
-      (format #f "tracepoint at ~a" proc)))))
+      (format #f "Tracepoint at ~a" proc)))))
 
 (define* (add-trap! trap name #:optional (trap-state (the-trap-state)))
   (let* ((idx (next-index! trap-state)))


hooks/post-receive
-- 
GNU Guile