1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 13:30:26 +02:00

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.
This commit is contained in:
Andy Wingo 2015-11-27 15:38:30 +01:00
parent adb2329863
commit 3582787cb0
2 changed files with 34 additions and 42 deletions

View file

@ -1088,11 +1088,6 @@ separately, we discuss them all together here:
@table @code @table @code
@item #:vm @item #:vm
The VM to instrument. Defaults to the current thread's 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 @item #:current-frame
For traps that enable more hooks depending on their dynamic context, For traps that enable more hooks depending on their dynamic context,
this argument gives the current frame that the trap is running in. 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 @end lisp
@deffn {Scheme Procedure} trap-at-procedure-call proc handler @ @deffn {Scheme Procedure} trap-at-procedure-call proc handler @
[#:vm] [#:closure?] [#:vm]
A trap that calls @var{handler} when @var{proc} is applied. A trap that calls @var{handler} when @var{proc} is applied.
@end deffn @end deffn
@deffn {Scheme Procedure} trap-in-procedure proc @ @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}, A trap that calls @var{enter-handler} when control enters @var{proc},
and @var{exit-handler} when control leaves @var{proc}. and @var{exit-handler} when control leaves @var{proc}.
@ -1140,13 +1135,13 @@ An abort.
@end deffn @end deffn
@deffn {Scheme Procedure} trap-instructions-in-procedure proc @ @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 A trap that calls @var{next-handler} for every instruction executed in
@var{proc}, and @var{exit-handler} when execution leaves @var{proc}. @var{proc}, and @var{exit-handler} when execution leaves @var{proc}.
@end deffn @end deffn
@deffn {Scheme Procedure} trap-at-procedure-ip-in-range proc range @ @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 A trap that calls @var{handler} when execution enters a range of
instructions in @var{proc}. @var{range} is a simple of pairs, instructions in @var{proc}. @var{range} is a simple of pairs,
@code{((@var{start} . @var{end}) ...)}. The @var{start} addresses are @code{((@var{start} . @var{end}) ...)}. The @var{start} addresses are
@ -1169,7 +1164,7 @@ exit.
@end deffn @end deffn
@deffn {Scheme Procedure} trap-in-dynamic-extent proc @ @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} A more traditional dynamic-wind trap, which fires @var{enter-handler}
when control enters @var{proc}, @var{return-handler} on a normal return, when control enters @var{proc}, @var{return-handler} on a normal return,
and @var{abort-handler} on a nonlocal exit. 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 @end deffn
@deffn {Scheme Procedure} trap-calls-in-dynamic-extent proc @ @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, 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 and @var{return-handler} for returns, but only during the dynamic extent
of an application of @var{proc}. of an application of @var{proc}.
@end deffn @end deffn
@deffn {Scheme Procedure} trap-instructions-in-dynamic-extent proc @ @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 A trap that calls @var{next-handler} for all retired instructions within
the dynamic extent of a call to @var{proc}. the dynamic extent of a call to @var{proc}.
@end deffn @end deffn

View file

