Replace the block_found global with explicit data-flow
[deliverable/binutils-gdb.git] / gdb / ada-lang.c
index b6d5e0b71a5732afeb34122332b82d96ee75f1aa..9f9be642f00f72b1bf92d30906346da7c6bceb78 100644 (file)
@@ -1,6 +1,6 @@
 /* Ada language support routines for GDB, the GNU debugger.
 
-   Copyright (C) 1992-2013 Free Software Foundation, Inc.
+   Copyright (C) 1992-2015 Free Software Foundation, Inc.
 
    This file is part of GDB.
 
 
 
 #include "defs.h"
-#include <stdio.h>
-#include "gdb_string.h"
 #include <ctype.h>
-#include <stdarg.h>
 #include "demangle.h"
 #include "gdb_regex.h"
 #include "frame.h"
@@ -32,6 +29,7 @@
 #include "expression.h"
 #include "parser-defs.h"
 #include "language.h"
+#include "varobj.h"
 #include "c-lang.h"
 #include "inferior.h"
 #include "symfile.h"
 #include "gdb_obstack.h"
 #include "ada-lang.h"
 #include "completer.h"
-#include "gdb_stat.h"
-#ifdef UI_OUT
+#include <sys/stat.h>
 #include "ui-out.h"
-#endif
 #include "block.h"
 #include "infcall.h"
 #include "dictionary.h"
-#include "exceptions.h"
 #include "annotate.h"
 #include "valprint.h"
 #include "source.h"
@@ -63,7 +58,6 @@
 #include "value.h"
 #include "mi/mi-common.h"
 #include "arch-utils.h"
-#include "exceptions.h"
 #include "cli/cli-utils.h"
 
 /* Define whether or not the C operator '/' truncates towards zero for
@@ -111,17 +105,17 @@ static int full_match (const char *, const char *);
 static struct value *make_array_descriptor (struct type *, struct value *);
 
 static void ada_add_block_symbols (struct obstack *,
-                                   struct block *, const char *,
+                                   const struct block *, const char *,
                                    domain_enum, struct objfile *, int);
 
-static int is_nonfunction (struct ada_symbol_info *, int);
+static int is_nonfunction (struct block_symbol *, int);
 
 static void add_defn_to_vec (struct obstack *, struct symbol *,
-                             struct block *);
+                             const struct block *);
 
 static int num_defns_collected (struct obstack *);
 
-static struct ada_symbol_info *defns_collected (struct obstack *, int);
+static struct block_symbol *defns_collected (struct obstack *, int);
 
 static struct value *resolve_subexp (struct expression **, int *, int,
                                      struct type *);
@@ -229,7 +223,7 @@ static int find_struct_field (const char *, struct type *, int,
 static struct value *ada_to_fixed_value_create (struct type *, CORE_ADDR,
                                                 struct value *);
 
-static int ada_resolve_function (struct ada_symbol_info *, int,
+static int ada_resolve_function (struct block_symbol *, int,
                                  struct value **, int, const char *,
                                  struct type *);
 
@@ -238,8 +232,6 @@ static int ada_is_direct_array_type (struct type *);
 static void ada_language_arch_info (struct gdbarch *,
                                    struct language_arch_info *);
 
-static void check_size (const struct type *);
-
 static struct value *ada_index_struct_field (int, struct value *, int,
                                             struct type *);
 
@@ -275,6 +267,45 @@ static void ada_forward_operator_length (struct expression *, int, int *,
 static struct type *ada_find_any_type (const char *name);
 \f
 
+/* The result of a symbol lookup to be stored in our symbol cache.  */
+
+struct cache_entry
+{
+  /* The name used to perform the lookup.  */
+  const char *name;
+  /* The namespace used during the lookup.  */
+  domain_enum domain;
+  /* The symbol returned by the lookup, or NULL if no matching symbol
+     was found.  */
+  struct symbol *sym;
+  /* The block where the symbol was found, or NULL if no matching
+     symbol was found.  */
+  const struct block *block;
+  /* A pointer to the next entry with the same hash.  */
+  struct cache_entry *next;
+};
+
+/* The Ada symbol cache, used to store the result of Ada-mode symbol
+   lookups in the course of executing the user's commands.
+
+   The cache is implemented using a simple, fixed-sized hash.
+   The size is fixed on the grounds that there are not likely to be
+   all that many symbols looked up during any given session, regardless
+   of the size of the symbol table.  If we decide to go to a resizable
+   table, let's just use the stuff from libiberty instead.  */
+
+#define HASH_SIZE 1009
+
+struct ada_symbol_cache
+{
+  /* An obstack used to store the entries in our cache.  */
+  struct obstack cache_space;
+
+  /* The root of the hash table used to implement our symbol cache.  */
+  struct cache_entry *root[HASH_SIZE];
+};
+
+static void ada_free_symbol_cache (struct ada_symbol_cache *sym_cache);
 
 /* Maximum-sized dynamic type.  */
 static unsigned int varsize_limit;
@@ -310,6 +341,32 @@ static const char *known_auxiliary_function_name_patterns[] = {
 /* Space for allocating results of ada_lookup_symbol_list.  */
 static struct obstack symbol_list_obstack;
 
+/* Maintenance-related settings for this module.  */
+
+static struct cmd_list_element *maint_set_ada_cmdlist;
+static struct cmd_list_element *maint_show_ada_cmdlist;
+
+/* Implement the "maintenance set ada" (prefix) command.  */
+
+static void
+maint_set_ada_cmd (char *args, int from_tty)
+{
+  help_list (maint_set_ada_cmdlist, "maintenance set ada ", all_commands,
+            gdb_stdout);
+}
+
+/* Implement the "maintenance show ada" (prefix) command.  */
+
+static void
+maint_show_ada_cmd (char *args, int from_tty)
+{
+  cmd_show_list (maint_show_ada_cmdlist, from_tty, "");
+}
+
+/* The "maintenance ada set/show ignore-descriptive-type" value.  */
+
+static int ada_ignore_descriptive_types_p = 0;
+
                        /* Inferior-specific data.  */
 
 /* Per-inferior data for this module.  */
@@ -358,7 +415,7 @@ get_ada_inferior_data (struct inferior *inf)
   data = inferior_data (inf, ada_inferior_data);
   if (data == NULL)
     {
-      data = XZALLOC (struct ada_inferior_data);
+      data = XCNEW (struct ada_inferior_data);
       set_inferior_data (inf, ada_inferior_data, data);
     }
 
@@ -375,6 +432,51 @@ ada_inferior_exit (struct inferior *inf)
   set_inferior_data (inf, ada_inferior_data, NULL);
 }
 
+
+                       /* program-space-specific data.  */
+
+/* This module's per-program-space data.  */
+struct ada_pspace_data
+{
+  /* The Ada symbol cache.  */
+  struct ada_symbol_cache *sym_cache;
+};
+
+/* Key to our per-program-space data.  */
+static const struct program_space_data *ada_pspace_data_handle;
+
+/* Return this module's data for the given program space (PSPACE).
+   If not is found, add a zero'ed one now.
+
+   This function always returns a valid object.  */
+
+static struct ada_pspace_data *
+get_ada_pspace_data (struct program_space *pspace)
+{
+  struct ada_pspace_data *data;
+
+  data = program_space_data (pspace, ada_pspace_data_handle);
+  if (data == NULL)
+    {
+      data = XCNEW (struct ada_pspace_data);
+      set_program_space_data (pspace, ada_pspace_data_handle, data);
+    }
+
+  return data;
+}
+
+/* The cleanup callback for this module's per-program-space data.  */
+
+static void
+ada_pspace_data_cleanup (struct program_space *pspace, void *data)
+{
+  struct ada_pspace_data *pspace_data = data;
+
+  if (pspace_data->sym_cache != NULL)
+    ada_free_symbol_cache (pspace_data->sym_cache);
+  xfree (pspace_data);
+}
+
                         /* Utilities */
 
 /* If TYPE is a TYPE_CODE_TYPEDEF type, return the target type after
@@ -419,8 +521,16 @@ ada_typedef_target_type (struct type *type)
 static const char *
 ada_unqualified_name (const char *decoded_name)
 {
-  const char *result = strrchr (decoded_name, '.');
+  const char *result;
+  
+  /* If the decoded name starts with '<', it means that the encoded
+     name does not follow standard naming conventions, and thus that
+     it is not your typical Ada symbol name.  Trying to unqualify it
+     is therefore pointless and possibly erroneous.  */
+  if (decoded_name[0] == '<')
+    return decoded_name;
 
+  result = strrchr (decoded_name, '.');
   if (result != NULL)
     result++;                   /* Skip the dot...  */
   else
@@ -486,7 +596,7 @@ field_name_match (const char *field_name, const char *target)
   return
     (strncmp (field_name, target, len) == 0
      && (field_name[len] == '\0'
-         || (strncmp (field_name + len, "___", 3) == 0
+         || (startswith (field_name + len, "___")
              && strcmp (field_name + strlen (field_name) - 6,
                         "___XVN") != 0)));
 }
@@ -566,7 +676,7 @@ coerce_unspec_val_to_type (struct value *val, struct type *type)
 
       /* Make sure that the object size is not unreasonable before
          trying to allocate some memory for it.  */
-      check_size (type);
+      ada_ensure_varsize_limit (type);
 
       if (value_lazy (val)
           || TYPE_LENGTH (type) > TYPE_LENGTH (value_type (val)))
@@ -574,14 +684,12 @@ coerce_unspec_val_to_type (struct value *val, struct type *type)
       else
        {
          result = allocate_value (type);
-         memcpy (value_contents_raw (result), value_contents (val),
-                 TYPE_LENGTH (type));
+         value_contents_copy_raw (result, 0, val, 0, TYPE_LENGTH (type));
        }
       set_value_component_location (result, val);
       set_value_bitsize (result, value_bitsize (val));
       set_value_bitpos (result, value_bitpos (val));
       set_value_address (result, value_address (val));
-      set_value_optimized_out (result, value_optimized_out (val));
       return result;
     }
 }
@@ -630,8 +738,8 @@ lim_warning (const char *format, ...)
    i.e. if it would be a bad idea to allocate a value of this type in
    GDB.  */
 
-static void
-check_size (const struct type *type)
+void
+ada_ensure_varsize_limit (const struct type *type)
 {
   if (TYPE_LENGTH (type) > varsize_limit)
     error (_("object size is larger than varsize-limit"));
@@ -686,6 +794,7 @@ min_of_type (struct type *t)
 LONGEST
 ada_discrete_type_high_bound (struct type *type)
 {
+  type = resolve_dynamic_type (type, NULL, 0);
   switch (TYPE_CODE (type))
     {
     case TYPE_CODE_RANGE:
@@ -706,6 +815,7 @@ ada_discrete_type_high_bound (struct type *type)
 LONGEST
 ada_discrete_type_low_bound (struct type *type)
 {
+  type = resolve_dynamic_type (type, NULL, 0);
   switch (TYPE_CODE (type))
     {
     case TYPE_CODE_RANGE:
@@ -787,7 +897,7 @@ enum language
 ada_update_initial_language (enum language lang)
 {
   if (lookup_minimal_symbol ("adainit", (const char *) NULL,
-                             (struct objfile *) NULL) != NULL)
+                             (struct objfile *) NULL).minsym != NULL)
     return language_ada;
 
   return lang;
@@ -800,7 +910,7 @@ ada_update_initial_language (enum language lang)
 char *
 ada_main_name (void)
 {
-  struct minimal_symbol *msym;
+  struct bound_minimal_symbol msym;
   static char *main_program_name = NULL;
 
   /* For Ada, the name of the main procedure is stored in a specific
@@ -810,12 +920,12 @@ ada_main_name (void)
      in Ada.  */
   msym = lookup_minimal_symbol (ADA_MAIN_PROGRAM_SYMBOL_NAME, NULL, NULL);
 
-  if (msym != NULL)
+  if (msym.minsym != NULL)
     {
       CORE_ADDR main_program_name_addr;
       int err_code;
 
-      main_program_name_addr = SYMBOL_VALUE_ADDRESS (msym);
+      main_program_name_addr = BMSYMBOL_VALUE_ADDRESS (msym);
       if (main_program_name_addr == 0)
         error (_("Invalid address for Ada main program name."));
 
@@ -893,8 +1003,7 @@ ada_encode (const char *decoded)
 
           for (mapping = ada_opname_table;
                mapping->encoded != NULL
-               && strncmp (mapping->decoded, p,
-                           strlen (mapping->decoded)) != 0; mapping += 1)
+               && !startswith (p, mapping->decoded); mapping += 1)
             ;
           if (mapping->encoded == NULL)
             error (_("invalid Ada operator name: %s"), p);
@@ -975,9 +1084,9 @@ ada_remove_trailing_digits (const char *encoded, int *len)
         *len = i;
       else if (i >= 0 && encoded[i] == '$')
         *len = i;
-      else if (i >= 2 && strncmp (encoded + i - 2, "___", 3) == 0)
+      else if (i >= 2 && startswith (encoded + i - 2, "___"))
         *len = i - 2;
-      else if (i >= 1 && strncmp (encoded + i - 1, "__", 2) == 0)
+      else if (i >= 1 && startswith (encoded + i - 1, "__"))
         *len = i - 1;
     }
 }
@@ -1046,7 +1155,7 @@ ada_decode (const char *encoded)
   /* The name of the Ada main procedure starts with "_ada_".
      This prefix is not part of the decoded name, so skip this part
      if we see this prefix.  */
-  if (strncmp (encoded, "_ada_", 5) == 0)
+  if (startswith (encoded, "_ada_"))
     encoded += 5;
 
   /* If the name starts with '_', then it is not a properly encoded
@@ -1077,20 +1186,20 @@ ada_decode (const char *encoded)
      is for the body of a task, but that information does not actually
      appear in the decoded name.  */
 
-  if (len0 > 3 && strncmp (encoded + len0 - 3, "TKB", 3) == 0)
+  if (len0 > 3 && startswith (encoded + len0 - 3, "TKB"))
     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)
+  if (len0 > 2 && startswith (encoded + len0 - 2, "TB"))
     len0 -= 2;
 
   /* Remove trailing "B" suffixes.  */
   /* FIXME: brobecker/2006-04-19: Not sure what this are used for...  */
 
-  if (len0 > 1 && strncmp (encoded + len0 - 1, "B", 1) == 0)
+  if (len0 > 1 && startswith (encoded + len0 - 1, "B"))
     len0 -= 1;
 
   /* Make decoded big enough for possible expansion by operator name.  */
@@ -1148,7 +1257,7 @@ ada_decode (const char *encoded)
       /* Replace "TK__" with "__", which will eventually be translated
          into "." (just below).  */
 
-      if (i < len0 - 4 && strncmp (encoded + i, "TK__", 4) == 0)
+      if (i < len0 - 4 && startswith (encoded + i, "TK__"))
         i += 2;
 
       /* Replace "__B_{DIGITS}+__" sequences by "__", which will eventually
@@ -1357,7 +1466,7 @@ match_name (const char *sym_name, const char *name, int wild)
 
       return (strncmp (sym_name, name, len_name) == 0
               && is_name_suffix (sym_name + len_name))
-        || (strncmp (sym_name, "_ada_", 5) == 0
+        || (startswith (sym_name, "_ada_")
             && strncmp (sym_name + 5, name, len_name) == 0
             && is_name_suffix (sym_name + len_name + 5));
     }
@@ -1874,9 +1983,9 @@ ada_type_of_array (struct value *arr, int bounds)
           struct value *high = desc_one_bound (descriptor, arity, 1);
 
           arity -= 1;
-          create_range_type (range_type, value_type (low),
-                             longest_to_int (value_as_long (low)),
-                             longest_to_int (value_as_long (high)));
+          create_static_range_type (range_type, value_type (low),
+                                   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)))
@@ -1940,7 +2049,7 @@ ada_coerce_to_simple_array (struct value *arr)
 
       if (arrVal == NULL)
         error (_("Bounds unavailable for null array pointer."));
-      check_size (TYPE_TARGET_TYPE (value_type (arrVal)));
+      ada_ensure_varsize_limit (TYPE_TARGET_TYPE (value_type (arrVal)));
       return value_ind (arrVal);
     }
   else if (ada_is_constrained_packed_array_type (value_type (arr)))
@@ -2042,7 +2151,15 @@ decode_packed_array_bitsize (struct type *type)
    but with the bit sizes of its elements (and those of any
    constituent arrays) recorded in the BITSIZE components of its
    TYPE_FIELD_BITSIZE values, and with *ELT_BITS set to its total size
-   in bits.  */
+   in bits.
+
+   Note that, for arrays whose index type has an XA encoding where
+   a bound references a record discriminant, getting that discriminant,
+   and therefore the actual value of that bound, is not possible
+   because none of the given parameters gives us access to the record.
+   This function assumes that it is OK in the context where it is being
+   used to return an array whose bounds are still dynamic and where
+   the length is arbitrary.  */
 
 static struct type *
 constrained_packed_array_type (struct type *type, long *elt_bits)
@@ -2072,7 +2189,9 @@ constrained_packed_array_type (struct type *type, long *elt_bits)
   TYPE_FIELD_BITSIZE (new_type, 0) = *elt_bits;
   TYPE_NAME (new_type) = ada_type_name (type);
 
-  if (get_discrete_bounds (index_type, &low_bound, &high_bound) < 0)
+  if ((TYPE_CODE (check_typedef (index_type)) == TYPE_CODE_RANGE
+       && is_dynamic_type (check_typedef (index_type)))
+      || get_discrete_bounds (index_type, &low_bound, &high_bound) < 0)
     low_bound = high_bound = 0;
   if (high_bound < low_bound)
     *elt_bits = TYPE_LENGTH (new_type) = 0;
@@ -2119,7 +2238,7 @@ decode_constrained_packed_array_type (struct type *type)
       lim_warning (_("could not find bounds information on packed array"));
       return NULL;
     }
-  CHECK_TYPEDEF (shadow_type);
+  shadow_type = check_typedef (shadow_type);
 
   if (TYPE_CODE (shadow_type) != TYPE_CODE_ARRAY)
     {
@@ -2143,14 +2262,14 @@ decode_constrained_packed_array (struct value *arr)
 {
   struct type *type;
 
-  arr = ada_coerce_ref (arr);
-
-  /* If our value is a pointer, then dererence it.  Make sure that
-     this operation does not cause the target type to be fixed, as
-     this would indirectly cause this array to be decoded.  The rest
-     of the routine assumes that the array hasn't been decoded yet,
-     so we use the basic "value_ind" routine to perform the dereferencing,
-     as opposed to using "ada_value_ind".  */
+  /* If our value is a pointer, then dereference it. Likewise if
+     the value is a reference.  Make sure that this operation does not
+     cause the target type to be fixed, as this would indirectly cause
+     this array to be decoded.  The rest of the routine assumes that
+     the array hasn't been decoded yet, so we use the basic "coerce_ref"
+     and "value_ind" routines to perform the dereferencing, as opposed
+     to using "ada_coerce_ref" or "ada_value_ind".  */
+  arr = coerce_ref (arr);
   if (TYPE_CODE (ada_check_typedef (value_type (arr))) == TYPE_CODE_PTR)
     arr = value_ind (arr);
 
@@ -2298,9 +2417,21 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
     }
   else if (VALUE_LVAL (obj) == lval_memory && value_lazy (obj))
     {
-      v = value_at (type, value_address (obj));
+      v = value_at (type, value_address (obj) + offset);
+      type = value_type (v);
+      if (TYPE_LENGTH (type) * HOST_CHAR_BIT < bit_size)
+       {
+         /* This can happen in the case of an array of dynamic objects,
+            where the size of each element changes from element to element.
+            In that case, we're initially given the array stride, but
+            after resolving the element type, we find that its size is
+            less than this stride.  In that case, adjust bit_size to
+            match TYPE's length, and recompute LEN accordingly.  */
+         bit_size = TYPE_LENGTH (type) * HOST_CHAR_BIT;
+         len = TYPE_LENGTH (type) + (bit_offset + HOST_CHAR_BIT - 1) / 8;
+       }
       bytes = (unsigned char *) alloca (len);
-      read_memory (value_address (v) + offset, bytes, len);
+      read_memory (value_address (v), bytes, len);
     }
   else
     {
@@ -2413,11 +2544,16 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
       accum |= sign << accumSize;
       unpacked[targ] = accum & ~(~0L << HOST_CHAR_BIT);
       accumSize -= HOST_CHAR_BIT;
+      if (accumSize < 0)
+       accumSize = 0;
       accum >>= HOST_CHAR_BIT;
       ntarg -= 1;
       targ += delta;
     }
 
+  if (is_dynamic_type (value_type (v)))
+    v = value_from_contents_and_address (value_type (v), value_contents (v),
+                                        0);
   return v;
 }
 
@@ -2548,21 +2684,27 @@ ada_value_assign (struct value *toval, struct value *fromval)
 }
 
 
