X-Git-Url: http://git.efficios.com/?a=blobdiff_plain;ds=sidebyside;f=gdb%2Fada-lang.c;h=656e771e9b54c59e9311f8b800609b5153531025;hb=457395c3504d0f35f0365e9176597c1aec091f94;hp=844b25d9f421d8f77e3c0336c515147848bd0591;hpb=6d84d3d833b29bb5adc88f462fa5ec9c65f5b143;p=deliverable%2Fbinutils-gdb.git diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index 844b25d9f4..656e771e9b 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -57,10 +57,6 @@ #include "observer.h" #include "vec.h" -#ifndef ADA_RETAIN_DOTS -#define ADA_RETAIN_DOTS 0 -#endif - /* Define whether or not the C operator '/' truncates towards zero for differently signed operands (truncation direction is undefined in C). Copied from valarith.c. */ @@ -206,8 +202,6 @@ static int equiv_types (struct type *, struct type *); static int is_name_suffix (const char *); -static int is_digits_suffix (const char *str); - static int wild_match (const char *, int, const char *); static struct value *ada_coerce_ref (struct value *); @@ -359,9 +353,9 @@ ada_get_gdb_completer_word_break_characters (void) static void ada_print_array_index (struct value *index_value, struct ui_file *stream, - int format, enum val_prettyprint pretty) + const struct value_print_options *options) { - LA_VALUE_PRINT (index_value, stream, format, pretty); + LA_VALUE_PRINT (index_value, stream, options); fprintf_filtered (stream, " => "); } @@ -471,26 +465,6 @@ is_suffix (const char *str, const char *suffix) return (len1 >= len2 && strcmp (str + len1 - len2, suffix) == 0); } -/* Create a value of type TYPE whose contents come from VALADDR, if it - is non-null, and whose memory address (in the inferior) is - ADDRESS. */ - -struct value * -value_from_contents_and_address (struct type *type, - const gdb_byte *valaddr, - CORE_ADDR address) -{ - struct value *v = allocate_value (type); - if (valaddr == NULL) - set_value_lazy (v, 1); - else - memcpy (value_contents_raw (v), valaddr, TYPE_LENGTH (type)); - VALUE_ADDRESS (v) = address; - if (address != 0) - VALUE_LVAL (v) = lval_memory; - return v; -} - /* The contents of value VAL, treated as a value of type TYPE. The result is an lval in memory if VAL is. */ @@ -509,10 +483,10 @@ coerce_unspec_val_to_type (struct value *val, struct type *type) check_size (type); result = allocate_value (type); - VALUE_LVAL (result) = VALUE_LVAL (val); + set_value_component_location (result, val); set_value_bitsize (result, value_bitsize (val)); set_value_bitpos (result, value_bitpos (val)); - VALUE_ADDRESS (result) = VALUE_ADDRESS (val) + value_offset (val); + VALUE_ADDRESS (result) += value_offset (val); if (value_lazy (val) || TYPE_LENGTH (type) > TYPE_LENGTH (value_type (val))) set_value_lazy (result, 1); @@ -814,7 +788,7 @@ ada_encode (const char *decoded) k = 0; for (p = decoded; *p != '\0'; p += 1) { - if (!ADA_RETAIN_DOTS && *p == '.') + if (*p == '.') { encoding_buffer[k] = encoding_buffer[k + 1] = '_'; k += 2; @@ -1136,8 +1110,7 @@ ada_decode (const char *encoded) if (i < len0) goto Suppress; } - else if (!ADA_RETAIN_DOTS - && i < len0 - 2 && encoded[i] == '_' && encoded[i + 1] == '_') + else if (i < len0 - 2 && encoded[i] == '_' && encoded[i + 1] == '_') { /* Replace '__' by '.'. */ decoded[j] = '.'; @@ -1804,11 +1777,11 @@ packed_array_type (struct type *type, long *elt_bits) new_type = alloc_type (TYPE_OBJFILE (type)); new_elt_type = packed_array_type (ada_check_typedef (TYPE_TARGET_TYPE (type)), elt_bits); - create_array_type (new_type, new_elt_type, TYPE_FIELD_TYPE (type, 0)); + 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); - if (get_discrete_bounds (TYPE_FIELD_TYPE (type, 0), + if (get_discrete_bounds (TYPE_INDEX_TYPE (type), &low_bound, &high_bound) < 0) low_bound = high_bound = 0; if (high_bound < low_bound) @@ -2045,10 +2018,8 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr, if (obj != NULL) { - VALUE_LVAL (v) = VALUE_LVAL (obj); - if (VALUE_LVAL (obj) == lval_internalvar) - VALUE_LVAL (v) = lval_internalvar_component; - VALUE_ADDRESS (v) = VALUE_ADDRESS (obj) + value_offset (obj) + offset; + set_value_component_location (v, obj); + VALUE_ADDRESS (v) += value_offset (obj) + offset; set_value_bitpos (v, bit_offset + value_bitpos (obj)); set_value_bitsize (v, bit_size); if (value_bitpos (v) >= HOST_CHAR_BIT) @@ -2373,12 +2344,12 @@ ada_value_ptr_subscript (struct value *arr, struct type *type, int arity, } /* Given that ARRAY_PTR is a pointer or reference to an array of type TYPE (the - actual type of ARRAY_PTR is ignored), returns a reference to - the Ada slice of HIGH-LOW+1 elements starting at index LOW. The lower - bound of this array is LOW, as per Ada rules. */ + actual type of ARRAY_PTR is ignored), returns the Ada slice of HIGH-LOW+1 + elements starting at index LOW. The lower bound of this array is LOW, as + per Ada rules. */ static struct value * -ada_value_slice_ptr (struct value *array_ptr, struct type *type, - int low, int high) +ada_value_slice_from_ptr (struct value *array_ptr, struct type *type, + int low, int high) { CORE_ADDR base = value_as_address (array_ptr) + ((low - TYPE_LOW_BOUND (TYPE_INDEX_TYPE (type))) @@ -2388,7 +2359,7 @@ ada_value_slice_ptr (struct value *array_ptr, struct type *type, low, high); struct type *slice_type = create_array_type (NULL, TYPE_TARGET_TYPE (type), index_type); - return value_from_pointer (lookup_reference_type (slice_type), base); + return value_at_lazy (slice_type, base); } @@ -2495,7 +2466,7 @@ ada_index_type (struct type *type, int n) for (i = 1; i < n; i += 1) type = TYPE_TARGET_TYPE (type); - result_type = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0)); + result_type = TYPE_TARGET_TYPE (TYPE_INDEX_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. */ @@ -2519,8 +2490,10 @@ static LONGEST ada_array_bound_from_type (struct type * arr_type, int n, int which, struct type ** typep) { - struct type *type; - struct type *index_type_desc; + struct type *type, *index_type_desc, *index_type; + LONGEST retval; + + gdb_assert (which == 0 || which == 1); if (ada_is_packed_array_type (arr_type)) arr_type = decode_packed_array_type (arr_type); @@ -2538,10 +2511,11 @@ ada_array_bound_from_type (struct type * arr_type, int n, int which, type = arr_type; index_type_desc = ada_find_parallel_type (type, "___XA"); - if (index_type_desc == NULL) + if (index_type_desc != NULL) + index_type = to_fixed_range_type (TYPE_FIELD_NAME (index_type_desc, n - 1), + NULL, TYPE_OBJFILE (arr_type)); + else { - struct type *index_type; - while (n > 1) { type = TYPE_TARGET_TYPE (type); @@ -2549,34 +2523,27 @@ ada_array_bound_from_type (struct type * arr_type, int n, int which, } index_type = TYPE_INDEX_TYPE (type); - if (typep != NULL) - *typep = index_type; - - /* The index type is either a range type or an enumerated type. - For the range type, we have some macros that allow us to - extract the value of the low and high bounds. But they - do now work for enumerated types. The expressions used - below work for both range and enum types. */ - return - (LONGEST) (which == 0 - ? TYPE_FIELD_BITPOS (index_type, 0) - : TYPE_FIELD_BITPOS (index_type, - TYPE_NFIELDS (index_type) - 1)); } - else + + switch (TYPE_CODE (index_type)) { - struct type *index_type = - to_fixed_range_type (TYPE_FIELD_NAME (index_type_desc, n - 1), - NULL, TYPE_OBJFILE (arr_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; + if (typep != NULL) + *typep = index_type; - return - (LONGEST) (which == 0 - ? TYPE_LOW_BOUND (index_type) - : TYPE_HIGH_BOUND (index_type)); - } + return retval; } /* Given that arr is an array value, returns the lower bound of the @@ -4396,7 +4363,29 @@ remove_extra_symbols (struct ada_symbol_info *syms, int nsyms) i = 0; while (i < nsyms) { - if (SYMBOL_LINKAGE_NAME (syms[i].sym) != NULL + int remove = 0; + + /* If two symbols have the same name and one of them is a stub type, + the get rid of the stub. */ + + if (TYPE_STUB (SYMBOL_TYPE (syms[i].sym)) + && SYMBOL_LINKAGE_NAME (syms[i].sym) != NULL) + { + for (j = 0; j < nsyms; j++) + { + if (j != i + && !TYPE_STUB (SYMBOL_TYPE (syms[j].sym)) + && SYMBOL_LINKAGE_NAME (syms[j].sym) != NULL + && strcmp (SYMBOL_LINKAGE_NAME (syms[i].sym), + SYMBOL_LINKAGE_NAME (syms[j].sym)) == 0) + remove = 1; + } + } + + /* Two symbols with the same name, same class and same address + should be identical. */ + + else if (SYMBOL_LINKAGE_NAME (syms[i].sym) != NULL && SYMBOL_CLASS (syms[i].sym) == LOC_STATIC && is_nondebugging_type (SYMBOL_TYPE (syms[i].sym))) { @@ -4409,18 +4398,18 @@ remove_extra_symbols (struct ada_symbol_info *syms, int nsyms) && SYMBOL_CLASS (syms[i].sym) == SYMBOL_CLASS (syms[j].sym) && SYMBOL_VALUE_ADDRESS (syms[i].sym) == SYMBOL_VALUE_ADDRESS (syms[j].sym)) - { - int k; - for (k = i + 1; k < nsyms; k += 1) - syms[k - 1] = syms[k]; - nsyms -= 1; - goto NextSymbol; - } + remove = 1; } } + + if (remove) + { + for (j = i + 1; j < nsyms; j += 1) + syms[j - 1] = syms[j]; + nsyms -= 1; + } + i += 1; - NextSymbol: - ; } return nsyms; } @@ -4650,6 +4639,70 @@ remove_irrelevant_renamings (struct ada_symbol_info *syms, return nsyms; } +/* Add to OBSTACKP all symbols from BLOCK (and its super-blocks) + whose name and domain match NAME and DOMAIN respectively. + If no match was found, then extend the search to "enclosing" + routines (in other words, if we're inside a nested function, + search the symbols defined inside the enclosing functions). + + Note: This function assumes that OBSTACKP has 0 (zero) element in it. */ + +static void +ada_add_local_symbols (struct obstack *obstackp, const char *name, + struct block *block, domain_enum domain, + int wild_match) +{ + int block_depth = 0; + + while (block != NULL) + { + block_depth += 1; + ada_add_block_symbols (obstackp, block, name, domain, NULL, wild_match); + + /* If we found a non-function match, assume that's the one. */ + if (is_nonfunction (defns_collected (obstackp, 0), + num_defns_collected (obstackp))) + return; + + block = BLOCK_SUPERBLOCK (block); + } + + /* If no luck so far, try to find NAME as a local symbol in some lexically + enclosing subprogram. */ + if (num_defns_collected (obstackp) == 0 && block_depth > 2) + add_symbols_from_enclosing_procs (obstackp, name, domain, 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) +{ + struct objfile *objfile; + struct partial_symtab *ps; + + 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; + + if (s == NULL || !s->primary) + continue; + ada_add_block_symbols (obstackp, + BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), block_kind), + name, domain, objfile, wild_match); + } + } +} + /* Find symbols in DOMAIN matching NAME0, in BLOCK0 and enclosing scope and in global scopes, returning the number of matches. Sets *RESULTS to point to a vector of (SYM,BLOCK) tuples, @@ -4670,16 +4723,10 @@ ada_lookup_symbol_list (const char *name0, const struct block *block0, struct ada_symbol_info **results) { struct symbol *sym; - struct symtab *s; - struct partial_symtab *ps; - struct blockvector *bv; - struct objfile *objfile; struct block *block; const char *name; - struct minimal_symbol *msymbol; int wild_match; int cacheIfUnique; - int block_depth; int ndefns; obstack_free (&symbol_list_obstack, NULL); @@ -4694,6 +4741,14 @@ ada_lookup_symbol_list (const char *name0, const struct block *block0, block = (struct block *) block0; /* FIXME: No cast ought to be needed, but adding const will have a cascade effect. */ + + /* Special case: If the user specifies a symbol name inside package + Standard, do a non-wild matching of the symbol name without + the "standard__" prefix. This was primarily introduced in order + to allow the user to specifically access the standard exceptions + using, for instance, Standard.Constraint_Error when Constraint_Error + is ambiguous (due to the user defining its own Constraint_Error + entity inside its program). */ if (strncmp (name0, "standard__", sizeof ("standard__") - 1) == 0) { wild_match = 0; @@ -4701,32 +4756,17 @@ ada_lookup_symbol_list (const char *name0, const struct block *block0, name = name0 + sizeof ("standard__") - 1; } - block_depth = 0; - while (block != NULL) - { - block_depth += 1; - ada_add_block_symbols (&symbol_list_obstack, block, name, - namespace, NULL, wild_match); - - /* If we found a non-function match, assume that's the one. */ - if (is_nonfunction (defns_collected (&symbol_list_obstack, 0), - num_defns_collected (&symbol_list_obstack))) - goto done; - - block = BLOCK_SUPERBLOCK (block); - } - - /* If no luck so far, try to find NAME as a local symbol in some lexically - enclosing subprogram. */ - if (num_defns_collected (&symbol_list_obstack) == 0 && block_depth > 2) - add_symbols_from_enclosing_procs (&symbol_list_obstack, - name, namespace, wild_match); - - /* If we found ANY matches among non-global symbols, we're done. */ + /* Check the non-global symbols. If we have ANY match, then we're done. */ + ada_add_local_symbols (&symbol_list_obstack, name, block, namespace, + wild_match); if (num_defns_collected (&symbol_list_obstack) > 0) goto done; + /* No non-global symbols found. Check our cache to see if we have + already performed this search before. If we have, then return + the same result. */ + cacheIfUnique = 1; if (lookup_cached_symbol (name0, namespace, &sym, &block)) { @@ -4735,114 +4775,17 @@ ada_lookup_symbol_list (const char *name0, const struct block *block0, goto done; } - /* Now add symbols from all global blocks: symbol tables, minimal symbol - tables, and psymtab's. */ - - ALL_PRIMARY_SYMTABS (objfile, s) - { - QUIT; - bv = BLOCKVECTOR (s); - block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK); - ada_add_block_symbols (&symbol_list_obstack, block, name, namespace, - objfile, wild_match); - } - - if (namespace == VAR_DOMAIN) - { - ALL_MSYMBOLS (objfile, msymbol) - { - if (ada_match_name (SYMBOL_LINKAGE_NAME (msymbol), name, wild_match)) - { - switch (MSYMBOL_TYPE (msymbol)) - { - case mst_solib_trampoline: - break; - default: - s = find_pc_symtab (SYMBOL_VALUE_ADDRESS (msymbol)); - if (s != NULL) - { - int ndefns0 = num_defns_collected (&symbol_list_obstack); - char *raw_name = SYMBOL_LINKAGE_NAME (msymbol); - char *name1; - const char *suffix; - QUIT; - suffix = strrchr (raw_name, '.'); - if (suffix == NULL) - suffix = strrchr (raw_name, '$'); - if (suffix != NULL && is_digits_suffix (suffix + 1)) - { - name1 = alloca (suffix - raw_name + 1); - strncpy (name1, raw_name, suffix - raw_name); - name1[suffix - raw_name] = '\0'; - } - else - name1 = raw_name; - - bv = BLOCKVECTOR (s); - block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK); - ada_add_block_symbols (&symbol_list_obstack, block, - name1, namespace, objfile, 0); - - if (num_defns_collected (&symbol_list_obstack) == ndefns0) - { - block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK); - ada_add_block_symbols (&symbol_list_obstack, block, - name1, namespace, objfile, 0); - } - } - } - } - } - } - - ALL_PSYMTABS (objfile, ps) - { - QUIT; - if (!ps->readin - && ada_lookup_partial_symbol (ps, name, 1, namespace, wild_match)) - { - s = PSYMTAB_TO_SYMTAB (ps); - if (!s->primary) - continue; - bv = BLOCKVECTOR (s); - block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK); - ada_add_block_symbols (&symbol_list_obstack, block, name, - namespace, objfile, wild_match); - } - } + /* Search symbols from all global blocks. */ + + ada_add_non_local_symbols (&symbol_list_obstack, name, namespace, 1, + wild_match); /* Now add symbols from all per-file blocks if we've gotten no hits - (Not strictly correct, but perhaps better than an error). - Do the symtabs first, then check the psymtabs. */ + (not strictly correct, but perhaps better than an error). */ if (num_defns_collected (&symbol_list_obstack) == 0) - { - - ALL_PRIMARY_SYMTABS (objfile, s) - { - QUIT; - bv = BLOCKVECTOR (s); - block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK); - ada_add_block_symbols (&symbol_list_obstack, block, name, namespace, - objfile, wild_match); - } - - ALL_PSYMTABS (objfile, ps) - { - QUIT; - if (!ps->readin - && ada_lookup_partial_symbol (ps, name, 0, namespace, wild_match)) - { - s = PSYMTAB_TO_SYMTAB (ps); - bv = BLOCKVECTOR (s); - if (!s->primary) - continue; - block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK); - ada_add_block_symbols (&symbol_list_obstack, block, name, - namespace, objfile, wild_match); - } - } - } + ada_add_non_local_symbols (&symbol_list_obstack, name, namespace, 0, + wild_match); done: ndefns = num_defns_collected (&symbol_list_obstack); @@ -5051,17 +4994,6 @@ is_name_suffix (const char *str) return 0; } -/* Return nonzero if the given string contains only digits. - The empty string also matches. */ - -static int -is_digits_suffix (const char *str) -{ - while (isdigit (str[0])) - str++; - return (str[0] == '\0'); -} - /* Return non-zero if the string starting at NAME and ending before NAME_END contains no capital letters. */ @@ -6240,9 +6172,7 @@ ada_index_struct_field_1 (int *index_p, struct value *arg, int offset, /* Given ARG, a value of type (pointer or reference to a)* structure/union, extract the component named NAME from the ultimate target structure/union and return it as a value with its - appropriate type. If ARG is a pointer or reference and the field - is not packed, returns a reference to the field, otherwise the - value of the field (an lvalue if ARG is an lvalue). + appropriate type. The routine searches for NAME among all members of the structure itself and (recursively) among all members of any wrapper members @@ -6319,8 +6249,7 @@ ada_value_struct_elt (struct value *arg, char *name, int no_err) field_type); } else - v = value_from_pointer (lookup_reference_type (field_type), - address + byte_offset); + v = value_at_lazy (field_type, address + byte_offset); } } @@ -6432,9 +6361,19 @@ ada_lookup_struct_elt_type (struct type *type, char *name, int refok, for (j = TYPE_NFIELDS (field_type) - 1; j >= 0; j -= 1) { + /* FIXME pnh 2008/01/26: We check for a field that is + NOT wrapped in a struct, since the compiler sometimes + generates these for unchecked variant types. Revisit + if the compiler changes this practice. */ + char *v_field_name = TYPE_FIELD_NAME (field_type, j); disp = 0; - t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (field_type, j), - name, 0, 1, &disp); + if (v_field_name != NULL + && field_name_match (v_field_name, name)) + t = ada_check_typedef (TYPE_FIELD_TYPE (field_type, j)); + else + t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (field_type, j), + name, 0, 1, &disp); + if (t != NULL) { if (dispp != NULL) @@ -6470,6 +6409,20 @@ BadName: return NULL; } +/* Assuming that VAR_TYPE is the type of a variant part of a record (a union), + within a value of type OUTER_TYPE, return true iff VAR_TYPE + represents an unchecked union (that is, the variant part of a + record that is named in an Unchecked_Union pragma). */ + +static int +is_unchecked_variant (struct type *var_type, struct type *outer_type) +{ + char *discrim_name = ada_variant_discrim_name (var_type); + return (ada_lookup_struct_elt_type (outer_type, discrim_name, 0, 1, NULL) + == NULL); +} + + /* Assuming that VAR_TYPE is the type of a variant part of a record (a union), within a value of type OUTER_TYPE that is stored in GDB at OUTER_VALADDR, determine which variant clause (field number in VAR_TYPE, @@ -6841,6 +6794,7 @@ empty_record (struct objfile *objfile) TYPE_CODE (type) = TYPE_CODE_STRUCT; TYPE_NFIELDS (type) = 0; TYPE_FIELDS (type) = NULL; + INIT_CPLUS_SPECIFIC (type); TYPE_NAME (type) = ""; TYPE_TAG_NAME (type) = NULL; TYPE_LENGTH (type) = 0; @@ -6962,7 +6916,7 @@ ada_template_to_fixed_record_type_1 (struct type *type, } /* We handle the variant part, if any, at the end because of certain - odd cases in which it is re-ordered so as NOT the last field of + odd cases in which it is re-ordered so as NOT to be the last field of the record. This can happen in the presence of representation clauses. */ if (variant_field >= 0) @@ -7209,7 +7163,8 @@ to_fixed_record_type (struct type *type0, const gdb_byte *valaddr, union type. Any necessary discriminants' values should be in DVAL, a record value. That is, this routine selects the appropriate branch of the union at ADDR according to the discriminant value - indicated in the union's type name. */ + indicated in the union's type name. Returns VAR_TYPE0 itself if + it represents a variant subject to a pragma Unchecked_Union. */ static struct type * to_fixed_variant_branch_type (struct type *var_type0, const gdb_byte *valaddr, @@ -7229,6 +7184,8 @@ to_fixed_variant_branch_type (struct type *var_type0, const gdb_byte *valaddr, if (templ_type != NULL) var_type = templ_type; + if (is_unchecked_variant (var_type, value_type (dval))) + return var_type0; which = ada_which_variant_applies (var_type, value_type (dval), value_contents (dval)); @@ -7371,6 +7328,46 @@ ada_to_fixed_type_1 (struct type *type, const gdb_byte *valaddr, if (real_type != NULL) return to_fixed_record_type (real_type, valaddr, address, NULL); } + + /* Check to see if there is a parallel ___XVZ variable. + If there is, then it provides the actual size of our type. */ + else if (ada_type_name (fixed_record_type) != NULL) + { + char *name = ada_type_name (fixed_record_type); + char *xvz_name = alloca (strlen (name) + 7 /* "___XVZ\0" */); + int xvz_found = 0; + LONGEST size; + + sprintf (xvz_name, "%s___XVZ", name); + size = get_int_var_value (xvz_name, &xvz_found); + if (xvz_found && TYPE_LENGTH (fixed_record_type) != size) + { + fixed_record_type = copy_type (fixed_record_type); + TYPE_LENGTH (fixed_record_type) = size; + + /* The FIXED_RECORD_TYPE may have be a stub. We have + observed this when the debugging info is STABS, and + apparently it is something that is hard to fix. + + In practice, we don't need the actual type definition + at all, because the presence of the XVZ variable allows us + to assume that there must be a XVS type as well, which we + should be able to use later, when we need the actual type + definition. + + In the meantime, pretend that the "fixed" type we are + returning is NOT a stub, because this can cause trouble + when using this type to create new types targeting it. + Indeed, the associated creation routines often check + whether the target type is a stub and will try to replace + it, thus using a type with the wrong size. This, in turn, + might cause the new type to have the wrong size too. + Consider the case of an array, for instance, where the size + of the array is computed from the number of elements in + our array multiplied by the size of its element. */ + TYPE_STUB (fixed_record_type) = 0; + } + } return fixed_record_type; } case TYPE_CODE_ARRAY: @@ -8802,9 +8799,9 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp, struct type *arr_type0 = to_fixed_array_type (TYPE_TARGET_TYPE (value_type (array)), NULL, 1); - return ada_value_slice_ptr (array, arr_type0, - longest_to_int (low_bound), - longest_to_int (high_bound)); + return ada_value_slice_from_ptr (array, arr_type0, + longest_to_int (low_bound), + longest_to_int (high_bound)); } } else if (noside == EVAL_AVOID_SIDE_EFFECTS) @@ -9070,14 +9067,21 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp, case OP_ATR_SIZE: arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); + type = value_type (arg1); + + /* If the argument is a reference, then dereference its type, since + the user is really asking for the size of the actual object, + not the size of the pointer. */ + if (TYPE_CODE (type) == TYPE_CODE_REF) + type = TYPE_TARGET_TYPE (type); + if (noside == EVAL_SKIP) goto nosideret; else if (noside == EVAL_AVOID_SIDE_EFFECTS) return value_zero (builtin_type_int32, not_lval); else return value_from_longest (builtin_type_int32, - TARGET_CHAR_BIT - * TYPE_LENGTH (value_type (arg1))); + TARGET_CHAR_BIT * TYPE_LENGTH (type)); case OP_ATR_VAL: evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP); @@ -9127,9 +9131,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp, return arg1; case UNOP_IND: - if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR) - expect_type = TYPE_TARGET_TYPE (ada_check_typedef (expect_type)); - arg1 = evaluate_subexp (expect_type, exp, pos, noside); + arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); if (noside == EVAL_SKIP) goto nosideret; type = ada_check_typedef (value_type (arg1)); @@ -9155,22 +9157,40 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp, return value_zero (type, lval_memory); } else if (TYPE_CODE (type) == TYPE_CODE_INT) - /* GDB allows dereferencing an int. */ - return value_zero (builtin_type (exp->gdbarch)->builtin_int, - lval_memory); + { + /* GDB allows dereferencing an int. */ + if (expect_type == NULL) + return value_zero (builtin_type (exp->gdbarch)->builtin_int, + lval_memory); + else + { + expect_type = + to_static_fixed_type (ada_aligned_type (expect_type)); + return value_zero (expect_type, lval_memory); + } + } else error (_("Attempt to take contents of a non-pointer value.")); } arg1 = ada_coerce_ref (arg1); /* FIXME: What is this for?? */ type = ada_check_typedef (value_type (arg1)); + if (TYPE_CODE (type) == TYPE_CODE_INT) + /* GDB allows dereferencing an int. If we were given + the expect_type, then use that as the target type. + Otherwise, assume that the target type is an int. */ + { + if (expect_type != NULL) + return ada_value_ind (value_cast (lookup_pointer_type (expect_type), + arg1)); + else + return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int, + (CORE_ADDR) value_as_address (arg1)); + } + if (ada_is_array_descriptor_type (type)) /* GDB allows dereferencing GNAT array descriptors. */ return ada_coerce_to_simple_array (arg1); - else if (TYPE_CODE (type) == TYPE_CODE_INT) - /* GDB allows dereferencing an int. */ - return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int, - (CORE_ADDR) value_as_address (arg1)); else return ada_value_ind (arg1); @@ -9617,7 +9637,7 @@ ada_is_modular_type (struct type *type) ULONGEST ada_modulus (struct type * type) { - return (ULONGEST) TYPE_HIGH_BOUND (type) + 1; + return (ULONGEST) (unsigned int) TYPE_HIGH_BOUND (type) + 1; } @@ -9669,6 +9689,15 @@ enum exception_catchpoint_kind ex_catch_assert }; +/* Ada's standard exceptions. */ + +static char *standard_exc[] = { + "constraint_error", + "program_error", + "storage_error", + "tasking_error" +}; + typedef CORE_ADDR (ada_unhandled_exception_name_addr_ftype) (void); /* A structure that describes how to support exception catchpoints @@ -9876,7 +9905,7 @@ is_known_support_routine (struct frame_info *frame) /* Find the first frame that contains debugging information and that is not part of the Ada run-time, starting from FI and moving upward. */ -static void +void ada_find_printable_frame (struct frame_info *fi) { for (; fi != NULL; fi = get_prev_frame (fi)) @@ -10048,7 +10077,10 @@ static void print_one_exception (enum exception_catchpoint_kind ex, struct breakpoint *b, CORE_ADDR *last_addr) { - if (addressprint) + struct value_print_options opts; + + get_user_print_options (&opts); + if (opts.addressprint) { annotate_field (4); ui_out_field_core_addr (uiout, "addr", b->loc->address); @@ -10140,6 +10172,9 @@ print_mention_catch_exception (struct breakpoint *b) static struct breakpoint_ops catch_exception_breakpoint_ops = { + NULL, /* insert */ + NULL, /* remove */ + NULL, /* breakpoint_hit */ print_it_catch_exception, print_one_catch_exception, print_mention_catch_exception @@ -10166,6 +10201,9 @@ print_mention_catch_exception_unhandled (struct breakpoint *b) } 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 @@ -10192,6 +10230,9 @@ print_mention_catch_assert (struct breakpoint *b) } 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 @@ -10353,6 +10394,35 @@ ada_exception_breakpoint_ops (enum exception_catchpoint_kind ex) static char * ada_exception_catchpoint_cond_string (const char *exp_string) { + int i; + + /* The standard exceptions are a special case. They are defined in + runtime units that have been compiled without debugging info; if + EXP_STRING is the not-fully-qualified name of a standard + exception (e.g. "constraint_error") then, during the evaluation + of the condition expression, the symbol lookup on this name would + *not* return this standard exception. The catchpoint condition + may then be set only on user-defined exceptions which have the + same not-fully-qualified name (e.g. my_package.constraint_error). + + To avoid this unexcepted behavior, these standard exceptions are + systematically prefixed by "standard". This means that "catch + exception constraint_error" is rewritten into "catch exception + standard.constraint_error". + + If an exception named contraint_error is defined in another package of + the inferior program, then the only way to specify this exception as a + breakpoint condition is to use its fully-qualified named: + e.g. my_package.constraint_error. */ + + for (i = 0; i < sizeof (standard_exc) / sizeof (char *); i++) + { + if (strcmp (standard_exc [i], exp_string) == 0) + { + return xstrprintf ("long_integer (e) = long_integer (&standard.%s)", + exp_string); + } + } return xstrprintf ("long_integer (e) = long_integer (&%s)", exp_string); } @@ -10959,6 +11029,7 @@ const struct language_defn ada_language_defn = { case_sensitive_on, /* Yes, Ada is case-insensitive, but that's not quite what this means. */ array_row_major, + macro_expansion_no, &ada_exp_descriptor, parse, ada_error, @@ -10967,6 +11038,7 @@ const struct language_defn ada_language_defn = { ada_printstr, /* Function to print string constant */ emit_char, /* Function to print single char (not used) */ ada_print_type, /* Print a type using appropriate syntax */ + default_print_typedef, /* Print a typedef using appropriate syntax */ ada_val_print, /* Print a value using appropriate syntax */ ada_value_print, /* Print a top-level value */ NULL, /* Language specific skip_trampoline */