gdb
[deliverable/binutils-gdb.git] / gdb / ada-lang.c
index baeef0a923c1924ff1ca17d235611b6c86046dcd..c425c80d41f3fe0ebdc3e23def656683c5ea7a4e 100644 (file)
@@ -115,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 *);
 
@@ -207,13 +206,15 @@ 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 *);
 
 static LONGEST pos_atr (struct value *);
 
-static struct value *value_pos_atr (struct value *);
+static struct value *value_pos_atr (struct type *, struct value *);
 
 static struct value *value_val_atr (struct type *, struct value *);
 
@@ -622,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."));
     }
@@ -1203,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
@@ -1768,7 +1759,7 @@ struct type *
 ada_coerce_to_simple_array_type (struct type *type)
 {
   struct value *mark = value_mark ();
-  struct value *dummy = value_from_longest (builtin_type_long, 0);
+  struct value *dummy = value_from_longest (builtin_type_int32, 0);
   struct type *result;
   deprecated_set_value_type (dummy, type);
   result = ada_type_of_array (dummy, 0);
@@ -1829,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;
 }
 
@@ -1968,7 +1959,7 @@ value_subscript_packed (struct value *arr, int arity, struct value **ind)
               lowerbound = upperbound = 0;
             }
 
-          idx = value_as_long (value_pos_atr (ind[i]));
+          idx = pos_atr (ind[i]);
           if (idx < lowerbound || idx > upperbound)
             lim_warning (_("packed array index %ld out of bounds"), (long) idx);
           bits = TYPE_FIELD_BITSIZE (elt_type, 0);
@@ -2253,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);
@@ -2261,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);
@@ -2342,7 +2335,7 @@ ada_value_subscript (struct value *arr, int arity, struct value **ind)
     {
       if (TYPE_CODE (elt_type) != TYPE_CODE_ARRAY)
         error (_("too many subscripts (%d expected)"), k);
-      elt = value_subscript (elt, value_pos_atr (ind[k]));
+      elt = value_subscript (elt, value_pos_atr (builtin_type_int32, ind[k]));
     }
   return elt;
 }
@@ -2367,10 +2360,12 @@ ada_value_ptr_subscript (struct value *arr, struct type *type, int arity,
       arr = value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
                         value_copy (arr));
       get_discrete_bounds (TYPE_INDEX_TYPE (type), &lwb, &upb);
-      idx = value_pos_atr (ind[k]);
+      idx = value_pos_atr (builtin_type_int32, 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);
     }
 
@@ -2505,7 +2500,7 @@ ada_index_type (struct type *type, int n)
          has a target type of TYPE_CODE_UNDEF.  We compensate here, but
          perhaps stabsread.c would make more sense.  */
       if (result_type == NULL || TYPE_CODE (result_type) == TYPE_CODE_UNDEF)
-        result_type = builtin_type_int;
+        result_type = builtin_type_int32;
 
       return result_type;
     }
@@ -2533,7 +2528,7 @@ ada_array_bound_from_type (struct type * arr_type, int n, int which,
   if (arr_type == NULL || !ada_is_simple_array_type (arr_type))
     {
       if (typep != NULL)
-        *typep = builtin_type_int;
+        *typep = builtin_type_int32;
       return (LONGEST) - which;
     }
 
@@ -2630,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),
@@ -2891,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;
@@ -3976,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
@@ -3998,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;
 }
 
@@ -4089,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;
@@ -4112,7 +4099,6 @@ add_defn_to_vec (struct obstack *obstackp,
         {
           prevDefns[i].sym = sym;
           prevDefns[i].block = block;
-          prevDefns[i].symtab = symtab;
           return;
         }
     }
@@ -4122,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));
   }
 }
