gdb/guile/guile.c

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