[Guile-commits] GNU Guile branch, master, updated. release_1-9-12-135-g6e197f3

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=6e197f3d1af34cffef0b285f655b84d2d63bbdeb

The branch, master has been updated
       via  6e197f3d1af34cffef0b285f655b84d2d63bbdeb (commit)
       via  6e1dccc42f9ec81e04524ccc0956c692ee423576 (commit)
      from  f16a20071dcb55e1362a5b21c63e98b3b4101364 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 6e197f3d1af34cffef0b285f655b84d2d63bbdeb
Author: Andy Wingo <address@hidden>
Date:   Sun Oct 3 23:09:32 2010 +0200

    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.

commit 6e1dccc42f9ec81e04524ccc0956c692ee423576
Author: Andy Wingo <address@hidden>
Date:   Sun Oct 3 23:08:27 2010 +0200

    repl.scm next-char needed to read EOF from port
    
    * module/system/repl/repl.scm (next-char): Actually read off the EOF if
      we got one. Interesting, this.

-----------------------------------------------------------------------

Summary of changes:
 module/system/repl/repl.scm |    2 +-
 module/system/vm/traps.scm  |   28 ++++++++++++++++++++++------
 2 files changed, 23 insertions(+), 7 deletions(-)

diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index efe29ac..e416d1d 100644
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -173,7 +173,7 @@
 (define (next-char wait)
   (if (or wait (char-ready?))
       (let ((ch (peek-char)))
-       (cond ((eof-object? ch) ch)
+       (cond ((eof-object? ch) (read-char) ch)
              ((char-whitespace? ch) (read-char) (next-char wait))
              (else ch)))
       #f))
diff --git a/module/system/vm/traps.scm b/module/system/vm/traps.scm
index 7abe453..3b2a438 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


hooks/post-receive
-- 
GNU Guile