@@ -4324,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)
           {
@@ -4416,7 +4396,29 @@ remove_extra_symbols (struct ada_symbol_info *syms, int nsyms)
   i = 0;
   while (i < nsyms)
     {
-      if (SYMBOL_LINKAGE_NAME (syms[i].sym) != NULL
+      int remove = 0;
+
+      /* If two symbols have the same name and one of them is a stub type,
+         the get rid of the stub.  */
+
+      if (TYPE_STUB (SYMBOL_TYPE (syms[i].sym))
+          && SYMBOL_LINKAGE_NAME (syms[i].sym) != NULL)
+        {
+          for (j = 0; j < nsyms; j++)
+            {
+              if (j != i
+                  && !TYPE_STUB (SYMBOL_TYPE (syms[j].sym))
+                  && SYMBOL_LINKAGE_NAME (syms[j].sym) != NULL
+                  && strcmp (SYMBOL_LINKAGE_NAME (syms[i].sym),
+                             SYMBOL_LINKAGE_NAME (syms[j].sym)) == 0)
+                remove = 1;
+            }
+        }
+
+      /* Two symbols with the same name, same class and same address
+         should be identical.  */
+
+      else if (SYMBOL_LINKAGE_NAME (syms[i].sym) != NULL
           && SYMBOL_CLASS (syms[i].sym) == LOC_STATIC
           && is_nondebugging_type (SYMBOL_TYPE (syms[i].sym)))
         {
@@ -4429,18 +4431,18 @@ 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))
-                {
-                  int k;
-                  for (k = i + 1; k < nsyms; k += 1)
-                    syms[k - 1] = syms[k];
-                  nsyms -= 1;
-                  goto NextSymbol;
-                }
+                remove = 1;
             }
         }
+      
+      if (remove)
+        {
+          for (j = i + 1; j < nsyms; j += 1)
+            syms[j - 1] = syms[j];
+          nsyms -= 1;
+        }
+
       i += 1;
-    NextSymbol:
-      ;
     }
   return nsyms;
 }
@@ -4639,7 +4641,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;
 
@@ -4670,9 +4672,73 @@ remove_irrelevant_renamings (struct ada_symbol_info *syms,
   return nsyms;
 }
 
+/* Add to OBSTACKP all symbols from BLOCK (and its super-blocks)
+   whose name and domain match NAME and DOMAIN respectively.
+   If no match was found, then extend the search to "enclosing"
+   routines (in other words, if we're inside a nested function,
+   search the symbols defined inside the enclosing functions).
+
+   Note: This function assumes that OBSTACKP has 0 (zero) element in it.  */
+
+static void
+ada_add_local_symbols (struct obstack *obstackp, const char *name,
+                       struct block *block, domain_enum domain,
+                       int wild_match)
+{
+  int block_depth = 0;
+
+  while (block != NULL)
+    {
+      block_depth += 1;
+      ada_add_block_symbols (obstackp, block, name, domain, NULL, wild_match);
+
+      /* If we found a non-function match, assume that's the one.  */
+      if (is_nonfunction (defns_collected (obstackp, 0),
+                          num_defns_collected (obstackp)))
+        return;
+
+      block = BLOCK_SUPERBLOCK (block);
+    }
+
+  /* If no luck so far, try to find NAME as a local symbol in some lexically
+     enclosing subprogram.  */
+  if (num_defns_collected (obstackp) == 0 && block_depth > 2)
+    add_symbols_from_enclosing_procs (obstackp, name, domain, wild_match);
+}
+
+/* Add to OBSTACKP all non-local symbols whose name and domain match
+   NAME and DOMAIN respectively.  The search is performed on GLOBAL_BLOCK
+   symbols if GLOBAL is non-zero, or on STATIC_BLOCK symbols otherwise.  */
+
+static void
+ada_add_non_local_symbols (struct obstack *obstackp, const char *name,
+                           domain_enum domain, int global,
+                           int wild_match)
+{
+  struct objfile *objfile;
+  struct partial_symtab *ps;
+
+  ALL_PSYMTABS (objfile, ps)
+  {
+    QUIT;
+    if (ps->readin
+        || ada_lookup_partial_symbol (ps, name, global, domain, wild_match))
+      {
+        struct symtab *s = PSYMTAB_TO_SYMTAB (ps);
+        const int block_kind = global ? GLOBAL_BLOCK : STATIC_BLOCK;
+
+        if (s == NULL || !s->primary)
+          continue;
+        ada_add_block_symbols (obstackp,
+                               BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), block_kind),
+                               name, domain, objfile, wild_match);
+      }
+  }
+}
+
 /* 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 
@@ -4690,16 +4756,10 @@ ada_lookup_symbol_list (const char *name0, const struct block *block0,
                         struct ada_symbol_info **results)
 {
   struct symbol *sym;
-  struct symtab *s;
-  struct partial_symtab *ps;
-  struct blockvector *bv;
-  struct objfile *objfile;
   struct block *block;
   const char *name;
-  struct minimal_symbol *msymbol;
   int wild_match;
   int cacheIfUnique;
-  int block_depth;
   int ndefns;
 
   obstack_free (&symbol_list_obstack, NULL);
@@ -4714,6 +4774,14 @@ ada_lookup_symbol_list (const char *name0, const struct block *block0,
   block = (struct block *) block0;      /* FIXME: No cast ought to be
                                            needed, but adding const will
                                            have a cascade effect.  */
