1 /* Internal header for GDB/Scheme code. 2 3 Copyright (C) 2014-2020 Free Software Foundation, Inc. 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 #ifndef GUILE_GUILE_INTERNAL_H 21 #define GUILE_GUILE_INTERNAL_H 22 23 /* See README file in this directory for implementation notes, coding 24 conventions, et.al. */ 25 26 27 #include "hashtab.h" 28 #include "extension-priv.h" 29 #include "symtab.h" 30 #include "libguile.h" 31 32 struct block; 33 struct frame_info; 34 struct objfile; 35 struct symbol; 36 37 /* A function to pass to the safe-call routines to ignore things like 38 memory errors. */ 39 typedef int excp_matcher_func (SCM key); 40 41 /* Scheme variables to define during initialization. */ 42 43 typedef struct 44 { 45 const char *name; 46 SCM value; 47 const char *doc_string; 48 } scheme_variable; 49 50 /* End of scheme_variable table mark. */ 51 52 #define END_VARIABLES { NULL, SCM_BOOL_F, NULL } 53 54 /* Although scm_t_subr is meant to hold a function pointer, at least 55 in some versions of guile, it is actually a typedef to "void *". 56 That means that in C++, an explicit cast is necessary to convert 57 function pointer to scm_t_subr. But a cast also makes it possible 58 to pass function pointers with the wrong type by mistake. So 59 instead of adding such casts throughout, we use 'as_a_scm_t_subr' 60 to do the conversion, which (only) has overloads for function 61 pointer types that are valid. 62 63 See https://lists.gnu.org/archive/html/guile-devel/2013-03/msg00001.html. 64 */ 65 66 static inline scm_t_subr 67 as_a_scm_t_subr (SCM (*func) (void)) 68 { 69 return (scm_t_subr) func; 70 } 71 72 static inline scm_t_subr 73 as_a_scm_t_subr (SCM (*func) (SCM)) 74 { 75 return (scm_t_subr) func; 76 } 77 78 static inline scm_t_subr 79 as_a_scm_t_subr (SCM (*func) (SCM, SCM)) 80 { 81 return (scm_t_subr) func; 82 } 83 84 static inline scm_t_subr 85 as_a_scm_t_subr (SCM (*func) (SCM, SCM, SCM)) 86 { 87 return (scm_t_subr) func; 88 } 89 90 /* Scheme functions to define during initialization. */ 91 92 typedef struct 93 { 94 const char *name; 95 int required; 96 int optional; 97 int rest; 98 scm_t_subr func; 99 const char *doc_string; 100 } scheme_function; 101 102 /* End of scheme_function table mark. */ 103 104 #define END_FUNCTIONS { NULL, 0, 0, 0, NULL, NULL } 105 106 /* Useful for defining a set of constants. */ 107 108 typedef struct 109 { 110 const char *name; 111 int value; 112 } scheme_integer_constant; 113 114 #define END_INTEGER_CONSTANTS { NULL, 0 } 115 116 /* Pass this instead of 0 to routines like SCM_ASSERT to indicate the value 117 is not a function argument. */ 118 #define GDBSCM_ARG_NONE 0 119 120 /* Ensure new code doesn't accidentally try to use this. */ 121 #undef scm_make_smob_type 122 #define scm_make_smob_type USE_gdbscm_make_smob_type_INSTEAD 123 124 /* They brought over () == #f from lisp. 125 Let's avoid that for now. */ 126 #undef scm_is_bool 127 #undef scm_is_false 128 #undef scm_is_true 129 #define scm_is_bool USE_gdbscm_is_bool_INSTEAD 130 #define scm_is_false USE_gdbscm_is_false_INSTEAD 131 #define scm_is_true USE_gdbscm_is_true_INSTEAD 132 #define gdbscm_is_bool(scm) \ 133 (scm_is_eq ((scm), SCM_BOOL_F) || scm_is_eq ((scm), SCM_BOOL_T)) 134 #define gdbscm_is_false(scm) scm_is_eq ((scm), SCM_BOOL_F) 135 #define gdbscm_is_true(scm) (!gdbscm_is_false (scm)) 136 137 #ifndef HAVE_SCM_NEW_SMOB 138 139 /* Guile <= 2.0.5 did not provide this function, so provide it here. */ 140 141 static inline SCM 142 scm_new_smob (scm_t_bits tc, scm_t_bits data) 143 { 144 SCM_RETURN_NEWSMOB (tc, data); 145 } 146 147 #endif 148 149 /* Function name that is passed around in case an error needs to be reported. 150 __func is in C99, but we provide a wrapper "just in case", 151 and because FUNC_NAME is the canonical value used in guile sources. 152 IWBN to use the Scheme version of the name (e.g. foo-bar vs foo_bar), 153 but let's KISS for now. */ 154 #define FUNC_NAME __func__ 155 156 extern const char gdbscm_module_name[]; 157 extern const char gdbscm_init_module_name[]; 158 159 extern int gdb_scheme_initialized; 160 161 extern int gdbscm_guile_major_version; 162 extern int gdbscm_guile_minor_version; 163 extern int gdbscm_guile_micro_version; 164 165 extern const char gdbscm_print_excp_none[]; 166 extern const char gdbscm_print_excp_full[]; 167 extern const char gdbscm_print_excp_message[]; 168 extern const char *gdbscm_print_excp; 169 170 extern SCM gdbscm_documentation_symbol; 171 extern SCM gdbscm_invalid_object_error_symbol; 172 173 extern SCM gdbscm_map_string; 174 extern SCM gdbscm_array_string; 175 extern SCM gdbscm_string_string; 176 177 /* scm-utils.c */ 178 179 extern void gdbscm_define_variables (const scheme_variable *, int is_public); 180 181 extern void gdbscm_define_functions (const scheme_function *, int is_public); 182 183 extern void gdbscm_define_integer_constants (const scheme_integer_constant *, 184 int is_public); 185 186 extern void gdbscm_printf (SCM port, const char *format, ...) 187 ATTRIBUTE_PRINTF (2, 3); 188 189 extern void gdbscm_debug_display (SCM obj); 190 191 extern void gdbscm_debug_write (SCM obj); 192 193 extern void gdbscm_parse_function_args (const char *function_name, 194 int beginning_arg_pos, 195 const SCM *keywords, 196 const char *format, ...); 197 198 extern SCM gdbscm_scm_from_longest (LONGEST l); 199 200 extern LONGEST gdbscm_scm_to_longest (SCM l); 201 202 extern SCM gdbscm_scm_from_ulongest (ULONGEST l); 203 204 extern ULONGEST gdbscm_scm_to_ulongest (SCM u); 205 206 extern void gdbscm_dynwind_xfree (void *ptr); 207 208 extern int gdbscm_is_procedure (SCM proc); 209 210 extern char *gdbscm_gc_xstrdup (const char *); 211 212 extern const char * const *gdbscm_gc_dup_argv (char **argv); 213 214 extern int gdbscm_guile_version_is_at_least (int major, int minor, int micro); 215 216 /* GDB smobs, from scm-gsmob.c */ 217 218 /* All gdb smobs must contain one of the following as the first member: 219 gdb_smob, chained_gdb_smob, or eqable_gdb_smob. 220 221 Chained GDB smobs should have chained_gdb_smob as their first member. The 222 next,prev members of chained_gdb_smob allow for chaining gsmobs together so 223 that, for example, when an objfile is deleted we can clean up all smobs that 224 reference it. 225 226 Eq-able GDB smobs should have eqable_gdb_smob as their first member. The 227 containing_scm member of eqable_gdb_smob allows for returning the same gsmob 228 instead of creating a new one, allowing them to be eq?-able. 229 230 All other smobs should have gdb_smob as their first member. 231 FIXME: dje/2014-05-26: gdb_smob was useful during early development as a 232 "baseclass" for all gdb smobs. If it's still unused by gdb 8.0 delete it. 233 234 IMPORTANT: chained_gdb_smob and eqable_gdb-smob are "subclasses" of 235 gdb_smob. The layout of chained_gdb_smob,eqable_gdb_smob must match 236 gdb_smob as if it is a subclass. To that end we use macro GDB_SMOB_HEAD 237 to ensure this. */ 238 239 #define GDB_SMOB_HEAD \ 240 int empty_base_class; 241 242 typedef struct 243 { 244 GDB_SMOB_HEAD 245 } gdb_smob; 246 247 typedef struct _chained_gdb_smob 248 { 249 GDB_SMOB_HEAD 250 251 struct _chained_gdb_smob *prev; 252 struct _chained_gdb_smob *next; 253 } chained_gdb_smob; 254 255 typedef struct _eqable_gdb_smob 256 { 257 GDB_SMOB_HEAD 258 259 /* The object we are contained in. 260 This can be used for several purposes. 261 This is used by the eq? machinery: We need to be able to see if we have 262 already created an object for a symbol, and if so use that SCM. 263 This may also be used to protect the smob from GC if there is 264 a reference to this smob from outside of GC space (i.e., from gdb). 265 This can also be used in place of chained_gdb_smob where we need to 266 keep track of objfile referencing objects. When the objfile is deleted 267 we need to invalidate the objects: we can do that using the same hashtab 268 used to record the smob for eq-ability. */ 269 SCM containing_scm; 270 } eqable_gdb_smob; 271 272 #undef GDB_SMOB_HEAD 273 274 struct objfile; 275 struct objfile_data; 276 277 /* A predicate that returns non-zero if an object is a particular kind 278 of gsmob. */ 279 typedef int (gsmob_pred_func) (SCM); 280 281 extern scm_t_bits gdbscm_make_smob_type (const char *name, size_t size); 282 283 extern void gdbscm_init_gsmob (gdb_smob *base); 284 285 extern void gdbscm_init_chained_gsmob (chained_gdb_smob *base); 286 287 extern void gdbscm_init_eqable_gsmob (eqable_gdb_smob *base, 288 SCM containing_scm); 289 290 extern void gdbscm_add_objfile_ref (struct objfile *objfile, 291 const struct objfile_data *data_key, 292 chained_gdb_smob *g_smob); 293 294 extern void gdbscm_remove_objfile_ref (struct objfile *objfile, 295 const struct objfile_data *data_key, 296 chained_gdb_smob *g_smob); 297 298 extern htab_t gdbscm_create_eqable_gsmob_ptr_map (htab_hash hash_fn, 299 htab_eq eq_fn); 300 301 extern eqable_gdb_smob **gdbscm_find_eqable_gsmob_ptr_slot 302 (htab_t htab, eqable_gdb_smob *base); 303 304 extern void gdbscm_fill_eqable_gsmob_ptr_slot (eqable_gdb_smob **slot, 305 eqable_gdb_smob *base); 306 307 extern void gdbscm_clear_eqable_gsmob_ptr_slot (htab_t htab, 308 eqable_gdb_smob *base); 309 310 /* Exceptions and calling out to Guile. */ 311 312 /* scm-exception.c */ 313 314 extern SCM gdbscm_make_exception (SCM tag, SCM args); 315 316 extern int gdbscm_is_exception (SCM scm); 317 318 extern SCM gdbscm_exception_key (SCM excp); 319 320 extern SCM gdbscm_exception_args (SCM excp); 321 322 extern SCM gdbscm_make_exception_with_stack (SCM key, SCM args, SCM stack); 323 324 extern SCM gdbscm_make_error_scm (SCM key, SCM subr, SCM message, 325 SCM args, SCM data); 326 327 extern SCM gdbscm_make_error (SCM key, const char *subr, const char *message, 328 SCM args, SCM data); 329 330 extern SCM gdbscm_make_type_error (const char *subr, int arg_pos, 331 SCM bad_value, const char *expected_type); 332 333 extern SCM gdbscm_make_invalid_object_error (const char *subr, int arg_pos, 334 SCM bad_value, const char *error); 335 336 extern void gdbscm_invalid_object_error (const char *subr, int arg_pos, 337 SCM bad_value, const char *error) 338 ATTRIBUTE_NORETURN; 339 340 extern SCM gdbscm_make_out_of_range_error (const char *subr, int arg_pos, 341 SCM bad_value, const char *error); 342 343 extern void gdbscm_out_of_range_error (const char *subr, int arg_pos, 344 SCM bad_value, const char *error) 345 ATTRIBUTE_NORETURN; 346 347 extern SCM gdbscm_make_misc_error (const char *subr, int arg_pos, 348 SCM bad_value, const char *error); 349 350 extern void gdbscm_misc_error (const char *subr, int arg_pos, 351 SCM bad_value, const char *error) 352 ATTRIBUTE_NORETURN; 353 354 extern void gdbscm_throw (SCM exception) ATTRIBUTE_NORETURN; 355 356 struct gdbscm_gdb_exception; 357 extern SCM gdbscm_scm_from_gdb_exception 358 (const gdbscm_gdb_exception &exception); 359 360 extern void gdbscm_throw_gdb_exception (gdbscm_gdb_exception exception) 361 ATTRIBUTE_NORETURN; 362 363 extern void gdbscm_print_exception_with_stack (SCM port, SCM stack, 364 SCM key, SCM args); 365 366 extern void gdbscm_print_gdb_exception (SCM port, SCM exception); 367 368 extern gdb::unique_xmalloc_ptr<char> gdbscm_exception_message_to_string 369 (SCM exception); 370 371 extern excp_matcher_func gdbscm_memory_error_p; 372 373 extern excp_matcher_func gdbscm_user_error_p; 374 375 extern SCM gdbscm_make_memory_error (const char *subr, const char *msg, 376 SCM args); 377 378 extern void gdbscm_memory_error (const char *subr, const char *msg, SCM args) 379 ATTRIBUTE_NORETURN; 380 381 /* scm-safe-call.c */ 382 383 extern const char *gdbscm_with_guile (const char *(*func) (void *), void *data); 384 385 extern SCM gdbscm_call_guile (SCM (*func) (void *), void *data, 386 excp_matcher_func *ok_excps); 387 388 extern SCM gdbscm_safe_call_0 (SCM proc, excp_matcher_func *ok_excps); 389 390 extern SCM gdbscm_safe_call_1 (SCM proc, SCM arg0, 391 excp_matcher_func *ok_excps); 392 393 extern SCM gdbscm_safe_call_2 (SCM proc, SCM arg0, SCM arg1, 394 excp_matcher_func *ok_excps); 395 396 extern SCM gdbscm_safe_call_3 (SCM proc, SCM arg0, SCM arg1, SCM arg2, 397 excp_matcher_func *ok_excps); 398 399 extern SCM gdbscm_safe_call_4 (SCM proc, SCM arg0, SCM arg1, SCM arg2, 400 SCM arg3, 401 excp_matcher_func *ok_excps); 402 403 extern SCM gdbscm_safe_apply_1 (SCM proc, SCM arg0, SCM args, 404 excp_matcher_func *ok_excps); 405 406 extern SCM gdbscm_unsafe_call_1 (SCM proc, SCM arg0); 407 408 extern gdb::unique_xmalloc_ptr<char> gdbscm_safe_eval_string 409 (const char *string, int display_result); 410 411 extern char *gdbscm_safe_source_script (const char *filename); 412 413 extern void gdbscm_enter_repl (void); 414 415 /* Interface to various GDB objects, in alphabetical order. */ 416 417 /* scm-arch.c */ 418 419 typedef struct _arch_smob arch_smob; 420 421 extern struct gdbarch *arscm_get_gdbarch (arch_smob *a_smob); 422 423 extern arch_smob *arscm_get_arch_smob_arg_unsafe (SCM arch_scm, int arg_pos, 424 const char *func_name); 425 426 extern SCM arscm_scm_from_arch (struct gdbarch *gdbarch); 427 428 /* scm-block.c */ 429 430 extern SCM bkscm_scm_from_block (const struct block *block, 431 struct objfile *objfile); 432 433 extern const struct block *bkscm_scm_to_block 434 (SCM block_scm, int arg_pos, const char *func_name, SCM *excp); 435 436 /* scm-cmd.c */ 437 438 extern char *gdbscm_parse_command_name (const char *name, 439 const char *func_name, int arg_pos, 440 struct cmd_list_element ***base_list, 441 struct cmd_list_element **start_list); 442 443 extern int gdbscm_valid_command_class_p (int command_class); 444 445 extern char *gdbscm_canonicalize_command_name (const char *name, 446 int want_trailing_space); 447 448 /* scm-frame.c */ 449 450 typedef struct _frame_smob frame_smob; 451 452 extern int frscm_is_frame (SCM scm); 453 454 extern frame_smob *frscm_get_frame_smob_arg_unsafe (SCM frame_scm, int arg_pos, 455 const char *func_name); 456 457 extern struct frame_info *frscm_frame_smob_to_frame (frame_smob *); 458 459 /* scm-iterator.c */ 460 461 typedef struct _iterator_smob iterator_smob; 462 463 extern SCM itscm_iterator_smob_object (iterator_smob *i_smob); 464 465 extern SCM itscm_iterator_smob_progress (iterator_smob *i_smob); 466 467 extern void itscm_set_iterator_smob_progress_x (iterator_smob *i_smob, 468 SCM progress); 469 470 extern const char *itscm_iterator_smob_name (void); 471 472 extern SCM gdbscm_make_iterator (SCM object, SCM progress, SCM next); 473 474 extern int itscm_is_iterator (SCM scm); 475 476 extern SCM gdbscm_end_of_iteration (void); 477 478 extern int itscm_is_end_of_iteration (SCM obj); 479 480 extern SCM itscm_safe_call_next_x (SCM iter, excp_matcher_func *ok_excps); 481 482 extern SCM itscm_get_iterator_arg_unsafe (SCM self, int arg_pos, 483 const char *func_name); 484 485 /* scm-lazy-string.c */ 486 487 extern int lsscm_is_lazy_string (SCM scm); 488 489 extern SCM lsscm_make_lazy_string (CORE_ADDR address, int length, 490 const char *encoding, struct type *type); 491 492 extern struct value *lsscm_safe_lazy_string_to_value (SCM string, 493 int arg_pos, 494 const char *func_name, 495 SCM *except_scmp); 496 497 extern void lsscm_val_print_lazy_string 498 (SCM string, struct ui_file *stream, 499 const struct value_print_options *options); 500 501 /* scm-objfile.c */ 502 503 typedef struct _objfile_smob objfile_smob; 504 505 extern SCM ofscm_objfile_smob_pretty_printers (objfile_smob *o_smob); 506 507 extern objfile_smob *ofscm_objfile_smob_from_objfile (struct objfile *objfile); 508 509 extern SCM ofscm_scm_from_objfile (struct objfile *objfile); 510 511 /* scm-progspace.c */ 512 513 typedef struct _pspace_smob pspace_smob; 514 515 extern SCM psscm_pspace_smob_pretty_printers (const pspace_smob *); 516 517 extern pspace_smob *psscm_pspace_smob_from_pspace (struct program_space *); 518 519 extern SCM psscm_scm_from_pspace (struct program_space *); 520 521 /* scm-string.c */ 522 523 extern int gdbscm_scm_string_to_int (SCM string); 524 525 extern gdb::unique_xmalloc_ptr<char> gdbscm_scm_to_c_string (SCM string); 526 527 extern SCM gdbscm_scm_from_c_string (const char *string); 528 529 extern SCM gdbscm_scm_from_printf (const char *format, ...) 530 ATTRIBUTE_PRINTF (1, 2); 531 532 extern gdb::unique_xmalloc_ptr<char> gdbscm_scm_to_string 533 (SCM string, size_t *lenp, const char *charset, int strict, SCM *except_scmp); 534 535 extern SCM gdbscm_scm_from_string (const char *string, size_t len, 536 const char *charset, int strict); 537 538 extern gdb::unique_xmalloc_ptr<char> gdbscm_scm_to_host_string 539 (SCM string, size_t *lenp, SCM *except); 540 541 extern SCM gdbscm_scm_from_host_string (const char *string, size_t len); 542 543 /* scm-symbol.c */ 544 545 extern int syscm_is_symbol (SCM scm); 546 547 extern SCM syscm_scm_from_symbol (struct symbol *symbol); 548 549 extern struct symbol *syscm_get_valid_symbol_arg_unsafe 550 (SCM self, int arg_pos, const char *func_name); 551 552 /* scm-symtab.c */ 553 554 extern SCM stscm_scm_from_symtab (struct symtab *symtab); 555 556 extern SCM stscm_scm_from_sal (struct symtab_and_line sal); 557 558 /* scm-type.c */ 559 560 typedef struct _type_smob type_smob; 561 562 extern int tyscm_is_type (SCM scm); 563 564 extern SCM tyscm_scm_from_type (struct type *type); 565 566 extern type_smob *tyscm_get_type_smob_arg_unsafe (SCM type_scm, int arg_pos, 567 const char *func_name); 568 569 extern struct type *tyscm_scm_to_type (SCM t_scm); 570 571 extern struct type *tyscm_type_smob_type (type_smob *t_smob); 572 573 extern SCM tyscm_scm_from_field (SCM type_scm, int field_num); 574 575 /* scm-value.c */ 576 577 extern struct value *vlscm_scm_to_value (SCM scm); 578 579 extern int vlscm_is_value (SCM scm); 580 581 extern SCM vlscm_scm_from_value (struct value *value); 582 extern SCM vlscm_scm_from_value_no_release (struct value *value); 583 584 extern struct value *vlscm_convert_typed_value_from_scheme 585 (const char *func_name, int obj_arg_pos, SCM obj, 586 int type_arg_pos, SCM type_scm, struct type *type, SCM *except_scmp, 587 struct gdbarch *gdbarch, const struct language_defn *language); 588 589 extern struct value *vlscm_convert_value_from_scheme 590 (const char *func_name, int obj_arg_pos, SCM obj, SCM *except_scmp, 591 struct gdbarch *gdbarch, const struct language_defn *language); 592 593 /* stript_lang methods */ 594 595 extern objfile_script_sourcer_func gdbscm_source_objfile_script; 596 extern objfile_script_executor_func gdbscm_execute_objfile_script; 597 598 extern int gdbscm_auto_load_enabled (const struct extension_language_defn *); 599 600 extern void gdbscm_preserve_values 601 (const struct extension_language_defn *, 602 struct objfile *, htab_t copied_types); 603 604 extern enum ext_lang_rc gdbscm_apply_val_pretty_printer 605 (const struct extension_language_defn *, 606 struct value *val, 607 struct ui_file *stream, int recurse, 608 const struct value_print_options *options, 609 const struct language_defn *language); 610 611 extern int gdbscm_breakpoint_has_cond (const struct extension_language_defn *, 612 struct breakpoint *b); 613 614 extern enum ext_lang_bp_stop gdbscm_breakpoint_cond_says_stop 615 (const struct extension_language_defn *, struct breakpoint *b); 616 617 /* Initializers for each piece of Scheme support, in alphabetical order. */ 618 619 extern void gdbscm_initialize_arches (void); 620 extern void gdbscm_initialize_auto_load (void); 621 extern void gdbscm_initialize_blocks (void); 622 extern void gdbscm_initialize_breakpoints (void); 623 extern void gdbscm_initialize_commands (void); 624 extern void gdbscm_initialize_disasm (void); 625 extern void gdbscm_initialize_exceptions (void); 626 extern void gdbscm_initialize_frames (void); 627 extern void gdbscm_initialize_iterators (void); 628 extern void gdbscm_initialize_lazy_strings (void); 629 extern void gdbscm_initialize_math (void); 630 extern void gdbscm_initialize_objfiles (void); 631 extern void gdbscm_initialize_pretty_printers (void); 632 extern void gdbscm_initialize_parameters (void); 633 extern void gdbscm_initialize_ports (void); 634 extern void gdbscm_initialize_pspaces (void); 635 extern void gdbscm_initialize_smobs (void); 636 extern void gdbscm_initialize_strings (void); 637 extern void gdbscm_initialize_symbols (void); 638 extern void gdbscm_initialize_symtabs (void); 639 extern void gdbscm_initialize_types (void); 640 extern void gdbscm_initialize_values (void); 641 642 643 /* A complication with the Guile code is that we have two types of 644 exceptions to consider. GDB/C++ exceptions, and Guile/SJLJ 645 exceptions. Code that is facing the Guile interpreter must not 646 throw GDB exceptions, instead Scheme exceptions must be thrown. 647 Also, because Guile exceptions are SJLJ based, Guile-facing code 648 must not use local objects with dtors, unless wrapped in a scope 649 with a TRY/CATCH, because the dtors won't otherwise be run when a 650 Guile exceptions is thrown. */ 651 652 /* This is a destructor-less clone of gdb_exception. */ 653 654 struct gdbscm_gdb_exception 655 { 656 enum return_reason reason; 657 enum errors error; 658 /* The message is xmalloc'd. */ 659 char *message; 660 }; 661 662 /* Return a gdbscm_gdb_exception representing EXC. */ 663 664 inline gdbscm_gdb_exception 665 unpack (const gdb_exception &exc) 666 { 667 gdbscm_gdb_exception result; 668 result.reason = exc.reason; 669 result.error = exc.error; 670 if (exc.message == nullptr) 671 result.message = nullptr; 672 else 673 result.message = xstrdup (exc.message->c_str ()); 674 /* The message should be NULL iff the reason is zero. */ 675 gdb_assert ((result.reason == 0) == (result.message == nullptr)); 676 return result; 677 } 678 679 /* Use this after a TRY/CATCH to throw the appropriate Scheme 680 exception if a GDB error occurred. */ 681 682 #define GDBSCM_HANDLE_GDB_EXCEPTION(exception) \ 683 do { \ 684 if (exception.reason < 0) \ 685 { \ 686 gdbscm_throw_gdb_exception (exception); \ 687 /*NOTREACHED */ \ 688 } \ 689 } while (0) 690 691 /* Use this to wrap a callable to throw the appropriate Scheme 692 exception if the callable throws a GDB error. ARGS are forwarded 693 to FUNC. Returns the result of FUNC, unless FUNC returns a Scheme 694 exception, in which case that exception is thrown. Note that while 695 the callable is free to use objects of types with destructors, 696 because GDB errors are C++ exceptions, the caller of gdbscm_wrap 697 must not use such objects, because their destructors would not be 698 called when a Scheme exception is thrown. */ 699 700 template<typename Function, typename... Args> 701 SCM 702 gdbscm_wrap (Function &&func, Args &&... args) 703 { 704 SCM result = SCM_BOOL_F; 705 gdbscm_gdb_exception exc {}; 706 707 try 708 { 709 result = func (std::forward<Args> (args)...); 710 } 711 catch (const gdb_exception &except) 712 { 713 exc = unpack (except); 714 } 715 716 GDBSCM_HANDLE_GDB_EXCEPTION (exc); 717 718 if (gdbscm_is_exception (result)) 719 gdbscm_throw (result); 720 721 return result; 722 } 723 724 #endif /* GUILE_GUILE_INTERNAL_H */ 725