Commit | Line | Data |
---|---|---|
ed3ef339 DE |
1 | /* General GDB/Guile code. |
2 | ||
88b9d363 | 3 | Copyright (C) 2014-2022 Free Software Foundation, Inc. |
ed3ef339 DE |
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" | |
ed3ef339 DE |
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" | |
cb814510 | 30 | #include "top.h" |
ed3ef339 DE |
31 | #include "extension-priv.h" |
32 | #include "utils.h" | |
268a13a5 | 33 | #include "gdbsupport/version.h" |
ed3ef339 DE |
34 | #ifdef HAVE_GUILE |
35 | #include "guile.h" | |
36 | #include "guile-internal.h" | |
37 | #endif | |
92d8d229 | 38 | #include <signal.h> |
21987b9c | 39 | #include "gdbsupport/block-signals.h" |
ed3ef339 | 40 | |
d2929fdc DE |
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 | ||
15766370 | 50 | #ifdef HAVE_GUILE |
d2929fdc DE |
51 | /* The guile subdirectory within gdb's data-directory. */ |
52 | static const char *guile_datadir; | |
15766370 | 53 | #endif |
d2929fdc | 54 | |
ed3ef339 DE |
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 | ||
ed3ef339 DE |
75 | \f |
76 | #ifdef HAVE_GUILE | |
77 | ||
041ca48e | 78 | static void gdbscm_initialize (const struct extension_language_defn *); |
ed3ef339 DE |
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; | |
880ae75a | 83 | static void gdbscm_set_backtrace (int enable); |
ed3ef339 DE |
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"; | |
186fcde0 | 96 | const char gdbscm_init_module_name[] = "gdb"; |
ed3ef339 DE |
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 | ||
6a25e8a2 | 103 | static const struct extension_language_script_ops guile_extension_script_ops = |
ed3ef339 DE |
104 | { |
105 | gdbscm_source_script, | |
106 | gdbscm_source_objfile_script, | |
9f050062 | 107 | gdbscm_execute_objfile_script, |
ed3ef339 DE |
108 | gdbscm_auto_load_enabled |
109 | }; | |
110 | ||
111 | /* The interface between gdb proper and guile scripting. */ | |
112 | ||
6a25e8a2 | 113 | static const struct extension_language_ops guile_extension_ops = |
ed3ef339 | 114 | { |
041ca48e | 115 | gdbscm_initialize, |
ed3ef339 DE |
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, */ | |
ed3ef339 DE |
134 | NULL, /* gdbscm_set_quit_flag, */ |
135 | }; | |
6a25e8a2 CB |
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", | |
ed3ef339 | 148 | |
6a25e8a2 CB |
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 | |
ed3ef339 DE |
161 | /* Implementation of the gdb "guile-repl" command. */ |
162 | ||
163 | static void | |
0b39b52e | 164 | guile_repl_command (const char *arg, int from_tty) |
ed3ef339 | 165 | { |
156d9eab | 166 | scoped_restore restore_async = make_scoped_restore (¤t_ui->async, 0); |
ed3ef339 DE |
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 | } | |
ed3ef339 DE |
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 | |
0b39b52e | 192 | guile_command (const char *arg, int from_tty) |
ed3ef339 | 193 | { |
156d9eab | 194 | scoped_restore restore_async = make_scoped_restore (¤t_ui->async, 0); |
ed3ef339 DE |
195 | |
196 | arg = skip_spaces (arg); | |
197 | ||
198 | if (arg && *arg) | |
199 | { | |
a1a31cb8 | 200 | gdb::unique_xmalloc_ptr<char> msg = gdbscm_safe_eval_string (arg, 1); |
ed3ef339 DE |
201 | |
202 | if (msg != NULL) | |
a1a31cb8 | 203 | error ("%s", msg.get ()); |
ed3ef339 DE |
204 | } |
205 | else | |
206 | { | |
12973681 | 207 | counted_command_line l = get_command_line (guile_control, ""); |
ed3ef339 | 208 | |
93921405 | 209 | execute_control_command_untraced (l.get ()); |
ed3ef339 | 210 | } |
ed3ef339 DE |
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 | ||
224c3ddb | 229 | script = (char *) xmalloc (size + 1); |
ed3ef339 DE |
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 | { | |
a1a31cb8 | 251 | char *script; |
ed3ef339 | 252 | |
12973681 | 253 | if (cmd->body_list_1 != nullptr) |
ed3ef339 DE |
254 | error (_("Invalid \"guile\" block structure.")); |
255 | ||
12973681 | 256 | script = compute_scheme_string (cmd->body_list_0.get ()); |
a1a31cb8 | 257 | gdb::unique_xmalloc_ptr<char> msg = gdbscm_safe_eval_string (script, 0); |
ed3ef339 DE |
258 | xfree (script); |
259 | if (msg != NULL) | |
a1a31cb8 | 260 | error ("%s", msg.get ()); |
ed3ef339 DE |
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 | { | |
9589edb8 | 273 | gdb::unique_xmalloc_ptr<char> msg = gdbscm_safe_source_script (filename); |
ed3ef339 DE |
274 | |
275 | if (msg != NULL) | |
9589edb8 | 276 | fprintf_filtered (gdb_stderr, "%s\n", msg.get ()); |
ed3ef339 DE |
277 | } |
278 | \f | |
0c3abbc7 | 279 | /* (execute string [#:from-tty boolean] [#:to-string boolean]) |
ed3ef339 DE |
280 | A Scheme function which evaluates a string using the gdb CLI. */ |
281 | ||
282 | static SCM | |
283 | gdbscm_execute_gdb_command (SCM command_scm, SCM rest) | |
284 | { | |
285 | int from_tty_arg_pos = -1, to_string_arg_pos = -1; | |
286 | int from_tty = 0, to_string = 0; | |
ed3ef339 DE |
287 | const SCM keywords[] = { from_tty_keyword, to_string_keyword, SCM_BOOL_F }; |
288 | char *command; | |
ed3ef339 DE |
289 | |
290 | gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#tt", | |
291 | command_scm, &command, rest, | |
292 | &from_tty_arg_pos, &from_tty, | |
293 | &to_string_arg_pos, &to_string); | |
294 | ||
3a5f2a48 | 295 | return gdbscm_wrap ([=] |
ed3ef339 | 296 | { |
3a5f2a48 PA |
297 | gdb::unique_xmalloc_ptr<char> command_holder (command); |
298 | std::string to_string_res; | |
299 | ||
156d9eab TT |
300 | scoped_restore restore_async = make_scoped_restore (¤t_ui->async, |
301 | 0); | |
ed3ef339 | 302 | |
1ac32117 | 303 | scoped_restore preventer = prevent_dont_repeat (); |
ed3ef339 | 304 | if (to_string) |
fa731fa0 | 305 | to_string_res = execute_command_to_string (command, from_tty, false); |
ed3ef339 | 306 | else |
db1ec11f | 307 | execute_command (command, from_tty); |
ed3ef339 DE |
308 | |
309 | /* Do any commands attached to breakpoint we stopped at. */ | |
310 | bpstat_do_actions (); | |
492d29ea | 311 | |
3a5f2a48 PA |
312 | if (to_string) |
313 | return gdbscm_scm_from_c_string (to_string_res.c_str ()); | |
314 | return SCM_UNSPECIFIED; | |
315 | }); | |
ed3ef339 DE |
316 | } |
317 | ||
318 | /* (data-directory) -> string */ | |
319 | ||
320 | static SCM | |
321 | gdbscm_data_directory (void) | |
322 | { | |
f2aec7f6 | 323 | return gdbscm_scm_from_c_string (gdb_datadir.c_str ()); |
ed3ef339 DE |
324 | } |
325 | ||
d2929fdc DE |
326 | /* (guile-data-directory) -> string */ |
327 | ||
328 | static SCM | |
329 | gdbscm_guile_data_directory (void) | |
330 | { | |
331 | return gdbscm_scm_from_c_string (guile_datadir); | |
332 | } | |
333 | ||
ed3ef339 DE |
334 | /* (gdb-version) -> string */ |
335 | ||
336 | static SCM | |
337 | gdbscm_gdb_version (void) | |
338 | { | |
339 | return gdbscm_scm_from_c_string (version); | |
340 | } | |
341 | ||
342 | /* (host-config) -> string */ | |
343 | ||
344 | static SCM | |
345 | gdbscm_host_config (void) | |
346 | { | |
347 | return gdbscm_scm_from_c_string (host_name); | |
348 | } | |
349 | ||
350 | /* (target-config) -> string */ | |
351 | ||
352 | static SCM | |
353 | gdbscm_target_config (void) | |
354 | { | |
355 | return gdbscm_scm_from_c_string (target_name); | |
356 | } | |
357 | ||
358 | #else /* ! HAVE_GUILE */ | |
359 | ||
360 | /* Dummy implementation of the gdb "guile-repl" and "guile" | |
361 | commands. */ | |
362 | ||
363 | static void | |
0b39b52e | 364 | guile_repl_command (const char *arg, int from_tty) |
ed3ef339 DE |
365 | { |
366 | arg = skip_spaces (arg); | |
367 | if (arg && *arg) | |
368 | error (_("guile-repl currently does not take any arguments.")); | |
369 | error (_("Guile scripting is not supported in this copy of GDB.")); | |
370 | } | |
371 | ||
372 | static void | |
0b39b52e | 373 | guile_command (const char *arg, int from_tty) |
ed3ef339 DE |
374 | { |
375 | arg = skip_spaces (arg); | |
376 | if (arg && *arg) | |
377 | error (_("Guile scripting is not supported in this copy of GDB.")); | |
378 | else | |
379 | { | |
380 | /* Even if Guile isn't enabled, we still have to slurp the | |
381 | command list to the corresponding "end". */ | |
12973681 | 382 | counted_command_line l = get_command_line (guile_control, ""); |
ed3ef339 | 383 | |
93921405 | 384 | execute_control_command_untraced (l.get ()); |
ed3ef339 DE |
385 | } |
386 | } | |
387 | ||
388 | #endif /* ! HAVE_GUILE */ | |
389 | \f | |
390 | /* Lists for 'set,show,info guile' commands. */ | |
391 | ||
392 | static struct cmd_list_element *set_guile_list; | |
393 | static struct cmd_list_element *show_guile_list; | |
394 | static struct cmd_list_element *info_guile_list; | |
395 | ||
ed3ef339 DE |
396 | \f |
397 | /* Initialization. */ | |
398 | ||
399 | #ifdef HAVE_GUILE | |
400 | ||
401 | static const scheme_function misc_guile_functions[] = | |
402 | { | |
72e02483 | 403 | { "execute", 1, 0, 1, as_a_scm_t_subr (gdbscm_execute_gdb_command), |
ed3ef339 DE |
404 | "\ |
405 | Execute the given GDB command.\n\ | |
406 | \n\ | |
407 | Arguments: string [#:to-string boolean] [#:from-tty boolean]\n\ | |
408 | If #:from-tty is true then the command executes as if entered\n\ | |
409 | from the keyboard. The default is false (#f).\n\ | |
410 | If #:to-string is true then the result is returned as a string.\n\ | |
411 | Otherwise output is sent to the current output port,\n\ | |
412 | which is the default.\n\ | |
413 | Returns: The result of the command if #:to-string is true.\n\ | |
414 | Otherwise returns unspecified." }, | |
415 | ||
72e02483 | 416 | { "data-directory", 0, 0, 0, as_a_scm_t_subr (gdbscm_data_directory), |
ed3ef339 DE |
417 | "\ |
418 | Return the name of GDB's data directory." }, | |
419 | ||
72e02483 PA |
420 | { "guile-data-directory", 0, 0, 0, |
421 | as_a_scm_t_subr (gdbscm_guile_data_directory), | |
d2929fdc DE |
422 | "\ |
423 | Return the name of the Guile directory within GDB's data directory." }, | |
424 | ||
72e02483 | 425 | { "gdb-version", 0, 0, 0, as_a_scm_t_subr (gdbscm_gdb_version), |
ed3ef339 DE |
426 | "\ |
427 | Return GDB's version string." }, | |
428 | ||
72e02483 | 429 | { "host-config", 0, 0, 0, as_a_scm_t_subr (gdbscm_host_config), |
ed3ef339 DE |
430 | "\ |
431 | Return the name of the host configuration." }, | |
432 | ||
72e02483 | 433 | { "target-config", 0, 0, 0, as_a_scm_t_subr (gdbscm_target_config), |
ed3ef339 DE |
434 | "\ |
435 | Return the name of the target configuration." }, | |
436 | ||
437 | END_FUNCTIONS | |
438 | }; | |
439 | ||
e76c5d17 DE |
440 | /* Load BOOT_SCM_FILE, the first Scheme file that gets loaded. */ |
441 | ||
442 | static SCM | |
443 | boot_guile_support (void *boot_scm_file) | |
444 | { | |
445 | /* Load boot.scm without compiling it (there's no need to compile it). | |
446 | The other files should have been compiled already, and boot.scm is | |
447 | expected to adjust '%load-compiled-path' accordingly. If they haven't | |
448 | been compiled, Guile will auto-compile them. The important thing to keep | |
449 | in mind is that there's a >= 100x speed difference between compiled and | |
450 | non-compiled files. */ | |
451 | return scm_c_primitive_load ((const char *) boot_scm_file); | |
452 | } | |
453 | ||
454 | /* Return non-zero if ARGS has the "standard" format for throw args. | |
455 | The standard format is: | |
456 | (function format-string (format-string-args-list) ...). | |
457 | FUNCTION is #f if no function was recorded. */ | |
458 | ||
459 | static int | |
460 | standard_throw_args_p (SCM args) | |
461 | { | |
462 | if (gdbscm_is_true (scm_list_p (args)) | |
463 | && scm_ilength (args) >= 3) | |
464 | { | |
465 | /* The function in which the error occurred. */ | |
466 | SCM arg0 = scm_list_ref (args, scm_from_int (0)); | |
467 | /* The format string. */ | |
468 | SCM arg1 = scm_list_ref (args, scm_from_int (1)); | |
469 | /* The arguments of the format string. */ | |
470 | SCM arg2 = scm_list_ref (args, scm_from_int (2)); | |
471 | ||
472 | if ((scm_is_string (arg0) || gdbscm_is_false (arg0)) | |
473 | && scm_is_string (arg1) | |
474 | && gdbscm_is_true (scm_list_p (arg2))) | |
475 | return 1; | |
476 | } | |
477 | ||
478 | return 0; | |
479 | } | |
480 | ||
481 | /* Print the error recorded in a "standard" throw args. */ | |
482 | ||
483 | static void | |
484 | print_standard_throw_error (SCM args) | |
485 | { | |
486 | /* The function in which the error occurred. */ | |
487 | SCM arg0 = scm_list_ref (args, scm_from_int (0)); | |
488 | /* The format string. */ | |
489 | SCM arg1 = scm_list_ref (args, scm_from_int (1)); | |
490 | /* The arguments of the format string. */ | |
491 | SCM arg2 = scm_list_ref (args, scm_from_int (2)); | |
492 | ||
493 | /* ARG0 is #f if no function was recorded. */ | |
494 | if (gdbscm_is_true (arg0)) | |
495 | { | |
496 | scm_simple_format (scm_current_error_port (), | |
497 | scm_from_latin1_string (_("Error in function ~s:~%")), | |
498 | scm_list_1 (arg0)); | |
499 | } | |
500 | scm_simple_format (scm_current_error_port (), arg1, arg2); | |
501 | } | |
502 | ||
503 | /* Print the error message recorded in KEY, ARGS, the arguments to throw. | |
504 | Normally we let Scheme print the error message. | |
505 | This function is used when Scheme initialization fails. | |
506 | We can still use the Scheme C API though. */ | |
507 | ||
508 | static void | |
509 | print_throw_error (SCM key, SCM args) | |
510 | { | |
511 | /* IWBN to call gdbscm_print_exception_with_stack here, but Guile didn't | |
512 | boot successfully so play it safe and avoid it. The "format string" and | |
513 | its args are embedded in ARGS, but the content of ARGS depends on KEY. | |
514 | Make sure ARGS has the expected canonical content before trying to use | |
515 | it. */ | |
516 | if (standard_throw_args_p (args)) | |
517 | print_standard_throw_error (args); | |
518 | else | |
519 | { | |
520 | scm_simple_format (scm_current_error_port (), | |
521 | scm_from_latin1_string (_("Throw to key `~a' with args `~s'.~%")), | |
522 | scm_list_2 (key, args)); | |
523 | } | |
524 | } | |
525 | ||
526 | /* Handle an exception thrown while loading BOOT_SCM_FILE. */ | |
527 | ||
528 | static SCM | |
529 | handle_boot_error (void *boot_scm_file, SCM key, SCM args) | |
530 | { | |
531 | fprintf_unfiltered (gdb_stderr, ("Exception caught while booting Guile.\n")); | |
532 | ||
533 | print_throw_error (key, args); | |
534 | ||
535 | fprintf_unfiltered (gdb_stderr, "\n"); | |
536 | warning (_("Could not complete Guile gdb module initialization from:\n" | |
537 | "%s.\n" | |
538 | "Limited Guile support is available.\n" | |
422186a9 | 539 | "Suggest passing --data-directory=/path/to/gdb/data-directory."), |
e76c5d17 DE |
540 | (const char *) boot_scm_file); |
541 | ||
542 | return SCM_UNSPECIFIED; | |
543 | } | |
544 | ||
ed3ef339 DE |
545 | /* Load gdb/boot.scm, the Scheme side of GDB/Guile support. |
546 | Note: This function assumes it's called within the gdb module. */ | |
547 | ||
548 | static void | |
549 | initialize_scheme_side (void) | |
550 | { | |
d2929fdc | 551 | char *boot_scm_path; |
ed3ef339 | 552 | |
f2aec7f6 CB |
553 | guile_datadir = concat (gdb_datadir.c_str (), SLASH_STRING, "guile", |
554 | (char *) NULL); | |
d2929fdc | 555 | boot_scm_path = concat (guile_datadir, SLASH_STRING, "gdb", |
b36cec19 | 556 | SLASH_STRING, boot_scm_filename, (char *) NULL); |
d2929fdc | 557 | |
e76c5d17 DE |
558 | scm_c_catch (SCM_BOOL_T, boot_guile_support, boot_scm_path, |
559 | handle_boot_error, boot_scm_path, NULL, NULL); | |
ed3ef339 | 560 | |
ed3ef339 DE |
561 | xfree (boot_scm_path); |
562 | } | |
563 | ||
564 | /* Install the gdb scheme module. | |
565 | The result is a boolean indicating success. | |
566 | If initializing the gdb module fails an error message is printed. | |
567 | Note: This function runs in the context of the gdb module. */ | |
568 | ||
569 | static void | |
570 | initialize_gdb_module (void *data) | |
571 | { | |
d2929fdc DE |
572 | /* Computing these is a pain, so only do it once. |
573 | Also, do it here and save the result so that obtaining the values | |
574 | is thread-safe. */ | |
575 | gdbscm_guile_major_version = gdbscm_scm_string_to_int (scm_major_version ()); | |
576 | gdbscm_guile_minor_version = gdbscm_scm_string_to_int (scm_minor_version ()); | |
577 | gdbscm_guile_micro_version = gdbscm_scm_string_to_int (scm_micro_version ()); | |
578 | ||
ed3ef339 DE |
579 | /* The documentation symbol needs to be defined before any calls to |
580 | gdbscm_define_{variables,functions}. */ | |
581 | gdbscm_documentation_symbol = scm_from_latin1_symbol ("documentation"); | |
582 | ||
583 | /* The smob and exception support must be initialized early. */ | |
584 | gdbscm_initialize_smobs (); | |
585 | gdbscm_initialize_exceptions (); | |
586 | ||
587 | /* The rest are initialized in alphabetical order. */ | |
588 | gdbscm_initialize_arches (); | |
589 | gdbscm_initialize_auto_load (); | |
590 | gdbscm_initialize_blocks (); | |
591 | gdbscm_initialize_breakpoints (); | |
e698b8c4 | 592 | gdbscm_initialize_commands (); |
ed3ef339 DE |
593 | gdbscm_initialize_disasm (); |
594 | gdbscm_initialize_frames (); | |
595 | gdbscm_initialize_iterators (); | |
596 | gdbscm_initialize_lazy_strings (); | |
597 | gdbscm_initialize_math (); | |
598 | gdbscm_initialize_objfiles (); | |
06eb1586 | 599 | gdbscm_initialize_parameters (); |
ed3ef339 DE |
600 | gdbscm_initialize_ports (); |
601 | gdbscm_initialize_pretty_printers (); | |
ded03782 | 602 | gdbscm_initialize_pspaces (); |
ed3ef339 DE |
603 | gdbscm_initialize_strings (); |
604 | gdbscm_initialize_symbols (); | |
605 | gdbscm_initialize_symtabs (); | |
606 | gdbscm_initialize_types (); | |
607 | gdbscm_initialize_values (); | |
608 | ||
609 | gdbscm_define_functions (misc_guile_functions, 1); | |
610 | ||
611 | from_tty_keyword = scm_from_latin1_keyword ("from-tty"); | |
612 | to_string_keyword = scm_from_latin1_keyword ("to-string"); | |
613 | ||
614 | initialize_scheme_side (); | |
615 | ||
616 | gdb_scheme_initialized = 1; | |
617 | } | |
618 | ||
c1966e26 DE |
619 | /* Utility to call scm_c_define_module+initialize_gdb_module from |
620 | within scm_with_guile. */ | |
621 | ||
622 | static void * | |
623 | call_initialize_gdb_module (void *data) | |
624 | { | |
625 | /* Most of the initialization is done by initialize_gdb_module. | |
626 | It is called via scm_c_define_module so that the initialization is | |
627 | performed within the desired module. */ | |
628 | scm_c_define_module (gdbscm_module_name, initialize_gdb_module, NULL); | |
629 | ||
92fab5a6 AW |
630 | #if HAVE_GUILE_MANUAL_FINALIZATION |
631 | scm_run_finalizers (); | |
632 | #endif | |
633 | ||
c1966e26 DE |
634 | return NULL; |
635 | } | |
636 | ||
041ca48e AB |
637 | /* A callback to initialize Guile after gdb has finished all its |
638 | initialization. This is the extension_language_ops.initialize "method". */ | |
ed3ef339 DE |
639 | |
640 | static void | |
041ca48e | 641 | gdbscm_initialize (const struct extension_language_defn *extlang) |
ed3ef339 | 642 | { |
880ae75a AB |
643 | #if HAVE_GUILE |
644 | /* The Python support puts the C side in module "_gdb", leaving the | |
645 | Python side to define module "gdb" which imports "_gdb". There is | |
646 | evidently no similar convention in Guile so we skip this. */ | |
647 | ||
648 | #if HAVE_GUILE_MANUAL_FINALIZATION | |
649 | /* Our SMOB free functions are not thread-safe, as GDB itself is not | |
650 | intended to be thread-safe. Disable automatic finalization so that | |
651 | finalizers aren't run in other threads. */ | |
652 | scm_set_automatic_finalization_enabled (0); | |
653 | #endif | |
654 | ||
655 | /* Before we initialize Guile, block signals needed by gdb (especially | |
656 | SIGCHLD). This is done so that all threads created during Guile | |
657 | initialization have SIGCHLD blocked. PR 17247. Really libgc and | |
658 | Guile should do this, but we need to work with libgc 7.4.x. */ | |
659 | { | |
660 | gdb::block_signals blocker; | |
661 | ||
225bda24 TV |
662 | /* There are libguile versions (f.i. v3.0.5) that by default call |
663 | mp_get_memory_functions during initialization to install custom | |
664 | libgmp memory functions. This is considered a bug and should be | |
665 | fixed starting v3.0.6. | |
666 | Before gdb commit 880ae75a2b7 "gdb delay guile initialization until | |
667 | gdbscm_finish_initialization", that bug had no effect for gdb, | |
668 | because gdb subsequently called mp_get_memory_functions to install | |
669 | its own custom functions in _initialize_gmp_utils. However, since | |
670 | aforementioned gdb commit the initialization order is reversed, | |
671 | allowing libguile to install a custom malloc that is incompatible | |
672 | with the custom free as used in gmp-utils.c, resulting in a | |
673 | "double free or corruption (out)" error. | |
674 | Work around the libguile bug by disabling the installation of the | |
675 | libgmp memory functions by guile initialization. */ | |
676 | scm_install_gmp_memory_functions = 0; | |
677 | ||
880ae75a AB |
678 | /* scm_with_guile is the most portable way to initialize Guile. Plus |
679 | we need to initialize the Guile support while in Guile mode (e.g., | |
680 | called from within a call to scm_with_guile). */ | |
681 | scm_with_guile (call_initialize_gdb_module, NULL); | |
682 | } | |
683 | ||
684 | /* Set Guile's backtrace to match the "set guile print-stack" default. | |
685 | [N.B. The two settings are still separate.] But only do this after | |
686 | we've initialized Guile, it's nice to see a backtrace if there's an | |
687 | error during initialization. OTOH, if the error is that gdb/init.scm | |
688 | wasn't found because gdb is being run from the build tree, the | |
689 | backtrace is more noise than signal. Sigh. */ | |
690 | gdbscm_set_backtrace (0); | |
691 | #endif | |
692 | ||
ed3ef339 DE |
693 | /* Restore the environment to the user interaction one. */ |
694 | scm_set_current_module (scm_interaction_environment ()); | |
695 | } | |
696 | ||
697 | /* The extension_language_ops.initialized "method". */ | |
698 | ||
699 | static int | |
700 | gdbscm_initialized (const struct extension_language_defn *extlang) | |
701 | { | |
702 | return gdb_scheme_initialized; | |
703 | } | |
704 | ||
705 | /* Enable or disable Guile backtraces. */ | |
706 | ||
707 | static void | |
708 | gdbscm_set_backtrace (int enable) | |
709 | { | |
710 | static const char disable_bt[] = "(debug-disable 'backtrace)"; | |
711 | static const char enable_bt[] = "(debug-enable 'backtrace)"; | |
712 | ||
713 | if (enable) | |
714 | gdbscm_safe_eval_string (enable_bt, 0); | |
715 | else | |
716 | gdbscm_safe_eval_string (disable_bt, 0); | |
717 | } | |
718 | ||
719 | #endif /* HAVE_GUILE */ | |
720 | ||
8588b356 SM |
721 | /* See guile.h. */ |
722 | cmd_list_element *guile_cmd_element = nullptr; | |
723 | ||
ed3ef339 DE |
724 | /* Install the various gdb commands used by Guile. */ |
725 | ||
726 | static void | |
727 | install_gdb_commands (void) | |
728 | { | |
3947f654 SM |
729 | cmd_list_element *guile_repl_cmd |
730 | = add_com ("guile-repl", class_obscure, guile_repl_command, | |
ed3ef339 DE |
731 | #ifdef HAVE_GUILE |
732 | _("\ | |
733 | Start an interactive Guile prompt.\n\ | |
734 | \n\ | |
735 | To return to GDB, type the EOF character (e.g., Ctrl-D on an empty\n\ | |
736 | prompt) or ,quit.") | |
737 | #else /* HAVE_GUILE */ | |
738 | _("\ | |
739 | Start a Guile interactive prompt.\n\ | |
740 | \n\ | |
741 | Guile scripting is not supported in this copy of GDB.\n\ | |
742 | This command is only a placeholder.") | |
743 | #endif /* HAVE_GUILE */ | |
744 | ); | |
3947f654 | 745 | add_com_alias ("gr", guile_repl_cmd, class_obscure, 1); |
ed3ef339 DE |
746 | |
747 | /* Since "help guile" is easy to type, and intuitive, we add general help | |
748 | in using GDB+Guile to this command. */ | |
8588b356 | 749 | guile_cmd_element = add_com ("guile", class_obscure, guile_command, |
ed3ef339 DE |
750 | #ifdef HAVE_GUILE |
751 | _("\ | |
752 | Evaluate one or more Guile expressions.\n\ | |
753 | \n\ | |
754 | The expression(s) can be given as an argument, for instance:\n\ | |
755 | \n\ | |
756 | guile (display 23)\n\ | |
757 | \n\ | |
758 | The result of evaluating the last expression is printed.\n\ | |
759 | \n\ | |
760 | If no argument is given, the following lines are read and passed\n\ | |
761 | to Guile for evaluation. Type a line containing \"end\" to indicate\n\ | |
762 | the end of the set of expressions.\n\ | |
763 | \n\ | |
764 | The Guile GDB module must first be imported before it can be used.\n\ | |
765 | Do this with:\n\ | |
766 | (gdb) guile (use-modules (gdb))\n\ | |
767 | or if you want to import the (gdb) module with a prefix, use:\n\ | |
768 | (gdb) guile (use-modules ((gdb) #:renamer (symbol-prefix-proc 'gdb:)))\n\ | |
769 | \n\ | |
770 | The Guile interactive session, started with the \"guile-repl\"\n\ | |
771 | command, provides extensive help and apropos capabilities.\n\ | |
772 | Type \",help\" once in a Guile interactive session.") | |
773 | #else /* HAVE_GUILE */ | |
774 | _("\ | |
775 | Evaluate a Guile expression.\n\ | |
776 | \n\ | |
777 | Guile scripting is not supported in this copy of GDB.\n\ | |
778 | This command is only a placeholder.") | |
779 | #endif /* HAVE_GUILE */ | |
780 | ); | |
3947f654 | 781 | add_com_alias ("gu", guile_cmd_element, class_obscure, 1); |
ed3ef339 | 782 | |
5e84b7ee SM |
783 | cmd_list_element *set_guile_cmd |
784 | = add_basic_prefix_cmd ("guile", class_obscure, | |
785 | _("Prefix command for Guile preference settings."), | |
786 | &set_guile_list, 0, &setlist); | |
787 | add_alias_cmd ("gu", set_guile_cmd, class_obscure, 1, &setlist); | |
788 | ||
789 | cmd_list_element *show_guile_cmd | |
790 | = add_show_prefix_cmd ("guile", class_obscure, | |
791 | _("Prefix command for Guile preference settings."), | |
792 | &show_guile_list, 0, &showlist); | |
793 | add_alias_cmd ("gu", show_guile_cmd, class_obscure, 1, &showlist); | |
ed3ef339 | 794 | |
e0f25bd9 SM |
795 | cmd_list_element *info_guile_cmd |
796 | = add_basic_prefix_cmd ("guile", class_obscure, | |
797 | _("Prefix command for Guile info displays."), | |
798 | &info_guile_list, 0, &infolist); | |
799 | add_info_alias ("gu", info_guile_cmd, 1); | |
ed3ef339 DE |
800 | |
801 | /* The name "print-stack" is carried over from Python. | |
802 | A better name is "print-exception". */ | |
803 | add_setshow_enum_cmd ("print-stack", no_class, guile_print_excp_enums, | |
804 | &gdbscm_print_excp, _("\ | |
805 | Set mode for Guile exception printing on error."), _("\ | |
806 | Show the mode of Guile exception printing on error."), _("\ | |
807 | none == no stack or message will be printed.\n\ | |
808 | full == a message and a stack will be printed.\n\ | |
809 | message == an error message without a stack will be printed."), | |
810 | NULL, NULL, | |
811 | &set_guile_list, &show_guile_list); | |
812 | } | |
813 | ||
6c265988 | 814 | void _initialize_guile (); |
ed3ef339 | 815 | void |
6c265988 | 816 | _initialize_guile () |
ed3ef339 | 817 | { |
ed3ef339 | 818 | install_gdb_commands (); |
ed3ef339 | 819 | } |