+
+  /* 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 (name0, "standard__", sizeof ("standard__") - 1) == 0)
     {
       wild_match = 0;
@@ -4721,136 +4789,36 @@ ada_lookup_symbol_list (const char *name0, const struct block *block0,
       name = name0 + sizeof ("standard__") - 1;
     }
 
-  block_depth = 0;
-  while (block != NULL)
-    {
-      block_depth += 1;
-      ada_add_block_symbols (&symbol_list_obstack, block, name,
-                             namespace, NULL, NULL, wild_match);
-
-      /* If we found a non-function match, assume that's the one.  */
-      if (is_nonfunction (defns_collected (&symbol_list_obstack, 0),
-                          num_defns_collected (&symbol_list_obstack)))
-        goto done;
-
-      block = BLOCK_SUPERBLOCK (block);
-    }
-
-  /* If no luck so far, try to find NAME as a local symbol in some lexically
-     enclosing subprogram.  */
-  if (num_defns_collected (&symbol_list_obstack) == 0 && block_depth > 2)
-    add_symbols_from_enclosing_procs (&symbol_list_obstack,
-                                      name, namespace, wild_match);
-
-  /* If we found ANY matches among non-global symbols, we're done.  */
+  /* Check the non-global symbols.  If we have ANY match, then we're done.  */
 
+  ada_add_local_symbols (&symbol_list_obstack, name, block, namespace,
+                         wild_match);
   if (num_defns_collected (&symbol_list_obstack) > 0)
     goto done;
 
+  /* No non-global symbols found.  Check our cache to see if we have
+     already performed this search before.  If we have, then return
+     the same result.  */
+
   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;
     }
 
-  /* Now add symbols from all global blocks: symbol tables, minimal symbol
-     tables, and psymtab's.  */
-
-  ALL_PRIMARY_SYMTABS (objfile, s)
-  {
-    QUIT;
-    bv = BLOCKVECTOR (s);
-    block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
-    ada_add_block_symbols (&symbol_list_obstack, block, name, namespace,
-                           objfile, s, wild_match);
-  }
-
-  if (namespace == VAR_DOMAIN)
-    {
-      ALL_MSYMBOLS (objfile, msymbol)
-      {
-        if (ada_match_name (SYMBOL_LINKAGE_NAME (msymbol), name, wild_match))
-          {
-            switch (MSYMBOL_TYPE (msymbol))
-              {
-              case mst_solib_trampoline:
-                break;
-              default:
-                s = find_pc_symtab (SYMBOL_VALUE_ADDRESS (msymbol));
-                if (s != NULL)
-                  {
-                    int ndefns0 = num_defns_collected (&symbol_list_obstack);
-                    QUIT;
-                    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);
-
-                    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);
-                      }
-                  }
-              }
-          }
-      }
-    }
-
-  ALL_PSYMTABS (objfile, ps)
-  {
-    QUIT;
-    if (!ps->readin
-        && ada_lookup_partial_symbol (ps, name, 1, namespace, wild_match))
-      {
-        s = PSYMTAB_TO_SYMTAB (ps);
-        if (!s->primary)
-          continue;
-        bv = BLOCKVECTOR (s);
-        block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
-        ada_add_block_symbols (&symbol_list_obstack, block, name,
-                               namespace, objfile, s, wild_match);
-      }
-  }
+  /* Search symbols from all global blocks.  */
+  ada_add_non_local_symbols (&symbol_list_obstack, name, namespace, 1,
+                             wild_match);
 
   /* Now add symbols from all per-file blocks if we've gotten no hits
-     (Not strictly correct, but perhaps better than an error).
-     Do the symtabs first, then check the psymtabs.  */
+     (not strictly correct, but perhaps better than an error).  */
 
   if (num_defns_collected (&symbol_list_obstack) == 0)
