static int is_nonfunction (struct block_symbol *, int);
static void add_defn_to_vec (struct obstack *, struct symbol *,
- const struct block *);
+ const struct block *);
static int num_defns_collected (struct obstack *);
static struct block_symbol *defns_collected (struct obstack *, int);
static struct value *resolve_subexp (expression_up *, int *, int,
- struct type *, int,
+ struct type *, int,
innermost_block_tracker *);
static void replace_operator_with_call (expression_up *, int, int, int,
- struct symbol *, const struct block *);
+ struct symbol *, const struct block *);
static int possible_user_operator_p (enum exp_opcode, struct value **);
static int discrete_type_p (struct type *);
static struct type *ada_lookup_struct_elt_type (struct type *, const char *,
- int, int);
+ int, int);
static struct value *evaluate_subexp_type (struct expression *, int *);
static struct type *ada_find_parallel_type_with_name (struct type *,
- const char *);
+ const char *);
static int is_dynamic_field (struct type *, int);
static struct type *to_fixed_variant_branch_type (struct type *,
const gdb_byte *,
- CORE_ADDR, struct value *);
+ CORE_ADDR, struct value *);
static struct type *to_fixed_array_type (struct type *, struct value *, int);
static struct value *decode_constrained_packed_array (struct value *);
-static int ada_is_packed_array_type (struct type *);
-
static int ada_is_unconstrained_packed_array_type (struct type *);
static struct value *value_subscript_packed (struct value *, int,
- struct value **);
+ struct value **);
static struct value *coerce_unspec_val_to_type (struct value *,
- struct type *);
+ struct type *);
static int lesseq_defined_than (struct symbol *, struct symbol *);
static int is_name_suffix (const char *);
-static int advance_wild_match (const char **, const char *, int);
+static int advance_wild_match (const char **, const char *, char);
static bool wild_match (const char *name, const char *patn);
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 *,
- domain_enum);
+ domain_enum);
static struct value *ada_search_struct_field (const char *, struct value *, int,
- struct type *);
+ struct type *);
static int find_struct_field (const char *, struct type *, int,
- struct type **, int *, int *, int *, int *);
+ struct type **, int *, int *, int *, int *);
static int ada_resolve_function (struct block_symbol *, int,
- struct value **, int, const char *,
- struct type *, int);
+ struct value **, int, const char *,
+ struct type *, int);
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 *);
expression evaluation. */
static int warnings_issued = 0;
-static const char *known_runtime_file_name_patterns[] = {
+static const char * const known_runtime_file_name_patterns[] = {
ADA_KNOWN_RUNTIME_FILE_NAME_PATTERNS NULL
};
-static const char *known_auxiliary_function_name_patterns[] = {
+static const char * const known_auxiliary_function_name_patterns[] = {
ADA_KNOWN_AUXILIARY_FUNCTION_NAME_PATTERNS NULL
};
return data;
}
- /* Utilities */
+ /* Utilities */
/* If TYPE is a TYPE_CODE_TYPEDEF type, return the target type after
all typedef layers have been peeled. Otherwise, return 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. */
{
*size *= 2;
if (*size < min_size)
- *size = min_size;
+ *size = min_size;
vect = xrealloc (vect, *size * element_size);
}
return vect;
return
(strncmp (field_name, target, len) == 0
&& (field_name[len] == '\0'
- || (startswith (field_name + len, "___")
- && strcmp (field_name + strlen (field_name) - 6,
- "___XVN") != 0)));
+ || (startswith (field_name + len, "___")
+ && strcmp (field_name + strlen (field_name) - 6,
+ "___XVN") != 0)));
}
int
ada_get_field_index (const struct type *type, const char *field_name,
- int maybe_missing)
+ int maybe_missing)
{
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, struct_type->name ());
+ field_name, struct_type->name ());
return -1;
}
const char *p = strstr (name, "___");
if (p == NULL)
- return strlen (name);
+ return strlen (name);
else
- return p - name;
+ return p - name;
}
}
struct value *result;
/* Make sure that the object size is not unreasonable before
- trying to allocate some memory for it. */
+ trying to allocate some memory for it. */
ada_ensure_varsize_limit (type);
if (value_lazy (val)
- || TYPE_LENGTH (type) > TYPE_LENGTH (value_type (val)))
+ || TYPE_LENGTH (type) > TYPE_LENGTH (value_type (val)))
result = allocate_value_lazy (type);
else
{
static LONGEST
max_of_type (struct type *t)
{
- if (TYPE_UNSIGNED (t))
+ if (t->is_unsigned ())
return (LONGEST) umax_of_size (TYPE_LENGTH (t));
else
return max_of_size (TYPE_LENGTH (t));
static LONGEST
min_of_type (struct type *t)
{
- if (TYPE_UNSIGNED (t))
+ if (t->is_unsigned ())
return 0;
else
return min_of_size (TYPE_LENGTH (t));
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:
while (type != NULL && type->code () == TYPE_CODE_RANGE)
{
if (type == TYPE_TARGET_TYPE (type) || TYPE_TARGET_TYPE (type) == NULL)
- return type;
+ return type;
type = TYPE_TARGET_TYPE (type);
}
return type;
if (ada_is_array_descriptor_type (type)
|| (ada_is_constrained_packed_array_type (type)
- && type->code () != TYPE_CODE_PTR))
+ && type->code () != TYPE_CODE_PTR))
{
if (type->code () == TYPE_CODE_TYPEDEF) /* array access type. */
- value = ada_coerce_to_simple_array_ptr (value);
+ value = ada_coerce_to_simple_array_ptr (value);
else
- value = ada_coerce_to_simple_array (value);
+ value = ada_coerce_to_simple_array (value);
}
else
value = ada_to_fixed_value (value);
\f
- /* Language Selection */
+ /* Language Selection */
/* If the main program is in Ada, return language_ada, otherwise return LANG
(the main program is in Ada iif the adainit symbol is found). */
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."));
+ 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 NULL;
}
\f
- /* Symbols */
+ /* Symbols */
/* Table of Ada operators and their GNAT-encoded names. Last entry is pair
of NULLs. */
{NULL, NULL}
};
-/* The "encoded" form of DECODED, according to GNAT conventions. The
- result is valid until the next call to ada_encode. If
+/* The "encoded" form of DECODED, according to GNAT conventions. If
THROW_ERRORS, throw an error if invalid operator name is found.
- Otherwise, return NULL in that case. */
+ Otherwise, return the empty string in that case. */
-static char *
+static std::string
ada_encode_1 (const char *decoded, bool throw_errors)
{
- static char *encoding_buffer = NULL;
- static size_t encoding_buffer_size = 0;
- const char *p;
- int k;
-
if (decoded == NULL)
- return NULL;
-
- GROW_VECT (encoding_buffer, encoding_buffer_size,
- 2 * strlen (decoded) + 10);
+ return {};
- k = 0;
- for (p = decoded; *p != '\0'; p += 1)
+ std::string encoding_buffer;
+ for (const char *p = decoded; *p != '\0'; p += 1)
{
if (*p == '.')
- {
- encoding_buffer[k] = encoding_buffer[k + 1] = '_';
- k += 2;
- }
+ encoding_buffer.append ("__");
else if (*p == '"')
- {
- const struct ada_opname_map *mapping;
-
- for (mapping = ada_opname_table;
- mapping->encoded != NULL
- && !startswith (p, mapping->decoded); mapping += 1)
- ;
- if (mapping->encoded == NULL)
+ {
+ const struct ada_opname_map *mapping;
+
+ for (mapping = ada_opname_table;
+ mapping->encoded != NULL
+ && !startswith (p, mapping->decoded); mapping += 1)
+ ;
+ if (mapping->encoded == NULL)
{
if (throw_errors)
error (_("invalid Ada operator name: %s"), p);
else
- return NULL;
+ return {};
}
- strcpy (encoding_buffer + k, mapping->encoded);
- k += strlen (mapping->encoded);
- break;
- }
+ encoding_buffer.append (mapping->encoded);
+ break;
+ }
else
- {
- encoding_buffer[k] = *p;
- k += 1;
- }
+ encoding_buffer.push_back (*p);
}
- encoding_buffer[k] = '\0';
return encoding_buffer;
}
-/* The "encoded" form of DECODED, according to GNAT conventions.
- The result is valid until the next call to ada_encode. */
+/* The "encoded" form of DECODED, according to GNAT conventions. */
-char *
+std::string
ada_encode (const char *decoded)
{
return ada_encode_1 (decoded, true);
int i;
for (i = 0; i <= len; i += 1)
- fold_buffer[i] = tolower (name[i]);
+ fold_buffer[i] = tolower (name[i]);
}
return fold_buffer;
int i = *len - 2;
while (i > 0 && isdigit (encoded[i]))
- i--;
+ i--;
if (i >= 0 && encoded[i] == '.')
- *len = i;
+ *len = i;
else if (i >= 0 && encoded[i] == '$')
- *len = i;
+ *len = i;
else if (i >= 2 && startswith (encoded + i - 2, "___"))
- *len = i - 2;
+ *len = i - 2;
else if (i >= 1 && startswith (encoded + i - 1, "__"))
- *len = i - 1;
+ *len = i - 1;
}
}
if (p != NULL && p - encoded < len0 - 3)
{
if (p[3] == 'X')
- len0 = p - encoded;
+ len0 = p - encoded;
else
- goto Suppress;
+ goto Suppress;
}
/* Remove any trailing TKB suffix. It tells us that this symbol
{
i = len0 - 2;
while ((i >= 0 && isdigit (encoded[i]))
- || (i >= 1 && encoded[i] == '_' && isdigit (encoded[i - 1])))
- i -= 1;
+ || (i >= 1 && encoded[i] == '_' && isdigit (encoded[i - 1])))
+ i -= 1;
if (i > 1 && encoded[i] == '_' && encoded[i - 1] == '_')
- len0 = i - 1;
+ len0 = i - 1;
else if (encoded[i] == '$')
- len0 = i;
+ len0 = i;
}
/* The first few characters that are not alphabetic are not part
{
/* Is this a symbol function? */
if (at_start_name && encoded[i] == 'O')
- {
- int k;
-
- for (k = 0; ada_opname_table[k].encoded != NULL; k += 1)
- {
- int op_len = strlen (ada_opname_table[k].encoded);
- if ((strncmp (ada_opname_table[k].encoded + 1, encoded + i + 1,
- op_len - 1) == 0)
- && !isalnum (encoded[i + op_len]))
- {
- strcpy (&decoded.front() + j, ada_opname_table[k].decoded);
- at_start_name = 0;
- i += op_len;
- j += strlen (ada_opname_table[k].decoded);
- break;
- }
- }
- if (ada_opname_table[k].encoded != NULL)
- continue;
- }
+ {
+ int k;
+
+ for (k = 0; ada_opname_table[k].encoded != NULL; k += 1)
+ {
+ int op_len = strlen (ada_opname_table[k].encoded);
+ if ((strncmp (ada_opname_table[k].encoded + 1, encoded + i + 1,
+ op_len - 1) == 0)
+ && !isalnum (encoded[i + op_len]))
+ {
+ strcpy (&decoded.front() + j, ada_opname_table[k].decoded);
+ at_start_name = 0;
+ i += op_len;
+ j += strlen (ada_opname_table[k].decoded);
+ break;
+ }
+ }
+ if (ada_opname_table[k].encoded != NULL)
+ continue;
+ }
at_start_name = 0;
/* Replace "TK__" with "__", which will eventually be translated
- into "." (just below). */
+ into "." (just below). */
if (i < len0 - 4 && startswith (encoded + i, "TK__"))
- i += 2;
+ i += 2;
/* Replace "__B_{DIGITS}+__" sequences by "__", which will eventually
- be translated into "." (just below). These are internal names
- generated for anonymous blocks inside which our symbol is nested. */
+ be translated into "." (just below). These are internal names
+ generated for anonymous blocks inside which our symbol is nested. */
if (len0 - i > 5 && encoded [i] == '_' && encoded [i+1] == '_'
- && encoded [i+2] == 'B' && encoded [i+3] == '_'
- && isdigit (encoded [i+4]))
- {
- int k = i + 5;
-
- while (k < len0 && isdigit (encoded[k]))
- k++; /* Skip any extra digit. */
-
- /* Double-check that the "__B_{DIGITS}+" sequence we found
- is indeed followed by "__". */
- if (len0 - k > 2 && encoded [k] == '_' && encoded [k+1] == '_')
- i = k;
- }
+ && encoded [i+2] == 'B' && encoded [i+3] == '_'
+ && isdigit (encoded [i+4]))
+ {
+ int k = i + 5;
+
+ while (k < len0 && isdigit (encoded[k]))
+ k++; /* Skip any extra digit. */
+
+ /* Double-check that the "__B_{DIGITS}+" sequence we found
+ is indeed followed by "__". */
+ if (len0 - k > 2 && encoded [k] == '_' && encoded [k+1] == '_')
+ i = k;
+ }
/* Remove _E{DIGITS}+[sb] */
/* Just as for protected object subprograms, there are 2 categories
- of subprograms created by the compiler for each entry. The first
- one implements the actual entry code, and has a suffix following
- the convention above; the second one implements the barrier and
- uses the same convention as above, except that the 'E' is replaced
- by a 'B'.
+ of subprograms created by the compiler for each entry. The first
+ one implements the actual entry code, and has a suffix following
+ the convention above; the second one implements the barrier and
+ uses the same convention as above, except that the 'E' is replaced
+ by a 'B'.
- Just as above, we do not decode the name of barrier functions
- to give the user a clue that the code he is debugging has been
- internally generated. */
+ Just as above, we do not decode the name of barrier functions
+ to give the user a clue that the code he is debugging has been
+ internally generated. */
if (len0 - i > 3 && encoded [i] == '_' && encoded[i+1] == 'E'
- && isdigit (encoded[i+2]))
- {
- int k = i + 3;
-
- while (k < len0 && isdigit (encoded[k]))
- k++;
-
- if (k < len0
- && (encoded[k] == 'b' || encoded[k] == 's'))
- {
- k++;
- /* Just as an extra precaution, make sure that if this
- suffix is followed by anything else, it is a '_'.
- Otherwise, we matched this sequence by accident. */
- if (k == len0
- || (k < len0 && encoded[k] == '_'))
- i = k;
- }
- }
+ && isdigit (encoded[i+2]))
+ {
+ int k = i + 3;
+
+ while (k < len0 && isdigit (encoded[k]))
+ k++;
+
+ if (k < len0
+ && (encoded[k] == 'b' || encoded[k] == 's'))
+ {
+ k++;
+ /* Just as an extra precaution, make sure that if this
+ suffix is followed by anything else, it is a '_'.
+ Otherwise, we matched this sequence by accident. */
+ if (k == len0
+ || (k < len0 && encoded[k] == '_'))
+ i = k;
+ }
+ }
/* Remove trailing "N" in [a-z0-9]+N__. The N is added by
- the GNAT front-end in protected object subprograms. */
+ the GNAT front-end in protected object subprograms. */
if (i < len0 + 3
- && encoded[i] == 'N' && encoded[i+1] == '_' && encoded[i+2] == '_')
- {
- /* Backtrack a bit up until we reach either the begining of
- the encoded name, or "__". Make sure that we only find
- digits or lowercase characters. */
- const char *ptr = encoded + i - 1;
-
- while (ptr >= encoded && is_lower_alphanum (ptr[0]))
- ptr--;
- if (ptr < encoded
- || (ptr > encoded && ptr[0] == '_' && ptr[-1] == '_'))
- i++;
- }
+ && encoded[i] == 'N' && encoded[i+1] == '_' && encoded[i+2] == '_')
+ {
+ /* Backtrack a bit up until we reach either the begining of
+ the encoded name, or "__". Make sure that we only find
+ digits or lowercase characters. */
+ const char *ptr = encoded + i - 1;
+
+ while (ptr >= encoded && is_lower_alphanum (ptr[0]))
+ ptr--;
+ if (ptr < encoded
+ || (ptr > encoded && ptr[0] == '_' && ptr[-1] == '_'))
+ i++;
+ }
if (encoded[i] == 'X' && i != 0 && isalnum (encoded[i - 1]))
- {
- /* This is a X[bn]* sequence not separated from the previous
- part of the name with a non-alpha-numeric character (in other
- words, immediately following an alpha-numeric character), then
- verify that it is placed at the end of the encoded name. If
- not, then the encoding is not valid and we should abort the
- decoding. Otherwise, just skip it, it is used in body-nested
- package names. */
- do
- i += 1;
- while (i < len0 && (encoded[i] == 'b' || encoded[i] == 'n'));
- if (i < len0)
- goto Suppress;
- }
+ {
+ /* This is a X[bn]* sequence not separated from the previous
+ part of the name with a non-alpha-numeric character (in other
+ words, immediately following an alpha-numeric character), then
+ verify that it is placed at the end of the encoded name. If
+ not, then the encoding is not valid and we should abort the
+ decoding. Otherwise, just skip it, it is used in body-nested
+ package names. */
+ do
+ i += 1;
+ while (i < len0 && (encoded[i] == 'b' || encoded[i] == 'n'));
+ if (i < len0)
+ goto Suppress;
+ }
else if (i < len0 - 2 && encoded[i] == '_' && encoded[i + 1] == '_')
- {
- /* Replace '__' by '.'. */
- decoded[j] = '.';
- at_start_name = 1;
- i += 2;
- j += 1;
- }
+ {
+ /* Replace '__' by '.'. */
+ decoded[j] = '.';
+ at_start_name = 1;
+ i += 2;
+ j += 1;
+ }
else
- {
- /* It's a character part of the decoded name, so just copy it
- over. */
- decoded[j] = encoded[i];
- i += 1;
- j += 1;
- }
+ {
+ /* It's a character part of the decoded name, so just copy it
+ over. */
+ decoded[j] = encoded[i];
+ i += 1;
+ j += 1;
+ }
}
decoded.resize (j);
if (obstack != NULL)
*resultp = obstack_strdup (obstack, decoded.c_str ());
else
- {
+ {
/* Sometimes, we can't find a corresponding objfile, in
which case, we put the result on the heap. Since we only
decode when needed, we hope this usually does not cause a
significant memory leak (FIXME). */
- char **slot = (char **) htab_find_slot (decoded_names_store,
- decoded.c_str (), INSERT);
+ char **slot = (char **) htab_find_slot (decoded_names_store,
+ decoded.c_str (), INSERT);
- if (*slot == NULL)
- *slot = xstrdup (decoded.c_str ());
- *resultp = *slot;
- }
+ if (*slot == NULL)
+ *slot = xstrdup (decoded.c_str ());
+ *resultp = *slot;
+ }
}
return *resultp;
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 */
+ /* Arrays */
/* Assuming that INDEX_DESC_TYPE is an ___XA structure, a structure
generated by the GNAT compiler to describe the index type used
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_FIELD_TYPE (index_desc_type, 0)->name () != NULL
- && strcmp (TYPE_FIELD_TYPE (index_desc_type, 0)->name (),
- TYPE_FIELD_NAME (index_desc_type, 0)) == 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);
}
}
if (type != NULL
&& (type->code () == TYPE_CODE_PTR
- || type->code () == TYPE_CODE_REF))
+ || type->code () == TYPE_CODE_REF))
return ada_check_typedef (TYPE_TARGET_TYPE (type));
else
return type;
struct type *alt_type = ada_find_parallel_type (base_type, "___XVE");
if (alt_type == NULL)
- return base_type;
+ return base_type;
else
- return alt_type;
+ return alt_type;
}
}
{
type = desc_base_type (type);
return (type != NULL && type->code () == TYPE_CODE_STRUCT
- && lookup_struct_elt_type (type, "P_BOUNDS", 1) != NULL);
+ && lookup_struct_elt_type (type, "P_BOUNDS", 1) != NULL);
}
/* If TYPE is the type of an array descriptor (fat or thin pointer) or a
{
type = thin_descriptor_type (type);
if (type == NULL)
- return NULL;
+ return NULL;
r = lookup_struct_elt_type (type, "BOUNDS", 1);
if (r != NULL)
- return ada_check_typedef (r);
+ return ada_check_typedef (r);
}
else if (type->code () == TYPE_CODE_STRUCT)
{
r = lookup_struct_elt_type (type, "P_BOUNDS", 1);
if (r != NULL)
- return ada_check_typedef (TYPE_TARGET_TYPE (ada_check_typedef (r)));
+ return ada_check_typedef (TYPE_TARGET_TYPE (ada_check_typedef (r)));
}
return NULL;
}
if (is_thin_pntr (type))
{
struct type *bounds_type =
- desc_bounds_type (thin_descriptor_type (type));
+ desc_bounds_type (thin_descriptor_type (type));
LONGEST addr;
if (bounds_type == NULL)
- error (_("Bad GNAT array descriptor"));
+ error (_("Bad GNAT array descriptor"));
/* NOTE: The following calculation is not really kosher, but
- since desc_type is an XVE-encoded type (and shouldn't be),
- the correct calculation is a real pain. FIXME (and fix GCC). */
+ since desc_type is an XVE-encoded type (and shouldn't be),
+ the correct calculation is a real pain. FIXME (and fix GCC). */
if (type->code () == TYPE_CODE_PTR)
- addr = value_as_long (arr);
+ addr = value_as_long (arr);
else
- addr = value_address (arr);
+ addr = value_address (arr);
return
- value_from_longest (lookup_pointer_type (bounds_type),
- addr - TYPE_LENGTH (bounds_type));
+ value_from_longest (lookup_pointer_type (bounds_type),
+ addr - TYPE_LENGTH (bounds_type));
}
else if (is_thick_pntr (type))
{
struct type *target_type = TYPE_TARGET_TYPE (p_bounds_type);
- if (TYPE_STUB (target_type))
+ if (target_type->is_stub ())
p_bounds = value_cast (lookup_pointer_type
(ada_check_typedef (target_type)),
p_bounds);
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);
return thin_data_pntr (arr);
else if (is_thick_pntr (type))
return value_struct_elt (&arr, NULL, "P_ARRAY", NULL,
- _("Bad GNAT array descriptor"));
+ _("Bad GNAT array descriptor"));
else
return NULL;
}
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
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"));
+ _("Bad GNAT array descriptor bounds"));
}
/* If BOUNDS is an array-bounds structure type, return the bit position
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 != NULL)
- return TYPE_NFIELDS (type) / 2;
+ return type->num_fields () / 2;
return 0;
}
return 0;
type = ada_check_typedef (type);
return (type->code () == TYPE_CODE_ARRAY
- || ada_is_array_descriptor_type (type));
+ || ada_is_array_descriptor_type (type));
}
/* Non-zero iff TYPE represents any kind of array in Ada, or a pointer
type != NULL
&& type->code () == TYPE_CODE_STRUCT
&& (lookup_struct_elt_type (type, "P_BOUNDS", 1) != NULL
- || lookup_struct_elt_type (type, "P_ARRAY", 1) != NULL)
+ || lookup_struct_elt_type (type, "P_ARRAY", 1) != NULL)
&& !ada_is_array_descriptor_type (type);
}
arity = ada_array_arity (value_type (arr));
if (elt_type == NULL || arity == 0)
- return ada_check_typedef (value_type (arr));
+ return ada_check_typedef (value_type (arr));
descriptor = desc_bounds (arr);
if (value_as_long (descriptor) == 0)
- return NULL;
+ return NULL;
while (arity > 0)
- {
- struct type *range_type = alloc_type_copy (value_type (arr));
- struct type *array_type = alloc_type_copy (value_type (arr));
- struct value *low = desc_one_bound (descriptor, arity, 0);
- struct value *high = desc_one_bound (descriptor, arity, 1);
-
- arity -= 1;
- create_static_range_type (range_type, value_type (low),
+ {
+ struct type *range_type = alloc_type_copy (value_type (arr));
+ struct type *array_type = alloc_type_copy (value_type (arr));
+ struct value *low = desc_one_bound (descriptor, arity, 0);
+ struct value *high = desc_one_bound (descriptor, arity, 1);
+
+ arity -= 1;
+ create_static_range_type (range_type, value_type (low),
longest_to_int (value_as_long (low)),
longest_to_int (value_as_long (high)));
- elt_type = create_array_type (array_type, elt_type, range_type);
+ elt_type = create_array_type (array_type, elt_type, range_type);
if (ada_is_unconstrained_packed_array_type (value_type (arr)))
{
/* We need to store the element packed bitsize, as well as
- recompute the array size, because it was previously
+ recompute the array size, because it was previously
computed based on the unpacked element size. */
LONGEST lo = value_as_long (low);
LONGEST hi = value_as_long (high);
TYPE_FIELD_BITSIZE (elt_type, 0) =
decode_packed_array_bitsize (value_type (arr));
/* If the array has no element, then the size is already
- zero, and does not need to be recomputed. */
+ zero, and does not need to be recomputed. */
if (lo < hi)
{
int array_bitsize =
- (hi - lo + 1) * TYPE_FIELD_BITSIZE (elt_type, 0);
+ (hi - lo + 1) * TYPE_FIELD_BITSIZE (elt_type, 0);
TYPE_LENGTH (array_type) = (array_bitsize + 7) / 8;
}
}
- }
+ }
return lookup_pointer_type (elt_type);
}
struct type *arrType = ada_type_of_array (arr, 1);
if (arrType == NULL)
- return NULL;
+ return NULL;
return value_cast (arrType, value_copy (desc_data (arr)));
}
else if (ada_is_constrained_packed_array_type (value_type (arr)))
struct value *arrVal = ada_coerce_to_simple_array_ptr (arr);
if (arrVal == NULL)
- error (_("Bounds unavailable for null array pointer."));
+ error (_("Bounds unavailable for null array pointer."));
ada_ensure_varsize_limit (TYPE_TARGET_TYPE (value_type (arrVal)));
return value_ind (arrVal);
}
/* Non-zero iff TYPE represents a standard GNAT packed-array type. */
static int
-ada_is_packed_array_type (struct type *type)
+ada_is_gnat_encoded_packed_array_type (struct type *type)
{
if (type == NULL)
return 0;
int
ada_is_constrained_packed_array_type (struct type *type)
{
- return ada_is_packed_array_type (type)
+ return ada_is_gnat_encoded_packed_array_type (type)
&& !ada_is_array_descriptor_type (type);
}
static int
ada_is_unconstrained_packed_array_type (struct type *type)
{
- return ada_is_packed_array_type (type)
- && ada_is_array_descriptor_type (type);
+ if (!ada_is_array_descriptor_type (type))
+ return 0;
+
+ if (ada_is_gnat_encoded_packed_array_type (type))
+ return 1;
+
+ /* If we saw GNAT encodings, then the above code is sufficient.
+ However, with minimal encodings, we will just have a thick
+ pointer instead. */
+ if (is_thick_pntr (type))
+ {
+ type = desc_base_type (type);
+ /* The structure's first field is a pointer to an array, so this
+ fetches the array type. */
+ type = TYPE_TARGET_TYPE (type->field (0).type ());
+ /* Now we can see if the array elements are packed. */
+ return TYPE_FIELD_BITSIZE (type, 0) > 0;
+ }
+
+ return 0;
+}
+
+/* Return true if TYPE is a (Gnat-encoded) constrained packed array
+ type, or if it is an ordinary (non-Gnat-encoded) packed array. */
+
+static bool
+ada_is_any_packed_array_type (struct type *type)
+{
+ return (ada_is_constrained_packed_array_type (type)
+ || (type->code () == TYPE_CODE_ARRAY
+ && TYPE_FIELD_BITSIZE (type, 0) % 8 != 0));
}
/* Given that TYPE encodes a packed array type (constrained or unconstrained),
return 0;
tail = strstr (raw_name, "___XP");
- gdb_assert (tail != NULL);
+ if (tail == nullptr)
+ {
+ gdb_assert (is_thick_pntr (type));
+ /* The structure's first field is a pointer to an array, so this
+ fetches the array type. */
+ type = TYPE_TARGET_TYPE (type->field (0).type ());
+ /* Now we can see if the array elements are packed. */
+ return TYPE_FIELD_BITSIZE (type, 0);
+ }
if (sscanf (tail + sizeof ("___XP") - 1, "%ld", &bits) != 1)
{
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 *= (high_bound - low_bound + 1);
TYPE_LENGTH (new_type) =
- (*elt_bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT;
+ (*elt_bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT;
}
- TYPE_FIXED_INSTANCE (new_type) = 1;
+ new_type->set_is_fixed_instance (true);
return new_type;
}
return constrained_packed_array_type (shadow_type, &bits);
}
+/* Helper function for decode_constrained_packed_array. Set the field
+ bitsize on a series of packed arrays. Returns the number of
+ elements in TYPE. */
+
+static LONGEST
+recursively_update_array_bitsize (struct type *type)
+{
+ gdb_assert (type->code () == TYPE_CODE_ARRAY);
+
+ LONGEST low, high;
+ if (get_discrete_bounds (type->index_type (), &low, &high) < 0
+ || low > high)
+ return 0;
+ LONGEST our_len = high - low + 1;
+
+ struct type *elt_type = TYPE_TARGET_TYPE (type);
+ if (elt_type->code () == TYPE_CODE_ARRAY)
+ {
+ LONGEST elt_len = recursively_update_array_bitsize (elt_type);
+ LONGEST elt_bitsize = elt_len * TYPE_FIELD_BITSIZE (elt_type, 0);
+ TYPE_FIELD_BITSIZE (type, 0) = elt_bitsize;
+
+ TYPE_LENGTH (type) = ((our_len * elt_bitsize + HOST_CHAR_BIT - 1)
+ / HOST_CHAR_BIT);
+ }
+
+ return our_len;
+}
+
/* Given that ARR is a struct value *indicating a GNAT constrained packed
array, returns a simple array that denotes that array. Its type is a
standard GDB array type except that the BITSIZEs of the array
return NULL;
}
+ /* Decoding the packed array type could not correctly set the field
+ bitsizes for any dimension except the innermost, because the
+ bounds may be variable and were not passed to that function. So,
+ we further resolve the array bounds here and then update the
+ sizes. */
+ const gdb_byte *valaddr = value_contents_for_printing (arr);
+ CORE_ADDR address = value_address (arr);
+ gdb::array_view<const gdb_byte> view
+ = gdb::make_array_view (valaddr, TYPE_LENGTH (type));
+ type = resolve_dynamic_type (type, view, address);
+ recursively_update_array_bitsize (type);
+
if (type_byte_order (value_type (arr)) == BFD_ENDIAN_BIG
&& ada_is_modular_type (value_type (arr)))
{
for (i = 0; i < arity; i += 1)
{
if (elt_type->code () != TYPE_CODE_ARRAY
- || TYPE_FIELD_BITSIZE (elt_type, 0) == 0)
- error
- (_("attempt to do packed indexing of "
+ || TYPE_FIELD_BITSIZE (elt_type, 0) == 0)
+ error
+ (_("attempt to do packed indexing of "
"something other than a packed array"));
else
- {
- struct type *range_type = TYPE_INDEX_TYPE (elt_type);
- LONGEST lowerbound, upperbound;
- LONGEST idx;
-
- if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
- {
- lim_warning (_("don't know bounds of array"));
- lowerbound = upperbound = 0;
- }
-
- idx = pos_atr (ind[i]);
- if (idx < lowerbound || idx > upperbound)
- lim_warning (_("packed array index %ld out of bounds"),
+ {
+ struct type *range_type = elt_type->index_type ();
+ LONGEST lowerbound, upperbound;
+ LONGEST idx;
+
+ if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
+ {
+ lim_warning (_("don't know bounds of array"));
+ lowerbound = upperbound = 0;
+ }
+
+ idx = pos_atr (ind[i]);
+ if (idx < lowerbound || idx > upperbound)
+ lim_warning (_("packed array index %ld out of bounds"),
(long) idx);
- bits = TYPE_FIELD_BITSIZE (elt_type, 0);
- elt_total_bit_offset += (idx - lowerbound) * bits;
- elt_type = ada_check_typedef (TYPE_TARGET_TYPE (elt_type));
- }
+ bits = TYPE_FIELD_BITSIZE (elt_type, 0);
+ elt_total_bit_offset += (idx - lowerbound) * bits;
+ elt_type = ada_check_typedef (TYPE_TARGET_TYPE (elt_type));
+ }
}
elt_off = elt_total_bit_offset / HOST_CHAR_BIT;
bit_off = elt_total_bit_offset % HOST_CHAR_BIT;
v = ada_value_primitive_packed_val (arr, NULL, elt_off, bit_off,
- bits, elt_type);
+ bits, elt_type);
return v;
}
default:
return 0;
case TYPE_CODE_INT:
- return !TYPE_UNSIGNED (type);
+ return !type->is_unsigned ();
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;
}
}
int src_bytes_left; /* Number of source bytes left to process. */
int srcBitsLeft; /* Number of source bits left to move */
int unusedLS; /* Number of bits in next significant
- byte of source that are unused */
+ byte of source that are unused */
int unpacked_idx; /* Index into the unpacked buffer */
int unpacked_bytes_left; /* Number of bytes left to set in unpacked. */
src_idx = src_len - 1;
if (is_signed_type
&& ((src[0] << bit_offset) & (1 << (HOST_CHAR_BIT - 1))))
- sign = ~0;
+ sign = ~0;
unusedLS =
- (HOST_CHAR_BIT - (bit_size + bit_offset) % HOST_CHAR_BIT)
- % HOST_CHAR_BIT;
+ (HOST_CHAR_BIT - (bit_size + bit_offset) % HOST_CHAR_BIT)
+ % HOST_CHAR_BIT;
if (is_scalar)
{
- accumSize = 0;
- unpacked_idx = unpacked_len - 1;
+ accumSize = 0;
+ unpacked_idx = unpacked_len - 1;
}
else
{
- /* Non-scalar values must be aligned at a byte boundary... */
- accumSize =
- (HOST_CHAR_BIT - bit_size % HOST_CHAR_BIT) % HOST_CHAR_BIT;
- /* ... And are placed at the beginning (most-significant) bytes
- of the target. */
- unpacked_idx = (bit_size + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT - 1;
- unpacked_bytes_left = unpacked_idx + 1;
+ /* Non-scalar values must be aligned at a byte boundary... */
+ accumSize =
+ (HOST_CHAR_BIT - bit_size % HOST_CHAR_BIT) % HOST_CHAR_BIT;
+ /* ... And are placed at the beginning (most-significant) bytes
+ of the target. */
+ unpacked_idx = (bit_size + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT - 1;
+ unpacked_bytes_left = unpacked_idx + 1;
}
}
else
accumSize = 0;
if (is_signed_type && (src[src_len - 1] & (1 << sign_bit_offset)))
- sign = ~0;
+ sign = ~0;
}
accum = 0;
while (src_bytes_left > 0)
{
/* Mask for removing bits of the next source byte that are not
- part of the value. */
+ part of the value. */
unsigned int unusedMSMask =
- (1 << (srcBitsLeft >= HOST_CHAR_BIT ? HOST_CHAR_BIT : srcBitsLeft)) -
- 1;
+ (1 << (srcBitsLeft >= HOST_CHAR_BIT ? HOST_CHAR_BIT : srcBitsLeft)) -
+ 1;
/* Sign-extend bits for this byte. */
unsigned int signMask = sign & ~unusedMSMask;
accum |=
- (((src[src_idx] >> unusedLS) & unusedMSMask) | signMask) << accumSize;
+ (((src[src_idx] >> unusedLS) & unusedMSMask) | signMask) << accumSize;
accumSize += HOST_CHAR_BIT - unusedLS;
if (accumSize >= HOST_CHAR_BIT)
- {
- unpacked[unpacked_idx] = accum & ~(~0UL << HOST_CHAR_BIT);
- accumSize -= HOST_CHAR_BIT;
- accum >>= HOST_CHAR_BIT;
- unpacked_bytes_left -= 1;
- unpacked_idx += delta;
- }
+ {
+ unpacked[unpacked_idx] = accum & ~(~0UL << HOST_CHAR_BIT);
+ accumSize -= HOST_CHAR_BIT;
+ accum >>= HOST_CHAR_BIT;
+ unpacked_bytes_left -= 1;
+ unpacked_idx += delta;
+ }
srcBitsLeft -= HOST_CHAR_BIT - unusedLS;
unusedLS = 0;
src_bytes_left -= 1;
struct value *
ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
long offset, int bit_offset, int bit_size,
- struct type *type)
+ struct type *type)
{
struct value *v;
const gdb_byte *src; /* First byte containing data to unpack */
staging.resize (staging_len);
ada_unpack_from_contents (src, bit_offset, bit_size,
- staging.data (), staging.size (),
+ staging.data (), staging.size (),
is_big_endian, has_negatives (type),
is_scalar);
type = resolve_dynamic_type (type, staging, 0);
set_value_bitpos (v, bit_offset + value_bitpos (obj));
set_value_bitsize (v, bit_size);
if (value_bitpos (v) >= HOST_CHAR_BIT)
- {
+ {
++new_offset;
- set_value_bitpos (v, value_bitpos (v) - HOST_CHAR_BIT);
- }
+ set_value_bitpos (v, value_bitpos (v) - HOST_CHAR_BIT);
+ }
set_value_offset (v, new_offset);
/* Also set the parent value. This is needed when trying to
if (VALUE_LVAL (toval) == lval_memory
&& bits > 0
&& (type->code () == TYPE_CODE_FLT
- || type->code () == TYPE_CODE_STRUCT))
+ || type->code () == TYPE_CODE_STRUCT))
{
int len = (value_bitpos (toval)
+ bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT;
CORE_ADDR to_addr = value_address (toval);
if (type->code () == TYPE_CODE_FLT)
- fromval = value_cast (type, fromval);
+ fromval = value_cast (type, fromval);
read_memory (to_addr, buffer, len);
from_size = value_bitsize (fromval);
val = value_copy (toval);
memcpy (value_contents_raw (val), value_contents (fromval),
- TYPE_LENGTH (type));
+ TYPE_LENGTH (type));
deprecated_set_value_type (val, type);
return val;
int src_offset;
if (is_scalar_type (check_typedef (value_type (component))))
- src_offset
+ src_offset
= TYPE_LENGTH (value_type (component)) * TARGET_CHAR_BIT - bits;
else
src_offset = 0;
struct type *saved_elt_type = TYPE_TARGET_TYPE (elt_type);
if (elt_type->code () != TYPE_CODE_ARRAY)
- error (_("too many subscripts (%d expected)"), k);
+ error (_("too many subscripts (%d expected)"), k);
elt = value_subscript (elt, pos_atr (ind[k]));
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);
+ 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));
+ value_copy (arr));
+ get_discrete_bounds (type->index_type (), &lwb, &upb);
+ arr = value_ptradd (arr, pos_atr (ind[k]) - lwb);
type = TYPE_TARGET_TYPE (type);
}
this array is LOW, as per Ada rules. */
static struct value *
ada_value_slice_from_ptr (struct value *array_ptr, struct type *type,
- int low, int high)
+ 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;
base_low_pos = base_low;
}
- base = value_as_address (array_ptr)
- + ((low_pos - base_low_pos)
- * TYPE_LENGTH (TYPE_TARGET_TYPE (type0)));
+ ULONGEST stride = TYPE_FIELD_BITSIZE (slice_type, 0) / 8;
+ if (stride == 0)
+ stride = TYPE_LENGTH (TYPE_TARGET_TYPE (type0));
+
+ base = value_as_address (array_ptr) + (low_pos - base_low_pos) * stride;
return value_at_lazy (slice_type, 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),
else
while (type->code () == TYPE_CODE_ARRAY)
{
- arity += 1;
- type = ada_check_typedef (TYPE_TARGET_TYPE (type));
+ arity += 1;
+ type = ada_check_typedef (TYPE_TARGET_TYPE (type));
}
return arity;
k = ada_array_arity (type);
if (k == 0)
- return NULL;
+ return NULL;
/* Initially p_array_type = elt_type(*)[]...(k times)...[]. */
if (nindices >= 0 && k > nindices)
- k = nindices;
+ k = nindices;
while (k > 0 && p_array_type != NULL)
- {
- p_array_type = ada_check_typedef (TYPE_TARGET_TYPE (p_array_type));
- k -= 1;
- }
+ {
+ p_array_type = ada_check_typedef (TYPE_TARGET_TYPE (p_array_type));
+ k -= 1;
+ }
return p_array_type;
}
else if (type->code () == TYPE_CODE_ARRAY)
{
while (nindices != 0 && type->code () == TYPE_CODE_ARRAY)
- {
- type = TYPE_TARGET_TYPE (type);
- nindices -= 1;
- }
+ {
+ type = TYPE_TARGET_TYPE (type);
+ nindices -= 1;
+ }
return type;
}
int i;
for (i = 1; i < n; i += 1)
- type = TYPE_TARGET_TYPE (type);
- result_type = TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type));
+ type = TYPE_TARGET_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. */
+ has a target type of TYPE_CODE_UNDEF. We compensate here, but
+ perhaps stabsread.c would make more sense. */
if (result_type && result_type->code () == TYPE_CODE_UNDEF)
- result_type = NULL;
+ result_type = NULL;
}
else
{
else
type = arr_type;
- if (TYPE_FIXED_INSTANCE (type))
+ if (type->is_fixed_instance ())
{
/* The array has already been fixed, so we do not need to
check the parallel ___XA type again. That encoding has
}
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
(LONGEST) (which == 0
- ? ada_discrete_type_low_bound (index_type)
- : ada_discrete_type_high_bound (index_type));
+ ? ada_discrete_type_low_bound (index_type)
+ : ada_discrete_type_high_bound (index_type));
}
/* Given that arr is an array value, returns the lower bound of the
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);
}
\f
- /* Name resolution */
+ /* Name resolution */
/* The "decoded" name for the user-definable Ada operator corresponding
to OP. */
for (i = 0; ada_opname_table[i].encoded != NULL; i += 1)
{
if (ada_opname_table[i].op == op)
- return ada_opname_table[i].decoded;
+ return ada_opname_table[i].decoded;
}
error (_("Could not find operator name for opcode"));
}
int k0, k1;
for (k0 = strlen (N0) - 1; k0 > 0 && isdigit (N0[k0]); k0 -= 1)
- ;
+ ;
for (k1 = strlen (N1) - 1; k1 > 0 && isdigit (N1[k1]); k1 -= 1)
- ;
+ ;
if ((N0[k0] == '_' || N0[k0] == '$') && N0[k0 + 1] != '\000'
- && (N1[k1] == '_' || N1[k1] == '$') && N1[k1 + 1] != '\000')
- {
- int n0, n1;
-
- n0 = k0;
- while (N0[n0] == '_' && n0 > 0 && N0[n0 - 1] == '_')
- n0 -= 1;
- n1 = k1;
- while (N1[n1] == '_' && n1 > 0 && N1[n1 - 1] == '_')
- n1 -= 1;
- if (n0 == n1 && strncmp (N0, N1, n0) == 0)
- return (atoi (N0 + k0 + 1) < atoi (N1 + k1 + 1));
- }
+ && (N1[k1] == '_' || N1[k1] == '$') && N1[k1 + 1] != '\000')
+ {
+ int n0, n1;
+
+ n0 = k0;
+ while (N0[n0] == '_' && n0 > 0 && N0[n0 - 1] == '_')
+ n0 -= 1;
+ n1 = k1;
+ while (N1[n1] == '_' && n1 > 0 && N1[n1 - 1] == '_')
+ n1 -= 1;
+ if (n0 == n1 && strncmp (N0, N1, n0) == 0)
+ return (atoi (N0 + k0 + 1) < atoi (N1 + k1 + 1));
+ }
return (strcmp (N0, N1) < 0);
}
}
int j;
for (j = i - 1; j >= 0; j -= 1)
- {
- if (encoded_ordered_before (syms[j].symbol->linkage_name (),
- sym.symbol->linkage_name ()))
- break;
- syms[j + 1] = syms[j];
- }
+ {
+ if (encoded_ordered_before (syms[j].symbol->linkage_name (),
+ sym.symbol->linkage_name ()))
+ break;
+ syms[j + 1] = syms[j];
+ }
syms[j + 1] = sym;
}
}
|| 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, ")");
static int
get_selections (int *choices, int n_choices, int max_results,
- int is_all_choice, const char *annotation_suffix)
+ int is_all_choice, const char *annotation_suffix)
{
const char *args;
const char *prompt;
args = skip_spaces (args);
if (*args == '\0' && n_chosen == 0)
- error_no_arg (_("one or more choice numbers"));
+ error_no_arg (_("one or more choice numbers"));
else if (*args == '\0')
- break;
+ break;
choice = strtol (args, &args2, 10);
if (args == args2 || choice < 0
- || choice > n_choices + first_choice - 1)
- error (_("Argument must be choice number"));
+ || choice > n_choices + first_choice - 1)
+ error (_("Argument must be choice number"));
args = args2;
if (choice == 0)
- error (_("cancelled"));
+ error (_("cancelled"));
if (choice < first_choice)
- {
- n_chosen = n_choices;
- for (j = 0; j < n_choices; j += 1)
- choices[j] = j;
- break;
- }
+ {
+ n_chosen = n_choices;
+ for (j = 0; j < n_choices; j += 1)
+ choices[j] = j;
+ break;
+ }
choice -= first_choice;
for (j = n_chosen - 1; j >= 0 && choice < choices[j]; j -= 1)
- {
- }
+ {
+ }
if (j < 0 || choice != choices[j])
- {
- int k;
+ {
+ int k;
- for (k = n_chosen - 1; k > j; k -= 1)
- choices[k + 1] = choices[k];
- choices[j + 1] = choice;
- n_chosen += 1;
- }
+ for (k = n_chosen - 1; k > j; k -= 1)
+ choices[k + 1] = choices[k];
+ choices[j + 1] = choice;
+ n_chosen += 1;
+ }
}
if (n_chosen > max_results)
for (i = 0; i < nsyms; i += 1)
{
if (syms[i].symbol == NULL)
- continue;
+ continue;
if (SYMBOL_CLASS (syms[i].symbol) == LOC_BLOCK)
- {
- struct symtab_and_line sal =
- find_function_start_sal (syms[i].symbol, 1);
+ {
+ struct symtab_and_line sal =
+ find_function_start_sal (syms[i].symbol, 1);
printf_filtered ("[%d] ", i + first_choice);
ada_print_symbol_signature (gdb_stdout, syms[i].symbol,
styled_string (file_name_style.style (),
symtab_to_filename_for_display (sal.symtab)),
sal.line);
- continue;
- }
+ continue;
+ }
else
- {
- int is_enumeral =
- (SYMBOL_CLASS (syms[i].symbol) == LOC_CONST
- && SYMBOL_TYPE (syms[i].symbol) != NULL
- && SYMBOL_TYPE (syms[i].symbol)->code () == TYPE_CODE_ENUM);
+ {
+ int is_enumeral =
+ (SYMBOL_CLASS (syms[i].symbol) == LOC_CONST
+ && SYMBOL_TYPE (syms[i].symbol) != NULL
+ && SYMBOL_TYPE (syms[i].symbol)->code () == TYPE_CODE_ENUM);
struct symtab *symtab = NULL;
if (SYMBOL_OBJFILE_OWNED (syms[i].symbol))
symtab = symbol_symtab (syms[i].symbol);
- if (SYMBOL_LINE (syms[i].symbol) != 0 && symtab != NULL)
+ if (SYMBOL_LINE (syms[i].symbol) != 0 && symtab != NULL)
{
printf_filtered ("[%d] ", i + first_choice);
ada_print_symbol_signature (gdb_stdout, syms[i].symbol,
symtab_to_filename_for_display (symtab),
SYMBOL_LINE (syms[i].symbol));
}
- else if (is_enumeral
- && SYMBOL_TYPE (syms[i].symbol)->name () != NULL)
- {
- printf_filtered (("[%d] "), i + first_choice);
- ada_print_type (SYMBOL_TYPE (syms[i].symbol), NULL,
- gdb_stdout, -1, 0, &type_print_raw_options);
- printf_filtered (_("'(%s) (enumeral)\n"),
+ else if (is_enumeral
+ && SYMBOL_TYPE (syms[i].symbol)->name () != NULL)
+ {
+ printf_filtered (("[%d] "), i + first_choice);
+ ada_print_type (SYMBOL_TYPE (syms[i].symbol), NULL,
+ gdb_stdout, -1, 0, &type_print_raw_options);
+ printf_filtered (_("'(%s) (enumeral)\n"),
syms[i].symbol->print_name ());
- }
+ }
else
{
printf_filtered ("[%d] ", i + first_choice);
? _(" (enumeral)\n")
: _(" at ?\n"));
}
- }
+ }
}
n_chosen = get_selections (chosen, nsyms, max_results, max_results > 1,
- "overload-choice");
+ "overload-choice");
for (i = 0; i < n_chosen; i += 1)
syms[i] = syms[chosen[i]];
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
static struct value *
resolve_subexp (expression_up *expp, int *pos, int deprocedure_p,
- struct type *context_type, int parse_completion,
+ struct type *context_type, int parse_completion,
innermost_block_tracker *tracker)
{
int pc = *pos;
{
case OP_FUNCALL:
if (exp->elts[pc + 3].opcode == OP_VAR_VALUE
- && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
- *pos += 7;
+ && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
+ *pos += 7;
else
- {
- *pos += 3;
- resolve_subexp (expp, pos, 0, NULL, parse_completion, tracker);
- }
+ {
+ *pos += 3;
+ resolve_subexp (expp, pos, 0, NULL, parse_completion, tracker);
+ }
nargs = longest_to_int (exp->elts[pc + 1].longconst);
break;
case BINOP_ASSIGN:
{
- struct value *arg1;
-
- *pos += 1;
- arg1 = resolve_subexp (expp, pos, 0, NULL, parse_completion, tracker);
- if (arg1 == NULL)
- resolve_subexp (expp, pos, 1, NULL, parse_completion, tracker);
- else
- resolve_subexp (expp, pos, 1, value_type (arg1), parse_completion,
+ struct value *arg1;
+
+ *pos += 1;
+ arg1 = resolve_subexp (expp, pos, 0, NULL, parse_completion, tracker);
+ if (arg1 == NULL)
+ resolve_subexp (expp, pos, 1, NULL, parse_completion, tracker);
+ else
+ resolve_subexp (expp, pos, 1, value_type (arg1), parse_completion,
tracker);
- break;
+ break;
}
case UNOP_CAST:
case OP_VAR_VALUE:
if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
- {
- std::vector<struct block_symbol> candidates;
- int n_candidates;
-
- n_candidates =
- ada_lookup_symbol_list (exp->elts[pc + 2].symbol->linkage_name (),
- exp->elts[pc + 1].block, VAR_DOMAIN,
- &candidates);
-
- if (n_candidates > 1)
- {
- /* Types tend to get re-introduced locally, so if there
- are any local symbols that are not types, first filter
- out all types. */
- int j;
- for (j = 0; j < n_candidates; j += 1)
- switch (SYMBOL_CLASS (candidates[j].symbol))
- {
- case LOC_REGISTER:
- case LOC_ARG:
- case LOC_REF_ARG:
- case LOC_REGPARM_ADDR:
- case LOC_LOCAL:
- case LOC_COMPUTED:
- goto FoundNonType;
- default:
- break;
- }
- FoundNonType:
- if (j < n_candidates)
- {
- j = 0;
- while (j < n_candidates)
- {
- if (SYMBOL_CLASS (candidates[j].symbol) == LOC_TYPEDEF)
- {
- candidates[j] = candidates[n_candidates - 1];
- n_candidates -= 1;
- }
- else
- j += 1;
- }
- }
- }
-
- if (n_candidates == 0)
- error (_("No definition found for %s"),
- exp->elts[pc + 2].symbol->print_name ());
- else if (n_candidates == 1)
- i = 0;
- else if (deprocedure_p
- && !is_nonfunction (candidates.data (), n_candidates))
- {
- i = ada_resolve_function
- (candidates.data (), n_candidates, NULL, 0,
- exp->elts[pc + 2].symbol->linkage_name (),
- context_type, parse_completion);
- if (i < 0)
- error (_("Could not find a match for %s"),
- exp->elts[pc + 2].symbol->print_name ());
- }
- else
- {
- printf_filtered (_("Multiple matches for %s\n"),
- exp->elts[pc + 2].symbol->print_name ());
- user_select_syms (candidates.data (), n_candidates, 1);
- i = 0;
- }
-
- exp->elts[pc + 1].block = candidates[i].block;
- exp->elts[pc + 2].symbol = candidates[i].symbol;
+ {
+ std::vector<struct block_symbol> candidates;
+ int n_candidates;
+
+ n_candidates =
+ ada_lookup_symbol_list (exp->elts[pc + 2].symbol->linkage_name (),
+ exp->elts[pc + 1].block, VAR_DOMAIN,
+ &candidates);
+
+ if (n_candidates > 1)
+ {
+ /* Types tend to get re-introduced locally, so if there
+ are any local symbols that are not types, first filter
+ out all types. */
+ int j;
+ for (j = 0; j < n_candidates; j += 1)
+ switch (SYMBOL_CLASS (candidates[j].symbol))
+ {
+ case LOC_REGISTER:
+ case LOC_ARG:
+ case LOC_REF_ARG:
+ case LOC_REGPARM_ADDR:
+ case LOC_LOCAL:
+ case LOC_COMPUTED:
+ goto FoundNonType;
+ default:
+ break;
+ }
+ FoundNonType:
+ if (j < n_candidates)
+ {
+ j = 0;
+ while (j < n_candidates)
+ {
+ if (SYMBOL_CLASS (candidates[j].symbol) == LOC_TYPEDEF)
+ {
+ candidates[j] = candidates[n_candidates - 1];
+ n_candidates -= 1;
+ }
+ else
+ j += 1;
+ }
+ }
+ }
+
+ if (n_candidates == 0)
+ error (_("No definition found for %s"),
+ exp->elts[pc + 2].symbol->print_name ());
+ else if (n_candidates == 1)
+ i = 0;
+ else if (deprocedure_p
+ && !is_nonfunction (candidates.data (), n_candidates))
+ {
+ i = ada_resolve_function
+ (candidates.data (), n_candidates, NULL, 0,
+ exp->elts[pc + 2].symbol->linkage_name (),
+ context_type, parse_completion);
+ if (i < 0)
+ error (_("Could not find a match for %s"),
+ exp->elts[pc + 2].symbol->print_name ());
+ }
+ else
+ {
+ printf_filtered (_("Multiple matches for %s\n"),
+ exp->elts[pc + 2].symbol->print_name ());
+ user_select_syms (candidates.data (), n_candidates, 1);
+ i = 0;
+ }
+
+ exp->elts[pc + 1].block = candidates[i].block;
+ exp->elts[pc + 2].symbol = candidates[i].symbol;
tracker->update (candidates[i]);
- }
+ }
if (deprocedure_p
- && (SYMBOL_TYPE (exp->elts[pc + 2].symbol)->code ()
- == TYPE_CODE_FUNC))
- {
- replace_operator_with_call (expp, pc, 0, 4,
- exp->elts[pc + 2].symbol,
- exp->elts[pc + 1].block);
- exp = expp->get ();
- }
+ && (SYMBOL_TYPE (exp->elts[pc + 2].symbol)->code ()
+ == TYPE_CODE_FUNC))
+ {
+ replace_operator_with_call (expp, pc, 0, 4,
+ exp->elts[pc + 2].symbol,
+ exp->elts[pc + 1].block);
+ exp = expp->get ();
+ }
break;
case OP_FUNCALL:
{
- if (exp->elts[pc + 3].opcode == OP_VAR_VALUE
- && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
- {
+ if (exp->elts[pc + 3].opcode == OP_VAR_VALUE
+ && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
+ {
std::vector<struct block_symbol> candidates;
- int n_candidates;
-
- n_candidates =
- ada_lookup_symbol_list (exp->elts[pc + 5].symbol->linkage_name (),
- exp->elts[pc + 4].block, VAR_DOMAIN,
- &candidates);
-
- if (n_candidates == 1)
- i = 0;
- else
- {
- i = ada_resolve_function
- (candidates.data (), n_candidates,
- argvec, nargs,
- exp->elts[pc + 5].symbol->linkage_name (),
- context_type, parse_completion);
- if (i < 0)
- error (_("Could not find a match for %s"),
- exp->elts[pc + 5].symbol->print_name ());
- }
-
- exp->elts[pc + 4].block = candidates[i].block;
- exp->elts[pc + 5].symbol = candidates[i].symbol;
+ int n_candidates;
+
+ n_candidates =
+ ada_lookup_symbol_list (exp->elts[pc + 5].symbol->linkage_name (),
+ exp->elts[pc + 4].block, VAR_DOMAIN,
+ &candidates);
+
+ if (n_candidates == 1)
+ i = 0;
+ else
+ {
+ i = ada_resolve_function
+ (candidates.data (), n_candidates,
+ argvec, nargs,
+ exp->elts[pc + 5].symbol->linkage_name (),
+ context_type, parse_completion);
+ if (i < 0)
+ error (_("Could not find a match for %s"),
+ exp->elts[pc + 5].symbol->print_name ());
+ }
+
+ exp->elts[pc + 4].block = candidates[i].block;
+ exp->elts[pc + 5].symbol = candidates[i].symbol;
tracker->update (candidates[i]);
- }
+ }
}
break;
case BINOP_ADD:
case UNOP_LOGICAL_NOT:
case UNOP_ABS:
if (possible_user_operator_p (op, argvec))
- {
+ {
std::vector<struct block_symbol> candidates;
- int n_candidates;
+ int n_candidates;
- n_candidates =
- ada_lookup_symbol_list (ada_decoded_op_name (op),
+ n_candidates =
+ ada_lookup_symbol_list (ada_decoded_op_name (op),
NULL, VAR_DOMAIN,
- &candidates);
+ &candidates);
- i = ada_resolve_function (candidates.data (), n_candidates, argvec,
+ i = ada_resolve_function (candidates.data (), n_candidates, argvec,
nargs, ada_decoded_op_name (op), NULL,
parse_completion);
- if (i < 0)
- break;
+ if (i < 0)
+ break;
replace_operator_with_call (expp, pc, nargs, 1,
candidates[i].symbol,
candidates[i].block);
- exp = expp->get ();
- }
+ exp = expp->get ();
+ }
break;
case OP_TYPE:
return ftype->code () == atype->code ();
case TYPE_CODE_PTR:
if (atype->code () == TYPE_CODE_PTR)
- return ada_type_match (TYPE_TARGET_TYPE (ftype),
- TYPE_TARGET_TYPE (atype), 0);
+ return ada_type_match (TYPE_TARGET_TYPE (ftype),
+ TYPE_TARGET_TYPE (atype), 0);
else
- return (may_deref
- && ada_type_match (TYPE_TARGET_TYPE (ftype), atype, 0));
+ return (may_deref
+ && ada_type_match (TYPE_TARGET_TYPE (ftype), atype, 0));
case TYPE_CODE_INT:
case TYPE_CODE_ENUM:
case TYPE_CODE_RANGE:
switch (atype->code ())
- {
- case TYPE_CODE_INT:
- case TYPE_CODE_ENUM:
- case TYPE_CODE_RANGE:
- return 1;
- default:
- return 0;
- }
+ {
+ case TYPE_CODE_INT:
+ case TYPE_CODE_ENUM:
+ case TYPE_CODE_RANGE:
+ return 1;
+ default:
+ return 0;
+ }
case TYPE_CODE_ARRAY:
return (atype->code () == TYPE_CODE_ARRAY
- || ada_is_array_descriptor_type (atype));
+ || ada_is_array_descriptor_type (atype));
case TYPE_CODE_STRUCT:
if (ada_is_array_descriptor_type (ftype))
- return (atype->code () == TYPE_CODE_ARRAY
- || ada_is_array_descriptor_type (atype));
+ return (atype->code () == TYPE_CODE_ARRAY
+ || ada_is_array_descriptor_type (atype));
else
- return (atype->code () == TYPE_CODE_STRUCT
- && !ada_is_array_descriptor_type (atype));
+ return (atype->code () == TYPE_CODE_STRUCT
+ && !ada_is_array_descriptor_type (atype));
case TYPE_CODE_UNION:
case TYPE_CODE_FLT:
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)
{
if (actuals[i] == NULL)
- return 0;
+ return 0;
else
- {
- struct type *ftype = ada_check_typedef (TYPE_FIELD_TYPE (func_type,
- i));
- struct type *atype = ada_check_typedef (value_type (actuals[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))
- return 0;
- }
+ if (!ada_type_match (ftype, atype, 1))
+ return 0;
+ }
}
return 1;
}
static int
ada_resolve_function (struct block_symbol syms[],
- int nsyms, struct value **args, int nargs,
- const char *name, struct type *context_type,
+ int nsyms, struct value **args, int nargs,
+ const char *name, struct type *context_type,
int parse_completion)
{
int fallback;
for (fallback = 0; m == 0 && fallback < 2; fallback++)
{
for (k = 0; k < nsyms; k += 1)
- {
- struct type *type = ada_check_typedef (SYMBOL_TYPE (syms[k].symbol));
+ {
+ struct type *type = ada_check_typedef (SYMBOL_TYPE (syms[k].symbol));
- if (ada_args_match (syms[k].symbol, args, nargs)
- && (fallback || return_match (type, context_type)))
- {
- syms[m] = syms[k];
- m += 1;
- }
- }
+ if (ada_args_match (syms[k].symbol, args, nargs)
+ && (fallback || return_match (type, context_type)))
+ {
+ syms[m] = syms[k];
+ m += 1;
+ }
+ }
}
/* If we got multiple matches, ask the user which one to use. Don't do this
static void
replace_operator_with_call (expression_up *expp, int pc, int nargs,
- int oplen, struct symbol *sym,
- const struct block *block)
+ int oplen, struct symbol *sym,
+ const struct block *block)
{
/* A new expression, with 6 more elements (3 for funcall, 4 for function
symbol, -oplen for operator being replaced). */
struct expression *newexp = (struct expression *)
xzalloc (sizeof (struct expression)
- + EXP_ELEM_TO_BYTES ((*expp)->nelts + 7 - oplen));
+ + EXP_ELEM_TO_BYTES ((*expp)->nelts + 7 - oplen));
struct expression *exp = expp->get ();
newexp->nelts = exp->nelts + 7 - oplen;
newexp->gdbarch = exp->gdbarch;
memcpy (newexp->elts, exp->elts, EXP_ELEM_TO_BYTES (pc));
memcpy (newexp->elts + pc + 7, exp->elts + pc + oplen,
- EXP_ELEM_TO_BYTES (exp->nelts - pc - oplen));
+ EXP_ELEM_TO_BYTES (exp->nelts - pc - oplen));
newexp->elts[pc].opcode = newexp->elts[pc + 2].opcode = OP_FUNCALL;
newexp->elts[pc + 1].longconst = (LONGEST) nargs;
else
{
switch (type->code ())
- {
- case TYPE_CODE_INT:
- case TYPE_CODE_FLT:
- return 1;
- case TYPE_CODE_RANGE:
- return (type == TYPE_TARGET_TYPE (type)
- || numeric_type_p (TYPE_TARGET_TYPE (type)));
- default:
- return 0;
- }
+ {
+ case TYPE_CODE_INT:
+ case TYPE_CODE_FLT:
+ return 1;
+ case TYPE_CODE_RANGE:
+ return (type == TYPE_TARGET_TYPE (type)
+ || numeric_type_p (TYPE_TARGET_TYPE (type)));
+ default:
+ return 0;
+ }
}
}
else
{
switch (type->code ())
- {
- case TYPE_CODE_INT:
- return 1;
- case TYPE_CODE_RANGE:
- return (type == TYPE_TARGET_TYPE (type)
- || integer_type_p (TYPE_TARGET_TYPE (type)));
- default:
- return 0;
- }
+ {
+ case TYPE_CODE_INT:
+ return 1;
+ case TYPE_CODE_RANGE:
+ return (type == TYPE_TARGET_TYPE (type)
+ || integer_type_p (TYPE_TARGET_TYPE (type)));
+ default:
+ return 0;
+ }
}
}
else
{
switch (type->code ())
- {
- case TYPE_CODE_INT:
- case TYPE_CODE_RANGE:
- case TYPE_CODE_ENUM:
- case TYPE_CODE_FLT:
- return 1;
- default:
- return 0;
- }
+ {
+ case TYPE_CODE_INT:
+ case TYPE_CODE_RANGE:
+ case TYPE_CODE_ENUM:
+ case TYPE_CODE_FLT:
+ return 1;
+ default:
+ return 0;
+ }
}
}
else
{
switch (type->code ())
- {
- case TYPE_CODE_INT:
- case TYPE_CODE_RANGE:
- case TYPE_CODE_ENUM:
- case TYPE_CODE_BOOL:
- return 1;
- default:
- return 0;
- }
+ {
+ case TYPE_CODE_INT:
+ case TYPE_CODE_RANGE:
+ case TYPE_CODE_ENUM:
+ case TYPE_CODE_BOOL:
+ return 1;
+ default:
+ return 0;
+ }
}
}
}
}
\f
- /* Renaming */
+ /* Renaming */
/* NOTES:
}
\f
- /* Evaluation: Function Calls */
+ /* Evaluation: Function Calls */
/* Return an lvalue containing the value VAL. This is the identity on
lvalues, and otherwise has the side-effect of allocating memory
{
int len = TYPE_LENGTH (ada_check_typedef (value_type (val)));
const CORE_ADDR addr =
- value_as_long (value_allocate_space_in_inferior (len));
+ value_as_long (value_allocate_space_in_inferior (len));
VALUE_LVAL (val) = lval_memory;
set_value_address (val, addr);
goto BadValue;
t1 = ada_check_typedef (t1);
if (t1->code () == TYPE_CODE_PTR)
- {
- arg = coerce_ref (arg);
- t = t1;
- }
+ {
+ arg = coerce_ref (arg);
+ t = t1;
+ }
}
while (t->code () == TYPE_CODE_PTR)
goto BadValue;
t1 = ada_check_typedef (t1);
if (t1->code () == TYPE_CODE_PTR)
- {
- arg = value_ind (arg);
- t = t1;
- }
+ {
+ arg = value_ind (arg);
+ t = t1;
+ }
else
- break;
+ break;
}
if (t1->code () != TYPE_CODE_STRUCT && t1->code () != TYPE_CODE_UNION)
address = value_address (ada_coerce_ref (arg));
/* Check to see if this is a tagged type. We also need to handle
- the case where the type is a reference to a tagged type, but
- we have to be careful to exclude pointers to tagged types.
- The latter should be shown as usual (as a pointer), whereas
- a reference should mostly be transparent to the user. */
+ the case where the type is a reference to a tagged type, but
+ we have to be careful to exclude pointers to tagged types.
+ The latter should be shown as usual (as a pointer), whereas
+ a reference should mostly be transparent to the user. */
if (ada_is_tagged_type (t1, 0)
- || (t1->code () == TYPE_CODE_REF
- && ada_is_tagged_type (TYPE_TARGET_TYPE (t1), 0)))
- {
- /* We first try to find the searched field in the current type.
+ || (t1->code () == TYPE_CODE_REF
+ && ada_is_tagged_type (TYPE_TARGET_TYPE (t1), 0)))
+ {
+ /* We first try to find the searched field in the current type.
If not found then let's look in the fixed type. */
- if (!find_struct_field (name, t1, 0,
- &field_type, &byte_offset, &bit_offset,
- &bit_size, NULL))
+ if (!find_struct_field (name, t1, 0,
+ &field_type, &byte_offset, &bit_offset,
+ &bit_size, NULL))
check_tag = 1;
else
check_tag = 0;
- }
+ }
else
check_tag = 0;
t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL,
address, NULL, check_tag);
+ /* Resolve the dynamic type as well. */
+ arg = value_from_contents_and_address (t1, nullptr, address);
+ t1 = value_type (arg);
+
if (find_struct_field (name, t1, 0,
- &field_type, &byte_offset, &bit_offset,
- &bit_size, NULL))
- {
- if (bit_size != 0)
- {
- if (t->code () == TYPE_CODE_REF)
- arg = ada_coerce_ref (arg);
- else
- arg = ada_value_ind (arg);
- v = ada_value_primitive_packed_val (arg, NULL, byte_offset,
- bit_offset, bit_size,
- field_type);
- }
- else
- v = value_at_lazy (field_type, address + byte_offset);
- }
+ &field_type, &byte_offset, &bit_offset,
+ &bit_size, NULL))
+ {
+ if (bit_size != 0)
+ {
+ if (t->code () == TYPE_CODE_REF)
+ arg = ada_coerce_ref (arg);
+ else
+ arg = ada_value_ind (arg);
+ v = ada_value_primitive_packed_val (arg, NULL, byte_offset,
+ bit_offset, bit_size,
+ field_type);
+ }
+ else
+ v = value_at_lazy (field_type, address + byte_offset);
+ }
}
if (v != NULL || no_err)
struct value *result;
if (formal_target->code () == TYPE_CODE_ARRAY
- && ada_is_array_descriptor_type (actual_target))
+ && ada_is_array_descriptor_type (actual_target))
result = desc_data (actual);
else if (formal_type->code () != TYPE_CODE_PTR)
- {
- if (VALUE_LVAL (actual) != lval_memory)
- {
- struct value *val;
-
- actual_type = ada_check_typedef (value_type (actual));
- val = allocate_value (actual_type);
- memcpy ((char *) value_contents_raw (val),
- (char *) value_contents (actual),
- TYPE_LENGTH (actual_type));
- actual = ensure_lval (val);
- }
- result = value_addr (actual);
- }
+ {
+ if (VALUE_LVAL (actual) != lval_memory)
+ {
+ struct value *val;
+
+ actual_type = ada_check_typedef (value_type (actual));
+ val = allocate_value (actual_type);
+ memcpy ((char *) value_contents_raw (val),
+ (char *) value_contents (actual),
+ TYPE_LENGTH (actual_type));
+ actual = ensure_lval (val);
+ }
+ result = value_addr (actual);
+ }
else
return actual;
return value_cast_pointers (formal_type, result, 0);
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));
return descriptor;
}
\f
- /* Symbol Cache Module */
+ /* Symbol Cache Module */
/* Performance measurements made as of 2010-01-15 indicate that
this cache does bring some noticeable improvements. Depending
for (e = &sym_cache->root[h]; *e != NULL; e = &(*e)->next)
{
if (domain == (*e)->domain && strcmp (name, (*e)->name) == 0)
- return e;
+ return e;
}
return NULL;
}
static int
lookup_cached_symbol (const char *name, domain_enum domain,
- struct symbol **sym, const struct block **block)
+ struct symbol **sym, const struct block **block)
{
struct cache_entry **e = find_entry (name, domain);
static void
cache_symbol (const char *name, domain_enum domain, struct symbol *sym,
- const struct block *block)
+ const struct block *block)
{
struct ada_symbol_cache *sym_cache
= ada_get_symbol_cache (current_program_space);
e->block = block;
}
\f
- /* Symbol Lookup */
+ /* Symbol Lookup */
/* Return the symbol name match type that should be used used when
searching for all symbols matching LOOKUP_NAME.
static struct symbol *
standard_lookup (const char *name, const struct block *block,
- domain_enum domain)
+ domain_enum domain)
{
/* Initialize it just to avoid a GCC false warning. */
struct block_symbol sym = {};
for (i = 0; i < n; i += 1)
if (SYMBOL_TYPE (syms[i].symbol)->code () != TYPE_CODE_FUNC
- && (SYMBOL_TYPE (syms[i].symbol)->code () != TYPE_CODE_ENUM
- || SYMBOL_CLASS (syms[i].symbol) != LOC_CONST))
+ && (SYMBOL_TYPE (syms[i].symbol)->code () != TYPE_CODE_ENUM
+ || SYMBOL_CLASS (syms[i].symbol) != LOC_CONST))
return 1;
return 0;
return 1;
case LOC_TYPEDEF:
{
- struct type *type0 = SYMBOL_TYPE (sym0);
- struct type *type1 = SYMBOL_TYPE (sym1);
- const char *name0 = sym0->linkage_name ();
- const char *name1 = sym1->linkage_name ();
- int len0 = strlen (name0);
-
- return
- type0->code () == type1->code ()
- && (equiv_types (type0, type1)
- || (len0 < strlen (name1) && strncmp (name0, name1, len0) == 0
- && startswith (name1 + len0, "___XV")));
+ struct type *type0 = SYMBOL_TYPE (sym0);
+ struct type *type1 = SYMBOL_TYPE (sym1);
+ const char *name0 = sym0->linkage_name ();
+ const char *name1 = sym1->linkage_name ();
+ int len0 = strlen (name0);
+
+ return
+ type0->code () == type1->code ()
+ && (equiv_types (type0, type1)
+ || (len0 < strlen (name1) && strncmp (name0, name1, len0) == 0
+ && startswith (name1 + len0, "___XV")));
}
case LOC_CONST:
return SYMBOL_VALUE (sym0) == SYMBOL_VALUE (sym1)
- && equiv_types (SYMBOL_TYPE (sym0), SYMBOL_TYPE (sym1));
+ && equiv_types (SYMBOL_TYPE (sym0), SYMBOL_TYPE (sym1));
case LOC_STATIC:
{
- const char *name0 = sym0->linkage_name ();
- const char *name1 = sym1->linkage_name ();
- return (strcmp (name0, name1) == 0
- && SYMBOL_VALUE_ADDRESS (sym0) == SYMBOL_VALUE_ADDRESS (sym1));
+ const char *name0 = sym0->linkage_name ();
+ const char *name1 = sym1->linkage_name ();
+ return (strcmp (name0, name1) == 0
+ && SYMBOL_VALUE_ADDRESS (sym0) == SYMBOL_VALUE_ADDRESS (sym1));
}
default:
static void
add_defn_to_vec (struct obstack *obstackp,
- struct symbol *sym,
- const struct block *block)
+ struct symbol *sym,
+ const struct block *block)
{
int i;
struct block_symbol *prevDefns = defns_collected (obstackp, 0);
for (i = num_defns_collected (obstackp) - 1; i >= 0; i -= 1)
{
if (lesseq_defined_than (sym, prevDefns[i].symbol))
- return;
+ return;
else if (lesseq_defined_than (prevDefns[i].symbol, sym))
- {
- prevDefns[i].symbol = sym;
- prevDefns[i].block = block;
- return;
- }
+ {
+ prevDefns[i].symbol = sym;
+ prevDefns[i].block = block;
+ return;
+ }
}
{
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);
ada_remove_trailing_digits (TYPE_FIELD_NAME (type1, i), &len_1);
ada_remove_trailing_digits (TYPE_FIELD_NAME (type2, i), &len_2);
if (len_1 != len_2
- || strncmp (TYPE_FIELD_NAME (type1, i),
+ || strncmp (TYPE_FIELD_NAME (type1, i),
TYPE_FIELD_NAME (type2, i),
len_1) != 0)
return 0;
/* 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
comparison of the type of each symbol. */
for (i = 1; i < syms.size (); i++)
if (!ada_identical_enum_types_p (SYMBOL_TYPE (syms[i].symbol),
- SYMBOL_TYPE (syms[0].symbol)))
+ SYMBOL_TYPE (syms[0].symbol)))
return 0;
return 1;
int remove_p = 0;
/* If two symbols have the same name and one of them is a stub type,
- the get rid of the stub. */
-
- if (TYPE_STUB (SYMBOL_TYPE ((*syms)[i].symbol))
- && (*syms)[i].symbol->linkage_name () != NULL)
- {
- for (j = 0; j < syms->size (); j++)
- {
- if (j != i
- && !TYPE_STUB (SYMBOL_TYPE ((*syms)[j].symbol))
- && (*syms)[j].symbol->linkage_name () != NULL
- && strcmp ((*syms)[i].symbol->linkage_name (),
- (*syms)[j].symbol->linkage_name ()) == 0)
- remove_p = 1;
- }
- }
+ the get rid of the stub. */
+
+ if (SYMBOL_TYPE ((*syms)[i].symbol)->is_stub ()
+ && (*syms)[i].symbol->linkage_name () != NULL)
+ {
+ for (j = 0; j < syms->size (); j++)
+ {
+ if (j != i
+ && !SYMBOL_TYPE ((*syms)[j].symbol)->is_stub ()
+ && (*syms)[j].symbol->linkage_name () != NULL
+ && strcmp ((*syms)[i].symbol->linkage_name (),
+ (*syms)[j].symbol->linkage_name ()) == 0)
+ remove_p = 1;
+ }
+ }
/* Two symbols with the same name, same class and same address
- should be identical. */
+ should be identical. */
else if ((*syms)[i].symbol->linkage_name () != NULL
- && SYMBOL_CLASS ((*syms)[i].symbol) == LOC_STATIC
- && is_nondebugging_type (SYMBOL_TYPE ((*syms)[i].symbol)))
- {
- for (j = 0; j < syms->size (); j += 1)
- {
- if (i != j
- && (*syms)[j].symbol->linkage_name () != NULL
- && strcmp ((*syms)[i].symbol->linkage_name (),
- (*syms)[j].symbol->linkage_name ()) == 0
- && SYMBOL_CLASS ((*syms)[i].symbol)
+ && SYMBOL_CLASS ((*syms)[i].symbol) == LOC_STATIC
+ && is_nondebugging_type (SYMBOL_TYPE ((*syms)[i].symbol)))
+ {
+ for (j = 0; j < syms->size (); j += 1)
+ {
+ if (i != j
+ && (*syms)[j].symbol->linkage_name () != NULL
+ && strcmp ((*syms)[i].symbol->linkage_name (),
+ (*syms)[j].symbol->linkage_name ()) == 0
+ && SYMBOL_CLASS ((*syms)[i].symbol)
== SYMBOL_CLASS ((*syms)[j].symbol)
- && SYMBOL_VALUE_ADDRESS ((*syms)[i].symbol)
- == SYMBOL_VALUE_ADDRESS ((*syms)[j].symbol))
- remove_p = 1;
- }
- }
+ && SYMBOL_VALUE_ADDRESS ((*syms)[i].symbol)
+ == SYMBOL_VALUE_ADDRESS ((*syms)[j].symbol))
+ remove_p = 1;
+ }
+ }
if (remove_p)
syms->erase (syms->begin () + i);
-
- i += 1;
+ else
+ i += 1;
}
/* If all the remaining symbols are identical enumerals, then
below has a couple of limitations (FIXME: brobecker-2003-05-12):
- When the user tries to print a rename in a function while there
- is another rename entity defined in a package: Normally, the
- rename in the function has precedence over the rename in the
- package, so the latter should be removed from the list. This is
- currently not the case.
-
+ is another rename entity defined in a package: Normally, the
+ rename in the function has precedence over the rename in the
+ package, so the latter should be removed from the list. This is
+ currently not the case.
+
- This function will incorrectly remove valid renames if
- the CURRENT_BLOCK corresponds to a function which symbol name
- has been changed by an "Export" pragma. As a consequence,
- the user will be unable to print such rename entities. */
+ the CURRENT_BLOCK corresponds to a function which symbol name
+ has been changed by an "Export" pragma. As a consequence,
+ the user will be unable to print such rename entities. */
static int
remove_irrelevant_renamings (std::vector<struct block_symbol> *syms,
while (i < syms->size ())
{
if (ada_parse_renaming ((*syms)[i].symbol, NULL, NULL, NULL)
- == ADA_OBJECT_RENAMING
- && old_renaming_is_invisible ((*syms)[i].symbol,
+ == ADA_OBJECT_RENAMING
+ && old_renaming_is_invisible ((*syms)[i].symbol,
current_function_name))
syms->erase (syms->begin () + i);
else
- i += 1;
+ i += 1;
}
return syms->size ();
/* If we found a non-function match, assume that's the one. */
if (is_nonfunction (defns_collected (obstackp, 0),
- num_defns_collected (obstackp)))
- return;
+ num_defns_collected (obstackp)))
+ return;
block = BLOCK_SUPERBLOCK (block);
}
lookup_name_info name1 (bracket_name, symbol_name_match_type::FULL);
for (objfile *objfile : current_program_space->objfiles ())
- {
+ {
data.objfile = objfile;
objfile->sf->qf->map_matching_symbols (objfile, name1,
domain, global, callback,
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.
struct block_symbol
ada_lookup_symbol (const char *name, const struct block *block0,
- domain_enum domain)
+ domain_enum domain)
{
std::vector<struct block_symbol> candidates;
int n_candidates;
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
{
str += 3;
while (isdigit (str[0]))
- str += 1;
+ str += 1;
}
/* [.$][0-9]+ */
{
matching = str + 1;
while (isdigit (matching[0]))
- matching += 1;
+ matching += 1;
if (matching[0] == '\0')
- return 1;
+ return 1;
}
/* ___[0-9]+ */
{
matching = str + 3;
while (isdigit (matching[0]))
- matching += 1;
+ matching += 1;
if (matching[0] == '\0')
- return 1;
+ return 1;
}
/* "TKB" suffixes are used for subprograms implementing task bodies. */
{
matching = str + 3;
while (isdigit (matching[0]))
- matching += 1;
+ matching += 1;
if ((matching[0] == 'b' || matching[0] == 's')
- && matching [1] == '\0')
- return 1;
+ && matching [1] == '\0')
+ return 1;
}
/* ??? We should not modify STR directly, as we are doing below. This
{
str += 1;
while (str[0] != '_' && str[0] != '\0')
- {
- if (str[0] != 'n' && str[0] != 'b')
- return 0;
- str += 1;
- }
+ {
+ if (str[0] != 'n' && str[0] != 'b')
+ return 0;
+ str += 1;
+ }
}
if (str[0] == '\000')
if (str[0] == '_')
{
if (str[1] != '_' || str[2] == '\000')
- return 0;
+ return 0;
if (str[2] == '_')
- {
- if (strcmp (str + 3, "JM") == 0)
- return 1;
- /* FIXME: brobecker/2004-09-30: GNAT will soon stop using
- the LJM suffix in favor of the JM one. But we will
- still accept LJM as a valid suffix for a reasonable
- amount of time, just to allow ourselves to debug programs
- compiled using an older version of GNAT. */
- if (strcmp (str + 3, "LJM") == 0)
- return 1;
- if (str[3] != 'X')
- return 0;
- if (str[4] == 'F' || str[4] == 'D' || str[4] == 'B'
- || str[4] == 'U' || str[4] == 'P')
- return 1;
- if (str[4] == 'R' && str[5] != 'T')
- return 1;
- return 0;
- }
+ {
+ if (strcmp (str + 3, "JM") == 0)
+ return 1;
+ /* FIXME: brobecker/2004-09-30: GNAT will soon stop using
+ the LJM suffix in favor of the JM one. But we will
+ still accept LJM as a valid suffix for a reasonable
+ amount of time, just to allow ourselves to debug programs
+ compiled using an older version of GNAT. */
+ if (strcmp (str + 3, "LJM") == 0)
+ return 1;
+ if (str[3] != 'X')
+ return 0;
+ if (str[4] == 'F' || str[4] == 'D' || str[4] == 'B'
+ || str[4] == 'U' || str[4] == 'P')
+ return 1;
+ if (str[4] == 'R' && str[5] != 'T')
+ return 1;
+ return 0;
+ }
if (!isdigit (str[2]))
- return 0;
+ return 0;
for (k = 3; str[k] != '\0'; k += 1)
- if (!isdigit (str[k]) && str[k] != '_')
- return 0;
+ if (!isdigit (str[k]) && str[k] != '_')
+ return 0;
return 1;
}
if (str[0] == '$' && isdigit (str[1]))
{
for (k = 2; str[k] != '\0'; k += 1)
- if (!isdigit (str[k]) && str[k] != '_')
- return 0;
+ if (!isdigit (str[k]) && str[k] != '_')
+ return 0;
return 1;
}
return 0;
return 1;
}
-/* Advance *NAMEP to next occurrence of TARGET0 in the string NAME0
- that could start a simple name. Assumes that *NAMEP points into
- the string beginning at NAME0. */
+/* Advance *NAMEP to next occurrence in the string NAME0 of the TARGET0
+ character which could start a simple name. Assumes that *NAMEP points
+ somewhere inside the string beginning at NAME0. */
static int
-advance_wild_match (const char **namep, const char *name0, int target0)
+advance_wild_match (const char **namep, const char *name0, char target0)
{
const char *name = *namep;
while (1)
{
- int t0, t1;
+ char t0, t1;
t0 = *name;
if (t0 == '_')
if (!found_sym && arg_sym != NULL)
{
add_defn_to_vec (obstackp,
- fixup_symbol_section (arg_sym, objfile),
- block);
+ fixup_symbol_section (arg_sym, objfile),
+ block);
}
if (!lookup_name.ada ().wild_match_p ())
ALL_BLOCK_SYMBOLS (block, iter, sym)
{
- if (symbol_matches_domain (sym->language (),
- SYMBOL_DOMAIN (sym), domain))
- {
- int cmp;
-
- cmp = (int) '_' - (int) sym->linkage_name ()[0];
- if (cmp == 0)
- {
- cmp = !startswith (sym->linkage_name (), "_ada_");
- if (cmp == 0)
- cmp = strncmp (name, sym->linkage_name () + 5,
- name_len);
- }
-
- if (cmp == 0
- && is_name_suffix (sym->linkage_name () + name_len + 5))
- {
+ if (symbol_matches_domain (sym->language (),
+ SYMBOL_DOMAIN (sym), domain))
+ {
+ int cmp;
+
+ cmp = (int) '_' - (int) sym->linkage_name ()[0];
+ if (cmp == 0)
+ {
+ cmp = !startswith (sym->linkage_name (), "_ada_");
+ if (cmp == 0)
+ cmp = strncmp (name, sym->linkage_name () + 5,
+ name_len);
+ }
+
+ if (cmp == 0
+ && is_name_suffix (sym->linkage_name () + name_len + 5))
+ {
if (SYMBOL_CLASS (sym) != LOC_UNRESOLVED)
{
if (SYMBOL_IS_ARGUMENT (sym))
block);
}
}
- }
- }
+ }
+ }
}
/* NOTE: This really shouldn't be needed for _ada_ symbols.
- They aren't parameters, right? */
+ They aren't parameters, right? */
if (!found_sym && arg_sym != NULL)
- {
- add_defn_to_vec (obstackp,
- fixup_symbol_section (arg_sym, objfile),
- block);
- }
+ {
+ add_defn_to_vec (obstackp,
+ fixup_symbol_section (arg_sym, objfile),
+ block);
+ }
}
}
\f
- /* Symbol Completion */
+ /* Symbol Completion */
/* See symtab.h. */
if (match && !m_encoded_p)
{
/* One needed check before declaring a positive match is to verify
- that iff we are doing a verbatim match, the decoded version
- of the symbol name starts with '<'. Otherwise, this symbol name
- is not a suitable completion. */
+ that iff we are doing a verbatim match, the decoded version
+ of the symbol name starts with '<'. Otherwise, this symbol name
+ is not a suitable completion. */
bool has_angle_bracket = (decoded_name[0] == '<');
match = (has_angle_bracket == m_verbatim_p);
if (match && !m_verbatim_p)
{
/* When doing non-verbatim match, another check that needs to
- be done is to verify that the potentially matching symbol name
- does not include capital letters, because the ada-mode would
- not be able to understand these symbol names without the
- angle bracket notation. */
+ be done is to verify that the potentially matching symbol name
+ does not include capital letters, because the ada-mode would
+ not be able to understand these symbol names without the
+ angle bracket notation. */
const char *tmp;
for (tmp = sym_name; *tmp != '\0' && !isupper (*tmp); tmp++);
if (!match && m_wild_match_p)
{
/* Since we are doing wild matching, this means that TEXT
- may represent an unqualified symbol name. We therefore must
- also compare TEXT against the unqualified name of the symbol. */
+ may represent an unqualified symbol name. We therefore must
+ also compare TEXT against the unqualified name of the symbol. */
sym_name = ada_unqualified_name (decoded_name.c_str ());
if (strncmp (sym_name, text, text_len) == 0)
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 */
+ /* Field Access */
/* Return non-zero if TYPE is a pointer to the GNAT dispatch table used
for tagged types. */
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. */
const char *name = ada_type_name (TYPE_TARGET_TYPE (type));
return (name != NULL
- && strcmp (name, "ada__tags__dispatch_table") == 0);
+ && strcmp (name, "ada__tags__dispatch_table") == 0);
}
}
static struct value *
value_tag_from_contents_and_address (struct type *type,
const gdb_byte *valaddr,
- CORE_ADDR address)
+ CORE_ADDR address)
{
int tag_byte_offset;
struct type *tag_type;
if (find_struct_field ("_tag", type, 0, &tag_type, &tag_byte_offset,
- NULL, NULL, NULL))
+ NULL, NULL, NULL))
{
const gdb_byte *valaddr1 = ((valaddr == NULL)
? NULL
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 ()).c_str ());
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)
- parent_type = TYPE_TARGET_TYPE (parent_type);
- /* If there is a parallel XVS type, get the actual base type. */
- parent_type = ada_get_base_type (parent_type);
+ /* If the _parent field is a pointer, then dereference it. */
+ if (parent_type->code () == TYPE_CODE_PTR)
+ parent_type = TYPE_TARGET_TYPE (parent_type);
+ /* If there is a parallel XVS type, get the actual base type. */
+ parent_type = ada_get_base_type (parent_type);
- return ada_check_typedef (parent_type);
+ return ada_check_typedef (parent_type);
}
return NULL;
const char *name = TYPE_FIELD_NAME (ada_check_typedef (type), field_num);
return (name != NULL
- && (startswith (name, "PARENT")
- || startswith (name, "_parent")));
+ && (startswith (name, "PARENT")
+ || startswith (name, "_parent")));
}
/* True iff field number FIELD_NUM of structure type TYPE is a
}
return (name != NULL
- && (startswith (name, "PARENT")
- || strcmp (name, "REP") == 0
- || startswith (name, "_parent")
- || name[0] == 'S' || name[0] == 'R' || name[0] == 'O'));
+ && (startswith (name, "PARENT")
+ || strcmp (name, "REP") == 0
+ || startswith (name, "_parent")
+ || name[0] == 'S' || name[0] == 'R' || name[0] == 'O'));
}
/* True iff field number FIELD_NUM of structure or union type TYPE
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)
discrim_end -= 1)
{
if (startswith (discrim_end, "___XVN"))
- break;
+ break;
}
if (discrim_end == name)
return "";
discrim_start -= 1)
{
if (discrim_start == name + 1)
- return "";
+ return "";
if ((discrim_start > name + 3
- && startswith (discrim_start - 3, "___"))
- || discrim_start[-1] == '.')
- break;
+ && startswith (discrim_start - 3, "___"))
+ || discrim_start[-1] == '.')
+ break;
}
GROW_VECT (result, result_len, discrim_end - discrim_start + 1);
if (str[k] == 'm')
{
if (R != NULL)
- *R = (-(LONGEST) (RU - 1)) - 1;
+ *R = (-(LONGEST) (RU - 1)) - 1;
k += 1;
}
else if (R != NULL)
while (1)
{
switch (name[p])
- {
- case '\0':
- return 0;
- case 'S':
- {
- LONGEST W;
-
- if (!ada_scan_number (name, p + 1, &W, &p))
- return 0;
- if (val == W)
- return 1;
- break;
- }
- case 'R':
- {
- LONGEST L, U;
-
- if (!ada_scan_number (name, p + 1, &L, &p)
- || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
- return 0;
- if (val >= L && val <= U)
- return 1;
- break;
- }
- case 'O':
- return 1;
- default:
- return 0;
- }
+ {
+ case '\0':
+ return 0;
+ case 'S':
+ {
+ LONGEST W;
+
+ if (!ada_scan_number (name, p + 1, &W, &p))
+ return 0;
+ if (val == W)
+ return 1;
+ break;
+ }
+ case 'R':
+ {
+ LONGEST L, U;
+
+ if (!ada_scan_number (name, p + 1, &L, &p)
+ || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
+ return 0;
+ if (val >= L && val <= U)
+ return 1;
+ break;
+ }
+ case 'O':
+ return 1;
+ default:
+ return 0;
+ }
}
}
struct value *
ada_value_primitive_field (struct value *arg1, int offset, int fieldno,
- struct type *arg_type)
+ struct type *arg_type)
{
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 (arg_type, fieldno);
return ada_value_primitive_packed_val (arg1, value_contents (arg1),
- offset + bit_pos / 8,
- bit_pos % 8, bit_size, type);
+ offset + bit_pos / 8,
+ bit_pos % 8, bit_size, type);
}
else
return value_primitive_field (arg1, offset, fieldno, arg_type);
has some components with the same name, like in this scenario:
type Top_T is tagged record
- N : Integer := 1;
- U : Integer := 974;
- A : Integer := 48;
+ N : Integer := 1;
+ U : Integer := 974;
+ A : Integer := 48;
end record;
type Middle_T is new Top.Top_T with record
- N : Character := 'a';
- C : Integer := 3;
+ N : Character := 'a';
+ C : Integer := 3;
end record;
type Bottom_T is new Middle.Middle_T with record
- N : Float := 4.0;
- C : Character := '5';
- X : Integer := 6;
- A : Character := 'J';
+ N : Float := 4.0;
+ C : Character := '5';
+ X : Integer := 6;
+ A : Character := 'J';
end record;
Let's say we now have a variable declared and initialized as follow:
static int
find_struct_field (const char *name, struct type *type, int offset,
- struct type **field_type_p,
- int *byte_offset_p, int *bit_offset_p, int *bit_size_p,
+ struct type **field_type_p,
+ int *byte_offset_p, int *bit_offset_p, int *bit_size_p,
int *index_p)
{
int i;
if (bit_size_p != NULL)
*bit_size_p = 0;
- for (i = 0; i < TYPE_NFIELDS (type); i += 1)
+ for (i = 0; i < type->num_fields (); i += 1)
{
int bit_pos = TYPE_FIELD_BITPOS (type, i);
int fld_offset = offset + bit_pos / 8;
const char *t_field_name = TYPE_FIELD_NAME (type, i);
if (t_field_name == NULL)
- continue;
+ continue;
else if (ada_is_parent_field (type, i))
- {
+ {
/* This is a field pointing us to the parent type of a tagged
type. As hinted in this function's documentation, we give
preference to fields in the current record first, so what
in the current record, then we'll get back to it and search
inside it whether the field might exist in the parent. */
- parent_offset = i;
- continue;
- }
+ parent_offset = i;
+ continue;
+ }
else if (name != NULL && field_name_match (t_field_name, name))
- {
- int bit_size = TYPE_FIELD_BITSIZE (type, i);
+ {
+ 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)
*bit_offset_p = bit_pos % 8;
if (bit_size_p != NULL)
*bit_size_p = bit_size;
- return 1;
- }
+ return 1;
+ }
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;
- }
+ return 1;
+ }
else if (ada_is_variant_part (type, i))
- {
+ {
/* PNH: Wait. Do we ever execute this section, or is ARG always of
fixed type?? */
- int j;
- struct type *field_type
- = ada_check_typedef (TYPE_FIELD_TYPE (type, i));
-
- for (j = 0; j < TYPE_NFIELDS (field_type); j += 1)
- {
- if (find_struct_field (name, TYPE_FIELD_TYPE (field_type, j),
- fld_offset
- + TYPE_FIELD_BITPOS (field_type, j) / 8,
- field_type_p, byte_offset_p,
- bit_offset_p, bit_size_p, index_p))
- return 1;
- }
- }
+ int j;
+ struct type *field_type
+ = ada_check_typedef (type->field (i).type ());
+
+ for (j = 0; j < field_type->num_fields (); j += 1)
+ {
+ 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,
+ bit_offset_p, bit_size_p, index_p))
+ return 1;
+ }
+ }
else if (index_p != NULL)
*index_p += 1;
}
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),
- fld_offset, field_type_p, byte_offset_p,
- bit_offset_p, bit_size_p, index_p))
- return 1;
+ 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;
}
return 0;
static struct value *
ada_search_struct_field (const char *name, struct value *arg, int offset,
- struct type *type)
+ struct type *type)
{
int i;
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);
if (t_field_name == NULL)
- continue;
+ continue;
else if (ada_is_parent_field (type, i))
- {
+ {
/* This is a field pointing us to the parent type of a tagged
type. As hinted in this function's documentation, we give
preference to fields in the current record first, so what
in the current record, then we'll get back to it and search
inside it whether the field might exist in the parent. */
- parent_offset = i;
- continue;
- }
+ parent_offset = i;
+ continue;
+ }
else if (field_name_match (t_field_name, name))
- return ada_value_primitive_field (arg, offset, i, type);
+ return ada_value_primitive_field (arg, offset, i, type);
else if (ada_is_wrapper_field (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));
+ {
+ 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 (i).type ());
- if (v != NULL)
- return v;
- }
+ if (v != NULL)
+ return v;
+ }
else if (ada_is_variant_part (type, i))
- {
+ {
/* PNH: Do we ever get here? See find_struct_field. */
- int j;
- struct type *field_type = ada_check_typedef (TYPE_FIELD_TYPE (type,
- i));
- int var_offset = offset + TYPE_FIELD_BITPOS (type, i) / 8;
-
- for (j = 0; j < TYPE_NFIELDS (field_type); j += 1)
- {
- struct value *v = ada_search_struct_field /* Force line
+ int j;
+ 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)
+ {
+ 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));
+ (name, arg,
+ var_offset + TYPE_FIELD_BITPOS (field_type, j) / 8,
+ field_type->field (j).type ());
- if (v != NULL)
- return v;
- }
- }
+ if (v != NULL)
+ return v;
+ }
+ }
}
/* Field not found so far. If this is a tagged type which
{
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;
+ return v;
}
return NULL;
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;
+ continue;
else if (ada_is_wrapper_field (type, i))
- {
- struct value *v = /* Do not let indent join lines here. */
- ada_index_struct_field_1 (index_p, arg,
+ {
+ 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;
- }
+ if (v != NULL)
+ return v;
+ }
else if (ada_is_variant_part (type, i))
- {
+ {
/* PNH: Do we ever get here? See ada_search_struct_field,
find_struct_field. */
error (_("Cannot assign this kind of variant record"));
- }
+ }
else if (*index_p == 0)
- return ada_value_primitive_field (arg, offset, i, type);
+ return ada_value_primitive_field (arg, offset, i, type);
else
*index_p -= 1;
}
static struct type *
ada_lookup_struct_elt_type (struct type *type, const char *name, int refok,
- int noerr)
+ int noerr)
{
int i;
int parent_offset = -1;
if (refok && type != NULL)
while (1)
{
- type = ada_check_typedef (type);
- if (type->code () != TYPE_CODE_PTR && type->code () != TYPE_CODE_REF)
- break;
- type = TYPE_TARGET_TYPE (type);
+ type = ada_check_typedef (type);
+ if (type->code () != TYPE_CODE_PTR && type->code () != TYPE_CODE_REF)
+ break;
+ type = TYPE_TARGET_TYPE (type);
}
if (type == NULL
&& type->code () != TYPE_CODE_UNION))
{
if (noerr)
- return NULL;
+ return NULL;
error (_("Type %s is not a structure or union type"),
type != NULL ? type_as_string (type).c_str () : _("(null)"));
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;
if (t_field_name == NULL)
- continue;
+ continue;
else if (ada_is_parent_field (type, i))
- {
+ {
/* This is a field pointing us to the parent type of a tagged
type. As hinted in this function's documentation, we give
preference to fields in the current record first, so what
in the current record, then we'll get back to it and search
inside it whether the field might exist in the parent. */
- parent_offset = i;
- continue;
- }
+ parent_offset = i;
+ continue;
+ }
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,
- 0, 1);
- if (t != NULL)
+ {
+ 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));
+ {
+ int j;
+ 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
+ NOT wrapped in a struct, since the compiler sometimes
generates these for unchecked variant types. Revisit
- if the compiler changes this practice. */
+ if the compiler changes this practice. */
const char *v_field_name = TYPE_FIELD_NAME (field_type, j);
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)
+ if (t != NULL)
return t;
- }
- }
+ }
+ }
}
if (parent_offset != -1)
{
- struct type *t;
+ struct type *t;
- t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (type, parent_offset),
- name, 0, 1);
- if (t != NULL)
+ 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;
+ others_clause = i;
else if (ada_in_variant (discrim_val, var_type, i))
- return i;
+ return i;
}
return others_clause;
\f
- /* Dynamic-Sized Records */
+ /* Dynamic-Sized Records */
/* Strategy: The type ostensibly attached to a value with dynamic size
(i.e., a size that is not statically recorded in the debugging
else if (ada_is_constrained_packed_array_type (type0))
return 1;
else if (ada_is_array_descriptor_type (type0)
- && !ada_is_array_descriptor_type (type1))
+ && !ada_is_array_descriptor_type (type1))
return 1;
else
{
const char *result_name = ada_type_name (result);
if (result_name == NULL)
- {
- warning (_("unexpected null name on descriptive type"));
- return NULL;
- }
+ {
+ warning (_("unexpected null name on descriptive type"));
+ return NULL;
+ }
/* If the names match, stop. */
if (strcmp (result_name, name) == 0)
int len = strlen (ada_type_name (type));
if (len > 6 && strcmp (ada_type_name (type) + len - 6, "___XVE") == 0)
- return type;
+ return type;
else
- return ada_find_parallel_type (type, "___XVE");
+ return ada_find_parallel_type (type, "___XVE");
}
}
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;
+ return f;
}
return -1;
}
struct type *type = alloc_type_copy (templ);
type->set_code (TYPE_CODE_STRUCT);
- TYPE_FIELDS (type) = NULL;
INIT_NONE_SPECIFIC (type);
type->set_name ("<empty>");
TYPE_LENGTH (type) = 0;
struct type *
ada_template_to_fixed_record_type_1 (struct type *type,
const gdb_byte *valaddr,
- CORE_ADDR address, struct value *dval0,
- int keep_dynamic_fields)
+ CORE_ADDR address, struct value *dval0,
+ int keep_dynamic_fields)
{
struct value *mark = value_mark ();
struct value *dval;
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)
- && !ada_is_variant_part (type, nfields)
- && !is_dynamic_field (type, nfields))
- nfields++;
+ 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);
rtype->set_num_fields (nfields);
- TYPE_FIELDS (rtype) = (struct field *)
- TYPE_ALLOC (rtype, nfields * sizeof (struct field));
- memset (TYPE_FIELDS (rtype), 0, sizeof (struct field) * nfields);
+ rtype->set_fields
+ ((struct field *) TYPE_ZALLOC (rtype, nfields * sizeof (struct field)));
rtype->set_name (ada_type_name (type));
- TYPE_FIXED_INSTANCE (rtype) = 1;
+ rtype->set_is_fixed_instance (true);
off = 0;
bit_len = 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))
- {
- variant_field = f;
- fld_bit_len = 0;
- }
+ {
+ variant_field = f;
+ fld_bit_len = 0;
+ }
else if (is_dynamic_field (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)
+ if (dval0 == NULL)
{
/* rtype's length is computed based on the run-time
value of discriminants. If the discriminants are not
address);
rtype = value_type (dval);
}
- else
- dval = dval0;
+ else
+ dval = dval0;
/* If the type referenced by this field is an aligner type, we need
to unwrap that aligner type, because its size might not be set.
record size. */
ada_ensure_varsize_limit (field_type);
- TYPE_FIELD_TYPE (rtype, f) = field_type;
- TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
+ 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
assuming that the maximum size is a reasonable value,
an overflow should not happen in practice. So rather than
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;
- }
+ fld_bit_len =
+ TYPE_LENGTH (rtype->field (f).type ()) * TARGET_CHAR_BIT;
+ }
else
- {
+ {
/* Note: If this field's type is a typedef, it is important
to preserve the typedef layer.
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);
- 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
+ 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,
if (field_type->code () == TYPE_CODE_TYPEDEF)
field_type = ada_typedef_target_type (field_type);
- fld_bit_len =
- TYPE_LENGTH (ada_check_typedef (field_type)) * TARGET_CHAR_BIT;
+ fld_bit_len =
+ TYPE_LENGTH (ada_check_typedef (field_type)) * TARGET_CHAR_BIT;
}
- }
+ }
if (off + fld_bit_len > bit_len)
- bit_len = off + fld_bit_len;
+ bit_len = off + fld_bit_len;
off += fld_bit_len;
TYPE_LENGTH (rtype) =
- align_up (bit_len, TARGET_CHAR_BIT) / TARGET_CHAR_BIT;
+ align_up (bit_len, TARGET_CHAR_BIT) / TARGET_CHAR_BIT;
}
/* We handle the variant part, if any, at the end because of certain
rtype = value_type (dval);
}
else
- dval = dval0;
+ dval = dval0;
branch_type =
- to_fixed_variant_branch_type
- (TYPE_FIELD_TYPE (type, variant_field),
- cond_offset_host (valaddr, off / TARGET_CHAR_BIT),
- cond_offset_target (address, off / TARGET_CHAR_BIT), dval);
+ to_fixed_variant_branch_type
+ (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];
+ {
+ 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;
- TYPE_FIELD_NAME (rtype, variant_field) = "S";
- fld_bit_len =
- TYPE_LENGTH (TYPE_FIELD_TYPE (rtype, variant_field)) *
- TARGET_CHAR_BIT;
- if (off + fld_bit_len > bit_len)
- bit_len = off + fld_bit_len;
- TYPE_LENGTH (rtype) =
- align_up (bit_len, TARGET_CHAR_BIT) / TARGET_CHAR_BIT;
- }
+ {
+ rtype->field (variant_field).set_type (branch_type);
+ TYPE_FIELD_NAME (rtype, variant_field) = "S";
+ fld_bit_len =
+ TYPE_LENGTH (rtype->field (variant_field).type ()) *
+ TARGET_CHAR_BIT;
+ if (off + fld_bit_len > bit_len)
+ bit_len = off + fld_bit_len;
+ TYPE_LENGTH (rtype) =
+ align_up (bit_len, TARGET_CHAR_BIT) / TARGET_CHAR_BIT;
+ }
}
/* According to exp_dbug.ads, the size of TYPE for variable-size records
static struct type *
template_to_fixed_record_type (struct type *type, const gdb_byte *valaddr,
- CORE_ADDR address, struct value *dval0)
+ CORE_ADDR address, struct value *dval0)
{
return ada_template_to_fixed_record_type_1 (type, valaddr,
- address, dval0, 1);
+ address, dval0, 1);
}
/* An ordinary record type in which ___XVL-convention fields and
int f;
/* No need no do anything if the input type is already fixed. */
- if (TYPE_FIXED_INSTANCE (type0))
+ if (type0->is_fixed_instance ())
return type0;
/* Likewise if we already have computed the static approximation. */
/* 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))
{
field_type = ada_check_typedef (field_type);
- new_type = to_static_fixed_type (TYPE_TARGET_TYPE (field_type));
+ new_type = to_static_fixed_type (TYPE_TARGET_TYPE (field_type));
}
else
- new_type = static_unwrap_type (field_type);
+ new_type = static_unwrap_type (field_type);
if (new_type != field_type)
{
type->set_code (type0->code ());
INIT_NONE_SPECIFIC (type);
type->set_num_fields (nfields);
- TYPE_FIELDS (type) = (struct field *)
- TYPE_ALLOC (type, nfields * sizeof (struct field));
- memcpy (TYPE_FIELDS (type), TYPE_FIELDS (type0),
+
+ field *fields =
+ ((struct field *)
+ TYPE_ALLOC (type, nfields * sizeof (struct field)));
+ memcpy (fields, type0->fields (),
sizeof (struct field) * nfields);
+ type->set_fields (fields);
+
type->set_name (ada_type_name (type0));
- TYPE_FIXED_INSTANCE (type) = 1;
+ type->set_is_fixed_instance (true);
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);
}
}
static struct type *
to_record_with_fixed_variant_part (struct type *type, const gdb_byte *valaddr,
- CORE_ADDR address, struct value *dval0)
+ CORE_ADDR address, struct value *dval0)
{
struct value *mark = value_mark ();
struct value *dval;
struct type *rtype;
struct type *branch_type;
- int nfields = TYPE_NFIELDS (type);
+ int nfields = type->num_fields ();
int variant_field = variant_field_index (type);
if (variant_field == -1)
rtype->set_code (TYPE_CODE_STRUCT);
INIT_NONE_SPECIFIC (rtype);
rtype->set_num_fields (nfields);
- TYPE_FIELDS (rtype) =
+
+ field *fields =
(struct field *) TYPE_ALLOC (rtype, nfields * sizeof (struct field));
- memcpy (TYPE_FIELDS (rtype), TYPE_FIELDS (type),
- sizeof (struct field) * nfields);
+ memcpy (fields, type->fields (), sizeof (struct field) * nfields);
+ rtype->set_fields (fields);
+
rtype->set_name (ada_type_name (type));
- TYPE_FIXED_INSTANCE (rtype) = 1;
+ rtype->set_is_fixed_instance (true);
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),
+ TYPE_FIELD_BITPOS (type, variant_field)
+ / TARGET_CHAR_BIT),
cond_offset_target (address,
- TYPE_FIELD_BITPOS (type, variant_field)
- / TARGET_CHAR_BIT), dval);
+ TYPE_FIELD_BITPOS (type, variant_field)
+ / TARGET_CHAR_BIT), dval);
if (branch_type == NULL)
{
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;
static struct type *
to_fixed_record_type (struct type *type0, const gdb_byte *valaddr,
- CORE_ADDR address, struct value *dval)
+ CORE_ADDR address, struct value *dval)
{
struct type *templ_type;
- if (TYPE_FIXED_INSTANCE (type0))
+ if (type0->is_fixed_instance ())
return type0;
templ_type = dynamic_template_type (type0);
else if (variant_field_index (type0) >= 0)
{
if (dval == NULL && valaddr == NULL && address == 0)
- return type0;
+ return type0;
return to_record_with_fixed_variant_part (type0, valaddr, address,
- dval);
+ dval);
}
else
{
- TYPE_FIXED_INSTANCE (type0) = 1;
+ type0->set_is_fixed_instance (true);
return type0;
}
static struct type *
to_fixed_variant_branch_type (struct type *var_type0, const gdb_byte *valaddr,
- CORE_ADDR address, struct value *dval)
+ CORE_ADDR address, struct value *dval)
{
int which;
struct type *templ_type;
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
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));
}
static struct type *
to_fixed_array_type (struct type *type0, struct value *dval,
- int ignore_too_big)
+ int ignore_too_big)
{
struct type *index_type_desc;
struct type *result;
static const char *xa_suffix = "___XA";
type0 = ada_check_typedef (type0);
- if (TYPE_FIXED_INSTANCE (type0))
+ if (type0->is_fixed_instance ())
return type0;
constrained_packed_array_p = ada_is_constrained_packed_array_type (type0);
if (constrained_packed_array_p)
- type0 = decode_constrained_packed_array_type (type0);
+ {
+ type0 = decode_constrained_packed_array_type (type0);
+ if (type0 == nullptr)
+ error (_("could not decode constrained packed array type"));
+ }
index_type_desc = ada_find_parallel_type (type0, xa_suffix);
struct type *elt_type0 = ada_check_typedef (TYPE_TARGET_TYPE (type0));
/* NOTE: elt_type---the fixed version of elt_type0---should never
- depend on the contents of the array in properly constructed
- debugging data. */
+ depend on the contents of the array in properly constructed
+ debugging data. */
/* Create a fixed version of the array element type.
- We're not providing the address of an element here,
- and thus the actual object value cannot be inspected to do
- the conversion. This should not be a problem, since arrays of
- unconstrained objects are not allowed. In particular, all
- the elements of an array of a tagged type should all be of
- the same type specified in the debugging info. No need to
- consult the object tag. */
+ We're not providing the address of an element here,
+ and thus the actual object value cannot be inspected to do
+ the conversion. This should not be a problem, since arrays of
+ unconstrained objects are not allowed. In particular, all
+ the elements of an array of a tagged type should all be of
+ the same type specified in the debugging info. No need to
+ consult the object tag. */
struct type *elt_type = ada_to_fixed_type (elt_type0, 0, 0, dval, 1);
/* Make sure we always create a new array type when dealing with
packed array types, since we're going to fix-up the array
type length and element bitsize a little further down. */
if (elt_type0 == elt_type && !constrained_packed_array_p)
- result = type0;
+ result = type0;
else
- result = create_array_type (alloc_type_copy (type0),
- elt_type, TYPE_INDEX_TYPE (type0));
+ result = create_array_type (alloc_type_copy (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)
- elt_type0 = TYPE_TARGET_TYPE (elt_type0);
+ 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
- depend on the contents of the array in properly constructed
- debugging data. */
+ depend on the contents of the array in properly constructed
+ debugging data. */
/* Create a fixed version of the array element type.
- We're not providing the address of an element here,
- and thus the actual object value cannot be inspected to do
- the conversion. This should not be a problem, since arrays of
- unconstrained objects are not allowed. In particular, all
- the elements of an array of a tagged type should all be of
- the same type specified in the debugging info. No need to
- consult the object tag. */
+ We're not providing the address of an element here,
+ and thus the actual object value cannot be inspected to do
+ the conversion. This should not be a problem, since arrays of
+ unconstrained objects are not allowed. In particular, all
+ the elements of an array of a tagged type should all be of
+ the same type specified in the debugging info. No need to
+ consult the object tag. */
result =
- ada_to_fixed_type (ada_check_typedef (elt_type0), 0, 0, dval, 1);
+ 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)
- {
- struct type *range_type =
- to_fixed_range_type (TYPE_FIELD_TYPE (index_type_desc, i), dval);
+ for (i = index_type_desc->num_fields () - 1; i >= 0; i -= 1)
+ {
+ struct type *range_type =
+ to_fixed_range_type (index_type_desc->field (i).type (), dval);
- result = create_array_type (alloc_type_copy (elt_type0),
- result, range_type);
+ result = create_array_type (alloc_type_copy (elt_type0),
+ result, range_type);
elt_type0 = TYPE_TARGET_TYPE (elt_type0);
- }
+ }
if (!ignore_too_big && TYPE_LENGTH (result) > varsize_limit)
- error (_("array type with dynamic size is larger than varsize-limit"));
+ error (_("array type with dynamic size is larger than varsize-limit"));
}
/* We want to preserve the type name. This can be useful when
TYPE_FIELD_BITSIZE (result, 0) = TYPE_FIELD_BITSIZE (type0, 0);
TYPE_LENGTH (result) = len * elt_bitsize / HOST_CHAR_BIT;
if (TYPE_LENGTH (result) * HOST_CHAR_BIT < len * elt_bitsize)
- TYPE_LENGTH (result)++;
+ TYPE_LENGTH (result)++;
}
- TYPE_FIXED_INSTANCE (result) = 1;
+ result->set_is_fixed_instance (true);
return result;
}
static struct type *
ada_to_fixed_type_1 (struct type *type, const gdb_byte *valaddr,
- CORE_ADDR address, struct value *dval, int check_tag)
+ CORE_ADDR address, struct value *dval, int check_tag)
{
type = ada_check_typedef (type);
return type;
case TYPE_CODE_STRUCT:
{
- struct type *static_type = to_static_fixed_type (type);
- struct type *fixed_record_type =
- to_fixed_record_type (type, valaddr, address, NULL);
-
- /* If STATIC_TYPE is a tagged type and we know the object's address,
- then we can determine its tag, and compute the object's actual
- type from there. Note that we have to use the fixed record
- type (the parent part of the record may have dynamic fields
- and the way the location of _tag is expressed may depend on
- them). */
-
- if (check_tag && address != 0 && ada_is_tagged_type (static_type, 0))
- {
+ struct type *static_type = to_static_fixed_type (type);
+ struct type *fixed_record_type =
+ to_fixed_record_type (type, valaddr, address, NULL);
+
+ /* If STATIC_TYPE is a tagged type and we know the object's address,
+ then we can determine its tag, and compute the object's actual
+ type from there. Note that we have to use the fixed record
+ type (the parent part of the record may have dynamic fields
+ and the way the location of _tag is expressed may depend on
+ them). */
+
+ if (check_tag && address != 0 && ada_is_tagged_type (static_type, 0))
+ {
struct value *tag =
value_tag_from_contents_and_address
(fixed_record_type,
value_from_contents_and_address (fixed_record_type,
valaddr,
address);
- fixed_record_type = value_type (obj);
- if (real_type != NULL)
- return to_fixed_record_type
+ fixed_record_type = value_type (obj);
+ if (real_type != NULL)
+ return to_fixed_record_type
(real_type, NULL,
value_address (ada_tag_value_at_base_address (obj)), NULL);
- }
-
- /* Check to see if there is a parallel ___XVZ variable.
- If there is, then it provides the actual size of our type. */
- else if (ada_type_name (fixed_record_type) != NULL)
- {
- const char *name = ada_type_name (fixed_record_type);
- char *xvz_name
+ }
+
+ /* Check to see if there is a parallel ___XVZ variable.
+ If there is, then it provides the actual size of our type. */
+ else if (ada_type_name (fixed_record_type) != NULL)
+ {
+ const char *name = ada_type_name (fixed_record_type);
+ char *xvz_name
= (char *) alloca (strlen (name) + 7 /* "___XVZ\0" */);
bool xvz_found = false;
- LONGEST size;
+ LONGEST size;
- xsnprintf (xvz_name, strlen (name) + 7, "%s___XVZ", name);
+ xsnprintf (xvz_name, strlen (name) + 7, "%s___XVZ", name);
try
{
xvz_found = get_int_var_value (xvz_name, size);
xvz_name, except.what ());
}
- if (xvz_found && TYPE_LENGTH (fixed_record_type) != size)
- {
- fixed_record_type = copy_type (fixed_record_type);
- TYPE_LENGTH (fixed_record_type) = size;
-
- /* The FIXED_RECORD_TYPE may have be a stub. We have
- observed this when the debugging info is STABS, and
- apparently it is something that is hard to fix.
-
- In practice, we don't need the actual type definition
- at all, because the presence of the XVZ variable allows us
- to assume that there must be a XVS type as well, which we
- should be able to use later, when we need the actual type
- definition.
-
- In the meantime, pretend that the "fixed" type we are
- returning is NOT a stub, because this can cause trouble
- when using this type to create new types targeting it.
- Indeed, the associated creation routines often check
- whether the target type is a stub and will try to replace
- it, thus using a type with the wrong size. This, in turn,
- might cause the new type to have the wrong size too.
- Consider the case of an array, for instance, where the size
- of the array is computed from the number of elements in
- our array multiplied by the size of its element. */
- TYPE_STUB (fixed_record_type) = 0;
- }
- }
- return fixed_record_type;
+ if (xvz_found && TYPE_LENGTH (fixed_record_type) != size)
+ {
+ fixed_record_type = copy_type (fixed_record_type);
+ TYPE_LENGTH (fixed_record_type) = size;
+
+ /* The FIXED_RECORD_TYPE may have be a stub. We have
+ observed this when the debugging info is STABS, and
+ apparently it is something that is hard to fix.
+
+ In practice, we don't need the actual type definition
+ at all, because the presence of the XVZ variable allows us
+ to assume that there must be a XVS type as well, which we
+ should be able to use later, when we need the actual type
+ definition.
+
+ In the meantime, pretend that the "fixed" type we are
+ returning is NOT a stub, because this can cause trouble
+ when using this type to create new types targeting it.
+ Indeed, the associated creation routines often check
+ whether the target type is a stub and will try to replace
+ it, thus using a type with the wrong size. This, in turn,
+ might cause the new type to have the wrong size too.
+ Consider the case of an array, for instance, where the size
+ of the array is computed from the number of elements in
+ our array multiplied by the size of its element. */
+ fixed_record_type->set_is_stub (false);
+ }
+ }
+ return fixed_record_type;
}
case TYPE_CODE_ARRAY:
return to_fixed_array_type (type, dval, 1);
case TYPE_CODE_UNION:
if (dval == NULL)
- return type;
+ return type;
else
- return to_fixed_variant_branch_type (type, valaddr, address, dval);
+ return to_fixed_variant_branch_type (type, valaddr, address, dval);
}
}
struct type *
ada_to_fixed_type (struct type *type, const gdb_byte *valaddr,
- CORE_ADDR address, struct value *dval, int check_tag)
+ CORE_ADDR address, struct value *dval, int check_tag)
{
struct type *fixed_type =
if (type0 == NULL)
return NULL;
- if (TYPE_FIXED_INSTANCE (type0))
+ if (type0->is_fixed_instance ())
return type0;
type0 = ada_check_typedef (type0);
case TYPE_CODE_STRUCT:
type = dynamic_template_type (type0);
if (type != NULL)
- return template_to_static_fixed_type (type);
+ return template_to_static_fixed_type (type);
else
- return template_to_static_fixed_type (type0);
+ return template_to_static_fixed_type (type0);
case TYPE_CODE_UNION:
type = ada_find_parallel_type (type0, "___XVU");
if (type != NULL)
- return template_to_static_fixed_type (type);
+ return template_to_static_fixed_type (type);
else
- return template_to_static_fixed_type (type0);
+ return template_to_static_fixed_type (type0);
}
}
{
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));
struct type *raw_real_type = ada_get_base_type (type);
if (raw_real_type == type)
- return type;
+ return type;
else
- return to_static_fixed_type (raw_real_type);
+ return to_static_fixed_type (raw_real_type);
}
}
type = check_typedef (type);
if (type == NULL || type->code () != TYPE_CODE_ENUM
- || !TYPE_STUB (type)
+ || !type->is_stub ()
|| type->name () == NULL)
return type;
else
struct type *type1 = ada_find_any_type (name);
if (type1 == NULL)
- return type;
+ return type;
/* TYPE1 might itself be a TYPE_CODE_TYPEDEF (this can happen with
stubs pointing to arrays, as we don't create symbols for array
static struct value *
ada_to_fixed_value_create (struct type *type0, CORE_ADDR address,
- struct value *val0)
+ struct value *val0)
{
struct type *type = ada_to_fixed_type (type0, 0, address, NULL, 1);
/* Table mapping attribute numbers to names.
NOTE: Keep up to date with enum ada_attribute definition in ada-lang.h. */
-static const char *attribute_names[] = {
+static const char * const attribute_names[] = {
"<?>",
"first",
/* 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
- /* Evaluation */
+ /* Evaluation */
/* True if TYPE appears to be an Ada character type.
[At the moment, this is true only for Character and Wide_Character;
with a known character type name. */
name = ada_type_name (type);
return (name != NULL
- && (type->code () == TYPE_CODE_INT
- || type->code () == TYPE_CODE_RANGE)
- && (strcmp (name, "character") == 0
- || strcmp (name, "wide_character") == 0
- || strcmp (name, "wide_wide_character") == 0
- || strcmp (name, "unsigned char") == 0));
+ && (type->code () == TYPE_CODE_INT
+ || type->code () == TYPE_CODE_RANGE)
+ && (strcmp (name, "character") == 0
+ || strcmp (name, "wide_character") == 0
+ || strcmp (name, "wide_wide_character") == 0
+ || strcmp (name, "unsigned char") == 0));
}
/* True if TYPE appears to be an Ada string type. */
if (type != NULL
&& type->code () != TYPE_CODE_PTR
&& (ada_is_simple_array_type (type)
- || ada_is_array_descriptor_type (type))
+ || ada_is_array_descriptor_type (type))
&& ada_array_arity (type) == 1)
{
struct type *elttype = ada_array_element_type (type, 1);
return 0;
return (type->code () == TYPE_CODE_STRUCT
- && TYPE_NFIELDS (type) == 1
- && strcmp (TYPE_FIELD_NAME (type, 0), "F") == 0);
+ && type->num_fields () == 1
+ && strcmp (TYPE_FIELD_NAME (type, 0), "F") == 0);
}
/* If there is an ___XVS-convention type parallel to SUBTYPE, return
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),
- valaddr +
- TYPE_FIELD_BITPOS (type,
- 0) / TARGET_CHAR_BIT);
+ return ada_aligned_value_addr (type->field (0).type (),
+ valaddr +
+ TYPE_FIELD_BITPOS (type,
+ 0) / TARGET_CHAR_BIT);
else
return valaddr;
}
else
{
while ((tmp = strstr (name, "__")) != NULL)
- {
- if (isdigit (tmp[2]))
- break;
- else
- name = tmp + 2;
- }
+ {
+ if (isdigit (tmp[2]))
+ break;
+ else
+ name = tmp + 2;
+ }
}
if (name[0] == 'Q')
int v;
if (name[1] == 'U' || name[1] == 'W')
- {
- if (sscanf (name + 2, "%x", &v) != 1)
- return name;
- }
+ {
+ if (sscanf (name + 2, "%x", &v) != 1)
+ return name;
+ }
else if (((name[1] >= '0' && name[1] <= '9')
|| (name[1] >= 'a' && name[1] <= 'z'))
&& name[2] == '\0')
return result;
}
else
- return name;
+ return name;
GROW_VECT (result, result_len, 16);
if (isascii (v) && isprint (v))
- xsnprintf (result, result_len, "'%c'", v);
+ xsnprintf (result, result_len, "'%c'", v);
else if (name[1] == 'U')
- xsnprintf (result, result_len, "[\"%02x\"]", v);
+ xsnprintf (result, result_len, "[\"%02x\"]", v);
else
- xsnprintf (result, result_len, "[\"%04x\"]", v);
+ xsnprintf (result, result_len, "[\"%04x\"]", v);
return result;
}
if (tmp == NULL)
tmp = strstr (name, "$");
if (tmp != NULL)
- {
- GROW_VECT (result, result_len, tmp - name + 1);
- strncpy (result, name, tmp - name);
- result[tmp - name] = '\0';
- return result;
- }
+ {
+ GROW_VECT (result, result_len, tmp - name + 1);
+ strncpy (result, name, tmp - name);
+ result[tmp - name] = '\0';
+ return result;
+ }
return name;
}
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
else
{
struct type *raw_real_type =
- ada_check_typedef (ada_get_base_type (type));
+ ada_check_typedef (ada_get_base_type (type));
/* If there is no parallel XVS or XVE type, then the value is
already unwrapped. Return it without further modification. */
return val;
return
- coerce_unspec_val_to_type
- (val, ada_to_fixed_type (raw_real_type, 0,
- value_address (val),
- NULL, 1));
+ coerce_unspec_val_to_type
+ (val, ada_to_fixed_type (raw_real_type, 0,
+ value_address (val),
+ NULL, 1));
}
}
static struct value *
-cast_from_fixed (struct type *type, struct value *arg)
+cast_from_gnat_encoded_fixed_point_type (struct type *type, struct value *arg)
{
- struct value *scale = ada_scaling_factor (value_type (arg));
+ struct value *scale
+ = gnat_encoded_fixed_point_scaling_factor (value_type (arg));
arg = value_cast (value_type (scale), arg);
arg = value_binop (arg, scale, BINOP_MUL);
}
static struct value *
-cast_to_fixed (struct type *type, struct value *arg)
+cast_to_gnat_encoded_fixed_point_type (struct type *type, struct value *arg)
{
if (type == value_type (arg))
return arg;
- struct value *scale = ada_scaling_factor (type);
+ struct value *scale = gnat_encoded_fixed_point_scaling_factor (type);
if (ada_is_gnat_encoded_fixed_point_type (value_type (arg)))
- arg = cast_from_fixed (value_type (scale), arg);
+ arg = cast_from_gnat_encoded_fixed_point_type (value_type (scale), arg);
else
arg = value_cast (value_type (scale), arg);
}
if (TYPE_LENGTH (TYPE_TARGET_TYPE (type2))
- != TYPE_LENGTH (TYPE_TARGET_TYPE (type)))
- error (_("Incompatible types in assignment"));
+ != TYPE_LENGTH (TYPE_TARGET_TYPE (type)))
+ error (_("Incompatible types in assignment"));
deprecated_set_value_type (val, type);
}
return val;
if (v2 == 0)
error (_("second operand of %s must not be zero."), op_string (op));
- if (TYPE_UNSIGNED (type1) || op == BINOP_MOD)
+ if (type1->is_unsigned () || op == BINOP_MOD)
return value_binop (arg1, arg2, op);
v1 = value_as_long (arg1);
case BINOP_DIV:
v = v1 / v2;
if (!TRUNCATION_TOWARDS_ZERO && v1 * (v1 % v2) < 0)
- v += v > 0 ? -1 : 1;
+ v += v > 0 ? -1 : 1;
break;
case BINOP_REM:
v = v1 % v2;
if (v * v1 < 0)
- v -= v2;
+ v -= v2;
break;
default:
/* Should not reach this point. */
val = allocate_value (type1);
store_unsigned_integer (value_contents_raw (val),
- TYPE_LENGTH (value_type (val)),
+ TYPE_LENGTH (value_type (val)),
type_byte_order (type1), v);
return val;
}
struct type *arg1_type, *arg2_type;
/* Automatically dereference any array reference before
- we attempt to perform the comparison. */
+ we attempt to perform the comparison. */
arg1 = ada_coerce_ref (arg1);
arg2 = ada_coerce_ref (arg2);
arg2_type = ada_check_typedef (value_type (arg2));
if (arg1_type->code () != TYPE_CODE_ARRAY
- || arg2_type->code () != TYPE_CODE_ARRAY)
- error (_("Attempt to compare array with non-array"));
+ || arg2_type->code () != TYPE_CODE_ARRAY)
+ error (_("Attempt to compare array with non-array"));
/* FIXME: The following works only for types whose
- representations use all bits (no padding or undefined bits)
- and do not have user-defined equality. */
+ representations use all bits (no padding or undefined bits)
+ and do not have user-defined equality. */
return (TYPE_LENGTH (arg1_type) == TYPE_LENGTH (arg2_type)
&& memcmp (value_contents (arg1), value_contents (arg2),
TYPE_LENGTH (arg1_type)) == 0);
{
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)
{
return arg2;
if (ada_is_gnat_encoded_fixed_point_type (type))
- return cast_to_fixed (type, arg2);
+ return cast_to_gnat_encoded_fixed_point_type (type, arg2);
if (ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
- return cast_from_fixed (type, arg2);
+ return cast_from_gnat_encoded_fixed_point_type (type, arg2);
return value_cast (type, arg2);
}
known. Consider for instance a variant record:
type Rec (Empty : Boolean := True) is record
- case Empty is
- when True => null;
- when False => Value : Integer;
- end case;
+ case Empty is
+ when True => null;
+ when False => Value : Integer;
+ end case;
end record;
Yes : Rec := (Empty => False, Value => 1);
No : Rec := (empty => True);
type would look like this:
type Rec is record
- Empty : Boolean;
- Value : Integer;
+ Empty : Boolean;
+ Value : Integer;
end record;
On the other hand, if we printed the value of "No", its fixed type
would become:
type Rec is record
- Empty : Boolean;
+ Empty : Boolean;
end record;
Things become a little more complicated when trying to fix an entity
The simplest case is when we have an array of a constrained element
type. For instance, consider the following type declarations:
- type Bounded_String (Max_Size : Integer) is
- Length : Integer;
- Buffer : String (1 .. Max_Size);
- end record;
- type Bounded_String_Array is array (1 ..2) of Bounded_String (80);
+ type Bounded_String (Max_Size : Integer) is
+ Length : Integer;
+ Buffer : String (1 .. Max_Size);
+ end record;
+ type Bounded_String_Array is array (1 ..2) of Bounded_String (80);
In this case, the compiler describes the array as an array of
variable-size elements (identified by its XVS suffix) for which
But there are cases when this size is not statically known.
For instance, assuming that "Five" is an integer variable:
- type Dynamic is array (1 .. Five) of Integer;
- type Wrapper (Has_Length : Boolean := False) is record
- Data : Dynamic;
- case Has_Length is
- when True => Length : Integer;
- when False => null;
- end case;
- end record;
- type Wrapper_Array is array (1 .. 2) of Wrapper;
+ type Dynamic is array (1 .. Five) of Integer;
+ type Wrapper (Has_Length : Boolean := False) is record
+ Data : Dynamic;
+ case Has_Length is
+ when True => Length : Integer;
+ when False => null;
+ end case;
+ end record;
+ type Wrapper_Array is array (1 .. 2) of Wrapper;
- Hello : Wrapper_Array := (others => (Has_Length => True,
- Data => (others => 17),
- Length => 1));
+ Hello : Wrapper_Array := (others => (Has_Length => True,
+ Data => (others => 17),
+ Length => 1));
The debugging info would describe variable Hello as being an
Consider for instance the example:
- type Bounded_String (Max_Size : Natural) is record
- Str : String (1 .. Max_Size);
- Length : Natural;
- end record;
- My_String : Bounded_String (Max_Size => 10);
+ type Bounded_String (Max_Size : Natural) is record
+ Str : String (1 .. Max_Size);
+ Length : Natural;
+ end record;
+ My_String : Bounded_String (Max_Size => 10);
In that case, the position of field "Length" depends on the size
of field Str, which itself depends on the value of the Max_Size
(assuming type Rec above):
type Container (Big : Boolean) is record
- First : Rec;
- After : Integer;
- case Big is
- when True => Another : Integer;
- when False => null;
- end case;
+ First : Rec;
+ After : Integer;
+ case Big is
+ when True => Another : Integer;
+ when False => null;
+ end case;
end record;
My_Container : Container := (Big => False,
- First => (Empty => True),
- After => 42);
+ First => (Empty => True),
+ After => 42);
In that example, the compiler creates a PAD type for component First,
whose size is constant, and then positions the component After just
we might end up with the wrong size for our component. This can be
observed with the following type declarations:
- type Octal is new Integer range 0 .. 7;
- type Octal_Array is array (Positive range <>) of Octal;
- pragma Pack (Octal_Array);
+ type Octal is new Integer range 0 .. 7;
+ type Octal_Array is array (Positive range <>) of Octal;
+ pragma Pack (Octal_Array);
- type Octal_Buffer (Size : Positive) is record
- Buffer : Octal_Array (1 .. Size);
- Length : Integer;
- end record;
+ type Octal_Buffer (Size : Positive) is record
+ Buffer : Octal_Array (1 .. Size);
+ Length : Integer;
+ end record;
In that case, Buffer is a PAD type whose size is unset and needs
to be computed by fixing the unwrapped type.
value *val;
if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE)
- {
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (to_type, not_lval);
-
- val = evaluate_var_msym_value (noside,
- exp->elts[pc + 1].objfile,
- exp->elts[pc + 2].msymbol);
- }
+ {
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (to_type, not_lval);
+
+ val = evaluate_var_msym_value (noside,
+ exp->elts[pc + 1].objfile,
+ exp->elts[pc + 2].msymbol);
+ }
else
- val = evaluate_var_value (noside,
- exp->elts[pc + 1].block,
- exp->elts[pc + 2].symbol);
+ val = evaluate_var_value (noside,
+ exp->elts[pc + 1].block,
+ exp->elts[pc + 2].symbol);
if (noside == EVAL_SKIP)
- return eval_skip_value (exp);
+ return eval_skip_value (exp);
val = ada_value_cast (to_type, val);
/* Follow the Ada language semantics that do not allow taking
an address of the result of a cast (view conversion in Ada). */
if (VALUE_LVAL (val) == lval_memory)
- {
- if (value_lazy (val))
- value_fetch_lazy (val);
- VALUE_LVAL (val) = not_lval;
- }
+ {
+ if (value_lazy (val))
+ value_fetch_lazy (val);
+ VALUE_LVAL (val) = not_lval;
+ }
return val;
}
static struct value *
ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
- int *pos, enum noside noside)
+ int *pos, enum noside noside)
{
enum exp_opcode op;
int tem;
arg1 = unwrap_value (arg1);
/* If evaluating an OP_FLOAT and an EXPECT_TYPE was provided,
- then we need to perform the conversion manually, because
- evaluate_subexp_standard doesn't do it. This conversion is
- necessary in Ada because the different kinds of float/fixed
- types in Ada have different representations.
+ then we need to perform the conversion manually, because
+ evaluate_subexp_standard doesn't do it. This conversion is
+ necessary in Ada because the different kinds of float/fixed
+ types in Ada have different representations.
- Similarly, we need to perform the conversion from OP_LONG
- ourselves. */
+ Similarly, we need to perform the conversion from OP_LONG
+ ourselves. */
if ((op == OP_FLOAT || op == OP_LONG) && expect_type != NULL)
- arg1 = ada_value_cast (expect_type, arg1);
+ arg1 = ada_value_cast (expect_type, arg1);
return arg1;
case OP_STRING:
{
- struct value *result;
-
- *pos -= 1;
- result = evaluate_subexp_standard (expect_type, exp, pos, noside);
- /* The result type will have code OP_STRING, bashed there from
- OP_ARRAY. Bash it back. */
- if (value_type (result)->code () == TYPE_CODE_STRING)
- value_type (result)->set_code (TYPE_CODE_ARRAY);
- return result;
+ struct value *result;
+
+ *pos -= 1;
+ result = evaluate_subexp_standard (expect_type, exp, pos, noside);
+ /* The result type will have code OP_STRING, bashed there from
+ OP_ARRAY. Bash it back. */
+ if (value_type (result)->code () == TYPE_CODE_STRING)
+ value_type (result)->set_code (TYPE_CODE_ARRAY);
+ return result;
}
case UNOP_CAST:
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);
return ada_value_assign (arg1, arg1);
}
/* Force the evaluation of the rhs ARG2 to the type of the lhs ARG1,
- except if the lhs of our assignment is a convenience variable.
- In the case of assigning to a convenience variable, the lhs
- should be exactly the result of the evaluation of the rhs. */
+ except if the lhs of our assignment is a convenience variable.
+ In the case of assigning to a convenience variable, the lhs
+ should be exactly the result of the evaluation of the rhs. */
type = value_type (arg1);
if (VALUE_LVAL (arg1) == lval_internalvar)
- type = NULL;
+ type = NULL;
arg2 = evaluate_subexp (type, exp, pos, noside);
if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
- return arg1;
+ return arg1;
if (VALUE_LVAL (arg1) == lval_internalvar)
{
/* Nothing. */
}
else if (ada_is_gnat_encoded_fixed_point_type (value_type (arg1)))
- arg2 = cast_to_fixed (value_type (arg1), arg2);
+ arg2 = cast_to_gnat_encoded_fixed_point_type (value_type (arg1), arg2);
else if (ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
- error
- (_("Fixed-point values must be assigned to fixed-point variables"));
+ error
+ (_("Fixed-point values must be assigned to fixed-point variables"));
else
- arg2 = coerce_for_assign (value_type (arg1), arg2);
+ arg2 = coerce_for_assign (value_type (arg1), arg2);
return ada_value_assign (arg1, arg2);
case BINOP_ADD:
arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
if (noside == EVAL_SKIP)
- goto nosideret;
+ goto nosideret;
if (value_type (arg1)->code () == TYPE_CODE_PTR)
- return (value_from_longest
- (value_type (arg1),
- value_as_long (arg1) + value_as_long (arg2)));
+ return (value_from_longest
+ (value_type (arg1),
+ value_as_long (arg1) + value_as_long (arg2)));
if (value_type (arg2)->code () == TYPE_CODE_PTR)
- return (value_from_longest
- (value_type (arg2),
- value_as_long (arg1) + value_as_long (arg2)));
+ return (value_from_longest
+ (value_type (arg2),
+ value_as_long (arg1) + value_as_long (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"));
+ || 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
- argument. We cannot cast the result to a reference type, so if
- ARG1 is a reference type, find its underlying type. */
+ argument. We cannot cast the result to a reference type, so if
+ ARG1 is a reference type, find its underlying type. */
type = value_type (arg1);
while (type->code () == TYPE_CODE_REF)
- type = TYPE_TARGET_TYPE (type);
+ type = TYPE_TARGET_TYPE (type);
binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
return value_cast (type, value_binop (arg1, arg2, BINOP_ADD));
arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
if (noside == EVAL_SKIP)
- goto nosideret;
+ goto nosideret;
if (value_type (arg1)->code () == TYPE_CODE_PTR)
- return (value_from_longest
- (value_type (arg1),
- value_as_long (arg1) - value_as_long (arg2)));
+ return (value_from_longest
+ (value_type (arg1),
+ value_as_long (arg1) - value_as_long (arg2)));
if (value_type (arg2)->code () == TYPE_CODE_PTR)
- return (value_from_longest
- (value_type (arg2),
- value_as_long (arg1) - value_as_long (arg2)));
+ return (value_from_longest
+ (value_type (arg2),
+ value_as_long (arg1) - value_as_long (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 "
+ || 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"));
/* Do the substraction, and cast the result to the type of the first
- argument. We cannot cast the result to a reference type, so if
- ARG1 is a reference type, find its underlying type. */
+ argument. We cannot cast the result to a reference type, so if
+ ARG1 is a reference type, find its underlying type. */
type = value_type (arg1);
while (type->code () == TYPE_CODE_REF)
- type = TYPE_TARGET_TYPE (type);
+ type = TYPE_TARGET_TYPE (type);
binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
return value_cast (type, value_binop (arg1, arg2, BINOP_SUB));
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;
+ goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
- return value_zero (value_type (arg1), not_lval);
- }
+ {
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ return value_zero (value_type (arg1), not_lval);
+ }
else
- {
- type = builtin_type (exp->gdbarch)->builtin_double;
- if (ada_is_gnat_encoded_fixed_point_type (value_type (arg1)))
- arg1 = cast_from_fixed (type, arg1);
- 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);
- }
+ {
+ type = builtin_type (exp->gdbarch)->builtin_double;
+ if (ada_is_gnat_encoded_fixed_point_type (value_type (arg1)))
+ arg1 = cast_from_gnat_encoded_fixed_point_type (type, arg1);
+ if (ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
+ arg2 = cast_from_gnat_encoded_fixed_point_type (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;
+ goto nosideret;
if (noside == EVAL_AVOID_SIDE_EFFECTS)
- tem = 0;
+ tem = 0;
else
{
binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
tem = ada_value_equal (arg1, arg2);
}
if (op == BINOP_NOTEQUAL)
- tem = !tem;
+ tem = !tem;
type = language_bool_type (exp->language_defn, exp->gdbarch);
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;
+ goto nosideret;
else if (ada_is_gnat_encoded_fixed_point_type (value_type (arg1)))
- return value_cast (value_type (arg1), value_neg (arg1));
+ return value_cast (value_type (arg1), value_neg (arg1));
else
{
unop_promote (exp->language_defn, exp->gdbarch, &arg1);
case BINOP_LOGICAL_OR:
case UNOP_LOGICAL_NOT:
{
- struct value *val;
+ struct value *val;
- *pos -= 1;
- val = evaluate_subexp_standard (expect_type, exp, pos, noside);
+ *pos -= 1;
+ val = evaluate_subexp_standard (expect_type, exp, pos, noside);
type = language_bool_type (exp->language_defn, exp->gdbarch);
- return value_cast (type, val);
+ return value_cast (type, val);
}
case BINOP_BITWISE_AND:
case BINOP_BITWISE_IOR:
case BINOP_BITWISE_XOR:
{
- struct value *val;
+ struct value *val;
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
- *pos = pc;
- val = evaluate_subexp_standard (expect_type, exp, pos, noside);
+ 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);
+ return value_cast (value_type (arg1), val);
}
case OP_VAR_VALUE:
*pos -= 1;
if (noside == EVAL_SKIP)
- {
- *pos += 4;
- goto nosideret;
- }
+ {
+ *pos += 4;
+ goto nosideret;
+ }
if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
- /* Only encountered when an unresolved symbol occurs in a
- context other than a function call, in which case, it is
- invalid. */
- error (_("Unexpected unresolved symbol, %s, during evaluation"),
- exp->elts[pc + 2].symbol->print_name ());
+ /* Only encountered when an unresolved symbol occurs in a
+ context other than a function call, in which case, it is
+ invalid. */
+ error (_("Unexpected unresolved symbol, %s, during evaluation"),
+ exp->elts[pc + 2].symbol->print_name ());
if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- type = static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
- /* Check to see if this is a tagged type. We also need to handle
- the case where the type is a reference to a tagged type, but
- we have to be careful to exclude pointers to tagged types.
- The latter should be shown as usual (as a pointer), whereas
- a reference should mostly be transparent to the user. */
- if (ada_is_tagged_type (type, 0)
- || (type->code () == TYPE_CODE_REF
- && ada_is_tagged_type (TYPE_TARGET_TYPE (type), 0)))
+ {
+ type = static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
+ /* Check to see if this is a tagged type. We also need to handle
+ the case where the type is a reference to a tagged type, but
+ we have to be careful to exclude pointers to tagged types.
+ The latter should be shown as usual (as a pointer), whereas
+ a reference should mostly be transparent to the user. */
+ if (ada_is_tagged_type (type, 0)
+ || (type->code () == TYPE_CODE_REF
+ && ada_is_tagged_type (TYPE_TARGET_TYPE (type), 0)))
{
/* Tagged types are a little special in the fact that the real
type is dynamic and can only be determined by inspecting the
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)
{
*pos += 4;
return value_zero (to_static_fixed_type (type), not_lval);
}
- }
+ }
arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
return ada_to_fixed_value (arg1);
(*pos) += 2;
/* Allocate arg vector, including space for the function to be
- called in argvec[0] and a terminating NULL. */
+ called in argvec[0] and a terminating NULL. */
nargs = longest_to_int (exp->elts[pc + 1].longconst);
argvec = XALLOCAVEC (struct value *, nargs + 2);
if (exp->elts[*pos].opcode == OP_VAR_VALUE
- && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
- error (_("Unexpected unresolved symbol, %s, during evaluation"),
- exp->elts[pc + 5].symbol->print_name ());
+ && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
+ error (_("Unexpected unresolved symbol, %s, during evaluation"),
+ exp->elts[pc + 5].symbol->print_name ());
else
- {
- for (tem = 0; tem <= nargs; tem += 1)
- argvec[tem] = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- argvec[tem] = 0;
+ {
+ for (tem = 0; tem <= nargs; tem += 1)
+ argvec[tem] = evaluate_subexp (nullptr, exp, pos, noside);
+ argvec[tem] = 0;
- if (noside == EVAL_SKIP)
- goto nosideret;
- }
+ if (noside == EVAL_SKIP)
+ goto nosideret;
+ }
if (ada_is_constrained_packed_array_type
(desc_base_type (value_type (argvec[0]))))
- argvec[0] = ada_coerce_to_simple_array (argvec[0]);
+ argvec[0] = ada_coerce_to_simple_array (argvec[0]);
else if (value_type (argvec[0])->code () == TYPE_CODE_ARRAY
- && TYPE_FIELD_BITSIZE (value_type (argvec[0]), 0) != 0)
- /* This is a packed array that has already been fixed, and
+ && TYPE_FIELD_BITSIZE (value_type (argvec[0]), 0) != 0)
+ /* This is a packed array that has already been fixed, and
therefore already coerced to a simple array. Nothing further
to do. */
- ;
+ ;
else if (value_type (argvec[0])->code () == TYPE_CODE_REF)
{
/* Make sure we dereference references so that all the code below
type = ada_typedef_target_type (type);
if (type->code () == TYPE_CODE_PTR)
- {
- switch (ada_check_typedef (TYPE_TARGET_TYPE (type))->code ())
- {
- case TYPE_CODE_FUNC:
- type = ada_check_typedef (TYPE_TARGET_TYPE (type));
- break;
- case TYPE_CODE_ARRAY:
- break;
- case TYPE_CODE_STRUCT:
- if (noside != EVAL_AVOID_SIDE_EFFECTS)
- argvec[0] = ada_value_ind (argvec[0]);
- type = ada_check_typedef (TYPE_TARGET_TYPE (type));
- break;
- default:
- error (_("cannot subscript or call something of type `%s'"),
- ada_type_name (value_type (argvec[0])));
- break;
- }
- }
-
- switch (type->code ())
- {
- case TYPE_CODE_FUNC:
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ switch (ada_check_typedef (TYPE_TARGET_TYPE (type))->code ())
{
- if (TYPE_TARGET_TYPE (type) == NULL)
- error_call_unknown_return_type (NULL);
- return allocate_value (TYPE_TARGET_TYPE (type));
- }
- return call_function_by_hand (argvec[0], NULL,
+ case TYPE_CODE_FUNC:
+ type = ada_check_typedef (TYPE_TARGET_TYPE (type));
+ break;
+ case TYPE_CODE_ARRAY:
+ break;
+ case TYPE_CODE_STRUCT:
+ if (noside != EVAL_AVOID_SIDE_EFFECTS)
+ argvec[0] = ada_value_ind (argvec[0]);
+ type = ada_check_typedef (TYPE_TARGET_TYPE (type));
+ break;
+ default:
+ error (_("cannot subscript or call something of type `%s'"),
+ ada_type_name (value_type (argvec[0])));
+ break;
+ }
+ }
+
+ switch (type->code ())
+ {
+ case TYPE_CODE_FUNC:
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ if (TYPE_TARGET_TYPE (type) == NULL)
+ error_call_unknown_return_type (NULL);
+ return allocate_value (TYPE_TARGET_TYPE (type));
+ }
+ return call_function_by_hand (argvec[0], NULL,
gdb::make_array_view (argvec + 1,
nargs));
case TYPE_CODE_INTERNAL_FUNCTION:
return call_internal_function (exp->gdbarch, exp->language_defn,
argvec[0], nargs, argvec + 1);
- case TYPE_CODE_STRUCT:
- {
- int arity;
-
- arity = ada_array_arity (type);
- type = ada_array_element_type (type, nargs);
- if (type == NULL)
- error (_("cannot subscript or call a record"));
- if (arity != nargs)
- error (_("wrong number of subscripts; expecting %d"), arity);
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (ada_aligned_type (type), lval_memory);
- return
- unwrap_value (ada_value_subscript
- (argvec[0], nargs, argvec + 1));
- }
- case TYPE_CODE_ARRAY:
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- type = ada_array_element_type (type, nargs);
- if (type == NULL)
- error (_("element type of array unknown"));
- else
- return value_zero (ada_aligned_type (type), lval_memory);
- }
- return
- unwrap_value (ada_value_subscript
- (ada_coerce_to_simple_array (argvec[0]),
- nargs, argvec + 1));
- case TYPE_CODE_PTR: /* Pointer to array */
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
+ case TYPE_CODE_STRUCT:
+ {
+ int arity;
+
+ arity = ada_array_arity (type);
+ type = ada_array_element_type (type, nargs);
+ if (type == NULL)
+ error (_("cannot subscript or call a record"));
+ if (arity != nargs)
+ error (_("wrong number of subscripts; expecting %d"), arity);
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (ada_aligned_type (type), lval_memory);
+ return
+ unwrap_value (ada_value_subscript
+ (argvec[0], nargs, argvec + 1));
+ }
+ case TYPE_CODE_ARRAY:
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ type = ada_array_element_type (type, nargs);
+ if (type == NULL)
+ error (_("element type of array unknown"));
+ else
+ return value_zero (ada_aligned_type (type), lval_memory);
+ }
+ return
+ unwrap_value (ada_value_subscript
+ (ada_coerce_to_simple_array (argvec[0]),
+ nargs, argvec + 1));
+ case TYPE_CODE_PTR: /* Pointer to array */
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
- type = ada_array_element_type (type, nargs);
- if (type == NULL)
- error (_("element type of array unknown"));
- else
- return value_zero (ada_aligned_type (type), lval_memory);
- }
- return
- unwrap_value (ada_value_ptr_subscript (argvec[0],
+ type = ada_array_element_type (type, nargs);
+ if (type == NULL)
+ error (_("element type of array unknown"));
+ else
+ return value_zero (ada_aligned_type (type), lval_memory);
+ }
+ return
+ unwrap_value (ada_value_ptr_subscript (argvec[0],
nargs, argvec + 1));
- default:
- error (_("Attempt to index or call something other than an "
+ default:
+ error (_("Attempt to index or call something other than an "
"array or function"));
- }
+ }
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;
- LONGEST high_bound;
-
- low_bound_val = coerce_ref (low_bound_val);
- high_bound_val = coerce_ref (high_bound_val);
- low_bound = value_as_long (low_bound_val);
- high_bound = value_as_long (high_bound_val);
-
- if (noside == EVAL_SKIP)
- goto nosideret;
-
- /* If this is a reference to an aligner type, then remove all
- the aligners. */
- if (value_type (array)->code () == TYPE_CODE_REF
- && ada_is_aligner_type (TYPE_TARGET_TYPE (value_type (array))))
- TYPE_TARGET_TYPE (value_type (array)) =
- ada_aligned_type (TYPE_TARGET_TYPE (value_type (array)));
-
- if (ada_is_constrained_packed_array_type (value_type (array)))
- error (_("cannot slice a packed array"));
-
- /* If this is a reference to an array or an array lvalue,
- convert to a pointer. */
- if (value_type (array)->code () == TYPE_CODE_REF
- || (value_type (array)->code () == TYPE_CODE_ARRAY
- && VALUE_LVAL (array) == lval_memory))
- array = value_addr (array);
-
- if (noside == EVAL_AVOID_SIDE_EFFECTS
- && ada_is_array_descriptor_type (ada_check_typedef
- (value_type (array))))
- return empty_array (ada_type_of_array (array, 0), 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);
+ high_bound_val = coerce_ref (high_bound_val);
+ low_bound = value_as_long (low_bound_val);
+ high_bound = value_as_long (high_bound_val);
+
+ if (noside == EVAL_SKIP)
+ goto nosideret;
+
+ /* If this is a reference to an aligner type, then remove all
+ the aligners. */
+ if (value_type (array)->code () == TYPE_CODE_REF
+ && ada_is_aligner_type (TYPE_TARGET_TYPE (value_type (array))))
+ TYPE_TARGET_TYPE (value_type (array)) =
+ ada_aligned_type (TYPE_TARGET_TYPE (value_type (array)));
+
+ if (ada_is_any_packed_array_type (value_type (array)))
+ error (_("cannot slice a packed array"));
+
+ /* If this is a reference to an array or an array lvalue,
+ convert to a pointer. */
+ if (value_type (array)->code () == TYPE_CODE_REF
+ || (value_type (array)->code () == TYPE_CODE_ARRAY
+ && VALUE_LVAL (array) == lval_memory))
+ array = value_addr (array);
+
+ if (noside == EVAL_AVOID_SIDE_EFFECTS
+ && ada_is_array_descriptor_type (ada_check_typedef
+ (value_type (array))))
+ return empty_array (ada_type_of_array (array, 0), low_bound,
high_bound);
- array = ada_coerce_to_simple_array_ptr (array);
-
- /* If we have more than one level of pointer indirection,
- dereference the value until we get only one level. */
- while (value_type (array)->code () == TYPE_CODE_PTR
- && (TYPE_TARGET_TYPE (value_type (array))->code ()
- == TYPE_CODE_PTR))
- array = value_ind (array);
-
- /* Make sure we really do have an array type before going further,
- to avoid a SEGV when trying to get the index type or the target
- type later down the road if the debug info generated by
- the compiler is incorrect or incomplete. */
- if (!ada_is_simple_array_type (value_type (array)))
- error (_("cannot take slice of non-array"));
-
- if (ada_check_typedef (value_type (array))->code ()
- == TYPE_CODE_PTR)
- {
- struct type *type0 = ada_check_typedef (value_type (array));
-
- if (high_bound < low_bound || noside == EVAL_AVOID_SIDE_EFFECTS)
- return empty_array (TYPE_TARGET_TYPE (type0), low_bound, high_bound);
- else
- {
- struct type *arr_type0 =
- to_fixed_array_type (TYPE_TARGET_TYPE (type0), NULL, 1);
-
- return ada_value_slice_from_ptr (array, arr_type0,
- longest_to_int (low_bound),
- longest_to_int (high_bound));
- }
- }
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return array;
- else if (high_bound < low_bound)
- return empty_array (value_type (array), low_bound, high_bound);
- else
- return ada_value_slice (array, longest_to_int (low_bound),
+ array = ada_coerce_to_simple_array_ptr (array);
+
+ /* If we have more than one level of pointer indirection,
+ dereference the value until we get only one level. */
+ while (value_type (array)->code () == TYPE_CODE_PTR
+ && (TYPE_TARGET_TYPE (value_type (array))->code ()
+ == TYPE_CODE_PTR))
+ array = value_ind (array);
+
+ /* Make sure we really do have an array type before going further,
+ to avoid a SEGV when trying to get the index type or the target
+ type later down the road if the debug info generated by
+ the compiler is incorrect or incomplete. */
+ if (!ada_is_simple_array_type (value_type (array)))
+ error (_("cannot take slice of non-array"));
+
+ if (ada_check_typedef (value_type (array))->code ()
+ == TYPE_CODE_PTR)
+ {
+ struct type *type0 = ada_check_typedef (value_type (array));
+
+ if (high_bound < low_bound || noside == EVAL_AVOID_SIDE_EFFECTS)
+ return empty_array (TYPE_TARGET_TYPE (type0), low_bound, high_bound);
+ else
+ {
+ struct type *arr_type0 =
+ to_fixed_array_type (TYPE_TARGET_TYPE (type0), NULL, 1);
+
+ return ada_value_slice_from_ptr (array, arr_type0,
+ longest_to_int (low_bound),
+ longest_to_int (high_bound));
+ }
+ }
+ else if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return array;
+ else if (high_bound < low_bound)
+ return empty_array (value_type (array), low_bound, high_bound);
+ else
+ return ada_value_slice (array, longest_to_int (low_bound),
longest_to_int (high_bound));
}
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)
- goto nosideret;
+ goto nosideret;
switch (type->code ())
- {
- default:
- lim_warning (_("Membership test incompletely implemented; "
+ {
+ default:
+ lim_warning (_("Membership test incompletely implemented; "
"always returns true"));
type = language_bool_type (exp->language_defn, exp->gdbarch);
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));
+ case TYPE_CODE_RANGE:
+ 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);
return
value_from_longest (type,
- (value_less (arg1, arg3)
- || value_equal (arg1, arg3))
- && (value_less (arg2, arg1)
- || value_equal (arg2, arg1)));
- }
+ (value_less (arg1, arg3)
+ || value_equal (arg1, arg3))
+ && (value_less (arg2, arg1)
+ || value_equal (arg2, arg1)));
+ }
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;
+ goto nosideret;
if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
type = language_bool_type (exp->language_defn, exp->gdbarch);
return
- value_from_longest (type,
- (value_less (arg1, arg3)
- || value_equal (arg1, arg3))
- && (value_less (arg2, arg1)
- || value_equal (arg2, arg1)));
+ value_from_longest (type,
+ (value_less (arg1, arg3)
+ || value_equal (arg1, arg3))
+ && (value_less (arg2, arg1)
+ || 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;
+ goto nosideret;
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);
return
- value_from_longest (type,
- (value_less (arg1, arg3)
- || value_equal (arg1, arg3))
- && (value_less (arg2, arg1)
- || value_equal (arg2, arg1)));
+ value_from_longest (type,
+ (value_less (arg1, arg3)
+ || value_equal (arg1, arg3))
+ && (value_less (arg2, arg1)
+ || value_equal (arg2, arg1)));
case OP_ATR_FIRST:
case OP_ATR_LAST:
case OP_ATR_LENGTH:
{
- struct type *type_arg;
-
- if (exp->elts[*pos].opcode == OP_TYPE)
- {
- evaluate_subexp (NULL_TYPE, 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;
- }
-
- if (exp->elts[*pos].opcode != OP_LONG)
- error (_("Invalid operand to '%s"), ada_attribute_name (op));
- tem = longest_to_int (exp->elts[*pos + 2].longconst);
- *pos += 4;
-
- if (noside == EVAL_SKIP)
- goto nosideret;
+ struct type *type_arg;
+
+ if (exp->elts[*pos].opcode == OP_TYPE)
+ {
+ evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
+ arg1 = NULL;
+ type_arg = check_typedef (exp->elts[pc + 2].type);
+ }
+ else
+ {
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
+ type_arg = NULL;
+ }
+
+ if (exp->elts[*pos].opcode != OP_LONG)
+ error (_("Invalid operand to '%s"), ada_attribute_name (op));
+ tem = longest_to_int (exp->elts[*pos + 2].longconst);
+ *pos += 4;
+
+ if (noside == EVAL_SKIP)
+ goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
if (type_arg == NULL)
type_arg = value_type (arg1);
- if (ada_is_constrained_packed_array_type (type_arg))
+ if (ada_is_constrained_packed_array_type (type_arg))
type_arg = decode_constrained_packed_array_type (type_arg);
if (!discrete_type_p (type_arg))
return value_zero (type_arg, not_lval);
}
- else if (type_arg == NULL)
- {
- arg1 = ada_coerce_ref (arg1);
+ else if (type_arg == NULL)
+ {
+ arg1 = ada_coerce_ref (arg1);
- if (ada_is_constrained_packed_array_type (value_type (arg1)))
- arg1 = ada_coerce_to_simple_array (arg1);
+ if (ada_is_constrained_packed_array_type (value_type (arg1)))
+ arg1 = ada_coerce_to_simple_array (arg1);
- if (op == OP_ATR_LENGTH)
+ if (op == OP_ATR_LENGTH)
type = builtin_type (exp->gdbarch)->builtin_int;
else
{
type = builtin_type (exp->gdbarch)->builtin_int;
}
- switch (op)
- {
- default: /* Should never happen. */
- error (_("unexpected attribute encountered"));
- case OP_ATR_FIRST:
- return value_from_longest
+ switch (op)
+ {
+ default: /* Should never happen. */
+ error (_("unexpected attribute encountered"));
+ case OP_ATR_FIRST:
+ return value_from_longest
(type, ada_array_bound (arg1, tem, 0));
- case OP_ATR_LAST:
- return value_from_longest
+ case OP_ATR_LAST:
+ return value_from_longest
(type, ada_array_bound (arg1, tem, 1));
- case OP_ATR_LENGTH:
- return value_from_longest
+ case OP_ATR_LENGTH:
+ return value_from_longest
(type, ada_array_length (arg1, tem));
- }
- }
- else if (discrete_type_p (type_arg))
- {
- struct type *range_type;
- const char *name = ada_type_name (type_arg);
-
- range_type = NULL;
- if (name != NULL && type_arg->code () != TYPE_CODE_ENUM)
- range_type = to_fixed_range_type (type_arg, NULL);
- if (range_type == NULL)
- range_type = type_arg;
- switch (op)
- {
- default:
- error (_("unexpected attribute encountered"));
- case OP_ATR_FIRST:
+ }
+ }
+ else if (discrete_type_p (type_arg))
+ {
+ struct type *range_type;
+ const char *name = ada_type_name (type_arg);
+
+ range_type = NULL;
+ if (name != NULL && type_arg->code () != TYPE_CODE_ENUM)
+ range_type = to_fixed_range_type (type_arg, NULL);
+ if (range_type == NULL)
+ range_type = type_arg;
+ switch (op)
+ {
+ default:
+ error (_("unexpected attribute encountered"));
+ case OP_ATR_FIRST:
return value_from_longest
(range_type, ada_discrete_type_low_bound (range_type));
- case OP_ATR_LAST:
- return value_from_longest
+ case OP_ATR_LAST:
+ return value_from_longest
(range_type, ada_discrete_type_high_bound (range_type));
- case OP_ATR_LENGTH:
- error (_("the 'length attribute applies only to array types"));
- }
- }
- else if (type_arg->code () == TYPE_CODE_FLT)
- error (_("unimplemented type attribute"));
- else
- {
- LONGEST low, high;
-
- if (ada_is_constrained_packed_array_type (type_arg))
- type_arg = decode_constrained_packed_array_type (type_arg);
+ case OP_ATR_LENGTH:
+ error (_("the 'length attribute applies only to array types"));
+ }
+ }
+ else if (type_arg->code () == TYPE_CODE_FLT)
+ error (_("unimplemented type attribute"));
+ else
+ {
+ LONGEST low, high;
+
+ if (ada_is_constrained_packed_array_type (type_arg))
+ type_arg = decode_constrained_packed_array_type (type_arg);
if (op == OP_ATR_LENGTH)
type = builtin_type (exp->gdbarch)->builtin_int;
type = builtin_type (exp->gdbarch)->builtin_int;
}
- switch (op)
- {
- default:
- error (_("unexpected attribute encountered"));
- case OP_ATR_FIRST:
- low = ada_array_bound_from_type (type_arg, tem, 0);
- return value_from_longest (type, low);
- case OP_ATR_LAST:
- high = ada_array_bound_from_type (type_arg, tem, 1);
- return value_from_longest (type, high);
- case OP_ATR_LENGTH:
- low = ada_array_bound_from_type (type_arg, tem, 0);
- high = ada_array_bound_from_type (type_arg, tem, 1);
- return value_from_longest (type, high - low + 1);
- }
- }
+ switch (op)
+ {
+ default:
+ error (_("unexpected attribute encountered"));
+ case OP_ATR_FIRST:
+ low = ada_array_bound_from_type (type_arg, tem, 0);
+ return value_from_longest (type, low);
+ case OP_ATR_LAST:
+ high = ada_array_bound_from_type (type_arg, tem, 1);
+ return value_from_longest (type, high);
+ case OP_ATR_LENGTH:
+ low = ada_array_bound_from_type (type_arg, tem, 0);
+ high = ada_array_bound_from_type (type_arg, tem, 1);
+ return value_from_longest (type, high - low + 1);
+ }
+ }
}
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;
+ goto nosideret;
if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (ada_tag_type (arg1), not_lval);
+ return value_zero (ada_tag_type (arg1), not_lval);
return ada_value_tag (arg1);
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;
+ goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (value_type (arg1), not_lval);
+ return value_zero (value_type (arg1), not_lval);
else
{
binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
case OP_ATR_MODULUS:
{
- struct type *type_arg = check_typedef (exp->elts[pc + 2].type);
+ struct type *type_arg = check_typedef (exp->elts[pc + 2].type);
- evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
- if (noside == EVAL_SKIP)
- goto nosideret;
+ evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
+ if (noside == EVAL_SKIP)
+ goto nosideret;
- if (!ada_is_modular_type (type_arg))
- error (_("'modulus must be applied to modular type"));
+ if (!ada_is_modular_type (type_arg))
+ error (_("'modulus must be applied to modular type"));
- return value_from_longest (TYPE_TARGET_TYPE (type_arg),
- ada_modulus (type_arg));
+ return value_from_longest (TYPE_TARGET_TYPE (type_arg),
+ ada_modulus (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;
+ goto nosideret;
type = builtin_type (exp->gdbarch)->builtin_int;
if (noside == EVAL_AVOID_SIDE_EFFECTS)
return value_zero (type, not_lval);
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
- the user is really asking for the size of the actual object,
- not the size of the pointer. */
+ the user is really asking for the size of the actual object,
+ not the size of the pointer. */
if (type->code () == TYPE_CODE_REF)
- type = TYPE_TARGET_TYPE (type);
+ type = TYPE_TARGET_TYPE (type);
if (noside == EVAL_SKIP)
- goto nosideret;
+ goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (builtin_type (exp->gdbarch)->builtin_int, not_lval);
+ return value_zero (builtin_type (exp->gdbarch)->builtin_int, not_lval);
else
- return value_from_longest (builtin_type (exp->gdbarch)->builtin_int,
- TARGET_CHAR_BIT * TYPE_LENGTH (type));
+ return value_from_longest (builtin_type (exp->gdbarch)->builtin_int,
+ 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;
+ goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (type, not_lval);
+ return value_zero (type, not_lval);
else
- return value_val_atr (type, arg1);
+ 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;
+ goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (value_type (arg1), not_lval);
+ return value_zero (value_type (arg1), not_lval);
else
{
/* For integer exponentiation operations,
}
case UNOP_PLUS:
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
- goto nosideret;
+ goto nosideret;
else
- return arg1;
+ 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;
+ goto nosideret;
unop_promote (exp->language_defn, exp->gdbarch, &arg1);
if (value_less (arg1, value_zero (value_type (arg1), not_lval)))
- return value_neg (arg1);
+ return value_neg (arg1);
else
- return arg1;
+ return 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;
+ goto nosideret;
type = ada_check_typedef (value_type (arg1));
if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- if (ada_is_array_descriptor_type (type))
- /* GDB allows dereferencing GNAT array descriptors. */
- {
- struct type *arrType = ada_type_of_array (arg1, 0);
-
- if (arrType == NULL)
- error (_("Attempt to dereference null array pointer."));
- return value_at_lazy (arrType, 0);
- }
- else if (type->code () == TYPE_CODE_PTR
- || type->code () == TYPE_CODE_REF
- /* In C you can dereference an array to get the 1st elt. */
- || type->code () == TYPE_CODE_ARRAY)
- {
- /* As mentioned in the OP_VAR_VALUE case, tagged types can
- only be determined by inspecting the object's tag.
- This means that we need to evaluate completely the
- expression in order to get its type. */
+ {
+ if (ada_is_array_descriptor_type (type))
+ /* GDB allows dereferencing GNAT array descriptors. */
+ {
+ struct type *arrType = ada_type_of_array (arg1, 0);
+
+ if (arrType == NULL)
+ error (_("Attempt to dereference null array pointer."));
+ return value_at_lazy (arrType, 0);
+ }
+ else if (type->code () == TYPE_CODE_PTR
+ || type->code () == TYPE_CODE_REF
+ /* In C you can dereference an array to get the 1st elt. */
+ || type->code () == TYPE_CODE_ARRAY)
+ {
+ /* As mentioned in the OP_VAR_VALUE case, tagged types can
+ only be determined by inspecting the object's tag.
+ This means that we need to evaluate completely the
+ expression in order to get its type. */
if ((type->code () == TYPE_CODE_REF
|| 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
(ada_check_typedef (TYPE_TARGET_TYPE (type))));
}
ada_ensure_varsize_limit (type);
- return value_zero (type, lval_memory);
- }
- else if (type->code () == TYPE_CODE_INT)
+ return value_zero (type, lval_memory);
+ }
+ else if (type->code () == TYPE_CODE_INT)
{
/* GDB allows dereferencing an int. */
if (expect_type == NULL)
return value_zero (expect_type, lval_memory);
}
}
- else
- error (_("Attempt to take contents of a non-pointer value."));
- }
+ else
+ error (_("Attempt to take contents of a non-pointer value."));
+ }
arg1 = ada_coerce_ref (arg1); /* FIXME: What is this for?? */
type = ada_check_typedef (value_type (arg1));
if (type->code () == TYPE_CODE_INT)
- /* GDB allows dereferencing an int. If we were given
- the expect_type, then use that as the target type.
- Otherwise, assume that the target type is an int. */
- {
- if (expect_type != NULL)
+ /* GDB allows dereferencing an int. If we were given
+ the expect_type, then use that as the target type.
+ Otherwise, assume that the target type is an int. */
+ {
+ if (expect_type != NULL)
return ada_value_ind (value_cast (lookup_pointer_type (expect_type),
arg1));
else
return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int,
(CORE_ADDR) value_as_address (arg1));
- }
+ }
if (ada_is_array_descriptor_type (type))
- /* GDB allows dereferencing GNAT array descriptors. */
- return ada_coerce_to_simple_array (arg1);
+ /* GDB allows dereferencing GNAT array descriptors. */
+ return ada_coerce_to_simple_array (arg1);
else
- return ada_value_ind (arg1);
+ return ada_value_ind (arg1);
case STRUCTOP_STRUCT:
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;
+ goto nosideret;
if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- struct type *type1 = value_type (arg1);
+ {
+ struct type *type1 = value_type (arg1);
- if (ada_is_tagged_type (type1, 1))
- {
- type = ada_lookup_struct_elt_type (type1,
- &exp->elts[pc + 2].string,
- 1, 1);
+ if (ada_is_tagged_type (type1, 1))
+ {
+ type = ada_lookup_struct_elt_type (type1,
+ &exp->elts[pc + 2].string,
+ 1, 1);
/* If the field is not found, check if it exists in the
extension of this object's type. This means that we
need to evaluate completely the expression. */
- if (type == NULL)
+ 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);
arg1 = unwrap_value (arg1);
type = value_type (ada_to_fixed_value (arg1));
}
- }
- else
- type =
- ada_lookup_struct_elt_type (type1, &exp->elts[pc + 2].string, 1,
- 0);
-
- return value_zero (ada_aligned_type (type), lval_memory);
- }
+ }
+ else
+ type =
+ ada_lookup_struct_elt_type (type1, &exp->elts[pc + 2].string, 1,
+ 0);
+
+ return value_zero (ada_aligned_type (type), lval_memory);
+ }
else
{
arg1 = ada_value_struct_elt (arg1, &exp->elts[pc + 2].string, 0);
case OP_TYPE:
/* The value is not supposed to be used. This is here to make it
- easier to accommodate expressions that contain types. */
+ easier to accommodate expressions that contain types. */
(*pos) += 2;
if (noside == EVAL_SKIP)
- goto nosideret;
+ goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return allocate_value (exp->elts[pc + 1].type);
+ return allocate_value (exp->elts[pc + 1].type);
else
- error (_("Attempt to use a type name as an expression"));
+ error (_("Attempt to use a type name as an expression"));
case OP_AGGREGATE:
case OP_CHOICES:
}
\f
- /* Fixed point */
+ /* Fixed point */
/* If TYPE encodes an Ada fixed-point type, return the suffix of the
type name that encodes the 'small and 'delta information.
Otherwise, return NULL. */
static const char *
-gnat_encoded_fixed_type_info (struct type *type)
+gnat_encoded_fixed_point_type_info (struct type *type)
{
const char *name = ada_type_name (type);
enum type_code code = (type == NULL) ? TYPE_CODE_UNDEF : type->code ();
const char *tail = strstr (name, "___XF_");
if (tail == NULL)
- return NULL;
+ return NULL;
else
- return tail + 5;
+ return tail + 5;
}
else if (code == TYPE_CODE_RANGE && TYPE_TARGET_TYPE (type) != type)
- return gnat_encoded_fixed_type_info (TYPE_TARGET_TYPE (type));
+ return gnat_encoded_fixed_point_type_info (TYPE_TARGET_TYPE (type));
else
return NULL;
}
int
ada_is_gnat_encoded_fixed_point_type (struct type *type)
{
- return gnat_encoded_fixed_type_info (type) != NULL;
+ return gnat_encoded_fixed_point_type_info (type) != NULL;
}
/* Return non-zero iff TYPE represents a System.Address type. */
struct value *
gnat_encoded_fixed_point_delta (struct type *type)
{
- const char *encoding = gnat_encoded_fixed_type_info (type);
+ const char *encoding = gnat_encoded_fixed_point_type_info (type);
struct type *scale_type = ada_scaling_type (type);
long long num, den;
the scaling factor ('SMALL value) associated with the type. */
struct value *
-ada_scaling_factor (struct type *type)
+gnat_encoded_fixed_point_scaling_factor (struct type *type)
{
- const char *encoding = gnat_encoded_fixed_type_info (type);
+ const char *encoding = gnat_encoded_fixed_point_type_info (type);
struct type *scale_type = ada_scaling_type (type);
long long num0, den0, num1, den1;
\f
- /* Range types */
+ /* Range types */
/* Scan STR beginning at position K for a discriminant name, and
return the value of that discriminant field of DVAL in *PX. If
static int
scan_discrim_bound (const char *str, int k, struct value *dval, LONGEST * px,
- int *pnew_k)
+ int *pnew_k)
{
static char *bound_buffer = NULL;
static size_t bound_buffer_len = 0;
if (nsyms != 1)
{
if (err_msg == NULL)
- return 0;
+ return 0;
else
- error (("%s"), err_msg);
+ error (("%s"), err_msg);
}
return value_of_variable (syms[0].symbol, syms[0].block);
n = 1;
if (*subtype_info == 'L')
- {
- if (!ada_scan_number (bounds_str, n, &L, &n)
- && !scan_discrim_bound (bounds_str, n, dval, &L, &n))
- return raw_type;
- if (bounds_str[n] == '_')
- n += 2;
- else if (bounds_str[n] == '.') /* FIXME? SGI Workshop kludge. */
- n += 1;
- subtype_info += 1;
- }
+ {
+ if (!ada_scan_number (bounds_str, n, &L, &n)
+ && !scan_discrim_bound (bounds_str, n, dval, &L, &n))
+ return raw_type;
+ if (bounds_str[n] == '_')
+ n += 2;
+ else if (bounds_str[n] == '.') /* FIXME? SGI Workshop kludge. */
+ n += 1;
+ subtype_info += 1;
+ }
else
- {
- strcpy (name_buf + prefix_len, "___L");
- if (!get_int_var_value (name_buf, L))
- {
- lim_warning (_("Unknown lower bound, using 1."));
- L = 1;
- }
- }
+ {
+ strcpy (name_buf + prefix_len, "___L");
+ if (!get_int_var_value (name_buf, L))
+ {
+ lim_warning (_("Unknown lower bound, using 1."));
+ L = 1;
+ }
+ }
if (*subtype_info == 'U')
- {
- if (!ada_scan_number (bounds_str, n, &U, &n)
- && !scan_discrim_bound (bounds_str, n, dval, &U, &n))
- return raw_type;
- }
+ {
+ if (!ada_scan_number (bounds_str, n, &U, &n)
+ && !scan_discrim_bound (bounds_str, n, dval, &U, &n))
+ return raw_type;
+ }
else
- {
- strcpy (name_buf + prefix_len, "___U");
- if (!get_int_var_value (name_buf, U))
- {
- lim_warning (_("Unknown upper bound, using %ld."), (long) L);
- U = L;
- }
- }
+ {
+ strcpy (name_buf + prefix_len, "___U");
+ if (!get_int_var_value (name_buf, U))
+ {
+ lim_warning (_("Unknown upper bound, using %ld."), (long) L);
+ U = L;
+ }
+ }
type = create_static_range_type (alloc_type_copy (raw_type),
base_type, L, U);
/* create_static_range_type alters the resulting type's length
- to match the size of the base_type, which is not what we want.
- Set it back to the original range type's length. */
+ 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->set_name (name);
return type;
}
\f
- /* Modular types */
+ /* Modular types */
/* True iff TYPE is an Ada modular type. */
struct type *subranged_type = get_base_type (type);
return (subranged_type != NULL && type->code () == TYPE_CODE_RANGE
- && subranged_type->code () == TYPE_CODE_INT
- && TYPE_UNSIGNED (subranged_type));
+ && subranged_type->code () == TYPE_CODE_INT
+ && subranged_type->is_unsigned ());
}
/* Assuming ada_is_modular_type (TYPE), the modulus of 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
an Ada83 compiler). As such, we do not include Numeric_Error from
this list of standard exceptions. */
-static const char *standard_exc[] = {
+static const char * const standard_exc[] = {
"constraint_error",
"program_error",
"storage_error",
{
re_comp (known_runtime_file_name_patterns[i]);
if (re_exec (lbasename (sal.symtab->filename)))
- return 1;
+ return 1;
if (SYMTAB_OBJFILE (sal.symtab) != NULL
- && re_exec (objfile_name (SYMTAB_OBJFILE (sal.symtab))))
- return 1;
+ && re_exec (objfile_name (SYMTAB_OBJFILE (sal.symtab))))
+ return 1;
}
/* Check whether the function is a GNAT-generated entity. */
for (; fi != NULL; fi = get_prev_frame (fi))
{
if (!is_known_support_routine (fi))
- {
- select_frame (fi);
- break;
- }
+ {
+ select_frame (fi);
+ break;
+ }
}
}
= find_frame_funname (fi, &func_lang, NULL);
if (func_name != NULL)
{
- if (strcmp (func_name.get (),
+ if (strcmp (func_name.get (),
data->exception_info->catch_exception_sym) == 0)
break; /* We found the frame we were looking for... */
}
static CORE_ADDR
ada_exception_name_addr_1 (enum ada_exception_catchpoint_kind ex,
- struct breakpoint *b)
+ struct breakpoint *b)
{
struct ada_inferior_data *data = get_ada_inferior_data (current_inferior ());
switch (ex)
{
case ada_catch_exception:
- return (parse_and_eval_address ("e.full_name"));
- break;
+ return (parse_and_eval_address ("e.full_name"));
+ break;
case ada_catch_exception_unhandled:
- return data->exception_info->unhandled_exception_name_addr ();
- break;
+ return data->exception_info->unhandled_exception_name_addr ();
+ break;
case ada_catch_handlers:
- return 0; /* The runtimes does not provide access to the exception
+ return 0; /* The runtimes does not provide access to the exception
name. */
- break;
+ break;
case ada_catch_assert:
- return 0; /* Exception name is not relevant in this case. */
- break;
+ return 0; /* Exception name is not relevant in this case. */
+ break;
default:
- internal_error (__FILE__, __LINE__, _("unexpected catchpoint type"));
- break;
+ internal_error (__FILE__, __LINE__, _("unexpected catchpoint type"));
+ break;
}
return 0; /* Should never be reached. */
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 CORE_ADDR
ada_exception_name_addr (enum ada_exception_catchpoint_kind ex,
- struct breakpoint *b)
+ struct breakpoint *b)
{
CORE_ADDR result = 0;
static void
create_excep_cond_exprs (struct ada_catchpoint *c,
- enum ada_exception_catchpoint_kind ex)
+ enum ada_exception_catchpoint_kind ex)
{
struct bp_location *bl;
switch (c->m_kind)
{
case ada_catch_exception:
- if (!c->excep_string.empty ())
- {
+ if (!c->excep_string.empty ())
+ {
std::string msg = string_printf (_("`%s' Ada exception"),
c->excep_string.c_str ());
- uiout->field_string ("what", msg);
- }
- else
- uiout->field_string ("what", "all Ada exceptions");
-
- break;
+ uiout->field_string ("what", msg);
+ }
+ else
+ uiout->field_string ("what", "all Ada exceptions");
+
+ break;
case ada_catch_exception_unhandled:
- uiout->field_string ("what", "unhandled Ada exceptions");
- break;
+ uiout->field_string ("what", "unhandled Ada exceptions");
+ break;
case ada_catch_handlers:
- if (!c->excep_string.empty ())
- {
+ if (!c->excep_string.empty ())
+ {
uiout->field_fmt ("what",
_("`%s' Ada exception handlers"),
c->excep_string.c_str ());
- }
- else
+ }
+ else
uiout->field_string ("what", "all Ada exceptions handlers");
- break;
+ break;
case ada_catch_assert:
- uiout->field_string ("what", "failed Ada assertions");
- break;
+ uiout->field_string ("what", "failed Ada assertions");
+ break;
default:
- internal_error (__FILE__, __LINE__, _("unexpected catchpoint type"));
- break;
+ internal_error (__FILE__, __LINE__, _("unexpected catchpoint type"));
+ break;
}
}
struct ui_out *uiout = current_uiout;
uiout->text (b->disposition == disp_del ? _("Temporary catchpoint ")
- : _("Catchpoint "));
+ : _("Catchpoint "));
uiout->field_signed ("bkptno", b->number);
uiout->text (": ");
switch (c->m_kind)
{
case ada_catch_exception:
- if (!c->excep_string.empty ())
+ if (!c->excep_string.empty ())
{
std::string info = string_printf (_("`%s' Ada exception"),
c->excep_string.c_str ());
uiout->text (info.c_str ());
}
- else
- uiout->text (_("all Ada exceptions"));
- break;
+ else
+ uiout->text (_("all Ada exceptions"));
+ break;
case ada_catch_exception_unhandled:
- uiout->text (_("unhandled Ada exceptions"));
- break;
+ uiout->text (_("unhandled Ada exceptions"));
+ break;
case ada_catch_handlers:
- if (!c->excep_string.empty ())
+ if (!c->excep_string.empty ())
{
std::string info
= string_printf (_("`%s' Ada exception handlers"),
c->excep_string.c_str ());
uiout->text (info.c_str ());
}
- else
- uiout->text (_("all Ada exceptions handlers"));
- break;
+ else
+ uiout->text (_("all Ada exceptions handlers"));
+ break;
case ada_catch_assert:
- uiout->text (_("failed Ada assertions"));
- break;
+ uiout->text (_("failed Ada assertions"));
+ break;
default:
- internal_error (__FILE__, __LINE__, _("unexpected catchpoint type"));
- break;
+ internal_error (__FILE__, __LINE__, _("unexpected catchpoint type"));
+ break;
}
}
static void
catch_ada_exception_command_split (const char *args,
bool is_catch_handlers_cmd,
- enum ada_exception_catchpoint_kind *ex,
+ enum ada_exception_catchpoint_kind *ex,
std::string *excep_string,
std::string *cond_string)
{
args = skip_spaces (args);
if (args[0] == '\0')
- error (_("Condition missing after `if' keyword"));
+ error (_("Condition missing after `if' keyword"));
*cond_string = args;
args += strlen (args);
switch (ex)
{
case ada_catch_exception:
- return (data->exception_info->catch_exception_sym);
- break;
+ return (data->exception_info->catch_exception_sym);
+ break;
case ada_catch_exception_unhandled:
- return (data->exception_info->catch_exception_unhandled_sym);
- break;
+ return (data->exception_info->catch_exception_unhandled_sym);
+ break;
case ada_catch_assert:
- return (data->exception_info->catch_assert_sym);
- break;
+ return (data->exception_info->catch_assert_sym);
+ break;
case ada_catch_handlers:
- return (data->exception_info->catch_handlers_sym);
- break;
+ return (data->exception_info->catch_handlers_sym);
+ break;
default:
- internal_error (__FILE__, __LINE__,
- _("unexpected catchpoint kind (%d)"), ex);
+ internal_error (__FILE__, __LINE__,
+ _("unexpected catchpoint kind (%d)"), ex);
}
}
switch (ex)
{
case ada_catch_exception:
- return (&catch_exception_breakpoint_ops);
- break;
+ return (&catch_exception_breakpoint_ops);
+ break;
case ada_catch_exception_unhandled:
- return (&catch_exception_unhandled_breakpoint_ops);
- break;
+ return (&catch_exception_unhandled_breakpoint_ops);
+ break;
case ada_catch_assert:
- return (&catch_assert_breakpoint_ops);
- break;
+ return (&catch_assert_breakpoint_ops);
+ break;
case ada_catch_handlers:
- return (&catch_handlers_breakpoint_ops);
- break;
+ return (&catch_handlers_breakpoint_ops);
+ break;
default:
- internal_error (__FILE__, __LINE__,
- _("unexpected catchpoint kind (%d)"), ex);
+ internal_error (__FILE__, __LINE__,
+ _("unexpected catchpoint kind (%d)"), ex);
}
}
static std::string
ada_exception_catchpoint_cond_string (const char *excep_string,
- enum ada_exception_catchpoint_kind ex)
+ enum ada_exception_catchpoint_kind ex)
{
int i;
bool is_standard_exc = false;
if (ex == ada_catch_handlers)
{
/* For exception handlers catchpoints, the condition string does
- not use the same parameter as for the other exceptions. */
+ not use the same parameter as for the other exceptions. */
result = ("long_integer (GNAT_GCC_exception_Access"
"(gcc_exception).all.occurrence.id)");
}
c->excep_string = excep_string;
create_excep_cond_exprs (c.get (), ex_kind);
if (!cond_string.empty ())
- set_breakpoint_condition (c.get (), cond_string.c_str (), from_tty);
+ set_breakpoint_condition (c.get (), cond_string.c_str (), from_tty, false);
install_breakpoint (0, std::move (c), 1);
}
args += 2;
args = skip_spaces (args);
if (args[0] == '\0')
- error (_("condition missing after `if' keyword"));
+ error (_("condition missing after `if' keyword"));
cond_string.assign (args);
}
const char *type_name = SYMBOL_TYPE (sym)->name ();
return (SYMBOL_CLASS (sym) != LOC_TYPEDEF
- && SYMBOL_CLASS (sym) != LOC_BLOCK
- && SYMBOL_CLASS (sym) != LOC_CONST
- && SYMBOL_CLASS (sym) != LOC_UNRESOLVED
- && type_name != NULL && strcmp (type_name, "exception") == 0);
+ && SYMBOL_CLASS (sym) != LOC_BLOCK
+ && SYMBOL_CLASS (sym) != LOC_CONST
+ && SYMBOL_CLASS (sym) != LOC_UNRESOLVED
+ && type_name != NULL && strcmp (type_name, "exception") == 0);
}
/* Given a global symbol SYM, return non-zero iff SYM is a non-standard
printf_filtered ("%s: %s\n", info.name, paddress (gdbarch, info.addr));
}
- /* Operators */
+ /* Operators */
/* Information about operators given special treatment in functions
below. */
/* Format: OP_DEFN (<operator>, <operator length>, <# args>, <binop>). */
static void
ada_forward_operator_length (struct expression *exp, int pc,
- int *oplenp, int *argsp)
+ int *oplenp, int *argsp)
{
switch (exp->elts[pc].opcode)
{
static void
ada_print_subexp (struct expression *exp, int *pos,
- struct ui_file *stream, enum precedence prec)
+ struct ui_file *stream, enum precedence prec)
{
int oplen, nargs, i;
int pc = *pos;
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered ("'range", stream);
if (exp->elts[pc + 1].longconst > 1)
- fprintf_filtered (stream, "(%ld)",
- (long) exp->elts[pc + 1].longconst);
+ fprintf_filtered (stream, "(%ld)",
+ (long) exp->elts[pc + 1].longconst);
return;
case TERNOP_IN_RANGE:
if (prec >= PREC_EQUAL)
- fputs_filtered ("(", stream);
+ fputs_filtered ("(", stream);
/* XXX: sprint_subexp */
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered (" in ", stream);
fputs_filtered (" .. ", stream);
print_subexp (exp, pos, stream, PREC_EQUAL);
if (prec >= PREC_EQUAL)
- fputs_filtered (")", stream);
+ fputs_filtered (")", stream);
return;
case OP_ATR_FIRST:
case OP_ATR_TAG:
case OP_ATR_VAL:
if (exp->elts[*pos].opcode == OP_TYPE)
- {
- if (exp->elts[*pos + 1].type->code () != TYPE_CODE_VOID)
- LA_PRINT_TYPE (exp->elts[*pos + 1].type, "", stream, 0, 0,
+ {
+ if (exp->elts[*pos + 1].type->code () != TYPE_CODE_VOID)
+ LA_PRINT_TYPE (exp->elts[*pos + 1].type, "", stream, 0, 0,
&type_print_raw_options);
- *pos += 3;
- }
+ *pos += 3;
+ }
else
- print_subexp (exp, pos, stream, PREC_SUFFIX);
+ print_subexp (exp, pos, stream, PREC_SUFFIX);
fprintf_filtered (stream, "'%s", ada_attribute_name (op));
if (nargs > 1)
- {
- int tem;
-
- for (tem = 1; tem < nargs; tem += 1)
- {
- fputs_filtered ((tem == 1) ? " (" : ", ", stream);
- print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
- }
- fputs_filtered (")", stream);
- }
+ {
+ int tem;
+
+ for (tem = 1; tem < nargs; tem += 1)
+ {
+ fputs_filtered ((tem == 1) ? " (" : ", ", stream);
+ print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
+ }
+ fputs_filtered (")", stream);
+ }
return;
case UNOP_QUAL:
{"'size", OP_ATR_SIZE, PREC_SUFFIX, 1},
{NULL, OP_NULL, PREC_SUFFIX, 0}
};
-\f
-enum ada_primitive_types {
- ada_primitive_type_int,
- ada_primitive_type_long,
- ada_primitive_type_short,
- ada_primitive_type_char,
- ada_primitive_type_float,
- ada_primitive_type_double,
- ada_primitive_type_void,
- ada_primitive_type_long_long,
- ada_primitive_type_long_double,
- ada_primitive_type_natural,
- ada_primitive_type_positive,
- ada_primitive_type_system_address,
- ada_primitive_type_storage_offset,
- 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 */
-/* 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 (!m_encoded_p)
{
const char *folded = ada_fold_name (user_name);
- const char *encoded = ada_encode_1 (folded, false);
- if (encoded != NULL)
- m_encoded_name = encoded;
- else
- m_encoded_name = user_name.to_string ();
+ m_encoded_name = ada_encode_1 (folded, false);
+ if (m_encoded_name.empty ())
+ 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. */
+/* Class representing the Ada language. */
-static struct value *
-ada_read_var_value (struct symbol *var, const struct block *var_block,
- struct frame_info *frame)
+class ada_language : public language_defn
{
- /* The only case where default_read_var_value is not sufficient
- is when VAR is a renaming... */
- if (frame != nullptr)
+public:
+ ada_language ()
+ : language_defn (language_ada)
+ { /* Nothing. */ }
+
+ /* See language.h. */
+
+ const char *name () const override
+ { return "ada"; }
+
+ /* See language.h. */
+
+ const char *natural_name () const override
+ { return "Ada"; }
+
+ /* See language.h. */
+
+ const std::vector<const char *> &filename_extensions () const override
+ {
+ static const std::vector<const char *> extensions
+ = { ".adb", ".ads", ".a", ".ada", ".dg" };
+ return extensions;
+ }
+
+ /* 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);
+
+ 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);
+
+ /* Helper function to allow shorter lines below. */
+ auto add = [&] (struct type *t)
{
- 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);
- }
+ lai->add_primitive_type (t);
+ };
- /* 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);
-}
+ add (arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+ 0, "integer"));
+ add (arch_integer_type (gdbarch, gdbarch_long_bit (gdbarch),
+ 0, "long_integer"));
+ add (arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch),
+ 0, "short_integer"));
+ struct type *char_type = arch_character_type (gdbarch, TARGET_CHAR_BIT,
+ 0, "character");
+ lai->set_string_char_type (char_type);
+ add (char_type);
+ add (arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
+ "float", gdbarch_float_format (gdbarch)));
+ add (arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
+ "long_float", gdbarch_double_format (gdbarch)));
+ add (arch_integer_type (gdbarch, gdbarch_long_long_bit (gdbarch),
+ 0, "long_long_integer"));
+ add (arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch),
+ "long_long_float",
+ gdbarch_long_double_format (gdbarch)));
+ add (arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+ 0, "natural"));
+ add (arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+ 0, "positive"));
+ add (builtin->builtin_void);
+
+ struct type *system_addr_ptr
+ = lookup_pointer_type (arch_type (gdbarch, TYPE_CODE_VOID, TARGET_CHAR_BIT,
+ "void"));
+ system_addr_ptr->set_name ("system__address");
+ add (system_addr_ptr);
+
+ /* 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 (system_addr_ptr);
+ add (arch_integer_type (gdbarch, addr_length * HOST_CHAR_BIT, 0,
+ "storage_offset"));
+
+ lai->set_bool_type (builtin->builtin_bool);
+ }
-static const char *ada_extensions[] =
-{
- ".adb", ".ads", ".a", ".ada", ".dg", NULL
-};
+ /* 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_symbol (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;
-extern const struct language_defn ada_language_defn = {
- "ada", /* Language name */
- "Ada",
- language_ada,
- range_check_off,
- case_sensitive_on, /* Yes, Ada is case-insensitive, but
- that's not quite what this means. */
- array_row_major,
- 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 */
+ 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);
+ }
+
+ /* See language.h. */
+
+ const char *struct_too_deep_ellipsis () const override
+ { return "(...)"; }
+
+ /* See language.h. */
+
+ bool c_style_arrays_p () const override
+ { return false; }
+
+ /* See language.h. */
+
+ bool store_sym_names_in_linkage_form_p () const override
+ { return true; }
+
+ /* See language.h. */
+
+ const struct lang_varobj_ops *varobj_ops () const override
+ { return &ada_varobj_ops; }
+
+ /* See language.h. */
+
+ const struct exp_descriptor *expression_ops () const override
+ { return &ada_exp_descriptor; }
+
+ /* See language.h. */
+
+ const struct op_print *opcode_print_table () const override
+ { return ada_op_print_tab; }
+
+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;
&show_ada_list, "show ada ", 0, &showlist);
add_setshow_boolean_cmd ("trust-PAD-over-XVS", class_obscure,
- &trust_pad_over_xvs, _("\
+ &trust_pad_over_xvs, _("\
Enable or disable an optimization trusting PAD types over XVS types."), _("\
Show whether an optimization trusting PAD types over XVS types is activated."),
- _("\
+ _("\
This is related to the encoding used by the GNAT compiler. The debugger\n\
should normally trust the contents of PAD types, but certain older versions\n\
of GNAT have a bug that sometimes causes the information in the PAD type\n\
work around this bug. It is always safe to turn this option \"off\", but\n\
this incurs a slight performance penalty, so it is recommended to NOT change\n\
this option to \"off\" unless necessary."),
- NULL, NULL, &set_ada_list, &show_ada_list);
+ NULL, NULL, &set_ada_list, &show_ada_list);
add_setshow_boolean_cmd ("print-signatures", class_vars,
&print_signatures, _("\
CONDITION is a boolean expression that is evaluated to see whether the\n\
exception should cause a stop."),
catch_ada_handlers_command,
- catch_ada_completer,
+ catch_ada_completer,
CATCH_PERMANENT,
CATCH_TEMPORARY);
add_catch_command ("assert", _("\
CONDITION is a boolean expression that is evaluated to see whether the\n\
exception should cause a stop."),
catch_assert_command,
- NULL,
+ NULL,
CATCH_PERMANENT,
CATCH_TEMPORARY);
projects / deliverable / binutils-gdb.git / blobdiff