guile-commits
[Top][All Lists]
Advanced

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

[Guile-commits] 02/02: gdb: Support builds with SCM_DEBUG_TYPING_STRICTN


From: Ludovic Courtès
Subject: [Guile-commits] 02/02: gdb: Support builds with SCM_DEBUG_TYPING_STRICTNESS=2.
Date: Tue, 02 Jun 2015 19:18:27 +0000

civodul pushed a commit to branch stable-2.0
in repository guile.

commit 6bfd298c56d7797201bb45c740c3ceb2eb19f17c
Author: Ludovic Courtès <address@hidden>
Date:   Tue Jun 2 21:08:03 2015 +0200

    gdb: Support builds with SCM_DEBUG_TYPING_STRICTNESS=2.
    
    * libguile/libguile-2.0-gdb.scm (scm-value->integer): New procedure.
      (%scm-pretty-printer): Use it instead of 'value->integer'.
---
 libguile/libguile-2.0-gdb.scm |   14 +++++++++++++-
 1 files changed, 13 insertions(+), 1 deletions(-)

diff --git a/libguile/libguile-2.0-gdb.scm b/libguile/libguile-2.0-gdb.scm
index ce4a41a..d91ae56 100644
--- a/libguile/libguile-2.0-gdb.scm
+++ b/libguile/libguile-2.0-gdb.scm
@@ -48,6 +48,18 @@ if the information is not available."
                 (name       (value-field type-descr "name")))
            (value->string name)))))
 
+(define (scm-value->integer value)
+  "Return the integer value of VALUE, which is assumed to be a GDB value
+corresponding to an 'SCM' object."
+  (let ((type (type-strip-typedefs (value-type value))))
+    (cond ((= (type-code type) TYPE_CODE_UNION)
+           ;; SCM_DEBUG_TYPING_STRICTNESS = 2
+           (value->integer (value-field (value-field value "n")
+                                        "n")))
+          (else
+           ;; SCM_DEBUG_TYPING_STRICTNESS = 1
+           (value->integer value)))))
+
 (define %gdb-memory-backend
   ;; The GDB back-end to access the inferior's memory.
   (let ((void* (type-pointer (lookup-type "void"))))
@@ -130,7 +142,7 @@ if the information is not available."
      (let ((name (type-name (value-type value))))
        (and (and name (string=? name "SCM"))
             (make-scm-pretty-printer-worker
-             (scm->object (value->integer value) %gdb-memory-backend)))))))
+             (scm->object (scm-value->integer value) %gdb-memory-backend)))))))
 
 (define* (register-pretty-printer #:optional objfile)
   (prepend-pretty-printer! objfile %scm-pretty-printer))



reply via email to

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