-    {
-
-      ALL_PRIMARY_SYMTABS (objfile, s)
-      {
-        QUIT;
-        bv = BLOCKVECTOR (s);
-        block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
-        ada_add_block_symbols (&symbol_list_obstack, block, name, namespace,
-                               objfile, s, wild_match);
-      }
-
-      ALL_PSYMTABS (objfile, ps)
-      {
-        QUIT;
-        if (!ps->readin
-            && ada_lookup_partial_symbol (ps, name, 0, namespace, wild_match))
-          {
-            s = PSYMTAB_TO_SYMTAB (ps);
-            bv = BLOCKVECTOR (s);
-            if (!s->primary)
-              continue;
-            block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
-            ada_add_block_symbols (&symbol_list_obstack, block, name,
-                                   namespace, objfile, s, wild_match);
-          }
-      }
-    }
+    ada_add_non_local_symbols (&symbol_list_obstack, name, namespace, 0,
+                               wild_match);
 
 done:
   ndefns = num_defns_collected (&symbol_list_obstack);
@@ -4859,11 +4827,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);
 
@@ -4923,7 +4890,7 @@ ada_lookup_symbol_nonlocal (const char *name,
 /* 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]
@@ -5060,24 +5027,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');
@@ -5092,6 +5047,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;
@@ -5107,91 +5068,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;
 }
 
 
@@ -5205,7 +5097,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);
@@ -5226,25 +5118,16 @@ ada_add_block_symbols (struct obstack *obstackp,
                                    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);
               }
           }
       }
@@ -5260,26 +5143,18 @@ ada_add_block_symbols (struct obstack *obstackp,
             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);
+                     }
+                 }
               }
           }
       }
@@ -5289,7 +5164,7 @@ ada_add_block_symbols (struct obstack *obstackp,
     {
       add_defn_to_vec (obstackp,
                        fixup_symbol_section (arg_sym, objfile),
-                       block, symtab);
+                       block);
     }
 
   if (!wild)
@@ -5316,26 +5191,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);
+                     }
+                 }
               }
           }
       }
@@ -5346,7 +5213,7 @@ ada_add_block_symbols (struct obstack *obstackp,
         {
           add_defn_to_vec (obstackp,
                            fixup_symbol_section (arg_sym, objfile),
-                           block, symtab);
+                           block);
         }
     }
 }
@@ -5837,7 +5704,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);
@@ -5880,7 +5748,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;
 }
@@ -5940,7 +5818,7 @@ ada_variant_discrim_type (struct type *var_type, struct type *outer_type)
   struct type *type =
     ada_lookup_struct_elt_type (outer_type, name, 1, 1, NULL);
   if (type == NULL)
-    return builtin_type_int;
+    return builtin_type_int32;
   else
     return type;
 }
@@ -6761,7 +6639,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)
@@ -6941,7 +6819,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;
 }
@@ -7001,7 +6878,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;
@@ -7181,7 +7058,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;
@@ -7191,9 +7068,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.  */
 
@@ -7226,7 +7103,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
@@ -7281,7 +7158,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);
@@ -7297,7 +7174,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;
     }
 
@@ -7362,7 +7239,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");
@@ -7422,7 +7299,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;
 }
 
@@ -7512,7 +7389,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);
@@ -7674,7 +7551,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"));
@@ -7682,7 +7560,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)
         {
@@ -7692,13 +7570,13 @@ 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 *
-value_pos_atr (struct value *arg)
+value_pos_atr (struct type *type, struct value *arg)
 {
-  return value_from_longest (builtin_type_int, pos_atr (arg));
+  return value_from_longest (type, pos_atr (arg));
 }
 
 /* Evaluate the TYPE'VAL attribute applied to ARG.  */
@@ -7980,8 +7858,7 @@ cast_to_fixed (struct type *type, struct value *arg)
                                                   value_as_long (arg)));
   else
     {
-      DOUBLEST argd =
-        value_as_double (value_cast (builtin_type_double, value_copy (arg)));
+      DOUBLEST argd = value_as_double (arg);
       val = ada_float_to_fixed (type, argd);
     }
 
