/* Scheme interface to types.
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2024 Free Software Foundation, Inc.
This file is part of GDB.
conventions, et.al. */
#include "defs.h"
+#include "top.h"
#include "arch-utils.h"
#include "value.h"
#include "gdbtypes.h"
/* The <gdb:type> smob.
The type is chained with all types associated with its objfile, if any.
This lets us copy the underlying struct type when the objfile is
- deleted.
- The typedef for this struct is in guile-internal.h. */
+ deleted. */
-struct _type_smob
+struct type_smob
{
/* This always appears first.
eqable_gdb_smob is used so that types are eq?-able.
/* 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";
/* Keywords used in argument passing. */
static SCM block_keyword;
-static const struct objfile_data *tyscm_objfile_data_key;
+static int tyscm_copy_type_recursive (void **slot, void *info);
+
+/* Called when an objfile is about to be deleted.
+ Make a copy of all types associated with OBJFILE. */
+
+struct tyscm_deleter
+{
+ void operator() (htab_t htab)
+ {
+ if (!gdb_scheme_initialized)
+ return;
+
+ gdb_assert (htab != nullptr);
+ htab_up copied_types = create_copied_types_hash ();
+ htab_traverse_noresize (htab, tyscm_copy_type_recursive, copied_types.get ());
+ htab_delete (htab);
+ }
+};
+
+static const registry<objfile>::key<htab, tyscm_deleter>
+ tyscm_objfile_data_key;
/* Hash table to uniquify global (non-objfile-owned) types. */
static htab_t global_types_map;
{
string_file stb;
- LA_PRINT_TYPE (type, "", &stb, -1, 0, &type_print_raw_options);
- return std::move (stb.string ());
+ current_language->print_type (type, "", &stb, -1, 0,
+ &type_print_raw_options);
+ return stb.release ();
+ }
+ catch (const gdb_exception_forced_quit &except)
+ {
+ quit_force (NULL, 0);
}
catch (const gdb_exception &except)
{
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 = (htab_t) objfile_data (objfile, tyscm_objfile_data_key);
+ htab = tyscm_objfile_data_key.get (objfile);
if (htab == NULL)
{
htab = gdbscm_create_eqable_gsmob_ptr_map (tyscm_hash_type_smob,
tyscm_eq_type_smob);
- set_objfile_data (objfile, tyscm_objfile_data_key, htab);
+ tyscm_objfile_data_key.set (objfile, htab);
}
return htab;
return t_smob->type;
}
-/* Helper function for save_objfile_types to make a deep copy of the type. */
+/* Helper function 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 = (htab_t) info;
- struct objfile *objfile = TYPE_OBJFILE (t_smob->type);
htab_t htab;
eqable_gdb_smob **new_slot;
type_smob t_smob_for_lookup;
- gdb_assert (objfile != NULL);
-
htab_empty (copied_types);
- t_smob->type = copy_type_recursive (objfile, t_smob->type, copied_types);
+ t_smob->type = copy_type_recursive (t_smob->type, copied_types);
/* The eq?-hashtab that the type lived in is going away.
Add the type to its new eq?-hashtab: Otherwise if/when the type is later
return 1;
}
-/* Called when OBJFILE is about to be deleted.
- Make a copy of all types associated with OBJFILE. */
-
-static void
-save_objfile_types (struct objfile *objfile, void *datum)
-{
- htab_t htab = (htab_t) datum;
- htab_t copied_types;
-
- if (!gdb_scheme_initialized)
- return;
-
- copied_types = create_copied_types_hash (objfile);
-
- if (htab != NULL)
- {
- htab_traverse_noresize (htab, tyscm_copy_type_recursive, copied_types);
- htab_delete (htab);
- }
-
- htab_delete (copied_types);
-}
\f
/* Administrivia for field smobs. */
/* Ignore exceptions. */
- return scm_from_long (TYPE_LENGTH (type));
+ return scm_from_long (type->length ());
}
/* (type-strip-typedefs <gdb:type>) -> <gdb:type>
if (type->code () != TYPE_CODE_PTR
&& type->code () != TYPE_CODE_REF)
break;
- type = TYPE_TARGET_TYPE (type);
+ type = type->target_type ();
}
/* If this is not a struct, union, or enum type, raise TypeError
case TYPE_CODE_ARRAY:
case TYPE_CODE_STRING:
case TYPE_CODE_RANGE:
- low = type->bounds ()->low.const_val ();
- high = type->bounds ()->high.const_val ();
+ if (type->bounds ()->low.is_constant ())
+ low = type->bounds ()->low.const_val ();
+ else
+ low = 0;
+
+ if (type->bounds ()->high.is_constant ())
+ high = type->bounds ()->high.const_val ();
+ else
+ high = 0;
break;
}
= tyscm_get_type_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct type *type = t_smob->type;
- SCM_ASSERT (TYPE_TARGET_TYPE (type), self, SCM_ARG1, FUNC_NAME);
+ SCM_ASSERT (type->target_type (), self, SCM_ARG1, FUNC_NAME);
- return tyscm_scm_from_type (TYPE_TARGET_TYPE (type));
+ return tyscm_scm_from_type (type->target_type ());
}
/* (type-const <gdb:type>) -> <gdb:type>
for (int i = 0; i < type->num_fields (); i++)
{
- const char *t_field_name = TYPE_FIELD_NAME (type, i);
+ const char *t_field_name = type->field (i).name ();
if (t_field_name && (strcmp_iw (t_field_name, field.get ()) == 0))
{
for (int i = 0; i < type->num_fields (); i++)
{
- const char *t_field_name = TYPE_FIELD_NAME (type, i);
+ const char *t_field_name = type->field (i).name ();
if (t_field_name && (strcmp_iw (t_field_name, field.get ()) == 0))
return SCM_BOOL_T;
= tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct field *field = tyscm_field_smob_to_field (f_smob);
- if (FIELD_NAME (*field))
- return gdbscm_scm_from_c_string (FIELD_NAME (*field));
+ if (field->name () != nullptr)
+ return gdbscm_scm_from_c_string (field->name ());
return SCM_BOOL_F;
}
SCM_ASSERT_TYPE (type->code () == TYPE_CODE_ENUM,
self, SCM_ARG1, FUNC_NAME, _("enum type"));
- return scm_from_long (FIELD_ENUMVAL (*field));
+ return scm_from_long (field->loc_enumval ());
}
/* (field-bitpos <gdb:field>) -> integer
SCM_ASSERT_TYPE (type->code () != TYPE_CODE_ENUM,
self, SCM_ARG1, FUNC_NAME, _("non-enum type"));
- return scm_from_long (FIELD_BITPOS (*field));
+ return scm_from_long (field->loc_bitpos ());
}
/* (field-bitsize <gdb:field>) -> integer
= tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct field *field = tyscm_field_smob_to_field (f_smob);
- return scm_from_long (FIELD_BITPOS (*field));
+ return scm_from_long (field->loc_bitpos ());
}
/* (field-artificial? <gdb:field>) -> boolean
= tyscm_get_field_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct field *field = tyscm_field_smob_to_field (f_smob);
- return scm_from_bool (FIELD_ARTIFICIAL (*field));
+ return scm_from_bool (field->is_artificial ());
}
/* (field-baseclass? <gdb:field>) -> boolean
static const scheme_integer_constant type_integer_constants[] =
{
-#define X(SYM) { #SYM, SYM }
- X (TYPE_CODE_BITSTRING),
- X (TYPE_CODE_PTR),
- X (TYPE_CODE_ARRAY),
- X (TYPE_CODE_STRUCT),
- X (TYPE_CODE_UNION),
- X (TYPE_CODE_ENUM),
- X (TYPE_CODE_FLAGS),
- X (TYPE_CODE_FUNC),
- X (TYPE_CODE_INT),
- X (TYPE_CODE_FLT),
- X (TYPE_CODE_VOID),
- X (TYPE_CODE_SET),
- X (TYPE_CODE_RANGE),
- X (TYPE_CODE_STRING),
- X (TYPE_CODE_ERROR),
- X (TYPE_CODE_METHOD),
- X (TYPE_CODE_METHODPTR),
- X (TYPE_CODE_MEMBERPTR),
- X (TYPE_CODE_REF),
- X (TYPE_CODE_CHAR),
- X (TYPE_CODE_BOOL),
- X (TYPE_CODE_COMPLEX),
- X (TYPE_CODE_TYPEDEF),
- X (TYPE_CODE_NAMESPACE),
- X (TYPE_CODE_DECFLOAT),
- X (TYPE_CODE_INTERNAL_FUNCTION),
-#undef X
+ /* This is kept for backward compatibility. */
+ { "TYPE_CODE_BITSTRING", -1 },
+
+#define OP(SYM) { #SYM, SYM },
+#include "type-codes.def"
+#undef OP
END_INTEGER_CONSTANTS
};
block_keyword = scm_from_latin1_keyword ("block");
- /* 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 / thirdparty / binutils-gdb.git / blobdiff