X-Git-Url: http://git.efficios.com/?a=blobdiff_plain;ds=sidebyside;f=gdb%2Fada-lang.c;h=656e771e9b54c59e9311f8b800609b5153531025;hb=74bcbdf3cea56564d1f9f597c8458b86ed71f621;hp=7176561115de74004ca44658843e108d7e9d40b8;hpb=339c13b662e90ae3ba32ac076a8fd6dd4548d608;p=deliverable%2Fbinutils-gdb.git diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index 7176561115..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 @@ -5027,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. */ @@ -6216,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 @@ -6295,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); } } @@ -6408,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) @@ -6446,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, @@ -6817,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; @@ -6938,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) @@ -7185,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, @@ -7205,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)); @@ -7347,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: @@ -8778,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) @@ -9046,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); @@ -9103,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)); @@ -9131,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); @@ -9593,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; } @@ -9645,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 @@ -9852,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)) @@ -10024,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); @@ -10116,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 @@ -10142,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 @@ -10168,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 @@ -10329,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); } @@ -10935,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, @@ -10943,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 */