* dwarf2read.c (struct attribute): Increase sizes of unsnd and snd
[deliverable/binutils-gdb.git] / gdb / ada-lang.c
index 7a49c453d9bae05b32a2dfc8e5d67bb16858521f..a80afa4d7365dcbcb9d6be646a0a9bed8e21cd55 100644 (file)
@@ -67,7 +67,7 @@
 
 static void extract_string (CORE_ADDR addr, char *buf);
 
-static void modify_general_field (char *, LONGEST, int, int);
+static void modify_general_field (struct type *, char *, LONGEST, int, int);
 
 static struct type *desc_base_type (struct type *);
 
@@ -101,13 +101,11 @@ static int ada_type_match (struct type *, struct type *, int);
 
 static int ada_args_match (struct symbol *, struct value **, int);
 
-static struct value *ensure_lval (struct value *, CORE_ADDR *);
-
-static struct value *convert_actual (struct value *, struct type *,
-                                     CORE_ADDR *);
+static struct value *ensure_lval (struct value *,
+                                 struct gdbarch *, CORE_ADDR *);
 
 static struct value *make_array_descriptor (struct type *, struct value *,
-                                            CORE_ADDR *);
+                                            struct gdbarch *, CORE_ADDR *);
 
 static void ada_add_block_symbols (struct obstack *,
                                    struct block *, const char *,
@@ -168,23 +166,29 @@ static struct type *to_fixed_variant_branch_type (struct type *,
 static struct type *to_fixed_array_type (struct type *, struct value *, int);
 
 static struct type *to_fixed_range_type (char *, struct value *,
-                                         struct objfile *);
+                                         struct type *);
 
 static struct type *to_static_fixed_type (struct type *);
 static struct type *static_unwrap_type (struct type *type);
 
 static struct value *unwrap_value (struct value *);
 
-static struct type *packed_array_type (struct type *, long *);
+static struct type *constrained_packed_array_type (struct type *, long *);
+
+static struct type *decode_constrained_packed_array_type (struct type *);
+
+static long decode_packed_array_bitsize (struct type *);
+
+static struct value *decode_constrained_packed_array (struct value *);
 
-static struct type *decode_packed_array_type (struct type *);
+static int ada_is_packed_array_type  (struct type *);
 
-static struct value *decode_packed_array (struct value *);
+static int ada_is_unconstrained_packed_array_type (struct type *);
 
 static struct value *value_subscript_packed (struct value *, int,
                                              struct value **);
 
-static void move_bits (gdb_byte *, int, const gdb_byte *, int, int);
+static void move_bits (gdb_byte *, int, const gdb_byte *, int, int, int);
 
 static struct value *coerce_unspec_val_to_type (struct value *,
                                                 struct type *);
@@ -593,8 +597,8 @@ min_of_type (struct type *t)
 }
 
 /* The largest value in the domain of TYPE, a discrete type, as an integer.  */
-static LONGEST
-discrete_type_high_bound (struct type *type)
+LONGEST
+ada_discrete_type_high_bound (struct type *type)
 {
   switch (TYPE_CODE (type))
     {
@@ -608,13 +612,13 @@ discrete_type_high_bound (struct type *type)
     case TYPE_CODE_INT:
       return max_of_type (type);
     default:
-      error (_("Unexpected type in discrete_type_high_bound."));
+      error (_("Unexpected type in ada_discrete_type_high_bound."));
     }
 }
 
 /* The largest value in the domain of TYPE, a discrete type, as an integer.  */
-static LONGEST
-discrete_type_low_bound (struct type *type)
+LONGEST
+ada_discrete_type_low_bound (struct type *type)
 {
   switch (TYPE_CODE (type))
     {
@@ -628,7 +632,7 @@ discrete_type_low_bound (struct type *type)
     case TYPE_CODE_INT:
       return min_of_type (type);
     default:
-      error (_("Unexpected type in discrete_type_low_bound."));
+      error (_("Unexpected type in ada_discrete_type_low_bound."));
     }
 }
 
@@ -872,6 +876,26 @@ ada_remove_po_subprogram_suffix (const char *encoded, int *len)
     *len = *len - 1;
 }
 
+/* Remove trailing X[bn]* suffixes (indicating names in package bodies).  */
+
+static void
+ada_remove_Xbn_suffix (const char *encoded, int *len)
+{
+  int i = *len - 1;
+
+  while (i > 0 && (encoded[i] == 'b' || encoded[i] == 'n'))
+    i--;
+
+  if (encoded[i] != 'X')
+    return;
+
+  if (i == 0)
+    return;
+
+  if (isalnum (encoded[i-1]))
+    *len = i;
+}
+
 /* If ENCODED follows the GNAT entity encoding conventions, then return
    the decoded form of ENCODED.  Otherwise, return "<%s>" where "%s" is
    replaced by ENCODED.
@@ -928,6 +952,13 @@ ada_decode (const char *encoded)
   if (len0 > 3 && strncmp (encoded + len0 - 3, "TKB", 3) == 0)
     len0 -= 3;
 
+  /* Remove any trailing TB suffix.  The TB suffix is slightly different
+     from the TKB suffix because it is used for non-anonymous task
+     bodies.  */
+
+  if (len0 > 2 && strncmp (encoded + len0 - 2, "TB", 2) == 0)
+    len0 -= 2;
+
   /* Remove trailing "B" suffixes.  */
   /* FIXME: brobecker/2006-04-19: Not sure what this are used for...  */
 
@@ -1216,9 +1247,10 @@ static char *bound_name[] = {
 /* Like modify_field, but allows bitpos > wordlength.  */
 
 static void
-modify_general_field (char *addr, LONGEST fieldval, int bitpos, int bitsize)
+modify_general_field (struct type *type, char *addr,
+                     LONGEST fieldval, int bitpos, int bitsize)
 {
-  modify_field (addr + bitpos / 8, fieldval, bitpos % 8, bitsize);
+  modify_field (type, addr + bitpos / 8, fieldval, bitpos % 8, bitsize);
 }
 
 
@@ -1596,21 +1628,28 @@ ada_is_bogus_array_descriptor (struct type *type)
 struct type *
 ada_type_of_array (struct value *arr, int bounds)
 {
-  if (ada_is_packed_array_type (value_type (arr)))
-    return decode_packed_array_type (value_type (arr));
+  if (ada_is_constrained_packed_array_type (value_type (arr)))
+    return decode_constrained_packed_array_type (value_type (arr));
 
   if (!ada_is_array_descriptor_type (value_type (arr)))
     return value_type (arr);
 
   if (!bounds)
-    return
-      ada_check_typedef (desc_data_target_type (value_type (arr)));
+    {
+      struct type *array_type =
+       ada_check_typedef (desc_data_target_type (value_type (arr)));
+
+      if (ada_is_unconstrained_packed_array_type (value_type (arr)))
+       TYPE_FIELD_BITSIZE (array_type, 0) =
+         decode_packed_array_bitsize (value_type (arr));
+      
+      return array_type;
+    }
   else
     {
       struct type *elt_type;
       int arity;
       struct value *descriptor;
-      struct objfile *objf = TYPE_OBJFILE (value_type (arr));
 
       elt_type = ada_array_element_type (value_type (arr), -1);
       arity = ada_array_arity (value_type (arr));
@@ -1623,8 +1662,8 @@ ada_type_of_array (struct value *arr, int bounds)
         return NULL;
       while (arity > 0)
         {
-          struct type *range_type = alloc_type (objf);
-          struct type *array_type = alloc_type (objf);
+          struct type *range_type = alloc_type_copy (value_type (arr));
+          struct type *array_type = alloc_type_copy (value_type (arr));
           struct value *low = desc_one_bound (descriptor, arity, 0);
           struct value *high = desc_one_bound (descriptor, arity, 1);
           arity -= 1;
@@ -1633,6 +1672,10 @@ ada_type_of_array (struct value *arr, int bounds)
                              longest_to_int (value_as_long (low)),
                              longest_to_int (value_as_long (high)));
           elt_type = create_array_type (array_type, elt_type, range_type);
+
+         if (ada_is_unconstrained_packed_array_type (value_type (arr)))
+           TYPE_FIELD_BITSIZE (elt_type, 0) =
+             decode_packed_array_bitsize (value_type (arr));
         }
 
       return lookup_pointer_type (elt_type);
@@ -1654,8 +1697,8 @@ ada_coerce_to_simple_array_ptr (struct value *arr)
         return NULL;
       return value_cast (arrType, value_copy (desc_data (arr)));
     }
-  else if (ada_is_packed_array_type (value_type (arr)))
-    return decode_packed_array (arr);
+  else if (ada_is_constrained_packed_array_type (value_type (arr)))
+    return decode_constrained_packed_array (arr);
   else
     return arr;
 }
