Fix "breakpoint always-inserted off"; remove "breakpoint always-inserted auto"
[deliverable/binutils-gdb.git] / gdb / ada-lang.c
index e69ed8165ff48fdc779a2c3223fd9393b273501c..c7e50e285dd195c3f212a22066bdbc7e4bce49cd 100644 (file)
 
 
 #include "defs.h"
-#include <stdio.h>
-#include <string.h>
 #include <ctype.h>
-#include <stdarg.h>
 #include "demangle.h"
 #include "gdb_regex.h"
 #include "frame.h"
@@ -273,6 +270,45 @@ static void ada_forward_operator_length (struct expression *, int, int *,
 static struct type *ada_find_any_type (const char *name);
 \f
 
+/* The result of a symbol lookup to be stored in our symbol cache.  */
+
+struct cache_entry
+{
+  /* The name used to perform the lookup.  */
+  const char *name;
+  /* The namespace used during the lookup.  */
+  domain_enum namespace;
+  /* The symbol returned by the lookup, or NULL if no matching symbol
+     was found.  */
+  struct symbol *sym;
+  /* The block where the symbol was found, or NULL if no matching
+     symbol was found.  */
+  const struct block *block;
+  /* A pointer to the next entry with the same hash.  */
+  struct cache_entry *next;
+};
+
+/* The Ada symbol cache, used to store the result of Ada-mode symbol
+   lookups in the course of executing the user's commands.
+
+   The cache is implemented using a simple, fixed-sized hash.
+   The size is fixed on the grounds that there are not likely to be
+   all that many symbols looked up during any given session, regardless
+   of the size of the symbol table.  If we decide to go to a resizable
+   table, let's just use the stuff from libiberty instead.  */
+
+#define HASH_SIZE 1009
+
+struct ada_symbol_cache
+{
+  /* An obstack used to store the entries in our cache.  */
+  struct obstack cache_space;
+
+  /* The root of the hash table used to implement our symbol cache.  */
+  struct cache_entry *root[HASH_SIZE];
+};
+
+static void ada_free_symbol_cache (struct ada_symbol_cache *sym_cache);
 
 /* Maximum-sized dynamic type.  */
 static unsigned int varsize_limit;
@@ -318,7 +354,8 @@ static struct cmd_list_element *maint_show_ada_cmdlist;
 static void
 maint_set_ada_cmd (char *args, int from_tty)
 {
-  help_list (maint_set_ada_cmdlist, "maintenance set ada ", -1, gdb_stdout);
+  help_list (maint_set_ada_cmdlist, "maintenance set ada ", all_commands,
+            gdb_stdout);
 }
 
 /* Implement the "maintenance show ada" (prefix) command.  */
@@ -398,6 +435,51 @@ ada_inferior_exit (struct inferior *inf)
   set_inferior_data (inf, ada_inferior_data, NULL);
 }
 
+
+                       /* program-space-specific data.  */
+
+/* This module's per-program-space data.  */
+struct ada_pspace_data
+{
+  /* The Ada symbol cache.  */
+  struct ada_symbol_cache *sym_cache;
+};
+
+/* Key to our per-program-space data.  */
+static const struct program_space_data *ada_pspace_data_handle;
+
+/* Return this module's data for the given program space (PSPACE).
+   If not is found, add a zero'ed one now.
+
+   This function always returns a valid object.  */
+
+static struct ada_pspace_data *
+get_ada_pspace_data (struct program_space *pspace)
+{
+  struct ada_pspace_data *data;
+
+  data = program_space_data (pspace, ada_pspace_data_handle);
+  if (data == NULL)
+    {
+      data = XCNEW (struct ada_pspace_data);
+      set_program_space_data (pspace, ada_pspace_data_handle, data);
+    }
+
+  return data;
+}
+
+/* The cleanup callback for this module's per-program-space data.  */
+
+static void
+ada_pspace_data_cleanup (struct program_space *pspace, void *data)
+{
+  struct ada_pspace_data *pspace_data = data;
+
+  if (pspace_data->sym_cache != NULL)
+    ada_free_symbol_cache (pspace_data->sym_cache);
+  xfree (pspace_data);
+}
+
                         /* Utilities */
 
 /* If TYPE is a TYPE_CODE_TYPEDEF type, return the target type after
@@ -597,14 +679,12 @@ coerce_unspec_val_to_type (struct value *val, struct type *type)
       else
        {
          result = allocate_value (type);
-         memcpy (value_contents_raw (result), value_contents (val),
-                 TYPE_LENGTH (type));
+         value_contents_copy_raw (result, 0, val, 0, TYPE_LENGTH (type));
        }
       set_value_component_location (result, val);
       set_value_bitsize (result, value_bitsize (val));
       set_value_bitpos (result, value_bitpos (val));
       set_value_address (result, value_address (val));
-      set_value_optimized_out (result, value_optimized_out_const (val));
       return result;
     }
 }
@@ -709,6 +789,7 @@ min_of_type (struct type *t)
 LONGEST
 ada_discrete_type_high_bound (struct type *type)
 {
+  type = resolve_dynamic_type (type, 0);
   switch (TYPE_CODE (type))
     {
     case TYPE_CODE_RANGE:
@@ -729,6 +810,7 @@ ada_discrete_type_high_bound (struct type *type)
 LONGEST
 ada_discrete_type_low_bound (struct type *type)
 {
+  type = resolve_dynamic_type (type, 0);
   switch (TYPE_CODE (type))
     {
     case TYPE_CODE_RANGE:
@@ -810,7 +892,7 @@ enum language
 ada_update_initial_language (enum language lang)
 {
   if (lookup_minimal_symbol ("adainit", (const char *) NULL,
-                             (struct objfile *) NULL) != NULL)
+                             (struct objfile *) NULL).minsym != NULL)
     return language_ada;
 
   return lang;
@@ -823,7 +905,7 @@ ada_update_initial_language (enum language lang)
 char *
 ada_main_name (void)
 {
-  struct minimal_symbol *msym;
+  struct bound_minimal_symbol msym;
   static char *main_program_name = NULL;
 
   /* For Ada, the name of the main procedure is stored in a specific
@@ -833,12 +915,12 @@ ada_main_name (void)
      in Ada.  */
   msym = lookup_minimal_symbol (ADA_MAIN_PROGRAM_SYMBOL_NAME, NULL, NULL);
 
