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>
-ada_watch_location_expression (struct type *type, CORE_ADDR addr)
-{
- type = check_typedef (TYPE_TARGET_TYPE (check_typedef (type)));
- std::string name = type_to_string (type);
- return gdb::unique_xmalloc_ptr<char>
- (xstrprintf ("{%s} %s", name.c_str (), core_addr_to_string (addr)));
-}
-
/* Assuming V points to an array of S objects, make sure that it contains at
least M objects, updating V and S as necessary. */
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;
if (!maybe_missing)
error (_("Unable to find field %s in struct %s. Aborting"),
- field_name, TYPE_NAME (struct_type));
+ field_name, struct_type->name ());
return -1;
}
switch (type->code ())
{
case TYPE_CODE_RANGE:
- return TYPE_HIGH_BOUND (type);
+ {
+ const dynamic_prop &high = type->bounds ()->high;
+
+ if (high.kind () == PROP_CONST)
+ return high.const_val ();
+ else
+ {
+ gdb_assert (high.kind () == PROP_UNDEFINED);
+
+ /* This happens when trying to evaluate a type's dynamic bound
+ without a live target. There is nothing relevant for us to
+ return here, so return 0. */
+ return 0;
+ }
+ }
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:
switch (type->code ())
{
case TYPE_CODE_RANGE:
- return TYPE_LOW_BOUND (type);
+ {
+ const dynamic_prop &low = type->bounds ()->low;
+
+ if (low.kind () == PROP_CONST)
+ return low.const_val ();
+ else
+ {
+ gdb_assert (low.kind () == PROP_UNDEFINED);
+
+ /* This happens when trying to evaluate a type's dynamic bound
+ without a live target. There is nothing relevant for us to
+ return here, so return 0. */
+ return 0;
+ }
+ }
case TYPE_CODE_ENUM:
return TYPE_FIELD_ENUMVAL (type, 0);
case TYPE_CODE_BOOL:
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 (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
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_NAME (TYPE_FIELD_TYPE (index_desc_type, 0)) != NULL
- && strcmp (TYPE_NAME (TYPE_FIELD_TYPE (index_desc_type, 0)),
+ 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;
/* 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));
if (raw_type)
- TYPE_FIELD_TYPE (index_desc_type, i) = raw_type;
+ index_desc_type->field (i).set_type (raw_type);
}
}
-/* Names of MAX_ADA_DIMENS bounds in P_BOUNDS fields of array descriptors. */
-
-static const char *bound_name[] = {
- "LB0", "UB0", "LB1", "UB1", "LB2", "UB2", "LB3", "UB3",
- "LB4", "UB4", "LB5", "UB5", "LB6", "UB6", "LB7", "UB7"
-};
-
-/* Maximum number of array dimensions we are prepared to handle. */
-
-#define MAX_ADA_DIMENS (sizeof(bound_name) / (2*sizeof(char *)))
-
-
/* The desc_* routines return primitive portions of array descriptors
(fat pointers). */
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
static struct value *
desc_one_bound (struct value *bounds, int i, int which)
{
- return value_struct_elt (&bounds, NULL, bound_name[2 * i + which - 2], NULL,
+ char bound_name[20];
+ xsnprintf (bound_name, sizeof (bound_name), "%cB%d",
+ which ? 'U' : 'L', i - 1);
+ return value_struct_elt (&bounds, NULL, bound_name, NULL,
_("Bad GNAT array descriptor bounds"));
}
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
type = desc_base_type (type);
if (type->code () == TYPE_CODE_STRUCT)
- return lookup_struct_elt_type (type, bound_name[2 * i - 2], 1);
+ {
+ char bound_name[20];
+ xsnprintf (bound_name, sizeof (bound_name), "LB%d", i - 1);
+ return lookup_struct_elt_type (type, bound_name, 1);
+ }
else
return NULL;
}
type = desc_base_type (type);
if (type != NULL)
- return TYPE_NFIELDS (type) / 2;
+ return type->num_fields () / 2;
return 0;
}
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 =
elt_bits);
create_array_type (new_type, new_elt_type, index_type);
TYPE_FIELD_BITSIZE (new_type, 0) = *elt_bits;
- TYPE_NAME (new_type) = ada_type_name (type);
+ new_type->set_name (ada_type_name (type));
if ((check_typedef (index_type)->code () == TYPE_CODE_RANGE
&& is_dynamic_type (check_typedef (index_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;
case TYPE_CODE_INT:
return !TYPE_UNSIGNED (type);
case TYPE_CODE_RANGE:
- return TYPE_LOW_BOUND (type) - TYPE_RANGE_DATA (type)->bias < 0;
+ return type->bounds ()->low.const_val () - type->bounds ()->bias < 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));
+ 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);
|| 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, "; ");
- 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, ")");
SYMBOL_LINE (syms[i].symbol));
}
else if (is_enumeral
- && TYPE_NAME (SYMBOL_TYPE (syms[i].symbol)) != NULL)
+ && SYMBOL_TYPE (syms[i].symbol)->name () != NULL)
{
printf_filtered (("[%d] "), i + first_choice);
ada_print_type (SYMBOL_TYPE (syms[i].symbol), NULL,
return n_chosen;
}
-/* Same as evaluate_type (*EXP), but resolves ambiguous symbol
- references (marked by OP_VAR_VALUE nodes in which the symbol has an
- undefined namespace) and converts operators that are
- user-defined into appropriate function calls. If CONTEXT_TYPE is
- non-null, it provides a preferred result type [at the moment, only
- type void has any effect---causing procedures to be preferred over
- functions in calls]. A null CONTEXT_TYPE indicates that a non-void
- return type is preferred. May change (expand) *EXP. */
-
-static void
-resolve (expression_up *expp, int void_context_p, int parse_completion,
- innermost_block_tracker *tracker)
-{
- struct type *context_type = NULL;
- int pc = 0;
-
- if (void_context_p)
- context_type = builtin_type ((*expp)->gdbarch)->builtin_void;
-
- resolve_subexp (expp, &pc, 1, context_type, parse_completion, tracker);
-}
-
/* Resolve the operator of the subexpression beginning at
position *POS of *EXPP. "Resolving" consists of replacing
the symbols that have undefined namespaces in OP_VAR_VALUE nodes
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)
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));
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
if (remove_p)
syms->erase (syms->begin () + i);
-
- i += 1;
+ else
+ i += 1;
}
/* If all the remaining symbols are identical enumerals, then
So, to extract the scope, we search for the "___XR" extension,
and then backtrack until we find the first "__". */
- const char *name = TYPE_NAME (renaming_type);
+ const char *name = renaming_type->name ();
const char *suffix = strstr (name, "___XR");
const char *last;
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.
return info;
}
-static struct block_symbol
-ada_lookup_symbol_nonlocal (const struct language_defn *langdef,
- const char *name,
- const struct block *block,
- const domain_enum domain)
-{
- struct block_symbol sym;
-
- sym = ada_lookup_symbol (name, block_static_block (block), domain);
- if (sym.symbol != NULL)
- return sym;
-
- /* If we haven't found a match at this point, try the primitive
- types. In other languages, this search is performed before
- searching for global symbols in order to short-circuit that
- global-symbol search if it happens that the name corresponds
- to a primitive type. But we cannot do the same in Ada, because
- it is perfectly legitimate for a program to declare a type which
- has the same name as a standard type. If looking up a type in
- that situation, we have traditionally ignored the primitive type
- in favor of user-defined types. This is why, unlike most other
- languages, we search the primitive types this late and only after
- having searched the global symbols without success. */
-
- if (domain == VAR_DOMAIN)
- {
- struct gdbarch *gdbarch;
-
- if (block == NULL)
- gdbarch = target_gdbarch ();
- else
- gdbarch = block_gdbarch (block);
- sym.symbol = language_lookup_primitive_type_as_symbol (langdef, gdbarch, name);
- if (sym.symbol != NULL)
- return sym;
- }
-
- return {};
-}
-
/* True iff STR is a possible encoded suffix of a normal Ada name
that is to be ignored for matching purposes. Suffixes of parallel
return true;
}
-/* Add the list of possible symbol names completing TEXT to TRACKER.
- WORD is the entire command on which completion is made. */
-
-static void
-ada_collect_symbol_completion_matches (completion_tracker &tracker,
- complete_symbol_mode mode,
- symbol_name_match_type name_match_type,
- const char *text, const char *word,
- enum type_code code)
-{
- struct symbol *sym;
- const struct block *b, *surrounding_static_block = 0;
- struct block_iterator iter;
-
- gdb_assert (code == TYPE_CODE_UNDEF);
-
- lookup_name_info lookup_name (text, name_match_type, true);
-
- /* First, look at the partial symtab symbols. */
- expand_symtabs_matching (NULL,
- lookup_name,
- NULL,
- NULL,
- ALL_DOMAIN);
-
- /* At this point scan through the misc symbol vectors and add each
- symbol you find to the list. Eventually we want to ignore
- anything that isn't a text symbol (everything else will be
- handled by the psymtab code above). */
-
- for (objfile *objfile : current_program_space->objfiles ())
- {
- for (minimal_symbol *msymbol : objfile->msymbols ())
- {
- QUIT;
-
- if (completion_skip_symbol (mode, msymbol))
- continue;
-
- language symbol_language = msymbol->language ();
-
- /* Ada minimal symbols won't have their language set to Ada. If
- we let completion_list_add_name compare using the
- default/C-like matcher, then when completing e.g., symbols in a
- package named "pck", we'd match internal Ada symbols like
- "pckS", which are invalid in an Ada expression, unless you wrap
- them in '<' '>' to request a verbatim match.
-
- Unfortunately, some Ada encoded names successfully demangle as
- C++ symbols (using an old mangling scheme), such as "name__2Xn"
- -> "Xn::name(void)" and thus some Ada minimal symbols end up
- with the wrong language set. Paper over that issue here. */
- if (symbol_language == language_auto
- || symbol_language == language_cplus)
- symbol_language = language_ada;
-
- completion_list_add_name (tracker,
- symbol_language,
- msymbol->linkage_name (),
- lookup_name, text, word);
- }
- }
-
- /* Search upwards from currently selected frame (so that we can
- complete on local vars. */
-
- for (b = get_selected_block (0); b != NULL; b = BLOCK_SUPERBLOCK (b))
- {
- if (!BLOCK_SUPERBLOCK (b))
- surrounding_static_block = b; /* For elmin of dups */
-
- ALL_BLOCK_SYMBOLS (b, iter, sym)
- {
- if (completion_skip_symbol (mode, sym))
- continue;
-
- completion_list_add_name (tracker,
- sym->language (),
- sym->linkage_name (),
- lookup_name, text, word);
- }
- }
-
- /* Go through the symtabs and check the externs and statics for
- symbols which match. */
-
- for (objfile *objfile : current_program_space->objfiles ())
- {
- for (compunit_symtab *s : objfile->compunits ())
- {
- QUIT;
- b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), GLOBAL_BLOCK);
- ALL_BLOCK_SYMBOLS (b, iter, sym)
- {
- if (completion_skip_symbol (mode, sym))
- continue;
-
- completion_list_add_name (tracker,
- sym->language (),
- sym->linkage_name (),
- lookup_name, text, word);
- }
- }
- }
-
- for (objfile *objfile : current_program_space->objfiles ())
- {
- for (compunit_symtab *s : objfile->compunits ())
- {
- QUIT;
- b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), STATIC_BLOCK);
- /* Don't do this block twice. */
- if (b == surrounding_static_block)
- continue;
- ALL_BLOCK_SYMBOLS (b, iter, sym)
- {
- if (completion_skip_symbol (mode, sym))
- continue;
-
- completion_list_add_name (tracker,
- sym->language (),
- sym->linkage_name (),
- lookup_name, text, word);
- }
- }
- }
-}
-
/* Field Access */
/* Return non-zero if TYPE is a pointer to the GNAT dispatch table used
if (type->code () != TYPE_CODE_PTR)
return 0;
- name = TYPE_NAME (TYPE_TARGET_TYPE (type));
+ name = TYPE_TARGET_TYPE (type)->name ();
if (name == NULL)
return 0;
static int
ada_is_interface_tag (struct type *type)
{
- const char *name = TYPE_NAME (type);
+ const char *name = type->name ();
if (name == NULL)
return 0;
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 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;
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);
+ 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
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;
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 < 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),
+ 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;
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);
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 < 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. */
(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;
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;
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;
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;
}
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 = 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
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;
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;
return 1;
else if (type0->code () == TYPE_CODE_VOID)
return 0;
- else if (TYPE_NAME (type1) == NULL && TYPE_NAME (type0) != NULL)
+ else if (type1->name () == NULL && type0->name () != NULL)
return 1;
else if (ada_is_constrained_packed_array_type (type0))
return 1;
return 1;
else
{
- const char *type0_name = TYPE_NAME (type0);
- const char *type1_name = TYPE_NAME (type1);
+ const char *type0_name = type0->name ();
+ const char *type1_name = type1->name ();
if (type0_name != NULL && strstr (type0_name, "___XR") != NULL
&& (type1_name == NULL || strstr (type1_name, "___XR") == NULL))
{
if (type == NULL)
return NULL;
- return TYPE_NAME (type);
+ return type->name ();
}
/* Search the list of "descriptive" types associated to TYPE for a type
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;
}
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_NFIELDS (type) = 0;
- TYPE_FIELDS (type) = NULL;
INIT_NONE_SPECIFIC (type);
- TYPE_NAME (type) = "<empty>";
+ type->set_name ("<empty>");
TYPE_LENGTH (type) = 0;
return type;
}
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 = alloc_type_copy (type);
rtype->set_code (TYPE_CODE_STRUCT);
INIT_NONE_SPECIFIC (rtype);
- TYPE_NFIELDS (rtype) = nfields;
- TYPE_FIELDS (rtype) = (struct field *)
- TYPE_ALLOC (rtype, nfields * sizeof (struct field));
- memset (TYPE_FIELDS (rtype), 0, sizeof (struct field) * nfields);
- TYPE_NAME (rtype) = ada_type_name (type);
+ rtype->set_num_fields (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 = 0;
{
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 < TYPE_NFIELDS (rtype); f += 1)
- TYPE_FIELDS (rtype)[f - 1] = TYPE_FIELDS (rtype)[f];
- TYPE_NFIELDS (rtype) -= 1;
+ 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
{
- 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;
the current RTYPE length might be good enough for our purposes. */
if (TYPE_LENGTH (type) <= 0)
{
- if (TYPE_NAME (rtype))
+ if (rtype->name ())
warning (_("Invalid type size for `%s' detected: %s."),
- TYPE_NAME (rtype), pulongest (TYPE_LENGTH (type)));
+ rtype->name (), pulongest (TYPE_LENGTH (type)));
else
warning (_("Invalid type size for <unnamed> detected: %s."),
pulongest (TYPE_LENGTH (type)));
/* 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. */
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))
TYPE_TARGET_TYPE (type0) = type = alloc_type_copy (type0);
type->set_code (type0->code ());
INIT_NONE_SPECIFIC (type);
- TYPE_NFIELDS (type) = nfields;
- TYPE_FIELDS (type) = (struct field *)
- TYPE_ALLOC (type, nfields * sizeof (struct field));
- memcpy (TYPE_FIELDS (type), TYPE_FIELDS (type0),
+ type->set_num_fields (nfields);
+
+ field *fields =
+ ((struct field *)
+ TYPE_ALLOC (type, nfields * sizeof (struct field)));
+ memcpy (fields, type0->fields (),
sizeof (struct field) * nfields);
- TYPE_NAME (type) = ada_type_name (type0);
+ type->set_fields (fields);
+
+ type->set_name (ada_type_name (type0));
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);
}
}
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 = alloc_type_copy (type);
rtype->set_code (TYPE_CODE_STRUCT);
INIT_NONE_SPECIFIC (rtype);
- TYPE_NFIELDS (rtype) = nfields;
- TYPE_FIELDS (rtype) =
+ rtype->set_num_fields (nfields);
+
+ field *fields =
(struct field *) TYPE_ALLOC (rtype, nfields * sizeof (struct field));
- memcpy (TYPE_FIELDS (rtype), TYPE_FIELDS (type),
- sizeof (struct field) * nfields);
- TYPE_NAME (rtype) = ada_type_name (type);
+ 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);
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];
- TYPE_NFIELDS (rtype) -= 1;
+ 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
if (is_dynamic_type (range_type))
return 0;
- if (TYPE_NAME (encoding_type) == NULL)
+ if (encoding_type->name () == NULL)
return 0;
- bounds_str = strstr (TYPE_NAME (encoding_type), "___XDLU_");
+ bounds_str = strstr (encoding_type->name (), "___XDLU_");
if (bounds_str == NULL)
return 0;
n = 8; /* Skip "___XDLU_". */
if (!ada_scan_number (bounds_str, n, &lo, &n))
return 0;
- if (TYPE_LOW_BOUND (range_type) != lo)
+ if (range_type->bounds ()->low.const_val () != lo)
return 0;
n += 2; /* Skip the "__" separator between the two bounds. */
if (!ada_scan_number (bounds_str, n, &hi, &n))
return 0;
- if (TYPE_HIGH_BOUND (range_type) != hi)
+ if (range_type->bounds ()->high.const_val () != hi)
return 0;
return 1;
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)))
+ 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
{
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);
+ to_fixed_range_type (index_type_desc->field (i).type (), dval);
result = create_array_type (alloc_type_copy (elt_type0),
result, range_type);
/* We want to preserve the type name. This can be useful when
trying to get the type name of a value that has already been
printed (for instance, if the user did "print VAR; whatis $". */
- TYPE_NAME (result) = TYPE_NAME (type0);
+ result->set_name (type0->name ());
if (constrained_packed_array_p)
{
{
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)
- TYPE_NAME (type1) = ada_type_name (type);
+ type1->set_name (ada_type_name (type));
return static_unwrap_type (type1);
}
type = check_typedef (type);
if (type == NULL || type->code () != TYPE_CODE_ENUM
|| !TYPE_STUB (type)
- || TYPE_NAME (type) == NULL)
+ || type->name () == NULL)
return type;
else
{
- const char *name = TYPE_NAME (type);
+ const char *name = type->name ();
struct type *type1 = ada_find_any_type (name);
if (type1 == NULL)
/* 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)
+ 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);
static struct value *
evaluate_subexp_type (struct expression *exp, int *pos)
{
- return evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
+ return evaluate_subexp (nullptr, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
}
/* If VAL is wrapped in an aligner or subtype wrapper, return the
struct type *val_type = ada_check_typedef (value_type (v));
if (ada_type_name (val_type) == NULL)
- TYPE_NAME (val_type) = ada_type_name (type);
+ val_type->set_name (ada_type_name (type));
return unwrap_value (v);
}
return arg;
struct value *scale = ada_scaling_factor (type);
- if (ada_is_fixed_point_type (value_type (arg)))
+ if (ada_is_gnat_encoded_fixed_point_type (value_type (arg)))
arg = cast_from_fixed (value_type (scale), arg);
else
arg = value_cast (value_type (scale), arg);
{
lhs = ada_coerce_to_simple_array (lhs);
lhs_type = check_typedef (value_type (lhs));
- low_index = TYPE_ARRAY_LOWER_BOUND_VALUE (lhs_type);
- high_index = TYPE_ARRAY_UPPER_BOUND_VALUE (lhs_type);
+ low_index = lhs_type->bounds ()->low.const_val ();
+ high_index = lhs_type->bounds ()->high.const_val ();
}
else if (lhs_type->code () == TYPE_CODE_STRUCT)
{
if (type == ada_check_typedef (value_type (arg2)))
return arg2;
- if (ada_is_fixed_point_type (type))
+ if (ada_is_gnat_encoded_fixed_point_type (type))
return cast_to_fixed (type, arg2);
- if (ada_is_fixed_point_type (value_type (arg2)))
+ if (ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
return cast_from_fixed (type, arg2);
return value_cast (type, arg2);
return ada_evaluate_subexp (type, exp, pos, noside);
case BINOP_ASSIGN:
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
if (exp->elts[*pos].opcode == OP_AGGREGATE)
{
arg1 = assign_aggregate (arg1, arg1, exp, pos, noside);
{
/* Nothing. */
}
- else if (ada_is_fixed_point_type (value_type (arg1)))
+ else if (ada_is_gnat_encoded_fixed_point_type (value_type (arg1)))
arg2 = cast_to_fixed (value_type (arg1), arg2);
- else if (ada_is_fixed_point_type (value_type (arg2)))
+ else if (ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
error
(_("Fixed-point values must be assigned to fixed-point variables"));
else
return (value_from_longest
(value_type (arg2),
value_as_long (arg1) + value_as_long (arg2)));
- if ((ada_is_fixed_point_type (value_type (arg1))
- || ada_is_fixed_point_type (value_type (arg2)))
+ if ((ada_is_gnat_encoded_fixed_point_type (value_type (arg1))
+ || ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
&& value_type (arg1) != value_type (arg2))
error (_("Operands of fixed-point addition must have the same type"));
/* Do the addition, and cast the result to the type of the first
return (value_from_longest
(value_type (arg2),
value_as_long (arg1) - value_as_long (arg2)));
- if ((ada_is_fixed_point_type (value_type (arg1))
- || ada_is_fixed_point_type (value_type (arg2)))
+ if ((ada_is_gnat_encoded_fixed_point_type (value_type (arg1))
+ || ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
&& value_type (arg1) != value_type (arg2))
error (_("Operands of fixed-point subtraction "
"must have the same type"));
case BINOP_DIV:
case BINOP_REM:
case BINOP_MOD:
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
+ arg2 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
else
{
type = builtin_type (exp->gdbarch)->builtin_double;
- if (ada_is_fixed_point_type (value_type (arg1)))
+ if (ada_is_gnat_encoded_fixed_point_type (value_type (arg1)))
arg1 = cast_from_fixed (type, arg1);
- if (ada_is_fixed_point_type (value_type (arg2)))
+ if (ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
arg2 = cast_from_fixed (type, arg2);
binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
return ada_value_binop (arg1, arg2, op);
case BINOP_EQUAL:
case BINOP_NOTEQUAL:
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
return value_from_longest (type, (LONGEST) tem);
case UNOP_NEG:
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
- else if (ada_is_fixed_point_type (value_type (arg1)))
+ else if (ada_is_gnat_encoded_fixed_point_type (value_type (arg1)))
return value_cast (value_type (arg1), value_neg (arg1));
else
{
{
struct value *val;
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
- *pos = pc;
+ arg1 = evaluate_subexp (nullptr, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
+ *pos = pc;
val = evaluate_subexp_standard (expect_type, exp, pos, noside);
return value_cast (value_type (arg1), val);
a fixed type would result in the loss of that type name,
thus preventing us from printing the name of the ancestor
type in the type description. */
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
+ arg1 = evaluate_subexp (nullptr, exp, pos, EVAL_NORMAL);
if (type->code () != TYPE_CODE_REF)
{
else
{
for (tem = 0; tem <= nargs; tem += 1)
- argvec[tem] = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- argvec[tem] = 0;
+ argvec[tem] = evaluate_subexp (nullptr, exp, pos, noside);
+ argvec[tem] = 0;
if (noside == EVAL_SKIP)
goto nosideret;
case TERNOP_SLICE:
{
- struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- struct value *low_bound_val =
- evaluate_subexp (NULL_TYPE, exp, pos, noside);
- struct value *high_bound_val =
- evaluate_subexp (NULL_TYPE, exp, pos, noside);
- LONGEST low_bound;
+ struct value *array = evaluate_subexp (nullptr, exp, pos, noside);
+ struct value *low_bound_val
+ = evaluate_subexp (nullptr, exp, pos, noside);
+ struct value *high_bound_val
+ = evaluate_subexp (nullptr, exp, pos, noside);
+ LONGEST low_bound;
LONGEST high_bound;
low_bound_val = coerce_ref (low_bound_val);
case UNOP_IN_RANGE:
(*pos) += 2;
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
type = check_typedef (exp->elts[pc + 1].type);
if (noside == EVAL_SKIP)
return value_from_longest (type, (LONGEST) 1);
case TYPE_CODE_RANGE:
- arg2 = value_from_longest (type, TYPE_LOW_BOUND (type));
- arg3 = value_from_longest (type, TYPE_HIGH_BOUND (type));
+ arg2 = value_from_longest (type,
+ type->bounds ()->low.const_val ());
+ arg3 = value_from_longest (type,
+ type->bounds ()->high.const_val ());
binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
type = language_bool_type (exp->language_defn, exp->gdbarch);
case BINOP_IN_BOUNDS:
(*pos) += 2;
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
+ arg2 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
|| value_equal (arg2, arg1)));
case TERNOP_IN_RANGE:
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- arg3 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
+ arg2 = evaluate_subexp (nullptr, exp, pos, noside);
+ arg3 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
if (exp->elts[*pos].opcode == OP_TYPE)
{
- evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
- arg1 = NULL;
+ evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
+ arg1 = NULL;
type_arg = check_typedef (exp->elts[pc + 2].type);
}
else
{
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- type_arg = NULL;
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
+ type_arg = NULL;
}
if (exp->elts[*pos].opcode != OP_LONG)
}
case OP_ATR_TAG:
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
case OP_ATR_MIN:
case OP_ATR_MAX:
- evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
+ arg2 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
struct type *type_arg = check_typedef (exp->elts[pc + 2].type);
- evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
- if (noside == EVAL_SKIP)
+ evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
+ if (noside == EVAL_SKIP)
goto nosideret;
if (!ada_is_modular_type (type_arg))
case OP_ATR_POS:
- evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
type = builtin_type (exp->gdbarch)->builtin_int;
return value_pos_atr (type, arg1);
case OP_ATR_SIZE:
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
type = value_type (arg1);
/* If the argument is a reference, then dereference its type, since
TARGET_CHAR_BIT * TYPE_LENGTH (type));
case OP_ATR_VAL:
- evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
type = exp->elts[pc + 2].type;
if (noside == EVAL_SKIP)
goto nosideret;
return value_val_atr (type, arg1);
case BINOP_EXP:
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
+ arg2 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
}
case UNOP_PLUS:
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
else
return arg1;
case UNOP_ABS:
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
unop_promote (exp->language_defn, exp->gdbarch, &arg1);
case UNOP_IND:
preeval_pos = *pos;
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
type = ada_check_typedef (value_type (arg1));
|| type->code () == TYPE_CODE_PTR)
&& ada_is_tagged_type (TYPE_TARGET_TYPE (type), 0))
{
- arg1 = evaluate_subexp (NULL_TYPE, exp, &preeval_pos,
- EVAL_NORMAL);
+ arg1
+ = evaluate_subexp (nullptr, exp, &preeval_pos, EVAL_NORMAL);
type = value_type (ada_value_ind (arg1));
}
else
tem = longest_to_int (exp->elts[pc + 1].longconst);
(*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
preeval_pos = *pos;
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
if (noside == EVAL_AVOID_SIDE_EFFECTS)
if (type == NULL)
{
- arg1 = evaluate_subexp (NULL_TYPE, exp, &preeval_pos,
- EVAL_NORMAL);
+ arg1
+ = evaluate_subexp (nullptr, exp, &preeval_pos, EVAL_NORMAL);
arg1 = ada_value_struct_elt (arg1,
&exp->elts[pc + 2].string,
0);
Otherwise, return NULL. */
static const char *
-fixed_type_info (struct type *type)
+gnat_encoded_fixed_type_info (struct type *type)
{
const char *name = ada_type_name (type);
enum type_code code = (type == NULL) ? TYPE_CODE_UNDEF : type->code ();
return tail + 5;
}
else if (code == TYPE_CODE_RANGE && TYPE_TARGET_TYPE (type) != type)
- return fixed_type_info (TYPE_TARGET_TYPE (type));
+ return gnat_encoded_fixed_type_info (TYPE_TARGET_TYPE (type));
else
return NULL;
}
/* Returns non-zero iff TYPE represents an Ada fixed-point type. */
int
-ada_is_fixed_point_type (struct type *type)
+ada_is_gnat_encoded_fixed_point_type (struct type *type)
{
- return fixed_type_info (type) != NULL;
+ return gnat_encoded_fixed_type_info (type) != NULL;
}
/* Return non-zero iff TYPE represents a System.Address type. */
int
ada_is_system_address_type (struct type *type)
{
- return (TYPE_NAME (type)
- && strcmp (TYPE_NAME (type), "system__address") == 0);
+ return (type->name () && strcmp (type->name (), "system__address") == 0);
}
/* Assuming that TYPE is the representation of an Ada fixed-point
delta cannot be determined. */
struct value *
-ada_delta (struct type *type)
+gnat_encoded_fixed_point_delta (struct type *type)
{
- const char *encoding = fixed_type_info (type);
+ const char *encoding = gnat_encoded_fixed_type_info (type);
struct type *scale_type = ada_scaling_type (type);
long long num, den;
value_from_longest (scale_type, den), BINOP_DIV);
}
-/* Assuming that ada_is_fixed_point_type (TYPE), return the scaling
- factor ('SMALL value) associated with the type. */
+/* Assuming that ada_is_gnat_encoded_fixed_point_type (TYPE), return
+ the scaling factor ('SMALL value) associated with the type. */
struct value *
ada_scaling_factor (struct type *type)
{
- const char *encoding = fixed_type_info (type);
+ const char *encoding = gnat_encoded_fixed_type_info (type);
struct type *scale_type = ada_scaling_type (type);
long long num0, den0, num1, den1;
const char *subtype_info;
gdb_assert (raw_type != NULL);
- gdb_assert (TYPE_NAME (raw_type) != NULL);
+ gdb_assert (raw_type->name () != NULL);
if (raw_type->code () == TYPE_CODE_RANGE)
base_type = TYPE_TARGET_TYPE (raw_type);
else
base_type = raw_type;
- name = TYPE_NAME (raw_type);
+ name = raw_type->name ();
subtype_info = strstr (name, "___XD");
if (subtype_info == NULL)
{
to match the size of the base_type, which is not what we want.
Set it back to the original range type's length. */
TYPE_LENGTH (type) = TYPE_LENGTH (raw_type);
- TYPE_NAME (type) = name;
+ type->set_name (name);
return type;
}
}
ULONGEST
ada_modulus (struct type *type)
{
- return (ULONGEST) TYPE_HIGH_BOUND (type) + 1;
+ const dynamic_prop &high = type->bounds ()->high;
+
+ if (high.kind () == PROP_CONST)
+ return (ULONGEST) high.const_val () + 1;
+
+ /* If TYPE is unresolved, the high bound might be a location list. Return
+ 0, for lack of a better value to return. */
+ return 0;
}
\f
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);
+ read_memory (value_address (e_msg_val), (gdb_byte *) e_msg.get (),
+ e_msg_len);
e_msg.get ()[e_msg_len] = '\0';
return e_msg;
static int
ada_is_exception_sym (struct symbol *sym)
{
- const char *type_name = TYPE_NAME (SYMBOL_TYPE (sym));
+ const char *type_name = SYMBOL_TYPE (sym)->name ();
return (SYMBOL_CLASS (sym) != LOC_TYPEDEF
&& SYMBOL_CLASS (sym) != LOC_BLOCK
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"));
- TYPE_NAME (lai->primitive_type_vector [ada_primitive_type_system_address])
- = "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 */
-/* Not really used, but needed in the ada_language_defn. */
-
-static void
-emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
-{
- ada_emit_char (c, type, stream, quoter, 1);
-}
-
-static int
-parse (struct parser_state *ps)
-{
- warnings_issued = 0;
- return ada_parse (ps);
-}
-
static const struct exp_descriptor ada_exp_descriptor = {
ada_print_subexp,
ada_operator_length,
{
if (user_name.back () == '>')
m_encoded_name
- = user_name.substr (1, user_name.size () - 2).to_string ();
+ = gdb::to_string (user_name.substr (1, user_name.size () - 2));
else
m_encoded_name
- = user_name.substr (1, user_name.size () - 1).to_string ();
+ = gdb::to_string (user_name.substr (1, user_name.size () - 1));
m_encoded_p = true;
m_verbatim_p = true;
m_wild_match_p = false;
if (encoded != NULL)
m_encoded_name = encoded;
else
- m_encoded_name = user_name.to_string ();
+ m_encoded_name = gdb::to_string (user_name);
}
else
- m_encoded_name = user_name.to_string ();
+ m_encoded_name = gdb::to_string (user_name);
/* Handle the 'package Standard' special case. See description
of m_standard_p. */
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,
macro_expansion_no,
ada_extensions,
&ada_exp_descriptor,
- parse,
- resolve,
- 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;
+ }
+
+ /* See language.h. */
+
+ void collect_symbol_completion_matches (completion_tracker &tracker,
+ complete_symbol_mode mode,
+ symbol_name_match_type name_match_type,
+ const char *text, const char *word,
+ enum type_code code) const override
+ {
+ struct symbol *sym;
+ const struct block *b, *surrounding_static_block = 0;
+ struct block_iterator iter;
+
+ gdb_assert (code == TYPE_CODE_UNDEF);
+
+ lookup_name_info lookup_name (text, name_match_type, true);
+
+ /* First, look at the partial symtab symbols. */
+ expand_symtabs_matching (NULL,
+ lookup_name,
+ NULL,
+ NULL,
+ ALL_DOMAIN);
+
+ /* At this point scan through the misc symbol vectors and add each
+ symbol you find to the list. Eventually we want to ignore
+ anything that isn't a text symbol (everything else will be
+ handled by the psymtab code above). */
+
+ for (objfile *objfile : current_program_space->objfiles ())
+ {
+ for (minimal_symbol *msymbol : objfile->msymbols ())
+ {
+ QUIT;
+
+ if (completion_skip_symbol (mode, msymbol))
+ continue;
+
+ language symbol_language = msymbol->language ();
+
+ /* Ada minimal symbols won't have their language set to Ada. If
+ we let completion_list_add_name compare using the
+ default/C-like matcher, then when completing e.g., symbols in a
+ package named "pck", we'd match internal Ada symbols like
+ "pckS", which are invalid in an Ada expression, unless you wrap
+ them in '<' '>' to request a verbatim match.
+
+ Unfortunately, some Ada encoded names successfully demangle as
+ C++ symbols (using an old mangling scheme), such as "name__2Xn"
+ -> "Xn::name(void)" and thus some Ada minimal symbols end up
+ with the wrong language set. Paper over that issue here. */
+ if (symbol_language == language_auto
+ || symbol_language == language_cplus)
+ symbol_language = language_ada;
+
+ completion_list_add_name (tracker,
+ symbol_language,
+ msymbol->linkage_name (),
+ lookup_name, text, word);
+ }
+ }
+
+ /* Search upwards from currently selected frame (so that we can
+ complete on local vars. */
+
+ for (b = get_selected_block (0); b != NULL; b = BLOCK_SUPERBLOCK (b))
+ {
+ if (!BLOCK_SUPERBLOCK (b))
+ surrounding_static_block = b; /* For elmin of dups */
+
+ ALL_BLOCK_SYMBOLS (b, iter, sym)
+ {
+ if (completion_skip_symbol (mode, sym))
+ continue;
+
+ completion_list_add_name (tracker,
+ sym->language (),
+ sym->linkage_name (),
+ lookup_name, text, word);
+ }
+ }
+
+ /* Go through the symtabs and check the externs and statics for
+ symbols which match. */
+
+ for (objfile *objfile : current_program_space->objfiles ())
+ {
+ for (compunit_symtab *s : objfile->compunits ())
+ {
+ QUIT;
+ b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), GLOBAL_BLOCK);
+ ALL_BLOCK_SYMBOLS (b, iter, sym)
+ {
+ if (completion_skip_symbol (mode, sym))
+ continue;
+
+ completion_list_add_name (tracker,
+ sym->language (),
+ sym->linkage_name (),
+ lookup_name, text, word);
+ }
+ }
+ }
+
+ for (objfile *objfile : current_program_space->objfiles ())
+ {
+ for (compunit_symtab *s : objfile->compunits ())
+ {
+ QUIT;
+ b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), STATIC_BLOCK);
+ /* Don't do this block twice. */
+ if (b == surrounding_static_block)
+ continue;
+ ALL_BLOCK_SYMBOLS (b, iter, sym)
+ {
+ if (completion_skip_symbol (mode, sym))
+ continue;
+
+ completion_list_add_name (tracker,
+ sym->language (),
+ sym->linkage_name (),
+ lookup_name, text, word);
+ }
+ }
+ }
+ }
+
+ /* See language.h. */
+
+ gdb::unique_xmalloc_ptr<char> watch_location_expression
+ (struct type *type, CORE_ADDR addr) const override
+ {
+ type = check_typedef (TYPE_TARGET_TYPE (check_typedef (type)));
+ std::string name = type_to_string (type);
+ return gdb::unique_xmalloc_ptr<char>
+ (xstrprintf ("{%s} %s", name.c_str (), core_addr_to_string (addr)));
+ }
+
+ /* See language.h. */
+
+ void value_print (struct value *val, struct ui_file *stream,
+ const struct value_print_options *options) const override
+ {
+ return ada_value_print (val, stream, options);
+ }
+
+ /* See language.h. */
+
+ void value_print_inner
+ (struct value *val, struct ui_file *stream, int recurse,
+ const struct value_print_options *options) const override
+ {
+ return ada_value_print_inner (val, stream, recurse, options);
+ }
+
+ /* See language.h. */
+
+ struct block_symbol lookup_symbol_nonlocal
+ (const char *name, const struct block *block,
+ const domain_enum domain) const override
+ {
+ struct block_symbol sym;
+
+ sym = ada_lookup_symbol (name, block_static_block (block), domain);
+ if (sym.symbol != NULL)
+ return sym;
+
+ /* If we haven't found a match at this point, try the primitive
+ types. In other languages, this search is performed before
+ searching for global symbols in order to short-circuit that
+ global-symbol search if it happens that the name corresponds
+ to a primitive type. But we cannot do the same in Ada, because
+ it is perfectly legitimate for a program to declare a type which
+ has the same name as a standard type. If looking up a type in
+ that situation, we have traditionally ignored the primitive type
+ in favor of user-defined types. This is why, unlike most other
+ languages, we search the primitive types this late and only after
+ having searched the global symbols without success. */
+
+ if (domain == VAR_DOMAIN)
+ {
+ struct gdbarch *gdbarch;
+
+ if (block == NULL)
+ gdbarch = target_gdbarch ();
+ else
+ gdbarch = block_gdbarch (block);
+ sym.symbol
+ = language_lookup_primitive_type_as_symbol (this, gdbarch, name);
+ if (sym.symbol != NULL)
+ return sym;
+ }
+
+ return {};
+ }
+
+ /* See language.h. */
+
+ int parser (struct parser_state *ps) const override
+ {
+ warnings_issued = 0;
+ return ada_parse (ps);
+ }
+
+ /* See language.h.
+
+ Same as evaluate_type (*EXP), but resolves ambiguous symbol references
+ (marked by OP_VAR_VALUE nodes in which the symbol has an undefined
+ namespace) and converts operators that are user-defined into
+ appropriate function calls. If CONTEXT_TYPE is non-null, it provides
+ a preferred result type [at the moment, only type void has any
+ effect---causing procedures to be preferred over functions in calls].
+ A null CONTEXT_TYPE indicates that a non-void return type is
+ preferred. May change (expand) *EXP. */
+
+ void post_parser (expression_up *expp, int void_context_p, int completing,
+ innermost_block_tracker *tracker) const override
+ {
+ struct type *context_type = NULL;
+ int pc = 0;
+
+ if (void_context_p)
+ context_type = builtin_type ((*expp)->gdbarch)->builtin_void;
+
+ resolve_subexp (expp, &pc, 1, context_type, completing, tracker);
+ }
+
+ /* See language.h. */
+
+ void emitchar (int ch, struct type *chtype,
+ struct ui_file *stream, int quoter) const override
+ {
+ ada_emit_char (ch, chtype, stream, quoter, 1);
+ }
+
+ /* See language.h. */
+
+ void printchar (int ch, struct type *chtype,
+ struct ui_file *stream) const override
+ {
+ ada_printchar (ch, chtype, stream);
+ }
+
+ /* See language.h. */
+
+ void printstr (struct ui_file *stream, struct type *elttype,
+ const gdb_byte *string, unsigned int length,
+ const char *encoding, int force_ellipses,
+ const struct value_print_options *options) const override
+ {
+ ada_printstr (stream, elttype, string, length, encoding,
+ force_ellipses, options);
+ }
+
+ /* See language.h. */
+
+ void print_typedef (struct type *type, struct symbol *new_symbol,
+ struct ui_file *stream) const override
+ {
+ ada_print_typedef (type, new_symbol, stream);
+ }
+
+ /* See language.h. */
+
+ bool is_string_type_p (struct type *type) const override
+ {
+ return ada_is_string_type (type);
+ }
+
+
+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;