/* General GDB/Guile code.
- Copyright (C) 2014 Free Software Foundation, Inc.
+ Copyright (C) 2014-2019 Free Software Foundation, Inc.
This file is part of GDB.
conventions, et.al. */
#include "defs.h"
-#include <string.h>
#include "breakpoint.h"
#include "cli/cli-cmds.h"
#include "cli/cli-script.h"
#include "cli/cli-utils.h"
#include "command.h"
#include "gdbcmd.h"
-#include "interps.h"
+#include "top.h"
#include "extension-priv.h"
#include "utils.h"
-#include "version.h"
+#include "common/version.h"
#ifdef HAVE_GUILE
#include "guile.h"
#include "guile-internal.h"
#endif
+#include <signal.h>
+
+/* The Guile version we're using.
+ We *could* use the macros in libguile/version.h but that would preclude
+ handling the user switching in a different version with, e.g.,
+ LD_LIBRARY_PATH (using a different version than what gdb was compiled with
+ is not something to be done lightly, but can be useful). */
+int gdbscm_guile_major_version;
+int gdbscm_guile_minor_version;
+int gdbscm_guile_micro_version;
+
+#ifdef HAVE_GUILE
+/* The guile subdirectory within gdb's data-directory. */
+static const char *guile_datadir;
+#endif
/* Declared constants and enum for guile exception printing. */
const char gdbscm_print_excp_none[] = "none";
#ifdef HAVE_GUILE
/* Forward decls, these are defined later. */
-static const struct extension_language_script_ops guile_extension_script_ops;
-static const struct extension_language_ops guile_extension_ops;
+extern const struct extension_language_script_ops guile_extension_script_ops;
+extern const struct extension_language_ops guile_extension_ops;
#endif
/* The main struct describing GDB's interface to the Guile
extension language. */
-const struct extension_language_defn extension_language_guile =
+extern const struct extension_language_defn extension_language_guile =
{
EXT_LANG_GUILE,
"guile",
/* The name of the various modules (without the surrounding parens). */
const char gdbscm_module_name[] = "gdb";
-const char gdbscm_init_module_name[] = "gdb init";
+const char gdbscm_init_module_name[] = "gdb";
/* The name of the bootstrap file. */
static const char boot_scm_filename[] = "boot.scm";
/* The interface between gdb proper and loading of python scripts. */
-static const struct extension_language_script_ops guile_extension_script_ops =
+const struct extension_language_script_ops guile_extension_script_ops =
{
gdbscm_source_script,
gdbscm_source_objfile_script,
+ gdbscm_execute_objfile_script,
gdbscm_auto_load_enabled
};
/* The interface between gdb proper and guile scripting. */
-static const struct extension_language_ops guile_extension_ops =
+const struct extension_language_ops guile_extension_ops =
{
gdbscm_finish_initialization,
gdbscm_initialized,
gdbscm_breakpoint_cond_says_stop,
NULL, /* gdbscm_check_quit_flag, */
- NULL, /* gdbscm_clear_quit_flag, */
NULL, /* gdbscm_set_quit_flag, */
};
/* Implementation of the gdb "guile-repl" command. */
static void
-guile_repl_command (char *arg, int from_tty)
+guile_repl_command (const char *arg, int from_tty)
{
- struct cleanup *cleanup;
-
- cleanup = make_cleanup_restore_integer (&interpreter_async);
- interpreter_async = 0;
+ scoped_restore restore_async = make_scoped_restore (¤t_ui->async, 0);
arg = skip_spaces (arg);
dont_repeat ();
gdbscm_enter_repl ();
}
-
- do_cleanups (cleanup);
}
/* Implementation of the gdb "guile" command.
TODO: Add the result to Guile's history? */
static void
-guile_command (char *arg, int from_tty)
+guile_command (const char *arg, int from_tty)
{
- struct cleanup *cleanup;
-
- cleanup = make_cleanup_restore_integer (&interpreter_async);
- interpreter_async = 0;
+ scoped_restore restore_async = make_scoped_restore (¤t_ui->async, 0);
arg = skip_spaces (arg);
if (arg && *arg)
{
- char *msg = gdbscm_safe_eval_string (arg, 1);
+ gdb::unique_xmalloc_ptr<char> msg = gdbscm_safe_eval_string (arg, 1);
if (msg != NULL)
- {
- make_cleanup (xfree, msg);
- error ("%s", msg);
- }
+ error ("%s", msg.get ());
}
else
{
- struct command_line *l = get_command_line (guile_control, "");
+ counted_command_line l = get_command_line (guile_control, "");
- make_cleanup_free_command_lines (&l);
- execute_control_command_untraced (l);
+ execute_control_command_untraced (l.get ());
}
-
- do_cleanups (cleanup);
}
/* Given a command_line, return a command string suitable for passing
for (iter = l; iter; iter = iter->next)
size += strlen (iter->line) + 1;
- script = xmalloc (size + 1);
+ script = (char *) xmalloc (size + 1);
here = 0;
for (iter = l; iter; iter = iter->next)
{
gdbscm_eval_from_control_command
(const struct extension_language_defn *extlang, struct command_line *cmd)
{
- char *script, *msg;
- struct cleanup *cleanup;
+ char *script;
- if (cmd->body_count != 1)
+ if (cmd->body_list_1 != nullptr)
error (_("Invalid \"guile\" block structure."));
- cleanup = make_cleanup (null_cleanup, NULL);
-
- script = compute_scheme_string (cmd->body_list[0]);
- msg = gdbscm_safe_eval_string (script, 0);
+ script = compute_scheme_string (cmd->body_list_0.get ());
+ gdb::unique_xmalloc_ptr<char> msg = gdbscm_safe_eval_string (script, 0);
xfree (script);
if (msg != NULL)
- {
- make_cleanup (xfree, msg);
- error ("%s", msg);
- }
-
- do_cleanups (cleanup);
+ error ("%s", msg.get ());
}
/* Read a file as Scheme code.
}
}
\f
-/* (execute string [#:from-tty boolean] [#:to-string boolean\
+/* (execute string [#:from-tty boolean] [#:to-string boolean])
A Scheme function which evaluates a string using the gdb CLI. */
static SCM
{
int from_tty_arg_pos = -1, to_string_arg_pos = -1;
int from_tty = 0, to_string = 0;
- volatile struct gdb_exception except;
const SCM keywords[] = { from_tty_keyword, to_string_keyword, SCM_BOOL_F };
char *command;
- char *result = NULL;
- struct cleanup *cleanups;
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#tt",
command_scm, &command, rest,
&from_tty_arg_pos, &from_tty,
&to_string_arg_pos, &to_string);
- /* Note: The contents of "command" may get modified while it is
- executed. */
- cleanups = make_cleanup (xfree, command);
-
- TRY_CATCH (except, RETURN_MASK_ALL)
+ return gdbscm_wrap ([=]
{
- struct cleanup *inner_cleanups;
+ gdb::unique_xmalloc_ptr<char> command_holder (command);
+ std::string to_string_res;
- inner_cleanups = make_cleanup_restore_integer (&interpreter_async);
- interpreter_async = 0;
+ scoped_restore restore_async = make_scoped_restore (¤t_ui->async,
+ 0);
- prevent_dont_repeat ();
+ scoped_restore preventer = prevent_dont_repeat ();
if (to_string)
- result = execute_command_to_string (command, from_tty);
+ to_string_res = execute_command_to_string (command, from_tty);
else
- {
- execute_command (command, from_tty);
- result = NULL;
- }
+ execute_command (command, from_tty);
/* Do any commands attached to breakpoint we stopped at. */
bpstat_do_actions ();
- do_cleanups (inner_cleanups);
- }
- do_cleanups (cleanups);
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
-
- if (result)
- {
- SCM r = gdbscm_scm_from_c_string (result);
- xfree (result);
- return r;
- }
- return SCM_UNSPECIFIED;
+ if (to_string)
+ return gdbscm_scm_from_c_string (to_string_res.c_str ());
+ return SCM_UNSPECIFIED;
+ });
}
/* (data-directory) -> string */
return gdbscm_scm_from_c_string (gdb_datadir);
}
+/* (guile-data-directory) -> string */
+
+static SCM
+gdbscm_guile_data_directory (void)
+{
+ return gdbscm_scm_from_c_string (guile_datadir);
+}
+
/* (gdb-version) -> string */
static SCM
commands. */
static void
-guile_repl_command (char *arg, int from_tty)
+guile_repl_command (const char *arg, int from_tty)
{
arg = skip_spaces (arg);
if (arg && *arg)
}
static void
-guile_command (char *arg, int from_tty)
+guile_command (const char *arg, int from_tty)
{
arg = skip_spaces (arg);
if (arg && *arg)
{
/* Even if Guile isn't enabled, we still have to slurp the
command list to the corresponding "end". */
- struct command_line *l = get_command_line (guile_control, "");
- struct cleanup *cleanups = make_cleanup_free_command_lines (&l);
+ counted_command_line l = get_command_line (guile_control, "");
- execute_control_command_untraced (l);
- do_cleanups (cleanups);
+ execute_control_command_untraced (l.get ());
}
}
/* Function for use by 'set guile' prefix command. */
static void
-set_guile_command (char *args, int from_tty)
+set_guile_command (const char *args, int from_tty)
{
help_list (set_guile_list, "set guile ", all_commands, gdb_stdout);
}
/* Function for use by 'show guile' prefix command. */
static void
-show_guile_command (char *args, int from_tty)
+show_guile_command (const char *args, int from_tty)
{
cmd_show_list (show_guile_list, from_tty, "");
}
"info scheme" with no args. */
static void
-info_guile_command (char *args, int from_tty)
+info_guile_command (const char *args, int from_tty)
{
printf_unfiltered (_("\"info guile\" must be followed"
" by the name of an info command.\n"));
- help_list (info_guile_list, "info guile ", -1, gdb_stdout);
+ help_list (info_guile_list, "info guile ", all_commands, gdb_stdout);
}
\f
/* Initialization. */
static const scheme_function misc_guile_functions[] =
{
- { "execute", 1, 0, 1, gdbscm_execute_gdb_command,
+ { "execute", 1, 0, 1, as_a_scm_t_subr (gdbscm_execute_gdb_command),
"\
Execute the given GDB command.\n\
\n\
Returns: The result of the command if #:to-string is true.\n\
Otherwise returns unspecified." },
- { "data-directory", 0, 0, 0, gdbscm_data_directory,
+ { "data-directory", 0, 0, 0, as_a_scm_t_subr (gdbscm_data_directory),
"\
Return the name of GDB's data directory." },
- { "gdb-version", 0, 0, 0, gdbscm_gdb_version,
+ { "guile-data-directory", 0, 0, 0,
+ as_a_scm_t_subr (gdbscm_guile_data_directory),
+ "\
+Return the name of the Guile directory within GDB's data directory." },
+
+ { "gdb-version", 0, 0, 0, as_a_scm_t_subr (gdbscm_gdb_version),
"\
Return GDB's version string." },
- { "host-config", 0, 0, 0, gdbscm_host_config,
+ { "host-config", 0, 0, 0, as_a_scm_t_subr (gdbscm_host_config),
"\
Return the name of the host configuration." },
- { "target-config", 0, 0, 0, gdbscm_target_config,
+ { "target-config", 0, 0, 0, as_a_scm_t_subr (gdbscm_target_config),
"\
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. */
static void
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;
+ char *boot_scm_path;
- /* 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);
+ guile_datadir = concat (gdb_datadir, SLASH_STRING, "guile", (char *) NULL);
+ boot_scm_path = concat (guile_datadir, SLASH_STRING, "gdb",
+ SLASH_STRING, boot_scm_filename, (char *) NULL);
- 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);
}
static void
initialize_gdb_module (void *data)
{
+ /* Computing these is a pain, so only do it once.
+ Also, do it here and save the result so that obtaining the values
+ is thread-safe. */
+ gdbscm_guile_major_version = gdbscm_scm_string_to_int (scm_major_version ());
+ gdbscm_guile_minor_version = gdbscm_scm_string_to_int (scm_minor_version ());
+ gdbscm_guile_micro_version = gdbscm_scm_string_to_int (scm_micro_version ());
+
/* The documentation symbol needs to be defined before any calls to
gdbscm_define_{variables,functions}. */
gdbscm_documentation_symbol = scm_from_latin1_symbol ("documentation");
gdbscm_initialize_auto_load ();
gdbscm_initialize_blocks ();
gdbscm_initialize_breakpoints ();
+ gdbscm_initialize_commands ();
gdbscm_initialize_disasm ();
gdbscm_initialize_frames ();
gdbscm_initialize_iterators ();
gdbscm_initialize_lazy_strings ();
gdbscm_initialize_math ();
gdbscm_initialize_objfiles ();
+ gdbscm_initialize_parameters ();
gdbscm_initialize_ports ();
gdbscm_initialize_pretty_printers ();
+ gdbscm_initialize_pspaces ();
gdbscm_initialize_strings ();
gdbscm_initialize_symbols ();
gdbscm_initialize_symtabs ();
gdb_scheme_initialized = 1;
}
+/* Utility to call scm_c_define_module+initialize_gdb_module from
+ within scm_with_guile. */
+
+static void *
+call_initialize_gdb_module (void *data)
+{
+ /* Most of the initialization is done by initialize_gdb_module.
+ It is called via scm_c_define_module so that the initialization is
+ performed within the desired module. */
+ scm_c_define_module (gdbscm_module_name, initialize_gdb_module, NULL);
+
+#if HAVE_GUILE_MANUAL_FINALIZATION
+ scm_run_finalizers ();
+#endif
+
+ return NULL;
+}
+
/* A callback to finish Guile initialization after gdb has finished all its
initialization.
This is the extension_language_ops.finish_initialization "method". */
#endif /* HAVE_GUILE */
+/* See guile.h. */
+cmd_list_element *guile_cmd_element = nullptr;
+
/* Install the various gdb commands used by Guile. */
static void
/* Since "help guile" is easy to type, and intuitive, we add general help
in using GDB+Guile to this command. */
- add_com ("guile", class_obscure, guile_command,
+ guile_cmd_element = add_com ("guile", class_obscure, guile_command,
#ifdef HAVE_GUILE
_("\
Evaluate one or more Guile expressions.\n\
&set_guile_list, &show_guile_list);
}
-/* Provide a prototype to silence -Wmissing-prototypes. */
-extern initialize_file_ftype _initialize_guile;
-
void
_initialize_guile (void)
{
- char *msg;
-
install_gdb_commands ();
#if HAVE_GUILE
- /* The Guile docs say scm_init_guile isn't as portable as the other Guile
- initialization routines. However, this is the easiest to use.
- We can switch to a more portable routine if/when the need arises
- and if it can be used with gdb. */
- scm_init_guile ();
-
- /* The Python support puts the C side in module "_gdb", leaving the Python
- side to define module "gdb" which imports "_gdb". There is evidently no
- similar convention in Guile so we skip this. */
-
- /* The rest of the initialization is done by initialize_gdb_module.
- scm_c_define_module is used as it allows us to perform the initialization
- within the desired module. */
- scm_c_define_module (gdbscm_module_name, initialize_gdb_module, NULL);
+ {
+#ifdef HAVE_SIGPROCMASK
+ sigset_t sigchld_mask, prev_mask;
+#endif
+
+ /* The Python support puts the C side in module "_gdb", leaving the Python
+ side to define module "gdb" which imports "_gdb". There is evidently no
+ similar convention in Guile so we skip this. */
+
+#if HAVE_GUILE_MANUAL_FINALIZATION
+ /* Our SMOB free functions are not thread-safe, as GDB itself is not
+ intended to be thread-safe. Disable automatic finalization so that
+ finalizers aren't run in other threads. */
+ scm_set_automatic_finalization_enabled (0);
+#endif
+
+#ifdef HAVE_SIGPROCMASK
+ /* Before we initialize Guile, block SIGCHLD.
+ This is done so that all threads created during Guile initialization
+ have SIGCHLD blocked. PR 17247.
+ Really libgc and Guile should do this, but we need to work with
+ libgc 7.4.x. */
+ sigemptyset (&sigchld_mask);
+ sigaddset (&sigchld_mask, SIGCHLD);
+ sigprocmask (SIG_BLOCK, &sigchld_mask, &prev_mask);
+#endif
+
+ /* scm_with_guile is the most portable way to initialize Guile.
+ Plus we need to initialize the Guile support while in Guile mode
+ (e.g., called from within a call to scm_with_guile). */
+ scm_with_guile (call_initialize_gdb_module, NULL);
+
+#ifdef HAVE_SIGPROCMASK
+ sigprocmask (SIG_SETMASK, &prev_mask, NULL);
+#endif
- /* Set Guile's backtrace to match the "set guile print-stack" default.
- [N.B. The two settings are still separate.]
- But only do this after we've initialized Guile, it's nice to see a
- backtrace if there's an error during initialization.
- OTOH, if the error is that gdb/init.scm wasn't found because gdb is being
- run from the build tree, the backtrace is more noise than signal.
- Sigh. */
- gdbscm_set_backtrace (0);
+ /* Set Guile's backtrace to match the "set guile print-stack" default.
+ [N.B. The two settings are still separate.]
+ But only do this after we've initialized Guile, it's nice to see a
+ backtrace if there's an error during initialization.
+ OTOH, if the error is that gdb/init.scm wasn't found because gdb is
+ being run from the build tree, the backtrace is more noise than signal.
+ Sigh. */
+ gdbscm_set_backtrace (0);
+ }
#endif
}
projects / deliverable / binutils-gdb.git / blobdiff