[Guile-commits] GNU Guile branch, master, updated. release_1-9-12-152-g90966af

[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=90966af89581aa059707bc1cf47e034a2a81129a

The branch, master has been updated
       via  90966af89581aa059707bc1cf47e034a2a81129a (commit)
       via  439e032b0b04ddc96b0abcdcf73a4d9cf67316ee (commit)
       via  e8e4e7310c7c3964e4a6c19f154c3b341974eac7 (commit)
      from  5f8760e467aca7bc94fe399761635ec39a7ff753 (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 90966af89581aa059707bc1cf47e034a2a81129a
Author: Andy Wingo <address@hidden>
Date:   Wed Oct 6 21:19:49 2010 +0200

    update (system repl debug) todo
    
    * module/system/repl/debug.scm: Update todo.

commit 439e032b0b04ddc96b0abcdcf73a4d9cf67316ee
Author: Andy Wingo <address@hidden>
Date:   Wed Oct 6 21:19:08 2010 +0200

    add ,step ,stepi ,next and ,nexti
    
    * module/system/vm/traps.scm (trap-matching-instructions): New trap,
      just installs a next hook and runs the handler when a predicate
      succeeds.
    
    * module/system/vm/trap-state.scm (add-ephemeral-stepping-trap!): New
      procedure, uses trap-matching-instructions with an appropriate
      predicate to handle step, stepi, next, and nexti repl metacommands.
    
    * module/system/repl/command.scm (step, step-instruction, next)
      (next-instruction): New repl debugger commands.

commit e8e4e7310c7c3964e4a6c19f154c3b341974eac7
Author: Andy Wingo <address@hidden>
Date:   Wed Oct 6 21:17:06 2010 +0200

    cleanups to ,finish
    
    * module/system/repl/command.scm (repl-pop-continuation-resumer): Factor
      out of finish.
      (finish): Adapt.
    
    * module/system/vm/trap-state.scm (add-ephemeral-trap-at-frame-finish!):
      Rename to add "ephemeral" to the name.
    
    * module/system/vm/traps.scm (trap-calls-to-procedure): Remove unused
      #:width kwarg.

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

Summary of changes:
 module/system/repl/command.scm  |  112 +++++++++++++++++++++++++++++---------
 module/system/repl/debug.scm    |    5 --
 module/system/vm/trap-state.scm |   48 ++++++++++++++++-
 module/system/vm/traps.scm      |   23 +++++++-
 4 files changed, 151 insertions(+), 37 deletions(-)

diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index d23c6c4..fce2324 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -50,7 +50,7 @@
 ;;;
 
 (define *command-table*
-  '((help     (help h) (show s) (apropos a) (describe d))
+  '((help     (help h) (show) (apropos a) (describe d))
     (module   (module m) (import use) (load l) (binding b))
     (language (language L))
     (compile  (compile c) (compile-file cc)
@@ -59,6 +59,8 @@
     (debug    (backtrace bt) (up) (down) (frame fr)
               (procedure proc) (locals) (error-message error)
               (break br bp) (break-at-source break-at bs)
+              (step s) (step-instruction si)
+              (next n) (next-instruction ni)
               (finish)
               (tracepoint tp)
               (traps) (delete del) (disable) (enable)
@@ -594,37 +596,93 @@ Note that the given source location must be inside a 
procedure."
     (let ((idx (add-trap-at-source-location! file line)))
       (format #t "Trap ~a: ~a.~%" idx (trap-name idx)))))
 
+(define (repl-pop-continuation-resumer msg)
+  ;; Capture the dynamic environment with this prompt thing. The
+  ;; result is a procedure that takes a frame.
+  (% (call-with-values
+         (lambda ()
+           (abort
+            (lambda (k)
+              ;; Call frame->stack-vector before reinstating the
+              ;; continuation, so that we catch the %stacks fluid at
+              ;; the time of capture.
+              (lambda (frame)
+                (k frame
+                   (frame->stack-vector
+                    (frame-previous frame)))))))
+       (lambda (from stack)
+         (format #t "~a~%" msg)
+         (let ((vals (frame-return-values from)))
+           (if (null? vals)
+               (format #t "No return values.~%" msg)
+               (begin
+                 (format #t "Return values:~%" msg)
+                 (for-each (lambda (x) (repl-print repl x)) vals))))
+         ((module-ref (resolve-interface '(system repl repl)) 'start-repl)
+          #:debug (make-debug stack 0 msg))))))
+
 (define-stack-command (finish repl)
   "finish
 Run until the current frame finishes.
 
 Resume execution, breaking when the current frame finishes."
-  (let ((msg (format #f "Return from ~a" cur)))
-    (define resume-repl
-      ;; Capture the dynamic environment with this prompt thing. The
-      ;; result is a procedure that takes a frame.
-      (% (call-with-values
-             (lambda ()
-               (abort
-                (lambda (k)
-                  ;; Call frame->stack-vector before reinstating the
-                  ;; continuation, so that we catch the %stacks fluid at
-                  ;; the time of capture.
-                  (lambda (frame)
-                    (k frame
-                       (frame->stack-vector
-                        (frame-previous frame)))))))
-           (lambda (from stack)
-             (format #t "~a~%" msg)
-             (let ((vals (frame-return-values from)))
-               (if (null? vals)
-                   (format #t "No return values.~%" msg)
-                   (begin
-                     (format #t "Return values:~%" msg)
-                     (for-each (lambda (x) (repl-print repl x)) vals))))
-             ((module-ref (resolve-interface '(system repl repl)) 'start-repl)
-              #:debug (make-debug stack 0 msg))))))
-    (add-trap-at-frame-finish! cur resume-repl)
+  (let ((handler (repl-pop-continuation-resumer
+                  (format #f "Return from ~a" cur))))
+    (add-ephemeral-trap-at-frame-finish! cur handler)
+    (throw 'quit)))
+
+(define (repl-next-resumer msg)
+  ;; Capture the dynamic environment with this prompt thing. The
+  ;; result is a procedure that takes a frame.
+  (% (let ((stack (abort
+                   (lambda (k)
+                     ;; Call frame->stack-vector before reinstating the
+                     ;; continuation, so that we catch the %stacks fluid
+                     ;; at the time of capture.
+                     (lambda (frame)
+                       (k (frame->stack-vector frame)))))))
+       (format #t "~a~%" msg)
+       ((module-ref (resolve-interface '(system repl repl)) 'start-repl)
+        #:debug (make-debug stack 0 msg)))))
+
+(define-stack-command (step repl)
+  "step
+Step until control reaches a different source location.
+
+Step until control reaches a different source location."
+  (let ((msg (format #f "Step into ~a" cur)))
+    (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
+                                  #:into? #t #:instruction? #f)
+    (throw 'quit)))
+
+(define-stack-command (step-instruction repl)
+  "step-instruction
+Step until control reaches a different instruction.
+
+Step until control reaches a different VM instruction."
+  (let ((msg (format #f "Step into ~a" cur)))
+    (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
+                                  #:into? #t #:instruction? #t)
+    (throw 'quit)))
+
+(define-stack-command (next repl)
+  "next
+Step until control reaches a different source location in the current frame.
+
+Step until control reaches a different source location in the current frame."
+  (let ((msg (format #f "Step into ~a" cur)))
+    (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
+                                  #:into? #f #:instruction? #f)
+    (throw 'quit)))
+
+(define-stack-command (step-instruction repl)
+  "next-instruction
+Step until control reaches a different instruction in the current frame.
+
+Step until control reaches a different VM instruction in the current frame."
+  (let ((msg (format #f "Step into ~a" cur)))
+    (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
+                                  #:into? #f #:instruction? #t)
     (throw 'quit)))
 
 (define-meta-command (tracepoint repl (form))
diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm
index da42a37..e3beee1 100644
--- a/module/system/repl/debug.scm
+++ b/module/system/repl/debug.scm
@@ -39,16 +39,11 @@
 ;;
 ;; eval expression in context of frame
 ;; set local variable in frame
-;; step until next instruction
-;; step until next function call/return
-;; step until return from frame
-;; step until different source line
 ;; step until greater source line
 ;; watch expression
 ;; set printing width
 ;; disassemble the current function
 ;; inspect any object
-;; (state associated with vm ?)
 
 ;;;
 ;;; Debugger
diff --git a/module/system/vm/trap-state.scm b/module/system/vm/trap-state.scm
index f45f981..e9a2ad8 100644
--- a/module/system/vm/trap-state.scm
+++ b/module/system/vm/trap-state.scm
@@ -26,6 +26,8 @@
   #:use-module (system vm vm)
   #:use-module (system vm traps)
   #:use-module (system vm trace)
+  #:use-module (system vm frame)
+  #:use-module (system vm program)
   #:export (list-traps
             trap-enabled?
             trap-name
@@ -39,7 +41,8 @@
             add-trap-at-procedure-call!
             add-trace-at-procedure-call!
             add-trap-at-source-location!
-            add-trap-at-frame-finish!))
+            add-ephemeral-trap-at-frame-finish!
+            add-ephemeral-stepping-trap!))
 
 (define %default-trap-handler (make-fluid))
 
@@ -239,8 +242,9 @@
       (format #f "Breakpoint at ~a:~a" file user-line)))))
 
 ;; handler := frame -> nothing
-(define* (add-trap-at-frame-finish! frame handler
-                                    #:optional (trap-state (the-trap-state)))
+(define* (add-ephemeral-trap-at-frame-finish! frame handler
+                                              #:optional (trap-state
+                                                          (the-trap-state)))
   (let* ((idx (next-ephemeral-index! trap-state))
          (trap (trap-frame-finish
                 frame
@@ -252,6 +256,44 @@
       idx #t trap
       (format #f "Return from ~a" frame)))))
 
+(define (source-string source)
+  (if source
+      (format #f "~a:~a:~a" (or (source:file source) "unknown file")
+              (source:line-for-user source) (source:column source))
+      "unknown source location"))
+
+(define* (add-ephemeral-stepping-trap! frame handler
+                                       #:optional (trap-state
+                                                   (the-trap-state))
+                                       #:key (into? #t) (instruction? #f))
+  (define (wrap-predicate-according-to-into predicate)
+    (if into?
+        predicate
+        (let ((fp (frame-address frame)))
+          (lambda (f)
+            (and (<= (frame-address f) fp)
+                 (predicate f))))))
+  
+  (let* ((source (frame-source frame))
+         (idx (next-ephemeral-index! trap-state))
+         (trap (trap-matching-instructions
+                (wrap-predicate-according-to-into
+                 (if instruction?
+                     (lambda (f) #t)
+                     (lambda (f) (not (equal? (frame-source f) source)))))
+                (ephemeral-handler-for-index trap-state idx handler))))
+    (add-trap-wrapper!
+     trap-state
+     (make-trap-wrapper
+      idx #t trap
+      (if instruction?
+          (if into?
+              "Step to different instruction"
+              (format #f "Step to different instruction in ~a" frame))
+          (if into?
+              (format #f "Step into ~a" (source-string source)) 
+              (format #f "Step out of ~a" (source-string source))))))))
+
 (define* (add-trap! trap name #:optional (trap-state (the-trap-state)))
   (let* ((idx (next-index! trap-state)))
     (add-trap-wrapper!
diff --git a/module/system/vm/traps.scm b/module/system/vm/traps.scm
index dfaedc5..627e6c5 100644
--- a/module/system/vm/traps.scm
+++ b/module/system/vm/traps.scm
@@ -72,7 +72,8 @@
             trap-in-dynamic-extent
             trap-calls-in-dynamic-extent
             trap-instructions-in-dynamic-extent
-            trap-calls-to-procedure))
+            trap-calls-to-procedure
+            trap-matching-instructions))
 
 (define-syntax arg-check
   (syntax-rules ()
@@ -604,7 +605,7 @@
 ;; Traps calls and returns for a given procedure, keeping track of the call 
depth.
 ;;
 (define* (trap-calls-to-procedure proc apply-handler return-handler
-                                  #:key (width 80) (vm (the-vm)))
+                                  #:key (vm (the-vm)))
   (arg-check proc procedure?)
   (arg-check apply-handler procedure?)
   (arg-check return-handler procedure?)
@@ -662,3 +663,21 @@
 
     (with-pending-finish-disablers
      (trap-at-procedure-call proc apply-hook #:vm vm))))
+
+;; Trap when the source location changes.
+;;
+(define* (trap-matching-instructions frame-pred handler
+                                     #:key (vm (the-vm)))
+  (arg-check frame-pred procedure?)
+  (arg-check handler procedure?)
+  (let ()
+    (define (next-hook frame)
+      (if (frame-pred frame)
+          (handler frame)))
+  
+    (new-enabled-trap
+     vm #f
+     (lambda (frame)
+       (add-hook! (vm-next-hook vm) next-hook))
+     (lambda (frame)
+       (remove-hook! (vm-next-hook vm) next-hook)))))


hooks/post-receive
-- 
GNU Guile