@@ -7989,11 +7866,11 @@ cast_to_fixed (struct type *type, struct value *arg)
 }
 
 static struct value *
-cast_from_fixed_to_double (struct value *arg)
+cast_from_fixed (struct type *type, struct value *arg)
 {
   DOUBLEST val = ada_fixed_to_float (value_type (arg),
                                      value_as_long (arg));
-  return value_from_double (builtin_type_double, val);
+  return value_from_double (type, val);
 }
 
 /* Coerce VAL as necessary for assignment to an lval of type TYPE, and
@@ -8153,7 +8030,7 @@ assign_component (struct value *container, struct value *lhs, LONGEST index,
   struct value *elt;
   if (TYPE_CODE (value_type (lhs)) == TYPE_CODE_ARRAY)
     {
-      struct value *index_val = value_from_longest (builtin_type_int, index);
+      struct value *index_val = value_from_longest (builtin_type_int32, index);
       elt = unwrap_value (ada_value_subscript (lhs, 1, &index_val));
     }
   else
@@ -8447,7 +8324,7 @@ ada_value_cast (struct type *type, struct value *arg2, enum noside noside)
     return (cast_to_fixed (type, arg2));
 
   if (ada_is_fixed_point_type (value_type (arg2)))
-    return value_cast (type, cast_from_fixed_to_double (arg2));
+    return cast_from_fixed (type, arg2);
 
   return value_cast (type, arg2);
 }
@@ -8547,6 +8424,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))
@@ -8557,13 +8438,18 @@ 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));
+      binop_promote (exp->language_defn, exp->gdbarch, &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))
@@ -8574,7 +8460,8 @@ 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));
+      binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+      return value_cast (type, value_binop (arg1, arg2, BINOP_SUB));
 
     case BINOP_MUL:
     case BINOP_DIV:
@@ -8587,10 +8474,12 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
         return value_zero (value_type (arg1), not_lval);
       else
         {
+          type = builtin_type (exp->gdbarch)->builtin_double;
           if (ada_is_fixed_point_type (value_type (arg1)))
-            arg1 = cast_from_fixed_to_double (arg1);
+            arg1 = cast_from_fixed (type, arg1);
           if (ada_is_fixed_point_type (value_type (arg2)))
-            arg2 = cast_from_fixed_to_double (arg2);
+            arg2 = cast_from_fixed (type, arg2);
+          binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
           return ada_value_binop (arg1, arg2, op);
         }
 
@@ -8604,7 +8493,10 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
                && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
         return value_zero (value_type (arg1), not_lval);
       else
-        return ada_value_binop (arg1, arg2, op);
+       {
+         binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+         return ada_value_binop (arg1, arg2, op);
+       }
 
     case BINOP_EQUAL:
     case BINOP_NOTEQUAL:
@@ -8615,10 +8507,14 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       if (noside == EVAL_AVOID_SIDE_EFFECTS)
         tem = 0;
       else
-        tem = ada_value_equal (arg1, arg2);
+       {
+         binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+         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);
@@ -8627,7 +8523,10 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       else if (ada_is_fixed_point_type (value_type (arg1)))
         return value_cast (value_type (arg1), value_neg (arg1));
       else
-        return value_neg (arg1);
+       {
+         unop_promote (exp->language_defn, exp->gdbarch, &arg1);
+         return value_neg (arg1);
+       }
 
     case BINOP_LOGICAL_AND:
     case BINOP_LOGICAL_OR:
@@ -8637,7 +8536,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:
@@ -8656,14 +8556,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;
@@ -8677,6 +8569,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
@@ -8889,14 +8805,17 @@ 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));
+         binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+         binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
+         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)
@@ -8912,7 +8831,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);
 
@@ -8922,8 +8844,11 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       arg3 = ada_array_bound (arg2, tem, 1);
       arg2 = ada_array_bound (arg2, tem, 0);
 
+      binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+      binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
+      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)
@@ -8937,8 +8862,11 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       if (noside == EVAL_SKIP)
         goto nosideret;
 
+      binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+      binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
+      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)
@@ -9016,9 +8944,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"));
               }
@@ -9081,8 +9011,11 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
         return value_zero (value_type (arg1), not_lval);
       else
-        return value_binop (arg1, arg2,
-                            op == OP_ATR_MIN ? BINOP_MIN : BINOP_MAX);
+       {
+         binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+         return value_binop (arg1, arg2,
+                             op == OP_ATR_MIN ? BINOP_MIN : BINOP_MAX);
+       }
 
     case OP_ATR_MODULUS:
       {
@@ -9105,19 +9038,20 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
       if (noside == EVAL_SKIP)
         goto nosideret;
-      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-        return value_zero (builtin_type_int, not_lval);
+      type = builtin_type (exp->gdbarch)->builtin_int;
+      if (noside == EVAL_AVOID_SIDE_EFFECTS)
+       return value_zero (type, not_lval);
       else
-        return value_pos_atr (arg1);
+       return value_pos_atr (type, arg1);
 
     case OP_ATR_SIZE:
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
       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)));
 
@@ -9140,7 +9074,16 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
         return value_zero (value_type (arg1), not_lval);
       else
-        return value_binop (arg1, arg2, op);
+       {
+         /* For integer exponentiation operations,
+            only promote the first argument.  */
+         if (is_integral_type (value_type (arg2)))
+           unop_promote (exp->language_defn, exp->gdbarch, &arg1);
+         else
+           binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+
+         return value_binop (arg1, arg2, op);
+       }
 
     case UNOP_PLUS:
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
@@ -9153,6 +9096,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
       if (noside == EVAL_SKIP)
         goto nosideret;