@@ -1675,8 +1718,8 @@ ada_coerce_to_simple_array (struct value *arr)
       check_size (TYPE_TARGET_TYPE (value_type (arrVal)));
       return value_ind (arrVal);
     }
-  else if (ada_is_packed_array_type (value_type (arr)))
-    return decode_packed_array (arr);
+  else if (ada_is_constrained_packed_array_type (value_type (arr)))
+    return decode_constrained_packed_array (arr);
   else
     return arr;
 }
@@ -1688,8 +1731,8 @@ ada_coerce_to_simple_array (struct value *arr)
 struct type *
 ada_coerce_to_simple_array_type (struct type *type)
 {
-  if (ada_is_packed_array_type (type))
-    return decode_packed_array_type (type);
+  if (ada_is_constrained_packed_array_type (type))
+    return decode_constrained_packed_array_type (type);
 
   if (ada_is_array_descriptor_type (type))
     return ada_check_typedef (desc_data_target_type (type));
@@ -1699,8 +1742,8 @@ ada_coerce_to_simple_array_type (struct type *type)
 
 /* Non-zero iff TYPE represents a standard GNAT packed-array type.  */
 
-int
-ada_is_packed_array_type (struct type *type)
+static int
+ada_is_packed_array_type  (struct type *type)
 {
   if (type == NULL)
     return 0;
@@ -1711,6 +1754,54 @@ ada_is_packed_array_type (struct type *type)
     && strstr (ada_type_name (type), "___XP") != NULL;
 }
 
+/* Non-zero iff TYPE represents a standard GNAT constrained
+   packed-array type.  */
+
+int
+ada_is_constrained_packed_array_type (struct type *type)
+{
+  return ada_is_packed_array_type (type)
+    && !ada_is_array_descriptor_type (type);
+}
+
+/* Non-zero iff TYPE represents an array descriptor for a
+   unconstrained packed-array type.  */
+
+static int
+ada_is_unconstrained_packed_array_type (struct type *type)
+{
+  return ada_is_packed_array_type (type)
+    && ada_is_array_descriptor_type (type);
+}
+
+/* Given that TYPE encodes a packed array type (constrained or unconstrained),
+   return the size of its elements in bits.  */
+
+static long
+decode_packed_array_bitsize (struct type *type)
+{
+  char *raw_name = ada_type_name (ada_check_typedef (type));
+  char *tail;
+  long bits;
+
+  if (!raw_name)
+    raw_name = ada_type_name (desc_base_type (type));
+
+  if (!raw_name)
+    return 0;
+
+  tail = strstr (raw_name, "___XP");
+
+  if (sscanf (tail + sizeof ("___XP") - 1, "%ld", &bits) != 1)
+    {
+      lim_warning
+       (_("could not understand bit size information on packed array"));
+      return 0;
+    }
+
+  return bits;
+}
+
 /* Given that TYPE is a standard GDB array type with all bounds filled
    in, and that the element size of its ultimate scalar constituents
    (that is, either its elements, or, if it is an array of arrays, its
@@ -1721,7 +1812,7 @@ ada_is_packed_array_type (struct type *type)
    in bits.  */
 
 static struct type *
-packed_array_type (struct type *type, long *elt_bits)
+constrained_packed_array_type (struct type *type, long *elt_bits)
 {
   struct type *new_elt_type;
   struct type *new_type;
@@ -1731,9 +1822,10 @@ packed_array_type (struct type *type, long *elt_bits)
   if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
     return type;
 
-  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_copy (type);
+  new_elt_type =
+    constrained_packed_array_type (ada_check_typedef (TYPE_TARGET_TYPE (type)),
+                                  elt_bits);
   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);
@@ -1754,10 +1846,11 @@ packed_array_type (struct type *type, long *elt_bits)
   return new_type;
 }
 
-/* The array type encoded by TYPE, where ada_is_packed_array_type (TYPE).  */
+/* The array type encoded by TYPE, where
+   ada_is_constrained_packed_array_type (TYPE).  */
 
 static struct type *
-decode_packed_array_type (struct type *type)
+decode_constrained_packed_array_type (struct type *type)
 {
   struct symbol *sym;
   struct block **blocks;
@@ -1796,24 +1889,18 @@ decode_packed_array_type (struct type *type)
       return NULL;
     }
 
-  if (sscanf (tail + sizeof ("___XP") - 1, "%ld", &bits) != 1)
-    {
-      lim_warning
-       (_("could not understand bit size information on packed array"));
-      return NULL;
-    }
-
-  return packed_array_type (shadow_type, &bits);
+  bits = decode_packed_array_bitsize (type);
+  return constrained_packed_array_type (shadow_type, &bits);
 }
 
-/* Given that ARR is a struct value *indicating a GNAT packed array,
-   returns a simple array that denotes that array.  Its type is a
+/* Given that ARR is a struct value *indicating a GNAT constrained packed
+   array, returns a simple array that denotes that array.  Its type is a
    standard GDB array type except that the BITSIZEs of the array
    target types are set to the number of bits in each element, and the
    type length is set appropriately.  */
 
 static struct value *
