* acinclude.m4 (GDB_GUILE_PROGRAM_NAMES): New macro.
(GDB_GUILD_TARGET_FLAG, GDB_TRY_GUILD): New macros.
* configure.ac: Try to use guild to compile an scm file, if it fails
then disable guile support.
* configure: Regenerate.
* data-directory/Makefile.in (GUILE_SOURCE_FILES): Renamed from
GUILE_FILE_LIST.
(GUILE_COMPILED_FILES): New variable.
(GUILE_FILES) Update.
(GUILD, GUILD_TARGET_FLAG, GUILD_COMPILE_FLAGS): New variables.
(stamp-guile): Compile scm files.
* guile/guile.c (boot_guile_support): New function.
(standard_throw_args_p): New function.
(print_standard_throw_error, print_throw_error): New functions.
(handle_boot_error): New function.
(initialize_scheme_side): Rewrite to call boot_guile_support.
* guile/lib/gdb/boot.scm: Update %load-compiled-path. Load gdb.go.
* guile/lib/gdb/init.scm (%silence-compiler-warnings%): New function.
+2014-07-26 Ludovic Courtès <ludo@gnu.org>
+ Doug Evans <xdje42@gmail.com>
+
+ PR guile/17146
+ * acinclude.m4 (GDB_GUILE_PROGRAM_NAMES): New macro.
+ (GDB_GUILD_TARGET_FLAG, GDB_TRY_GUILD): New macros.
+ * configure.ac: Try to use guild to compile an scm file, if it fails
+ then disable guile support.
+ * configure: Regenerate.
+ * data-directory/Makefile.in (GUILE_SOURCE_FILES): Renamed from
+ GUILE_FILE_LIST.
+ (GUILE_COMPILED_FILES): New variable.
+ (GUILE_FILES) Update.
+ (GUILD, GUILD_TARGET_FLAG, GUILD_COMPILE_FLAGS): New variables.
+ (stamp-guile): Compile scm files.
+ * guile/guile.c (boot_guile_support): New function.
+ (standard_throw_args_p): New function.
+ (print_standard_throw_error, print_throw_error): New functions.
+ (handle_boot_error): New function.
+ (initialize_scheme_side): Rewrite to call boot_guile_support.
+ * guile/lib/gdb/boot.scm: Update %load-compiled-path. Load gdb.go.
+ * guile/lib/gdb/init.scm (%silence-compiler-warnings%): New function.
+
2014-07-26 Ludovic Courtès <ludo@gnu.org>
Doug Evans <xdje42@gmail.com>
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 >&AS_MESSAGE_LOG_FD 2>&AS_MESSAGE_LOG_FD; then
+ AC_MSG_ERROR(['$ac_cv_guild_program_name' appears to be unusable])
+ fi
+
+ GUILD="$ac_cv_guild_program_name"
+ AC_SUBST([GUILD])
+])
+
+dnl GDB_GUILD_TARGET_FLAG
+dnl
+dnl Compute the value of GUILD_TARGET_FLAG.
+dnl For native builds this is empty.
+dnl For cross builds this is --target=<host>.
+AC_DEFUN([GDB_GUILD_TARGET_FLAG], [
+ if test "$cross_compiling" = no; then
+ GUILD_TARGET_FLAG=
+ else
+ GUILD_TARGET_FLAG="--target=$host"
+ fi
+ AC_SUBST(GUILD_TARGET_FLAG)
+])
+
+dnl GDB_TRY_GUILD([SRC-FILE])
+dnl
+dnl We precompile the .scm files and install them with gdb, so make sure
+dnl guild works for this host.
+dnl The .scm files are precompiled for several reasons:
+dnl 1) To silence Guile during gdb startup (Guile's auto-compilation output
+dnl is unnecessarily verbose).
+dnl 2) Make gdb developers see compilation errors/warnings during the build,
+dnl and not leave it to later when the user runs gdb.
+dnl 3) As a convenience for the user, so that one copy of the files is built
+dnl instead of one copy per user.
+dnl
+dnl Make sure guild can handle this host by trying to compile SRC-FILE, and
+dnl setting ac_cv_guild_ok to yes or no.
+dnl Note that guild can handle cross-compilation.
+dnl It could happen that guild can't handle the host, but guile would still
+dnl work. For the time being we're conservative, and if guild doesn't work
+dnl we punt.
+AC_DEFUN([GDB_TRY_GUILD], [
+ AC_REQUIRE([GDB_GUILD_TARGET_FLAG])
+ AC_CACHE_CHECK([whether guild supports this host],
+ [ac_cv_guild_ok],
+ [echo "$ac_cv_guild_program_name compile $GUILD_TARGET_FLAG -o conftest.go $1" >&AS_MESSAGE_LOG_FD
+ if "$ac_cv_guild_program_name" compile $GUILD_TARGET_FLAG -o conftest.go "$1" >&AS_MESSAGE_LOG_FD 2>&AS_MESSAGE_LOG_FD; then
+ ac_cv_guild_ok=yes
+ else
+ ac_cv_guild_ok=no
+ fi])
+])
HAVE_GUILE_TRUE
GUILE_LIBS
GUILE_CPPFLAGS
+GUILD_TARGET_FLAG
+GUILD
pkg_config_prog_path
HAVE_PYTHON_FALSE
HAVE_PYTHON_TRUE
;;
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 >&5 2>&5; then
+ as_fn_error "'$ac_cv_guild_program_name' appears to be unusable" "$LINENO" 5
+ fi
+
+ GUILD="$ac_cv_guild_program_name"
+
+
+
+
+ if test "$cross_compiling" = no; then
+ GUILD_TARGET_FLAG=
+ else
+ GUILD_TARGET_FLAG="--target=$host"
+ fi
+
+
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether guild supports this host" >&5
+$as_echo_n "checking whether guild supports this host... " >&6; }
+if test "${ac_cv_guild_ok+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ echo "$ac_cv_guild_program_name compile $GUILD_TARGET_FLAG -o conftest.go $srcdir/guile/lib/gdb/support.scm" >&5
+ if "$ac_cv_guild_program_name" compile $GUILD_TARGET_FLAG -o conftest.go "$srcdir/guile/lib/gdb/support.scm" >&5 2>&5; then
+ ac_cv_guild_ok=yes
+ else
+ ac_cv_guild_ok=no
+ fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_guild_ok" >&5
+$as_echo "$ac_cv_guild_ok" >&6; }
+
+ if test "$ac_cv_guild_ok" = no; then
+ have_libguile=no
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: disabling guile support" >&5
+$as_echo "$as_me: WARNING: disabling guile support" >&2;}
+ fi
+fi
+
if test "${have_libguile}" != no; then
$as_echo "#define HAVE_GUILE 1" >>confdefs.h
;;
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}"])
+
+ dnl Make sure guild can handle this host.
+ GDB_TRY_GUILD([$srcdir/guile/lib/gdb/support.scm])
+ dnl If not, disable guile support.
+ if test "$ac_cv_guild_ok" = no; then
+ have_libguile=no
+ AC_MSG_WARN(disabling guile support, $GUILD fails compiling for $host)
+ fi
+fi
+
if test "${have_libguile}" != no; then
AC_DEFINE(HAVE_GUILE, 1, [Define if Guile interpreter is being linked in.])
CONFIG_OBS="$CONFIG_OBS \$(SUBDIR_GUILE_OBS)"
GUILE_DIR = guile
GUILE_INSTALL_DIR = $(DESTDIR)$(GDB_DATADIR)/$(GUILE_DIR)
-GUILE_FILE_LIST = \
+
+GUILE_SOURCE_FILES = \
./gdb.scm \
gdb/boot.scm \
gdb/experimental.scm \
gdb/support.scm \
gdb/types.scm
-@HAVE_GUILE_TRUE@GUILE_FILES = $(GUILE_FILE_LIST)
+GUILE_COMPILED_FILES = \
+ ./gdb.go \
+ gdb/experimental.go \
+ gdb/iterator.go \
+ gdb/printing.go \
+ gdb/support.go \
+ gdb/types.go
+
+@HAVE_GUILE_TRUE@GUILE_FILES = $(GUILE_SOURCE_FILES) $(GUILE_COMPILED_FILES)
@HAVE_GUILE_FALSE@GUILE_FILES =
+GUILD = @GUILD@
+GUILD_TARGET_FLAG = @GUILD_TARGET_FLAG@
+
+# Flags passed to 'guild compile'.
+# Note: We can't use -Wunbound-variable because all the variables
+# defined in C aren't visible when we compile.
+# Note: To work around a guile 2.0.5 issue (it can't find gdb/init.scm even if
+# we pass -L <dir>) we have to compile in the directory containing gdb.scm.
+# We still need to pass "-L ." so that other modules are found.
+GUILD_COMPILE_FLAGS = \
+ $(GUILD_TARGET_FLAG) \
+ -Warity-mismatch -Wformat -Wunused-toplevel \
+ -L .
+
SYSTEM_GDBINIT_DIR = system-gdbinit
SYSTEM_GDBINIT_INSTALL_DIR = $(DESTDIR)$(GDB_DATADIR)/$(SYSTEM_GDBINIT_DIR)
SYSTEM_GDBINIT_FILES = \
done ; \
fi
-stamp-guile: Makefile $(GUILE_FILES)
+stamp-guile: Makefile $(GUILE_SOURCE_FILES)
rm -rf ./$(GUILE_DIR)
- files='$(GUILE_FILES)' ; \
- if test "x$$files" != x ; then \
+ if test "x$(GUILE_FILES)" != x ; then \
+ 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)' ; \
+ cd ./$(GUILE_DIR) ; \
+ for go in $$files ; do \
+ source="`echo $$go | sed 's/\.go$$/.scm/'`" ; \
+ echo $(GUILD) compile $(GUILD_COMPILE_FLAGS) -o "$$go" "$$source" ; \
+ $(GUILD) compile $(GUILD_COMPILE_FLAGS) -o "$$go" "$$source" || exit 1 ; \
+ done ; \
fi
touch $@
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 (there's no need to compile it).
+ The other files should have been compiled already, and boot.scm is
+ expected to adjust '%load-compiled-path' accordingly. If they haven't
+ been compiled, Guile will auto-compile them. The important thing to keep
+ in mind is that there's a >= 100x speed difference between compiled and
+ non-compiled files. */
+ return scm_c_primitive_load ((const char *) boot_scm_file);
+}
+
+/* Return non-zero if ARGS has the "standard" format for throw args.
+ The standard format is:
+ (function format-string (format-string-args-list) ...).
+ FUNCTION is #f if no function was recorded. */
+
+static int
+standard_throw_args_p (SCM args)
+{
+ if (gdbscm_is_true (scm_list_p (args))
+ && scm_ilength (args) >= 3)
+ {
+ /* The function in which the error occurred. */
+ SCM arg0 = scm_list_ref (args, scm_from_int (0));
+ /* The format string. */
+ SCM arg1 = scm_list_ref (args, scm_from_int (1));
+ /* The arguments of the format string. */
+ SCM arg2 = scm_list_ref (args, scm_from_int (2));
+
+ if ((scm_is_string (arg0) || gdbscm_is_false (arg0))
+ && scm_is_string (arg1)
+ && gdbscm_is_true (scm_list_p (arg2)))
+ return 1;
+ }
+
+ return 0;
+}
+
+/* Print the error recorded in a "standard" throw args. */
+
+static void
+print_standard_throw_error (SCM args)
+{
+ /* The function in which the error occurred. */
+ SCM arg0 = scm_list_ref (args, scm_from_int (0));
+ /* The format string. */
+ SCM arg1 = scm_list_ref (args, scm_from_int (1));
+ /* The arguments of the format string. */
+ SCM arg2 = scm_list_ref (args, scm_from_int (2));
+
+ /* ARG0 is #f if no function was recorded. */
+ if (gdbscm_is_true (arg0))
+ {
+ scm_simple_format (scm_current_error_port (),
+ scm_from_latin1_string (_("Error in function ~s:~%")),
+ scm_list_1 (arg0));
+ }
+ scm_simple_format (scm_current_error_port (), arg1, arg2);
+}
+
+/* Print the error message recorded in KEY, ARGS, the arguments to throw.
+ Normally we let Scheme print the error message.
+ This function is used when Scheme initialization fails.
+ We can still use the Scheme C API though. */
+
+static void
+print_throw_error (SCM key, SCM args)
+{
+ /* IWBN to call gdbscm_print_exception_with_stack here, but Guile didn't
+ boot successfully so play it safe and avoid it. The "format string" and
+ its args are embedded in ARGS, but the content of ARGS depends on KEY.
+ Make sure ARGS has the expected canonical content before trying to use
+ it. */
+ if (standard_throw_args_p (args))
+ print_standard_throw_error (args);
+ else
+ {
+ scm_simple_format (scm_current_error_port (),
+ scm_from_latin1_string (_("Throw to key `~a' with args `~s'.~%")),
+ scm_list_2 (key, args));
+ }
+}
+
+/* Handle an exception thrown while loading BOOT_SCM_FILE. */
+
+static SCM
+handle_boot_error (void *boot_scm_file, SCM key, SCM args)
+{
+ fprintf_unfiltered (gdb_stderr, ("Exception caught while booting Guile.\n"));
+
+ print_throw_error (key, args);
+
+ fprintf_unfiltered (gdb_stderr, "\n");
+ warning (_("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. */
boot_scm_path = concat (guile_datadir, SLASH_STRING, "gdb",
SLASH_STRING, boot_scm_filename, NULL);
- /* 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 (boot_scm_path);
}
;; loaded with it are not compiled. So we do very little here, and do
;; most of the initialization elsewhere.
-;; guile-data-directory is provided by the C code.
-(add-to-load-path (guile-data-directory))
-(load-from-path "gdb.scm")
+;; Initialize the source and compiled file search paths.
+;; Note: 'guile-data-directory' is provided by the C code.
+(let ((module-dir (guile-data-directory)))
+ (set! %load-path (cons module-dir %load-path))
+ (set! %load-compiled-path (cons module-dir %load-compiled-path)))
+
+;; Load the (gdb) module. This needs 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'.
+(let ((gdb-go-file (search-path %load-compiled-path "gdb.go")))
+ (if gdb-go-file
+ (load-compiled gdb-go-file)
+ (error "Unable to find gdb.go file.")))
;; Now that the Scheme side support is loaded, initialize it.
(let ((init-proc (@@ (gdb) %initialize!)))
(set! %orig-input-port (set-current-input-port (input-port)))
(set! %orig-output-port (set-current-output-port (output-port)))
(set! %orig-error-port (set-current-error-port (error-port))))
+
+;; Dummy routine to silence "possibly unused local top-level variable"
+;; warnings from the compiler.
+
+(define-public (%silence-compiler-warnings%)
+ (list %print-exception-with-stack %initialize!))
\f
;; Public routines.
projects / deliverable / binutils-gdb.git / commitdiff