-/* Given that COMPONENT is a memory lvalue that is part of the lvalue 
- * CONTAINER, assign the contents of VAL to COMPONENTS's place in 
- * CONTAINER.  Modifies the VALUE_CONTENTS of CONTAINER only, not 
- * COMPONENT, and not the inferior's memory.  The current contents 
- * of COMPONENT are ignored.  */
+/* Given that COMPONENT is a memory lvalue that is part of the lvalue
+   CONTAINER, assign the contents of VAL to COMPONENTS's place in
+   CONTAINER.  Modifies the VALUE_CONTENTS of CONTAINER only, not
+   COMPONENT, and not the inferior's memory.  The current contents
+   of COMPONENT are ignored.
+
+   Although not part of the initial design, this function also works
+   when CONTAINER and COMPONENT are not_lval's: it works as if CONTAINER
+   had a null address, and COMPONENT had an address which is equal to
+   its offset inside CONTAINER.  */
+
 static void
 value_assign_to_component (struct value *container, struct value *component,
                           struct value *val)
 {
   LONGEST offset_in_container =
     (LONGEST)  (value_address (component) - value_address (container));
-  int bit_offset_in_container = 
+  int bit_offset_in_container =
     value_bitpos (component) - value_bitpos (container);
   int bits;
-  
+
   val = value_cast (value_type (component), val);
 
   if (value_bitsize (component) == 0)
@@ -2571,17 +2713,17 @@ value_assign_to_component (struct value *container, struct value *component,
     bits = value_bitsize (component);
 
   if (gdbarch_bits_big_endian (get_type_arch (value_type (container))))
-    move_bits (value_contents_writeable (container) + offset_in_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, 1);
   else
-    move_bits (value_contents_writeable (container) + offset_in_container, 
+    move_bits (value_contents_writeable (container) + offset_in_container,
               value_bitpos (container) + bit_offset_in_container,
               value_contents (val), 0, bits, 0);
-}             
-                       
+}
+
 /* The value of the element of array ARR at the ARITY indices given in IND.
    ARR may be either a simple array, GNAT array descriptor, or pointer
    thereto.  */
@@ -2609,26 +2751,29 @@ ada_value_subscript (struct value *arr, int arity, struct value **ind)
   return elt;
 }
 
-/* Assuming ARR is a pointer to a standard GDB array of type TYPE, the
-   value of the element of *ARR at the ARITY indices given in
-   IND.  Does not read the entire array into memory.  */
+/* Assuming ARR is a pointer to a GDB array, the value of the element
+   of *ARR at the ARITY indices given in IND.
+   Does not read the entire array into memory.  */
 
 static struct value *
-ada_value_ptr_subscript (struct value *arr, struct type *type, int arity,
-                         struct value **ind)
+ada_value_ptr_subscript (struct value *arr, int arity, struct value **ind)
 {
   int k;
+  struct type *type
+    = check_typedef (value_enclosing_type (ada_value_ind (arr)));
 
   for (k = 0; k < arity; k += 1)
     {
       LONGEST lwb, upb;
+      struct value *lwb_value;
 
       if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
         error (_("too many subscripts (%d expected)"), k);
       arr = value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
                         value_copy (arr));
       get_discrete_bounds (TYPE_INDEX_TYPE (type), &lwb, &upb);
-      arr = value_ptradd (arr, pos_atr (ind[k]) - lwb);
+      lwb_value = value_from_longest (value_type(ind[k]), lwb);
+      arr = value_ptradd (arr, pos_atr (ind[k]) - pos_atr (lwb_value));
       type = TYPE_TARGET_TYPE (type);
     }
 
@@ -2636,23 +2781,34 @@ ada_value_ptr_subscript (struct value *arr, struct type *type, int arity,
 }
 
 /* Given that ARRAY_PTR is a pointer or reference to an array of type TYPE (the
-   actual type of ARRAY_PTR is ignored), returns 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'Pos-LOW'Pos+1 elements starting at index LOW.  The lower bound of
+   this array is LOW, as per Ada rules.  */
 static struct value *
 ada_value_slice_from_ptr (struct value *array_ptr, struct type *type,
                           int low, int high)
 {
   struct type *type0 = ada_check_typedef (type);
-  CORE_ADDR base = value_as_address (array_ptr)
-    + ((low - ada_discrete_type_low_bound (TYPE_INDEX_TYPE (type0)))
-       * TYPE_LENGTH (TYPE_TARGET_TYPE (type0)));
-  struct type *index_type =
-    create_range_type (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type0)),
-                       low, high);
+  struct type *base_index_type = TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type0));
+  struct type *index_type
+    = create_static_range_type (NULL, base_index_type, low, high);
   struct type *slice_type =
     create_array_type (NULL, TYPE_TARGET_TYPE (type0), index_type);
+  int base_low =  ada_discrete_type_low_bound (TYPE_INDEX_TYPE (type0));
+  LONGEST base_low_pos, low_pos;
+  CORE_ADDR base;
+
+  if (!discrete_position (base_index_type, low, &low_pos)
+      || !discrete_position (base_index_type, base_low, &base_low_pos))
+    {
+      warning (_("unable to get positions in slice, use bounds instead"));
+      low_pos = low;
+      base_low_pos = base_low;
+    }
 
+  base = value_as_address (array_ptr)
+    + ((low_pos - base_low_pos)
+       * TYPE_LENGTH (TYPE_TARGET_TYPE (type0)));
   return value_at_lazy (slice_type, base);
 }
 
@@ -2661,12 +2817,23 @@ static struct value *
 ada_value_slice (struct value *array, int low, int high)
 {
   struct type *type = ada_check_typedef (value_type (array));
-  struct type *index_type =
-    create_range_type (NULL, TYPE_INDEX_TYPE (type), low, high);
+  struct type *base_index_type = TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type));
+  struct type *index_type
+    = create_static_range_type (NULL, TYPE_INDEX_TYPE (type), low, high);
   struct type *slice_type =
     create_array_type (NULL, TYPE_TARGET_TYPE (type), index_type);
+  LONGEST low_pos, high_pos;
+
+  if (!discrete_position (base_index_type, low, &low_pos)
+      || !discrete_position (base_index_type, high, &high_pos))
+    {
+      warning (_("unable to get positions in slice, use bounds instead"));
+      low_pos = low;
+      high_pos = high;
+    }
 
-  return value_cast (slice_type, value_slice (array, low, high - low + 1));
+  return value_cast (slice_type,
+                    value_slice (array, low, high_pos - low_pos + 1));
 }
 
 /* If type is a record type in the form of a standard GNAT array
@@ -2787,9 +2954,9 @@ ada_index_type (struct type *type, int n, const char *name)
    by run-time quantities other than discriminants.  */
 
 static LONGEST
-ada_array_bound_from_type (struct type * arr_type, int n, int which)
+ada_array_bound_from_type (struct type *arr_type, int n, int which)
 {
-  struct type *type, *elt_type, *index_type_desc, *index_type;
+  struct type *type, *index_type_desc, *index_type;
   int i;
 
   gdb_assert (which == 0 || which == 1);
@@ -2805,17 +2972,31 @@ 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);
+  if (TYPE_FIXED_INSTANCE (type))
+    {
+      /* The array has already been fixed, so we do not need to
+        check the parallel ___XA type again.  That encoding has
+        already been applied, so ignore it now.  */
+      index_type_desc = NULL;
+    }
+  else
+    {
+      index_type_desc = ada_find_parallel_type (type, "___XA");
+      ada_fixup_array_indexes_type (index_type_desc);
+    }
 
-  index_type_desc = ada_find_parallel_type (type, "___XA");
-  ada_fixup_array_indexes_type (index_type_desc);
   if (index_type_desc != NULL)
     index_type = to_fixed_range_type (TYPE_FIELD_TYPE (index_type_desc, n - 1),
                                      NULL);
   else
