1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 22:10:21 +02:00

breakpoints from recursive prompts work

* module/system/vm/traps.scm (new-disabled-trap): Don't manipulate the
  VM trace level in the enable and disable handlers. Unfortunately, this
  makes traps not work unless you enable hooks, but given that
  vm_dispatch_hook has to set trace-level to 0, there needs to be an
  object with a broader view of what traps are enabled. That object is
  the hook state.

* module/system/vm/trap-state.scm (trap-state->trace-level): New
  procedure.
  (with-default-trap-handler): Add an optional trap-state argument. Now
  makes sure that the vm-trace-level is set appropriately during the
  execution of the thunk, allowing for breakpoints from recursive
  prompts.
This commit is contained in:
Andy Wingo 2010-09-21 21:37:11 +02:00
parent 194865d2f7
commit 65bce23759
2 changed files with 19 additions and 6 deletions

View file

@ -22,6 +22,7 @@
(define-module (system vm trap-state)
#:use-module (system base syntax)
#:use-module ((srfi srfi-1) #:select (fold))
#:use-module (system vm vm)
#:use-module (system vm traps)
#:export (list-traps
@ -37,10 +38,6 @@
(define %default-trap-handler (make-fluid))
(define (with-default-trap-handler handler thunk)
(with-fluids ((%default-trap-handler handler))
(thunk)))
(define (default-trap-handler frame idx trap-name)
(let ((default-handler (fluid-ref %default-trap-handler)))
(if default-handler
@ -87,6 +84,14 @@
(define (remove-trap-wrapper! trap-state wrapper)
(delq wrapper (trap-state-wrappers trap-state)))
(define (trap-state->trace-level trap-state)
(fold (lambda (wrapper level)
(if (trap-wrapper-enabled? wrapper)
(1+ level)
level))
0
(trap-state-wrappers trap-state)))
(define (wrapper-at-index trap-state idx)
(let lp ((wrappers (trap-state-wrappers trap-state)))
(cond
@ -135,6 +140,16 @@
;;; API
;;;
(define* (with-default-trap-handler handler thunk
#:optional (trap-state (the-trap-state)))
(with-fluids ((%default-trap-handler handler))
(dynamic-wind
(lambda ()
(set-vm-trace-level! (the-vm) (trap-state->trace-level trap-state)))
thunk
(lambda ()
(set-vm-trace-level! (the-vm) 0)))))
(define* (list-traps #:optional (trap-state (the-trap-state)))
(map (lambda (wrapper)
(cons (trap-wrapper-index wrapper)

View file

@ -87,14 +87,12 @@
(define* (enable-trap #:optional frame)
(if enabled? (error "trap already enabled"))
(enable frame)
(set-vm-trace-level! vm (1+ (vm-trace-level vm)))
(set! enabled? #t)
disable-trap)
(define* (disable-trap #:optional frame)
(if disabled? (error "trap already disabled"))
(disable frame)
(set-vm-trace-level! vm (1- (vm-trace-level vm)))
(set! disabled? #t)
enable-trap)