static struct value *value_pos_atr (struct type *, struct value *);
+static struct value *val_atr (struct type *, LONGEST);
+
static struct value *value_val_atr (struct type *, struct value *);
static struct symbol *standard_lookup (const char *, const struct block *,
static int ada_is_direct_array_type (struct type *);
-static void ada_language_arch_info (struct gdbarch *,
- struct language_arch_info *);
-
static struct value *ada_index_struct_field (int, struct value *, int,
struct type *);
return ada_completer_word_break_characters;
}
-/* Print an array element index using the Ada syntax. */
-
-static void
-ada_print_array_index (struct value *index_value, struct ui_file *stream,
- const struct value_print_options *options)
-{
- LA_VALUE_PRINT (index_value, stream, options);
- fprintf_filtered (stream, " => ");
-}
-
/* la_watch_location_expression for Ada. */
static gdb::unique_xmalloc_ptr<char>
int fieldno;
struct type *struct_type = check_typedef ((struct type *) type);
- for (fieldno = 0; fieldno < TYPE_NFIELDS (struct_type); fieldno++)
+ for (fieldno = 0; fieldno < struct_type->num_fields (); fieldno++)
if (field_name_match (TYPE_FIELD_NAME (struct_type, fieldno), field_name))
return fieldno;
case TYPE_CODE_RANGE:
return TYPE_HIGH_BOUND (type);
case TYPE_CODE_ENUM:
- return TYPE_FIELD_ENUMVAL (type, TYPE_NFIELDS (type) - 1);
+ return TYPE_FIELD_ENUMVAL (type, type->num_fields () - 1);
case TYPE_CODE_BOOL:
return 1;
case TYPE_CODE_CHAR:
return xstrdup (ada_decode (encoded).c_str ());
}
-/* Implement la_sniff_from_mangled_name for Ada. */
-
-static int
-ada_sniff_from_mangled_name (const char *mangled, char **out)
-{
- std::string demangled = ada_decode (mangled);
-
- *out = NULL;
-
- if (demangled != mangled && demangled[0] != '<')
- {
- /* Set the gsymbol language to Ada, but still return 0.
- Two reasons for that:
-
- 1. For Ada, we prefer computing the symbol's decoded name
- on the fly rather than pre-compute it, in order to save
- memory (Ada projects are typically very large).
-
- 2. There are some areas in the definition of the GNAT
- encoding where, with a bit of bad luck, we might be able
- to decode a non-Ada symbol, generating an incorrect
- demangled name (Eg: names ending with "TB" for instance
- are identified as task bodies and so stripped from
- the decoded name returned).
-
- Returning 1, here, but not setting *DEMANGLED, helps us get a
- little bit of the best of both worlds. Because we're last,
- we should not affect any of the other languages that were
- able to demangle the symbol before us; we get to correctly
- tag Ada symbols as such; and even if we incorrectly tagged a
- non-Ada symbol, which should be rare, any routing through the
- Ada language should be transparent (Ada tries to behave much
- like C/C++ with non-Ada symbols). */
- return 1;
- }
-
- return 0;
-}
-
\f
/* Arrays */
if (index_desc_type == NULL)
return;
- gdb_assert (TYPE_NFIELDS (index_desc_type) > 0);
+ gdb_assert (index_desc_type->num_fields () > 0);
/* Check if INDEX_DESC_TYPE follows the older encoding (it is sufficient
to check one field only, no need to check them all). If not, return
return;
/* Fixup each field of INDEX_DESC_TYPE. */
- for (i = 0; i < TYPE_NFIELDS (index_desc_type); i++)
+ for (i = 0; i < index_desc_type->num_fields (); i++)
{
const char *name = TYPE_FIELD_NAME (index_desc_type, i);
struct type *raw_type = ada_check_typedef (ada_find_any_type (name));
type = desc_base_type (type);
if (type != NULL)
- return TYPE_NFIELDS (type) / 2;
+ return type->num_fields () / 2;
return 0;
}
for (k = 0; k < arity; k += 1)
{
LONGEST lwb, upb;
- struct value *lwb_value;
if (type->code () != TYPE_CODE_ARRAY)
error (_("too many subscripts (%d expected)"), k);
arr = value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
value_copy (arr));
get_discrete_bounds (TYPE_INDEX_TYPE (type), &lwb, &upb);
- lwb_value = value_from_longest (value_type (ind[k]), lwb);
- arr = value_ptradd (arr, pos_atr (ind[k]) - pos_atr (lwb_value));
+ arr = value_ptradd (arr, pos_atr (ind[k]) - lwb);
type = TYPE_TARGET_TYPE (type);
}
|| type->code () != TYPE_CODE_FUNC)
return;
- if (TYPE_NFIELDS (type) > 0)
+ if (type->num_fields () > 0)
{
int i;
fprintf_filtered (stream, " (");
- for (i = 0; i < TYPE_NFIELDS (type); ++i)
+ for (i = 0; i < type->num_fields (); ++i)
{
if (i > 0)
fprintf_filtered (stream, "; ");
else if (func_type == NULL || func_type->code () != TYPE_CODE_FUNC)
return 0;
- if (TYPE_NFIELDS (func_type) != n_actuals)
+ if (func_type->num_fields () != n_actuals)
return 0;
for (i = 0; i < n_actuals; i += 1)
This function assumes that TYPE1 and TYPE2 are both TYPE_CODE_ENUM
types and that their number of enumerals is identical (in other
- words, TYPE_NFIELDS (type1) == TYPE_NFIELDS (type2)). */
+ words, type1->num_fields () == type2->num_fields ()). */
static int
ada_identical_enum_types_p (struct type *type1, struct type *type2)
underlying value and name. */
/* All enums in the type should have an identical underlying value. */
- for (i = 0; i < TYPE_NFIELDS (type1); i++)
+ for (i = 0; i < type1->num_fields (); i++)
if (TYPE_FIELD_ENUMVAL (type1, i) != TYPE_FIELD_ENUMVAL (type2, i))
return 0;
/* All enumerals should also have the same name (modulo any numerical
suffix). */
- for (i = 0; i < TYPE_NFIELDS (type1); i++)
+ for (i = 0; i < type1->num_fields (); i++)
{
const char *name_1 = TYPE_FIELD_NAME (type1, i);
const char *name_2 = TYPE_FIELD_NAME (type2, i);
/* Quick check: They should all have the same number of enumerals. */
for (i = 1; i < syms.size (); i++)
- if (TYPE_NFIELDS (SYMBOL_TYPE (syms[i].symbol))
- != TYPE_NFIELDS (SYMBOL_TYPE (syms[0].symbol)))
+ if (SYMBOL_TYPE (syms[i].symbol)->num_fields ()
+ != SYMBOL_TYPE (syms[0].symbol)->num_fields ())
return 0;
/* All the sanity checks passed, so we might have a set of
else
{
/* In the !full_search case we're are being called by
- ada_iterate_over_symbols, and we don't want to search
+ iterate_over_symbols, and we don't want to search
superblocks. */
ada_add_block_symbols (obstackp, block, lookup_name, domain, NULL);
}
return ada_lookup_symbol_list_worker (lookup_name, block, domain, results, 1);
}
-/* Implementation of the la_iterate_over_symbols method. */
-
-static bool
-ada_iterate_over_symbols
- (const struct block *block, const lookup_name_info &name,
- domain_enum domain,
- gdb::function_view<symbol_found_callback_ftype> callback)
-{
- int ndefs, i;
- std::vector<struct block_symbol> results;
-
- ndefs = ada_lookup_symbol_list_worker (name, block, domain, &results, 0);
-
- for (i = 0; i < ndefs; ++i)
- {
- if (!callback (&results[i]))
- return false;
- }
-
- return true;
-}
-
/* The result is as for ada_lookup_symbol_list with FULL_SEARCH set
to 1, but choosing the first symbol found if there are multiple
choices.
int
ada_is_ignored_field (struct type *type, int field_num)
{
- if (field_num < 0 || field_num > TYPE_NFIELDS (type))
+ if (field_num < 0 || field_num > type->num_fields ())
return 1;
/* Check the name of that field. */
if (type == NULL || type->code () != TYPE_CODE_STRUCT)
return NULL;
- for (i = 0; i < TYPE_NFIELDS (type); i += 1)
+ for (i = 0; i < type->num_fields (); i += 1)
if (ada_is_parent_field (type, i))
{
struct type *parent_type = TYPE_FIELD_TYPE (type, i);
if (bit_size_p != NULL)
*bit_size_p = 0;
- for (i = 0; i < TYPE_NFIELDS (type); i += 1)
+ for (i = 0; i < type->num_fields (); i += 1)
{
int bit_pos = TYPE_FIELD_BITPOS (type, i);
int fld_offset = offset + bit_pos / 8;
struct type *field_type
= ada_check_typedef (TYPE_FIELD_TYPE (type, i));
- for (j = 0; j < TYPE_NFIELDS (field_type); j += 1)
+ for (j = 0; j < field_type->num_fields (); j += 1)
{
if (find_struct_field (name, TYPE_FIELD_TYPE (field_type, j),
fld_offset
int parent_offset = -1;
type = ada_check_typedef (type);
- for (i = 0; i < TYPE_NFIELDS (type); i += 1)
+ for (i = 0; i < type->num_fields (); i += 1)
{
const char *t_field_name = TYPE_FIELD_NAME (type, i);
i));
int var_offset = offset + TYPE_FIELD_BITPOS (type, i) / 8;
- for (j = 0; j < TYPE_NFIELDS (field_type); j += 1)
+ for (j = 0; j < field_type->num_fields (); j += 1)
{
struct value *v = ada_search_struct_field /* Force line
break. */
int i;
type = ada_check_typedef (type);
- for (i = 0; i < TYPE_NFIELDS (type); i += 1)
+ for (i = 0; i < type->num_fields (); i += 1)
{
if (TYPE_FIELD_NAME (type, i) == NULL)
continue;
type = to_static_fixed_type (type);
- for (i = 0; i < TYPE_NFIELDS (type); i += 1)
+ for (i = 0; i < type->num_fields (); i += 1)
{
const char *t_field_name = TYPE_FIELD_NAME (type, i);
struct type *t;
struct type *field_type = ada_check_typedef (TYPE_FIELD_TYPE (type,
i));
- for (j = TYPE_NFIELDS (field_type) - 1; j >= 0; j -= 1)
+ for (j = field_type->num_fields () - 1; j >= 0; j -= 1)
{
/* FIXME pnh 2008/01/26: We check for a field that is
NOT wrapped in a struct, since the compiler sometimes
discrim_val = value_as_long (discrim);
others_clause = -1;
- for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
+ for (i = 0; i < var_type->num_fields (); i += 1)
{
if (ada_is_others_clause (var_type, i))
others_clause = i;
if (type == NULL || type->code () != TYPE_CODE_STRUCT)
return -1;
- for (f = 0; f < TYPE_NFIELDS (type); f += 1)
+ for (f = 0; f < type->num_fields (); f += 1)
{
if (ada_is_variant_part (type, f))
return f;
struct type *type = alloc_type_copy (templ);
type->set_code (TYPE_CODE_STRUCT);
- TYPE_FIELDS (type) = NULL;
INIT_NONE_SPECIFIC (type);
type->set_name ("<empty>");
TYPE_LENGTH (type) = 0;
to be processed: unless keep_dynamic_fields, this includes only
fields whose position and length are static will be processed. */
if (keep_dynamic_fields)
- nfields = TYPE_NFIELDS (type);
+ nfields = type->num_fields ();
else
{
nfields = 0;
- while (nfields < TYPE_NFIELDS (type)
+ while (nfields < type->num_fields ()
&& !ada_is_variant_part (type, nfields)
&& !is_dynamic_field (type, nfields))
nfields++;
rtype->set_code (TYPE_CODE_STRUCT);
INIT_NONE_SPECIFIC (rtype);
rtype->set_num_fields (nfields);
- TYPE_FIELDS (rtype) = (struct field *)
- TYPE_ALLOC (rtype, nfields * sizeof (struct field));
- memset (TYPE_FIELDS (rtype), 0, sizeof (struct field) * nfields);
+ rtype->set_fields
+ ((struct field *) TYPE_ZALLOC (rtype, nfields * sizeof (struct field)));
rtype->set_name (ada_type_name (type));
TYPE_FIXED_INSTANCE (rtype) = 1;
{
off = align_up (off, field_alignment (type, f))
+ TYPE_FIELD_BITPOS (type, f);
- SET_FIELD_BITPOS (TYPE_FIELD (rtype, f), off);
+ SET_FIELD_BITPOS (rtype->field (f), off);
TYPE_FIELD_BITSIZE (rtype, f) = 0;
if (ada_is_variant_part (type, f))
cond_offset_target (address, off / TARGET_CHAR_BIT), dval);
if (branch_type == NULL)
{
- for (f = variant_field + 1; f < TYPE_NFIELDS (rtype); f += 1)
- TYPE_FIELDS (rtype)[f - 1] = TYPE_FIELDS (rtype)[f];
+ for (f = variant_field + 1; f < rtype->num_fields (); f += 1)
+ rtype->field (f - 1) = rtype->field (f);
rtype->set_num_fields (rtype->num_fields () - 1);
}
else
/* Don't clone TYPE0 until we are sure we are going to need a copy. */
type = type0;
- nfields = TYPE_NFIELDS (type0);
+ nfields = type0->num_fields ();
/* Whether or not we cloned TYPE0, cache the result so that we don't do
recompute all over next time. */
type->set_code (type0->code ());
INIT_NONE_SPECIFIC (type);
type->set_num_fields (nfields);
- TYPE_FIELDS (type) = (struct field *)
- TYPE_ALLOC (type, nfields * sizeof (struct field));
- memcpy (TYPE_FIELDS (type), TYPE_FIELDS (type0),
+
+ field *fields =
+ ((struct field *)
+ TYPE_ALLOC (type, nfields * sizeof (struct field)));
+ memcpy (fields, type0->fields (),
sizeof (struct field) * nfields);
+ type->set_fields (fields);
+
type->set_name (ada_type_name (type0));
TYPE_FIXED_INSTANCE (type) = 1;
TYPE_LENGTH (type) = 0;
struct value *dval;
struct type *rtype;
struct type *branch_type;
- int nfields = TYPE_NFIELDS (type);
+ int nfields = type->num_fields ();
int variant_field = variant_field_index (type);
if (variant_field == -1)
rtype->set_code (TYPE_CODE_STRUCT);
INIT_NONE_SPECIFIC (rtype);
rtype->set_num_fields (nfields);
- TYPE_FIELDS (rtype) =
+
+ field *fields =
(struct field *) TYPE_ALLOC (rtype, nfields * sizeof (struct field));
- memcpy (TYPE_FIELDS (rtype), TYPE_FIELDS (type),
- sizeof (struct field) * nfields);
+ memcpy (fields, type->fields (), sizeof (struct field) * nfields);
+ rtype->set_fields (fields);
+
rtype->set_name (ada_type_name (type));
TYPE_FIXED_INSTANCE (rtype) = 1;
TYPE_LENGTH (rtype) = TYPE_LENGTH (type);
int f;
for (f = variant_field + 1; f < nfields; f += 1)
- TYPE_FIELDS (rtype)[f - 1] = TYPE_FIELDS (rtype)[f];
+ rtype->field (f - 1) = rtype->field (f);
rtype->set_num_fields (rtype->num_fields () - 1);
}
else
struct type *this_layer = check_typedef (array_type);
int i;
- for (i = 0; i < TYPE_NFIELDS (desc_type); i++)
+ for (i = 0; i < desc_type->num_fields (); i++)
{
if (!ada_is_redundant_range_encoding (TYPE_INDEX_TYPE (this_layer),
TYPE_FIELD_TYPE (desc_type, i)))
struct type *elt_type0;
elt_type0 = type0;
- for (i = TYPE_NFIELDS (index_type_desc); i > 0; i -= 1)
+ for (i = index_type_desc->num_fields (); i > 0; i -= 1)
elt_type0 = TYPE_TARGET_TYPE (elt_type0);
/* NOTE: result---the fixed version of elt_type0---should never
ada_to_fixed_type (ada_check_typedef (elt_type0), 0, 0, dval, 1);
elt_type0 = type0;
- for (i = TYPE_NFIELDS (index_type_desc) - 1; i >= 0; i -= 1)
+ for (i = index_type_desc->num_fields () - 1; i >= 0; i -= 1)
{
struct type *range_type =
to_fixed_range_type (TYPE_FIELD_TYPE (index_type_desc, i), dval);
/* Evaluate the TYPE'VAL attribute applied to ARG. */
+static struct value *
+val_atr (struct type *type, LONGEST val)
+{
+ gdb_assert (discrete_type_p (type));
+ if (type->code () == TYPE_CODE_RANGE)
+ type = TYPE_TARGET_TYPE (type);
+ if (type->code () == TYPE_CODE_ENUM)
+ {
+ if (val < 0 || val >= type->num_fields ())
+ error (_("argument to 'VAL out of range"));
+ val = TYPE_FIELD_ENUMVAL (type, val);
+ }
+ return value_from_longest (type, val);
+}
+
static struct value *
value_val_atr (struct type *type, struct value *arg)
{
if (!integer_type_p (value_type (arg)))
error (_("'VAL requires integral argument"));
- if (type->code () == TYPE_CODE_ENUM)
- {
- long pos = value_as_long (arg);
-
- if (pos < 0 || pos >= TYPE_NFIELDS (type))
- error (_("argument to 'VAL out of range"));
- return value_from_longest (type, TYPE_FIELD_ENUMVAL (type, pos));
- }
- else
- return value_from_longest (type, value_as_long (arg));
+ return val_atr (type, value_as_long (arg));
}
\f
return 0;
return (type->code () == TYPE_CODE_STRUCT
- && TYPE_NFIELDS (type) == 1
+ && type->num_fields () == 1
&& strcmp (TYPE_FIELD_NAME (type, 0), "F") == 0);
}
real_type_namer = ada_find_parallel_type (raw_type, "___XVS");
if (real_type_namer == NULL
|| real_type_namer->code () != TYPE_CODE_STRUCT
- || TYPE_NFIELDS (real_type_namer) != 1)
+ || real_type_namer->num_fields () != 1)
return raw_type;
if (TYPE_FIELD_TYPE (real_type_namer, 0)->code () != TYPE_CODE_REF)
nr_ada_primitive_types
};
-static void
-ada_language_arch_info (struct gdbarch *gdbarch,
- struct language_arch_info *lai)
-{
- const struct builtin_type *builtin = builtin_type (gdbarch);
-
- lai->primitive_type_vector
- = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_ada_primitive_types + 1,
- struct type *);
-
- lai->primitive_type_vector [ada_primitive_type_int]
- = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
- 0, "integer");
- lai->primitive_type_vector [ada_primitive_type_long]
- = arch_integer_type (gdbarch, gdbarch_long_bit (gdbarch),
- 0, "long_integer");
- lai->primitive_type_vector [ada_primitive_type_short]
- = arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch),
- 0, "short_integer");
- lai->string_char_type
- = lai->primitive_type_vector [ada_primitive_type_char]
- = arch_character_type (gdbarch, TARGET_CHAR_BIT, 0, "character");
- lai->primitive_type_vector [ada_primitive_type_float]
- = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
- "float", gdbarch_float_format (gdbarch));
- lai->primitive_type_vector [ada_primitive_type_double]
- = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
- "long_float", gdbarch_double_format (gdbarch));
- lai->primitive_type_vector [ada_primitive_type_long_long]
- = arch_integer_type (gdbarch, gdbarch_long_long_bit (gdbarch),
- 0, "long_long_integer");
- lai->primitive_type_vector [ada_primitive_type_long_double]
- = arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch),
- "long_long_float", gdbarch_long_double_format (gdbarch));
- lai->primitive_type_vector [ada_primitive_type_natural]
- = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
- 0, "natural");
- lai->primitive_type_vector [ada_primitive_type_positive]
- = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
- 0, "positive");
- lai->primitive_type_vector [ada_primitive_type_void]
- = builtin->builtin_void;
-
- lai->primitive_type_vector [ada_primitive_type_system_address]
- = lookup_pointer_type (arch_type (gdbarch, TYPE_CODE_VOID, TARGET_CHAR_BIT,
- "void"));
- lai->primitive_type_vector [ada_primitive_type_system_address]
- ->set_name ("system__address");
-
- /* Create the equivalent of the System.Storage_Elements.Storage_Offset
- type. This is a signed integral type whose size is the same as
- the size of addresses. */
- {
- unsigned int addr_length = TYPE_LENGTH
- (lai->primitive_type_vector [ada_primitive_type_system_address]);
-
- lai->primitive_type_vector [ada_primitive_type_storage_offset]
- = arch_integer_type (gdbarch, addr_length * HOST_CHAR_BIT, 0,
- "storage_offset");
- }
-
- lai->bool_type_symbol = NULL;
- lai->bool_type_default = builtin->builtin_bool;
-}
\f
/* Language vector */
}
}
-/* Implement the "la_read_var_value" language_defn method for Ada. */
-
-static struct value *
-ada_read_var_value (struct symbol *var, const struct block *var_block,
- struct frame_info *frame)
-{
- /* The only case where default_read_var_value is not sufficient
- is when VAR is a renaming... */
- if (frame != nullptr)
- {
- const struct block *frame_block = get_frame_block (frame, NULL);
- if (frame_block != nullptr && ada_is_renaming_symbol (var))
- return ada_read_renaming_var_value (var, frame_block);
- }
-
- /* This is a typical case where we expect the default_read_var_value
- function to work. */
- return default_read_var_value (var, var_block, frame);
-}
-
static const char *ada_extensions[] =
{
".adb", ".ads", ".a", ".ada", ".dg", NULL
};
-extern const struct language_defn ada_language_defn = {
+/* Constant data that describes the Ada language. */
+
+extern const struct language_data ada_language_data =
+{
"ada", /* Language name */
"Ada",
language_ada,
ada_printchar, /* Print a character constant */
ada_printstr, /* Function to print string constant */
emit_char, /* Function to print single char (not used) */
- ada_print_type, /* Print a type using appropriate syntax */
ada_print_typedef, /* Print a typedef using appropriate syntax */
ada_value_print_inner, /* la_value_print_inner */
ada_value_print, /* Print a top-level value */
- ada_read_var_value, /* la_read_var_value */
NULL, /* Language specific skip_trampoline */
NULL, /* name_of_this */
true, /* la_store_sym_names_in_linkage_form_p */
ada_lookup_symbol_nonlocal, /* Looking up non-local symbols. */
- basic_lookup_transparent_type, /* lookup_transparent_type */
ada_la_decode, /* Language specific symbol demangler */
- ada_sniff_from_mangled_name,
NULL, /* Language specific
class_name_from_physname */
ada_op_print_tab, /* expression operators for printing */
1, /* String lower bound */
ada_get_gdb_completer_word_break_characters,
ada_collect_symbol_completion_matches,
- ada_language_arch_info,
- ada_print_array_index,
- default_pass_by_reference,
ada_watch_location_expression,
ada_get_symbol_name_matcher, /* la_get_symbol_name_matcher */
- ada_iterate_over_symbols,
- default_search_name_hash,
&ada_varobj_ops,
NULL,
- NULL,
ada_is_string_type,
"(...)" /* la_struct_too_deep_ellipsis */
};
+/* Class representing the Ada language. */
+
+class ada_language : public language_defn
+{
+public:
+ ada_language ()
+ : language_defn (language_ada, ada_language_data)
+ { /* Nothing. */ }
+
+ /* Print an array element index using the Ada syntax. */
+
+ void print_array_index (struct type *index_type,
+ LONGEST index,
+ struct ui_file *stream,
+ const value_print_options *options) const override
+ {
+ struct value *index_value = val_atr (index_type, index);
+
+ LA_VALUE_PRINT (index_value, stream, options);
+ fprintf_filtered (stream, " => ");
+ }
+
+ /* Implement the "read_var_value" language_defn method for Ada. */
+
+ struct value *read_var_value (struct symbol *var,
+ const struct block *var_block,
+ struct frame_info *frame) const override
+ {
+ /* The only case where default_read_var_value is not sufficient
+ is when VAR is a renaming... */
+ if (frame != nullptr)
+ {
+ const struct block *frame_block = get_frame_block (frame, NULL);
+ if (frame_block != nullptr && ada_is_renaming_symbol (var))
+ return ada_read_renaming_var_value (var, frame_block);
+ }
+
+ /* This is a typical case where we expect the default_read_var_value
+ function to work. */
+ return language_defn::read_var_value (var, var_block, frame);
+ }
+
+ /* See language.h. */
+ void language_arch_info (struct gdbarch *gdbarch,
+ struct language_arch_info *lai) const override
+ {
+ const struct builtin_type *builtin = builtin_type (gdbarch);
+
+ lai->primitive_type_vector
+ = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_ada_primitive_types + 1,
+ struct type *);
+
+ lai->primitive_type_vector [ada_primitive_type_int]
+ = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+ 0, "integer");
+ lai->primitive_type_vector [ada_primitive_type_long]
+ = arch_integer_type (gdbarch, gdbarch_long_bit (gdbarch),
+ 0, "long_integer");
+ lai->primitive_type_vector [ada_primitive_type_short]
+ = arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch),
+ 0, "short_integer");
+ lai->string_char_type
+ = lai->primitive_type_vector [ada_primitive_type_char]
+ = arch_character_type (gdbarch, TARGET_CHAR_BIT, 0, "character");
+ lai->primitive_type_vector [ada_primitive_type_float]
+ = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
+ "float", gdbarch_float_format (gdbarch));
+ lai->primitive_type_vector [ada_primitive_type_double]
+ = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
+ "long_float", gdbarch_double_format (gdbarch));
+ lai->primitive_type_vector [ada_primitive_type_long_long]
+ = arch_integer_type (gdbarch, gdbarch_long_long_bit (gdbarch),
+ 0, "long_long_integer");
+ lai->primitive_type_vector [ada_primitive_type_long_double]
+ = arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch),
+ "long_long_float", gdbarch_long_double_format (gdbarch));
+ lai->primitive_type_vector [ada_primitive_type_natural]
+ = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+ 0, "natural");
+ lai->primitive_type_vector [ada_primitive_type_positive]
+ = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+ 0, "positive");
+ lai->primitive_type_vector [ada_primitive_type_void]
+ = builtin->builtin_void;
+
+ lai->primitive_type_vector [ada_primitive_type_system_address]
+ = lookup_pointer_type (arch_type (gdbarch, TYPE_CODE_VOID, TARGET_CHAR_BIT,
+ "void"));
+ lai->primitive_type_vector [ada_primitive_type_system_address]
+ ->set_name ("system__address");
+
+ /* Create the equivalent of the System.Storage_Elements.Storage_Offset
+ type. This is a signed integral type whose size is the same as
+ the size of addresses. */
+ {
+ unsigned int addr_length = TYPE_LENGTH
+ (lai->primitive_type_vector [ada_primitive_type_system_address]);
+
+ lai->primitive_type_vector [ada_primitive_type_storage_offset]
+ = arch_integer_type (gdbarch, addr_length * HOST_CHAR_BIT, 0,
+ "storage_offset");
+ }
+
+ lai->bool_type_symbol = NULL;
+ lai->bool_type_default = builtin->builtin_bool;
+ }
+
+ /* See language.h. */
+
+ bool iterate_over_symbols
+ (const struct block *block, const lookup_name_info &name,
+ domain_enum domain,
+ gdb::function_view<symbol_found_callback_ftype> callback) const override
+ {
+ std::vector<struct block_symbol> results;
+
+ ada_lookup_symbol_list_worker (name, block, domain, &results, 0);
+ for (block_symbol &sym : results)
+ {
+ if (!callback (&sym))
+ return false;
+ }
+
+ return true;
+ }
+
+ /* See language.h. */
+ bool sniff_from_mangled_name (const char *mangled,
+ char **out) const override
+ {
+ std::string demangled = ada_decode (mangled);
+
+ *out = NULL;
+
+ if (demangled != mangled && demangled[0] != '<')
+ {
+ /* Set the gsymbol language to Ada, but still return 0.
+ Two reasons for that:
+
+ 1. For Ada, we prefer computing the symbol's decoded name
+ on the fly rather than pre-compute it, in order to save
+ memory (Ada projects are typically very large).
+
+ 2. There are some areas in the definition of the GNAT
+ encoding where, with a bit of bad luck, we might be able
+ to decode a non-Ada symbol, generating an incorrect
+ demangled name (Eg: names ending with "TB" for instance
+ are identified as task bodies and so stripped from
+ the decoded name returned).
+
+ Returning true, here, but not setting *DEMANGLED, helps us get
+ a little bit of the best of both worlds. Because we're last,
+ we should not affect any of the other languages that were
+ able to demangle the symbol before us; we get to correctly
+ tag Ada symbols as such; and even if we incorrectly tagged a
+ non-Ada symbol, which should be rare, any routing through the
+ Ada language should be transparent (Ada tries to behave much
+ like C/C++ with non-Ada symbols). */
+ return true;
+ }
+
+ return false;
+ }
+
+ /* See language.h. */
+
+ void print_type (struct type *type, const char *varstring,
+ struct ui_file *stream, int show, int level,
+ const struct type_print_options *flags) const override
+ {
+ ada_print_type (type, varstring, stream, show, level, flags);
+ }
+};
+
+/* Single instance of the Ada language class. */
+
+static ada_language ada_language_defn;
+
/* Command-list for the "set/show ada" prefix command. */
static struct cmd_list_element *set_ada_list;
static struct cmd_list_element *show_ada_list;
projects / deliverable / binutils-gdb.git / blobdiff