1 /* General GDB/Guile code.
3 Copyright (C) 2014-2020 Free Software Foundation, Inc.
5 This file is part of GDB.
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.
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.
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/>. */
20 /* See README file in this directory for implementation notes, coding
21 conventions, et.al. */
24 #include "breakpoint.h"
25 #include "cli/cli-cmds.h"
26 #include "cli/cli-script.h"
27 #include "cli/cli-utils.h"
31 #include "extension-priv.h"
33 #include "gdbsupport/version.h"
36 #include "guile-internal.h"
39 #include "gdbsupport/block-signals.h"
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
;
51 /* The guile subdirectory within gdb's data-directory. */
52 static const char *guile_datadir
;
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";
60 /* "set guile print-stack" choices. */
61 static const char *const guile_print_excp_enums
[] =
63 gdbscm_print_excp_none
,
64 gdbscm_print_excp_full
,
65 gdbscm_print_excp_message
,
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
73 const char *gdbscm_print_excp
= gdbscm_print_excp_message
;
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
;
85 int gdb_scheme_initialized
;
87 /* Symbol for setting documentation strings. */
88 SCM gdbscm_documentation_symbol
;
90 /* Keywords used by various functions. */
91 static SCM from_tty_keyword
;
92 static SCM to_string_keyword
;
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";
98 /* The name of the bootstrap file. */
99 static const char boot_scm_filename
[] = "boot.scm";
101 /* The interface between gdb proper and loading of python scripts. */
103 static const struct extension_language_script_ops guile_extension_script_ops
=
105 gdbscm_source_script
,
106 gdbscm_source_objfile_script
,
107 gdbscm_execute_objfile_script
,
108 gdbscm_auto_load_enabled
111 /* The interface between gdb proper and guile scripting. */
113 static const struct extension_language_ops guile_extension_ops
=
115 gdbscm_finish_initialization
,
118 gdbscm_eval_from_control_command
,
120 NULL
, /* gdbscm_start_type_printers, */
121 NULL
, /* gdbscm_apply_type_printers, */
122 NULL
, /* gdbscm_free_type_printers, */
124 gdbscm_apply_val_pretty_printer
,
126 NULL
, /* gdbscm_apply_frame_filter, */
128 gdbscm_preserve_values
,
130 gdbscm_breakpoint_has_cond
,
131 gdbscm_breakpoint_cond_says_stop
,
133 NULL
, /* gdbscm_check_quit_flag, */
134 NULL
, /* gdbscm_set_quit_flag, */
138 /* The main struct describing GDB's interface to the Guile
139 extension language. */
140 extern const struct extension_language_defn extension_language_guile
=
152 &guile_extension_script_ops
,
161 /* Implementation of the gdb "guile-repl" command. */
164 guile_repl_command (const char *arg
, int from_tty
)
166 scoped_restore restore_async
= make_scoped_restore (¤t_ui
->async
, 0);
168 arg
= skip_spaces (arg
);
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. */
177 error (_("guile-repl currently does not take any arguments."));
181 gdbscm_enter_repl ();
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.
189 TODO: Add the result to Guile's history? */
192 guile_command (const char *arg
, int from_tty
)
194 scoped_restore restore_async
= make_scoped_restore (¤t_ui
->async
, 0);
196 arg
= skip_spaces (arg
);
200 gdb::unique_xmalloc_ptr
<char> msg
= gdbscm_safe_eval_string (arg
, 1);
203 error ("%s", msg
.get ());
207 counted_command_line l
= get_command_line (guile_control
, "");
209 execute_control_command_untraced (l
.get ());
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
219 compute_scheme_string (struct command_line
*l
)
221 struct command_line
*iter
;
226 for (iter
= l
; iter
; iter
= iter
->next
)
227 size
+= strlen (iter
->line
) + 1;
229 script
= (char *) xmalloc (size
+ 1);
231 for (iter
= l
; iter
; iter
= iter
->next
)
233 int len
= strlen (iter
->line
);
235 strcpy (&script
[here
], iter
->line
);
237 script
[here
++] = '\n';
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". */
248 gdbscm_eval_from_control_command
249 (const struct extension_language_defn
*extlang
, struct command_line
*cmd
)
253 if (cmd
->body_list_1
!= nullptr)
254 error (_("Invalid \"guile\" block structure."));
256 script
= compute_scheme_string (cmd
->body_list_0
.get ());
257 gdb::unique_xmalloc_ptr
<char> msg
= gdbscm_safe_eval_string (script
, 0);
260 error ("%s", msg
.get ());
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
270 gdbscm_source_script (const struct extension_language_defn
*extlang
,
271 FILE *file
, const char *filename
)
273 char *msg
= gdbscm_safe_source_script (filename
);
277 fprintf_filtered (gdb_stderr
, "%s\n", msg
);
282 /* (execute string [#:from-tty boolean] [#:to-string boolean])
283 A Scheme function which evaluates a string using the gdb CLI. */
286 gdbscm_execute_gdb_command (SCM command_scm
, SCM rest
)
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
};
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
);
298 return gdbscm_wrap ([=]
300 gdb::unique_xmalloc_ptr
<char> command_holder (command
);
301 std::string to_string_res
;
303 scoped_restore restore_async
= make_scoped_restore (¤t_ui
->async
,
306 scoped_restore preventer
= prevent_dont_repeat ();
308 to_string_res
= execute_command_to_string (command
, from_tty
, false);
310 execute_command (command
, from_tty
);
312 /* Do any commands attached to breakpoint we stopped at. */
313 bpstat_do_actions ();
316 return gdbscm_scm_from_c_string (to_string_res
.c_str ());
317 return SCM_UNSPECIFIED
;
321 /* (data-directory) -> string */
324 gdbscm_data_directory (void)
326 return gdbscm_scm_from_c_string (gdb_datadir
.c_str ());
329 /* (guile-data-directory) -> string */
332 gdbscm_guile_data_directory (void)
334 return gdbscm_scm_from_c_string (guile_datadir
);
337 /* (gdb-version) -> string */
340 gdbscm_gdb_version (void)
342 return gdbscm_scm_from_c_string (version
);
345 /* (host-config) -> string */
348 gdbscm_host_config (void)
350 return gdbscm_scm_from_c_string (host_name
);
353 /* (target-config) -> string */
356 gdbscm_target_config (void)
358 return gdbscm_scm_from_c_string (target_name
);
361 #else /* ! HAVE_GUILE */
363 /* Dummy implementation of the gdb "guile-repl" and "guile"
367 guile_repl_command (const char *arg
, int from_tty
)
369 arg
= skip_spaces (arg
);
371 error (_("guile-repl currently does not take any arguments."));
372 error (_("Guile scripting is not supported in this copy of GDB."));
376 guile_command (const char *arg
, int from_tty
)
378 arg
= skip_spaces (arg
);
380 error (_("Guile scripting is not supported in this copy of GDB."));
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
, "");
387 execute_control_command_untraced (l
.get ());
391 #endif /* ! HAVE_GUILE */
393 /* Lists for 'set,show,info guile' commands. */
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
;
400 /* Initialization. */
404 static const scheme_function misc_guile_functions
[] =
406 { "execute", 1, 0, 1, as_a_scm_t_subr (gdbscm_execute_gdb_command
),
408 Execute the given GDB command.\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." },
419 { "data-directory", 0, 0, 0, as_a_scm_t_subr (gdbscm_data_directory
),
421 Return the name of GDB's data directory." },
423 { "guile-data-directory", 0, 0, 0,
424 as_a_scm_t_subr (gdbscm_guile_data_directory
),
426 Return the name of the Guile directory within GDB's data directory." },
428 { "gdb-version", 0, 0, 0, as_a_scm_t_subr (gdbscm_gdb_version
),
430 Return GDB's version string." },
432 { "host-config", 0, 0, 0, as_a_scm_t_subr (gdbscm_host_config
),
434 Return the name of the host configuration." },
436 { "target-config", 0, 0, 0, as_a_scm_t_subr (gdbscm_target_config
),
438 Return the name of the target configuration." },
443 /* Load BOOT_SCM_FILE, the first Scheme file that gets loaded. */
446 boot_guile_support (void *boot_scm_file
)
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
);
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. */
463 standard_throw_args_p (SCM args
)
465 if (gdbscm_is_true (scm_list_p (args
))
466 && scm_ilength (args
) >= 3)
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));
475 if ((scm_is_string (arg0
) || gdbscm_is_false (arg0
))
476 && scm_is_string (arg1
)
477 && gdbscm_is_true (scm_list_p (arg2
)))
484 /* Print the error recorded in a "standard" throw args. */
487 print_standard_throw_error (SCM args
)
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));
496 /* ARG0 is #f if no function was recorded. */
497 if (gdbscm_is_true (arg0
))
499 scm_simple_format (scm_current_error_port (),
500 scm_from_latin1_string (_("Error in function ~s:~%")),
503 scm_simple_format (scm_current_error_port (), arg1
, arg2
);
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. */
512 print_throw_error (SCM key
, SCM args
)
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
519 if (standard_throw_args_p (args
))
520 print_standard_throw_error (args
);
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
));
529 /* Handle an exception thrown while loading BOOT_SCM_FILE. */
532 handle_boot_error (void *boot_scm_file
, SCM key
, SCM args
)
534 fprintf_unfiltered (gdb_stderr
, ("Exception caught while booting Guile.\n"));
536 print_throw_error (key
, args
);
538 fprintf_unfiltered (gdb_stderr
, "\n");
539 warning (_("Could not complete Guile gdb module initialization from:\n"
541 "Limited Guile support is available.\n"
542 "Suggest passing --data-directory=/path/to/gdb/data-directory."),
543 (const char *) boot_scm_file
);
545 return SCM_UNSPECIFIED
;
548 /* Load gdb/boot.scm, the Scheme side of GDB/Guile support.
549 Note: This function assumes it's called within the gdb module. */
552 initialize_scheme_side (void)
556 guile_datadir
= concat (gdb_datadir
.c_str (), SLASH_STRING
, "guile",
558 boot_scm_path
= concat (guile_datadir
, SLASH_STRING
, "gdb",
559 SLASH_STRING
, boot_scm_filename
, (char *) NULL
);
561 scm_c_catch (SCM_BOOL_T
, boot_guile_support
, boot_scm_path
,
562 handle_boot_error
, boot_scm_path
, NULL
, NULL
);
564 xfree (boot_scm_path
);
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. */
573 initialize_gdb_module (void *data
)
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
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 ());
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");
586 /* The smob and exception support must be initialized early. */
587 gdbscm_initialize_smobs ();
588 gdbscm_initialize_exceptions ();
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 ();
612 gdbscm_define_functions (misc_guile_functions
, 1);
614 from_tty_keyword
= scm_from_latin1_keyword ("from-tty");
615 to_string_keyword
= scm_from_latin1_keyword ("to-string");
617 initialize_scheme_side ();
619 gdb_scheme_initialized
= 1;
622 /* Utility to call scm_c_define_module+initialize_gdb_module from
623 within scm_with_guile. */
626 call_initialize_gdb_module (void *data
)
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
);
633 #if HAVE_GUILE_MANUAL_FINALIZATION
634 scm_run_finalizers ();
640 /* A callback to finish Guile initialization after gdb has finished all its
642 This is the extension_language_ops.finish_initialization "method". */
645 gdbscm_finish_initialization (const struct extension_language_defn
*extlang
)
647 /* Restore the environment to the user interaction one. */
648 scm_set_current_module (scm_interaction_environment ());
651 /* The extension_language_ops.initialized "method". */
654 gdbscm_initialized (const struct extension_language_defn
*extlang
)
656 return gdb_scheme_initialized
;
659 /* Enable or disable Guile backtraces. */
662 gdbscm_set_backtrace (int enable
)
664 static const char disable_bt
[] = "(debug-disable 'backtrace)";
665 static const char enable_bt
[] = "(debug-enable 'backtrace)";
668 gdbscm_safe_eval_string (enable_bt
, 0);
670 gdbscm_safe_eval_string (disable_bt
, 0);
673 #endif /* HAVE_GUILE */
676 cmd_list_element
*guile_cmd_element
= nullptr;
678 /* Install the various gdb commands used by Guile. */
681 install_gdb_commands (void)
683 add_com ("guile-repl", class_obscure
,
687 Start an interactive Guile prompt.\n\
689 To return to GDB, type the EOF character (e.g., Ctrl-D on an empty\n\
691 #else /* HAVE_GUILE */
693 Start a Guile interactive prompt.\n\
695 Guile scripting is not supported in this copy of GDB.\n\
696 This command is only a placeholder.")
697 #endif /* HAVE_GUILE */
699 add_com_alias ("gr", "guile-repl", class_obscure
, 1);
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
,
706 Evaluate one or more Guile expressions.\n\
708 The expression(s) can be given as an argument, for instance:\n\
710 guile (display 23)\n\
712 The result of evaluating the last expression is printed.\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\
718 The Guile GDB module must first be imported before it can be used.\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\
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 */
729 Evaluate a Guile expression.\n\
731 Guile scripting is not supported in this copy of GDB.\n\
732 This command is only a placeholder.")
733 #endif /* HAVE_GUILE */
735 add_com_alias ("gu", "guile", class_obscure
, 1);
737 add_basic_prefix_cmd ("guile", class_obscure
,
738 _("Prefix command for Guile preference settings."),
739 &set_guile_list
, "set guile ", 0,
741 add_alias_cmd ("gu", "guile", class_obscure
, 1, &setlist
);
743 add_show_prefix_cmd ("guile", class_obscure
,
744 _("Prefix command for Guile preference settings."),
745 &show_guile_list
, "show guile ", 0,
747 add_alias_cmd ("gu", "guile", class_obscure
, 1, &showlist
);
749 add_basic_prefix_cmd ("guile", class_obscure
,
750 _("Prefix command for Guile info displays."),
751 &info_guile_list
, "info guile ", 0,
753 add_info_alias ("gu", "guile", 1);
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."),
765 &set_guile_list
, &show_guile_list
);
768 void _initialize_guile ();
772 install_gdb_commands ();
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. */
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);
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
794 gdb::block_signals blocker
;
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
);
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.
809 gdbscm_set_backtrace (0);