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