-  if (msym != NULL)
+  if (msym.minsym != NULL)
     {
       CORE_ADDR main_program_name_addr;
       int err_code;
 
-      main_program_name_addr = SYMBOL_VALUE_ADDRESS (msym);
+      main_program_name_addr = BMSYMBOL_VALUE_ADDRESS (msym);
       if (main_program_name_addr == 0)
         error (_("Invalid address for Ada main program name."));
 
@@ -1897,9 +1979,9 @@ ada_type_of_array (struct value *arr, int bounds)
           struct value *high = desc_one_bound (descriptor, arity, 1);
 
           arity -= 1;
-          create_range_type (range_type, value_type (low),
-                             longest_to_int (value_as_long (low)),
-                             longest_to_int (value_as_long (high)));
+          create_static_range_type (range_type, value_type (low),
+                                   longest_to_int (value_as_long (low)),
+                                   longest_to_int (value_as_long (high)));
           elt_type = create_array_type (array_type, elt_type, range_type);
 
          if (ada_is_unconstrained_packed_array_type (value_type (arr)))
@@ -2166,14 +2248,14 @@ decode_constrained_packed_array (struct value *arr)
 {
   struct type *type;
 
-  arr = ada_coerce_ref (arr);
-
-  /* If our value is a pointer, then dererence it.  Make sure that
-     this operation does not cause the target type to be fixed, as
-     this would indirectly cause this array to be decoded.  The rest
-     of the routine assumes that the array hasn't been decoded yet,
-     so we use the basic "value_ind" routine to perform the dereferencing,
-     as opposed to using "ada_value_ind".  */
+  /* If our value is a pointer, then dereference it. Likewise if
+     the value is a reference.  Make sure that this operation does not
+     cause the target type to be fixed, as this would indirectly cause
+     this array to be decoded.  The rest of the routine assumes that
+     the array hasn't been decoded yet, so we use the basic "coerce_ref"
+     and "value_ind" routines to perform the dereferencing, as opposed
+     to using "ada_coerce_ref" or "ada_value_ind".  */
+  arr = coerce_ref (arr);
   if (TYPE_CODE (ada_check_typedef (value_type (arr))) == TYPE_CODE_PTR)
     arr = value_ind (arr);
 
@@ -2322,6 +2404,7 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
   else if (VALUE_LVAL (obj) == lval_memory && value_lazy (obj))
     {
       v = value_at (type, value_address (obj));
+      type = value_type (v);
       bytes = (unsigned char *) alloca (len);
       read_memory (value_address (v) + offset, bytes, len);
     }
@@ -2632,15 +2715,16 @@ ada_value_subscript (struct value *arr, int arity, struct value **ind)
   return elt;
 }
 
-/* Assuming ARR is a pointer to a standard GDB array of type TYPE, the
-   value of the element of *ARR at the ARITY indices given in
-   IND.  Does not read the entire array into memory.  */
+/* Assuming ARR is a pointer to a GDB array, the value of the element
+   of *ARR at the ARITY indices given in IND.
+   Does not read the entire array into memory.  */
 
 static struct value *
-ada_value_ptr_subscript (struct value *arr, struct type *type, int arity,
-                         struct value **ind)
+ada_value_ptr_subscript (struct value *arr, int arity, struct value **ind)
 {
   int k;
+  struct type *type
+    = check_typedef (value_enclosing_type (ada_value_ind (arr)));
 
   for (k = 0; k < arity; k += 1)
     {
@@ -2670,9 +2754,10 @@ ada_value_slice_from_ptr (struct value *array_ptr, struct type *type,
   CORE_ADDR base = value_as_address (array_ptr)
     + ((low - ada_discrete_type_low_bound (TYPE_INDEX_TYPE (type0)))
        * TYPE_LENGTH (TYPE_TARGET_TYPE (type0)));
-  struct type *index_type =
-    create_range_type (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type0)),
-                       low, high);
+  struct type *index_type
+    = create_static_range_type (NULL,
+                               TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type0)),
+                               low, high);
   struct type *slice_type =
     create_array_type (NULL, TYPE_TARGET_TYPE (type0), index_type);
 
