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.

1 files changed, 42 insertions, 1 deletions

diff --git a/module/system/vm/trap-state.scm b/module/system/vm/trap-state.scm
index 1f21615ad..e9a2ad86c 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-ephemeral-trap-at-frame-finish!))
+            add-ephemeral-trap-at-frame-finish!
+            add-ephemeral-stepping-trap!))
 
 (define %default-trap-handler (make-fluid))
 
@@ -253,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!