* value.h (value_add, value_sub): Remove.
[deliverable/binutils-gdb.git] / gdb / ada-lang.c
index 44a3cc53167a38df3329aeda309583794d86e793..2142b16420605e41645fd665a5bf243e3c55912f 100644 (file)
@@ -55,6 +55,7 @@
 #include "valprint.h"
 #include "source.h"
 #include "observer.h"
+#include "vec.h"
 
 #ifndef ADA_RETAIN_DOTS
 #define ADA_RETAIN_DOTS 0
 #define TRUNCATION_TOWARDS_ZERO ((-5 / 2) == -2)
 #endif
 
-/* A structure that contains a vector of strings.
-   The main purpose of this type is to group the vector and its
-   associated parameters in one structure.  This makes it easier
-   to handle and pass around.
-   
-   brobecker/2008-02-04:  GDB does provide a generic VEC which should be
-   preferable.  But we are using the string_vector structure in the context
-   of symbol completion, and the current infrastructure is such that it's
-   more convenient to use the string vector for now.  It would become
-   advantageous to switch to VECs if the rest of the completion-related
-   code switches to VECs as well.  */
-
-struct string_vector
-{
-  char **array; /* The vector itself.  */
-  int index;    /* Index of the next available element in the array.  */
-  size_t size;  /* The number of entries allocated in the array.  */
-};
-
 static void extract_string (CORE_ADDR addr, char *buf);
 
 static void modify_general_field (char *, LONGEST, int, int);
@@ -133,13 +115,12 @@ static struct value *make_array_descriptor (struct type *, struct value *,
 
 static void ada_add_block_symbols (struct obstack *,
                                    struct block *, const char *,
-                                   domain_enum, struct objfile *,
-                                   struct symtab *, int);
+                                   domain_enum, struct objfile *, int);
 
 static int is_nonfunction (struct ada_symbol_info *, int);
 
 static void add_defn_to_vec (struct obstack *, struct symbol *,
-                             struct block *, struct symtab *);
+                             struct block *);
 
 static int num_defns_collected (struct obstack *);
 
@@ -225,6 +206,8 @@ static int equiv_types (struct type *, struct type *);
 
 static int is_name_suffix (const char *);
 
+static int is_digits_suffix (const char *str);
+
 static int wild_match (const char *, int, const char *);
 
 static struct value *ada_coerce_ref (struct value *);
@@ -334,34 +317,6 @@ static struct obstack symbol_list_obstack;
 
                         /* Utilities */
 
-/* Create a new empty string_vector struct with an initial size of
-   INITIAL_SIZE.  */
-
-static struct string_vector
-new_string_vector (int initial_size)
-{
-  struct string_vector result;
-
-  result.array = (char **) xmalloc ((initial_size + 1) * sizeof (char *));
-  result.index = 0;
-  result.size = initial_size;
-
-  return result;
-}
-
-/* Add STR at the end of the given string vector SV.  If SV is already
-   full, its size is automatically increased (doubled).  */
-
-static void
-string_vector_append (struct string_vector *sv, char *str)
-{
-  if (sv->index >= sv->size)
-    GROW_VECT (sv->array, sv->size, sv->size * 2);
-
-  sv->array[sv->index] = str;
-  sv->index++;
-}
-
 /* Given DECODED_NAME a string holding a symbol name in its
    decoded form (ie using the Ada dotted notation), returns
    its unqualified name.  */
@@ -668,39 +623,40 @@ min_of_type (struct type *t)
 }
 
 /* The largest value in the domain of TYPE, a discrete type, as an integer.  */
-static struct value *
+static LONGEST
 discrete_type_high_bound (struct type *type)
 {
   switch (TYPE_CODE (type))
     {
     case TYPE_CODE_RANGE:
-      return value_from_longest (TYPE_TARGET_TYPE (type),
-                                 TYPE_HIGH_BOUND (type));
+      return TYPE_HIGH_BOUND (type);
     case TYPE_CODE_ENUM:
-      return
-        value_from_longest (type,
-                            TYPE_FIELD_BITPOS (type,
-                                               TYPE_NFIELDS (type) - 1));
+      return TYPE_FIELD_BITPOS (type, TYPE_NFIELDS (type) - 1);
+    case TYPE_CODE_BOOL:
+      return 1;
+    case TYPE_CODE_CHAR:
     case TYPE_CODE_INT:
-      return value_from_longest (type, max_of_type (type));
+      return max_of_type (type);
     default:
       error (_("Unexpected type in discrete_type_high_bound."));
     }
 }
 
 /* The largest value in the domain of TYPE, a discrete type, as an integer.  */
