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