-    index_type = TYPE_INDEX_TYPE (elt_type);
+    {
+      struct type *elt_type = check_typedef (type);
+
+      for (i = 1; i < n; i++)
+       elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type));
+
+      index_type = TYPE_INDEX_TYPE (elt_type);
+    }
 
   return
     (LONGEST) (which == 0
@@ -2831,7 +3012,11 @@ ada_array_bound_from_type (struct type * arr_type, int n, int which)
 static LONGEST
 ada_array_bound (struct value *arr, int n, int which)
 {
-  struct type *arr_type = value_type (arr);
+  struct type *arr_type;
+
+  if (TYPE_CODE (check_typedef (value_type (arr))) == TYPE_CODE_PTR)
+    arr = value_ind (arr);
+  arr_type = value_enclosing_type (arr);
 
   if (ada_is_constrained_packed_array_type (arr_type))
     return ada_array_bound (decode_constrained_packed_array (arr), n, which);
@@ -2850,17 +3035,41 @@ ada_array_bound (struct value *arr, int n, int which)
 static LONGEST
 ada_array_length (struct value *arr, int n)
 {
-  struct type *arr_type = ada_check_typedef (value_type (arr));
+  struct type *arr_type, *index_type;
+  int low, high;
+
+  if (TYPE_CODE (check_typedef (value_type (arr))) == TYPE_CODE_PTR)
+    arr = value_ind (arr);
+  arr_type = value_enclosing_type (arr);
 
   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)
-           - ada_array_bound_from_type (arr_type, n, 0) + 1);
+    {
+      low = ada_array_bound_from_type (arr_type, n, 0);
+      high = ada_array_bound_from_type (arr_type, n, 1);
+    }
   else
-    return (value_as_long (desc_one_bound (desc_bounds (arr), n, 1))
-           - value_as_long (desc_one_bound (desc_bounds (arr), n, 0)) + 1);
+    {
+      low = value_as_long (desc_one_bound (desc_bounds (arr), n, 0));
+      high = value_as_long (desc_one_bound (desc_bounds (arr), n, 1));
+    }
+
+  arr_type = check_typedef (arr_type);
+  index_type = TYPE_INDEX_TYPE (arr_type);
+  if (index_type != NULL)
+    {
+      struct type *base_type;
+      if (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
+       base_type = TYPE_TARGET_TYPE (index_type);
+      else
+       base_type = index_type;
+
+      low = pos_atr (value_from_longest (base_type, low));
+      high = pos_atr (value_from_longest (base_type, high));
+    }
+  return high - low + 1;
 }
 
 /* An empty array whose type is that of ARR_TYPE (an array type),
@@ -2870,9 +3079,9 @@ static struct value *
 empty_array (struct type *arr_type, int low)
 {
   struct type *arr_type0 = ada_check_typedef (arr_type);
-  struct type *index_type =
-    create_range_type (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (arr_type0)),
-                       low, low - 1);
+  struct type *index_type
+    = create_static_range_type
+        (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (arr_type0)),  low, low - 1);
   struct type *elt_type = ada_array_element_type (arr_type0, 1);
 
   return allocate_value (create_array_type (NULL, elt_type, index_type));
@@ -3102,7 +3311,7 @@ resolve_subexp (struct expression **expp, int *pos, int deprocedure_p,
     case OP_VAR_VALUE:
       if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
         {
-          struct ada_symbol_info *candidates;
+          struct block_symbol *candidates;
           int n_candidates;
 
           n_candidates =
@@ -3118,7 +3327,7 @@ resolve_subexp (struct expression **expp, int *pos, int deprocedure_p,
                  out all types.  */
               int j;
               for (j = 0; j < n_candidates; j += 1)
-                switch (SYMBOL_CLASS (candidates[j].sym))
+                switch (SYMBOL_CLASS (candidates[j].symbol))
                   {
                   case LOC_REGISTER:
                   case LOC_ARG:
@@ -3136,7 +3345,7 @@ resolve_subexp (struct expression **expp, int *pos, int deprocedure_p,
                   j = 0;
                   while (j < n_candidates)
                     {
-                      if (SYMBOL_CLASS (candidates[j].sym) == LOC_TYPEDEF)
+                      if (SYMBOL_CLASS (candidates[j].symbol) == LOC_TYPEDEF)
                         {
                           candidates[j] = candidates[n_candidates - 1];
                           n_candidates -= 1;
@@ -3172,7 +3381,7 @@ resolve_subexp (struct expression **expp, int *pos, int deprocedure_p,
             }
 
           exp->elts[pc + 1].block = candidates[i].block;
-          exp->elts[pc + 2].symbol = candidates[i].sym;
+          exp->elts[pc + 2].symbol = candidates[i].symbol;
           if (innermost_block == NULL
               || contained_in (candidates[i].block, innermost_block))
             innermost_block = candidates[i].block;
@@ -3194,7 +3403,7 @@ resolve_subexp (struct expression **expp, int *pos, int deprocedure_p,
         if (exp->elts[pc + 3].opcode == OP_VAR_VALUE
             && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
           {
-            struct ada_symbol_info *candidates;
+            struct block_symbol *candidates;
             int n_candidates;
 
             n_candidates =
@@ -3217,7 +3426,7 @@ resolve_subexp (struct expression **expp, int *pos, int deprocedure_p,
               }
 
             exp->elts[pc + 4].block = candidates[i].block;
-            exp->elts[pc + 5].symbol = candidates[i].sym;
+            exp->elts[pc + 5].symbol = candidates[i].symbol;
             if (innermost_block == NULL
                 || contained_in (candidates[i].block, innermost_block))
               innermost_block = candidates[i].block;
@@ -3247,7 +3456,7 @@ resolve_subexp (struct expression **expp, int *pos, int deprocedure_p,
     case UNOP_ABS:
       if (possible_user_operator_p (op, argvec))
         {
-          struct ada_symbol_info *candidates;
+          struct block_symbol *candidates;
           int n_candidates;
 
           n_candidates =
@@ -3259,8 +3468,9 @@ resolve_subexp (struct expression **expp, int *pos, int deprocedure_p,
           if (i < 0)
             break;
 
-          replace_operator_with_call (expp, pc, nargs, 1,
-                                      candidates[i].sym, candidates[i].block);
+         replace_operator_with_call (expp, pc, nargs, 1,
+                                     candidates[i].symbol,
+                                     candidates[i].block);
           exp = *expp;
         }
       break;
@@ -3414,7 +3624,7 @@ return_match (struct type *func_type, struct type *context_type)
    the process; the index returned is for the modified vector.  */
 
 static int
-ada_resolve_function (struct ada_symbol_info syms[],
+ada_resolve_function (struct block_symbol syms[],
                       int nsyms, struct value **args, int nargs,
                       const char *name, struct type *context_type)
 {
@@ -3430,9 +3640,9 @@ ada_resolve_function (struct ada_symbol_info syms[],
     {
       for (k = 0; k < nsyms; k += 1)
         {
-          struct type *type = ada_check_typedef (SYMBOL_TYPE (syms[k].sym));
+          struct type *type = ada_check_typedef (SYMBOL_TYPE (syms[k].symbol));
 
-          if (ada_args_match (syms[k].sym, args, nargs)
+          if (ada_args_match (syms[k].symbol, args, nargs)
               && (fallback || return_match (type, context_type)))
             {
               syms[m] = syms[k];
@@ -3495,19 +3705,19 @@ encoded_ordered_before (const char *N0, const char *N1)
    encoded names.  */
 
 static void
-sort_choices (struct ada_symbol_info syms[], int nsyms)
+sort_choices (struct block_symbol syms[], int nsyms)
 {
   int i;
 
   for (i = 1; i < nsyms; i += 1)
     {
-      struct ada_symbol_info sym = syms[i];
+      struct block_symbol sym = syms[i];
       int j;
 
       for (j = i - 1; j >= 0; j -= 1)
         {
-          if (encoded_ordered_before (SYMBOL_LINKAGE_NAME (syms[j].sym),
-                                      SYMBOL_LINKAGE_NAME (sym.sym)))
+          if (encoded_ordered_before (SYMBOL_LINKAGE_NAME (syms[j].symbol),
+                                      SYMBOL_LINKAGE_NAME (sym.symbol)))
             break;
           syms[j + 1] = syms[j];
         }
@@ -3524,7 +3734,7 @@ sort_choices (struct ada_symbol_info syms[], int nsyms)
    to be re-integrated one of these days.  */
 
 int
-user_select_syms (struct ada_symbol_info *syms, int nsyms, int max_results)
+user_select_syms (struct block_symbol *syms, int nsyms, int max_results)
 {
   int i;
   int *chosen = (int *) alloca (sizeof (int) * nsyms);
@@ -3556,22 +3766,22 @@ See set/show multiple-symbol."));
 
   for (i = 0; i < nsyms; i += 1)
     {
-      if (syms[i].sym == NULL)
+      if (syms[i].symbol == NULL)
         continue;
 
-      if (SYMBOL_CLASS (syms[i].sym) == LOC_BLOCK)
+      if (SYMBOL_CLASS (syms[i].symbol) == LOC_BLOCK)
         {
           struct symtab_and_line sal =
-            find_function_start_sal (syms[i].sym, 1);
+            find_function_start_sal (syms[i].symbol, 1);
 
          if (sal.symtab == NULL)
            printf_unfiltered (_("[%d] %s at <no source file available>:%d\n"),
                               i + first_choice,
-                              SYMBOL_PRINT_NAME (syms[i].sym),
+                              SYMBOL_PRINT_NAME (syms[i].symbol),
                               sal.line);
          else
            printf_unfiltered (_("[%d] %s at %s:%d\n"), i + first_choice,
-                              SYMBOL_PRINT_NAME (syms[i].sym),
+                              SYMBOL_PRINT_NAME (syms[i].symbol),
                               symtab_to_filename_for_display (sal.symtab),
                               sal.line);
           continue;
@@ -3579,39 +3789,42 @@ See set/show multiple-symbol."));
       else
         {
           int is_enumeral =
-            (SYMBOL_CLASS (syms[i].sym) == LOC_CONST
-             && SYMBOL_TYPE (syms[i].sym) != NULL
-             && TYPE_CODE (SYMBOL_TYPE (syms[i].sym)) == TYPE_CODE_ENUM);
-          struct symtab *symtab = SYMBOL_SYMTAB (syms[i].sym);
+            (SYMBOL_CLASS (syms[i].symbol) == LOC_CONST
+             && SYMBOL_TYPE (syms[i].symbol) != NULL
+             && TYPE_CODE (SYMBOL_TYPE (syms[i].symbol)) == TYPE_CODE_ENUM);
+         struct symtab *symtab = NULL;
 
-          if (SYMBOL_LINE (syms[i].sym) != 0 && symtab != NULL)
+         if (SYMBOL_OBJFILE_OWNED (syms[i].symbol))
+           symtab = symbol_symtab (syms[i].symbol);
+
+          if (SYMBOL_LINE (syms[i].symbol) != 0 && symtab != NULL)
             printf_unfiltered (_("[%d] %s at %s:%d\n"),
                                i + first_choice,
-                               SYMBOL_PRINT_NAME (syms[i].sym),
+                               SYMBOL_PRINT_NAME (syms[i].symbol),
                               symtab_to_filename_for_display (symtab),
-                              SYMBOL_LINE (syms[i].sym));
+                              SYMBOL_LINE (syms[i].symbol));
           else if (is_enumeral
-                   && TYPE_NAME (SYMBOL_TYPE (syms[i].sym)) != NULL)
+                   && TYPE_NAME (SYMBOL_TYPE (syms[i].symbol)) != NULL)
             {
               printf_unfiltered (("[%d] "), i + first_choice);
-              ada_print_type (SYMBOL_TYPE (syms[i].sym), NULL,
+              ada_print_type (SYMBOL_TYPE (syms[i].symbol), NULL,
                               gdb_stdout, -1, 0, &type_print_raw_options);
               printf_unfiltered (_("'(%s) (enumeral)\n"),
-                                 SYMBOL_PRINT_NAME (syms[i].sym));
+                                 SYMBOL_PRINT_NAME (syms[i].symbol));
             }
           else if (symtab != NULL)
             printf_unfiltered (is_enumeral
                                ? _("[%d] %s in %s (enumeral)\n")
                                : _("[%d] %s at %s:?\n"),
                                i + first_choice,
-                               SYMBOL_PRINT_NAME (syms[i].sym),
+                               SYMBOL_PRINT_NAME (syms[i].symbol),
                                symtab_to_filename_for_display (symtab));
           else
             printf_unfiltered (is_enumeral
                                ? _("[%d] %s (enumeral)\n")
                                : _("[%d] %s at ?\n"),
                                i + first_choice,
-                               SYMBOL_PRINT_NAME (syms[i].sym));
+                               SYMBOL_PRINT_NAME (syms[i].symbol));
         }
     }
 
@@ -4053,7 +4266,7 @@ parse_old_style_renaming (struct type *type,
 
 static struct value *
 ada_read_renaming_var_value (struct symbol *renaming_sym,
-                            struct block *block)
+                            const struct block *block)
 {
   const char *sym_name;
   struct expression *expr;
@@ -4143,6 +4356,16 @@ ada_convert_actual (struct value *actual, struct type *formal_type0)
     }
   else if (TYPE_CODE (actual_type) == TYPE_CODE_PTR)
     return ada_value_ind (actual);
+  else if (ada_is_aligner_type (formal_type))
+    {
+      /* We need to turn this parameter into an aligner type
+        as well.  */
+      struct value *aligner = allocate_value (formal_type);
+      struct value *component = ada_value_struct_elt (aligner, "F", 0);
+
+      value_assign_to_component (aligner, component, actual);
+      return aligner;
+    }
 
   return actual;
 }
@@ -4219,20 +4442,144 @@ make_array_descriptor (struct type *type, struct value *arr)
     return descriptor;
 }
 \f
-/* Dummy definitions for an experimental caching module that is not
- * used in the public sources.  */
+                                /* Symbol Cache Module */
+
+/* Performance measurements made as of 2010-01-15 indicate that
+   this cache does bring some noticeable improvements.  Depending
+   on the type of entity being printed, the cache can make it as much
+   as an order of magnitude faster than without it.
+
+   The descriptive type DWARF extension has significantly reduced
+   the need for this cache, at least when DWARF is being used.  However,
+   even in this case, some expensive name-based symbol searches are still
+   sometimes necessary - to find an XVZ variable, mostly.  */
+
+/* Initialize the contents of SYM_CACHE.  */
+
+static void
+ada_init_symbol_cache (struct ada_symbol_cache *sym_cache)
+{
+  obstack_init (&sym_cache->cache_space);
+  memset (sym_cache->root, '\000', sizeof (sym_cache->root));
+}
+
+/* Free the memory used by SYM_CACHE.  */
+
+static void
+ada_free_symbol_cache (struct ada_symbol_cache *sym_cache)
+{
+  obstack_free (&sym_cache->cache_space, NULL);
+  xfree (sym_cache);
+}
+
+/* Return the symbol cache associated to the given program space PSPACE.
+   If not allocated for this PSPACE yet, allocate and initialize one.  */
+
+static struct ada_symbol_cache *
+ada_get_symbol_cache (struct program_space *pspace)
+{
+  struct ada_pspace_data *pspace_data = get_ada_pspace_data (pspace);
+
+  if (pspace_data->sym_cache == NULL)
+    {
+      pspace_data->sym_cache = XCNEW (struct ada_symbol_cache);
+      ada_init_symbol_cache (pspace_data->sym_cache);
+    }
+
+  return pspace_data->sym_cache;
+}
+
+/* Clear all entries from the symbol cache.  */
+
+static void
+ada_clear_symbol_cache (void)
+{
+  struct ada_symbol_cache *sym_cache
+    = ada_get_symbol_cache (current_program_space);
+
+  obstack_free (&sym_cache->cache_space, NULL);
+  ada_init_symbol_cache (sym_cache);
+}
+
+/* Search our cache for an entry matching NAME and DOMAIN.
+   Return it if found, or NULL otherwise.  */
+
+static struct cache_entry **
+find_entry (const char *name, domain_enum domain)
+{
+  struct ada_symbol_cache *sym_cache
+    = ada_get_symbol_cache (current_program_space);
+  int h = msymbol_hash (name) % HASH_SIZE;
+  struct cache_entry **e;
+
+  for (e = &sym_cache->root[h]; *e != NULL; e = &(*e)->next)
+    {
+      if (domain == (*e)->domain && strcmp (name, (*e)->name) == 0)
+        return e;
+    }
+  return NULL;
+}
+
+/* Search the symbol cache for an entry matching NAME and DOMAIN.
+   Return 1 if found, 0 otherwise.
+
+   If an entry was found and SYM is not NULL, set *SYM to the entry's
+   SYM.  Same principle for BLOCK if not NULL.  */
 
 static int
-lookup_cached_symbol (const char *name, domain_enum namespace,
-                      struct symbol **sym, struct block **block)
+lookup_cached_symbol (const char *name, domain_enum domain,
+                      struct symbol **sym, const struct block **block)
 {
-  return 0;
+  struct cache_entry **e = find_entry (name, domain);
+
+  if (e == NULL)
+    return 0;
+  if (sym != NULL)
+    *sym = (*e)->sym;
+  if (block != NULL)
+    *block = (*e)->block;
+  return 1;
 }
 
+/* Assuming that (SYM, BLOCK) is the result of the lookup of NAME
+   in domain DOMAIN, save this result in our symbol cache.  */
+
 static void
-cache_symbol (const char *name, domain_enum namespace, struct symbol *sym,
+cache_symbol (const char *name, domain_enum domain, struct symbol *sym,
               const struct block *block)
 {
+  struct ada_symbol_cache *sym_cache
+    = ada_get_symbol_cache (current_program_space);
+  int h;
+  char *copy;
+  struct cache_entry *e;
+
+  /* Symbols for builtin types don't have a block.
+     For now don't cache such symbols.  */
+  if (sym != NULL && !SYMBOL_OBJFILE_OWNED (sym))
+    return;
+
+  /* If the symbol is a local symbol, then do not cache it, as a search
+     for that symbol depends on the context.  To determine whether
+     the symbol is local or not, we check the block where we found it
+     against the global and static blocks of its associated symtab.  */
+  if (sym
+      && BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (symbol_symtab (sym)),
+                           GLOBAL_BLOCK) != block
+      && BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (symbol_symtab (sym)),
+                           STATIC_BLOCK) != block)
+    return;
+
+  h = msymbol_hash (name) % HASH_SIZE;
+  e = (struct cache_entry *) obstack_alloc (&sym_cache->cache_space,
+                                           sizeof (*e));
+  e->next = sym_cache->root[h];
+  sym_cache->root[h] = e;
+  e->name = copy = obstack_alloc (&sym_cache->cache_space, strlen (name) + 1);
+  strcpy (copy, name);
+  e->sym = sym;
+  e->domain = domain;
+  e->block = block;
 }
 \f
                                 /* Symbol Lookup */
@@ -4257,13 +4604,13 @@ standard_lookup (const char *name, const struct block *block,
                  domain_enum domain)
 {
   /* Initialize it just to avoid a GCC false warning.  */
-  struct symbol *sym = NULL;
+  struct block_symbol sym = {NULL, NULL};
 
-  if (lookup_cached_symbol (name, domain, &sym, NULL))
-    return sym;
+  if (lookup_cached_symbol (name, domain, &sym.symbol, NULL))
+    return sym.symbol;
   sym = lookup_symbol_in_language (name, block, domain, language_c, 0);
-  cache_symbol (name, domain, sym, block_found);
-  return sym;
+  cache_symbol (name, domain, sym.symbol, sym.block);
+  return sym.symbol;
 }
 
 
@@ -4271,14 +4618,14 @@ standard_lookup (const char *name, const struct block *block,
    in the symbol fields of SYMS[0..N-1].  We treat enumerals as functions, 
    since they contend in overloading in the same way.  */
 static int
-is_nonfunction (struct ada_symbol_info syms[], int n)
+is_nonfunction (struct block_symbol syms[], int n)
 {
   int i;
 
   for (i = 0; i < n; i += 1)
-    if (TYPE_CODE (SYMBOL_TYPE (syms[i].sym)) != TYPE_CODE_FUNC
-        && (TYPE_CODE (SYMBOL_TYPE (syms[i].sym)) != TYPE_CODE_ENUM
-            || SYMBOL_CLASS (syms[i].sym) != LOC_CONST))
+    if (TYPE_CODE (SYMBOL_TYPE (syms[i].symbol)) != TYPE_CODE_FUNC
+        && (TYPE_CODE (SYMBOL_TYPE (syms[i].symbol)) != TYPE_CODE_ENUM
+            || SYMBOL_CLASS (syms[i].symbol) != LOC_CONST))
       return 1;
 
   return 0;
@@ -4332,7 +4679,7 @@ lesseq_defined_than (struct symbol *sym0, struct symbol *sym1)
           TYPE_CODE (type0) == TYPE_CODE (type1)
           && (equiv_types (type0, type1)
               || (len0 < strlen (name1) && strncmp (name0, name1, len0) == 0
-                  && strncmp (name1 + len0, "___XV", 5) == 0));
+                  && startswith (name1 + len0, "___XV")));
       }
     case LOC_CONST:
       return SYMBOL_VALUE (sym0) == SYMBOL_VALUE (sym1)
@@ -4342,16 +4689,16 @@ lesseq_defined_than (struct symbol *sym0, struct symbol *sym1)
     }
 }
 
-/* Append (SYM,BLOCK,SYMTAB) to the end of the array of struct ada_symbol_info
+/* Append (SYM,BLOCK,SYMTAB) to the end of the array of struct block_symbol
    records in OBSTACKP.  Do nothing if SYM is a duplicate.  */
 
 static void
 add_defn_to_vec (struct obstack *obstackp,
                  struct symbol *sym,
-                 struct block *block)
+                 const struct block *block)
 {
   int i;
-  struct ada_symbol_info *prevDefns = defns_collected (obstackp, 0);
+  struct block_symbol *prevDefns = defns_collected (obstackp, 0);
 
   /* Do not try to complete stub types, as the debugger is probably
      already scanning all symbols matching a certain name at the
@@ -4364,59 +4711,62 @@ add_defn_to_vec (struct obstack *obstackp,
 
   for (i = num_defns_collected (obstackp) - 1; i >= 0; i -= 1)
     {
-      if (lesseq_defined_than (sym, prevDefns[i].sym))
+      if (lesseq_defined_than (sym, prevDefns[i].symbol))
         return;
-      else if (lesseq_defined_than (prevDefns[i].sym, sym))
+      else if (lesseq_defined_than (prevDefns[i].symbol, sym))
         {
-          prevDefns[i].sym = sym;
+          prevDefns[i].symbol = sym;
           prevDefns[i].block = block;
           return;
         }
     }
 
   {
-    struct ada_symbol_info info;
+    struct block_symbol info;
 
-    info.sym = sym;
+    info.symbol = sym;
     info.block = block;
-    obstack_grow (obstackp, &info, sizeof (struct ada_symbol_info));
+    obstack_grow (obstackp, &info, sizeof (struct block_symbol));
   }
 }
 
-/* Number of ada_symbol_info structures currently collected in 
-   current vector in *OBSTACKP.  */
+/* Number of block_symbol structures currently collected in current vector in
+   OBSTACKP.  */
 
 static int
 num_defns_collected (struct obstack *obstackp)
 {
-  return obstack_object_size (obstackp) / sizeof (struct ada_symbol_info);
+  return obstack_object_size (obstackp) / sizeof (struct block_symbol);
 }
 
-/* Vector of ada_symbol_info structures currently collected in current 
-   vector in *OBSTACKP.  If FINISH, close off the vector and return
-   its final address.  */
+/* Vector of block_symbol structures currently collected in current vector in
+   OBSTACKP.  If FINISH, close off the vector and return its final address.  */
 
-static struct ada_symbol_info *
+static struct block_symbol *
 defns_collected (struct obstack *obstackp, int finish)
 {
   if (finish)
     return obstack_finish (obstackp);
   else
-    return (struct ada_symbol_info *) obstack_base (obstackp);
+    return (struct block_symbol *) obstack_base (obstackp);
 }
 
-/* Return a minimal symbol matching NAME according to Ada decoding
-   rules.  Returns NULL if there is no such minimal symbol.  Names
-   prefixed with "standard__" are handled specially: "standard__" is
-   first stripped off, and only static and global symbols are searched.  */
+/* Return a bound minimal symbol matching NAME according to Ada
+   decoding rules.  Returns an invalid symbol if there is no such
+   minimal symbol.  Names prefixed with "standard__" are handled
+   specially: "standard__" is first stripped off, and only static and
+   global symbols are searched.  */
 
-struct minimal_symbol *
+struct bound_minimal_symbol
 ada_lookup_simple_minsym (const char *name)
 {
+  struct bound_minimal_symbol result;
   struct objfile *objfile;
   struct minimal_symbol *msymbol;
   const int wild_match_p = should_use_wild_match (name);
 
+  memset (&result, 0, sizeof (result));
+
   /* Special case: If the user specifies a symbol name inside package
      Standard, do a non-wild matching of the symbol name without
      the "standard__" prefix.  This was primarily introduced in order
@@ -4424,17 +4774,21 @@ ada_lookup_simple_minsym (const char *name)
      using, for instance, Standard.Constraint_Error when Constraint_Error
      is ambiguous (due to the user defining its own Constraint_Error
      entity inside its program).  */
-  if (strncmp (name, "standard__", sizeof ("standard__") - 1) == 0)
+  if (startswith (name, "standard__"))
     name += sizeof ("standard__") - 1;
 
   ALL_MSYMBOLS (objfile, msymbol)
   {
-    if (match_name (SYMBOL_LINKAGE_NAME (msymbol), name, wild_match_p)
+    if (match_name (MSYMBOL_LINKAGE_NAME (msymbol), name, wild_match_p)
         && MSYMBOL_TYPE (msymbol) != mst_solib_trampoline)
-      return msymbol;
+      {
+       result.minsym = msymbol;
+       result.objfile = objfile;
+       break;
+      }
   }
 
-  return NULL;
+  return result;
 }
 
 /* For all subprograms that statically enclose the subprogram of the
@@ -4445,7 +4799,7 @@ ada_lookup_simple_minsym (const char *name)
 
 static void
 add_symbols_from_enclosing_procs (struct obstack *obstackp,
-                                  const char *name, domain_enum namespace,
+                                  const char *name, domain_enum domain,
                                   int wild_match_p)
 {
 }
@@ -4525,7 +4879,7 @@ ada_identical_enum_types_p (struct type *type1, struct type *type2)
    So, for practical purposes, we consider them as the same.  */
 
 static int
-symbols_are_identical_enums (struct ada_symbol_info *syms, int nsyms)
+symbols_are_identical_enums (struct block_symbol *syms, int nsyms)
 {
   int i;
 
@@ -4538,26 +4892,26 @@ symbols_are_identical_enums (struct ada_symbol_info *syms, int nsyms)
 
   /* Quick check: All symbols should have an enum type.  */
   for (i = 0; i < nsyms; i++)
-    if (TYPE_CODE (SYMBOL_TYPE (syms[i].sym)) != TYPE_CODE_ENUM)
+    if (TYPE_CODE (SYMBOL_TYPE (syms[i].symbol)) != TYPE_CODE_ENUM)
       return 0;
 
   /* Quick check: They should all have the same value.  */
   for (i = 1; i < nsyms; i++)
-    if (SYMBOL_VALUE (syms[i].sym) != SYMBOL_VALUE (syms[0].sym))
+    if (SYMBOL_VALUE (syms[i].symbol) != SYMBOL_VALUE (syms[0].symbol))
       return 0;
 
   /* Quick check: They should all have the same number of enumerals.  */
   for (i = 1; i < nsyms; i++)
-    if (TYPE_NFIELDS (SYMBOL_TYPE (syms[i].sym))
-        != TYPE_NFIELDS (SYMBOL_TYPE (syms[0].sym)))
+    if (TYPE_NFIELDS (SYMBOL_TYPE (syms[i].symbol))
+        != TYPE_NFIELDS (SYMBOL_TYPE (syms[0].symbol)))
       return 0;
 
   /* All the sanity checks passed, so we might have a set of
      identical enumeration types.  Perform a more complete
      comparison of the type of each symbol.  */
   for (i = 1; i < nsyms; i++)
-    if (!ada_identical_enum_types_p (SYMBOL_TYPE (syms[i].sym),
-                                     SYMBOL_TYPE (syms[0].sym)))
+    if (!ada_identical_enum_types_p (SYMBOL_TYPE (syms[i].symbol),
+                                     SYMBOL_TYPE (syms[0].symbol)))
       return 0;
 
   return 1;
@@ -4571,7 +4925,7 @@ symbols_are_identical_enums (struct ada_symbol_info *syms, int nsyms)
    Returns the number of items in the modified list.  */
 
 static int
-remove_extra_symbols (struct ada_symbol_info *syms, int nsyms)
+remove_extra_symbols (struct block_symbol *syms, int nsyms)
 {
   int i, j;
 
@@ -4589,16 +4943,16 @@ remove_extra_symbols (struct ada_symbol_info *syms, int nsyms)
       /* If two symbols have the same name and one of them is a stub type,
          the get rid of the stub.  */
 
-      if (TYPE_STUB (SYMBOL_TYPE (syms[i].sym))
-          && SYMBOL_LINKAGE_NAME (syms[i].sym) != NULL)
+      if (TYPE_STUB (SYMBOL_TYPE (syms[i].symbol))
+          && SYMBOL_LINKAGE_NAME (syms[i].symbol) != NULL)
         {
           for (j = 0; j < nsyms; j++)
             {
               if (j != i
-                  && !TYPE_STUB (SYMBOL_TYPE (syms[j].sym))
-                  && SYMBOL_LINKAGE_NAME (syms[j].sym) != NULL
-                  && strcmp (SYMBOL_LINKAGE_NAME (syms[i].sym),
-                             SYMBOL_LINKAGE_NAME (syms[j].sym)) == 0)
+                  && !TYPE_STUB (SYMBOL_TYPE (syms[j].symbol))
+                  && SYMBOL_LINKAGE_NAME (syms[j].symbol) != NULL
+                  && strcmp (SYMBOL_LINKAGE_NAME (syms[i].symbol),
+                             SYMBOL_LINKAGE_NAME (syms[j].symbol)) == 0)
                 remove_p = 1;
             }
         }
@@ -4606,19 +4960,20 @@ remove_extra_symbols (struct ada_symbol_info *syms, int nsyms)
       /* Two symbols with the same name, same class and same address
          should be identical.  */
 
-      else if (SYMBOL_LINKAGE_NAME (syms[i].sym) != NULL
-          && SYMBOL_CLASS (syms[i].sym) == LOC_STATIC
-          && is_nondebugging_type (SYMBOL_TYPE (syms[i].sym)))
+      else if (SYMBOL_LINKAGE_NAME (syms[i].symbol) != NULL
+          && SYMBOL_CLASS (syms[i].symbol) == LOC_STATIC
+          && is_nondebugging_type (SYMBOL_TYPE (syms[i].symbol)))
         {
           for (j = 0; j < nsyms; j += 1)
             {
               if (i != j
-                  && SYMBOL_LINKAGE_NAME (syms[j].sym) != NULL
-                  && strcmp (SYMBOL_LINKAGE_NAME (syms[i].sym),
-                             SYMBOL_LINKAGE_NAME (syms[j].sym)) == 0
-                  && SYMBOL_CLASS (syms[i].sym) == SYMBOL_CLASS (syms[j].sym)
-                  && SYMBOL_VALUE_ADDRESS (syms[i].sym)
-                  == SYMBOL_VALUE_ADDRESS (syms[j].sym))
+                  && SYMBOL_LINKAGE_NAME (syms[j].symbol) != NULL
+                  && strcmp (SYMBOL_LINKAGE_NAME (syms[i].symbol),
+                             SYMBOL_LINKAGE_NAME (syms[j].symbol)) == 0
+                  && SYMBOL_CLASS (syms[i].symbol)
+                      == SYMBOL_CLASS (syms[j].symbol)
+                  && SYMBOL_VALUE_ADDRESS (syms[i].symbol)
+                  == SYMBOL_VALUE_ADDRESS (syms[j].symbol))
                 remove_p = 1;
             }
         }
@@ -4748,11 +5103,11 @@ old_renaming_is_invisible (const struct symbol *sym, const char *function_name)
      a library-level function.  Strip this prefix before doing the
      comparison, as the encoding for the renaming does not contain
      this prefix.  */
-  if (strncmp (function_name, "_ada_", 5) == 0)
+  if (startswith (function_name, "_ada_"))
     function_name += 5;
 
   {
-    int is_invisible = strncmp (function_name, scope, strlen (scope)) != 0;
+    int is_invisible = !startswith (function_name, scope);
 
     do_cleanups (old_chain);
     return is_invisible;
@@ -4797,7 +5152,7 @@ old_renaming_is_invisible (const struct symbol *sym, const char *function_name)
         the user will be unable to print such rename entities.  */
 
 static int
-remove_irrelevant_renamings (struct ada_symbol_info *syms,
+remove_irrelevant_renamings (struct block_symbol *syms,
                             int nsyms, const struct block *current_block)
 {
   struct symbol *current_function;
@@ -4811,7 +5166,7 @@ remove_irrelevant_renamings (struct ada_symbol_info *syms,
   is_new_style_renaming = 0;
   for (i = 0; i < nsyms; i += 1)
     {
-      struct symbol *sym = syms[i].sym;
+      struct symbol *sym = syms[i].symbol;
       const struct block *block = syms[i].block;
       const char *name;
       const char *suffix;
@@ -4828,11 +5183,11 @@ remove_irrelevant_renamings (struct ada_symbol_info *syms,
 
          is_new_style_renaming = 1;
          for (j = 0; j < nsyms; j += 1)
-           if (i != j && syms[j].sym != NULL
-               && strncmp (name, SYMBOL_LINKAGE_NAME (syms[j].sym),
+           if (i != j && syms[j].symbol != NULL
+               && strncmp (name, SYMBOL_LINKAGE_NAME (syms[j].symbol),
                            name_len) == 0
                && block == syms[j].block)
-             syms[j].sym = NULL;
+             syms[j].symbol = NULL;
        }
     }
   if (is_new_style_renaming)
@@ -4840,7 +5195,7 @@ remove_irrelevant_renamings (struct ada_symbol_info *syms,
       int j, k;
 
       for (j = k = 0; j < nsyms; j += 1)
-       if (syms[j].sym != NULL)
+       if (syms[j].symbol != NULL)
            {
              syms[k] = syms[j];
              k += 1;
@@ -4869,9 +5224,9 @@ remove_irrelevant_renamings (struct ada_symbol_info *syms,
   i = 0;
   while (i < nsyms)
     {
-      if (ada_parse_renaming (syms[i].sym, NULL, NULL, NULL)
+      if (ada_parse_renaming (syms[i].symbol, NULL, NULL, NULL)
           == ADA_OBJECT_RENAMING
-          && old_renaming_is_invisible (syms[i].sym, current_function_name))
+          && old_renaming_is_invisible (syms[i].symbol, current_function_name))
         {
           int j;
 
@@ -4898,7 +5253,7 @@ remove_irrelevant_renamings (struct ada_symbol_info *syms,
 
 static void
 ada_add_local_symbols (struct obstack *obstackp, const char *name,
-                       struct block *block, domain_enum domain,
+                       const struct block *block, domain_enum domain,
                        int wild_match_p)
 {
   int block_depth = 0;
@@ -4974,23 +5329,37 @@ aux_add_nonlocal_symbols (struct block *block, struct symbol *sym, void *data0)
   return 0;
 }
 
-/* Compare STRING1 to STRING2, with results as for strcmp.
-   Compatible with strcmp_iw in that strcmp_iw (STRING1, STRING2) <= 0
-   implies compare_names (STRING1, STRING2) (they may differ as to
-   what symbols compare equal).  */
+/* Implements compare_names, but only applying the comparision using
+   the given CASING.  */
 
 static int
-compare_names (const char *string1, const char *string2)
+compare_names_with_case (const char *string1, const char *string2,
+                        enum case_sensitivity casing)
 {
   while (*string1 != '\0' && *string2 != '\0')
     {
+      char c1, c2;
+
       if (isspace (*string1) || isspace (*string2))
        return strcmp_iw_ordered (string1, string2);
-      if (*string1 != *string2)
+
+      if (casing == case_sensitive_off)
+       {
+         c1 = tolower (*string1);
+         c2 = tolower (*string2);
+       }
+      else
+       {
+         c1 = *string1;
+         c2 = *string2;
+       }
+      if (c1 != c2)
        break;
+
       string1 += 1;
       string2 += 1;
     }
+
   switch (*string1)
     {
     case '(':
@@ -5008,10 +5377,43 @@ compare_names (const char *string1, const char *string2)
       if (*string2 == '(')
        return strcmp_iw_ordered (string1, string2);
       else
-       return *string1 - *string2;
+       {
+         if (casing == case_sensitive_off)
+           return tolower (*string1) - tolower (*string2);
+         else
+           return *string1 - *string2;
+       }
     }
 }
 
+/* Compare STRING1 to STRING2, with results as for strcmp.
+   Compatible with strcmp_iw_ordered in that...
+
+       strcmp_iw_ordered (STRING1, STRING2) <= 0
+
+   ... implies...
+
+       compare_names (STRING1, STRING2) <= 0
+
+   (they may differ as to what symbols compare equal).  */
+
+static int
+compare_names (const char *string1, const char *string2)
+{
+  int result;
+
+  /* Similar to what strcmp_iw_ordered does, we need to perform
+     a case-insensitive comparison first, and only resort to
+     a second, case-sensitive, comparison if the first one was
+     not sufficient to differentiate the two strings.  */
+
+  result = compare_names_with_case (string1, string2, case_sensitive_off);
+  if (result == 0)
+    result = compare_names_with_case (string1, string2, case_sensitive_on);
+
+  return result;
+}
+
 /* Add to OBSTACKP all non-local symbols whose name and domain match
    NAME and DOMAIN respectively.  The search is performed on GLOBAL_BLOCK
    symbols if GLOBAL is non-zero, or on STATIC_BLOCK symbols otherwise.  */
@@ -5032,11 +5434,11 @@ add_nonlocal_symbols (struct obstack *obstackp, const char *name,
       data.objfile = objfile;
 
       if (is_wild_match)
-       objfile->sf->qf->map_matching_symbols (name, domain, objfile, global,
+       objfile->sf->qf->map_matching_symbols (objfile, name, domain, global,
                                               aux_add_nonlocal_symbols, &data,
                                               wild_match, NULL);
       else
-       objfile->sf->qf->map_matching_symbols (name, domain, objfile, global,
+       objfile->sf->qf->map_matching_symbols (objfile, name, domain, global,
                                               aux_add_nonlocal_symbols, &data,
                                               full_match, compare_names);
     }
@@ -5049,8 +5451,8 @@ add_nonlocal_symbols (struct obstack *obstackp, const char *name,
          strcpy (name1, "_ada_");
          strcpy (name1 + sizeof ("_ada_") - 1, name);
          data.objfile = objfile;
-         objfile->sf->qf->map_matching_symbols (name1, domain,
-                                                objfile, global,
+         objfile->sf->qf->map_matching_symbols (objfile, name1, domain,
+                                                global,
                                                 aux_add_nonlocal_symbols,
                                                 &data,
                                                 full_match, compare_names);
@@ -5077,28 +5479,24 @@ add_nonlocal_symbols (struct obstack *obstackp, const char *name,
 
 static int
 ada_lookup_symbol_list_worker (const char *name0, const struct block *block0,
-                              domain_enum namespace,
-                              struct ada_symbol_info **results,
+                              domain_enum domain,
+                              struct block_symbol **results,
                               int full_search)
 {
   struct symbol *sym;
-  struct block *block;
+  const struct block *block;
   const char *name;
   const int wild_match_p = should_use_wild_match (name0);
-  int cacheIfUnique;
+  int syms_from_global_search = 0;
   int ndefns;
 
   obstack_free (&symbol_list_obstack, NULL);
   obstack_init (&symbol_list_obstack);
 
-  cacheIfUnique = 0;
-
   /* Search specified block and its superiors.  */
 
   name = name0;
-  block = (struct block *) block0;      /* FIXME: No cast ought to be
-                                           needed, but adding const will
-                                           have a cascade effect.  */
+  block = block0;
 
   /* Special case: If the user specifies a symbol name inside package
      Standard, do a non-wild matching of the symbol name without
@@ -5107,7 +5505,7 @@ ada_lookup_symbol_list_worker (const char *name0, const struct block *block0,
      using, for instance, Standard.Constraint_Error when Constraint_Error
      is ambiguous (due to the user defining its own Constraint_Error
      entity inside its program).  */
-  if (strncmp (name0, "standard__", sizeof ("standard__") - 1) == 0)
+  if (startswith (name0, "standard__"))
     {
       block = NULL;
       name = name0 + sizeof ("standard__") - 1;
@@ -5120,7 +5518,7 @@ ada_lookup_symbol_list_worker (const char *name0, const struct block *block0,
       if (full_search)
        {
          ada_add_local_symbols (&symbol_list_obstack, name, block,
-                                namespace, wild_match_p);
+                                domain, wild_match_p);
        }
       else
        {
@@ -5128,7 +5526,7 @@ ada_lookup_symbol_list_worker (const char *name0, const struct block *block0,
             ada_iterate_over_symbols, and we don't want to search
             superblocks.  */
          ada_add_block_symbols (&symbol_list_obstack, block, name,
-                                namespace, NULL, wild_match_p);
+                                domain, NULL, wild_match_p);
        }
       if (num_defns_collected (&symbol_list_obstack) > 0 || !full_search)
        goto done;
@@ -5138,24 +5536,25 @@ ada_lookup_symbol_list_worker (const char *name0, const struct block *block0,
      already performed this search before.  If we have, then return
      the same result.  */
 
-  cacheIfUnique = 1;
-  if (lookup_cached_symbol (name0, namespace, &sym, &block))
+  if (lookup_cached_symbol (name0, domain, &sym, &block))
     {
       if (sym != NULL)
         add_defn_to_vec (&symbol_list_obstack, sym, block);
       goto done;
     }
 
+  syms_from_global_search = 1;
+
   /* Search symbols from all global blocks.  */
  
-  add_nonlocal_symbols (&symbol_list_obstack, name, namespace, 1,
+  add_nonlocal_symbols (&symbol_list_obstack, name, domain, 1,
                        wild_match_p);
 
   /* Now add symbols from all per-file blocks if we've gotten no hits
      (not strictly correct, but perhaps better than an error).  */
 
   if (num_defns_collected (&symbol_list_obstack) == 0)
-    add_nonlocal_symbols (&symbol_list_obstack, name, namespace, 0,
+    add_nonlocal_symbols (&symbol_list_obstack, name, domain, 0,
                          wild_match_p);
 
 done:
@@ -5164,11 +5563,11 @@ done:
 
   ndefns = remove_extra_symbols (*results, ndefns);
 
-  if (ndefns == 0 && full_search)
-    cache_symbol (name0, namespace, NULL, NULL);
+  if (ndefns == 0 && full_search && syms_from_global_search)
+    cache_symbol (name0, domain, NULL, NULL);
 
-  if (ndefns == 1 && full_search && cacheIfUnique)
-    cache_symbol (name0, namespace, (*results)[0].sym, (*results)[0].block);
+  if (ndefns == 1 && full_search && syms_from_global_search)
+    cache_symbol (name0, domain, (*results)[0].symbol, (*results)[0].block);
 
   ndefns = remove_irrelevant_renamings (*results, ndefns, block0);
 
@@ -5182,7 +5581,7 @@ done:
 
 int
 ada_lookup_symbol_list (const char *name0, const struct block *block0,
-                       domain_enum domain, struct ada_symbol_info **results)
+                       domain_enum domain, struct block_symbol **results)
 {
   return ada_lookup_symbol_list_worker (name0, block0, domain, results, 1);
 }
@@ -5196,12 +5595,12 @@ ada_iterate_over_symbols (const struct block *block,
                          void *data)
 {
   int ndefs, i;
-  struct ada_symbol_info *results;
+  struct block_symbol *results;
 
   ndefs = ada_lookup_symbol_list_worker (name, block, domain, &results, 0);
   for (i = 0; i < ndefs; ++i)
     {
-      if (! (*callback) (results[i].sym, data))
+      if (! (*callback) (results[i].symbol, data))
        break;
     }
 }
@@ -5240,21 +5639,21 @@ ada_name_for_lookup (const char *name)
 
 void
 ada_lookup_encoded_symbol (const char *name, const struct block *block,
-                          domain_enum namespace,
-                          struct ada_symbol_info *info)
+                          domain_enum domain,
+                          struct block_symbol *info)
 {
-  struct ada_symbol_info *candidates;
+  struct block_symbol *candidates;
   int n_candidates;
 
   gdb_assert (info != NULL);
-  memset (info, 0, sizeof (struct ada_symbol_info));
+  memset (info, 0, sizeof (struct block_symbol));
 
-  n_candidates = ada_lookup_symbol_list (name, block, namespace, &candidates);
+  n_candidates = ada_lookup_symbol_list (name, block, domain, &candidates);
   if (n_candidates == 0)
     return;
 
   *info = candidates[0];
-  info->sym = fixup_symbol_section (info->sym, NULL);
+  info->symbol = fixup_symbol_section (info->symbol, NULL);
 }
 
 /* Return a symbol in DOMAIN matching NAME, in BLOCK0 and enclosing
@@ -5263,26 +5662,58 @@ ada_lookup_encoded_symbol (const char *name, const struct block *block,
    choosing the first symbol if there are multiple choices.
    If IS_A_FIELD_OF_THIS is not NULL, it is set to zero.  */
 
-struct symbol *
+struct block_symbol
 ada_lookup_symbol (const char *name, const struct block *block0,
-                   domain_enum namespace, int *is_a_field_of_this)
+                   domain_enum domain, int *is_a_field_of_this)
 {
-  struct ada_symbol_info info;
+  struct block_symbol info;
 
   if (is_a_field_of_this != NULL)
     *is_a_field_of_this = 0;
 
   ada_lookup_encoded_symbol (ada_encode (ada_fold_name (name)),
-                            block0, namespace, &info);
-  return info.sym;
+                            block0, domain, &info);
+  return info;
 }
 
-static struct symbol *
-ada_lookup_symbol_nonlocal (const char *name,
+static struct block_symbol
+ada_lookup_symbol_nonlocal (const struct language_defn *langdef,
+                           const char *name,
                             const struct block *block,
                             const domain_enum domain)
 {
-  return ada_lookup_symbol (name, block_static_block (block), domain, NULL);
+  struct block_symbol sym;
+
+  sym = ada_lookup_symbol (name, block_static_block (block), domain, NULL);
+  if (sym.symbol != NULL)
+    return sym;
+
+  /* If we haven't found a match at this point, try the primitive
+     types.  In other languages, this search is performed before
+     searching for global symbols in order to short-circuit that
+     global-symbol search if it happens that the name corresponds
+     to a primitive type.  But we cannot do the same in Ada, because
+     it is perfectly legitimate for a program to declare a type which
+     has the same name as a standard type.  If looking up a type in
+     that situation, we have traditionally ignored the primitive type
+     in favor of user-defined types.  This is why, unlike most other
+     languages, we search the primitive types this late and only after
+     having searched the global symbols without success.  */
+
+  if (domain == VAR_DOMAIN)
+    {
+      struct gdbarch *gdbarch;
+
+      if (block == NULL)
+       gdbarch = target_gdbarch ();
+      else
+       gdbarch = block_gdbarch (block);
+      sym.symbol = language_lookup_primitive_type_as_symbol (langdef, gdbarch, name);
+      if (sym.symbol != NULL)
+       return sym;
+    }
+
+  return (struct block_symbol) {NULL, NULL};
 }
 
 
@@ -5474,7 +5905,7 @@ advance_wild_match (const char **namep, const char *name0, int target0)
          if ((t1 >= 'a' && t1 <= 'z') || (t1 >= '0' && t1 <= '9'))
            {
              name += 1;
-             if (name == name0 + 5 && strncmp (name0, "_ada", 4) == 0)
+             if (name == name0 + 5 && startswith (name0, "_ada"))
                break;
              else
                name += 1;
@@ -5545,7 +5976,7 @@ full_match (const char *sym_name, const char *search_name)
 
 static void
 ada_add_block_symbols (struct obstack *obstackp,
-                       struct block *block, const char *name,
+                       const struct block *block, const char *name,
                        domain_enum domain, struct objfile *objfile,
                        int wild)
 {
@@ -5628,7 +6059,7 @@ ada_add_block_symbols (struct obstack *obstackp,
             cmp = (int) '_' - (int) SYMBOL_LINKAGE_NAME (sym)[0];
             if (cmp == 0)
               {
-                cmp = strncmp ("_ada_", SYMBOL_LINKAGE_NAME (sym), 5);
+                cmp = !startswith (SYMBOL_LINKAGE_NAME (sym), "_ada_");
                 if (cmp == 0)
                   cmp = strncmp (name, SYMBOL_LINKAGE_NAME (sym) + 5,
                                  name_len);
@@ -5808,7 +6239,7 @@ symbol_completion_add (VEC(char_ptr) **sv,
 }
 
 /* An object of this type is passed as the user_data argument to the
-   expand_partial_symbol_names method.  */
+   expand_symtabs_matching method.  */
 struct add_partial_datum
 {
   VEC(char_ptr) **completions;
@@ -5820,9 +6251,10 @@ struct add_partial_datum
   int encoded;
 };
 
-/* A callback for expand_partial_symbol_names.  */
+/* A callback for expand_symtabs_matching.  */
+
 static int
-ada_expand_partial_symbol_name (const char *name, void *user_data)
+ada_complete_symbol_matcher (const char *name, void *user_data)
 {
   struct add_partial_datum *data = user_data;
   
@@ -5843,10 +6275,10 @@ ada_make_symbol_completion_list (const char *text0, const char *word,
   int encoded_p;
   VEC(char_ptr) *completions = VEC_alloc (char_ptr, 128);
   struct symbol *sym;
-  struct symtab *s;
+  struct compunit_symtab *s;
   struct minimal_symbol *msymbol;
   struct objfile *objfile;
-  struct block *b, *surrounding_static_block = 0;
+  const struct block *b, *surrounding_static_block = 0;
   int i;
   struct block_iterator iter;
   struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
@@ -5888,7 +6320,8 @@ ada_make_symbol_completion_list (const char *text0, const char *word,
     data.word = word;
     data.wild_match = wild_match_p;
     data.encoded = encoded_p;
-    expand_partial_symbol_names (ada_expand_partial_symbol_name, &data);
+    expand_symtabs_matching (NULL, ada_complete_symbol_matcher, NULL,
+                            ALL_DOMAIN, &data);
   }
 
   /* At this point scan through the misc symbol vectors and add each
@@ -5899,7 +6332,7 @@ ada_make_symbol_completion_list (const char *text0, const char *word,
   ALL_MSYMBOLS (objfile, msymbol)
   {
     QUIT;
-    symbol_completion_add (&completions, SYMBOL_LINKAGE_NAME (msymbol),
+    symbol_completion_add (&completions, MSYMBOL_LINKAGE_NAME (msymbol),
                           text, text_len, text0, word, wild_match_p,
                           encoded_p);
   }
@@ -5923,10 +6356,10 @@ ada_make_symbol_completion_list (const char *text0, const char *word,
   /* Go through the symtabs and check the externs and statics for
      symbols which match.  */
 
-  ALL_SYMTABS (objfile, s)
+  ALL_COMPUNITS (objfile, s)
   {
     QUIT;
-    b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), GLOBAL_BLOCK);
+    b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), GLOBAL_BLOCK);
     ALL_BLOCK_SYMBOLS (b, iter, sym)
     {
       symbol_completion_add (&completions, SYMBOL_LINKAGE_NAME (sym),
@@ -5935,10 +6368,10 @@ ada_make_symbol_completion_list (const char *text0, const char *word,
     }
   }
 
-  ALL_SYMTABS (objfile, s)
+  ALL_COMPUNITS (objfile, s)
   {
     QUIT;
-    b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), STATIC_BLOCK);
+    b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), STATIC_BLOCK);
     /* Don't do this block twice.  */
     if (b == surrounding_static_block)
       continue;
@@ -6013,7 +6446,7 @@ ada_is_ignored_field (struct type *type, int field_num)
        for tagged types, and it contains the components inherited from
        the parent type.  This field should not be printed as is, but
        should not be ignored either.  */
-    if (name[0] == '_' && strncmp (name, "_parent", 7) != 0)
+    if (name[0] == '_' && !startswith (name, "_parent"))
       return 1;
   }
 
@@ -6042,6 +6475,8 @@ ada_is_tagged_type (struct type *type, int refok)
 int
 ada_is_tag_type (struct type *type)
 {
+  type = ada_check_typedef (type);
+
   if (type == NULL || TYPE_CODE (type) != TYPE_CODE_PTR)
     return 0;
   else
@@ -6122,7 +6557,6 @@ type_from_tag (struct value *tag)
 struct value *
 ada_tag_value_at_base_address (struct value *obj)
 {
-  volatile struct gdb_exception e;
   struct value *val;
   LONGEST offset_to_top = 0;
   struct type *ptr_type, *obj_type;
@@ -6157,13 +6591,16 @@ ada_tag_value_at_base_address (struct value *obj)
      see ada_tag_name for more details.  We do not print the error
      message for the same reason.  */
 
-  TRY_CATCH (e, RETURN_MASK_ERROR)
+  TRY
     {
       offset_to_top = value_as_long (value_ind (value_ptradd (val, -2)));
     }
 
-  if (e.reason < 0)
-    return obj;
+  CATCH (e, RETURN_MASK_ERROR)
+    {
+      return obj;
+    }
+  END_CATCH
 
   /* If offset is null, nothing to do.  */
 
@@ -6275,7 +6712,6 @@ ada_tag_name_from_tsd (struct value *tsd)
 const char *
 ada_tag_name (struct value *tag)
 {
-  volatile struct gdb_exception e;
   char *name = NULL;
 
   if (!ada_is_tag_type (value_type (tag)))
@@ -6290,13 +6726,17 @@ ada_tag_name (struct value *tag)
      We also do not print the error message either (which often is very
      low-level (Eg: "Cannot read memory at 0x[...]"), but instead let
      the caller print a more meaningful message if necessary.  */
-  TRY_CATCH (e, RETURN_MASK_ERROR)
+  TRY
     {
       struct value *tsd = ada_get_tsd_from_tag (tag);
 
       if (tsd != NULL)
        name = ada_tag_name_from_tsd (tsd);
     }
+  CATCH (e, RETURN_MASK_ERROR)
+    {
+    }
+  END_CATCH
 
   return name;
 }
@@ -6340,8 +6780,8 @@ ada_is_parent_field (struct type *type, int field_num)
   const char *name = TYPE_FIELD_NAME (ada_check_typedef (type), field_num);
 
   return (name != NULL
-          && (strncmp (name, "PARENT", 6) == 0
-              || strncmp (name, "_parent", 7) == 0));
+          && (startswith (name, "PARENT")
+              || startswith (name, "_parent")));
 }
 
 /* True iff field number FIELD_NUM of structure type TYPE is a
@@ -6356,9 +6796,9 @@ ada_is_wrapper_field (struct type *type, int field_num)
   const char *name = TYPE_FIELD_NAME (type, field_num);
 
   return (name != NULL
-          && (strncmp (name, "PARENT", 6) == 0
+          && (startswith (name, "PARENT")
               || strcmp (name, "REP") == 0
-              || strncmp (name, "_parent", 7) == 0
+              || startswith (name, "_parent")
               || name[0] == 'S' || name[0] == 'R' || name[0] == 'O'));
 }
 
@@ -6429,7 +6869,7 @@ ada_variant_discrim_name (struct type *type0)
   for (discrim_end = name + strlen (name) - 6; discrim_end != name;
        discrim_end -= 1)
     {
-      if (strncmp (discrim_end, "___XVN", 6) == 0)
+      if (startswith (discrim_end, "___XVN"))
         break;
     }
   if (discrim_end == name)
@@ -6441,7 +6881,7 @@ ada_variant_discrim_name (struct type *type0)
       if (discrim_start == name + 1)
         return "";
       if ((discrim_start > name + 3
-           && strncmp (discrim_start - 3, "___", 3) == 0)
+           && startswith (discrim_start - 3, "___"))
           || discrim_start[-1] == '.')
         break;
     }
@@ -6960,7 +7400,7 @@ ada_lookup_struct_elt_type (struct type *type, char *name, int refok,
         {
           if (dispp != NULL)
             *dispp += TYPE_FIELD_BITPOS (type, i) / 8;
-          return ada_check_typedef (TYPE_FIELD_TYPE (type, i));
+          return TYPE_FIELD_TYPE (type, i);
         }
 
       else if (ada_is_wrapper_field (type, i))
@@ -6992,7 +7432,7 @@ ada_lookup_struct_elt_type (struct type *type, char *name, int refok,
               disp = 0;
              if (v_field_name != NULL 
                  && field_name_match (v_field_name, name))
-               t = ada_check_typedef (TYPE_FIELD_TYPE (field_type, j));
+               t = TYPE_FIELD_TYPE (field_type, j);
              else
                t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (field_type,
                                                                 j),
@@ -7064,7 +7504,11 @@ ada_which_variant_applies (struct type *var_type, struct type *outer_type,
   struct value *discrim;
   LONGEST discrim_val;
 
-  outer = value_from_contents_and_address (outer_type, outer_valaddr, 0);
+  /* Using plain value_from_contents_and_address here causes problems
+     because we will end up trying to resolve a type that is currently
+     being constructed.  */
+  outer = value_from_contents_and_address_unresolved (outer_type,
+                                                     outer_valaddr, 0);
   discrim = ada_value_struct_elt (outer, discrim_name, 1);
   if (discrim == NULL)
     return -1;
@@ -7189,7 +7633,7 @@ field_alignment (struct type *type, int f)
   else
     align_offset = len - 1;
 
-  if (align_offset < 7 || strncmp ("___XV", name + align_offset - 6, 5) != 0)
+  if (align_offset < 7 || !startswith (name + align_offset - 6, "___XV"))
     return TARGET_CHAR_BIT;
 
   return atoi (name + align_offset) * TARGET_CHAR_BIT;
@@ -7362,7 +7806,10 @@ ada_type_name (struct type *type)
 static struct type *
 find_parallel_type_by_descriptive_type (struct type *type, const char *name)
 {
-  struct type *result;
+  struct type *result, *tmp;
+
+  if (ada_ignore_descriptive_types_p)
+    return NULL;
 
   /* If there no descriptive-type info, then there is no parallel type
      to be found.  */
@@ -7386,9 +7833,21 @@ find_parallel_type_by_descriptive_type (struct type *type, const char *name)
 
       /* Otherwise, look at the next item on the list, if any.  */
       if (HAVE_GNAT_AUX_INFO (result))
-       result = TYPE_DESCRIPTIVE_TYPE (result);
+       tmp = TYPE_DESCRIPTIVE_TYPE (result);
+      else
+       tmp = NULL;
+
+      /* If not found either, try after having resolved the typedef.  */
+      if (tmp != NULL)
+       result = tmp;
       else
-       result = NULL;
+       {
+         result = check_typedef (result);
+         if (HAVE_GNAT_AUX_INFO (result))
+           result = TYPE_DESCRIPTIVE_TYPE (result);
+         else
+           result = NULL;
+       }
     }
 
   /* If we didn't find a match, see whether this is a packed array.  With
@@ -7425,17 +7884,17 @@ struct type *
 ada_find_parallel_type (struct type *type, const char *suffix)
 {
   char *name;
-  const char *typename = ada_type_name (type);
+  const char *type_name = ada_type_name (type);
   int len;
 
-  if (typename == NULL)
+  if (type_name == NULL)
     return NULL;
 
-  len = strlen (typename);
+  len = strlen (type_name);
 
   name = (char *) alloca (len + strlen (suffix) + 1);
 
-  strcpy (name, typename);
+  strcpy (name, type_name);
   strcpy (name + len, suffix);
 
   return ada_find_parallel_type_with_name (type, name);
@@ -7498,9 +7957,9 @@ variant_field_index (struct type *type)
 /* A record type with no fields.  */
 
 static struct type *
-empty_record (struct type *template)
+empty_record (struct type *templ)
 {
-  struct type *type = alloc_type_copy (template);
+  struct type *type = alloc_type_copy (templ);
 
   TYPE_CODE (type) = TYPE_CODE_STRUCT;
   TYPE_NFIELDS (type) = 0;
@@ -7599,8 +8058,15 @@ ada_template_to_fixed_record_type_1 (struct type *type,
                 initialized, the type size may be completely bogus and
                 GDB may fail to allocate a value for it.  So check the
                 size first before creating the value.  */
-             check_size (rtype);
-             dval = value_from_contents_and_address (rtype, valaddr, address);
+             ada_ensure_varsize_limit (rtype);
+             /* Using plain value_from_contents_and_address here
+                causes problems because we will end up trying to
+                resolve a type that is currently being
+                constructed.  */
+             dval = value_from_contents_and_address_unresolved (rtype,
+                                                                valaddr,
+                                                                address);
+             rtype = value_type (dval);
            }
           else
             dval = dval0;
@@ -7640,7 +8106,7 @@ ada_template_to_fixed_record_type_1 (struct type *type,
             large (due to an uninitialized variable in the inferior)
             that it would cause an overflow when adding it to the
             record size.  */
-         check_size (field_type);
+         ada_ensure_varsize_limit (field_type);
 
          TYPE_FIELD_TYPE (rtype, f) = field_type;
           TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
@@ -7703,7 +8169,14 @@ ada_template_to_fixed_record_type_1 (struct type *type,
       off = TYPE_FIELD_BITPOS (rtype, variant_field);
 
       if (dval0 == NULL)
-        dval = value_from_contents_and_address (rtype, valaddr, address);
+       {
+         /* Using plain value_from_contents_and_address here causes
+            problems because we will end up trying to resolve a type
+            that is currently being constructed.  */
+         dval = value_from_contents_and_address_unresolved (rtype, valaddr,
+                                                            address);
+         rtype = value_type (dval);
+       }
       else
         dval = dval0;
 
@@ -7786,39 +8259,58 @@ template_to_static_fixed_type (struct type *type0)
   int nfields;
   int f;
 
+  /* No need no do anything if the input type is already fixed.  */
+  if (TYPE_FIXED_INSTANCE (type0))
+    return type0;
+
+  /* Likewise if we already have computed the static approximation.  */
   if (TYPE_TARGET_TYPE (type0) != NULL)
     return TYPE_TARGET_TYPE (type0);
 
-  nfields = TYPE_NFIELDS (type0);
+  /* Don't clone TYPE0 until we are sure we are going to need a copy.  */
   type = type0;
+  nfields = TYPE_NFIELDS (type0);
+
+  /* Whether or not we cloned TYPE0, cache the result so that we don't do
+     recompute all over next time.  */
+  TYPE_TARGET_TYPE (type0) = type;
 
   for (f = 0; f < nfields; f += 1)
     {
-      struct type *field_type = ada_check_typedef (TYPE_FIELD_TYPE (type0, f));
+      struct type *field_type = TYPE_FIELD_TYPE (type0, f);
       struct type *new_type;
 
       if (is_dynamic_field (type0, f))
-        new_type = to_static_fixed_type (TYPE_TARGET_TYPE (field_type));
+       {
+         field_type = ada_check_typedef (field_type);
+          new_type = to_static_fixed_type (TYPE_TARGET_TYPE (field_type));
+       }
       else
         new_type = static_unwrap_type (field_type);
-      if (type == type0 && new_type != field_type)
-        {
-          TYPE_TARGET_TYPE (type0) = type = alloc_type_copy (type0);
-          TYPE_CODE (type) = TYPE_CODE (type0);
-          INIT_CPLUS_SPECIFIC (type);
-          TYPE_NFIELDS (type) = nfields;
-          TYPE_FIELDS (type) = (struct field *)
-            TYPE_ALLOC (type, nfields * sizeof (struct field));
-          memcpy (TYPE_FIELDS (type), TYPE_FIELDS (type0),
-                  sizeof (struct field) * nfields);
-          TYPE_NAME (type) = ada_type_name (type0);
-          TYPE_TAG_NAME (type) = NULL;
-         TYPE_FIXED_INSTANCE (type) = 1;
-          TYPE_LENGTH (type) = 0;
-        }
-      TYPE_FIELD_TYPE (type, f) = new_type;
-      TYPE_FIELD_NAME (type, f) = TYPE_FIELD_NAME (type0, f);
+
+      if (new_type != field_type)
+       {
+         /* Clone TYPE0 only the first time we get a new field type.  */
+         if (type == type0)
+           {
+             TYPE_TARGET_TYPE (type0) = type = alloc_type_copy (type0);
+             TYPE_CODE (type) = TYPE_CODE (type0);
+             INIT_CPLUS_SPECIFIC (type);
+             TYPE_NFIELDS (type) = nfields;
+             TYPE_FIELDS (type) = (struct field *)
+               TYPE_ALLOC (type, nfields * sizeof (struct field));
+             memcpy (TYPE_FIELDS (type), TYPE_FIELDS (type0),
+                     sizeof (struct field) * nfields);
+             TYPE_NAME (type) = ada_type_name (type0);
+             TYPE_TAG_NAME (type) = NULL;
+             TYPE_FIXED_INSTANCE (type) = 1;
+             TYPE_LENGTH (type) = 0;
+           }
+         TYPE_FIELD_TYPE (type, f) = new_type;
+         TYPE_FIELD_NAME (type, f) = TYPE_FIELD_NAME (type0, f);
+       }
     }
+
   return type;
 }
 
@@ -7844,7 +8336,10 @@ to_record_with_fixed_variant_part (struct type *type, const gdb_byte *valaddr,
     return type;
 
   if (dval0 == NULL)
-    dval = value_from_contents_and_address (type, valaddr, address);
+    {
+      dval = value_from_contents_and_address (type, valaddr, address);
+      type = value_type (dval);
+    }
   else
     dval = dval0;
 
@@ -7982,32 +8477,140 @@ to_fixed_variant_branch_type (struct type *var_type0, const gdb_byte *valaddr,
     return TYPE_FIELD_TYPE (var_type, which);
 }
 
-/* Assuming that TYPE0 is an array type describing the type of a value
-   at ADDR, and that DVAL describes a record containing any
-   discriminants used in TYPE0, returns a type for the value that
-   contains no dynamic components (that is, no components whose sizes
-   are determined by run-time quantities).  Unless IGNORE_TOO_BIG is
-   true, gives an error message if the resulting type's size is over
-   varsize_limit.  */
+/* Assuming RANGE_TYPE is a TYPE_CODE_RANGE, return nonzero if
+   ENCODING_TYPE, a type following the GNAT conventions for discrete
+   type encodings, only carries redundant information.  */
 
-static struct type *
-to_fixed_array_type (struct type *type0, struct value *dval,
-                     int ignore_too_big)
+static int
+ada_is_redundant_range_encoding (struct type *range_type,
+                                struct type *encoding_type)
 {
-  struct type *index_type_desc;
-  struct type *result;
-  int constrained_packed_array_p;
+  struct type *fixed_range_type;
+  char *bounds_str;
+  int n;
+  LONGEST lo, hi;
 
-  type0 = ada_check_typedef (type0);
-  if (TYPE_FIXED_INSTANCE (type0))
-    return type0;
+  gdb_assert (TYPE_CODE (range_type) == TYPE_CODE_RANGE);
+
+  if (TYPE_CODE (get_base_type (range_type))
+      != TYPE_CODE (get_base_type (encoding_type)))
+    {
+      /* The compiler probably used a simple base type to describe
+        the range type instead of the range's actual base type,
+        expecting us to get the real base type from the encoding
+        anyway.  In this situation, the encoding cannot be ignored
+        as redundant.  */
+      return 0;
+    }
+
+  if (is_dynamic_type (range_type))
+    return 0;
+
+  if (TYPE_NAME (encoding_type) == NULL)
+    return 0;
+
+  bounds_str = strstr (TYPE_NAME (encoding_type), "___XDLU_");
+  if (bounds_str == NULL)
+    return 0;
+
+  n = 8; /* Skip "___XDLU_".  */
+  if (!ada_scan_number (bounds_str, n, &lo, &n))
+    return 0;
+  if (TYPE_LOW_BOUND (range_type) != lo)
+    return 0;
+
+  n += 2; /* Skip the "__" separator between the two bounds.  */
+  if (!ada_scan_number (bounds_str, n, &hi, &n))
+    return 0;
+  if (TYPE_HIGH_BOUND (range_type) != hi)
+    return 0;
+
+  return 1;
+}
+
+/* Given the array type ARRAY_TYPE, return nonzero if DESC_TYPE,
+   a type following the GNAT encoding for describing array type
+   indices, only carries redundant information.  */
+
+static int
+ada_is_redundant_index_type_desc (struct type *array_type,
+                                 struct type *desc_type)
+{
+  struct type *this_layer = check_typedef (array_type);
+  int i;
+
+  for (i = 0; i < TYPE_NFIELDS (desc_type); i++)
+    {
+      if (!ada_is_redundant_range_encoding (TYPE_INDEX_TYPE (this_layer),
+                                           TYPE_FIELD_TYPE (desc_type, i)))
+       return 0;
+      this_layer = check_typedef (TYPE_TARGET_TYPE (this_layer));
+    }
+
+  return 1;
+}
+
+/* Assuming that TYPE0 is an array type describing the type of a value
+   at ADDR, and that DVAL describes a record containing any
+   discriminants used in TYPE0, returns a type for the value that
+   contains no dynamic components (that is, no components whose sizes
+   are determined by run-time quantities).  Unless IGNORE_TOO_BIG is
+   true, gives an error message if the resulting type's size is over
+   varsize_limit.  */
+
+static struct type *
+to_fixed_array_type (struct type *type0, struct value *dval,
+                     int ignore_too_big)
+{
+  struct type *index_type_desc;
+  struct type *result;
+  int constrained_packed_array_p;
+  static const char *xa_suffix = "___XA";
+
+  type0 = ada_check_typedef (type0);
+  if (TYPE_FIXED_INSTANCE (type0))
+    return 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");
+  index_type_desc = ada_find_parallel_type (type0, xa_suffix);
+
+  /* As mentioned in exp_dbug.ads, for non bit-packed arrays an
+     encoding suffixed with 'P' may still be generated.  If so,
+     it should be used to find the XA type.  */
+
+  if (index_type_desc == NULL)
+    {
+      const char *type_name = ada_type_name (type0);
+
+      if (type_name != NULL)
+       {
+         const int len = strlen (type_name);
+         char *name = (char *) alloca (len + strlen (xa_suffix));
+
+         if (type_name[len - 1] == 'P')
+           {
+             strcpy (name, type_name);
+             strcpy (name + len - 1, xa_suffix);
+             index_type_desc = ada_find_parallel_type_with_name (type0, name);
+           }
+       }
+    }
+
   ada_fixup_array_indexes_type (index_type_desc);
+  if (index_type_desc != NULL
+      && ada_is_redundant_index_type_desc (type0, index_type_desc))
+    {
+      /* Ignore this ___XA parallel type, as it does not bring any
+        useful information.  This allows us to avoid creating fixed
+        versions of the array's index types, which would be identical
+        to the original ones.  This, in turn, can also help avoid
+        the creation of fixed versions of the array itself.  */
+      index_type_desc = NULL;
+    }
+
   if (index_type_desc == NULL)
     {
       struct type *elt_type0 = ada_check_typedef (TYPE_TARGET_TYPE (type0));
@@ -8142,6 +8745,7 @@ ada_to_fixed_type_1 (struct type *type, const gdb_byte *valaddr,
              value_from_contents_and_address (fixed_record_type,
                                               valaddr,
                                               address);
+            fixed_record_type = value_type (obj);
             if (real_type != NULL)
               return to_fixed_record_type
                (real_type, NULL,
@@ -8340,7 +8944,7 @@ ada_check_typedef (struct type *type)
       && is_thick_pntr (ada_typedef_target_type (type)))
     return type;
 
-  CHECK_TYPEDEF (type);
+  type = check_typedef (type);
   if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM
       || !TYPE_STUB (type)
       || TYPE_TAG_NAME (type) == NULL)
@@ -8435,24 +9039,15 @@ pos_atr (struct value *arg)
 {
   struct value *val = coerce_ref (arg);
   struct type *type = value_type (val);
+  LONGEST result;
 
   if (!discrete_type_p (type))
     error (_("'POS only defined on discrete types"));
 
-  if (TYPE_CODE (type) == TYPE_CODE_ENUM)
-    {
-      int i;
-      LONGEST v = value_as_long (val);
+  if (!discrete_position (type, value_as_long (val), &result))
+    error (_("enumeration value is invalid: can't find 'POS"));
 
-      for (i = 0; i < TYPE_NFIELDS (type); i += 1)
-        {
-          if (v == TYPE_FIELD_ENUMVAL (type, i))
-            return i;
-        }
-      error (_("enumeration value is invalid: can't find 'POS"));
-    }
-  else
-    return value_as_long (val);
+  return result;
 }
 
 static struct value *
@@ -9592,6 +10187,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
   enum exp_opcode op;
   int tem;
   int pc;
+  int preeval_pos;
   struct value *arg1 = NULL, *arg2 = NULL, *arg3;
   struct type *type;
   int nargs, oplen;
@@ -9687,6 +10283,10 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
         return (value_from_longest
                  (value_type (arg1),
                   value_as_long (arg1) + value_as_long (arg2)));
+      if (TYPE_CODE (value_type (arg2)) == TYPE_CODE_PTR)
+        return (value_from_longest
+                 (value_type (arg2),
+                  value_as_long (arg1) + value_as_long (arg2)));
       if ((ada_is_fixed_point_type (value_type (arg1))
            || ada_is_fixed_point_type (value_type (arg2)))
           && value_type (arg1) != value_type (arg2))
@@ -9709,6 +10309,10 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
         return (value_from_longest
                  (value_type (arg1),
                   value_as_long (arg1) - value_as_long (arg2)));
+      if (TYPE_CODE (value_type (arg2)) == TYPE_CODE_PTR)
+        return (value_from_longest
+                 (value_type (arg2),
+                  value_as_long (arg1) - value_as_long (arg2)));
       if ((ada_is_fixed_point_type (value_type (arg1))
            || ada_is_fixed_point_type (value_type (arg2)))
           && value_type (arg1) != value_type (arg2))
@@ -9810,13 +10414,15 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
           *pos += 4;
           goto nosideret;
         }
-      else if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
+
+      if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
         /* Only encountered when an unresolved symbol occurs in a
            context other than a function call, in which case, it is
            invalid.  */
         error (_("Unexpected unresolved symbol, %s, during evaluation"),
                SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol));
-      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
+
+      if (noside == EVAL_AVOID_SIDE_EFFECTS)
         {
           type = static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
           /* Check to see if this is a tagged type.  We also need to handle
@@ -9825,65 +10431,74 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
              The latter should be shown as usual (as a pointer), whereas
              a reference should mostly be transparent to the user.  */
           if (ada_is_tagged_type (type, 0)
-              || (TYPE_CODE(type) == TYPE_CODE_REF
+              || (TYPE_CODE (type) == TYPE_CODE_REF
                   && ada_is_tagged_type (TYPE_TARGET_TYPE (type), 0)))
-          {
-            /* Tagged types are a little special in the fact that the real
-               type is dynamic and can only be determined by inspecting the
-               object's tag.  This means that we need to get the object's
-               value first (EVAL_NORMAL) and then extract the actual object
-               type from its tag.
-
-               Note that we cannot skip the final step where we extract
-               the object type from its tag, because the EVAL_NORMAL phase
-               results in dynamic components being resolved into fixed ones.
-               This can cause problems when trying to print the type
-               description of tagged types whose parent has a dynamic size:
-               We use the type name of the "_parent" component in order
-               to print the name of the ancestor type in the type description.
-               If that component had a dynamic size, the resolution into
-               a fixed type would result in the loss of that type name,
-               thus preventing us from printing the name of the ancestor
-               type in the type description.  */
-            arg1 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
-
-           if (TYPE_CODE (type) != TYPE_CODE_REF)
-             {
-               struct type *actual_type;
-
-               actual_type = type_from_tag (ada_value_tag (arg1));
-               if (actual_type == NULL)
-                 /* If, for some reason, we were unable to determine
-                    the actual type from the tag, then use the static
-                    approximation that we just computed as a fallback.
-                    This can happen if the debugging information is
-                    incomplete, for instance.  */
-                 actual_type = type;
-               return value_zero (actual_type, not_lval);
-             }
-           else
-             {
-               /* In the case of a ref, ada_coerce_ref takes care
-                  of determining the actual type.  But the evaluation
-                  should return a ref as it should be valid to ask
-                  for its address; so rebuild a ref after coerce.  */
-               arg1 = ada_coerce_ref (arg1);
-               return value_ref (arg1);
-             }
-          }
+           {
+             /* Tagged types are a little special in the fact that the real
+                type is dynamic and can only be determined by inspecting the
+                object's tag.  This means that we need to get the object's
+                value first (EVAL_NORMAL) and then extract the actual object
+                type from its tag.
+
+                Note that we cannot skip the final step where we extract
+                the object type from its tag, because the EVAL_NORMAL phase
+                results in dynamic components being resolved into fixed ones.
+                This can cause problems when trying to print the type
+                description of tagged types whose parent has a dynamic size:
+                We use the type name of the "_parent" component in order
+                to print the name of the ancestor type in the type description.
+                If that component had a dynamic size, the resolution into
+                a fixed type would result in the loss of that type name,
+                thus preventing us from printing the name of the ancestor
+                type in the type description.  */
+             arg1 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
+
+             if (TYPE_CODE (type) != TYPE_CODE_REF)
+               {
+                 struct type *actual_type;
+
+                 actual_type = type_from_tag (ada_value_tag (arg1));
+                 if (actual_type == NULL)
+                   /* If, for some reason, we were unable to determine
+                      the actual type from the tag, then use the static
+                      approximation that we just computed as a fallback.
+                      This can happen if the debugging information is
+                      incomplete, for instance.  */
+                   actual_type = type;
+                 return value_zero (actual_type, not_lval);
+               }
+             else
+               {
+                 /* In the case of a ref, ada_coerce_ref takes care
+                    of determining the actual type.  But the evaluation
+                    should return a ref as it should be valid to ask
+                    for its address; so rebuild a ref after coerce.  */
+                 arg1 = ada_coerce_ref (arg1);
+                 return value_ref (arg1);
+               }
+           }
 
-          *pos += 4;
-          return value_zero
-            (to_static_fixed_type
-             (static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol))),
-             not_lval);
-        }
-      else
-        {
-          arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
-          return ada_to_fixed_value (arg1);
+         /* Records and unions for which GNAT encodings have been
+            generated need to be statically fixed as well.
+            Otherwise, non-static fixing produces a type where
+            all dynamic properties are removed, which prevents "ptype"
+            from being able to completely describe the type.
+            For instance, a case statement in a variant record would be
+            replaced by the relevant components based on the actual
+            value of the discriminants.  */
+         if ((TYPE_CODE (type) == TYPE_CODE_STRUCT
+              && dynamic_template_type (type) != NULL)
+             || (TYPE_CODE (type) == TYPE_CODE_UNION
+                 && ada_find_parallel_type (type, "___XVU") != NULL))
+           {
+             *pos += 4;
+             return value_zero (to_static_fixed_type (type), not_lval);
+           }
         }
 
+      arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
+      return ada_to_fixed_value (arg1);
+
     case OP_FUNCALL:
       (*pos) += 2;
 
@@ -10003,9 +10618,9 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
                           (ada_coerce_to_simple_array (argvec[0]),
                            nargs, argvec + 1));
         case TYPE_CODE_PTR:     /* Pointer to array */
-          type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
           if (noside == EVAL_AVOID_SIDE_EFFECTS)
             {
+             type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
               type = ada_array_element_type (type, nargs);
               if (type == NULL)
                 error (_("element type of array unknown"));
@@ -10013,8 +10628,8 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
                 return value_zero (ada_aligned_type (type), lval_memory);
             }
           return
-            unwrap_value (ada_value_ptr_subscript (argvec[0], type,
-                                                   nargs, argvec + 1));
+            unwrap_value (ada_value_ptr_subscript (argvec[0],
+                                                  nargs, argvec + 1));
 
         default:
           error (_("Attempt to index or call something other than an "
@@ -10033,8 +10648,8 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
 
         low_bound_val = coerce_ref (low_bound_val);
         high_bound_val = coerce_ref (high_bound_val);
-        low_bound = pos_atr (low_bound_val);
-        high_bound = pos_atr (high_bound_val);
+        low_bound = value_as_long (low_bound_val);
+        high_bound = value_as_long (high_bound_val);
 
         if (noside == EVAL_SKIP)
           goto nosideret;
@@ -10217,10 +10832,15 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
             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,
-                                  ada_attribute_name (op));
-            if (type == NULL)
+            if (op == OP_ATR_LENGTH)
              type = builtin_type (exp->gdbarch)->builtin_int;
+           else
+             {
+               type = ada_index_type (value_type (arg1), tem,
+                                      ada_attribute_name (op));
+               if (type == NULL)
+                 type = builtin_type (exp->gdbarch)->builtin_int;
+             }
 
             if (noside == EVAL_AVOID_SIDE_EFFECTS)
               return allocate_value (type);
@@ -10273,9 +10893,14 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
             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)
+           if (op == OP_ATR_LENGTH)
              type = builtin_type (exp->gdbarch)->builtin_int;
+           else
+             {
+               type = ada_index_type (type_arg, tem, ada_attribute_name (op));
+               if (type == NULL)
+                 type = builtin_type (exp->gdbarch)->builtin_int;
+             }
 
             if (noside == EVAL_AVOID_SIDE_EFFECTS)
               return allocate_value (type);
@@ -10417,6 +11042,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
         return arg1;
 
     case UNOP_IND:
+      preeval_pos = *pos;
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
       if (noside == EVAL_SKIP)
         goto nosideret;
@@ -10437,10 +11063,26 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
                    /* In C you can dereference an array to get the 1st elt.  */
                    || TYPE_CODE (type) == TYPE_CODE_ARRAY)
             {
-              type = to_static_fixed_type
-                (ada_aligned_type
-                 (ada_check_typedef (TYPE_TARGET_TYPE (type))));
-              check_size (type);
+            /* As mentioned in the OP_VAR_VALUE case, tagged types can
+               only be determined by inspecting the object's tag.
+               This means that we need to evaluate completely the
+               expression in order to get its type.  */
+
+             if ((TYPE_CODE (type) == TYPE_CODE_REF
+                  || TYPE_CODE (type) == TYPE_CODE_PTR)
+                 && ada_is_tagged_type (TYPE_TARGET_TYPE (type), 0))
+               {
+                 arg1 = evaluate_subexp (NULL_TYPE, exp, &preeval_pos,
+                                         EVAL_NORMAL);
+                 type = value_type (ada_value_ind (arg1));
+               }
+             else
+               {
+                 type = to_static_fixed_type
+                   (ada_aligned_type
+                    (ada_check_typedef (TYPE_TARGET_TYPE (type))));
+               }
+             ada_ensure_varsize_limit (type);
               return value_zero (type, lval_memory);
             }
           else if (TYPE_CODE (type) == TYPE_CODE_INT)
@@ -10484,6 +11126,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
     case STRUCTOP_STRUCT:
       tem = longest_to_int (exp->elts[pc + 1].longconst);
       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
+      preeval_pos = *pos;
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
       if (noside == EVAL_SKIP)
         goto nosideret;
@@ -10496,13 +11139,21 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
               type = ada_lookup_struct_elt_type (type1,
                                                  &exp->elts[pc + 2].string,
                                                  1, 1, NULL);
+
+             /* If the field is not found, check if it exists in the
+                extension of this object's type. This means that we
+                need to evaluate completely the expression.  */
+
               if (type == NULL)
-                /* In this case, we assume that the field COULD exist
-                   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 (exp->gdbarch)->builtin_void,
-                                  lval_memory);
+               {
+                 arg1 = evaluate_subexp (NULL_TYPE, exp, &preeval_pos,
+                                         EVAL_NORMAL);
+                 arg1 = ada_value_struct_elt (arg1,
+                                              &exp->elts[pc + 2].string,
+                                              0);
+                 arg1 = unwrap_value (arg1);
+                 type = value_type (ada_to_fixed_value (arg1));
+               }
             }
           else
             type =
@@ -10722,7 +11373,7 @@ scan_discrim_bound (char *str, int k, struct value *dval, LONGEST * px,
 static struct value *
 get_var_value (char *name, char *err_msg)
 {
-  struct ada_symbol_info *syms;
+  struct block_symbol *syms;
   int nsyms;
 
   nsyms = ada_lookup_symbol_list (name, get_selected_block (0), VAR_DOMAIN,
@@ -10736,7 +11387,7 @@ get_var_value (char *name, char *err_msg)
         error (("%s"), err_msg);
     }
 
-  return value_of_variable (syms[0].sym, syms[0].block);
+  return value_of_variable (syms[0].symbol, syms[0].block);
 }
 
 /* Value of integer variable named NAME in the current environment.  If
@@ -10797,9 +11448,8 @@ to_fixed_range_type (struct type *raw_type, struct value *dval)
       if (L < INT_MIN || U > INT_MAX)
        return raw_type;
       else
-       return create_range_type (alloc_type_copy (raw_type), raw_type,
-                                 ada_discrete_type_low_bound (raw_type),
-                                 ada_discrete_type_high_bound (raw_type));
+       return create_static_range_type (alloc_type_copy (raw_type), raw_type,
+                                        L, U);
     }
   else
     {
@@ -10862,7 +11512,8 @@ to_fixed_range_type (struct type *raw_type, struct value *dval)
             }
         }
 
-      type = create_range_type (alloc_type_copy (raw_type), base_type, L, U);
+      type = create_static_range_type (alloc_type_copy (raw_type),
+                                      base_type, L, U);
       TYPE_NAME (type) = name;
       return type;
     }
@@ -10926,17 +11577,19 @@ ada_modulus (struct type *type)
    variants of the runtime, we use a sniffer that will determine
    the runtime variant used by the program being debugged.  */
 
-/* The different types of catchpoints that we introduced for catching
-   Ada exceptions.  */
-
-enum exception_catchpoint_kind
-{
-  ex_catch_exception,
-  ex_catch_exception_unhandled,
-  ex_catch_assert
-};
+/* Ada's standard exceptions.
 
-/* Ada's standard exceptions.  */
+   The Ada 83 standard also defined Numeric_Error.  But there so many
+   situations where it was unclear from the Ada 83 Reference Manual
+   (RM) whether Constraint_Error or Numeric_Error should be raised,
+   that the ARG (Ada Rapporteur Group) eventually issued a Binding
+   Interpretation saying that anytime the RM says that Numeric_Error
+   should be raised, the implementation may raise Constraint_Error.
+   Ada 95 went one step further and pretty much removed Numeric_Error
+   from the list of standard exceptions (it made it a renaming of
+   Constraint_Error, to help preserve compatibility when compiling
+   an Ada83 compiler). As such, we do not include Numeric_Error from
+   this list of standard exceptions.  */
 
 static char *standard_exc[] = {
   "constraint_error",
@@ -11031,7 +11684,10 @@ ada_has_this_exception_support (const struct exception_support_info *einfo)
         the name of the exception being raised (this name is printed in
         the catchpoint message, and is also used when trying to catch
         a specific exception).  We do not handle this case for now.  */
-      if (lookup_minimal_symbol (einfo->catch_exception_sym, NULL, NULL))
+      struct bound_minimal_symbol msym
+       = lookup_minimal_symbol (einfo->catch_exception_sym, NULL, NULL);
+
+      if (msym.minsym && MSYMBOL_TYPE (msym.minsym) != mst_solib_trampoline)
        error (_("Your Ada runtime appears to be missing some debugging "
                 "information.\nCannot insert Ada exception catchpoint "
                 "in this configuration."));
@@ -11113,7 +11769,7 @@ static int
 is_known_support_routine (struct frame_info *frame)
 {
   struct symtab_and_line sal;
-  const char *func_name;
+  char *func_name;
   enum language func_lang;
   int i;
   const char *fullname;
@@ -11145,8 +11801,8 @@ is_known_support_routine (struct frame_info *frame)
       re_comp (known_runtime_file_name_patterns[i]);
       if (re_exec (lbasename (sal.symtab->filename)))
         return 1;
-      if (sal.symtab->objfile != NULL
-          && re_exec (sal.symtab->objfile->name))
+      if (SYMTAB_OBJFILE (sal.symtab) != NULL
+          && re_exec (objfile_name (SYMTAB_OBJFILE (sal.symtab))))
         return 1;
     }
 
@@ -11160,9 +11816,13 @@ is_known_support_routine (struct frame_info *frame)
     {
       re_comp (known_auxiliary_function_name_patterns[i]);
       if (re_exec (func_name))
-        return 1;
+       {
+         xfree (func_name);
+         return 1;
+       }
     }
 
+  xfree (func_name);
   return 0;
 }
 
@@ -11206,6 +11866,7 @@ ada_unhandled_exception_name_addr_from_raise (void)
   int frame_level;
   struct frame_info *fi;
   struct ada_inferior_data *data = get_ada_inferior_data (current_inferior ());
+  struct cleanup *old_chain;
 
   /* To determine the name of this exception, we need to select
      the frame corresponding to RAISE_SYM_NAME.  This frame is
@@ -11216,17 +11877,24 @@ ada_unhandled_exception_name_addr_from_raise (void)
     if (fi != NULL)
       fi = get_prev_frame (fi); 
 
+  old_chain = make_cleanup (null_cleanup, NULL);
   while (fi != NULL)
     {
-      const char *func_name;
+      char *func_name;
       enum language func_lang;
 
       find_frame_funname (fi, &func_name, &func_lang, NULL);
-      if (func_name != NULL
-          && strcmp (func_name, data->exception_info->catch_exception_sym) == 0)
-        break; /* We found the frame we were looking for...  */
-      fi = get_prev_frame (fi);
+      if (func_name != NULL)
+       {
+         make_cleanup (xfree, func_name);
+
+          if (strcmp (func_name,
+                     data->exception_info->catch_exception_sym) == 0)
+           break; /* We found the frame we were looking for...  */
+         fi = get_prev_frame (fi);
+       }
     }
+  do_cleanups (old_chain);
 
   if (fi == NULL)
     return 0;
@@ -11242,22 +11910,22 @@ ada_unhandled_exception_name_addr_from_raise (void)
    Return zero if the address could not be computed, or if not relevant.  */
 
 static CORE_ADDR
-ada_exception_name_addr_1 (enum exception_catchpoint_kind ex,
+ada_exception_name_addr_1 (enum ada_exception_catchpoint_kind ex,
                            struct breakpoint *b)
 {
   struct ada_inferior_data *data = get_ada_inferior_data (current_inferior ());
 
   switch (ex)
     {
-      case ex_catch_exception:
+      case ada_catch_exception:
         return (parse_and_eval_address ("e.full_name"));
         break;
 
-      case ex_catch_exception_unhandled:
+      case ada_catch_exception_unhandled:
         return data->exception_info->unhandled_exception_name_addr ();
         break;
       
-      case ex_catch_assert:
+      case ada_catch_assert:
         return 0;  /* Exception name is not relevant in this case.  */
         break;
 
@@ -11275,29 +11943,26 @@ ada_exception_name_addr_1 (enum exception_catchpoint_kind ex,
    and zero is returned.  */
 
 static CORE_ADDR
-ada_exception_name_addr (enum exception_catchpoint_kind ex,
+ada_exception_name_addr (enum ada_exception_catchpoint_kind ex,
                          struct breakpoint *b)
 {
-  volatile struct gdb_exception e;
   CORE_ADDR result = 0;
 
-  TRY_CATCH (e, RETURN_MASK_ERROR)
+  TRY
     {
       result = ada_exception_name_addr_1 (ex, b);
     }
 
-  if (e.reason < 0)
+  CATCH (e, RETURN_MASK_ERROR)
     {
       warning (_("failed to get exception name: %s"), e.message);
       return 0;
     }
+  END_CATCH
 
   return result;
 }
 
-static struct symtab_and_line ada_exception_sal (enum exception_catchpoint_kind,
-                                                char *, char **,
-                                                const struct breakpoint_ops **);
 static char *ada_exception_catchpoint_cond_string (const char *excep_string);
 
 /* Ada catchpoints.
@@ -11393,19 +12058,28 @@ create_excep_cond_exprs (struct ada_catchpoint *c)
 
       if (!bl->shlib_disabled)
        {
-         volatile struct gdb_exception e;
          const char *s;
 
          s = cond_string;
-         TRY_CATCH (e, RETURN_MASK_ERROR)
+         TRY
            {
              exp = parse_exp_1 (&s, bl->address,
                                 block_for_pc (bl->address), 0);
            }
-         if (e.reason < 0)
-           warning (_("failed to reevaluate internal exception condition "
-                      "for catchpoint %d: %s"),
-                    c->base.number, e.message);
+         CATCH (e, RETURN_MASK_ERROR)
+           {
+             warning (_("failed to reevaluate internal exception condition "
+                        "for catchpoint %d: %s"),
+                      c->base.number, e.message);
+             /* There is a bug in GCC on sparc-solaris when building with
+                optimization which causes EXP to change unexpectedly
+                (http://gcc.gnu.org/bugzilla/show_bug.cgi?id=56982).
+                The problem should be fixed starting with GCC 4.9.
+                In the meantime, work around it by forcing EXP back
+                to NULL.  */
+             exp = NULL;
+           }
+         END_CATCH
        }
 
       ada_loc->excep_cond_expr = exp;
@@ -11418,7 +12092,7 @@ create_excep_cond_exprs (struct ada_catchpoint *c)
    exception catchpoint kinds.  */
 
 static void
-dtor_exception (enum exception_catchpoint_kind ex, struct breakpoint *b)
+dtor_exception (enum ada_exception_catchpoint_kind ex, struct breakpoint *b)
 {
   struct ada_catchpoint *c = (struct ada_catchpoint *) b;
 
@@ -11431,7 +12105,7 @@ dtor_exception (enum exception_catchpoint_kind ex, struct breakpoint *b)
    structure for all exception catchpoint kinds.  */
 
 static struct bp_location *
-allocate_location_exception (enum exception_catchpoint_kind ex,
+allocate_location_exception (enum ada_exception_catchpoint_kind ex,
                             struct breakpoint *self)
 {
   struct ada_catchpoint_location *loc;
@@ -11446,7 +12120,7 @@ allocate_location_exception (enum exception_catchpoint_kind ex,
    exception catchpoint kinds.  */
 
 static void
-re_set_exception (enum exception_catchpoint_kind ex, struct breakpoint *b)
+re_set_exception (enum ada_exception_catchpoint_kind ex, struct breakpoint *b)
 {
   struct ada_catchpoint *c = (struct ada_catchpoint *) b;
 
@@ -11469,7 +12143,6 @@ should_stop_exception (const struct bp_location *bl)
   struct ada_catchpoint *c = (struct ada_catchpoint *) bl->owner;
   const struct ada_catchpoint_location *ada_loc
     = (const struct ada_catchpoint_location *) bl;
-  volatile struct gdb_exception ex;
   int stop;
 
   /* With no specific exception, should always stop.  */
@@ -11484,7 +12157,7 @@ should_stop_exception (const struct bp_location *bl)
     }
 
   stop = 1;
-  TRY_CATCH (ex, RETURN_MASK_ALL)
+  TRY
     {
       struct value *mark;
 
@@ -11492,9 +12165,13 @@ should_stop_exception (const struct bp_location *bl)
       stop = value_true (evaluate_expression (ada_loc->excep_cond_expr));
       value_free_to_mark (mark);
     }
-  if (ex.reason < 0)
-    exception_fprintf (gdb_stderr, ex,
-                      _("Error in testing exception condition:\n"));
+  CATCH (ex, RETURN_MASK_ALL)
+    {
+      exception_fprintf (gdb_stderr, ex,
+                        _("Error in testing exception condition:\n"));
+    }
+  END_CATCH
+
   return stop;
 }
 
@@ -11502,7 +12179,7 @@ should_stop_exception (const struct bp_location *bl)
    for all exception catchpoint kinds.  */
 
 static void
-check_status_exception (enum exception_catchpoint_kind ex, bpstat bs)
+check_status_exception (enum ada_exception_catchpoint_kind ex, bpstat bs)
 {
   bs->stop = should_stop_exception (bs->bp_location_at);
 }
@@ -11511,7 +12188,7 @@ check_status_exception (enum exception_catchpoint_kind ex, bpstat bs)
    for all exception catchpoint kinds.  */
 
 static enum print_stop_action
-print_it_exception (enum exception_catchpoint_kind ex, bpstat bs)
+print_it_exception (enum ada_exception_catchpoint_kind ex, bpstat bs)
 {
   struct ui_out *uiout = current_uiout;
   struct breakpoint *b = bs->breakpoint_at;
@@ -11533,8 +12210,8 @@ print_it_exception (enum exception_catchpoint_kind ex, bpstat bs)
 
   switch (ex)
     {
-      case ex_catch_exception:
-      case ex_catch_exception_unhandled:
+      case ada_catch_exception:
+      case ada_catch_exception_unhandled:
        {
          const CORE_ADDR addr = ada_exception_name_addr (ex, b);
          char exception_name[256];
@@ -11560,12 +12237,12 @@ print_it_exception (enum exception_catchpoint_kind ex, bpstat bs)
             it clearer to the user which kind of catchpoint just got
             hit.  We used ui_out_text to make sure that this extra
             info does not pollute the exception name in the MI case.  */
-         if (ex == ex_catch_exception_unhandled)
+         if (ex == ada_catch_exception_unhandled)
            ui_out_text (uiout, "unhandled ");
          ui_out_field_string (uiout, "exception-name", exception_name);
        }
        break;
-      case ex_catch_assert:
+      case ada_catch_assert:
        /* In this case, the name of the exception is not really
           important.  Just print "failed assertion" to make it clearer
           that his program just hit an assertion-failure catchpoint.
@@ -11584,7 +12261,7 @@ print_it_exception (enum exception_catchpoint_kind ex, bpstat bs)
    for all exception catchpoint kinds.  */
 
 static void
-print_one_exception (enum exception_catchpoint_kind ex,
+print_one_exception (enum ada_exception_catchpoint_kind ex,
                      struct breakpoint *b, struct bp_location **last_loc)
 { 
   struct ui_out *uiout = current_uiout;
@@ -11602,7 +12279,7 @@ print_one_exception (enum exception_catchpoint_kind ex,
   *last_loc = b->loc;
   switch (ex)
     {
-      case ex_catch_exception:
+      case ada_catch_exception:
         if (c->excep_string != NULL)
           {
             char *msg = xstrprintf (_("`%s' Ada exception"), c->excep_string);
@@ -11615,11 +12292,11 @@ print_one_exception (enum exception_catchpoint_kind ex,
         
         break;
 
-      case ex_catch_exception_unhandled:
+      case ada_catch_exception_unhandled:
         ui_out_field_string (uiout, "what", "unhandled Ada exceptions");
         break;
       
-      case ex_catch_assert:
+      case ada_catch_assert:
         ui_out_field_string (uiout, "what", "failed Ada assertions");
         break;
 
@@ -11633,7 +12310,7 @@ print_one_exception (enum exception_catchpoint_kind ex,
    for all exception catchpoint kinds.  */
 
 static void
-print_mention_exception (enum exception_catchpoint_kind ex,
+print_mention_exception (enum ada_exception_catchpoint_kind ex,
                          struct breakpoint *b)
 {
   struct ada_catchpoint *c = (struct ada_catchpoint *) b;
@@ -11646,7 +12323,7 @@ print_mention_exception (enum exception_catchpoint_kind ex,
 
   switch (ex)
     {
-      case ex_catch_exception:
+      case ada_catch_exception:
         if (c->excep_string != NULL)
          {
            char *info = xstrprintf (_("`%s' Ada exception"), c->excep_string);
@@ -11659,11 +12336,11 @@ print_mention_exception (enum exception_catchpoint_kind ex,
           ui_out_text (uiout, _("all Ada exceptions"));
         break;
 
-      case ex_catch_exception_unhandled:
+      case ada_catch_exception_unhandled:
         ui_out_text (uiout, _("unhandled Ada exceptions"));
         break;
       
-      case ex_catch_assert:
+      case ada_catch_assert:
         ui_out_text (uiout, _("failed Ada assertions"));
         break;
 
@@ -11677,24 +12354,24 @@ print_mention_exception (enum exception_catchpoint_kind ex,
    for all exception catchpoint kinds.  */
 
 static void
-print_recreate_exception (enum exception_catchpoint_kind ex,
+print_recreate_exception (enum ada_exception_catchpoint_kind ex,
                          struct breakpoint *b, struct ui_file *fp)
 {
   struct ada_catchpoint *c = (struct ada_catchpoint *) b;
 
   switch (ex)
     {
-      case ex_catch_exception:
+      case ada_catch_exception:
        fprintf_filtered (fp, "catch exception");
        if (c->excep_string != NULL)
          fprintf_filtered (fp, " %s", c->excep_string);
        break;
 
-      case ex_catch_exception_unhandled:
+      case ada_catch_exception_unhandled:
        fprintf_filtered (fp, "catch exception unhandled");
        break;
 
-      case ex_catch_assert:
+      case ada_catch_assert:
        fprintf_filtered (fp, "catch assert");
        break;
 
@@ -11709,49 +12386,49 @@ print_recreate_exception (enum exception_catchpoint_kind ex,
 static void
 dtor_catch_exception (struct breakpoint *b)
 {
-  dtor_exception (ex_catch_exception, b);
+  dtor_exception (ada_catch_exception, b);
 }
 
 static struct bp_location *
 allocate_location_catch_exception (struct breakpoint *self)
 {
-  return allocate_location_exception (ex_catch_exception, self);
+  return allocate_location_exception (ada_catch_exception, self);
 }
 
 static void
 re_set_catch_exception (struct breakpoint *b)
 {
-  re_set_exception (ex_catch_exception, b);
+  re_set_exception (ada_catch_exception, b);
 }
 
 static void
 check_status_catch_exception (bpstat bs)
 {
-  check_status_exception (ex_catch_exception, bs);
+  check_status_exception (ada_catch_exception, bs);
 }
 
 static enum print_stop_action
 print_it_catch_exception (bpstat bs)
 {
-  return print_it_exception (ex_catch_exception, bs);
+  return print_it_exception (ada_catch_exception, bs);
 }
 
 static void
 print_one_catch_exception (struct breakpoint *b, struct bp_location **last_loc)
 {
-  print_one_exception (ex_catch_exception, b, last_loc);
+  print_one_exception (ada_catch_exception, b, last_loc);
 }
 
 static void
 print_mention_catch_exception (struct breakpoint *b)
 {
-  print_mention_exception (ex_catch_exception, b);
+  print_mention_exception (ada_catch_exception, b);
 }
 
 static void
 print_recreate_catch_exception (struct breakpoint *b, struct ui_file *fp)
 {
-  print_recreate_exception (ex_catch_exception, b, fp);
+  print_recreate_exception (ada_catch_exception, b, fp);
 }
 
 static struct breakpoint_ops catch_exception_breakpoint_ops;
@@ -11761,51 +12438,51 @@ static struct breakpoint_ops catch_exception_breakpoint_ops;
 static void
 dtor_catch_exception_unhandled (struct breakpoint *b)
 {
-  dtor_exception (ex_catch_exception_unhandled, b);
+  dtor_exception (ada_catch_exception_unhandled, b);
 }
 
 static struct bp_location *
 allocate_location_catch_exception_unhandled (struct breakpoint *self)
 {
-  return allocate_location_exception (ex_catch_exception_unhandled, self);
+  return allocate_location_exception (ada_catch_exception_unhandled, self);
 }
 
 static void
 re_set_catch_exception_unhandled (struct breakpoint *b)
 {
-  re_set_exception (ex_catch_exception_unhandled, b);
+  re_set_exception (ada_catch_exception_unhandled, b);
 }
 
 static void
 check_status_catch_exception_unhandled (bpstat bs)
 {
-  check_status_exception (ex_catch_exception_unhandled, bs);
+  check_status_exception (ada_catch_exception_unhandled, bs);
 }
 
 static enum print_stop_action
 print_it_catch_exception_unhandled (bpstat bs)
 {
-  return print_it_exception (ex_catch_exception_unhandled, bs);
+  return print_it_exception (ada_catch_exception_unhandled, bs);
 }
 
 static void
 print_one_catch_exception_unhandled (struct breakpoint *b,
                                     struct bp_location **last_loc)
 {
-  print_one_exception (ex_catch_exception_unhandled, b, last_loc);
+  print_one_exception (ada_catch_exception_unhandled, b, last_loc);
 }
 
 static void
 print_mention_catch_exception_unhandled (struct breakpoint *b)
 {
-  print_mention_exception (ex_catch_exception_unhandled, b);
+  print_mention_exception (ada_catch_exception_unhandled, b);
 }
 
 static void
 print_recreate_catch_exception_unhandled (struct breakpoint *b,
                                          struct ui_file *fp)
 {
-  print_recreate_exception (ex_catch_exception_unhandled, b, fp);
+  print_recreate_exception (ada_catch_exception_unhandled, b, fp);
 }
 
 static struct breakpoint_ops catch_exception_unhandled_breakpoint_ops;
@@ -11815,49 +12492,49 @@ static struct breakpoint_ops catch_exception_unhandled_breakpoint_ops;
 static void
 dtor_catch_assert (struct breakpoint *b)
 {
-  dtor_exception (ex_catch_assert, b);
+  dtor_exception (ada_catch_assert, b);
 }
 
 static struct bp_location *
 allocate_location_catch_assert (struct breakpoint *self)
 {
-  return allocate_location_exception (ex_catch_assert, self);
+  return allocate_location_exception (ada_catch_assert, self);
 }
 
 static void
 re_set_catch_assert (struct breakpoint *b)
 {
-  re_set_exception (ex_catch_assert, b);
+  re_set_exception (ada_catch_assert, b);
 }
 
 static void
 check_status_catch_assert (bpstat bs)
 {
-  check_status_exception (ex_catch_assert, bs);
+  check_status_exception (ada_catch_assert, bs);
 }
 
 static enum print_stop_action
 print_it_catch_assert (bpstat bs)
 {
-  return print_it_exception (ex_catch_assert, bs);
+  return print_it_exception (ada_catch_assert, bs);
 }
 
 static void
 print_one_catch_assert (struct breakpoint *b, struct bp_location **last_loc)
 {
-  print_one_exception (ex_catch_assert, b, last_loc);
+  print_one_exception (ada_catch_assert, b, last_loc);
 }
 
 static void
 print_mention_catch_assert (struct breakpoint *b)
 {
-  print_mention_exception (ex_catch_assert, b);
+  print_mention_exception (ada_catch_assert, b);
 }
 
 static void
 print_recreate_catch_assert (struct breakpoint *b, struct ui_file *fp)
 {
-  print_recreate_exception (ex_catch_assert, b, fp);
+  print_recreate_exception (ada_catch_assert, b, fp);
 }
 
 static struct breakpoint_ops catch_assert_breakpoint_ops;
@@ -11906,7 +12583,7 @@ ada_get_next_arg (char **argsp)
 
 static void
 catch_ada_exception_command_split (char *args,
-                                   enum exception_catchpoint_kind *ex,
+                                   enum ada_exception_catchpoint_kind *ex,
                                   char **excep_string,
                                   char **cond_string)
 {
@@ -11929,7 +12606,7 @@ catch_ada_exception_command_split (char *args,
   /* Check to see if we have a condition.  */
 
   args = skip_spaces (args);
-  if (strncmp (args, "if", 2) == 0
+  if (startswith (args, "if")
       && (isspace (args[2]) || args[2] == '\0'))
     {
       args += 2;
@@ -11954,19 +12631,19 @@ catch_ada_exception_command_split (char *args,
   if (exception_name == NULL)
     {
       /* Catch all exceptions.  */
-      *ex = ex_catch_exception;
+      *ex = ada_catch_exception;
       *excep_string = NULL;
     }
   else if (strcmp (exception_name, "unhandled") == 0)
     {
       /* Catch unhandled exceptions.  */
-      *ex = ex_catch_exception_unhandled;
+      *ex = ada_catch_exception_unhandled;
       *excep_string = NULL;
     }
   else
     {
       /* Catch a specific exception.  */
-      *ex = ex_catch_exception;
+      *ex = ada_catch_exception;
       *excep_string = exception_name;
     }
   *cond_string = cond;
@@ -11976,7 +12653,7 @@ catch_ada_exception_command_split (char *args,
    implement a catchpoint of the EX kind.  */
 
 static const char *
-ada_exception_sym_name (enum exception_catchpoint_kind ex)
+ada_exception_sym_name (enum ada_exception_catchpoint_kind ex)
 {
   struct ada_inferior_data *data = get_ada_inferior_data (current_inferior ());
 
@@ -11984,13 +12661,13 @@ ada_exception_sym_name (enum exception_catchpoint_kind ex)
 
   switch (ex)
     {
-      case ex_catch_exception:
+      case ada_catch_exception:
         return (data->exception_info->catch_exception_sym);
         break;
-      case ex_catch_exception_unhandled:
+      case ada_catch_exception_unhandled:
         return (data->exception_info->catch_exception_unhandled_sym);
         break;
-      case ex_catch_assert:
+      case ada_catch_assert:
         return (data->exception_info->catch_assert_sym);
         break;
       default:
@@ -12003,17 +12680,17 @@ ada_exception_sym_name (enum exception_catchpoint_kind ex)
    of the EX kind.  */
 
 static const struct breakpoint_ops *
-ada_exception_breakpoint_ops (enum exception_catchpoint_kind ex)
+ada_exception_breakpoint_ops (enum ada_exception_catchpoint_kind ex)
 {
   switch (ex)
     {
-      case ex_catch_exception:
+      case ada_catch_exception:
         return (&catch_exception_breakpoint_ops);
         break;
-      case ex_catch_exception_unhandled:
+      case ada_catch_exception_unhandled:
         return (&catch_exception_unhandled_breakpoint_ops);
         break;
-      case ex_catch_assert:
+      case ada_catch_assert:
         return (&catch_assert_breakpoint_ops);
         break;
       default:
@@ -12076,7 +12753,7 @@ ada_exception_catchpoint_cond_string (const char *excep_string)
    type of catchpoint we need to create.  */
 
 static struct symtab_and_line
-ada_exception_sal (enum exception_catchpoint_kind ex, char *excep_string,
+ada_exception_sal (enum ada_exception_catchpoint_kind ex, char *excep_string,
                   char **addr_string, const struct breakpoint_ops **ops)
 {
   const char *sym_name;
@@ -12108,47 +12785,43 @@ ada_exception_sal (enum exception_catchpoint_kind ex, char *excep_string,
   return find_function_start_sal (sym, 1);
 }
 
-/* Parse the arguments (ARGS) of the "catch exception" command.
-   If the user asked the catchpoint to catch only a specific
-   exception, then save the exception name in ADDR_STRING.
+/* Create an Ada exception catchpoint.
 
-   If the user provided a condition, then set COND_STRING to
-   that condition expression (the memory must be deallocated
-   after use).  Otherwise, set COND_STRING to NULL.
+   EX_KIND is the kind of exception catchpoint to be created.
 
-   See ada_exception_sal for a description of all the remaining
-   function arguments of this function.  */
+   If EXCEPT_STRING is NULL, this catchpoint is expected to trigger
+   for all exceptions.  Otherwise, EXCEPT_STRING indicates the name
+   of the exception to which this catchpoint applies.  When not NULL,
+   the string must be allocated on the heap, and its deallocation
+   is no longer the responsibility of the caller.
 
-static struct symtab_and_line
-ada_decode_exception_location (char *args, char **addr_string,
-                               char **excep_string,
-                              char **cond_string,
-                               const struct breakpoint_ops **ops)
-{
-  enum exception_catchpoint_kind ex;
+   COND_STRING, if not NULL, is the catchpoint condition.  This string
+   must be allocated on the heap, and its deallocation is no longer
+   the responsibility of the caller.
 
-  catch_ada_exception_command_split (args, &ex, excep_string, cond_string);
-  return ada_exception_sal (ex, *excep_string, addr_string, ops);
-}
+   TEMPFLAG, if nonzero, means that the underlying breakpoint
+   should be temporary.
 
-/* Create an Ada exception catchpoint.  */
+   FROM_TTY is the usual argument passed to all commands implementations.  */
 
-static void
+void
 create_ada_exception_catchpoint (struct gdbarch *gdbarch,
-                                struct symtab_and_line sal,
-                                char *addr_string,
+                                enum ada_exception_catchpoint_kind ex_kind,
                                 char *excep_string,
                                 char *cond_string,
-                                const struct breakpoint_ops *ops,
                                 int tempflag,
+                                int disabled,
                                 int from_tty)
 {
   struct ada_catchpoint *c;
+  char *addr_string = NULL;
+  const struct breakpoint_ops *ops = NULL;
+  struct symtab_and_line sal
+    = ada_exception_sal (ex_kind, excep_string, &addr_string, &ops);
 
   c = XNEW (struct ada_catchpoint);
   init_ada_exception_breakpoint (&c->base, gdbarch, sal, addr_string,
-                                ops, tempflag, from_tty);
+                                ops, tempflag, disabled, from_tty);
   c->excep_string = excep_string;
   create_excep_cond_exprs (c);
   if (cond_string != NULL)
@@ -12164,43 +12837,37 @@ catch_ada_exception_command (char *arg, int from_tty,
 {
   struct gdbarch *gdbarch = get_current_arch ();
   int tempflag;
-  struct symtab_and_line sal;
-  char *addr_string = NULL;
+  enum ada_exception_catchpoint_kind ex_kind;
   char *excep_string = NULL;
   char *cond_string = NULL;
-  const struct breakpoint_ops *ops = NULL;
 
   tempflag = get_cmd_context (command) == CATCH_TEMPORARY;
 
   if (!arg)
     arg = "";
-  sal = ada_decode_exception_location (arg, &addr_string, &excep_string,
-                                      &cond_string, &ops);
-  create_ada_exception_catchpoint (gdbarch, sal, addr_string,
-                                  excep_string, cond_string, ops,
-                                  tempflag, from_tty);
+  catch_ada_exception_command_split (arg, &ex_kind, &excep_string,
+                                    &cond_string);
+  create_ada_exception_catchpoint (gdbarch, ex_kind,
+                                  excep_string, cond_string,
+                                  tempflag, 1 /* enabled */,
+                                  from_tty);
 }
 
-/* Assuming that ARGS contains the arguments of a "catch assert"
-   command, parse those arguments and return a symtab_and_line object
-   for a failed assertion catchpoint.
+/* Split the arguments specified in a "catch assert" command.
 
-   Set ADDR_STRING to the name of the function where the real
-   breakpoint that implements the catchpoint is set.
+   ARGS contains the command's arguments (or the empty string if
+   no arguments were passed).
 
    If ARGS contains a condition, set COND_STRING to that condition
-   (the memory needs to be deallocated after use).  Otherwise, set
-   COND_STRING to NULL.  */
+   (the memory needs to be deallocated after use).  */
 
-static struct symtab_and_line
-ada_decode_assert_location (char *args, char **addr_string,
-                           char **cond_string,
-                            const struct breakpoint_ops **ops)
+static void
+catch_ada_assert_command_split (char *args, char **cond_string)
 {
   args = skip_spaces (args);
 
   /* Check whether a condition was provided.  */
-  if (strncmp (args, "if", 2) == 0
+  if (startswith (args, "if")
       && (isspace (args[2]) || args[2] == '\0'))
     {
       args += 2;
@@ -12214,8 +12881,6 @@ ada_decode_assert_location (char *args, char **addr_string,
      the command.  */
   else if (args[0] != '\0')
     error (_("Junk at end of arguments."));
-
-  return ada_exception_sal (ex_catch_assert, NULL, addr_string, ops);
 }
 
 /* Implement the "catch assert" command.  */
@@ -12226,20 +12891,366 @@ catch_assert_command (char *arg, int from_tty,
 {
   struct gdbarch *gdbarch = get_current_arch ();
   int tempflag;
-  struct symtab_and_line sal;
-  char *addr_string = NULL;
   char *cond_string = NULL;
-  const struct breakpoint_ops *ops = NULL;
 
   tempflag = get_cmd_context (command) == CATCH_TEMPORARY;
 
   if (!arg)
     arg = "";
-  sal = ada_decode_assert_location (arg, &addr_string, &cond_string, &ops);
-  create_ada_exception_catchpoint (gdbarch, sal, addr_string,
-                                  NULL, cond_string, ops, tempflag,
+  catch_ada_assert_command_split (arg, &cond_string);
+  create_ada_exception_catchpoint (gdbarch, ada_catch_assert,
+                                  NULL, cond_string,
+                                  tempflag, 1 /* enabled */,
                                   from_tty);
 }
+
+/* Return non-zero if the symbol SYM is an Ada exception object.  */
+
+static int
+ada_is_exception_sym (struct symbol *sym)
+{
+  const char *type_name = type_name_no_tag (SYMBOL_TYPE (sym));
+
+  return (SYMBOL_CLASS (sym) != LOC_TYPEDEF
+          && SYMBOL_CLASS (sym) != LOC_BLOCK
+          && SYMBOL_CLASS (sym) != LOC_CONST
+          && SYMBOL_CLASS (sym) != LOC_UNRESOLVED
+          && type_name != NULL && strcmp (type_name, "exception") == 0);
+}
+
+/* Given a global symbol SYM, return non-zero iff SYM is a non-standard
+   Ada exception object.  This matches all exceptions except the ones
+   defined by the Ada language.  */
+
+static int
+ada_is_non_standard_exception_sym (struct symbol *sym)
+{
+  int i;
+
+  if (!ada_is_exception_sym (sym))
+    return 0;
+
+  for (i = 0; i < ARRAY_SIZE (standard_exc); i++)
+    if (strcmp (SYMBOL_LINKAGE_NAME (sym), standard_exc[i]) == 0)
+      return 0;  /* A standard exception.  */
+
+  /* Numeric_Error is also a standard exception, so exclude it.
+     See the STANDARD_EXC description for more details as to why
+     this exception is not listed in that array.  */
+  if (strcmp (SYMBOL_LINKAGE_NAME (sym), "numeric_error") == 0)
+    return 0;
+
+  return 1;
+}
+
+/* A helper function for qsort, comparing two struct ada_exc_info
+   objects.
+
+   The comparison is determined first by exception name, and then
+   by exception address.  */
+
+static int
+compare_ada_exception_info (const void *a, const void *b)
+{
+  const struct ada_exc_info *exc_a = (struct ada_exc_info *) a;
+  const struct ada_exc_info *exc_b = (struct ada_exc_info *) b;
+  int result;
+
+  result = strcmp (exc_a->name, exc_b->name);
+  if (result != 0)
+    return result;
+
+  if (exc_a->addr < exc_b->addr)
+    return -1;
+  if (exc_a->addr > exc_b->addr)
+    return 1;
+
+  return 0;
+}
+
+/* Sort EXCEPTIONS using compare_ada_exception_info as the comparison
+   routine, but keeping the first SKIP elements untouched.
+
+   All duplicates are also removed.  */
+
+static void
+sort_remove_dups_ada_exceptions_list (VEC(ada_exc_info) **exceptions,
+                                     int skip)
+{
+  struct ada_exc_info *to_sort
+    = VEC_address (ada_exc_info, *exceptions) + skip;
+  int to_sort_len
+    = VEC_length (ada_exc_info, *exceptions) - skip;
+  int i, j;
+
+  qsort (to_sort, to_sort_len, sizeof (struct ada_exc_info),
+        compare_ada_exception_info);
+
+  for (i = 1, j = 1; i < to_sort_len; i++)
+    if (compare_ada_exception_info (&to_sort[i], &to_sort[j - 1]) != 0)
+      to_sort[j++] = to_sort[i];
+  to_sort_len = j;
+  VEC_truncate(ada_exc_info, *exceptions, skip + to_sort_len);
+}
+
+/* A function intended as the "name_matcher" callback in the struct
+   quick_symbol_functions' expand_symtabs_matching method.
+
+   SEARCH_NAME is the symbol's search name.
+
+   If USER_DATA is not NULL, it is a pointer to a regext_t object
+   used to match the symbol (by natural name).  Otherwise, when USER_DATA
+   is null, no filtering is performed, and all symbols are a positive
+   match.  */
+
+static int
+ada_exc_search_name_matches (const char *search_name, void *user_data)
+{
+  regex_t *preg = user_data;
+
+  if (preg == NULL)
+    return 1;
+
+  /* In Ada, the symbol "search name" is a linkage name, whereas
+     the regular expression used to do the matching refers to
+     the natural name.  So match against the decoded name.  */
+  return (regexec (preg, ada_decode (search_name), 0, NULL, 0) == 0);
+}
+
+/* Add all exceptions defined by the Ada standard whose name match
+   a regular expression.
+
+   If PREG is not NULL, then this regexp_t object is used to
+   perform the symbol name matching.  Otherwise, no name-based
+   filtering is performed.
+
+   EXCEPTIONS is a vector of exceptions to which matching exceptions
+   gets pushed.  */
+
+static void
+ada_add_standard_exceptions (regex_t *preg, VEC(ada_exc_info) **exceptions)
+{
+  int i;
+
+  for (i = 0; i < ARRAY_SIZE (standard_exc); i++)
+    {
+      if (preg == NULL
+         || regexec (preg, standard_exc[i], 0, NULL, 0) == 0)
+       {
+         struct bound_minimal_symbol msymbol
+           = ada_lookup_simple_minsym (standard_exc[i]);
+
+         if (msymbol.minsym != NULL)
+           {
+             struct ada_exc_info info
+               = {standard_exc[i], BMSYMBOL_VALUE_ADDRESS (msymbol)};
+
+             VEC_safe_push (ada_exc_info, *exceptions, &info);
+           }
+       }
+    }
+}
+
+/* Add all Ada exceptions defined locally and accessible from the given
+   FRAME.
+
+   If PREG is not NULL, then this regexp_t object is used to
+   perform the symbol name matching.  Otherwise, no name-based
+   filtering is performed.
+
+   EXCEPTIONS is a vector of exceptions to which matching exceptions
+   gets pushed.  */
+
+static void
+ada_add_exceptions_from_frame (regex_t *preg, struct frame_info *frame,
+                              VEC(ada_exc_info) **exceptions)
+{
+  const struct block *block = get_frame_block (frame, 0);
+
+  while (block != 0)
+    {
+      struct block_iterator iter;
+      struct symbol *sym;
+
+      ALL_BLOCK_SYMBOLS (block, iter, sym)
+       {
+         switch (SYMBOL_CLASS (sym))
+           {
+           case LOC_TYPEDEF:
+           case LOC_BLOCK:
+           case LOC_CONST:
+             break;
+           default:
+             if (ada_is_exception_sym (sym))
+               {
+                 struct ada_exc_info info = {SYMBOL_PRINT_NAME (sym),
+                                             SYMBOL_VALUE_ADDRESS (sym)};
+
+                 VEC_safe_push (ada_exc_info, *exceptions, &info);
+               }
+           }
+       }
+      if (BLOCK_FUNCTION (block) != NULL)
+       break;
+      block = BLOCK_SUPERBLOCK (block);
+    }
+}
+
+/* Add all exceptions defined globally whose name name match
+   a regular expression, excluding standard exceptions.
+
+   The reason we exclude standard exceptions is that they need
+   to be handled separately: Standard exceptions are defined inside
+   a runtime unit which is normally not compiled with debugging info,
+   and thus usually do not show up in our symbol search.  However,
+   if the unit was in fact built with debugging info, we need to
+   exclude them because they would duplicate the entry we found
+   during the special loop that specifically searches for those
+   standard exceptions.
+
+   If PREG is not NULL, then this regexp_t object is used to
+   perform the symbol name matching.  Otherwise, no name-based
+   filtering is performed.
+
+   EXCEPTIONS is a vector of exceptions to which matching exceptions
+   gets pushed.  */
+
+static void
+ada_add_global_exceptions (regex_t *preg, VEC(ada_exc_info) **exceptions)
+{
+  struct objfile *objfile;
+  struct compunit_symtab *s;
+
+  expand_symtabs_matching (NULL, ada_exc_search_name_matches, NULL,
+                          VARIABLES_DOMAIN, preg);
+
+  ALL_COMPUNITS (objfile, s)
+    {
+      const struct blockvector *bv = COMPUNIT_BLOCKVECTOR (s);
+      int i;
+
+      for (i = GLOBAL_BLOCK; i <= STATIC_BLOCK; i++)
+       {
+         struct block *b = BLOCKVECTOR_BLOCK (bv, i);
+         struct block_iterator iter;
+         struct symbol *sym;
+
+         ALL_BLOCK_SYMBOLS (b, iter, sym)
+           if (ada_is_non_standard_exception_sym (sym)
+               && (preg == NULL
+                   || regexec (preg, SYMBOL_NATURAL_NAME (sym),
+                               0, NULL, 0) == 0))
+             {
+               struct ada_exc_info info
+                 = {SYMBOL_PRINT_NAME (sym), SYMBOL_VALUE_ADDRESS (sym)};
+
+               VEC_safe_push (ada_exc_info, *exceptions, &info);
+             }
+       }
+    }
+}
+
+/* Implements ada_exceptions_list with the regular expression passed
+   as a regex_t, rather than a string.
+
+   If not NULL, PREG is used to filter out exceptions whose names
+   do not match.  Otherwise, all exceptions are listed.  */
+
+static VEC(ada_exc_info) *
+ada_exceptions_list_1 (regex_t *preg)
+{
+  VEC(ada_exc_info) *result = NULL;
+  struct cleanup *old_chain
+    = make_cleanup (VEC_cleanup (ada_exc_info), &result);
+  int prev_len;
+
+  /* First, list the known standard exceptions.  These exceptions
+     need to be handled separately, as they are usually defined in
+     runtime units that have been compiled without debugging info.  */
+
+  ada_add_standard_exceptions (preg, &result);
+
+  /* Next, find all exceptions whose scope is local and accessible
+     from the currently selected frame.  */
+
+  if (has_stack_frames ())
+    {
+      prev_len = VEC_length (ada_exc_info, result);
+      ada_add_exceptions_from_frame (preg, get_selected_frame (NULL),
+                                    &result);
+      if (VEC_length (ada_exc_info, result) > prev_len)
+       sort_remove_dups_ada_exceptions_list (&result, prev_len);
+    }
+
+  /* Add all exceptions whose scope is global.  */
+
+  prev_len = VEC_length (ada_exc_info, result);
+  ada_add_global_exceptions (preg, &result);
+  if (VEC_length (ada_exc_info, result) > prev_len)
+    sort_remove_dups_ada_exceptions_list (&result, prev_len);
+
+  discard_cleanups (old_chain);
+  return result;
+}
+
+/* Return a vector of ada_exc_info.
+
+   If REGEXP is NULL, all exceptions are included in the result.
+   Otherwise, it should contain a valid regular expression,
+   and only the exceptions whose names match that regular expression
+   are included in the result.
+
+   The exceptions are sorted in the following order:
+     - Standard exceptions (defined by the Ada language), in
+       alphabetical order;
+     - Exceptions only visible from the current frame, in
+       alphabetical order;
+     - Exceptions whose scope is global, in alphabetical order.  */
+
+VEC(ada_exc_info) *
+ada_exceptions_list (const char *regexp)
+{
+  VEC(ada_exc_info) *result = NULL;
+  struct cleanup *old_chain = NULL;
+  regex_t reg;
+
+  if (regexp != NULL)
+    old_chain = compile_rx_or_error (&reg, regexp,
+                                    _("invalid regular expression"));
+
+  result = ada_exceptions_list_1 (regexp != NULL ? &reg : NULL);
+
+  if (old_chain != NULL)
+    do_cleanups (old_chain);
+  return result;
+}
+
+/* Implement the "info exceptions" command.  */
+
+static void
+info_exceptions_command (char *regexp, int from_tty)
+{
+  VEC(ada_exc_info) *exceptions;
+  struct cleanup *cleanup;
+  struct gdbarch *gdbarch = get_current_arch ();
+  int ix;
+  struct ada_exc_info *info;
+
+  exceptions = ada_exceptions_list (regexp);
+  cleanup = make_cleanup (VEC_cleanup (ada_exc_info), &exceptions);
+
+  if (regexp != NULL)
+    printf_filtered
+      (_("All Ada exceptions matching regular expression \"%s\":\n"), regexp);
+  else
+    printf_filtered (_("All defined Ada exceptions:\n"));
+
+  for (ix = 0; VEC_iterate(ada_exc_info, exceptions, ix, info); ix++)
+    printf_filtered ("%s: %s\n", info->name, paddress (gdbarch, info->addr));
+
+  do_cleanups (cleanup);
+}
+
                                 /* Operators */
 /* Information about operators given special treatment in functions
    below.  */
@@ -12626,7 +13637,7 @@ static const struct op_print ada_op_print_tab[] = {
   {".all", UNOP_IND, PREC_SUFFIX, 1},
   {"'access", UNOP_ADDR, PREC_SUFFIX, 1},
   {"'size", OP_ATR_SIZE, PREC_SUFFIX, 1},
-  {NULL, 0, 0, 0}
+  {NULL, OP_NULL, PREC_SUFFIX, 0}
 };
 \f
 enum ada_primitive_types {
@@ -12708,10 +13719,10 @@ emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
 }
 
 static int
-parse (void)
+parse (struct parser_state *ps)
 {
   warnings_issued = 0;
-  return ada_parse ();
+  return ada_parse (ps);
 }
 
 static const struct exp_descriptor ada_exp_descriptor = {
@@ -12740,7 +13751,7 @@ ada_get_symbol_name_cmp (const char *lookup_name)
 static struct value *
 ada_read_var_value (struct symbol *var, struct frame_info *frame)
 {
-  struct block *frame_block = NULL;
+  const struct block *frame_block = NULL;
   struct symbol *renaming_sym = NULL;
 
   /* The only case where default_read_var_value is not sufficient
@@ -12759,6 +13770,7 @@ ada_read_var_value (struct symbol *var, struct frame_info *frame)
 
 const struct language_defn ada_language_defn = {
   "ada",                        /* Language name */
+  "Ada",
   language_ada,
   range_check_off,
   case_sensitive_on,            /* Yes, Ada is case-insensitive, but
@@ -12795,6 +13807,9 @@ const struct language_defn ada_language_defn = {
   c_get_string,
   ada_get_symbol_name_cmp,     /* la_get_symbol_name_cmp */
   ada_iterate_over_symbols,
+  &ada_varobj_ops,
+  NULL,
+  NULL,
   LANG_MAGIC
 };
 
@@ -12812,7 +13827,7 @@ set_ada_command (char *arg, int from_tty)
 {
   printf_unfiltered (_(\
 "\"set ada\" must be followed by the name of a setting.\n"));
-  help_list (set_ada_list, "set ada ", -1, gdb_stdout);
+  help_list (set_ada_list, "set ada ", all_commands, gdb_stdout);
 }
 
 /* Implement the "show ada" prefix command.  */
@@ -12864,6 +13879,22 @@ initialize_ada_catchpoint_ops (void)
   ops->print_recreate = print_recreate_catch_assert;
 }
 
+/* This module's 'new_objfile' observer.  */
+
+static void
+ada_new_objfile_observer (struct objfile *objfile)
+{
+  ada_clear_symbol_cache ();
+}
+
+/* This module's 'free_objfile' observer.  */
+
+static void
+ada_free_objfile_observer (struct objfile *objfile)
+{
+  ada_clear_symbol_cache ();
+}
+
 void
 _initialize_ada_language (void)
 {
@@ -12910,14 +13941,46 @@ With an argument, catch only exceptions with the given name."),
 
   varsize_limit = 65536;
 
+  add_info ("exceptions", info_exceptions_command,
+           _("\
+List all Ada exception names.\n\
+If a regular expression is passed as an argument, only those matching\n\
+the regular expression are listed."));
+
+  add_prefix_cmd ("ada", class_maintenance, maint_set_ada_cmd,
+                 _("Set Ada maintenance-related variables."),
+                  &maint_set_ada_cmdlist, "maintenance set ada ",
+                  0/*allow-unknown*/, &maintenance_set_cmdlist);
+
+  add_prefix_cmd ("ada", class_maintenance, maint_show_ada_cmd,
+                 _("Show Ada maintenance-related variables"),
+                  &maint_show_ada_cmdlist, "maintenance show ada ",
+                  0/*allow-unknown*/, &maintenance_show_cmdlist);
+
+  add_setshow_boolean_cmd
+    ("ignore-descriptive-types", class_maintenance,
+     &ada_ignore_descriptive_types_p,
+     _("Set whether descriptive types generated by GNAT should be ignored."),
+     _("Show whether descriptive types generated by GNAT should be ignored."),
+     _("\
+When enabled, the debugger will stop using the DW_AT_GNAT_descriptive_type\n\
+DWARF attribute."),
+     NULL, NULL, &maint_set_ada_cmdlist, &maint_show_ada_cmdlist);
+
   obstack_init (&symbol_list_obstack);
 
   decoded_names_store = htab_create_alloc
     (256, htab_hash_string, (int (*)(const void *, const void *)) streq,
      NULL, xcalloc, xfree);
 
-  /* Setup per-inferior data.  */
+  /* The ada-lang observers.  */
+  observer_attach_new_objfile (ada_new_objfile_observer);
+  observer_attach_free_objfile (ada_free_objfile_observer);
   observer_attach_inferior_exit (ada_inferior_exit);
+
+  /* Setup various context-specific data.  */
   ada_inferior_data
     = register_inferior_data_with_cleanup (NULL, ada_inferior_data_cleanup);
+  ada_pspace_data_handle
+    = register_program_space_data_with_cleanup (NULL, ada_pspace_data_cleanup);
 }
This page took 0.12673 seconds and 4 git commands to generate.