-static struct value *
+static LONGEST
 discrete_type_low_bound (struct type *type)
 {
   switch (TYPE_CODE (type))
     {
     case TYPE_CODE_RANGE:
-      return value_from_longest (TYPE_TARGET_TYPE (type),
-                                 TYPE_LOW_BOUND (type));
+      return TYPE_LOW_BOUND (type);
     case TYPE_CODE_ENUM:
-      return value_from_longest (type, TYPE_FIELD_BITPOS (type, 0));
+      return TYPE_FIELD_BITPOS (type, 0);
+    case TYPE_CODE_BOOL:
+      return 0;
+    case TYPE_CODE_CHAR:
     case TYPE_CODE_INT:
-      return value_from_longest (type, min_of_type (type));
+      return min_of_type (type);
     default:
       error (_("Unexpected type in discrete_type_low_bound."));
     }
@@ -1249,22 +1205,11 @@ ada_decode_symbol (const struct general_symbol_info *gsymbol)
   if (*resultp == NULL)
     {
       const char *decoded = ada_decode (gsymbol->name);
-      if (gsymbol->bfd_section != NULL)
+      if (gsymbol->obj_section != NULL)
         {
-          bfd *obfd = gsymbol->bfd_section->owner;
-          if (obfd != NULL)
-            {
-              struct objfile *objf;
-              ALL_OBJFILES (objf)
-              {
-                if (obfd == objf->obfd)
-                  {
-                    *resultp = obsavestring (decoded, strlen (decoded),
-                                             &objf->objfile_obstack);
-                    break;
-                  }
-              }
-            }
+         struct objfile *objf = gsymbol->obj_section->objfile;
+         *resultp = obsavestring (decoded, strlen (decoded),
+                                  &objf->objfile_obstack);
         }
       /* Sometimes, we can't find a corresponding objfile, in which
          case, we put the result on the heap.  Since we only decode
@@ -1875,7 +1820,7 @@ packed_array_type (struct type *type, long *elt_bits)
         (*elt_bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT;
     }
 
-  TYPE_FLAGS (new_type) |= TYPE_FLAG_FIXED_INSTANCE;
+  TYPE_FIXED_INSTANCE (new_type) = 1;
   return new_type;
 }
 
@@ -2085,7 +2030,7 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
       v = allocate_value (type);
       bytes = (unsigned char *) (valaddr + offset);
     }
-  else if (value_lazy (obj))
+  else if (VALUE_LVAL (obj) == lval_memory && value_lazy (obj))
     {
       v = value_at (type,
                     VALUE_ADDRESS (obj) + value_offset (obj) + offset);
@@ -2299,6 +2244,7 @@ ada_value_assign (struct value *toval, struct value *fromval)
     {
       int len = (value_bitpos (toval)
                 + bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT;
+      int from_size;
       char *buffer = (char *) alloca (len);
       struct value *val;
       CORE_ADDR to_addr = VALUE_ADDRESS (toval) + value_offset (toval);
@@ -2307,11 +2253,12 @@ ada_value_assign (struct value *toval, struct value *fromval)
         fromval = value_cast (type, fromval);
 
       read_memory (to_addr, buffer, len);
+      from_size = value_bitsize (fromval);
+      if (from_size == 0)
+       from_size = TYPE_LENGTH (value_type (fromval)) * TARGET_CHAR_BIT;
       if (gdbarch_bits_big_endian (current_gdbarch))
         move_bits (buffer, value_bitpos (toval),
-                   value_contents (fromval),
-                   TYPE_LENGTH (value_type (fromval)) * TARGET_CHAR_BIT -
-                   bits, bits);
+                  value_contents (fromval), from_size - bits, bits);
       else
         move_bits (buffer, value_bitpos (toval), value_contents (fromval),
                    0, bits);
@@ -2415,8 +2362,10 @@ ada_value_ptr_subscript (struct value *arr, struct type *type, int arity,
       get_discrete_bounds (TYPE_INDEX_TYPE (type), &lwb, &upb);
       idx = value_pos_atr (ind[k]);
       if (lwb != 0)
-        idx = value_sub (idx, value_from_longest (builtin_type_int, lwb));
-      arr = value_add (arr, idx);
+       idx = value_binop (idx, value_from_longest (value_type (idx), lwb),
+                          BINOP_SUB);
+
+      arr = value_ptradd (arr, idx);
       type = TYPE_TARGET_TYPE (type);
     }
 
@@ -2676,7 +2625,7 @@ ada_array_length (struct value *arr, int n)
     }
   else
     return
-      value_from_longest (builtin_type_int,
+      value_from_longest (builtin_type_int32,
                           value_as_long (desc_one_bound (desc_bounds (arr),
                                                          n, 1))
                           - value_as_long (desc_one_bound (desc_bounds (arr),
@@ -2937,14 +2886,9 @@ resolve_subexp (struct expression **expp, int *pos, int deprocedure_p,
                   case LOC_REGISTER:
                   case LOC_ARG:
                   case LOC_REF_ARG:
-                  case LOC_REGPARM:
                   case LOC_REGPARM_ADDR:
                   case LOC_LOCAL:
-                  case LOC_LOCAL_ARG:
-                  case LOC_BASEREG:
-                  case LOC_BASEREG_ARG:
                   case LOC_COMPUTED:
-                  case LOC_COMPUTED_ARG:
                     goto FoundNonType;
                   default:
                     break;
@@ -3358,12 +3302,24 @@ user_select_syms (struct ada_symbol_info *syms, int nsyms, int max_results)
   int *chosen = (int *) alloca (sizeof (int) * nsyms);
   int n_chosen;
   int first_choice = (max_results == 1) ? 1 : 2;
+  const char *select_mode = multiple_symbols_select_mode ();
 
   if (max_results < 1)
     error (_("Request to select 0 symbols!"));
   if (nsyms <= 1)
     return nsyms;
 
+  if (select_mode == multiple_symbols_cancel)
+    error (_("\
+canceled because the command is ambiguous\n\
+See set/show multiple-symbol."));
+  
+  /* If select_mode is "all", then return all possible symbols.
+     Only do that if more than one symbol can be selected, of course.
+     Otherwise, display the menu as usual.  */
+  if (select_mode == multiple_symbols_all && max_results > 1)
+    return nsyms;
+
   printf_unfiltered (_("[0] cancel\n"));
   if (max_results > 1)
     printf_unfiltered (_("[1] all\n"));
@@ -3458,18 +3414,15 @@ get_selections (int *choices, int n_choices, int max_results,
                 int is_all_choice, char *annotation_suffix)
 {
   char *args;
-  const char *prompt;
+  char *prompt;
   int n_chosen;
   int first_choice = is_all_choice ? 2 : 1;
 
   prompt = getenv ("PS2");
   if (prompt == NULL)
-    prompt = ">";
-
-  printf_unfiltered (("%s "), prompt);
-  gdb_flush (gdb_stdout);
+    prompt = "> ";
 
-  args = command_line_input ((char *) NULL, 0, annotation_suffix);
+  args = command_line_input (prompt, 0, annotation_suffix);
 
   if (args == NULL)
     error_no_arg (_("one or more choice numbers"));
@@ -4013,15 +3966,14 @@ make_array_descriptor (struct type *type, struct value *arr, CORE_ADDR *sp)
 
 static int
 lookup_cached_symbol (const char *name, domain_enum namespace,
-                      struct symbol **sym, struct block **block,
-                      struct symtab **symtab)
+                      struct symbol **sym, struct block **block)
 {
   return 0;
 }
 
 static void
 cache_symbol (const char *name, domain_enum namespace, struct symbol *sym,
-              struct block *block, struct symtab *symtab)
+              struct block *block)
 {
 }
 \f
@@ -4035,13 +3987,11 @@ standard_lookup (const char *name, const struct block *block,
                  domain_enum domain)
 {
   struct symbol *sym;
-  struct symtab *symtab;
 
-  if (lookup_cached_symbol (name, domain, &sym, NULL, NULL))
+  if (lookup_cached_symbol (name, domain, &sym, NULL))
     return sym;
-  sym =
-    lookup_symbol_in_language (name, block, domain, language_c, 0, &symtab);
-  cache_symbol (name, domain, sym, block_found, symtab);
+  sym = lookup_symbol_in_language (name, block, domain, language_c, 0);
+  cache_symbol (name, domain, sym, block_found);
   return sym;
 }
 
@@ -4126,7 +4076,7 @@ lesseq_defined_than (struct symbol *sym0, struct symbol *sym1)
 static void
 add_defn_to_vec (struct obstack *obstackp,
                  struct symbol *sym,
-                 struct block *block, struct symtab *symtab)
+                 struct block *block)
 {
   int i;
   size_t tmp;
@@ -4149,7 +4099,6 @@ add_defn_to_vec (struct obstack *obstackp,
         {
           prevDefns[i].sym = sym;
           prevDefns[i].block = block;
-          prevDefns[i].symtab = symtab;
           return;
         }
     }
@@ -4159,7 +4108,6 @@ add_defn_to_vec (struct obstack *obstackp,
 
     info.sym = sym;
     info.block = block;
-    info.symtab = symtab;
     obstack_grow (obstackp, &info, sizeof (struct ada_symbol_info));
   }
 }
