Remove stale -DNO_PROTOTYPES bits from gdb testsuite
[deliverable/binutils-gdb.git] / gdb / ada-lang.c
index 825549d86e9b53a713380a962951a05ff3879c72..98508c168bc127d2c22dde4c6cb326da4ce6dfa4 100644 (file)
@@ -196,6 +196,8 @@ static LONGEST pos_atr (struct value *);
 
 static struct value *value_pos_atr (struct type *, struct value *);
 
+static struct value *val_atr (struct type *, LONGEST);
+
 static struct value *value_val_atr (struct type *, struct value *);
 
 static struct symbol *standard_lookup (const char *, const struct block *,
@@ -213,9 +215,6 @@ static int ada_resolve_function (struct block_symbol *, int,
 
 static int ada_is_direct_array_type (struct type *);
 
-static void ada_language_arch_info (struct gdbarch *,
-                                   struct language_arch_info *);
-
 static struct value *ada_index_struct_field (int, struct value *, int,
                                             struct type *);
 
@@ -489,33 +488,6 @@ add_angle_brackets (const char *str)
   return string_printf ("<%s>", str);
 }
 
-static const char *
-ada_get_gdb_completer_word_break_characters (void)
-{
-  return ada_completer_word_break_characters;
-}
-
-/* Print an array element index using the Ada syntax.  */
-
-static void
-ada_print_array_index (struct value *index_value, struct ui_file *stream,
-                       const struct value_print_options *options)
-{
-  LA_VALUE_PRINT (index_value, stream, options);
-  fprintf_filtered (stream, " => ");
-}
-
-/* la_watch_location_expression for Ada.  */
-
-static gdb::unique_xmalloc_ptr<char>
-ada_watch_location_expression (struct type *type, CORE_ADDR addr)
-{
-  type = check_typedef (TYPE_TARGET_TYPE (check_typedef (type)));
-  std::string name = type_to_string (type);
-  return gdb::unique_xmalloc_ptr<char>
-    (xstrprintf ("{%s} %s", name.c_str (), core_addr_to_string (addr)));
-}
-
 /* Assuming V points to an array of S objects,  make sure that it contains at
    least M objects, updating V and S as necessary.  */
 
@@ -571,7 +543,7 @@ ada_get_field_index (const struct type *type, const char *field_name,
   int fieldno;
   struct type *struct_type = check_typedef ((struct type *) type);
 
-  for (fieldno = 0; fieldno < TYPE_NFIELDS (struct_type); fieldno++)
+  for (fieldno = 0; fieldno < struct_type->num_fields (); fieldno++)
     if (field_name_match (TYPE_FIELD_NAME (struct_type, fieldno), field_name))
       return fieldno;
 
@@ -755,7 +727,7 @@ ada_discrete_type_high_bound (struct type *type)
     case TYPE_CODE_RANGE:
       return TYPE_HIGH_BOUND (type);
     case TYPE_CODE_ENUM:
-      return TYPE_FIELD_ENUMVAL (type, TYPE_NFIELDS (type) - 1);
+      return TYPE_FIELD_ENUMVAL (type, type->num_fields () - 1);
     case TYPE_CODE_BOOL:
       return 1;
     case TYPE_CODE_CHAR:
@@ -876,18 +848,11 @@ ada_main_name (void)
 
   if (msym.minsym != NULL)
     {
-      CORE_ADDR main_program_name_addr;
-      int err_code;
-
-      main_program_name_addr = BMSYMBOL_VALUE_ADDRESS (msym);
+      CORE_ADDR main_program_name_addr = BMSYMBOL_VALUE_ADDRESS (msym);
       if (main_program_name_addr == 0)
         error (_("Invalid address for Ada main program name."));
 
-      target_read_string (main_program_name_addr, &main_program_name,
-                          1024, &err_code);
-
-      if (err_code != 0)
-        return NULL;
+      main_program_name = target_read_string (main_program_name_addr, 1024);
       return main_program_name.get ();
     }
 
@@ -1388,45 +1353,6 @@ ada_la_decode (const char *encoded, int options)
   return xstrdup (ada_decode (encoded).c_str ());
 }
 
-/* Implement la_sniff_from_mangled_name for Ada.  */
-
-static int
-ada_sniff_from_mangled_name (const char *mangled, char **out)
-{
-  std::string demangled = ada_decode (mangled);
-
-  *out = NULL;
-
-  if (demangled != mangled && demangled[0] != '<')
-    {
-      /* Set the gsymbol language to Ada, but still return 0.
-        Two reasons for that:
-
-        1. For Ada, we prefer computing the symbol's decoded name
-        on the fly rather than pre-compute it, in order to save
-        memory (Ada projects are typically very large).
-
-        2. There are some areas in the definition of the GNAT
-        encoding where, with a bit of bad luck, we might be able
-        to decode a non-Ada symbol, generating an incorrect
-        demangled name (Eg: names ending with "TB" for instance
-        are identified as task bodies and so stripped from
-        the decoded name returned).
-
-        Returning 1, here, but not setting *DEMANGLED, helps us get a
-        little bit of the best of both worlds.  Because we're last,
-        we should not affect any of the other languages that were
-        able to demangle the symbol before us; we get to correctly
-        tag Ada symbols as such; and even if we incorrectly tagged a
-        non-Ada symbol, which should be rare, any routing through the
-        Ada language should be transparent (Ada tries to behave much
-        like C/C++ with non-Ada symbols).  */
-      return 1;
-    }
-
-  return 0;
-}
-
 \f
 
                                 /* Arrays */
@@ -1461,7 +1387,7 @@ ada_fixup_array_indexes_type (struct type *index_desc_type)
 
   if (index_desc_type == NULL)
     return;
-  gdb_assert (TYPE_NFIELDS (index_desc_type) > 0);
+  gdb_assert (index_desc_type->num_fields () > 0);
 
   /* Check if INDEX_DESC_TYPE follows the older encoding (it is sufficient
      to check one field only, no need to check them all).  If not, return
@@ -1470,34 +1396,22 @@ ada_fixup_array_indexes_type (struct type *index_desc_type)
      If our INDEX_DESC_TYPE was generated using the older encoding,
      the field type should be a meaningless integer type whose name
      is not equal to the field name.  */
-  if (TYPE_FIELD_TYPE (index_desc_type, 0)->name () != NULL
-      && strcmp (TYPE_FIELD_TYPE (index_desc_type, 0)->name (),
+  if (index_desc_type->field (0).type ()->name () != NULL
+      && strcmp (index_desc_type->field (0).type ()->name (),
                  TYPE_FIELD_NAME (index_desc_type, 0)) == 0)
     return;
 
   /* Fixup each field of INDEX_DESC_TYPE.  */
-  for (i = 0; i < TYPE_NFIELDS (index_desc_type); i++)
+  for (i = 0; i < index_desc_type->num_fields (); i++)
    {
      const char *name = TYPE_FIELD_NAME (index_desc_type, i);
      struct type *raw_type = ada_check_typedef (ada_find_any_type (name));
 
      if (raw_type)
-       TYPE_FIELD_TYPE (index_desc_type, i) = raw_type;
+       index_desc_type->field (i).set_type (raw_type);
    }
 }
 
-/* Names of MAX_ADA_DIMENS bounds in P_BOUNDS fields of array descriptors.  */
-
-static const char *bound_name[] = {
-  "LB0", "UB0", "LB1", "UB1", "LB2", "UB2", "LB3", "UB3",
-  "LB4", "UB4", "LB5", "UB5", "LB6", "UB6", "LB7", "UB7"
-};
-
-/* Maximum number of array dimensions we are prepared to handle.  */
-
-#define MAX_ADA_DIMENS (sizeof(bound_name) / (2*sizeof(char *)))
-
-
 /* The desc_* routines return primitive portions of array descriptors
    (fat pointers).  */
 
@@ -1684,7 +1598,7 @@ fat_pntr_bounds_bitsize (struct type *type)
   if (TYPE_FIELD_BITSIZE (type, 1) > 0)
     return TYPE_FIELD_BITSIZE (type, 1);
   else
-    return 8 * TYPE_LENGTH (ada_check_typedef (TYPE_FIELD_TYPE (type, 1)));
+    return 8 * TYPE_LENGTH (ada_check_typedef (type->field (1).type ()));
 }
 
 /* If TYPE is the type of an array descriptor (fat or thin pointer) or a
@@ -1699,7 +1613,7 @@ desc_data_target_type (struct type *type)
 
   /* NOTE: The following is bogus; see comment in desc_bounds.  */
   if (is_thin_pntr (type))
-    return desc_base_type (TYPE_FIELD_TYPE (thin_descriptor_type (type), 1));
+    return desc_base_type (thin_descriptor_type (type)->field (1).type ());
   else if (is_thick_pntr (type))
     {
       struct type *data_type = lookup_struct_elt_type (type, "P_ARRAY", 1);
@@ -1750,7 +1664,7 @@ fat_pntr_data_bitsize (struct type *type)
   if (TYPE_FIELD_BITSIZE (type, 0) > 0)
     return TYPE_FIELD_BITSIZE (type, 0);
   else
-    return TARGET_CHAR_BIT * TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0));
+    return TARGET_CHAR_BIT * TYPE_LENGTH (type->field (0).type ());
 }
 
 /* If BOUNDS is an array-bounds structure (or pointer to one), return
@@ -1760,7 +1674,10 @@ fat_pntr_data_bitsize (struct type *type)
 static struct value *
 desc_one_bound (struct value *bounds, int i, int which)
 {
-  return value_struct_elt (&bounds, NULL, bound_name[2 * i + which - 2], NULL,
+  char bound_name[20];
+  xsnprintf (bound_name, sizeof (bound_name), "%cB%d",
+            which ? 'U' : 'L', i - 1);
+  return value_struct_elt (&bounds, NULL, bound_name, NULL,
                            _("Bad GNAT array descriptor bounds"));
 }
 
@@ -1786,7 +1703,7 @@ desc_bound_bitsize (struct type *type, int i, int which)
   if (TYPE_FIELD_BITSIZE (type, 2 * i + which - 2) > 0)
     return TYPE_FIELD_BITSIZE (type, 2 * i + which - 2);
   else
-    return 8 * TYPE_LENGTH (TYPE_FIELD_TYPE (type, 2 * i + which - 2));
+    return 8 * TYPE_LENGTH (type->field (2 * i + which - 2).type ());
 }
 
 /* If TYPE is the type of an array-bounds structure, the type of its
@@ -1798,7 +1715,11 @@ desc_index_type (struct type *type, int i)
   type = desc_base_type (type);
 
   if (type->code () == TYPE_CODE_STRUCT)
-    return lookup_struct_elt_type (type, bound_name[2 * i - 2], 1);
+    {
+      char bound_name[20];
+      xsnprintf (bound_name, sizeof (bound_name), "LB%d", i - 1);
+      return lookup_struct_elt_type (type, bound_name, 1);
+    }
   else
     return NULL;
 }
@@ -1812,7 +1733,7 @@ desc_arity (struct type *type)
   type = desc_base_type (type);
 
   if (type != NULL)
-    return TYPE_NFIELDS (type) / 2;
+    return type->num_fields () / 2;
   return 0;
 }
 
@@ -2133,10 +2054,10 @@ constrained_packed_array_type (struct type *type, long *elt_bits)
 
   index_type_desc = ada_find_parallel_type (type, "___XA");
   if (index_type_desc)
-    index_type = to_fixed_range_type (TYPE_FIELD_TYPE (index_type_desc, 0),
+    index_type = to_fixed_range_type (index_type_desc->field (0).type (),
                                      NULL);
   else
-    index_type = TYPE_INDEX_TYPE (type);
+    index_type = type->index_type ();
 
   new_type = alloc_type_copy (type);
   new_elt_type =
@@ -2290,7 +2211,7 @@ value_subscript_packed (struct value *arr, int arity, struct value **ind)
             "something other than a packed array"));
       else
         {
-          struct type *range_type = TYPE_INDEX_TYPE (elt_type);
+          struct type *range_type = elt_type->index_type ();
           LONGEST lowerbound, upperbound;
           LONGEST idx;
 
@@ -2780,15 +2701,13 @@ ada_value_ptr_subscript (struct value *arr, int arity, struct value **ind)
   for (k = 0; k < arity; k += 1)
     {
       LONGEST lwb, upb;
-      struct value *lwb_value;
 
       if (type->code () != TYPE_CODE_ARRAY)
         error (_("too many subscripts (%d expected)"), k);
       arr = value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
                         value_copy (arr));
-      get_discrete_bounds (TYPE_INDEX_TYPE (type), &lwb, &upb);
-      lwb_value = value_from_longest (value_type (ind[k]), lwb);
-      arr = value_ptradd (arr, pos_atr (ind[k]) - pos_atr (lwb_value));
+      get_discrete_bounds (type->index_type (), &lwb, &upb);
+      arr = value_ptradd (arr, pos_atr (ind[k]) - lwb);
       type = TYPE_TARGET_TYPE (type);
     }
 
@@ -2804,14 +2723,14 @@ ada_value_slice_from_ptr (struct value *array_ptr, struct type *type,
                           int low, int high)
 {
   struct type *type0 = ada_check_typedef (type);
-  struct type *base_index_type = TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type0));
+  struct type *base_index_type = TYPE_TARGET_TYPE (type0->index_type ());
   struct type *index_type
     = create_static_range_type (NULL, base_index_type, low, high);
   struct type *slice_type = create_array_type_with_stride
                              (NULL, TYPE_TARGET_TYPE (type0), index_type,
                               type0->dyn_prop (DYN_PROP_BYTE_STRIDE),
                               TYPE_FIELD_BITSIZE (type0, 0));
-  int base_low =  ada_discrete_type_low_bound (TYPE_INDEX_TYPE (type0));
+  int base_low =  ada_discrete_type_low_bound (type0->index_type ());
   LONGEST base_low_pos, low_pos;
   CORE_ADDR base;
 
@@ -2834,9 +2753,9 @@ static struct value *
 ada_value_slice (struct value *array, int low, int high)
 {
   struct type *type = ada_check_typedef (value_type (array));
-  struct type *base_index_type = TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type));
+  struct type *base_index_type = TYPE_TARGET_TYPE (type->index_type ());
   struct type *index_type
-    = create_static_range_type (NULL, TYPE_INDEX_TYPE (type), low, high);
+    = create_static_range_type (NULL, type->index_type (), low, high);
   struct type *slice_type = create_array_type_with_stride
                              (NULL, TYPE_TARGET_TYPE (type), index_type,
                               type->dyn_prop (DYN_PROP_BYTE_STRIDE),
@@ -2949,7 +2868,7 @@ ada_index_type (struct type *type, int n, const char *name)
 
       for (i = 1; i < n; i += 1)
         type = TYPE_TARGET_TYPE (type);
-      result_type = TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type));
+      result_type = TYPE_TARGET_TYPE (type->index_type ());
       /* FIXME: The stabs type r(0,0);bound;bound in an array type
          has a target type of TYPE_CODE_UNDEF.  We compensate here, but
          perhaps stabsread.c would make more sense.  */
