/* Ada language support routines for GDB, the GNU debugger.
- Copyright (C) 1992-2020 Free Software Foundation, Inc.
+ Copyright (C) 1992-2021 Free Software Foundation, Inc.
This file is part of GDB.
#include "gdbsupport/function-view.h"
#include "gdbsupport/byte-vector.h"
#include <algorithm>
+#include "ada-exp.h"
/* Define whether or not the C operator '/' truncates towards zero for
differently signed operands (truncation direction is undefined in C).
static struct value *make_array_descriptor (struct type *, struct value *);
-static void ada_add_block_symbols (struct obstack *,
+static void ada_add_block_symbols (std::vector<struct block_symbol> &,
const struct block *,
const lookup_name_info &lookup_name,
domain_enum, struct objfile *);
-static void ada_add_all_symbols (struct obstack *, const struct block *,
+static void ada_add_all_symbols (std::vector<struct block_symbol> &,
+ const struct block *,
const lookup_name_info &lookup_name,
domain_enum, int, int *);
-static int is_nonfunction (struct block_symbol *, int);
+static int is_nonfunction (const std::vector<struct block_symbol> &);
-static void add_defn_to_vec (struct obstack *, struct symbol *,
- const struct block *);
-
-static int num_defns_collected (struct obstack *);
-
-static struct block_symbol *defns_collected (struct obstack *, int);
+static void add_defn_to_vec (std::vector<struct block_symbol> &,
+ struct symbol *,
+ const struct block *);
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 const char *ada_op_name (enum exp_opcode);
-
static const char *ada_decoded_op_name (enum exp_opcode);
static int numeric_type_p (struct type *);
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 *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);
+static int ada_resolve_function (std::vector<struct block_symbol> &,
+ struct value **, int, const char *,
+ struct type *, int);
static int ada_is_direct_array_type (struct type *);
struct expression *,
int *, enum noside);
-static void aggregate_assign_from_choices (struct value *, struct value *,
+static void aggregate_assign_from_choices (struct value *, struct value *,
struct expression *,
- int *, LONGEST *, int *,
- int, LONGEST, LONGEST);
+ int *, std::vector<LONGEST> &,
+ LONGEST, LONGEST);
static void aggregate_assign_positional (struct value *, struct value *,
struct expression *,
- int *, LONGEST *, int *, int,
+ int *, std::vector<LONGEST> &,
LONGEST, LONGEST);
static void aggregate_assign_others (struct value *, struct value *,
struct expression *,
- int *, LONGEST *, int, LONGEST, LONGEST);
+ int *, std::vector<LONGEST> &,
+ LONGEST, LONGEST);
-static void add_component_interval (LONGEST, LONGEST, LONGEST *, int *, int);
+static void add_component_interval (LONGEST, LONGEST, std::vector<LONGEST> &);
static struct value *ada_evaluate_subexp (struct type *, struct expression *,
struct ada_symbol_cache
{
/* An obstack used to store the entries in our cache. */
- struct obstack cache_space;
+ struct auto_obstack cache_space;
/* The root of the hash table used to implement our symbol cache. */
- struct cache_entry *root[HASH_SIZE];
+ struct cache_entry *root[HASH_SIZE] {};
};
-static void ada_free_symbol_cache (struct ada_symbol_cache *sym_cache);
-
/* Maximum-sized dynamic type. */
static unsigned int varsize_limit;
/* This module's per-program-space data. */
struct ada_pspace_data
{
- ~ada_pspace_data ()
- {
- if (sym_cache != NULL)
- ada_free_symbol_cache (sym_cache);
- }
-
/* The Ada symbol cache. */
- struct ada_symbol_cache *sym_cache = nullptr;
+ std::unique_ptr<ada_symbol_cache> sym_cache;
};
/* Key to our per-program-space data. */
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);
}
-/* Assuming V points to an array of S objects, make sure that it contains at
- least M objects, updating V and S as necessary. */
-
-#define GROW_VECT(v, s, m) \
- if ((s) < (m)) (v) = (char *) grow_vect (v, &(s), m, sizeof *(v));
-
-/* Assuming VECT points to an array of *SIZE objects of size
- ELEMENT_SIZE, grow it to contain at least MIN_SIZE objects,
- updating *SIZE as necessary and returning the (new) array. */
-
-static void *
-grow_vect (void *vect, size_t *size, size_t min_size, int element_size)
-{
- if (*size < min_size)
- {
- *size *= 2;
- if (*size < min_size)
- *size = min_size;
- vect = xrealloc (vect, *size * element_size);
- }
- return vect;
-}
-
/* True (non-zero) iff TARGET matches FIELD_NAME up to any trailing
suffix of FIELD_NAME beginning "___". */
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);
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)))
+ if (value_optimized_out (val))
+ result = allocate_optimized_out_value (type);
+ else if (value_lazy (val)
+ /* Be careful not to make a lazy not_lval value. */
+ || (VALUE_LVAL (val) != not_lval
+ && TYPE_LENGTH (type) > TYPE_LENGTH (value_type (val))))
result = allocate_value_lazy (type);
else
{
result = allocate_value (type);
- value_contents_copy_raw (result, 0, val, 0, TYPE_LENGTH (type));
+ value_contents_copy (result, 0, val, 0, TYPE_LENGTH (type));
}
set_value_component_location (result, val);
set_value_bitsize (result, value_bitsize (val));
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). */
{
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."));
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);
quotes, unfolded, but with the quotes stripped away. Result good
to next call. */
-static char *
+static const char *
ada_fold_name (gdb::string_view name)
{
- static char *fold_buffer = NULL;
- static size_t fold_buffer_size = 0;
-
- int len = name.size ();
- GROW_VECT (fold_buffer, fold_buffer_size, len + 1);
+ static std::string fold_storage;
- if (name[0] == '\'')
- {
- strncpy (fold_buffer, name.data () + 1, len - 2);
- fold_buffer[len - 2] = '\000';
- }
+ if (!name.empty () && name[0] == '\'')
+ fold_storage = gdb::to_string (name.substr (1, name.size () - 2));
else
{
- int i;
-
- for (i = 0; i <= len; i += 1)
- fold_buffer[i] = tolower (name[i]);
+ fold_storage = gdb::to_string (name);
+ for (int i = 0; i < name.size (); i += 1)
+ fold_storage[i] = tolower (fold_storage[i]);
}
- return fold_buffer;
+ return fold_storage.c_str ();
}
/* Return nonzero if C is either a digit or a lowercase alphabet character. */
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;
\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
is not equal to the field name. */
if (index_desc_type->field (0).type ()->name () != NULL
&& strcmp (index_desc_type->field (0).type ()->name (),
- TYPE_FIELD_NAME (index_desc_type, 0)) == 0)
+ TYPE_FIELD_NAME (index_desc_type, 0)) == 0)
return;
/* Fixup each field of INDEX_DESC_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))
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;
}
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
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)
{
if ((check_typedef (index_type)->code () == TYPE_CODE_RANGE
&& is_dynamic_type (check_typedef (index_type)))
- || get_discrete_bounds (index_type, &low_bound, &high_bound) < 0)
+ || !get_discrete_bounds (index_type, &low_bound, &high_bound))
low_bound = high_bound = 0;
if (high_bound < low_bound)
*elt_bits = TYPE_LENGTH (new_type) = 0;
{
*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;
}
new_type->set_is_fixed_instance (true);
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)
+ || 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 = 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"),
+ {
+ struct type *range_type = elt_type->index_type ();
+ LONGEST lowerbound, upperbound;
+ LONGEST idx;
+
+ if (!get_discrete_bounds (range_type, &lowerbound, &upperbound))
+ {
+ 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;
}
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]));
LONGEST lwb, upb;
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));
+ 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 (type0->index_type ());
type0->dyn_prop (DYN_PROP_BYTE_STRIDE),
TYPE_FIELD_BITSIZE (type0, 0));
int base_low = ada_discrete_type_low_bound (type0->index_type ());
- LONGEST base_low_pos, low_pos;
+ gdb::optional<LONGEST> base_low_pos, low_pos;
CORE_ADDR base;
- if (!discrete_position (base_index_type, low, &low_pos)
- || !discrete_position (base_index_type, base_low, &base_low_pos))
+ low_pos = discrete_position (base_index_type, low);
+ base_low_pos = discrete_position (base_index_type, base_low);
+
+ if (!low_pos.has_value () || !base_low_pos.has_value ())
{
warning (_("unable to get positions in slice, use bounds instead"));
low_pos = low;
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);
}
(NULL, TYPE_TARGET_TYPE (type), index_type,
type->dyn_prop (DYN_PROP_BYTE_STRIDE),
TYPE_FIELD_BITSIZE (type, 0));
- LONGEST low_pos, high_pos;
+ gdb::optional<LONGEST> low_pos, high_pos;
+
- if (!discrete_position (base_index_type, low, &low_pos)
- || !discrete_position (base_index_type, high, &high_pos))
+ low_pos = discrete_position (base_index_type, low);
+ high_pos = discrete_position (base_index_type, high);
+
+ if (!low_pos.has_value () || !high_pos.has_value ())
{
warning (_("unable to get positions in slice, use bounds instead"));
low_pos = low;
}
return value_cast (slice_type,
- value_slice (array, low, high_pos - low_pos + 1));
+ value_slice (array, low, *high_pos - *low_pos + 1));
}
/* If type is a record type in the form of a standard GNAT array
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);
+ 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
{
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 (arr_type0->index_type ()), 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;
}
}
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;
}
+/* See ada-lang.h. */
+
+block_symbol
+ada_find_operator_symbol (enum exp_opcode op, int parse_completion,
+ int nargs, value *argvec[])
+{
+ if (possible_user_operator_p (op, argvec))
+ {
+ std::vector<struct block_symbol> candidates
+ = ada_lookup_symbol_list (ada_decoded_op_name (op),
+ NULL, VAR_DOMAIN);
+
+ int i = ada_resolve_function (candidates, argvec,
+ nargs, ada_decoded_op_name (op), NULL,
+ parse_completion);
+ if (i >= 0)
+ return candidates[i];
+ }
+ return {};
+}
+
+/* See ada-lang.h. */
+
+block_symbol
+ada_resolve_funcall (struct symbol *sym, const struct block *block,
+ struct type *context_type,
+ int parse_completion,
+ int nargs, value *argvec[],
+ innermost_block_tracker *tracker)
+{
+ std::vector<struct block_symbol> candidates
+ = ada_lookup_symbol_list (sym->linkage_name (), block, VAR_DOMAIN);
+
+ int i;
+ if (candidates.size () == 1)
+ i = 0;
+ else
+ {
+ i = ada_resolve_function
+ (candidates,
+ argvec, nargs,
+ sym->linkage_name (),
+ context_type, parse_completion);
+ if (i < 0)
+ error (_("Could not find a match for %s"), sym->print_name ());
+ }
+
+ tracker->update (candidates[i]);
+ return candidates[i];
+}
+
+/* See ada-lang.h. */
+
+block_symbol
+ada_resolve_variable (struct symbol *sym, const struct block *block,
+ struct type *context_type,
+ int parse_completion,
+ int deprocedure_p,
+ innermost_block_tracker *tracker)
+{
+ std::vector<struct block_symbol> candidates
+ = ada_lookup_symbol_list (sym->linkage_name (), block, VAR_DOMAIN);
+
+ if (std::any_of (candidates.begin (),
+ candidates.end (),
+ [] (block_symbol &bsym)
+ {
+ switch (SYMBOL_CLASS (bsym.symbol))
+ {
+ case LOC_REGISTER:
+ case LOC_ARG:
+ case LOC_REF_ARG:
+ case LOC_REGPARM_ADDR:
+ case LOC_LOCAL:
+ case LOC_COMPUTED:
+ return true;
+ default:
+ return false;
+ }
+ }))
+ {
+ /* Types tend to get re-introduced locally, so if there
+ are any local symbols that are not types, first filter
+ out all types. */
+ candidates.erase
+ (std::remove_if
+ (candidates.begin (),
+ candidates.end (),
+ [] (block_symbol &bsym)
+ {
+ return SYMBOL_CLASS (bsym.symbol) == LOC_TYPEDEF;
+ }),
+ candidates.end ());
+ }
+
+ int i;
+ if (candidates.empty ())
+ error (_("No definition found for %s"), sym->print_name ());
+ else if (candidates.size () == 1)
+ i = 0;
+ else if (deprocedure_p && !is_nonfunction (candidates))
+ {
+ i = ada_resolve_function
+ (candidates, NULL, 0,
+ sym->linkage_name (),
+ context_type, parse_completion);
+ if (i < 0)
+ error (_("Could not find a match for %s"), sym->print_name ());
+ }
+ else
+ {
+ printf_filtered (_("Multiple matches for %s\n"), sym->print_name ());
+ user_select_syms (candidates.data (), candidates.size (), 1);
+ i = 0;
+ }
+
+ tracker->update (candidates[i]);
+ return candidates[i];
+}
+
/* 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;
struct value **argvec; /* Vector of operand types (alloca'ed). */
int nargs; /* Number of operands. */
int oplen;
+ /* If we're resolving an expression like ARRAY(ARG...), then we set
+ this to the type of the array, so we can use the index types as
+ the expected types for resolution. */
+ struct type *array_type = nullptr;
+ /* The arity of ARRAY_TYPE. */
+ int array_arity = 0;
argvec = NULL;
nargs = 0;
{
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;
+ struct value *lhs = resolve_subexp (expp, pos, 0, NULL,
+ parse_completion, tracker);
+ struct type *lhstype = ada_check_typedef (value_type (lhs));
+ array_arity = ada_array_arity (lhstype);
+ if (array_arity > 0)
+ array_type = lhstype;
+ }
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:
argvec = XALLOCAVEC (struct value *, nargs + 1);
for (i = 0; i < nargs; i += 1)
- argvec[i] = resolve_subexp (expp, pos, 1, NULL, parse_completion,
- tracker);
+ {
+ struct type *subtype = nullptr;
+ if (i < array_arity)
+ subtype = ada_index_type (array_type, i + 1, "array type");
+ argvec[i] = resolve_subexp (expp, pos, 1, subtype, parse_completion,
+ tracker);
+ }
argvec[i] = NULL;
exp = expp->get ();
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;
- tracker->update (candidates[i]);
- }
+ {
+ block_symbol resolved
+ = ada_resolve_variable (exp->elts[pc + 2].symbol,
+ exp->elts[pc + 1].block,
+ context_type, parse_completion,
+ deprocedure_p, tracker);
+ exp->elts[pc + 1].block = resolved.block;
+ exp->elts[pc + 2].symbol = resolved.symbol;
+ }
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)
- {
- 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;
- tracker->update (candidates[i]);
- }
+ if (exp->elts[pc + 3].opcode == OP_VAR_VALUE
+ && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
+ {
+ block_symbol resolved
+ = ada_resolve_funcall (exp->elts[pc + 5].symbol,
+ exp->elts[pc + 4].block,
+ context_type, parse_completion,
+ nargs, argvec,
+ tracker);
+ exp->elts[pc + 4].block = resolved.block;
+ exp->elts[pc + 5].symbol = resolved.symbol;
+ }
}
break;
case BINOP_ADD:
case UNOP_PLUS:
case UNOP_LOGICAL_NOT:
case UNOP_ABS:
- if (possible_user_operator_p (op, argvec))
- {
- std::vector<struct block_symbol> candidates;
- int n_candidates;
-
- n_candidates =
- ada_lookup_symbol_list (ada_decoded_op_name (op),
- NULL, VAR_DOMAIN,
- &candidates);
+ {
+ block_symbol found = ada_find_operator_symbol (op, parse_completion,
+ nargs, argvec);
+ if (found.symbol == nullptr)
+ break;
- i = ada_resolve_function (candidates.data (), n_candidates, argvec,
- nargs, ada_decoded_op_name (op), NULL,
- parse_completion);
- if (i < 0)
- break;
-
- replace_operator_with_call (expp, pc, nargs, 1,
- candidates[i].symbol,
- candidates[i].block);
- exp = expp->get ();
- }
+ replace_operator_with_call (expp, pc, nargs, 1,
+ found.symbol, found.block);
+ 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:
for (i = 0; i < n_actuals; i += 1)
{
if (actuals[i] == NULL)
- return 0;
+ return 0;
else
- {
- struct type *ftype = ada_check_typedef (func_type->field (i).type ());
- 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;
}
}
-/* Returns the index in SYMS[0..NSYMS-1] that contains the symbol for the
+/* Returns the index in SYMS that contains the symbol for the
function (if any) that matches the types of the NARGS arguments in
ARGS. If CONTEXT_TYPE is non-null and there is at least one match
that returns that type, then eliminate matches that don't. If
the process; the index returned is for the modified vector. */
static int
-ada_resolve_function (struct block_symbol syms[],
- int nsyms, struct value **args, int nargs,
- const char *name, struct type *context_type,
+ada_resolve_function (std::vector<struct block_symbol> &syms,
+ struct value **args, int nargs,
+ const char *name, struct type *context_type,
int parse_completion)
{
int fallback;
where every function is accepted. */
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));
+ for (k = 0; k < syms.size (); k += 1)
+ {
+ 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
else if (m > 1 && !parse_completion)
{
printf_filtered (_("Multiple matches for %s\n"), name);
- user_select_syms (syms, m, 1);
+ user_select_syms (syms.data (), m, 1);
return 0;
}
return 0;
static void
replace_operator_with_call (expression_up *expp, int pc, int nargs,
- 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));
+ int oplen, struct symbol *sym,
+ const struct block *block)
+{
+ /* We want to add 6 more elements (3 for funcall, 4 for function
+ symbol, -OPLEN for operator being replaced) to the
+ expression. */
struct expression *exp = expp->get ();
+ int save_nelts = exp->nelts;
+ int extra_elts = 7 - oplen;
+ exp->nelts += extra_elts;
- newexp->nelts = exp->nelts + 7 - oplen;
- newexp->language_defn = exp->language_defn;
- 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));
+ if (extra_elts > 0)
+ exp->resize (exp->nelts);
+ memmove (exp->elts + pc + 7, exp->elts + pc + oplen,
+ EXP_ELEM_TO_BYTES (save_nelts - pc - oplen));
+ if (extra_elts < 0)
+ exp->resize (exp->nelts);
- newexp->elts[pc].opcode = newexp->elts[pc + 2].opcode = OP_FUNCALL;
- newexp->elts[pc + 1].longconst = (LONGEST) nargs;
+ exp->elts[pc].opcode = exp->elts[pc + 2].opcode = OP_FUNCALL;
+ exp->elts[pc + 1].longconst = (LONGEST) nargs;
- newexp->elts[pc + 3].opcode = newexp->elts[pc + 6].opcode = OP_VAR_VALUE;
- newexp->elts[pc + 4].block = block;
- newexp->elts[pc + 5].symbol = sym;
-
- expp->reset (newexp);
+ exp->elts[pc + 3].opcode = exp->elts[pc + 6].opcode = OP_VAR_VALUE;
+ exp->elts[pc + 4].block = block;
+ exp->elts[pc + 5].symbol = sym;
}
/* Type-class predicates */
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);
static CORE_ADDR
value_pointer (struct value *value, struct type *type)
{
- struct gdbarch *gdbarch = get_type_arch (type);
unsigned len = TYPE_LENGTH (type);
gdb_byte *buf = (gdb_byte *) alloca (len);
CORE_ADDR addr;
addr = value_address (value);
- gdbarch_address_to_pointer (gdbarch, type, buf, addr);
+ gdbarch_address_to_pointer (type->arch (), type, buf, addr);
addr = extract_unsigned_integer (buf, len, type_byte_order (type));
return addr;
}
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
even in this case, some expensive name-based symbol searches are still
sometimes necessary - to find an XVZ variable, mostly. */
-/* Initialize the contents of SYM_CACHE. */
-
-static void
-ada_init_symbol_cache (struct ada_symbol_cache *sym_cache)
-{
- obstack_init (&sym_cache->cache_space);
- memset (sym_cache->root, '\000', sizeof (sym_cache->root));
-}
-
-/* Free the memory used by SYM_CACHE. */
-
-static void
-ada_free_symbol_cache (struct ada_symbol_cache *sym_cache)
-{
- obstack_free (&sym_cache->cache_space, NULL);
- xfree (sym_cache);
-}
-
/* Return the symbol cache associated to the given program space PSPACE.
If not allocated for this PSPACE yet, allocate and initialize one. */
{
struct ada_pspace_data *pspace_data = get_ada_pspace_data (pspace);
- if (pspace_data->sym_cache == NULL)
- {
- pspace_data->sym_cache = XCNEW (struct ada_symbol_cache);
- ada_init_symbol_cache (pspace_data->sym_cache);
- }
+ if (pspace_data->sym_cache == nullptr)
+ pspace_data->sym_cache.reset (new ada_symbol_cache);
- return pspace_data->sym_cache;
+ return pspace_data->sym_cache.get ();
}
/* Clear all entries from the symbol cache. */
static void
-ada_clear_symbol_cache (void)
+ada_clear_symbol_cache ()
{
- struct ada_symbol_cache *sym_cache
- = ada_get_symbol_cache (current_program_space);
+ struct ada_pspace_data *pspace_data
+ = get_ada_pspace_data (current_program_space);
- obstack_free (&sym_cache->cache_space, NULL);
- ada_init_symbol_cache (sym_cache);
+ if (pspace_data->sym_cache != nullptr)
+ pspace_data->sym_cache.reset ();
}
/* Search our cache for an entry matching NAME and DOMAIN.
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 = {};
/* Non-zero iff there is at least one non-function/non-enumeral symbol
- in the symbol fields of SYMS[0..N-1]. We treat enumerals as functions,
+ in the symbol fields of SYMS. We treat enumerals as functions,
since they contend in overloading in the same way. */
static int
-is_nonfunction (struct block_symbol syms[], int n)
+is_nonfunction (const std::vector<struct block_symbol> &syms)
{
- int i;
-
- 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))
+ for (const block_symbol &sym : syms)
+ if (SYMBOL_TYPE (sym.symbol)->code () != TYPE_CODE_FUNC
+ && (SYMBOL_TYPE (sym.symbol)->code () != TYPE_CODE_ENUM
+ || SYMBOL_CLASS (sym.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:
}
}
-/* Append (SYM,BLOCK,SYMTAB) to the end of the array of struct block_symbol
- records in OBSTACKP. Do nothing if SYM is a duplicate. */
+/* Append (SYM,BLOCK) to the end of the array of struct block_symbol
+ records in RESULT. Do nothing if SYM is a duplicate. */
static void
-add_defn_to_vec (struct obstack *obstackp,
- struct symbol *sym,
- const struct block *block)
+add_defn_to_vec (std::vector<struct block_symbol> &result,
+ struct symbol *sym,
+ const struct block *block)
{
- int i;
- struct block_symbol *prevDefns = defns_collected (obstackp, 0);
-
/* Do not try to complete stub types, as the debugger is probably
already scanning all symbols matching a certain name at the
time when this function is called. Trying to replace the stub
matches, with at least one of them complete. It can then filter
out the stub ones if needed. */
- for (i = num_defns_collected (obstackp) - 1; i >= 0; i -= 1)
+ for (int i = result.size () - 1; i >= 0; i -= 1)
{
- if (lesseq_defined_than (sym, prevDefns[i].symbol))
- return;
- else if (lesseq_defined_than (prevDefns[i].symbol, sym))
- {
- prevDefns[i].symbol = sym;
- prevDefns[i].block = block;
- return;
- }
+ if (lesseq_defined_than (sym, result[i].symbol))
+ return;
+ else if (lesseq_defined_than (result[i].symbol, sym))
+ {
+ result[i].symbol = sym;
+ result[i].block = block;
+ return;
+ }
}
- {
- struct block_symbol info;
-
- info.symbol = sym;
- info.block = block;
- obstack_grow (obstackp, &info, sizeof (struct block_symbol));
- }
-}
-
-/* Number of block_symbol structures currently collected in current vector in
- OBSTACKP. */
-
-static int
-num_defns_collected (struct obstack *obstackp)
-{
- return obstack_object_size (obstackp) / sizeof (struct block_symbol);
-}
-
-/* Vector of block_symbol structures currently collected in current vector in
- OBSTACKP. If FINISH, close off the vector and return its final address. */
-
-static struct block_symbol *
-defns_collected (struct obstack *obstackp, int finish)
-{
- if (finish)
- return (struct block_symbol *) obstack_finish (obstackp);
- else
- return (struct block_symbol *) obstack_base (obstackp);
+ struct block_symbol info;
+ info.symbol = sym;
+ info.block = block;
+ result.push_back (info);
}
/* Return a bound minimal symbol matching NAME according to Ada
/* For all subprograms that statically enclose the subprogram of the
selected frame, add symbols matching identifier NAME in DOMAIN
- and their blocks to the list of data in OBSTACKP, as for
+ and their blocks to the list of data in RESULT, as for
ada_add_block_symbols (q.v.). If WILD_MATCH_P, treat as NAME
with a wildcard prefix. */
static void
-add_symbols_from_enclosing_procs (struct obstack *obstackp,
+add_symbols_from_enclosing_procs (std::vector<struct block_symbol> &result,
const lookup_name_info &lookup_name,
domain_enum domain)
{
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 (SYMBOL_TYPE (syms[i].symbol)->num_fields ()
- != SYMBOL_TYPE (syms[0].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;
duplicate other symbols in the list (The only case I know of where
this happens is when object files containing stabs-in-ecoff are
linked with files containing ordinary ecoff debugging symbols (or no
- debugging symbols)). Modifies SYMS to squeeze out deleted entries.
- Returns the number of items in the modified list. */
+ debugging symbols)). Modifies SYMS to squeeze out deleted entries. */
-static int
+static void
remove_extra_symbols (std::vector<struct block_symbol> *syms)
{
int i, j;
cannot be any extra symbol in that case. But it's easy to
handle, since we have nothing to do in that case. */
if (syms->size () < 2)
- return syms->size ();
+ return;
i = 0;
while (i < syms->size ())
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. */
+ 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;
- }
- }
+ && (*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);
isn't missing some choices that were identical and yet distinct. */
if (symbols_are_identical_enums (*syms))
syms->resize (1);
-
- return syms->size ();
}
/* Given a type that corresponds to a renaming entity, use the type name
is not visible from the function associated with CURRENT_BLOCK or
that is superfluous due to the presence of more specific renaming
information. Places surviving symbols in the initial entries of
- SYMS and returns the number of surviving symbols.
-
+ SYMS.
+
Rationale:
First, in cases where an object renaming is implemented as a
reference variable, GNAT may produce both the actual reference
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
+static void
remove_irrelevant_renamings (std::vector<struct block_symbol> *syms,
const struct block *current_block)
{
(*syms)[k] = (*syms)[j];
k += 1;
}
- return k;
+ syms->resize (k);
+ return;
}
/* Extract the function name associated to CURRENT_BLOCK.
Abort if unable to do so. */
if (current_block == NULL)
- return syms->size ();
+ return;
current_function = block_linkage_function (current_block);
if (current_function == NULL)
- return syms->size ();
+ return;
current_function_name = current_function->linkage_name ();
if (current_function_name == NULL)
- return syms->size ();
+ return;
/* Check each of the symbols, and remove it from the list if it is
a type corresponding to a renaming that is out of the scope of
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 ();
}
-/* Add to OBSTACKP all symbols from BLOCK (and its super-blocks)
+/* Add to RESULT all symbols from BLOCK (and its super-blocks)
whose name and domain match NAME and DOMAIN respectively.
If no match was found, then extend the search to "enclosing"
routines (in other words, if we're inside a nested function,
If WILD_MATCH_P is nonzero, perform the naming matching in
"wild" mode (see function "wild_match" for more info).
- Note: This function assumes that OBSTACKP has 0 (zero) element in it. */
+ Note: This function assumes that RESULT has 0 (zero) element in it. */
static void
-ada_add_local_symbols (struct obstack *obstackp,
+ada_add_local_symbols (std::vector<struct block_symbol> &result,
const lookup_name_info &lookup_name,
const struct block *block, domain_enum domain)
{
while (block != NULL)
{
block_depth += 1;
- ada_add_block_symbols (obstackp, block, lookup_name, domain, NULL);
+ ada_add_block_symbols (result, block, lookup_name, domain, NULL);
/* If we found a non-function match, assume that's the one. */
- if (is_nonfunction (defns_collected (obstackp, 0),
- num_defns_collected (obstackp)))
- return;
+ if (is_nonfunction (result))
+ return;
block = BLOCK_SUPERBLOCK (block);
}
/* If no luck so far, try to find NAME as a local symbol in some lexically
enclosing subprogram. */
- if (num_defns_collected (obstackp) == 0 && block_depth > 2)
- add_symbols_from_enclosing_procs (obstackp, lookup_name, domain);
+ if (result.empty () && block_depth > 2)
+ add_symbols_from_enclosing_procs (result, lookup_name, domain);
}
/* An object of this type is used as the user_data argument when
struct match_data
{
- struct objfile *objfile;
- struct obstack *obstackp;
- struct symbol *arg_sym;
- int found_sym;
+ explicit match_data (std::vector<struct block_symbol> *rp)
+ : resultp (rp)
+ {
+ }
+ DISABLE_COPY_AND_ASSIGN (match_data);
+
+ struct objfile *objfile = nullptr;
+ std::vector<struct block_symbol> *resultp;
+ struct symbol *arg_sym = nullptr;
+ bool found_sym = false;
};
/* A callback for add_nonlocal_symbols that adds symbol, found in BSYM,
to a list of symbols. DATA is a pointer to a struct match_data *
- containing the obstack that collects the symbol list, the file that SYM
+ containing the vector that collects the symbol list, the file that SYM
must come from, a flag indicating whether a non-argument symbol has
been found in the current block, and the last argument symbol
passed in SYM within the current block (if any). When SYM is null,
if (sym == NULL)
{
if (!data->found_sym && data->arg_sym != NULL)
- add_defn_to_vec (data->obstackp,
+ add_defn_to_vec (*data->resultp,
fixup_symbol_section (data->arg_sym, data->objfile),
block);
- data->found_sym = 0;
+ data->found_sym = false;
data->arg_sym = NULL;
}
else
data->arg_sym = sym;
else
{
- data->found_sym = 1;
- add_defn_to_vec (data->obstackp,
+ data->found_sym = true;
+ add_defn_to_vec (*data->resultp,
fixup_symbol_section (sym, data->objfile),
block);
}
/* Helper for add_nonlocal_symbols. Find symbols in DOMAIN which are
targeted by renamings matching LOOKUP_NAME in BLOCK. Add these
- symbols to OBSTACKP. Return whether we found such symbols. */
+ symbols to RESULT. Return whether we found such symbols. */
static int
-ada_add_block_renamings (struct obstack *obstackp,
+ada_add_block_renamings (std::vector<struct block_symbol> &result,
const struct block *block,
const lookup_name_info &lookup_name,
domain_enum domain)
{
struct using_direct *renaming;
- int defns_mark = num_defns_collected (obstackp);
+ int defns_mark = result.size ();
symbol_name_matcher_ftype *name_match
= ada_get_symbol_name_matcher (lookup_name);
{
lookup_name_info decl_lookup_name (renaming->declaration,
lookup_name.match_type ());
- ada_add_all_symbols (obstackp, block, decl_lookup_name, domain,
+ ada_add_all_symbols (result, block, decl_lookup_name, domain,
1, NULL);
}
renaming->searched = 0;
}
- return num_defns_collected (obstackp) != defns_mark;
+ return result.size () != defns_mark;
}
/* Implements compare_names, but only applying the comparision using
return lookup_name.ada ().lookup_name ().c_str ();
}
-/* Add to OBSTACKP all non-local symbols whose name and domain match
+/* Add to RESULT all non-local symbols whose name and domain match
LOOKUP_NAME and DOMAIN respectively. The search is performed on
GLOBAL_BLOCK symbols if GLOBAL is non-zero, or on STATIC_BLOCK
symbols otherwise. */
static void
-add_nonlocal_symbols (struct obstack *obstackp,
+add_nonlocal_symbols (std::vector<struct block_symbol> &result,
const lookup_name_info &lookup_name,
domain_enum domain, int global)
{
- struct match_data data;
-
- memset (&data, 0, sizeof data);
- data.obstackp = obstackp;
+ struct match_data data (&result);
bool is_wild_match = lookup_name.ada ().wild_match_p ();
{
data.objfile = objfile;
- objfile->sf->qf->map_matching_symbols (objfile, lookup_name,
- domain, global, callback,
- (is_wild_match
- ? NULL : compare_names));
+ if (objfile->sf != nullptr)
+ objfile->sf->qf->map_matching_symbols (objfile, lookup_name,
+ domain, global, callback,
+ (is_wild_match
+ ? NULL : compare_names));
for (compunit_symtab *cu : objfile->compunits ())
{
const struct block *global_block
= BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (cu), GLOBAL_BLOCK);
- if (ada_add_block_renamings (obstackp, global_block, lookup_name,
+ if (ada_add_block_renamings (result, global_block, lookup_name,
domain))
- data.found_sym = 1;
+ data.found_sym = true;
}
}
- if (num_defns_collected (obstackp) == 0 && global && !is_wild_match)
+ if (result.empty () && global && !is_wild_match)
{
const char *name = ada_lookup_name (lookup_name);
std::string bracket_name = std::string ("<_ada_") + name + '>';
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,
- compare_names);
+ if (objfile->sf != nullptr)
+ objfile->sf->qf->map_matching_symbols (objfile, name1,
+ domain, global, callback,
+ compare_names);
}
}
}
/* Find symbols in DOMAIN matching LOOKUP_NAME, in BLOCK and, if
FULL_SEARCH is non-zero, enclosing scope and in global scopes,
- returning the number of matches. Add these to OBSTACKP.
+ returning the number of matches. Add these to RESULT.
When FULL_SEARCH is non-zero, any non-function/non-enumeral
symbol match within the nest of blocks whose innermost member is BLOCK,
to lookup global symbols. */
static void
-ada_add_all_symbols (struct obstack *obstackp,
+ada_add_all_symbols (std::vector<struct block_symbol> &result,
const struct block *block,
const lookup_name_info &lookup_name,
domain_enum domain,
if (block != NULL)
{
if (full_search)
- ada_add_local_symbols (obstackp, lookup_name, block, domain);
+ ada_add_local_symbols (result, lookup_name, block, domain);
else
{
/* In the !full_search case we're are being called by
iterate_over_symbols, and we don't want to search
superblocks. */
- ada_add_block_symbols (obstackp, block, lookup_name, domain, NULL);
+ ada_add_block_symbols (result, block, lookup_name, domain, NULL);
}
- if (num_defns_collected (obstackp) > 0 || !full_search)
+ if (!result.empty () || !full_search)
return;
}
domain, &sym, &block))
{
if (sym != NULL)
- add_defn_to_vec (obstackp, sym, block);
+ add_defn_to_vec (result, sym, block);
return;
}
/* Search symbols from all global blocks. */
- add_nonlocal_symbols (obstackp, lookup_name, domain, 1);
+ add_nonlocal_symbols (result, lookup_name, domain, 1);
/* Now add symbols from all per-file blocks if we've gotten no hits
(not strictly correct, but perhaps better than an error). */
- if (num_defns_collected (obstackp) == 0)
- add_nonlocal_symbols (obstackp, lookup_name, domain, 0);
+ if (result.empty ())
+ add_nonlocal_symbols (result, lookup_name, domain, 0);
}
/* Find symbols in DOMAIN matching LOOKUP_NAME, in BLOCK and, if FULL_SEARCH
- is non-zero, enclosing scope and in global scopes, returning the number of
- matches.
- Fills *RESULTS with (SYM,BLOCK) tuples, indicating the symbols
- found and the blocks and symbol tables (if any) in which they were
- found.
+ is non-zero, enclosing scope and in global scopes.
+
+ Returns (SYM,BLOCK) tuples, indicating the symbols found and the
+ blocks and symbol tables (if any) in which they were found.
When full_search is non-zero, any non-function/non-enumeral
symbol match within the nest of blocks whose innermost member is BLOCK,
Names prefixed with "standard__" are handled specially: "standard__"
is first stripped off, and only static and global symbols are searched. */
-static int
+static std::vector<struct block_symbol>
ada_lookup_symbol_list_worker (const lookup_name_info &lookup_name,
const struct block *block,
domain_enum domain,
- std::vector<struct block_symbol> *results,
int full_search)
{
int syms_from_global_search;
- int ndefns;
- auto_obstack obstack;
+ std::vector<struct block_symbol> results;
- ada_add_all_symbols (&obstack, block, lookup_name,
+ ada_add_all_symbols (results, block, lookup_name,
domain, full_search, &syms_from_global_search);
- ndefns = num_defns_collected (&obstack);
-
- struct block_symbol *base = defns_collected (&obstack, 1);
- for (int i = 0; i < ndefns; ++i)
- results->push_back (base[i]);
+ remove_extra_symbols (&results);
- ndefns = remove_extra_symbols (results);
-
- if (ndefns == 0 && full_search && syms_from_global_search)
+ if (results.empty () && full_search && syms_from_global_search)
cache_symbol (ada_lookup_name (lookup_name), domain, NULL, NULL);
- if (ndefns == 1 && full_search && syms_from_global_search)
+ if (results.size () == 1 && full_search && syms_from_global_search)
cache_symbol (ada_lookup_name (lookup_name), domain,
- (*results)[0].symbol, (*results)[0].block);
-
- ndefns = remove_irrelevant_renamings (results, block);
+ results[0].symbol, results[0].block);
- return ndefns;
+ remove_irrelevant_renamings (&results, block);
+ return results;
}
/* Find symbols in DOMAIN matching NAME, in BLOCK and enclosing scope and
- in global scopes, returning the number of matches, and filling *RESULTS
- with (SYM,BLOCK) tuples.
+ in global scopes, returning (SYM,BLOCK) tuples.
See ada_lookup_symbol_list_worker for further details. */
-int
+std::vector<struct block_symbol>
ada_lookup_symbol_list (const char *name, const struct block *block,
- domain_enum domain,
- std::vector<struct block_symbol> *results)
+ domain_enum domain)
{
symbol_name_match_type name_match_type = name_match_type_from_name (name);
lookup_name_info lookup_name (name, name_match_type);
- return ada_lookup_symbol_list_worker (lookup_name, block, domain, results, 1);
+ return ada_lookup_symbol_list_worker (lookup_name, block, domain, 1);
}
/* The result is as for ada_lookup_symbol_list with FULL_SEARCH set
ada_lookup_name_info would re-encode/fold it again, and that
would e.g., incorrectly lowercase object renaming names like
"R28b" -> "r28b". */
- std::string verbatim = std::string ("<") + name + '>';
+ std::string verbatim = add_angle_brackets (name);
gdb_assert (info != NULL);
*info = ada_lookup_symbol (verbatim.c_str (), block, domain);
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;
-
- n_candidates = ada_lookup_symbol_list (name, block0, domain, &candidates);
+ std::vector<struct block_symbol> candidates
+ = ada_lookup_symbol_list (name, block0, domain);
- if (n_candidates == 0)
+ if (candidates.empty ())
return {};
block_symbol info = candidates[0];
{
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 == '_')
name += 2;
break;
}
+ else if (t1 == '_' && name[2] == 'B' && name[3] == '_')
+ {
+ /* Names like "pkg__B_N__name", where N is a number, are
+ block-local. We can handle these by simply skipping
+ the "B_" here. */
+ name += 4;
+ }
else
return 0;
}
}
}
-/* Returns true iff symbol name SYM_NAME matches SEARCH_NAME, ignoring
- any trailing suffixes that encode debugging information or leading
- _ada_ on SYM_NAME (see is_name_suffix commentary for the debugging
- information that is ignored). */
-
-static bool
-full_match (const char *sym_name, const char *search_name)
-{
- size_t search_name_len = strlen (search_name);
-
- if (strncmp (sym_name, search_name, search_name_len) == 0
- && is_name_suffix (sym_name + search_name_len))
- return true;
-
- if (startswith (sym_name, "_ada_")
- && strncmp (sym_name + 5, search_name, search_name_len) == 0
- && is_name_suffix (sym_name + search_name_len + 5))
- return true;
-
- return false;
-}
-
-/* Add symbols from BLOCK matching LOOKUP_NAME in DOMAIN to vector
- *defn_symbols, updating the list of symbols in OBSTACKP (if
+/* Add symbols from BLOCK matching LOOKUP_NAME in DOMAIN to RESULT (if
necessary). OBJFILE is the section containing BLOCK. */
static void
-ada_add_block_symbols (struct obstack *obstackp,
+ada_add_block_symbols (std::vector<struct block_symbol> &result,
const struct block *block,
const lookup_name_info &lookup_name,
domain_enum domain, struct objfile *objfile)
/* A matching argument symbol, if any. */
struct symbol *arg_sym;
/* Set true when we find a matching non-argument symbol. */
- int found_sym;
+ bool found_sym;
struct symbol *sym;
arg_sym = NULL;
- found_sym = 0;
+ found_sym = false;
for (sym = block_iter_match_first (block, lookup_name, &iter);
sym != NULL;
sym = block_iter_match_next (lookup_name, &iter))
arg_sym = sym;
else
{
- found_sym = 1;
- add_defn_to_vec (obstackp,
+ found_sym = true;
+ add_defn_to_vec (result,
fixup_symbol_section (sym, objfile),
block);
}
/* Handle renamings. */
- if (ada_add_block_renamings (obstackp, block, lookup_name, domain))
- found_sym = 1;
+ if (ada_add_block_renamings (result, block, lookup_name, domain))
+ found_sym = true;
if (!found_sym && arg_sym != NULL)
{
- add_defn_to_vec (obstackp,
- fixup_symbol_section (arg_sym, objfile),
- block);
+ add_defn_to_vec (result,
+ fixup_symbol_section (arg_sym, objfile),
+ block);
}
if (!lookup_name.ada ().wild_match_p ())
{
arg_sym = NULL;
- found_sym = 0;
+ found_sym = false;
const std::string &ada_lookup_name = lookup_name.ada ().lookup_name ();
const char *name = ada_lookup_name.c_str ();
size_t name_len = ada_lookup_name.size ();
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))
arg_sym = sym;
else
{
- found_sym = 1;
- add_defn_to_vec (obstackp,
+ found_sym = true;
+ add_defn_to_vec (result,
fixup_symbol_section (sym, objfile),
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 (result,
+ 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;
}
- /* Field Access */
+ /* Field Access */
/* Return non-zero if TYPE is a pointer to the GNAT dispatch table used
for tagged types. */
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
gdb::unique_xmalloc_ptr<char> type_name = ada_tag_name (tag);
if (type_name != NULL)
- return ada_find_any_type (ada_encode (type_name.get ()));
+ return ada_find_any_type (ada_encode (type_name.get ()).c_str ());
return NULL;
}
for (i = 0; i < type->num_fields (); i += 1)
if (ada_is_parent_field (type, i))
{
- struct type *parent_type = type->field (i).type ();
+ 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
const char *
ada_variant_discrim_name (struct type *type0)
{
- static char *result = NULL;
- static size_t result_len = 0;
+ static std::string result;
struct type *type;
const char *name;
const char *discrim_end;
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);
- strncpy (result, discrim_start, discrim_end - discrim_start);
- result[discrim_end - discrim_start] = '\0';
- return result;
+ result = std::string (discrim_start, discrim_end - discrim_start);
+ return result.c_str ();
}
/* Scan STR for a subtype-encoded number, beginning at position K.
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;
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;
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 (i).type ();
*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 (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
+ 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;
- }
- }
+ 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 fld_offset = offset + bit_pos / 8;
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;
+ 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;
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 (i).type ());
+ {
+ 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 (i).type ());
- int var_offset = offset + TYPE_FIELD_BITPOS (type, i) / 8;
+ 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
+ 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,
- field_type->field (j).type ());
+ (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
type->field (parent_offset).type ());
if (v != NULL)
- return v;
+ return v;
}
return NULL;
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 (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)"));
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 (i).type ();
else if (ada_is_wrapper_field (type, i))
- {
- t = ada_lookup_struct_elt_type (type->field (i).type (), 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 (i).type ());
+ {
+ int j;
+ struct type *field_type = ada_check_typedef (type->field (i).type ());
- for (j = field_type->num_fields () - 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
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 (parent_offset).type (),
- 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;
}
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");
}
}
for (f = 0; f < type->num_fields (); f += 1)
{
if (ada_is_variant_part (type, f))
- return f;
+ return f;
}
return -1;
}
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;
{
nfields = 0;
while (nfields < type->num_fields ()
- && !ada_is_variant_part (type, nfields)
- && !is_dynamic_field (type, nfields))
- nfields++;
+ && !ada_is_variant_part (type, nfields)
+ && !is_dynamic_field (type, nfields))
+ nfields++;
}
rtype = alloc_type_copy (type);
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 (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.
ada_ensure_varsize_limit (field_type);
rtype->field (f).set_type (field_type);
- TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
+ 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 (rtype->field (f).type ()) * 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. */
- 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
+ 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 (f).type ();
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 (variant_field).type (),
- 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 < rtype->num_fields (); f += 1)
- rtype->field (f - 1) = rtype->field (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
- {
- 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;
- }
+ {
+ 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
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)
{
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;
branch_type = to_fixed_variant_branch_type
(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)
- rtype->field (f - 1) = rtype->field (f);
+ rtype->field (f - 1) = rtype->field (f);
rtype->set_num_fields (rtype->num_fields () - 1);
}
else
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;
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
{
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;
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;
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, type0->index_type ());
+ result = create_array_type (alloc_type_copy (type0),
+ elt_type, type0->index_type ());
}
else
{
elt_type0 = type0;
for (i = index_type_desc->num_fields (); i > 0; i -= 1)
- elt_type0 = TYPE_TARGET_TYPE (elt_type0);
+ 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 = 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);
+ {
+ 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)++;
}
result->set_is_fixed_instance (true);
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. */
+ 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;
+ }
+ }
+ 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 =
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);
}
}
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);
}
}
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);
{
struct value *val = coerce_ref (arg);
struct type *type = value_type (val);
- LONGEST result;
if (!discrete_type_p (type))
error (_("'POS only defined on discrete types"));
- if (!discrete_position (type, value_as_long (val), &result))
+ gdb::optional<LONGEST> result = discrete_position (type, value_as_long (val));
+ if (!result.has_value ())
error (_("enumeration value is invalid: can't find 'POS"));
- return result;
+ return *result;
}
static struct value *
if (type->code () == TYPE_CODE_ENUM)
{
if (val < 0 || val >= type->num_fields ())
- error (_("argument to 'VAL out of range"));
+ 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)
+ada_val_atr (enum noside noside, struct type *type, struct value *arg)
{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (type, not_lval);
+
if (!discrete_type_p (type))
error (_("'VAL only defined on discrete types"));
if (!integer_type_p (value_type (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->num_fields () == 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
{
if (ada_is_aligner_type (type))
return ada_aligned_value_addr (type->field (0).type (),
- valaddr +
- TYPE_FIELD_BITPOS (type,
- 0) / TARGET_CHAR_BIT);
+ valaddr +
+ TYPE_FIELD_BITPOS (type,
+ 0) / TARGET_CHAR_BIT);
else
return valaddr;
}
const char *
ada_enum_name (const char *name)
{
- static char *result;
- static size_t result_len = 0;
+ static std::string storage;
const char *tmp;
/* First, unqualify the enumeration name:
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')
{
- GROW_VECT (result, result_len, 4);
- xsnprintf (result, result_len, "'%c'", name[1]);
- return result;
+ storage = string_printf ("'%c'", name[1]);
+ return storage.c_str ();
}
else
- return name;
+ return name;
- GROW_VECT (result, result_len, 16);
if (isascii (v) && isprint (v))
- xsnprintf (result, result_len, "'%c'", v);
+ storage = string_printf ("'%c'", v);
else if (name[1] == 'U')
- xsnprintf (result, result_len, "[\"%02x\"]", v);
+ storage = string_printf ("[\"%02x\"]", v);
else
- xsnprintf (result, result_len, "[\"%04x\"]", v);
+ storage = string_printf ("[\"%04x\"]", v);
- return result;
+ return storage.c_str ();
}
else
{
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;
- }
+ {
+ storage = std::string (name, tmp - name);
+ return storage.c_str ();
+ }
return name;
}
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)
-{
- struct value *scale = ada_scaling_factor (value_type (arg));
- arg = value_cast (value_type (scale), arg);
-
- arg = value_binop (arg, scale, BINOP_MUL);
- return value_cast (type, arg);
-}
-
-static struct value *
-cast_to_fixed (struct type *type, struct value *arg)
-{
- if (type == value_type (arg))
- return arg;
-
- struct value *scale = ada_scaling_factor (type);
- if (ada_is_gnat_encoded_fixed_point_type (value_type (arg)))
- arg = cast_from_fixed (value_type (scale), arg);
- else
- arg = value_cast (value_type (scale), arg);
-
- arg = value_binop (arg, scale, BINOP_DIV);
- return value_cast (type, arg);
-}
-
/* Given two array types T1 and T2, return nonzero iff both arrays
contain the same number of elements. */
}
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;
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);
return value_equal (arg1, arg2);
}
-/* Total number of component associations in the aggregate starting at
- index PC in EXP. Assumes that index PC is the start of an
- OP_AGGREGATE. */
-
-static int
-num_component_specs (struct expression *exp, int pc)
-{
- int n, m, i;
-
- m = exp->elts[pc + 1].longconst;
- pc += 3;
- n = 0;
- for (i = 0; i < m; i += 1)
- {
- switch (exp->elts[pc].opcode)
- {
- default:
- n += 1;
- break;
- case OP_CHOICES:
- n += exp->elts[pc + 1].longconst;
- break;
- }
- ada_evaluate_subexp (NULL, exp, &pc, EVAL_SKIP);
- }
- return n;
-}
-
/* Assign the result of evaluating EXP starting at *POS to the INDEXth
component of LHS (a simple array or a record), updating *POS past
the expression, assuming that LHS is contained in CONTAINER. Does
struct type *lhs_type;
int n = exp->elts[*pos+1].longconst;
LONGEST low_index, high_index;
- int num_specs;
- LONGEST *indices;
- int max_indices, num_indices;
int i;
*pos += 3;
else
error (_("Left-hand side must be array or record."));
- num_specs = num_component_specs (exp, *pos - 3);
- max_indices = 4 * num_specs + 4;
- indices = XALLOCAVEC (LONGEST, max_indices);
+ std::vector<LONGEST> indices (4);
indices[0] = indices[1] = low_index - 1;
indices[2] = indices[3] = high_index + 1;
- num_indices = 4;
for (i = 0; i < n; i += 1)
{
switch (exp->elts[*pos].opcode)
{
case OP_CHOICES:
- aggregate_assign_from_choices (container, lhs, exp, pos, indices,
- &num_indices, max_indices,
+ aggregate_assign_from_choices (container, lhs, exp, pos, indices,
low_index, high_index);
break;
case OP_POSITIONAL:
aggregate_assign_positional (container, lhs, exp, pos, indices,
- &num_indices, max_indices,
low_index, high_index);
break;
case OP_OTHERS:
if (i != n-1)
error (_("Misplaced 'others' clause"));
- aggregate_assign_others (container, lhs, exp, pos, indices,
- num_indices, low_index, high_index);
+ aggregate_assign_others (container, lhs, exp, pos, indices,
+ low_index, high_index);
break;
default:
error (_("Internal error: bad aggregate clause"));
/* Assign into the component of LHS indexed by the OP_POSITIONAL
construct at *POS, updating *POS past the construct, given that
- the positions are relative to lower bound LOW, where HIGH is the
- upper bound. Record the position in INDICES[0 .. MAX_INDICES-1]
- updating *NUM_INDICES as needed. CONTAINER is as for
+ the positions are relative to lower bound LOW, where HIGH is the
+ upper bound. Record the position in INDICES. CONTAINER is as for
assign_aggregate. */
static void
aggregate_assign_positional (struct value *container,
struct value *lhs, struct expression *exp,
- int *pos, LONGEST *indices, int *num_indices,
- int max_indices, LONGEST low, LONGEST high)
+ int *pos, std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high)
{
LONGEST ind = longest_to_int (exp->elts[*pos + 1].longconst) + low;
warning (_("Extra components in aggregate ignored."));
if (ind <= high)
{
- add_component_interval (ind, ind, indices, num_indices, max_indices);
+ add_component_interval (ind, ind, indices);
*pos += 3;
assign_component (container, lhs, ind, exp, pos);
}
/* Assign into the components of LHS indexed by the OP_CHOICES
construct at *POS, updating *POS past the construct, given that
the allowable indices are LOW..HIGH. Record the indices assigned
- to in INDICES[0 .. MAX_INDICES-1], updating *NUM_INDICES as
- needed. CONTAINER is as for assign_aggregate. */
+ to in INDICES. CONTAINER is as for assign_aggregate. */
static void
aggregate_assign_from_choices (struct value *container,
struct value *lhs, struct expression *exp,
- int *pos, LONGEST *indices, int *num_indices,
- int max_indices, LONGEST low, LONGEST high)
+ int *pos, std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high)
{
int j;
int n_choices = longest_to_int (exp->elts[*pos+1].longconst);
if (lower <= upper && (lower < low || upper > high))
error (_("Index in component association out of bounds."));
- add_component_interval (lower, upper, indices, num_indices,
- max_indices);
+ add_component_interval (lower, upper, indices);
while (lower <= upper)
{
int pos1;
/* Assign the value of the expression in the OP_OTHERS construct in
EXP at *POS into the components of LHS indexed from LOW .. HIGH that
have not been previously assigned. The index intervals already assigned
- are in INDICES[0 .. NUM_INDICES-1]. Updates *POS to after the
- OP_OTHERS clause. CONTAINER is as for assign_aggregate. */
+ are in INDICES. Updates *POS to after the OP_OTHERS clause.
+ CONTAINER is as for assign_aggregate. */
static void
aggregate_assign_others (struct value *container,
struct value *lhs, struct expression *exp,
- int *pos, LONGEST *indices, int num_indices,
+ int *pos, std::vector<LONGEST> &indices,
LONGEST low, LONGEST high)
{
int i;
int expr_pc = *pos + 1;
+ int num_indices = indices.size ();
for (i = 0; i < num_indices - 2; i += 2)
{
LONGEST ind;
ada_evaluate_subexp (NULL, exp, pos, EVAL_SKIP);
}
-/* Add the interval [LOW .. HIGH] to the sorted set of intervals
- [ INDICES[0] .. INDICES[1] ],..., [ INDICES[*SIZE-2] .. INDICES[*SIZE-1] ],
- modifying *SIZE as needed. It is an error if *SIZE exceeds
- MAX_SIZE. The resulting intervals do not overlap. */
+/* Add the interval [LOW .. HIGH] to the sorted set of intervals
+ [ INDICES[0] .. INDICES[1] ],... The resulting intervals do not
+ overlap. */
static void
add_component_interval (LONGEST low, LONGEST high,
- LONGEST* indices, int *size, int max_size)
+ std::vector<LONGEST> &indices)
{
int i, j;
- for (i = 0; i < *size; i += 2) {
+ int size = indices.size ();
+ for (i = 0; i < size; i += 2) {
if (high >= indices[i] && low <= indices[i + 1])
{
int kh;
- for (kh = i + 2; kh < *size; kh += 2)
+ for (kh = i + 2; kh < size; kh += 2)
if (high < indices[kh])
break;
if (low < indices[i])
indices[i + 1] = indices[kh - 1];
if (high > indices[i + 1])
indices[i + 1] = high;
- memcpy (indices + i + 2, indices + kh, *size - kh);
- *size -= kh - i - 2;
+ memcpy (indices.data () + i + 2, indices.data () + kh, size - kh);
+ indices.resize (kh - i - 2);
return;
}
else if (high < indices[i])
break;
}
- if (*size == max_size)
- error (_("Internal error: miscounted aggregate components."));
- *size += 2;
- for (j = *size-1; j >= i+2; j -= 1)
+ indices.resize (indices.size () + 2);
+ for (j = indices.size () - 1; j >= i + 2; j -= 1)
indices[j] = indices[j - 2];
indices[i] = low;
indices[i + 1] = high;
if (type == ada_check_typedef (value_type (arg2)))
return arg2;
- if (ada_is_gnat_encoded_fixed_point_type (type))
- return cast_to_fixed (type, arg2);
-
- if (ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
- return cast_from_fixed (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;
}
return ada_value_cast (to_type, val);
}
-/* Implement the evaluate_exp routine in the exp_descriptor structure
- for the Ada language. */
+/* A helper function for TERNOP_IN_RANGE. */
-static struct value *
-ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
- int *pos, enum noside noside)
+static value *
+eval_ternop_in_range (struct type *expect_type, struct expression *exp,
+ enum noside noside,
+ value *arg1, value *arg2, value *arg3)
{
- enum exp_opcode op;
- int tem;
- int pc;
- int preeval_pos;
- struct value *arg1 = NULL, *arg2 = NULL, *arg3;
- struct type *type;
- int nargs, oplen;
- struct value **argvec;
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
- pc = *pos;
- *pos += 1;
- op = exp->elts[pc].opcode;
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
+ struct type *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)));
+}
- switch (op)
- {
- default:
- *pos -= 1;
- arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
+/* A helper function for UNOP_NEG. */
- if (noside == EVAL_NORMAL)
- arg1 = unwrap_value (arg1);
+value *
+ada_unop_neg (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1)
+{
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ unop_promote (exp->language_defn, exp->gdbarch, &arg1);
+ return value_neg (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.
+/* A helper function for UNOP_IN_RANGE. */
- 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);
+value *
+ada_unop_in_range (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1, struct type *type)
+{
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
- return arg1;
+ struct value *arg2, *arg3;
+ switch (type->code ())
+ {
+ 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 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;
+ 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)));
+ }
+}
+
+/* A helper function for OP_ATR_TAG. */
+
+value *
+ada_atr_tag (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (ada_tag_type (arg1), not_lval);
+
+ return ada_value_tag (arg1);
+}
+
+/* A helper function for OP_ATR_SIZE. */
+
+value *
+ada_atr_size (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1)
+{
+ struct type *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. */
+ if (type->code () == TYPE_CODE_REF)
+ type = TYPE_TARGET_TYPE (type);
+
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ else if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ 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));
+}
+
+/* A helper function for UNOP_ABS. */
+
+value *
+ada_abs (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1)
+{
+ unop_promote (exp->language_defn, exp->gdbarch, &arg1);
+ if (value_less (arg1, value_zero (value_type (arg1), not_lval)))
+ return value_neg (arg1);
+ else
+ return arg1;
+}
+
+/* A helper function for BINOP_MUL. */
+
+static value *
+ada_mult_binop (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1, struct value *arg2)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ return value_zero (value_type (arg1), not_lval);
+ }
+ else
+ {
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ return ada_value_binop (arg1, arg2, op);
+ }
+}
+
+/* A helper function for BINOP_EQUAL and BINOP_NOTEQUAL. */
+
+static value *
+ada_equal_binop (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1, struct value *arg2)
+{
+ int tem;
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ tem = 0;
+ else
+ {
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ tem = ada_value_equal (arg1, arg2);
+ }
+ if (op == BINOP_NOTEQUAL)
+ tem = !tem;
+ struct type *type = language_bool_type (exp->language_defn, exp->gdbarch);
+ return value_from_longest (type, (LONGEST) tem);
+}
+
+/* A helper function for TERNOP_SLICE. */
+
+static value *
+ada_ternop_slice (struct expression *exp,
+ enum noside noside,
+ struct value *array, struct value *low_bound_val,
+ struct value *high_bound_val)
+{
+ 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 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),
+ longest_to_int (high_bound));
+}
+
+/* A helper function for BINOP_IN_BOUNDS. */
+
+static value *
+ada_binop_in_bounds (struct expression *exp, enum noside noside,
+ struct value *arg1, struct value *arg2, int n)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ struct type *type = language_bool_type (exp->language_defn,
+ exp->gdbarch);
+ return value_zero (type, not_lval);
+ }
+
+ struct type *type = ada_index_type (value_type (arg2), n, "range");
+ if (!type)
+ type = value_type (arg1);
+
+ value *arg3 = value_from_longest (type, ada_array_bound (arg2, n, 1));
+ arg2 = value_from_longest (type, ada_array_bound (arg2, n, 0));
+
+ 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)));
+}
+
+/* A helper function for some attribute operations. */
+
+static value *
+ada_unop_atr (struct expression *exp, enum noside noside, enum exp_opcode op,
+ struct value *arg1, struct type *type_arg, int tem)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ if (type_arg == NULL)
+ type_arg = value_type (arg1);
+
+ if (ada_is_constrained_packed_array_type (type_arg))
+ type_arg = decode_constrained_packed_array_type (type_arg);
+
+ if (!discrete_type_p (type_arg))
+ {
+ switch (op)
+ {
+ default: /* Should never happen. */
+ error (_("unexpected attribute encountered"));
+ case OP_ATR_FIRST:
+ case OP_ATR_LAST:
+ type_arg = ada_index_type (type_arg, tem,
+ ada_attribute_name (op));
+ break;
+ case OP_ATR_LENGTH:
+ type_arg = builtin_type (exp->gdbarch)->builtin_int;
+ break;
+ }
+ }
+
+ return value_zero (type_arg, not_lval);
+ }
+ 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);
+
+ struct type *type;
+ if (op == OP_ATR_LENGTH)
+ type = builtin_type (exp->gdbarch)->builtin_int;
+ else
+ {
+ type = ada_index_type (value_type (arg1), tem,
+ ada_attribute_name (op));
+ if (type == NULL)
+ 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
+ (type, ada_array_bound (arg1, tem, 0));
+ case OP_ATR_LAST:
+ return value_from_longest
+ (type, ada_array_bound (arg1, tem, 1));
+ 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:
+ return value_from_longest
+ (range_type, ada_discrete_type_low_bound (range_type));
+ 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);
+
+ struct type *type;
+ if (op == OP_ATR_LENGTH)
+ type = builtin_type (exp->gdbarch)->builtin_int;
+ else
+ {
+ type = ada_index_type (type_arg, tem, ada_attribute_name (op));
+ if (type == NULL)
+ 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);
+ }
+ }
+}
+
+/* A helper function for OP_ATR_MIN and OP_ATR_MAX. */
+
+static struct value *
+ada_binop_minmax (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1, struct value *arg2)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (value_type (arg1), not_lval);
+ else
+ {
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ return value_binop (arg1, arg2,
+ op == OP_ATR_MIN ? BINOP_MIN : BINOP_MAX);
+ }
+}
+
+/* A helper function for BINOP_EXP. */
+
+static struct value *
+ada_binop_exp (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1, struct value *arg2)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (value_type (arg1), not_lval);
+ else
+ {
+ /* For integer exponentiation operations,
+ only promote the first argument. */
+ if (is_integral_type (value_type (arg2)))
+ unop_promote (exp->language_defn, exp->gdbarch, &arg1);
+ else
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+
+ return value_binop (arg1, arg2, op);
+ }
+}
+
+namespace expr
+{
+
+value *
+ada_wrapped_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ value *result = std::get<0> (m_storage)->evaluate (expect_type, exp, noside);
+ if (noside == EVAL_NORMAL)
+ result = unwrap_value (result);
+
+ /* 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.
+
+ Similarly, we need to perform the conversion from OP_LONG
+ ourselves. */
+ if ((opcode () == OP_FLOAT || opcode () == OP_LONG) && expect_type != NULL)
+ result = ada_value_cast (expect_type, result);
+
+ return result;
+}
+
+value *
+ada_string_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ value *result = string_operation::evaluate (expect_type, exp, 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;
+}
+
+value *
+ada_qual_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ struct type *type = std::get<1> (m_storage);
+ return std::get<0> (m_storage)->evaluate (type, exp, noside);
+}
+
+value *
+ada_ternop_range_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ value *arg0 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
+ value *arg1 = std::get<1> (m_storage)->evaluate (nullptr, exp, noside);
+ value *arg2 = std::get<2> (m_storage)->evaluate (nullptr, exp, noside);
+ return eval_ternop_in_range (expect_type, exp, noside, arg0, arg1, arg2);
+}
+
+}
+
+/* Implement the evaluate_exp routine in the exp_descriptor structure
+ for the Ada language. */
+
+static struct value *
+ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
+ int *pos, enum noside noside)
+{
+ enum exp_opcode op;
+ int tem;
+ int pc;
+ int preeval_pos;
+ struct value *arg1 = NULL, *arg2 = NULL, *arg3;
+ struct type *type;
+ int nargs, oplen;
+ struct value **argvec;
+
+ pc = *pos;
+ *pos += 1;
+ op = exp->elts[pc].opcode;
+
+ switch (op)
+ {
+ default:
+ *pos -= 1;
+ arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
+
+ if (noside == EVAL_NORMAL)
+ 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.
+
+ 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);
+
+ 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;
}
case UNOP_CAST:
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);
- else if (ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
- 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)));
- if ((ada_is_gnat_encoded_fixed_point_type (value_type (arg1))
- || ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
- && value_type (arg1) != value_type (arg2))
- error (_("Operands of fixed-point addition must have the same type"));
- /* Do the addition, and cast the result to the type of the first
- argument. We cannot cast the result to a reference type, so if
- ARG1 is a reference type, find its underlying type. */
+ return (value_from_longest
+ (value_type (arg2),
+ value_as_long (arg1) + value_as_long (arg2)));
+ /* Preserve the original type for use by the range case below.
+ 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 = value_binop (arg1, arg2, BINOP_ADD);
+ /* We need to special-case the result of adding to a range.
+ This is done for the benefit of "ptype". gdb's Ada support
+ historically used the LHS to set the result type here, so
+ preserve this behavior. */
+ if (type->code () == TYPE_CODE_RANGE)
+ arg1 = value_cast (type, arg1);
+ return arg1;
case BINOP_SUB:
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)));
- if ((ada_is_gnat_encoded_fixed_point_type (value_type (arg1))
- || ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
- && value_type (arg1) != value_type (arg2))
- error (_("Operands of fixed-point subtraction "
- "must have the same type"));
- /* 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. */
+ return (value_from_longest
+ (value_type (arg2),
+ value_as_long (arg1) - value_as_long (arg2)));
+ /* Preserve the original type for use by the range case below.
+ 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));
+ arg1 = value_binop (arg1, arg2, BINOP_SUB);
+ /* We need to special-case the result of adding to a range.
+ This is done for the benefit of "ptype". gdb's Ada support
+ historically used the LHS to set the result type here, so
+ preserve this behavior. */
+ if (type->code () == TYPE_CODE_RANGE)
+ arg1 = value_cast (type, arg1);
+ return arg1;
case BINOP_MUL:
case BINOP_DIV:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
arg2 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
- goto nosideret;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- 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);
- }
+ goto nosideret;
+ return ada_mult_binop (expect_type, exp, noside, op,
+ arg1, arg2);
case BINOP_EQUAL:
case BINOP_NOTEQUAL:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
if (noside == EVAL_SKIP)
- goto nosideret;
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- tem = 0;
- else
- {
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
- tem = ada_value_equal (arg1, arg2);
- }
- if (op == BINOP_NOTEQUAL)
- tem = !tem;
- type = language_bool_type (exp->language_defn, exp->gdbarch);
- return value_from_longest (type, (LONGEST) tem);
+ goto nosideret;
+ return ada_equal_binop (expect_type, exp, noside, op, arg1, arg2);
case UNOP_NEG:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- else if (ada_is_gnat_encoded_fixed_point_type (value_type (arg1)))
- return value_cast (value_type (arg1), value_neg (arg1));
- else
- {
- unop_promote (exp->language_defn, exp->gdbarch, &arg1);
- return value_neg (arg1);
- }
+ return ada_unop_neg (expect_type, exp, noside, op, arg1);
case BINOP_LOGICAL_AND:
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 (nullptr, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
*pos = pc;
- val = evaluate_subexp_standard (expect_type, exp, pos, noside);
+ 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
*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)
+ {
+ 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 (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)
+ {
+ case TYPE_CODE_FUNC:
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
if (TYPE_TARGET_TYPE (type) == NULL)
error_call_unknown_return_type (NULL);
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:
{
= 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_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,
- 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),
- longest_to_int (high_bound));
+
+ if (noside == EVAL_SKIP)
+ goto nosideret;
+
+ return ada_ternop_slice (exp, noside, array, low_bound_val,
+ high_bound_val);
}
case UNOP_IN_RANGE:
(*pos) += 2;
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
type = check_typedef (exp->elts[pc + 1].type);
-
- if (noside == EVAL_SKIP)
- goto nosideret;
-
- switch (type->code ())
- {
- 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->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)));
- }
+ return ada_unop_in_range (expect_type, exp, noside, op, arg1, type);
case BINOP_IN_BOUNDS:
(*pos) += 2;
arg2 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
- goto nosideret;
-
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- type = language_bool_type (exp->language_defn, exp->gdbarch);
- return value_zero (type, not_lval);
- }
+ goto nosideret;
tem = longest_to_int (exp->elts[pc + 1].longconst);
- type = ada_index_type (value_type (arg2), tem, "range");
- if (!type)
- type = value_type (arg1);
-
- arg3 = value_from_longest (type, ada_array_bound (arg2, tem, 1));
- arg2 = value_from_longest (type, ada_array_bound (arg2, tem, 0));
-
- 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)));
+ return ada_binop_in_bounds (exp, noside, arg1, arg2, tem);
case TERNOP_IN_RANGE:
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;
-
- 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)));
+ return eval_ternop_in_range (expect_type, exp, noside, arg1, arg2, arg3);
case OP_ATR_FIRST:
case OP_ATR_LAST:
case OP_ATR_LENGTH:
{
- struct type *type_arg;
+ struct type *type_arg;
- if (exp->elts[*pos].opcode == OP_TYPE)
- {
+ 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
- {
+ 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))
- type_arg = decode_constrained_packed_array_type (type_arg);
-
- if (!discrete_type_p (type_arg))
- {
- switch (op)
- {
- default: /* Should never happen. */
- error (_("unexpected attribute encountered"));
- case OP_ATR_FIRST:
- case OP_ATR_LAST:
- type_arg = ada_index_type (type_arg, tem,
- ada_attribute_name (op));
- break;
- case OP_ATR_LENGTH:
- type_arg = builtin_type (exp->gdbarch)->builtin_int;
- break;
- }
- }
-
- return value_zero (type_arg, not_lval);
}
- 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 (op == OP_ATR_LENGTH)
- type = builtin_type (exp->gdbarch)->builtin_int;
- else
- {
- type = ada_index_type (value_type (arg1), tem,
- ada_attribute_name (op));
- if (type == NULL)
- type = builtin_type (exp->gdbarch)->builtin_int;
- }
+ 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;
- 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
- (type, ada_array_bound (arg1, tem, 1));
- 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:
- return value_from_longest
- (range_type, ada_discrete_type_low_bound (range_type));
- 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);
-
- if (op == OP_ATR_LENGTH)
- type = builtin_type (exp->gdbarch)->builtin_int;
- else
- {
- type = ada_index_type (type_arg, tem, ada_attribute_name (op));
- if (type == NULL)
- type = builtin_type (exp->gdbarch)->builtin_int;
- }
+ if (noside == EVAL_SKIP)
+ goto nosideret;
- 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);
- }
- }
+ return ada_unop_atr (exp, noside, op, arg1, type_arg, tem);
}
case OP_ATR_TAG:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
- goto nosideret;
-
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (ada_tag_type (arg1), not_lval);
-
- return ada_value_tag (arg1);
+ goto nosideret;
+ return ada_atr_tag (expect_type, exp, noside, op, arg1);
case OP_ATR_MIN:
case OP_ATR_MAX:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
arg2 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
- goto nosideret;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (value_type (arg1), not_lval);
- else
- {
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
- return value_binop (arg1, arg2,
- op == OP_ATR_MIN ? BINOP_MIN : BINOP_MAX);
- }
+ goto nosideret;
+ return ada_binop_minmax (expect_type, exp, noside, op, 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 (nullptr, exp, pos, EVAL_SKIP);
if (noside == EVAL_SKIP)
- goto nosideret;
+ 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));
}
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);
case OP_ATR_SIZE:
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. */
- if (type->code () == TYPE_CODE_REF)
- type = TYPE_TARGET_TYPE (type);
-
- if (noside == EVAL_SKIP)
- goto nosideret;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- 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 ada_atr_size (expect_type, exp, noside, op, arg1);
case OP_ATR_VAL:
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;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (type, not_lval);
- else
- return value_val_atr (type, arg1);
+ goto nosideret;
+ return ada_val_atr (noside, type, arg1);
case BINOP_EXP:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
arg2 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
- goto nosideret;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (value_type (arg1), not_lval);
- else
- {
- /* For integer exponentiation operations,
- only promote the first argument. */
- if (is_integral_type (value_type (arg2)))
- unop_promote (exp->language_defn, exp->gdbarch, &arg1);
- else
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
-
- return value_binop (arg1, arg2, op);
- }
+ goto nosideret;
+ return ada_binop_exp (expect_type, exp, noside, op, arg1, arg2);
case UNOP_PLUS:
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 (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
- 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);
- else
- return arg1;
+ goto nosideret;
+ return ada_abs (expect_type, exp, noside, op, arg1);
case UNOP_IND:
preeval_pos = *pos;
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_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);
preeval_pos = *pos;
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 (nullptr, exp, &preeval_pos, EVAL_NORMAL);
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 */
-
-/* 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)
-{
- const char *name = ada_type_name (type);
- enum type_code code = (type == NULL) ? TYPE_CODE_UNDEF : type->code ();
-
- if ((code == TYPE_CODE_INT || code == TYPE_CODE_RANGE) && name != NULL)
- {
- const char *tail = strstr (name, "___XF_");
-
- if (tail == NULL)
- return NULL;
- else
- return tail + 5;
- }
- else if (code == TYPE_CODE_RANGE && TYPE_TARGET_TYPE (type) != type)
- return gnat_encoded_fixed_type_info (TYPE_TARGET_TYPE (type));
- else
- return NULL;
-}
-
-/* Returns non-zero iff TYPE represents an Ada fixed-point type. */
-
-int
-ada_is_gnat_encoded_fixed_point_type (struct type *type)
-{
- return gnat_encoded_fixed_type_info (type) != NULL;
-}
-
/* Return non-zero iff TYPE represents a System.Address type. */
int
return (type->name () && strcmp (type->name (), "system__address") == 0);
}
-/* Assuming that TYPE is the representation of an Ada fixed-point
- type, return the target floating-point type to be used to represent
- of this type during internal computation. */
-
-static struct type *
-ada_scaling_type (struct type *type)
-{
- return builtin_type (get_type_arch (type))->builtin_long_double;
-}
-
-/* Assuming that TYPE is the representation of an Ada fixed-point
- type, return its delta, or NULL if the type is malformed and the
- delta cannot be determined. */
-
-struct value *
-gnat_encoded_fixed_point_delta (struct type *type)
-{
- const char *encoding = gnat_encoded_fixed_type_info (type);
- struct type *scale_type = ada_scaling_type (type);
-
- long long num, den;
-
- if (sscanf (encoding, "_%lld_%lld", &num, &den) < 2)
- return nullptr;
- else
- return value_binop (value_from_longest (scale_type, num),
- value_from_longest (scale_type, den), BINOP_DIV);
-}
-
-/* Assuming that ada_is_gnat_encoded_fixed_point_type (TYPE), return
- the scaling factor ('SMALL value) associated with the type. */
-
-struct value *
-ada_scaling_factor (struct type *type)
-{
- const char *encoding = gnat_encoded_fixed_type_info (type);
- struct type *scale_type = ada_scaling_type (type);
-
- long long num0, den0, num1, den1;
- int n;
-
- n = sscanf (encoding, "_%lld_%lld_%lld_%lld",
- &num0, &den0, &num1, &den1);
-
- if (n < 2)
- return value_from_longest (scale_type, 1);
- else if (n == 4)
- return value_binop (value_from_longest (scale_type, num1),
- value_from_longest (scale_type, den1), BINOP_DIV);
- else
- return value_binop (value_from_longest (scale_type, num0),
- value_from_longest (scale_type, den0), BINOP_DIV);
-}
-
\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;
+ static std::string storage;
const char *pstart, *pend, *bound;
struct value *bound_val;
int len = pend - pstart;
/* Strip __ and beyond. */
- GROW_VECT (bound_buffer, bound_buffer_len, len + 1);
- strncpy (bound_buffer, pstart, len);
- bound_buffer[len] = '\0';
-
- bound = bound_buffer;
+ storage = std::string (pstart, len);
+ bound = storage.c_str ();
k = pend - str;
}
return 1;
}
-/* Value of variable named NAME in the current environment. If
- no such variable found, then if ERR_MSG is null, returns 0, and
+/* Value of variable named NAME. Only exact matches are considered.
+ If no such variable found, then if ERR_MSG is null, returns 0, and
otherwise causes an error with message ERR_MSG. */
static struct value *
get_var_value (const char *name, const char *err_msg)
{
- lookup_name_info lookup_name (name, symbol_name_match_type::FULL);
+ std::string quoted_name = add_angle_brackets (name);
+
+ lookup_name_info lookup_name (quoted_name, symbol_name_match_type::FULL);
- std::vector<struct block_symbol> syms;
- int nsyms = ada_lookup_symbol_list_worker (lookup_name,
- get_selected_block (0),
- VAR_DOMAIN, &syms, 1);
+ std::vector<struct block_symbol> syms
+ = ada_lookup_symbol_list_worker (lookup_name,
+ get_selected_block (0),
+ VAR_DOMAIN, 1);
- if (nsyms != 1)
+ if (syms.size () != 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);
}
else
{
- static char *name_buf = NULL;
- static size_t name_len = 0;
int prefix_len = subtype_info - name;
LONGEST L, U;
struct type *type;
const char *bounds_str;
int n;
- GROW_VECT (name_buf, name_len, prefix_len + 5);
- strncpy (name_buf, name, prefix_len);
- name_buf[prefix_len] = '\0';
-
subtype_info += 5;
bounds_str = strchr (subtype_info, '_');
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;
- }
- }
+ {
+ std::string name_buf = std::string (name, prefix_len) + "___L";
+ if (!get_int_var_value (name_buf.c_str (), 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;
- }
- }
+ {
+ std::string name_buf = std::string (name, prefix_len) + "___U";
+ if (!get_int_var_value (name_buf.c_str (), 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
- && subranged_type->is_unsigned ());
+ && subranged_type->code () == TYPE_CODE_INT
+ && subranged_type->is_unsigned ());
}
/* Assuming ada_is_modular_type (TYPE), the modulus of TYPE. */
{
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. */
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;
static void
check_status_exception (bpstat bs)
{
- bs->stop = should_stop_exception (bs->bp_location_at);
+ bs->stop = should_stop_exception (bs->bp_location_at.get ());
}
/* Implement the PRINT_IT method in the breakpoint_ops structure
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>). */
/* Invoke callbacks for TYPE and OBJFILE if they were set as non-NULL. */
- if (type && TYPE_OBJFILE (type)
- && (*objfile_func) (TYPE_OBJFILE (type), data))
+ if (type != nullptr && type->objfile_owner () != nullptr
+ && objfile_func (type->objfile_owner (), data))
return 1;
return 0;
}
-static const char *
-ada_op_name (enum exp_opcode opcode)
-{
- switch (opcode)
- {
- default:
- return op_name_standard (opcode);
-
-#define OP_DEFN(op, len, args, binop) case op: return #op;
- ADA_OPERATORS;
-#undef OP_DEFN
-
- case OP_AGGREGATE:
- return "OP_AGGREGATE";
- case OP_CHOICES:
- return "OP_CHOICES";
- case OP_NAME:
- return "OP_NAME";
- }
-}
-
/* As for operator_length, but assumes PC is pointing at the first
element of the operator, and gives meaningful results only for the
Ada-specific operators, returning 0 for *OPLENP and *ARGSP otherwise. */
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
-};
-
\f
/* Language vector */
ada_print_subexp,
ada_operator_length,
ada_operator_check,
- ada_op_name,
ada_dump_subexp_body,
ada_evaluate_subexp
};
const lookup_name_info &lookup_name,
completion_match_result *comp_match_res)
{
- return full_match (symbol_search_name, ada_lookup_name (lookup_name));
+ const char *lname = lookup_name.ada ().lookup_name ().c_str ();
+
+ /* If both symbols start with "_ada_", just let the loop below
+ handle the comparison. However, if only the symbol name starts
+ with "_ada_", skip the prefix and let the match proceed as
+ usual. */
+ if (startswith (symbol_search_name, "_ada_")
+ && !startswith (lname, "_ada"))
+ symbol_search_name += 5;
+
+ int uscore_count = 0;
+ while (*lname != '\0')
+ {
+ if (*symbol_search_name != *lname)
+ {
+ if (*symbol_search_name == 'B' && uscore_count == 2
+ && symbol_search_name[1] == '_')
+ {
+ symbol_search_name += 2;
+ while (isdigit (*symbol_search_name))
+ ++symbol_search_name;
+ if (symbol_search_name[0] == '_'
+ && symbol_search_name[1] == '_')
+ {
+ symbol_search_name += 2;
+ continue;
+ }
+ }
+ return false;
+ }
+
+ if (*symbol_search_name == '_')
+ ++uscore_count;
+ else
+ uscore_count = 0;
+
+ ++symbol_search_name;
+ ++lname;
+ }
+
+ return is_name_suffix (symbol_search_name);
}
/* symbol_name_matcher_ftype for exact (verbatim) matches. */
{
gdb::string_view user_name = lookup_name.name ();
- if (user_name[0] == '<')
+ if (!user_name.empty () && user_name[0] == '<')
{
if (user_name.back () == '>')
m_encoded_name
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 = ada_encode_1 (folded, false);
+ if (m_encoded_name.empty ())
m_encoded_name = gdb::to_string (user_name);
}
else
}
}
-/* Constant data that describes the Ada language. */
-
-extern const struct language_data ada_language_data =
-{
- 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_exp_descriptor,
- true, /* la_store_sym_names_in_linkage_form_p */
- ada_op_print_tab, /* expression operators for printing */
- &ada_varobj_ops,
-};
-
/* Class representing the Ada language. */
class ada_language : public language_defn
{
public:
ada_language ()
- : language_defn (language_ada, ada_language_data)
+ : language_defn (language_ada)
{ /* Nothing. */ }
/* See language.h. */
{
struct value *index_value = val_atr (index_type, index);
- LA_VALUE_PRINT (index_value, stream, options);
+ value_print (index_value, stream, options);
fprintf_filtered (stream, " => ");
}
{
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]
+ /* Helper function to allow shorter lines below. */
+ auto add = [&] (struct type *t)
+ {
+ lai->add_primitive_type (t);
+ };
+
+ 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"));
- lai->primitive_type_vector [ada_primitive_type_system_address]
- ->set_name ("system__address");
+ 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
- (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");
- }
+ unsigned int addr_length = TYPE_LENGTH (system_addr_ptr);
+ add (arch_integer_type (gdbarch, addr_length * HOST_CHAR_BIT, 0,
+ "storage_offset"));
- lai->bool_type_symbol = NULL;
- lai->bool_type_default = builtin->builtin_bool;
+ lai->set_bool_type (builtin->builtin_bool);
}
/* See language.h. */
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);
+ std::vector<struct block_symbol> results
+ = ada_lookup_symbol_list_worker (name, block, domain, 0);
for (block_symbol &sym : results)
{
if (!callback (&sym))
/* See language.h. */
- char *demangle (const char *mangled, int options) const override
+ char *demangle_symbol (const char *mangled, int options) const override
{
return ada_la_decode (mangled, options);
}
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
+ void post_parser (expression_up *expp, struct parser_state *ps)
+ const override
{
struct type *context_type = NULL;
int pc = 0;
- if (void_context_p)
+ if (ps->void_context_p)
context_type = builtin_type ((*expp)->gdbarch)->builtin_void;
- resolve_subexp (expp, &pc, 1, context_type, completing, tracker);
+ resolve_subexp (expp, &pc, 1, context_type, ps->parse_completion,
+ ps->block_tracker);
}
/* 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. */
&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