@@ -4214,7 +4162,8 @@ ada_lookup_partial_symbol (struct partial_symtab *pst, const char *name,
         {
           struct partial_symbol *psym = start[i];
 
-          if (SYMBOL_DOMAIN (psym) == namespace
+          if (symbol_matches_domain (SYMBOL_LANGUAGE (psym),
+                                     SYMBOL_DOMAIN (psym), namespace)
               && wild_match (name, name_len, SYMBOL_LINKAGE_NAME (psym)))
             return psym;
         }
@@ -4248,7 +4197,8 @@ ada_lookup_partial_symbol (struct partial_symtab *pst, const char *name,
         {
           struct partial_symbol *psym = start[i];
 
-          if (SYMBOL_DOMAIN (psym) == namespace)
+          if (symbol_matches_domain (SYMBOL_LANGUAGE (psym),
+                                     SYMBOL_DOMAIN (psym), namespace))
             {
               int cmp = strncmp (name, SYMBOL_LINKAGE_NAME (psym), name_len);
 
@@ -4291,7 +4241,8 @@ ada_lookup_partial_symbol (struct partial_symtab *pst, const char *name,
         {
           struct partial_symbol *psym = start[i];
 
-          if (SYMBOL_DOMAIN (psym) == namespace)
+          if (symbol_matches_domain (SYMBOL_LANGUAGE (psym),
+                                     SYMBOL_DOMAIN (psym), namespace))
             {
               int cmp;
 
@@ -4358,15 +4309,10 @@ symtab_for_sym (struct symbol *sym)
       case LOC_REGISTER:
       case LOC_ARG:
       case LOC_REF_ARG:
-      case LOC_REGPARM:
       case LOC_REGPARM_ADDR:
       case LOC_LOCAL:
       case LOC_TYPEDEF:
-      case LOC_LOCAL_ARG:
-      case LOC_BASEREG:
-      case LOC_BASEREG_ARG:
       case LOC_COMPUTED:
-      case LOC_COMPUTED_ARG:
         for (j = FIRST_LOCAL_BLOCK;
              j < BLOCKVECTOR_NBLOCKS (BLOCKVECTOR (s)); j += 1)
           {
@@ -4673,7 +4619,7 @@ remove_irrelevant_renamings (struct ada_symbol_info *syms,
   if (current_block == NULL)
     return nsyms;
 
-  current_function = block_function (current_block);
+  current_function = block_linkage_function (current_block);
   if (current_function == NULL)
     return nsyms;
 
@@ -4706,7 +4652,7 @@ remove_irrelevant_renamings (struct ada_symbol_info *syms,
 
 /* Find symbols in DOMAIN matching NAME0, in BLOCK0 and enclosing
    scope and in global scopes, returning the number of matches.  Sets
-   *RESULTS to point to a vector of (SYM,BLOCK,SYMTAB) triples,
+   *RESULTS to point to a vector of (SYM,BLOCK) tuples,
    indicating the symbols found and the blocks and symbol tables (if
    any) in which they were found.  This vector are transient---good only to 
    the next call of ada_lookup_symbol_list.  Any non-function/non-enumeral 
@@ -4760,7 +4706,7 @@ ada_lookup_symbol_list (const char *name0, const struct block *block0,
     {
       block_depth += 1;
       ada_add_block_symbols (&symbol_list_obstack, block, name,
-                             namespace, NULL, NULL, wild_match);
+                             namespace, NULL, wild_match);
 
       /* If we found a non-function match, assume that's the one.  */
       if (is_nonfunction (defns_collected (&symbol_list_obstack, 0),
@@ -4782,10 +4728,10 @@ ada_lookup_symbol_list (const char *name0, const struct block *block0,
     goto done;
 
   cacheIfUnique = 1;
-  if (lookup_cached_symbol (name0, namespace, &sym, &block, &s))
+  if (lookup_cached_symbol (name0, namespace, &sym, &block))
     {
       if (sym != NULL)
-        add_defn_to_vec (&symbol_list_obstack, sym, block, s);
+        add_defn_to_vec (&symbol_list_obstack, sym, block);
       goto done;
     }
 
@@ -4798,7 +4744,7 @@ ada_lookup_symbol_list (const char *name0, const struct block *block0,
     bv = BLOCKVECTOR (s);
     block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
     ada_add_block_symbols (&symbol_list_obstack, block, name, namespace,
-                           objfile, s, wild_match);
+                           objfile, wild_match);
   }
 
   if (namespace == VAR_DOMAIN)
@@ -4816,20 +4762,32 @@ ada_lookup_symbol_list (const char *name0, const struct block *block0,
                 if (s != NULL)
                   {
                     int ndefns0 = num_defns_collected (&symbol_list_obstack);
+                   char *raw_name = SYMBOL_LINKAGE_NAME (msymbol);
+                   char *name1;
+                   const char *suffix;
                     QUIT;
+                   suffix = strrchr (raw_name, '.');
+                   if (suffix == NULL)
+                     suffix = strrchr (raw_name, '$');
+                   if (suffix != NULL && is_digits_suffix (suffix + 1))
+                     {
+                       name1 = alloca (suffix - raw_name + 1);
+                       strncpy (name1, raw_name, suffix - raw_name);
+                       name1[suffix - raw_name] = '\0';
+                     }
+                   else
+                     name1 = raw_name;
+                       
                     bv = BLOCKVECTOR (s);
                     block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
                     ada_add_block_symbols (&symbol_list_obstack, block,
-                                           SYMBOL_LINKAGE_NAME (msymbol),
-                                           namespace, objfile, s, wild_match);
+                                           name1, namespace, objfile, 0);
 
                     if (num_defns_collected (&symbol_list_obstack) == ndefns0)
                       {
                         block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
                         ada_add_block_symbols (&symbol_list_obstack, block,
-                                               SYMBOL_LINKAGE_NAME (msymbol),
-                                               namespace, objfile, s,
-                                               wild_match);
+                                               name1, namespace, objfile, 0);
                       }
                   }
               }
@@ -4849,7 +4807,7 @@ ada_lookup_symbol_list (const char *name0, const struct block *block0,
         bv = BLOCKVECTOR (s);
         block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
         ada_add_block_symbols (&symbol_list_obstack, block, name,
-                               namespace, objfile, s, wild_match);
+                               namespace, objfile, wild_match);
       }
   }
 
@@ -4866,7 +4824,7 @@ ada_lookup_symbol_list (const char *name0, const struct block *block0,
         bv = BLOCKVECTOR (s);
         block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
         ada_add_block_symbols (&symbol_list_obstack, block, name, namespace,
-                               objfile, s, wild_match);
+                               objfile, wild_match);
       }
 
       ALL_PSYMTABS (objfile, ps)
@@ -4881,7 +4839,7 @@ ada_lookup_symbol_list (const char *name0, const struct block *block0,
               continue;
             block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
             ada_add_block_symbols (&symbol_list_obstack, block, name,
-                                   namespace, objfile, s, wild_match);
+                                   namespace, objfile, wild_match);
           }
       }
     }
@@ -4893,11 +4851,10 @@ done:
   ndefns = remove_extra_symbols (*results, ndefns);
 
   if (ndefns == 0)
-    cache_symbol (name0, namespace, NULL, NULL, NULL);
+    cache_symbol (name0, namespace, NULL, NULL);
 
   if (ndefns == 1 && cacheIfUnique)
-    cache_symbol (name0, namespace, (*results)[0].sym, (*results)[0].block,
-                  (*results)[0].symtab);
+    cache_symbol (name0, namespace, (*results)[0].sym, (*results)[0].block);
 
   ndefns = remove_irrelevant_renamings (*results, ndefns, block0);
 
@@ -4906,8 +4863,7 @@ done:
 
 struct symbol *
 ada_lookup_encoded_symbol (const char *name, const struct block *block0,
-                          domain_enum namespace, 
-                          struct block **block_found, struct symtab **symtab)
+                          domain_enum namespace, struct block **block_found)
 {
   struct ada_symbol_info *candidates;
   int n_candidates;
@@ -4920,40 +4876,7 @@ ada_lookup_encoded_symbol (const char *name, const struct block *block0,
   if (block_found != NULL)
     *block_found = candidates[0].block;
 
-  if (symtab != NULL)
-    {
-      *symtab = candidates[0].symtab;
-      if (*symtab == NULL && candidates[0].block != NULL)
-        {
-          struct objfile *objfile;
-          struct symtab *s;
-          struct block *b;
-          struct blockvector *bv;
-
-          /* Search the list of symtabs for one which contains the
-             address of the start of this block.  */
-          ALL_PRIMARY_SYMTABS (objfile, s)
-          {
-            bv = BLOCKVECTOR (s);
-            b = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
-            if (BLOCK_START (b) <= BLOCK_START (candidates[0].block)
-                && BLOCK_END (b) > BLOCK_START (candidates[0].block))
-              {
-                *symtab = s;
-                return fixup_symbol_section (candidates[0].sym, objfile);
-              }
-          }
-          /* FIXME: brobecker/2004-11-12: I think that we should never
-             reach this point.  I don't see a reason why we would not
-             find a symtab for a given block, so I suggest raising an
-             internal_error exception here.  Otherwise, we end up
-             returning a symbol but no symtab, which certain parts of
-             the code that rely (indirectly) on this function do not
-             expect, eventually causing a SEGV.  */
-          return fixup_symbol_section (candidates[0].sym, NULL);
-        }
-    }
-  return candidates[0].sym;
+  return fixup_symbol_section (candidates[0].sym, NULL);
 }  
 
 /* Return a symbol in DOMAIN matching NAME, in BLOCK0 and enclosing
@@ -4965,34 +4888,33 @@ ada_lookup_encoded_symbol (const char *name, const struct block *block0,
    assignments occur only if the pointers are non-null).  */
 struct symbol *
 ada_lookup_symbol (const char *name, const struct block *block0,
-                   domain_enum namespace, int *is_a_field_of_this,
-                   struct symtab **symtab)
+                   domain_enum namespace, int *is_a_field_of_this)
 {
   if (is_a_field_of_this != NULL)
     *is_a_field_of_this = 0;
 
   return
     ada_lookup_encoded_symbol (ada_encode (ada_fold_name (name)),
-                              block0, namespace, NULL, symtab);
+                              block0, namespace, NULL);
 }
 
 static struct symbol *
 ada_lookup_symbol_nonlocal (const char *name,
                             const char *linkage_name,
                             const struct block *block,
-                            const domain_enum domain, struct symtab **symtab)
+                            const domain_enum domain)
 {
   if (linkage_name == NULL)
     linkage_name = name;
   return ada_lookup_symbol (linkage_name, block_static_block (block), domain,
-                            NULL, symtab);
+                            NULL);
 }
 
 
 /* True iff STR is a possible encoded suffix of a normal Ada name
    that is to be ignored for matching purposes.  Suffixes of parallel
    names (e.g., XVE) are not included here.  Currently, the possible suffixes
-   are given by either of the regular expression:
+   are given by any of the regular expressions:
 
    [.$][0-9]+       [nested subprogram suffix, on platforms such as GNU/Linux]
    ___[0-9]+        [nested subprogram suffix, on platforms such as HP/UX]
@@ -5129,24 +5051,12 @@ is_name_suffix (const char *str)
   return 0;
 }
 
-/* Return nonzero if the given string starts with a dot ('.')
-   followed by zero or more digits.  
-   
-   Note: brobecker/2003-11-10: A forward declaration has not been
-   added at the begining of this file yet, because this function
-   is only used to work around a problem found during wild matching
-   when trying to match minimal symbol names against symbol names
-   obtained from dwarf-2 data.  This function is therefore currently
-   only used in wild_match() and is likely to be deleted when the
-   problem in dwarf-2 is fixed.  */
+/* Return nonzero if the given string contains only digits.
+   The empty string also matches.  */
 
 static int
-is_dot_digits_suffix (const char *str)
+is_digits_suffix (const char *str)
 {
-  if (str[0] != '.')
-    return 0;
-
-  str++;
   while (isdigit (str[0]))
     str++;
   return (str[0] == '\0');
@@ -5161,6 +5071,12 @@ is_valid_name_for_wild_match (const char *name0)
   const char *decoded_name = ada_decode (name0);
   int i;
 
+  /* If the decoded name starts with an angle bracket, it means that
+     NAME0 does not follow the GNAT encoding format.  It should then
+     not be allowed as a possible wild match.  */
+  if (decoded_name[0] == '<')
+    return 0;
+
   for (i=0; decoded_name[i] != '\0'; i++)
     if (isalpha (decoded_name[i]) && !islower (decoded_name[i]))
       return 0;
@@ -5176,91 +5092,22 @@ is_valid_name_for_wild_match (const char *name0)
 static int
 wild_match (const char *patn0, int patn_len, const char *name0)
 {
-  int name_len;
-  char *name;
-  char *name_start;
-  char *patn;
-
-  /* FIXME: brobecker/2003-11-10: For some reason, the symbol name
-     stored in the symbol table for nested function names is sometimes
-     different from the name of the associated entity stored in
-     the dwarf-2 data: This is the case for nested subprograms, where
-     the minimal symbol name contains a trailing ".[:digit:]+" suffix,
-     while the symbol name from the dwarf-2 data does not.
-
-     Although the DWARF-2 standard documents that entity names stored
-     in the dwarf-2 data should be identical to the name as seen in
-     the source code, GNAT takes a different approach as we already use
-     a special encoding mechanism to convey the information so that
-     a C debugger can still use the information generated to debug
-     Ada programs.  A corollary is that the symbol names in the dwarf-2
-     data should match the names found in the symbol table.  I therefore
-     consider this issue as a compiler defect.
-
-     Until the compiler is properly fixed, we work-around the problem
-     by ignoring such suffixes during the match.  We do so by making
-     a copy of PATN0 and NAME0, and then by stripping such a suffix
-     if present.  We then perform the match on the resulting strings.  */
-  {
-    char *dot;
-    name_len = strlen (name0);
-
-    name = name_start = (char *) alloca ((name_len + 1) * sizeof (char));
-    strcpy (name, name0);
-    dot = strrchr (name, '.');
-    if (dot != NULL && is_dot_digits_suffix (dot))
-      *dot = '\0';
-
-    patn = (char *) alloca ((patn_len + 1) * sizeof (char));
-    strncpy (patn, patn0, patn_len);
-    patn[patn_len] = '\0';
-    dot = strrchr (patn, '.');
-    if (dot != NULL && is_dot_digits_suffix (dot))
-      {
-        *dot = '\0';
-        patn_len = dot - patn;
-      }
-  }
-
-  /* Now perform the wild match.  */
-
-  name_len = strlen (name);
-  if (name_len >= patn_len + 5 && strncmp (name, "_ada_", 5) == 0
-      && strncmp (patn, name + 5, patn_len) == 0
-      && is_name_suffix (name + patn_len + 5))
-    return 1;
-
-  while (name_len >= patn_len)
+  char* match;
+  const char* start;
+  start = name0;
+  while (1)
     {
-      if (strncmp (patn, name, patn_len) == 0
-          && is_name_suffix (name + patn_len))
-        return (name == name_start || is_valid_name_for_wild_match (name0));
-      do
-        {
-          name += 1;
-          name_len -= 1;
-        }
-      while (name_len > 0
-             && name[0] != '.' && (name[0] != '_' || name[1] != '_'));
-      if (name_len <= 0)
-        return 0;
-      if (name[0] == '_')
-        {
-          if (!islower (name[2]))
-            return 0;
-          name += 2;
-          name_len -= 2;
-        }
-      else
-        {
-          if (!islower (name[1]))
-            return 0;
-          name += 1;
-          name_len -= 1;
-        }
+      match = strstr (start, patn0);
+      if (match == NULL)
+       return 0;
+      if ((match == name0 
+          || match[-1] == '.' 
+          || (match > name0 + 1 && match[-1] == '_' && match[-2] == '_')
+          || (match == name0 + 5 && strncmp ("_ada_", name0, 5) == 0))
+          && is_name_suffix (match + patn_len))
+        return (match == name0 || is_valid_name_for_wild_match (name0));
+      start = match + 1;
     }
-
-  return 0;
 }
 
 
@@ -5274,7 +5121,7 @@ static void
 ada_add_block_symbols (struct obstack *obstackp,
                        struct block *block, const char *name,
                        domain_enum domain, struct objfile *objfile,
-                       struct symtab *symtab, int wild)
+                       int wild)
 {
   struct dict_iterator iter;
   int name_len = strlen (name);
@@ -5291,28 +5138,20 @@ ada_add_block_symbols (struct obstack *obstackp,
       struct symbol *sym;
       ALL_BLOCK_SYMBOLS (block, iter, sym)
       {
-        if (SYMBOL_DOMAIN (sym) == domain
+        if (symbol_matches_domain (SYMBOL_LANGUAGE (sym),
+                                   SYMBOL_DOMAIN (sym), domain)
             && wild_match (name, name_len, SYMBOL_LINKAGE_NAME (sym)))
           {
-            switch (SYMBOL_CLASS (sym))
-              {
-              case LOC_ARG:
-              case LOC_LOCAL_ARG:
-              case LOC_REF_ARG:
-              case LOC_REGPARM:
-              case LOC_REGPARM_ADDR:
-              case LOC_BASEREG_ARG:
-              case LOC_COMPUTED_ARG:
-                arg_sym = sym;
-                break;
-              case LOC_UNRESOLVED:
-                continue;
-              default:
+           if (SYMBOL_CLASS (sym) == LOC_UNRESOLVED)
+             continue;
+           else if (SYMBOL_IS_ARGUMENT (sym))
+             arg_sym = sym;
+           else
+             {
                 found_sym = 1;
                 add_defn_to_vec (obstackp,
                                  fixup_symbol_section (sym, objfile),
-                                 block, symtab);
-                break;
+                                 block);
               }
           }
       }
@@ -5321,32 +5160,25 @@ ada_add_block_symbols (struct obstack *obstackp,
     {
       ALL_BLOCK_SYMBOLS (block, iter, sym)
       {
-        if (SYMBOL_DOMAIN (sym) == domain)
+        if (symbol_matches_domain (SYMBOL_LANGUAGE (sym),
+                                   SYMBOL_DOMAIN (sym), domain))
           {
             int cmp = strncmp (name, SYMBOL_LINKAGE_NAME (sym), name_len);
             if (cmp == 0
                 && is_name_suffix (SYMBOL_LINKAGE_NAME (sym) + name_len))
               {
-                switch (SYMBOL_CLASS (sym))
-                  {
-                  case LOC_ARG:
-                  case LOC_LOCAL_ARG:
-                  case LOC_REF_ARG:
-                  case LOC_REGPARM:
-                  case LOC_REGPARM_ADDR:
-                  case LOC_BASEREG_ARG:
-                  case LOC_COMPUTED_ARG:
-                    arg_sym = sym;
-                    break;
-                  case LOC_UNRESOLVED:
-                    break;
-                  default:
-                    found_sym = 1;
-                    add_defn_to_vec (obstackp,
-                                     fixup_symbol_section (sym, objfile),
-                                     block, symtab);
-                    break;
-                  }
+               if (SYMBOL_CLASS (sym) != LOC_UNRESOLVED)
+                 {
+                   if (SYMBOL_IS_ARGUMENT (sym))
+                     arg_sym = sym;
+                   else
+                     {
+                       found_sym = 1;
+                       add_defn_to_vec (obstackp,
+                                        fixup_symbol_section (sym, objfile),
+                                        block);
+                     }
+                 }
               }
           }
       }
@@ -5356,7 +5188,7 @@ ada_add_block_symbols (struct obstack *obstackp,
     {
       add_defn_to_vec (obstackp,
                        fixup_symbol_section (arg_sym, objfile),
-                       block, symtab);
+                       block);
     }
 
   if (!wild)
@@ -5366,7 +5198,8 @@ ada_add_block_symbols (struct obstack *obstackp,
 
       ALL_BLOCK_SYMBOLS (block, iter, sym)
       {
-        if (SYMBOL_DOMAIN (sym) == domain)
+        if (symbol_matches_domain (SYMBOL_LANGUAGE (sym),
+                                   SYMBOL_DOMAIN (sym), domain))
           {
             int cmp;
 
@@ -5382,26 +5215,18 @@ ada_add_block_symbols (struct obstack *obstackp,
             if (cmp == 0
                 && is_name_suffix (SYMBOL_LINKAGE_NAME (sym) + name_len + 5))
               {
-                switch (SYMBOL_CLASS (sym))
-                  {
-                  case LOC_ARG:
-                  case LOC_LOCAL_ARG:
-                  case LOC_REF_ARG:
-                  case LOC_REGPARM:
-                  case LOC_REGPARM_ADDR:
-                  case LOC_BASEREG_ARG:
-                  case LOC_COMPUTED_ARG:
-                    arg_sym = sym;
-                    break;
-                  case LOC_UNRESOLVED:
-                    break;
-                  default:
-                    found_sym = 1;
-                    add_defn_to_vec (obstackp,
-                                     fixup_symbol_section (sym, objfile),
-                                     block, symtab);
-                    break;
-                  }
+               if (SYMBOL_CLASS (sym) != LOC_UNRESOLVED)
+                 {
+                   if (SYMBOL_IS_ARGUMENT (sym))
+                     arg_sym = sym;
+                   else
+                     {
+                       found_sym = 1;
+                       add_defn_to_vec (obstackp,
+                                        fixup_symbol_section (sym, objfile),
+                                        block);
+                     }
+                 }
               }
           }
       }
@@ -5412,7 +5237,7 @@ ada_add_block_symbols (struct obstack *obstackp,
         {
           add_defn_to_vec (obstackp,
                            fixup_symbol_section (arg_sym, objfile),
-                           block, symtab);
+                           block);
         }
     }
 }
@@ -5506,6 +5331,9 @@ symbol_completion_match (const char *sym_name,
   return sym_name;
 }
 
+typedef char *char_ptr;
+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
@@ -5522,7 +5350,7 @@ symbol_completion_match (const char *sym_name,
    encoded).  */
 
 static void
-symbol_completion_add (struct string_vector *sv,
+symbol_completion_add (VEC(char_ptr) **sv,
                        const char *sym_name,
                        const char *text, int text_len,
                        const char *orig_text, const char *word,
@@ -5558,7 +5386,7 @@ symbol_completion_add (struct string_vector *sv,
       strcat (completion, match);
     }
 
-  string_vector_append (sv, completion);
+  VEC_safe_push (char_ptr, *sv, completion);
 }
 
 /* Return a list of possible symbol names completing TEXT0.  The list
@@ -5572,7 +5400,7 @@ ada_make_symbol_completion_list (char *text0, char *word)
   int text_len;
   int wild_match;
   int encoded;
-  struct string_vector result = new_string_vector (128);
+  VEC(char_ptr) *completions = VEC_alloc (char_ptr, 128);
   struct symbol *sym;
   struct symtab *s;
   struct partial_symtab *ps;
@@ -5621,7 +5449,7 @@ ada_make_symbol_completion_list (char *text0, char *word)
                  + ps->n_global_syms); psym++)
       {
         QUIT;
-        symbol_completion_add (&result, SYMBOL_LINKAGE_NAME (*psym),
+        symbol_completion_add (&completions, SYMBOL_LINKAGE_NAME (*psym),
                                text, text_len, text0, word,
                                wild_match, encoded);
       }
@@ -5631,7 +5459,7 @@ ada_make_symbol_completion_list (char *text0, char *word)
                  + ps->n_static_syms); psym++)
       {
         QUIT;
-        symbol_completion_add (&result, SYMBOL_LINKAGE_NAME (*psym),
+        symbol_completion_add (&completions, SYMBOL_LINKAGE_NAME (*psym),
                                text, text_len, text0, word,
                                wild_match, encoded);
       }
@@ -5645,7 +5473,7 @@ ada_make_symbol_completion_list (char *text0, char *word)
   ALL_MSYMBOLS (objfile, msymbol)
   {
     QUIT;
-    symbol_completion_add (&result, SYMBOL_LINKAGE_NAME (msymbol),
+    symbol_completion_add (&completions, SYMBOL_LINKAGE_NAME (msymbol),
                            text, text_len, text0, word, wild_match, encoded);
   }
 
@@ -5659,7 +5487,7 @@ ada_make_symbol_completion_list (char *text0, char *word)
 
       ALL_BLOCK_SYMBOLS (b, iter, sym)
       {
-        symbol_completion_add (&result, SYMBOL_LINKAGE_NAME (sym),
+        symbol_completion_add (&completions, SYMBOL_LINKAGE_NAME (sym),
                                text, text_len, text0, word,
                                wild_match, encoded);
       }
@@ -5674,7 +5502,7 @@ ada_make_symbol_completion_list (char *text0, char *word)
     b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), GLOBAL_BLOCK);
     ALL_BLOCK_SYMBOLS (b, iter, sym)
     {
-      symbol_completion_add (&result, SYMBOL_LINKAGE_NAME (sym),
+      symbol_completion_add (&completions, SYMBOL_LINKAGE_NAME (sym),
                              text, text_len, text0, word,
                              wild_match, encoded);
     }
@@ -5689,16 +5517,30 @@ ada_make_symbol_completion_list (char *text0, char *word)
       continue;
     ALL_BLOCK_SYMBOLS (b, iter, sym)
     {
-      symbol_completion_add (&result, SYMBOL_LINKAGE_NAME (sym),
+      symbol_completion_add (&completions, SYMBOL_LINKAGE_NAME (sym),
                              text, text_len, text0, word,
                              wild_match, encoded);
     }
   }
 
   /* Append the closing NULL entry.  */
-  string_vector_append (&result, NULL);
+  VEC_safe_push (char_ptr, completions, NULL);
 
-  return (result.array);
+  /* Make a copy of the COMPLETIONS VEC before we free it, and then
+     return the copy.  It's unfortunate that we have to make a copy
+     of an array that we're about to destroy, but there is nothing much
+     we can do about it.  Fortunately, it's typically not a very large
+     array.  */
+  {
+    const size_t completions_size = 
+      VEC_length (char_ptr, completions) * sizeof (char *);
+    char **result = malloc (completions_size);
+    
+    memcpy (result, VEC_address (char_ptr, completions), completions_size);
+
+    VEC_free (char_ptr, completions);
+    return result;
+  }
 }
 
                                 /* Field Access */
@@ -5886,7 +5728,8 @@ ada_tag_name_2 (struct tag_args *args)
   valp = value_cast (info_type, args->tag);
   if (valp == NULL)
     return 0;
-  val = value_ind (value_add (valp, value_from_longest (builtin_type_int, -1)));
+  val = value_ind (value_ptradd (valp,
+                                value_from_longest (builtin_type_int8, -1)));
   if (val == NULL)
     return 0;
   val = ada_value_struct_elt (val, "expanded_name", 1);
@@ -5929,7 +5772,17 @@ ada_parent_type (struct type *type)
 
   for (i = 0; i < TYPE_NFIELDS (type); i += 1)
     if (ada_is_parent_field (type, i))
-      return ada_check_typedef (TYPE_FIELD_TYPE (type, i));
+      {
+        struct type *parent_type = TYPE_FIELD_TYPE (type, i);
+
+        /* If the _parent field is a pointer, then dereference it.  */
+        if (TYPE_CODE (parent_type) == TYPE_CODE_PTR)
+          parent_type = TYPE_TARGET_TYPE (parent_type);
+        /* If there is a parallel XVS type, get the actual base type.  */
+        parent_type = ada_get_base_type (parent_type);
+
+        return ada_check_typedef (parent_type);
+      }
 
   return NULL;
 }
@@ -6810,7 +6663,7 @@ ada_find_renaming_symbol (const char *name, struct block *block)
 static struct symbol *
 find_old_style_renaming_symbol (const char *name, struct block *block)
 {
-  const struct symbol *function_sym = block_function (block);
+  const struct symbol *function_sym = block_linkage_function (block);
   char *rename;
 
   if (function_sym != NULL)
@@ -6990,7 +6843,6 @@ empty_record (struct objfile *objfile)
   TYPE_FIELDS (type) = NULL;
   TYPE_NAME (type) = "<empty>";
   TYPE_TAG_NAME (type) = NULL;
-  TYPE_FLAGS (type) = 0;
   TYPE_LENGTH (type) = 0;
   return type;
 }
@@ -7050,7 +6902,7 @@ ada_template_to_fixed_record_type_1 (struct type *type,
   memset (TYPE_FIELDS (rtype), 0, sizeof (struct field) * nfields);
   TYPE_NAME (rtype) = ada_type_name (type);
   TYPE_TAG_NAME (rtype) = NULL;
-  TYPE_FLAGS (rtype) |= TYPE_FLAG_FIXED_INSTANCE;
+  TYPE_FIXED_INSTANCE (rtype) = 1;
 
   off = 0;
   bit_len = 0;
@@ -7230,7 +7082,7 @@ template_to_static_fixed_type (struct type *type0)
                   sizeof (struct field) * nfields);
           TYPE_NAME (type) = ada_type_name (type0);
           TYPE_TAG_NAME (type) = NULL;
-          TYPE_FLAGS (type) |= TYPE_FLAG_FIXED_INSTANCE;
+         TYPE_FIXED_INSTANCE (type) = 1;
           TYPE_LENGTH (type) = 0;
         }
       TYPE_FIELD_TYPE (type, f) = new_type;
@@ -7240,9 +7092,9 @@ template_to_static_fixed_type (struct type *type0)
 }
 
 /* Given an object of type TYPE whose contents are at VALADDR and
-   whose address in memory is ADDRESS, returns a revision of TYPE --
-   a non-dynamic-sized record with a variant part -- in which
-   the variant part is replaced with the appropriate branch.  Looks
+   whose address in memory is ADDRESS, returns a revision of TYPE,
+   which should be a non-dynamic-sized record, in which the variant
+   part, if any, is replaced with the appropriate branch.  Looks
    for discriminant values in DVAL0, which can be NULL if the record
    contains the necessary discriminant values.  */
 
@@ -7275,7 +7127,7 @@ to_record_with_fixed_variant_part (struct type *type, const gdb_byte *valaddr,
           sizeof (struct field) * nfields);
   TYPE_NAME (rtype) = ada_type_name (type);
   TYPE_TAG_NAME (rtype) = NULL;
-  TYPE_FLAGS (rtype) |= TYPE_FLAG_FIXED_INSTANCE;
+  TYPE_FIXED_INSTANCE (rtype) = 1;
   TYPE_LENGTH (rtype) = TYPE_LENGTH (type);
 
   branch_type = to_fixed_variant_branch_type
@@ -7330,7 +7182,7 @@ to_fixed_record_type (struct type *type0, const gdb_byte *valaddr,
 {
   struct type *templ_type;
 
-  if (TYPE_FLAGS (type0) & TYPE_FLAG_FIXED_INSTANCE)
+  if (TYPE_FIXED_INSTANCE (type0))
     return type0;
 
   templ_type = dynamic_template_type (type0);
@@ -7346,7 +7198,7 @@ to_fixed_record_type (struct type *type0, const gdb_byte *valaddr,
     }
   else
     {
-      TYPE_FLAGS (type0) |= TYPE_FLAG_FIXED_INSTANCE;
+      TYPE_FIXED_INSTANCE (type0) = 1;
       return type0;
     }
 
@@ -7411,7 +7263,7 @@ to_fixed_array_type (struct type *type0, struct value *dval,
   struct type *result;
 
   if (ada_is_packed_array_type (type0)  /* revisit? */
-      || (TYPE_FLAGS (type0) & TYPE_FLAG_FIXED_INSTANCE))
+      || TYPE_FIXED_INSTANCE (type0))
     return type0;
 
   index_type_desc = ada_find_parallel_type (type0, "___XA");
@@ -7471,7 +7323,7 @@ to_fixed_array_type (struct type *type0, struct value *dval,
         error (_("array type with dynamic size is larger than varsize-limit"));
     }
 
-  TYPE_FLAGS (result) |= TYPE_FLAG_FIXED_INSTANCE;
+  TYPE_FIXED_INSTANCE (result) = 1;
   return result;
 }
 
@@ -7561,7 +7413,7 @@ to_static_fixed_type (struct type *type0)
   if (type0 == NULL)
     return NULL;
 
-  if (TYPE_FLAGS (type0) & TYPE_FLAG_FIXED_INSTANCE)
+  if (TYPE_FIXED_INSTANCE (type0))
     return type0;
 
   type0 = ada_check_typedef (type0);
@@ -7723,7 +7575,8 @@ ada_attribute_name (enum exp_opcode n)
 static LONGEST
 pos_atr (struct value *arg)
 {
-  struct type *type = value_type (arg);
+  struct value *val = coerce_ref (arg);
+  struct type *type = value_type (val);
 
   if (!discrete_type_p (type))
     error (_("'POS only defined on discrete types"));
@@ -7731,7 +7584,7 @@ pos_atr (struct value *arg)
   if (TYPE_CODE (type) == TYPE_CODE_ENUM)
     {
       int i;
-      LONGEST v = value_as_long (arg);
+      LONGEST v = value_as_long (val);
 
       for (i = 0; i < TYPE_NFIELDS (type); i += 1)
         {
@@ -7741,7 +7594,7 @@ pos_atr (struct value *arg)
       error (_("enumeration value is invalid: can't find 'POS"));
     }
   else
-    return value_as_long (arg);
+    return value_as_long (val);
 }
 
 static struct value *
@@ -7993,8 +7846,7 @@ unwrap_value (struct value *val)
   struct type *type = ada_check_typedef (value_type (val));
   if (ada_is_aligner_type (type))
     {
-      struct value *v = value_struct_elt (&val, NULL, "F",
-                                          NULL, "internal structure");
+      struct value *v = ada_value_struct_elt (val, "F", 0);
       struct type *val_type = ada_check_typedef (value_type (v));
       if (ada_type_name (val_type) == NULL)
         TYPE_NAME (val_type) = ada_type_name (type);
@@ -8573,7 +8425,14 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
            return arg1;
          return ada_value_assign (arg1, arg1);
        }
-      arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
+      /* Force the evaluation of the rhs ARG2 to the type of the lhs ARG1,
+         except if the lhs of our assignment is a convenience variable.
+         In the case of assigning to a convenience variable, the lhs
+         should be exactly the result of the evaluation of the rhs.  */
+      type = value_type (arg1);
+      if (VALUE_LVAL (arg1) == lval_internalvar)
+         type = NULL;
+      arg2 = evaluate_subexp (type, exp, pos, noside);
       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
         return arg1;
       if (ada_is_fixed_point_type (value_type (arg1)))
@@ -8590,6 +8449,10 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
       if (noside == EVAL_SKIP)
         goto nosideret;
+      if (TYPE_CODE (value_type (arg1)) == TYPE_CODE_PTR)
+        return (value_from_longest
+                 (value_type (arg1),
+                  value_as_long (arg1) + value_as_long (arg2)));
       if ((ada_is_fixed_point_type (value_type (arg1))
            || ada_is_fixed_point_type (value_type (arg2)))
           && value_type (arg1) != value_type (arg2))
@@ -8600,13 +8463,17 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       type = value_type (arg1);
       while (TYPE_CODE (type) == TYPE_CODE_REF)
         type = TYPE_TARGET_TYPE (type);
-      return value_cast (type, value_add (arg1, arg2));
+      return value_cast (type, value_binop (arg1, arg2, BINOP_ADD));
 
     case BINOP_SUB:
       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
       if (noside == EVAL_SKIP)
         goto nosideret;
+      if (TYPE_CODE (value_type (arg1)) == TYPE_CODE_PTR)
+        return (value_from_longest
+                 (value_type (arg1),
+                  value_as_long (arg1) - value_as_long (arg2)));
       if ((ada_is_fixed_point_type (value_type (arg1))
            || ada_is_fixed_point_type (value_type (arg2)))
           && value_type (arg1) != value_type (arg2))
@@ -8617,7 +8484,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       type = value_type (arg1);
       while (TYPE_CODE (type) == TYPE_CODE_REF)
         type = TYPE_TARGET_TYPE (type);
-      return value_cast (type, value_sub (arg1, arg2));
+      return value_cast (type, value_binop (arg1, arg2, BINOP_SUB));
 
     case BINOP_MUL:
     case BINOP_DIV:
@@ -8661,7 +8528,8 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
         tem = ada_value_equal (arg1, arg2);
       if (op == BINOP_NOTEQUAL)
         tem = !tem;
-      return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
+      type = language_bool_type (exp->language_defn, exp->gdbarch);
+      return value_from_longest (type, (LONGEST) tem);
 
     case UNOP_NEG:
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
@@ -8680,7 +8548,8 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
 
         *pos -= 1;
         val = evaluate_subexp_standard (expect_type, exp, pos, noside);
-        return value_cast (LA_BOOL_TYPE, val);
+       type = language_bool_type (exp->language_defn, exp->gdbarch);
+        return value_cast (type, val);
       }
 
     case BINOP_BITWISE_AND:
@@ -8699,14 +8568,6 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
     case OP_VAR_VALUE:
       *pos -= 1;
 
-      /* Tagged types are a little special in the fact that the real type
-         is dynamic and can only be determined by inspecting the object
-         value.  So even if we're support to do an EVAL_AVOID_SIDE_EFFECTS
-         evaluation, we force an EVAL_NORMAL evaluation for tagged types.  */
-      if (noside == EVAL_AVOID_SIDE_EFFECTS
-          && ada_is_tagged_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol), 1))
-        noside = EVAL_NORMAL;
-
       if (noside == EVAL_SKIP)
         {
           *pos += 4;
@@ -8720,6 +8581,30 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
                SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol));
       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
         {
+          type = static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
+          if (ada_is_tagged_type (type, 0))
+          {
+            /* Tagged types are a little special in the fact that the real
+               type is dynamic and can only be determined by inspecting the
+               object's tag.  This means that we need to get the object's
+               value first (EVAL_NORMAL) and then extract the actual object
+               type from its tag.
+
+               Note that we cannot skip the final step where we extract
+               the object type from its tag, because the EVAL_NORMAL phase
+               results in dynamic components being resolved into fixed ones.
+               This can cause problems when trying to print the type
+               description of tagged types whose parent has a dynamic size:
+               We use the type name of the "_parent" component in order
+               to print the name of the ancestor type in the type description.
+               If that component had a dynamic size, the resolution into
+               a fixed type would result in the loss of that type name,
+               thus preventing us from printing the name of the ancestor
+               type in the type description.  */
+            arg1 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
+            return value_zero (type_from_tag (ada_value_tag (arg1)), not_lval);
+          }
+
           *pos += 4;
           return value_zero
             (to_static_fixed_type
@@ -8932,14 +8817,15 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
         default:
           lim_warning (_("Membership test incompletely implemented; "
                         "always returns true"));
-          return value_from_longest (builtin_type_int, (LONGEST) 1);
+         type = language_bool_type (exp->language_defn, exp->gdbarch);
+         return value_from_longest (type, (LONGEST) 1);
 
         case TYPE_CODE_RANGE:
-          arg2 = value_from_longest (builtin_type_int, TYPE_LOW_BOUND (type));
-          arg3 = value_from_longest (builtin_type_int,
-                                     TYPE_HIGH_BOUND (type));
-          return
-            value_from_longest (builtin_type_int,
+         arg2 = value_from_longest (type, TYPE_LOW_BOUND (type));
+         arg3 = value_from_longest (type, TYPE_HIGH_BOUND (type));
+         type = language_bool_type (exp->language_defn, exp->gdbarch);
+         return
+           value_from_longest (type,
                                 (value_less (arg1, arg3)
                                  || value_equal (arg1, arg3))
                                 && (value_less (arg2, arg1)
@@ -8955,7 +8841,10 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
         goto nosideret;
 
       if (noside == EVAL_AVOID_SIDE_EFFECTS)
-        return value_zero (builtin_type_int, not_lval);
+       {
+         type = language_bool_type (exp->language_defn, exp->gdbarch);
+         return value_zero (type, not_lval);
+       }
 
       tem = longest_to_int (exp->elts[pc + 1].longconst);
 
@@ -8965,8 +8854,9 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       arg3 = ada_array_bound (arg2, tem, 1);
       arg2 = ada_array_bound (arg2, tem, 0);
 
+      type = language_bool_type (exp->language_defn, exp->gdbarch);
       return
-        value_from_longest (builtin_type_int,
+        value_from_longest (type,
                             (value_less (arg1, arg3)
                              || value_equal (arg1, arg3))
                             && (value_less (arg2, arg1)
@@ -8980,8 +8870,9 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       if (noside == EVAL_SKIP)
         goto nosideret;
 
+      type = language_bool_type (exp->language_defn, exp->gdbarch);
       return
-        value_from_longest (builtin_type_int,
+        value_from_longest (type,
                             (value_less (arg1, arg3)
                              || value_equal (arg1, arg3))
                             && (value_less (arg2, arg1)
@@ -9059,9 +8950,11 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
               default:
                 error (_("unexpected attribute encountered"));
               case OP_ATR_FIRST:
-                return discrete_type_low_bound (range_type);
+               return value_from_longest 
+                 (range_type, discrete_type_low_bound (range_type));
               case OP_ATR_LAST:
-                return discrete_type_high_bound (range_type);
+                return value_from_longest
+                 (range_type, discrete_type_high_bound (range_type));
               case OP_ATR_LENGTH:
                 error (_("the 'length attribute applies only to array types"));
               }
@@ -9158,9 +9051,9 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       if (noside == EVAL_SKIP)
         goto nosideret;
       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-        return value_zero (builtin_type_int, not_lval);
+        return value_zero (builtin_type_int32, not_lval);
       else
-        return value_from_longest (builtin_type_int,
+        return value_from_longest (builtin_type_int32,
                                    TARGET_CHAR_BIT
                                    * TYPE_LENGTH (value_type (arg1)));
 
@@ -9582,7 +9475,16 @@ to_fixed_range_type (char *name, struct value *dval, struct objfile *objfile)
 
   subtype_info = strstr (name, "___XD");
   if (subtype_info == NULL)
-    return raw_type;
+    {
+      LONGEST L = discrete_type_low_bound (raw_type);
+      LONGEST U = discrete_type_high_bound (raw_type);
+      if (L < INT_MIN || U > INT_MAX)
+       return raw_type;
+      else
+       return create_range_type (alloc_type (objfile), raw_type, 
+                                 discrete_type_low_bound (raw_type),
+                                 discrete_type_high_bound (raw_type));
+    }
   else
     {
       static char *name_buf = NULL;
@@ -9669,7 +9571,7 @@ ada_is_modular_type (struct type *type)
   struct type *subranged_type = base_type (type);
 
   return (subranged_type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE
-          && TYPE_CODE (subranged_type) != TYPE_CODE_ENUM
+          && TYPE_CODE (subranged_type) == TYPE_CODE_INT
           && TYPE_UNSIGNED (subranged_type));
 }
 
@@ -9852,7 +9754,7 @@ ada_exception_support_info_sniffer (void)
    each time a new executable is loaded by GDB.  */
 
 static void
-ada_executable_changed_observer (void *unused)
+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
@@ -10982,6 +10884,9 @@ ada_language_arch_info (struct gdbarch *gdbarch,
                                     (struct objfile *) NULL));
   TYPE_NAME (lai->primitive_type_vector [ada_primitive_type_system_address])
     = "system__address";
+
+  lai->bool_type_symbol = "boolean";
+  lai->bool_type_default = builtin->builtin_bool;
 }
 \f
                                /* Language vector */
@@ -11028,7 +10933,7 @@ const struct language_defn ada_language_defn = {
   ada_val_print,                /* Print a value using appropriate syntax */
   ada_value_print,              /* Print a top-level value */
   NULL,                         /* Language specific skip_trampoline */
-  NULL,                         /* value_of_this */
+  NULL,                         /* name_of_this */
   ada_lookup_symbol_nonlocal,   /* Looking up non-local symbols.  */
   basic_lookup_transparent_type,        /* lookup_transparent_type */
   ada_la_decode,                /* Language specific symbol demangler */
This page took 0.046491 seconds and 4 git commands to generate.