/* Ada language support routines for GDB, the GNU debugger.
- Copyright (C) 1992-1994, 1997-2000, 2003-2005, 2007-2012 Free
- Software Foundation, Inc.
+ Copyright (C) 1992-2013 Free Software Foundation, Inc.
This file is part of GDB.
#include "vec.h"
#include "stack.h"
#include "gdb_vecs.h"
+#include "typeprint.h"
#include "psymtab.h"
#include "value.h"
struct type *);
static void replace_operator_with_call (struct expression **, int, int, int,
- struct symbol *, struct block *);
+ struct symbol *, const struct block *);
static int possible_user_operator_p (enum exp_opcode, struct value **);
const char **);
static struct symbol *find_old_style_renaming_symbol (const char *,
- struct block *);
+ const struct block *);
static struct type *ada_lookup_struct_elt_type (struct type *, char *,
int, int, int *);
set_value_bitsize (result, value_bitsize (val));
set_value_bitpos (result, value_bitpos (val));
set_value_address (result, value_address (val));
+ set_value_optimized_out (result, value_optimized_out (val));
return result;
}
}
(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 = syms[i].sym->symtab;
+ struct symtab *symtab = SYMBOL_SYMTAB (syms[i].sym);
if (SYMBOL_LINE (syms[i].sym) != 0 && symtab != NULL)
printf_unfiltered (_("[%d] %s at %s:%d\n"),
{
printf_unfiltered (("[%d] "), i + first_choice);
ada_print_type (SYMBOL_TYPE (syms[i].sym), NULL,
- gdb_stdout, -1, 0);
+ gdb_stdout, -1, 0, &type_print_raw_options);
printf_unfiltered (_("'(%s) (enumeral)\n"),
SYMBOL_PRINT_NAME (syms[i].sym));
}
static void
replace_operator_with_call (struct expression **expp, int pc, int nargs,
int oplen, struct symbol *sym,
- struct block *block)
+ const struct block *block)
{
/* A new expression, with 6 more elements (3 for funcall, 4 for function
symbol, -oplen for operator being replaced). */
static void
cache_symbol (const char *name, domain_enum namespace, struct symbol *sym,
- struct block *block)
+ const struct block *block)
{
}
\f
for (i = 0; i < nsyms; i += 1)
{
struct symbol *sym = syms[i].sym;
- struct block *block = syms[i].block;
+ const struct block *block = syms[i].block;
const char *name;
const char *suffix;
the entire command on which completion is made. */
static VEC (char_ptr) *
-ada_make_symbol_completion_list (char *text0, char *word)
+ada_make_symbol_completion_list (char *text0, char *word, enum type_code code)
{
char *text;
int text_len;
int i;
struct block_iterator iter;
+ gdb_assert (code == TYPE_CODE_UNDEF);
+
if (text0[0] == '<')
{
text = xstrdup (text0);
return (strcmp (name, "ada__tags__dispatch_table") == 0);
}
+/* Return non-zero if TYPE is an interface tag. */
+
+static int
+ada_is_interface_tag (struct type *type)
+{
+ const char *name = TYPE_NAME (type);
+
+ if (name == NULL)
+ return 0;
+
+ return (strcmp (name, "ada__tags__interface_tag") == 0);
+}
+
/* True if field number FIELD_NUM in struct or union type TYPE is supposed
to be invisible to users. */
return 1;
}
- /* If this is the dispatch table of a tagged type, then ignore. */
+ /* If this is the dispatch table of a tagged type or an interface tag,
+ then ignore. */
if (ada_is_tagged_type (type, 1)
- && ada_is_dispatch_table_ptr_type (TYPE_FIELD_TYPE (type, field_num)))
+ && (ada_is_dispatch_table_ptr_type (TYPE_FIELD_TYPE (type, field_num))
+ || ada_is_interface_tag (TYPE_FIELD_TYPE (type, field_num))))
return 1;
/* Not a special field, so it should not be ignored. */
return ada_lookup_struct_elt_type (value_type (val), "_tag", 1, 0, NULL);
}
+/* Return 1 if TAG follows the old scheme for Ada tags (used for Ada 95,
+ retired at Ada 05). */
+
+static int
+is_ada95_tag (struct value *tag)
+{
+ return ada_value_struct_elt (tag, "tsd", 1) != NULL;
+}
+
/* The value of the tag on VAL. */
struct value *
return NULL;
}
+/* Given a value OBJ of a tagged type, return a value of this
+ type at the base address of the object. The base address, as
+ defined in Ada.Tags, it is the address of the primary tag of
+ the object, and therefore where the field values of its full
+ view can be fetched. */
+
+struct value *
+ada_tag_value_at_base_address (struct value *obj)
+{
+ volatile struct gdb_exception e;
+ struct value *val;
+ LONGEST offset_to_top = 0;
+ struct type *ptr_type, *obj_type;
+ struct value *tag;
+ CORE_ADDR base_address;
+
+ obj_type = value_type (obj);
+
+ /* It is the responsability of the caller to deref pointers. */
+
+ if (TYPE_CODE (obj_type) == TYPE_CODE_PTR
+ || TYPE_CODE (obj_type) == TYPE_CODE_REF)
+ return obj;
+
+ tag = ada_value_tag (obj);
+ if (!tag)
+ return obj;
+
+ /* Base addresses only appeared with Ada 05 and multiple inheritance. */
+
+ if (is_ada95_tag (tag))
+ return obj;
+
+ ptr_type = builtin_type (target_gdbarch ())->builtin_data_ptr;
+ ptr_type = lookup_pointer_type (ptr_type);
+ val = value_cast (ptr_type, tag);
+ if (!val)
+ return obj;
+
+ /* It is perfectly possible that an exception be raised while
+ trying to determine the base address, just like for the tag;
+ see ada_tag_name for more details. We do not print the error
+ message for the same reason. */
+
+ TRY_CATCH (e, RETURN_MASK_ERROR)
+ {
+ offset_to_top = value_as_long (value_ind (value_ptradd (val, -2)));
+ }
+
+ if (e.reason < 0)
+ return obj;
+
+ /* If offset is null, nothing to do. */
+
+ if (offset_to_top == 0)
+ return obj;
+
+ /* -1 is a special case in Ada.Tags; however, what should be done
+ is not quite clear from the documentation. So do nothing for
+ now. */
+
+ if (offset_to_top == -1)
+ return obj;
+
+ base_address = value_address (obj) - offset_to_top;
+ tag = value_tag_from_contents_and_address (obj_type, NULL, base_address);
+
+ /* Make sure that we have a proper tag at the new address.
+ Otherwise, offset_to_top is bogus (which can happen when
+ the object is not initialized yet). */
+
+ if (!tag)
+ return obj;
+
+ obj_type = type_from_tag (tag);
+
+ if (!obj_type)
+ return obj;
+
+ return value_from_contents_and_address (obj_type, NULL, base_address);
+}
+
/* Return the "ada__tags__type_specific_data" type. */
static struct type *
CORE_ADDR address;
if (TYPE_CODE (t) == TYPE_CODE_PTR)
- address = value_as_address (arg);
+ address = value_address (ada_value_ind (arg));
else
- address = unpack_pointer (t, value_contents (arg));
+ address = value_address (ada_coerce_ref (arg));
t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL, address, NULL, 1);
if (find_struct_field (name, t1, 0,
{
struct value *val = value_ind (val0);
+ if (ada_is_tagged_type (value_type (val), 0))
+ val = ada_tag_value_at_base_address (val);
+
return ada_to_fixed_value (val);
}
struct value *val = val0;
val = coerce_ref (val);
+
+ if (ada_is_tagged_type (value_type (val), 0))
+ val = ada_tag_value_at_base_address (val);
+
return ada_to_fixed_value (val);
}
else
Return symbol if found, and NULL otherwise. */
struct symbol *
-ada_find_renaming_symbol (struct symbol *name_sym, struct block *block)
+ada_find_renaming_symbol (struct symbol *name_sym, const struct block *block)
{
const char *name = SYMBOL_LINKAGE_NAME (name_sym);
struct symbol *sym;
}
static struct symbol *
-find_old_style_renaming_symbol (const char *name, struct block *block)
+find_old_style_renaming_symbol (const char *name, const struct block *block)
{
const struct symbol *function_sym = block_linkage_function (block);
char *rename;
}
else
{
- struct type *field_type = TYPE_FIELD_TYPE (type, f);
-
- /* If our field is a typedef type (most likely a typedef of
- a fat pointer, encoding an array access), then we need to
- look at its target type to determine its characteristics.
- In particular, we would miscompute the field size if we took
- the size of the typedef (zero), instead of the size of
- the target type. */
- if (TYPE_CODE (field_type) == TYPE_CODE_TYPEDEF)
- field_type = ada_typedef_target_type (field_type);
-
- TYPE_FIELD_TYPE (rtype, f) = field_type;
+ /* Note: If this field's type is a typedef, it is important
+ to preserve the typedef layer.
+
+ Otherwise, we might be transforming a typedef to a fat
+ pointer (encoding a pointer to an unconstrained array),
+ into a basic fat pointer (encoding an unconstrained
+ array). As both types are implemented using the same
+ structure, the typedef is the only clue which allows us
+ to distinguish between the two options. Stripping it
+ would prevent us from printing this field appropriately. */
+ TYPE_FIELD_TYPE (rtype, f) = TYPE_FIELD_TYPE (type, f);
TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
if (TYPE_FIELD_BITSIZE (type, f) > 0)
fld_bit_len =
TYPE_FIELD_BITSIZE (rtype, f) = TYPE_FIELD_BITSIZE (type, f);
else
- fld_bit_len =
- TYPE_LENGTH (ada_check_typedef (field_type)) * TARGET_CHAR_BIT;
+ {
+ struct type *field_type = TYPE_FIELD_TYPE (type, f);
+
+ /* We need to be careful of typedefs when computing
+ the length of our field. If this is a typedef,
+ get the length of the target type, not the length
+ of the typedef. */
+ if (TYPE_CODE (field_type) == TYPE_CODE_TYPEDEF)
+ field_type = ada_typedef_target_type (field_type);
+
+ fld_bit_len =
+ TYPE_LENGTH (ada_check_typedef (field_type)) * TARGET_CHAR_BIT;
+ }
}
if (off + fld_bit_len > bit_len)
bit_len = off + fld_bit_len;
if (check_tag && address != 0 && ada_is_tagged_type (static_type, 0))
{
- struct type *real_type =
- type_from_tag (value_tag_from_contents_and_address
- (fixed_record_type,
- valaddr,
- address));
-
+ struct value *tag =
+ value_tag_from_contents_and_address
+ (fixed_record_type,
+ valaddr,
+ address);
+ struct type *real_type = type_from_tag (tag);
+ struct value *obj =
+ value_from_contents_and_address (fixed_record_type,
+ valaddr,
+ address);
if (real_type != NULL)
- return to_fixed_record_type (real_type, valaddr, address, NULL);
+ return to_fixed_record_type
+ (real_type, NULL,
+ value_address (ada_tag_value_at_base_address (obj)), NULL);
}
/* Check to see if there is a parallel ___XVZ variable.
return value_from_double (type, val);
}
+/* Given two array types T1 and T2, return nonzero iff both arrays
+ contain the same number of elements. */
+
+static int
+ada_same_array_size_p (struct type *t1, struct type *t2)
+{
+ LONGEST lo1, hi1, lo2, hi2;
+
+ /* Get the array bounds in order to verify that the size of
+ the two arrays match. */
+ if (!get_array_bounds (t1, &lo1, &hi1)
+ || !get_array_bounds (t2, &lo2, &hi2))
+ error (_("unable to determine array bounds"));
+
+ /* To make things easier for size comparison, normalize a bit
+ the case of empty arrays by making sure that the difference
+ between upper bound and lower bound is always -1. */
+ if (lo1 > hi1)
+ hi1 = lo1 - 1;
+ if (lo2 > hi2)
+ hi2 = lo2 - 1;
+
+ return (hi1 - lo1 == hi2 - lo2);
+}
+
+/* Assuming that VAL is an array of integrals, and TYPE represents
+ an array with the same number of elements, but with wider integral
+ elements, return an array "casted" to TYPE. In practice, this
+ means that the returned array is built by casting each element
+ of the original array into TYPE's (wider) element type. */
+
+static struct value *
+ada_promote_array_of_integrals (struct type *type, struct value *val)
+{
+ struct type *elt_type = TYPE_TARGET_TYPE (type);
+ LONGEST lo, hi;
+ struct value *res;
+ LONGEST i;
+
+ /* Verify that both val and type are arrays of scalars, and
+ that the size of val's elements is smaller than the size
+ of type's element. */
+ gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY);
+ gdb_assert (is_integral_type (TYPE_TARGET_TYPE (type)));
+ gdb_assert (TYPE_CODE (value_type (val)) == TYPE_CODE_ARRAY);
+ gdb_assert (is_integral_type (TYPE_TARGET_TYPE (value_type (val))));
+ gdb_assert (TYPE_LENGTH (TYPE_TARGET_TYPE (type))
+ > TYPE_LENGTH (TYPE_TARGET_TYPE (value_type (val))));
+
+ if (!get_array_bounds (type, &lo, &hi))
+ error (_("unable to determine array bounds"));
+
+ res = allocate_value (type);
+
+ /* Promote each array element. */
+ for (i = 0; i < hi - lo + 1; i++)
+ {
+ struct value *elt = value_cast (elt_type, value_subscript (val, lo + i));
+
+ memcpy (value_contents_writeable (res) + (i * TYPE_LENGTH (elt_type)),
+ value_contents_all (elt), TYPE_LENGTH (elt_type));
+ }
+
+ return res;
+}
+
/* Coerce VAL as necessary for assignment to an lval of type TYPE, and
return the converted value. */
if (TYPE_CODE (type2) == TYPE_CODE_ARRAY
&& TYPE_CODE (type) == TYPE_CODE_ARRAY)
{
- if (TYPE_LENGTH (type2) != TYPE_LENGTH (type)
- || TYPE_LENGTH (TYPE_TARGET_TYPE (type2))
- != TYPE_LENGTH (TYPE_TARGET_TYPE (type2)))
+ if (!ada_same_array_size_p (type, type2))
+ error (_("cannot assign arrays of different length"));
+
+ if (is_integral_type (TYPE_TARGET_TYPE (type))
+ && is_integral_type (TYPE_TARGET_TYPE (type2))
+ && TYPE_LENGTH (TYPE_TARGET_TYPE (type2))
+ < TYPE_LENGTH (TYPE_TARGET_TYPE (type)))
+ {
+ /* Allow implicit promotion of the array elements to
+ a wider type. */
+ return ada_promote_array_of_integrals (type, val);
+ }
+
+ if (TYPE_LENGTH (TYPE_TARGET_TYPE (type2))
+ != TYPE_LENGTH (TYPE_TARGET_TYPE (type)))
error (_("Incompatible types in assignment"));
deprecated_set_value_type (val, type);
}
default:
*pos -= 1;
arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
- arg1 = unwrap_value (arg1);
+
+ if (noside == EVAL_NORMAL)
+ arg1 = unwrap_value (arg1);
/* If evaluating an OP_DOUBLE and an EXPECT_TYPE was provided,
then we need to perform the conversion manually, because
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);
- 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);
+
+ if (TYPE_CODE (type) != TYPE_CODE_REF)
+ {
+ struct type *actual_type;
+
+ 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);
+ }
+ else
+ {
+ /* In the case of a ref, ada_coerce_ref takes care
+ of determining the actual type. But the evaluation
+ should return a ref as it should be valid to ask
+ for its address; so rebuild a ref after coerce. */
+ arg1 = ada_coerce_ref (arg1);
+ return value_ref (arg1);
+ }
}
*pos += 4;
const char *func_name;
enum language func_lang;
int i;
+ const char *fullname;
/* If this code does not have any debugging information (no symtab),
This cannot be any user code. */
for the user. This should also take care of case such as VxWorks
where the kernel has some debugging info provided for a few units. */
- if (symtab_to_fullname (sal.symtab) == NULL)
+ fullname = symtab_to_fullname (sal.symtab);
+ if (access (fullname, R_OK) != 0)
return 1;
/* Check the unit filename againt the Ada runtime file naming.
for (i = 0; known_runtime_file_name_patterns[i] != NULL; i += 1)
{
re_comp (known_runtime_file_name_patterns[i]);
- if (re_exec (sal.symtab->filename))
+ if (re_exec (lbasename (sal.symtab->filename)))
return 1;
if (sal.symtab->objfile != NULL
&& re_exec (sal.symtab->objfile->name))
static void
re_set_catch_assert (struct breakpoint *b)
{
- return re_set_exception (ex_catch_assert, b);
+ re_set_exception (ex_catch_assert, b);
}
static void
if (exp->elts[*pos].opcode == OP_TYPE)
{
if (TYPE_CODE (exp->elts[*pos + 1].type) != TYPE_CODE_VOID)
- LA_PRINT_TYPE (exp->elts[*pos + 1].type, "", stream, 0, 0);
+ LA_PRINT_TYPE (exp->elts[*pos + 1].type, "", stream, 0, 0,
+ &type_print_raw_options);
*pos += 3;
}
else
/* XXX: sprint_subexp */
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered (" in ", stream);
- LA_PRINT_TYPE (exp->elts[pc + 1].type, "", stream, 1, 0);
+ LA_PRINT_TYPE (exp->elts[pc + 1].type, "", stream, 1, 0,
+ &type_print_raw_options);
return;
case OP_DISCRETE_RANGE:
projects / deliverable / binutils-gdb.git / blobdiff