2012-03-01 Pedro Alves <palves@redhat.com>
[deliverable/binutils-gdb.git] / gdb / ada-lang.c
index d434521be7dfc86ffef5d9ae77465b39e67265c3..4c17eaaae390a3682fd19b70a5a332bca8be0872 100644 (file)
@@ -1,7 +1,7 @@
-/* Ada language support routines for GDB, the GNU debugger.  Copyright (C)
+/* Ada language support routines for GDB, the GNU debugger.
 
-   1992, 1993, 1994, 1997, 1998, 1999, 2000, 2003, 2004, 2005, 2007, 2008,
-   2009 Free Software Foundation, Inc.
+   Copyright (C) 1992-1994, 1997-2000, 2003-2005, 2007-2012 Free
+   Software Foundation, Inc.
 
    This file is part of GDB.
 
 #include "observer.h"
 #include "vec.h"
 #include "stack.h"
+#include "gdb_vecs.h"
 
 #include "psymtab.h"
 #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
    differently signed operands (truncation direction is undefined in C).
@@ -219,7 +223,7 @@ static struct value *ada_search_struct_field (char *, struct value *, int,
 static struct value *ada_value_primitive_field (struct value *, int, int,
                                                 struct type *);
 
-static int find_struct_field (char *, struct type *, int,
+static int find_struct_field (const char *, struct type *, int,
                               struct type **, int *, int *, int *, int *);
 
 static struct value *ada_to_fixed_value_create (struct type *, CORE_ADDR,
@@ -267,6 +271,8 @@ static struct value *ada_evaluate_subexp (struct type *, struct expression *,
 
 static void ada_forward_operator_length (struct expression *, int, int *,
                                         int *);
+
+static struct type *ada_find_any_type (const char *name);
 \f
 
 
@@ -315,6 +321,11 @@ struct ada_inferior_data
      accessible through a component ("tsd") in the object tag.  But this
      is no longer the case, so we cache it for each inferior.  */
   struct type *tsd_type;
+
+  /* The exception_support_info data.  This data is used to determine
+     how to implement support for Ada exception catchpoints in a given
+     inferior.  */
+  const struct exception_support_info *exception_info;
 };
 
 /* Our key to this module's inferior data.  */
@@ -714,7 +725,7 @@ ada_discrete_type_low_bound (struct type *type)
    non-range scalar type.  */
 
 static struct type *
-base_type (struct type *type)
+get_base_type (struct type *type)
 {
   while (type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE)
     {
@@ -724,6 +735,46 @@ base_type (struct type *type)
     }
   return type;
 }
+
+/* Return a decoded version of the given VALUE.  This means returning
+   a value whose type is obtained by applying all the GNAT-specific
+   encondings, making the resulting type a static but standard description
+   of the initial type.  */
+
+struct value *
+ada_get_decoded_value (struct value *value)
+{
+  struct type *type = ada_check_typedef (value_type (value));
+
+  if (ada_is_array_descriptor_type (type)
+      || (ada_is_constrained_packed_array_type (type)
+          && TYPE_CODE (type) != TYPE_CODE_PTR))
+    {
+      if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)  /* array access type.  */
+        value = ada_coerce_to_simple_array_ptr (value);
+      else
+        value = ada_coerce_to_simple_array (value);
+    }
+  else
+    value = ada_to_fixed_value (value);
+
+  return value;
+}
+
+/* Same as ada_get_decoded_value, but with the given TYPE.
+   Because there is no associated actual value for this type,
+   the resulting type might be a best-effort approximation in
+   the case of dynamic types.  */
+
+struct type *
+ada_get_decoded_type (struct type *type)
+{
+  type = to_static_fixed_type (type);
+  if (ada_is_constrained_packed_array_type (type))
+    type = ada_coerce_to_simple_array_type (type);
+  return type;
+}
+
 \f
 
                                 /* Language Selection */
@@ -898,11 +949,14 @@ is_lower_alphanum (const char c)
   return (isdigit (c) || (isalpha (c) && islower (c)));
 }
 
-/* Remove either of these suffixes:
+/* ENCODED is the linkage name of a symbol and LEN contains its length.
+   This function saves in LEN the length of that same symbol name but
+   without either of these suffixes:
      . .{DIGIT}+
      . ${DIGIT}+
      . ___{DIGIT}+
      . __{DIGIT}+.
+
    These are suffixes introduced by the compiler for entities such as
    nested subprogram for instance, in order to avoid name clashes.
    They do not serve any purpose for the debugger.  */