-decode_packed_array (struct value *arr)
+decode_constrained_packed_array (struct value *arr)
 {
   struct type *type;
 
@@ -1828,14 +1915,14 @@ decode_packed_array (struct value *arr)
   if (TYPE_CODE (value_type (arr)) == TYPE_CODE_PTR)
     arr = value_ind (arr);
 
-  type = decode_packed_array_type (value_type (arr));
+  type = decode_constrained_packed_array_type (value_type (arr));
   if (type == NULL)
     {
       error (_("can't unpack array"));
       return NULL;
     }
 
-  if (gdbarch_bits_big_endian (current_gdbarch)
+  if (gdbarch_bits_big_endian (get_type_arch (value_type (arr)))
       && ada_is_modular_type (value_type (arr)))
     {
        /* This is a (right-justified) modular type representing a packed
@@ -1959,7 +2046,7 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
   int len = (bit_size + bit_offset + HOST_CHAR_BIT - 1) / 8;
   /* Transmit bytes from least to most significant; delta is the direction
      the indices move.  */
-  int delta = gdbarch_bits_big_endian (current_gdbarch) ? -1 : 1;
+  int delta = gdbarch_bits_big_endian (get_type_arch (type)) ? -1 : 1;
 
   type = ada_check_typedef (type);
 
@@ -2008,7 +2095,7 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
       memset (unpacked, 0, TYPE_LENGTH (type));
       return v;
     }
-  else if (gdbarch_bits_big_endian (current_gdbarch))
+  else if (gdbarch_bits_big_endian (get_type_arch (type)))
     {
       src = len - 1;
       if (has_negatives (type)
@@ -2094,7 +2181,7 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
    not overlap.  */
 static void
 move_bits (gdb_byte *target, int targ_offset, const gdb_byte *source,
-          int src_offset, int n)
+          int src_offset, int n, int bits_big_endian_p)
 {
   unsigned int accum, mask;
   int accum_bits, chunk_size;
@@ -2103,7 +2190,7 @@ move_bits (gdb_byte *target, int targ_offset, const gdb_byte *source,
   targ_offset %= HOST_CHAR_BIT;
   source += src_offset / HOST_CHAR_BIT;
   src_offset %= HOST_CHAR_BIT;
-  if (gdbarch_bits_big_endian (current_gdbarch))
+  if (bits_big_endian_p)
     {
       accum = (unsigned char) *source;
       source += 1;
@@ -2195,16 +2282,15 @@ ada_value_assign (struct value *toval, struct value *fromval)
       from_size = value_bitsize (fromval);
       if (from_size == 0)
        from_size = TYPE_LENGTH (value_type (fromval)) * TARGET_CHAR_BIT;
-      if (gdbarch_bits_big_endian (current_gdbarch))
+      if (gdbarch_bits_big_endian (get_type_arch (type)))
         move_bits (buffer, value_bitpos (toval),
-                  value_contents (fromval), from_size - bits, bits);
+                  value_contents (fromval), from_size - bits, bits, 1);
       else
-        move_bits (buffer, value_bitpos (toval), value_contents (fromval),
-                   0, bits);
+        move_bits (buffer, value_bitpos (toval),
+                  value_contents (fromval), 0, bits, 0);
       write_memory (to_addr, buffer, len);
-      if (deprecated_memory_changed_hook)
-       deprecated_memory_changed_hook (to_addr, len);
-      
+      observer_notify_memory_changed (to_addr, len, buffer);
+
       val = value_copy (toval);
       memcpy (value_contents_raw (val), value_contents (fromval),
               TYPE_LENGTH (type));
@@ -2239,16 +2325,16 @@ value_assign_to_component (struct value *container, struct value *component,
   else
     bits = value_bitsize (component);
 
-  if (gdbarch_bits_big_endian (current_gdbarch))
+  if (gdbarch_bits_big_endian (get_type_arch (value_type (container))))
     move_bits (value_contents_writeable (container) + offset_in_container, 
               value_bitpos (container) + bit_offset_in_container,
               value_contents (val),
               TYPE_LENGTH (value_type (component)) * TARGET_CHAR_BIT - bits,
-              bits);
+              bits, 1);
   else
     move_bits (value_contents_writeable (container) + offset_in_container, 
               value_bitpos (container) + bit_offset_in_container,
-              value_contents (val), 0, bits);
+              value_contents (val), 0, bits, 0);
 }             
                        
 /* The value of the element of array ARR at the ARITY indices given in IND.
@@ -2313,7 +2399,7 @@ 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)))
+    + ((low - ada_discrete_type_low_bound (TYPE_INDEX_TYPE (type)))
        * TYPE_LENGTH (TYPE_TARGET_TYPE (type)));
   struct type *index_type =
     create_range_type (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type)),
@@ -2408,7 +2494,10 @@ ada_array_element_type (struct type *type, int nindices)
 }
 
 /* The type of nth index in arrays of given type (n numbering from 1).
-   Does not examine memory.  */
+   Does not examine memory.  Throws an error if N is invalid or TYPE
+   is not an array type.  NAME is the name of the Ada attribute being
+   evaluated ('range, 'first, 'last, or 'length); it is used in building
+   the error message.  */
 
 static struct type *
 ada_index_type (struct type *type, int n, const char *name)
@@ -2452,13 +2541,13 @@ ada_index_type (struct type *type, int n, const char *name)
 static LONGEST
 ada_array_bound_from_type (struct type * arr_type, int n, int which)
 {
-  struct type *type, *index_type_desc, *index_type;
-  LONGEST retval;
+  struct type *type, *elt_type, *index_type_desc, *index_type;
+  int i;
 
   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_constrained_packed_array_type (arr_type))
+    arr_type = decode_constrained_packed_array_type (arr_type);
 
   if (arr_type == NULL || !ada_is_simple_array_type (arr_type))
     return (LONGEST) - which;
@@ -2468,37 +2557,21 @@ ada_array_bound_from_type (struct type * arr_type, int n, int which)
   else
     type = arr_type;
 
+  elt_type = type;
+  for (i = n; i > 1; i--)
+    elt_type = TYPE_TARGET_TYPE (type);
+
   index_type_desc = ada_find_parallel_type (type, "___XA");
   if (index_type_desc != NULL)
     index_type = to_fixed_range_type (TYPE_FIELD_NAME (index_type_desc, n - 1),
-                                     NULL, TYPE_OBJFILE (arr_type));
+                                     NULL, TYPE_INDEX_TYPE (elt_type));
   else
-    {
-      while (n > 1)
-        {
-          type = TYPE_TARGET_TYPE (type);
-          n -= 1;
-        }
+    index_type = TYPE_INDEX_TYPE (elt_type);
 
-      index_type = TYPE_INDEX_TYPE (type);
-    }
-
-  switch (TYPE_CODE (index_type))
-    {
-    case TYPE_CODE_RANGE:
-      retval = which == 0 ? TYPE_LOW_BOUND (index_type)
-                         : TYPE_HIGH_BOUND (index_type);
-      break;
-    case TYPE_CODE_ENUM:
-      retval = which == 0 ? TYPE_FIELD_BITPOS (index_type, 0)
-                         : TYPE_FIELD_BITPOS (index_type,
-                                              TYPE_NFIELDS (index_type) - 1);
-      break;
-    default:
-      internal_error (__FILE__, __LINE__, _("invalid type code of index type"));
-    }
-
-  return retval;
+  return
+    (LONGEST) (which == 0
+               ? ada_discrete_type_low_bound (index_type)
+               : ada_discrete_type_high_bound (index_type));
 }
 
 /* Given that arr is an array value, returns the lower bound of the
@@ -2511,8 +2584,8 @@ ada_array_bound (struct value *arr, int n, int which)
 {
   struct type *arr_type = value_type (arr);
 
-  if (ada_is_packed_array_type (arr_type))
-    return ada_array_bound (decode_packed_array (arr), n, which);
+  if (ada_is_constrained_packed_array_type (arr_type))
+    return ada_array_bound (decode_constrained_packed_array (arr), n, which);
   else if (ada_is_simple_array_type (arr_type))
     return ada_array_bound_from_type (arr_type, n, which);
   else
@@ -2530,8 +2603,8 @@ ada_array_length (struct value *arr, int n)
 {
   struct type *arr_type = ada_check_typedef (value_type (arr));
 
-  if (ada_is_packed_array_type (arr_type))
-    return ada_array_length (decode_packed_array (arr), n);
+  if (ada_is_constrained_packed_array_type (arr_type))
+    return ada_array_length (decode_constrained_packed_array (arr), n);
 
   if (ada_is_simple_array_type (arr_type))
     return (ada_array_bound_from_type (arr_type, n, 1)
@@ -2586,9 +2659,13 @@ ada_decoded_op_name (enum exp_opcode op)
 static void
 resolve (struct expression **expp, int void_context_p)
 {
-  int pc;
-  pc = 0;
-  resolve_subexp (expp, &pc, 1, void_context_p ? builtin_type_void : NULL);
+  struct type *context_type = NULL;
+  int pc = 0;
+
+  if (void_context_p)
+    context_type = builtin_type ((*expp)->gdbarch)->builtin_void;
+
+  resolve_subexp (expp, &pc, 1, context_type);
 }
 
 /* Resolve the operator of the subexpression beginning at
@@ -2948,10 +3025,9 @@ resolve_subexp (struct expression **expp, int *pos, int deprocedure_p,
 
 /* Return non-zero if formal type FTYPE matches actual type ATYPE.  If
    MAY_DEREF is non-zero, the formal may be a pointer and the actual
-   a non-pointer.   A type of 'void' (which is never a valid expression type)
-   by convention matches anything. */
+   a non-pointer.  */
 /* The term "match" here is rather loose.  The match is heuristic and
-   liberal.  FIXME: TOO liberal, in fact.  */
+   liberal.  */
 
 static int
 ada_type_match (struct type *ftype, struct type *atype, int may_deref)
@@ -2964,14 +3040,10 @@ ada_type_match (struct type *ftype, struct type *atype, int may_deref)
   if (TYPE_CODE (atype) == TYPE_CODE_REF)
     atype = TYPE_TARGET_TYPE (atype);
 
-  if (TYPE_CODE (ftype) == TYPE_CODE_VOID
-      || TYPE_CODE (atype) == TYPE_CODE_VOID)
-    return 1;
-
   switch (TYPE_CODE (ftype))
     {
     default:
-      return 1;
+      return TYPE_CODE (ftype) == TYPE_CODE (atype);
     case TYPE_CODE_PTR:
       if (TYPE_CODE (atype) == TYPE_CODE_PTR)
         return ada_type_match (TYPE_TARGET_TYPE (ftype),
@@ -3094,35 +3166,27 @@ ada_resolve_function (struct ada_symbol_info syms[],
                       int nsyms, struct value **args, int nargs,
                       const char *name, struct type *context_type)
 {
+  int fallback;
   int k;
   int m;                        /* Number of hits */
-  struct type *fallback;
-  struct type *return_type;
-
-  return_type = context_type;
-  if (context_type == NULL)
-    fallback = builtin_type_void;
-  else
-    fallback = NULL;
 
   m = 0;
-  while (1)
+  /* In the first pass of the loop, we only accept functions matching
+     context_type.  If none are found, we add a second pass of the loop
+     where every function is accepted.  */
+  for (fallback = 0; m == 0 && fallback < 2; fallback++)
     {
       for (k = 0; k < nsyms; k += 1)
         {
           struct type *type = ada_check_typedef (SYMBOL_TYPE (syms[k].sym));
 
           if (ada_args_match (syms[k].sym, args, nargs)
-              && return_match (type, return_type))
+              && (fallback || return_match (type, context_type)))
             {
               syms[m] = syms[k];
               m += 1;
             }
         }
-      if (m > 0 || return_type == fallback)
-        break;
-      else
-        return_type = fallback;
     }
 
   if (m == 0)
@@ -3507,6 +3571,7 @@ discrete_type_p (struct type *type)
         case TYPE_CODE_INT:
         case TYPE_CODE_RANGE:
         case TYPE_CODE_ENUM:
+        case TYPE_CODE_BOOL:
           return 1;
         default:
           return 0;
@@ -3733,7 +3798,7 @@ parse_old_style_renaming (struct type *type,
    returning an lvalue whose value_address points to the copy.  */
 
 static struct value *
-ensure_lval (struct value *val, CORE_ADDR *sp)
+ensure_lval (struct value *val, struct gdbarch *gdbarch, CORE_ADDR *sp)
 {
   if (! VALUE_LVAL (val))
     {
@@ -3742,25 +3807,25 @@ ensure_lval (struct value *val, CORE_ADDR *sp)
       /* The following is taken from the structure-return code in
         call_function_by_hand. FIXME: Therefore, some refactoring seems 
         indicated. */
-      if (gdbarch_inner_than (current_gdbarch, 1, 2))
+      if (gdbarch_inner_than (gdbarch, 1, 2))
        {
          /* Stack grows downward.  Align SP and value_address (val) after
             reserving sufficient space. */
          *sp -= len;
-         if (gdbarch_frame_align_p (current_gdbarch))
-           *sp = gdbarch_frame_align (current_gdbarch, *sp);
+         if (gdbarch_frame_align_p (gdbarch))
+           *sp = gdbarch_frame_align (gdbarch, *sp);
          set_value_address (val, *sp);
        }
       else
        {
          /* Stack grows upward.  Align the frame, allocate space, and
             then again, re-align the frame. */
-         if (gdbarch_frame_align_p (current_gdbarch))
-           *sp = gdbarch_frame_align (current_gdbarch, *sp);
+         if (gdbarch_frame_align_p (gdbarch))
+           *sp = gdbarch_frame_align (gdbarch, *sp);
          set_value_address (val, *sp);
          *sp += len;
-         if (gdbarch_frame_align_p (current_gdbarch))
-           *sp = gdbarch_frame_align (current_gdbarch, *sp);
+         if (gdbarch_frame_align_p (gdbarch))
+           *sp = gdbarch_frame_align (gdbarch, *sp);
        }
       VALUE_LVAL (val) = lval_memory;
 
@@ -3777,7 +3842,7 @@ ensure_lval (struct value *val, CORE_ADDR *sp)
 
 struct value *
 ada_convert_actual (struct value *actual, struct type *formal_type0,
-                    CORE_ADDR *sp)
+                    struct gdbarch *gdbarch, CORE_ADDR *sp)
 {
   struct type *actual_type = ada_check_typedef (value_type (actual));
   struct type *formal_type = ada_check_typedef (formal_type0);
@@ -3790,7 +3855,7 @@ ada_convert_actual (struct value *actual, struct type *formal_type0,
 
   if (ada_is_array_descriptor_type (formal_target)
       && TYPE_CODE (actual_target) == TYPE_CODE_ARRAY)
-    return make_array_descriptor (formal_type, actual, sp);
+    return make_array_descriptor (formal_type, actual, gdbarch, sp);
   else if (TYPE_CODE (formal_type) == TYPE_CODE_PTR
           || TYPE_CODE (formal_type) == TYPE_CODE_REF)
     {
@@ -3808,7 +3873,7 @@ ada_convert_actual (struct value *actual, struct type *formal_type0,
               memcpy ((char *) value_contents_raw (val),
                       (char *) value_contents (actual),
                       TYPE_LENGTH (actual_type));
-              actual = ensure_lval (val, sp);
+              actual = ensure_lval (val, gdbarch, sp);
             }
           result = value_addr (actual);
         }
@@ -3830,7 +3895,8 @@ ada_convert_actual (struct value *actual, struct type *formal_type0,
    representing a pointer to this descriptor.  */
 
 static struct value *
-make_array_descriptor (struct type *type, struct value *arr, CORE_ADDR *sp)
+make_array_descriptor (struct type *type, struct value *arr,
+                      struct gdbarch *gdbarch, CORE_ADDR *sp)
 {
   struct type *bounds_type = desc_bounds_type (type);
   struct type *desc_type = desc_base_type (type);
@@ -3840,29 +3906,33 @@ make_array_descriptor (struct type *type, struct value *arr, CORE_ADDR *sp)
 
   for (i = ada_array_arity (ada_check_typedef (value_type (arr))); i > 0; i -= 1)
     {
-      modify_general_field (value_contents_writeable (bounds),
+      modify_general_field (value_type (bounds),
+                           value_contents_writeable (bounds),
                             ada_array_bound (arr, i, 0),
                             desc_bound_bitpos (bounds_type, i, 0),
                             desc_bound_bitsize (bounds_type, i, 0));
-      modify_general_field (value_contents_writeable (bounds),
+      modify_general_field (value_type (bounds),
+                           value_contents_writeable (bounds),
                             ada_array_bound (arr, i, 1),
                             desc_bound_bitpos (bounds_type, i, 1),
                             desc_bound_bitsize (bounds_type, i, 1));
     }
 
-  bounds = ensure_lval (bounds, sp);
+  bounds = ensure_lval (bounds, gdbarch, sp);
 
-  modify_general_field (value_contents_writeable (descriptor),
-                        value_address (ensure_lval (arr, sp)),
+  modify_general_field (value_type (descriptor),
+                       value_contents_writeable (descriptor),
+                        value_address (ensure_lval (arr, gdbarch, sp)),
                         fat_pntr_data_bitpos (desc_type),
                         fat_pntr_data_bitsize (desc_type));
 
-  modify_general_field (value_contents_writeable (descriptor),
+  modify_general_field (value_type (descriptor),
+                       value_contents_writeable (descriptor),
                         value_address (bounds),
                         fat_pntr_bounds_bitpos (desc_type),
                         fat_pntr_bounds_bitsize (desc_type));
 
-  descriptor = ensure_lval (descriptor, sp);
+  descriptor = ensure_lval (descriptor, gdbarch, sp);
 
   if (TYPE_CODE (type) == TYPE_CODE_PTR)
     return value_addr (descriptor);
@@ -5648,18 +5718,14 @@ ada_is_variant_part (struct type *type, int field_num)
 
 /* Assuming that VAR_TYPE is a variant wrapper (type of the variant part)
    whose discriminants are contained in the record type OUTER_TYPE,
-   returns the type of the controlling discriminant for the variant.  */
+   returns the type of the controlling discriminant for the variant.
+   May return NULL if the type could not be found.  */
 
 struct type *
 ada_variant_discrim_type (struct type *var_type, struct type *outer_type)
 {
   char *name = ada_variant_discrim_name (var_type);
-  struct type *type =
-    ada_lookup_struct_elt_type (outer_type, name, 1, 1, NULL);
-  if (type == NULL)
-    return builtin_type_int32;
-  else
-    return type;
+  return ada_lookup_struct_elt_type (outer_type, name, 1, 1, NULL);
 }
 
 /* Assuming that TYPE is the type of a variant wrapper, and FIELD_NUM is a
@@ -6516,12 +6582,14 @@ find_old_style_renaming_symbol (const char *name, struct block *block)
          the XR type name, we need to make sure that this suffix is
          not included.  So do not include any suffix in the function
          name length below.  */
-      const int function_name_len = ada_name_prefix_len (function_name);
+      int function_name_len = ada_name_prefix_len (function_name);
       const int rename_len = function_name_len + 2      /*  "__" */
         + strlen (name) + 6 /* "___XR\0" */ ;
 
       /* Strip the suffix if necessary.  */
-      function_name[function_name_len] = '\0';
+      ada_remove_trailing_digits (function_name, &function_name_len);
+      ada_remove_po_subprogram_suffix (function_name, &function_name_len);
+      ada_remove_Xbn_suffix (function_name, &function_name_len);
 
       /* Library-level functions are a special case, as GNAT adds
          a ``_ada_'' prefix to the function name to avoid namespace
@@ -6529,11 +6597,15 @@ find_old_style_renaming_symbol (const char *name, struct block *block)
          have this prefix, so we need to skip this prefix if present.  */
       if (function_name_len > 5 /* "_ada_" */
           && strstr (function_name, "_ada_") == function_name)
-        function_name = function_name + 5;
+        {
+         function_name += 5;
+         function_name_len -= 5;
+        }
 
       rename = (char *) alloca (rename_len * sizeof (char));
-      xsnprintf (rename, rename_len * sizeof (char), "%s__%s___XR", 
-                function_name, name);
+      strncpy (rename, function_name, function_name_len);
+      xsnprintf (rename + function_name_len, rename_len - function_name_len,
+                "__%s___XR", name);
     }
   else
     {
@@ -6563,7 +6635,7 @@ ada_prefer_type (struct type *type0, struct type *type1)
     return 0;
   else if (TYPE_NAME (type1) == NULL && TYPE_NAME (type0) != NULL)
     return 1;
-  else if (ada_is_packed_array_type (type0))
+  else if (ada_is_constrained_packed_array_type (type0))
     return 1;
   else if (ada_is_array_descriptor_type (type0)
            && !ada_is_array_descriptor_type (type1))
@@ -6674,9 +6746,9 @@ variant_field_index (struct type *type)
 /* A record type with no fields.  */
 
 static struct type *
-empty_record (struct objfile *objfile)
+empty_record (struct type *template)
 {
-  struct type *type = alloc_type (objfile);
+  struct type *type = alloc_type_copy (template);
   TYPE_CODE (type) = TYPE_CODE_STRUCT;
   TYPE_NFIELDS (type) = 0;
   TYPE_FIELDS (type) = NULL;
@@ -6733,7 +6805,7 @@ ada_template_to_fixed_record_type_1 (struct type *type,
         nfields++;
     }
 
-  rtype = alloc_type (TYPE_OBJFILE (type));
+  rtype = alloc_type_copy (type);
   TYPE_CODE (rtype) = TYPE_CODE_STRUCT;
   INIT_CPLUS_SPECIFIC (rtype);
   TYPE_NFIELDS (rtype) = nfields;
@@ -6943,7 +7015,7 @@ template_to_static_fixed_type (struct type *type0)
         new_type = static_unwrap_type (field_type);
       if (type == type0 && new_type != field_type)
         {
-          TYPE_TARGET_TYPE (type0) = type = alloc_type (TYPE_OBJFILE (type0));
+          TYPE_TARGET_TYPE (type0) = type = alloc_type_copy (type0);
           TYPE_CODE (type) = TYPE_CODE (type0);
           INIT_CPLUS_SPECIFIC (type);
           TYPE_NFIELDS (type) = nfields;
@@ -6988,7 +7060,7 @@ to_record_with_fixed_variant_part (struct type *type, const gdb_byte *valaddr,
   else
     dval = dval0;
 
-  rtype = alloc_type (TYPE_OBJFILE (type));
+  rtype = alloc_type_copy (type);
   TYPE_CODE (rtype) = TYPE_CODE_STRUCT;
   INIT_CPLUS_SPECIFIC (rtype);
   TYPE_NFIELDS (rtype) = nfields;
@@ -7108,7 +7180,7 @@ to_fixed_variant_branch_type (struct type *var_type0, const gdb_byte *valaddr,
                                value_type (dval), value_contents (dval));
 
   if (which < 0)
-    return empty_record (TYPE_OBJFILE (var_type));
+    return empty_record (var_type);
   else if (is_dynamic_field (var_type, which))
     return to_fixed_record_type
       (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (var_type, which)),
@@ -7135,14 +7207,14 @@ to_fixed_array_type (struct type *type0, struct value *dval,
 {
   struct type *index_type_desc;
   struct type *result;
-  int packed_array_p;
+  int constrained_packed_array_p;
 
   if (TYPE_FIXED_INSTANCE (type0))
     return type0;
 
-  packed_array_p = ada_is_packed_array_type (type0);
-  if (packed_array_p)
-    type0 = decode_packed_array_type (type0);
+  constrained_packed_array_p = ada_is_constrained_packed_array_type (type0);
+  if (constrained_packed_array_p)
+    type0 = decode_constrained_packed_array_type (type0);
 
   index_type_desc = ada_find_parallel_type (type0, "___XA");
   if (index_type_desc == NULL)
@@ -7164,10 +7236,10 @@ to_fixed_array_type (struct type *type0, struct value *dval,
       /* Make sure we always create a new array type when dealing with
         packed array types, since we're going to fix-up the array
         type length and element bitsize a little further down.  */
-      if (elt_type0 == elt_type && !packed_array_p)
+      if (elt_type0 == elt_type && !constrained_packed_array_p)
         result = type0;
       else
-        result = create_array_type (alloc_type (TYPE_OBJFILE (type0)),
+        result = create_array_type (alloc_type_copy (type0),
                                     elt_type, TYPE_INDEX_TYPE (type0));
     }
   else
@@ -7192,19 +7264,22 @@ to_fixed_array_type (struct type *type0, struct value *dval,
          consult the object tag.  */
       result =
         ada_to_fixed_type (ada_check_typedef (elt_type0), 0, 0, dval, 1);
+
+      elt_type0 = type0;
       for (i = TYPE_NFIELDS (index_type_desc) - 1; i >= 0; i -= 1)
         {
           struct type *range_type =
             to_fixed_range_type (TYPE_FIELD_NAME (index_type_desc, i),
-                                 dval, TYPE_OBJFILE (type0));
-          result = create_array_type (alloc_type (TYPE_OBJFILE (type0)),
+                                 dval, TYPE_INDEX_TYPE (elt_type0));
+          result = create_array_type (alloc_type_copy (elt_type0),
                                       result, range_type);
+         elt_type0 = TYPE_TARGET_TYPE (elt_type0);
         }
       if (!ignore_too_big && TYPE_LENGTH (result) > varsize_limit)
         error (_("array type with dynamic size is larger than varsize-limit"));
     }
 
-  if (packed_array_p)
+  if (constrained_packed_array_p)
     {
       /* So far, the resulting type has been created as if the original
         type was a regular (non-packed) array type.  As a result, the
@@ -7924,7 +7999,8 @@ ada_value_binop (struct value *arg1, struct value *arg2, enum exp_opcode op)
 
   val = allocate_value (type1);
   store_unsigned_integer (value_contents_raw (val),
-                          TYPE_LENGTH (value_type (val)), v);
+                          TYPE_LENGTH (value_type (val)),
+                         gdbarch_byte_order (get_type_arch (type1)), v);
   return val;
 }
 
@@ -7996,7 +8072,8 @@ assign_component (struct value *container, struct value *lhs, LONGEST index,
   struct value *elt;
   if (TYPE_CODE (value_type (lhs)) == TYPE_CODE_ARRAY)
     {
-      struct value *index_val = value_from_longest (builtin_type_int32, index);
+      struct type *index_type = builtin_type (exp->gdbarch)->builtin_int;
+      struct value *index_val = value_from_longest (index_type, index);
       elt = unwrap_value (ada_value_subscript (lhs, 1, &index_val));
     }
   else
@@ -8298,6 +8375,9 @@ ada_value_cast (struct type *type, struct value *arg2, enum noside noside)
 /*  Evaluating Ada expressions, and printing their result.
     ------------------------------------------------------
 
+    1. Introduction:
+    ----------------
+
     We usually evaluate an Ada expression in order to print its value.
     We also evaluate an expression in order to print its type, which
     happens during the EVAL_AVOID_SIDE_EFFECTS phase of the evaluation,
@@ -8326,6 +8406,9 @@ ada_value_cast (struct type *type, struct value *arg2, enum noside noside)
     cleaned up, this guide might become redundant with the comments
     inserted in the code, and we might want to remove it.
 
+    2. ``Fixing'' an Entity, the Simple Case:
+    -----------------------------------------
+
     When evaluating Ada expressions, the tricky issue is that they may
     reference entities whose type contents and size are not statically
     known.  Consider for instance a variant record:
@@ -8367,34 +8450,60 @@ ada_value_cast (struct type *type, struct value *arg2, enum noside noside)
     such as an array of variant records, for instance.  There are
     two possible cases: Arrays, and records.
 
-    Arrays are a little simpler to handle, because the same amount of
-    memory is allocated for each element of the array, even if the amount
-    of space used by each element changes from element to element.
-    Consider for instance the following array of type Rec:
+    3. ``Fixing'' Arrays:
+    ---------------------
+
+    The type structure in GDB describes an array in terms of its bounds,
+    and the type of its elements.  By design, all elements in the array
+    have the same type and we cannot represent an array of variant elements
+    using the current type structure in GDB.  When fixing an array,
+    we cannot fix the array element, as we would potentially need one
+    fixed type per element of the array.  As a result, the best we can do
+    when fixing an array is to produce an array whose bounds and size
+    are correct (allowing us to read it from memory), but without having
+    touched its element type.  Fixing each element will be done later,
+    when (if) necessary.
+
+    Arrays are a little simpler to handle than records, because the same
+    amount of memory is allocated for each element of the array, even if
+    the amount of space actually used by each element differs from element
+    to element.  Consider for instance the following array of type Rec:
 
        type Rec_Array is array (1 .. 2) of Rec;
 
-    The type structure in GDB describes an array in terms of its
-    bounds, and the type of its elements.  By design, all elements
-    in the array have the same type.  So we cannot use a fixed type
-    for the array elements in this case, since the fixed type depends
-    on the actual value of each element.
-
-    Fortunately, what happens in practice is that each element of
-    the array has the same size, which is the maximum size that
-    might be needed in order to hold an object of the element type.
-    And the compiler shows it in the debugging information by wrapping
-    the array element inside a private PAD type.  This type should not
-    be shown to the user, and must be "unwrap"'ed before printing. Note
+    The actual amount of memory occupied by each element might be different
+    from element to element, depending on the value of their discriminant.
+    But the amount of space reserved for each element in the array remains
+    fixed regardless.  So we simply need to compute that size using
+    the debugging information available, from which we can then determine
+    the array size (we multiply the number of elements of the array by
+    the size of each element).
+
+    The simplest case is when we have an array of a constrained element
+    type. For instance, consider the following type declarations:
+
+        type Bounded_String (Max_Size : Integer) is
+           Length : Integer;
+           Buffer : String (1 .. Max_Size);
+        end record;
+        type Bounded_String_Array is array (1 ..2) of Bounded_String (80);
+
+    In this case, the compiler describes the array as an array of
+    variable-size elements (identified by its XVS suffix) for which
+    the size can be read in the parallel XVZ variable.
+
+    In the case of an array of an unconstrained element type, the compiler
+    wraps the array element inside a private PAD type.  This type should not
+    be shown to the user, and must be "unwrap"'ed before printing.  Note
     that we also use the adjective "aligner" in our code to designate
     these wrapper types.
 
-    These wrapper types should have a constant size, which is the size
-    of each element of the array.  In the case when the size is statically
-    known, the PAD type will already have the right size, and the array
-    element type should remain unfixed.  But there are cases when
-    this size is not statically known.  For instance, assuming that
-    "Five" is an integer variable:
+    In some cases, the size allocated for each element is statically
+    known.  In that case, the PAD type already has the correct size,
+    and the array element should remain unfixed.
+
+    But there are cases when this size is not statically known.
+    For instance, assuming that "Five" is an integer variable:
 
         type Dynamic is array (1 .. Five) of Integer;
         type Wrapper (Has_Length : Boolean := False) is record
@@ -8417,7 +8526,10 @@ ada_value_cast (struct type *type, struct value *arg2, enum noside noside)
     In that case, a copy of the PAD type with the correct size should
     be used for the fixed array.
 
-    However, things are slightly different in the case of dynamic
+    3. ``Fixing'' record type objects:
+    ----------------------------------
+
+    Things are slightly different from arrays in the case of dynamic
     record types.  In this case, in order to compute the associated
     fixed type, we need to determine the size and offset of each of
     its components.  This, in turn, requires us to compute the fixed
@@ -8433,7 +8545,7 @@ ada_value_cast (struct type *type, struct value *arg2, enum noside noside)
 
     In that case, the position of field "Length" depends on the size
     of field Str, which itself depends on the value of the Max_Size
-    discriminant. In order to fix the type of variable My_String,
+    discriminant.  In order to fix the type of variable My_String,
     we need to fix the type of field Str.  Therefore, fixing a variant
     record requires us to fix each of its components.
 
@@ -8461,21 +8573,21 @@ ada_value_cast (struct type *type, struct value *arg2, enum noside noside)
 
     The debugger computes the position of each field based on an algorithm
     that uses, among other things, the actual position and size of the field
-    preceding it.  Let's now imagine that the user is trying to print the
-    value of My_Container.  If the type fixing was recursive, we would
+    preceding it.  Let's now imagine that the user is trying to print
+    the value of My_Container.  If the type fixing was recursive, we would
     end up computing the offset of field After based on the size of the
     fixed version of field First.  And since in our example First has
     only one actual field, the size of the fixed type is actually smaller
     than the amount of space allocated to that field, and thus we would
     compute the wrong offset of field After.
 
-    Unfortunately, we need to watch out for dynamic components of variant
-    records (identified by the ___XVL suffix in the component name).
-    Even if the target type is a PAD type, the size of that type might
-    not be statically known.  So the PAD type needs to be unwrapped and
-    the resulting type needs to be fixed.  Otherwise, we might end up
-    with the wrong size for our component.  This can be observed with
-    the following type declarations:
+    To make things more complicated, we need to watch out for dynamic
+    components of variant records (identified by the ___XVL suffix in
+    the component name).  Even if the target type is a PAD type, the size
+    of that type might not be statically known.  So the PAD type needs
+    to be unwrapped and the resulting type needs to be fixed.  Otherwise,
+    we might end up with the wrong size for our component.  This can be
+    observed with the following type declarations:
 
         type Octal is new Integer range 0 .. 7;
         type Octal_Array is array (Positive range <>) of Octal;
@@ -8489,7 +8601,10 @@ ada_value_cast (struct type *type, struct value *arg2, enum noside noside)
     In that case, Buffer is a PAD type whose size is unset and needs
     to be computed by fixing the unwrapped type.
 
-    Lastly, when should the sub-elements of a type that remained unfixed
+    4. When to ``Fix'' un-``Fixed'' sub-elements of an entity:
+    ----------------------------------------------------------
+
+    Lastly, when should the sub-elements of an entity that remained unfixed
     thus far, be actually fixed?
 
     The answer is: Only when referencing that element.  For instance
@@ -8814,7 +8929,8 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
             goto nosideret;
         }
 
-      if (ada_is_packed_array_type (desc_base_type (value_type (argvec[0]))))
+      if (ada_is_constrained_packed_array_type
+         (desc_base_type (value_type (argvec[0]))))
         argvec[0] = ada_coerce_to_simple_array (argvec[0]);
       else if (TYPE_CODE (value_type (argvec[0])) == TYPE_CODE_ARRAY
                && TYPE_FIELD_BITSIZE (value_type (argvec[0]), 0) != 0)
@@ -8927,7 +9043,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
           TYPE_TARGET_TYPE (value_type (array)) =
             ada_aligned_type (TYPE_TARGET_TYPE (value_type (array)));
 
-        if (ada_is_packed_array_type (value_type (array)))
+        if (ada_is_constrained_packed_array_type (value_type (array)))
           error (_("cannot slice a packed array"));
 
         /* If this is a reference to an array or an array lvalue,
@@ -9092,7 +9208,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
           {
             arg1 = ada_coerce_ref (arg1);
 
-            if (ada_is_packed_array_type (value_type (arg1)))
+            if (ada_is_constrained_packed_array_type (value_type (arg1)))
               arg1 = ada_coerce_to_simple_array (arg1);
 
             type = ada_index_type (value_type (arg1), tem,
@@ -9124,8 +9240,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
             char *name = ada_type_name (type_arg);
             range_type = NULL;
             if (name != NULL && TYPE_CODE (type_arg) != TYPE_CODE_ENUM)
-              range_type =
-                to_fixed_range_type (name, NULL, TYPE_OBJFILE (type_arg));
+              range_type = to_fixed_range_type (name, NULL, type_arg);
             if (range_type == NULL)
               range_type = type_arg;
             switch (op)
@@ -9134,10 +9249,10 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
                 error (_("unexpected attribute encountered"));
               case OP_ATR_FIRST:
                return value_from_longest 
-                 (range_type, discrete_type_low_bound (range_type));
+                 (range_type, ada_discrete_type_low_bound (range_type));
               case OP_ATR_LAST:
                 return value_from_longest
-                 (range_type, discrete_type_high_bound (range_type));
+                 (range_type, ada_discrete_type_high_bound (range_type));
               case OP_ATR_LENGTH:
                 error (_("the 'length attribute applies only to array types"));
               }
@@ -9148,8 +9263,8 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
           {
             LONGEST low, high;
 
-            if (ada_is_packed_array_type (type_arg))
-              type_arg = decode_packed_array_type (type_arg);
+            if (ada_is_constrained_packed_array_type (type_arg))
+              type_arg = decode_constrained_packed_array_type (type_arg);
 
             type = ada_index_type (type_arg, tem, ada_attribute_name (op));
             if (type == NULL)
@@ -9242,9 +9357,9 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       if (noside == EVAL_SKIP)
         goto nosideret;
       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-        return value_zero (builtin_type_int32, not_lval);
+        return value_zero (builtin_type (exp->gdbarch)->builtin_int, not_lval);
       else
-        return value_from_longest (builtin_type_int32,
+        return value_from_longest (builtin_type (exp->gdbarch)->builtin_int,
                                    TARGET_CHAR_BIT * TYPE_LENGTH (type));
 
     case OP_ATR_VAL:
@@ -9377,7 +9492,8 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
                    in some extension of the type.  Return an object of 
                    "type" void, which will match any formal 
                    (see ada_type_match). */
-                return value_zero (builtin_type_void, lval_memory);
+                return value_zero (builtin_type (exp->gdbarch)->builtin_void,
+                                  lval_memory);
             }
           else
             type =
@@ -9428,7 +9544,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
     }
 
 nosideret:
-  return value_from_longest (builtin_type_int8, (LONGEST) 1);
+  return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
 }
 \f
 
@@ -9685,26 +9801,24 @@ get_int_var_value (char *name, int *flag)
 /* Return a range type whose base type is that of the range type named
    NAME in the current environment, and whose bounds are calculated
    from NAME according to the GNAT range encoding conventions.
-   Extract discriminant values, if needed, from DVAL.  If a new type
-   must be created, allocate in OBJFILE's space.  The bounds
-   information, in general, is encoded in NAME, the base type given in
-   the named range type.  */
+   Extract discriminant values, if needed, from DVAL.  ORIG_TYPE is the
+   corresponding range type from debug information; fall back to using it
+   if symbol lookup fails.  If a new type must be created, allocate it
+   like ORIG_TYPE was.  The bounds information, in general, is encoded
+   in NAME, the base type given in the named range type.  */
 
 static struct type *
-to_fixed_range_type (char *name, struct value *dval, struct objfile *objfile)
+to_fixed_range_type (char *name, struct value *dval, struct type *orig_type)
 {
   struct type *raw_type = ada_find_any_type (name);
   struct type *base_type;
   char *subtype_info;
 
-  /* Also search primitive types if type symbol could not be found.  */
+  /* Fall back to the original type if symbol lookup failed.  */
   if (raw_type == NULL)
-    raw_type = language_lookup_primitive_type_by_name
-               (language_def (language_ada), current_gdbarch, name);
+    raw_type = orig_type;
 
-  if (raw_type == NULL)
-    base_type = builtin_type_int32;
-  else if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
+  if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
     base_type = TYPE_TARGET_TYPE (raw_type);
   else
     base_type = raw_type;
@@ -9712,14 +9826,14 @@ to_fixed_range_type (char *name, struct value *dval, struct objfile *objfile)
   subtype_info = strstr (name, "___XD");
   if (subtype_info == NULL)
     {
-      LONGEST L = discrete_type_low_bound (raw_type);
-      LONGEST U = discrete_type_high_bound (raw_type);
+      LONGEST L = ada_discrete_type_low_bound (raw_type);
+      LONGEST U = ada_discrete_type_high_bound (raw_type);
       if (L < INT_MIN || U > INT_MAX)
        return raw_type;
       else
-       return create_range_type (alloc_type (objfile), raw_type, 
-                                 discrete_type_low_bound (raw_type),
-                                 discrete_type_high_bound (raw_type));
+       return create_range_type (alloc_type_copy (orig_type), raw_type,
+                                 ada_discrete_type_low_bound (raw_type),
+                                 ada_discrete_type_high_bound (raw_type));
     }
   else
     {
@@ -9780,9 +9894,7 @@ to_fixed_range_type (char *name, struct value *dval, struct objfile *objfile)
             }
         }
 
-      if (objfile == NULL)
-        objfile = TYPE_OBJFILE (base_type);
-      type = create_range_type (alloc_type (objfile), base_type, L, U);
+      type = create_range_type (alloc_type_copy (orig_type), base_type, L, U);
       TYPE_NAME (type) = name;
       return type;
     }
@@ -9847,20 +9959,7 @@ ada_modulus_from_name (struct type *type, ULONGEST *modulus)
 ULONGEST
 ada_modulus (struct type *type)
 {
-  ULONGEST modulus;
-
-  /* Normally, the modulus of a modular type is equal to the value of
-     its upper bound + 1.  However, the upper bound is currently stored
-     as an int, which is not always big enough to hold the actual bound
-     value.  To workaround this, try to take advantage of the encoding
-     that GNAT uses with with discrete types.  To avoid some unnecessary
-     parsing, we do this only when the size of TYPE is greater than
-     the size of the field holding the bound.  */
-  if (TYPE_LENGTH (type) > sizeof (TYPE_HIGH_BOUND (type))
-      && ada_modulus_from_name (type, &modulus))
-    return modulus;
-
-  return (ULONGEST) (unsigned int) TYPE_HIGH_BOUND (type) + 1;
+  return (ULONGEST) TYPE_HIGH_BOUND (type) + 1;
 }
 \f
 
@@ -10298,7 +10397,7 @@ print_it_exception (enum exception_catchpoint_kind ex, struct breakpoint *b)
 
 static void
 print_one_exception (enum exception_catchpoint_kind ex,
-                     struct breakpoint *b, CORE_ADDR *last_addr)
+                     struct breakpoint *b, struct bp_location **last_loc)
 { 
   struct value_print_options opts;
 
@@ -10306,11 +10405,11 @@ print_one_exception (enum exception_catchpoint_kind ex,
   if (opts.addressprint)
     {
       annotate_field (4);
-      ui_out_field_core_addr (uiout, "addr", b->loc->address);
+      ui_out_field_core_addr (uiout, "addr", b->loc->gdbarch, b->loc->address);
     }
 
   annotate_field (5);
-  *last_addr = b->loc->address;
+  *last_loc = b->loc;
   switch (ex)
     {
       case ex_catch_exception:
@@ -10382,9 +10481,9 @@ print_it_catch_exception (struct breakpoint *b)
 }
 
 static void
-print_one_catch_exception (struct breakpoint *b, CORE_ADDR *last_addr)
+print_one_catch_exception (struct breakpoint *b, struct bp_location **last_loc)
 {
-  print_one_exception (ex_catch_exception, b, last_addr);
+  print_one_exception (ex_catch_exception, b, last_loc);
 }
 
 static void
@@ -10412,9 +10511,10 @@ print_it_catch_exception_unhandled (struct breakpoint *b)
 }
 
 static void
-print_one_catch_exception_unhandled (struct breakpoint *b, CORE_ADDR *last_addr)
+print_one_catch_exception_unhandled (struct breakpoint *b,
+                                    struct bp_location **last_loc)
 {
-  print_one_exception (ex_catch_exception_unhandled, b, last_addr);
+  print_one_exception (ex_catch_exception_unhandled, b, last_loc);
 }
 
 static void
@@ -10441,9 +10541,9 @@ print_it_catch_assert (struct breakpoint *b)
 }
 
 static void
-print_one_catch_assert (struct breakpoint *b, CORE_ADDR *last_addr)
+print_one_catch_assert (struct breakpoint *b, struct bp_location **last_loc)
 {
-  print_one_exception (ex_catch_assert, b, last_addr);
+  print_one_exception (ex_catch_assert, b, last_loc);
 }
 
 static void
@@ -11167,51 +11267,42 @@ ada_language_arch_info (struct gdbarch *gdbarch,
   lai->primitive_type_vector
     = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_ada_primitive_types + 1,
                              struct type *);
-  lai->primitive_type_vector [ada_primitive_type_int] =
-    init_type (TYPE_CODE_INT,
-              gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
-              0, "integer", (struct objfile *) NULL);
-  lai->primitive_type_vector [ada_primitive_type_long] =
-    init_type (TYPE_CODE_INT,
-              gdbarch_long_bit (gdbarch) / TARGET_CHAR_BIT,
-              0, "long_integer", (struct objfile *) NULL);
-  lai->primitive_type_vector [ada_primitive_type_short] =
-    init_type (TYPE_CODE_INT,
-              gdbarch_short_bit (gdbarch) / TARGET_CHAR_BIT,
-              0, "short_integer", (struct objfile *) NULL);
-  lai->string_char_type = 
-    lai->primitive_type_vector [ada_primitive_type_char] =
-    init_type (TYPE_CODE_INT, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-               0, "character", (struct objfile *) NULL);
-  lai->primitive_type_vector [ada_primitive_type_float] =
-    init_type (TYPE_CODE_FLT,
-              gdbarch_float_bit (gdbarch)/ TARGET_CHAR_BIT,
-               0, "float", (struct objfile *) NULL);
-  lai->primitive_type_vector [ada_primitive_type_double] =
-    init_type (TYPE_CODE_FLT,
-              gdbarch_double_bit (gdbarch) / TARGET_CHAR_BIT,
-               0, "long_float", (struct objfile *) NULL);
-  lai->primitive_type_vector [ada_primitive_type_long_long] =
-    init_type (TYPE_CODE_INT, 
-              gdbarch_long_long_bit (gdbarch) / TARGET_CHAR_BIT,
-               0, "long_long_integer", (struct objfile *) NULL);
-  lai->primitive_type_vector [ada_primitive_type_long_double] =
-    init_type (TYPE_CODE_FLT,
-              gdbarch_double_bit (gdbarch) / TARGET_CHAR_BIT,
-               0, "long_long_float", (struct objfile *) NULL);
-  lai->primitive_type_vector [ada_primitive_type_natural] =
-    init_type (TYPE_CODE_INT,
-              gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
-              0, "natural", (struct objfile *) NULL);
-  lai->primitive_type_vector [ada_primitive_type_positive] =
-    init_type (TYPE_CODE_INT,
-              gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
-              0, "positive", (struct objfile *) NULL);
-  lai->primitive_type_vector [ada_primitive_type_void] = builtin->builtin_void;
-
-  lai->primitive_type_vector [ada_primitive_type_system_address] =
-    lookup_pointer_type (init_type (TYPE_CODE_VOID, 1, 0, "void",
-                                    (struct objfile *) NULL));
+
+  lai->primitive_type_vector [ada_primitive_type_int]
+    = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+                        0, "integer");
+  lai->primitive_type_vector [ada_primitive_type_long]
+    = arch_integer_type (gdbarch, gdbarch_long_bit (gdbarch),
+                        0, "long_integer");
+  lai->primitive_type_vector [ada_primitive_type_short]
+    = arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch),
+                        0, "short_integer");
+  lai->string_char_type
+    = lai->primitive_type_vector [ada_primitive_type_char]
+    = arch_integer_type (gdbarch, TARGET_CHAR_BIT, 0, "character");
+  lai->primitive_type_vector [ada_primitive_type_float]
+    = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
+                      "float", NULL);
+  lai->primitive_type_vector [ada_primitive_type_double]
+    = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
+                      "long_float", NULL);
+  lai->primitive_type_vector [ada_primitive_type_long_long]
+    = arch_integer_type (gdbarch, gdbarch_long_long_bit (gdbarch),
+                        0, "long_long_integer");
+  lai->primitive_type_vector [ada_primitive_type_long_double]
+    = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
+                      "long_long_float", NULL);
+  lai->primitive_type_vector [ada_primitive_type_natural]
+    = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+                        0, "natural");
+  lai->primitive_type_vector [ada_primitive_type_positive]
+    = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+                        0, "positive");
+  lai->primitive_type_vector [ada_primitive_type_void]
+    = builtin->builtin_void;
+
+  lai->primitive_type_vector [ada_primitive_type_system_address]
+    = lookup_pointer_type (arch_type (gdbarch, TYPE_CODE_VOID, 1, "void"));
   TYPE_NAME (lai->primitive_type_vector [ada_primitive_type_system_address])
     = "system__address";
 
This page took 0.122158 seconds and 4 git commands to generate.