@@ -3005,7 +2924,7 @@ ada_array_bound_from_type (struct type *arr_type, int n, int which)
     }
 
   if (index_type_desc != NULL)
-    index_type = to_fixed_range_type (TYPE_FIELD_TYPE (index_type_desc, n - 1),
+    index_type = to_fixed_range_type (index_type_desc->field (n - 1).type (),
                                      NULL);
   else
     {
@@ -3014,7 +2933,7 @@ ada_array_bound_from_type (struct type *arr_type, int n, int which)
       for (i = 1; i < n; i++)
        elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type));
 
-      index_type = TYPE_INDEX_TYPE (elt_type);
+      index_type = elt_type->index_type ();
     }
 
   return
@@ -3101,7 +3020,7 @@ empty_array (struct type *arr_type, int low, int high)
   struct type *arr_type0 = ada_check_typedef (arr_type);
   struct type *index_type
     = create_static_range_type
-        (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (arr_type0)), low,
+        (NULL, TYPE_TARGET_TYPE (arr_type0->index_type ()), low,
         high < low ? low - 1 : high);
   struct type *elt_type = ada_array_element_type (arr_type0, 1);
 
@@ -3211,16 +3130,16 @@ ada_print_symbol_signature (struct ui_file *stream, struct symbol *sym,
       || type->code () != TYPE_CODE_FUNC)
     return;
 
-  if (TYPE_NFIELDS (type) > 0)
+  if (type->num_fields () > 0)
     {
       int i;
 
       fprintf_filtered (stream, " (");
-      for (i = 0; i < TYPE_NFIELDS (type); ++i)
+      for (i = 0; i < type->num_fields (); ++i)
        {
          if (i > 0)
            fprintf_filtered (stream, "; ");
-         ada_print_type (TYPE_FIELD_TYPE (type, i), NULL, stream, -1, 0,
+         ada_print_type (type->field (i).type (), NULL, stream, -1, 0,
                          flags);
        }
       fprintf_filtered (stream, ")");
@@ -3441,28 +3360,6 @@ See set/show multiple-symbol."));
   return n_chosen;
 }
 
-/* Same as evaluate_type (*EXP), but resolves ambiguous symbol
-   references (marked by OP_VAR_VALUE nodes in which the symbol has an
-   undefined namespace) and converts operators that are
-   user-defined into appropriate function calls.  If CONTEXT_TYPE is
-   non-null, it provides a preferred result type [at the moment, only
-   type void has any effect---causing procedures to be preferred over
-   functions in calls].  A null CONTEXT_TYPE indicates that a non-void
-   return type is preferred.  May change (expand) *EXP.  */
-
-static void
-resolve (expression_up *expp, int void_context_p, int parse_completion,
-        innermost_block_tracker *tracker)
-{
-  struct type *context_type = NULL;
-  int pc = 0;
-
-  if (void_context_p)
-    context_type = builtin_type ((*expp)->gdbarch)->builtin_void;
-
-  resolve_subexp (expp, &pc, 1, context_type, parse_completion, tracker);
-}
-
 /* Resolve the operator of the subexpression beginning at
    position *POS of *EXPP.  "Resolving" consists of replacing
    the symbols that have undefined namespaces in OP_VAR_VALUE nodes
@@ -3902,7 +3799,7 @@ ada_args_match (struct symbol *func, struct value **actuals, int n_actuals)
   else if (func_type == NULL || func_type->code () != TYPE_CODE_FUNC)
     return 0;
 
-  if (TYPE_NFIELDS (func_type) != n_actuals)
+  if (func_type->num_fields () != n_actuals)
     return 0;
 
   for (i = 0; i < n_actuals; i += 1)
@@ -3911,8 +3808,7 @@ ada_args_match (struct symbol *func, struct value **actuals, int n_actuals)
         return 0;
       else
         {
-          struct type *ftype = ada_check_typedef (TYPE_FIELD_TYPE (func_type,
-                                                                  i));
+          struct type *ftype = ada_check_typedef (func_type->field (i).type ());
           struct type *atype = ada_check_typedef (value_type (actuals[i]));
 
           if (!ada_type_match (ftype, atype, 1))
@@ -4562,14 +4458,14 @@ make_array_descriptor (struct type *type, struct value *arr)
   modify_field (value_type (descriptor),
                value_contents_writeable (descriptor),
                value_pointer (ensure_lval (arr),
-                              TYPE_FIELD_TYPE (desc_type, 0)),
+                              desc_type->field (0).type ()),
                fat_pntr_data_bitpos (desc_type),
                fat_pntr_data_bitsize (desc_type));
 
   modify_field (value_type (descriptor),
                value_contents_writeable (descriptor),
                value_pointer (bounds,
-                              TYPE_FIELD_TYPE (desc_type, 1)),
+                              desc_type->field (1).type ()),
                fat_pntr_bounds_bitpos (desc_type),
                fat_pntr_bounds_bitsize (desc_type));
 
@@ -4963,7 +4859,7 @@ is_nondebugging_type (struct type *type)
 
    This function assumes that TYPE1 and TYPE2 are both TYPE_CODE_ENUM
    types and that their number of enumerals is identical (in other
-   words, TYPE_NFIELDS (type1) == TYPE_NFIELDS (type2)).  */
+   words, type1->num_fields () == type2->num_fields ()).  */
 
 static int
 ada_identical_enum_types_p (struct type *type1, struct type *type2)
@@ -4976,13 +4872,13 @@ ada_identical_enum_types_p (struct type *type1, struct type *type2)
      underlying value and name.  */
 
   /* All enums in the type should have an identical underlying value.  */
-  for (i = 0; i < TYPE_NFIELDS (type1); i++)
+  for (i = 0; i < type1->num_fields (); i++)
     if (TYPE_FIELD_ENUMVAL (type1, i) != TYPE_FIELD_ENUMVAL (type2, i))
       return 0;
 
   /* All enumerals should also have the same name (modulo any numerical
      suffix).  */
