/* Internal header for GDB/Scheme code.
- Copyright (C) 2014 Free Software Foundation, Inc.
+ Copyright (C) 2014-2020 Free Software Foundation, Inc.
This file is part of GDB.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */
+#ifndef GUILE_GUILE_INTERNAL_H
+#define GUILE_GUILE_INTERNAL_H
+
/* See README file in this directory for implementation notes, coding
conventions, et.al. */
-#ifndef GDB_GUILE_INTERNAL_H
-#define GDB_GUILE_INTERNAL_H
#include "hashtab.h"
#include "extension-priv.h"
#define END_VARIABLES { NULL, SCM_BOOL_F, NULL }
+/* Although scm_t_subr is meant to hold a function pointer, at least
+ in some versions of guile, it is actually a typedef to "void *".
+ That means that in C++, an explicit cast is necessary to convert
+ function pointer to scm_t_subr. But a cast also makes it possible
+ to pass function pointers with the wrong type by mistake. So
+ instead of adding such casts throughout, we use 'as_a_scm_t_subr'
+ to do the conversion, which (only) has overloads for function
+ pointer types that are valid.
+
+ See https://lists.gnu.org/archive/html/guile-devel/2013-03/msg00001.html.
+*/
+
+static inline scm_t_subr
+as_a_scm_t_subr (SCM (*func) (void))
+{
+ return (scm_t_subr) func;
+}
+
+static inline scm_t_subr
+as_a_scm_t_subr (SCM (*func) (SCM))
+{
+ return (scm_t_subr) func;
+}
+
+static inline scm_t_subr
+as_a_scm_t_subr (SCM (*func) (SCM, SCM))
+{
+ return (scm_t_subr) func;
+}
+
+static inline scm_t_subr
+as_a_scm_t_subr (SCM (*func) (SCM, SCM, SCM))
+{
+ return (scm_t_subr) func;
+}
+
/* Scheme functions to define during initialization. */
typedef struct
#define gdbscm_is_false(scm) scm_is_eq ((scm), SCM_BOOL_F)
#define gdbscm_is_true(scm) (!gdbscm_is_false (scm))
+#ifndef HAVE_SCM_NEW_SMOB
+
+/* Guile <= 2.0.5 did not provide this function, so provide it here. */
+
+static inline SCM
+scm_new_smob (scm_t_bits tc, scm_t_bits data)
+{
+ SCM_RETURN_NEWSMOB (tc, data);
+}
+
+#endif
+
/* Function name that is passed around in case an error needs to be reported.
__func is in C99, but we provide a wrapper "just in case",
and because FUNC_NAME is the canonical value used in guile sources.
extern int gdb_scheme_initialized;
+extern int gdbscm_guile_major_version;
+extern int gdbscm_guile_minor_version;
+extern int gdbscm_guile_micro_version;
+
extern const char gdbscm_print_excp_none[];
extern const char gdbscm_print_excp_full[];
extern const char gdbscm_print_excp_message[];
\f
/* scm-utils.c */
-extern void gdbscm_define_variables (const scheme_variable *, int public);
+extern void gdbscm_define_variables (const scheme_variable *, int is_public);
-extern void gdbscm_define_functions (const scheme_function *, int public);
+extern void gdbscm_define_functions (const scheme_function *, int is_public);
extern void gdbscm_define_integer_constants (const scheme_integer_constant *,
- int public);
+ int is_public);
-extern void gdbscm_printf (SCM port, const char *format, ...);
+extern void gdbscm_printf (SCM port, const char *format, ...)
+ ATTRIBUTE_PRINTF (2, 3);
extern void gdbscm_debug_display (SCM obj);
extern void gdbscm_dynwind_xfree (void *ptr);
extern int gdbscm_is_procedure (SCM proc);
+
+extern char *gdbscm_gc_xstrdup (const char *);
+
+extern const char * const *gdbscm_gc_dup_argv (char **argv);
+
+extern int gdbscm_guile_version_is_at_least (int major, int minor, int micro);
\f
-/* GDB smobs, from scm-smob.c */
+/* GDB smobs, from scm-gsmob.c */
/* All gdb smobs must contain one of the following as the first member:
gdb_smob, chained_gdb_smob, or eqable_gdb_smob.
- The next,prev members of chained_gdb_smob allow for chaining gsmobs
- together so that, for example, when an objfile is deleted we can clean up
- all smobs that reference it.
+ Chained GDB smobs should have chained_gdb_smob as their first member. The
+ next,prev members of chained_gdb_smob allow for chaining gsmobs together so
+ that, for example, when an objfile is deleted we can clean up all smobs that
+ reference it.
+
+ Eq-able GDB smobs should have eqable_gdb_smob as their first member. The
+ containing_scm member of eqable_gdb_smob allows for returning the same gsmob
+ instead of creating a new one, allowing them to be eq?-able.
- The containing_scm member of eqable_gdb_smob allows for returning the
- same gsmob instead of creating a new one, allowing them to be eq?-able.
+ All other smobs should have gdb_smob as their first member.
+ FIXME: dje/2014-05-26: gdb_smob was useful during early development as a
+ "baseclass" for all gdb smobs. If it's still unused by gdb 8.0 delete it.
- IMPORTANT: chained_gdb_smob and eqable_gdb-smob are a "subclasses" of
+ IMPORTANT: chained_gdb_smob and eqable_gdb-smob are "subclasses" of
gdb_smob. The layout of chained_gdb_smob,eqable_gdb_smob must match
gdb_smob as if it is a subclass. To that end we use macro GDB_SMOB_HEAD
to ensure this. */
-#define GDB_SMOB_HEAD \
- /* Property list for externally added fields. */ \
- SCM properties;
+#define GDB_SMOB_HEAD \
+ int empty_base_class;
typedef struct
{
extern void gdbscm_init_eqable_gsmob (eqable_gdb_smob *base,
SCM containing_scm);
-extern SCM gdbscm_mark_gsmob (gdb_smob *base);
-
-extern SCM gdbscm_mark_chained_gsmob (chained_gdb_smob *base);
-
-extern SCM gdbscm_mark_eqable_gsmob (eqable_gdb_smob *base);
-
extern void gdbscm_add_objfile_ref (struct objfile *objfile,
const struct objfile_data *data_key,
chained_gdb_smob *g_smob);
extern SCM gdbscm_make_misc_error (const char *subr, int arg_pos,
SCM bad_value, const char *error);
+extern void gdbscm_misc_error (const char *subr, int arg_pos,
+ SCM bad_value, const char *error)
+ ATTRIBUTE_NORETURN;
+
extern void gdbscm_throw (SCM exception) ATTRIBUTE_NORETURN;
-extern SCM gdbscm_scm_from_gdb_exception (struct gdb_exception exception);
+struct gdbscm_gdb_exception;
+extern SCM gdbscm_scm_from_gdb_exception
+ (const gdbscm_gdb_exception &exception);
-extern void gdbscm_throw_gdb_exception (struct gdb_exception exception)
+extern void gdbscm_throw_gdb_exception (gdbscm_gdb_exception exception)
ATTRIBUTE_NORETURN;
extern void gdbscm_print_exception_with_stack (SCM port, SCM stack,
extern void gdbscm_print_gdb_exception (SCM port, SCM exception);
-extern char *gdbscm_exception_message_to_string (SCM exception);
+extern gdb::unique_xmalloc_ptr<char> gdbscm_exception_message_to_string
+ (SCM exception);
extern excp_matcher_func gdbscm_memory_error_p;
+extern excp_matcher_func gdbscm_user_error_p;
+
extern SCM gdbscm_make_memory_error (const char *subr, const char *msg,
SCM args);
/* scm-safe-call.c */
-extern void *gdbscm_with_guile (void *(*func) (void *), void *data);
+extern const char *gdbscm_with_guile (const char *(*func) (void *), void *data);
extern SCM gdbscm_call_guile (SCM (*func) (void *), void *data,
excp_matcher_func *ok_excps);
extern SCM gdbscm_unsafe_call_1 (SCM proc, SCM arg0);
-extern char *gdbscm_safe_eval_string (const char *string, int display_result);
+extern gdb::unique_xmalloc_ptr<char> gdbscm_safe_eval_string
+ (const char *string, int display_result);
extern char *gdbscm_safe_source_script (const char *filename);
extern const struct block *bkscm_scm_to_block
(SCM block_scm, int arg_pos, const char *func_name, SCM *excp);
+/* scm-cmd.c */
+
+extern char *gdbscm_parse_command_name (const char *name,
+ const char *func_name, int arg_pos,
+ struct cmd_list_element ***base_list,
+ struct cmd_list_element **start_list);
+
+extern int gdbscm_valid_command_class_p (int command_class);
+
+extern char *gdbscm_canonicalize_command_name (const char *name,
+ int want_trailing_space);
+
/* scm-frame.c */
typedef struct _frame_smob frame_smob;
extern SCM ofscm_scm_from_objfile (struct objfile *objfile);
+/* scm-progspace.c */
+
+typedef struct _pspace_smob pspace_smob;
+
+extern SCM psscm_pspace_smob_pretty_printers (const pspace_smob *);
+
+extern pspace_smob *psscm_pspace_smob_from_pspace (struct program_space *);
+
+extern SCM psscm_scm_from_pspace (struct program_space *);
+
/* scm-string.c */
-extern char *gdbscm_scm_to_c_string (SCM string);
+extern int gdbscm_scm_string_to_int (SCM string);
+
+extern gdb::unique_xmalloc_ptr<char> gdbscm_scm_to_c_string (SCM string);
extern SCM gdbscm_scm_from_c_string (const char *string);
-extern SCM gdbscm_scm_from_printf (const char *format, ...);
+extern SCM gdbscm_scm_from_printf (const char *format, ...)
+ ATTRIBUTE_PRINTF (1, 2);
-extern char *gdbscm_scm_to_string (SCM string, size_t *lenp,
- const char *charset,
- int strict, SCM *except_scmp);
+extern gdb::unique_xmalloc_ptr<char> gdbscm_scm_to_string
+ (SCM string, size_t *lenp, const char *charset, int strict, SCM *except_scmp);
extern SCM gdbscm_scm_from_string (const char *string, size_t len,
const char *charset, int strict);
+extern gdb::unique_xmalloc_ptr<char> gdbscm_scm_to_host_string
+ (SCM string, size_t *lenp, SCM *except);
+
+extern SCM gdbscm_scm_from_host_string (const char *string, size_t len);
+
/* scm-symbol.c */
extern int syscm_is_symbol (SCM scm);
extern type_smob *tyscm_get_type_smob_arg_unsafe (SCM type_scm, int arg_pos,
const char *func_name);
+extern struct type *tyscm_scm_to_type (SCM t_scm);
+
extern struct type *tyscm_type_smob_type (type_smob *t_smob);
extern SCM tyscm_scm_from_field (SCM type_scm, int field_num);
extern SCM vlscm_scm_from_value (struct value *value);
-extern SCM vlscm_scm_from_value_unsafe (struct value *value);
-
extern struct value *vlscm_convert_typed_value_from_scheme
(const char *func_name, int obj_arg_pos, SCM obj,
int type_arg_pos, SCM type_scm, struct type *type, SCM *except_scmp,
/* stript_lang methods */
extern objfile_script_sourcer_func gdbscm_source_objfile_script;
+extern objfile_script_executor_func gdbscm_execute_objfile_script;
extern int gdbscm_auto_load_enabled (const struct extension_language_defn *);
extern enum ext_lang_rc gdbscm_apply_val_pretty_printer
(const struct extension_language_defn *,
- struct type *type, const gdb_byte *valaddr,
- int embedded_offset, CORE_ADDR address,
+ struct type *type,
+ LONGEST embedded_offset, CORE_ADDR address,
struct ui_file *stream, int recurse,
- const struct value *val,
+ struct value *val,
const struct value_print_options *options,
const struct language_defn *language);
extern void gdbscm_initialize_auto_load (void);
extern void gdbscm_initialize_blocks (void);
extern void gdbscm_initialize_breakpoints (void);
+extern void gdbscm_initialize_commands (void);
extern void gdbscm_initialize_disasm (void);
extern void gdbscm_initialize_exceptions (void);
extern void gdbscm_initialize_frames (void);
extern void gdbscm_initialize_math (void);
extern void gdbscm_initialize_objfiles (void);
extern void gdbscm_initialize_pretty_printers (void);
+extern void gdbscm_initialize_parameters (void);
extern void gdbscm_initialize_ports (void);
+extern void gdbscm_initialize_pspaces (void);
extern void gdbscm_initialize_smobs (void);
extern void gdbscm_initialize_strings (void);
extern void gdbscm_initialize_symbols (void);
extern void gdbscm_initialize_types (void);
extern void gdbscm_initialize_values (void);
\f
-/* Use these after a TRY_CATCH to throw the appropriate Scheme exception
- if a GDB error occurred. */
+
+/* A complication with the Guile code is that we have two types of
+ exceptions to consider. GDB/C++ exceptions, and Guile/SJLJ
+ exceptions. Code that is facing the Guile interpreter must not
+ throw GDB exceptions, instead Scheme exceptions must be thrown.
+ Also, because Guile exceptions are SJLJ based, Guile-facing code
+ must not use local objects with dtors, unless wrapped in a scope
+ with a TRY/CATCH, because the dtors won't otherwise be run when a
+ Guile exceptions is thrown. */
+
+/* This is a destructor-less clone of gdb_exception. */
+
+struct gdbscm_gdb_exception
+{
+ enum return_reason reason;
+ enum errors error;
+ /* The message is xmalloc'd. */
+ char *message;
+};
+
+/* Return a gdbscm_gdb_exception representing EXC. */
+
+inline gdbscm_gdb_exception
+unpack (const gdb_exception &exc)
+{
+ gdbscm_gdb_exception result;
+ result.reason = exc.reason;
+ result.error = exc.error;
+ if (exc.message == nullptr)
+ result.message = nullptr;
+ else
+ result.message = xstrdup (exc.message->c_str ());
+ /* The message should be NULL iff the reason is zero. */
+ gdb_assert ((result.reason == 0) == (result.message == nullptr));
+ return result;
+}
+
+/* Use this after a TRY/CATCH to throw the appropriate Scheme
+ exception if a GDB error occurred. */
#define GDBSCM_HANDLE_GDB_EXCEPTION(exception) \
do { \
} \
} while (0)
-/* If cleanups are establish outside the TRY_CATCH block, use this version. */
+/* Use this to wrap a callable to throw the appropriate Scheme
+ exception if the callable throws a GDB error. ARGS are forwarded
+ to FUNC. Returns the result of FUNC, unless FUNC returns a Scheme
+ exception, in which case that exception is thrown. Note that while
+ the callable is free to use objects of types with destructors,
+ because GDB errors are C++ exceptions, the caller of gdbscm_wrap
+ must not use such objects, because their destructors would not be
+ called when a Scheme exception is thrown. */
+
+template<typename Function, typename... Args>
+SCM
+gdbscm_wrap (Function &&func, Args &&... args)
+{
+ SCM result = SCM_BOOL_F;
+ gdbscm_gdb_exception exc {};
-#define GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS(exception, cleanups) \
- do { \
- if (exception.reason < 0) \
- { \
- do_cleanups (cleanups); \
- gdbscm_throw_gdb_exception (exception); \
- /*NOTREACHED */ \
- } \
- } while (0)
+ try
+ {
+ result = func (std::forward<Args> (args)...);
+ }
+ catch (const gdb_exception &except)
+ {
+ exc = unpack (except);
+ }
+
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
+
+ if (gdbscm_is_exception (result))
+ gdbscm_throw (result);
+
+ return result;
+}
-#endif /* GDB_GUILE_INTERNAL_H */
+#endif /* GUILE_GUILE_INTERNAL_H */
projects / deliverable / binutils-gdb.git / blobdiff