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