mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

add ,step ,stepi ,next and ,nexti

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2010-10-06 21:19:08 +02:00
parent e8e4e7310c
commit 439e032b0b
3 changed files with 119 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

58
module/system/repl/command.scm
View file

@ -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)
@ -629,6 +631,60 @@ Resume execution, breaking when the current frame finishes."
(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))
"tracepoint PROCEDURE
Add a tracepoint to PROCEDURE.

43
module/system/vm/trap-state.scm
View file

@ -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!

21
module/system/vm/traps.scm
View file

@ -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 ()
@ -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)))))