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