Added --identify option to dlltool.
[deliverable/binutils-gdb.git] / gdb / ada-lang.c
index 74b2194d908355cce0ad8abe0d3de33fdfe58941..9fdd944197f2cd035b4b776bea8b3e2a704e399a 100644 (file)
 #include "observer.h"
 #include "vec.h"
 
-#ifndef ADA_RETAIN_DOTS
-#define ADA_RETAIN_DOTS 0
-#endif
-
 /* Define whether or not the C operator '/' truncates towards zero for
    differently signed operands (truncation direction is undefined in C). 
    Copied from valarith.c.  */
@@ -206,15 +202,13 @@ 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 *);
 
@@ -359,9 +353,9 @@ ada_get_gdb_completer_word_break_characters (void)
 
 static void
 ada_print_array_index (struct value *index_value, struct ui_file *stream,
-                       int format, enum val_prettyprint pretty)
+                       const struct value_print_options *options)
 {
-  LA_VALUE_PRINT (index_value, stream, format, pretty);
+  LA_VALUE_PRINT (index_value, stream, options);
   fprintf_filtered (stream, " => ");
 }
 
@@ -814,7 +808,7 @@ ada_encode (const char *decoded)
   k = 0;
   for (p = decoded; *p != '\0'; p += 1)
     {
-      if (!ADA_RETAIN_DOTS && *p == '.')
+      if (*p == '.')
         {
           encoding_buffer[k] = encoding_buffer[k + 1] = '_';
           k += 2;
@@ -1136,8 +1130,7 @@ ada_decode (const char *encoded)
           if (i < len0)
             goto Suppress;
         }
-      else if (!ADA_RETAIN_DOTS
-               && i < len0 - 2 && encoded[i] == '_' && encoded[i + 1] == '_')
+      else if (i < len0 - 2 && encoded[i] == '_' && encoded[i + 1] == '_')
         {
          /* Replace '__' by '.'.  */
           decoded[j] = '.';
@@ -1759,7 +1752,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);
@@ -1959,7 +1952,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);
@@ -2335,7 +2328,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;
 }
@@ -2360,7 +2353,7 @@ 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_binop (idx, value_from_longest (value_type (idx), lwb),
                           BINOP_SUB);
@@ -2500,7 +2493,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;
     }
@@ -2528,7 +2521,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;
     }
 
@@ -4396,7 +4389,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)))
         {
@@ -4409,18 +4424,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;
 }
@@ -4650,6 +4665,70 @@ 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) tuples,
@@ -4670,16 +4749,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);
@@ -4694,6 +4767,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;
@@ -4701,32 +4782,17 @@ 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, 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))
     {
@@ -4735,114 +4801,17 @@ ada_lookup_symbol_list (const char *name0, const struct block *block0,
       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, 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);
-                   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,
-                                           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,
-                                               name1, namespace, objfile, 0);
-                      }
-                  }
-              }
-          }
-      }
-    }
-
-  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, 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, 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, wild_match);
-          }
-      }
-    }
+    ada_add_non_local_symbols (&symbol_list_obstack, name, namespace, 0,
+                               wild_match);
 
 done:
   ndefns = num_defns_collected (&symbol_list_obstack);
@@ -5051,17 +5020,6 @@ is_name_suffix (const char *str)
   return 0;
 }
 
-/* Return nonzero if the given string contains only digits.
-   The empty string also matches.  */
-
-static int
-is_digits_suffix (const char *str)
-{
-  while (isdigit (str[0]))
-    str++;
-  return (str[0] == '\0');
-}
-
 /* Return non-zero if the string starting at NAME and ending before
    NAME_END contains no capital letters.  */
 
@@ -5842,7 +5800,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;
 }
