diff options
author | Andy Wingo <wingo@pobox.com> | 2010-10-03 23:09:32 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-10-03 23:09:32 +0200 |
commit | 6e197f3d1af34cffef0b285f655b84d2d63bbdeb (patch) | |
tree | e18a1390f19e9a187a047ed37fa72a460e4b8e19 | |
parent | 6e1dccc42f9ec81e04524ccc0956c692ee423576 (diff) | |
download | guile-6e197f3d1af34cffef0b285f655b84d2d63bbdeb.tar.gz |
avoid some double-breaks in trap-at-procedure-ip-in-range
* module/system/vm/traps.scm (trap-at-procedure-ip-in-range): Rework not
to call the handler when returning to a frame that was already
entered. So now breaking at foo.scm:1234 doesn't break when returning
to that line.
-rw-r--r-- | module/system/vm/traps.scm | 28 |
1 files changed, 22 insertions, 6 deletions
diff --git a/module/system/vm/traps.scm b/module/system/vm/traps.scm index 7abe45396..3b2a43875 100644 --- a/module/system/vm/traps.scm +++ b/module/system/vm/traps.scm @@ -278,15 +278,31 @@ (arg-check proc procedure?) (arg-check range range?) (arg-check handler procedure?) - (let ((was-in-range? #f)) + (let ((fp-stack '())) + (define (cull-frames! fp) + (let lp ((frames fp-stack)) + (if (and (pair? frames) (< (car frames) fp)) + (lp (cdr frames)) + (set! fp-stack frames)))) + (define (next-handler frame) - (let ((now-in-range? (in-range? range (frame-instruction-pointer frame)))) - (cond - (was-in-range? (set! was-in-range? now-in-range?)) - (now-in-range? (handler frame) (set! was-in-range? #t))))) + (let ((fp (frame-address frame)) + (ip (frame-instruction-pointer frame))) + (cull-frames! fp) + (let ((now-in-range? (in-range? range ip)) + (was-in-range? (and (pair? fp-stack) (= (car fp-stack) fp)))) + (cond + (was-in-range? + (if (not now-in-range?) + (set! fp-stack (cdr fp-stack)))) + (now-in-range? + (set! fp-stack (cons fp fp-stack)) + (handler frame)))))) (define (exit-handler frame) - (set! was-in-range? #f)) + (if (and (pair? fp-stack) + (= (car fp-stack) (frame-address frame))) + (set! fp-stack (cdr fp-stack)))) (trap-instructions-in-procedure proc next-handler exit-handler #:current-frame current-frame #:vm vm |