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