[Guile-commits] 01/01: Allow GDB support to be used with GDB-linked-against-Guile-2.0.

[Ludovic Courtès]

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

commit 81d2e352663bc5f80734312fec90f250b1fbe2e4
Author: Ludovic Courtès <address@hidden>
Date:   Sun Nov 5 18:21:35 2017 +0100

    Allow GDB support to be used with GDB-linked-against-Guile-2.0.
    
    * libguile/Makefile.am (INSTANTIATE): New variable.
    (install-data-hook): Use it.
    * libguile/libguile-2.2-gdb.scm: Autoload (system vm debug).
    Augment %load-path and %load-compiled-path, and reload (system base
    types).
    * module/system/base/types.scm: Remove #:hide to be 2.0-compatible.
    Use (system syntax internal) conditionally when on 2.2.
---
 libguile/Makefile.am          | 12 ++++++++++--
 libguile/libguile-2.2-gdb.scm | 19 +++++++++++++++++--
 module/system/base/types.scm  | 30 ++++++++++++++++++++----------
 3 files changed, 47 insertions(+), 14 deletions(-)

diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 2214a4a..a9646d8 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -1,7 +1,7 @@
 ## Process this file with Automake to create Makefile.in
 ##
 ##   Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007,
-##     2008, 2009, 2010, 2011, 2012, 2013, 2014, 2016 Free Software 
Foundation, Inc.
+##     2008, 2009, 2010, 2011, 2012, 2013, 2014, 2016, 2017 Free Software 
Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
@@ -468,6 +468,13 @@ address@hidden@_la_SOURCES = _scm.h                \
 install-exec-hook:
        rm -f $(DESTDIR)$(bindir)/guile-snarf.awk
 
+## Instantiate a template.
+INSTANTIATE =                                                                  
 \
+  $(SED) -e 's,address@hidden@],$(pkgdatadir),g'                               
 \
+         -e 's,address@hidden@],$(pkglibdir),g'                                
  \
+         -e 's,address@hidden@],$(GUILE_EFFECTIVE_VERSION),g'      \
+         -i
+
 install-data-hook: libguile-2.2-gdb.scm
        @$(MKDIR_P) $(DESTDIR)$(libdir)
 ## We want to install libguile-2.2-gdb.scm as SOMETHING-gdb.scm.
@@ -491,7 +498,8 @@ install-data-hook: libguile-2.2-gdb.scm
        echo " $(INSTALL_DATA) $<                               \
 $(DESTDIR)$(libdir)/$$libname-gdb.scm";                                \
        $(INSTALL_DATA) "$<"                                    \
-           "$(DESTDIR)$(libdir)/$$libname-gdb.scm"
+           "$(DESTDIR)$(libdir)/$$libname-gdb.scm";            \
+       $(INSTANTIATE) "$(DESTDIR)$(libdir)/$$libname-gdb.scm"
 
 # Remove the GDB support file and the Info 'dir' file that
 # 'install-info' 5.x installs.
diff --git a/libguile/libguile-2.2-gdb.scm b/libguile/libguile-2.2-gdb.scm
index 5a9bd25..02b3437 100644
--- a/libguile/libguile-2.2-gdb.scm
+++ b/libguile/libguile-2.2-gdb.scm
@@ -1,6 +1,6 @@
 ;;; GDB debugging support for Guile.
 ;;;
-;;; Copyright 2014, 2015 Free Software Foundation, Inc.
+;;; Copyright 2014, 2015, 2017 Free Software Foundation, Inc.
 ;;;
 ;;; This program is free software; you can redistribute it and/or modify it
 ;;; under the terms of the GNU General Public License as published by
