[PATCH] guile: Compile and install Scheme files.

Ludovic Courtès
2014-06-20T21:35:37Z

[-- Attachment #1: Type: text/plain, Size: 1780 bytes --]

This patch compiles Scheme code under data-directory/.

Another option would have been to compile them from gdb/Makefile, and
then simply copy them to data-directory/. It seemed more consistent to
handle everything under data-directory/ though. WDYT?

Thanks,
Ludo’.

gdb/
2014-06-20 Ludovic Courtès <ludo@gnu.org>

* acinclude.m4 (GDB_GUILE_PROGRAM_NAMES): New macro.
* configure.ac ["${have_libguile}" != no]: Use it.
* configure: Regenerate.
* data-directory/Makefile.in (GUILE_FILES): Rename to...
(GUILE_SOURCE_FILES): ... this. New variable.
(GUILE_COMPILED_FILES): New variable.
(GUILE_FILES, GUILD, GUILD_COMPILE_FLAGS, COMPILE_SCM_FILE)
(.SUFFIXES): New variables.
(stamp-guile): Depend on $(GUILE_SOURCE_FILES). Build all of
$(GUILE_SOURCE_FILES) with $(COMPILE_SCM_FILE).
* guile/guile.c (boot_guile_support, handle_boot_error): New
functions.
(initialize_scheme_side): Use them and 'scm_c_catch' in lieu of
'gdbscm_safe_source_script'.
* guile/lib/gdb.scm: Remove 'add-to-load-path' call.
* guile/lib/boot.scm: Augment '%load-path' and
'%load-compiled-path'. Remove 'load' call, and use
'load-compiled' for 'gdb.go'.
* guile/lib/init.scm (%initialize): Remove 'add-to-load-path'
call.
---
gdb/acinclude.m4 | 28 ++++++++++++++++++++++
gdb/configure | 30 ++++++++++++++++++++++++
gdb/configure.ac | 3 +++
gdb/data-directory/Makefile.in | 48 +++++++++++++++++++++++++++++++-------
gdb/guile/guile.c | 53 ++++++++++++++++++++++++++++--------------
gdb/guile/lib/gdb.scm | 3 ---
gdb/guile/lib/gdb/boot.scm | 16 +++++++++----
gdb/guile/lib/gdb/init.scm | 3 ---
8 files changed, 147 insertions(+), 37 deletions(-)

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 10157 bytes --]