-  for (i = 0; i < TYPE_NFIELDS (type1); i++)
+  for (i = 0; i < type1->num_fields (); i++)
     {
       const char *name_1 = TYPE_FIELD_NAME (type1, i);
       const char *name_2 = TYPE_FIELD_NAME (type2, i);
@@ -5045,8 +4941,8 @@ symbols_are_identical_enums (const std::vector<struct block_symbol> &syms)
 
   /* Quick check: They should all have the same number of enumerals.  */
   for (i = 1; i < syms.size (); i++)
-    if (TYPE_NFIELDS (SYMBOL_TYPE (syms[i].symbol))
-        != TYPE_NFIELDS (SYMBOL_TYPE (syms[0].symbol)))
+    if (SYMBOL_TYPE (syms[i].symbol)->num_fields ()
+        != SYMBOL_TYPE (syms[0].symbol)->num_fields ())
       return 0;
 
   /* All the sanity checks passed, so we might have a set of
@@ -5699,7 +5595,7 @@ ada_add_all_symbols (struct obstack *obstackp,
       else
        {
          /* In the !full_search case we're are being called by
-            ada_iterate_over_symbols, and we don't want to search
+            iterate_over_symbols, and we don't want to search
             superblocks.  */
          ada_add_block_symbols (obstackp, block, lookup_name, domain, NULL);
        }
@@ -5800,28 +5696,6 @@ ada_lookup_symbol_list (const char *name, const struct block *block,
   return ada_lookup_symbol_list_worker (lookup_name, block, domain, results, 1);
 }
 
-/* Implementation of the la_iterate_over_symbols method.  */
-
-static bool
-ada_iterate_over_symbols
-  (const struct block *block, const lookup_name_info &name,
-   domain_enum domain,
-   gdb::function_view<symbol_found_callback_ftype> callback)
-{
-  int ndefs, i;
-  std::vector<struct block_symbol> results;
-
-  ndefs = ada_lookup_symbol_list_worker (name, block, domain, &results, 0);
-
-  for (i = 0; i < ndefs; ++i)
-    {
-      if (!callback (&results[i]))
-       return false;
-    }
-
-  return true;
-}
-
 /* The result is as for ada_lookup_symbol_list with FULL_SEARCH set
    to 1, but choosing the first symbol found if there are multiple
    choices.
@@ -5868,46 +5742,6 @@ ada_lookup_symbol (const char *name, const struct block *block0,
   return info;
 }
 
-static struct block_symbol
-ada_lookup_symbol_nonlocal (const struct language_defn *langdef,
-                           const char *name,
-                            const struct block *block,
-                            const domain_enum domain)
-{
-  struct block_symbol sym;
-
-  sym = ada_lookup_symbol (name, block_static_block (block), domain);
-  if (sym.symbol != NULL)
-    return sym;
-
-  /* If we haven't found a match at this point, try the primitive
-     types.  In other languages, this search is performed before
-     searching for global symbols in order to short-circuit that
-     global-symbol search if it happens that the name corresponds
-     to a primitive type.  But we cannot do the same in Ada, because
-     it is perfectly legitimate for a program to declare a type which
-     has the same name as a standard type.  If looking up a type in
-     that situation, we have traditionally ignored the primitive type
-     in favor of user-defined types.  This is why, unlike most other
-     languages, we search the primitive types this late and only after
-     having searched the global symbols without success.  */
-
-  if (domain == VAR_DOMAIN)
-    {
-      struct gdbarch *gdbarch;
-
-      if (block == NULL)
-       gdbarch = target_gdbarch ();
-      else
-       gdbarch = block_gdbarch (block);
-      sym.symbol = language_lookup_primitive_type_as_symbol (langdef, gdbarch, name);
-      if (sym.symbol != NULL)
-       return sym;
-    }
-
-  return {};
-}
-
 
 /* True iff STR is a possible encoded suffix of a normal Ada name
    that is to be ignored for matching purposes.  Suffixes of parallel
@@ -6365,134 +6199,6 @@ ada_lookup_name_info::matches
   return true;
 }
 
-/* Add the list of possible symbol names completing TEXT to TRACKER.
-   WORD is the entire command on which completion is made.  */
-
-static void
-ada_collect_symbol_completion_matches (completion_tracker &tracker,
-                                      complete_symbol_mode mode,
-                                      symbol_name_match_type name_match_type,
-                                      const char *text, const char *word,
-                                      enum type_code code)
-{
-  struct symbol *sym;
-  const struct block *b, *surrounding_static_block = 0;
-  struct block_iterator iter;
-
-  gdb_assert (code == TYPE_CODE_UNDEF);
-
-  lookup_name_info lookup_name (text, name_match_type, true);
-
-  /* First, look at the partial symtab symbols.  */
-  expand_symtabs_matching (NULL,
-                          lookup_name,
-                          NULL,
-                          NULL,
-                          ALL_DOMAIN);
-
-  /* At this point scan through the misc symbol vectors and add each
-     symbol you find to the list.  Eventually we want to ignore
-     anything that isn't a text symbol (everything else will be
-     handled by the psymtab code above).  */
-
-  for (objfile *objfile : current_program_space->objfiles ())
-    {
-      for (minimal_symbol *msymbol : objfile->msymbols ())
-       {
-         QUIT;
-
-         if (completion_skip_symbol (mode, msymbol))
-           continue;
-
-         language symbol_language = msymbol->language ();
-
-         /* Ada minimal symbols won't have their language set to Ada.  If
-            we let completion_list_add_name compare using the
-            default/C-like matcher, then when completing e.g., symbols in a
-            package named "pck", we'd match internal Ada symbols like
-            "pckS", which are invalid in an Ada expression, unless you wrap
-            them in '<' '>' to request a verbatim match.
-
-            Unfortunately, some Ada encoded names successfully demangle as
-            C++ symbols (using an old mangling scheme), such as "name__2Xn"
-            -> "Xn::name(void)" and thus some Ada minimal symbols end up
-            with the wrong language set.  Paper over that issue here.  */
-         if (symbol_language == language_auto
-             || symbol_language == language_cplus)
-           symbol_language = language_ada;
-
-         completion_list_add_name (tracker,
-                                   symbol_language,
-                                   msymbol->linkage_name (),
-                                   lookup_name, text, word);
-       }
-    }
-
-  /* Search upwards from currently selected frame (so that we can
-     complete on local vars.  */
-
-  for (b = get_selected_block (0); b != NULL; b = BLOCK_SUPERBLOCK (b))
-    {
-      if (!BLOCK_SUPERBLOCK (b))
-        surrounding_static_block = b;   /* For elmin of dups */
-
-      ALL_BLOCK_SYMBOLS (b, iter, sym)
-      {
-       if (completion_skip_symbol (mode, sym))
-         continue;
-
-       completion_list_add_name (tracker,
-                                 sym->language (),
-                                 sym->linkage_name (),
-                                 lookup_name, text, word);
-      }
-    }
-
-  /* Go through the symtabs and check the externs and statics for
-     symbols which match.  */
-
-  for (objfile *objfile : current_program_space->objfiles ())
-    {
-      for (compunit_symtab *s : objfile->compunits ())
-       {
-         QUIT;
-         b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), GLOBAL_BLOCK);
-         ALL_BLOCK_SYMBOLS (b, iter, sym)
-           {
-             if (completion_skip_symbol (mode, sym))
-               continue;
-
-             completion_list_add_name (tracker,
-                                       sym->language (),
-                                       sym->linkage_name (),
-                                       lookup_name, text, word);
-           }
-       }
-    }
-
-  for (objfile *objfile : current_program_space->objfiles ())
-    {
-      for (compunit_symtab *s : objfile->compunits ())
-       {
-         QUIT;
-         b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), STATIC_BLOCK);
-         /* Don't do this block twice.  */
-         if (b == surrounding_static_block)
-           continue;
-         ALL_BLOCK_SYMBOLS (b, iter, sym)
-           {
-             if (completion_skip_symbol (mode, sym))
-               continue;
-
-             completion_list_add_name (tracker,
-                                       sym->language (),
-                                       sym->linkage_name (),
-                                       lookup_name, text, word);
-           }
-       }
-    }
-}
-
                                 /* Field Access */
 
 /* Return non-zero if TYPE is a pointer to the GNAT dispatch table used
@@ -6532,7 +6238,7 @@ ada_is_interface_tag (struct type *type)
 int
 ada_is_ignored_field (struct type *type, int field_num)
 {
-  if (field_num < 0 || field_num > TYPE_NFIELDS (type))
+  if (field_num < 0 || field_num > type->num_fields ())
     return 1;
 
   /* Check the name of that field.  */
@@ -6559,8 +6265,8 @@ ada_is_ignored_field (struct type *type, int field_num)
   /* If this is the dispatch table of a tagged type or an interface tag,
      then ignore.  */
   if (ada_is_tagged_type (type, 1)
-      && (ada_is_dispatch_table_ptr_type (TYPE_FIELD_TYPE (type, field_num))
-         || ada_is_interface_tag (TYPE_FIELD_TYPE (type, field_num))))
+      && (ada_is_dispatch_table_ptr_type (type->field (field_num).type ())
+         || ada_is_interface_tag (type->field (field_num).type ())))
     return 1;
 
   /* Not a special field, so it should not be ignored.  */