@@ -2684,8 +2769,8 @@ static struct value *
 ada_value_slice (struct value *array, int low, int high)
 {
   struct type *type = ada_check_typedef (value_type (array));
-  struct type *index_type =
-    create_range_type (NULL, TYPE_INDEX_TYPE (type), low, high);
+  struct type *index_type
+    = create_static_range_type (NULL, TYPE_INDEX_TYPE (type), low, high);
   struct type *slice_type =
     create_array_type (NULL, TYPE_TARGET_TYPE (type), index_type);
 
@@ -2857,7 +2942,11 @@ ada_array_bound_from_type (struct type *arr_type, int n, int which)
 static LONGEST
 ada_array_bound (struct value *arr, int n, int which)
 {
-  struct type *arr_type = value_type (arr);
+  struct type *arr_type;
+
+  if (TYPE_CODE (check_typedef (value_type (arr))) == TYPE_CODE_PTR)
+    arr = value_ind (arr);
+  arr_type = value_enclosing_type (arr);
 
   if (ada_is_constrained_packed_array_type (arr_type))
     return ada_array_bound (decode_constrained_packed_array (arr), n, which);
@@ -2876,7 +2965,11 @@ ada_array_bound (struct value *arr, int n, int which)
 static LONGEST
 ada_array_length (struct value *arr, int n)
 {
-  struct type *arr_type = ada_check_typedef (value_type (arr));
+  struct type *arr_type;
+
+  if (TYPE_CODE (check_typedef (value_type (arr))) == TYPE_CODE_PTR)
+    arr = value_ind (arr);
+  arr_type = value_enclosing_type (arr);
 
   if (ada_is_constrained_packed_array_type (arr_type))
     return ada_array_length (decode_constrained_packed_array (arr), n);
@@ -2896,9 +2989,9 @@ static struct value *
 empty_array (struct type *arr_type, int low)
 {
   struct type *arr_type0 = ada_check_typedef (arr_type);
-  struct type *index_type =
-    create_range_type (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (arr_type0)),
-                       low, low - 1);
+  struct type *index_type
+    = create_static_range_type
+        (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (arr_type0)),  low, low - 1);
   struct type *elt_type = ada_array_element_type (arr_type0, 1);
 
   return allocate_value (create_array_type (NULL, elt_type, index_type));
@@ -4079,7 +4172,7 @@ parse_old_style_renaming (struct type *type,
 
 static struct value *
 ada_read_renaming_var_value (struct symbol *renaming_sym,
-                            struct block *block)
+                            const struct block *block)
 {
   const char *sym_name;
   struct expression *expr;
@@ -4247,16 +4340,8 @@ make_array_descriptor (struct type *type, struct value *arr)
 \f
                                 /* Symbol Cache Module */
 
-/* This section implements a simple, fixed-sized hash table for those
-   Ada-mode symbols that get looked up in the course of executing the user's
-   commands.  The size is fixed on the grounds that there are not
-   likely to be all that many symbols looked up during any given
-   session, regardless of the size of the symbol table.  If we decide
-   to go to a resizable table, let's just use the stuff from libiberty
-   instead.  */
-
 /* Performance measurements made as of 2010-01-15 indicate that
-   this case does bring some noticeable improvements.  Depending
+   this cache does bring some noticeable improvements.  Depending
    on the type of entity being printed, the cache can make it as much
    as an order of magnitude faster than without it.
 
@@ -4265,40 +4350,52 @@ make_array_descriptor (struct type *type, struct value *arr)
    even in this case, some expensive name-based symbol searches are still
    sometimes necessary - to find an XVZ variable, mostly.  */
 
-#define HASH_SIZE 1009
+/* Initialize the contents of SYM_CACHE.  */
 
-/* The result of a symbol lookup to be stored in our cache.  */
+static void
+ada_init_symbol_cache (struct ada_symbol_cache *sym_cache)
+{
+  obstack_init (&sym_cache->cache_space);
+  memset (sym_cache->root, '\000', sizeof (sym_cache->root));
+}
 
-struct cache_entry
+/* Free the memory used by SYM_CACHE.  */
+
+static void
+ada_free_symbol_cache (struct ada_symbol_cache *sym_cache)
 {
-  /* The name used to perform the lookup.  */
-  const char *name;
-  /* The namespace used during the lookup.  */
-  domain_enum namespace;
-  /* The symbol returned by the lookup, or NULL if no matching symbol
-     was found.  */
-  struct symbol *sym;
-  /* The block where the symbol was found, or NULL if no matching
-     symbol was found.  */
-  const struct block *block;
-  /* A pointer to the next entry with the same hash.  */
-  struct cache_entry *next;
-};
+  obstack_free (&sym_cache->cache_space, NULL);
+  xfree (sym_cache);
+}
 
-/* An obstack used to store the entries in our cache.  */
-static struct obstack cache_space;
+/* Return the symbol cache associated to the given program space PSPACE.
+   If not allocated for this PSPACE yet, allocate and initialize one.  */
+
+static struct ada_symbol_cache *
+ada_get_symbol_cache (struct program_space *pspace)
+{
+  struct ada_pspace_data *pspace_data = get_ada_pspace_data (pspace);
+  struct ada_symbol_cache *sym_cache = pspace_data->sym_cache;
+
+  if (sym_cache == NULL)
+    {
+      sym_cache = XCNEW (struct ada_symbol_cache);
+      ada_init_symbol_cache (sym_cache);
+    }
 
-/* The root of the hash table used to implement our symbol cache.  */
-static struct cache_entry *cache[HASH_SIZE];
+  return sym_cache;
+}
 
 /* Clear all entries from the symbol cache.  */
 
 static void
 ada_clear_symbol_cache (void)
 {
-  obstack_free (&cache_space, NULL);
-  obstack_init (&cache_space);
-  memset (cache, '\000', sizeof (cache));
+  struct ada_symbol_cache *sym_cache
+    = ada_get_symbol_cache (current_program_space);
+
+  obstack_free (&sym_cache->cache_space, NULL);
+  ada_init_symbol_cache (sym_cache);
 }
 
 /* Search our cache for an entry matching NAME and NAMESPACE.
@@ -4307,10 +4404,12 @@ ada_clear_symbol_cache (void)
 static struct cache_entry **
 find_entry (const char *name, domain_enum namespace)
 {
+  struct ada_symbol_cache *sym_cache
+    = ada_get_symbol_cache (current_program_space);
   int h = msymbol_hash (name) % HASH_SIZE;
   struct cache_entry **e;
 
-  for (e = &cache[h]; *e != NULL; e = &(*e)->next)
+  for (e = &sym_cache->root[h]; *e != NULL; e = &(*e)->next)
     {
       if (namespace == (*e)->namespace && strcmp (name, (*e)->name) == 0)
         return e;
@@ -4346,6 +4445,8 @@ static void
 cache_symbol (const char *name, domain_enum namespace, struct symbol *sym,
               const struct block *block)
 {
+  struct ada_symbol_cache *sym_cache
+    = ada_get_symbol_cache (current_program_space);
   int h;
   char *copy;
   struct cache_entry *e;
@@ -4360,10 +4461,11 @@ cache_symbol (const char *name, domain_enum namespace, struct symbol *sym,
     return;
 
   h = msymbol_hash (name) % HASH_SIZE;
-  e = (struct cache_entry *) obstack_alloc (&cache_space, sizeof (*e));
-  e->next = cache[h];
-  cache[h] = e;
-  e->name = copy = obstack_alloc (&cache_space, strlen (name) + 1);
+  e = (struct cache_entry *) obstack_alloc (&sym_cache->cache_space,
+                                           sizeof (*e));
+  e->next = sym_cache->root[h];
+  sym_cache->root[h] = e;
+  e->name = copy = obstack_alloc (&sym_cache->cache_space, strlen (name) + 1);
   strcpy (copy, name);
   e->sym = sym;
   e->namespace = namespace;
@@ -4568,7 +4670,7 @@ ada_lookup_simple_minsym (const char *name)
 
   ALL_MSYMBOLS (objfile, msymbol)
   {
-    if (match_name (SYMBOL_LINKAGE_NAME (msymbol), name, wild_match_p)
+    if (match_name (MSYMBOL_LINKAGE_NAME (msymbol), name, wild_match_p)
         && MSYMBOL_TYPE (msymbol) != mst_solib_trampoline)
       {
        result.minsym = msymbol;
@@ -6035,7 +6137,7 @@ ada_make_symbol_completion_list (const char *text0, const char *word,
   struct symtab *s;
   struct minimal_symbol *msymbol;
   struct objfile *objfile;
-  struct block *b, *surrounding_static_block = 0;
+  const struct block *b, *surrounding_static_block = 0;
   int i;
   struct block_iterator iter;
   struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
@@ -6089,7 +6191,7 @@ ada_make_symbol_completion_list (const char *text0, const char *word,
   ALL_MSYMBOLS (objfile, msymbol)
   {
     QUIT;
-    symbol_completion_add (&completions, SYMBOL_LINKAGE_NAME (msymbol),
+    symbol_completion_add (&completions, MSYMBOL_LINKAGE_NAME (msymbol),
                           text, text_len, text0, word, wild_match_p,
                           encoded_p);
   }
@@ -7254,7 +7356,11 @@ ada_which_variant_applies (struct type *var_type, struct type *outer_type,
   struct value *discrim;
   LONGEST discrim_val;
 
-  outer = value_from_contents_and_address (outer_type, outer_valaddr, 0);
+  /* Using plain value_from_contents_and_address here causes problems
+     because we will end up trying to resolve a type that is currently
+     being constructed.  */
+  outer = value_from_contents_and_address_unresolved (outer_type,
+                                                     outer_valaddr, 0);
   discrim = ada_value_struct_elt (outer, discrim_name, 1);
   if (discrim == NULL)
     return -1;
@@ -7793,7 +7899,14 @@ ada_template_to_fixed_record_type_1 (struct type *type,
                 GDB may fail to allocate a value for it.  So check the
                 size first before creating the value.  */
              check_size (rtype);
-             dval = value_from_contents_and_address (rtype, valaddr, address);
+             /* Using plain value_from_contents_and_address here
+                causes problems because we will end up trying to
+                resolve a type that is currently being
+                constructed.  */
+             dval = value_from_contents_and_address_unresolved (rtype,
+                                                                valaddr,
+                                                                address);
+             rtype = value_type (dval);
            }
           else
             dval = dval0;
@@ -7896,7 +8009,14 @@ ada_template_to_fixed_record_type_1 (struct type *type,
       off = TYPE_FIELD_BITPOS (rtype, variant_field);
 
       if (dval0 == NULL)
-        dval = value_from_contents_and_address (rtype, valaddr, address);
+       {
+         /* Using plain value_from_contents_and_address here causes
+            problems because we will end up trying to resolve a type
+            that is currently being constructed.  */
+         dval = value_from_contents_and_address_unresolved (rtype, valaddr,
+                                                            address);
+         rtype = value_type (dval);
+       }
       else
         dval = dval0;
 
@@ -8037,7 +8157,10 @@ to_record_with_fixed_variant_part (struct type *type, const gdb_byte *valaddr,
     return type;
 
   if (dval0 == NULL)
-    dval = value_from_contents_and_address (type, valaddr, address);
+    {
+      dval = value_from_contents_and_address (type, valaddr, address);
+      type = value_type (dval);
+    }
   else
     dval = dval0;
 
@@ -8335,6 +8458,7 @@ ada_to_fixed_type_1 (struct type *type, const gdb_byte *valaddr,
              value_from_contents_and_address (fixed_record_type,
                                               valaddr,
                                               address);
+            fixed_record_type = value_type (obj);
             if (real_type != NULL)
               return to_fixed_record_type
                (real_type, NULL,
@@ -9785,6 +9909,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
   enum exp_opcode op;
   int tem;
   int pc;
+  int preeval_pos;
   struct value *arg1 = NULL, *arg2 = NULL, *arg3;
   struct type *type;
   int nargs, oplen;
@@ -10003,13 +10128,15 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
           *pos += 4;
           goto nosideret;
         }
-      else if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
+
+      if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
         /* Only encountered when an unresolved symbol occurs in a
            context other than a function call, in which case, it is
            invalid.  */
         error (_("Unexpected unresolved symbol, %s, during evaluation"),
                SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol));
-      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
+
+      if (noside == EVAL_AVOID_SIDE_EFFECTS)
         {
           type = static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
           /* Check to see if this is a tagged type.  We also need to handle
@@ -10018,65 +10145,74 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
              The latter should be shown as usual (as a pointer), whereas
              a reference should mostly be transparent to the user.  */
           if (ada_is_tagged_type (type, 0)
-              || (TYPE_CODE(type) == TYPE_CODE_REF
+              || (TYPE_CODE (type) == TYPE_CODE_REF
                   && ada_is_tagged_type (TYPE_TARGET_TYPE (type), 0)))
-          {
-            /* Tagged types are a little special in the fact that the real
-               type is dynamic and can only be determined by inspecting the
-               object's tag.  This means that we need to get the object's
-               value first (EVAL_NORMAL) and then extract the actual object
-               type from its tag.
-
-               Note that we cannot skip the final step where we extract
-               the object type from its tag, because the EVAL_NORMAL phase
-               results in dynamic components being resolved into fixed ones.
-               This can cause problems when trying to print the type
-               description of tagged types whose parent has a dynamic size:
-               We use the type name of the "_parent" component in order
-               to print the name of the ancestor type in the type description.
-               If that component had a dynamic size, the resolution into
-               a fixed type would result in the loss of that type name,
-               thus preventing us from printing the name of the ancestor
-               type in the type description.  */
-            arg1 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
-
-           if (TYPE_CODE (type) != TYPE_CODE_REF)
-             {
-               struct type *actual_type;
-
-               actual_type = type_from_tag (ada_value_tag (arg1));
-               if (actual_type == NULL)
-                 /* If, for some reason, we were unable to determine
-                    the actual type from the tag, then use the static
-                    approximation that we just computed as a fallback.
-                    This can happen if the debugging information is
-                    incomplete, for instance.  */
-                 actual_type = type;
-               return value_zero (actual_type, not_lval);
-             }
-           else
-             {
-               /* In the case of a ref, ada_coerce_ref takes care
-                  of determining the actual type.  But the evaluation
-                  should return a ref as it should be valid to ask
-                  for its address; so rebuild a ref after coerce.  */
-               arg1 = ada_coerce_ref (arg1);
-               return value_ref (arg1);
-             }
-          }
+           {
+             /* Tagged types are a little special in the fact that the real
+                type is dynamic and can only be determined by inspecting the
+                object's tag.  This means that we need to get the object's
+                value first (EVAL_NORMAL) and then extract the actual object
+                type from its tag.
+
+                Note that we cannot skip the final step where we extract
+                the object type from its tag, because the EVAL_NORMAL phase
+                results in dynamic components being resolved into fixed ones.
+                This can cause problems when trying to print the type
+                description of tagged types whose parent has a dynamic size:
+                We use the type name of the "_parent" component in order
+                to print the name of the ancestor type in the type description.
+                If that component had a dynamic size, the resolution into
+                a fixed type would result in the loss of that type name,
+                thus preventing us from printing the name of the ancestor
+                type in the type description.  */
+             arg1 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_NORMAL);
+
+             if (TYPE_CODE (type) != TYPE_CODE_REF)
+               {
+                 struct type *actual_type;
+
+                 actual_type = type_from_tag (ada_value_tag (arg1));
+                 if (actual_type == NULL)
+                   /* If, for some reason, we were unable to determine
+                      the actual type from the tag, then use the static
+                      approximation that we just computed as a fallback.
+                      This can happen if the debugging information is
+                      incomplete, for instance.  */
+                   actual_type = type;
+                 return value_zero (actual_type, not_lval);
+               }
+             else
+               {
+                 /* In the case of a ref, ada_coerce_ref takes care
+                    of determining the actual type.  But the evaluation
+                    should return a ref as it should be valid to ask
+                    for its address; so rebuild a ref after coerce.  */
+                 arg1 = ada_coerce_ref (arg1);
+                 return value_ref (arg1);
+               }
+           }
 
-          *pos += 4;
-          return value_zero
-            (to_static_fixed_type
-             (static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol))),
-             not_lval);
-        }
-      else
-        {
-          arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
-          return ada_to_fixed_value (arg1);
+         /* Records and unions for which GNAT encodings have been
+            generated need to be statically fixed as well.
+            Otherwise, non-static fixing produces a type where
+            all dynamic properties are removed, which prevents "ptype"
+            from being able to completely describe the type.
+            For instance, a case statement in a variant record would be
+            replaced by the relevant components based on the actual
+            value of the discriminants.  */
+         if ((TYPE_CODE (type) == TYPE_CODE_STRUCT
+              && dynamic_template_type (type) != NULL)
+             || (TYPE_CODE (type) == TYPE_CODE_UNION
+                 && ada_find_parallel_type (type, "___XVU") != NULL))
+           {
+             *pos += 4;
+             return value_zero (to_static_fixed_type (type), not_lval);
+           }
         }
 
+      arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
+      return ada_to_fixed_value (arg1);
+
     case OP_FUNCALL:
       (*pos) += 2;
 
@@ -10196,9 +10332,9 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
                           (ada_coerce_to_simple_array (argvec[0]),
                            nargs, argvec + 1));
         case TYPE_CODE_PTR:     /* Pointer to array */
-          type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
           if (noside == EVAL_AVOID_SIDE_EFFECTS)
             {
+             type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
               type = ada_array_element_type (type, nargs);
               if (type == NULL)
                 error (_("element type of array unknown"));
@@ -10206,8 +10342,8 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
                 return value_zero (ada_aligned_type (type), lval_memory);
             }
           return
-            unwrap_value (ada_value_ptr_subscript (argvec[0], type,
-                                                   nargs, argvec + 1));
+            unwrap_value (ada_value_ptr_subscript (argvec[0],
+                                                  nargs, argvec + 1));
 
         default:
           error (_("Attempt to index or call something other than an "
@@ -10620,6 +10756,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
         return arg1;
 
     case UNOP_IND:
+      preeval_pos = *pos;
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
       if (noside == EVAL_SKIP)
         goto nosideret;
@@ -10640,10 +10777,26 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
                    /* In C you can dereference an array to get the 1st elt.  */
                    || TYPE_CODE (type) == TYPE_CODE_ARRAY)
             {
-              type = to_static_fixed_type
-                (ada_aligned_type
-                 (ada_check_typedef (TYPE_TARGET_TYPE (type))));
-              check_size (type);
+            /* As mentioned in the OP_VAR_VALUE case, tagged types can
+               only be determined by inspecting the object's tag.
+               This means that we need to evaluate completely the
+               expression in order to get its type.  */
+
+             if ((TYPE_CODE (type) == TYPE_CODE_REF
+                  || TYPE_CODE (type) == TYPE_CODE_PTR)
+                 && ada_is_tagged_type (TYPE_TARGET_TYPE (type), 0))
+               {
+                 arg1 = evaluate_subexp (NULL_TYPE, exp, &preeval_pos,
+                                         EVAL_NORMAL);
+                 type = value_type (ada_value_ind (arg1));
+               }
+             else
+               {
+                 type = to_static_fixed_type
+                   (ada_aligned_type
+                    (ada_check_typedef (TYPE_TARGET_TYPE (type))));
+               }
+             check_size (type);
               return value_zero (type, lval_memory);
             }
           else if (TYPE_CODE (type) == TYPE_CODE_INT)
@@ -10687,6 +10840,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
     case STRUCTOP_STRUCT:
       tem = longest_to_int (exp->elts[pc + 1].longconst);
       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
+      preeval_pos = *pos;
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
       if (noside == EVAL_SKIP)
         goto nosideret;
@@ -10699,13 +10853,21 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
               type = ada_lookup_struct_elt_type (type1,
                                                  &exp->elts[pc + 2].string,
                                                  1, 1, NULL);
+
+             /* If the field is not found, check if it exists in the
+                extension of this object's type. This means that we
+                need to evaluate completely the expression.  */
+
               if (type == NULL)
-                /* In this case, we assume that the field COULD exist
-                   in some extension of the type.  Return an object of 
-                   "type" void, which will match any formal 
-                   (see ada_type_match).  */
-                return value_zero (builtin_type (exp->gdbarch)->builtin_void,
-                                  lval_memory);
+               {
+                 arg1 = evaluate_subexp (NULL_TYPE, exp, &preeval_pos,
+                                         EVAL_NORMAL);
+                 arg1 = ada_value_struct_elt (arg1,
+                                              &exp->elts[pc + 2].string,
+                                              0);
+                 arg1 = unwrap_value (arg1);
+                 type = value_type (ada_to_fixed_value (arg1));
+               }
             }
           else
             type =
@@ -11000,9 +11162,8 @@ to_fixed_range_type (struct type *raw_type, struct value *dval)
       if (L < INT_MIN || U > INT_MAX)
        return raw_type;
       else
-       return create_range_type (alloc_type_copy (raw_type), raw_type,
-                                 ada_discrete_type_low_bound (raw_type),
-                                 ada_discrete_type_high_bound (raw_type));
+       return create_static_range_type (alloc_type_copy (raw_type), raw_type,
+                                        L, U);
     }
   else
     {
@@ -11065,7 +11226,8 @@ to_fixed_range_type (struct type *raw_type, struct value *dval)
             }
         }
 
