/* Ada language support routines for GDB, the GNU debugger. Copyright (C)
- 1992, 1993, 1994, 1997, 1998, 1999, 2000, 2003, 2004, 2005, 2007
- Free Software Foundation, Inc.
+ 1992, 1993, 1994, 1997, 1998, 1999, 2000, 2003, 2004, 2005, 2007, 2008,
+ 2009 Free Software Foundation, Inc.
This file is part of GDB.
#include "source.h"
#include "observer.h"
#include "vec.h"
+#include "stack.h"
+
+#include "psymtab.h"
/* Define whether or not the C operator '/' truncates towards zero for
differently signed operands (truncation direction is undefined in C).
#define TRUNCATION_TOWARDS_ZERO ((-5 / 2) == -2)
#endif
-static void extract_string (CORE_ADDR addr, char *buf);
-
-static void modify_general_field (char *, LONGEST, int, int);
+static void modify_general_field (struct type *, char *, LONGEST, int, int);
static struct type *desc_base_type (struct type *);
static int fat_pntr_bounds_bitsize (struct type *);
-static struct type *desc_data_type (struct type *);
+static struct type *desc_data_target_type (struct type *);
static struct value *desc_data (struct value *);
static int ada_args_match (struct symbol *, struct value **, int);
-static struct value *ensure_lval (struct value *, CORE_ADDR *);
-
-static struct value *convert_actual (struct value *, struct type *,
- CORE_ADDR *);
+static struct value *ensure_lval (struct value *,
+ struct gdbarch *, CORE_ADDR *);
static struct value *make_array_descriptor (struct type *, struct value *,
- CORE_ADDR *);
+ struct gdbarch *, CORE_ADDR *);
static void ada_add_block_symbols (struct obstack *,
struct block *, const char *,
static struct ada_symbol_info *defns_collected (struct obstack *, int);
-static struct partial_symbol *ada_lookup_partial_symbol (struct partial_symtab
- *, const char *, int,
- domain_enum, int);
-
-static struct symtab *symtab_for_sym (struct symbol *);
-
static struct value *resolve_subexp (struct expression **, int *, int,
struct type *);
static struct type *ada_lookup_struct_elt_type (struct type *, char *,
int, int, int *);
-static struct value *evaluate_subexp (struct type *, struct expression *,
- int *, enum noside);
-
static struct value *evaluate_subexp_type (struct expression *, int *);
+static struct type *ada_find_parallel_type_with_name (struct type *,
+ const char *);
+
static int is_dynamic_field (struct type *, int);
static struct type *to_fixed_variant_branch_type (struct type *,
static struct type *to_fixed_array_type (struct type *, struct value *, int);
static struct type *to_fixed_range_type (char *, struct value *,
- struct objfile *);
+ struct type *);
static struct type *to_static_fixed_type (struct type *);
static struct type *static_unwrap_type (struct type *type);
static struct value *unwrap_value (struct value *);
-static struct type *packed_array_type (struct type *, long *);
+static struct type *constrained_packed_array_type (struct type *, long *);
+
+static struct type *decode_constrained_packed_array_type (struct type *);
+
+static long decode_packed_array_bitsize (struct type *);
+
+static struct value *decode_constrained_packed_array (struct value *);
-static struct type *decode_packed_array_type (struct type *);
+static int ada_is_packed_array_type (struct type *);
-static struct value *decode_packed_array (struct value *);
+static int ada_is_unconstrained_packed_array_type (struct type *);
static struct value *value_subscript_packed (struct value *, int,
struct value **);
-static void move_bits (gdb_byte *, int, const gdb_byte *, int, int);
+static void move_bits (gdb_byte *, int, const gdb_byte *, int, int, int);
static struct value *coerce_unspec_val_to_type (struct value *,
struct type *);
static char *result = NULL;
xfree (result);
- result = (char *) xmalloc ((strlen (str) + 3) * sizeof (char));
-
- sprintf (result, "<%s>", str);
+ result = xstrprintf ("<%s>", str);
return result;
}
fprintf_filtered (stream, " => ");
}
-/* Read the string located at ADDR from the inferior and store the
- result into BUF. */
-
-static void
-extract_string (CORE_ADDR addr, char *buf)
-{
- int char_index = 0;
-
- /* Loop, reading one byte at a time, until we reach the '\000'
- end-of-string marker. */
- do
- {
- target_read_memory (addr + char_index * sizeof (char),
- buf + char_index * sizeof (char), sizeof (char));
- char_index++;
- }
- while (buf[char_index - 1] != '\000');
-}
-
/* 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. */
}
-/* Assuming TYPE is a TYPE_CODE_STRUCT, find the field whose name matches
- FIELD_NAME, and return its index. This function also handles fields
- whose name have ___ suffixes because the compiler sometimes alters
- their name by adding such a suffix to represent fields with certain
- constraints. If the field could not be found, return a negative
- number if MAYBE_MISSING is set. Otherwise raise an error. */
+/* Assuming TYPE is a TYPE_CODE_STRUCT or a TYPE_CODE_TYPDEF to
+ a TYPE_CODE_STRUCT, find the field whose name matches FIELD_NAME,
+ and return its index. This function also handles fields whose name
+ have ___ suffixes because the compiler sometimes alters their name
+ by adding such a suffix to represent fields with certain constraints.
+ If the field could not be found, return a negative number if
+ MAYBE_MISSING is set. Otherwise raise an error. */
int
ada_get_field_index (const struct type *type, const char *field_name,
int maybe_missing)
{
int fieldno;
- for (fieldno = 0; fieldno < TYPE_NFIELDS (type); fieldno++)
- if (field_name_match (TYPE_FIELD_NAME (type, fieldno), field_name))
+ struct type *struct_type = check_typedef ((struct type *) type);
+
+ for (fieldno = 0; fieldno < TYPE_NFIELDS (struct_type); fieldno++)
+ if (field_name_match (TYPE_FIELD_NAME (struct_type, fieldno), field_name))
return fieldno;
if (!maybe_missing)
error (_("Unable to find field %s in struct %s. Aborting"),
- field_name, TYPE_NAME (type));
+ field_name, TYPE_NAME (struct_type));
return -1;
}
set_value_component_location (result, val);
set_value_bitsize (result, value_bitsize (val));
set_value_bitpos (result, value_bitpos (val));
- VALUE_ADDRESS (result) += value_offset (val);
+ set_value_address (result, value_address (val));
if (value_lazy (val)
|| TYPE_LENGTH (type) > TYPE_LENGTH (value_type (val)))
set_value_lazy (result, 1);
}
/* The largest value in the domain of TYPE, a discrete type, as an integer. */
-static LONGEST
-discrete_type_high_bound (struct type *type)
+LONGEST
+ada_discrete_type_high_bound (struct type *type)
{
switch (TYPE_CODE (type))
{
case TYPE_CODE_INT:
return max_of_type (type);
default:
- error (_("Unexpected type in discrete_type_high_bound."));
+ error (_("Unexpected type in ada_discrete_type_high_bound."));
}
}
/* The largest value in the domain of TYPE, a discrete type, as an integer. */
-static LONGEST
-discrete_type_low_bound (struct type *type)
+LONGEST
+ada_discrete_type_low_bound (struct type *type)
{
switch (TYPE_CODE (type))
{
case TYPE_CODE_INT:
return min_of_type (type);
default:
- error (_("Unexpected type in discrete_type_low_bound."));
+ error (_("Unexpected type in ada_discrete_type_low_bound."));
}
}
/* 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).
-
- MAIN_PST is not used. */
+ (the main program is in Ada iif the adainit symbol is found). */
enum language
-ada_update_initial_language (enum language lang,
- struct partial_symtab *main_pst)
+ada_update_initial_language (enum language lang)
{
if (lookup_minimal_symbol ("adainit", (const char *) NULL,
(struct objfile *) NULL) != NULL)
ada_main_name (void)
{
struct minimal_symbol *msym;
- CORE_ADDR main_program_name_addr;
- static char main_program_name[1024];
+ static char *main_program_name = NULL;
/* For Ada, the name of the main procedure is stored in a specific
string constant, generated by the binder. Look for that symbol,
if (msym != NULL)
{
+ CORE_ADDR main_program_name_addr;
+ int err_code;
+
main_program_name_addr = SYMBOL_VALUE_ADDRESS (msym);
if (main_program_name_addr == 0)
error (_("Invalid address for Ada main program name."));
- extract_string (main_program_name_addr, main_program_name);
+ xfree (main_program_name);
+ target_read_string (main_program_name_addr, &main_program_name,
+ 1024, &err_code);
+
+ if (err_code != 0)
+ return NULL;
return main_program_name;
}
{NULL, NULL}
};
-/* Return non-zero if STR should be suppressed in info listings. */
-
-static int
-is_suppressed_name (const char *str)
-{
- if (strncmp (str, "_ada_", 5) == 0)
- str += 5;
- if (str[0] == '_' || str[0] == '\000')
- return 1;
- else
- {
- const char *p;
- const char *suffix = strstr (str, "___");
- if (suffix != NULL && suffix[3] != 'X')
- return 1;
- if (suffix == NULL)
- suffix = str + strlen (str);
- for (p = suffix - 1; p != str; p -= 1)
- if (isupper (*p))
- {
- int i;
- if (p[0] == 'X' && p[-1] != '_')
- goto OK;
- if (*p != 'O')
- return 1;
- for (i = 0; ada_opname_table[i].encoded != NULL; i += 1)
- if (strncmp (ada_opname_table[i].encoded, p,
- strlen (ada_opname_table[i].encoded)) == 0)
- goto OK;
- return 1;
- OK:;
- }
- return 0;
- }
-}
-
/* The "encoded" form of DECODED, according to GNAT conventions.
The result is valid until the next call to ada_encode. */
*len = *len - 1;
}
+/* Remove trailing X[bn]* suffixes (indicating names in package bodies). */
+
+static void
+ada_remove_Xbn_suffix (const char *encoded, int *len)
+{
+ int i = *len - 1;
+
+ while (i > 0 && (encoded[i] == 'b' || encoded[i] == 'n'))
+ i--;
+
+ if (encoded[i] != 'X')
+ return;
+
+ if (i == 0)
+ return;
+
+ if (isalnum (encoded[i-1]))
+ *len = i;
+}
+
/* If ENCODED follows the GNAT entity encoding conventions, then return
the decoded form of ENCODED. Otherwise, return "<%s>" where "%s" is
replaced by ENCODED.
if (len0 > 3 && strncmp (encoded + len0 - 3, "TKB", 3) == 0)
len0 -= 3;
+ /* Remove any trailing TB suffix. The TB suffix is slightly different
+ from the TKB suffix because it is used for non-anonymous task
+ bodies. */
+
+ if (len0 > 2 && strncmp (encoded + len0 - 2, "TB", 2) == 0)
+ len0 -= 2;
+
/* Remove trailing "B" suffixes. */
/* FIXME: brobecker/2006-04-19: Not sure what this are used for... */
if (encoded[0] == '<')
strcpy (decoded, encoded);
else
- sprintf (decoded, "<%s>", encoded);
+ xsnprintf (decoded, decoding_buffer_size, "<%s>", encoded);
return decoded;
}
return *resultp;
}
-char *
+static char *
ada_la_decode (const char *encoded, int options)
{
return xstrdup (ada_decode (encoded));
suffix of SYM_NAME minus the same suffixes. Also returns 0 if
either argument is NULL. */
-int
+static int
ada_match_name (const char *sym_name, const char *name, int wild)
{
if (sym_name == NULL || name == NULL)
&& is_name_suffix (sym_name + len_name + 5));
}
}
-
-/* True (non-zero) iff, in Ada mode, the symbol SYM should be
- suppressed in info listings. */
-
-int
-ada_suppress_symbol_printing (struct symbol *sym)
-{
- if (SYMBOL_DOMAIN (sym) == STRUCT_DOMAIN)
- return 1;
- else
- return is_suppressed_name (SYMBOL_LINKAGE_NAME (sym));
-}
\f
/* Arrays */
/* Like modify_field, but allows bitpos > wordlength. */
static void
-modify_general_field (char *addr, LONGEST fieldval, int bitpos, int bitsize)
+modify_general_field (struct type *type, char *addr,
+ LONGEST fieldval, int bitpos, int bitsize)
{
- modify_field (addr + bitpos / 8, fieldval, bitpos % 8, bitsize);
+ modify_field (type, addr + bitpos / 8, fieldval, bitpos % 8, bitsize);
}
thin_data_pntr (struct value *val)
{
struct type *type = value_type (val);
+ struct type *data_type = desc_data_target_type (thin_descriptor_type (type));
+ data_type = lookup_pointer_type (data_type);
+
if (TYPE_CODE (type) == TYPE_CODE_PTR)
- return value_cast (desc_data_type (thin_descriptor_type (type)),
- value_copy (val));
+ return value_cast (data_type, value_copy (val));
else
- return value_from_longest (desc_data_type (thin_descriptor_type (type)),
- VALUE_ADDRESS (val) + value_offset (val));
+ return value_from_longest (data_type, value_address (val));
}
/* True iff TYPE indicates a "thick" array pointer type. */
if (TYPE_CODE (type) == TYPE_CODE_PTR)
addr = value_as_long (arr);
else
- addr = VALUE_ADDRESS (arr) + value_offset (arr);
+ addr = value_address (arr);
return
value_from_longest (lookup_pointer_type (bounds_type),
}
/* If TYPE is the type of an array descriptor (fat or thin pointer) or a
- pointer to one, the type of its array data (a
- pointer-to-array-with-no-bounds type); otherwise, NULL. Use
- ada_type_of_array to get an array type with bounds data. */
+ pointer to one, the type of its array data (a array-with-no-bounds type);
+ otherwise, NULL. Use ada_type_of_array to get an array type with bounds
+ data. */
static struct type *
-desc_data_type (struct type *type)
+desc_data_target_type (struct type *type)
{
type = desc_base_type (type);
/* NOTE: The following is bogus; see comment in desc_bounds. */
if (is_thin_pntr (type))
- return lookup_pointer_type
- (desc_base_type (TYPE_FIELD_TYPE (thin_descriptor_type (type), 1)));
+ return desc_base_type (TYPE_FIELD_TYPE (thin_descriptor_type (type), 1));
else if (is_thick_pntr (type))
- return lookup_struct_elt_type (type, "P_ARRAY", 1);
- else
- return NULL;
+ {
+ struct type *data_type = lookup_struct_elt_type (type, "P_ARRAY", 1);
+
+ if (data_type
+ && TYPE_CODE (ada_check_typedef (data_type)) == TYPE_CODE_PTR)
+ return TYPE_TARGET_TYPE (data_type);
+ }
+
+ return NULL;
}
/* If ARR is an array descriptor (fat or thin pointer), a pointer to
/* Non-zero iff TYPE represents any kind of array in Ada, or a pointer
* to one. */
-int
+static int
ada_is_array_type (struct type *type)
{
while (type != NULL
int
ada_is_array_descriptor_type (struct type *type)
{
- struct type *data_type = desc_data_type (type);
+ struct type *data_type = desc_data_target_type (type);
if (type == NULL)
return 0;
type = ada_check_typedef (type);
- return
- data_type != NULL
- && ((TYPE_CODE (data_type) == TYPE_CODE_PTR
- && TYPE_TARGET_TYPE (data_type) != NULL
- && TYPE_CODE (TYPE_TARGET_TYPE (data_type)) == TYPE_CODE_ARRAY)
- || TYPE_CODE (data_type) == TYPE_CODE_ARRAY)
- && desc_arity (desc_bounds_type (type)) > 0;
+ return (data_type != NULL
+ && TYPE_CODE (data_type) == TYPE_CODE_ARRAY
+ && desc_arity (desc_bounds_type (type)) > 0);
}
/* Non-zero iff type is a partially mal-formed GNAT array
struct type *
ada_type_of_array (struct value *arr, int bounds)
{
- if (ada_is_packed_array_type (value_type (arr)))
- return decode_packed_array_type (value_type (arr));
+ if (ada_is_constrained_packed_array_type (value_type (arr)))
+ return decode_constrained_packed_array_type (value_type (arr));
if (!ada_is_array_descriptor_type (value_type (arr)))
return value_type (arr);
if (!bounds)
- return
- ada_check_typedef (TYPE_TARGET_TYPE (desc_data_type (value_type (arr))));
+ {
+ struct type *array_type =
+ ada_check_typedef (desc_data_target_type (value_type (arr)));
+
+ if (ada_is_unconstrained_packed_array_type (value_type (arr)))
+ TYPE_FIELD_BITSIZE (array_type, 0) =
+ decode_packed_array_bitsize (value_type (arr));
+
+ return array_type;
+ }
else
{
struct type *elt_type;
int arity;
struct value *descriptor;
- struct objfile *objf = TYPE_OBJFILE (value_type (arr));
elt_type = ada_array_element_type (value_type (arr), -1);
arity = ada_array_arity (value_type (arr));
return NULL;
while (arity > 0)
{
- struct type *range_type = alloc_type (objf);
- struct type *array_type = alloc_type (objf);
+ 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;
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);
+
+ if (ada_is_unconstrained_packed_array_type (value_type (arr)))
+ TYPE_FIELD_BITSIZE (elt_type, 0) =
+ decode_packed_array_bitsize (value_type (arr));
}
return lookup_pointer_type (elt_type);
return NULL;
return value_cast (arrType, value_copy (desc_data (arr)));
}
- else if (ada_is_packed_array_type (value_type (arr)))
- return decode_packed_array (arr);
+ else if (ada_is_constrained_packed_array_type (value_type (arr)))
+ return decode_constrained_packed_array (arr);
else
return arr;
}
check_size (TYPE_TARGET_TYPE (value_type (arrVal)));
return value_ind (arrVal);
}
- else if (ada_is_packed_array_type (value_type (arr)))
- return decode_packed_array (arr);
+ else if (ada_is_constrained_packed_array_type (value_type (arr)))
+ return decode_constrained_packed_array (arr);
else
return arr;
}
struct type *
ada_coerce_to_simple_array_type (struct type *type)
{
- struct value *mark = value_mark ();
- struct value *dummy = value_from_longest (builtin_type_int32, 0);
- struct type *result;
- deprecated_set_value_type (dummy, type);
- result = ada_type_of_array (dummy, 0);
- value_free_to_mark (mark);
- return result;
+ if (ada_is_constrained_packed_array_type (type))
+ return decode_constrained_packed_array_type (type);
+
+ if (ada_is_array_descriptor_type (type))
+ return ada_check_typedef (desc_data_target_type (type));
+
+ return type;
}
/* Non-zero iff TYPE represents a standard GNAT packed-array type. */
-int
-ada_is_packed_array_type (struct type *type)
+static int
+ada_is_packed_array_type (struct type *type)
{
if (type == NULL)
return 0;
&& strstr (ada_type_name (type), "___XP") != NULL;
}
+/* Non-zero iff TYPE represents a standard GNAT constrained
+ packed-array type. */
+
+int
+ada_is_constrained_packed_array_type (struct type *type)
+{
+ return ada_is_packed_array_type (type)
+ && !ada_is_array_descriptor_type (type);
+}
+
+/* Non-zero iff TYPE represents an array descriptor for a
+ unconstrained packed-array 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);
+}
+
+/* Given that TYPE encodes a packed array type (constrained or unconstrained),
+ return the size of its elements in bits. */
+
+static long
+decode_packed_array_bitsize (struct type *type)
+{
+ char *raw_name = ada_type_name (ada_check_typedef (type));
+ char *tail;
+ long bits;
+
+ if (!raw_name)
+ raw_name = ada_type_name (desc_base_type (type));
+
+ if (!raw_name)
+ return 0;
+
+ tail = strstr (raw_name, "___XP");
+
+ if (sscanf (tail + sizeof ("___XP") - 1, "%ld", &bits) != 1)
+ {
+ lim_warning
+ (_("could not understand bit size information on packed array"));
+ return 0;
+ }
+
+ return bits;
+}
+
/* Given that TYPE is a standard GDB array type with all bounds filled
in, and that the element size of its ultimate scalar constituents
(that is, either its elements, or, if it is an array of arrays, its
in bits. */
static struct type *
-packed_array_type (struct type *type, long *elt_bits)
+constrained_packed_array_type (struct type *type, long *elt_bits)
{
struct type *new_elt_type;
struct type *new_type;
if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
return type;
- new_type = alloc_type (TYPE_OBJFILE (type));
- new_elt_type = packed_array_type (ada_check_typedef (TYPE_TARGET_TYPE (type)),
- elt_bits);
+ new_type = alloc_type_copy (type);
+ new_elt_type =
+ constrained_packed_array_type (ada_check_typedef (TYPE_TARGET_TYPE (type)),
+ elt_bits);
create_array_type (new_type, new_elt_type, TYPE_INDEX_TYPE (type));
TYPE_FIELD_BITSIZE (new_type, 0) = *elt_bits;
TYPE_NAME (new_type) = ada_type_name (type);
return new_type;
}
-/* The array type encoded by TYPE, where ada_is_packed_array_type (TYPE). */
+/* The array type encoded by TYPE, where
+ ada_is_constrained_packed_array_type (TYPE). */
static struct type *
-decode_packed_array_type (struct type *type)
+decode_constrained_packed_array_type (struct type *type)
{
struct symbol *sym;
struct block **blocks;
memcpy (name, raw_name, tail - raw_name);
name[tail - raw_name] = '\000';
- sym = standard_lookup (name, get_selected_block (0), VAR_DOMAIN);
- if (sym == NULL || SYMBOL_TYPE (sym) == NULL)
+ shadow_type = ada_find_parallel_type_with_name (type, name);
+
+ if (shadow_type == NULL)
{
lim_warning (_("could not find bounds information on packed array"));
return NULL;
}
- shadow_type = SYMBOL_TYPE (sym);
+ CHECK_TYPEDEF (shadow_type);
if (TYPE_CODE (shadow_type) != TYPE_CODE_ARRAY)
{
return NULL;
}
- if (sscanf (tail + sizeof ("___XP") - 1, "%ld", &bits) != 1)
- {
- lim_warning
- (_("could not understand bit size information on packed array"));
- return NULL;
- }
-
- return packed_array_type (shadow_type, &bits);
+ bits = decode_packed_array_bitsize (type);
+ return constrained_packed_array_type (shadow_type, &bits);
}
-/* Given that ARR is a struct value *indicating a GNAT packed array,
- returns a simple array that denotes that array. Its type is a
+/* 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
target types are set to the number of bits in each element, and the
type length is set appropriately. */
static struct value *
-decode_packed_array (struct value *arr)
+decode_constrained_packed_array (struct value *arr)
{
struct type *type;
arr = ada_coerce_ref (arr);
+
+ /* If our value is a pointer, then dererence it. Make sure that
+ this operation does not cause the target type to be fixed, as
+ this would indirectly cause this array to be decoded. The rest
+ of the routine assumes that the array hasn't been decoded yet,
+ so we use the basic "value_ind" routine to perform the dereferencing,
+ as opposed to using "ada_value_ind". */
if (TYPE_CODE (value_type (arr)) == TYPE_CODE_PTR)
- arr = ada_value_ind (arr);
+ arr = value_ind (arr);
- type = decode_packed_array_type (value_type (arr));
+ type = decode_constrained_packed_array_type (value_type (arr));
if (type == NULL)
{
error (_("can't unpack array"));
return NULL;
}
- if (gdbarch_bits_big_endian (current_gdbarch)
+ if (gdbarch_bits_big_endian (get_type_arch (value_type (arr)))
&& ada_is_modular_type (value_type (arr)))
{
/* This is a (right-justified) modular type representing a packed
int len = (bit_size + bit_offset + HOST_CHAR_BIT - 1) / 8;
/* Transmit bytes from least to most significant; delta is the direction
the indices move. */
- int delta = gdbarch_bits_big_endian (current_gdbarch) ? -1 : 1;
+ int delta = gdbarch_bits_big_endian (get_type_arch (type)) ? -1 : 1;
type = ada_check_typedef (type);
else if (VALUE_LVAL (obj) == lval_memory && value_lazy (obj))
{
v = value_at (type,
- VALUE_ADDRESS (obj) + value_offset (obj) + offset);
+ value_address (obj) + offset);
bytes = (unsigned char *) alloca (len);
- read_memory (VALUE_ADDRESS (v), bytes, len);
+ read_memory (value_address (v), bytes, len);
}
else
{
if (obj != NULL)
{
+ CORE_ADDR new_addr;
set_value_component_location (v, obj);
- VALUE_ADDRESS (v) += value_offset (obj) + offset;
+ new_addr = value_address (obj) + offset;
set_value_bitpos (v, bit_offset + value_bitpos (obj));
set_value_bitsize (v, bit_size);
if (value_bitpos (v) >= HOST_CHAR_BIT)
{
- VALUE_ADDRESS (v) += 1;
+ ++new_addr;
set_value_bitpos (v, value_bitpos (v) - HOST_CHAR_BIT);
}
+ set_value_address (v, new_addr);
}
else
set_value_bitsize (v, bit_size);
memset (unpacked, 0, TYPE_LENGTH (type));
return v;
}
- else if (gdbarch_bits_big_endian (current_gdbarch))
+ else if (gdbarch_bits_big_endian (get_type_arch (type)))
{
src = len - 1;
if (has_negatives (type)
/* ... And are placed at the beginning (most-significant) bytes
of the target. */
targ = (bit_size + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT - 1;
+ ntarg = targ + 1;
break;
default:
accumSize = 0;
not overlap. */
static void
move_bits (gdb_byte *target, int targ_offset, const gdb_byte *source,
- int src_offset, int n)
+ int src_offset, int n, int bits_big_endian_p)
{
unsigned int accum, mask;
int accum_bits, chunk_size;
targ_offset %= HOST_CHAR_BIT;
source += src_offset / HOST_CHAR_BIT;
src_offset %= HOST_CHAR_BIT;
- if (gdbarch_bits_big_endian (current_gdbarch))
+ if (bits_big_endian_p)
{
accum = (unsigned char) *source;
source += 1;
int from_size;
char *buffer = (char *) alloca (len);
struct value *val;
- CORE_ADDR to_addr = VALUE_ADDRESS (toval) + value_offset (toval);
+ CORE_ADDR to_addr = value_address (toval);
if (TYPE_CODE (type) == TYPE_CODE_FLT)
fromval = value_cast (type, fromval);
from_size = value_bitsize (fromval);
if (from_size == 0)
from_size = TYPE_LENGTH (value_type (fromval)) * TARGET_CHAR_BIT;
- if (gdbarch_bits_big_endian (current_gdbarch))
+ if (gdbarch_bits_big_endian (get_type_arch (type)))
move_bits (buffer, value_bitpos (toval),
- value_contents (fromval), from_size - bits, bits);
+ value_contents (fromval), from_size - bits, bits, 1);
else
- move_bits (buffer, value_bitpos (toval), value_contents (fromval),
- 0, bits);
+ move_bits (buffer, value_bitpos (toval),
+ value_contents (fromval), 0, bits, 0);
write_memory (to_addr, buffer, len);
- if (deprecated_memory_changed_hook)
- deprecated_memory_changed_hook (to_addr, len);
-
+ observer_notify_memory_changed (to_addr, len, buffer);
+
val = value_copy (toval);
memcpy (value_contents_raw (val), value_contents (fromval),
TYPE_LENGTH (type));
struct value *val)
{
LONGEST offset_in_container =
- (LONGEST) (VALUE_ADDRESS (component) + value_offset (component)
- - VALUE_ADDRESS (container) - value_offset (container));
+ (LONGEST) (value_address (component) - value_address (container));
int bit_offset_in_container =
value_bitpos (component) - value_bitpos (container);
int bits;
else
bits = value_bitsize (component);
- if (gdbarch_bits_big_endian (current_gdbarch))
+ if (gdbarch_bits_big_endian (get_type_arch (value_type (container))))
move_bits (value_contents_writeable (container) + offset_in_container,
value_bitpos (container) + bit_offset_in_container,
value_contents (val),
TYPE_LENGTH (value_type (component)) * TARGET_CHAR_BIT - bits,
- bits);
+ bits, 1);
else
move_bits (value_contents_writeable (container) + offset_in_container,
value_bitpos (container) + bit_offset_in_container,
- value_contents (val), 0, bits);
+ value_contents (val), 0, bits, 0);
}
/* The value of the element of array ARR at the ARITY indices given in IND.
{
if (TYPE_CODE (elt_type) != TYPE_CODE_ARRAY)
error (_("too many subscripts (%d expected)"), k);
- elt = value_subscript (elt, value_pos_atr (builtin_type_int32, ind[k]));
+ elt = value_subscript (elt, pos_atr (ind[k]));
}
return elt;
}
value of the element of *ARR at the ARITY indices given in
IND. Does not read the entire array into memory. */
-struct value *
+static struct value *
ada_value_ptr_subscript (struct value *arr, struct type *type, int arity,
struct value **ind)
{
for (k = 0; k < arity; k += 1)
{
LONGEST lwb, upb;
- struct value *idx;
if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
error (_("too many subscripts (%d expected)"), k);
arr = value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
value_copy (arr));
get_discrete_bounds (TYPE_INDEX_TYPE (type), &lwb, &upb);
- idx = value_pos_atr (builtin_type_int32, ind[k]);
- if (lwb != 0)
- idx = value_binop (idx, value_from_longest (value_type (idx), lwb),
- BINOP_SUB);
-
- arr = value_ptradd (arr, idx);
+ arr = value_ptradd (arr, pos_atr (ind[k]) - lwb);
type = TYPE_TARGET_TYPE (type);
}
int low, int high)
{
CORE_ADDR base = value_as_address (array_ptr)
- + ((low - TYPE_LOW_BOUND (TYPE_INDEX_TYPE (type)))
+ + ((low - ada_discrete_type_low_bound (TYPE_INDEX_TYPE (type)))
* TYPE_LENGTH (TYPE_TARGET_TYPE (type)));
struct type *index_type =
create_range_type (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type)),
int k;
struct type *p_array_type;
- p_array_type = desc_data_type (type);
+ p_array_type = desc_data_target_type (type);
k = ada_array_arity (type);
if (k == 0)
/* Initially p_array_type = elt_type(*)[]...(k times)...[]. */
if (nindices >= 0 && k > nindices)
k = nindices;
- p_array_type = TYPE_TARGET_TYPE (p_array_type);
while (k > 0 && p_array_type != NULL)
{
p_array_type = ada_check_typedef (TYPE_TARGET_TYPE (p_array_type));
}
/* The type of nth index in arrays of given type (n numbering from 1).
- Does not examine memory. */
+ Does not examine memory. Throws an error if N is invalid or TYPE
+ is not an array type. NAME is the name of the Ada attribute being
+ evaluated ('range, 'first, 'last, or 'length); it is used in building
+ the error message. */
-struct type *
-ada_index_type (struct type *type, int n)
+static struct type *
+ada_index_type (struct type *type, int n, const char *name)
{
struct type *result_type;
type = desc_base_type (type);
- if (n > ada_array_arity (type))
- return NULL;
+ if (n < 0 || n > ada_array_arity (type))
+ error (_("invalid dimension number to '%s"), name);
if (ada_is_simple_array_type (type))
{
/* FIXME: The stabs type r(0,0);bound;bound in an array type
has a target type of TYPE_CODE_UNDEF. We compensate here, but
perhaps stabsread.c would make more sense. */
- if (result_type == NULL || TYPE_CODE (result_type) == TYPE_CODE_UNDEF)
- result_type = builtin_type_int32;
-
- return result_type;
+ if (result_type && TYPE_CODE (result_type) == TYPE_CODE_UNDEF)
+ result_type = NULL;
}
else
- return desc_index_type (desc_bounds_type (type), n);
+ {
+ result_type = desc_index_type (desc_bounds_type (type), n);
+ if (result_type == NULL)
+ error (_("attempt to take bound of something that is not an array"));
+ }
+
+ return result_type;
}
/* Given that arr is an array type, returns the lower bound of the
Nth index (numbering from 1) if WHICH is 0, and the upper bound if
WHICH is 1. This returns bounds 0 .. -1 if ARR_TYPE is an
- array-descriptor type. If TYPEP is non-null, *TYPEP is set to the
- bounds type. It works for other arrays with bounds supplied by
- run-time quantities other than discriminants. */
+ array-descriptor type. It works for other arrays with bounds supplied
+ by run-time quantities other than discriminants. */
static LONGEST
-ada_array_bound_from_type (struct type * arr_type, int n, int which,
- struct type ** typep)
+ada_array_bound_from_type (struct type * arr_type, int n, int which)
{
- struct type *type, *index_type_desc, *index_type;
- LONGEST retval;
+ struct type *type, *elt_type, *index_type_desc, *index_type;
+ int i;
gdb_assert (which == 0 || which == 1);
- if (ada_is_packed_array_type (arr_type))
- arr_type = decode_packed_array_type (arr_type);
+ if (ada_is_constrained_packed_array_type (arr_type))
+ arr_type = decode_constrained_packed_array_type (arr_type);
if (arr_type == NULL || !ada_is_simple_array_type (arr_type))
- {
- if (typep != NULL)
- *typep = builtin_type_int32;
- return (LONGEST) - which;
- }
+ return (LONGEST) - which;
if (TYPE_CODE (arr_type) == TYPE_CODE_PTR)
type = TYPE_TARGET_TYPE (arr_type);
else
type = arr_type;
+ elt_type = type;
+ for (i = n; i > 1; i--)
+ elt_type = TYPE_TARGET_TYPE (type);
+
index_type_desc = ada_find_parallel_type (type, "___XA");
if (index_type_desc != NULL)
index_type = to_fixed_range_type (TYPE_FIELD_NAME (index_type_desc, n - 1),
- NULL, TYPE_OBJFILE (arr_type));
+ NULL, TYPE_INDEX_TYPE (elt_type));
else
- {
- while (n > 1)
- {
- type = TYPE_TARGET_TYPE (type);
- n -= 1;
- }
-
- index_type = TYPE_INDEX_TYPE (type);
- }
+ index_type = TYPE_INDEX_TYPE (elt_type);
- switch (TYPE_CODE (index_type))
- {
- case TYPE_CODE_RANGE:
- retval = which == 0 ? TYPE_LOW_BOUND (index_type)
- : TYPE_HIGH_BOUND (index_type);
- break;
- case TYPE_CODE_ENUM:
- retval = which == 0 ? TYPE_FIELD_BITPOS (index_type, 0)
- : TYPE_FIELD_BITPOS (index_type,
- TYPE_NFIELDS (index_type) - 1);
- break;
- default:
- internal_error (__FILE__, __LINE__, _("invalid type code of index type"));
- }
-
- if (typep != NULL)
- *typep = index_type;
-
- return retval;
+ return
+ (LONGEST) (which == 0
+ ? 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
WHICH is 1. This routine will also work for arrays with bounds
supplied by run-time quantities other than discriminants. */
-struct value *
+static LONGEST
ada_array_bound (struct value *arr, int n, int which)
{
struct type *arr_type = value_type (arr);
- if (ada_is_packed_array_type (arr_type))
- return ada_array_bound (decode_packed_array (arr), n, which);
+ if (ada_is_constrained_packed_array_type (arr_type))
+ return ada_array_bound (decode_constrained_packed_array (arr), n, which);
else if (ada_is_simple_array_type (arr_type))
- {
- struct type *type;
- LONGEST v = ada_array_bound_from_type (arr_type, n, which, &type);
- return value_from_longest (type, v);
- }
+ return ada_array_bound_from_type (arr_type, n, which);
else
- return desc_one_bound (desc_bounds (arr), n, which);
+ return value_as_long (desc_one_bound (desc_bounds (arr), n, which));
}
/* Given that arr is an array value, returns the length of the
Does not work for arrays indexed by enumeration types with representation
clauses at the moment. */
-struct value *
+static LONGEST
ada_array_length (struct value *arr, int n)
{
struct type *arr_type = ada_check_typedef (value_type (arr));
- if (ada_is_packed_array_type (arr_type))
- return ada_array_length (decode_packed_array (arr), n);
+ if (ada_is_constrained_packed_array_type (arr_type))
+ return ada_array_length (decode_constrained_packed_array (arr), n);
if (ada_is_simple_array_type (arr_type))
- {
- struct type *type;
- LONGEST v =
- ada_array_bound_from_type (arr_type, n, 1, &type) -
- ada_array_bound_from_type (arr_type, n, 0, NULL) + 1;
- return value_from_longest (type, v);
- }
+ return (ada_array_bound_from_type (arr_type, n, 1)
+ - ada_array_bound_from_type (arr_type, n, 0) + 1);
else
- return
- value_from_longest (builtin_type_int32,
- value_as_long (desc_one_bound (desc_bounds (arr),
- n, 1))
- - value_as_long (desc_one_bound (desc_bounds (arr),
- n, 0)) + 1);
+ return (value_as_long (desc_one_bound (desc_bounds (arr), n, 1))
+ - value_as_long (desc_one_bound (desc_bounds (arr), n, 0)) + 1);
}
/* An empty array whose type is that of ARR_TYPE (an array type),
static void
resolve (struct expression **expp, int void_context_p)
{
- int pc;
- pc = 0;
- resolve_subexp (expp, &pc, 1, void_context_p ? builtin_type_void : NULL);
+ struct type *context_type = NULL;
+ int pc = 0;
+
+ if (void_context_p)
+ context_type = builtin_type ((*expp)->gdbarch)->builtin_void;
+
+ resolve_subexp (expp, &pc, 1, context_type);
}
/* Resolve the operator of the subexpression beginning at
case UNOP_QUAL:
*pos += 3;
- resolve_subexp (expp, pos, 1, exp->elts[pc + 1].type);
+ resolve_subexp (expp, pos, 1, check_typedef (exp->elts[pc + 1].type));
break;
case OP_ATR_MODULUS:
/* Return non-zero if formal type FTYPE matches actual type ATYPE. If
MAY_DEREF is non-zero, the formal may be a pointer and the actual
- a non-pointer. A type of 'void' (which is never a valid expression type)
- by convention matches anything. */
+ a non-pointer. */
/* The term "match" here is rather loose. The match is heuristic and
- liberal. FIXME: TOO liberal, in fact. */
+ liberal. */
static int
ada_type_match (struct type *ftype, struct type *atype, int may_deref)
if (TYPE_CODE (atype) == TYPE_CODE_REF)
atype = TYPE_TARGET_TYPE (atype);
- if (TYPE_CODE (ftype) == TYPE_CODE_VOID
- || TYPE_CODE (atype) == TYPE_CODE_VOID)
- return 1;
-
switch (TYPE_CODE (ftype))
{
default:
- return 1;
+ return TYPE_CODE (ftype) == TYPE_CODE (atype);
case TYPE_CODE_PTR:
if (TYPE_CODE (atype) == TYPE_CODE_PTR)
return ada_type_match (TYPE_TARGET_TYPE (ftype),
int nsyms, struct value **args, int nargs,
const char *name, struct type *context_type)
{
+ int fallback;
int k;
int m; /* Number of hits */
- struct type *fallback;
- struct type *return_type;
-
- return_type = context_type;
- if (context_type == NULL)
- fallback = builtin_type_void;
- else
- fallback = NULL;
m = 0;
- while (1)
+ /* In the first pass of the loop, we only accept functions matching
+ context_type. If none are found, we add a second pass of the loop
+ 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].sym));
if (ada_args_match (syms[k].sym, args, nargs)
- && return_match (type, return_type))
+ && (fallback || return_match (type, context_type)))
{
syms[m] = syms[k];
m += 1;
}
}
- if (m > 0 || return_type == fallback)
- break;
- else
- return_type = fallback;
}
if (m == 0)
(SYMBOL_CLASS (syms[i].sym) == LOC_CONST
&& SYMBOL_TYPE (syms[i].sym) != NULL
&& TYPE_CODE (SYMBOL_TYPE (syms[i].sym)) == TYPE_CODE_ENUM);
- struct symtab *symtab = symtab_for_sym (syms[i].sym);
+ struct symtab *symtab = syms[i].sym->symtab;
if (SYMBOL_LINE (syms[i].sym) != 0 && symtab != NULL)
printf_unfiltered (_("[%d] %s at %s:%d\n"),
case TYPE_CODE_INT:
case TYPE_CODE_RANGE:
case TYPE_CODE_ENUM:
+ case TYPE_CODE_BOOL:
return 1;
default:
return 0;
/* Return an lvalue containing the value VAL. This is the identity on
lvalues, and otherwise has the side-effect of pushing a copy of VAL
on the stack, using and updating *SP as the stack pointer, and
- returning an lvalue whose VALUE_ADDRESS points to the copy. */
+ returning an lvalue whose value_address points to the copy. */
static struct value *
-ensure_lval (struct value *val, CORE_ADDR *sp)
+ensure_lval (struct value *val, struct gdbarch *gdbarch, CORE_ADDR *sp)
{
if (! VALUE_LVAL (val))
{
/* The following is taken from the structure-return code in
call_function_by_hand. FIXME: Therefore, some refactoring seems
indicated. */
- if (gdbarch_inner_than (current_gdbarch, 1, 2))
+ if (gdbarch_inner_than (gdbarch, 1, 2))
{
- /* Stack grows downward. Align SP and VALUE_ADDRESS (val) after
+ /* Stack grows downward. Align SP and value_address (val) after
reserving sufficient space. */
*sp -= len;
- if (gdbarch_frame_align_p (current_gdbarch))
- *sp = gdbarch_frame_align (current_gdbarch, *sp);
- VALUE_ADDRESS (val) = *sp;
+ if (gdbarch_frame_align_p (gdbarch))
+ *sp = gdbarch_frame_align (gdbarch, *sp);
+ set_value_address (val, *sp);
}
else
{
/* Stack grows upward. Align the frame, allocate space, and
then again, re-align the frame. */
- if (gdbarch_frame_align_p (current_gdbarch))
- *sp = gdbarch_frame_align (current_gdbarch, *sp);
- VALUE_ADDRESS (val) = *sp;
+ if (gdbarch_frame_align_p (gdbarch))
+ *sp = gdbarch_frame_align (gdbarch, *sp);
+ set_value_address (val, *sp);
*sp += len;
- if (gdbarch_frame_align_p (current_gdbarch))
- *sp = gdbarch_frame_align (current_gdbarch, *sp);
+ if (gdbarch_frame_align_p (gdbarch))
+ *sp = gdbarch_frame_align (gdbarch, *sp);
}
VALUE_LVAL (val) = lval_memory;
- write_memory (VALUE_ADDRESS (val), value_contents_raw (val), len);
+ write_memory (value_address (val), value_contents_raw (val), len);
}
return val;
struct value *
ada_convert_actual (struct value *actual, struct type *formal_type0,
- CORE_ADDR *sp)
+ struct gdbarch *gdbarch, CORE_ADDR *sp)
{
struct type *actual_type = ada_check_typedef (value_type (actual));
struct type *formal_type = ada_check_typedef (formal_type0);
if (ada_is_array_descriptor_type (formal_target)
&& TYPE_CODE (actual_target) == TYPE_CODE_ARRAY)
- return make_array_descriptor (formal_type, actual, sp);
+ return make_array_descriptor (formal_type, actual, gdbarch, sp);
else if (TYPE_CODE (formal_type) == TYPE_CODE_PTR
|| TYPE_CODE (formal_type) == TYPE_CODE_REF)
{
memcpy ((char *) value_contents_raw (val),
(char *) value_contents (actual),
TYPE_LENGTH (actual_type));
- actual = ensure_lval (val, sp);
+ actual = ensure_lval (val, gdbarch, sp);
}
result = value_addr (actual);
}
representing a pointer to this descriptor. */
static struct value *
-make_array_descriptor (struct type *type, struct value *arr, CORE_ADDR *sp)
+make_array_descriptor (struct type *type, struct value *arr,
+ struct gdbarch *gdbarch, CORE_ADDR *sp)
{
struct type *bounds_type = desc_bounds_type (type);
struct type *desc_type = desc_base_type (type);
for (i = ada_array_arity (ada_check_typedef (value_type (arr))); i > 0; i -= 1)
{
- modify_general_field (value_contents_writeable (bounds),
- value_as_long (ada_array_bound (arr, i, 0)),
+ modify_general_field (value_type (bounds),
+ value_contents_writeable (bounds),
+ ada_array_bound (arr, i, 0),
desc_bound_bitpos (bounds_type, i, 0),
desc_bound_bitsize (bounds_type, i, 0));
- modify_general_field (value_contents_writeable (bounds),
- value_as_long (ada_array_bound (arr, i, 1)),
+ modify_general_field (value_type (bounds),
+ value_contents_writeable (bounds),
+ ada_array_bound (arr, i, 1),
desc_bound_bitpos (bounds_type, i, 1),
desc_bound_bitsize (bounds_type, i, 1));
}
- bounds = ensure_lval (bounds, sp);
+ bounds = ensure_lval (bounds, gdbarch, sp);
- modify_general_field (value_contents_writeable (descriptor),
- VALUE_ADDRESS (ensure_lval (arr, sp)),
+ modify_general_field (value_type (descriptor),
+ value_contents_writeable (descriptor),
+ value_address (ensure_lval (arr, gdbarch, sp)),
fat_pntr_data_bitpos (desc_type),
fat_pntr_data_bitsize (desc_type));
- modify_general_field (value_contents_writeable (descriptor),
- VALUE_ADDRESS (bounds),
+ modify_general_field (value_type (descriptor),
+ value_contents_writeable (descriptor),
+ value_address (bounds),
fat_pntr_bounds_bitpos (desc_type),
fat_pntr_bounds_bitsize (desc_type));
- descriptor = ensure_lval (descriptor, sp);
+ descriptor = ensure_lval (descriptor, gdbarch, sp);
if (TYPE_CODE (type) == TYPE_CODE_PTR)
return value_addr (descriptor);
static int
num_defns_collected (struct obstack *obstackp)
-{
- return obstack_object_size (obstackp) / sizeof (struct ada_symbol_info);
-}
-
-/* Vector of ada_symbol_info structures currently collected in current
- vector in *OBSTACKP. If FINISH, close off the vector and return
- its final address. */
-
-static struct ada_symbol_info *
-defns_collected (struct obstack *obstackp, int finish)
-{
- if (finish)
- return obstack_finish (obstackp);
- else
- return (struct ada_symbol_info *) obstack_base (obstackp);
-}
-
-/* Look, in partial_symtab PST, for symbol NAME in given namespace.
- Check the global symbols if GLOBAL, the static symbols if not.
- Do wild-card match if WILD. */
-
-static struct partial_symbol *
-ada_lookup_partial_symbol (struct partial_symtab *pst, const char *name,
- int global, domain_enum namespace, int wild)
-{
- struct partial_symbol **start;
- int name_len = strlen (name);
- int length = (global ? pst->n_global_syms : pst->n_static_syms);
- int i;
-
- if (length == 0)
- {
- return (NULL);
- }
-
- start = (global ?
- pst->objfile->global_psymbols.list + pst->globals_offset :
- pst->objfile->static_psymbols.list + pst->statics_offset);
-
- if (wild)
- {
- for (i = 0; i < length; i += 1)
- {
- struct partial_symbol *psym = start[i];
-
- if (symbol_matches_domain (SYMBOL_LANGUAGE (psym),
- SYMBOL_DOMAIN (psym), namespace)
- && wild_match (name, name_len, SYMBOL_LINKAGE_NAME (psym)))
- return psym;
- }
- return NULL;
- }
- else
- {
- if (global)
- {
- int U;
- i = 0;
- U = length - 1;
- while (U - i > 4)
- {
- int M = (U + i) >> 1;
- struct partial_symbol *psym = start[M];
- if (SYMBOL_LINKAGE_NAME (psym)[0] < name[0])
- i = M + 1;
- else if (SYMBOL_LINKAGE_NAME (psym)[0] > name[0])
- U = M - 1;
- else if (strcmp (SYMBOL_LINKAGE_NAME (psym), name) < 0)
- i = M + 1;
- else
- U = M;
- }
- }
- else
- i = 0;
-
- while (i < length)
- {
- struct partial_symbol *psym = start[i];
-
- if (symbol_matches_domain (SYMBOL_LANGUAGE (psym),
- SYMBOL_DOMAIN (psym), namespace))
- {
- int cmp = strncmp (name, SYMBOL_LINKAGE_NAME (psym), name_len);
-
- if (cmp < 0)
- {
- if (global)
- break;
- }
- else if (cmp == 0
- && is_name_suffix (SYMBOL_LINKAGE_NAME (psym)
- + name_len))
- return psym;
- }
- i += 1;
- }
-
- if (global)
- {
- int U;
- i = 0;
- U = length - 1;
- while (U - i > 4)
- {
- int M = (U + i) >> 1;
- struct partial_symbol *psym = start[M];
- if (SYMBOL_LINKAGE_NAME (psym)[0] < '_')
- i = M + 1;
- else if (SYMBOL_LINKAGE_NAME (psym)[0] > '_')
- U = M - 1;
- else if (strcmp (SYMBOL_LINKAGE_NAME (psym), "_ada_") < 0)
- i = M + 1;
- else
- U = M;
- }
- }
- else
- i = 0;
-
- while (i < length)
- {
- struct partial_symbol *psym = start[i];
-
- if (symbol_matches_domain (SYMBOL_LANGUAGE (psym),
- SYMBOL_DOMAIN (psym), namespace))
- {
- int cmp;
-
- cmp = (int) '_' - (int) SYMBOL_LINKAGE_NAME (psym)[0];
- if (cmp == 0)
- {
- cmp = strncmp ("_ada_", SYMBOL_LINKAGE_NAME (psym), 5);
- if (cmp == 0)
- cmp = strncmp (name, SYMBOL_LINKAGE_NAME (psym) + 5,
- name_len);
- }
-
- if (cmp < 0)
- {
- if (global)
- break;
- }
- else if (cmp == 0
- && is_name_suffix (SYMBOL_LINKAGE_NAME (psym)
- + name_len + 5))
- return psym;
- }
- i += 1;
- }
- }
- return NULL;
-}
-
-/* Find a symbol table containing symbol SYM or NULL if none. */
-
-static struct symtab *
-symtab_for_sym (struct symbol *sym)
-{
- struct symtab *s;
- struct objfile *objfile;
- struct block *b;
- struct symbol *tmp_sym;
- struct dict_iterator iter;
- int j;
-
- ALL_PRIMARY_SYMTABS (objfile, s)
- {
- switch (SYMBOL_CLASS (sym))
- {
- case LOC_CONST:
- case LOC_STATIC:
- case LOC_TYPEDEF:
- case LOC_REGISTER:
- case LOC_LABEL:
- case LOC_BLOCK:
- case LOC_CONST_BYTES:
- b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), GLOBAL_BLOCK);
- ALL_BLOCK_SYMBOLS (b, iter, tmp_sym) if (sym == tmp_sym)
- return s;
- b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), STATIC_BLOCK);
- ALL_BLOCK_SYMBOLS (b, iter, tmp_sym) if (sym == tmp_sym)
- return s;
- break;
- default:
- break;
- }
- switch (SYMBOL_CLASS (sym))
- {
- case LOC_REGISTER:
- case LOC_ARG:
- case LOC_REF_ARG:
- case LOC_REGPARM_ADDR:
- case LOC_LOCAL:
- case LOC_TYPEDEF:
- case LOC_COMPUTED:
- for (j = FIRST_LOCAL_BLOCK;
- j < BLOCKVECTOR_NBLOCKS (BLOCKVECTOR (s)); j += 1)
- {
- b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), j);
- ALL_BLOCK_SYMBOLS (b, iter, tmp_sym) if (sym == tmp_sym)
- return s;
- }
- break;
- default:
- break;
- }
- }
- return NULL;
+{
+ return obstack_object_size (obstackp) / sizeof (struct ada_symbol_info);
+}
+
+/* Vector of ada_symbol_info structures currently collected in current
+ vector in *OBSTACKP. If FINISH, close off the vector and return
+ its final address. */
+
+static struct ada_symbol_info *
+defns_collected (struct obstack *obstackp, int finish)
+{
+ if (finish)
+ return obstack_finish (obstackp);
+ else
+ return (struct ada_symbol_info *) obstack_base (obstackp);
}
/* Return a minimal symbol matching NAME according to Ada decoding
add_symbols_from_enclosing_procs (obstackp, name, domain, wild_match);
}
+/* An object of this type is used as the user_data argument when
+ calling the map_ada_symtabs method. */
+
+struct ada_psym_data
+{
+ struct obstack *obstackp;
+ const char *name;
+ domain_enum domain;
+ int global;
+ int wild_match;
+};
+
+/* Callback function for map_ada_symtabs. */
+
+static void
+ada_add_psyms (struct objfile *objfile, struct symtab *s, void *user_data)
+{
+ struct ada_psym_data *data = user_data;
+ const int block_kind = data->global ? GLOBAL_BLOCK : STATIC_BLOCK;
+ ada_add_block_symbols (data->obstackp,
+ BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), block_kind),
+ data->name, data->domain, objfile, data->wild_match);
+}
+
/* Add to OBSTACKP all non-local symbols whose name and domain match
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
ada_add_non_local_symbols (struct obstack *obstackp, const char *name,
domain_enum domain, int global,
- int wild_match)
+ int is_wild_match)
{
struct objfile *objfile;
- struct partial_symtab *ps;
+ struct ada_psym_data data;
- ALL_PSYMTABS (objfile, ps)
- {
- QUIT;
- if (ps->readin
- || ada_lookup_partial_symbol (ps, name, global, domain, wild_match))
- {
- struct symtab *s = PSYMTAB_TO_SYMTAB (ps);
- const int block_kind = global ? GLOBAL_BLOCK : STATIC_BLOCK;
+ data.obstackp = obstackp;
+ data.name = name;
+ data.domain = domain;
+ data.global = global;
+ data.wild_match = is_wild_match;
- if (s == NULL || !s->primary)
- continue;
- ada_add_block_symbols (obstackp,
- BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), block_kind),
- name, domain, objfile, wild_match);
- }
+ ALL_OBJFILES (objfile)
+ {
+ if (objfile->sf)
+ objfile->sf->qf->map_ada_symtabs (objfile, wild_match, is_name_suffix,
+ ada_add_psyms, name,
+ global, domain,
+ is_wild_match, &data);
}
}
static struct symbol *
ada_lookup_symbol_nonlocal (const char *name,
- const char *linkage_name,
const struct block *block,
const domain_enum domain)
{
- if (linkage_name == NULL)
- linkage_name = name;
- return ada_lookup_symbol (linkage_name, block_static_block (block), domain,
- NULL);
+ return ada_lookup_symbol (name, block_static_block (block), domain, NULL);
}
}
}
-
/* Add symbols from BLOCK matching identifier NAME in DOMAIN to
vector *defn_symbols, updating the list of symbols in OBSTACKP
(if necessary). If WILD, treat as NAME with a wildcard prefix.
return sym_name;
}
-typedef char *char_ptr;
DEF_VEC_P (char_ptr);
/* A companion function to ada_make_symbol_completion_list().
VEC_safe_push (char_ptr, *sv, completion);
}
+/* An object of this type is passed as the user_data argument to the
+ map_partial_symbol_names method. */
+struct add_partial_datum
+{
+ VEC(char_ptr) **completions;
+ char *text;
+ int text_len;
+ char *text0;
+ char *word;
+ int wild_match;
+ int encoded;
+};
+
+/* A callback for map_partial_symbol_names. */
+static void
+ada_add_partial_symbol_completions (const char *name, void *user_data)
+{
+ struct add_partial_datum *data = user_data;
+ symbol_completion_add (data->completions, name,
+ data->text, data->text_len, data->text0, data->word,
+ data->wild_match, data->encoded);
+}
+
/* Return a list of possible symbol names completing TEXT0. The list
is NULL terminated. WORD is the entire command on which completion
is made. */
VEC(char_ptr) *completions = VEC_alloc (char_ptr, 128);
struct symbol *sym;
struct symtab *s;
- struct partial_symtab *ps;
struct minimal_symbol *msymbol;
struct objfile *objfile;
struct block *b, *surrounding_static_block = 0;
}
/* First, look at the partial symtab symbols. */
- ALL_PSYMTABS (objfile, ps)
{
- struct partial_symbol **psym;
-
- /* If the psymtab's been read in we'll get it when we search
- through the blockvector. */
- if (ps->readin)
- continue;
-
- for (psym = objfile->global_psymbols.list + ps->globals_offset;
- psym < (objfile->global_psymbols.list + ps->globals_offset
- + ps->n_global_syms); psym++)
- {
- QUIT;
- symbol_completion_add (&completions, SYMBOL_LINKAGE_NAME (*psym),
- text, text_len, text0, word,
- wild_match, encoded);
- }
-
- for (psym = objfile->static_psymbols.list + ps->statics_offset;
- psym < (objfile->static_psymbols.list + ps->statics_offset
- + ps->n_static_syms); psym++)
- {
- QUIT;
- symbol_completion_add (&completions, SYMBOL_LINKAGE_NAME (*psym),
- text, text_len, text0, word,
- wild_match, encoded);
- }
+ struct add_partial_datum data;
+
+ data.completions = &completions;
+ data.text = text;
+ data.text_len = text_len;
+ data.text0 = text0;
+ data.word = word;
+ data.wild_match = wild_match;
+ data.encoded = encoded;
+ map_partial_symbol_names (ada_add_partial_symbol_completions, &data);
}
/* At this point scan through the misc symbol vectors and add each
valp = value_cast (info_type, args->tag);
if (valp == NULL)
return 0;
- val = value_ind (value_ptradd (valp,
- value_from_longest (builtin_type_int8, -1)));
+ val = value_ind (value_ptradd (valp, -1));
if (val == NULL)
return 0;
val = ada_value_struct_elt (val, "expanded_name", 1);
/* Assuming that VAR_TYPE is a variant wrapper (type of the variant part)
whose discriminants are contained in the record type OUTER_TYPE,
- returns the type of the controlling discriminant for the variant. */
+ returns the type of the controlling discriminant for the variant.
+ May return NULL if the type could not be found. */
struct type *
ada_variant_discrim_type (struct type *var_type, struct type *outer_type)
{
char *name = ada_variant_discrim_name (var_type);
- struct type *type =
- ada_lookup_struct_elt_type (outer_type, name, 1, 1, NULL);
- if (type == NULL)
- return builtin_type_int32;
- else
- return type;
+ return ada_lookup_struct_elt_type (outer_type, name, 1, 1, NULL);
}
/* Assuming that TYPE is the type of a variant wrapper, and FIELD_NUM is a
return sym;
}
-/* Find a type named NAME. Ignores ambiguity. */
+/* Find a type named NAME. Ignores ambiguity. This routine will look
+ solely for types defined by debug info, it will not search the GDB
+ primitive types. */
struct type *
ada_find_any_type (const char *name)
the XR type name, we need to make sure that this suffix is
not included. So do not include any suffix in the function
name length below. */
- const int function_name_len = ada_name_prefix_len (function_name);
+ int function_name_len = ada_name_prefix_len (function_name);
const int rename_len = function_name_len + 2 /* "__" */
+ strlen (name) + 6 /* "___XR\0" */ ;
/* Strip the suffix if necessary. */
- function_name[function_name_len] = '\0';
+ ada_remove_trailing_digits (function_name, &function_name_len);
+ ada_remove_po_subprogram_suffix (function_name, &function_name_len);
+ ada_remove_Xbn_suffix (function_name, &function_name_len);
/* Library-level functions are a special case, as GNAT adds
a ``_ada_'' prefix to the function name to avoid namespace
have this prefix, so we need to skip this prefix if present. */
if (function_name_len > 5 /* "_ada_" */
&& strstr (function_name, "_ada_") == function_name)
- function_name = function_name + 5;
+ {
+ function_name += 5;
+ function_name_len -= 5;
+ }
rename = (char *) alloca (rename_len * sizeof (char));
- sprintf (rename, "%s__%s___XR", function_name, name);
+ strncpy (rename, function_name, function_name_len);
+ xsnprintf (rename + function_name_len, rename_len - function_name_len,
+ "__%s___XR", name);
}
else
{
const int rename_len = strlen (name) + 6;
rename = (char *) alloca (rename_len * sizeof (char));
- sprintf (rename, "%s___XR", name);
+ xsnprintf (rename, rename_len * sizeof (char), "%s___XR", name);
}
return ada_find_any_symbol (rename);
return 0;
else if (TYPE_NAME (type1) == NULL && TYPE_NAME (type0) != NULL)
return 1;
- else if (ada_is_packed_array_type (type0))
+ 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))
return TYPE_TAG_NAME (type);
}
-/* Find a parallel type to TYPE whose name is formed by appending
+/* Search the list of "descriptive" types associated to TYPE for a type
+ whose name is NAME. */
+
+static struct type *
+find_parallel_type_by_descriptive_type (struct type *type, const char *name)
+{
+ struct type *result;
+
+ /* If there no descriptive-type info, then there is no parallel type
+ to be found. */
+ if (!HAVE_GNAT_AUX_INFO (type))
+ return NULL;
+
+ result = TYPE_DESCRIPTIVE_TYPE (type);
+ while (result != NULL)
+ {
+ char *result_name = ada_type_name (result);
+
+ if (result_name == NULL)
+ {
+ warning (_("unexpected null name on descriptive type"));
+ return NULL;
+ }
+
+ /* If the names match, stop. */
+ if (strcmp (result_name, name) == 0)
+ break;
+
+ /* Otherwise, look at the next item on the list, if any. */
+ if (HAVE_GNAT_AUX_INFO (result))
+ result = TYPE_DESCRIPTIVE_TYPE (result);
+ else
+ result = NULL;
+ }
+
+ /* If we didn't find a match, see whether this is a packed array. With
+ older compilers, the descriptive type information is either absent or
+ irrelevant when it comes to packed arrays so the above lookup fails.
+ Fall back to using a parallel lookup by name in this case. */
+ if (result == NULL && ada_is_constrained_packed_array_type (type))
+ return ada_find_any_type (name);
+
+ return result;
+}
+
+/* Find a parallel type to TYPE with the specified NAME, using the
+ descriptive type taken from the debugging information, if available,
+ and otherwise using the (slower) name-based method. */
+
+static struct type *
+ada_find_parallel_type_with_name (struct type *type, const char *name)
+{
+ struct type *result = NULL;
+
+ if (HAVE_GNAT_AUX_INFO (type))
+ result = find_parallel_type_by_descriptive_type (type, name);
+ else
+ result = ada_find_any_type (name);
+
+ return result;
+}
+
+/* Same as above, but specify the name of the parallel type by appending
SUFFIX to the name of TYPE. */
struct type *
ada_find_parallel_type (struct type *type, const char *suffix)
{
- static char *name;
- static size_t name_len = 0;
+ char *name, *typename = ada_type_name (type);
int len;
- char *typename = ada_type_name (type);
if (typename == NULL)
return NULL;
len = strlen (typename);
- GROW_VECT (name, name_len, len + strlen (suffix) + 1);
+ name = (char *) alloca (len + strlen (suffix) + 1);
strcpy (name, typename);
strcpy (name + len, suffix);
- return ada_find_any_type (name);
+ return ada_find_parallel_type_with_name (type, name);
}
-
/* If TYPE is a variable-size record type, return the corresponding template
type describing its fields. Otherwise, return NULL. */
/* A record type with no fields. */
static struct type *
-empty_record (struct objfile *objfile)
+empty_record (struct type *template)
{
- struct type *type = alloc_type (objfile);
+ struct type *type = alloc_type_copy (template);
TYPE_CODE (type) = TYPE_CODE_STRUCT;
TYPE_NFIELDS (type) = 0;
TYPE_FIELDS (type) = NULL;
nfields++;
}
- rtype = alloc_type (TYPE_OBJFILE (type));
+ rtype = alloc_type_copy (type);
TYPE_CODE (rtype) = TYPE_CODE_STRUCT;
INIT_CPLUS_SPECIFIC (rtype);
TYPE_NFIELDS (rtype) = nfields;
}
else if (is_dynamic_field (type, f))
{
+ const gdb_byte *field_valaddr = valaddr;
+ CORE_ADDR field_address = address;
+ struct type *field_type =
+ TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, f));
+
if (dval0 == NULL)
- dval = value_from_contents_and_address (rtype, valaddr, address);
+ {
+ /* rtype's length is computed based on the run-time
+ value of discriminants. If the discriminants are not
+ initialized, the type size may be completely bogus and
+ GDB may fail to allocate a value for it. So check the
+ size first before creating the value. */
+ check_size (rtype);
+ dval = value_from_contents_and_address (rtype, valaddr, address);
+ }
else
dval = dval0;
- /* Get the fixed type of the field. Note that, in this case, we
- do not want to get the real type out of the tag: if the current
- field is the parent part of a tagged record, we will get the
- tag of the object. Clearly wrong: the real type of the parent
- is not the real type of the child. We would end up in an infinite
- loop. */
- TYPE_FIELD_TYPE (rtype, f) =
- ada_to_fixed_type
- (ada_get_base_type
- (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, f))),
- cond_offset_host (valaddr, off / TARGET_CHAR_BIT),
- cond_offset_target (address, off / TARGET_CHAR_BIT), dval, 0);
+ /* 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.
+ Keeping the aligner type would cause us to compute the wrong
+ size for this field, impacting the offset of the all the fields
+ that follow this one. */
+ if (ada_is_aligner_type (field_type))
+ {
+ long field_offset = TYPE_FIELD_BITPOS (field_type, f);
+
+ field_valaddr = cond_offset_host (field_valaddr, field_offset);
+ field_address = cond_offset_target (field_address, field_offset);
+ field_type = ada_aligned_type (field_type);
+ }
+
+ field_valaddr = cond_offset_host (field_valaddr,
+ off / TARGET_CHAR_BIT);
+ field_address = cond_offset_target (field_address,
+ off / TARGET_CHAR_BIT);
+
+ /* Get the fixed type of the field. Note that, in this case,
+ we do not want to get the real type out of the tag: if
+ the current field is the parent part of a tagged record,
+ we will get the tag of the object. Clearly wrong: the real
+ type of the parent is not the real type of the child. We
+ would end up in an infinite loop. */
+ field_type = ada_get_base_type (field_type);
+ field_type = ada_to_fixed_type (field_type, field_valaddr,
+ field_address, dval, 0);
+
+ TYPE_FIELD_TYPE (rtype, f) = field_type;
TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
bit_incr = fld_bit_len =
TYPE_LENGTH (TYPE_FIELD_TYPE (rtype, f)) * TARGET_CHAR_BIT;
}
else
{
- TYPE_FIELD_TYPE (rtype, f) = TYPE_FIELD_TYPE (type, f);
+ struct type *field_type = TYPE_FIELD_TYPE (type, f);
+
+ TYPE_FIELD_TYPE (rtype, f) = field_type;
TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
if (TYPE_FIELD_BITSIZE (type, f) > 0)
bit_incr = fld_bit_len =
TYPE_FIELD_BITSIZE (rtype, f) = TYPE_FIELD_BITSIZE (type, f);
else
bit_incr = fld_bit_len =
- TYPE_LENGTH (TYPE_FIELD_TYPE (type, f)) * TARGET_CHAR_BIT;
+ TYPE_LENGTH (ada_check_typedef (field_type)) * TARGET_CHAR_BIT;
}
if (off + fld_bit_len > bit_len)
bit_len = off + fld_bit_len;
new_type = static_unwrap_type (field_type);
if (type == type0 && new_type != field_type)
{
- TYPE_TARGET_TYPE (type0) = type = alloc_type (TYPE_OBJFILE (type0));
+ TYPE_TARGET_TYPE (type0) = type = alloc_type_copy (type0);
TYPE_CODE (type) = TYPE_CODE (type0);
INIT_CPLUS_SPECIFIC (type);
TYPE_NFIELDS (type) = nfields;
else
dval = dval0;
- rtype = alloc_type (TYPE_OBJFILE (type));
+ rtype = alloc_type_copy (type);
TYPE_CODE (rtype) = TYPE_CODE_STRUCT;
INIT_CPLUS_SPECIFIC (rtype);
TYPE_NFIELDS (rtype) = nfields;
value_type (dval), value_contents (dval));
if (which < 0)
- return empty_record (TYPE_OBJFILE (var_type));
+ return empty_record (var_type);
else if (is_dynamic_field (var_type, which))
return to_fixed_record_type
(TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (var_type, which)),
{
struct type *index_type_desc;
struct type *result;
+ int constrained_packed_array_p;
- if (ada_is_packed_array_type (type0) /* revisit? */
- || TYPE_FIXED_INSTANCE (type0))
+ if (TYPE_FIXED_INSTANCE (type0))
return type0;
+ constrained_packed_array_p = ada_is_constrained_packed_array_type (type0);
+ if (constrained_packed_array_p)
+ type0 = decode_constrained_packed_array_type (type0);
+
index_type_desc = ada_find_parallel_type (type0, "___XA");
if (index_type_desc == NULL)
{
consult the object tag. */
struct type *elt_type = ada_to_fixed_type (elt_type0, 0, 0, dval, 1);
- if (elt_type0 == elt_type)
+ /* 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;
else
- result = create_array_type (alloc_type (TYPE_OBJFILE (type0)),
+ result = create_array_type (alloc_type_copy (type0),
elt_type, TYPE_INDEX_TYPE (type0));
}
else
consult the object tag. */
result =
ada_to_fixed_type (ada_check_typedef (elt_type0), 0, 0, dval, 1);
+
+ elt_type0 = type0;
for (i = TYPE_NFIELDS (index_type_desc) - 1; i >= 0; i -= 1)
{
struct type *range_type =
to_fixed_range_type (TYPE_FIELD_NAME (index_type_desc, i),
- dval, TYPE_OBJFILE (type0));
- result = create_array_type (alloc_type (TYPE_OBJFILE (type0)),
+ dval, TYPE_INDEX_TYPE (elt_type0));
+ 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"));
}
+ if (constrained_packed_array_p)
+ {
+ /* So far, the resulting type has been created as if the original
+ type was a regular (non-packed) array type. As a result, the
+ bitsize of the array elements needs to be set again, and the array
+ length needs to be recomputed based on that bitsize. */
+ int len = TYPE_LENGTH (result) / TYPE_LENGTH (TYPE_TARGET_TYPE (result));
+ int elt_bitsize = TYPE_FIELD_BITSIZE (type0, 0);
+
+ 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_FIXED_INSTANCE (result) = 1;
return result;
}
int xvz_found = 0;
LONGEST size;
- sprintf (xvz_name, "%s___XVZ", name);
+ xsnprintf (xvz_name, strlen (name) + 7, "%s___XVZ", name);
size = get_int_var_value (xvz_name, &xvz_found);
if (xvz_found && TYPE_LENGTH (fixed_record_type) != size)
{
ada_to_fixed_value (struct value *val)
{
return ada_to_fixed_value_create (value_type (val),
- VALUE_ADDRESS (val) + value_offset (val),
+ value_address (val),
val);
}
-
-/* A value representing VAL, but with a standard (static-sized) type
- chosen to approximate the real type of VAL as well as possible, but
- without consulting any runtime values. For Ada dynamic-sized
- types, therefore, the type of the result is likely to be inaccurate. */
-
-struct value *
-ada_to_static_fixed_value (struct value *val)
-{
- struct type *type =
- to_static_fixed_type (static_unwrap_type (value_type (val)));
- if (type == value_type (val))
- return val;
- else
- return coerce_unspec_val_to_type (val, type);
-}
\f
/* Attributes */
return 0;
}
+/* The compiler sometimes provides a parallel XVS type for a given
+ PAD type. Normally, it is safe to follow the PAD type directly,
+ but older versions of the compiler have a bug that causes the offset
+ of its "F" field to be wrong. Following that field in that case
+ would lead to incorrect results, but this can be worked around
+ by ignoring the PAD type and using the associated XVS type instead.
+
+ Set to True if the debugger should trust the contents of PAD types.
+ Otherwise, ignore the PAD type if there is a parallel XVS type. */
+static int trust_pad_over_xvs = 1;
/* True if TYPE is a struct type introduced by the compiler to force the
alignment of a value. Such types have a single field with a
{
type = ada_check_typedef (type);
- /* If we can find a parallel XVS type, then the XVS type should
- be used instead of this type. And hence, this is not an aligner
- type. */
- if (ada_find_parallel_type (type, "___XVS") != NULL)
+ if (!trust_pad_over_xvs && ada_find_parallel_type (type, "___XVS") != NULL)
return 0;
return (TYPE_CODE (type) == TYPE_CODE_STRUCT
if (raw_type == NULL || TYPE_CODE (raw_type) != TYPE_CODE_STRUCT)
return raw_type;
+ if (ada_is_aligner_type (raw_type))
+ /* The encoding specifies that we should always use the aligner type.
+ So, even if this aligner type has an associated XVS type, we should
+ simply ignore it.
+
+ According to the compiler gurus, an XVS type parallel to an aligner
+ type may exist because of a stabs limitation. In stabs, aligner
+ types are empty because the field has a variable-sized type, and
+ thus cannot actually be used as an aligner type. As a result,
+ we need the associated parallel XVS type to decode the type.
+ Since the policy in the compiler is to not change the internal
+ representation based on the debugging info format, we sometimes
+ end up having a redundant XVS type parallel to the aligner type. */
+ return raw_type;
+
real_type_namer = ada_find_parallel_type (raw_type, "___XVS");
if (real_type_namer == NULL
|| TYPE_CODE (real_type_namer) != TYPE_CODE_STRUCT
|| TYPE_NFIELDS (real_type_namer) != 1)
return raw_type;
- raw_real_type = ada_find_any_type (TYPE_FIELD_NAME (real_type_namer, 0));
- if (raw_real_type == NULL)
- return raw_type;
- else
- return raw_real_type;
+ if (TYPE_CODE (TYPE_FIELD_TYPE (real_type_namer, 0)) != TYPE_CODE_REF)
+ {
+ /* This is an older encoding form where the base type needs to be
+ looked up by name. We prefer the newer enconding because it is
+ more efficient. */
+ raw_real_type = ada_find_any_type (TYPE_FIELD_NAME (real_type_namer, 0));
+ if (raw_real_type == NULL)
+ return raw_type;
+ else
+ return raw_real_type;
+ }
+
+ /* The field in our XVS type is a reference to the base type. */
+ return TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (real_type_namer, 0));
}
/* The type of value designated by TYPE, with all aligners removed. */
GROW_VECT (result, result_len, 16);
if (isascii (v) && isprint (v))
- sprintf (result, "'%c'", v);
+ xsnprintf (result, result_len, "'%c'", v);
else if (name[1] == 'U')
- sprintf (result, "[\"%02x\"]", v);
+ xsnprintf (result, result_len, "[\"%02x\"]", v);
else
- sprintf (result, "[\"%04x\"]", v);
+ xsnprintf (result, result_len, "[\"%04x\"]", v);
return result;
}
}
}
-static struct value *
-evaluate_subexp (struct type *expect_type, struct expression *exp, int *pos,
- enum noside noside)
-{
- return (*exp->language_defn->la_exp_desc->evaluate_exp)
- (expect_type, exp, pos, noside);
-}
-
/* Evaluate the subexpression of EXP starting at *POS as for
evaluate_type, updating *POS to point just past the evaluated
expression. */
static struct value *
evaluate_subexp_type (struct expression *exp, int *pos)
{
- return (*exp->language_defn->la_exp_desc->evaluate_exp)
- (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
+ return evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
}
/* If VAL is wrapped in an aligner or subtype wrapper, return the
struct type *raw_real_type =
ada_check_typedef (ada_get_base_type (type));
- if (type == raw_real_type)
- return val;
+ /* If there is no parallel XVS or XVE type, then the value is
+ already unwrapped. Return it without further modification. */
+ if ((type == raw_real_type)
+ && ada_find_parallel_type (type, "___XVE") == NULL)
+ return val;
return
coerce_unspec_val_to_type
(val, ada_to_fixed_type (raw_real_type, 0,
- VALUE_ADDRESS (val) + value_offset (val),
+ value_address (val),
NULL, 1));
}
}
val = allocate_value (type1);
store_unsigned_integer (value_contents_raw (val),
- TYPE_LENGTH (value_type (val)), v);
+ TYPE_LENGTH (value_type (val)),
+ gdbarch_byte_order (get_type_arch (type1)), v);
return val;
}
struct value *elt;
if (TYPE_CODE (value_type (lhs)) == TYPE_CODE_ARRAY)
{
- struct value *index_val = value_from_longest (builtin_type_int32, index);
+ struct type *index_type = builtin_type (exp->gdbarch)->builtin_int;
+ struct value *index_val = value_from_longest (index_type, index);
elt = unwrap_value (ada_value_subscript (lhs, 1, &index_val));
}
else
return value_cast (type, arg2);
}
+/* Evaluating Ada expressions, and printing their result.
+ ------------------------------------------------------
+
+ 1. Introduction:
+ ----------------
+
+ We usually evaluate an Ada expression in order to print its value.
+ We also evaluate an expression in order to print its type, which
+ happens during the EVAL_AVOID_SIDE_EFFECTS phase of the evaluation,
+ but we'll focus mostly on the EVAL_NORMAL phase. In practice, the
+ EVAL_AVOID_SIDE_EFFECTS phase allows us to simplify certain aspects of
+ the evaluation compared to the EVAL_NORMAL, but is otherwise very
+ similar.
+
+ Evaluating expressions is a little more complicated for Ada entities
+ than it is for entities in languages such as C. The main reason for
+ this is that Ada provides types whose definition might be dynamic.
+ One example of such types is variant records. Or another example
+ would be an array whose bounds can only be known at run time.
+
+ The following description is a general guide as to what should be
+ done (and what should NOT be done) in order to evaluate an expression
+ involving such types, and when. This does not cover how the semantic
+ information is encoded by GNAT as this is covered separatly. For the
+ document used as the reference for the GNAT encoding, see exp_dbug.ads
+ in the GNAT sources.
+
+ Ideally, we should embed each part of this description next to its
+ associated code. Unfortunately, the amount of code is so vast right
+ now that it's hard to see whether the code handling a particular
+ situation might be duplicated or not. One day, when the code is
+ cleaned up, this guide might become redundant with the comments
+ inserted in the code, and we might want to remove it.
+
+ 2. ``Fixing'' an Entity, the Simple Case:
+ -----------------------------------------
+
+ When evaluating Ada expressions, the tricky issue is that they may
+ reference entities whose type contents and size are not statically
+ 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;
+ end record;
+ Yes : Rec := (Empty => False, Value => 1);
+ No : Rec := (empty => True);
+
+ The size and contents of that record depends on the value of the
+ descriminant (Rec.Empty). At this point, neither the debugging
+ information nor the associated type structure in GDB are able to
+ express such dynamic types. So what the debugger does is to create
+ "fixed" versions of the type that applies to the specific object.
+ We also informally refer to this opperation as "fixing" an object,
+ which means creating its associated fixed type.
+
+ Example: when printing the value of variable "Yes" above, its fixed
+ type would look like this:
+
+ type Rec is record
+ 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;
+ end record;
+
+ Things become a little more complicated when trying to fix an entity
+ with a dynamic type that directly contains another dynamic type,
+ such as an array of variant records, for instance. There are
+ two possible cases: Arrays, and records.
+
+ 3. ``Fixing'' Arrays:
+ ---------------------
+
+ The type structure in GDB describes an array in terms of its bounds,
+ and the type of its elements. By design, all elements in the array
+ have the same type and we cannot represent an array of variant elements
+ using the current type structure in GDB. When fixing an array,
+ we cannot fix the array element, as we would potentially need one
+ fixed type per element of the array. As a result, the best we can do
+ when fixing an array is to produce an array whose bounds and size
+ are correct (allowing us to read it from memory), but without having
+ touched its element type. Fixing each element will be done later,
+ when (if) necessary.
+
+ Arrays are a little simpler to handle than records, because the same
+ amount of memory is allocated for each element of the array, even if
+ the amount of space actually used by each element differs from element
+ to element. Consider for instance the following array of type Rec:
+
+ type Rec_Array is array (1 .. 2) of Rec;
+
+ The actual amount of memory occupied by each element might be different
+ from element to element, depending on the value of their discriminant.
+ But the amount of space reserved for each element in the array remains
+ fixed regardless. So we simply need to compute that size using
+ the debugging information available, from which we can then determine
+ the array size (we multiply the number of elements of the array by
+ the size of each element).
+
+ 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);
+
+ In this case, the compiler describes the array as an array of
+ variable-size elements (identified by its XVS suffix) for which
+ the size can be read in the parallel XVZ variable.
+
+ In the case of an array of an unconstrained element type, the compiler
+ wraps the array element inside a private PAD type. This type should not
+ be shown to the user, and must be "unwrap"'ed before printing. Note
+ that we also use the adjective "aligner" in our code to designate
+ these wrapper types.
+
+ In some cases, the size allocated for each element is statically
+ known. In that case, the PAD type already has the correct size,
+ and the array element should remain unfixed.
+
+ 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;
+
+ Hello : Wrapper_Array := (others => (Has_Length => True,
+ Data => (others => 17),
+ Length => 1));
+
+
+ The debugging info would describe variable Hello as being an
+ array of a PAD type. The size of that PAD type is not statically
+ known, but can be determined using a parallel XVZ variable.
+ In that case, a copy of the PAD type with the correct size should
+ be used for the fixed array.
+
+ 3. ``Fixing'' record type objects:
+ ----------------------------------
+
+ Things are slightly different from arrays in the case of dynamic
+ record types. In this case, in order to compute the associated
+ fixed type, we need to determine the size and offset of each of
+ its components. This, in turn, requires us to compute the fixed
+ type of each of these components.
+
+ 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);
+
+ 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
+ discriminant. In order to fix the type of variable My_String,
+ we need to fix the type of field Str. Therefore, fixing a variant
+ record requires us to fix each of its components.
+
+ However, if a component does not have a dynamic size, the component
+ should not be fixed. In particular, fields that use a PAD type
+ should not fixed. Here is an example where this might happen
+ (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;
+ end record;
+ My_Container : Container := (Big => False,
+ 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
+ right after it. The offset of component After is therefore constant
+ in this case.
+
+ The debugger computes the position of each field based on an algorithm
+ that uses, among other things, the actual position and size of the field
+ preceding it. Let's now imagine that the user is trying to print
+ the value of My_Container. If the type fixing was recursive, we would
+ end up computing the offset of field After based on the size of the
+ fixed version of field First. And since in our example First has
+ only one actual field, the size of the fixed type is actually smaller
+ than the amount of space allocated to that field, and thus we would
+ compute the wrong offset of field After.
+
+ To make things more complicated, we need to watch out for dynamic
+ components of variant records (identified by the ___XVL suffix in
+ the component name). Even if the target type is a PAD type, the size
+ of that type might not be statically known. So the PAD type needs
+ to be unwrapped and the resulting type needs to be fixed. Otherwise,
+ 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_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.
+
+ 4. When to ``Fix'' un-``Fixed'' sub-elements of an entity:
+ ----------------------------------------------------------
+
+ Lastly, when should the sub-elements of an entity that remained unfixed
+ thus far, be actually fixed?
+
+ The answer is: Only when referencing that element. For instance
+ when selecting one component of a record, this specific component
+ should be fixed at that point in time. Or when printing the value
+ of a record, each component should be fixed before its value gets
+ printed. Similarly for arrays, the element of the array should be
+ fixed when printing each element of the array, or when extracting
+ one element out of that array. On the other hand, fixing should
+ not be performed on the elements when taking a slice of an array!
+
+ Note that one of the side-effects of miscomputing the offset and
+ size of each field is that we end up also miscomputing the size
+ of the containing type. This can have adverse results when computing
+ the value of an entity. GDB fetches the value of an entity based
+ on the size of its type, and thus a wrong size causes GDB to fetch
+ the wrong amount of memory. In the case where the computed size is
+ too small, GDB fetches too little data to print the value of our
+ entiry. Results in this case as unpredicatble, as we usually read
+ past the buffer containing the data =:-o. */
+
+/* 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)
case BINOP_MUL:
case BINOP_DIV:
+ case BINOP_REM:
+ case BINOP_MOD:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS
- && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
- return value_zero (value_type (arg1), not_lval);
+ 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;
return ada_value_binop (arg1, arg2, op);
}
- case BINOP_REM:
- case BINOP_MOD:
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS
- && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
- 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);
- }
-
case BINOP_EQUAL:
case BINOP_NOTEQUAL:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
type = static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
- if (ada_is_tagged_type (type, 0))
+ /* 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) == TYPE_CODE_REF
+ && ada_is_tagged_type (TYPE_TARGET_TYPE (type), 0)))
{
/* Tagged types are a little special in the fact that the real
type is dynamic and can only be determined by inspecting the
a fixed type would result in the loss of that type name,
thus preventing us from printing the name of the ancestor
type in the type description. */
+ struct type *actual_type;
+
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
- return value_zero (type_from_tag (ada_value_tag (arg1)), not_lval);
+ actual_type = type_from_tag (ada_value_tag (arg1));
+ if (actual_type == NULL)
+ /* If, for some reason, we were unable to determine
+ the actual type from the tag, then use the static
+ approximation that we just computed as a fallback.
+ This can happen if the debugging information is
+ incomplete, for instance. */
+ actual_type = type;
+
+ return value_zero (actual_type, not_lval);
}
*pos += 4;
}
else
{
- arg1 =
- unwrap_value (evaluate_subexp_standard
- (expect_type, exp, pos, noside));
+ arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
+ arg1 = unwrap_value (arg1);
return ada_to_fixed_value (arg1);
}
goto nosideret;
}
- if (ada_is_packed_array_type (desc_base_type (value_type (argvec[0]))))
+ if (ada_is_constrained_packed_array_type
+ (desc_base_type (value_type (argvec[0]))))
argvec[0] = ada_coerce_to_simple_array (argvec[0]);
+ else if (TYPE_CODE (value_type (argvec[0])) == TYPE_CODE_ARRAY
+ && 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 (TYPE_CODE (value_type (argvec[0])) == TYPE_CODE_REF
|| (TYPE_CODE (value_type (argvec[0])) == TYPE_CODE_ARRAY
&& VALUE_LVAL (argvec[0]) == lval_memory))
TYPE_TARGET_TYPE (value_type (array)) =
ada_aligned_type (TYPE_TARGET_TYPE (value_type (array)));
- if (ada_is_packed_array_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,
case UNOP_IN_RANGE:
(*pos) += 2;
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- type = exp->elts[pc + 1].type;
+ type = check_typedef (exp->elts[pc + 1].type);
if (noside == EVAL_SKIP)
goto nosideret;
tem = longest_to_int (exp->elts[pc + 1].longconst);
- if (tem < 1 || tem > ada_array_arity (value_type (arg2)))
- error (_("invalid dimension number to 'range"));
+ type = ada_index_type (value_type (arg2), tem, "range");
+ if (!type)
+ type = value_type (arg1);
- arg3 = ada_array_bound (arg2, tem, 1);
- arg2 = ada_array_bound (arg2, tem, 0);
+ 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);
{
evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
arg1 = NULL;
- type_arg = exp->elts[pc + 2].type;
+ type_arg = check_typedef (exp->elts[pc + 2].type);
}
else
{
{
arg1 = ada_coerce_ref (arg1);
- if (ada_is_packed_array_type (value_type (arg1)))
+ if (ada_is_constrained_packed_array_type (value_type (arg1)))
arg1 = ada_coerce_to_simple_array (arg1);
- if (tem < 1 || tem > ada_array_arity (value_type (arg1)))
- error (_("invalid dimension number to '%s"),
- ada_attribute_name (op));
+ type = ada_index_type (value_type (arg1), tem,
+ ada_attribute_name (op));
+ if (type == NULL)
+ type = builtin_type (exp->gdbarch)->builtin_int;
if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- type = ada_index_type (value_type (arg1), tem);
- if (type == NULL)
- error
- (_("attempt to take bound of something that is not an array"));
- return allocate_value (type);
- }
+ return allocate_value (type);
switch (op)
{
default: /* Should never happen. */
error (_("unexpected attribute encountered"));
case OP_ATR_FIRST:
- return ada_array_bound (arg1, tem, 0);
+ return value_from_longest
+ (type, ada_array_bound (arg1, tem, 0));
case OP_ATR_LAST:
- return ada_array_bound (arg1, tem, 1);
+ return value_from_longest
+ (type, ada_array_bound (arg1, tem, 1));
case OP_ATR_LENGTH:
- return ada_array_length (arg1, tem);
+ return value_from_longest
+ (type, ada_array_length (arg1, tem));
}
}
else if (discrete_type_p (type_arg))
char *name = ada_type_name (type_arg);
range_type = NULL;
if (name != NULL && TYPE_CODE (type_arg) != TYPE_CODE_ENUM)
- range_type =
- to_fixed_range_type (name, NULL, TYPE_OBJFILE (type_arg));
+ range_type = to_fixed_range_type (name, NULL, type_arg);
if (range_type == NULL)
range_type = type_arg;
switch (op)
error (_("unexpected attribute encountered"));
case OP_ATR_FIRST:
return value_from_longest
- (range_type, discrete_type_low_bound (range_type));
+ (range_type, ada_discrete_type_low_bound (range_type));
case OP_ATR_LAST:
return value_from_longest
- (range_type, discrete_type_high_bound (range_type));
+ (range_type, ada_discrete_type_high_bound (range_type));
case OP_ATR_LENGTH:
error (_("the 'length attribute applies only to array types"));
}
{
LONGEST low, high;
- if (ada_is_packed_array_type (type_arg))
- type_arg = decode_packed_array_type (type_arg);
+ if (ada_is_constrained_packed_array_type (type_arg))
+ type_arg = decode_constrained_packed_array_type (type_arg);
- if (tem < 1 || tem > ada_array_arity (type_arg))
- error (_("invalid dimension number to '%s"),
- ada_attribute_name (op));
-
- type = ada_index_type (type_arg, tem);
+ type = ada_index_type (type_arg, tem, ada_attribute_name (op));
if (type == NULL)
- error
- (_("attempt to take bound of something that is not an array"));
+ type = builtin_type (exp->gdbarch)->builtin_int;
+
if (noside == EVAL_AVOID_SIDE_EFFECTS)
return allocate_value (type);
default:
error (_("unexpected attribute encountered"));
case OP_ATR_FIRST:
- low = ada_array_bound_from_type (type_arg, tem, 0, &type);
+ 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, &type);
+ 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, &type);
- high = ada_array_bound_from_type (type_arg, tem, 1, NULL);
+ low = ada_array_bound_from_type (type_arg, tem, 0);
+ high = ada_array_bound_from_type (type_arg, tem, 1);
return value_from_longest (type, high - low + 1);
}
}
case OP_ATR_MODULUS:
{
- struct type *type_arg = exp->elts[pc + 2].type;
+ struct type *type_arg = check_typedef (exp->elts[pc + 2].type);
evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
if (noside == EVAL_SKIP)
if (noside == EVAL_SKIP)
goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (builtin_type_int32, not_lval);
+ return value_zero (builtin_type (exp->gdbarch)->builtin_int, not_lval);
else
- return value_from_longest (builtin_type_int32,
+ return value_from_longest (builtin_type (exp->gdbarch)->builtin_int,
TARGET_CHAR_BIT * TYPE_LENGTH (type));
case OP_ATR_VAL:
in some extension of the type. Return an object of
"type" void, which will match any formal
(see ada_type_match). */
- return value_zero (builtin_type_void, lval_memory);
+ return value_zero (builtin_type (exp->gdbarch)->builtin_void,
+ lval_memory);
}
else
type =
return value_zero (ada_aligned_type (type), lval_memory);
}
else
- return
- ada_to_fixed_value (unwrap_value
- (ada_value_struct_elt
- (arg1, &exp->elts[pc + 2].string, 0)));
+ arg1 = ada_value_struct_elt (arg1, &exp->elts[pc + 2].string, 0);
+ arg1 = unwrap_value (arg1);
+ return ada_to_fixed_value (arg1);
+
case OP_TYPE:
/* The value is not supposed to be used. This is here to make it
easier to accommodate expressions that contain types. */
}
nosideret:
- return value_from_longest (builtin_type_int8, (LONGEST) 1);
+ return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
}
\f
ada_delta (struct type *type)
{
const char *encoding = fixed_type_info (type);
- long num, den;
+ DOUBLEST num, den;
- if (sscanf (encoding, "_%ld_%ld", &num, &den) < 2)
+ /* Strictly speaking, num and den are encoded as integer. However,
+ they may not fit into a long, and they will have to be converted
+ to DOUBLEST anyway. So scan them as DOUBLEST. */
+ if (sscanf (encoding, "_%" DOUBLEST_SCAN_FORMAT "_%" DOUBLEST_SCAN_FORMAT,
+ &num, &den) < 2)
return -1.0;
else
- return (DOUBLEST) num / (DOUBLEST) den;
+ return num / den;
}
/* Assuming that ada_is_fixed_point_type (TYPE), return the scaling
scaling_factor (struct type *type)
{
const char *encoding = fixed_type_info (type);
- unsigned long num0, den0, num1, den1;
+ DOUBLEST num0, den0, num1, den1;
int n;
- n = sscanf (encoding, "_%lu_%lu_%lu_%lu", &num0, &den0, &num1, &den1);
+ /* Strictly speaking, num's and den's are encoded as integer. However,
+ they may not fit into a long, and they will have to be converted
+ to DOUBLEST anyway. So scan them as DOUBLEST. */
+ n = sscanf (encoding,
+ "_%" DOUBLEST_SCAN_FORMAT "_%" DOUBLEST_SCAN_FORMAT
+ "_%" DOUBLEST_SCAN_FORMAT "_%" DOUBLEST_SCAN_FORMAT,
+ &num0, &den0, &num1, &den1);
if (n < 2)
return 1.0;
else if (n == 4)
- return (DOUBLEST) num1 / (DOUBLEST) den1;
+ return num1 / den1;
else
- return (DOUBLEST) num0 / (DOUBLEST) den0;
+ return num0 / den0;
}
return (LONGEST) (x / scaling_factor (type) + 0.5);
}
-
- /* VAX floating formats */
-
-/* Non-zero iff TYPE represents one of the special VAX floating-point
- types. */
-
-int
-ada_is_vax_floating_type (struct type *type)
-{
- int name_len =
- (ada_type_name (type) == NULL) ? 0 : strlen (ada_type_name (type));
- return
- name_len > 6
- && (TYPE_CODE (type) == TYPE_CODE_INT
- || TYPE_CODE (type) == TYPE_CODE_RANGE)
- && strncmp (ada_type_name (type) + name_len - 6, "___XF", 5) == 0;
-}
-
-/* The type of special VAX floating-point type this is, assuming
- ada_is_vax_floating_point. */
-
-int
-ada_vax_float_type_suffix (struct type *type)
-{
- return ada_type_name (type)[strlen (ada_type_name (type)) - 1];
-}
-
-/* A value representing the special debugging function that outputs
- VAX floating-point values of the type represented by TYPE. Assumes
- ada_is_vax_floating_type (TYPE). */
-
-struct value *
-ada_vax_float_print_function (struct type *type)
-{
- switch (ada_vax_float_type_suffix (type))
- {
- case 'F':
- return get_var_value ("DEBUG_STRING_F", 0);
- case 'D':
- return get_var_value ("DEBUG_STRING_D", 0);
- case 'G':
- return get_var_value ("DEBUG_STRING_G", 0);
- default:
- error (_("invalid VAX floating-point type"));
- }
-}
\f
/* Range types */
/* Return a range type whose base type is that of the range type named
NAME in the current environment, and whose bounds are calculated
from NAME according to the GNAT range encoding conventions.
- Extract discriminant values, if needed, from DVAL. If a new type
- must be created, allocate in OBJFILE's space. The bounds
- information, in general, is encoded in NAME, the base type given in
- the named range type. */
+ Extract discriminant values, if needed, from DVAL. ORIG_TYPE is the
+ corresponding range type from debug information; fall back to using it
+ if symbol lookup fails. If a new type must be created, allocate it
+ like ORIG_TYPE was. The bounds information, in general, is encoded
+ in NAME, the base type given in the named range type. */
static struct type *
-to_fixed_range_type (char *name, struct value *dval, struct objfile *objfile)
+to_fixed_range_type (char *name, struct value *dval, struct type *orig_type)
{
struct type *raw_type = ada_find_any_type (name);
struct type *base_type;
char *subtype_info;
+ /* Fall back to the original type if symbol lookup failed. */
if (raw_type == NULL)
- base_type = builtin_type_int32;
- else if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
+ raw_type = orig_type;
+
+ if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
base_type = TYPE_TARGET_TYPE (raw_type);
else
base_type = raw_type;
subtype_info = strstr (name, "___XD");
if (subtype_info == NULL)
{
- LONGEST L = discrete_type_low_bound (raw_type);
- LONGEST U = discrete_type_high_bound (raw_type);
+ LONGEST L = ada_discrete_type_low_bound (raw_type);
+ LONGEST U = ada_discrete_type_high_bound (raw_type);
if (L < INT_MIN || U > INT_MAX)
return raw_type;
else
- return create_range_type (alloc_type (objfile), raw_type,
- discrete_type_low_bound (raw_type),
- discrete_type_high_bound (raw_type));
+ return create_range_type (alloc_type_copy (orig_type), raw_type,
+ ada_discrete_type_low_bound (raw_type),
+ ada_discrete_type_high_bound (raw_type));
}
else
{
}
}
- if (objfile == NULL)
- objfile = TYPE_OBJFILE (base_type);
- type = create_range_type (alloc_type (objfile), base_type, L, U);
+ type = create_range_type (alloc_type_copy (orig_type), base_type, L, U);
TYPE_NAME (type) = name;
return type;
}
&& TYPE_UNSIGNED (subranged_type));
}
+/* Try to determine the lower and upper bounds of the given modular type
+ using the type name only. Return non-zero and set L and U as the lower
+ and upper bounds (respectively) if successful. */
+
+int
+ada_modulus_from_name (struct type *type, ULONGEST *modulus)
+{
+ char *name = ada_type_name (type);
+ char *suffix;
+ int k;
+ LONGEST U;
+
+ if (name == NULL)
+ return 0;
+
+ /* Discrete type bounds are encoded using an __XD suffix. In our case,
+ we are looking for static bounds, which means an __XDLU suffix.
+ Moreover, we know that the lower bound of modular types is always
+ zero, so the actual suffix should start with "__XDLU_0__", and
+ then be followed by the upper bound value. */
+ suffix = strstr (name, "__XDLU_0__");
+ if (suffix == NULL)
+ return 0;
+ k = 10;
+ if (!ada_scan_number (suffix, k, &U, NULL))
+ return 0;
+
+ *modulus = (ULONGEST) U + 1;
+ return 1;
+}
+
/* Assuming ada_is_modular_type (TYPE), the modulus of TYPE. */
ULONGEST
-ada_modulus (struct type * type)
+ada_modulus (struct type *type)
{
- return (ULONGEST) (unsigned int) TYPE_HIGH_BOUND (type) + 1;
+ return (ULONGEST) TYPE_HIGH_BOUND (type) + 1;
}
\f
started yet. Inform the user of these two possible causes if
applicable. */
- if (ada_update_initial_language (language_unknown, NULL) != language_ada)
+ if (ada_update_initial_language (language_unknown) != language_ada)
error (_("Unable to insert catchpoint. Is this an Ada main program?"));
/* If the symbol does not exist, then check that the program is
exception_info = NULL;
}
-/* Return the name of the function at PC, NULL if could not find it.
- This function only checks the debugging information, not the symbol
- table. */
-
-static char *
-function_name_from_pc (CORE_ADDR pc)
-{
- char *func_name;
-
- if (!find_pc_partial_function (pc, &func_name, NULL, NULL))
- return NULL;
-
- return func_name;
-}
-
/* True iff FRAME is very likely to be that of a function that is
part of the runtime system. This is all very heuristic, but is
intended to be used as advice as to what frames are uninteresting
{
struct symtab_and_line sal;
char *func_name;
+ enum language func_lang;
int i;
/* If this code does not have any debugging information (no symtab),
/* Check whether the function is a GNAT-generated entity. */
- func_name = function_name_from_pc (get_frame_address_in_block (frame));
+ find_frame_funname (frame, &func_name, &func_lang);
if (func_name == NULL)
return 1;
while (fi != NULL)
{
- const char *func_name =
- function_name_from_pc (get_frame_address_in_block (fi));
+ char *func_name;
+ enum language func_lang;
+
+ find_frame_funname (fi, &func_name, &func_lang);
if (func_name != NULL
&& strcmp (func_name, exception_info->catch_exception_sym) == 0)
break; /* We found the frame we were looking for... */
static void
print_one_exception (enum exception_catchpoint_kind ex,
- struct breakpoint *b, CORE_ADDR *last_addr)
+ struct breakpoint *b, struct bp_location **last_loc)
{
struct value_print_options opts;
if (opts.addressprint)
{
annotate_field (4);
- ui_out_field_core_addr (uiout, "addr", b->loc->address);
+ ui_out_field_core_addr (uiout, "addr", b->loc->gdbarch, b->loc->address);
}
annotate_field (5);
- *last_addr = b->loc->address;
+ *last_loc = b->loc;
switch (ex)
{
case ex_catch_exception:
}
}
+/* Implement the PRINT_RECREATE method in the breakpoint_ops structure
+ for all exception catchpoint kinds. */
+
+static void
+print_recreate_exception (enum exception_catchpoint_kind ex,
+ struct breakpoint *b, struct ui_file *fp)
+{
+ switch (ex)
+ {
+ case ex_catch_exception:
+ fprintf_filtered (fp, "catch exception");
+ if (b->exp_string != NULL)
+ fprintf_filtered (fp, " %s", b->exp_string);
+ break;
+
+ case ex_catch_exception_unhandled:
+ fprintf_filtered (fp, "catch unhandled");
+ break;
+
+ case ex_catch_assert:
+ fprintf_filtered (fp, "catch assert");
+ break;
+
+ default:
+ internal_error (__FILE__, __LINE__, _("unexpected catchpoint type"));
+ }
+}
+
/* Virtual table for "catch exception" breakpoints. */
static enum print_stop_action
}
static void
-print_one_catch_exception (struct breakpoint *b, CORE_ADDR *last_addr)
+print_one_catch_exception (struct breakpoint *b, struct bp_location **last_loc)
{
- print_one_exception (ex_catch_exception, b, last_addr);
+ print_one_exception (ex_catch_exception, b, last_loc);
}
static void
print_mention_exception (ex_catch_exception, b);
}
+static void
+print_recreate_catch_exception (struct breakpoint *b, struct ui_file *fp)
+{
+ print_recreate_exception (ex_catch_exception, b, fp);
+}
+
static struct breakpoint_ops catch_exception_breakpoint_ops =
{
NULL, /* insert */
NULL, /* breakpoint_hit */
print_it_catch_exception,
print_one_catch_exception,
- print_mention_catch_exception
+ print_mention_catch_exception,
+ print_recreate_catch_exception
};
/* Virtual table for "catch exception unhandled" breakpoints. */
}
static void
-print_one_catch_exception_unhandled (struct breakpoint *b, CORE_ADDR *last_addr)
+print_one_catch_exception_unhandled (struct breakpoint *b,
+ struct bp_location **last_loc)
{
- print_one_exception (ex_catch_exception_unhandled, b, last_addr);
+ print_one_exception (ex_catch_exception_unhandled, b, last_loc);
}
static void
print_mention_exception (ex_catch_exception_unhandled, b);
}
+static void
+print_recreate_catch_exception_unhandled (struct breakpoint *b,
+ struct ui_file *fp)
+{
+ print_recreate_exception (ex_catch_exception_unhandled, b, fp);
+}
+
static struct breakpoint_ops catch_exception_unhandled_breakpoint_ops = {
NULL, /* insert */
NULL, /* remove */
NULL, /* breakpoint_hit */
print_it_catch_exception_unhandled,
print_one_catch_exception_unhandled,
- print_mention_catch_exception_unhandled
+ print_mention_catch_exception_unhandled,
+ print_recreate_catch_exception_unhandled
};
/* Virtual table for "catch assert" breakpoints. */
}
static void
-print_one_catch_assert (struct breakpoint *b, CORE_ADDR *last_addr)
+print_one_catch_assert (struct breakpoint *b, struct bp_location **last_loc)
{
- print_one_exception (ex_catch_assert, b, last_addr);
+ print_one_exception (ex_catch_assert, b, last_loc);
}
static void
print_mention_exception (ex_catch_assert, b);
}
+static void
+print_recreate_catch_assert (struct breakpoint *b, struct ui_file *fp)
+{
+ print_recreate_exception (ex_catch_assert, b, fp);
+}
+
static struct breakpoint_ops catch_assert_breakpoint_ops = {
NULL, /* insert */
NULL, /* remove */
NULL, /* breakpoint_hit */
print_it_catch_assert,
print_one_catch_assert,
- print_mention_catch_assert
+ print_mention_catch_assert,
+ print_recreate_catch_assert
};
/* Return non-zero if B is an Ada exception catchpoint. */
lai->primitive_type_vector
= GDBARCH_OBSTACK_CALLOC (gdbarch, nr_ada_primitive_types + 1,
struct type *);
- lai->primitive_type_vector [ada_primitive_type_int] =
- init_type (TYPE_CODE_INT,
- gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
- 0, "integer", (struct objfile *) NULL);
- lai->primitive_type_vector [ada_primitive_type_long] =
- init_type (TYPE_CODE_INT,
- gdbarch_long_bit (gdbarch) / TARGET_CHAR_BIT,
- 0, "long_integer", (struct objfile *) NULL);
- lai->primitive_type_vector [ada_primitive_type_short] =
- init_type (TYPE_CODE_INT,
- gdbarch_short_bit (gdbarch) / TARGET_CHAR_BIT,
- 0, "short_integer", (struct objfile *) NULL);
- lai->string_char_type =
- lai->primitive_type_vector [ada_primitive_type_char] =
- init_type (TYPE_CODE_INT, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
- 0, "character", (struct objfile *) NULL);
- lai->primitive_type_vector [ada_primitive_type_float] =
- init_type (TYPE_CODE_FLT,
- gdbarch_float_bit (gdbarch)/ TARGET_CHAR_BIT,
- 0, "float", (struct objfile *) NULL);
- lai->primitive_type_vector [ada_primitive_type_double] =
- init_type (TYPE_CODE_FLT,
- gdbarch_double_bit (gdbarch) / TARGET_CHAR_BIT,
- 0, "long_float", (struct objfile *) NULL);
- lai->primitive_type_vector [ada_primitive_type_long_long] =
- init_type (TYPE_CODE_INT,
- gdbarch_long_long_bit (gdbarch) / TARGET_CHAR_BIT,
- 0, "long_long_integer", (struct objfile *) NULL);
- lai->primitive_type_vector [ada_primitive_type_long_double] =
- init_type (TYPE_CODE_FLT,
- gdbarch_double_bit (gdbarch) / TARGET_CHAR_BIT,
- 0, "long_long_float", (struct objfile *) NULL);
- lai->primitive_type_vector [ada_primitive_type_natural] =
- init_type (TYPE_CODE_INT,
- gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
- 0, "natural", (struct objfile *) NULL);
- lai->primitive_type_vector [ada_primitive_type_positive] =
- init_type (TYPE_CODE_INT,
- gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
- 0, "positive", (struct objfile *) NULL);
- lai->primitive_type_vector [ada_primitive_type_void] = builtin->builtin_void;
-
- lai->primitive_type_vector [ada_primitive_type_system_address] =
- lookup_pointer_type (init_type (TYPE_CODE_VOID, 1, 0, "void",
- (struct objfile *) NULL));
+
+ 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_integer_type (gdbarch, TARGET_CHAR_BIT, 0, "character");
+ lai->primitive_type_vector [ada_primitive_type_float]
+ = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
+ "float", NULL);
+ lai->primitive_type_vector [ada_primitive_type_double]
+ = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
+ "long_float", NULL);
+ 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_double_bit (gdbarch),
+ "long_long_float", NULL);
+ lai->primitive_type_vector [ada_primitive_type_natural]
+ = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+ 0, "natural");
+ lai->primitive_type_vector [ada_primitive_type_positive]
+ = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+ 0, "positive");
+ lai->primitive_type_vector [ada_primitive_type_void]
+ = builtin->builtin_void;
+
+ lai->primitive_type_vector [ada_primitive_type_system_address]
+ = lookup_pointer_type (arch_type (gdbarch, TYPE_CODE_VOID, 1, "void"));
TYPE_NAME (lai->primitive_type_vector [ada_primitive_type_system_address])
= "system__address";
- lai->bool_type_symbol = "boolean";
+ lai->bool_type_symbol = NULL;
lai->bool_type_default = builtin->builtin_bool;
}
\f
/* Not really used, but needed in the ada_language_defn. */
static void
-emit_char (int c, struct ui_file *stream, int quoter)
+emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
{
- ada_emit_char (c, stream, quoter, 1);
+ ada_emit_char (c, type, stream, quoter, 1);
}
static int
ada_language_arch_info,
ada_print_array_index,
default_pass_by_reference,
+ c_get_string,
LANG_MAGIC
};
+/* Provide a prototype to silence -Wmissing-prototypes. */
+extern initialize_file_ftype _initialize_ada_language;
+
+/* Command-list for the "set/show ada" prefix command. */
+static struct cmd_list_element *set_ada_list;
+static struct cmd_list_element *show_ada_list;
+
+/* Implement the "set ada" prefix command. */
+
+static void
+set_ada_command (char *arg, int from_tty)
+{
+ printf_unfiltered (_(\
+"\"set ada\" must be followed by the name of a setting.\n"));
+ help_list (set_ada_list, "set ada ", -1, gdb_stdout);
+}
+
+/* Implement the "show ada" prefix command. */
+
+static void
+show_ada_command (char *args, int from_tty)
+{
+ cmd_show_list (show_ada_list, from_tty, "");
+}
+
void
_initialize_ada_language (void)
{
add_language (&ada_language_defn);
+ add_prefix_cmd ("ada", no_class, set_ada_command,
+ _("Prefix command for changing Ada-specfic settings"),
+ &set_ada_list, "set ada ", 0, &setlist);
+
+ add_prefix_cmd ("ada", no_class, show_ada_command,
+ _("Generic command for showing Ada-specific settings."),
+ &show_ada_list, "show ada ", 0, &showlist);
+
+ add_setshow_boolean_cmd ("trust-PAD-over-XVS", class_obscure,
+ &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\
+to be incorrect. Turning this setting \"off\" allows the debugger to\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);
+
varsize_limit = 65536;
obstack_init (&symbol_list_obstack);