X-Git-Url: http://git.efficios.com/?a=blobdiff_plain;f=gdb%2Fguile%2Fguile.c;h=d745c56ec68aa07e041193aa449b9589bd1787a8;hb=228c8f4be0c428369ec6b68e25696863d1e62ed7;hp=6bc078f779160d65a57f97cc3fcce038fbc61ba0;hpb=74edf51613b507d1f27d66360cd8fdd8a253e88a;p=deliverable%2Fbinutils-gdb.git diff --git a/gdb/guile/guile.c b/gdb/guile/guile.c index 6bc078f779..d745c56ec6 100644 --- a/gdb/guile/guile.c +++ b/gdb/guile/guile.c @@ -1,6 +1,6 @@ /* 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. @@ -21,24 +21,22 @@ conventions, et.al. */ #include "defs.h" -#include #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 "gdbsupport/version.h" #ifdef HAVE_GUILE #include "guile.h" #include "guile-internal.h" -#ifdef HAVE_GC_GC_H -#include /* PR 17185 */ -#endif #endif +#include +#include "gdbsupport/block-signals.h" /* The Guile version we're using. We *could* use the macros in libguile/version.h but that would preclude @@ -49,8 +47,10 @@ 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"; @@ -72,33 +72,6 @@ static const char *const guile_print_excp_enums[] = the default. */ const char *gdbscm_print_excp = gdbscm_print_excp_message; -#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; -#endif - -/* The main struct describing GDB's interface to the Guile - extension language. */ -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 @@ -120,7 +93,7 @@ static SCM to_string_keyword; /* 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"; @@ -131,6 +104,7 @@ static 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 }; @@ -157,19 +131,39 @@ static const struct extension_language_ops guile_extension_ops = gdbscm_breakpoint_cond_says_stop, NULL, /* gdbscm_check_quit_flag, */ - NULL, /* gdbscm_clear_quit_flag, */ NULL, /* gdbscm_set_quit_flag, */ }; +#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); @@ -186,8 +180,6 @@ guile_repl_command (char *arg, int from_tty) dont_repeat (); gdbscm_enter_repl (); } - - do_cleanups (cleanup); } /* Implementation of the gdb "guile" command. @@ -197,34 +189,25 @@ guile_repl_command (char *arg, int from_tty) 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 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 @@ -243,7 +226,7 @@ compute_scheme_string (struct command_line *l) 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) { @@ -265,24 +248,16 @@ static void 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 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. @@ -304,7 +279,7 @@ gdbscm_source_script (const struct extension_language_defn *extlang, } } -/* (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 @@ -312,52 +287,35 @@ gdbscm_execute_gdb_command (SCM command_scm, SCM rest) { 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 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, 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); - } - 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 */ @@ -365,7 +323,7 @@ gdbscm_execute_gdb_command (SCM command_scm, SCM rest) 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 */ @@ -406,7 +364,7 @@ gdbscm_target_config (void) 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) @@ -415,7 +373,7 @@ guile_repl_command (char *arg, int from_tty) } static void -guile_command (char *arg, int from_tty) +guile_command (const char *arg, int from_tty) { arg = skip_spaces (arg); if (arg && *arg) @@ -424,11 +382,9 @@ guile_command (char *arg, int from_tty) { /* 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 ()); } } @@ -443,7 +399,7 @@ 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) +set_guile_command (const char *args, int from_tty) { help_list (set_guile_list, "set guile ", all_commands, gdb_stdout); } @@ -451,7 +407,7 @@ set_guile_command (char *args, int from_tty) /* 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, ""); } @@ -461,7 +417,7 @@ show_guile_command (char *args, int 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")); @@ -474,7 +430,7 @@ info_guile_command (char *args, int from_tty) 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\ @@ -487,29 +443,135 @@ Execute the given GDB command.\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." }, 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."), + (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. */ @@ -517,29 +579,14 @@ static void 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); - /* 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); } @@ -610,6 +657,10 @@ call_initialize_gdb_module (void *data) 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; } @@ -648,6 +699,9 @@ gdbscm_set_backtrace (int enable) #endif /* HAVE_GUILE */ +/* See guile.h. */ +cmd_list_element *guile_cmd_element = nullptr; + /* Install the various gdb commands used by Guile. */ static void @@ -673,7 +727,7 @@ This command is only a placeholder.") /* 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\ @@ -738,45 +792,47 @@ message == an error message without a stack will be printed."), &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 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. */ - - /* PR 17185 There are problems with using libgc 7.4.0. - Copy over the workaround Guile uses (Guile is working around a different - problem, but the workaround is the same). */ -#if (GC_VERSION_MAJOR == 7 && GC_VERSION_MINOR == 4 && GC_VERSION_MICRO == 0) - /* The bug is only known to appear with pthreads. We assume any system - using pthreads also uses setenv (and not putenv). That is why we don't - have a similar call to putenv here. */ -#if defined (HAVE_SETENV) - setenv ("GC_MARKERS", "1", 1); -#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 - /* 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); + /* 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; + + /* 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 }