gdb/guile/guile-internal.h

   1 /* Internal header for GDB/Scheme code.
   2
   3    Copyright (C) 2014-2022 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 struct scheme_variable
  44 {
  45   const char *name;
  46   SCM value;
  47   const char *doc_string;
  48 };
  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 struct scheme_function
  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 };
 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 struct scheme_integer_constant
 109 {
 110   const char *name;
 111   int value;
 112 };
 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 struct gdb_smob
 243 {
 244   GDB_SMOB_HEAD
 245 };
 246
 247 struct chained_gdb_smob
 248 {
 249   GDB_SMOB_HEAD
 250
 251   chained_gdb_smob *prev;
 252   chained_gdb_smob *next;
 253 };
 254
 255 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 };
 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 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 gdb::unique_xmalloc_ptr<char> gdbscm_safe_source_script
 412   (const char *filename);
 413
 414 extern void gdbscm_enter_repl (void);
 415 \f
 416 /* Interface to various GDB objects, in alphabetical order.  */
 417
 418 /* scm-arch.c */
 419
 420 struct arch_smob;
 421
 422 extern struct gdbarch *arscm_get_gdbarch (arch_smob *a_smob);
 423
 424 extern arch_smob *arscm_get_arch_smob_arg_unsafe (SCM arch_scm, int arg_pos,
 425                                                   const char *func_name);
 426
 427 extern SCM arscm_scm_from_arch (struct gdbarch *gdbarch);
 428
 429 /* scm-block.c */
 430
 431 extern SCM bkscm_scm_from_block (const struct block *block,
 432                                  struct objfile *objfile);
 433
 434 extern const struct block *bkscm_scm_to_block
 435   (SCM block_scm, int arg_pos, const char *func_name, SCM *excp);
 436
 437 /* scm-cmd.c */
 438
 439 extern char *gdbscm_parse_command_name (const char *name,
 440                                         const char *func_name, int arg_pos,
 441                                         struct cmd_list_element ***base_list,
 442                                         struct cmd_list_element **start_list);
 443
 444 extern int gdbscm_valid_command_class_p (int command_class);
 445
 446 extern char *gdbscm_canonicalize_command_name (const char *name,
 447                                                int want_trailing_space);
 448
 449 /* scm-frame.c */
 450
 451 struct frame_smob;
 452
 453 extern int frscm_is_frame (SCM scm);
 454
 455 extern frame_smob *frscm_get_frame_smob_arg_unsafe (SCM frame_scm, int arg_pos,
 456                                                     const char *func_name);
 457
 458 extern struct frame_info *frscm_frame_smob_to_frame (frame_smob *);
 459
 460 /* scm-iterator.c */
 461
 462 struct iterator_smob;
 463
 464 extern SCM itscm_iterator_smob_object (iterator_smob *i_smob);
 465
 466 extern SCM itscm_iterator_smob_progress (iterator_smob *i_smob);
 467
 468 extern void itscm_set_iterator_smob_progress_x (iterator_smob *i_smob,
 469                                                 SCM progress);
 470
 471 extern const char *itscm_iterator_smob_name (void);
 472
 473 extern SCM gdbscm_make_iterator (SCM object, SCM progress, SCM next);
 474
 475 extern int itscm_is_iterator (SCM scm);
 476
 477 extern SCM gdbscm_end_of_iteration (void);
 478
 479 extern int itscm_is_end_of_iteration (SCM obj);
 480
 481 extern SCM itscm_safe_call_next_x (SCM iter, excp_matcher_func *ok_excps);
 482
 483 extern SCM itscm_get_iterator_arg_unsafe (SCM self, int arg_pos,
 484                                           const char *func_name);
 485
 486 /* scm-lazy-string.c */
 487
 488 extern int lsscm_is_lazy_string (SCM scm);
 489
 490 extern SCM lsscm_make_lazy_string (CORE_ADDR address, int length,
 491                                    const char *encoding, struct type *type);
 492
 493 extern struct value *lsscm_safe_lazy_string_to_value (SCM string,
 494                                                       int arg_pos,
 495                                                       const char *func_name,
 496                                                       SCM *except_scmp);
 497
 498 extern void lsscm_val_print_lazy_string
 499   (SCM string, struct ui_file *stream,
 500    const struct value_print_options *options);
 501
 502 /* scm-objfile.c */
 503
 504 struct objfile_smob;
 505
 506 extern SCM ofscm_objfile_smob_pretty_printers (objfile_smob *o_smob);
 507
 508 extern objfile_smob *ofscm_objfile_smob_from_objfile (struct objfile *objfile);
 509
 510 extern SCM ofscm_scm_from_objfile (struct objfile *objfile);
 511
 512 /* scm-progspace.c */
 513
 514 struct pspace_smob;
 515
 516 extern SCM psscm_pspace_smob_pretty_printers (const pspace_smob *);
 517
 518 extern pspace_smob *psscm_pspace_smob_from_pspace (struct program_space *);
 519
 520 extern SCM psscm_scm_from_pspace (struct program_space *);
 521
 522 /* scm-string.c */
 523
 524 extern int gdbscm_scm_string_to_int (SCM string);
 525
 526 extern gdb::unique_xmalloc_ptr<char> gdbscm_scm_to_c_string (SCM string);
 527
 528 extern SCM gdbscm_scm_from_c_string (const char *string);
 529
 530 extern SCM gdbscm_scm_from_printf (const char *format, ...)
 531     ATTRIBUTE_PRINTF (1, 2);
 532
 533 extern gdb::unique_xmalloc_ptr<char> gdbscm_scm_to_string
 534   (SCM string, size_t *lenp, const char *charset, int strict, SCM *except_scmp);
 535
 536 extern SCM gdbscm_scm_from_string (const char *string, size_t len,
 537                                    const char *charset, int strict);
 538
 539 extern gdb::unique_xmalloc_ptr<char> gdbscm_scm_to_host_string
 540   (SCM string, size_t *lenp, SCM *except);
 541
 542 extern SCM gdbscm_scm_from_host_string (const char *string, size_t len);
 543
 544 /* scm-symbol.c */
 545
 546 extern int syscm_is_symbol (SCM scm);
 547
 548 extern SCM syscm_scm_from_symbol (struct symbol *symbol);
 549
 550 extern struct symbol *syscm_get_valid_symbol_arg_unsafe
 551   (SCM self, int arg_pos, const char *func_name);
 552
 553 /* scm-symtab.c */
 554
 555 extern SCM stscm_scm_from_symtab (struct symtab *symtab);
 556
 557 extern SCM stscm_scm_from_sal (struct symtab_and_line sal);
 558
 559 /* scm-type.c */
 560
 561 struct type_smob;
 562
 563 extern int tyscm_is_type (SCM scm);
 564
 565 extern SCM tyscm_scm_from_type (struct type *type);
 566
 567 extern type_smob *tyscm_get_type_smob_arg_unsafe (SCM type_scm, int arg_pos,
 568                                                   const char *func_name);
 569
 570 extern struct type *tyscm_scm_to_type (SCM t_scm);
 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 extern SCM vlscm_scm_from_value_no_release (struct value *value);
 584
 585 extern struct value *vlscm_convert_typed_value_from_scheme
 586   (const char *func_name, int obj_arg_pos, SCM obj,
 587    int type_arg_pos, SCM type_scm, struct type *type, SCM *except_scmp,
 588    struct gdbarch *gdbarch, const struct language_defn *language);
 589
 590 extern struct value *vlscm_convert_value_from_scheme
 591   (const char *func_name, int obj_arg_pos, SCM obj, SCM *except_scmp,
 592    struct gdbarch *gdbarch, const struct language_defn *language);
 593 \f
 594 /* stript_lang methods */
 595
 596 extern objfile_script_sourcer_func gdbscm_source_objfile_script;
 597 extern objfile_script_executor_func gdbscm_execute_objfile_script;
 598
 599 /* Return true if auto-loading Guile scripts is enabled.
 600    This is the extension_language_script_ops.auto_load_enabled "method".  */
 601
 602 extern bool gdbscm_auto_load_enabled (const struct extension_language_defn *);
 603
 604 extern void gdbscm_preserve_values
 605   (const struct extension_language_defn *,
 606    struct objfile *, htab_t copied_types);
 607
 608 extern enum ext_lang_rc gdbscm_apply_val_pretty_printer
 609   (const struct extension_language_defn *,
 610    struct value *val,
 611    struct ui_file *stream, int recurse,
 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
 647 /* A complication with the Guile code is that we have two types of
 648    exceptions to consider.  GDB/C++ exceptions, and Guile/SJLJ
 649    exceptions.  Code that is facing the Guile interpreter must not
 650    throw GDB exceptions, instead Scheme exceptions must be thrown.
 651    Also, because Guile exceptions are SJLJ based, Guile-facing code
 652    must not use local objects with dtors, unless wrapped in a scope
 653    with a TRY/CATCH, because the dtors won't otherwise be run when a
 654    Guile exceptions is thrown.  */
 655
 656 /* This is a destructor-less clone of gdb_exception.  */
 657
 658 struct gdbscm_gdb_exception
 659 {
 660   enum return_reason reason;
 661   enum errors error;
 662   /* The message is xmalloc'd.  */
 663   char *message;
 664 };
 665
 666 /* Return a gdbscm_gdb_exception representing EXC.  */
 667
 668 inline gdbscm_gdb_exception
 669 unpack (const gdb_exception &exc)
 670 {
 671   gdbscm_gdb_exception result;
 672   result.reason = exc.reason;
 673   result.error = exc.error;
 674   if (exc.message == nullptr)
 675     result.message = nullptr;
 676   else
 677     result.message = xstrdup (exc.message->c_str ());
 678   /* The message should be NULL iff the reason is zero.  */
 679   gdb_assert ((result.reason == 0) == (result.message == nullptr));
 680   return result;
 681 }
 682
 683 /* Use this after a TRY/CATCH to throw the appropriate Scheme
 684    exception if a GDB error occurred.  */
 685
 686 #define GDBSCM_HANDLE_GDB_EXCEPTION(exception)          \
 687   do {                                                  \
 688     if (exception.reason < 0)                           \
 689       {                                                 \
 690         gdbscm_throw_gdb_exception (exception);         \
 691         /*NOTREACHED */                                 \
 692       }                                                 \
 693   } while (0)
 694
 695 /* Use this to wrap a callable to throw the appropriate Scheme
 696    exception if the callable throws a GDB error.  ARGS are forwarded
 697    to FUNC.  Returns the result of FUNC, unless FUNC returns a Scheme
 698    exception, in which case that exception is thrown.  Note that while
 699    the callable is free to use objects of types with destructors,
 700    because GDB errors are C++ exceptions, the caller of gdbscm_wrap
 701    must not use such objects, because their destructors would not be
 702    called when a Scheme exception is thrown.  */
 703
 704 template<typename Function, typename... Args>
 705 SCM
 706 gdbscm_wrap (Function &&func, Args &&... args)
 707 {
 708   SCM result = SCM_BOOL_F;
 709   gdbscm_gdb_exception exc {};
 710
 711   try
 712     {
 713       result = func (std::forward<Args> (args)...);
 714     }
 715   catch (const gdb_exception &except)
 716     {
 717       exc = unpack (except);
 718     }
 719
 720   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
 721
 722   if (gdbscm_is_exception (result))
 723     gdbscm_throw (result);
 724
 725   return result;
 726 }
 727
 728 #endif /* GUILE_GUILE_INTERNAL_H */