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