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