@@ -6432,9 +6390,19 @@ ada_lookup_struct_elt_type (struct type *type, char *name, int refok,
 
           for (j = TYPE_NFIELDS (field_type) - 1; j >= 0; j -= 1)
             {
+             /* FIXME pnh 2008/01/26: We check for a field that is
+                NOT wrapped in a struct, since the compiler sometimes
+                generates these for unchecked variant types.  Revisit
+                if the compiler changes this practice. */
+             char *v_field_name = TYPE_FIELD_NAME (field_type, j);
               disp = 0;
-              t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (field_type, j),
-                                              name, 0, 1, &disp);
+             if (v_field_name != NULL 
+                 && field_name_match (v_field_name, name))
+               t = ada_check_typedef (TYPE_FIELD_TYPE (field_type, j));
+             else
+               t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (field_type, j),
+                                               name, 0, 1, &disp);
+
               if (t != NULL)
                 {
                   if (dispp != NULL)
@@ -6470,6 +6438,20 @@ BadName:
   return NULL;
 }
 
+/* Assuming that VAR_TYPE is the type of a variant part of a record (a union),
+   within a value of type OUTER_TYPE, return true iff VAR_TYPE
+   represents an unchecked union (that is, the variant part of a
+   record that is named in an Unchecked_Union pragma). */
+
+static int
+is_unchecked_variant (struct type *var_type, struct type *outer_type)
+{
+  char *discrim_name = ada_variant_discrim_name (var_type);
+  return (ada_lookup_struct_elt_type (outer_type, discrim_name, 0, 1, NULL) 
+         == NULL);
+}
+
+
 /* Assuming that VAR_TYPE is the type of a variant part of a record (a union),
    within a value of type OUTER_TYPE that is stored in GDB at
    OUTER_VALADDR, determine which variant clause (field number in VAR_TYPE,
@@ -6841,6 +6823,7 @@ empty_record (struct objfile *objfile)
   TYPE_CODE (type) = TYPE_CODE_STRUCT;
   TYPE_NFIELDS (type) = 0;
   TYPE_FIELDS (type) = NULL;
+  INIT_CPLUS_SPECIFIC (type);
   TYPE_NAME (type) = "<empty>";
   TYPE_TAG_NAME (type) = NULL;
   TYPE_LENGTH (type) = 0;
@@ -6962,7 +6945,7 @@ ada_template_to_fixed_record_type_1 (struct type *type,
     }
 
   /* We handle the variant part, if any, at the end because of certain
-     odd cases in which it is re-ordered so as NOT the last field of
+     odd cases in which it is re-ordered so as NOT to be the last field of
      the record.  This can happen in the presence of representation
      clauses.  */
   if (variant_field >= 0)
