/* Scheme interface to types.
- Copyright (C) 2008-2014 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
This file is part of GDB.
#include "defs.h"
#include "arch-utils.h"
#include "value.h"
-#include "exceptions.h"
#include "gdbtypes.h"
#include "objfiles.h"
#include "language.h"
-#include "vec.h"
#include "bcache.h"
-#include "dwarf2loc.h"
+#include "dwarf2/loc.h"
#include "typeprint.h"
#include "guile-internal.h"
This lets us copy the underlying struct type when the objfile is
deleted. */
-typedef struct _type_smob
+struct type_smob
{
/* This always appears first.
eqable_gdb_smob is used so that types are eq?-able.
/* The GDB type structure this smob is wrapping. */
struct type *type;
-} type_smob;
+};
/* A field smob. */
-typedef struct
+struct field_smob
{
/* This always appears first. */
gdb_smob base;
/* The field number in TYPE_SCM. */
int field_num;
-} field_smob;
+};
static const char type_smob_name[] = "gdb:type";
static const char field_smob_name[] = "gdb:field";
return t_smob->type;
}
-/* Return the name of TYPE in expanded form.
- Space for the result is malloc'd, caller must free.
- If there's an error computing the name, the result is NULL and the
- exception is stored in *EXCP. */
+/* Return the name of TYPE in expanded form. If there's an error
+ computing the name, throws the gdb exception with scm_throw. */
-static char *
-tyscm_type_name (struct type *type, SCM *excp)
+static std::string
+tyscm_type_name (struct type *type)
{
- char *name = NULL;
- volatile struct gdb_exception except;
-
- TRY_CATCH (except, RETURN_MASK_ALL)
+ SCM excp;
+ try
{
- struct cleanup *old_chain;
- struct ui_file *stb;
+ string_file stb;
- stb = mem_fileopen ();
- old_chain = make_cleanup_ui_file_delete (stb);
-
- LA_PRINT_TYPE (type, "", stb, -1, 0, &type_print_raw_options);
-
- name = ui_file_xstrdup (stb, NULL);
- do_cleanups (old_chain);
+ LA_PRINT_TYPE (type, "", &stb, -1, 0, &type_print_raw_options);
+ return std::move (stb.string ());
}
- if (except.reason < 0)
+ catch (const gdb_exception &except)
{
- *excp = gdbscm_scm_from_gdb_exception (except);
- return NULL;
+ excp = gdbscm_scm_from_gdb_exception (unpack (except));
}
- return name;
+ gdbscm_throw (excp);
}
\f
/* Administrivia for type smobs. */
static hashval_t
tyscm_hash_type_smob (const void *p)
{
- const type_smob *t_smob = p;
+ const type_smob *t_smob = (const type_smob *) p;
return htab_hash_pointer (t_smob->type);
}
static int
tyscm_eq_type_smob (const void *ap, const void *bp)
{
- const type_smob *a = ap;
- const type_smob *b = bp;
+ const type_smob *a = (const type_smob *) ap;
+ const type_smob *b = (const type_smob *) bp;
return (a->type == b->type
&& a->type != NULL);
static htab_t
tyscm_type_map (struct type *type)
{
- struct objfile *objfile = TYPE_OBJFILE (type);
+ struct objfile *objfile = type->objfile_owner ();
htab_t htab;
if (objfile == NULL)
return global_types_map;
- htab = objfile_data (objfile, tyscm_objfile_data_key);
+ htab = (htab_t) objfile_data (objfile, tyscm_objfile_data_key);
if (htab == NULL)
{
htab = gdbscm_create_eqable_gsmob_ptr_map (tyscm_hash_type_smob,
return htab;
}
-/* The smob "mark" function for <gdb:type>. */
-
-static SCM
-tyscm_mark_type_smob (SCM self)
-{
- type_smob *t_smob = (type_smob *) SCM_SMOB_DATA (self);
-
- /* Do this last. */
- return gdbscm_mark_eqable_gsmob (&t_smob->base);
-}
-
/* The smob "free" function for <gdb:type>. */
static size_t
tyscm_print_type_smob (SCM self, SCM port, scm_print_state *pstate)
{
type_smob *t_smob = (type_smob *) SCM_SMOB_DATA (self);
- SCM exception;
- char *name = tyscm_type_name (t_smob->type, &exception);
-
- if (name == NULL)
- gdbscm_throw (exception);
+ std::string name = tyscm_type_name (t_smob->type);
/* pstate->writingp = zero if invoked by display/~A, and nonzero if
invoked by write/~S. What to do here may need to evolve.
if (pstate->writingp)
gdbscm_printf (port, "#<%s ", type_smob_name);
- scm_puts (name, port);
+ scm_puts (name.c_str (), port);
if (pstate->writingp)
scm_puts (">", port);
{
type_smob *type1_smob, *type2_smob;
struct type *type1, *type2;
- int result = 0;
- volatile struct gdb_exception except;
+ bool result = false;
SCM_ASSERT_TYPE (tyscm_is_type (type1_scm), type1_scm, SCM_ARG1, FUNC_NAME,
type_smob_name);
type1 = type1_smob->type;
type2 = type2_smob->type;
- TRY_CATCH (except, RETURN_MASK_ALL)
+ gdbscm_gdb_exception exc {};
+ try
{
result = types_deeply_equal (type1, type2);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ catch (const gdb_exception &except)
+ {
+ exc = unpack (except);
+ }
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
return scm_from_bool (result);
}
return t_smob;
}
+/* Return the type field of T_SCM, an object of type <gdb:type>.
+ This exists so that we don't have to export the struct's contents. */
+
+struct type *
+tyscm_scm_to_type (SCM t_scm)
+{
+ type_smob *t_smob;
+
+ gdb_assert (tyscm_is_type (t_scm));
+ t_smob = (type_smob *) SCM_SMOB_DATA (t_scm);
+ return t_smob->type;
+}
+
/* Helper function for save_objfile_types to make a deep copy of the type. */
static int
tyscm_copy_type_recursive (void **slot, void *info)
{
type_smob *t_smob = (type_smob *) *slot;
- htab_t copied_types = info;
- struct objfile *objfile = TYPE_OBJFILE (t_smob->type);
+ htab_t copied_types = (htab_t) info;
+ struct objfile *objfile = t_smob->type->objfile_owner ();
htab_t htab;
eqable_gdb_smob **new_slot;
type_smob t_smob_for_lookup;
static void
save_objfile_types (struct objfile *objfile, void *datum)
{
- htab_t htab = datum;
- htab_t copied_types;
+ htab_t htab = (htab_t) datum;
if (!gdb_scheme_initialized)
return;
- copied_types = create_copied_types_hash (objfile);
+ htab_up copied_types = create_copied_types_hash (objfile);
if (htab != NULL)
{
- htab_traverse_noresize (htab, tyscm_copy_type_recursive, copied_types);
+ htab_traverse_noresize (htab, tyscm_copy_type_recursive, copied_types.get ());
htab_delete (htab);
}
-
- htab_delete (copied_types);
}
\f
/* Administrivia for field smobs. */
-/* The smob "mark" function for <gdb:field>. */
-
-static SCM
-tyscm_mark_field_smob (SCM self)
-{
- field_smob *f_smob = (field_smob *) SCM_SMOB_DATA (self);
-
- scm_gc_mark (f_smob->type_scm);
- /* Do this last. */
- return gdbscm_mark_gsmob (&f_smob->base);
-}
-
/* The smob "print" function for <gdb:field>. */
static int
struct type *type = tyscm_field_smob_containing_type (f_smob);
/* This should be non-NULL by construction. */
- gdb_assert (TYPE_FIELDS (type) != NULL);
+ gdb_assert (type->fields () != NULL);
- return &TYPE_FIELD (type, f_smob->field_num);
+ return &type->field (f_smob->field_num);
}
\f
/* Type smob accessors. */
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct type *type = t_smob->type;
- return scm_from_int (TYPE_CODE (type));
+ return scm_from_int (type->code ());
}
/* (type-fields <gdb:type>) -> list
containing_type_scm = tyscm_scm_from_type (containing_type);
result = SCM_EOL;
- for (i = 0; i < TYPE_NFIELDS (containing_type); ++i)
+ for (i = 0; i < containing_type->num_fields (); ++i)
result = scm_cons (tyscm_make_field_smob (containing_type_scm, i), result);
return scm_reverse_x (result, SCM_EOL);
type_smob *t_smob
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct type *type = t_smob->type;
+ const char *tagname = nullptr;
+
+ if (type->code () == TYPE_CODE_STRUCT
+ || type->code () == TYPE_CODE_UNION
+ || type->code () == TYPE_CODE_ENUM)
+ tagname = type->name ();
- if (!TYPE_TAG_NAME (type))
+ if (tagname == nullptr)
return SCM_BOOL_F;
- return gdbscm_scm_from_c_string (TYPE_TAG_NAME (type));
+ return gdbscm_scm_from_c_string (tagname);
}
/* (type-name <gdb:type>) -> string
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct type *type = t_smob->type;
- if (!TYPE_NAME (type))
+ if (!type->name ())
return SCM_BOOL_F;
- return gdbscm_scm_from_c_string (TYPE_NAME (type));
+ return gdbscm_scm_from_c_string (type->name ());
}
/* (type-print-name <gdb:type>) -> string
type_smob *t_smob
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct type *type = t_smob->type;
- char *thetype;
- SCM exception, result;
-
- thetype = tyscm_type_name (type, &exception);
-
- if (thetype == NULL)
- gdbscm_throw (exception);
-
- result = gdbscm_scm_from_c_string (thetype);
- xfree (thetype);
+ std::string thetype = tyscm_type_name (type);
+ SCM result = gdbscm_scm_from_c_string (thetype.c_str ());
return result;
}
type_smob *t_smob
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct type *type = t_smob->type;
- volatile struct gdb_exception except;
- TRY_CATCH (except, RETURN_MASK_ALL)
+ try
{
check_typedef (type);
}
+ catch (const gdb_exception &except)
+ {
+ }
+
/* Ignore exceptions. */
return scm_from_long (TYPE_LENGTH (type));
type_smob *t_smob
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct type *type = t_smob->type;
- volatile struct gdb_exception except;
- TRY_CATCH (except, RETURN_MASK_ALL)
+ gdbscm_gdb_exception exc {};
+ try
{
type = check_typedef (type);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ catch (const gdb_exception &except)
+ {
+ exc = unpack (except);
+ }
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
return tyscm_scm_from_type (type);
}
static struct type *
tyscm_get_composite (struct type *type)
{
- volatile struct gdb_exception except;
for (;;)
{
- TRY_CATCH (except, RETURN_MASK_ALL)
+ gdbscm_gdb_exception exc {};
+ try
{
type = check_typedef (type);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ catch (const gdb_exception &except)
+ {
+ exc = unpack (except);
+ }
- if (TYPE_CODE (type) != TYPE_CODE_PTR
- && TYPE_CODE (type) != TYPE_CODE_REF)
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
+ if (type->code () != TYPE_CODE_PTR
+ && type->code () != TYPE_CODE_REF)
break;
type = TYPE_TARGET_TYPE (type);
}
/* If this is not a struct, union, or enum type, raise TypeError
exception. */
- if (TYPE_CODE (type) != TYPE_CODE_STRUCT
- && TYPE_CODE (type) != TYPE_CODE_UNION
- && TYPE_CODE (type) != TYPE_CODE_ENUM)
+ if (type->code () != TYPE_CODE_STRUCT
+ && type->code () != TYPE_CODE_UNION
+ && type->code () != TYPE_CODE_ENUM)
return NULL;
return type;
struct type *type = t_smob->type;
long n1, n2 = 0;
struct type *array = NULL;
- volatile struct gdb_exception except;
gdbscm_parse_function_args (func_name, SCM_ARG2, NULL, "l|l",
n1_scm, &n1, n2_scm, &n2);
n1 = 0;
}
- if (n2 < n1)
+ if (n2 < n1 - 1) /* Note: An empty array has n2 == n1 - 1. */
{
gdbscm_out_of_range_error (func_name, SCM_ARG3,
scm_cons (scm_from_long (n1),
_("Array length must not be negative"));
}
- TRY_CATCH (except, RETURN_MASK_ALL)
+ gdbscm_gdb_exception exc {};
+ try
{
array = lookup_array_range_type (type, n1, n2);
if (is_vector)
make_vector_type (array);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ catch (const gdb_exception &except)
+ {
+ exc = unpack (except);
+ }
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
return tyscm_scm_from_type (array);
}
type_smob *t_smob
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct type *type = t_smob->type;
- volatile struct gdb_exception except;
- TRY_CATCH (except, RETURN_MASK_ALL)
+ gdbscm_gdb_exception exc {};
+ try
{
type = lookup_pointer_type (type);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ catch (const gdb_exception &except)
+ {
+ exc = unpack (except);
+ }
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
return tyscm_scm_from_type (type);
}
/* Initialize these to appease GCC warnings. */
LONGEST low = 0, high = 0;
- SCM_ASSERT_TYPE (TYPE_CODE (type) == TYPE_CODE_ARRAY
- || TYPE_CODE (type) == TYPE_CODE_STRING
- || TYPE_CODE (type) == TYPE_CODE_RANGE,
+ SCM_ASSERT_TYPE (type->code () == TYPE_CODE_ARRAY
+ || type->code () == TYPE_CODE_STRING
+ || type->code () == TYPE_CODE_RANGE,
self, SCM_ARG1, FUNC_NAME, _("ranged type"));
- switch (TYPE_CODE (type))
+ switch (type->code ())
{
case TYPE_CODE_ARRAY:
case TYPE_CODE_STRING:
- low = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (type));
- high = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (type));
- break;
case TYPE_CODE_RANGE:
- low = TYPE_LOW_BOUND (type);
- high = TYPE_HIGH_BOUND (type);
+ if (type->bounds ()->low.kind () == PROP_CONST)
+ low = type->bounds ()->low.const_val ();
+ else
+ low = 0;
+
+ if (type->bounds ()->high.kind () == PROP_CONST)
+ high = type->bounds ()->high.const_val ();
+ else
+ high = 0;
break;
}
type_smob *t_smob
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct type *type = t_smob->type;
- volatile struct gdb_exception except;
- TRY_CATCH (except, RETURN_MASK_ALL)
+ gdbscm_gdb_exception exc {};
+ try
+ {
+ type = lookup_lvalue_reference_type (type);
+ }
+ catch (const gdb_exception &except)
{
- type = lookup_reference_type (type);
+ exc = unpack (except);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
return tyscm_scm_from_type (type);
}
type_smob *t_smob
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct type *type = t_smob->type;
- volatile struct gdb_exception except;
- TRY_CATCH (except, RETURN_MASK_ALL)
+ gdbscm_gdb_exception exc {};
+ try
{
type = make_cv_type (1, 0, type, NULL);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ catch (const gdb_exception &except)
+ {
+ exc = unpack (except);
+ }
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
return tyscm_scm_from_type (type);
}
type_smob *t_smob
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct type *type = t_smob->type;
- volatile struct gdb_exception except;
- TRY_CATCH (except, RETURN_MASK_ALL)
+ gdbscm_gdb_exception exc {};
+ try
{
type = make_cv_type (0, 1, type, NULL);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ catch (const gdb_exception &except)
+ {
+ exc = unpack (except);
+ }
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
return tyscm_scm_from_type (type);
}
type_smob *t_smob
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct type *type = t_smob->type;
- volatile struct gdb_exception except;
- TRY_CATCH (except, RETURN_MASK_ALL)
+ gdbscm_gdb_exception exc {};
+ try
{
type = make_cv_type (0, 0, type, NULL);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ catch (const gdb_exception &except)
+ {
+ exc = unpack (except);
+ }
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
return tyscm_scm_from_type (type);
}
\f
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
_(not_composite_error));
- return scm_from_long (TYPE_NFIELDS (type));
+ return scm_from_long (type->num_fields ());
}
/* (type-field <gdb:type> string) -> <gdb:field>
type_smob *t_smob
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct type *type = t_smob->type;
- char *field;
- int i;
- struct cleanup *cleanups;
SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
_("string"));
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
_(not_composite_error));
- field = gdbscm_scm_to_c_string (field_scm);
- cleanups = make_cleanup (xfree, field);
+ {
+ gdb::unique_xmalloc_ptr<char> field = gdbscm_scm_to_c_string (field_scm);
- for (i = 0; i < TYPE_NFIELDS (type); i++)
- {
- const char *t_field_name = TYPE_FIELD_NAME (type, i);
+ for (int i = 0; i < type->num_fields (); i++)
+ {
+ const char *t_field_name = TYPE_FIELD_NAME (type, i);
- if (t_field_name && (strcmp_iw (t_field_name, field) == 0))
- {
- do_cleanups (cleanups);
+ if (t_field_name && (strcmp_iw (t_field_name, field.get ()) == 0))
+ {
+ field.reset (nullptr);
return tyscm_make_field_smob (self, i);
- }
- }
-
- do_cleanups (cleanups);
+ }
+ }
+ }
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, field_scm,
_("Unknown field"));
type_smob *t_smob
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct type *type = t_smob->type;
- char *field;
- int i;
- struct cleanup *cleanups;
SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
_("string"));
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
_(not_composite_error));
- field = gdbscm_scm_to_c_string (field_scm);
- cleanups = make_cleanup (xfree, field);
+ {
+ gdb::unique_xmalloc_ptr<char> field
+ = gdbscm_scm_to_c_string (field_scm);
- for (i = 0; i < TYPE_NFIELDS (type); i++)
- {
- const char *t_field_name = TYPE_FIELD_NAME (type, i);
+ for (int i = 0; i < type->num_fields (); i++)
+ {
+ const char *t_field_name = TYPE_FIELD_NAME (type, i);
- if (t_field_name && (strcmp_iw (t_field_name, field) == 0))
- {
- do_cleanups (cleanups);
- return SCM_BOOL_T;
- }
- }
-
- do_cleanups (cleanups);
+ if (t_field_name && (strcmp_iw (t_field_name, field.get ()) == 0))
+ return SCM_BOOL_T;
+ }
+ }
return SCM_BOOL_F;
}
type_smob *t_smob;
struct type *type;
SCM it_scm, result, progress, object;
- int field, rc;
+ int field;
it_scm = itscm_get_iterator_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
i_smob = (iterator_smob *) SCM_SMOB_DATA (it_scm);
type = t_smob->type;
SCM_ASSERT_TYPE (scm_is_signed_integer (progress,
- 0, TYPE_NFIELDS (type)),
+ 0, type->num_fields ()),
progress, SCM_ARG1, FUNC_NAME, _("integer"));
field = scm_to_int (progress);
- if (field < TYPE_NFIELDS (type))
+ if (field < type->num_fields ())
{
result = tyscm_make_field_smob (object, field);
itscm_set_iterator_smob_progress_x (i_smob, scm_from_int (field + 1));
struct field *field = tyscm_field_smob_to_field (f_smob);
/* A field can have a NULL type in some situations. */
- if (FIELD_TYPE (*field))
- return tyscm_scm_from_type (FIELD_TYPE (*field));
+ if (field->type ())
+ return tyscm_scm_from_type (field->type ());
return SCM_BOOL_F;
}
struct field *field = tyscm_field_smob_to_field (f_smob);
struct type *type = tyscm_field_smob_containing_type (f_smob);
- SCM_ASSERT_TYPE (TYPE_CODE (type) == TYPE_CODE_ENUM,
+ SCM_ASSERT_TYPE (type->code () == TYPE_CODE_ENUM,
self, SCM_ARG1, FUNC_NAME, _("enum type"));
return scm_from_long (FIELD_ENUMVAL (*field));
struct field *field = tyscm_field_smob_to_field (f_smob);
struct type *type = tyscm_field_smob_containing_type (f_smob);
- SCM_ASSERT_TYPE (TYPE_CODE (type) != TYPE_CODE_ENUM,
+ SCM_ASSERT_TYPE (type->code () != TYPE_CODE_ENUM,
self, SCM_ARG1, FUNC_NAME, _("non-enum type"));
return scm_from_long (FIELD_BITPOS (*field));
{
field_smob *f_smob
= tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- struct field *field = tyscm_field_smob_to_field (f_smob);
struct type *type = tyscm_field_smob_containing_type (f_smob);
- if (TYPE_CODE (type) == TYPE_CODE_CLASS)
+ if (type->code () == TYPE_CODE_STRUCT)
return scm_from_bool (f_smob->field_num < TYPE_N_BASECLASSES (type));
return SCM_BOOL_F;
}
tyscm_lookup_typename (const char *type_name, const struct block *block)
{
struct type *type = NULL;
- volatile struct gdb_exception except;
- TRY_CATCH (except, RETURN_MASK_ALL)
+ try
{
- if (!strncmp (type_name, "struct ", 7))
+ if (startswith (type_name, "struct "))
type = lookup_struct (type_name + 7, NULL);
- else if (!strncmp (type_name, "union ", 6))
+ else if (startswith (type_name, "union "))
type = lookup_union (type_name + 6, NULL);
- else if (!strncmp (type_name, "enum ", 5))
+ else if (startswith (type_name, "enum "))
type = lookup_enum (type_name + 5, NULL);
else
- type = lookup_typename (current_language, get_current_arch (),
+ type = lookup_typename (current_language,
type_name, block, 0);
}
- if (except.reason < 0)
- return NULL;
+ catch (const gdb_exception &except)
+ {
+ return NULL;
+ }
return type;
}
X (TYPE_CODE_METHODPTR),
X (TYPE_CODE_MEMBERPTR),
X (TYPE_CODE_REF),
+ X (TYPE_CODE_RVALUE_REF),
X (TYPE_CODE_CHAR),
X (TYPE_CODE_BOOL),
X (TYPE_CODE_COMPLEX),
static const scheme_function type_functions[] =
{
- { "type?", 1, 0, 0, gdbscm_type_p,
+ { "type?", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_p),
"\
Return #t if the object is a <gdb:type> object." },
- { "lookup-type", 1, 0, 1, gdbscm_lookup_type,
+ { "lookup-type", 1, 0, 1, as_a_scm_t_subr (gdbscm_lookup_type),
"\
Return the <gdb:type> object representing string or #f if not found.\n\
If block is given then the type is looked for in that block.\n\
\n\
Arguments: string [#:block <gdb:block>]" },
- { "type-code", 1, 0, 0, gdbscm_type_code,
+ { "type-code", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_code),
"\
Return the code of the type" },
- { "type-tag", 1, 0, 0, gdbscm_type_tag,
+ { "type-tag", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_tag),
"\
Return the tag name of the type, or #f if there isn't one." },
- { "type-name", 1, 0, 0, gdbscm_type_name,
+ { "type-name", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_name),
"\
Return the name of the type as a string, or #f if there isn't one." },
- { "type-print-name", 1, 0, 0, gdbscm_type_print_name,
+ { "type-print-name", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_print_name),
"\
Return the print name of the type as a string." },
- { "type-sizeof", 1, 0, 0, gdbscm_type_sizeof,
+ { "type-sizeof", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_sizeof),
"\
Return the size of the type, in bytes." },
- { "type-strip-typedefs", 1, 0, 0, gdbscm_type_strip_typedefs,
+ { "type-strip-typedefs", 1, 0, 0,
+ as_a_scm_t_subr (gdbscm_type_strip_typedefs),
"\
Return a type formed by stripping the type of all typedefs." },
- { "type-array", 2, 1, 0, gdbscm_type_array,
+ { "type-array", 2, 1, 0, as_a_scm_t_subr (gdbscm_type_array),
"\
Return a type representing an array of objects of the type.\n\
\n\
the array size.\n\
Valid bounds for array indices are [low-bound,high-bound]." },
- { "type-vector", 2, 1, 0, gdbscm_type_vector,
+ { "type-vector", 2, 1, 0, as_a_scm_t_subr (gdbscm_type_vector),
"\
Return a type representing a vector of objects of the type.\n\
Vectors differ from arrays in that if the current language has C-style\n\
the array size.\n\
Valid bounds for array indices are [low-bound,high-bound]." },
- { "type-pointer", 1, 0, 0, gdbscm_type_pointer,
+ { "type-pointer", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_pointer),
"\
Return a type of pointer to the type." },
- { "type-range", 1, 0, 0, gdbscm_type_range,
+ { "type-range", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_range),
"\
Return (low high) representing the range for the type." },
- { "type-reference", 1, 0, 0, gdbscm_type_reference,
+ { "type-reference", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_reference),
"\
Return a type of reference to the type." },
- { "type-target", 1, 0, 0, gdbscm_type_target,
+ { "type-target", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_target),
"\
Return the target type of the type." },
- { "type-const", 1, 0, 0, gdbscm_type_const,
+ { "type-const", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_const),
"\
Return a const variant of the type." },
- { "type-volatile", 1, 0, 0, gdbscm_type_volatile,
+ { "type-volatile", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_volatile),
"\
Return a volatile variant of the type." },
- { "type-unqualified", 1, 0, 0, gdbscm_type_unqualified,
+ { "type-unqualified", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_unqualified),
"\
Return a variant of the type without const or volatile attributes." },
- { "type-num-fields", 1, 0, 0, gdbscm_type_num_fields,
+ { "type-num-fields", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_num_fields),
"\
Return the number of fields of the type." },
- { "type-fields", 1, 0, 0, gdbscm_type_fields,
+ { "type-fields", 1, 0, 0, as_a_scm_t_subr (gdbscm_type_fields),
"\
Return the list of <gdb:field> objects of fields of the type." },
- { "make-field-iterator", 1, 0, 0, gdbscm_make_field_iterator,
+ { "make-field-iterator", 1, 0, 0,
+ as_a_scm_t_subr (gdbscm_make_field_iterator),
"\
Return a <gdb:iterator> object for iterating over the fields of the type." },
- { "type-field", 2, 0, 0, gdbscm_type_field,
+ { "type-field", 2, 0, 0, as_a_scm_t_subr (gdbscm_type_field),
"\
Return the field named by string of the type.\n\
\n\
Arguments: <gdb:type> string" },
- { "type-has-field?", 2, 0, 0, gdbscm_type_has_field_p,
+ { "type-has-field?", 2, 0, 0, as_a_scm_t_subr (gdbscm_type_has_field_p),
"\
Return #t if the type has field named string.\n\
\n\
Arguments: <gdb:type> string" },
- { "field?", 1, 0, 0, gdbscm_field_p,
+ { "field?", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_p),
"\
Return #t if the object is a <gdb:field> object." },
- { "field-name", 1, 0, 0, gdbscm_field_name,
+ { "field-name", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_name),
"\
Return the name of the field." },
- { "field-type", 1, 0, 0, gdbscm_field_type,
+ { "field-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_type),
"\
Return the type of the field." },
- { "field-enumval", 1, 0, 0, gdbscm_field_enumval,
+ { "field-enumval", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_enumval),
"\
Return the enum value represented by the field." },
- { "field-bitpos", 1, 0, 0, gdbscm_field_bitpos,
+ { "field-bitpos", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_bitpos),
"\
Return the offset in bits of the field in its containing type." },
- { "field-bitsize", 1, 0, 0, gdbscm_field_bitsize,
+ { "field-bitsize", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_bitsize),
"\
Return the size of the field in bits." },
- { "field-artificial?", 1, 0, 0, gdbscm_field_artificial_p,
+ { "field-artificial?", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_artificial_p),
"\
Return #t if the field is artificial." },
- { "field-baseclass?", 1, 0, 0, gdbscm_field_baseclass_p,
+ { "field-baseclass?", 1, 0, 0, as_a_scm_t_subr (gdbscm_field_baseclass_p),
"\
Return #t if the field is a baseclass." },
gdbscm_initialize_types (void)
{
type_smob_tag = gdbscm_make_smob_type (type_smob_name, sizeof (type_smob));
- scm_set_smob_mark (type_smob_tag, tyscm_mark_type_smob);
scm_set_smob_free (type_smob_tag, tyscm_free_type_smob);
scm_set_smob_print (type_smob_tag, tyscm_print_type_smob);
scm_set_smob_equalp (type_smob_tag, tyscm_equal_p_type_smob);
field_smob_tag = gdbscm_make_smob_type (field_smob_name,
sizeof (field_smob));
- scm_set_smob_mark (field_smob_tag, tyscm_mark_field_smob);
scm_set_smob_print (field_smob_tag, tyscm_print_field_smob);
gdbscm_define_integer_constants (type_integer_constants, 1);
/* This function is "private". */
tyscm_next_field_x_proc
= scm_c_define_gsubr ("%type-next-field!", 1, 0, 0,
- gdbscm_type_next_field_x);
+ as_a_scm_t_subr (gdbscm_type_next_field_x));
scm_set_procedure_property_x (tyscm_next_field_x_proc,
gdbscm_documentation_symbol,
gdbscm_scm_from_c_string ("\
block_keyword = scm_from_latin1_keyword ("block");
+ global_types_map = gdbscm_create_eqable_gsmob_ptr_map (tyscm_hash_type_smob,
+ tyscm_eq_type_smob);
+}
+
+void _initialize_scm_type ();
+void
+_initialize_scm_type ()
+{
/* Register an objfile "free" callback so we can properly copy types
associated with the objfile when it's about to be deleted. */
tyscm_objfile_data_key
= register_objfile_data_with_cleanup (save_objfile_types, NULL);
-
- global_types_map = gdbscm_create_eqable_gsmob_ptr_map (tyscm_hash_type_smob,
- tyscm_eq_type_smob);
}
projects / deliverable / binutils-gdb.git / blobdiff