[PATCH] guile: Compile and install Scheme files.

[ludo@gnu.org (Ludovic Courtès)]

[-- 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