1 /* Internal header for GDB/Scheme code.
3 Copyright (C) 2014-2019 Free Software Foundation, Inc.
5 This file is part of GDB.
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.
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.
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/>. */
20 #ifndef GUILE_GUILE_INTERNAL_H
21 #define GUILE_GUILE_INTERNAL_H
23 /* See README file in this directory for implementation notes, coding
24 conventions, et.al. */
28 #include "extension-priv.h"
37 /* A function to pass to the safe-call routines to ignore things like
39 typedef int excp_matcher_func (SCM key
);
41 /* Scheme variables to define during initialization. */
47 const char *doc_string
;
50 /* End of scheme_variable table mark. */
52 #define END_VARIABLES { NULL, SCM_BOOL_F, NULL }
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.
63 See https://lists.gnu.org/archive/html/guile-devel/2013-03/msg00001.html.
66 static inline scm_t_subr
67 as_a_scm_t_subr (SCM (*func
) (void))
69 return (scm_t_subr
) func
;
72 static inline scm_t_subr
73 as_a_scm_t_subr (SCM (*func
) (SCM
))
75 return (scm_t_subr
) func
;
78 static inline scm_t_subr
79 as_a_scm_t_subr (SCM (*func
) (SCM
, SCM
))
81 return (scm_t_subr
) func
;
84 static inline scm_t_subr
85 as_a_scm_t_subr (SCM (*func
) (SCM
, SCM
, SCM
))
87 return (scm_t_subr
) func
;
90 /* Scheme functions to define during initialization. */
99 const char *doc_string
;
102 /* End of scheme_function table mark. */
104 #define END_FUNCTIONS { NULL, 0, 0, 0, NULL, NULL }
106 /* Useful for defining a set of constants. */
112 } scheme_integer_constant
;
114 #define END_INTEGER_CONSTANTS { NULL, 0 }
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
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
124 /* They brought over () == #f from lisp.
125 Let's avoid that for now. */
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))
137 #ifndef HAVE_SCM_NEW_SMOB
139 /* Guile <= 2.0.5 did not provide this function, so provide it here. */
142 scm_new_smob (scm_t_bits tc
, scm_t_bits data
)
144 SCM_RETURN_NEWSMOB (tc
, data
);
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__
156 extern const char gdbscm_module_name
[];
157 extern const char gdbscm_init_module_name
[];
159 extern int gdb_scheme_initialized
;
161 extern int gdbscm_guile_major_version
;
162 extern int gdbscm_guile_minor_version
;
163 extern int gdbscm_guile_micro_version
;
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
;
170 extern SCM gdbscm_documentation_symbol
;
171 extern SCM gdbscm_invalid_object_error_symbol
;
173 extern SCM gdbscm_map_string
;
174 extern SCM gdbscm_array_string
;
175 extern SCM gdbscm_string_string
;
179 extern void gdbscm_define_variables (const scheme_variable
*, int is_public
);
181 extern void gdbscm_define_functions (const scheme_function
*, int is_public
);
183 extern void gdbscm_define_integer_constants (const scheme_integer_constant
*,
186 extern void gdbscm_printf (SCM port
, const char *format
, ...)
187 ATTRIBUTE_PRINTF (2, 3);
189 extern void gdbscm_debug_display (SCM obj
);
191 extern void gdbscm_debug_write (SCM obj
);
193 extern void gdbscm_parse_function_args (const char *function_name
,
194 int beginning_arg_pos
,
196 const char *format
, ...);
198 extern SCM
gdbscm_scm_from_longest (LONGEST l
);
200 extern LONGEST
gdbscm_scm_to_longest (SCM l
);
202 extern SCM
gdbscm_scm_from_ulongest (ULONGEST l
);
204 extern ULONGEST
gdbscm_scm_to_ulongest (SCM u
);
206 extern void gdbscm_dynwind_xfree (void *ptr
);
208 extern int gdbscm_is_procedure (SCM proc
);
210 extern char *gdbscm_gc_xstrdup (const char *);
212 extern const char * const *gdbscm_gc_dup_argv (char **argv
);
214 extern int gdbscm_guile_version_is_at_least (int major
, int minor
, int micro
);
216 /* GDB smobs, from scm-gsmob.c */
218 /* All gdb smobs must contain one of the following as the first member:
219 gdb_smob, chained_gdb_smob, or eqable_gdb_smob.
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
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.
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.
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
239 #define GDB_SMOB_HEAD \
240 int empty_base_class;
247 typedef struct _chained_gdb_smob
251 struct _chained_gdb_smob
*prev
;
252 struct _chained_gdb_smob
*next
;
255 typedef struct _eqable_gdb_smob
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. */
277 /* A predicate that returns non-zero if an object is a particular kind
279 typedef int (gsmob_pred_func
) (SCM
);
281 extern scm_t_bits
gdbscm_make_smob_type (const char *name
, size_t size
);
283 extern void gdbscm_init_gsmob (gdb_smob
*base
);
285 extern void gdbscm_init_chained_gsmob (chained_gdb_smob
*base
);
287 extern void gdbscm_init_eqable_gsmob (eqable_gdb_smob
*base
,
290 extern void gdbscm_add_objfile_ref (struct objfile
*objfile
,
291 const struct objfile_data
*data_key
,
292 chained_gdb_smob
*g_smob
);
294 extern void gdbscm_remove_objfile_ref (struct objfile
*objfile
,
295 const struct objfile_data
*data_key
,
296 chained_gdb_smob
*g_smob
);
298 extern htab_t
gdbscm_create_eqable_gsmob_ptr_map (htab_hash hash_fn
,
301 extern eqable_gdb_smob
**gdbscm_find_eqable_gsmob_ptr_slot
302 (htab_t htab
, eqable_gdb_smob
*base
);
304 extern void gdbscm_fill_eqable_gsmob_ptr_slot (eqable_gdb_smob
**slot
,
305 eqable_gdb_smob
*base
);
307 extern void gdbscm_clear_eqable_gsmob_ptr_slot (htab_t htab
,
308 eqable_gdb_smob
*base
);
310 /* Exceptions and calling out to Guile. */
312 /* scm-exception.c */
314 extern SCM
gdbscm_make_exception (SCM tag
, SCM args
);
316 extern int gdbscm_is_exception (SCM scm
);
318 extern SCM
gdbscm_exception_key (SCM excp
);
320 extern SCM
gdbscm_exception_args (SCM excp
);
322 extern SCM
gdbscm_make_exception_with_stack (SCM key
, SCM args
, SCM stack
);
324 extern SCM
gdbscm_make_error_scm (SCM key
, SCM subr
, SCM message
,
327 extern SCM
gdbscm_make_error (SCM key
, const char *subr
, const char *message
,
330 extern SCM
gdbscm_make_type_error (const char *subr
, int arg_pos
,
331 SCM bad_value
, const char *expected_type
);
333 extern SCM
gdbscm_make_invalid_object_error (const char *subr
, int arg_pos
,
334 SCM bad_value
, const char *error
);
336 extern void gdbscm_invalid_object_error (const char *subr
, int arg_pos
,
337 SCM bad_value
, const char *error
)
340 extern SCM
gdbscm_make_out_of_range_error (const char *subr
, int arg_pos
,
341 SCM bad_value
, const char *error
);
343 extern void gdbscm_out_of_range_error (const char *subr
, int arg_pos
,
344 SCM bad_value
, const char *error
)
347 extern SCM
gdbscm_make_misc_error (const char *subr
, int arg_pos
,
348 SCM bad_value
, const char *error
);
350 extern void gdbscm_misc_error (const char *subr
, int arg_pos
,
351 SCM bad_value
, const char *error
)
354 extern void gdbscm_throw (SCM exception
) ATTRIBUTE_NORETURN
;
356 extern SCM
gdbscm_scm_from_gdb_exception (struct gdb_exception exception
);
358 extern void gdbscm_throw_gdb_exception (struct gdb_exception exception
)
361 extern void gdbscm_print_exception_with_stack (SCM port
, SCM stack
,
364 extern void gdbscm_print_gdb_exception (SCM port
, SCM exception
);
366 extern gdb::unique_xmalloc_ptr
<char> gdbscm_exception_message_to_string
369 extern excp_matcher_func gdbscm_memory_error_p
;
371 extern excp_matcher_func gdbscm_user_error_p
;
373 extern SCM
gdbscm_make_memory_error (const char *subr
, const char *msg
,
376 extern void gdbscm_memory_error (const char *subr
, const char *msg
, SCM args
)
379 /* scm-safe-call.c */
381 extern const char *gdbscm_with_guile (const char *(*func
) (void *), void *data
);
383 extern SCM
gdbscm_call_guile (SCM (*func
) (void *), void *data
,
384 excp_matcher_func
*ok_excps
);
386 extern SCM
gdbscm_safe_call_0 (SCM proc
, excp_matcher_func
*ok_excps
);
388 extern SCM
gdbscm_safe_call_1 (SCM proc
, SCM arg0
,
389 excp_matcher_func
*ok_excps
);
391 extern SCM
gdbscm_safe_call_2 (SCM proc
, SCM arg0
, SCM arg1
,
392 excp_matcher_func
*ok_excps
);
394 extern SCM
gdbscm_safe_call_3 (SCM proc
, SCM arg0
, SCM arg1
, SCM arg2
,
395 excp_matcher_func
*ok_excps
);
397 extern SCM
gdbscm_safe_call_4 (SCM proc
, SCM arg0
, SCM arg1
, SCM arg2
,
399 excp_matcher_func
*ok_excps
);
401 extern SCM
gdbscm_safe_apply_1 (SCM proc
, SCM arg0
, SCM args
,
402 excp_matcher_func
*ok_excps
);
404 extern SCM
gdbscm_unsafe_call_1 (SCM proc
, SCM arg0
);
406 extern gdb::unique_xmalloc_ptr
<char> gdbscm_safe_eval_string
407 (const char *string
, int display_result
);
409 extern char *gdbscm_safe_source_script (const char *filename
);
411 extern void gdbscm_enter_repl (void);
413 /* Interface to various GDB objects, in alphabetical order. */
417 typedef struct _arch_smob arch_smob
;
419 extern struct gdbarch
*arscm_get_gdbarch (arch_smob
*a_smob
);
421 extern arch_smob
*arscm_get_arch_smob_arg_unsafe (SCM arch_scm
, int arg_pos
,
422 const char *func_name
);
424 extern SCM
arscm_scm_from_arch (struct gdbarch
*gdbarch
);
428 extern SCM
bkscm_scm_from_block (const struct block
*block
,
429 struct objfile
*objfile
);
431 extern const struct block
*bkscm_scm_to_block
432 (SCM block_scm
, int arg_pos
, const char *func_name
, SCM
*excp
);
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
);
441 extern int gdbscm_valid_command_class_p (int command_class
);
443 extern char *gdbscm_canonicalize_command_name (const char *name
,
444 int want_trailing_space
);
448 typedef struct _frame_smob frame_smob
;
450 extern int frscm_is_frame (SCM scm
);
452 extern frame_smob
*frscm_get_frame_smob_arg_unsafe (SCM frame_scm
, int arg_pos
,
453 const char *func_name
);
455 extern struct frame_info
*frscm_frame_smob_to_frame (frame_smob
*);
459 typedef struct _iterator_smob iterator_smob
;
461 extern SCM
itscm_iterator_smob_object (iterator_smob
*i_smob
);
463 extern SCM
itscm_iterator_smob_progress (iterator_smob
*i_smob
);
465 extern void itscm_set_iterator_smob_progress_x (iterator_smob
*i_smob
,
468 extern const char *itscm_iterator_smob_name (void);
470 extern SCM
gdbscm_make_iterator (SCM object
, SCM progress
, SCM next
);
472 extern int itscm_is_iterator (SCM scm
);
474 extern SCM
gdbscm_end_of_iteration (void);
476 extern int itscm_is_end_of_iteration (SCM obj
);
478 extern SCM
itscm_safe_call_next_x (SCM iter
, excp_matcher_func
*ok_excps
);
480 extern SCM
itscm_get_iterator_arg_unsafe (SCM self
, int arg_pos
,
481 const char *func_name
);
483 /* scm-lazy-string.c */
485 extern int lsscm_is_lazy_string (SCM scm
);
487 extern SCM
lsscm_make_lazy_string (CORE_ADDR address
, int length
,
488 const char *encoding
, struct type
*type
);
490 extern struct value
*lsscm_safe_lazy_string_to_value (SCM string
,
492 const char *func_name
,
495 extern void lsscm_val_print_lazy_string
496 (SCM string
, struct ui_file
*stream
,
497 const struct value_print_options
*options
);
501 typedef struct _objfile_smob objfile_smob
;
503 extern SCM
ofscm_objfile_smob_pretty_printers (objfile_smob
*o_smob
);
505 extern objfile_smob
*ofscm_objfile_smob_from_objfile (struct objfile
*objfile
);
507 extern SCM
ofscm_scm_from_objfile (struct objfile
*objfile
);
509 /* scm-progspace.c */
511 typedef struct _pspace_smob pspace_smob
;
513 extern SCM
psscm_pspace_smob_pretty_printers (const pspace_smob
*);
515 extern pspace_smob
*psscm_pspace_smob_from_pspace (struct program_space
*);
517 extern SCM
psscm_scm_from_pspace (struct program_space
*);
521 extern int gdbscm_scm_string_to_int (SCM string
);
523 extern gdb::unique_xmalloc_ptr
<char> gdbscm_scm_to_c_string (SCM string
);
525 extern SCM
gdbscm_scm_from_c_string (const char *string
);
527 extern SCM
gdbscm_scm_from_printf (const char *format
, ...)
528 ATTRIBUTE_PRINTF (1, 2);
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
);
533 extern SCM
gdbscm_scm_from_string (const char *string
, size_t len
,
534 const char *charset
, int strict
);
536 extern gdb::unique_xmalloc_ptr
<char> gdbscm_scm_to_host_string
537 (SCM string
, size_t *lenp
, SCM
*except
);
539 extern SCM
gdbscm_scm_from_host_string (const char *string
, size_t len
);
543 extern int syscm_is_symbol (SCM scm
);
545 extern SCM
syscm_scm_from_symbol (struct symbol
*symbol
);
547 extern struct symbol
*syscm_get_valid_symbol_arg_unsafe
548 (SCM self
, int arg_pos
, const char *func_name
);
552 extern SCM
stscm_scm_from_symtab (struct symtab
*symtab
);
554 extern SCM
stscm_scm_from_sal (struct symtab_and_line sal
);
558 typedef struct _type_smob type_smob
;
560 extern int tyscm_is_type (SCM scm
);
562 extern SCM
tyscm_scm_from_type (struct type
*type
);
564 extern type_smob
*tyscm_get_type_smob_arg_unsafe (SCM type_scm
, int arg_pos
,
565 const char *func_name
);
567 extern struct type
*tyscm_scm_to_type (SCM t_scm
);
569 extern struct type
*tyscm_type_smob_type (type_smob
*t_smob
);
571 extern SCM
tyscm_scm_from_field (SCM type_scm
, int field_num
);
575 extern struct value
*vlscm_scm_to_value (SCM scm
);
577 extern int vlscm_is_value (SCM scm
);
579 extern SCM
vlscm_scm_from_value (struct value
*value
);
581 extern SCM
vlscm_scm_from_value_unsafe (struct value
*value
);
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
);
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
);
592 /* stript_lang methods */
594 extern objfile_script_sourcer_func gdbscm_source_objfile_script
;
595 extern objfile_script_executor_func gdbscm_execute_objfile_script
;
597 extern int gdbscm_auto_load_enabled (const struct extension_language_defn
*);
599 extern void gdbscm_preserve_values
600 (const struct extension_language_defn
*,
601 struct objfile
*, htab_t copied_types
);
603 extern enum ext_lang_rc gdbscm_apply_val_pretty_printer
604 (const struct extension_language_defn
*,
606 LONGEST embedded_offset
, CORE_ADDR address
,
607 struct ui_file
*stream
, int recurse
,
609 const struct value_print_options
*options
,
610 const struct language_defn
*language
);
612 extern int gdbscm_breakpoint_has_cond (const struct extension_language_defn
*,
613 struct breakpoint
*b
);
615 extern enum ext_lang_bp_stop gdbscm_breakpoint_cond_says_stop
616 (const struct extension_language_defn
*, struct breakpoint
*b
);
618 /* Initializers for each piece of Scheme support, in alphabetical order. */
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);
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. */
653 /* Use this after a TRY/CATCH to throw the appropriate Scheme
654 exception if a GDB error occurred. */
656 #define GDBSCM_HANDLE_GDB_EXCEPTION(exception) \
658 if (exception.reason < 0) \
660 gdbscm_throw_gdb_exception (exception); \
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. */
674 template<typename Function
, typename
... Args
>
676 gdbscm_wrap (Function
&&func
, Args
&&... args
)
678 SCM result
= SCM_BOOL_F
;
682 result
= func (std::forward
<Args
> (args
)...);
684 CATCH (except
, RETURN_MASK_ALL
)
686 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
690 if (gdbscm_is_exception (result
))
691 gdbscm_throw (result
);
696 #endif /* GUILE_GUILE_INTERNAL_H */