Per-inferior/Inferior-qualified thread IDs
[external/binutils.git] / gdb / guile / guile-internal.h
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 \f
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 \f
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 \f
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 \f
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 \f
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    int 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 \f
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 \f
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 */