-      type = create_range_type (alloc_type_copy (raw_type), base_type, L, U);
+      type = create_static_range_type (alloc_type_copy (raw_type),
+                                      base_type, L, U);
       TYPE_NAME (type) = name;
       return type;
     }
@@ -11129,7 +11291,19 @@ ada_modulus (struct type *type)
    variants of the runtime, we use a sniffer that will determine
    the runtime variant used by the program being debugged.  */
 
-/* Ada's standard exceptions.  */
+/* Ada's standard exceptions.
+
+   The Ada 83 standard also defined Numeric_Error.  But there so many
+   situations where it was unclear from the Ada 83 Reference Manual
+   (RM) whether Constraint_Error or Numeric_Error should be raised,
+   that the ARG (Ada Rapporteur Group) eventually issued a Binding
+   Interpretation saying that anytime the RM says that Numeric_Error
+   should be raised, the implementation may raise Constraint_Error.
+   Ada 95 went one step further and pretty much removed Numeric_Error
+   from the list of standard exceptions (it made it a renaming of
+   Constraint_Error, to help preserve compatibility when compiling
+   an Ada83 compiler). As such, we do not include Numeric_Error from
+   this list of standard exceptions.  */
 
 static char *standard_exc[] = {
   "constraint_error",
@@ -11224,10 +11398,10 @@ ada_has_this_exception_support (const struct exception_support_info *einfo)
         the name of the exception being raised (this name is printed in
         the catchpoint message, and is also used when trying to catch
         a specific exception).  We do not handle this case for now.  */
-      struct minimal_symbol *msym
+      struct bound_minimal_symbol msym
        = lookup_minimal_symbol (einfo->catch_exception_sym, NULL, NULL);
 
-      if (msym && MSYMBOL_TYPE (msym) != mst_solib_trampoline)
+      if (msym.minsym && MSYMBOL_TYPE (msym.minsym) != mst_solib_trampoline)
        error (_("Your Ada runtime appears to be missing some debugging "
                 "information.\nCannot insert Ada exception catchpoint "
                 "in this configuration."));
@@ -12580,7 +12754,7 @@ ada_add_standard_exceptions (regex_t *preg, VEC(ada_exc_info) **exceptions)
          if (msymbol.minsym != NULL)
            {
              struct ada_exc_info info
-               = {standard_exc[i], SYMBOL_VALUE_ADDRESS (msymbol.minsym)};
+               = {standard_exc[i], BMSYMBOL_VALUE_ADDRESS (msymbol)};
 
              VEC_safe_push (ada_exc_info, *exceptions, &info);
            }
@@ -12602,7 +12776,7 @@ static void
 ada_add_exceptions_from_frame (regex_t *preg, struct frame_info *frame,
                               VEC(ada_exc_info) **exceptions)
 {
-  struct block *block = get_frame_block (frame, 0);
+  const struct block *block = get_frame_block (frame, 0);
 
   while (block != 0)
     {
@@ -12663,7 +12837,7 @@ ada_add_global_exceptions (regex_t *preg, VEC(ada_exc_info) **exceptions)
 
   ALL_PRIMARY_SYMTABS (objfile, s)
     {
-      struct blockvector *bv = BLOCKVECTOR (s);
+      const struct blockvector *bv = BLOCKVECTOR (s);
       int i;
 
       for (i = GLOBAL_BLOCK; i <= STATIC_BLOCK; i++)
@@ -13256,10 +13430,10 @@ emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
 }
 
 static int
-parse (void)
+parse (struct parser_state *ps)
 {
   warnings_issued = 0;
-  return ada_parse ();
+  return ada_parse (ps);
 }
 
 static const struct exp_descriptor ada_exp_descriptor = {
@@ -13288,7 +13462,7 @@ ada_get_symbol_name_cmp (const char *lookup_name)
 static struct value *
 ada_read_var_value (struct symbol *var, struct frame_info *frame)
 {
-  struct block *frame_block = NULL;
+  const struct block *frame_block = NULL;
   struct symbol *renaming_sym = NULL;
 
   /* The only case where default_read_var_value is not sufficient
@@ -13362,7 +13536,7 @@ set_ada_command (char *arg, int from_tty)
 {
   printf_unfiltered (_(\
 "\"set ada\" must be followed by the name of a setting.\n"));
-  help_list (set_ada_list, "set ada ", -1, gdb_stdout);
+  help_list (set_ada_list, "set ada ", all_commands, gdb_stdout);
 }
 
 /* Implement the "show ada" prefix command.  */
@@ -13503,7 +13677,6 @@ DWARF attribute."),
      NULL, NULL, &maint_set_ada_cmdlist, &maint_show_ada_cmdlist);
 
   obstack_init (&symbol_list_obstack);
-  obstack_init (&cache_space);
 
   decoded_names_store = htab_create_alloc
     (256, htab_hash_string, (int (*)(const void *, const void *)) streq,
@@ -13512,9 +13685,11 @@ DWARF attribute."),
   /* The ada-lang observers.  */
   observer_attach_new_objfile (ada_new_objfile_observer);
   observer_attach_free_objfile (ada_free_objfile_observer);
-
-  /* Setup per-inferior data.  */
   observer_attach_inferior_exit (ada_inferior_exit);
+
+  /* Setup various context-specific data.  */
   ada_inferior_data
     = register_inferior_data_with_cleanup (NULL, ada_inferior_data_cleanup);
+  ada_pspace_data_handle
+    = register_program_space_data_with_cleanup (NULL, ada_pspace_data_cleanup);
 }
This page took 0.042658 seconds and 4 git commands to generate.