+      unop_promote (exp->language_defn, exp->gdbarch, &arg1);
       if (value_less (arg1, value_zero (value_type (arg1), not_lval)))
         return value_neg (arg1);
       else
@@ -9188,7 +9132,8 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
             }
           else if (TYPE_CODE (type) == TYPE_CODE_INT)
             /* GDB allows dereferencing an int.  */
-            return value_zero (builtin_type_int, lval_memory);
+            return value_zero (builtin_type (exp->gdbarch)->builtin_int,
+                              lval_memory);
           else
             error (_("Attempt to take contents of a non-pointer value."));
         }
@@ -9198,6 +9143,10 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
       if (ada_is_array_descriptor_type (type))
         /* GDB allows dereferencing GNAT array descriptors.  */
         return ada_coerce_to_simple_array (arg1);
+      else if (TYPE_CODE (type) == TYPE_CODE_INT)
+       /* GDB allows dereferencing an int.  */
+       return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int,
+                             (CORE_ADDR) value_as_address (arg1));
       else
         return ada_value_ind (arg1);
 
@@ -9271,7 +9220,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
     }
 
 nosideret:
-  return value_from_longest (builtin_type_long, (LONGEST) 1);
+  return value_from_longest (builtin_type_int8, (LONGEST) 1);
 }
 \f
 
@@ -9531,7 +9480,7 @@ to_fixed_range_type (char *name, struct value *dval, struct objfile *objfile)
   char *subtype_info;
 
   if (raw_type == NULL)
-    base_type = builtin_type_int;
+    base_type = builtin_type_int32;
   else if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
     base_type = TYPE_TARGET_TYPE (raw_type);
   else
@@ -9539,7 +9488,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;
@@ -9626,7 +9584,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));
 }
 
@@ -9809,7 +9767,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
@@ -10939,6 +10897,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 */
@@ -10974,6 +10935,7 @@ const struct language_defn ada_language_defn = {
   case_sensitive_on,            /* Yes, Ada is case-insensitive, but
                                    that's not quite what this means.  */
   array_row_major,
+  macro_expansion_no,
   &ada_exp_descriptor,
   parse,
   ada_error,
@@ -10982,6 +10944,7 @@ const struct language_defn ada_language_defn = {
   ada_printstr,                 /* Function to print string constant */
   emit_char,                    /* Function to print single char (not used) */
   ada_print_type,               /* Print a type using appropriate syntax */
+  default_print_typedef,       /* Print a typedef using appropriate syntax */
   ada_val_print,                /* Print a value using appropriate syntax */
   ada_value_print,              /* Print a top-level value */
   NULL,                         /* Language specific skip_trampoline */
This page took 0.046264 seconds and 4 git commands to generate.