Commit | Line | Data |
---|---|---|
ed3ef339 DE |
1 | /* General GDB/Guile code. |
2 | ||
32d0add0 | 3 | Copyright (C) 2014-2015 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" | |
30 | #include "interps.h" | |
31 | #include "extension-priv.h" | |
32 | #include "utils.h" | |
33 | #include "version.h" | |
34 | #ifdef HAVE_GUILE | |
35 | #include "guile.h" | |
36 | #include "guile-internal.h" | |
37 | #endif | |
92d8d229 | 38 | #include <signal.h> |
ed3ef339 | 39 | |
d2929fdc DE |
40 | /* The Guile version we're using. |
41 | We *could* use the macros in libguile/version.h but that would preclude | |
42 | handling the user switching in a different version with, e.g., | |
43 | LD_LIBRARY_PATH (using a different version than what gdb was compiled with | |
44 | is not something to be done lightly, but can be useful). */ | |
45 | int gdbscm_guile_major_version; | |
46 | int gdbscm_guile_minor_version; | |
47 | int gdbscm_guile_micro_version; | |
48 | ||
49 | /* The guile subdirectory within gdb's data-directory. */ | |
50 | static const char *guile_datadir; | |
51 | ||
ed3ef339 DE |
52 | /* Declared constants and enum for guile exception printing. */ |
53 | const char gdbscm_print_excp_none[] = "none"; | |
54 | const char gdbscm_print_excp_full[] = "full"; | |
55 | const char gdbscm_print_excp_message[] = "message"; | |
56 | ||
57 | /* "set guile print-stack" choices. */ | |
58 | static const char *const guile_print_excp_enums[] = | |
59 | { | |
60 | gdbscm_print_excp_none, | |
61 | gdbscm_print_excp_full, | |
62 | gdbscm_print_excp_message, | |
63 | NULL | |
64 | }; | |
65 | ||
66 | /* The exception printing variable. 'full' if we want to print the | |
67 | error message and stack, 'none' if we want to print nothing, and | |
68 | 'message' if we only want to print the error message. 'message' is | |
69 | the default. */ | |
70 | const char *gdbscm_print_excp = gdbscm_print_excp_message; | |
71 | ||
72 | #ifdef HAVE_GUILE | |
73 | /* Forward decls, these are defined later. */ | |
e36122e9 TT |
74 | extern const struct extension_language_script_ops guile_extension_script_ops; |
75 | extern const struct extension_language_ops guile_extension_ops; | |
ed3ef339 DE |
76 | #endif |
77 | ||
78 | /* The main struct describing GDB's interface to the Guile | |
79 | extension language. */ | |
80 | const struct extension_language_defn extension_language_guile = | |
81 | { | |
82 | EXT_LANG_GUILE, | |
83 | "guile", | |
84 | "Guile", | |
85 | ||
86 | ".scm", | |
87 | "-gdb.scm", | |
88 | ||
89 | guile_control, | |
90 | ||
91 | #ifdef HAVE_GUILE | |
92 | &guile_extension_script_ops, | |
93 | &guile_extension_ops | |
94 | #else | |
95 | NULL, | |
96 | NULL | |
97 | #endif | |
98 | }; | |
99 | \f | |
100 | #ifdef HAVE_GUILE | |
101 | ||
102 | static void gdbscm_finish_initialization | |
103 | (const struct extension_language_defn *); | |
104 | static int gdbscm_initialized (const struct extension_language_defn *); | |
105 | static void gdbscm_eval_from_control_command | |
106 | (const struct extension_language_defn *, struct command_line *); | |
107 | static script_sourcer_func gdbscm_source_script; | |
108 | ||
109 | int gdb_scheme_initialized; | |
110 | ||
111 | /* Symbol for setting documentation strings. */ | |
112 | SCM gdbscm_documentation_symbol; | |
113 | ||
114 | /* Keywords used by various functions. */ | |
115 | static SCM from_tty_keyword; | |
116 | static SCM to_string_keyword; | |
117 | ||
118 | /* The name of the various modules (without the surrounding parens). */ | |
119 | const char gdbscm_module_name[] = "gdb"; | |
186fcde0 | 120 | const char gdbscm_init_module_name[] = "gdb"; |
ed3ef339 DE |
121 | |
122 | /* The name of the bootstrap file. */ | |
123 | static const char boot_scm_filename[] = "boot.scm"; | |
124 | ||
125 | /* The interface between gdb proper and loading of python scripts. */ | |
126 | ||
e36122e9 | 127 | const struct extension_language_script_ops guile_extension_script_ops = |
ed3ef339 DE |
128 | { |
129 | gdbscm_source_script, | |
130 | gdbscm_source_objfile_script, | |
9f050062 | 131 | gdbscm_execute_objfile_script, |
ed3ef339 DE |
132 | gdbscm_auto_load_enabled |
133 | }; | |
134 | ||
135 | /* The interface between gdb proper and guile scripting. */ | |
136 | ||
e36122e9 | 137 | const struct extension_language_ops guile_extension_ops = |
ed3ef339 DE |
138 | { |
139 | gdbscm_finish_initialization, | |
140 | gdbscm_initialized, | |
141 | ||
142 | gdbscm_eval_from_control_command, | |
143 | ||
144 | NULL, /* gdbscm_start_type_printers, */ | |
145 | NULL, /* gdbscm_apply_type_printers, */ | |
146 | NULL, /* gdbscm_free_type_printers, */ | |
147 | ||
148 | gdbscm_apply_val_pretty_printer, | |
149 | ||
150 | NULL, /* gdbscm_apply_frame_filter, */ | |
151 | ||
152 | gdbscm_preserve_values, | |
153 | ||
154 | gdbscm_breakpoint_has_cond, | |
155 | gdbscm_breakpoint_cond_says_stop, | |
156 | ||
157 | NULL, /* gdbscm_check_quit_flag, */ | |
158 | NULL, /* gdbscm_clear_quit_flag, */ | |
159 | NULL, /* gdbscm_set_quit_flag, */ | |
160 | }; | |
161 | ||
162 | /* Implementation of the gdb "guile-repl" command. */ | |
163 | ||
164 | static void | |
165 | guile_repl_command (char *arg, int from_tty) | |
166 | { | |
167 | struct cleanup *cleanup; | |
168 | ||
169 | cleanup = make_cleanup_restore_integer (&interpreter_async); | |
170 | interpreter_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 | do_cleanups (cleanup); | |
189 | } | |
190 | ||
191 | /* Implementation of the gdb "guile" command. | |
192 | Note: Contrary to the Python version this displays the result. | |
193 | Have to see which is better. | |
194 | ||
195 | TODO: Add the result to Guile's history? */ | |
196 | ||
197 | static void | |
198 | guile_command (char *arg, int from_tty) | |
199 | { | |
200 | struct cleanup *cleanup; | |
201 | ||
202 | cleanup = make_cleanup_restore_integer (&interpreter_async); | |
203 | interpreter_async = 0; | |
204 | ||
205 | arg = skip_spaces (arg); | |
206 | ||
207 | if (arg && *arg) | |
208 | { | |
209 | char *msg = gdbscm_safe_eval_string (arg, 1); | |
210 | ||
211 | if (msg != NULL) | |
212 | { | |
213 | make_cleanup (xfree, msg); | |
214 | error ("%s", msg); | |
215 | } | |
216 | } | |
217 | else | |
218 | { | |
219 | struct command_line *l = get_command_line (guile_control, ""); | |
220 | ||
221 | make_cleanup_free_command_lines (&l); | |
222 | execute_control_command_untraced (l); | |
223 | } | |
224 | ||
225 | do_cleanups (cleanup); | |
226 | } | |
227 | ||
228 | /* Given a command_line, return a command string suitable for passing | |
229 | to Guile. Lines in the string are separated by newlines. The return | |
230 | value is allocated using xmalloc and the caller is responsible for | |
231 | freeing it. */ | |
232 | ||
233 | static char * | |
234 | compute_scheme_string (struct command_line *l) | |
235 | { | |
236 | struct command_line *iter; | |
237 | char *script = NULL; | |
238 | int size = 0; | |
239 | int here; | |
240 | ||
241 | for (iter = l; iter; iter = iter->next) | |
242 | size += strlen (iter->line) + 1; | |
243 | ||
244 | script = xmalloc (size + 1); | |
245 | here = 0; | |
246 | for (iter = l; iter; iter = iter->next) | |
247 | { | |
248 | int len = strlen (iter->line); | |
249 | ||
250 | strcpy (&script[here], iter->line); | |
251 | here += len; | |
252 | script[here++] = '\n'; | |
253 | } | |
254 | script[here] = '\0'; | |
255 | return script; | |
256 | } | |
257 | ||
258 | /* Take a command line structure representing a "guile" command, and | |
259 | evaluate its body using the Guile interpreter. | |
260 | This is the extension_language_ops.eval_from_control_command "method". */ | |
261 | ||
262 | static void | |
263 | gdbscm_eval_from_control_command | |
264 | (const struct extension_language_defn *extlang, struct command_line *cmd) | |
265 | { | |
266 | char *script, *msg; | |
267 | struct cleanup *cleanup; | |
268 | ||
269 | if (cmd->body_count != 1) | |
270 | error (_("Invalid \"guile\" block structure.")); | |
271 | ||
272 | cleanup = make_cleanup (null_cleanup, NULL); | |
273 | ||
274 | script = compute_scheme_string (cmd->body_list[0]); | |
275 | msg = gdbscm_safe_eval_string (script, 0); | |
276 | xfree (script); | |
277 | if (msg != NULL) | |
278 | { | |
279 | make_cleanup (xfree, msg); | |
280 | error ("%s", msg); | |
281 | } | |
282 | ||
283 | do_cleanups (cleanup); | |
284 | } | |
285 | ||
286 | /* Read a file as Scheme code. | |
287 | This is the extension_language_script_ops.script_sourcer "method". | |
288 | FILE is the file to run. FILENAME is name of the file FILE. | |
289 | This does not throw any errors. If an exception occurs an error message | |
290 | is printed. */ | |
291 | ||
292 | static void | |
293 | gdbscm_source_script (const struct extension_language_defn *extlang, | |
294 | FILE *file, const char *filename) | |
295 | { | |
296 | char *msg = gdbscm_safe_source_script (filename); | |
297 | ||
298 | if (msg != NULL) | |
299 | { | |
300 | fprintf_filtered (gdb_stderr, "%s\n", msg); | |
301 | xfree (msg); | |
302 | } | |
303 | } | |
304 | \f | |
0c3abbc7 | 305 | /* (execute string [#:from-tty boolean] [#:to-string boolean]) |
ed3ef339 DE |
306 | A Scheme function which evaluates a string using the gdb CLI. */ |
307 | ||
308 | static SCM | |
309 | gdbscm_execute_gdb_command (SCM command_scm, SCM rest) | |
310 | { | |
311 | int from_tty_arg_pos = -1, to_string_arg_pos = -1; | |
312 | int from_tty = 0, to_string = 0; | |
313 | volatile struct gdb_exception except; | |
314 | const SCM keywords[] = { from_tty_keyword, to_string_keyword, SCM_BOOL_F }; | |
315 | char *command; | |
316 | char *result = NULL; | |
317 | struct cleanup *cleanups; | |
318 | ||
319 | gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#tt", | |
320 | command_scm, &command, rest, | |
321 | &from_tty_arg_pos, &from_tty, | |
322 | &to_string_arg_pos, &to_string); | |
323 | ||
324 | /* Note: The contents of "command" may get modified while it is | |
325 | executed. */ | |
326 | cleanups = make_cleanup (xfree, command); | |
327 | ||
328 | TRY_CATCH (except, RETURN_MASK_ALL) | |
329 | { | |
330 | struct cleanup *inner_cleanups; | |
331 | ||
332 | inner_cleanups = make_cleanup_restore_integer (&interpreter_async); | |
333 | interpreter_async = 0; | |
334 | ||
335 | prevent_dont_repeat (); | |
336 | if (to_string) | |
337 | result = execute_command_to_string (command, from_tty); | |
338 | else | |
339 | { | |
340 | execute_command (command, from_tty); | |
341 | result = NULL; | |
342 | } | |
343 | ||
344 | /* Do any commands attached to breakpoint we stopped at. */ | |
345 | bpstat_do_actions (); | |
346 | ||
347 | do_cleanups (inner_cleanups); | |
348 | } | |
349 | do_cleanups (cleanups); | |
350 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
351 | ||
352 | if (result) | |
353 | { | |
354 | SCM r = gdbscm_scm_from_c_string (result); | |
355 | xfree (result); | |
356 | return r; | |
357 | } | |
358 | return SCM_UNSPECIFIED; | |
359 | } | |
360 | ||
361 | /* (data-directory) -> string */ | |
362 | ||
363 | static SCM | |
364 | gdbscm_data_directory (void) | |
365 | { | |
366 | return gdbscm_scm_from_c_string (gdb_datadir); | |
367 | } | |
368 | ||
d2929fdc DE |
369 | /* (guile-data-directory) -> string */ |
370 | ||
371 | static SCM | |
372 | gdbscm_guile_data_directory (void) | |
373 | { | |
374 | return gdbscm_scm_from_c_string (guile_datadir); | |
375 | } | |
376 | ||
ed3ef339 DE |
377 | /* (gdb-version) -> string */ |
378 | ||
379 | static SCM | |
380 | gdbscm_gdb_version (void) | |
381 | { | |
382 | return gdbscm_scm_from_c_string (version); | |
383 | } | |
384 | ||
385 | /* (host-config) -> string */ | |
386 | ||
387 | static SCM | |
388 | gdbscm_host_config (void) | |
389 | { | |
390 | return gdbscm_scm_from_c_string (host_name); | |
391 | } | |
392 | ||
393 | /* (target-config) -> string */ | |
394 | ||
395 | static SCM | |
396 | gdbscm_target_config (void) | |
397 | { | |
398 | return gdbscm_scm_from_c_string (target_name); | |
399 | } | |
400 | ||
401 | #else /* ! HAVE_GUILE */ | |
402 | ||
403 | /* Dummy implementation of the gdb "guile-repl" and "guile" | |
404 | commands. */ | |
405 | ||
406 | static void | |
407 | guile_repl_command (char *arg, int from_tty) | |
408 | { | |
409 | arg = skip_spaces (arg); | |
410 | if (arg && *arg) | |
411 | error (_("guile-repl currently does not take any arguments.")); | |
412 | error (_("Guile scripting is not supported in this copy of GDB.")); | |
413 | } | |
414 | ||
415 | static void | |
416 | guile_command (char *arg, int from_tty) | |
417 | { | |
418 | arg = skip_spaces (arg); | |
419 | if (arg && *arg) | |
420 | error (_("Guile scripting is not supported in this copy of GDB.")); | |
421 | else | |
422 | { | |
423 | /* Even if Guile isn't enabled, we still have to slurp the | |
424 | command list to the corresponding "end". */ | |
425 | struct command_line *l = get_command_line (guile_control, ""); | |
426 | struct cleanup *cleanups = make_cleanup_free_command_lines (&l); | |
427 | ||
428 | execute_control_command_untraced (l); | |
429 | do_cleanups (cleanups); | |
430 | } | |
431 | } | |
432 | ||
433 | #endif /* ! HAVE_GUILE */ | |
434 | \f | |
435 | /* Lists for 'set,show,info guile' commands. */ | |
436 | ||
437 | static struct cmd_list_element *set_guile_list; | |
438 | static struct cmd_list_element *show_guile_list; | |
439 | static struct cmd_list_element *info_guile_list; | |
440 | ||
441 | /* Function for use by 'set guile' prefix command. */ | |
442 | ||
443 | static void | |
444 | set_guile_command (char *args, int from_tty) | |
445 | { | |
446 | help_list (set_guile_list, "set guile ", all_commands, gdb_stdout); | |
447 | } | |
448 | ||
449 | /* Function for use by 'show guile' prefix command. */ | |
450 | ||
451 | static void | |
452 | show_guile_command (char *args, int from_tty) | |
453 | { | |
454 | cmd_show_list (show_guile_list, from_tty, ""); | |
455 | } | |
456 | ||
457 | /* The "info scheme" command is defined as a prefix, with | |
458 | allow_unknown 0. Therefore, its own definition is called only for | |
459 | "info scheme" with no args. */ | |
460 | ||
461 | static void | |
462 | info_guile_command (char *args, int from_tty) | |
463 | { | |
464 | printf_unfiltered (_("\"info guile\" must be followed" | |
465 | " by the name of an info command.\n")); | |
635c7e8a | 466 | help_list (info_guile_list, "info guile ", all_commands, gdb_stdout); |
ed3ef339 DE |
467 | } |
468 | \f | |
469 | /* Initialization. */ | |
470 | ||
471 | #ifdef HAVE_GUILE | |
472 | ||
473 | static const scheme_function misc_guile_functions[] = | |
474 | { | |
475 | { "execute", 1, 0, 1, gdbscm_execute_gdb_command, | |
476 | "\ | |
477 | Execute the given GDB command.\n\ | |
478 | \n\ | |
479 | Arguments: string [#:to-string boolean] [#:from-tty boolean]\n\ | |
480 | If #:from-tty is true then the command executes as if entered\n\ | |
481 | from the keyboard. The default is false (#f).\n\ | |
482 | If #:to-string is true then the result is returned as a string.\n\ | |
483 | Otherwise output is sent to the current output port,\n\ | |
484 | which is the default.\n\ | |
485 | Returns: The result of the command if #:to-string is true.\n\ | |
486 | Otherwise returns unspecified." }, | |
487 | ||
488 | { "data-directory", 0, 0, 0, gdbscm_data_directory, | |
489 | "\ | |
490 | Return the name of GDB's data directory." }, | |
491 | ||
d2929fdc DE |
492 | { "guile-data-directory", 0, 0, 0, gdbscm_guile_data_directory, |
493 | "\ | |
494 | Return the name of the Guile directory within GDB's data directory." }, | |
495 | ||
ed3ef339 DE |
496 | { "gdb-version", 0, 0, 0, gdbscm_gdb_version, |
497 | "\ | |
498 | Return GDB's version string." }, | |
499 | ||
500 | { "host-config", 0, 0, 0, gdbscm_host_config, | |
501 | "\ | |
502 | Return the name of the host configuration." }, | |
503 | ||
504 | { "target-config", 0, 0, 0, gdbscm_target_config, | |
505 | "\ | |
506 | Return the name of the target configuration." }, | |
507 | ||
508 | END_FUNCTIONS | |
509 | }; | |
510 | ||
e76c5d17 DE |
511 | /* Load BOOT_SCM_FILE, the first Scheme file that gets loaded. */ |
512 | ||
513 | static SCM | |
514 | boot_guile_support (void *boot_scm_file) | |
515 | { | |
516 | /* Load boot.scm without compiling it (there's no need to compile it). | |
517 | The other files should have been compiled already, and boot.scm is | |
518 | expected to adjust '%load-compiled-path' accordingly. If they haven't | |
519 | been compiled, Guile will auto-compile them. The important thing to keep | |
520 | in mind is that there's a >= 100x speed difference between compiled and | |
521 | non-compiled files. */ | |
522 | return scm_c_primitive_load ((const char *) boot_scm_file); | |
523 | } | |
524 | ||
525 | /* Return non-zero if ARGS has the "standard" format for throw args. | |
526 | The standard format is: | |
527 | (function format-string (format-string-args-list) ...). | |
528 | FUNCTION is #f if no function was recorded. */ | |
529 | ||
530 | static int | |
531 | standard_throw_args_p (SCM args) | |
532 | { | |
533 | if (gdbscm_is_true (scm_list_p (args)) | |
534 | && scm_ilength (args) >= 3) | |
535 | { | |
536 | /* The function in which the error occurred. */ | |
537 | SCM arg0 = scm_list_ref (args, scm_from_int (0)); | |
538 | /* The format string. */ | |
539 | SCM arg1 = scm_list_ref (args, scm_from_int (1)); | |
540 | /* The arguments of the format string. */ | |
541 | SCM arg2 = scm_list_ref (args, scm_from_int (2)); | |
542 | ||
543 | if ((scm_is_string (arg0) || gdbscm_is_false (arg0)) | |
544 | && scm_is_string (arg1) | |
545 | && gdbscm_is_true (scm_list_p (arg2))) | |
546 | return 1; | |
547 | } | |
548 | ||
549 | return 0; | |
550 | } | |
551 | ||
552 | /* Print the error recorded in a "standard" throw args. */ | |
553 | ||
554 | static void | |
555 | print_standard_throw_error (SCM args) | |
556 | { | |
557 | /* The function in which the error occurred. */ | |
558 | SCM arg0 = scm_list_ref (args, scm_from_int (0)); | |
559 | /* The format string. */ | |
560 | SCM arg1 = scm_list_ref (args, scm_from_int (1)); | |
561 | /* The arguments of the format string. */ | |
562 | SCM arg2 = scm_list_ref (args, scm_from_int (2)); | |
563 | ||
564 | /* ARG0 is #f if no function was recorded. */ | |
565 | if (gdbscm_is_true (arg0)) | |
566 | { | |
567 | scm_simple_format (scm_current_error_port (), | |
568 | scm_from_latin1_string (_("Error in function ~s:~%")), | |
569 | scm_list_1 (arg0)); | |
570 | } | |
571 | scm_simple_format (scm_current_error_port (), arg1, arg2); | |
572 | } | |
573 | ||
574 | /* Print the error message recorded in KEY, ARGS, the arguments to throw. | |
575 | Normally we let Scheme print the error message. | |
576 | This function is used when Scheme initialization fails. | |
577 | We can still use the Scheme C API though. */ | |
578 | ||
579 | static void | |
580 | print_throw_error (SCM key, SCM args) | |
581 | { | |
582 | /* IWBN to call gdbscm_print_exception_with_stack here, but Guile didn't | |
583 | boot successfully so play it safe and avoid it. The "format string" and | |
584 | its args are embedded in ARGS, but the content of ARGS depends on KEY. | |
585 | Make sure ARGS has the expected canonical content before trying to use | |
586 | it. */ | |
587 | if (standard_throw_args_p (args)) | |
588 | print_standard_throw_error (args); | |
589 | else | |
590 | { | |
591 | scm_simple_format (scm_current_error_port (), | |
592 | scm_from_latin1_string (_("Throw to key `~a' with args `~s'.~%")), | |
593 | scm_list_2 (key, args)); | |
594 | } | |
595 | } | |
596 | ||
597 | /* Handle an exception thrown while loading BOOT_SCM_FILE. */ | |
598 | ||
599 | static SCM | |
600 | handle_boot_error (void *boot_scm_file, SCM key, SCM args) | |
601 | { | |
602 | fprintf_unfiltered (gdb_stderr, ("Exception caught while booting Guile.\n")); | |
603 | ||
604 | print_throw_error (key, args); | |
605 | ||
606 | fprintf_unfiltered (gdb_stderr, "\n"); | |
607 | warning (_("Could not complete Guile gdb module initialization from:\n" | |
608 | "%s.\n" | |
609 | "Limited Guile support is available.\n" | |
610 | "Suggest passing --data-directory=/path/to/gdb/data-directory.\n"), | |
611 | (const char *) boot_scm_file); | |
612 | ||
613 | return SCM_UNSPECIFIED; | |
614 | } | |
615 | ||
ed3ef339 DE |
616 | /* Load gdb/boot.scm, the Scheme side of GDB/Guile support. |
617 | Note: This function assumes it's called within the gdb module. */ | |
618 | ||
619 | static void | |
620 | initialize_scheme_side (void) | |
621 | { | |
d2929fdc | 622 | char *boot_scm_path; |
ed3ef339 DE |
623 | char *msg; |
624 | ||
d2929fdc DE |
625 | guile_datadir = concat (gdb_datadir, SLASH_STRING, "guile", NULL); |
626 | boot_scm_path = concat (guile_datadir, SLASH_STRING, "gdb", | |
627 | SLASH_STRING, boot_scm_filename, NULL); | |
628 | ||
e76c5d17 DE |
629 | scm_c_catch (SCM_BOOL_T, boot_guile_support, boot_scm_path, |
630 | handle_boot_error, boot_scm_path, NULL, NULL); | |
ed3ef339 | 631 | |
ed3ef339 DE |
632 | xfree (boot_scm_path); |
633 | } | |
634 | ||
635 | /* Install the gdb scheme module. | |
636 | The result is a boolean indicating success. | |
637 | If initializing the gdb module fails an error message is printed. | |
638 | Note: This function runs in the context of the gdb module. */ | |
639 | ||
640 | static void | |
641 | initialize_gdb_module (void *data) | |
642 | { | |
d2929fdc DE |
643 | /* Computing these is a pain, so only do it once. |
644 | Also, do it here and save the result so that obtaining the values | |
645 | is thread-safe. */ | |
646 | gdbscm_guile_major_version = gdbscm_scm_string_to_int (scm_major_version ()); | |
647 | gdbscm_guile_minor_version = gdbscm_scm_string_to_int (scm_minor_version ()); | |
648 | gdbscm_guile_micro_version = gdbscm_scm_string_to_int (scm_micro_version ()); | |
649 | ||
ed3ef339 DE |
650 | /* The documentation symbol needs to be defined before any calls to |
651 | gdbscm_define_{variables,functions}. */ | |
652 | gdbscm_documentation_symbol = scm_from_latin1_symbol ("documentation"); | |
653 | ||
654 | /* The smob and exception support must be initialized early. */ | |
655 | gdbscm_initialize_smobs (); | |
656 | gdbscm_initialize_exceptions (); | |
657 | ||
658 | /* The rest are initialized in alphabetical order. */ | |
659 | gdbscm_initialize_arches (); | |
660 | gdbscm_initialize_auto_load (); | |
661 | gdbscm_initialize_blocks (); | |
662 | gdbscm_initialize_breakpoints (); | |
e698b8c4 | 663 | gdbscm_initialize_commands (); |
ed3ef339 DE |
664 | gdbscm_initialize_disasm (); |
665 | gdbscm_initialize_frames (); | |
666 | gdbscm_initialize_iterators (); | |
667 | gdbscm_initialize_lazy_strings (); | |
668 | gdbscm_initialize_math (); | |
669 | gdbscm_initialize_objfiles (); | |
06eb1586 | 670 | gdbscm_initialize_parameters (); |
ed3ef339 DE |
671 | gdbscm_initialize_ports (); |
672 | gdbscm_initialize_pretty_printers (); | |
ded03782 | 673 | gdbscm_initialize_pspaces (); |
ed3ef339 DE |
674 | gdbscm_initialize_strings (); |
675 | gdbscm_initialize_symbols (); | |
676 | gdbscm_initialize_symtabs (); | |
677 | gdbscm_initialize_types (); | |
678 | gdbscm_initialize_values (); | |
679 | ||
680 | gdbscm_define_functions (misc_guile_functions, 1); | |
681 | ||
682 | from_tty_keyword = scm_from_latin1_keyword ("from-tty"); | |
683 | to_string_keyword = scm_from_latin1_keyword ("to-string"); | |
684 | ||
685 | initialize_scheme_side (); | |
686 | ||
687 | gdb_scheme_initialized = 1; | |
688 | } | |
689 | ||
c1966e26 DE |
690 | /* Utility to call scm_c_define_module+initialize_gdb_module from |
691 | within scm_with_guile. */ | |
692 | ||
693 | static void * | |
694 | call_initialize_gdb_module (void *data) | |
695 | { | |
696 | /* Most of the initialization is done by initialize_gdb_module. | |
697 | It is called via scm_c_define_module so that the initialization is | |
698 | performed within the desired module. */ | |
699 | scm_c_define_module (gdbscm_module_name, initialize_gdb_module, NULL); | |
700 | ||
701 | return NULL; | |
702 | } | |
703 | ||
ed3ef339 DE |
704 | /* A callback to finish Guile initialization after gdb has finished all its |
705 | initialization. | |
706 | This is the extension_language_ops.finish_initialization "method". */ | |
707 | ||
708 | static void | |
709 | gdbscm_finish_initialization (const struct extension_language_defn *extlang) | |
710 | { | |
711 | /* Restore the environment to the user interaction one. */ | |
712 | scm_set_current_module (scm_interaction_environment ()); | |
713 | } | |
714 | ||
715 | /* The extension_language_ops.initialized "method". */ | |
716 | ||
717 | static int | |
718 | gdbscm_initialized (const struct extension_language_defn *extlang) | |
719 | { | |
720 | return gdb_scheme_initialized; | |
721 | } | |
722 | ||
723 | /* Enable or disable Guile backtraces. */ | |
724 | ||
725 | static void | |
726 | gdbscm_set_backtrace (int enable) | |
727 | { | |
728 | static const char disable_bt[] = "(debug-disable 'backtrace)"; | |
729 | static const char enable_bt[] = "(debug-enable 'backtrace)"; | |
730 | ||
731 | if (enable) | |
732 | gdbscm_safe_eval_string (enable_bt, 0); | |
733 | else | |
734 | gdbscm_safe_eval_string (disable_bt, 0); | |
735 | } | |
736 | ||
737 | #endif /* HAVE_GUILE */ | |
738 | ||
739 | /* Install the various gdb commands used by Guile. */ | |
740 | ||
741 | static void | |
742 | install_gdb_commands (void) | |
743 | { | |
744 | add_com ("guile-repl", class_obscure, | |
745 | guile_repl_command, | |
746 | #ifdef HAVE_GUILE | |
747 | _("\ | |
748 | Start an interactive Guile prompt.\n\ | |
749 | \n\ | |
750 | To return to GDB, type the EOF character (e.g., Ctrl-D on an empty\n\ | |
751 | prompt) or ,quit.") | |
752 | #else /* HAVE_GUILE */ | |
753 | _("\ | |
754 | Start a Guile interactive prompt.\n\ | |
755 | \n\ | |
756 | Guile scripting is not supported in this copy of GDB.\n\ | |
757 | This command is only a placeholder.") | |
758 | #endif /* HAVE_GUILE */ | |
759 | ); | |
760 | add_com_alias ("gr", "guile-repl", class_obscure, 1); | |
761 | ||
762 | /* Since "help guile" is easy to type, and intuitive, we add general help | |
763 | in using GDB+Guile to this command. */ | |
764 | add_com ("guile", class_obscure, guile_command, | |
765 | #ifdef HAVE_GUILE | |
766 | _("\ | |
767 | Evaluate one or more Guile expressions.\n\ | |
768 | \n\ | |
769 | The expression(s) can be given as an argument, for instance:\n\ | |
770 | \n\ | |
771 | guile (display 23)\n\ | |
772 | \n\ | |
773 | The result of evaluating the last expression is printed.\n\ | |
774 | \n\ | |
775 | If no argument is given, the following lines are read and passed\n\ | |
776 | to Guile for evaluation. Type a line containing \"end\" to indicate\n\ | |
777 | the end of the set of expressions.\n\ | |
778 | \n\ | |
779 | The Guile GDB module must first be imported before it can be used.\n\ | |
780 | Do this with:\n\ | |
781 | (gdb) guile (use-modules (gdb))\n\ | |
782 | or if you want to import the (gdb) module with a prefix, use:\n\ | |
783 | (gdb) guile (use-modules ((gdb) #:renamer (symbol-prefix-proc 'gdb:)))\n\ | |
784 | \n\ | |
785 | The Guile interactive session, started with the \"guile-repl\"\n\ | |
786 | command, provides extensive help and apropos capabilities.\n\ | |
787 | Type \",help\" once in a Guile interactive session.") | |
788 | #else /* HAVE_GUILE */ | |
789 | _("\ | |
790 | Evaluate a Guile expression.\n\ | |
791 | \n\ | |
792 | Guile scripting is not supported in this copy of GDB.\n\ | |
793 | This command is only a placeholder.") | |
794 | #endif /* HAVE_GUILE */ | |
795 | ); | |
796 | add_com_alias ("gu", "guile", class_obscure, 1); | |
797 | ||
798 | add_prefix_cmd ("guile", class_obscure, set_guile_command, | |
799 | _("Prefix command for Guile preference settings."), | |
800 | &set_guile_list, "set guile ", 0, | |
801 | &setlist); | |
802 | add_alias_cmd ("gu", "guile", class_obscure, 1, &setlist); | |
803 | ||
804 | add_prefix_cmd ("guile", class_obscure, show_guile_command, | |
805 | _("Prefix command for Guile preference settings."), | |
806 | &show_guile_list, "show guile ", 0, | |
807 | &showlist); | |
808 | add_alias_cmd ("gu", "guile", class_obscure, 1, &showlist); | |
809 | ||
810 | add_prefix_cmd ("guile", class_obscure, info_guile_command, | |
811 | _("Prefix command for Guile info displays."), | |
812 | &info_guile_list, "info guile ", 0, | |
813 | &infolist); | |
814 | add_info_alias ("gu", "guile", 1); | |
815 | ||
816 | /* The name "print-stack" is carried over from Python. | |
817 | A better name is "print-exception". */ | |
818 | add_setshow_enum_cmd ("print-stack", no_class, guile_print_excp_enums, | |
819 | &gdbscm_print_excp, _("\ | |
820 | Set mode for Guile exception printing on error."), _("\ | |
821 | Show the mode of Guile exception printing on error."), _("\ | |
822 | none == no stack or message will be printed.\n\ | |
823 | full == a message and a stack will be printed.\n\ | |
824 | message == an error message without a stack will be printed."), | |
825 | NULL, NULL, | |
826 | &set_guile_list, &show_guile_list); | |
827 | } | |
828 | ||
829 | /* Provide a prototype to silence -Wmissing-prototypes. */ | |
830 | extern initialize_file_ftype _initialize_guile; | |
831 | ||
832 | void | |
833 | _initialize_guile (void) | |
834 | { | |
ed3ef339 DE |
835 | install_gdb_commands (); |
836 | ||
837 | #if HAVE_GUILE | |
92d8d229 DE |
838 | { |
839 | #ifdef HAVE_SIGPROCMASK | |
840 | sigset_t sigchld_mask, prev_mask; | |
74edf516 | 841 | #endif |
92d8d229 DE |
842 | |
843 | /* The Python support puts the C side in module "_gdb", leaving the Python | |
844 | side to define module "gdb" which imports "_gdb". There is evidently no | |
845 | similar convention in Guile so we skip this. */ | |
846 | ||
847 | #ifdef HAVE_SIGPROCMASK | |
848 | /* Before we initialize Guile, block SIGCHLD. | |
849 | This is done so that all threads created during Guile initialization | |
850 | have SIGCHLD blocked. PR 17247. | |
851 | Really libgc and Guile should do this, but we need to work with | |
852 | libgc 7.4.x. */ | |
853 | sigemptyset (&sigchld_mask); | |
854 | sigaddset (&sigchld_mask, SIGCHLD); | |
855 | sigprocmask (SIG_BLOCK, &sigchld_mask, &prev_mask); | |
856 | #endif | |
857 | ||
858 | /* scm_with_guile is the most portable way to initialize Guile. | |
859 | Plus we need to initialize the Guile support while in Guile mode | |
860 | (e.g., called from within a call to scm_with_guile). */ | |
861 | scm_with_guile (call_initialize_gdb_module, NULL); | |
862 | ||
863 | #ifdef HAVE_SIGPROCMASK | |
864 | sigprocmask (SIG_SETMASK, &prev_mask, NULL); | |
74edf516 DE |
865 | #endif |
866 | ||
92d8d229 DE |
867 | /* Set Guile's backtrace to match the "set guile print-stack" default. |
868 | [N.B. The two settings are still separate.] | |
869 | But only do this after we've initialized Guile, it's nice to see a | |
870 | backtrace if there's an error during initialization. | |
871 | OTOH, if the error is that gdb/init.scm wasn't found because gdb is | |
872 | being run from the build tree, the backtrace is more noise than signal. | |
873 | Sigh. */ | |
874 | gdbscm_set_backtrace (0); | |
875 | } | |
ed3ef339 DE |
876 | #endif |
877 | } |