From e76c5d173bbf7137555919dd136004a7c0118af7 Mon Sep 17 00:00:00 2001 From: Doug Evans Date: Sat, 26 Jul 2014 18:16:27 -0700 Subject: 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. --- gdb/ChangeLog | 23 ++++++++ gdb/acinclude.m4 | 72 ++++++++++++++++++++++++ gdb/configure | 64 +++++++++++++++++++++ gdb/configure.ac | 13 +++++ gdb/data-directory/Makefile.in | 40 +++++++++++-- gdb/guile/guile.c | 124 +++++++++++++++++++++++++++++++++++------ gdb/guile/lib/gdb/boot.scm | 17 +++++- gdb/guile/lib/gdb/init.scm | 6 ++ 8 files changed, 334 insertions(+), 25 deletions(-) (limited to 'gdb') diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 3520177..69bac01 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -2,6 +2,29 @@ Doug Evans 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 + Doug Evans + + PR guile/17146 * data-directory/Makefile.in (GUILE_FILES): Add support.scm. * guile/lib/gdb/support.scm: New file. * guile/guile.c (gdbscm_init_module_name): Change to "gdb". diff --git a/gdb/acinclude.m4 b/gdb/acinclude.m4 index 01d0fd3..a3fb9e2 100644 --- a/gdb/acinclude.m4 +++ b/gdb/acinclude.m4 @@ -473,3 +473,75 @@ 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 >&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=. +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]) +]) diff --git a/gdb/configure b/gdb/configure index 98f653a..809326a 100755 --- a/gdb/configure +++ b/gdb/configure @@ -662,6 +662,8 @@ HAVE_GUILE_FALSE HAVE_GUILE_TRUE GUILE_LIBS GUILE_CPPFLAGS +GUILD_TARGET_FLAG +GUILD pkg_config_prog_path HAVE_PYTHON_FALSE HAVE_PYTHON_TRUE @@ -9081,6 +9083,68 @@ 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 CONFIG_OBS="$CONFIG_OBS \$(SUBDIR_GUILE_OBS)" diff --git a/gdb/configure.ac b/gdb/configure.ac index 48b3615..70d0964 100644 --- a/gdb/configure.ac +++ b/gdb/configure.ac @@ -1195,6 +1195,19 @@ 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}"]) + + 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)" CONFIG_DEPS="$CONFIG_DEPS \$(SUBDIR_GUILE_DEPS)" diff --git a/gdb/data-directory/Makefile.in b/gdb/data-directory/Makefile.in index b05dba5..509f888 100644 --- a/gdb/data-directory/Makefile.in +++ b/gdb/data-directory/Makefile.in @@ -80,7 +80,8 @@ PYTHON_FILE_LIST = \ 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 \ @@ -90,9 +91,31 @@ GUILE_FILE_LIST = \ 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 ) 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 = \ @@ -222,15 +245,22 @@ uninstall-python: 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 $@ diff --git a/gdb/guile/guile.c b/gdb/guile/guile.c index e81cb4c..1c0923d 100644 --- a/gdb/guile/guile.c +++ b/gdb/guile/guile.c @@ -510,6 +510,111 @@ 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 (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. */ @@ -523,23 +628,8 @@ initialize_scheme_side (void) 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); } diff --git a/gdb/guile/lib/gdb/boot.scm b/gdb/guile/lib/gdb/boot.scm index 6159354..9463f10 100644 --- a/gdb/guile/lib/gdb/boot.scm +++ b/gdb/guile/lib/gdb/boot.scm @@ -21,9 +21,20 @@ ;; 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!))) diff --git a/gdb/guile/lib/gdb/init.scm b/gdb/guile/lib/gdb/init.scm index 98888ed..53cce2e 100644 --- a/gdb/guile/lib/gdb/init.scm +++ b/gdb/guile/lib/gdb/init.scm @@ -147,6 +147,12 @@ (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!)) ;; Public routines. -- cgit v1.1