Automatic date update in version.in
[external/binutils.git] / gdb / guile / guile-internal.h
1 /* Internal header for GDB/Scheme code.
2
3    Copyright (C) 2014-2019 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 \f
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 \f
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 \f
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 extern SCM gdbscm_scm_from_gdb_exception (struct gdb_exception exception);
357
358 extern void gdbscm_throw_gdb_exception (struct gdb_exception exception)
359   ATTRIBUTE_NORETURN;
360
361 extern void gdbscm_print_exception_with_stack (SCM port, SCM stack,
362                                                SCM key, SCM args);
363
364 extern void gdbscm_print_gdb_exception (SCM port, SCM exception);
365
366 extern gdb::unique_xmalloc_ptr<char> gdbscm_exception_message_to_string
367     (SCM exception);
368
369 extern excp_matcher_func gdbscm_memory_error_p;
370
371 extern excp_matcher_func gdbscm_user_error_p;
372
373 extern SCM gdbscm_make_memory_error (const char *subr, const char *msg,
374                                      SCM args);
375
376 extern void gdbscm_memory_error (const char *subr, const char *msg, SCM args)
377   ATTRIBUTE_NORETURN;
378
379 /* scm-safe-call.c */
380
381 extern const char *gdbscm_with_guile (const char *(*func) (void *), void *data);
382
383 extern SCM gdbscm_call_guile (SCM (*func) (void *), void *data,
384                               excp_matcher_func *ok_excps);
385
386 extern SCM gdbscm_safe_call_0 (SCM proc, excp_matcher_func *ok_excps);
387
388 extern SCM gdbscm_safe_call_1 (SCM proc, SCM arg0,
389                                excp_matcher_func *ok_excps);
390
391 extern SCM gdbscm_safe_call_2 (SCM proc, SCM arg0, SCM arg1,
392                                excp_matcher_func *ok_excps);
393
394 extern SCM gdbscm_safe_call_3 (SCM proc, SCM arg0, SCM arg1, SCM arg2,
395                                excp_matcher_func *ok_excps);
396
397 extern SCM gdbscm_safe_call_4 (SCM proc, SCM arg0, SCM arg1, SCM arg2,
398                                SCM arg3,
399                                excp_matcher_func *ok_excps);
400
401 extern SCM gdbscm_safe_apply_1 (SCM proc, SCM arg0, SCM args,
402                                 excp_matcher_func *ok_excps);
403
404 extern SCM gdbscm_unsafe_call_1 (SCM proc, SCM arg0);
405
406 extern gdb::unique_xmalloc_ptr<char> gdbscm_safe_eval_string
407   (const char *string, int display_result);
408
409 extern char *gdbscm_safe_source_script (const char *filename);
410
411 extern void gdbscm_enter_repl (void);
412 \f
413 /* Interface to various GDB objects, in alphabetical order.  */
414
415 /* scm-arch.c */
416
417 typedef struct _arch_smob arch_smob;
418
419 extern struct gdbarch *arscm_get_gdbarch (arch_smob *a_smob);
420
421 extern arch_smob *arscm_get_arch_smob_arg_unsafe (SCM arch_scm, int arg_pos,
422                                                   const char *func_name);
423
424 extern SCM arscm_scm_from_arch (struct gdbarch *gdbarch);
425
426 /* scm-block.c */
427
428 extern SCM bkscm_scm_from_block (const struct block *block,
429                                  struct objfile *objfile);
430
431 extern const struct block *bkscm_scm_to_block
432   (SCM block_scm, int arg_pos, const char *func_name, SCM *excp);
433
434 /* scm-cmd.c */
435
436 extern char *gdbscm_parse_command_name (const char *name,
437                                         const char *func_name, int arg_pos,
438                                         struct cmd_list_element ***base_list,
439                                         struct cmd_list_element **start_list);
440
441 extern int gdbscm_valid_command_class_p (int command_class);
442
443 extern char *gdbscm_canonicalize_command_name (const char *name,
444                                                int want_trailing_space);
445
446 /* scm-frame.c */
447
448 typedef struct _frame_smob frame_smob;
449
450 extern int frscm_is_frame (SCM scm);
451
452 extern frame_smob *frscm_get_frame_smob_arg_unsafe (SCM frame_scm, int arg_pos,
453                                                     const char *func_name);
454
455 extern struct frame_info *frscm_frame_smob_to_frame (frame_smob *);
456
457 /* scm-iterator.c */
458
459 typedef struct _iterator_smob iterator_smob;
460
461 extern SCM itscm_iterator_smob_object (iterator_smob *i_smob);
462
463 extern SCM itscm_iterator_smob_progress (iterator_smob *i_smob);
464
465 extern void itscm_set_iterator_smob_progress_x (iterator_smob *i_smob,
466                                                 SCM progress);
467
468 extern const char *itscm_iterator_smob_name (void);
469
470 extern SCM gdbscm_make_iterator (SCM object, SCM progress, SCM next);
471
472 extern int itscm_is_iterator (SCM scm);
473
474 extern SCM gdbscm_end_of_iteration (void);
475
476 extern int itscm_is_end_of_iteration (SCM obj);
477
478 extern SCM itscm_safe_call_next_x (SCM iter, excp_matcher_func *ok_excps);
479
480 extern SCM itscm_get_iterator_arg_unsafe (SCM self, int arg_pos,
481                                           const char *func_name);
482
483 /* scm-lazy-string.c */
484
485 extern int lsscm_is_lazy_string (SCM scm);
486
487 extern SCM lsscm_make_lazy_string (CORE_ADDR address, int length,
488                                    const char *encoding, struct type *type);
489
490 extern struct value *lsscm_safe_lazy_string_to_value (SCM string,
491                                                       int arg_pos,
492                                                       const char *func_name,
493                                                       SCM *except_scmp);
494
495 extern void lsscm_val_print_lazy_string
496   (SCM string, struct ui_file *stream,
497    const struct value_print_options *options);
498
499 /* scm-objfile.c */
500
501 typedef struct _objfile_smob objfile_smob;
502
503 extern SCM ofscm_objfile_smob_pretty_printers (objfile_smob *o_smob);
504
505 extern objfile_smob *ofscm_objfile_smob_from_objfile (struct objfile *objfile);
506
507 extern SCM ofscm_scm_from_objfile (struct objfile *objfile);
508
509 /* scm-progspace.c */
510
511 typedef struct _pspace_smob pspace_smob;
512
513 extern SCM psscm_pspace_smob_pretty_printers (const pspace_smob *);
514
515 extern pspace_smob *psscm_pspace_smob_from_pspace (struct program_space *);
516
517 extern SCM psscm_scm_from_pspace (struct program_space *);
518
519 /* scm-string.c */
520
521 extern int gdbscm_scm_string_to_int (SCM string);
522
523 extern gdb::unique_xmalloc_ptr<char> gdbscm_scm_to_c_string (SCM string);
524
525 extern SCM gdbscm_scm_from_c_string (const char *string);
526
527 extern SCM gdbscm_scm_from_printf (const char *format, ...)
528     ATTRIBUTE_PRINTF (1, 2);
529
530 extern gdb::unique_xmalloc_ptr<char> gdbscm_scm_to_string
531   (SCM string, size_t *lenp, const char *charset, int strict, SCM *except_scmp);
532
533 extern SCM gdbscm_scm_from_string (const char *string, size_t len,
534                                    const char *charset, int strict);
535
536 extern gdb::unique_xmalloc_ptr<char> gdbscm_scm_to_host_string
537   (SCM string, size_t *lenp, SCM *except);
538
539 extern SCM gdbscm_scm_from_host_string (const char *string, size_t len);
540
541 /* scm-symbol.c */
542
543 extern int syscm_is_symbol (SCM scm);
544
545 extern SCM syscm_scm_from_symbol (struct symbol *symbol);
546
547 extern struct symbol *syscm_get_valid_symbol_arg_unsafe
548   (SCM self, int arg_pos, const char *func_name);
549
550 /* scm-symtab.c */
551
552 extern SCM stscm_scm_from_symtab (struct symtab *symtab);
553
554 extern SCM stscm_scm_from_sal (struct symtab_and_line sal);
555
556 /* scm-type.c */
557
558 typedef struct _type_smob type_smob;
559
560 extern int tyscm_is_type (SCM scm);
561
562 extern SCM tyscm_scm_from_type (struct type *type);
563
564 extern type_smob *tyscm_get_type_smob_arg_unsafe (SCM type_scm, int arg_pos,
565                                                   const char *func_name);
566
567 extern struct type *tyscm_scm_to_type (SCM t_scm);
568
569 extern struct type *tyscm_type_smob_type (type_smob *t_smob);
570
571 extern SCM tyscm_scm_from_field (SCM type_scm, int field_num);
572
573 /* scm-value.c */
574
575 extern struct value *vlscm_scm_to_value (SCM scm);
576
577 extern int vlscm_is_value (SCM scm);
578
579 extern SCM vlscm_scm_from_value (struct value *value);
580
581 extern SCM vlscm_scm_from_value_unsafe (struct value *value);
582
583 extern struct value *vlscm_convert_typed_value_from_scheme
584   (const char *func_name, int obj_arg_pos, SCM obj,
585    int type_arg_pos, SCM type_scm, struct type *type, SCM *except_scmp,
586    struct gdbarch *gdbarch, const struct language_defn *language);
587
588 extern struct value *vlscm_convert_value_from_scheme
589   (const char *func_name, int obj_arg_pos, SCM obj, SCM *except_scmp,
590    struct gdbarch *gdbarch, const struct language_defn *language);
591 \f
592 /* stript_lang methods */
593
594 extern objfile_script_sourcer_func gdbscm_source_objfile_script;
595 extern objfile_script_executor_func gdbscm_execute_objfile_script;
596
597 extern int gdbscm_auto_load_enabled (const struct extension_language_defn *);
598
599 extern void gdbscm_preserve_values
600   (const struct extension_language_defn *,
601    struct objfile *, htab_t copied_types);
602
603 extern enum ext_lang_rc gdbscm_apply_val_pretty_printer
604   (const struct extension_language_defn *,
605    struct type *type,
606    LONGEST embedded_offset, CORE_ADDR address,
607    struct ui_file *stream, int recurse,
608    struct value *val,
609    const struct value_print_options *options,
610    const struct language_defn *language);
611
612 extern int gdbscm_breakpoint_has_cond (const struct extension_language_defn *,
613                                        struct breakpoint *b);
614
615 extern enum ext_lang_bp_stop gdbscm_breakpoint_cond_says_stop
616   (const struct extension_language_defn *, struct breakpoint *b);
617 \f
618 /* Initializers for each piece of Scheme support, in alphabetical order.  */
619
620 extern void gdbscm_initialize_arches (void);
621 extern void gdbscm_initialize_auto_load (void);
622 extern void gdbscm_initialize_blocks (void);
623 extern void gdbscm_initialize_breakpoints (void);
624 extern void gdbscm_initialize_commands (void);
625 extern void gdbscm_initialize_disasm (void);
626 extern void gdbscm_initialize_exceptions (void);
627 extern void gdbscm_initialize_frames (void);
628 extern void gdbscm_initialize_iterators (void);
629 extern void gdbscm_initialize_lazy_strings (void);
630 extern void gdbscm_initialize_math (void);
631 extern void gdbscm_initialize_objfiles (void);
632 extern void gdbscm_initialize_pretty_printers (void);
633 extern void gdbscm_initialize_parameters (void);
634 extern void gdbscm_initialize_ports (void);
635 extern void gdbscm_initialize_pspaces (void);
636 extern void gdbscm_initialize_smobs (void);
637 extern void gdbscm_initialize_strings (void);
638 extern void gdbscm_initialize_symbols (void);
639 extern void gdbscm_initialize_symtabs (void);
640 extern void gdbscm_initialize_types (void);
641 extern void gdbscm_initialize_values (void);
642 \f
643
644 /* A complication with the Guile code is that we have two types of
645    exceptions to consider.  GDB/C++ exceptions, and Guile/SJLJ
646    exceptions.  Code that is facing the Guile interpreter must not
647    throw GDB exceptions, instead Scheme exceptions must be thrown.
648    Also, because Guile exceptions are SJLJ based, Guile-facing code
649    must not use local objects with dtors, unless wrapped in a scope
650    with a TRY/CATCH, because the dtors won't otherwise be run when a
651    Guile exceptions is thrown.  */
652
653 /* Use this after a TRY/CATCH to throw the appropriate Scheme
654    exception if a GDB error occurred.  */
655
656 #define GDBSCM_HANDLE_GDB_EXCEPTION(exception)          \
657   do {                                                  \
658     if (exception.reason < 0)                           \
659       {                                                 \
660         gdbscm_throw_gdb_exception (exception);         \
661         /*NOTREACHED */                                 \
662       }                                                 \
663   } while (0)
664
665 /* Use this to wrap a callable to throw the appropriate Scheme
666    exception if the callable throws a GDB error.  ARGS are forwarded
667    to FUNC.  Returns the result of FUNC, unless FUNC returns a Scheme
668    exception, in which case that exception is thrown.  Note that while
669    the callable is free to use objects of types with destructors,
670    because GDB errors are C++ exceptions, the caller of gdbscm_wrap
671    must not use such objects, because their destructors would not be
672    called when a Scheme exception is thrown.  */
673
674 template<typename Function, typename... Args>
675 SCM
676 gdbscm_wrap (Function &&func, Args &&... args)
677 {
678   SCM result = SCM_BOOL_F;
679
680   TRY
681     {
682       result = func (std::forward<Args> (args)...);
683     }
684   CATCH (except, RETURN_MASK_ALL)
685     {
686       GDBSCM_HANDLE_GDB_EXCEPTION (except);
687     }
688   END_CATCH
689
690   if (gdbscm_is_exception (result))
691     gdbscm_throw (result);
692
693   return result;
694 }
695
696 #endif /* GUILE_GUILE_INTERNAL_H */