Home | History | Annotate | Line # | Download | only in guile
      1 /* General GDB/Guile code.
      2 
      3    Copyright (C) 2014-2024 Free Software Foundation, Inc.
      4 
      5    This file is part of GDB.
      6 
      7    This program is free software; you can redistribute it and/or modify
      8    it under the terms of the GNU General Public License as published by
      9    the Free Software Foundation; either version 3 of the License, or
     10    (at your option) any later version.
     11 
     12    This program is distributed in the hope that it will be useful,
     13    but WITHOUT ANY WARRANTY; without even the implied warranty of
     14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     15    GNU General Public License for more details.
     16 
     17    You should have received a copy of the GNU General Public License
     18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
     19 
     20 /* See README file in this directory for implementation notes, coding
     21    conventions, et.al.  */
     22 
     23 #include "breakpoint.h"
     24 #include "cli/cli-cmds.h"
     25 #include "cli/cli-script.h"
     26 #include "cli/cli-utils.h"
     27 #include "command.h"
     28 #include "top.h"
     29 #include "ui.h"
     30 #include "extension-priv.h"
     31 #include "utils.h"
     32 #include "gdbsupport/version.h"
     33 #ifdef HAVE_GUILE
     34 #include "guile.h"
     35 #include "guile-internal.h"
     36 #endif
     37 #include <signal.h>
     38 #include "gdbsupport/block-signals.h"
     39 
     40 /* The Guile version we're using.
     41    We *could* use the macros in libguile/version.h but that would preclude
     42    handling the user switching in a different version with, e.g.,
     43    LD_LIBRARY_PATH (using a different version than what gdb was compiled with
     44    is not something to be done lightly, but can be useful).  */
     45 int gdbscm_guile_major_version;
     46 int gdbscm_guile_minor_version;
     47 int gdbscm_guile_micro_version;
     48 
     49 #ifdef HAVE_GUILE
     50 /* The guile subdirectory within gdb's data-directory.  */
     51 static const char *guile_datadir;
     52 #endif
     53 
     54 /* Declared constants and enum for guile exception printing.  */
     55 const char gdbscm_print_excp_none[] = "none";
     56 const char gdbscm_print_excp_full[] = "full";
     57 const char gdbscm_print_excp_message[] = "message";
     58 
     59 /* "set guile print-stack" choices.  */
     60 static const char *const guile_print_excp_enums[] =
     61   {
     62     gdbscm_print_excp_none,
     63     gdbscm_print_excp_full,
     64     gdbscm_print_excp_message,
     65     NULL
     66   };
     67 
     68 /* The exception printing variable.  'full' if we want to print the
     69    error message and stack, 'none' if we want to print nothing, and
     70    'message' if we only want to print the error message.  'message' is
     71    the default.  */
     72 const char *gdbscm_print_excp = gdbscm_print_excp_message;
     73 
     74 
     75 #ifdef HAVE_GUILE
     77 
     78 static void gdbscm_initialize (const struct extension_language_defn *);
     79 static int gdbscm_initialized (const struct extension_language_defn *);
     80 static void gdbscm_eval_from_control_command
     81   (const struct extension_language_defn *, struct command_line *);
     82 static script_sourcer_func gdbscm_source_script;
     83 static void gdbscm_set_backtrace (int enable);
     84 
     85 int gdb_scheme_initialized;
     86 
     87 /* Symbol for setting documentation strings.  */
     88 SCM gdbscm_documentation_symbol;
     89 
     90 /* Keywords used by various functions.  */
     91 static SCM from_tty_keyword;
     92 static SCM to_string_keyword;
     93 
     94 /* The name of the various modules (without the surrounding parens).  */
     95 const char gdbscm_module_name[] = "gdb";
     96 const char gdbscm_init_module_name[] = "gdb";
     97 
     98 /* The name of the bootstrap file.  */
     99 static const char boot_scm_filename[] = "boot.scm";
    100 
    101 /* The interface between gdb proper and loading of python scripts.  */
    102 
    103 static const struct extension_language_script_ops guile_extension_script_ops =
    104 {
    105   gdbscm_source_script,
    106   gdbscm_source_objfile_script,
    107   gdbscm_execute_objfile_script,
    108   gdbscm_auto_load_enabled
    109 };
    110 
    111 /* The interface between gdb proper and guile scripting.  */
    112 
    113 static const struct extension_language_ops guile_extension_ops =
    114 {
    115   gdbscm_initialize,
    116   gdbscm_initialized,
    117   nullptr,
    118 
    119   gdbscm_eval_from_control_command,
    120 
    121   NULL, /* gdbscm_start_type_printers, */
    122   NULL, /* gdbscm_apply_type_printers, */
    123   NULL, /* gdbscm_free_type_printers, */
    124 
    125   gdbscm_apply_val_pretty_printer,
    126 
    127   NULL, /* gdbscm_apply_frame_filter, */
    128 
    129   gdbscm_preserve_values,
    130 
    131   gdbscm_breakpoint_has_cond,
    132   gdbscm_breakpoint_cond_says_stop,
    133 
    134   NULL, /* gdbscm_set_quit_flag, */
    135   NULL, /* gdbscm_check_quit_flag, */
    136   NULL, /* gdbscm_before_prompt, */
    137   NULL, /* gdbscm_get_matching_xmethod_workers */
    138   NULL, /* gdbscm_colorize */
    139   NULL, /* gdbscm_print_insn */
    140 };
    141 #endif
    142 
    143 /* The main struct describing GDB's interface to the Guile
    144    extension language.  */
    145 extern const struct extension_language_defn extension_language_guile =
    146 {
    147   EXT_LANG_GUILE,
    148   "guile",
    149   "Guile",
    150 
    151   ".scm",
    152   "-gdb.scm",
    153 
    154   guile_control,
    155 
    156 #ifdef HAVE_GUILE
    157   &guile_extension_script_ops,
    158   &guile_extension_ops
    159 #else
    160   NULL,
    161   NULL
    162 #endif
    163 };
    164 
    165 #ifdef HAVE_GUILE
    166 /* Implementation of the gdb "guile-repl" command.  */
    167 
    168 static void
    169 guile_repl_command (const char *arg, int from_tty)
    170 {
    171   scoped_restore restore_async = make_scoped_restore (&current_ui->async, 0);
    172 
    173   arg = skip_spaces (arg);
    174 
    175   /* This explicitly rejects any arguments for now.
    176      "It is easier to relax a restriction than impose one after the fact."
    177      We would *like* to be able to pass arguments to the interactive shell
    178      but that's not what python-interactive does.  Until there is time to
    179      sort it out, we forbid arguments.  */
    180 
    181   if (arg && *arg)
    182     error (_("guile-repl currently does not take any arguments."));
    183   else
    184     {
    185       dont_repeat ();
    186       gdbscm_enter_repl ();
    187     }
    188 }
    189 
    190 /* Implementation of the gdb "guile" command.
    191    Note: Contrary to the Python version this displays the result.
    192    Have to see which is better.
    193 
    194    TODO: Add the result to Guile's history?  */
    195 
    196 static void
    197 guile_command (const char *arg, int from_tty)
    198 {
    199   scoped_restore restore_async = make_scoped_restore (&current_ui->async, 0);
    200 
    201   arg = skip_spaces (arg);
    202 
    203   if (arg && *arg)
    204     {
    205       gdb::unique_xmalloc_ptr<char> msg = gdbscm_safe_eval_string (arg, 1);
    206 
    207       if (msg != NULL)
    208 	error ("%s", msg.get ());
    209     }
    210   else
    211     {
    212       counted_command_line l = get_command_line (guile_control, "");
    213 
    214       execute_control_command_untraced (l.get ());
    215     }
    216 }
    217 
    218 /* Given a command_line, return a command string suitable for passing
    219    to Guile.  Lines in the string are separated by newlines.  The return
    220    value is allocated using xmalloc and the caller is responsible for
    221    freeing it.  */
    222 
    223 static char *
    224 compute_scheme_string (struct command_line *l)
    225 {
    226   struct command_line *iter;
    227   char *script = NULL;
    228   int size = 0;
    229   int here;
    230 
    231   for (iter = l; iter; iter = iter->next)
    232     size += strlen (iter->line) + 1;
    233 
    234   script = (char *) xmalloc (size + 1);
    235   here = 0;
    236   for (iter = l; iter; iter = iter->next)
    237     {
    238       int len = strlen (iter->line);
    239 
    240       strcpy (&script[here], iter->line);
    241       here += len;
    242       script[here++] = '\n';
    243     }
    244   script[here] = '\0';
    245   return script;
    246 }
    247 
    248 /* Take a command line structure representing a "guile" command, and
    249    evaluate its body using the Guile interpreter.
    250    This is the extension_language_ops.eval_from_control_command "method".  */
    251 
    252 static void
    253 gdbscm_eval_from_control_command
    254   (const struct extension_language_defn *extlang, struct command_line *cmd)
    255 {
    256   char *script;
    257 
    258   if (cmd->body_list_1 != nullptr)
    259     error (_("Invalid \"guile\" block structure."));
    260 
    261   script = compute_scheme_string (cmd->body_list_0.get ());
    262   gdb::unique_xmalloc_ptr<char> msg = gdbscm_safe_eval_string (script, 0);
    263   xfree (script);
    264   if (msg != NULL)
    265     error ("%s", msg.get ());
    266 }
    267 
    268 /* Read a file as Scheme code.
    269    This is the extension_language_script_ops.script_sourcer "method".
    270    FILE is the file to run.  FILENAME is name of the file FILE.
    271    This does not throw any errors.  If an exception occurs an error message
    272    is printed.  */
    273 
    274 static void
    275 gdbscm_source_script (const struct extension_language_defn *extlang,
    276 		      FILE *file, const char *filename)
    277 {
    278   gdb::unique_xmalloc_ptr<char> msg = gdbscm_safe_source_script (filename);
    279 
    280   if (msg != NULL)
    281     gdb_printf (gdb_stderr, "%s\n", msg.get ());
    282 }
    283 
    284 /* (execute string [#:from-tty boolean] [#:to-string boolean])
    286    A Scheme function which evaluates a string using the gdb CLI.  */
    287 
    288 static SCM
    289 gdbscm_execute_gdb_command (SCM command_scm, SCM rest)
    290 {
    291   int from_tty_arg_pos = -1, to_string_arg_pos = -1;
    292   int from_tty = 0, to_string = 0;
    293   const SCM keywords[] = { from_tty_keyword, to_string_keyword, SCM_BOOL_F };
    294   char *command;
    295 
    296   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#tt",
    297 			      command_scm, &command, rest,
    298 			      &from_tty_arg_pos, &from_tty,
    299 			      &to_string_arg_pos, &to_string);
    300 
    301   return gdbscm_wrap ([=]
    302     {
    303       gdb::unique_xmalloc_ptr<char> command_holder (command);
    304       std::string to_string_res;
    305 
    306       scoped_restore restore_async = make_scoped_restore (&current_ui->async,
    307 							  0);
    308 
    309       scoped_restore preventer = prevent_dont_repeat ();
    310       if (to_string)
    311 	execute_command_to_string (to_string_res, command, from_tty, false);
    312       else
    313 	execute_command (command, from_tty);
    314 
    315       /* Do any commands attached to breakpoint we stopped at.  */
    316       bpstat_do_actions ();
    317 
    318       if (to_string)
    319 	return gdbscm_scm_from_c_string (to_string_res.c_str ());
    320       return SCM_UNSPECIFIED;
    321     });
    322 }
    323 
    324 /* (data-directory) -> string */
    325 
    326 static SCM
    327 gdbscm_data_directory (void)
    328 {
    329   return gdbscm_scm_from_c_string (gdb_datadir.c_str ());
    330 }
    331 
    332 /* (guile-data-directory) -> string */
    333 
    334 static SCM
    335 gdbscm_guile_data_directory (void)
    336 {
    337   return gdbscm_scm_from_c_string (guile_datadir);
    338 }
    339 
    340 /* (gdb-version) -> string */
    341 
    342 static SCM
    343 gdbscm_gdb_version (void)
    344 {
    345   return gdbscm_scm_from_c_string (version);
    346 }
    347 
    348 /* (host-config) -> string */
    349 
    350 static SCM
    351 gdbscm_host_config (void)
    352 {
    353   return gdbscm_scm_from_c_string (host_name);
    354 }
    355 
    356 /* (target-config) -> string */
    357 
    358 static SCM
    359 gdbscm_target_config (void)
    360 {
    361   return gdbscm_scm_from_c_string (target_name);
    362 }
    363 
    364 #else /* ! HAVE_GUILE */
    365 
    366 /* Dummy implementation of the gdb "guile-repl" and "guile"
    367    commands. */
    368 
    369 static void
    370 guile_repl_command (const char *arg, int from_tty)
    371 {
    372   arg = skip_spaces (arg);
    373   if (arg && *arg)
    374     error (_("guile-repl currently does not take any arguments."));
    375   error (_("Guile scripting is not supported in this copy of GDB."));
    376 }
    377 
    378 static void
    379 guile_command (const char *arg, int from_tty)
    380 {
    381   arg = skip_spaces (arg);
    382   if (arg && *arg)
    383     error (_("Guile scripting is not supported in this copy of GDB."));
    384   else
    385     {
    386       /* Even if Guile isn't enabled, we still have to slurp the
    387 	 command list to the corresponding "end".  */
    388       counted_command_line l = get_command_line (guile_control, "");
    389 
    390       execute_control_command_untraced (l.get ());
    391     }
    392 }
    393 
    394 #endif /* ! HAVE_GUILE */
    395 
    396 /* Lists for 'set,show,info guile' commands.  */
    398 
    399 static struct cmd_list_element *set_guile_list;
    400 static struct cmd_list_element *show_guile_list;
    401 static struct cmd_list_element *info_guile_list;
    402 
    403 
    404 /* Initialization.  */
    406 
    407 #ifdef HAVE_GUILE
    408 
    409 static const scheme_function misc_guile_functions[] =
    410 {
    411   { "execute", 1, 0, 1, as_a_scm_t_subr (gdbscm_execute_gdb_command),
    412   "\
    413 Execute the given GDB command.\n\
    414 \n\
    415   Arguments: string [#:to-string boolean] [#:from-tty boolean]\n\
    416     If #:from-tty is true then the command executes as if entered\n\
    417     from the keyboard.  The default is false (#f).\n\
    418     If #:to-string is true then the result is returned as a string.\n\
    419     Otherwise output is sent to the current output port,\n\
    420     which is the default.\n\
    421   Returns: The result of the command if #:to-string is true.\n\
    422     Otherwise returns unspecified." },
    423 
    424   { "data-directory", 0, 0, 0, as_a_scm_t_subr (gdbscm_data_directory),
    425     "\
    426 Return the name of GDB's data directory." },
    427 
    428   { "guile-data-directory", 0, 0, 0,
    429     as_a_scm_t_subr (gdbscm_guile_data_directory),
    430     "\
    431 Return the name of the Guile directory within GDB's data directory." },
    432 
    433   { "gdb-version", 0, 0, 0, as_a_scm_t_subr (gdbscm_gdb_version),
    434     "\
    435 Return GDB's version string." },
    436 
    437   { "host-config", 0, 0, 0, as_a_scm_t_subr (gdbscm_host_config),
    438     "\
    439 Return the name of the host configuration." },
    440 
    441   { "target-config", 0, 0, 0, as_a_scm_t_subr (gdbscm_target_config),
    442     "\
    443 Return the name of the target configuration." },
    444 
    445   END_FUNCTIONS
    446 };
    447 
    448 /* Load BOOT_SCM_FILE, the first Scheme file that gets loaded.  */
    449 
    450 static SCM
    451 boot_guile_support (void *boot_scm_file)
    452 {
    453   /* Load boot.scm without compiling it (there's no need to compile it).
    454      The other files should have been compiled already, and boot.scm is
    455      expected to adjust '%load-compiled-path' accordingly.  If they haven't
    456      been compiled, Guile will auto-compile them. The important thing to keep
    457      in mind is that there's a >= 100x speed difference between compiled and
    458      non-compiled files.  */
    459   return scm_c_primitive_load ((const char *) boot_scm_file);
    460 }
    461 
    462 /* Return non-zero if ARGS has the "standard" format for throw args.
    463    The standard format is:
    464    (function format-string (format-string-args-list) ...).
    465    FUNCTION is #f if no function was recorded.  */
    466 
    467 static int
    468 standard_throw_args_p (SCM args)
    469 {
    470   if (gdbscm_is_true (scm_list_p (args))
    471       && scm_ilength (args) >= 3)
    472     {
    473       /* The function in which the error occurred.  */
    474       SCM arg0 = scm_list_ref (args, scm_from_int (0));
    475       /* The format string.  */
    476       SCM arg1 = scm_list_ref (args, scm_from_int (1));
    477       /* The arguments of the format string.  */
    478       SCM arg2 = scm_list_ref (args, scm_from_int (2));
    479 
    480       if ((scm_is_string (arg0) || gdbscm_is_false (arg0))
    481 	  && scm_is_string (arg1)
    482 	  && gdbscm_is_true (scm_list_p (arg2)))
    483 	return 1;
    484     }
    485 
    486   return 0;
    487 }
    488 
    489 /* Print the error recorded in a "standard" throw args.  */
    490 
    491 static void
    492 print_standard_throw_error (SCM args)
    493 {
    494   /* The function in which the error occurred.  */
    495   SCM arg0 = scm_list_ref (args, scm_from_int (0));
    496   /* The format string.  */
    497   SCM arg1 = scm_list_ref (args, scm_from_int (1));
    498   /* The arguments of the format string.  */
    499   SCM arg2 = scm_list_ref (args, scm_from_int (2));
    500 
    501   /* ARG0 is #f if no function was recorded.  */
    502   if (gdbscm_is_true (arg0))
    503     {
    504       scm_simple_format (scm_current_error_port (),
    505 			 scm_from_latin1_string (_("Error in function ~s:~%")),
    506 			 scm_list_1 (arg0));
    507     }
    508   scm_simple_format (scm_current_error_port (), arg1, arg2);
    509 }
    510 
    511 /* Print the error message recorded in KEY, ARGS, the arguments to throw.
    512    Normally we let Scheme print the error message.
    513    This function is used when Scheme initialization fails.
    514    We can still use the Scheme C API though.  */
    515 
    516 static void
    517 print_throw_error (SCM key, SCM args)
    518 {
    519   /* IWBN to call gdbscm_print_exception_with_stack here, but Guile didn't
    520      boot successfully so play it safe and avoid it.  The "format string" and
    521      its args are embedded in ARGS, but the content of ARGS depends on KEY.
    522      Make sure ARGS has the expected canonical content before trying to use
    523      it.  */
    524   if (standard_throw_args_p (args))
    525     print_standard_throw_error (args);
    526   else
    527     {
    528       scm_simple_format (scm_current_error_port (),
    529 			 scm_from_latin1_string (_("Throw to key `~a' with args `~s'.~%")),
    530 			 scm_list_2 (key, args));
    531     }
    532 }
    533 
    534 /* Handle an exception thrown while loading BOOT_SCM_FILE.  */
    535 
    536 static SCM
    537 handle_boot_error (void *boot_scm_file, SCM key, SCM args)
    538 {
    539   gdb_printf (gdb_stderr, ("Exception caught while booting Guile.\n"));
    540 
    541   print_throw_error (key, args);
    542 
    543   gdb_printf (gdb_stderr, "\n");
    544   warning (_("Could not complete Guile gdb module initialization from:\n"
    545 	     "%s.\n"
    546 	     "Limited Guile support is available.\n"
    547 	     "Suggest passing --data-directory=/path/to/gdb/data-directory."),
    548 	   (const char *) boot_scm_file);
    549 
    550   return SCM_UNSPECIFIED;
    551 }
    552 
    553 /* Load gdb/boot.scm, the Scheme side of GDB/Guile support.
    554    Note: This function assumes it's called within the gdb module.  */
    555 
    556 static void
    557 initialize_scheme_side (void)
    558 {
    559   char *boot_scm_path;
    560 
    561   guile_datadir = concat (gdb_datadir.c_str (), SLASH_STRING, "guile",
    562 			  (char *) NULL);
    563   boot_scm_path = concat (guile_datadir, SLASH_STRING, "gdb",
    564 			  SLASH_STRING, boot_scm_filename, (char *) NULL);
    565 
    566   scm_c_catch (SCM_BOOL_T, boot_guile_support, boot_scm_path,
    567 	       handle_boot_error, boot_scm_path, NULL, NULL);
    568 
    569   xfree (boot_scm_path);
    570 }
    571 
    572 /* Install the gdb scheme module.
    573    The result is a boolean indicating success.
    574    If initializing the gdb module fails an error message is printed.
    575    Note: This function runs in the context of the gdb module.  */
    576 
    577 static void
    578 initialize_gdb_module (void *data)
    579 {
    580   /* Computing these is a pain, so only do it once.
    581      Also, do it here and save the result so that obtaining the values
    582      is thread-safe.  */
    583   gdbscm_guile_major_version = gdbscm_scm_string_to_int (scm_major_version ());
    584   gdbscm_guile_minor_version = gdbscm_scm_string_to_int (scm_minor_version ());
    585   gdbscm_guile_micro_version = gdbscm_scm_string_to_int (scm_micro_version ());
    586 
    587   /* The documentation symbol needs to be defined before any calls to
    588      gdbscm_define_{variables,functions}.  */
    589   gdbscm_documentation_symbol = scm_from_latin1_symbol ("documentation");
    590 
    591   /* The smob and exception support must be initialized early.  */
    592   gdbscm_initialize_smobs ();
    593   gdbscm_initialize_exceptions ();
    594 
    595   /* The rest are initialized in alphabetical order.  */
    596   gdbscm_initialize_arches ();
    597   gdbscm_initialize_auto_load ();
    598   gdbscm_initialize_blocks ();
    599   gdbscm_initialize_breakpoints ();
    600   gdbscm_initialize_commands ();
    601   gdbscm_initialize_disasm ();
    602   gdbscm_initialize_frames ();
    603   gdbscm_initialize_iterators ();
    604   gdbscm_initialize_lazy_strings ();
    605   gdbscm_initialize_math ();
    606   gdbscm_initialize_objfiles ();
    607   gdbscm_initialize_parameters ();
    608   gdbscm_initialize_ports ();
    609   gdbscm_initialize_pretty_printers ();
    610   gdbscm_initialize_pspaces ();
    611   gdbscm_initialize_strings ();
    612   gdbscm_initialize_symbols ();
    613   gdbscm_initialize_symtabs ();
    614   gdbscm_initialize_types ();
    615   gdbscm_initialize_values ();
    616 
    617   gdbscm_define_functions (misc_guile_functions, 1);
    618 
    619   from_tty_keyword = scm_from_latin1_keyword ("from-tty");
    620   to_string_keyword = scm_from_latin1_keyword ("to-string");
    621 
    622   initialize_scheme_side ();
    623 
    624   gdb_scheme_initialized = 1;
    625 }
    626 
    627 /* Utility to call scm_c_define_module+initialize_gdb_module from
    628    within scm_with_guile.  */
    629 
    630 static void *
    631 call_initialize_gdb_module (void *data)
    632 {
    633   /* Most of the initialization is done by initialize_gdb_module.
    634      It is called via scm_c_define_module so that the initialization is
    635      performed within the desired module.  */
    636   scm_c_define_module (gdbscm_module_name, initialize_gdb_module, NULL);
    637 
    638 #if HAVE_GUILE_MANUAL_FINALIZATION
    639   scm_run_finalizers ();
    640 #endif
    641 
    642   return NULL;
    643 }
    644 
    645 /* A callback to initialize Guile after gdb has finished all its
    646    initialization.  This is the extension_language_ops.initialize "method".  */
    647 
    648 static void
    649 gdbscm_initialize (const struct extension_language_defn *extlang)
    650 {
    651 #if HAVE_GUILE
    652   /* The Python support puts the C side in module "_gdb", leaving the
    653      Python side to define module "gdb" which imports "_gdb".  There is
    654      evidently no similar convention in Guile so we skip this.  */
    655 
    656 #if HAVE_GUILE_MANUAL_FINALIZATION
    657   /* Our SMOB free functions are not thread-safe, as GDB itself is not
    658      intended to be thread-safe.  Disable automatic finalization so that
    659      finalizers aren't run in other threads.  */
    660   scm_set_automatic_finalization_enabled (0);
    661 #endif
    662 
    663   /* Before we initialize Guile, block signals needed by gdb (especially
    664      SIGCHLD).  This is done so that all threads created during Guile
    665      initialization have SIGCHLD blocked.  PR 17247.  Really libgc and
    666      Guile should do this, but we need to work with libgc 7.4.x.  */
    667   {
    668     gdb::block_signals blocker;
    669 
    670     /* There are libguile versions (f.i. v3.0.5) that by default call
    671        mp_get_memory_functions during initialization to install custom
    672        libgmp memory functions.  This is considered a bug and should be
    673        fixed starting v3.0.6.
    674        Before gdb commit 880ae75a2b7 "gdb delay guile initialization until
    675        gdbscm_finish_initialization", that bug had no effect for gdb,
    676        because gdb subsequently called mp_get_memory_functions to install
    677        its own custom functions in _initialize_gmp_utils.  However, since
    678        aforementioned gdb commit the initialization order is reversed,
    679        allowing libguile to install a custom malloc that is incompatible
    680        with the custom free as used in gmp-utils.c, resulting in a
    681        "double free or corruption (out)" error.
    682        Work around the libguile bug by disabling the installation of the
    683        libgmp memory functions by guile initialization.  */
    684 
    685     /* The scm_install_gmp_memory_functions variable should be removed after
    686        version 3.0, so limit usage to 3.0 and before.  */
    687 #if SCM_MAJOR_VERSION < 3 || (SCM_MAJOR_VERSION == 3 && SCM_MINOR_VERSION == 0)
    688     /* This variable is deprecated in Guile 3.0.8 and later but remains
    689        available in the whole 3.0 series.  */
    690 #pragma GCC diagnostic push
    691 #pragma GCC diagnostic ignored "-Wdeprecated-declarations"
    692     scm_install_gmp_memory_functions = 0;
    693 #pragma GCC diagnostic pop
    694 #endif
    695 
    696     /* scm_with_guile is the most portable way to initialize Guile.  Plus
    697        we need to initialize the Guile support while in Guile mode (e.g.,
    698        called from within a call to scm_with_guile).  */
    699     scm_with_guile (call_initialize_gdb_module, NULL);
    700   }
    701 
    702   /* Set Guile's backtrace to match the "set guile print-stack" default.
    703      [N.B. The two settings are still separate.]  But only do this after
    704      we've initialized Guile, it's nice to see a backtrace if there's an
    705      error during initialization.  OTOH, if the error is that gdb/init.scm
    706      wasn't found because gdb is being run from the build tree, the
    707      backtrace is more noise than signal.  Sigh.  */
    708   gdbscm_set_backtrace (0);
    709 #endif
    710 
    711   /* Restore the environment to the user interaction one.  */
    712   scm_set_current_module (scm_interaction_environment ());
    713 }
    714 
    715 /* The extension_language_ops.initialized "method".  */
    716 
    717 static int
    718 gdbscm_initialized (const struct extension_language_defn *extlang)
    719 {
    720   return gdb_scheme_initialized;
    721 }
    722 
    723 /* Enable or disable Guile backtraces.  */
    724 
    725 static void
    726 gdbscm_set_backtrace (int enable)
    727 {
    728   static const char disable_bt[] = "(debug-disable 'backtrace)";
    729   static const char enable_bt[] = "(debug-enable 'backtrace)";
    730 
    731   if (enable)
    732     gdbscm_safe_eval_string (enable_bt, 0);
    733   else
    734     gdbscm_safe_eval_string (disable_bt, 0);
    735 }
    736 
    737 #endif /* HAVE_GUILE */
    738 
    739 /* See guile.h.  */
    740 cmd_list_element *guile_cmd_element = nullptr;
    741 
    742 /* Install the various gdb commands used by Guile.  */
    743 
    744 static void
    745 install_gdb_commands (void)
    746 {
    747   cmd_list_element *guile_repl_cmd
    748     = add_com ("guile-repl", class_obscure, guile_repl_command,
    749 #ifdef HAVE_GUILE
    750 	   _("\
    751 Start an interactive Guile prompt.\n\
    752 \n\
    753 To return to GDB, type the EOF character (e.g., Ctrl-D on an empty\n\
    754 prompt) or ,quit.")
    755 #else /* HAVE_GUILE */
    756 	   _("\
    757 Start a Guile interactive prompt.\n\
    758 \n\
    759 Guile scripting is not supported in this copy of GDB.\n\
    760 This command is only a placeholder.")
    761 #endif /* HAVE_GUILE */
    762 	   );
    763   add_com_alias ("gr", guile_repl_cmd, class_obscure, 1);
    764 
    765   /* Since "help guile" is easy to type, and intuitive, we add general help
    766      in using GDB+Guile to this command.  */
    767   guile_cmd_element = add_com ("guile", class_obscure, guile_command,
    768 #ifdef HAVE_GUILE
    769 	   _("\
    770 Evaluate one or more Guile expressions.\n\
    771 \n\
    772 The expression(s) can be given as an argument, for instance:\n\
    773 \n\
    774     guile (display 23)\n\
    775 \n\
    776 The result of evaluating the last expression is printed.\n\
    777 \n\
    778 If no argument is given, the following lines are read and passed\n\
    779 to Guile for evaluation.  Type a line containing \"end\" to indicate\n\
    780 the end of the set of expressions.\n\
    781 \n\
    782 The Guile GDB module must first be imported before it can be used.\n\
    783 Do this with:\n\
    784 (gdb) guile (use-modules (gdb))\n\
    785 or if you want to import the (gdb) module with a prefix, use:\n\
    786 (gdb) guile (use-modules ((gdb) #:renamer (symbol-prefix-proc 'gdb:)))\n\
    787 \n\
    788 The Guile interactive session, started with the \"guile-repl\"\n\
    789 command, provides extensive help and apropos capabilities.\n\
    790 Type \",help\" once in a Guile interactive session.")
    791 #else /* HAVE_GUILE */
    792 	   _("\
    793 Evaluate a Guile expression.\n\
    794 \n\
    795 Guile scripting is not supported in this copy of GDB.\n\
    796 This command is only a placeholder.")
    797 #endif /* HAVE_GUILE */
    798 	   );
    799   add_com_alias ("gu", guile_cmd_element, class_obscure, 1);
    800 
    801   set_show_commands setshow_guile_cmds
    802     = add_setshow_prefix_cmd ("guile", class_obscure,
    803 			      _("\
    804 Prefix command for Guile preference settings."),
    805 			      _("\
    806 Prefix command for Guile preference settings."),
    807 			      &set_guile_list, &show_guile_list,
    808 			      &setlist, &showlist);
    809 
    810   add_alias_cmd ("gu", setshow_guile_cmds.set, class_obscure, 1, &setlist);
    811   add_alias_cmd ("gu", setshow_guile_cmds.show, class_obscure, 1, &showlist);
    812 
    813   cmd_list_element *info_guile_cmd
    814     = add_basic_prefix_cmd ("guile", class_obscure,
    815 			    _("Prefix command for Guile info displays."),
    816 			    &info_guile_list, 0, &infolist);
    817   add_info_alias ("gu", info_guile_cmd, 1);
    818 
    819   /* The name "print-stack" is carried over from Python.
    820      A better name is "print-exception".  */
    821   add_setshow_enum_cmd ("print-stack", no_class, guile_print_excp_enums,
    822 			&gdbscm_print_excp, _("\
    823 Set mode for Guile exception printing on error."), _("\
    824 Show the mode of Guile exception printing on error."), _("\
    825 none  == no stack or message will be printed.\n\
    826 full == a message and a stack will be printed.\n\
    827 message == an error message without a stack will be printed."),
    828 			NULL, NULL,
    829 			&set_guile_list, &show_guile_list);
    830 }
    831 
    832 void _initialize_guile ();
    833 void
    834 _initialize_guile ()
    835 {
    836   install_gdb_commands ();
    837 }
    838