Merge until 81d2e35266 from stable-2.2

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 @@ EXTRA_libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = _scm.h		\
 install-exec-hook:
 	rm -f $(DESTDIR)$(bindir)/guile-snarf.awk
 
+## Instantiate a template.
+INSTANTIATE =                                                                   \
+  $(SED) -e 's,[@]pkgdatadir[@],$(pkgdatadir),g'                                \
+         -e 's,[@]pkglibdir[@],$(pkglibdir),g'                                  \
+         -e 's,[@]GUILE_EFFECTIVE_VERSION[@],$(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.

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."

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)
@@ -50,6 +49,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.
@@ -379,12 +384,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)
+           (stringbuf (iconv:bytevector->string buf
-                                                ('little "UTF-32LE")
+                                                (match (native-endianness)
-                                                ('big "UTF-32BE")))))
+                                                  ('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)))
@@ -426,9 +432,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)
+           (cond-expand
-                        (cell->object wrap backend)
+             (guile-2.2
-                        (cell->object module backend)))
+              (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))