@@ -1358,7 +1412,7 @@ ada_fixup_array_indexes_type (struct type *index_desc_type)
   /* Fixup each field of INDEX_DESC_TYPE.  */
   for (i = 0; i < TYPE_NFIELDS (index_desc_type); i++)
    {
-     char *name = TYPE_FIELD_NAME (index_desc_type, i);
+     const char *name = TYPE_FIELD_NAME (index_desc_type, i);
      struct type *raw_type = ada_check_typedef (ada_find_any_type (name));
 
      if (raw_type)
@@ -1438,7 +1492,7 @@ thin_descriptor_type (struct type *type)
 static struct value *
 thin_data_pntr (struct value *val)
 {
-  struct type *type = value_type (val);
+  struct type *type = ada_check_typedef (value_type (val));
   struct type *data_type = desc_data_target_type (thin_descriptor_type (type));
 
   data_type = lookup_pointer_type (data_type);
@@ -1950,8 +2004,8 @@ ada_is_unconstrained_packed_array_type (struct type *type)
 static long
 decode_packed_array_bitsize (struct type *type)
 {
-  char *raw_name;
-  char *tail;
+  const char *raw_name;
+  const char *tail;
   long bits;
 
   /* Access to arrays implemented as fat pointers are encoded as a typedef
@@ -1994,22 +2048,30 @@ constrained_packed_array_type (struct type *type, long *elt_bits)
 {
   struct type *new_elt_type;
   struct type *new_type;
+  struct type *index_type_desc;
+  struct type *index_type;
   LONGEST low_bound, high_bound;
 
   type = ada_check_typedef (type);
   if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
     return type;
 
+  index_type_desc = ada_find_parallel_type (type, "___XA");
+  if (index_type_desc)
+    index_type = to_fixed_range_type (TYPE_FIELD_TYPE (index_type_desc, 0),
+                                     NULL);
+  else
+    index_type = TYPE_INDEX_TYPE (type);
+
   new_type = alloc_type_copy (type);
   new_elt_type =
     constrained_packed_array_type (ada_check_typedef (TYPE_TARGET_TYPE (type)),
                                   elt_bits);
-  create_array_type (new_type, new_elt_type, TYPE_INDEX_TYPE (type));
+  create_array_type (new_type, new_elt_type, index_type);
   TYPE_FIELD_BITSIZE (new_type, 0) = *elt_bits;
   TYPE_NAME (new_type) = ada_type_name (type);
 
-  if (get_discrete_bounds (TYPE_INDEX_TYPE (type),
-                           &low_bound, &high_bound) < 0)
+  if (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;
@@ -2030,9 +2092,9 @@ constrained_packed_array_type (struct type *type, long *elt_bits)
 static struct type *
 decode_constrained_packed_array_type (struct type *type)
 {
-  char *raw_name = ada_type_name (ada_check_typedef (type));
+  const char *raw_name = ada_type_name (ada_check_typedef (type));
   char *name;
-  char *tail;
+  const char *tail;
   struct type *shadow_type;
   long bits;
 
@@ -2088,7 +2150,7 @@ decode_constrained_packed_array (struct value *arr)
      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 (TYPE_CODE (value_type (arr)) == TYPE_CODE_PTR)
+  if (TYPE_CODE (ada_check_typedef (value_type (arr))) == TYPE_CODE_PTR)
     arr = value_ind (arr);
 
   type = decode_constrained_packed_array_type (value_type (arr));
@@ -3045,7 +3107,7 @@ resolve_subexp (struct expression **expp, int *pos, int deprocedure_p,
             ada_lookup_symbol_list (SYMBOL_LINKAGE_NAME
                                     (exp->elts[pc + 2].symbol),
                                     exp->elts[pc + 1].block, VAR_DOMAIN,
-                                    &candidates);
+                                    &candidates, 1);
 
           if (n_candidates > 1)
             {
@@ -3137,7 +3199,7 @@ resolve_subexp (struct expression **expp, int *pos, int deprocedure_p,
               ada_lookup_symbol_list (SYMBOL_LINKAGE_NAME
                                       (exp->elts[pc + 5].symbol),
                                       exp->elts[pc + 4].block, VAR_DOMAIN,
-                                      &candidates);
+                                      &candidates, 1);
             if (n_candidates == 1)
               i = 0;
             else
@@ -3189,7 +3251,7 @@ resolve_subexp (struct expression **expp, int *pos, int deprocedure_p,
           n_candidates =
             ada_lookup_symbol_list (ada_encode (ada_decoded_op_name (op)),
                                     (struct block *) NULL, VAR_DOMAIN,
-                                    &candidates);
+                                    &candidates, 1);
           i = ada_resolve_function (candidates, n_candidates, argvec, nargs,
                                     ada_decoded_op_name (op), NULL);
           if (i < 0)
@@ -3320,13 +3382,13 @@ return_match (struct type *func_type, struct type *context_type)
     return 1;
 
   if (TYPE_CODE (func_type) == TYPE_CODE_FUNC)
-    return_type = base_type (TYPE_TARGET_TYPE (func_type));
+    return_type = get_base_type (TYPE_TARGET_TYPE (func_type));
   else
-    return_type = base_type (func_type);
+    return_type = get_base_type (func_type);
   if (return_type == NULL)
     return 1;
 
-  context_type = base_type (context_type);
+  context_type = get_base_type (context_type);
 
   if (TYPE_CODE (return_type) == TYPE_CODE_ENUM)
     return context_type == NULL || return_type == context_type;
@@ -3395,7 +3457,7 @@ ada_resolve_function (struct ada_symbol_info syms[],
    such symbols by their trailing number (__N  or $N).  */
 
 static int
-encoded_ordered_before (char *N0, char *N1)
+encoded_ordered_before (const char *N0, const char *N1)
 {
   if (N1 == NULL)
     return 0;
@@ -3601,8 +3663,7 @@ get_selections (int *choices, int n_choices, int max_results,
       char *args2;
       int choice, j;
 
-      while (isspace (*args))
-        args += 1;
+      args = skip_spaces (args);
       if (*args == '\0' && n_chosen == 0)
         error_no_arg (_("one or more choice numbers"));
       else if (*args == '\0')
@@ -4151,6 +4212,18 @@ cache_symbol (const char *name, domain_enum namespace, struct symbol *sym,
 \f
                                 /* Symbol Lookup */
 
+/* Return nonzero if wild matching should be used when searching for
+   all symbols matching LOOKUP_NAME.
+
+   LOOKUP_NAME is expected to be a symbol name after transformation
+   for Ada lookups (see ada_name_for_lookup).  */
+
+static int
+should_use_wild_match (const char *lookup_name)
+{
+  return (strstr (lookup_name, "__") == NULL);
+}
+
 /* Return the result of a standard (literal, C-like) lookup of NAME in
    given DOMAIN, visible from lexical block BLOCK.  */
 
@@ -4225,8 +4298,8 @@ lesseq_defined_than (struct symbol *sym0, struct symbol *sym1)
       {
         struct type *type0 = SYMBOL_TYPE (sym0);
         struct type *type1 = SYMBOL_TYPE (sym1);
-        char *name0 = SYMBOL_LINKAGE_NAME (sym0);
-        char *name1 = SYMBOL_LINKAGE_NAME (sym1);
+        const char *name0 = SYMBOL_LINKAGE_NAME (sym0);
+        const char *name1 = SYMBOL_LINKAGE_NAME (sym1);
         int len0 = strlen (name0);
 
         return
@@ -4316,15 +4389,17 @@ ada_lookup_simple_minsym (const char *name)
 {
   struct objfile *objfile;
   struct minimal_symbol *msymbol;
-  int wild_match;
+  const int wild_match = should_use_wild_match (name);
 
+  /* Special case: If the user specifies a symbol name inside package
+     Standard, do a non-wild matching of the symbol name without
+     the "standard__" prefix.  This was primarily introduced in order
+     to allow the user to specifically access the standard exceptions
+     using, for instance, Standard.Constraint_Error when Constraint_Error
+     is ambiguous (due to the user defining its own Constraint_Error
+     entity inside its program).  */
   if (strncmp (name, "standard__", sizeof ("standard__") - 1) == 0)
-    {
-      name += sizeof ("standard__") - 1;
-      wild_match = 0;
-    }
-  else
-    wild_match = (strstr (name, "__") == NULL);
+    name += sizeof ("standard__") - 1;
 
   ALL_MSYMBOLS (objfile, msymbol)
   {
@@ -4355,11 +4430,113 @@ add_symbols_from_enclosing_procs (struct obstack *obstackp,
 static int
 is_nondebugging_type (struct type *type)
 {
-  char *name = ada_type_name (type);
+  const char *name = ada_type_name (type);
 
   return (name != NULL && strcmp (name, "<variable, no debug info>") == 0);
 }
 
+/* Return nonzero if TYPE1 and TYPE2 are two enumeration types
+   that are deemed "identical" for practical purposes.
+
+   This function assumes that TYPE1 and TYPE2 are both TYPE_CODE_ENUM
+   types and that their number of enumerals is identical (in other
+   words, TYPE_NFIELDS (type1) == TYPE_NFIELDS (type2)).  */
+
+static int
+ada_identical_enum_types_p (struct type *type1, struct type *type2)
+{
+  int i;
+
+  /* The heuristic we use here is fairly conservative.  We consider
+     that 2 enumerate types are identical if they have the same
+     number of enumerals and that all enumerals have the same
+     underlying value and name.  */
+
+  /* All enums in the type should have an identical underlying value.  */
+  for (i = 0; i < TYPE_NFIELDS (type1); i++)
+    if (TYPE_FIELD_BITPOS (type1, i) != TYPE_FIELD_BITPOS (type2, i))
+      return 0;
+
+  /* All enumerals should also have the same name (modulo any numerical
+     suffix).  */
+  for (i = 0; i < TYPE_NFIELDS (type1); i++)
+    {
+      const char *name_1 = TYPE_FIELD_NAME (type1, i);
+      const char *name_2 = TYPE_FIELD_NAME (type2, i);
+      int len_1 = strlen (name_1);
+      int len_2 = strlen (name_2);
+
+      ada_remove_trailing_digits (TYPE_FIELD_NAME (type1, i), &len_1);
+      ada_remove_trailing_digits (TYPE_FIELD_NAME (type2, i), &len_2);
+      if (len_1 != len_2
+          || strncmp (TYPE_FIELD_NAME (type1, i),
+                     TYPE_FIELD_NAME (type2, i),
+                     len_1) != 0)
+       return 0;
+    }
+
+  return 1;
+}
+
+/* Return nonzero if all the symbols in SYMS are all enumeral symbols
+   that are deemed "identical" for practical purposes.  Sometimes,
+   enumerals are not strictly identical, but their types are so similar
+   that they can be considered identical.
+
+   For instance, consider the following code:
+
+      type Color is (Black, Red, Green, Blue, White);
+      type RGB_Color is new Color range Red .. Blue;
+
+   Type RGB_Color is a subrange of an implicit type which is a copy
+   of type Color. If we call that implicit type RGB_ColorB ("B" is
+   for "Base Type"), then type RGB_ColorB is a copy of type Color.
+   As a result, when an expression references any of the enumeral
+   by name (Eg. "print green"), the expression is technically
+   ambiguous and the user should be asked to disambiguate. But
+   doing so would only hinder the user, since it wouldn't matter
+   what choice he makes, the outcome would always be the same.
+   So, for practical purposes, we consider them as the same.  */
+
+static int
+symbols_are_identical_enums (struct ada_symbol_info *syms, int nsyms)
+{
+  int i;
+
+  /* Before performing a thorough comparison check of each type,
+     we perform a series of inexpensive checks.  We expect that these
+     checks will quickly fail in the vast majority of cases, and thus
+     help prevent the unnecessary use of a more expensive comparison.
+     Said comparison also expects us to make some of these checks
+     (see ada_identical_enum_types_p).  */
+
+  /* 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)
+      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))
+      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)))
+      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)))
+      return 0;
+
+  return 1;
+}
+
 /* Remove any non-debugging symbols in SYMS[0 .. NSYMS-1] that definitely
    duplicate other symbols in the list (The only case I know of where
    this happens is when object files containing stabs-in-ecoff are
@@ -4372,10 +4549,16 @@ remove_extra_symbols (struct ada_symbol_info *syms, int nsyms)
 {
   int i, j;
 
+  /* We should never be called with less than 2 symbols, as there
+     cannot be any extra symbol in that case.  But it's easy to
+     handle, since we have nothing to do in that case.  */
+  if (nsyms < 2)
+    return nsyms;
+
   i = 0;
   while (i < nsyms)
     {
-      int remove = 0;
+      int remove_p = 0;
 
       /* If two symbols have the same name and one of them is a stub type,
          the get rid of the stub.  */
@@ -4390,7 +4573,7 @@ remove_extra_symbols (struct ada_symbol_info *syms, int nsyms)
                   && SYMBOL_LINKAGE_NAME (syms[j].sym) != NULL
                   && strcmp (SYMBOL_LINKAGE_NAME (syms[i].sym),
                              SYMBOL_LINKAGE_NAME (syms[j].sym)) == 0)
-                remove = 1;
+                remove_p = 1;
             }
         }
 
@@ -4410,11 +4593,11 @@ remove_extra_symbols (struct ada_symbol_info *syms, int nsyms)
                   && SYMBOL_CLASS (syms[i].sym) == SYMBOL_CLASS (syms[j].sym)
                   && SYMBOL_VALUE_ADDRESS (syms[i].sym)
                   == SYMBOL_VALUE_ADDRESS (syms[j].sym))
-                remove = 1;
+                remove_p = 1;
             }
         }
       
-      if (remove)
+      if (remove_p)
         {
           for (j = i + 1; j < nsyms; j += 1)
             syms[j - 1] = syms[j];
@@ -4423,6 +4606,22 @@ remove_extra_symbols (struct ada_symbol_info *syms, int nsyms)
 
       i += 1;
     }
+
+  /* If all the remaining symbols are identical enumerals, then
+     just keep the first one and discard the rest.
+
+     Unlike what we did previously, we do not discard any entry
+     unless they are ALL identical.  This is because the symbol
+     comparison is not a strict comparison, but rather a practical
+     comparison.  If all symbols are considered identical, then
+     we can just go ahead and use the first one and discard the rest.
+     But if we cannot reduce the list to a single element, we have
+     to ask the user to disambiguate anyways.  And if we have to
+     present a multiple-choice menu, it's less confusing if the list
+     isn't missing some choices that were identical and yet distinct.  */
+  if (symbols_are_identical_enums (syms, nsyms))
+    nsyms = 1;
+
   return nsyms;
 }
 
@@ -4498,7 +4697,7 @@ is_package_name (const char *name)
    not visible from FUNCTION_NAME.  */
 
 static int
-old_renaming_is_invisible (const struct symbol *sym, char *function_name)
+old_renaming_is_invisible (const struct symbol *sym, const char *function_name)
 {
   char *scope;
 
@@ -4568,7 +4767,7 @@ remove_irrelevant_renamings (struct ada_symbol_info *syms,
                             int nsyms, const struct block *current_block)
 {
   struct symbol *current_function;
-  char *current_function_name;
+  const char *current_function_name;
   int i;
   int is_new_style_renaming;
 
@@ -4765,7 +4964,7 @@ compare_names (const char *string1, const char *string2)
          if (is_name_suffix (string1))
            return 0;
          else
-           return -1;
+           return 1;
        }
       /* FALLTHROUGH */
     default:
@@ -4788,8 +4987,8 @@ add_nonlocal_symbols (struct obstack *obstackp, const char *name,
   struct objfile *objfile;
   struct match_data data;
 
+  memset (&data, 0, sizeof data);
   data.obstackp = obstackp;
-  data.arg_sym = NULL;
 
   ALL_OBJFILES (objfile)
     {
@@ -4830,21 +5029,23 @@ add_nonlocal_symbols (struct obstack *obstackp, const char *name,
    the next call of ada_lookup_symbol_list.  Any non-function/non-enumeral 
    symbol match within the nest of blocks whose innermost member is BLOCK0,
    is the one match returned (no other matches in that or
-     enclosing blocks is returned).  If there are any matches in or
-   surrounding BLOCK0, then these alone are returned.  Otherwise, the
-   search extends to global and file-scope (static) symbol tables.
+   enclosing blocks is returned).  If there are any matches in or
+   surrounding BLOCK0, then these alone are returned.  Otherwise, if
+   FULL_SEARCH is non-zero, then the search extends to global and
+   file-scope (static) symbol tables.
    Names prefixed with "standard__" are handled specially: "standard__" 
    is first stripped off, and only static and global symbols are searched.  */
 
 int
 ada_lookup_symbol_list (const char *name0, const struct block *block0,
-                        domain_enum namespace,
-                        struct ada_symbol_info **results)
+                       domain_enum namespace,
+                       struct ada_symbol_info **results,
+                       int full_search)
 {
   struct symbol *sym;
   struct block *block;
   const char *name;
-  int wild_match;
+  const int wild_match = should_use_wild_match (name0);
   int cacheIfUnique;
   int ndefns;
 
@@ -4855,7 +5056,6 @@ ada_lookup_symbol_list (const char *name0, const struct block *block0,
 
   /* Search specified block and its superiors.  */
 
-  wild_match = (strstr (name0, "__") == NULL);
   name = name0;
   block = (struct block *) block0;      /* FIXME: No cast ought to be
                                            needed, but adding const will
@@ -4870,7 +5070,6 @@ ada_lookup_symbol_list (const char *name0, const struct block *block0,
      entity inside its program).  */
   if (strncmp (name0, "standard__", sizeof ("standard__") - 1) == 0)
     {
-      wild_match = 0;
       block = NULL;
       name = name0 + sizeof ("standard__") - 1;
     }
@@ -4879,7 +5078,7 @@ ada_lookup_symbol_list (const char *name0, const struct block *block0,
 
   ada_add_local_symbols (&symbol_list_obstack, name, block, namespace,
                          wild_match);
-  if (num_defns_collected (&symbol_list_obstack) > 0)
+  if (num_defns_collected (&symbol_list_obstack) > 0 || !full_search)
     goto done;
 
   /* No non-global symbols found.  Check our cache to see if we have
@@ -4912,10 +5111,10 @@ done:
 
   ndefns = remove_extra_symbols (*results, ndefns);
 
-  if (ndefns == 0)
+  if (ndefns == 0 && full_search)
     cache_symbol (name0, namespace, NULL, NULL);
 
-  if (ndefns == 1 && cacheIfUnique)
+  if (ndefns == 1 && full_search && cacheIfUnique)
     cache_symbol (name0, namespace, (*results)[0].sym, (*results)[0].block);
 
   ndefns = remove_irrelevant_renamings (*results, ndefns, block0);
@@ -4923,6 +5122,50 @@ done:
   return ndefns;
 }
 
+/* If NAME is the name of an entity, return a string that should
+   be used to look that entity up in Ada units.  This string should
+   be deallocated after use using xfree.
+
+   NAME can have any form that the "break" or "print" commands might
+   recognize.  In other words, it does not have to be the "natural"
+   name, or the "encoded" name.  */
+
+char *
+ada_name_for_lookup (const char *name)
+{
+  char *canon;
+  int nlen = strlen (name);
+
+  if (name[0] == '<' && name[nlen - 1] == '>')
+    {
+      canon = xmalloc (nlen - 1);
+      memcpy (canon, name + 1, nlen - 2);
+      canon[nlen - 2] = '\0';
+    }
+  else
+    canon = xstrdup (ada_encode (ada_fold_name (name)));
+  return canon;
+}
+
+/* Implementation of the la_iterate_over_symbols method.  */
+
+static void
+ada_iterate_over_symbols (const struct block *block,
+                         const char *name, domain_enum domain,
+                         symbol_found_callback_ftype *callback,
+                         void *data)
+{
+  int ndefs, i;
+  struct ada_symbol_info *results;
+
+  ndefs = ada_lookup_symbol_list (name, block, domain, &results, 0);
+  for (i = 0; i < ndefs; ++i)
+    {
+      if (! (*callback) (results[i].sym, data))
+       break;
+    }
+}
+
 struct symbol *
 ada_lookup_encoded_symbol (const char *name, const struct block *block0,
                           domain_enum namespace, struct block **block_found)
@@ -4930,7 +5173,8 @@ ada_lookup_encoded_symbol (const char *name, const struct block *block0,
   struct ada_symbol_info *candidates;
   int n_candidates;
 
-  n_candidates = ada_lookup_symbol_list (name, block0, namespace, &candidates);
+  n_candidates = ada_lookup_symbol_list (name, block0, namespace, &candidates,
+                                        1);
 
   if (n_candidates == 0)
     return NULL;
@@ -4976,6 +5220,7 @@ ada_lookup_symbol_nonlocal (const char *name,
 
    [.$][0-9]+       [nested subprogram suffix, on platforms such as GNU/Linux]
    ___[0-9]+        [nested subprogram suffix, on platforms such as HP/UX]
+   TKB              [subprogram suffix for task bodies]
    _E[0-9]+[bs]$    [protected object entry suffixes]
    (X[nb]*)?((\$|__)[0-9](_?[0-9]+)|___(JM|LJM|X([FDBUP].*|R[^T]?)))?$
 
@@ -5021,6 +5266,11 @@ is_name_suffix (const char *str)
         return 1;
     }
 
+  /* "TKB" suffixes are used for subprograms implementing task bodies.  */
+
+  if (strcmp (str, "TKB") == 0)
+    return 1;
+
 #if 0
   /* FIXME: brobecker/2005-09-23: Protected Object subprograms end
      with a N at the end.  Unfortunately, the compiler uses the same
@@ -5432,8 +5682,6 @@ symbol_completion_match (const char *sym_name,
   return sym_name;
 }
 
-DEF_VEC_P (char_ptr);
-
 /* A companion function to ada_make_symbol_completion_list().
    Check if SYM_NAME represents a symbol which name would be suitable
    to complete TEXT (TEXT_LEN is the length of TEXT), in which case
@@ -5656,7 +5904,7 @@ ada_make_symbol_completion_list (char *text0, char *word)
 static int
 ada_is_dispatch_table_ptr_type (struct type *type)
 {
-  char *name;
+  const char *name;
 
   if (TYPE_CODE (type) != TYPE_CODE_PTR)
     return 0;
@@ -5676,7 +5924,7 @@ ada_is_ignored_field (struct type *type, int field_num)
 {
   if (field_num < 0 || field_num > TYPE_NFIELDS (type))
     return 1;
-   
+
   /* Check the name of that field.  */
   {
     const char *name = TYPE_FIELD_NAME (type, field_num);
@@ -5687,8 +5935,13 @@ ada_is_ignored_field (struct type *type, int field_num)
     if (name == NULL)
       return 1;
 
-    /* A field named "_parent" is internally generated by GNAT for
-       tagged types, and should not be printed either.  */
+    /* Normally, fields whose name start with an underscore ("_")
+       are fields that have been internally generated by the compiler,
+       and thus should not be printed.  The "_parent" field is special,
+       however: This is a field internally generated by the compiler
+       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)
       return 1;
   }
@@ -5778,105 +6031,110 @@ type_from_tag (struct value *tag)
   return NULL;
 }
 
-struct tag_args
+/* Return the "ada__tags__type_specific_data" type.  */
+
+static struct type *
+ada_get_tsd_type (struct inferior *inf)
 {
-  struct value *tag;
-  char *name;
-};
+  struct ada_inferior_data *data = get_ada_inferior_data (inf);
 
+  if (data->tsd_type == 0)
+    data->tsd_type = ada_find_any_type ("ada__tags__type_specific_data");
+  return data->tsd_type;
+}
 
-static int ada_tag_name_1 (void *);
-static int ada_tag_name_2 (struct tag_args *);
+/* Return the TSD (type-specific data) associated to the given TAG.
+   TAG is assumed to be the tag of a tagged-type entity.
 
-/* Wrapper function used by ada_tag_name.  Given a struct tag_args*
-   value ARGS, sets ARGS->name to the tag name of ARGS->tag.
-   The value stored in ARGS->name is valid until the next call to 
-   ada_tag_name_1.  */
+   May return NULL if we are unable to get the TSD.  */
 
-static int
-ada_tag_name_1 (void *args0)
+static struct value *
+ada_get_tsd_from_tag (struct value *tag)
 {
-  struct tag_args *args = (struct tag_args *) args0;
-  static char name[1024];
-  char *p;
   struct value *val;
+  struct type *type;
 
-  args->name = NULL;
-  val = ada_value_struct_elt (args->tag, "tsd", 1);
-  if (val == NULL)
-    return ada_tag_name_2 (args);
-  val = ada_value_struct_elt (val, "expanded_name", 1);
-  if (val == NULL)
-    return 0;
-  read_memory_string (value_as_address (val), name, sizeof (name) - 1);
-  for (p = name; *p != '\0'; p += 1)
-    if (isalpha (*p))
-      *p = tolower (*p);
-  args->name = name;
-  return 0;
-}
+  /* First option: The TSD is simply stored as a field of our TAG.
+     Only older versions of GNAT would use this format, but we have
+     to test it first, because there are no visible markers for
+     the current approach except the absence of that field.  */
 
-/* Return the "ada__tags__type_specific_data" type.  */
+  val = ada_value_struct_elt (tag, "tsd", 1);
+  if (val)
+    return val;
 
-static struct type *
-ada_get_tsd_type (struct inferior *inf)
-{
-  struct ada_inferior_data *data = get_ada_inferior_data (inf);
+  /* Try the second representation for the dispatch table (in which
+     there is no explicit 'tsd' field in the referent of the tag pointer,
+     and instead the tsd pointer is stored just before the dispatch
+     table.  */
 
-  if (data->tsd_type == 0)
-    data->tsd_type = ada_find_any_type ("ada__tags__type_specific_data");
-  return data->tsd_type;
+  type = ada_get_tsd_type (current_inferior());
+  if (type == NULL)
+    return NULL;
+  type = lookup_pointer_type (lookup_pointer_type (type));
+  val = value_cast (type, tag);
+  if (val == NULL)
+    return NULL;
+  return value_ind (value_ptradd (val, -1));
 }
 
-/* Utility function for ada_tag_name_1 that tries the second
-   representation for the dispatch table (in which there is no
-   explicit 'tsd' field in the referent of the tag pointer, and instead
-   the tsd pointer is stored just before the dispatch table.  */
-   
-static int
-ada_tag_name_2 (struct tag_args *args)
+/* Given the TSD of a tag (type-specific data), return a string
+   containing the name of the associated type.
+
+   The returned value is good until the next call.  May return NULL
+   if we are unable to determine the tag name.  */
+
+static char *
+ada_tag_name_from_tsd (struct value *tsd)
 {
-  struct type *info_type;
   static char name[1024];
   char *p;
-  struct value *val, *valp;
+  struct value *val;
 
-  args->name = NULL;
-  info_type = ada_get_tsd_type (current_inferior());
-  if (info_type == NULL)
-    return 0;
-  info_type = lookup_pointer_type (lookup_pointer_type (info_type));
-  valp = value_cast (info_type, args->tag);
-  if (valp == NULL)
-    return 0;
-  val = value_ind (value_ptradd (valp, -1));
-  if (val == NULL)
-    return 0;
-  val = ada_value_struct_elt (val, "expanded_name", 1);
+  val = ada_value_struct_elt (tsd, "expanded_name", 1);
   if (val == NULL)
-    return 0;
+    return NULL;
   read_memory_string (value_as_address (val), name, sizeof (name) - 1);
   for (p = name; *p != '\0'; p += 1)
     if (isalpha (*p))
       *p = tolower (*p);
-  args->name = name;
-  return 0;
+  return name;
 }
 
 /* The type name of the dynamic type denoted by the 'tag value TAG, as
-   a C string.  */
+   a C string.
+
+   Return NULL if the TAG is not an Ada tag, or if we were unable to
+   determine the name of that tag.  The result is good until the next
+   call.  */
 
 const char *
 ada_tag_name (struct value *tag)
 {
-  struct tag_args args;
+  volatile struct gdb_exception e;
+  char *name = NULL;
 
   if (!ada_is_tag_type (value_type (tag)))
     return NULL;
-  args.tag = tag;
-  args.name = NULL;
-  catch_errors (ada_tag_name_1, &args, NULL, RETURN_MASK_ALL);
-  return args.name;
+
+  /* It is perfectly possible that an exception be raised while trying
+     to determine the TAG's name, even under normal circumstances:
+     The associated variable may be uninitialized or corrupted, for
+     instance. We do not let any exception propagate past this point.
+     instead we return NULL.
+
+     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)
+    {
+      struct value *tsd = ada_get_tsd_from_tag (tag);
+
+      if (tsd != NULL)
+       name = ada_tag_name_from_tsd (tsd);
+    }
+
+  return name;
 }
 
 /* The parent type of TYPE, or NULL if none.  */
@@ -6169,7 +6427,7 @@ ada_value_primitive_field (struct value *arg1, int offset, int fieldno,
    Returns 1 if found, 0 otherwise.  */
 
 static int
-find_struct_field (char *name, struct type *type, int offset,
+find_struct_field (const char *name, struct type *type, int offset,
                    struct type **field_type_p,
                    int *byte_offset_p, int *bit_offset_p, int *bit_size_p,
                   int *index_p)
@@ -6191,7 +6449,7 @@ find_struct_field (char *name, struct type *type, int offset,
     {
       int bit_pos = TYPE_FIELD_BITPOS (type, i);
       int fld_offset = offset + bit_pos / 8;
-      char *t_field_name = TYPE_FIELD_NAME (type, i);
+      const char *t_field_name = TYPE_FIELD_NAME (type, i);
 
       if (t_field_name == NULL)
         continue;
@@ -6268,7 +6526,7 @@ ada_search_struct_field (char *name, struct value *arg, int offset,
   type = ada_check_typedef (type);
   for (i = 0; i < TYPE_NFIELDS (type); i += 1)
     {
-      char *t_field_name = TYPE_FIELD_NAME (type, i);
+      const char *t_field_name = TYPE_FIELD_NAME (type, i);
 
       if (t_field_name == NULL)
         continue;
@@ -6527,7 +6785,7 @@ ada_lookup_struct_elt_type (struct type *type, char *name, int refok,
 
   for (i = 0; i < TYPE_NFIELDS (type); i += 1)
     {
-      char *t_field_name = TYPE_FIELD_NAME (type, i);
+      const char *t_field_name = TYPE_FIELD_NAME (type, i);
       struct type *t;
       int disp;
 
@@ -6566,7 +6824,7 @@ ada_lookup_struct_elt_type (struct type *type, char *name, int refok,
                 NOT wrapped in a struct, since the compiler sometimes
                 generates these for unchecked variant types.  Revisit
                 if the compiler changes this practice.  */
-             char *v_field_name = TYPE_FIELD_NAME (field_type, j);
+             const char *v_field_name = TYPE_FIELD_NAME (field_type, j);
               disp = 0;
              if (v_field_name != NULL 
                  && field_name_match (v_field_name, name))
@@ -6704,7 +6962,7 @@ ada_which_variant_applies (struct type *var_type, struct type *outer_type,
 struct value *
 ada_value_ind (struct value *val0)
 {
-  struct value *val = unwrap_value (value_ind (val0));
+  struct value *val = value_ind (val0);
 
   return ada_to_fixed_value (val);
 }
@@ -6720,7 +6978,6 @@ ada_coerce_ref (struct value *val0)
       struct value *val = val0;
 
       val = coerce_ref (val);
-      val = unwrap_value (val);
       return ada_to_fixed_value (val);
     }
   else
@@ -6767,10 +7024,10 @@ field_alignment (struct type *type, int f)
   return atoi (name + align_offset) * TARGET_CHAR_BIT;
 }
 
-/* Find a symbol named NAME.  Ignores ambiguity.  */
+/* Find a typedef or tag symbol named NAME.  Ignores ambiguity.  */
 
-struct symbol *
-ada_find_any_symbol (const char *name)
+static struct symbol *
+ada_find_any_type_symbol (const char *name)
 {
   struct symbol *sym;
 
@@ -6786,10 +7043,10 @@ ada_find_any_symbol (const char *name)
    solely for types defined by debug info, it will not search the GDB
    primitive types.  */
 
-struct type *
+static struct type *
 ada_find_any_type (const char *name)
 {
-  struct symbol *sym = ada_find_any_symbol (name);
+  struct symbol *sym = ada_find_any_type_symbol (name);
 
   if (sym != NULL)
     return SYMBOL_TYPE (sym);
@@ -6797,23 +7054,28 @@ ada_find_any_type (const char *name)
   return NULL;
 }
 
-/* Given NAME and an associated BLOCK, search all symbols for
-   NAME suffixed with  "___XR", which is the ``renaming'' symbol
-   associated to NAME.  Return this symbol if found, return
-   NULL otherwise.  */
+/* Given NAME_SYM and an associated BLOCK, find a "renaming" symbol
+   associated with NAME_SYM's name.  NAME_SYM may itself be a renaming
+   symbol, in which case it is returned.  Otherwise, this looks for
+   symbols whose name is that of NAME_SYM suffixed with  "___XR".
+   Return symbol if found, and NULL otherwise.  */
 
 struct symbol *
-ada_find_renaming_symbol (const char *name, struct block *block)
+ada_find_renaming_symbol (struct symbol *name_sym, struct block *block)
 {
+  const char *name = SYMBOL_LINKAGE_NAME (name_sym);
   struct symbol *sym;
 
+  if (strstr (name, "___XR") != NULL)
+     return name_sym;
+
   sym = find_old_style_renaming_symbol (name, block);
 
   if (sym != NULL)
     return sym;
 
   /* Not right yet.  FIXME pnh 7/20/2007.  */
-  sym = ada_find_any_symbol (name);
+  sym = ada_find_any_type_symbol (name);
   if (sym != NULL && strstr (SYMBOL_LINKAGE_NAME (sym), "___XR") != NULL)
     return sym;
   else
@@ -6832,7 +7094,7 @@ find_old_style_renaming_symbol (const char *name, struct block *block)
          qualified.  This means we need to prepend the function name
          as well as adding the ``___XR'' suffix to build the name of
          the associated renaming symbol.  */
-      char *function_name = SYMBOL_LINKAGE_NAME (function_sym);
+      const char *function_name = SYMBOL_LINKAGE_NAME (function_sym);
       /* Function names sometimes contain suffixes used
          for instance to qualify nested subprograms.  When building
          the XR type name, we need to make sure that this suffix is
@@ -6871,7 +7133,7 @@ find_old_style_renaming_symbol (const char *name, struct block *block)
       xsnprintf (rename, rename_len * sizeof (char), "%s___XR", name);
     }
 
-  return ada_find_any_symbol (rename);
+  return ada_find_any_type_symbol (rename);
 }
 
 /* Because of GNAT encoding conventions, several GDB symbols may match a
@@ -6912,7 +7174,7 @@ ada_prefer_type (struct type *type0, struct type *type1)
 /* The name of TYPE, which is either its TYPE_NAME, or, if that is
    null, its TYPE_TAG_NAME.  Null if TYPE is null.  */
 
-char *
+const char *
 ada_type_name (struct type *type)
 {
   if (type == NULL)
@@ -6939,7 +7201,7 @@ find_parallel_type_by_descriptive_type (struct type *type, const char *name)
   result = TYPE_DESCRIPTIVE_TYPE (type);
   while (result != NULL)
     {
-      char *result_name = ada_type_name (result);
+      const char *result_name = ada_type_name (result);
 
       if (result_name == NULL)
         {
@@ -6991,7 +7253,8 @@ ada_find_parallel_type_with_name (struct type *type, const char *name)
 struct type *
 ada_find_parallel_type (struct type *type, const char *suffix)
 {
-  char *name, *typename = ada_type_name (type);
+  char *name;
+  const char *typename = ada_type_name (type);
   int len;
 
   if (typename == NULL)
@@ -7627,6 +7890,11 @@ to_fixed_array_type (struct type *type0, struct value *dval,
         error (_("array type with dynamic size is larger than varsize-limit"));
     }
 
+  /* We want to preserve the type name.  This can be useful when
+     trying to get the type name of a value that has already been
+     printed (for instance, if the user did "print VAR; whatis $".  */
+  TYPE_NAME (result) = TYPE_NAME (type0);
+
   if (constrained_packed_array_p)
     {
       /* So far, the resulting type has been created as if the original
@@ -7697,7 +7965,7 @@ ada_to_fixed_type_1 (struct type *type, const gdb_byte *valaddr,
            If there is, then it provides the actual size of our type.  */
         else if (ada_type_name (fixed_record_type) != NULL)
           {
-            char *name = ada_type_name (fixed_record_type);
+            const char *name = ada_type_name (fixed_record_type);
             char *xvz_name = alloca (strlen (name) + 7 /* "___XVZ\0" */);
             int xvz_found = 0;
             LONGEST size;
@@ -7892,7 +8160,7 @@ ada_check_typedef (struct type *type)
     return type;
   else
     {
-      char *name = TYPE_TAG_NAME (type);
+      const char *name = TYPE_TAG_NAME (type);
       struct type *type1 = ada_find_any_type (name);
 
       if (type1 == NULL)
@@ -7934,9 +8202,11 @@ ada_to_fixed_value_create (struct type *type0, CORE_ADDR address,
 struct value *
 ada_to_fixed_value (struct value *val)
 {
-  return ada_to_fixed_value_create (value_type (val),
-                                    value_address (val),
-                                    val);
+  val = unwrap_value (val);
+  val = ada_to_fixed_value_create (value_type (val),
+                                     value_address (val),
+                                     val);
+  return val;
 }
 \f
 
@@ -8192,7 +8462,7 @@ ada_enum_name (const char *name)
 
   /* First, unqualify the enumeration name:
      1. Search for the last '.' character.  If we find one, then skip
-     all the preceeding characters, the unqualified name starts
+     all the preceding characters, the unqualified name starts
      right after that dot.
      2. Otherwise, we may be debugging on a target where the compiler
      translates dots into "__".  Search forward for double underscores,
@@ -8371,8 +8641,8 @@ ada_value_binop (struct value *arg1, struct value *arg2, enum exp_opcode op)
 
   arg1 = coerce_ref (arg1);
   arg2 = coerce_ref (arg2);
-  type1 = base_type (ada_check_typedef (value_type (arg1)));
-  type2 = base_type (ada_check_typedef (value_type (arg2)));
+  type1 = get_base_type (ada_check_typedef (value_type (arg1)));
+  type2 = get_base_type (ada_check_typedef (value_type (arg2)));
 
   if (TYPE_CODE (type1) != TYPE_CODE_INT
       || TYPE_CODE (type2) != TYPE_CODE_INT)
@@ -8498,7 +8768,7 @@ assign_component (struct value *container, struct value *lhs, LONGEST index,
   else
     {
       elt = ada_index_struct_field (index, lhs, 0, value_type (lhs));
-      elt = ada_to_fixed_value (unwrap_value (elt));
+      elt = ada_to_fixed_value (elt);
     }
 
   if (exp->elts[*pos].opcode == OP_AGGREGATE)
@@ -8536,8 +8806,6 @@ assign_aggregate (struct value *container,
   *pos += 3;
   if (noside != EVAL_NORMAL)
     {
-      int i;
-
       for (i = 0; i < n; i += 1)
        ada_evaluate_subexp (NULL, exp, pos, noside);
       return container;
@@ -8579,24 +8847,24 @@ assign_aggregate (struct value *container,
     {
       switch (exp->elts[*pos].opcode)
        {
-       case OP_CHOICES:
-         aggregate_assign_from_choices (container, lhs, exp, pos, indices, 
+         case OP_CHOICES:
+           aggregate_assign_from_choices (container, lhs, exp, pos, indices, 
+                                          &num_indices, max_indices,
+                                          low_index, high_index);
+           break;
+         case OP_POSITIONAL:
+           aggregate_assign_positional (container, lhs, exp, pos, indices,
                                         &num_indices, max_indices,
                                         low_index, high_index);
-         break;
-       case OP_POSITIONAL:
-         aggregate_assign_positional (container, lhs, exp, pos, indices,
-                                      &num_indices, max_indices,
-                                      low_index, high_index);
-         break;
-       case OP_OTHERS:
-         if (i != n-1)
-           error (_("Misplaced 'others' clause"));
-         aggregate_assign_others (container, lhs, exp, pos, indices, 
-                                  num_indices, low_index, high_index);
-         break;
-       default:
-         error (_("Internal error: bad aggregate clause"));
+           break;
+         case OP_OTHERS:
+           if (i != n-1)
+             error (_("Misplaced 'others' clause"));
+           aggregate_assign_others (container, lhs, exp, pos, indices, 
+                                    num_indices, low_index, high_index);
+           break;
+         default:
+           error (_("Internal error: bad aggregate clause"));
        }
     }
 
@@ -8674,7 +8942,7 @@ aggregate_assign_from_choices (struct value *container,
       else
        {
          int ind;
-         char *name;
+         const char *name;
 
          switch (op)
            {
@@ -9337,7 +9605,6 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       else
         {
           arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
-          arg1 = unwrap_value (arg1);
           return ada_to_fixed_value (arg1);
         }
 
@@ -9381,8 +9648,8 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       type = ada_check_typedef (value_type (argvec[0]));
 
       /* Ada allows us to implicitly dereference arrays when subscripting
-         them.  So, if this is an typedef (encoding use for array access
-        types encoded as fat pointers), strip it now.  */
+        them.  So, if this is an array typedef (encoding use for array
+        access types encoded as fat pointers), strip it now.  */
       if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
        type = ada_typedef_target_type (type);
 
@@ -9517,16 +9784,17 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
         if (!ada_is_simple_array_type (value_type (array)))
           error (_("cannot take slice of non-array"));
 
-        if (TYPE_CODE (value_type (array)) == TYPE_CODE_PTR)
+        if (TYPE_CODE (ada_check_typedef (value_type (array)))
+            == TYPE_CODE_PTR)
           {
+            struct type *type0 = ada_check_typedef (value_type (array));
+
             if (high_bound < low_bound || noside == EVAL_AVOID_SIDE_EFFECTS)
-              return empty_array (TYPE_TARGET_TYPE (value_type (array)),
-                                  low_bound);
+              return empty_array (TYPE_TARGET_TYPE (type0), low_bound);
             else
               {
                 struct type *arr_type0 =
-                  to_fixed_array_type (TYPE_TARGET_TYPE (value_type (array)),
-                                       NULL, 1);
+                  to_fixed_array_type (TYPE_TARGET_TYPE (type0), NULL, 1);
 
                 return ada_value_slice_from_ptr (array, arr_type0,
                                                  longest_to_int (low_bound),
@@ -9682,7 +9950,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
         else if (discrete_type_p (type_arg))
           {
             struct type *range_type;
-            char *name = ada_type_name (type_arg);
+            const char *name = ada_type_name (type_arg);
 
             range_type = NULL;
             if (name != NULL && TYPE_CODE (type_arg) != TYPE_CODE_ENUM)
@@ -10165,7 +10433,7 @@ get_var_value (char *name, char *err_msg)
   int nsyms;
 
   nsyms = ada_lookup_symbol_list (name, get_selected_block (0), VAR_DOMAIN,
-                                  &syms);
+                                  &syms, 1);
 
   if (nsyms != 1)
     {
@@ -10214,7 +10482,7 @@ get_int_var_value (char *name, int *flag)
 static struct type *
 to_fixed_range_type (struct type *raw_type, struct value *dval)
 {
-  char *name;
+  const char *name;
   struct type *base_type;
   char *subtype_info;
 
@@ -10323,44 +10591,13 @@ ada_is_range_type_name (const char *name)
 int
 ada_is_modular_type (struct type *type)
 {
-  struct type *subranged_type = base_type (type);
+  struct type *subranged_type = get_base_type (type);
 
   return (subranged_type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE
           && TYPE_CODE (subranged_type) == TYPE_CODE_INT
           && TYPE_UNSIGNED (subranged_type));
 }
 
-/* Try to determine the lower and upper bounds of the given modular type
-   using the type name only.  Return non-zero and set L and U as the lower
-   and upper bounds (respectively) if successful.  */
-
-int
-ada_modulus_from_name (struct type *type, ULONGEST *modulus)
-{
-  char *name = ada_type_name (type);
-  char *suffix;
-  int k;
-  LONGEST U;
-
-  if (name == NULL)
-    return 0;
-
-  /* Discrete type bounds are encoded using an __XD suffix.  In our case,
-     we are looking for static bounds, which means an __XDLU suffix.
-     Moreover, we know that the lower bound of modular types is always
-     zero, so the actual suffix should start with "__XDLU_0__", and
-     then be followed by the upper bound value.  */
-  suffix = strstr (name, "__XDLU_0__");
-  if (suffix == NULL)
-    return 0;
-  k = 10;
-  if (!ada_scan_number (suffix, k, &U, NULL))
-    return 0;
-
-  *modulus = (ULONGEST) U + 1;
-  return 1;
-}
-
 /* Assuming ada_is_modular_type (TYPE), the modulus of TYPE.  */
 
 ULONGEST
@@ -10394,19 +10631,7 @@ ada_modulus (struct type *type)
    a few times already, and these changes affect the implementation
    of these catchpoints.  In order to be able to support several
    variants of the runtime, we use a sniffer that will determine
-   the runtime variant used by the program being debugged.
-
-   At this time, we do not support the use of conditions on Ada exception
-   catchpoints.  The COND and COND_STRING fields are therefore set
-   to NULL (most of the time, see below).
-   
-   Conditions where EXP_STRING, COND, and COND_STRING are used:
-
-     When a user specifies the name of a specific exception in the case
-     of catchpoints on Ada exceptions, we store the name of that exception
-     in the EXP_STRING.  We then translate this request into an actual
-     condition stored in COND_STRING, and then parse it into an expression
-     stored in COND.  */
+   the runtime variant used by the program being debugged.  */
 
 /* The different types of catchpoints that we introduced for catching
    Ada exceptions.  */
@@ -10480,40 +10705,83 @@ static const struct exception_support_info exception_support_info_fallback =
   ada_unhandled_exception_name_addr_from_raise
 };
 
-/* For each executable, we sniff which exception info structure to use
-   and cache it in the following global variable.  */
+/* Return nonzero if we can detect the exception support routines
+   described in EINFO.
+
+   This function errors out if an abnormal situation is detected
+   (for instance, if we find the exception support routines, but
+   that support is found to be incomplete).  */
 
-static const struct exception_support_info *exception_info = NULL;
+static int
+ada_has_this_exception_support (const struct exception_support_info *einfo)
+{
+  struct symbol *sym;
+
+  /* The symbol we're looking up is provided by a unit in the GNAT runtime
+     that should be compiled with debugging information.  As a result, we
+     expect to find that symbol in the symtabs.  */
+
+  sym = standard_lookup (einfo->catch_exception_sym, NULL, VAR_DOMAIN);
+  if (sym == NULL)
+    {
+      /* Perhaps we did not find our symbol because the Ada runtime was
+        compiled without debugging info, or simply stripped of it.
+        It happens on some GNU/Linux distributions for instance, where
+        users have to install a separate debug package in order to get
+        the runtime's debugging info.  In that situation, let the user
+        know why we cannot insert an Ada exception catchpoint.
+
+        Note: Just for the purpose of inserting our Ada exception
+        catchpoint, we could rely purely on the associated minimal symbol.
+        But we would be operating in degraded mode anyway, since we are
+        still lacking the debugging info needed later on to extract
+        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))
+       error (_("Your Ada runtime appears to be missing some debugging "
+                "information.\nCannot insert Ada exception catchpoint "
+                "in this configuration."));
+
+      return 0;
+    }
+
+  /* Make sure that the symbol we found corresponds to a function.  */
+
+  if (SYMBOL_CLASS (sym) != LOC_BLOCK)
+    error (_("Symbol \"%s\" is not a function (class = %d)"),
+           SYMBOL_LINKAGE_NAME (sym), SYMBOL_CLASS (sym));
+
+  return 1;
+}
 
 /* Inspect the Ada runtime and determine which exception info structure
    should be used to provide support for exception catchpoints.
 
-   This function will always set exception_info, or raise an error.  */
+   This function will always set the per-inferior exception_info,
+   or raise an error.  */
 
 static void
 ada_exception_support_info_sniffer (void)
 {
+  struct ada_inferior_data *data = get_ada_inferior_data (current_inferior ());
   struct symbol *sym;
 
   /* If the exception info is already known, then no need to recompute it.  */
-  if (exception_info != NULL)
+  if (data->exception_info != NULL)
     return;
 
   /* Check the latest (default) exception support info.  */
-  sym = standard_lookup (default_exception_support_info.catch_exception_sym,
-                         NULL, VAR_DOMAIN);
-  if (sym != NULL)
+  if (ada_has_this_exception_support (&default_exception_support_info))
     {
-      exception_info = &default_exception_support_info;
+      data->exception_info = &default_exception_support_info;
       return;
     }
 
   /* Try our fallback exception suport info.  */
-  sym = standard_lookup (exception_support_info_fallback.catch_exception_sym,
-                         NULL, VAR_DOMAIN);
-  if (sym != NULL)
+  if (ada_has_this_exception_support (&exception_support_info_fallback))
     {
-      exception_info = &exception_support_info_fallback;
+      data->exception_info = &exception_support_info_fallback;
       return;
     }
 
@@ -10541,20 +10809,7 @@ ada_exception_support_info_sniffer (void)
      out by the linker...  In any case, at this point it is not worth
      supporting this feature.  */
 
-  error (_("Cannot insert catchpoints in this configuration."));
-}
-
-/* An observer of "executable_changed" events.
-   Its role is to clear certain cached values that need to be recomputed
-   each time a new executable is loaded by GDB.  */
-
-static void
-ada_executable_changed_observer (void)
-{
-  /* If the executable changed, then it is possible that the Ada runtime
-     is different.  So we need to invalidate the exception support info
-     cache.  */
-  exception_info = NULL;
+  error (_("Cannot insert Ada exception catchpoints in this configuration."));
 }
 
 /* True iff FRAME is very likely to be that of a function that is
@@ -10566,7 +10821,7 @@ static int
 is_known_support_routine (struct frame_info *frame)
 {
   struct symtab_and_line sal;
-  char *func_name;
+  const char *func_name;
   enum language func_lang;
   int i;
 
@@ -10656,6 +10911,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 ());
 
   /* To determine the name of this exception, we need to select
      the frame corresponding to RAISE_SYM_NAME.  This frame is
@@ -10668,12 +10924,12 @@ ada_unhandled_exception_name_addr_from_raise (void)
 
   while (fi != NULL)
     {
-      char *func_name;
+      const char *func_name;
       enum language func_lang;
 
       find_frame_funname (fi, &func_name, &func_lang, NULL);
       if (func_name != NULL
-          && strcmp (func_name, exception_info->catch_exception_sym) == 0)
+          && strcmp (func_name, data->exception_info->catch_exception_sym) == 0)
         break; /* We found the frame we were looking for...  */
       fi = get_prev_frame (fi);
     }
@@ -10695,6 +10951,8 @@ static CORE_ADDR
 ada_exception_name_addr_1 (enum exception_catchpoint_kind ex,
                            struct breakpoint *b)
 {
+  struct ada_inferior_data *data = get_ada_inferior_data (current_inferior ());
+
   switch (ex)
     {
       case ex_catch_exception:
@@ -10702,7 +10960,7 @@ ada_exception_name_addr_1 (enum exception_catchpoint_kind ex,
         break;
 
       case ex_catch_exception_unhandled:
-        return exception_info->unhandled_exception_name_addr ();
+        return data->exception_info->unhandled_exception_name_addr ();
         break;
       
       case ex_catch_assert:
@@ -10726,7 +10984,7 @@ static CORE_ADDR
 ada_exception_name_addr (enum exception_catchpoint_kind ex,
                          struct breakpoint *b)
 {
-  struct gdb_exception e;
+  volatile struct gdb_exception e;
   CORE_ADDR result = 0;
 
   TRY_CATCH (e, RETURN_MASK_ERROR)
@@ -10743,12 +11001,226 @@ ada_exception_name_addr (enum exception_catchpoint_kind ex,
   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.
+
+   In the case of catchpoints on Ada exceptions, the catchpoint will
+   stop the target on every exception the program throws.  When a user
+   specifies the name of a specific exception, we translate this
+   request into a condition expression (in text form), and then parse
+   it into an expression stored in each of the catchpoint's locations.
+   We then use this condition to check whether the exception that was
+   raised is the one the user is interested in.  If not, then the
+   target is resumed again.  We store the name of the requested
+   exception, in order to be able to re-set the condition expression
+   when symbols change.  */
+
+/* An instance of this type is used to represent an Ada catchpoint
+   breakpoint location.  It includes a "struct bp_location" as a kind
+   of base class; users downcast to "struct bp_location *" when
+   needed.  */
+
+struct ada_catchpoint_location
+{
+  /* The base class.  */
+  struct bp_location base;
+
+  /* The condition that checks whether the exception that was raised
+     is the specific exception the user specified on catchpoint
+     creation.  */
+  struct expression *excep_cond_expr;
+};
+
+/* Implement the DTOR method in the bp_location_ops structure for all
+   Ada exception catchpoint kinds.  */
+
+static void
+ada_catchpoint_location_dtor (struct bp_location *bl)
+{
+  struct ada_catchpoint_location *al = (struct ada_catchpoint_location *) bl;
+
+  xfree (al->excep_cond_expr);
+}
+
+/* The vtable to be used in Ada catchpoint locations.  */
+
+static const struct bp_location_ops ada_catchpoint_location_ops =
+{
+  ada_catchpoint_location_dtor
+};
+
+/* An instance of this type is used to represent an Ada catchpoint.
+   It includes a "struct breakpoint" as a kind of base class; users
+   downcast to "struct breakpoint *" when needed.  */
+
+struct ada_catchpoint
+{
+  /* The base class.  */
+  struct breakpoint base;
+
+  /* The name of the specific exception the user specified.  */
+  char *excep_string;
+};
+
+/* Parse the exception condition string in the context of each of the
+   catchpoint's locations, and store them for later evaluation.  */
+
+static void
+create_excep_cond_exprs (struct ada_catchpoint *c)
+{
+  struct cleanup *old_chain;
+  struct bp_location *bl;
+  char *cond_string;
+
+  /* Nothing to do if there's no specific exception to catch.  */
+  if (c->excep_string == NULL)
+    return;
+
+  /* Same if there are no locations... */
+  if (c->base.loc == NULL)
+    return;
+
+  /* Compute the condition expression in text form, from the specific
+     expection we want to catch.  */
+  cond_string = ada_exception_catchpoint_cond_string (c->excep_string);
+  old_chain = make_cleanup (xfree, cond_string);
+
+  /* Iterate over all the catchpoint's locations, and parse an
+     expression for each.  */
+  for (bl = c->base.loc; bl != NULL; bl = bl->next)
+    {
+      struct ada_catchpoint_location *ada_loc
+       = (struct ada_catchpoint_location *) bl;
+      struct expression *exp = NULL;
+
+      if (!bl->shlib_disabled)
+       {
+         volatile struct gdb_exception e;
+         char *s;
+
+         s = cond_string;
+         TRY_CATCH (e, RETURN_MASK_ERROR)
+           {
+             exp = parse_exp_1 (&s, 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);
+       }
+
+      ada_loc->excep_cond_expr = exp;
+    }
+
+  do_cleanups (old_chain);
+}
+
+/* Implement the DTOR method in the breakpoint_ops structure for all
+   exception catchpoint kinds.  */
+
+static void
+dtor_exception (enum exception_catchpoint_kind ex, struct breakpoint *b)
+{
+  struct ada_catchpoint *c = (struct ada_catchpoint *) b;
+
+  xfree (c->excep_string);
+
+  bkpt_breakpoint_ops.dtor (b);
+}
+
+/* Implement the ALLOCATE_LOCATION method in the breakpoint_ops
+   structure for all exception catchpoint kinds.  */
+
+static struct bp_location *
+allocate_location_exception (enum exception_catchpoint_kind ex,
+                            struct breakpoint *self)
+{
+  struct ada_catchpoint_location *loc;
+
+  loc = XNEW (struct ada_catchpoint_location);
+  init_bp_location (&loc->base, &ada_catchpoint_location_ops, self);
+  loc->excep_cond_expr = NULL;
+  return &loc->base;
+}
+
+/* Implement the RE_SET method in the breakpoint_ops structure for all
+   exception catchpoint kinds.  */
+
+static void
+re_set_exception (enum exception_catchpoint_kind ex, struct breakpoint *b)
+{
+  struct ada_catchpoint *c = (struct ada_catchpoint *) b;
+
+  /* Call the base class's method.  This updates the catchpoint's
+     locations.  */
+  bkpt_breakpoint_ops.re_set (b);
+
+  /* Reparse the exception conditional expressions.  One for each
+     location.  */
+  create_excep_cond_exprs (c);
+}
+
+/* Returns true if we should stop for this breakpoint hit.  If the
+   user specified a specific exception, we only want to cause a stop
+   if the program thrown that exception.  */
+
+static int
+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.  */
+  if (c->excep_string == NULL)
+    return 1;
+
+  if (ada_loc->excep_cond_expr == NULL)
+    {
+      /* We will have a NULL expression if back when we were creating
+        the expressions, this location's had failed to parse.  */
+      return 1;
+    }
+
+  stop = 1;
+  TRY_CATCH (ex, RETURN_MASK_ALL)
+    {
+      struct value *mark;
+
+      mark = value_mark ();
+      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"));
+  return stop;
+}
+
+/* Implement the CHECK_STATUS method in the breakpoint_ops structure
+   for all exception catchpoint kinds.  */
+
+static void
+check_status_exception (enum exception_catchpoint_kind ex, bpstat bs)
+{
+  bs->stop = should_stop_exception (bs->bp_location_at);
+}
+
 /* Implement the PRINT_IT method in the breakpoint_ops structure
    for all exception catchpoint kinds.  */
 
 static enum print_stop_action
-print_it_exception (enum exception_catchpoint_kind ex, struct breakpoint *b)
+print_it_exception (enum exception_catchpoint_kind ex, bpstat bs)
 {
+  struct ui_out *uiout = current_uiout;
+  struct breakpoint *b = bs->breakpoint_at;
+
   annotate_catchpoint (b->number);
 
   if (ui_out_is_mi_like_p (uiout))
@@ -10758,7 +11230,9 @@ print_it_exception (enum exception_catchpoint_kind ex, struct breakpoint *b)
       ui_out_field_string (uiout, "disp", bpdisp_text (b->disposition));
     }
 
-  ui_out_text (uiout, "\nCatchpoint ");
+  ui_out_text (uiout,
+               b->disposition == disp_del ? "\nTemporary catchpoint "
+                                         : "\nCatchpoint ");
   ui_out_field_int (uiout, "bkptno", b->number);
   ui_out_text (uiout, ", ");
 
@@ -10783,7 +11257,7 @@ print_it_exception (enum exception_catchpoint_kind ex, struct breakpoint *b)
                 just replace the exception name by the generic string
                 "exception" - it will read as "an exception" in the
                 notification we are about to print.  */
-             sprintf (exception_name, "exception");
+             memcpy (exception_name, "exception", sizeof ("exception"));
            }
          /* In the case of unhandled exception breakpoints, we print
             the exception name as "unhandled EXCEPTION_NAME", to make
@@ -10817,6 +11291,8 @@ static void
 print_one_exception (enum exception_catchpoint_kind ex,
                      struct breakpoint *b, struct bp_location **last_loc)
 { 
+  struct ui_out *uiout = current_uiout;
+  struct ada_catchpoint *c = (struct ada_catchpoint *) b;
   struct value_print_options opts;
 
   get_user_print_options (&opts);
@@ -10831,10 +11307,10 @@ print_one_exception (enum exception_catchpoint_kind ex,
   switch (ex)
     {
       case ex_catch_exception:
-        if (b->exp_string != NULL)
+        if (c->excep_string != NULL)
           {
-            char *msg = xstrprintf (_("`%s' Ada exception"), b->exp_string);
-            
+            char *msg = xstrprintf (_("`%s' Ada exception"), c->excep_string);
+
             ui_out_field_string (uiout, "what", msg);
             xfree (msg);
           }
@@ -10864,24 +11340,35 @@ static void
 print_mention_exception (enum exception_catchpoint_kind ex,
                          struct breakpoint *b)
 {
+  struct ada_catchpoint *c = (struct ada_catchpoint *) b;
+  struct ui_out *uiout = current_uiout;
+
+  ui_out_text (uiout, b->disposition == disp_del ? _("Temporary catchpoint ")
+                                                 : _("Catchpoint "));
+  ui_out_field_int (uiout, "bkptno", b->number);
+  ui_out_text (uiout, ": ");
+
   switch (ex)
     {
       case ex_catch_exception:
-        if (b->exp_string != NULL)
-          printf_filtered (_("Catchpoint %d: `%s' Ada exception"),
-                           b->number, b->exp_string);
+        if (c->excep_string != NULL)
+         {
+           char *info = xstrprintf (_("`%s' Ada exception"), c->excep_string);
+           struct cleanup *old_chain = make_cleanup (xfree, info);
+
+           ui_out_text (uiout, info);
+           do_cleanups (old_chain);
+         }
         else
-          printf_filtered (_("Catchpoint %d: all Ada exceptions"), b->number);
-        
+          ui_out_text (uiout, _("all Ada exceptions"));
         break;
 
       case ex_catch_exception_unhandled:
-        printf_filtered (_("Catchpoint %d: unhandled Ada exceptions"),
-                         b->number);
+        ui_out_text (uiout, _("unhandled Ada exceptions"));
         break;
       
       case ex_catch_assert:
-        printf_filtered (_("Catchpoint %d: failed Ada assertions"), b->number);
+        ui_out_text (uiout, _("failed Ada assertions"));
         break;
 
       default:
@@ -10897,12 +11384,14 @@ static void
 print_recreate_exception (enum 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:
        fprintf_filtered (fp, "catch exception");
-       if (b->exp_string != NULL)
-         fprintf_filtered (fp, " %s", b->exp_string);
+       if (c->excep_string != NULL)
+         fprintf_filtered (fp, " %s", c->excep_string);
        break;
 
       case ex_catch_exception_unhandled:
@@ -10916,14 +11405,39 @@ print_recreate_exception (enum exception_catchpoint_kind ex,
       default:
        internal_error (__FILE__, __LINE__, _("unexpected catchpoint type"));
     }
+  print_recreate_thread (b, fp);
 }
 
 /* Virtual table for "catch exception" breakpoints.  */
 
+static void
+dtor_catch_exception (struct breakpoint *b)
+{
+  dtor_exception (ex_catch_exception, b);
+}
+
+static struct bp_location *
+allocate_location_catch_exception (struct breakpoint *self)
+{
+  return allocate_location_exception (ex_catch_exception, self);
+}
+
+static void
+re_set_catch_exception (struct breakpoint *b)
+{
+  re_set_exception (ex_catch_exception, b);
+}
+
+static void
+check_status_catch_exception (bpstat bs)
+{
+  check_status_exception (ex_catch_exception, bs);
+}
+
 static enum print_stop_action
-print_it_catch_exception (struct breakpoint *b)
+print_it_catch_exception (bpstat bs)
 {
-  return print_it_exception (ex_catch_exception, b);
+  return print_it_exception (ex_catch_exception, bs);
 }
 
 static void
@@ -10944,25 +11458,38 @@ print_recreate_catch_exception (struct breakpoint *b, struct ui_file *fp)
   print_recreate_exception (ex_catch_exception, b, fp);
 }
 
-static struct breakpoint_ops catch_exception_breakpoint_ops =
-{
-  NULL, /* insert */
-  NULL, /* remove */
-  NULL, /* breakpoint_hit */
-  NULL, /* resources_needed */
-  print_it_catch_exception,
-  print_one_catch_exception,
-  NULL, /* print_one_detail */
-  print_mention_catch_exception,
-  print_recreate_catch_exception
-};
+static struct breakpoint_ops catch_exception_breakpoint_ops;
 
 /* Virtual table for "catch exception unhandled" breakpoints.  */
 
+static void
+dtor_catch_exception_unhandled (struct breakpoint *b)
+{
+  dtor_exception (ex_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);
+}
+
+static void
+re_set_catch_exception_unhandled (struct breakpoint *b)
+{
+  re_set_exception (ex_catch_exception_unhandled, b);
+}
+
+static void
+check_status_catch_exception_unhandled (bpstat bs)
+{
+  check_status_exception (ex_catch_exception_unhandled, bs);
+}
+
 static enum print_stop_action
-print_it_catch_exception_unhandled (struct breakpoint *b)
+print_it_catch_exception_unhandled (bpstat bs)
 {
-  return print_it_exception (ex_catch_exception_unhandled, b);
+  return print_it_exception (ex_catch_exception_unhandled, bs);
 }
 
 static void
@@ -10985,24 +11512,38 @@ print_recreate_catch_exception_unhandled (struct breakpoint *b,
   print_recreate_exception (ex_catch_exception_unhandled, b, fp);
 }
 
-static struct breakpoint_ops catch_exception_unhandled_breakpoint_ops = {
-  NULL, /* insert */
-  NULL, /* remove */
-  NULL, /* breakpoint_hit */
-  NULL, /* resources_needed */
-  print_it_catch_exception_unhandled,
-  print_one_catch_exception_unhandled,
-  NULL, /* print_one_detail */
-  print_mention_catch_exception_unhandled,
-  print_recreate_catch_exception_unhandled
-};
+static struct breakpoint_ops catch_exception_unhandled_breakpoint_ops;
 
 /* Virtual table for "catch assert" breakpoints.  */
 
+static void
+dtor_catch_assert (struct breakpoint *b)
+{
+  dtor_exception (ex_catch_assert, b);
+}
+
+static struct bp_location *
+allocate_location_catch_assert (struct breakpoint *self)
+{
+  return allocate_location_exception (ex_catch_assert, self);
+}
+
+static void
+re_set_catch_assert (struct breakpoint *b)
+{
+  return re_set_exception (ex_catch_assert, b);
+}
+
+static void
+check_status_catch_assert (bpstat bs)
+{
+  check_status_exception (ex_catch_assert, bs);
+}
+
 static enum print_stop_action
-print_it_catch_assert (struct breakpoint *b)
+print_it_catch_assert (bpstat bs)
 {
-  return print_it_exception (ex_catch_assert, b);
+  return print_it_exception (ex_catch_assert, bs);
 }
 
 static void
@@ -11023,27 +11564,7 @@ print_recreate_catch_assert (struct breakpoint *b, struct ui_file *fp)
   print_recreate_exception (ex_catch_assert, b, fp);
 }
 
-static struct breakpoint_ops catch_assert_breakpoint_ops = {
-  NULL, /* insert */
-  NULL, /* remove */
-  NULL, /* breakpoint_hit */
-  NULL, /* resources_needed */
-  print_it_catch_assert,
-  print_one_catch_assert,
-  NULL, /* print_one_detail */
-  print_mention_catch_assert,
-  print_recreate_catch_assert
-};
-
-/* Return non-zero if B is an Ada exception catchpoint.  */
-
-int
-ada_exception_catchpoint_p (struct breakpoint *b)
-{
-  return (b->ops == &catch_exception_breakpoint_ops
-          || b->ops == &catch_exception_unhandled_breakpoint_ops
-          || b->ops == &catch_assert_breakpoint_ops);
-}
+static struct breakpoint_ops catch_assert_breakpoint_ops;
 
 /* Return a newly allocated copy of the first space-separated token
    in ARGSP, and then adjust ARGSP to point immediately after that
@@ -11058,19 +11579,13 @@ ada_get_next_arg (char **argsp)
   char *end;
   char *result;
 
-  /* Skip any leading white space.  */
-
-  while (isspace (*args))
-    args++;
-
+  args = skip_spaces (args);
   if (args[0] == '\0')
     return NULL; /* No more arguments.  */
   
   /* Find the end of the current argument.  */
 
-  end = args;
-  while (*end != '\0' && !isspace (*end))
-    end++;
+  end = skip_to_space (args);
 
   /* Adjust ARGSP to point to the start of the next argument.  */
 
@@ -11087,26 +11602,54 @@ ada_get_next_arg (char **argsp)
 
 /* Split the arguments specified in a "catch exception" command.  
    Set EX to the appropriate catchpoint type.
-   Set EXP_STRING to the name of the specific exception if
-   specified by the user.  */
+   Set EXCEP_STRING to the name of the specific exception if
+   specified by the user.
+   If a condition is found at the end of the arguments, the condition
+   expression is stored in COND_STRING (memory must be deallocated
+   after use).  Otherwise COND_STRING is set to NULL.  */
 
 static void
 catch_ada_exception_command_split (char *args,
                                    enum exception_catchpoint_kind *ex,
-                                   char **exp_string)
+                                  char **excep_string,
+                                  char **cond_string)
 {
   struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
   char *exception_name;
+  char *cond = NULL;
 
   exception_name = ada_get_next_arg (&args);
+  if (exception_name != NULL && strcmp (exception_name, "if") == 0)
+    {
+      /* This is not an exception name; this is the start of a condition
+        expression for a catchpoint on all exceptions.  So, "un-get"
+        this token, and set exception_name to NULL.  */
+      xfree (exception_name);
+      exception_name = NULL;
+      args -= 2;
+    }
   make_cleanup (xfree, exception_name);
 
+  /* Check to see if we have a condition.  */
+
+  args = skip_spaces (args);
+  if (strncmp (args, "if", 2) == 0
+      && (isspace (args[2]) || args[2] == '\0'))
+    {
+      args += 2;
+      args = skip_spaces (args);
+
+      if (args[0] == '\0')
+        error (_("Condition missing after `if' keyword"));
+      cond = xstrdup (args);
+      make_cleanup (xfree, cond);
+
+      args += strlen (args);
+    }
+
   /* Check that we do not have any more arguments.  Anything else
      is unexpected.  */
 
-  while (isspace (*args))
-    args++;
-
   if (args[0] != '\0')
     error (_("Junk at end of expression"));
 
@@ -11116,20 +11659,21 @@ catch_ada_exception_command_split (char *args,
     {
       /* Catch all exceptions.  */
       *ex = ex_catch_exception;
-      *exp_string = NULL;
+      *excep_string = NULL;
     }
   else if (strcmp (exception_name, "unhandled") == 0)
     {
       /* Catch unhandled exceptions.  */
       *ex = ex_catch_exception_unhandled;
-      *exp_string = NULL;
+      *excep_string = NULL;
     }
   else
     {
       /* Catch a specific exception.  */
       *ex = ex_catch_exception;
-      *exp_string = exception_name;
+      *excep_string = exception_name;
     }
+  *cond_string = cond;
 }
 
 /* Return the name of the symbol on which we should break in order to
@@ -11138,18 +11682,20 @@ catch_ada_exception_command_split (char *args,
 static const char *
 ada_exception_sym_name (enum exception_catchpoint_kind ex)
 {
-  gdb_assert (exception_info != NULL);
+  struct ada_inferior_data *data = get_ada_inferior_data (current_inferior ());
+
+  gdb_assert (data->exception_info != NULL);
 
   switch (ex)
     {
       case ex_catch_exception:
-        return (exception_info->catch_exception_sym);
+        return (data->exception_info->catch_exception_sym);
         break;
       case ex_catch_exception_unhandled:
-        return (exception_info->catch_exception_unhandled_sym);
+        return (data->exception_info->catch_exception_unhandled_sym);
         break;
       case ex_catch_assert:
-        return (exception_info->catch_assert_sym);
+        return (data->exception_info->catch_assert_sym);
         break;
       default:
         internal_error (__FILE__, __LINE__,
@@ -11160,7 +11706,7 @@ ada_exception_sym_name (enum exception_catchpoint_kind ex)
 /* Return the breakpoint ops "virtual table" used for catchpoints
    of the EX kind.  */
 
-static struct breakpoint_ops *
+static const struct breakpoint_ops *
 ada_exception_breakpoint_ops (enum exception_catchpoint_kind ex)
 {
   switch (ex)
@@ -11189,13 +11735,13 @@ ada_exception_breakpoint_ops (enum exception_catchpoint_kind ex)
    deallocated later.  */
 
 static char *
-ada_exception_catchpoint_cond_string (const char *exp_string)
+ada_exception_catchpoint_cond_string (const char *excep_string)
 {
   int i;
 
   /* The standard exceptions are a special case.  They are defined in
      runtime units that have been compiled without debugging info; if
-     EXP_STRING is the not-fully-qualified name of a standard
+     EXCEP_STRING is the not-fully-qualified name of a standard
      exception (e.g. "constraint_error") then, during the evaluation
      of the condition expression, the symbol lookup on this name would
      *not* return this standard exception.  The catchpoint condition
@@ -11214,156 +11760,190 @@ ada_exception_catchpoint_cond_string (const char *exp_string)
 
   for (i = 0; i < sizeof (standard_exc) / sizeof (char *); i++)
     {
-      if (strcmp (standard_exc [i], exp_string) == 0)
+      if (strcmp (standard_exc [i], excep_string) == 0)
        {
           return xstrprintf ("long_integer (e) = long_integer (&standard.%s)",
-                             exp_string);
+                             excep_string);
        }
     }
-  return xstrprintf ("long_integer (e) = long_integer (&%s)", exp_string);
-}
-
-/* Return the expression corresponding to COND_STRING evaluated at SAL.  */
-
-static struct expression *
-ada_parse_catchpoint_condition (char *cond_string,
-                                struct symtab_and_line sal)
-{
-  return (parse_exp_1 (&cond_string, block_for_pc (sal.pc), 0));
+  return xstrprintf ("long_integer (e) = long_integer (&%s)", excep_string);
 }
 
 /* Return the symtab_and_line that should be used to insert an exception
    catchpoint of the TYPE kind.
 
-   EX_STRING should contain the name of a specific exception
-   that the catchpoint should catch, or NULL otherwise.
+   EXCEP_STRING should contain the name of a specific exception that
+   the catchpoint should catch, or NULL otherwise.
 
-   The idea behind all the remaining parameters is that their names match
-   the name of certain fields in the breakpoint structure that are used to
-   handle exception catchpoints.  This function returns the value to which
-   these fields should be set, depending on the type of catchpoint we need
-   to create.
-   
-   If COND and COND_STRING are both non-NULL, any value they might
-   hold will be free'ed, and then replaced by newly allocated ones.
-   These parameters are left untouched otherwise.  */
+   ADDR_STRING returns the name of the function where the real
+   breakpoint that implements the catchpoints is set, depending on the
+   type of catchpoint we need to create.  */
 
 static struct symtab_and_line
-ada_exception_sal (enum exception_catchpoint_kind ex, char *exp_string,
-                   char **addr_string, char **cond_string,
-                   struct expression **cond, struct breakpoint_ops **ops)
+ada_exception_sal (enum exception_catchpoint_kind ex, char *excep_string,
+                  char **addr_string, const struct breakpoint_ops **ops)
 {
   const char *sym_name;
   struct symbol *sym;
-  struct symtab_and_line sal;
 
   /* First, find out which exception support info to use.  */
   ada_exception_support_info_sniffer ();
 
   /* Then lookup the function on which we will break in order to catch
      the Ada exceptions requested by the user.  */
-
   sym_name = ada_exception_sym_name (ex);
   sym = standard_lookup (sym_name, NULL, VAR_DOMAIN);
 
-  /* The symbol we're looking up is provided by a unit in the GNAT runtime
-     that should be compiled with debugging information.  As a result, we
-     expect to find that symbol in the symtabs.  If we don't find it, then
-     the target most likely does not support Ada exceptions, or we cannot
-     insert exception breakpoints yet, because the GNAT runtime hasn't been
-     loaded yet.  */
-
-  /* brobecker/2006-12-26: It is conceivable that the runtime was compiled
-     in such a way that no debugging information is produced for the symbol
-     we are looking for.  In this case, we could search the minimal symbols
-     as a fall-back mechanism.  This would still be operating in degraded
-     mode, however, as we would still be missing the debugging information
-     that is needed in order to extract 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 (sym == NULL)
-    error (_("Unable to break on '%s' in this configuration."), sym_name);
+  /* We can assume that SYM is not NULL at this stage.  If the symbol
+     did not exist, ada_exception_support_info_sniffer would have
+     raised an exception.
 
-  /* Make sure that the symbol we found corresponds to a function.  */
-  if (SYMBOL_CLASS (sym) != LOC_BLOCK)
-    error (_("Symbol \"%s\" is not a function (class = %d)"),
-           sym_name, SYMBOL_CLASS (sym));
-
-  sal = find_function_start_sal (sym, 1);
+     Also, ada_exception_support_info_sniffer should have already
+     verified that SYM is a function symbol.  */
+  gdb_assert (sym != NULL);
+  gdb_assert (SYMBOL_CLASS (sym) == LOC_BLOCK);
 
   /* Set ADDR_STRING.  */
-
   *addr_string = xstrdup (sym_name);
 
-  /* Set the COND and COND_STRING (if not NULL).  */
-
-  if (cond_string != NULL && cond != NULL)
-    {
-      if (*cond_string != NULL)
-        {
-          xfree (*cond_string);
-          *cond_string = NULL;
-        }
-      if (*cond != NULL)
-        {
-          xfree (*cond);
-          *cond = NULL;
-        }
-      if (exp_string != NULL)
-        {
-          *cond_string = ada_exception_catchpoint_cond_string (exp_string);
-          *cond = ada_parse_catchpoint_condition (*cond_string, sal);
-        }
-    }
-
   /* Set OPS.  */
   *ops = ada_exception_breakpoint_ops (ex);
 
-  return sal;
+  return find_function_start_sal (sym, 1);
 }
 
 /* Parse the arguments (ARGS) of the "catch exception" command.
  
-   Set TYPE to the appropriate exception catchpoint type.
    If the user asked the catchpoint to catch only a specific
    exception, then save the exception name in ADDR_STRING.
 
+   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.
+
    See ada_exception_sal for a description of all the remaining
    function arguments of this function.  */
 
-struct symtab_and_line
+static struct symtab_and_line
 ada_decode_exception_location (char *args, char **addr_string,
-                               char **exp_string, char **cond_string,
-                               struct expression **cond,
-                               struct breakpoint_ops **ops)
+                               char **excep_string,
+                              char **cond_string,
+                               const struct breakpoint_ops **ops)
 {
   enum exception_catchpoint_kind ex;
 
-  catch_ada_exception_command_split (args, &ex, exp_string);
-  return ada_exception_sal (ex, *exp_string, addr_string, cond_string,
-                            cond, ops);
+  catch_ada_exception_command_split (args, &ex, excep_string, cond_string);
+  return ada_exception_sal (ex, *excep_string, addr_string, ops);
 }
 
-struct symtab_and_line
+/* Create an Ada exception catchpoint.  */
+
+static void
+create_ada_exception_catchpoint (struct gdbarch *gdbarch,
+                                struct symtab_and_line sal,
+                                char *addr_string,
+                                char *excep_string,
+                                char *cond_string,
+                                const struct breakpoint_ops *ops,
+                                int tempflag,
+                                int from_tty)
+{
+  struct ada_catchpoint *c;
+
+  c = XNEW (struct ada_catchpoint);
+  init_ada_exception_breakpoint (&c->base, gdbarch, sal, addr_string,
+                                ops, tempflag, from_tty);
+  c->excep_string = excep_string;
+  create_excep_cond_exprs (c);
+  if (cond_string != NULL)
+    set_breakpoint_condition (&c->base, cond_string, from_tty);
+  install_breakpoint (0, &c->base, 1);
+}
+
+/* Implement the "catch exception" command.  */
+
+static void
+catch_ada_exception_command (char *arg, int from_tty,
+                            struct cmd_list_element *command)
+{
+  struct gdbarch *gdbarch = get_current_arch ();
+  int tempflag;
+  struct symtab_and_line sal;
+  char *addr_string = NULL;
+  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);
+}
+
+/* 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.
+
+   Set ADDR_STRING to the name of the function where the real
+   breakpoint that implements the catchpoint is set.
+
+   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.  */
+
+static struct symtab_and_line
 ada_decode_assert_location (char *args, char **addr_string,
-                            struct breakpoint_ops **ops)
+                           char **cond_string,
+                            const struct breakpoint_ops **ops)
 {
-  /* Check that no argument where provided at the end of the command.  */
+  args = skip_spaces (args);
 
-  if (args != NULL)
+  /* Check whether a condition was provided.  */
+  if (strncmp (args, "if", 2) == 0
+      && (isspace (args[2]) || args[2] == '\0'))
     {
-      while (isspace (*args))
-        args++;
-      if (*args != '\0')
-        error (_("Junk at end of arguments."));
+      args += 2;
+      args = skip_spaces (args);
+      if (args[0] == '\0')
+        error (_("condition missing after `if' keyword"));
+      *cond_string = xstrdup (args);
     }
 
-  return ada_exception_sal (ex_catch_assert, NULL, addr_string, NULL, NULL,
-                            ops);
+  /* Otherwise, there should be no other argument at the end of
+     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.  */
+
+static void
+catch_assert_command (char *arg, int from_tty,
+                     struct cmd_list_element *command)
+{
+  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,
+                                  from_tty);
+}
                                 /* Operators */
 /* Information about operators given special treatment in functions
    below.  */
@@ -11845,6 +12425,18 @@ static const struct exp_descriptor ada_exp_descriptor = {
   ada_evaluate_subexp
 };
 
+/* Implement the "la_get_symbol_name_cmp" language_defn method
+   for Ada.  */
+
+static symbol_name_cmp_ftype
+ada_get_symbol_name_cmp (const char *lookup_name)
+{
+  if (should_use_wild_match (lookup_name))
+    return wild_match;
+  else
+    return compare_names;
+}
+
 const struct language_defn ada_language_defn = {
   "ada",                        /* Language name */
   language_ada,
@@ -11881,6 +12473,8 @@ const struct language_defn ada_language_defn = {
   ada_print_array_index,
   default_pass_by_reference,
   c_get_string,
+  ada_get_symbol_name_cmp,     /* la_get_symbol_name_cmp */
+  ada_iterate_over_symbols,
   LANG_MAGIC
 };
 
@@ -11909,11 +12503,54 @@ show_ada_command (char *args, int from_tty)
   cmd_show_list (show_ada_list, from_tty, "");
 }
 
+static void
+initialize_ada_catchpoint_ops (void)
+{
+  struct breakpoint_ops *ops;
+
+  initialize_breakpoint_ops ();
+
+  ops = &catch_exception_breakpoint_ops;
+  *ops = bkpt_breakpoint_ops;
+  ops->dtor = dtor_catch_exception;
+  ops->allocate_location = allocate_location_catch_exception;
+  ops->re_set = re_set_catch_exception;
+  ops->check_status = check_status_catch_exception;
+  ops->print_it = print_it_catch_exception;
+  ops->print_one = print_one_catch_exception;
+  ops->print_mention = print_mention_catch_exception;
+  ops->print_recreate = print_recreate_catch_exception;
+
+  ops = &catch_exception_unhandled_breakpoint_ops;
+  *ops = bkpt_breakpoint_ops;
+  ops->dtor = dtor_catch_exception_unhandled;
+  ops->allocate_location = allocate_location_catch_exception_unhandled;
+  ops->re_set = re_set_catch_exception_unhandled;
+  ops->check_status = check_status_catch_exception_unhandled;
+  ops->print_it = print_it_catch_exception_unhandled;
+  ops->print_one = print_one_catch_exception_unhandled;
+  ops->print_mention = print_mention_catch_exception_unhandled;
+  ops->print_recreate = print_recreate_catch_exception_unhandled;
+
+  ops = &catch_assert_breakpoint_ops;
+  *ops = bkpt_breakpoint_ops;
+  ops->dtor = dtor_catch_assert;
+  ops->allocate_location = allocate_location_catch_assert;
+  ops->re_set = re_set_catch_assert;
+  ops->check_status = check_status_catch_assert;
+  ops->print_it = print_it_catch_assert;
+  ops->print_one = print_one_catch_assert;
+  ops->print_mention = print_mention_catch_assert;
+  ops->print_recreate = print_recreate_catch_assert;
+}
+
 void
 _initialize_ada_language (void)
 {
   add_language (&ada_language_defn);
 
+  initialize_ada_catchpoint_ops ();
+
   add_prefix_cmd ("ada", no_class, set_ada_command,
                   _("Prefix command for changing Ada-specfic settings"),
                   &set_ada_list, "set ada ", 0, &setlist);
@@ -11936,6 +12573,21 @@ this incurs a slight performance penalty, so it is recommended to NOT change\n\
 this option to \"off\" unless necessary."),
                             NULL, NULL, &set_ada_list, &show_ada_list);
 
+  add_catch_command ("exception", _("\
+Catch Ada exceptions, when raised.\n\
+With an argument, catch only exceptions with the given name."),
+                    catch_ada_exception_command,
+                     NULL,
+                    CATCH_PERMANENT,
+                    CATCH_TEMPORARY);
+  add_catch_command ("assert", _("\
+Catch failed Ada assertions, when raised.\n\
+With an argument, catch only exceptions with the given name."),
+                    catch_assert_command,
+                     NULL,
+                    CATCH_PERMANENT,
+                    CATCH_TEMPORARY);
+
   varsize_limit = 65536;
 
   obstack_init (&symbol_list_obstack);
@@ -11944,8 +12596,6 @@ this option to \"off\" unless necessary."),
     (256, htab_hash_string, (int (*)(const void *, const void *)) streq,
      NULL, xcalloc, xfree);
 
-  observer_attach_executable_changed (ada_executable_changed_observer);
-
   /* Setup per-inferior data.  */
   observer_attach_inferior_exit (ada_inferior_exit);
   ada_inferior_data
This page took 0.102811 seconds and 4 git commands to generate.