@@ -17,7 +17,13 @@
 
 (define-module (guile-gdb)
   #:use-module (system base types)
-  #:use-module (system vm debug)
+
+  ;; Note: (system vm debug) is 2.2-specific, but GDB might be built
+  ;; with Guile 2.0.
+  #:autoload   (system vm debug) (debug-context-from-image
+                                  debug-context-base
+                                  find-program-debug-info)
+
   #:use-module ((gdb) #:hide (symbol? frame?))
   #:use-module ((gdb) #:select ((symbol? . gdb:symbol?) (frame? . gdb:frame?)))
   #:use-module (gdb printing)
@@ -40,6 +46,15 @@
 ;;;
 ;;; Code:
 
+;; At run time, make sure we load (system base types) from the Guile
+;; being debugged rather than from the Guile GDB is linked against.
+(set! %load-path
+  (cons "@pkgdatadir@/@GUILE_EFFECTIVE_VERSION@" %load-path))
+(set! %load-compiled-path
+  (cons "@pkglibdir@/@GUILE_EFFECTIVE_VERSION@/site-ccache" 
%load-compiled-path))
+(reload-module (resolve-module '(system base types)))
+
+
 (define (type-name-from-descriptor descriptor-array type-number)
   "Return the name of the type TYPE-NUMBER as seen in DESCRIPTOR-ARRAY, or #f
 if the information is not available."
diff --git a/module/system/base/types.scm b/module/system/base/types.scm
index 49aea27..a3d8a66 100644
--- a/module/system/base/types.scm
+++ b/module/system/base/types.scm
@@ -16,16 +16,15 @@
 
 (define-module (system base types)
   #:use-module (rnrs bytevectors)
-  #:use-module ((rnrs io ports) #:hide (bytevector->string))
+  #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-60)
-  #:use-module (system syntax internal)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 iconv)
+  #:use-module ((ice-9 iconv) #:prefix iconv:)
   #:use-module (ice-9 format)
   #:use-module (ice-9 vlist)
   #:use-module (system foreign)
@@ -49,6 +48,12 @@
 
             scm->object))
 
+;; This module can be loaded from GDB-linked-against-2.0, so use 2.2
+;; features conditionally.
+(cond-expand
+  (guile-2.2 (use-modules (system syntax internal))) ;for 'make-syntax'
+  (else #t))
+
 ;;; Commentary:
 ;;;
 ;;; 'SCM' type tag decoding, primarily to support Guile debugging in GDB.
@@ -420,12 +425,13 @@ using BACKEND."
              (($ <stringbuf> string)
               (substring string start (+ start len)))))
           (((_ & #x047f = %tc7-stringbuf) len (bytevector buf len))
-           (stringbuf (bytevector->string buf "ISO-8859-1")))
+           (stringbuf (iconv:bytevector->string buf "ISO-8859-1")))
           (((_ & #x047f = (bitwise-ior #x400 %tc7-stringbuf))
             len (bytevector buf (* 4 len)))
-           (stringbuf (bytevector->string buf (match (native-endianness)
-                                                ('little "UTF-32LE")
-                                                ('big "UTF-32BE")))))
+           (stringbuf (iconv:bytevector->string buf
+                                                (match (native-endianness)
+                                                  ('little "UTF-32LE")
+                                                  ('big "UTF-32BE")))))
           (((_ & #x7f = %tc7-bytevector) len address)
            (let ((bv-port (memory-port backend address len)))
              (get-bytevector-n bv-port len)))
@@ -467,9 +473,13 @@ using BACKEND."
           (((_ & #x7f = %tc7-keyword) symbol)
            (symbol->keyword (cell->object symbol backend)))
           (((_ & #x7f = %tc7-syntax) expression wrap module)
-           (make-syntax (cell->object expression backend)
-                        (cell->object wrap backend)
-                        (cell->object module backend)))
+           (cond-expand
+             (guile-2.2
+              (make-syntax (cell->object expression backend)
+                           (cell->object wrap backend)
+                           (cell->object module backend)))
+             (else
+              (inferior-object 'syntax address))))
           (((_ & #x7f = %tc7-vm-continuation))
            (inferior-object 'vm-continuation address))
           (((_ & #x7f = %tc7-weak-set))