diff options
author | Andy Wingo <wingo@pobox.com> | 2015-11-27 15:38:30 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2015-12-01 11:30:54 +0100 |
commit | 3582787cb032da4d3a722bfb00882e6d992b0c87 (patch) | |
tree | 379d5e29972d1e7ca6d088dc606a430dcb884928 | |
parent | adb23298637edb2365fd78e98020f9aeb457b6ec (diff) | |
download | guile-3582787cb032da4d3a722bfb00882e6d992b0c87.tar.gz |
VM traps don't match on value of slot 0
* module/system/vm/traps.scm (frame-matcher): Always match on a
procedure's code, instead of the value in slot 0. Prevents confusion
with closure-optimized procedures, re-use of slot 0, and untagged
values in slot 0.
(trap-at-procedure-call, trap-in-procedure)
(trap-instructions-in-procedure, trap-at-procedure-ip-in-range)
(trap-at-source-location, trap-in-dynamic-extent)
(trap-calls-in-dynamic-extent, trap-instructions-in-dynamic-extent):
Update to adapt to frame-matcher change and remove #:closure?
argument, effectively changing the default behavior to #:closure? #t.
* doc/ref/api-debug.texi (Low-Level Traps): Update documentation.
-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 () |