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 <string.h>
  25 #include "breakpoint.h"
  26 #include "cli/cli-cmds.h"
  27 #include "cli/cli-script.h"
  28 #include "cli/cli-utils.h"
  29 #include "command.h"
  30 #include "gdbcmd.h"
  31 #include "interps.h"
  32 #include "extension-priv.h"
  33 #include "utils.h"
  34 #include "version.h"
  35 #ifdef HAVE_GUILE
  36 #include "guile.h"
  37 #include "guile-internal.h"
  38 #ifdef HAVE_GC_GC_H
  39 #include <gc/gc.h> /* PR 17185 */
  40 #endif
  41 #endif
  42
  43 /* The Guile version we're using.
  44    We *could* use the macros in libguile/version.h but that would preclude
  45    handling the user switching in a different version with, e.g.,
  46    LD_LIBRARY_PATH (using a different version than what gdb was compiled with
  47    is not something to be done lightly, but can be useful).  */
  48 int gdbscm_guile_major_version;
  49 int gdbscm_guile_minor_version;
  50 int gdbscm_guile_micro_version;
  51
  52 /* The guile subdirectory within gdb's data-directory.  */
  53 static const char *guile_datadir;
  54
  55 /* Declared constants and enum for guile exception printing.  */
  56 const char gdbscm_print_excp_none[] = "none";
  57 const char gdbscm_print_excp_full[] = "full";
  58 const char gdbscm_print_excp_message[] = "message";
  59
  60 /* "set guile print-stack" choices.  */
  61 static const char *const guile_print_excp_enums[] =
  62   {
  63     gdbscm_print_excp_none,
  64     gdbscm_print_excp_full,
  65     gdbscm_print_excp_message,
  66     NULL
  67   };
  68
  69 /* The exception printing variable.  'full' if we want to print the
  70    error message and stack, 'none' if we want to print nothing, and
  71    'message' if we only want to print the error message.  'message' is
  72    the default.  */
  73 const char *gdbscm_print_excp = gdbscm_print_excp_message;
  74
  75 #ifdef HAVE_GUILE
  76 /* Forward decls, these are defined later.  */
  77 static const struct extension_language_script_ops guile_extension_script_ops;
  78 static const struct extension_language_ops guile_extension_ops;
  79 #endif
  80
  81 /* The main struct describing GDB's interface to the Guile
  82    extension language.  */
  83 const struct extension_language_defn extension_language_guile =
  84 {
  85   EXT_LANG_GUILE,
  86   "guile",
  87   "Guile",
  88
  89   ".scm",
  90   "-gdb.scm",
  91
  92   guile_control,
  93
  94 #ifdef HAVE_GUILE
  95   &guile_extension_script_ops,
  96   &guile_extension_ops
  97 #else
  98   NULL,
  99   NULL
 100 #endif
 101 };
 102 \f
 103 #ifdef HAVE_GUILE
 104
 105 static void gdbscm_finish_initialization
 106   (const struct extension_language_defn *);
 107 static int gdbscm_initialized (const struct extension_language_defn *);
 108 static void gdbscm_eval_from_control_command
 109   (const struct extension_language_defn *, struct command_line *);
 110 static script_sourcer_func gdbscm_source_script;
 111
 112 int gdb_scheme_initialized;
 113
 114 /* Symbol for setting documentation strings.  */
 115 SCM gdbscm_documentation_symbol;
 116
 117 /* Keywords used by various functions.  */
 118 static SCM from_tty_keyword;
 119 static SCM to_string_keyword;
 120
 121 /* The name of the various modules (without the surrounding parens).  */
 122 const char gdbscm_module_name[] = "gdb";
 123 const char gdbscm_init_module_name[] = "gdb init";
 124
 125 /* The name of the bootstrap file.  */
 126 static const char boot_scm_filename[] = "boot.scm";
 127
 128 /* The interface between gdb proper and loading of python scripts.  */
 129
 130 static const struct extension_language_script_ops guile_extension_script_ops =
 131 {
 132   gdbscm_source_script,
 133   gdbscm_source_objfile_script,
 134   gdbscm_auto_load_enabled
 135 };
 136
 137 /* The interface between gdb proper and guile scripting.  */
 138
 139 static 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_clear_quit_flag, */
 161   NULL, /* gdbscm_set_quit_flag, */
 162 };
 163
 164 /* Implementation of the gdb "guile-repl" command.  */
 165
 166 static void
 167 guile_repl_command (char *arg, int from_tty)
 168 {
 169   struct cleanup *cleanup;
 170
 171   cleanup = make_cleanup_restore_integer (&interpreter_async);
 172   interpreter_async = 0;
 173
 174   arg = skip_spaces (arg);
 175
 176   /* This explicitly rejects any arguments for now.
 177      "It is easier to relax a restriction than impose one after the fact."
 178      We would *like* to be able to pass arguments to the interactive shell
 179      but that's not what python-interactive does.  Until there is time to
 180      sort it out, we forbid arguments.  */
 181
 182   if (arg && *arg)
 183     error (_("guile-repl currently does not take any arguments."));
 184   else
 185     {
 186       dont_repeat ();
 187       gdbscm_enter_repl ();
 188     }
 189
 190   do_cleanups (cleanup);
 191 }
 192
 193 /* Implementation of the gdb "guile" command.
 194    Note: Contrary to the Python version this displays the result.
 195    Have to see which is better.
 196
 197    TODO: Add the result to Guile's history?  */
 198
 199 static void
 200 guile_command (char *arg, int from_tty)
 201 {
 202   struct cleanup *cleanup;
 203
 204   cleanup = make_cleanup_restore_integer (&interpreter_async);
 205   interpreter_async = 0;
 206
 207   arg = skip_spaces (arg);
 208
 209   if (arg && *arg)
 210     {
 211       char *msg = gdbscm_safe_eval_string (arg, 1);
 212
 213       if (msg != NULL)
 214         {
 215           make_cleanup (xfree, msg);
 216           error ("%s", msg);
 217         }
 218     }
 219   else
 220     {
 221       struct command_line *l = get_command_line (guile_control, "");
 222
 223       make_cleanup_free_command_lines (&l);
 224       execute_control_command_untraced (l);
 225     }
 226
 227   do_cleanups (cleanup);
 228 }
 229
 230 /* Given a command_line, return a command string suitable for passing
 231    to Guile.  Lines in the string are separated by newlines.  The return
 232    value is allocated using xmalloc and the caller is responsible for
 233    freeing it.  */
 234
 235 static char *
 236 compute_scheme_string (struct command_line *l)
 237 {
 238   struct command_line *iter;
 239   char *script = NULL;
 240   int size = 0;
 241   int here;
 242
 243   for (iter = l; iter; iter = iter->next)
 244     size += strlen (iter->line) + 1;
 245
 246   script = xmalloc (size + 1);
 247   here = 0;
 248   for (iter = l; iter; iter = iter->next)
 249     {
 250       int len = strlen (iter->line);
 251
 252       strcpy (&script[here], iter->line);
 253       here += len;
 254       script[here++] = '\n';
 255     }
 256   script[here] = '\0';
 257   return script;
 258 }
 259
 260 /* Take a command line structure representing a "guile" command, and
 261    evaluate its body using the Guile interpreter.
 262    This is the extension_language_ops.eval_from_control_command "method".  */
 263
 264 static void
 265 gdbscm_eval_from_control_command
 266   (const struct extension_language_defn *extlang, struct command_line *cmd)
 267 {
 268   char *script, *msg;
 269   struct cleanup *cleanup;
 270
 271   if (cmd->body_count != 1)
 272     error (_("Invalid \"guile\" block structure."));
 273
 274   cleanup = make_cleanup (null_cleanup, NULL);
 275
 276   script = compute_scheme_string (cmd->body_list[0]);
 277   msg = gdbscm_safe_eval_string (script, 0);
 278   xfree (script);
 279   if (msg != NULL)
 280     {
 281       make_cleanup (xfree, msg);
 282       error ("%s", msg);
 283     }
 284
 285   do_cleanups (cleanup);
 286 }
 287
 288 /* Read a file as Scheme code.
 289    This is the extension_language_script_ops.script_sourcer "method".
 290    FILE is the file to run.  FILENAME is name of the file FILE.
 291    This does not throw any errors.  If an exception occurs an error message
 292    is printed.  */
 293
 294 static void
 295 gdbscm_source_script (const struct extension_language_defn *extlang,
 296                       FILE *file, const char *filename)
 297 {
 298   char *msg = gdbscm_safe_source_script (filename);
 299
 300   if (msg != NULL)
 301     {
 302       fprintf_filtered (gdb_stderr, "%s\n", msg);
 303       xfree (msg);
 304     }
 305 }
 306 \f
 307 /* (execute string [#:from-tty boolean] [#:to-string boolean\
 308    A Scheme function which evaluates a string using the gdb CLI.  */
 309
 310 static SCM
 311 gdbscm_execute_gdb_command (SCM command_scm, SCM rest)
 312 {
 313   int from_tty_arg_pos = -1, to_string_arg_pos = -1;
 314   int from_tty = 0, to_string = 0;
 315   volatile struct gdb_exception except;
 316   const SCM keywords[] = { from_tty_keyword, to_string_keyword, SCM_BOOL_F };
 317   char *command;
 318   char *result = NULL;
 319   struct cleanup *cleanups;
 320
 321   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#tt",
 322                               command_scm, &command, rest,
 323                               &from_tty_arg_pos, &from_tty,
 324                               &to_string_arg_pos, &to_string);
 325
 326   /* Note: The contents of "command" may get modified while it is
 327      executed.  */
 328   cleanups = make_cleanup (xfree, command);
 329
 330   TRY_CATCH (except, RETURN_MASK_ALL)
 331     {
 332       struct cleanup *inner_cleanups;
 333
 334       inner_cleanups = make_cleanup_restore_integer (&interpreter_async);
 335       interpreter_async = 0;
 336
 337       prevent_dont_repeat ();
 338       if (to_string)
 339         result = execute_command_to_string (command, from_tty);
 340       else
 341         {
 342           execute_command (command, from_tty);
 343           result = NULL;
 344         }
 345
 346       /* Do any commands attached to breakpoint we stopped at.  */
 347       bpstat_do_actions ();
 348
 349       do_cleanups (inner_cleanups);
 350     }
 351   do_cleanups (cleanups);
 352   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 353
 354   if (result)
 355     {
 356       SCM r = gdbscm_scm_from_c_string (result);
 357       xfree (result);
 358       return r;
 359     }
 360   return SCM_UNSPECIFIED;
 361 }
 362
 363 /* (data-directory) -> string */
 364
 365 static SCM
 366 gdbscm_data_directory (void)
 367 {
 368   return gdbscm_scm_from_c_string (gdb_datadir);
 369 }
 370
 371 /* (guile-data-directory) -> string */
 372
 373 static SCM
 374 gdbscm_guile_data_directory (void)
 375 {
 376   return gdbscm_scm_from_c_string (guile_datadir);
 377 }
 378
 379 /* (gdb-version) -> string */
 380
 381 static SCM
 382 gdbscm_gdb_version (void)
 383 {
 384   return gdbscm_scm_from_c_string (version);
 385 }
 386
 387 /* (host-config) -> string */
 388
 389 static SCM
 390 gdbscm_host_config (void)
 391 {
 392   return gdbscm_scm_from_c_string (host_name);
 393 }
 394
 395 /* (target-config) -> string */
 396
 397 static SCM
 398 gdbscm_target_config (void)
 399 {
 400   return gdbscm_scm_from_c_string (target_name);
 401 }
 402
 403 #else /* ! HAVE_GUILE */
 404
 405 /* Dummy implementation of the gdb "guile-repl" and "guile"
 406    commands. */
 407
 408 static void
 409 guile_repl_command (char *arg, int from_tty)
 410 {
 411   arg = skip_spaces (arg);
 412   if (arg && *arg)
 413     error (_("guile-repl currently does not take any arguments."));
 414   error (_("Guile scripting is not supported in this copy of GDB."));
 415 }
 416
 417 static void
 418 guile_command (char *arg, int from_tty)
 419 {
 420   arg = skip_spaces (arg);
 421   if (arg && *arg)
 422     error (_("Guile scripting is not supported in this copy of GDB."));
 423   else
 424     {
 425       /* Even if Guile isn't enabled, we still have to slurp the
 426          command list to the corresponding "end".  */
 427       struct command_line *l = get_command_line (guile_control, "");
 428       struct cleanup *cleanups = make_cleanup_free_command_lines (&l);
 429
 430       execute_control_command_untraced (l);
 431       do_cleanups (cleanups);
 432     }
 433 }
 434
 435 #endif /* ! HAVE_GUILE */
 436 \f
 437 /* Lists for 'set,show,info guile' commands.  */
 438
 439 static struct cmd_list_element *set_guile_list;
 440 static struct cmd_list_element *show_guile_list;
 441 static struct cmd_list_element *info_guile_list;
 442
 443 /* Function for use by 'set guile' prefix command.  */
 444
 445 static void
 446 set_guile_command (char *args, int from_tty)
 447 {
 448   help_list (set_guile_list, "set guile ", all_commands, gdb_stdout);
 449 }
 450
 451 /* Function for use by 'show guile' prefix command.  */
 452
 453 static void
 454 show_guile_command (char *args, int from_tty)
 455 {
 456   cmd_show_list (show_guile_list, from_tty, "");
 457 }
 458
 459 /* The "info scheme" command is defined as a prefix, with
 460    allow_unknown 0.  Therefore, its own definition is called only for
 461    "info scheme" with no args.  */
 462
 463 static void
 464 info_guile_command (char *args, int from_tty)
 465 {
 466   printf_unfiltered (_("\"info guile\" must be followed"
 467                        " by the name of an info command.\n"));
 468   help_list (info_guile_list, "info guile ", -1, gdb_stdout);
 469 }
 470 \f
 471 /* Initialization.  */
 472
 473 #ifdef HAVE_GUILE
 474
 475 static const scheme_function misc_guile_functions[] =
 476 {
 477   { "execute", 1, 0, 1, gdbscm_execute_gdb_command,
 478   "\
 479 Execute the given GDB command.\n\
 480 \n\
 481   Arguments: string [#:to-string boolean] [#:from-tty boolean]\n\
 482     If #:from-tty is true then the command executes as if entered\n\
 483     from the keyboard.  The default is false (#f).\n\
 484     If #:to-string is true then the result is returned as a string.\n\
 485     Otherwise output is sent to the current output port,\n\
 486     which is the default.\n\
 487   Returns: The result of the command if #:to-string is true.\n\
 488     Otherwise returns unspecified." },
 489
 490   { "data-directory", 0, 0, 0, gdbscm_data_directory,
 491     "\
 492 Return the name of GDB's data directory." },
 493
 494   { "guile-data-directory", 0, 0, 0, gdbscm_guile_data_directory,
 495     "\
 496 Return the name of the Guile directory within GDB's data directory." },
 497
 498   { "gdb-version", 0, 0, 0, gdbscm_gdb_version,
 499     "\
 500 Return GDB's version string." },
 501
 502   { "host-config", 0, 0, 0, gdbscm_host_config,
 503     "\
 504 Return the name of the host configuration." },
 505
 506   { "target-config", 0, 0, 0, gdbscm_target_config,
 507     "\
 508 Return the name of the target configuration." },
 509
 510   END_FUNCTIONS
 511 };
 512
 513 /* Load gdb/boot.scm, the Scheme side of GDB/Guile support.
 514    Note: This function assumes it's called within the gdb module.  */
 515
 516 static void
 517 initialize_scheme_side (void)
 518 {
 519   char *boot_scm_path;
 520   char *msg;
 521
 522   guile_datadir = concat (gdb_datadir, SLASH_STRING, "guile", NULL);
 523   boot_scm_path = concat (guile_datadir, SLASH_STRING, "gdb",
 524                           SLASH_STRING, boot_scm_filename, NULL);
 525
 526   /* While scm_c_primitive_load works, the loaded code is not compiled,
 527      instead it is left to be interpreted.  Eh?
 528      Anyways, this causes a ~100x slowdown, so we only use it to load
 529      gdb/boot.scm, and then let boot.scm do the rest.  */
 530   msg = gdbscm_safe_source_script (boot_scm_path);
 531
 532   if (msg != NULL)
 533     {
 534       fprintf_filtered (gdb_stderr, "%s", msg);
 535       xfree (msg);
 536       warning (_("\n"
 537                  "Could not complete Guile gdb module initialization from:\n"
 538                  "%s.\n"
 539                  "Limited Guile support is available.\n"
 540                  "Suggest passing --data-directory=/path/to/gdb/data-directory.\n"),
 541                boot_scm_path);
 542     }
 543
 544   xfree (boot_scm_path);
 545 }
 546
 547 /* Install the gdb scheme module.
 548    The result is a boolean indicating success.
 549    If initializing the gdb module fails an error message is printed.
 550    Note: This function runs in the context of the gdb module.  */
 551
 552 static void
 553 initialize_gdb_module (void *data)
 554 {
 555   /* Computing these is a pain, so only do it once.
 556      Also, do it here and save the result so that obtaining the values
 557      is thread-safe.  */
 558   gdbscm_guile_major_version = gdbscm_scm_string_to_int (scm_major_version ());
 559   gdbscm_guile_minor_version = gdbscm_scm_string_to_int (scm_minor_version ());
 560   gdbscm_guile_micro_version = gdbscm_scm_string_to_int (scm_micro_version ());
 561
 562   /* The documentation symbol needs to be defined before any calls to
 563      gdbscm_define_{variables,functions}.  */
 564   gdbscm_documentation_symbol = scm_from_latin1_symbol ("documentation");
 565
 566   /* The smob and exception support must be initialized early.  */
 567   gdbscm_initialize_smobs ();
 568   gdbscm_initialize_exceptions ();
 569
 570   /* The rest are initialized in alphabetical order.  */
 571   gdbscm_initialize_arches ();
 572   gdbscm_initialize_auto_load ();
 573   gdbscm_initialize_blocks ();
 574   gdbscm_initialize_breakpoints ();
 575   gdbscm_initialize_commands ();
 576   gdbscm_initialize_disasm ();
 577   gdbscm_initialize_frames ();
 578   gdbscm_initialize_iterators ();
 579   gdbscm_initialize_lazy_strings ();
 580   gdbscm_initialize_math ();
 581   gdbscm_initialize_objfiles ();
 582   gdbscm_initialize_parameters ();
 583   gdbscm_initialize_ports ();
 584   gdbscm_initialize_pretty_printers ();
 585   gdbscm_initialize_pspaces ();
 586   gdbscm_initialize_strings ();
 587   gdbscm_initialize_symbols ();
 588   gdbscm_initialize_symtabs ();
 589   gdbscm_initialize_types ();
 590   gdbscm_initialize_values ();
 591
 592   gdbscm_define_functions (misc_guile_functions, 1);
 593
 594   from_tty_keyword = scm_from_latin1_keyword ("from-tty");
 595   to_string_keyword = scm_from_latin1_keyword ("to-string");
 596
 597   initialize_scheme_side ();
 598
 599   gdb_scheme_initialized = 1;
 600 }
 601
 602 /* Utility to call scm_c_define_module+initialize_gdb_module from
 603    within scm_with_guile.  */
 604
 605 static void *
 606 call_initialize_gdb_module (void *data)
 607 {
 608   /* Most of the initialization is done by initialize_gdb_module.
 609      It is called via scm_c_define_module so that the initialization is
 610      performed within the desired module.  */
 611   scm_c_define_module (gdbscm_module_name, initialize_gdb_module, NULL);
 612
 613   return NULL;
 614 }
 615
 616 /* A callback to finish Guile initialization after gdb has finished all its
 617    initialization.
 618    This is the extension_language_ops.finish_initialization "method".  */
 619
 620 static void
 621 gdbscm_finish_initialization (const struct extension_language_defn *extlang)
 622 {
 623   /* Restore the environment to the user interaction one.  */
 624   scm_set_current_module (scm_interaction_environment ());
 625 }
 626
 627 /* The extension_language_ops.initialized "method".  */
 628
 629 static int
 630 gdbscm_initialized (const struct extension_language_defn *extlang)
 631 {
 632   return gdb_scheme_initialized;
 633 }
 634
 635 /* Enable or disable Guile backtraces.  */
 636
 637 static void
 638 gdbscm_set_backtrace (int enable)
 639 {
 640   static const char disable_bt[] = "(debug-disable 'backtrace)";
 641   static const char enable_bt[] = "(debug-enable 'backtrace)";
 642
 643   if (enable)
 644     gdbscm_safe_eval_string (enable_bt, 0);
 645   else
 646     gdbscm_safe_eval_string (disable_bt, 0);
 647 }
 648
 649 #endif /* HAVE_GUILE */
 650
 651 /* Install the various gdb commands used by Guile.  */
 652
 653 static void
 654 install_gdb_commands (void)
 655 {
 656   add_com ("guile-repl", class_obscure,
 657            guile_repl_command,
 658 #ifdef HAVE_GUILE
 659            _("\
 660 Start an interactive Guile prompt.\n\
 661 \n\
 662 To return to GDB, type the EOF character (e.g., Ctrl-D on an empty\n\
 663 prompt) or ,quit.")
 664 #else /* HAVE_GUILE */
 665            _("\
 666 Start a Guile interactive prompt.\n\
 667 \n\
 668 Guile scripting is not supported in this copy of GDB.\n\
 669 This command is only a placeholder.")
 670 #endif /* HAVE_GUILE */
 671            );
 672   add_com_alias ("gr", "guile-repl", class_obscure, 1);
 673
 674   /* Since "help guile" is easy to type, and intuitive, we add general help
 675      in using GDB+Guile to this command.  */
 676   add_com ("guile", class_obscure, guile_command,
 677 #ifdef HAVE_GUILE
 678            _("\
 679 Evaluate one or more Guile expressions.\n\
 680 \n\
 681 The expression(s) can be given as an argument, for instance:\n\
 682 \n\
 683     guile (display 23)\n\
 684 \n\
 685 The result of evaluating the last expression is printed.\n\
 686 \n\
 687 If no argument is given, the following lines are read and passed\n\
 688 to Guile for evaluation.  Type a line containing \"end\" to indicate\n\
 689 the end of the set of expressions.\n\
 690 \n\
 691 The Guile GDB module must first be imported before it can be used.\n\
 692 Do this with:\n\
 693 (gdb) guile (use-modules (gdb))\n\
 694 or if you want to import the (gdb) module with a prefix, use:\n\
 695 (gdb) guile (use-modules ((gdb) #:renamer (symbol-prefix-proc 'gdb:)))\n\
 696 \n\
 697 The Guile interactive session, started with the \"guile-repl\"\n\
 698 command, provides extensive help and apropos capabilities.\n\
 699 Type \",help\" once in a Guile interactive session.")
 700 #else /* HAVE_GUILE */
 701            _("\
 702 Evaluate a Guile expression.\n\
 703 \n\
 704 Guile scripting is not supported in this copy of GDB.\n\
 705 This command is only a placeholder.")
 706 #endif /* HAVE_GUILE */
 707            );
 708   add_com_alias ("gu", "guile", class_obscure, 1);
 709
 710   add_prefix_cmd ("guile", class_obscure, set_guile_command,
 711                   _("Prefix command for Guile preference settings."),
 712                   &set_guile_list, "set guile ", 0,
 713                   &setlist);
 714   add_alias_cmd ("gu", "guile", class_obscure, 1, &setlist);
 715
 716   add_prefix_cmd ("guile", class_obscure, show_guile_command,
 717                   _("Prefix command for Guile preference settings."),
 718                   &show_guile_list, "show guile ", 0,
 719                   &showlist);
 720   add_alias_cmd ("gu", "guile", class_obscure, 1, &showlist);
 721
 722   add_prefix_cmd ("guile", class_obscure, info_guile_command,
 723                   _("Prefix command for Guile info displays."),
 724                   &info_guile_list, "info guile ", 0,
 725                   &infolist);
 726   add_info_alias ("gu", "guile", 1);
 727
 728   /* The name "print-stack" is carried over from Python.
 729      A better name is "print-exception".  */
 730   add_setshow_enum_cmd ("print-stack", no_class, guile_print_excp_enums,
 731                         &gdbscm_print_excp, _("\
 732 Set mode for Guile exception printing on error."), _("\
 733 Show the mode of Guile exception printing on error."), _("\
 734 none  == no stack or message will be printed.\n\
 735 full == a message and a stack will be printed.\n\
 736 message == an error message without a stack will be printed."),
 737                         NULL, NULL,
 738                         &set_guile_list, &show_guile_list);
 739 }
 740
 741 /* Provide a prototype to silence -Wmissing-prototypes.  */
 742 extern initialize_file_ftype _initialize_guile;
 743
 744 void
 745 _initialize_guile (void)
 746 {
 747   char *msg;
 748
 749   install_gdb_commands ();
 750
 751 #if HAVE_GUILE
 752   /* The Python support puts the C side in module "_gdb", leaving the Python
 753      side to define module "gdb" which imports "_gdb".  There is evidently no
 754      similar convention in Guile so we skip this.  */
 755
 756   /* PR 17185 There are problems with using libgc 7.4.0.
 757      Copy over the workaround Guile uses (Guile is working around a different
 758      problem, but the workaround is the same).  */
 759 #if (GC_VERSION_MAJOR == 7 && GC_VERSION_MINOR == 4 && GC_VERSION_MICRO == 0)
 760   /* The bug is only known to appear with pthreads.  We assume any system
 761      using pthreads also uses setenv (and not putenv).  That is why we don't
 762      have a similar call to putenv here.  */
 763 #if defined (HAVE_SETENV)
 764   setenv ("GC_MARKERS", "1", 1);
 765 #endif
 766 #endif
 767
 768   /* scm_with_guile is the most portable way to initialize Guile.
 769      Plus we need to initialize the Guile support while in Guile mode
 770      (e.g., called from within a call to scm_with_guile).  */
 771   scm_with_guile (call_initialize_gdb_module, NULL);
 772
 773   /* Set Guile's backtrace to match the "set guile print-stack" default.
 774      [N.B. The two settings are still separate.]
 775      But only do this after we've initialized Guile, it's nice to see a
 776      backtrace if there's an error during initialization.
 777      OTOH, if the error is that gdb/init.scm wasn't found because gdb is being
 778      run from the build tree, the backtrace is more noise than signal.
 779      Sigh.  */
 780   gdbscm_set_backtrace (0);
 781 #endif
 782 }