guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 38/58: GDB support: Fix 'display-vm-frames'.


From: Andy Wingo
Subject: [Guile-commits] 38/58: GDB support: Fix 'display-vm-frames'.
Date: Tue, 7 Aug 2018 06:58:36 -0400 (EDT)

wingo pushed a commit to branch lightning
in repository guile.

commit 6e57d0d56edf53b66b0ce5ce7ea7fd3579d799e8
Author: Ludovic Courtès <address@hidden>
Date:   Sun Jun 24 23:22:52 2018 +0200

    GDB support: Fix 'display-vm-frames'.
    
    Previously 'vm-frame-older' would fail to traverse the chain of frames.
    
    * libguile/libguile-2.2-gdb.scm (uint-type): New variable
    (vm-frame): Fix "saved ip" and "saved fp" computation.  The latter had
    been broken roughly since commit
    72353de77d0a06f158d8af66a2540015658e2574.
    (vm-frame-older): Return #f when IP is zero, not when FP is zero.
    (vm-frame-function-name): Wrap 'vm-frame-program-debug-info' in
    'false-if-exception'
---
 libguile/libguile-2.2-gdb.scm | 19 +++++++++++++------
 1 file changed, 13 insertions(+), 6 deletions(-)

diff --git a/libguile/libguile-2.2-gdb.scm b/libguile/libguile-2.2-gdb.scm
index 02b3437..b2e340e 100644
--- a/libguile/libguile-2.2-gdb.scm
+++ b/libguile/libguile-2.2-gdb.scm
@@ -170,6 +170,7 @@ if the information is not available."
 (define ip-type (type-pointer (lookup-type "scm_t_uint32")))
 (define fp-type (type-pointer (lookup-type "SCM")))
 (define sp-type (type-pointer (lookup-type "SCM")))
+(define uint-type (type-pointer (lookup-type "scm_t_uintptr")))
 
 (define-record-type <vm-frame>
   (make-vm-frame ip sp fp saved-ip saved-fp)
@@ -186,10 +187,16 @@ if the information is not available."
   (make-vm-frame ip
                  sp
                  fp
-                 (value-dereference (value-cast (value-sub fp 1)
-                                                (type-pointer ip-type)))
-                 (value-dereference (value-cast (value-sub fp 2)
-                                                (type-pointer fp-type)))))
+
+                 ;; fp[0] is the return address.
+                 (value-dereference (value-cast fp (type-pointer ip-type)))
+
+                 ;; fp[1] is the offset to the previous frame pointer.
+                 (value-add fp
+                            (value->integer
+                             (value-dereference
+                              (value-cast (value-add fp 1)
+                                          (type-pointer uint-type)))))))
 
 (define (vm-engine-frame? frame)
   (let ((sym (frame-function frame)))
@@ -217,7 +224,7 @@ if the information is not available."
   (let ((ip (vm-frame-saved-ip frame))
         (sp (value-sub (vm-frame-fp frame) 3))
         (fp (vm-frame-saved-fp frame)))
-    (and (not (zero? (value->integer fp)))
+    (and (not (zero? (value->integer ip)))
          (vm-frame ip sp fp backend))))
 
 (define (vm-frames)
@@ -279,7 +286,7 @@ if the information is not available."
   (define (default-name)
     "[unknown]")
   (cond
-   ((vm-frame-program-debug-info frame)
+   ((false-if-exception (vm-frame-program-debug-info frame))
     => (lambda (pdi)
          (or (and=> (program-debug-info-name pdi) symbol->string)
              "[anonymous]")))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]