diff --git a/gdb/acinclude.m4 b/gdb/acinclude.m4
index 01d0fd3..3260989 100644
--- a/gdb/acinclude.m4
+++ b/gdb/acinclude.m4
@@ -473,3 +473,31 @@ AC_DEFUN([GDB_AC_CHECK_BFD], [
CFLAGS=$OLD_CFLAGS
LDFLAGS=$OLD_LDFLAGS
LIBS=$OLD_LIBS])
+
+dnl GDB_GUILE_PROGRAM_NAMES([PKG-CONFIG], [VERSION])
+dnl
+dnl Define and substitute 'GUILD' to contain the absolute file name of
+dnl the 'guild' command for VERSION, using PKG-CONFIG. (This is
+dnl similar to Guile's 'GUILE_PROGS' macro.)
+AC_DEFUN([GDB_GUILE_PROGRAM_NAMES], [
+ AC_CACHE_CHECK([for the absolute file name of the 'guild' command],
+ [ac_cv_guild_program_name],
+ [ac_cv_guild_program_name="`$1 $2 --variable guild`"
+
+ # In Guile up to 2.0.11 included, guile-2.0.pc would not define
+ # the 'guild' and 'bindir' variables. In that case, try to guess
+ # what the program name is, at the risk of getting it wrong if
+ # Guile was configured with '--program-suffix' or similar.
+ if test "x$ac_cv_guild_program_name" = "x"; then
+ guile_exec_prefix="`$1 $2 --variable exec_prefix`"
+ ac_cv_guild_program_name="$guile_exec_prefix/bin/guild"
+ fi
+ ])
+
+ if ! "$ac_cv_guild_program_name" --version >/dev/null 2>&1; then
+ AC_MSG_ERROR(['$ac_cv_guild_program_name' appears to be unusable])
+ fi
+
+ GUILD="$ac_cv_guild_program_name"
+ AC_SUBST([GUILD])
+])
diff --git a/gdb/configure b/gdb/configure
index 05ebace..5b8ab36 100755
--- a/gdb/configure
+++ b/gdb/configure
@@ -660,6 +660,7 @@ RDYNAMIC
ALLOCA
GUILE_LIBS
GUILE_CPPFLAGS
+GUILD
pkg_config_prog_path
PYTHON_LIBS
PYTHON_CPPFLAGS
@@ -9069,6 +9070,35 @@ esac

if test "${have_libguile}" != no; then

+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for the absolute file name of the 'guild' command" >&5
+$as_echo_n "checking for the absolute file name of the 'guild' command... " >&6; }
+if test "${ac_cv_guild_program_name+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_cv_guild_program_name="`"${pkg_config_prog_path}" "${guile_version}" --variable guild`"
+
+ # In Guile up to 2.0.11 included, guile-2.0.pc would not define
+ # the 'guild' and 'bindir' variables. In that case, try to guess
+ # what the program name is, at the risk of getting it wrong if
+ # Guile was configured with '--program-suffix' or similar.
+ if test "x$ac_cv_guild_program_name" = "x"; then
+ guile_exec_prefix="`"${pkg_config_prog_path}" "${guile_version}" --variable exec_prefix`"
+ ac_cv_guild_program_name="$guile_exec_prefix/bin/guild"
+ fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_guild_program_name" >&5
+$as_echo "$ac_cv_guild_program_name" >&6; }
+
+ if ! "$ac_cv_guild_program_name" --version >/dev/null 2>&1; then
+ as_fn_error "'$ac_cv_guild_program_name' appears to be unusable" "$LINENO" 5
+ fi
+
+ GUILD="$ac_cv_guild_program_name"
+
+
+
+
$as_echo "#define HAVE_GUILE 1" >>confdefs.h

CONFIG_OBS="$CONFIG_OBS \$(SUBDIR_GUILE_OBS)"
diff --git a/gdb/configure.ac b/gdb/configure.ac
index 138fc85..cfd2d0d 100644
--- a/gdb/configure.ac
+++ b/gdb/configure.ac
@@ -1194,6 +1194,9 @@ yes)
esac

if test "${have_libguile}" != no; then
+ dnl Get the name of the 'guild' program.
+ GDB_GUILE_PROGRAM_NAMES(["${pkg_config_prog_path}"], ["${guile_version}"])
+
AC_DEFINE(HAVE_GUILE, 1, [Define if Guile interpreter is being linked in.])
CONFIG_OBS="$CONFIG_OBS \$(SUBDIR_GUILE_OBS)"
CONFIG_DEPS="$CONFIG_DEPS \$(SUBDIR_GUILE_DEPS)"
diff --git a/gdb/data-directory/Makefile.in b/gdb/data-directory/Makefile.in
index b9fcc03..ff1174e 100644
--- a/gdb/data-directory/Makefile.in
+++ b/gdb/data-directory/Makefile.in
@@ -77,15 +77,39 @@ PYTHON_FILES = \

GUILE_DIR = guile
GUILE_INSTALL_DIR = $(DESTDIR)$(GDB_DATADIR)/$(GUILE_DIR)
-GUILE_FILES = \
- ./gdb.scm \
- gdb/boot.scm \
- gdb/experimental.scm \
- gdb/init.scm \
- gdb/iterator.scm \
- gdb/printing.scm \
+
+GUILE_SOURCE_FILES = \
+ ./gdb.scm \
+ gdb/boot.scm \
+ gdb/experimental.scm \
+ gdb/init.scm \
+ gdb/iterator.scm \
+ gdb/printing.scm \
gdb/types.scm

