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

View file

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