/* General GDB/Guile code.
- Copyright (C) 2014-2015 Free Software Foundation, Inc.
+ Copyright (C) 2014-2023 Free Software Foundation, Inc.
This file is part of GDB.
#include "cli/cli-utils.h"
#include "command.h"
#include "gdbcmd.h"
-#include "interps.h"
+#include "top.h"
+#include "ui.h"
#include "extension-priv.h"
#include "utils.h"
-#include "version.h"
+#include "gdbsupport/version.h"
#ifdef HAVE_GUILE
#include "guile.h"
#include "guile-internal.h"
#endif
#include <signal.h>
+#include "gdbsupport/block-signals.h"
/* The Guile version we're using.
We *could* use the macros in libguile/version.h but that would preclude
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";
the default. */
const char *gdbscm_print_excp = gdbscm_print_excp_message;
-#ifdef HAVE_GUILE
-/* Forward decls, these are defined later. */
-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. */
-EXPORTED_CONST struct extension_language_defn extension_language_guile =
-{
- EXT_LANG_GUILE,
- "guile",
- "Guile",
-
- ".scm",
- "-gdb.scm",
-
- guile_control,
-
-#ifdef HAVE_GUILE
- &guile_extension_script_ops,
- &guile_extension_ops
-#else
- NULL,
- NULL
-#endif
-};
\f
#ifdef HAVE_GUILE
-static void gdbscm_finish_initialization
- (const struct extension_language_defn *);
+static void gdbscm_initialize (const struct extension_language_defn *);
static int gdbscm_initialized (const struct extension_language_defn *);
static void gdbscm_eval_from_control_command
(const struct extension_language_defn *, struct command_line *);
static script_sourcer_func gdbscm_source_script;
+static void gdbscm_set_backtrace (int enable);
int gdb_scheme_initialized;
/* The interface between gdb proper and loading of python scripts. */
-const struct extension_language_script_ops guile_extension_script_ops =
+static const struct extension_language_script_ops guile_extension_script_ops =
{
gdbscm_source_script,
gdbscm_source_objfile_script,
/* The interface between gdb proper and guile scripting. */
-const struct extension_language_ops guile_extension_ops =
+static const struct extension_language_ops guile_extension_ops =
{
- gdbscm_finish_initialization,
+ gdbscm_initialize,
gdbscm_initialized,
gdbscm_eval_from_control_command,
gdbscm_breakpoint_has_cond,
gdbscm_breakpoint_cond_says_stop,
- NULL, /* gdbscm_check_quit_flag, */
- NULL, /* gdbscm_clear_quit_flag, */
NULL, /* gdbscm_set_quit_flag, */
+ NULL, /* gdbscm_check_quit_flag, */
+ NULL, /* gdbscm_before_prompt, */
+ NULL, /* gdbscm_get_matching_xmethod_workers */
+ NULL, /* gdbscm_colorize */
+ NULL, /* gdbscm_print_insn */
+};
+#endif
+
+/* The main struct describing GDB's interface to the Guile
+ extension language. */
+extern const struct extension_language_defn extension_language_guile =
+{
+ EXT_LANG_GUILE,
+ "guile",
+ "Guile",
+
+ ".scm",
+ "-gdb.scm",
+
+ guile_control,
+
+#ifdef HAVE_GUILE
+ &guile_extension_script_ops,
+ &guile_extension_ops
+#else
+ NULL,
+ NULL
+#endif
};
+#ifdef HAVE_GUILE
/* 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.
gdbscm_source_script (const struct extension_language_defn *extlang,
FILE *file, const char *filename)
{
- char *msg = gdbscm_safe_source_script (filename);
+ gdb::unique_xmalloc_ptr<char> msg = gdbscm_safe_source_script (filename);
if (msg != NULL)
- {
- fprintf_filtered (gdb_stderr, "%s\n", msg);
- xfree (msg);
- }
+ gdb_printf (gdb_stderr, "%s\n", msg.get ());
}
\f
/* (execute string [#:from-tty boolean] [#:to-string boolean])
int from_tty = 0, to_string = 0;
const SCM keywords[] = { from_tty_keyword, to_string_keyword, SCM_BOOL_F };
char *command;
- char *result = NULL;
- struct cleanup *cleanups;
- struct gdb_exception except = exception_none;
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
+ 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);
+ execute_command_to_string (to_string_res, command, from_tty, false);
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);
- }
- CATCH (ex, RETURN_MASK_ALL)
- {
- except = ex;
- }
- END_CATCH
-
- 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 */
static SCM
gdbscm_data_directory (void)
{
- return gdbscm_scm_from_c_string (gdb_datadir);
+ return gdbscm_scm_from_c_string (gdb_datadir.c_str ());
}
/* (guile-data-directory) -> string */
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 ());
}
}
static struct cmd_list_element *show_guile_list;
static struct cmd_list_element *info_guile_list;
-/* Function for use by 'set guile' prefix command. */
-
-static void
-set_guile_command (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)
-{
- cmd_show_list (show_guile_list, from_tty, "");
-}
-
-/* The "info scheme" command is defined as a prefix, with
- allow_unknown 0. Therefore, its own definition is called only for
- "info scheme" with no args. */
-
-static void
-info_guile_command (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 ", 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." },
- { "guile-data-directory", 0, 0, 0, gdbscm_guile_data_directory,
+ { "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, gdbscm_gdb_version,
+ { "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." },
static SCM
handle_boot_error (void *boot_scm_file, SCM key, SCM args)
{
- fprintf_unfiltered (gdb_stderr, ("Exception caught while booting Guile.\n"));
+ gdb_printf (gdb_stderr, ("Exception caught while booting Guile.\n"));
print_throw_error (key, args);
- fprintf_unfiltered (gdb_stderr, "\n");
+ gdb_printf (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"),
+ "Suggest passing --data-directory=/path/to/gdb/data-directory."),
(const char *) boot_scm_file);
return SCM_UNSPECIFIED;
initialize_scheme_side (void)
{
char *boot_scm_path;
- char *msg;
- guile_datadir = concat (gdb_datadir, SLASH_STRING, "guile", NULL);
+ guile_datadir = concat (gdb_datadir.c_str (), SLASH_STRING, "guile",
+ (char *) NULL);
boot_scm_path = concat (guile_datadir, SLASH_STRING, "gdb",
- SLASH_STRING, boot_scm_filename, NULL);
+ SLASH_STRING, boot_scm_filename, (char *) NULL);
scm_c_catch (SCM_BOOL_T, boot_guile_support, boot_scm_path,
handle_boot_error, boot_scm_path, NULL, NULL);
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". */
+/* A callback to initialize Guile after gdb has finished all its
+ initialization. This is the extension_language_ops.initialize "method". */
static void
-gdbscm_finish_initialization (const struct extension_language_defn *extlang)
+gdbscm_initialize (const struct extension_language_defn *extlang)
{
+#if HAVE_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. */
+
+#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
+
+ /* Before we initialize Guile, block signals needed by gdb (especially
+ 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. */
+ {
+ gdb::block_signals blocker;
+
+ /* There are libguile versions (f.i. v3.0.5) that by default call
+ mp_get_memory_functions during initialization to install custom
+ libgmp memory functions. This is considered a bug and should be
+ fixed starting v3.0.6.
+ Before gdb commit 880ae75a2b7 "gdb delay guile initialization until
+ gdbscm_finish_initialization", that bug had no effect for gdb,
+ because gdb subsequently called mp_get_memory_functions to install
+ its own custom functions in _initialize_gmp_utils. However, since
+ aforementioned gdb commit the initialization order is reversed,
+ allowing libguile to install a custom malloc that is incompatible
+ with the custom free as used in gmp-utils.c, resulting in a
+ "double free or corruption (out)" error.
+ Work around the libguile bug by disabling the installation of the
+ libgmp memory functions by guile initialization. */
+
+ /* The scm_install_gmp_memory_functions variable should be removed after
+ version 3.0, so limit usage to 3.0 and before. */
+#if SCM_MAJOR_VERSION < 3 || (SCM_MAJOR_VERSION == 3 && SCM_MINOR_VERSION == 0)
+ /* This variable is deprecated in Guile 3.0.8 and later but remains
+ available in the whole 3.0 series. */
+#pragma GCC diagnostic push
+#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
+ scm_install_gmp_memory_functions = 0;
+#pragma GCC diagnostic pop
+#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);
+ }
+
+ /* 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
+
/* Restore the environment to the user interaction one. */
scm_set_current_module (scm_interaction_environment ());
}
#endif /* HAVE_GUILE */
+/* See guile.h. */
+cmd_list_element *guile_cmd_element = nullptr;
+
/* Install the various gdb commands used by Guile. */
static void
install_gdb_commands (void)
{
- add_com ("guile-repl", class_obscure,
- guile_repl_command,
+ cmd_list_element *guile_repl_cmd
+ = add_com ("guile-repl", class_obscure, guile_repl_command,
#ifdef HAVE_GUILE
_("\
Start an interactive Guile prompt.\n\
This command is only a placeholder.")
#endif /* HAVE_GUILE */
);
- add_com_alias ("gr", "guile-repl", class_obscure, 1);
+ add_com_alias ("gr", guile_repl_cmd, class_obscure, 1);
/* 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\
This command is only a placeholder.")
#endif /* HAVE_GUILE */
);
- add_com_alias ("gu", "guile", class_obscure, 1);
-
- add_prefix_cmd ("guile", class_obscure, set_guile_command,
- _("Prefix command for Guile preference settings."),
- &set_guile_list, "set guile ", 0,
- &setlist);
- add_alias_cmd ("gu", "guile", class_obscure, 1, &setlist);
-
- add_prefix_cmd ("guile", class_obscure, show_guile_command,
- _("Prefix command for Guile preference settings."),
- &show_guile_list, "show guile ", 0,
- &showlist);
- add_alias_cmd ("gu", "guile", class_obscure, 1, &showlist);
-
- add_prefix_cmd ("guile", class_obscure, info_guile_command,
- _("Prefix command for Guile info displays."),
- &info_guile_list, "info guile ", 0,
- &infolist);
- add_info_alias ("gu", "guile", 1);
+ add_com_alias ("gu", guile_cmd_element, class_obscure, 1);
+
+ set_show_commands setshow_guile_cmds
+ = add_setshow_prefix_cmd ("guile", class_obscure,
+ _("\
+Prefix command for Guile preference settings."),
+ _("\
+Prefix command for Guile preference settings."),
+ &set_guile_list, &show_guile_list,
+ &setlist, &showlist);
+
+ add_alias_cmd ("gu", setshow_guile_cmds.set, class_obscure, 1, &setlist);
+ add_alias_cmd ("gu", setshow_guile_cmds.show, class_obscure, 1, &showlist);
+
+ cmd_list_element *info_guile_cmd
+ = add_basic_prefix_cmd ("guile", class_obscure,
+ _("Prefix command for Guile info displays."),
+ &info_guile_list, 0, &infolist);
+ add_info_alias ("gu", info_guile_cmd, 1);
/* The name "print-stack" is carried over from Python.
A better name is "print-exception". */
&set_guile_list, &show_guile_list);
}
-/* Provide a prototype to silence -Wmissing-prototypes. */
-extern initialize_file_ftype _initialize_guile;
-
+void _initialize_guile ();
void
-_initialize_guile (void)
+_initialize_guile ()
{
install_gdb_commands ();
-
-#if HAVE_GUILE
- {
-#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. */
-
-#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);
- }
-#endif
}
projects / binutils-gdb.git / blobdiff