summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/ref/api-debug.texi19
-rw-r--r--module/system/vm/traps.scm57
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 ()