+GUILE_COMPILED_FILES = \
+ ./gdb.go \
+ gdb/experimental.go \
+ gdb/iterator.go \
+ gdb/printing.go \
+ gdb/types.go
+
+GUILE_FILES = $(GUILE_SOURCE_FILES) $(GUILE_COMPILED_FILES)
+
+GUILD = @GUILD@
+
+# Flags passed to 'guild compile'.
+# XXX: We can't use -Wunbound-variable because all the variables
+# defined in C aren't visible when we compile.
+GUILD_COMPILE_FLAGS = \
+ -Warity-mismatch -Wformat -Wunused-toplevel
+
+# Command to compile a .scm file.
+COMPILE_SCM_FILE = \
+ "@GUILD@" compile -L $(GUILE_SRCDIR) $(GUILD_COMPILE_FLAGS)
+
+.SUFFIXES: .scm .go
+
SYSTEM_GDBINIT_DIR = system-gdbinit
SYSTEM_GDBINIT_INSTALL_DIR = $(DESTDIR)$(GDB_DATADIR)/$(SYSTEM_GDBINIT_DIR)
SYSTEM_GDBINIT_FILES = \
@@ -209,14 +233,20 @@ uninstall-python:
done \
done

-stamp-guile: Makefile $(GUILE_FILES)
+stamp-guile: Makefile $(GUILE_SOURCE_FILES)
rm -rf ./$(GUILE_DIR)
- files='$(GUILE_FILES)' ; \
+ files='$(GUILE_SOURCE_FILES)' ; \
for file in $$files ; do \
dir=`echo "$$file" | sed 's,/[^/]*$$,,'` ; \
$(INSTALL_DIR) ./$(GUILE_DIR)/$$dir ; \
$(INSTALL_DATA) $(GUILE_SRCDIR)/$$file ./$(GUILE_DIR)/$$dir ; \
done
+ files='$(GUILE_COMPILED_FILES)' ; \
+ for file in $$files; do \
+ source="`echo $$file | sed 's/\.go$$/.scm/'`" ; \
+ $(COMPILE_SCM_FILE) -o "$(GUILE_DIR)/$$file" \
+ "$(GUILE_DIR)/$$source" ; \
+ done
touch $@

.PHONY: clean-guile
diff --git a/gdb/guile/guile.c b/gdb/guile/guile.c
index b77cbf1..30a5174 100644
--- a/gdb/guile/guile.c
+++ b/gdb/guile/guile.c
@@ -483,6 +483,39 @@ Return the name of the target configuration." },
END_FUNCTIONS
};

+/* Load BOOT_SCM_FILE, the first Scheme file that gets loaded. */
+
+static SCM
+boot_guile_support (void *boot_scm_file)
+{
+ /* Load boot.scm without compiling it. The other files should have been
+ compiled already, and boot.scm is expected to adjust
+ '%load-compiled-path' accordingly. */
+ return scm_c_primitive_load ((const char *) boot_scm_file);
+}
+
+/* Handle an exception thrown while loading BOOT_SCM_FILE. */
+
+static SCM
+handle_boot_error (void *boot_scm_file, SCM tag, SCM args)
+{
+ const char *fmt;
+
+ fmt = _("Exception caught while booting Guile: ~s ~s~%");
+ scm_simple_format (scm_current_error_port (),
+ scm_from_latin1_string (fmt),
+ scm_list_2 (tag, args));
+
+ warning (_("\n"
+ "Could not complete Guile gdb module initialization from:\n"
+ "%s.\n"
+ "Limited Guile support is available.\n"
+ "Suggest passing --data-directory=/path/to/gdb/data-directory.\n"),
+ (const char *) boot_scm_file);
+
+ return SCM_UNSPECIFIED;
+}
+
/* Load gdb/boot.scm, the Scheme side of GDB/Guile support.
Note: This function assumes it's called within the gdb module. */