@@ -7209,7 +7192,8 @@ to_fixed_record_type (struct type *type0, const gdb_byte *valaddr,
    union type.  Any necessary discriminants' values should be in DVAL,
    a record value.  That is, this routine selects the appropriate
    branch of the union at ADDR according to the discriminant value
-   indicated in the union's type name.  */
+   indicated in the union's type name.  Returns VAR_TYPE0 itself if
+   it represents a variant subject to a pragma Unchecked_Union. */
 
 static struct type *
 to_fixed_variant_branch_type (struct type *var_type0, const gdb_byte *valaddr,
@@ -7229,6 +7213,8 @@ to_fixed_variant_branch_type (struct type *var_type0, const gdb_byte *valaddr,
   if (templ_type != NULL)
     var_type = templ_type;
 
+  if (is_unchecked_variant (var_type, value_type (dval)))
+      return var_type0;
   which =
     ada_which_variant_applies (var_type,
                                value_type (dval), value_contents (dval));
@@ -7371,6 +7357,46 @@ ada_to_fixed_type_1 (struct type *type, const gdb_byte *valaddr,
             if (real_type != NULL)
               return to_fixed_record_type (real_type, valaddr, address, NULL);
           }
+
+        /* Check to see if there is a parallel ___XVZ variable.
+           If there is, then it provides the actual size of our type.  */
+        else if (ada_type_name (fixed_record_type) != NULL)
+          {
+            char *name = ada_type_name (fixed_record_type);
+            char *xvz_name = alloca (strlen (name) + 7 /* "___XVZ\0" */);
+            int xvz_found = 0;
+            LONGEST size;
+
+            sprintf (xvz_name, "%s___XVZ", name);
+            size = get_int_var_value (xvz_name, &xvz_found);
+            if (xvz_found && TYPE_LENGTH (fixed_record_type) != size)
+              {
+                fixed_record_type = copy_type (fixed_record_type);
+                TYPE_LENGTH (fixed_record_type) = size;
+
+                /* The FIXED_RECORD_TYPE may have be a stub.  We have
+                   observed this when the debugging info is STABS, and
+                   apparently it is something that is hard to fix.
+
+                   In practice, we don't need the actual type definition
+                   at all, because the presence of the XVZ variable allows us
+                   to assume that there must be a XVS type as well, which we
+                   should be able to use later, when we need the actual type
+                   definition.
+
+                   In the meantime, pretend that the "fixed" type we are
+                   returning is NOT a stub, because this can cause trouble
+                   when using this type to create new types targeting it.
+                   Indeed, the associated creation routines often check
+                   whether the target type is a stub and will try to replace
+                   it, thus using a type with the wrong size. This, in turn,
+                   might cause the new type to have the wrong size too.
+                   Consider the case of an array, for instance, where the size
+                   of the array is computed from the number of elements in
+                   our array multiplied by the size of its element.  */
+                TYPE_STUB (fixed_record_type) = 0;
+              }
+          }
         return fixed_record_type;
       }
     case TYPE_CODE_ARRAY:
@@ -7598,9 +7624,9 @@ pos_atr (struct value *arg)
 }
 
 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.  */
@@ -8054,7 +8080,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
@@ -9062,21 +9088,29 @@ 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);
+      type = value_type (arg1);
+
+      /* If the argument is a reference, then dereference its type, since
+         the user is really asking for the size of the actual object,
+         not the size of the pointer.  */
+      if (TYPE_CODE (type) == TYPE_CODE_REF)
+        type = TYPE_TARGET_TYPE (type);
+
       if (noside == EVAL_SKIP)
         goto nosideret;
       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
         return value_zero (builtin_type_int32, not_lval);
       else
         return value_from_longest (builtin_type_int32,
-                                   TARGET_CHAR_BIT
-                                   * TYPE_LENGTH (value_type (arg1)));
+                                   TARGET_CHAR_BIT * TYPE_LENGTH (type));
 
     case OP_ATR_VAL:
       evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
@@ -9126,9 +9160,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
         return arg1;
 
     case UNOP_IND:
-      if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
-        expect_type = TYPE_TARGET_TYPE (ada_check_typedef (expect_type));
-      arg1 = evaluate_subexp (expect_type, exp, pos, noside);
+      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
       if (noside == EVAL_SKIP)
         goto nosideret;
       type = ada_check_typedef (value_type (arg1));
@@ -9154,22 +9186,34 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
               return value_zero (type, lval_memory);
             }
           else if (TYPE_CODE (type) == TYPE_CODE_INT)
-            /* GDB allows dereferencing an int.  */
-            return value_zero (builtin_type (exp->gdbarch)->builtin_int,
-                              lval_memory);
+           {
+             /* GDB allows dereferencing an int.  */
+             if (expect_type == NULL)
+               return value_zero (builtin_type (exp->gdbarch)->builtin_int,
+                                  lval_memory);
+             else
+               {
+                 expect_type = 
+                   to_static_fixed_type (ada_aligned_type (expect_type));
+                 return value_zero (expect_type, lval_memory);
+               }
+           }
           else
             error (_("Attempt to take contents of a non-pointer value."));
         }
       arg1 = ada_coerce_ref (arg1);     /* FIXME: What is this for?? */
       type = ada_check_typedef (value_type (arg1));
 
+      if (TYPE_CODE (type) == TYPE_CODE_INT && expect_type != NULL)
+         /* GDB allows dereferencing an int.  We give it the expected
+            type (which will be set in the case of a coercion or
+            qualification). */
+       return ada_value_ind (value_cast (lookup_pointer_type (expect_type),
+                                         arg1));
+
       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);
 
@@ -9503,7 +9547,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
@@ -9616,7 +9660,7 @@ ada_is_modular_type (struct type *type)
 ULONGEST
 ada_modulus (struct type * type)
 {
-  return (ULONGEST) TYPE_HIGH_BOUND (type) + 1;
+  return (ULONGEST) (unsigned int) TYPE_HIGH_BOUND (type) + 1;
 }
 \f
 
