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 string_printf ("<%s>", str);
}
-static const char *
-ada_get_gdb_completer_word_break_characters (void)
-{
- 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>
if (msym.minsym != NULL)
{
- CORE_ADDR main_program_name_addr;
- int err_code;
-
- main_program_name_addr = BMSYMBOL_VALUE_ADDRESS (msym);
+ CORE_ADDR main_program_name_addr = BMSYMBOL_VALUE_ADDRESS (msym);
if (main_program_name_addr == 0)
error (_("Invalid address for Ada main program name."));
- target_read_string (main_program_name_addr, &main_program_name,
- 1024, &err_code);
-
- if (err_code != 0)
- return NULL;
+ main_program_name = target_read_string (main_program_name_addr, 1024);
return main_program_name.get ();
}
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 our INDEX_DESC_TYPE was generated using the older encoding,
the field type should be a meaningless integer type whose name
is not equal to the field name. */
- if (TYPE_FIELD_TYPE (index_desc_type, 0)->name () != NULL
- && strcmp (TYPE_FIELD_TYPE (index_desc_type, 0)->name (),
+ if (index_desc_type->field (0).type ()->name () != NULL
+ && strcmp (index_desc_type->field (0).type ()->name (),
TYPE_FIELD_NAME (index_desc_type, 0)) == 0)
return;
struct type *raw_type = ada_check_typedef (ada_find_any_type (name));
if (raw_type)
- TYPE_FIELD_TYPE (index_desc_type, i) = raw_type;
+ index_desc_type->field (i).set_type (raw_type);
}
}
if (TYPE_FIELD_BITSIZE (type, 1) > 0)
return TYPE_FIELD_BITSIZE (type, 1);
else
- return 8 * TYPE_LENGTH (ada_check_typedef (TYPE_FIELD_TYPE (type, 1)));
+ return 8 * TYPE_LENGTH (ada_check_typedef (type->field (1).type ()));
}
/* If TYPE is the type of an array descriptor (fat or thin pointer) or a
/* NOTE: The following is bogus; see comment in desc_bounds. */
if (is_thin_pntr (type))
- return desc_base_type (TYPE_FIELD_TYPE (thin_descriptor_type (type), 1));
+ return desc_base_type (thin_descriptor_type (type)->field (1).type ());
else if (is_thick_pntr (type))
{
struct type *data_type = lookup_struct_elt_type (type, "P_ARRAY", 1);
if (TYPE_FIELD_BITSIZE (type, 0) > 0)
return TYPE_FIELD_BITSIZE (type, 0);
else
- return TARGET_CHAR_BIT * TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0));
+ return TARGET_CHAR_BIT * TYPE_LENGTH (type->field (0).type ());
}
/* If BOUNDS is an array-bounds structure (or pointer to one), return
if (TYPE_FIELD_BITSIZE (type, 2 * i + which - 2) > 0)
return TYPE_FIELD_BITSIZE (type, 2 * i + which - 2);
else
- return 8 * TYPE_LENGTH (TYPE_FIELD_TYPE (type, 2 * i + which - 2));
+ return 8 * TYPE_LENGTH (type->field (2 * i + which - 2).type ());
}
/* If TYPE is the type of an array-bounds structure, the type of its
index_type_desc = ada_find_parallel_type (type, "___XA");
if (index_type_desc)
- index_type = to_fixed_range_type (TYPE_FIELD_TYPE (index_type_desc, 0),
+ index_type = to_fixed_range_type (index_type_desc->field (0).type (),
NULL);
else
- index_type = TYPE_INDEX_TYPE (type);
+ index_type = type->index_type ();
new_type = alloc_type_copy (type);
new_elt_type =
"something other than a packed array"));
else
{
- struct type *range_type = TYPE_INDEX_TYPE (elt_type);
+ struct type *range_type = elt_type->index_type ();
LONGEST lowerbound, upperbound;
LONGEST idx;
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));
+ get_discrete_bounds (type->index_type (), &lwb, &upb);
+ arr = value_ptradd (arr, pos_atr (ind[k]) - lwb);
type = TYPE_TARGET_TYPE (type);
}
int low, int high)
{
struct type *type0 = ada_check_typedef (type);
- struct type *base_index_type = TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type0));
+ struct type *base_index_type = TYPE_TARGET_TYPE (type0->index_type ());
struct type *index_type
= create_static_range_type (NULL, base_index_type, low, high);
struct type *slice_type = create_array_type_with_stride
(NULL, TYPE_TARGET_TYPE (type0), index_type,
type0->dyn_prop (DYN_PROP_BYTE_STRIDE),
TYPE_FIELD_BITSIZE (type0, 0));
- int base_low = ada_discrete_type_low_bound (TYPE_INDEX_TYPE (type0));
+ int base_low = ada_discrete_type_low_bound (type0->index_type ());
LONGEST base_low_pos, low_pos;
CORE_ADDR base;
ada_value_slice (struct value *array, int low, int high)
{
struct type *type = ada_check_typedef (value_type (array));
- struct type *base_index_type = TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type));
+ struct type *base_index_type = TYPE_TARGET_TYPE (type->index_type ());
struct type *index_type
- = create_static_range_type (NULL, TYPE_INDEX_TYPE (type), low, high);
+ = create_static_range_type (NULL, type->index_type (), low, high);
struct type *slice_type = create_array_type_with_stride
(NULL, TYPE_TARGET_TYPE (type), index_type,
type->dyn_prop (DYN_PROP_BYTE_STRIDE),
for (i = 1; i < n; i += 1)
type = TYPE_TARGET_TYPE (type);
- result_type = TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type));
+ result_type = TYPE_TARGET_TYPE (type->index_type ());
/* FIXME: The stabs type r(0,0);bound;bound in an array type
has a target type of TYPE_CODE_UNDEF. We compensate here, but
perhaps stabsread.c would make more sense. */
}
if (index_type_desc != NULL)
- index_type = to_fixed_range_type (TYPE_FIELD_TYPE (index_type_desc, n - 1),
+ index_type = to_fixed_range_type (index_type_desc->field (n - 1).type (),
NULL);
else
{
for (i = 1; i < n; i++)
elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type));
- index_type = TYPE_INDEX_TYPE (elt_type);
+ index_type = elt_type->index_type ();
}
return
struct type *arr_type0 = ada_check_typedef (arr_type);
struct type *index_type
= create_static_range_type
- (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (arr_type0)), low,
+ (NULL, TYPE_TARGET_TYPE (arr_type0->index_type ()), low,
high < low ? low - 1 : high);
struct type *elt_type = ada_array_element_type (arr_type0, 1);
{
if (i > 0)
fprintf_filtered (stream, "; ");
- ada_print_type (TYPE_FIELD_TYPE (type, i), NULL, stream, -1, 0,
+ ada_print_type (type->field (i).type (), NULL, stream, -1, 0,
flags);
}
fprintf_filtered (stream, ")");
return 0;
else
{
- struct type *ftype = ada_check_typedef (TYPE_FIELD_TYPE (func_type,
- i));
+ struct type *ftype = ada_check_typedef (func_type->field (i).type ());
struct type *atype = ada_check_typedef (value_type (actuals[i]));
if (!ada_type_match (ftype, atype, 1))
modify_field (value_type (descriptor),
value_contents_writeable (descriptor),
value_pointer (ensure_lval (arr),
- TYPE_FIELD_TYPE (desc_type, 0)),
+ desc_type->field (0).type ()),
fat_pntr_data_bitpos (desc_type),
fat_pntr_data_bitsize (desc_type));
modify_field (value_type (descriptor),
value_contents_writeable (descriptor),
value_pointer (bounds,
- TYPE_FIELD_TYPE (desc_type, 1)),
+ desc_type->field (1).type ()),
fat_pntr_bounds_bitpos (desc_type),
fat_pntr_bounds_bitsize (desc_type));
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.
/* If this is the dispatch table of a tagged type or an interface tag,
then ignore. */
if (ada_is_tagged_type (type, 1)
- && (ada_is_dispatch_table_ptr_type (TYPE_FIELD_TYPE (type, field_num))
- || ada_is_interface_tag (TYPE_FIELD_TYPE (type, field_num))))
+ && (ada_is_dispatch_table_ptr_type (type->field (field_num).type ())
+ || ada_is_interface_tag (type->field (field_num).type ())))
return 1;
/* Not a special field, so it should not be ignored. */
static struct type *
type_from_tag (struct value *tag)
{
- const char *type_name = ada_tag_name (tag);
+ gdb::unique_xmalloc_ptr<char> type_name = ada_tag_name (tag);
if (type_name != NULL)
- return ada_find_any_type (ada_encode (type_name));
+ return ada_find_any_type (ada_encode (type_name.get ()));
return NULL;
}
/* Given the TSD of a tag (type-specific data), return a string
containing the name of the associated type.
- The returned value is good until the next call. May return NULL
- if we are unable to determine the tag name. */
+ May return NULL if we are unable to determine the tag name. */
-static char *
+static gdb::unique_xmalloc_ptr<char>
ada_tag_name_from_tsd (struct value *tsd)
{
- static char name[1024];
char *p;
struct value *val;
val = ada_value_struct_elt (tsd, "expanded_name", 1);
if (val == NULL)
return NULL;
- read_memory_string (value_as_address (val), name, sizeof (name) - 1);
- for (p = name; *p != '\0'; p += 1)
- if (isalpha (*p))
- *p = tolower (*p);
- return name;
+ gdb::unique_xmalloc_ptr<char> buffer
+ = target_read_string (value_as_address (val), INT_MAX);
+ if (buffer == nullptr)
+ return nullptr;
+
+ for (p = buffer.get (); *p != '\0'; ++p)
+ {
+ if (isalpha (*p))
+ *p = tolower (*p);
+ }
+
+ return buffer;
}
/* The type name of the dynamic type denoted by the 'tag value TAG, as
a C string.
Return NULL if the TAG is not an Ada tag, or if we were unable to
- determine the name of that tag. The result is good until the next
- call. */
+ determine the name of that tag. */
-const char *
+gdb::unique_xmalloc_ptr<char>
ada_tag_name (struct value *tag)
{
- char *name = NULL;
+ gdb::unique_xmalloc_ptr<char> name;
if (!ada_is_tag_type (value_type (tag)))
return NULL;
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);
+ struct type *parent_type = type->field (i).type ();
/* If the _parent field is a pointer, then dereference it. */
if (parent_type->code () == TYPE_CODE_PTR)
if (!ADA_TYPE_P (type))
return 0;
- struct type *field_type = TYPE_FIELD_TYPE (type, field_num);
+ struct type *field_type = type->field (field_num).type ();
return (field_type->code () == TYPE_CODE_UNION
|| (is_dynamic_field (type, field_num)
struct type *type;
arg_type = ada_check_typedef (arg_type);
- type = TYPE_FIELD_TYPE (arg_type, fieldno);
+ type = arg_type->field (fieldno).type ();
/* Handle packed fields. It might be that the field is not packed
relative to its containing structure, but the structure itself is
int bit_size = TYPE_FIELD_BITSIZE (type, i);
if (field_type_p != NULL)
- *field_type_p = TYPE_FIELD_TYPE (type, i);
+ *field_type_p = type->field (i).type ();
if (byte_offset_p != NULL)
*byte_offset_p = fld_offset;
if (bit_offset_p != NULL)
}
else if (ada_is_wrapper_field (type, i))
{
- if (find_struct_field (name, TYPE_FIELD_TYPE (type, i), fld_offset,
+ if (find_struct_field (name, type->field (i).type (), fld_offset,
field_type_p, byte_offset_p, bit_offset_p,
bit_size_p, index_p))
return 1;
fixed type?? */
int j;
struct type *field_type
- = ada_check_typedef (TYPE_FIELD_TYPE (type, i));
+ = ada_check_typedef (type->field (i).type ());
for (j = 0; j < field_type->num_fields (); j += 1)
{
- if (find_struct_field (name, TYPE_FIELD_TYPE (field_type, j),
+ if (find_struct_field (name, field_type->field (j).type (),
fld_offset
+ TYPE_FIELD_BITPOS (field_type, j) / 8,
field_type_p, byte_offset_p,
int bit_pos = TYPE_FIELD_BITPOS (type, parent_offset);
int fld_offset = offset + bit_pos / 8;
- if (find_struct_field (name, TYPE_FIELD_TYPE (type, parent_offset),
+ if (find_struct_field (name, type->field (parent_offset).type (),
fld_offset, field_type_p, byte_offset_p,
bit_offset_p, bit_size_p, index_p))
return 1;
struct value *v = /* Do not let indent join lines here. */
ada_search_struct_field (name, arg,
offset + TYPE_FIELD_BITPOS (type, i) / 8,
- TYPE_FIELD_TYPE (type, i));
+ type->field (i).type ());
if (v != NULL)
return v;
{
/* PNH: Do we ever get here? See find_struct_field. */
int j;
- struct type *field_type = ada_check_typedef (TYPE_FIELD_TYPE (type,
- i));
+ struct type *field_type = ada_check_typedef (type->field (i).type ());
int var_offset = offset + TYPE_FIELD_BITPOS (type, i) / 8;
for (j = 0; j < field_type->num_fields (); j += 1)
break. */
(name, arg,
var_offset + TYPE_FIELD_BITPOS (field_type, j) / 8,
- TYPE_FIELD_TYPE (field_type, j));
+ field_type->field (j).type ());
if (v != NULL)
return v;
{
struct value *v = ada_search_struct_field (
name, arg, offset + TYPE_FIELD_BITPOS (type, parent_offset) / 8,
- TYPE_FIELD_TYPE (type, parent_offset));
+ type->field (parent_offset).type ());
if (v != NULL)
return v;
struct value *v = /* Do not let indent join lines here. */
ada_index_struct_field_1 (index_p, arg,
offset + TYPE_FIELD_BITPOS (type, i) / 8,
- TYPE_FIELD_TYPE (type, i));
+ type->field (i).type ());
if (v != NULL)
return v;
}
else if (field_name_match (t_field_name, name))
- return TYPE_FIELD_TYPE (type, i);
+ return type->field (i).type ();
else if (ada_is_wrapper_field (type, i))
{
- t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (type, i), name,
+ t = ada_lookup_struct_elt_type (type->field (i).type (), name,
0, 1);
if (t != NULL)
return t;
else if (ada_is_variant_part (type, i))
{
int j;
- struct type *field_type = ada_check_typedef (TYPE_FIELD_TYPE (type,
- i));
+ struct type *field_type = ada_check_typedef (type->field (i).type ());
for (j = field_type->num_fields () - 1; j >= 0; j -= 1)
{
if (v_field_name != NULL
&& field_name_match (v_field_name, name))
- t = TYPE_FIELD_TYPE (field_type, j);
+ t = field_type->field (j).type ();
else
- t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (field_type,
- j),
+ t = ada_lookup_struct_elt_type (field_type->field (j).type (),
name, 0, 1);
if (t != NULL)
{
struct type *t;
- t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (type, parent_offset),
+ t = ada_lookup_struct_elt_type (type->field (parent_offset).type (),
name, 0, 1);
if (t != NULL)
return t;
const char *name = TYPE_FIELD_NAME (templ_type, field_num);
return name != NULL
- && TYPE_FIELD_TYPE (templ_type, field_num)->code () == TYPE_CODE_PTR
+ && templ_type->field (field_num).type ()->code () == TYPE_CODE_PTR
&& strstr (name, "___XVL") != NULL;
}
{
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))
const gdb_byte *field_valaddr = valaddr;
CORE_ADDR field_address = address;
struct type *field_type =
- TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, f));
+ TYPE_TARGET_TYPE (type->field (f).type ());
if (dval0 == NULL)
{
record size. */
ada_ensure_varsize_limit (field_type);
- TYPE_FIELD_TYPE (rtype, f) = field_type;
+ rtype->field (f).set_type (field_type);
TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
/* The multiplication can potentially overflow. But because
the field length has been size-checked just above, and
adding overflow recovery code to this already complex code,
we just assume that it's not going to happen. */
fld_bit_len =
- TYPE_LENGTH (TYPE_FIELD_TYPE (rtype, f)) * TARGET_CHAR_BIT;
+ TYPE_LENGTH (rtype->field (f).type ()) * TARGET_CHAR_BIT;
}
else
{
structure, the typedef is the only clue which allows us
to distinguish between the two options. Stripping it
would prevent us from printing this field appropriately. */
- TYPE_FIELD_TYPE (rtype, f) = TYPE_FIELD_TYPE (type, f);
+ rtype->field (f).set_type (type->field (f).type ());
TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
if (TYPE_FIELD_BITSIZE (type, f) > 0)
fld_bit_len =
TYPE_FIELD_BITSIZE (rtype, f) = TYPE_FIELD_BITSIZE (type, f);
else
{
- struct type *field_type = TYPE_FIELD_TYPE (type, f);
+ struct type *field_type = type->field (f).type ();
/* We need to be careful of typedefs when computing
the length of our field. If this is a typedef,
branch_type =
to_fixed_variant_branch_type
- (TYPE_FIELD_TYPE (type, variant_field),
+ (type->field (variant_field).type (),
cond_offset_host (valaddr, off / TARGET_CHAR_BIT),
cond_offset_target (address, off / TARGET_CHAR_BIT), dval);
if (branch_type == NULL)
{
for (f = variant_field + 1; f < rtype->num_fields (); 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
{
- TYPE_FIELD_TYPE (rtype, variant_field) = branch_type;
+ rtype->field (variant_field).set_type (branch_type);
TYPE_FIELD_NAME (rtype, variant_field) = "S";
fld_bit_len =
- TYPE_LENGTH (TYPE_FIELD_TYPE (rtype, variant_field)) *
+ TYPE_LENGTH (rtype->field (variant_field).type ()) *
TARGET_CHAR_BIT;
if (off + fld_bit_len > bit_len)
bit_len = off + fld_bit_len;
for (f = 0; f < nfields; f += 1)
{
- struct type *field_type = TYPE_FIELD_TYPE (type0, f);
+ struct type *field_type = type0->field (f).type ();
struct type *new_type;
if (is_dynamic_field (type0, f))
field *fields =
((struct field *)
TYPE_ALLOC (type, nfields * sizeof (struct field)));
- memcpy (fields, TYPE_FIELDS (type0),
+ memcpy (fields, type0->fields (),
sizeof (struct field) * nfields);
type->set_fields (fields);
TYPE_FIXED_INSTANCE (type) = 1;
TYPE_LENGTH (type) = 0;
}
- TYPE_FIELD_TYPE (type, f) = new_type;
+ type->field (f).set_type (new_type);
TYPE_FIELD_NAME (type, f) = TYPE_FIELD_NAME (type0, f);
}
}
field *fields =
(struct field *) TYPE_ALLOC (rtype, nfields * sizeof (struct field));
- memcpy (fields, 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_LENGTH (rtype) = TYPE_LENGTH (type);
branch_type = to_fixed_variant_branch_type
- (TYPE_FIELD_TYPE (type, variant_field),
+ (type->field (variant_field).type (),
cond_offset_host (valaddr,
TYPE_FIELD_BITPOS (type, variant_field)
/ TARGET_CHAR_BIT),
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
{
- TYPE_FIELD_TYPE (rtype, variant_field) = branch_type;
+ rtype->field (variant_field).set_type (branch_type);
TYPE_FIELD_NAME (rtype, variant_field) = "S";
TYPE_FIELD_BITSIZE (rtype, variant_field) = 0;
TYPE_LENGTH (rtype) += TYPE_LENGTH (branch_type);
}
- TYPE_LENGTH (rtype) -= TYPE_LENGTH (TYPE_FIELD_TYPE (type, variant_field));
+ TYPE_LENGTH (rtype) -= TYPE_LENGTH (type->field (variant_field).type ());
value_free_to_mark (mark);
return rtype;
return empty_record (var_type);
else if (is_dynamic_field (var_type, which))
return to_fixed_record_type
- (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (var_type, which)),
+ (TYPE_TARGET_TYPE (var_type->field (which).type ()),
valaddr, address, dval);
- else if (variant_field_index (TYPE_FIELD_TYPE (var_type, which)) >= 0)
+ else if (variant_field_index (var_type->field (which).type ()) >= 0)
return
to_fixed_record_type
- (TYPE_FIELD_TYPE (var_type, which), valaddr, address, dval);
+ (var_type->field (which).type (), valaddr, address, dval);
else
- return TYPE_FIELD_TYPE (var_type, which);
+ return var_type->field (which).type ();
}
/* Assuming RANGE_TYPE is a TYPE_CODE_RANGE, return nonzero if
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)))
+ if (!ada_is_redundant_range_encoding (this_layer->index_type (),
+ desc_type->field (i).type ()))
return 0;
this_layer = check_typedef (TYPE_TARGET_TYPE (this_layer));
}
result = type0;
else
result = create_array_type (alloc_type_copy (type0),
- elt_type, TYPE_INDEX_TYPE (type0));
+ elt_type, type0->index_type ());
}
else
{
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);
+ to_fixed_range_type (index_type_desc->field (i).type (), dval);
result = create_array_type (alloc_type_copy (elt_type0),
result, range_type);
{
if (ada_is_aligner_type (type))
{
- struct type *type1 = TYPE_FIELD_TYPE (ada_check_typedef (type), 0);
+ struct type *type1 = ada_check_typedef (type)->field (0).type ();
if (ada_type_name (type1) == NULL)
type1->set_name (ada_type_name (type));
/* 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->num_fields ())
- 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
|| real_type_namer->num_fields () != 1)
return raw_type;
- if (TYPE_FIELD_TYPE (real_type_namer, 0)->code () != TYPE_CODE_REF)
+ if (real_type_namer->field (0).type ()->code () != TYPE_CODE_REF)
{
/* This is an older encoding form where the base type needs to be
looked up by name. We prefer the newer encoding because it is
}
/* The field in our XVS type is a reference to the base type. */
- return TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (real_type_namer, 0));
+ return TYPE_TARGET_TYPE (real_type_namer->field (0).type ());
}
/* The type of value designated by TYPE, with all aligners removed. */
ada_aligned_type (struct type *type)
{
if (ada_is_aligner_type (type))
- return ada_aligned_type (TYPE_FIELD_TYPE (type, 0));
+ return ada_aligned_type (type->field (0).type ());
else
return ada_get_base_type (type);
}
ada_aligned_value_addr (struct type *type, const gdb_byte *valaddr)
{
if (ada_is_aligner_type (type))
- return ada_aligned_value_addr (TYPE_FIELD_TYPE (type, 0),
+ return ada_aligned_value_addr (type->field (0).type (),
valaddr +
TYPE_FIELD_BITPOS (type,
0) / TARGET_CHAR_BIT);
if (e_msg_len <= 0)
return NULL;
- gdb::unique_xmalloc_ptr<char> e_msg ((char *) xmalloc (e_msg_len + 1));
- read_memory_string (value_address (e_msg_val), e_msg.get (), e_msg_len + 1);
- e_msg.get ()[e_msg_len] = '\0';
-
- return e_msg;
+ return target_read_string (value_address (e_msg_val), INT_MAX);
}
/* Same as ada_exception_message_1, except that all exceptions are
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 */
return false;
}
-/* Implement the "la_get_symbol_name_matcher" language_defn method for
+/* Implement the "get_symbol_name_matcher" language_defn method for
Ada. */
static symbol_name_matcher_ftype *
}
}
-/* 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 */
0, /* c-style arrays */
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. */
+
+ char *demangle (const char *mangled, int options) const override
+ {
+ return ada_la_decode (mangled, options);
+ }
+
+ /* 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);
+ }
+
+ /* See language.h. */
+
+ const char *word_break_characters (void) const override
+ {
+ return ada_completer_word_break_characters;
+ }
+
+protected:
+ /* See language.h. */
+
+ symbol_name_matcher_ftype *get_symbol_name_matcher_inner
+ (const lookup_name_info &lookup_name) const override
+ {
+ return ada_get_symbol_name_matcher (lookup_name);
+ }
+};
+
+/* 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