@@ -492,25 +525,9 @@ initialize_scheme_side (void)
char *gdb_guile_dir = concat (gdb_datadir, SLASH_STRING, "guile", NULL);
char *boot_scm_path = concat (gdb_guile_dir, SLASH_STRING, "gdb",
SLASH_STRING, boot_scm_filename, NULL);
- char *msg;

- /* While scm_c_primitive_load works, the loaded code is not compiled,
- instead it is left to be interpreted. Eh?
- Anyways, this causes a ~100x slowdown, so we only use it to load
- gdb/boot.scm, and then let boot.scm do the rest. */
- msg = gdbscm_safe_source_script (boot_scm_path);
-
- if (msg != NULL)
- {
- fprintf_filtered (gdb_stderr, "%s", msg);
- xfree (msg);
- warning (_("\n"
- "Could not complete Guile gdb module initialization from:\n"
- "%s.\n"
- "Limited Guile support is available.\n"
- "Suggest passing --data-directory=/path/to/gdb/data-directory.\n"),
- boot_scm_path);
- }
+ scm_c_catch (SCM_BOOL_T, boot_guile_support, boot_scm_path,
+ handle_boot_error, boot_scm_path, NULL, NULL);

xfree (gdb_guile_dir);
xfree (boot_scm_path);
diff --git a/gdb/guile/lib/gdb.scm b/gdb/guile/lib/gdb.scm
index 8072860..343ec4e 100644
--- a/gdb/guile/lib/gdb.scm
+++ b/gdb/guile/lib/gdb.scm
@@ -494,9 +494,6 @@
;; Load the rest of the Scheme side.
;; data-directory is provided by the C code.

-(add-to-load-path
- (string-append (data-directory) file-name-separator-string "guile"))
-
(include "gdb/init.scm")

;; These come from other files, but they're really part of this module.
diff --git a/gdb/guile/lib/gdb/boot.scm b/gdb/guile/lib/gdb/boot.scm
index 0d775d4..febd716 100644
--- a/gdb/guile/lib/gdb/boot.scm
+++ b/gdb/guile/lib/gdb/boot.scm
@@ -21,10 +21,18 @@
;; loaded with it are not compiled. So we do very little here, and do
;; most of the initialization elsewhere.

-;; data-directory is provided by the C code.
-(load (string-append
- (data-directory) file-name-separator-string "guile"
- file-name-separator-string "gdb.scm"))
+;; Initialize the source and compiled file search paths.
+;; Note: 'data-directory' is provided by the C code.
+(let ((module-dir (string-append (data-directory)
+ file-name-separator-string "guile")))
+ (set! %load-path (cons module-dir %load-path))
+ (set! %load-compiled-path (cons module-dir %load-compiled-path)))
+
+;; Load the (gdb) module. This need to be done here because C code relies on
+;; the availability of Scheme bindings such as '%print-exception-with-stack'.
+;; Note: as of Guile 2.0.11, 'primitive-load' evaluates the code and 'load'
+;; somehow ignores the '.go', hence 'load-compiled'.
+(load-compiled (search-path %load-compiled-path "gdb.go"))

;; Now that the Scheme side support is loaded, initialize it.
(let ((init-proc (@@ (gdb) %initialize!)))
diff --git a/gdb/guile/lib/gdb/init.scm b/gdb/guile/lib/gdb/init.scm
index d4145e5..834e61d 100644
--- a/gdb/guile/lib/gdb/init.scm
+++ b/gdb/guile/lib/gdb/init.scm
@@ -151,9 +151,6 @@
;; GDB+Guile.

(define (%initialize!)
- (add-to-load-path (string-append (data-directory)
- file-name-separator-string "guile"))
-
(for-each (lambda (key)
(set-exception-printer! key %exception-printer))
%exception-keys)
--
1.8.4