@@ -9668,6 +9712,15 @@ enum exception_catchpoint_kind
   ex_catch_assert
 };
 
+/* Ada's standard exceptions.  */
+
+static char *standard_exc[] = {
+  "constraint_error",
+  "program_error",
+  "storage_error",
+  "tasking_error"
+};
+
 typedef CORE_ADDR (ada_unhandled_exception_name_addr_ftype) (void);
 
 /* A structure that describes how to support exception catchpoints
@@ -9875,7 +9928,7 @@ is_known_support_routine (struct frame_info *frame)
 /* Find the first frame that contains debugging information and that is not
    part of the Ada run-time, starting from FI and moving upward.  */
 
-static void
+void
 ada_find_printable_frame (struct frame_info *fi)
 {
   for (; fi != NULL; fi = get_prev_frame (fi))
@@ -10047,7 +10100,10 @@ static void
 print_one_exception (enum exception_catchpoint_kind ex,
                      struct breakpoint *b, CORE_ADDR *last_addr)
 { 
-  if (addressprint)
+  struct value_print_options opts;
+
+  get_user_print_options (&opts);
+  if (opts.addressprint)
     {
       annotate_field (4);
       ui_out_field_core_addr (uiout, "addr", b->loc->address);
@@ -10139,6 +10195,9 @@ print_mention_catch_exception (struct breakpoint *b)
 
 static struct breakpoint_ops catch_exception_breakpoint_ops =
 {
+  NULL, /* insert */
+  NULL, /* remove */
+  NULL, /* breakpoint_hit */
   print_it_catch_exception,
   print_one_catch_exception,
   print_mention_catch_exception
@@ -10165,6 +10224,9 @@ print_mention_catch_exception_unhandled (struct breakpoint *b)
 }
 
 static struct breakpoint_ops catch_exception_unhandled_breakpoint_ops = {
+  NULL, /* insert */
+  NULL, /* remove */
+  NULL, /* breakpoint_hit */
   print_it_catch_exception_unhandled,
   print_one_catch_exception_unhandled,
   print_mention_catch_exception_unhandled
@@ -10191,6 +10253,9 @@ print_mention_catch_assert (struct breakpoint *b)
 }
 
 static struct breakpoint_ops catch_assert_breakpoint_ops = {
+  NULL, /* insert */
+  NULL, /* remove */
+  NULL, /* breakpoint_hit */
   print_it_catch_assert,
   print_one_catch_assert,
   print_mention_catch_assert
@@ -10352,6 +10417,35 @@ ada_exception_breakpoint_ops (enum exception_catchpoint_kind ex)
 static char *
 ada_exception_catchpoint_cond_string (const char *exp_string)
 {
+  int i;
+
+  /* The standard exceptions are a special case. They are defined in
+     runtime units that have been compiled without debugging info; if
+     EXP_STRING is the not-fully-qualified name of a standard
+     exception (e.g. "constraint_error") then, during the evaluation
+     of the condition expression, the symbol lookup on this name would
+     *not* return this standard exception. The catchpoint condition
+     may then be set only on user-defined exceptions which have the
+     same not-fully-qualified name (e.g. my_package.constraint_error).
+
+     To avoid this unexcepted behavior, these standard exceptions are
+     systematically prefixed by "standard". This means that "catch
+     exception constraint_error" is rewritten into "catch exception
+     standard.constraint_error".
+
+     If an exception named contraint_error is defined in another package of
+     the inferior program, then the only way to specify this exception as a
+     breakpoint condition is to use its fully-qualified named:
+     e.g. my_package.constraint_error.  */
+
+  for (i = 0; i < sizeof (standard_exc) / sizeof (char *); i++)
+    {
+      if (strcmp (standard_exc [i], exp_string) == 0)
+       {
+          return xstrprintf ("long_integer (e) = long_integer (&standard.%s)",
+                             exp_string);
+       }
+    }
   return xstrprintf ("long_integer (e) = long_integer (&%s)", exp_string);
 }
 
@@ -10958,6 +11052,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,
@@ -10966,6 +11061,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.034336 seconds and 4 git commands to generate.