xref: /netbsd-src/external/gpl3/gdb.old/dist/gdb/guile/guile.c (revision 8b657b0747480f8989760d71343d6dd33f8d4cf9)
1 /* General GDB/Guile code.
2 
3    Copyright (C) 2014-2023 Free Software Foundation, Inc.
4 
5    This file is part of GDB.
6 
7    This program is free software; you can redistribute it and/or modify
8    it under the terms of the GNU General Public License as published by
9    the Free Software Foundation; either version 3 of the License, or
10    (at your option) any later version.
11 
12    This program is distributed in the hope that it will be useful,
13    but WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15    GNU General Public License for more details.
16 
17    You should have received a copy of the GNU General Public License
18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
19 
20 /* See README file in this directory for implementation notes, coding
21    conventions, et.al.  */
22 
23 #include "defs.h"
24 #include "breakpoint.h"
25 #include "cli/cli-cmds.h"
26 #include "cli/cli-script.h"
27 #include "cli/cli-utils.h"
28 #include "command.h"
29 #include "gdbcmd.h"
30 #include "top.h"
31 #include "extension-priv.h"
32 #include "utils.h"
33 #include "gdbsupport/version.h"
34 #ifdef HAVE_GUILE
35 #include "guile.h"
36 #include "guile-internal.h"
37 #endif
38 #include <signal.h>
39 #include "gdbsupport/block-signals.h"
40 
41 /* The Guile version we're using.
42    We *could* use the macros in libguile/version.h but that would preclude
43    handling the user switching in a different version with, e.g.,
44    LD_LIBRARY_PATH (using a different version than what gdb was compiled with
45    is not something to be done lightly, but can be useful).  */
46 int gdbscm_guile_major_version;
47 int gdbscm_guile_minor_version;
48 int gdbscm_guile_micro_version;
49 
50 #ifdef HAVE_GUILE
51 /* The guile subdirectory within gdb's data-directory.  */
52 static const char *guile_datadir;
53 #endif
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 
76 #ifdef HAVE_GUILE
77 
78 static void gdbscm_initialize (const struct extension_language_defn *);
79 static int gdbscm_initialized (const struct extension_language_defn *);
80 static void gdbscm_eval_from_control_command
81   (const struct extension_language_defn *, struct command_line *);
82 static script_sourcer_func gdbscm_source_script;
83 static void gdbscm_set_backtrace (int enable);
84 
85 int gdb_scheme_initialized;
86 
87 /* Symbol for setting documentation strings.  */
88 SCM gdbscm_documentation_symbol;
89 
90 /* Keywords used by various functions.  */
91 static SCM from_tty_keyword;
92 static SCM to_string_keyword;
93 
94 /* The name of the various modules (without the surrounding parens).  */
95 const char gdbscm_module_name[] = "gdb";
96 const char gdbscm_init_module_name[] = "gdb";
97 
98 /* The name of the bootstrap file.  */
99 static const char boot_scm_filename[] = "boot.scm";
100 
101 /* The interface between gdb proper and loading of python scripts.  */
102 
103 static const struct extension_language_script_ops guile_extension_script_ops =
104 {
105   gdbscm_source_script,
106   gdbscm_source_objfile_script,
107   gdbscm_execute_objfile_script,
108   gdbscm_auto_load_enabled
109 };
110 
111 /* The interface between gdb proper and guile scripting.  */
112 
113 static const struct extension_language_ops guile_extension_ops =
114 {
115   gdbscm_initialize,
116   gdbscm_initialized,
117 
118   gdbscm_eval_from_control_command,
119 
120   NULL, /* gdbscm_start_type_printers, */
121   NULL, /* gdbscm_apply_type_printers, */
122   NULL, /* gdbscm_free_type_printers, */
123 
124   gdbscm_apply_val_pretty_printer,
125 
126   NULL, /* gdbscm_apply_frame_filter, */
127 
128   gdbscm_preserve_values,
129 
130   gdbscm_breakpoint_has_cond,
131   gdbscm_breakpoint_cond_says_stop,
132 
133   NULL, /* gdbscm_set_quit_flag, */
134   NULL, /* gdbscm_check_quit_flag, */
135   NULL, /* gdbscm_before_prompt, */
136   NULL, /* gdbscm_get_matching_xmethod_workers */
137   NULL, /* gdbscm_colorize */
138   NULL, /* gdbscm_print_insn */
139 };
140 #endif
141 
142 /* The main struct describing GDB's interface to the Guile
143    extension language.  */
144 extern const struct extension_language_defn extension_language_guile =
145 {
146   EXT_LANG_GUILE,
147   "guile",
148   "Guile",
149 
150   ".scm",
151   "-gdb.scm",
152 
153   guile_control,
154 
155 #ifdef HAVE_GUILE
156   &guile_extension_script_ops,
157   &guile_extension_ops
158 #else
159   NULL,
160   NULL
161 #endif
162 };
163 
164 #ifdef HAVE_GUILE
165 /* Implementation of the gdb "guile-repl" command.  */
166 
167 static void
168 guile_repl_command (const char *arg, int from_tty)
169 {
170   scoped_restore restore_async = make_scoped_restore (&current_ui->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 
189 /* Implementation of the gdb "guile" command.
190    Note: Contrary to the Python version this displays the result.
191    Have to see which is better.
192 
193    TODO: Add the result to Guile's history?  */
194 
195 static void
196 guile_command (const char *arg, int from_tty)
197 {
198   scoped_restore restore_async = make_scoped_restore (&current_ui->async, 0);
199 
200   arg = skip_spaces (arg);
201 
202   if (arg && *arg)
203     {
204       gdb::unique_xmalloc_ptr<char> msg = gdbscm_safe_eval_string (arg, 1);
205 
206       if (msg != NULL)
207 	error ("%s", msg.get ());
208     }
209   else
210     {
211       counted_command_line l = get_command_line (guile_control, "");
212 
213       execute_control_command_untraced (l.get ());
214     }
215 }
216 
217 /* Given a command_line, return a command string suitable for passing
218    to Guile.  Lines in the string are separated by newlines.  The return
219    value is allocated using xmalloc and the caller is responsible for
220    freeing it.  */
221 
222 static char *
223 compute_scheme_string (struct command_line *l)
224 {
225   struct command_line *iter;
226   char *script = NULL;
227   int size = 0;
228   int here;
229 
230   for (iter = l; iter; iter = iter->next)
231     size += strlen (iter->line) + 1;
232 
233   script = (char *) xmalloc (size + 1);
234   here = 0;
235   for (iter = l; iter; iter = iter->next)
236     {
237       int len = strlen (iter->line);
238 
239       strcpy (&script[here], iter->line);
240       here += len;
241       script[here++] = '\n';
242     }
243   script[here] = '\0';
244   return script;
245 }
246 
247 /* Take a command line structure representing a "guile" command, and
248    evaluate its body using the Guile interpreter.
249    This is the extension_language_ops.eval_from_control_command "method".  */
250 
251 static void
252 gdbscm_eval_from_control_command
253   (const struct extension_language_defn *extlang, struct command_line *cmd)
254 {
255   char *script;
256 
257   if (cmd->body_list_1 != nullptr)
258     error (_("Invalid \"guile\" block structure."));
259 
260   script = compute_scheme_string (cmd->body_list_0.get ());
261   gdb::unique_xmalloc_ptr<char> msg = gdbscm_safe_eval_string (script, 0);
262   xfree (script);
263   if (msg != NULL)
264     error ("%s", msg.get ());
265 }
266 
267 /* Read a file as Scheme code.
268    This is the extension_language_script_ops.script_sourcer "method".
269    FILE is the file to run.  FILENAME is name of the file FILE.
270    This does not throw any errors.  If an exception occurs an error message
271    is printed.  */
272 
273 static void
274 gdbscm_source_script (const struct extension_language_defn *extlang,
275 		      FILE *file, const char *filename)
276 {
277   gdb::unique_xmalloc_ptr<char> msg = gdbscm_safe_source_script (filename);
278 
279   if (msg != NULL)
280     gdb_printf (gdb_stderr, "%s\n", msg.get ());
281 }
282 
283 /* (execute string [#:from-tty boolean] [#:to-string boolean])
284    A Scheme function which evaluates a string using the gdb CLI.  */
285 
286 static SCM
287 gdbscm_execute_gdb_command (SCM command_scm, SCM rest)
288 {
289   int from_tty_arg_pos = -1, to_string_arg_pos = -1;
290   int from_tty = 0, to_string = 0;
291   const SCM keywords[] = { from_tty_keyword, to_string_keyword, SCM_BOOL_F };
292   char *command;
293 
294   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#tt",
295 			      command_scm, &command, rest,
296 			      &from_tty_arg_pos, &from_tty,
297 			      &to_string_arg_pos, &to_string);
298 
299   return gdbscm_wrap ([=]
300     {
301       gdb::unique_xmalloc_ptr<char> command_holder (command);
302       std::string to_string_res;
303 
304       scoped_restore restore_async = make_scoped_restore (&current_ui->async,
305 							  0);
306 
307       scoped_restore preventer = prevent_dont_repeat ();
308       if (to_string)
309 	execute_command_to_string (to_string_res, command, from_tty, false);
310       else
311 	execute_command (command, from_tty);
312 
313       /* Do any commands attached to breakpoint we stopped at.  */
314       bpstat_do_actions ();
315 
316       if (to_string)
317 	return gdbscm_scm_from_c_string (to_string_res.c_str ());
318       return SCM_UNSPECIFIED;
319     });
320 }
321 
322 /* (data-directory) -> string */
323 
324 static SCM
325 gdbscm_data_directory (void)
326 {
327   return gdbscm_scm_from_c_string (gdb_datadir.c_str ());
328 }
329 
330 /* (guile-data-directory) -> string */
331 
332 static SCM
333 gdbscm_guile_data_directory (void)
334 {
335   return gdbscm_scm_from_c_string (guile_datadir);
336 }
337 
338 /* (gdb-version) -> string */
339 
340 static SCM
341 gdbscm_gdb_version (void)
342 {
343   return gdbscm_scm_from_c_string (version);
344 }
345 
346 /* (host-config) -> string */
347 
348 static SCM
349 gdbscm_host_config (void)
350 {
351   return gdbscm_scm_from_c_string (host_name);
352 }
353 
354 /* (target-config) -> string */
355 
356 static SCM
357 gdbscm_target_config (void)
358 {
359   return gdbscm_scm_from_c_string (target_name);
360 }
361 
362 #else /* ! HAVE_GUILE */
363 
364 /* Dummy implementation of the gdb "guile-repl" and "guile"
365    commands. */
366 
367 static void
368 guile_repl_command (const char *arg, int from_tty)
369 {
370   arg = skip_spaces (arg);
371   if (arg && *arg)
372     error (_("guile-repl currently does not take any arguments."));
373   error (_("Guile scripting is not supported in this copy of GDB."));
374 }
375 
376 static void
377 guile_command (const char *arg, int from_tty)
378 {
379   arg = skip_spaces (arg);
380   if (arg && *arg)
381     error (_("Guile scripting is not supported in this copy of GDB."));
382   else
383     {
384       /* Even if Guile isn't enabled, we still have to slurp the
385 	 command list to the corresponding "end".  */
386       counted_command_line l = get_command_line (guile_control, "");
387 
388       execute_control_command_untraced (l.get ());
389     }
390 }
391 
392 #endif /* ! HAVE_GUILE */
393 
394 /* Lists for 'set,show,info guile' commands.  */
395 
396 static struct cmd_list_element *set_guile_list;
397 static struct cmd_list_element *show_guile_list;
398 static struct cmd_list_element *info_guile_list;
399 
400 
401 /* Initialization.  */
402 
403 #ifdef HAVE_GUILE
404 
405 static const scheme_function misc_guile_functions[] =
406 {
407   { "execute", 1, 0, 1, as_a_scm_t_subr (gdbscm_execute_gdb_command),
408   "\
409 Execute the given GDB command.\n\
410 \n\
411   Arguments: string [#:to-string boolean] [#:from-tty boolean]\n\
412     If #:from-tty is true then the command executes as if entered\n\
413     from the keyboard.  The default is false (#f).\n\
414     If #:to-string is true then the result is returned as a string.\n\
415     Otherwise output is sent to the current output port,\n\
416     which is the default.\n\
417   Returns: The result of the command if #:to-string is true.\n\
418     Otherwise returns unspecified." },
419 
420   { "data-directory", 0, 0, 0, as_a_scm_t_subr (gdbscm_data_directory),
421     "\
422 Return the name of GDB's data directory." },
423 
424   { "guile-data-directory", 0, 0, 0,
425     as_a_scm_t_subr (gdbscm_guile_data_directory),
426     "\
427 Return the name of the Guile directory within GDB's data directory." },
428 
429   { "gdb-version", 0, 0, 0, as_a_scm_t_subr (gdbscm_gdb_version),
430     "\
431 Return GDB's version string." },
432 
433   { "host-config", 0, 0, 0, as_a_scm_t_subr (gdbscm_host_config),
434     "\
435 Return the name of the host configuration." },
436 
437   { "target-config", 0, 0, 0, as_a_scm_t_subr (gdbscm_target_config),
438     "\
439 Return the name of the target configuration." },
440 
441   END_FUNCTIONS
442 };
443 
444 /* Load BOOT_SCM_FILE, the first Scheme file that gets loaded.  */
445 
446 static SCM
447 boot_guile_support (void *boot_scm_file)
448 {
449   /* Load boot.scm without compiling it (there's no need to compile it).
450      The other files should have been compiled already, and boot.scm is
451      expected to adjust '%load-compiled-path' accordingly.  If they haven't
452      been compiled, Guile will auto-compile them. The important thing to keep
453      in mind is that there's a >= 100x speed difference between compiled and
454      non-compiled files.  */
455   return scm_c_primitive_load ((const char *) boot_scm_file);
456 }
457 
458 /* Return non-zero if ARGS has the "standard" format for throw args.
459    The standard format is:
460    (function format-string (format-string-args-list) ...).
461    FUNCTION is #f if no function was recorded.  */
462 
463 static int
464 standard_throw_args_p (SCM args)
465 {
466   if (gdbscm_is_true (scm_list_p (args))
467       && scm_ilength (args) >= 3)
468     {
469       /* The function in which the error occurred.  */
470       SCM arg0 = scm_list_ref (args, scm_from_int (0));
471       /* The format string.  */
472       SCM arg1 = scm_list_ref (args, scm_from_int (1));
473       /* The arguments of the format string.  */
474       SCM arg2 = scm_list_ref (args, scm_from_int (2));
475 
476       if ((scm_is_string (arg0) || gdbscm_is_false (arg0))
477 	  && scm_is_string (arg1)
478 	  && gdbscm_is_true (scm_list_p (arg2)))
479 	return 1;
480     }
481 
482   return 0;
483 }
484 
485 /* Print the error recorded in a "standard" throw args.  */
486 
487 static void
488 print_standard_throw_error (SCM args)
489 {
490   /* The function in which the error occurred.  */
491   SCM arg0 = scm_list_ref (args, scm_from_int (0));
492   /* The format string.  */
493   SCM arg1 = scm_list_ref (args, scm_from_int (1));
494   /* The arguments of the format string.  */
495   SCM arg2 = scm_list_ref (args, scm_from_int (2));
496 
497   /* ARG0 is #f if no function was recorded.  */
498   if (gdbscm_is_true (arg0))
499     {
500       scm_simple_format (scm_current_error_port (),
501 			 scm_from_latin1_string (_("Error in function ~s:~%")),
502 			 scm_list_1 (arg0));
503     }
504   scm_simple_format (scm_current_error_port (), arg1, arg2);
505 }
506 
507 /* Print the error message recorded in KEY, ARGS, the arguments to throw.
508    Normally we let Scheme print the error message.
509    This function is used when Scheme initialization fails.
510    We can still use the Scheme C API though.  */
511 
512 static void
513 print_throw_error (SCM key, SCM args)
514 {
515   /* IWBN to call gdbscm_print_exception_with_stack here, but Guile didn't
516      boot successfully so play it safe and avoid it.  The "format string" and
517      its args are embedded in ARGS, but the content of ARGS depends on KEY.
518      Make sure ARGS has the expected canonical content before trying to use
519      it.  */
520   if (standard_throw_args_p (args))
521     print_standard_throw_error (args);
522   else
523     {
524       scm_simple_format (scm_current_error_port (),
525 			 scm_from_latin1_string (_("Throw to key `~a' with args `~s'.~%")),
526 			 scm_list_2 (key, args));
527     }
528 }
529 
530 /* Handle an exception thrown while loading BOOT_SCM_FILE.  */
531 
532 static SCM
533 handle_boot_error (void *boot_scm_file, SCM key, SCM args)
534 {
535   gdb_printf (gdb_stderr, ("Exception caught while booting Guile.\n"));
536 
537   print_throw_error (key, args);
538 
539   gdb_printf (gdb_stderr, "\n");
540   warning (_("Could not complete Guile gdb module initialization from:\n"
541 	     "%s.\n"
542 	     "Limited Guile support is available.\n"
543 	     "Suggest passing --data-directory=/path/to/gdb/data-directory."),
544 	   (const char *) boot_scm_file);
545 
546   return SCM_UNSPECIFIED;
547 }
548 
549 /* Load gdb/boot.scm, the Scheme side of GDB/Guile support.
550    Note: This function assumes it's called within the gdb module.  */
551 
552 static void
553 initialize_scheme_side (void)
554 {
555   char *boot_scm_path;
556 
557   guile_datadir = concat (gdb_datadir.c_str (), SLASH_STRING, "guile",
558 			  (char *) NULL);
559   boot_scm_path = concat (guile_datadir, SLASH_STRING, "gdb",
560 			  SLASH_STRING, boot_scm_filename, (char *) NULL);
561 
562   scm_c_catch (SCM_BOOL_T, boot_guile_support, boot_scm_path,
563 	       handle_boot_error, boot_scm_path, NULL, NULL);
564 
565   xfree (boot_scm_path);
566 }
567 
568 /* Install the gdb scheme module.
569    The result is a boolean indicating success.
570    If initializing the gdb module fails an error message is printed.
571    Note: This function runs in the context of the gdb module.  */
572 
573 static void
574 initialize_gdb_module (void *data)
575 {
576   /* Computing these is a pain, so only do it once.
577      Also, do it here and save the result so that obtaining the values
578      is thread-safe.  */
579   gdbscm_guile_major_version = gdbscm_scm_string_to_int (scm_major_version ());
580   gdbscm_guile_minor_version = gdbscm_scm_string_to_int (scm_minor_version ());
581   gdbscm_guile_micro_version = gdbscm_scm_string_to_int (scm_micro_version ());
582 
583   /* The documentation symbol needs to be defined before any calls to
584      gdbscm_define_{variables,functions}.  */
585   gdbscm_documentation_symbol = scm_from_latin1_symbol ("documentation");
586 
587   /* The smob and exception support must be initialized early.  */
588   gdbscm_initialize_smobs ();
589   gdbscm_initialize_exceptions ();
590 
591   /* The rest are initialized in alphabetical order.  */
592   gdbscm_initialize_arches ();
593   gdbscm_initialize_auto_load ();
594   gdbscm_initialize_blocks ();
595   gdbscm_initialize_breakpoints ();
596   gdbscm_initialize_commands ();
597   gdbscm_initialize_disasm ();
598   gdbscm_initialize_frames ();
599   gdbscm_initialize_iterators ();
600   gdbscm_initialize_lazy_strings ();
601   gdbscm_initialize_math ();
602   gdbscm_initialize_objfiles ();
603   gdbscm_initialize_parameters ();
604   gdbscm_initialize_ports ();
605   gdbscm_initialize_pretty_printers ();
606   gdbscm_initialize_pspaces ();
607   gdbscm_initialize_strings ();
608   gdbscm_initialize_symbols ();
609   gdbscm_initialize_symtabs ();
610   gdbscm_initialize_types ();
611   gdbscm_initialize_values ();
612 
613   gdbscm_define_functions (misc_guile_functions, 1);
614 
615   from_tty_keyword = scm_from_latin1_keyword ("from-tty");
616   to_string_keyword = scm_from_latin1_keyword ("to-string");
617 
618   initialize_scheme_side ();
619 
620   gdb_scheme_initialized = 1;
621 }
622 
623 /* Utility to call scm_c_define_module+initialize_gdb_module from
624    within scm_with_guile.  */
625 
626 static void *
627 call_initialize_gdb_module (void *data)
628 {
629   /* Most of the initialization is done by initialize_gdb_module.
630      It is called via scm_c_define_module so that the initialization is
631      performed within the desired module.  */
632   scm_c_define_module (gdbscm_module_name, initialize_gdb_module, NULL);
633 
634 #if HAVE_GUILE_MANUAL_FINALIZATION
635   scm_run_finalizers ();
636 #endif
637 
638   return NULL;
639 }
640 
641 /* A callback to initialize Guile after gdb has finished all its
642    initialization.  This is the extension_language_ops.initialize "method".  */
643 
644 static void
645 gdbscm_initialize (const struct extension_language_defn *extlang)
646 {
647 #if HAVE_GUILE
648   /* The Python support puts the C side in module "_gdb", leaving the
649      Python side to define module "gdb" which imports "_gdb".  There is
650      evidently no similar convention in Guile so we skip this.  */
651 
652 #if HAVE_GUILE_MANUAL_FINALIZATION
653   /* Our SMOB free functions are not thread-safe, as GDB itself is not
654      intended to be thread-safe.  Disable automatic finalization so that
655      finalizers aren't run in other threads.  */
656   scm_set_automatic_finalization_enabled (0);
657 #endif
658 
659   /* Before we initialize Guile, block signals needed by gdb (especially
660      SIGCHLD).  This is done so that all threads created during Guile
661      initialization have SIGCHLD blocked.  PR 17247.  Really libgc and
662      Guile should do this, but we need to work with libgc 7.4.x.  */
663   {
664     gdb::block_signals blocker;
665 
666     /* There are libguile versions (f.i. v3.0.5) that by default call
667        mp_get_memory_functions during initialization to install custom
668        libgmp memory functions.  This is considered a bug and should be
669        fixed starting v3.0.6.
670        Before gdb commit 880ae75a2b7 "gdb delay guile initialization until
671        gdbscm_finish_initialization", that bug had no effect for gdb,
672        because gdb subsequently called mp_get_memory_functions to install
673        its own custom functions in _initialize_gmp_utils.  However, since
674        aforementioned gdb commit the initialization order is reversed,
675        allowing libguile to install a custom malloc that is incompatible
676        with the custom free as used in gmp-utils.c, resulting in a
677        "double free or corruption (out)" error.
678        Work around the libguile bug by disabling the installation of the
679        libgmp memory functions by guile initialization.  */
680 
681     /* The scm_install_gmp_memory_functions variable should be removed after
682        version 3.0, so limit usage to 3.0 and before.  */
683 #if SCM_MAJOR_VERSION < 3 || (SCM_MAJOR_VERSION == 3 && SCM_MINOR_VERSION == 0)
684     /* This variable is deprecated in Guile 3.0.8 and later but remains
685        available in the whole 3.0 series.  */
686 #pragma GCC diagnostic push
687 #pragma GCC diagnostic ignored "-Wdeprecated-declarations"
688     scm_install_gmp_memory_functions = 0;
689 #pragma GCC diagnostic pop
690 #endif
691 
692     /* scm_with_guile is the most portable way to initialize Guile.  Plus
693        we need to initialize the Guile support while in Guile mode (e.g.,
694        called from within a call to scm_with_guile).  */
695     scm_with_guile (call_initialize_gdb_module, NULL);
696   }
697 
698   /* Set Guile's backtrace to match the "set guile print-stack" default.
699      [N.B. The two settings are still separate.]  But only do this after
700      we've initialized Guile, it's nice to see a backtrace if there's an
701      error during initialization.  OTOH, if the error is that gdb/init.scm
702      wasn't found because gdb is being run from the build tree, the
703      backtrace is more noise than signal.  Sigh.  */
704   gdbscm_set_backtrace (0);
705 #endif
706 
707   /* Restore the environment to the user interaction one.  */
708   scm_set_current_module (scm_interaction_environment ());
709 }
710 
711 /* The extension_language_ops.initialized "method".  */
712 
713 static int
714 gdbscm_initialized (const struct extension_language_defn *extlang)
715 {
716   return gdb_scheme_initialized;
717 }
718 
719 /* Enable or disable Guile backtraces.  */
720 
721 static void
722 gdbscm_set_backtrace (int enable)
723 {
724   static const char disable_bt[] = "(debug-disable 'backtrace)";
725   static const char enable_bt[] = "(debug-enable 'backtrace)";
726 
727   if (enable)
728     gdbscm_safe_eval_string (enable_bt, 0);
729   else
730     gdbscm_safe_eval_string (disable_bt, 0);
731 }
732 
733 #endif /* HAVE_GUILE */
734 
735 /* See guile.h.  */
736 cmd_list_element *guile_cmd_element = nullptr;
737 
738 /* Install the various gdb commands used by Guile.  */
739 
740 static void
741 install_gdb_commands (void)
742 {
743   cmd_list_element *guile_repl_cmd
744     = add_com ("guile-repl", class_obscure, 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_cmd, 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   guile_cmd_element = 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_cmd_element, class_obscure, 1);
796 
797   set_show_commands setshow_guile_cmds
798     = add_setshow_prefix_cmd ("guile", class_obscure,
799 			      _("\
800 Prefix command for Guile preference settings."),
801 			      _("\
802 Prefix command for Guile preference settings."),
803 			      &set_guile_list, &show_guile_list,
804 			      &setlist, &showlist);
805 
806   add_alias_cmd ("gu", setshow_guile_cmds.set, class_obscure, 1, &setlist);
807   add_alias_cmd ("gu", setshow_guile_cmds.show, class_obscure, 1, &showlist);
808 
809   cmd_list_element *info_guile_cmd
810     = add_basic_prefix_cmd ("guile", class_obscure,
811 			    _("Prefix command for Guile info displays."),
812 			    &info_guile_list, 0, &infolist);
813   add_info_alias ("gu", info_guile_cmd, 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 void _initialize_guile ();
829 void
830 _initialize_guile ()
831 {
832   install_gdb_commands ();
833 }
834