diff options
-rw-r--r-- | doc/ref/api-debug.texi | 19 | ||||
-rw-r--r-- | module/system/vm/traps.scm | 57 |
2 files changed, 34 insertions, 42 deletions
diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi index bf25c74c9..958c92728 100644 --- a/doc/ref/api-debug.texi +++ b/doc/ref/api-debug.texi @@ -1088,11 +1088,6 @@ separately, we discuss them all together here: @table @code @item #:vm The VM to instrument. Defaults to the current thread's VM. -@item #:closure? -For traps that depend on the current frame's procedure, this argument -specifies whether to trap on the only the specific procedure given, or -on any closure that has the given procedure's code. Defaults to -@code{#f}. @item #:current-frame For traps that enable more hooks depending on their dynamic context, this argument gives the current frame that the trap is running in. @@ -1107,12 +1102,12 @@ To have access to these procedures, you'll need to have imported the @end lisp @deffn {Scheme Procedure} trap-at-procedure-call proc handler @ - [#:vm] [#:closure?] + [#:vm] A trap that calls @var{handler} when @var{proc} is applied. @end deffn @deffn {Scheme Procedure} trap-in-procedure proc @ - enter-handler exit-handler [#:current-frame] [#:vm] [#:closure?] + enter-handler exit-handler [#:current-frame] [#:vm] A trap that calls @var{enter-handler} when control enters @var{proc}, and @var{exit-handler} when control leaves @var{proc}. @@ -1140,13 +1135,13 @@ An abort. @end deffn @deffn {Scheme Procedure} trap-instructions-in-procedure proc @ - next-handler exit-handler [#:current-frame] [#:vm] [#:closure?] + next-handler exit-handler [#:current-frame] [#:vm] A trap that calls @var{next-handler} for every instruction executed in @var{proc}, and @var{exit-handler} when execution leaves @var{proc}. @end deffn @deffn {Scheme Procedure} trap-at-procedure-ip-in-range proc range @ - handler [#:current-frame] [#:vm] [#:closure?] + handler [#:current-frame] [#:vm] A trap that calls @var{handler} when execution enters a range of instructions in @var{proc}. @var{range} is a simple of pairs, @code{((@var{start} . @var{end}) ...)}. The @var{start} addresses are @@ -1169,7 +1164,7 @@ exit. @end deffn @deffn {Scheme Procedure} trap-in-dynamic-extent proc @ - enter-handler return-handler abort-handler [#:vm] [#:closure?] + enter-handler return-handler abort-handler [#:vm] A more traditional dynamic-wind trap, which fires @var{enter-handler} when control enters @var{proc}, @var{return-handler} on a normal return, and @var{abort-handler} on a nonlocal exit. @@ -1178,14 +1173,14 @@ Note that rewinds are not handled, so there is no rewind handler. @end deffn @deffn {Scheme Procedure} trap-calls-in-dynamic-extent proc @ - apply-handler return-handler [#:current-frame] [#:vm] [#:closure?] + apply-handler return-handler [#:current-frame] [#:vm] A trap that calls @var{apply-handler} every time a procedure is applied, and @var{return-handler} for returns, but only during the dynamic extent of an application of @var{proc}. @end deffn @deffn {Scheme Procedure} trap-instructions-in-dynamic-extent proc @ - next-handler [#:current-frame] [#:vm] [#:closure?] + next-handler [#:current-frame] [#:vm] A trap that calls @var{next-handler} for all retired instructions within the dynamic extent of a call to @var{proc}. @end deffn diff --git a/module/system/vm/traps.scm b/module/system/vm/traps.scm index ca6acddfa..db82a0ab9 100644 --- a/module/system/vm/traps.scm +++ b/module/system/vm/traps.scm @@ -112,25 +112,26 @@ (let ((pdi (find-program-debug-info (program-code prog)))) (and pdi (program-debug-info-size pdi)))) -(define (frame-matcher proc match-code?) +(define (frame-matcher proc) (let ((proc (if (struct? proc) (procedure proc) proc))) - (if match-code? - (if (program? proc) - (let ((start (program-code proc)) - (end (program-last-ip proc))) - (lambda (frame) - (let ((ip (frame-instruction-pointer frame))) - (and (<= start ip) (< ip end))))) - (lambda (frame) #f)) + (cond + ((program? proc) + (let ((start (program-code proc)) + (end (program-last-ip proc))) (lambda (frame) - (eq? (frame-procedure frame) proc))))) + (let ((ip (frame-instruction-pointer frame))) + (and (<= start ip) (< ip end)))))) + ((struct? proc) + (frame-matcher (procedure proc))) + (else + (error "Not a VM program" proc))))) ;; A basic trap, fires when a procedure is called. ;; -(define* (trap-at-procedure-call proc handler #:key (closure? #f) - (our-frame? (frame-matcher proc closure?))) +(define* (trap-at-procedure-call proc handler #:key + (our-frame? (frame-matcher proc))) (arg-check proc procedure?) (arg-check handler procedure?) (let () @@ -160,8 +161,8 @@ ;; * An abort. ;; (define* (trap-in-procedure proc enter-handler exit-handler - #:key current-frame (closure? #f) - (our-frame? (frame-matcher proc closure?))) + #:key current-frame + (our-frame? (frame-matcher proc))) (arg-check proc procedure?) (arg-check enter-handler procedure?) (arg-check exit-handler procedure?) @@ -216,9 +217,8 @@ ;; Building on trap-in-procedure, we have trap-instructions-in-procedure ;; (define* (trap-instructions-in-procedure proc next-handler exit-handler - #:key current-frame (closure? #f) - (our-frame? - (frame-matcher proc closure?))) + #:key current-frame + (our-frame? (frame-matcher proc))) (arg-check proc procedure?) (arg-check next-handler procedure?) (arg-check exit-handler procedure?) @@ -263,9 +263,8 @@ ;; trap-at-procedure-ip-in-range. ;; (define* (trap-at-procedure-ip-in-range proc range handler - #:key current-frame (closure? #f) - (our-frame? - (frame-matcher proc closure?))) + #:key current-frame + (our-frame? (frame-matcher proc))) (arg-check proc procedure?) (arg-check range range?) (arg-check handler procedure?) @@ -376,8 +375,8 @@ (lambda (proc) (let ((range (source->ip-range proc file (1- user-line)))) (trap-at-procedure-ip-in-range proc range handler - #:current-frame current-frame - #:closure? closures?))) + #:current-frame + current-frame))) procs)) (if (null? traps) (error "No procedures found at ~a:~a." file user-line))) @@ -424,8 +423,8 @@ ;; based on the above trap-frame-finish? ;; (define* (trap-in-dynamic-extent proc enter-handler return-handler abort-handler - #:key current-frame (closure? #f) - (our-frame? (frame-matcher proc closure?))) + #:key current-frame + (our-frame? (frame-matcher proc))) (arg-check proc procedure?) (arg-check enter-handler procedure?) (arg-check return-handler procedure?) @@ -462,9 +461,8 @@ ;; depth of the call stack relative to the original procedure. ;; (define* (trap-calls-in-dynamic-extent proc apply-handler return-handler - #:key current-frame (closure? #f) - (our-frame? - (frame-matcher proc closure?))) + #:key current-frame + (our-frame? (frame-matcher proc))) (arg-check proc procedure?) (arg-check apply-handler procedure?) (arg-check return-handler procedure?) @@ -504,9 +502,8 @@ ;; Trapping all retired intructions within a dynamic extent. ;; (define* (trap-instructions-in-dynamic-extent proc next-handler - #:key current-frame (closure? #f) - (our-frame? - (frame-matcher proc closure?))) + #:key current-frame + (our-frame? (frame-matcher proc))) (arg-check proc procedure?) (arg-check next-handler procedure?) (let () |