@@ -6647,10 +6353,10 @@ value_tag_from_contents_and_address (struct type *type,
 static struct type *
 type_from_tag (struct value *tag)
 {
-  const char *type_name = ada_tag_name (tag);
+  gdb::unique_xmalloc_ptr<char> type_name = ada_tag_name (tag);
 
   if (type_name != NULL)
-    return ada_find_any_type (ada_encode (type_name));
+    return ada_find_any_type (ada_encode (type_name.get ()));
   return NULL;
 }
 
@@ -6798,37 +6504,41 @@ ada_get_tsd_from_tag (struct value *tag)
 /* Given the TSD of a tag (type-specific data), return a string
    containing the name of the associated type.
 
-   The returned value is good until the next call.  May return NULL
-   if we are unable to determine the tag name.  */
+   May return NULL if we are unable to determine the tag name.  */
 
-static char *
+static gdb::unique_xmalloc_ptr<char>
 ada_tag_name_from_tsd (struct value *tsd)
 {
-  static char name[1024];
   char *p;
   struct value *val;
 
   val = ada_value_struct_elt (tsd, "expanded_name", 1);
   if (val == NULL)
     return NULL;
-  read_memory_string (value_as_address (val), name, sizeof (name) - 1);
-  for (p = name; *p != '\0'; p += 1)
-    if (isalpha (*p))
-      *p = tolower (*p);
-  return name;
+  gdb::unique_xmalloc_ptr<char> buffer
+    = target_read_string (value_as_address (val), INT_MAX);
+  if (buffer == nullptr)
+    return nullptr;
+
+  for (p = buffer.get (); *p != '\0'; ++p)
+    {
+      if (isalpha (*p))
+       *p = tolower (*p);
+    }
+
+  return buffer;
 }
 
 /* The type name of the dynamic type denoted by the 'tag value TAG, as
    a C string.
 
    Return NULL if the TAG is not an Ada tag, or if we were unable to
-   determine the name of that tag.  The result is good until the next
-   call.  */
+   determine the name of that tag.  */
 
-const char *
+gdb::unique_xmalloc_ptr<char>
 ada_tag_name (struct value *tag)
 {
-  char *name = NULL;
+  gdb::unique_xmalloc_ptr<char> name;
 
   if (!ada_is_tag_type (value_type (tag)))
     return NULL;
@@ -6868,10 +6578,10 @@ ada_parent_type (struct type *type)
   if (type == NULL || type->code () != TYPE_CODE_STRUCT)
     return NULL;
 
-  for (i = 0; i < TYPE_NFIELDS (type); i += 1)
+  for (i = 0; i < type->num_fields (); i += 1)
     if (ada_is_parent_field (type, i))
       {
-        struct type *parent_type = TYPE_FIELD_TYPE (type, i);
+        struct type *parent_type = type->field (i).type ();
 
         /* If the _parent field is a pointer, then dereference it.  */
         if (parent_type->code () == TYPE_CODE_PTR)
@@ -6939,7 +6649,7 @@ ada_is_variant_part (struct type *type, int field_num)
   if (!ADA_TYPE_P (type))
     return 0;
 
-  struct type *field_type = TYPE_FIELD_TYPE (type, field_num);
+  struct type *field_type = type->field (field_num).type ();
 
   return (field_type->code () == TYPE_CODE_UNION
          || (is_dynamic_field (type, field_num)
@@ -7128,7 +6838,7 @@ ada_value_primitive_field (struct value *arg1, int offset, int fieldno,
   struct type *type;
 
   arg_type = ada_check_typedef (arg_type);
-  type = TYPE_FIELD_TYPE (arg_type, fieldno);
+  type = arg_type->field (fieldno).type ();
 
   /* Handle packed fields.  It might be that the field is not packed
      relative to its containing structure, but the structure itself is
@@ -7231,7 +6941,7 @@ find_struct_field (const char *name, struct type *type, int offset,
   if (bit_size_p != NULL)
     *bit_size_p = 0;
 
-  for (i = 0; i < TYPE_NFIELDS (type); i += 1)
+  for (i = 0; i < type->num_fields (); i += 1)
     {
       int bit_pos = TYPE_FIELD_BITPOS (type, i);
       int fld_offset = offset + bit_pos / 8;
@@ -7259,7 +6969,7 @@ find_struct_field (const char *name, struct type *type, int offset,
           int bit_size = TYPE_FIELD_BITSIZE (type, i);
 
          if (field_type_p != NULL)
-           *field_type_p = TYPE_FIELD_TYPE (type, i);
+           *field_type_p = type->field (i).type ();
          if (byte_offset_p != NULL)
            *byte_offset_p = fld_offset;
          if (bit_offset_p != NULL)
@@ -7270,7 +6980,7 @@ find_struct_field (const char *name, struct type *type, int offset,
         }
       else if (ada_is_wrapper_field (type, i))
         {
-         if (find_struct_field (name, TYPE_FIELD_TYPE (type, i), fld_offset,
+         if (find_struct_field (name, type->field (i).type (), fld_offset,
                                 field_type_p, byte_offset_p, bit_offset_p,
                                 bit_size_p, index_p))
             return 1;
@@ -7281,11 +6991,11 @@ find_struct_field (const char *name, struct type *type, int offset,
             fixed type?? */
           int j;
           struct type *field_type
-           = ada_check_typedef (TYPE_FIELD_TYPE (type, i));
+           = ada_check_typedef (type->field (i).type ());
 
-          for (j = 0; j < TYPE_NFIELDS (field_type); j += 1)
+          for (j = 0; j < field_type->num_fields (); j += 1)
             {
-              if (find_struct_field (name, TYPE_FIELD_TYPE (field_type, j),
+              if (find_struct_field (name, field_type->field (j).type (),
                                      fld_offset
                                      + TYPE_FIELD_BITPOS (field_type, j) / 8,
                                      field_type_p, byte_offset_p,
@@ -7305,7 +7015,7 @@ find_struct_field (const char *name, struct type *type, int offset,
       int bit_pos = TYPE_FIELD_BITPOS (type, parent_offset);
       int fld_offset = offset + bit_pos / 8;
 
-      if (find_struct_field (name, TYPE_FIELD_TYPE (type, parent_offset),
+      if (find_struct_field (name, type->field (parent_offset).type (),
                              fld_offset, field_type_p, byte_offset_p,
                              bit_offset_p, bit_size_p, index_p))
         return 1;
@@ -7343,7 +7053,7 @@ ada_search_struct_field (const char *name, struct value *arg, int offset,
   int parent_offset = -1;
 
   type = ada_check_typedef (type);
-  for (i = 0; i < TYPE_NFIELDS (type); i += 1)
+  for (i = 0; i < type->num_fields (); i += 1)
     {
       const char *t_field_name = TYPE_FIELD_NAME (type, i);
 
@@ -7372,7 +7082,7 @@ ada_search_struct_field (const char *name, struct value *arg, int offset,
           struct value *v =     /* Do not let indent join lines here.  */
             ada_search_struct_field (name, arg,
                                      offset + TYPE_FIELD_BITPOS (type, i) / 8,
-                                     TYPE_FIELD_TYPE (type, i));
+                                     type->field (i).type ());
 
           if (v != NULL)
             return v;
@@ -7382,17 +7092,16 @@ ada_search_struct_field (const char *name, struct value *arg, int offset,
         {
          /* PNH: Do we ever get here?  See find_struct_field.  */
           int j;
-          struct type *field_type = ada_check_typedef (TYPE_FIELD_TYPE (type,
-                                                                       i));
+          struct type *field_type = ada_check_typedef (type->field (i).type ());
           int var_offset = offset + TYPE_FIELD_BITPOS (type, i) / 8;
 
-          for (j = 0; j < TYPE_NFIELDS (field_type); j += 1)
+          for (j = 0; j < field_type->num_fields (); j += 1)
             {
               struct value *v = ada_search_struct_field /* Force line
                                                           break.  */
                 (name, arg,
                  var_offset + TYPE_FIELD_BITPOS (field_type, j) / 8,
-                 TYPE_FIELD_TYPE (field_type, j));
+                 field_type->field (j).type ());
 
               if (v != NULL)
                 return v;
@@ -7407,7 +7116,7 @@ ada_search_struct_field (const char *name, struct value *arg, int offset,
     {
       struct value *v = ada_search_struct_field (
        name, arg, offset + TYPE_FIELD_BITPOS (type, parent_offset) / 8,
-       TYPE_FIELD_TYPE (type, parent_offset));
+       type->field (parent_offset).type ());
 
       if (v != NULL)
         return v;
@@ -7444,7 +7153,7 @@ ada_index_struct_field_1 (int *index_p, struct value *arg, int offset,
   int i;
   type = ada_check_typedef (type);
 
-  for (i = 0; i < TYPE_NFIELDS (type); i += 1)
+  for (i = 0; i < type->num_fields (); i += 1)
     {
       if (TYPE_FIELD_NAME (type, i) == NULL)
         continue;
@@ -7453,7 +7162,7 @@ ada_index_struct_field_1 (int *index_p, struct value *arg, int offset,
           struct value *v =     /* Do not let indent join lines here.  */
             ada_index_struct_field_1 (index_p, arg,
                                      offset + TYPE_FIELD_BITPOS (type, i) / 8,
-                                     TYPE_FIELD_TYPE (type, i));
+                                     type->field (i).type ());
 
           if (v != NULL)
             return v;
@@ -7537,7 +7246,7 @@ ada_lookup_struct_elt_type (struct type *type, const char *name, int refok,
 
   type = to_static_fixed_type (type);
 
-  for (i = 0; i < TYPE_NFIELDS (type); i += 1)
+  for (i = 0; i < type->num_fields (); i += 1)
     {
       const char *t_field_name = TYPE_FIELD_NAME (type, i);
       struct type *t;
@@ -7560,11 +7269,11 @@ ada_lookup_struct_elt_type (struct type *type, const char *name, int refok,
         }
 
       else if (field_name_match (t_field_name, name))
-       return TYPE_FIELD_TYPE (type, i);
+       return type->field (i).type ();
 
       else if (ada_is_wrapper_field (type, i))
         {
-          t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (type, i), name,
+          t = ada_lookup_struct_elt_type (type->field (i).type (), name,
                                           0, 1);
           if (t != NULL)
            return t;
@@ -7573,10 +7282,9 @@ ada_lookup_struct_elt_type (struct type *type, const char *name, int refok,
       else if (ada_is_variant_part (type, i))
         {
           int j;
-          struct type *field_type = ada_check_typedef (TYPE_FIELD_TYPE (type,
-                                                                       i));
+          struct type *field_type = ada_check_typedef (type->field (i).type ());
 
-          for (j = TYPE_NFIELDS (field_type) - 1; j >= 0; j -= 1)
+          for (j = field_type->num_fields () - 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
@@ -7586,10 +7294,9 @@ ada_lookup_struct_elt_type (struct type *type, const char *name, int refok,
 
              if (v_field_name != NULL 
                  && field_name_match (v_field_name, name))
-               t = TYPE_FIELD_TYPE (field_type, j);
+               t = field_type->field (j).type ();
              else
-               t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (field_type,
-                                                                j),
+               t = ada_lookup_struct_elt_type (field_type->field (j).type (),
                                                name, 0, 1);
 
               if (t != NULL)
@@ -7606,7 +7313,7 @@ ada_lookup_struct_elt_type (struct type *type, const char *name, int refok,
       {
         struct type *t;
 
-        t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (type, parent_offset),
+        t = ada_lookup_struct_elt_type (type->field (parent_offset).type (),
                                         name, 0, 1);
         if (t != NULL)
          return t;
@@ -7660,7 +7367,7 @@ ada_which_variant_applies (struct type *var_type, struct value *outer)
   discrim_val = value_as_long (discrim);
 
   others_clause = -1;
-  for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
+  for (i = 0; i < var_type->num_fields (); i += 1)
     {
       if (ada_is_others_clause (var_type, i))
         others_clause = i;
@@ -7995,7 +7702,7 @@ is_dynamic_field (struct type *templ_type, int field_num)
   const char *name = TYPE_FIELD_NAME (templ_type, field_num);
 
   return name != NULL
-    && TYPE_FIELD_TYPE (templ_type, field_num)->code () == TYPE_CODE_PTR
+    && templ_type->field (field_num).type ()->code () == TYPE_CODE_PTR
     && strstr (name, "___XVL") != NULL;
 }
 
@@ -8010,7 +7717,7 @@ variant_field_index (struct type *type)
   if (type == NULL || type->code () != TYPE_CODE_STRUCT)
     return -1;
 
-  for (f = 0; f < TYPE_NFIELDS (type); f += 1)
+  for (f = 0; f < type->num_fields (); f += 1)
     {
       if (ada_is_variant_part (type, f))
         return f;
@@ -8026,8 +7733,6 @@ empty_record (struct type *templ)
   struct type *type = alloc_type_copy (templ);
 
   type->set_code (TYPE_CODE_STRUCT);
-  TYPE_NFIELDS (type) = 0;
-  TYPE_FIELDS (type) = NULL;
   INIT_NONE_SPECIFIC (type);
   type->set_name ("<empty>");
   TYPE_LENGTH (type) = 0;
@@ -8070,11 +7775,11 @@ ada_template_to_fixed_record_type_1 (struct type *type,
      to be processed: unless keep_dynamic_fields, this includes only
      fields whose position and length are static will be processed.  */
   if (keep_dynamic_fields)
-    nfields = TYPE_NFIELDS (type);
+    nfields = type->num_fields ();
   else
     {
       nfields = 0;
-      while (nfields < TYPE_NFIELDS (type)
+      while (nfields < type->num_fields ()
              && !ada_is_variant_part (type, nfields)
              && !is_dynamic_field (type, nfields))
         nfields++;
@@ -8083,10 +7788,9 @@ ada_template_to_fixed_record_type_1 (struct type *type,
   rtype = alloc_type_copy (type);
   rtype->set_code (TYPE_CODE_STRUCT);
   INIT_NONE_SPECIFIC (rtype);
-  TYPE_NFIELDS (rtype) = nfields;
-  TYPE_FIELDS (rtype) = (struct field *)
-    TYPE_ALLOC (rtype, nfields * sizeof (struct field));
-  memset (TYPE_FIELDS (rtype), 0, sizeof (struct field) * nfields);
+  rtype->set_num_fields (nfields);
+  rtype->set_fields
+   ((struct field *) TYPE_ZALLOC (rtype, nfields * sizeof (struct field)));
   rtype->set_name (ada_type_name (type));
   TYPE_FIXED_INSTANCE (rtype) = 1;
 
@@ -8098,7 +7802,7 @@ ada_template_to_fixed_record_type_1 (struct type *type,
     {
       off = align_up (off, field_alignment (type, f))
        + TYPE_FIELD_BITPOS (type, f);
-      SET_FIELD_BITPOS (TYPE_FIELD (rtype, f), off);
+      SET_FIELD_BITPOS (rtype->field (f), off);
       TYPE_FIELD_BITSIZE (rtype, f) = 0;
 
       if (ada_is_variant_part (type, f))
@@ -8111,7 +7815,7 @@ ada_template_to_fixed_record_type_1 (struct type *type,
          const gdb_byte *field_valaddr = valaddr;
          CORE_ADDR field_address = address;
          struct type *field_type =
-           TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, f));
+           TYPE_TARGET_TYPE (type->field (f).type ());
 
           if (dval0 == NULL)
            {
@@ -8170,7 +7874,7 @@ ada_template_to_fixed_record_type_1 (struct type *type,
             record size.  */
          ada_ensure_varsize_limit (field_type);
 
-         TYPE_FIELD_TYPE (rtype, f) = field_type;
+         rtype->field (f).set_type (field_type);
           TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
          /* The multiplication can potentially overflow.  But because
             the field length has been size-checked just above, and
@@ -8179,7 +7883,7 @@ ada_template_to_fixed_record_type_1 (struct type *type,
             adding overflow recovery code to this already complex code,
             we just assume that it's not going to happen.  */
           fld_bit_len =
-            TYPE_LENGTH (TYPE_FIELD_TYPE (rtype, f)) * TARGET_CHAR_BIT;
+            TYPE_LENGTH (rtype->field (f).type ()) * TARGET_CHAR_BIT;
         }
       else
         {
@@ -8193,14 +7897,14 @@ ada_template_to_fixed_record_type_1 (struct type *type,
             structure, the typedef is the only clue which allows us
             to distinguish between the two options.  Stripping it
             would prevent us from printing this field appropriately.  */
-          TYPE_FIELD_TYPE (rtype, f) = TYPE_FIELD_TYPE (type, f);
+          rtype->field (f).set_type (type->field (f).type ());
           TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
           if (TYPE_FIELD_BITSIZE (type, f) > 0)
             fld_bit_len =
               TYPE_FIELD_BITSIZE (rtype, f) = TYPE_FIELD_BITSIZE (type, f);
           else
            {
-             struct type *field_type = TYPE_FIELD_TYPE (type, f);
+             struct type *field_type = type->field (f).type ();
 
              /* We need to be careful of typedefs when computing
                 the length of our field.  If this is a typedef,
@@ -8244,21 +7948,21 @@ ada_template_to_fixed_record_type_1 (struct type *type,
 
       branch_type =
         to_fixed_variant_branch_type
-        (TYPE_FIELD_TYPE (type, variant_field),
+        (type->field (variant_field).type (),
          cond_offset_host (valaddr, off / TARGET_CHAR_BIT),
          cond_offset_target (address, off / TARGET_CHAR_BIT), dval);
       if (branch_type == NULL)
         {
-          for (f = variant_field + 1; f < TYPE_NFIELDS (rtype); f += 1)
-            TYPE_FIELDS (rtype)[f - 1] = TYPE_FIELDS (rtype)[f];
-          TYPE_NFIELDS (rtype) -= 1;
+          for (f = variant_field + 1; f < rtype->num_fields (); f += 1)
+            rtype->field (f - 1) = rtype->field (f);
+         rtype->set_num_fields (rtype->num_fields () - 1);
         }
       else
         {
-          TYPE_FIELD_TYPE (rtype, variant_field) = branch_type;
+          rtype->field (variant_field).set_type (branch_type);
           TYPE_FIELD_NAME (rtype, variant_field) = "S";
           fld_bit_len =
-            TYPE_LENGTH (TYPE_FIELD_TYPE (rtype, variant_field)) *
+            TYPE_LENGTH (rtype->field (variant_field).type ()) *
             TARGET_CHAR_BIT;
           if (off + fld_bit_len > bit_len)
             bit_len = off + fld_bit_len;
@@ -8331,7 +8035,7 @@ template_to_static_fixed_type (struct type *type0)
 
   /* Don't clone TYPE0 until we are sure we are going to need a copy.  */
   type = type0;
-  nfields = TYPE_NFIELDS (type0);
+  nfields = type0->num_fields ();
 
   /* Whether or not we cloned TYPE0, cache the result so that we don't do
      recompute all over next time.  */
@@ -8339,7 +8043,7 @@ template_to_static_fixed_type (struct type *type0)
 
   for (f = 0; f < nfields; f += 1)
     {
-      struct type *field_type = TYPE_FIELD_TYPE (type0, f);
+      struct type *field_type = type0->field (f).type ();
       struct type *new_type;
 
       if (is_dynamic_field (type0, f))
@@ -8358,16 +8062,20 @@ template_to_static_fixed_type (struct type *type0)
              TYPE_TARGET_TYPE (type0) = type = alloc_type_copy (type0);
              type->set_code (type0->code ());
              INIT_NONE_SPECIFIC (type);
-             TYPE_NFIELDS (type) = nfields;
-             TYPE_FIELDS (type) = (struct field *)
-               TYPE_ALLOC (type, nfields * sizeof (struct field));
-             memcpy (TYPE_FIELDS (type), TYPE_FIELDS (type0),
+             type->set_num_fields (nfields);
+
+             field *fields =
+               ((struct field *)
+                TYPE_ALLOC (type, nfields * sizeof (struct field)));
+             memcpy (fields, type0->fields (),
                      sizeof (struct field) * nfields);
+             type->set_fields (fields);
+
              type->set_name (ada_type_name (type0));
              TYPE_FIXED_INSTANCE (type) = 1;
              TYPE_LENGTH (type) = 0;
            }
-         TYPE_FIELD_TYPE (type, f) = new_type;
+         type->field (f).set_type (new_type);
          TYPE_FIELD_NAME (type, f) = TYPE_FIELD_NAME (type0, f);
        }
     }
@@ -8390,7 +8098,7 @@ to_record_with_fixed_variant_part (struct type *type, const gdb_byte *valaddr,
   struct value *dval;
   struct type *rtype;
   struct type *branch_type;
-  int nfields = TYPE_NFIELDS (type);
+  int nfields = type->num_fields ();
   int variant_field = variant_field_index (type);
 
   if (variant_field == -1)
@@ -8407,17 +8115,19 @@ to_record_with_fixed_variant_part (struct type *type, const gdb_byte *valaddr,
   rtype = alloc_type_copy (type);
   rtype->set_code (TYPE_CODE_STRUCT);
   INIT_NONE_SPECIFIC (rtype);
-  TYPE_NFIELDS (rtype) = nfields;
-  TYPE_FIELDS (rtype) =
+  rtype->set_num_fields (nfields);
+
+  field *fields =
     (struct field *) TYPE_ALLOC (rtype, nfields * sizeof (struct field));
-  memcpy (TYPE_FIELDS (rtype), TYPE_FIELDS (type),
-          sizeof (struct field) * nfields);
+  memcpy (fields, type->fields (), sizeof (struct field) * nfields);
+  rtype->set_fields (fields);
+
   rtype->set_name (ada_type_name (type));
   TYPE_FIXED_INSTANCE (rtype) = 1;
   TYPE_LENGTH (rtype) = TYPE_LENGTH (type);
 
   branch_type = to_fixed_variant_branch_type
-    (TYPE_FIELD_TYPE (type, variant_field),
+    (type->field (variant_field).type (),
      cond_offset_host (valaddr,
                        TYPE_FIELD_BITPOS (type, variant_field)
                        / TARGET_CHAR_BIT),
@@ -8429,17 +8139,17 @@ to_record_with_fixed_variant_part (struct type *type, const gdb_byte *valaddr,
       int f;
 
       for (f = variant_field + 1; f < nfields; f += 1)
-        TYPE_FIELDS (rtype)[f - 1] = TYPE_FIELDS (rtype)[f];
-      TYPE_NFIELDS (rtype) -= 1;
+        rtype->field (f - 1) = rtype->field (f);
+      rtype->set_num_fields (rtype->num_fields () - 1);
     }
   else
     {
-      TYPE_FIELD_TYPE (rtype, variant_field) = branch_type;
+      rtype->field (variant_field).set_type (branch_type);
       TYPE_FIELD_NAME (rtype, variant_field) = "S";
       TYPE_FIELD_BITSIZE (rtype, variant_field) = 0;
       TYPE_LENGTH (rtype) += TYPE_LENGTH (branch_type);
     }
-  TYPE_LENGTH (rtype) -= TYPE_LENGTH (TYPE_FIELD_TYPE (type, variant_field));
+  TYPE_LENGTH (rtype) -= TYPE_LENGTH (type->field (variant_field).type ());
 
   value_free_to_mark (mark);
   return rtype;
@@ -8525,14 +8235,14 @@ to_fixed_variant_branch_type (struct type *var_type0, const gdb_byte *valaddr,
     return empty_record (var_type);
   else if (is_dynamic_field (var_type, which))
     return to_fixed_record_type
-      (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (var_type, which)),
+      (TYPE_TARGET_TYPE (var_type->field (which).type ()),
        valaddr, address, dval);
-  else if (variant_field_index (TYPE_FIELD_TYPE (var_type, which)) >= 0)
+  else if (variant_field_index (var_type->field (which).type ()) >= 0)
     return
       to_fixed_record_type
-      (TYPE_FIELD_TYPE (var_type, which), valaddr, address, dval);
+      (var_type->field (which).type (), valaddr, address, dval);
   else
-    return TYPE_FIELD_TYPE (var_type, which);
+    return var_type->field (which).type ();
 }
 
 /* Assuming RANGE_TYPE is a TYPE_CODE_RANGE, return nonzero if
@@ -8596,10 +8306,10 @@ ada_is_redundant_index_type_desc (struct type *array_type,
   struct type *this_layer = check_typedef (array_type);
   int i;
 
-  for (i = 0; i < TYPE_NFIELDS (desc_type); i++)
+  for (i = 0; i < desc_type->num_fields (); i++)
     {
-      if (!ada_is_redundant_range_encoding (TYPE_INDEX_TYPE (this_layer),
-                                           TYPE_FIELD_TYPE (desc_type, i)))
+      if (!ada_is_redundant_range_encoding (this_layer->index_type (),
+                                           desc_type->field (i).type ()))
        return 0;
       this_layer = check_typedef (TYPE_TARGET_TYPE (this_layer));
     }
@@ -8692,7 +8402,7 @@ to_fixed_array_type (struct type *type0, struct value *dval,
         result = type0;
       else
         result = create_array_type (alloc_type_copy (type0),
-                                    elt_type, TYPE_INDEX_TYPE (type0));
+                                    elt_type, type0->index_type ());
     }
   else
     {
@@ -8700,7 +8410,7 @@ to_fixed_array_type (struct type *type0, struct value *dval,
       struct type *elt_type0;
 
       elt_type0 = type0;
-      for (i = TYPE_NFIELDS (index_type_desc); i > 0; i -= 1)
+      for (i = index_type_desc->num_fields (); i > 0; i -= 1)
         elt_type0 = TYPE_TARGET_TYPE (elt_type0);
 
       /* NOTE: result---the fixed version of elt_type0---should never
@@ -8718,10 +8428,10 @@ to_fixed_array_type (struct type *type0, struct value *dval,
         ada_to_fixed_type (ada_check_typedef (elt_type0), 0, 0, dval, 1);
 
       elt_type0 = type0;
-      for (i = TYPE_NFIELDS (index_type_desc) - 1; i >= 0; i -= 1)
+      for (i = index_type_desc->num_fields () - 1; i >= 0; i -= 1)
         {
           struct type *range_type =
-            to_fixed_range_type (TYPE_FIELD_TYPE (index_type_desc, i), dval);
+            to_fixed_range_type (index_type_desc->field (i).type (), dval);
 
           result = create_array_type (alloc_type_copy (elt_type0),
                                       result, range_type);
@@ -8976,7 +8686,7 @@ static_unwrap_type (struct type *type)
 {
   if (ada_is_aligner_type (type))
     {
-      struct type *type1 = TYPE_FIELD_TYPE (ada_check_typedef (type), 0);
+      struct type *type1 = ada_check_typedef (type)->field (0).type ();
       if (ada_type_name (type1) == NULL)
        type1->set_name (ada_type_name (type));
 
@@ -9142,6 +8852,21 @@ value_pos_atr (struct type *type, struct value *arg)
 
 /* Evaluate the TYPE'VAL attribute applied to ARG.  */
 
+static struct value *
+val_atr (struct type *type, LONGEST val)
+{
+  gdb_assert (discrete_type_p (type));
+  if (type->code () == TYPE_CODE_RANGE)
+    type = TYPE_TARGET_TYPE (type);
+  if (type->code () == TYPE_CODE_ENUM)
+    {
+      if (val < 0 || val >= type->num_fields ())
+        error (_("argument to 'VAL out of range"));
+      val = TYPE_FIELD_ENUMVAL (type, val);
+    }
+  return value_from_longest (type, val);
+}
+
 static struct value *
 value_val_atr (struct type *type, struct value *arg)
 {
@@ -9150,16 +8875,7 @@ value_val_atr (struct type *type, struct value *arg)
   if (!integer_type_p (value_type (arg)))
     error (_("'VAL requires integral argument"));
 
-  if (type->code () == TYPE_CODE_ENUM)
-    {
-      long pos = value_as_long (arg);
-
-      if (pos < 0 || pos >= TYPE_NFIELDS (type))
-        error (_("argument to 'VAL out of range"));
-      return value_from_longest (type, TYPE_FIELD_ENUMVAL (type, pos));
-    }
-  else
-    return value_from_longest (type, value_as_long (arg));
+  return val_atr (type, value_as_long (arg));
 }
 \f
 
@@ -9235,7 +8951,7 @@ ada_is_aligner_type (struct type *type)
     return 0;
 
   return (type->code () == TYPE_CODE_STRUCT
-          && TYPE_NFIELDS (type) == 1
+          && type->num_fields () == 1
           && strcmp (TYPE_FIELD_NAME (type, 0), "F") == 0);
 }
 
@@ -9269,10 +8985,10 @@ ada_get_base_type (struct type *raw_type)
   real_type_namer = ada_find_parallel_type (raw_type, "___XVS");
   if (real_type_namer == NULL
       || real_type_namer->code () != TYPE_CODE_STRUCT
-      || TYPE_NFIELDS (real_type_namer) != 1)
+      || real_type_namer->num_fields () != 1)
     return raw_type;
 
-  if (TYPE_FIELD_TYPE (real_type_namer, 0)->code () != TYPE_CODE_REF)
+  if (real_type_namer->field (0).type ()->code () != TYPE_CODE_REF)
     {
       /* This is an older encoding form where the base type needs to be
         looked up by name.  We prefer the newer encoding because it is
@@ -9285,7 +9001,7 @@ ada_get_base_type (struct type *raw_type)
     }
 
   /* The field in our XVS type is a reference to the base type.  */
-  return TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (real_type_namer, 0));
+  return TYPE_TARGET_TYPE (real_type_namer->field (0).type ());
 }
 
 /* The type of value designated by TYPE, with all aligners removed.  */
@@ -9294,7 +9010,7 @@ struct type *
 ada_aligned_type (struct type *type)
 {
   if (ada_is_aligner_type (type))
-    return ada_aligned_type (TYPE_FIELD_TYPE (type, 0));
+    return ada_aligned_type (type->field (0).type ());
   else
     return ada_get_base_type (type);
 }
@@ -9307,7 +9023,7 @@ const gdb_byte *
 ada_aligned_value_addr (struct type *type, const gdb_byte *valaddr)
 {
   if (ada_is_aligner_type (type))
-    return ada_aligned_value_addr (TYPE_FIELD_TYPE (type, 0),
+    return ada_aligned_value_addr (type->field (0).type (),
                                    valaddr +
                                    TYPE_FIELD_BITPOS (type,
                                                       0) / TARGET_CHAR_BIT);
@@ -12178,11 +11894,7 @@ ada_exception_message_1 (void)
   if (e_msg_len <= 0)
     return NULL;
 
-  gdb::unique_xmalloc_ptr<char> e_msg ((char *) xmalloc (e_msg_len + 1));
-  read_memory_string (value_address (e_msg_val), e_msg.get (), e_msg_len + 1);
-  e_msg.get ()[e_msg_len] = '\0';
-
-  return e_msg;
+  return target_read_string (value_address (e_msg_val), INT_MAX);
 }
 
 /* Same as ada_exception_message_1, except that all exceptions are
@@ -13789,88 +13501,9 @@ enum ada_primitive_types {
   nr_ada_primitive_types
 };
 
-static void
-ada_language_arch_info (struct gdbarch *gdbarch,
-                       struct language_arch_info *lai)
-{
-  const struct builtin_type *builtin = builtin_type (gdbarch);
-
-  lai->primitive_type_vector
-    = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_ada_primitive_types + 1,
-                             struct type *);
-
-  lai->primitive_type_vector [ada_primitive_type_int]
-    = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
-                        0, "integer");
-  lai->primitive_type_vector [ada_primitive_type_long]
-    = arch_integer_type (gdbarch, gdbarch_long_bit (gdbarch),
-                        0, "long_integer");
-  lai->primitive_type_vector [ada_primitive_type_short]
-    = arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch),
-                        0, "short_integer");
-  lai->string_char_type
-    = lai->primitive_type_vector [ada_primitive_type_char]
-    = arch_character_type (gdbarch, TARGET_CHAR_BIT, 0, "character");
-  lai->primitive_type_vector [ada_primitive_type_float]
-    = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
-                      "float", gdbarch_float_format (gdbarch));
-  lai->primitive_type_vector [ada_primitive_type_double]
-    = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
-                      "long_float", gdbarch_double_format (gdbarch));
-  lai->primitive_type_vector [ada_primitive_type_long_long]
-    = arch_integer_type (gdbarch, gdbarch_long_long_bit (gdbarch),
-                        0, "long_long_integer");
-  lai->primitive_type_vector [ada_primitive_type_long_double]
-    = arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch),
-                      "long_long_float", gdbarch_long_double_format (gdbarch));
-  lai->primitive_type_vector [ada_primitive_type_natural]
-    = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
-                        0, "natural");
-  lai->primitive_type_vector [ada_primitive_type_positive]
-    = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
-                        0, "positive");
-  lai->primitive_type_vector [ada_primitive_type_void]
-    = builtin->builtin_void;
-
-  lai->primitive_type_vector [ada_primitive_type_system_address]
-    = lookup_pointer_type (arch_type (gdbarch, TYPE_CODE_VOID, TARGET_CHAR_BIT,
-                                     "void"));
-  lai->primitive_type_vector [ada_primitive_type_system_address]
-    ->set_name ("system__address");
-
-  /* Create the equivalent of the System.Storage_Elements.Storage_Offset
-     type.  This is a signed integral type whose size is the same as
-     the size of addresses.  */
-  {
-    unsigned int addr_length = TYPE_LENGTH
-      (lai->primitive_type_vector [ada_primitive_type_system_address]);
-
-    lai->primitive_type_vector [ada_primitive_type_storage_offset]
-      = arch_integer_type (gdbarch, addr_length * HOST_CHAR_BIT, 0,
-                          "storage_offset");
-  }
-
-  lai->bool_type_symbol = NULL;
-  lai->bool_type_default = builtin->builtin_bool;
-}
 \f
                                /* Language vector */
 
-/* Not really used, but needed in the ada_language_defn.  */
-
-static void
-emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
-{
-  ada_emit_char (c, type, stream, quoter, 1);
-}
-
-static int
-parse (struct parser_state *ps)
-{
-  warnings_issued = 0;
-  return ada_parse (ps);
-}
-
 static const struct exp_descriptor ada_exp_descriptor = {
   ada_print_subexp,
   ada_operator_length,
@@ -13920,10 +13553,10 @@ ada_lookup_name_info::ada_lookup_name_info (const lookup_name_info &lookup_name)
     {
       if (user_name.back () == '>')
        m_encoded_name
-         = user_name.substr (1, user_name.size () - 2).to_string ();
+         = gdb::to_string (user_name.substr (1, user_name.size () - 2));
       else
        m_encoded_name
-         = user_name.substr (1, user_name.size () - 1).to_string ();
+         = gdb::to_string (user_name.substr (1, user_name.size () - 1));
       m_encoded_p = true;
       m_verbatim_p = true;
       m_wild_match_p = false;
@@ -13942,10 +13575,10 @@ ada_lookup_name_info::ada_lookup_name_info (const lookup_name_info &lookup_name)
          if (encoded != NULL)
            m_encoded_name = encoded;
          else
-           m_encoded_name = user_name.to_string ();
+           m_encoded_name = gdb::to_string (user_name);
        }
       else
-       m_encoded_name = user_name.to_string ();
+       m_encoded_name = gdb::to_string (user_name);
 
       /* Handle the 'package Standard' special case.  See description
         of m_standard_p.  */
@@ -14007,7 +13640,7 @@ literal_symbol_name_matcher (const char *symbol_search_name,
     return false;
 }
 
-/* Implement the "la_get_symbol_name_matcher" language_defn method for
+/* Implement the "get_symbol_name_matcher" language_defn method for
    Ada.  */
 
 static symbol_name_matcher_ftype *
@@ -14029,32 +13662,15 @@ ada_get_symbol_name_matcher (const lookup_name_info &lookup_name)
     }
 }
 
-/* Implement the "la_read_var_value" language_defn method for Ada.  */
-
-static struct value *
-ada_read_var_value (struct symbol *var, const struct block *var_block,
-                   struct frame_info *frame)
-{
-  /* The only case where default_read_var_value is not sufficient
-     is when VAR is a renaming...  */
-  if (frame != nullptr)
-    {
-      const struct block *frame_block = get_frame_block (frame, NULL);
-      if (frame_block != nullptr && ada_is_renaming_symbol (var))
-       return ada_read_renaming_var_value (var, frame_block);
-    }
-
-  /* This is a typical case where we expect the default_read_var_value
-     function to work.  */
-  return default_read_var_value (var, var_block, frame);
-}
-
 static const char *ada_extensions[] =
 {
   ".adb", ".ads", ".a", ".ada", ".dg", NULL
 };
 
-extern const struct language_defn ada_language_defn = {
+/* Constant data that describes the Ada language.  */
+
+extern const struct language_data ada_language_data =
+{
   "ada",                        /* Language name */
   "Ada",
   language_ada,
@@ -14065,44 +13681,485 @@ extern const struct language_defn ada_language_defn = {
   macro_expansion_no,
   ada_extensions,
   &ada_exp_descriptor,
-  parse,
-  resolve,
-  ada_printchar,                /* Print a character constant */
-  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 */
-  ada_print_typedef,            /* Print a typedef using appropriate syntax */
-  ada_value_print_inner,       /* la_value_print_inner */
-  ada_value_print,              /* Print a top-level value */
-  ada_read_var_value,          /* la_read_var_value */
-  NULL,                         /* Language specific skip_trampoline */
   NULL,                         /* name_of_this */
   true,                         /* la_store_sym_names_in_linkage_form_p */
-  ada_lookup_symbol_nonlocal,   /* Looking up non-local symbols.  */
-  basic_lookup_transparent_type,        /* lookup_transparent_type */
-  ada_la_decode,                /* Language specific symbol demangler */
-  ada_sniff_from_mangled_name,
-  NULL,                         /* Language specific
-                                  class_name_from_physname */
   ada_op_print_tab,             /* expression operators for printing */
   0,                            /* c-style arrays */
   1,                            /* String lower bound */
-  ada_get_gdb_completer_word_break_characters,
-  ada_collect_symbol_completion_matches,
-  ada_language_arch_info,
-  ada_print_array_index,
-  default_pass_by_reference,
-  ada_watch_location_expression,
-  ada_get_symbol_name_matcher, /* la_get_symbol_name_matcher */
-  ada_iterate_over_symbols,
-  default_search_name_hash,
   &ada_varobj_ops,
-  NULL,
-  NULL,
-  ada_is_string_type,
   "(...)"                      /* la_struct_too_deep_ellipsis */
 };
 
+/* Class representing the Ada language.  */
+
+class ada_language : public language_defn
+{
+public:
+  ada_language ()
+    : language_defn (language_ada, ada_language_data)
+  { /* Nothing.  */ }
+
+  /* Print an array element index using the Ada syntax.  */
+
+  void print_array_index (struct type *index_type,
+                         LONGEST index,
+                         struct ui_file *stream,
+                         const value_print_options *options) const override
+  {
+    struct value *index_value = val_atr (index_type, index);
+
+    LA_VALUE_PRINT (index_value, stream, options);
+    fprintf_filtered (stream, " => ");
+  }
+
+  /* Implement the "read_var_value" language_defn method for Ada.  */
+
+  struct value *read_var_value (struct symbol *var,
+                               const struct block *var_block,
+                               struct frame_info *frame) const override
+  {
+    /* The only case where default_read_var_value is not sufficient
+       is when VAR is a renaming...  */
+    if (frame != nullptr)
+      {
+       const struct block *frame_block = get_frame_block (frame, NULL);
+       if (frame_block != nullptr && ada_is_renaming_symbol (var))
+         return ada_read_renaming_var_value (var, frame_block);
+      }
+
+    /* This is a typical case where we expect the default_read_var_value
+       function to work.  */
+    return language_defn::read_var_value (var, var_block, frame);
+  }
+
+  /* See language.h.  */
+  void language_arch_info (struct gdbarch *gdbarch,
+                          struct language_arch_info *lai) const override
+  {
+    const struct builtin_type *builtin = builtin_type (gdbarch);
+
+    lai->primitive_type_vector
+      = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_ada_primitive_types + 1,
+                               struct type *);
+
+    lai->primitive_type_vector [ada_primitive_type_int]
+      = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+                          0, "integer");
+    lai->primitive_type_vector [ada_primitive_type_long]
+      = arch_integer_type (gdbarch, gdbarch_long_bit (gdbarch),
+                          0, "long_integer");
+    lai->primitive_type_vector [ada_primitive_type_short]
+      = arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch),
+                          0, "short_integer");
+    lai->string_char_type
+      = lai->primitive_type_vector [ada_primitive_type_char]
+      = arch_character_type (gdbarch, TARGET_CHAR_BIT, 0, "character");
+    lai->primitive_type_vector [ada_primitive_type_float]
+      = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
+                        "float", gdbarch_float_format (gdbarch));
+    lai->primitive_type_vector [ada_primitive_type_double]
+      = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
+                        "long_float", gdbarch_double_format (gdbarch));
+    lai->primitive_type_vector [ada_primitive_type_long_long]
+      = arch_integer_type (gdbarch, gdbarch_long_long_bit (gdbarch),
+                          0, "long_long_integer");
+    lai->primitive_type_vector [ada_primitive_type_long_double]
+      = arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch),
+                        "long_long_float", gdbarch_long_double_format (gdbarch));
+    lai->primitive_type_vector [ada_primitive_type_natural]
+      = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+                          0, "natural");
+    lai->primitive_type_vector [ada_primitive_type_positive]
+      = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+                          0, "positive");
+    lai->primitive_type_vector [ada_primitive_type_void]
+      = builtin->builtin_void;
+
+    lai->primitive_type_vector [ada_primitive_type_system_address]
+      = lookup_pointer_type (arch_type (gdbarch, TYPE_CODE_VOID, TARGET_CHAR_BIT,
+                                       "void"));
+    lai->primitive_type_vector [ada_primitive_type_system_address]
+      ->set_name ("system__address");
+
+    /* Create the equivalent of the System.Storage_Elements.Storage_Offset
+       type.  This is a signed integral type whose size is the same as
+       the size of addresses.  */
+    {
+      unsigned int addr_length = TYPE_LENGTH
+       (lai->primitive_type_vector [ada_primitive_type_system_address]);
+
+      lai->primitive_type_vector [ada_primitive_type_storage_offset]
+       = arch_integer_type (gdbarch, addr_length * HOST_CHAR_BIT, 0,
+                            "storage_offset");
+    }
+
+    lai->bool_type_symbol = NULL;
+    lai->bool_type_default = builtin->builtin_bool;
+  }
+
+  /* See language.h.  */
+
+  bool iterate_over_symbols
+       (const struct block *block, const lookup_name_info &name,
+        domain_enum domain,
+        gdb::function_view<symbol_found_callback_ftype> callback) const override
+  {
+    std::vector<struct block_symbol> results;
+
+    ada_lookup_symbol_list_worker (name, block, domain, &results, 0);
+    for (block_symbol &sym : results)
+      {
+       if (!callback (&sym))
+         return false;
+      }
+
+    return true;
+  }
+
+  /* See language.h.  */
+  bool sniff_from_mangled_name (const char *mangled,
+                               char **out) const override
+  {
+    std::string demangled = ada_decode (mangled);
+
+    *out = NULL;
+
+    if (demangled != mangled && demangled[0] != '<')
+      {
+       /* Set the gsymbol language to Ada, but still return 0.
+          Two reasons for that:
+
+          1. For Ada, we prefer computing the symbol's decoded name
+          on the fly rather than pre-compute it, in order to save
+          memory (Ada projects are typically very large).
+
+          2. There are some areas in the definition of the GNAT
+          encoding where, with a bit of bad luck, we might be able
+          to decode a non-Ada symbol, generating an incorrect
+          demangled name (Eg: names ending with "TB" for instance
+          are identified as task bodies and so stripped from
+          the decoded name returned).
+
+          Returning true, here, but not setting *DEMANGLED, helps us get
+          a little bit of the best of both worlds.  Because we're last,
+          we should not affect any of the other languages that were
+          able to demangle the symbol before us; we get to correctly
+          tag Ada symbols as such; and even if we incorrectly tagged a
+          non-Ada symbol, which should be rare, any routing through the
+          Ada language should be transparent (Ada tries to behave much
+          like C/C++ with non-Ada symbols).  */
+       return true;
+      }
+
+    return false;
+  }
+
+  /* See language.h.  */
+
+  char *demangle (const char *mangled, int options) const override
+  {
+    return ada_la_decode (mangled, options);
+  }
+
+  /* See language.h.  */
+
+  void print_type (struct type *type, const char *varstring,
+                  struct ui_file *stream, int show, int level,
+                  const struct type_print_options *flags) const override
+  {
+    ada_print_type (type, varstring, stream, show, level, flags);
+  }
+
+  /* See language.h.  */
+
+  const char *word_break_characters (void) const override
+  {
+    return ada_completer_word_break_characters;
+  }
+
+  /* See language.h.  */
+
+  void collect_symbol_completion_matches (completion_tracker &tracker,
+                                         complete_symbol_mode mode,
+                                         symbol_name_match_type name_match_type,
+                                         const char *text, const char *word,
+                                         enum type_code code) const override
+  {
+    struct symbol *sym;
+    const struct block *b, *surrounding_static_block = 0;
+    struct block_iterator iter;
+
+    gdb_assert (code == TYPE_CODE_UNDEF);
+
+    lookup_name_info lookup_name (text, name_match_type, true);
+
+    /* First, look at the partial symtab symbols.  */
+    expand_symtabs_matching (NULL,
+                            lookup_name,
+                            NULL,
+                            NULL,
+                            ALL_DOMAIN);
+
+    /* At this point scan through the misc symbol vectors and add each
+       symbol you find to the list.  Eventually we want to ignore
+       anything that isn't a text symbol (everything else will be
+       handled by the psymtab code above).  */
+
+    for (objfile *objfile : current_program_space->objfiles ())
+      {
+       for (minimal_symbol *msymbol : objfile->msymbols ())
+         {
+           QUIT;
+
+           if (completion_skip_symbol (mode, msymbol))
+             continue;
+
+           language symbol_language = msymbol->language ();
+
+           /* Ada minimal symbols won't have their language set to Ada.  If
+              we let completion_list_add_name compare using the
+              default/C-like matcher, then when completing e.g., symbols in a
+              package named "pck", we'd match internal Ada symbols like
+              "pckS", which are invalid in an Ada expression, unless you wrap
+              them in '<' '>' to request a verbatim match.
+
+              Unfortunately, some Ada encoded names successfully demangle as
+              C++ symbols (using an old mangling scheme), such as "name__2Xn"
+              -> "Xn::name(void)" and thus some Ada minimal symbols end up
+              with the wrong language set.  Paper over that issue here.  */
+           if (symbol_language == language_auto
+               || symbol_language == language_cplus)
+             symbol_language = language_ada;
+
+           completion_list_add_name (tracker,
+                                     symbol_language,
+                                     msymbol->linkage_name (),
+                                     lookup_name, text, word);
+         }
+      }
+
+    /* Search upwards from currently selected frame (so that we can
+       complete on local vars.  */
+
+    for (b = get_selected_block (0); b != NULL; b = BLOCK_SUPERBLOCK (b))
+      {
+       if (!BLOCK_SUPERBLOCK (b))
+         surrounding_static_block = b;   /* For elmin of dups */
+
+       ALL_BLOCK_SYMBOLS (b, iter, sym)
+         {
+           if (completion_skip_symbol (mode, sym))
+             continue;
+
+           completion_list_add_name (tracker,
+                                     sym->language (),
+                                     sym->linkage_name (),
+                                     lookup_name, text, word);
+         }
+      }
+
+    /* Go through the symtabs and check the externs and statics for
+       symbols which match.  */
+
+    for (objfile *objfile : current_program_space->objfiles ())
+      {
+       for (compunit_symtab *s : objfile->compunits ())
+         {
+           QUIT;
+           b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), GLOBAL_BLOCK);
+           ALL_BLOCK_SYMBOLS (b, iter, sym)
+             {
+               if (completion_skip_symbol (mode, sym))
+                 continue;
+
+               completion_list_add_name (tracker,
+                                         sym->language (),
+                                         sym->linkage_name (),
+                                         lookup_name, text, word);
+             }
+         }
+      }
+
+    for (objfile *objfile : current_program_space->objfiles ())
+      {
+       for (compunit_symtab *s : objfile->compunits ())
+         {
+           QUIT;
+           b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), STATIC_BLOCK);
+           /* Don't do this block twice.  */
+           if (b == surrounding_static_block)
+             continue;
+           ALL_BLOCK_SYMBOLS (b, iter, sym)
+             {
+               if (completion_skip_symbol (mode, sym))
+                 continue;
+
+               completion_list_add_name (tracker,
+                                         sym->language (),
+                                         sym->linkage_name (),
+                                         lookup_name, text, word);
+             }
+         }
+      }
+  }
+
+  /* See language.h.  */
+
+  gdb::unique_xmalloc_ptr<char> watch_location_expression
+       (struct type *type, CORE_ADDR addr) const override
+  {
+    type = check_typedef (TYPE_TARGET_TYPE (check_typedef (type)));
+    std::string name = type_to_string (type);
+    return gdb::unique_xmalloc_ptr<char>
+      (xstrprintf ("{%s} %s", name.c_str (), core_addr_to_string (addr)));
+  }
+
+  /* See language.h.  */
+
+  void value_print (struct value *val, struct ui_file *stream,
+                   const struct value_print_options *options) const override
+  {
+    return ada_value_print (val, stream, options);
+  }
+
+  /* See language.h.  */
+
+  void value_print_inner
+       (struct value *val, struct ui_file *stream, int recurse,
+        const struct value_print_options *options) const override
+  {
+    return ada_value_print_inner (val, stream, recurse, options);
+  }
+
+  /* See language.h.  */
+
+  struct block_symbol lookup_symbol_nonlocal
+       (const char *name, const struct block *block,
+        const domain_enum domain) const override
+  {
+    struct block_symbol sym;
+
+    sym = ada_lookup_symbol (name, block_static_block (block), domain);
+    if (sym.symbol != NULL)
+      return sym;
+
+    /* If we haven't found a match at this point, try the primitive
+       types.  In other languages, this search is performed before
+       searching for global symbols in order to short-circuit that
+       global-symbol search if it happens that the name corresponds
+       to a primitive type.  But we cannot do the same in Ada, because
+       it is perfectly legitimate for a program to declare a type which
+       has the same name as a standard type.  If looking up a type in
+       that situation, we have traditionally ignored the primitive type
+       in favor of user-defined types.  This is why, unlike most other
+       languages, we search the primitive types this late and only after
+       having searched the global symbols without success.  */
+
+    if (domain == VAR_DOMAIN)
+      {
+       struct gdbarch *gdbarch;
+
+       if (block == NULL)
+         gdbarch = target_gdbarch ();
+       else
+         gdbarch = block_gdbarch (block);
+       sym.symbol
+         = language_lookup_primitive_type_as_symbol (this, gdbarch, name);
+       if (sym.symbol != NULL)
+         return sym;
+      }
+
+    return {};
+  }
+
+  /* See language.h.  */
+
+  int parser (struct parser_state *ps) const override
+  {
+    warnings_issued = 0;
+    return ada_parse (ps);
+  }
+
+  /* See language.h.
+
+     Same as evaluate_type (*EXP), but resolves ambiguous symbol references
+     (marked by OP_VAR_VALUE nodes in which the symbol has an undefined
+     namespace) and converts operators that are user-defined into
+     appropriate function calls.  If CONTEXT_TYPE is non-null, it provides
+     a preferred result type [at the moment, only type void has any
+     effect---causing procedures to be preferred over functions in calls].
+     A null CONTEXT_TYPE indicates that a non-void return type is
+     preferred.  May change (expand) *EXP.  */
+
+  void post_parser (expression_up *expp, int void_context_p, int completing,
+                   innermost_block_tracker *tracker) const override
+  {
+    struct type *context_type = NULL;
+    int pc = 0;
+
+    if (void_context_p)
+      context_type = builtin_type ((*expp)->gdbarch)->builtin_void;
+
+    resolve_subexp (expp, &pc, 1, context_type, completing, tracker);
+  }
+
+  /* See language.h.  */
+
+  void emitchar (int ch, struct type *chtype,
+                struct ui_file *stream, int quoter) const override
+  {
+    ada_emit_char (ch, chtype, stream, quoter, 1);
+  }
+
+  /* See language.h.  */
+
+  void printchar (int ch, struct type *chtype,
+                 struct ui_file *stream) const override
+  {
+    ada_printchar (ch, chtype, stream);
+  }
+
+  /* See language.h.  */
+
+  void printstr (struct ui_file *stream, struct type *elttype,
+                const gdb_byte *string, unsigned int length,
+                const char *encoding, int force_ellipses,
+                const struct value_print_options *options) const override
+  {
+    ada_printstr (stream, elttype, string, length, encoding,
+                 force_ellipses, options);
+  }
+
+  /* See language.h.  */
+
+  void print_typedef (struct type *type, struct symbol *new_symbol,
+                     struct ui_file *stream) const override
+  {
+    ada_print_typedef (type, new_symbol, stream);
+  }
+
+  /* See language.h.  */
+
+  bool is_string_type_p (struct type *type) const override
+  {
+    return ada_is_string_type (type);
+  }
+
+
+protected:
+  /* See language.h.  */
+
+  symbol_name_matcher_ftype *get_symbol_name_matcher_inner
+       (const lookup_name_info &lookup_name) const override
+  {
+    return ada_get_symbol_name_matcher (lookup_name);
+  }
+};
+
+/* Single instance of the Ada language class.  */
+
+static ada_language ada_language_defn;
+
 /* Command-list for the "set/show ada" prefix command.  */
 static struct cmd_list_element *set_ada_list;
 static struct cmd_list_element *show_ada_list;
This page took 0.05203 seconds and 4 git commands to generate.