gdb/guile/guile.c

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