@ -112,25 +112,26 @@
(let ((pdi (find-program-debug-info (program-code prog)))) (let ((pdi (find-program-debug-info (program-code prog))))
(and pdi (program-debug-info-size pdi)))) (and pdi (program-debug-info-size pdi))))
(define (frame-matcher proc match-code?) (define (frame-matcher proc)
(let ((proc (if (struct? proc) (let ((proc (if (struct? proc)
(procedure proc) (procedure proc)
proc))) proc)))
(if match-code? (cond
(if (program? proc) ((program? proc)
(let ((start (program-code proc)) (let ((start (program-code proc))
(end (program-last-ip proc))) (end (program-last-ip proc)))
(lambda (frame)
(let ((ip (frame-instruction-pointer frame)))
(and (<= start ip) (< ip end)))))
(lambda (frame) #f))
(lambda (frame) (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. ;; A basic trap, fires when a procedure is called.
;; ;;
(define* (trap-at-procedure-call proc handler #:key (closure? #f) (define* (trap-at-procedure-call proc handler #:key
(our-frame? (frame-matcher proc closure?))) (our-frame? (frame-matcher proc)))
(arg-check proc procedure?) (arg-check proc procedure?)
(arg-check handler procedure?) (arg-check handler procedure?)
(let () (let ()
@ -160,8 +161,8 @@
;; * An abort. ;; * An abort.
;; ;;
(define* (trap-in-procedure proc enter-handler exit-handler (define* (trap-in-procedure proc enter-handler exit-handler
#:key current-frame (closure? #f) #:key current-frame
(our-frame? (frame-matcher proc closure?))) (our-frame? (frame-matcher proc)))
(arg-check proc procedure?) (arg-check proc procedure?)
(arg-check enter-handler procedure?) (arg-check enter-handler procedure?)
(arg-check exit-handler procedure?) (arg-check exit-handler procedure?)
@ -216,9 +217,8 @@
;; Building on trap-in-procedure, we have trap-instructions-in-procedure ;; Building on trap-in-procedure, we have trap-instructions-in-procedure
;; ;;
(define* (trap-instructions-in-procedure proc next-handler exit-handler (define* (trap-instructions-in-procedure proc next-handler exit-handler
#:key current-frame (closure? #f) #:key current-frame
(our-frame? (our-frame? (frame-matcher proc)))
(frame-matcher proc closure?)))
(arg-check proc procedure?) (arg-check proc procedure?)
(arg-check next-handler procedure?) (arg-check next-handler procedure?)
(arg-check exit-handler procedure?) (arg-check exit-handler procedure?)
@ -263,9 +263,8 @@
;; trap-at-procedure-ip-in-range. ;; trap-at-procedure-ip-in-range.
;; ;;
(define* (trap-at-procedure-ip-in-range proc range handler (define* (trap-at-procedure-ip-in-range proc range handler
#:key current-frame (closure? #f) #:key current-frame
(our-frame? (our-frame? (frame-matcher proc)))
(frame-matcher proc closure?)))
(arg-check proc procedure?) (arg-check proc procedure?)
(arg-check range range?) (arg-check range range?)
(arg-check handler procedure?) (arg-check handler procedure?)
@ -376,8 +375,8 @@
(lambda (proc) (lambda (proc)
(let ((range (source->ip-range proc file (1- user-line)))) (let ((range (source->ip-range proc file (1- user-line))))
(trap-at-procedure-ip-in-range proc range handler (trap-at-procedure-ip-in-range proc range handler
#:current-frame current-frame #:current-frame
#:closure? closures?))) current-frame)))
procs)) procs))
(if (null? traps) (if (null? traps)
(error "No procedures found at ~a:~a." file user-line))) (error "No procedures found at ~a:~a." file user-line)))
@ -424,8 +423,8 @@
;; based on the above trap-frame-finish? ;; based on the above trap-frame-finish?
;; ;;
(define* (trap-in-dynamic-extent proc enter-handler return-handler abort-handler (define* (trap-in-dynamic-extent proc enter-handler return-handler abort-handler
#:key current-frame (closure? #f) #:key current-frame
(our-frame? (frame-matcher proc closure?))) (our-frame? (frame-matcher proc)))
(arg-check proc procedure?) (arg-check proc procedure?)
(arg-check enter-handler procedure?) (arg-check enter-handler procedure?)
(arg-check return-handler procedure?) (arg-check return-handler procedure?)
@ -462,9 +461,8 @@
;; depth of the call stack relative to the original procedure. ;; depth of the call stack relative to the original procedure.
;; ;;
(define* (trap-calls-in-dynamic-extent proc apply-handler return-handler (define* (trap-calls-in-dynamic-extent proc apply-handler return-handler
#:key current-frame (closure? #f) #:key current-frame
(our-frame? (our-frame? (frame-matcher proc)))
(frame-matcher proc closure?)))
(arg-check proc procedure?) (arg-check proc procedure?)
(arg-check apply-handler procedure?) (arg-check apply-handler procedure?)
(arg-check return-handler procedure?) (arg-check return-handler procedure?)
@ -504,9 +502,8 @@
;; Trapping all retired intructions within a dynamic extent. ;; Trapping all retired intructions within a dynamic extent.
;; ;;
(define* (trap-instructions-in-dynamic-extent proc next-handler (define* (trap-instructions-in-dynamic-extent proc next-handler
#:key current-frame (closure? #f) #:key current-frame
(our-frame? (our-frame? (frame-matcher proc)))
(frame-matcher proc closure?)))
(arg-check proc procedure?) (arg-check proc procedure?)
(arg-check next-handler procedure?) (arg-check next-handler procedure?)
(let () (let ()