diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 2214a4aa3..a9646d883 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 @@ 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. diff --git a/libguile/libguile-2.2-gdb.scm b/libguile/libguile-2.2-gdb.scm index 5a9bd254a..02b343743 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 0678e1548..c6aaed242 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) @@ -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." (($ 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))) @@ -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) - (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))