gdb/guile/guile.c

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