2009-01-13 Jim Blandy <jimb@codesourcery.com>
[deliverable/binutils-gdb.git] / gdb / ada-lang.c
index 7176561115de74004ca44658843e108d7e9d40b8..656e771e9b54c59e9311f8b800609b5153531025 100644 (file)
 #include "observer.h"
 #include "vec.h"
 
 #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.  */
 /* 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_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 *);
 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,
 
 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, " => ");
 }
 
   fprintf_filtered (stream, " => ");
 }
 
@@ -471,26 +465,6 @@ is_suffix (const char *str, const char *suffix)
   return (len1 >= len2 && strcmp (str + len1 - len2, suffix) == 0);
 }
 
   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.  */
 
 /* 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);
       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));
       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);
       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)
     {
   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;
         {
           encoding_buffer[k] = encoding_buffer[k + 1] = '_';
           k += 2;
@@ -1136,8 +1110,7 @@ ada_decode (const char *encoded)
           if (i < len0)
             goto Suppress;
         }
           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] = '.';
         {
          /* 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);
   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);
 
   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)
                            &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)
     {
 
   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)
       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
 }
 
 /* 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 *
 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)))
 {
   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);
                        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);
 
       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.  */
       /* 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)
 {
 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);
 
   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");
     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);
       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);
         }
 
       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
 }
 
 /* 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 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.  */
 
 /* 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
 /* 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
 
    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
                                                   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)
             {
 
           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;
               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)
               if (t != NULL)
                 {
                   if (dispp != NULL)
@@ -6446,6 +6409,20 @@ BadName:
   return NULL;
 }
 
   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,
 /* 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;
   TYPE_CODE (type) = TYPE_CODE_STRUCT;
   TYPE_NFIELDS (type) = 0;
   TYPE_FIELDS (type) = NULL;
+  INIT_CPLUS_SPECIFIC (type);
   TYPE_NAME (type) = "<empty>";
   TYPE_TAG_NAME (type) = NULL;
   TYPE_LENGTH (type) = 0;
   TYPE_NAME (type) = "<empty>";
   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
     }
 
   /* 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)
      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
    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,
 
 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 (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));
   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);
           }
             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:
         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);
                 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)
               }
           }
         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);
 
     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,
       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);
 
     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:
         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));
       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)
               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));
 
           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);
       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);
 
       else
         return ada_value_ind (arg1);
 
@@ -9593,7 +9637,7 @@ ada_is_modular_type (struct type *type)
 ULONGEST
 ada_modulus (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;
 }
 \f
 
 }
 \f
 
@@ -9645,6 +9689,15 @@ enum exception_catchpoint_kind
   ex_catch_assert
 };
 
   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
 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.  */
 
 /* 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))
 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)
 { 
 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);
     {
       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 =
 {
 
 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
   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 = {
 }
 
 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_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 = {
 }
 
 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_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)
 {
 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);
 }
 
   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,
   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,
   &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 */
   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 */
   ada_val_print,                /* Print a value using appropriate syntax */
   ada_value_print,              /* Print a top-level value */
   NULL,                         /* Language specific skip_trampoline */
This page took 0.048795 seconds and 4 git commands to generate.