gdb/guile/guile.c

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