[Guile-commits] GNU Guile branch, master, updated. release_1-9-12-127-g262ce91

[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=262ce9115743c3590ddaa6966bd3f2569f60003a

The branch, master has been updated
       via  262ce9115743c3590ddaa6966bd3f2569f60003a (commit)
      from  1905db2b48bc7cdd97c91fea35382de00ce2060a (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 262ce9115743c3590ddaa6966bd3f2569f60003a
Author: Andy Wingo <address@hidden>
Date:   Sun Oct 3 11:12:36 2010 +0200

    bugfixen in source breakpoints and in-procedure traps
    
    * module/system/vm/traps.scm (trap-in-procedure): If we are
      (re-)entering the procedure from a return, call the enter-proc with
      the returnee, not the returner.
      (in-range?): Tighten up a bit.
      (program-sources-before-retire): New helper, like program-sources but
      indexed before instructions are retired instead of after.
      (program-sources-by-line): Use program-sources-before-retire so that
      we can break on instructions by source line *before* those
      instructions are executed.

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

Summary of changes:
 module/system/vm/traps.scm |   62 +++++++++++++++++++++++++++++++++++++++++--
 1 files changed, 59 insertions(+), 3 deletions(-)

diff --git a/module/system/vm/traps.scm b/module/system/vm/traps.scm
index 0e7a540..7abe453 100644
--- a/module/system/vm/traps.scm
+++ b/module/system/vm/traps.scm
@@ -60,6 +60,7 @@
   #:use-module (system vm frame)
   #:use-module (system vm program)
   #:use-module (system vm objcode)
+  #:use-module (system vm instruction)
   #:use-module (system xref)
   #:use-module (rnrs bytevectors)
   #:export (trap-at-procedure-call
@@ -186,7 +187,7 @@
       (if in-proc?
           (exit-proc frame))
       (if (our-frame? (frame-previous frame))
-          (enter-proc frame)))
+          (enter-proc (frame-previous frame))))
 
     (define (abort-hook frame)
       (if in-proc?
@@ -262,7 +263,8 @@
 
 (define (in-range? range i)
   (or-map (lambda (bounds)
-            (<= (car bounds) i (cdr bounds)))
+            (and (<= (car bounds) i)
+                 (< i (cdr bounds))))
           range))
 
 ;; Building on trap-instructions-in-procedure, we have
@@ -290,14 +292,68 @@
                                     #:current-frame current-frame #:vm vm
                                     #:our-frame? our-frame?)))
 
+;; FIXME: pull this definition from elsewhere.
+(define *bytecode-header-len* 8)
+
 ;; FIXME: define this in objcode somehow. We are reffing the first
 ;; uint32 in the objcode, which is the length of the program (without
 ;; the meta).
 (define (program-last-ip prog)
   (bytevector-u32-native-ref (objcode->bytecode (program-objcode prog)) 0))
 
+;; We could decompile the program to get this, but that seems like a
+;; waste.
+(define (bytecode-instruction-length bytecode ip)
+  (let* ((idx (+ ip *bytecode-header-len*))
+         (inst (opcode->instruction (bytevector-u8-ref bytecode idx))))
+    ;; 1+ for the instruction itself.
+    (1+ (cond
+         ((eq? inst 'load-program)
+          (+ (bytevector-u32-native-ref bytecode (+ idx 1))
+             (bytevector-u32-native-ref bytecode (+ idx 5))))
+         ((< (instruction-length inst) 0)
+          ;; variable length instruction -- the length is encoded in the
+          ;; instruction stream.
+          (+ (ash (bytevector-u8-ref bytecode (+ idx 1)) 16)
+             (ash (bytevector-u8-ref bytecode (+ idx 2)) 8)
+             (bytevector-u8-ref bytecode (+ idx 3))))
+         (else
+          ;; fixed length
+          (instruction-length inst))))))
+
+;; Source information could in theory be correlated with the ip of the
+;; instruction, or the ip just after the instruction is retired. Guile
+;; does the latter, to make backtraces easy -- an error produced while
+;; running an opcode always happens after it has retired its arguments.
+;;
+;; But for breakpoints and such, we need the ip before the instruction
+;; is retired -- before it has had a chance to do anything. So here we
+;; change from the post-retire addresses given by program-sources to
+;; pre-retire addresses.
+;;
+(define (program-sources-before-retire proc)
+  (let ((bv (objcode->bytecode (program-objcode proc))))
+    (let lp ((in (program-sources proc))
+             (out '())
+             (ip 0))
+      (cond
+       ((null? in)
+        (reverse out))
+       (else
+        (pmatch (car in)
+          ((,post-ip . ,source)
+           (let lp2 ((ip ip)
+                     (next ip))
+             (if (< next post-ip)
+                 (lp2 next (+ next (bytecode-instruction-length bv next)))
+                 (lp (cdr in)
+                     (acons ip source out)
+                     next))))
+          (else
+           (error "unexpected"))))))))
+
 (define (program-sources-by-line proc file)
-  (let lp ((sources (program-sources proc))
+  (let lp ((sources (program-sources-before-retire proc))
            (out '()))
     (if (pair? sources)
         (lp (cdr sources)


hooks/post-receive
-- 
GNU Guile