#include "source.h"
#include "observer.h"
#include "vec.h"
+#include "stack.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 (struct type *, char *, LONGEST, int, int);
static struct type *desc_base_type (struct type *);
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 *,
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. */
}
/* 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."));
}
}
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)
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));
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)),
ada_array_bound_from_type (struct type * arr_type, int n, int which)
{
struct type *type, *elt_type, *index_type_desc, *index_type;
- LONGEST retval;
int i;
gdb_assert (which == 0 || which == 1);
else
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"));
- }
-
- 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
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. */
}
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;
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. */
-
-static 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
|| 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. */
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
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"));
}
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 */
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_copy (orig_type), raw_type,
- discrete_type_low_bound (raw_type),
- discrete_type_high_bound (raw_type));
+ ada_discrete_type_low_bound (raw_type),
+ ada_discrete_type_high_bound (raw_type));
}
else
{
ULONGEST
ada_modulus (struct type *type)
{
- ULONGEST modulus;
-
- /* Normally, the modulus of a modular type is equal to the value of
- its upper bound + 1. However, the upper bound is currently stored
- as an int, which is not always big enough to hold the actual bound
- value. To workaround this, try to take advantage of the encoding
- that GNAT uses with with discrete types. To avoid some unnecessary
- parsing, we do this only when the size of TYPE is greater than
- the size of the field holding the bound. */
- if (TYPE_LENGTH (type) > sizeof (TYPE_HIGH_BOUND (type))
- && ada_modulus_from_name (type, &modulus))
- return modulus;
-
- return (ULONGEST) (unsigned int) TYPE_HIGH_BOUND (type) + 1;
+ return (ULONGEST) TYPE_HIGH_BOUND (type) + 1;
}
\f
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... */
/* 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);
projects / deliverable / binutils-gdb.git / blobdiff