--- /dev/null
+===================================================================
+RCS file: /cvs/src/src/gdb/ada-lang.c,v
+retrieving revision 1.35
+retrieving revision 1.36
+diff -u -r1.35 -r1.36
+--- gdb/ada-lang.c 2004/01/23 23:03:28 1.35
++++ gdb/ada-lang.c 2004/06/02 09:55:36 1.36
+@@ -1,5 +1,5 @@
+ /* Ada language support routines for GDB, the GNU debugger. Copyright
+- 1992, 1993, 1994, 1997, 1998, 1999, 2000, 2003, 2004
++ 1992, 1993, 1994, 1997, 1998, 1999, 2000, 2003, 2004.
+ Free Software Foundation, Inc.
+
+ This file is part of GDB.
+@@ -18,12 +18,14 @@
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
++#include "defs.h"
+ #include <stdio.h>
+ #include "gdb_string.h"
+ #include <ctype.h>
+ #include <stdarg.h>
+ #include "demangle.h"
+-#include "defs.h"
++#include "gdb_regex.h"
++#include "frame.h"
+ #include "symtab.h"
+ #include "gdbtypes.h"
+ #include "gdbcmd.h"
+@@ -36,15 +38,49 @@
+ #include "objfiles.h"
+ #include "breakpoint.h"
+ #include "gdbcore.h"
++#include "hashtab.h"
++#include "gdb_obstack.h"
+ #include "ada-lang.h"
++#include "completer.h"
++#include "gdb_stat.h"
++#ifdef UI_OUT
+ #include "ui-out.h"
++#endif
+ #include "block.h"
+ #include "infcall.h"
+ #include "dictionary.h"
+
+-struct cleanup *unresolved_names;
++#ifndef ADA_RETAIN_DOTS
++#define ADA_RETAIN_DOTS 0
++#endif
++
++/* Define whether or not the C operator '/' truncates towards zero for
++ differently signed operands (truncation direction is undefined in C).
++ Copied from valarith.c. */
++
++#ifndef TRUNCATION_TOWARDS_ZERO
++#define TRUNCATION_TOWARDS_ZERO ((-5 / 2) == -2)
++#endif
++
++/* A structure that contains a vector of strings.
++ The main purpose of this type is to group the vector and its
++ associated parameters in one structure. This makes it easier
++ to handle and pass around. */
++
++struct string_vector
++{
++ char **array; /* The vector itself. */
++ int index; /* Index of the next available element in the array. */
++ size_t size; /* The number of entries allocated in the array. */
++};
++
++static struct string_vector xnew_string_vector (int initial_size);
++static void string_vector_append (struct string_vector *sv, char *str);
+
+-void extract_string (CORE_ADDR addr, char *buf);
++static const char *ada_unqualified_name (const char *decoded_name);
++static char *add_angle_brackets (const char *str);
++static void extract_string (CORE_ADDR addr, char *buf);
++static char *function_name_from_pc (CORE_ADDR pc);
+
+ static struct type *ada_create_fundamental_type (struct objfile *, int);
+
+@@ -82,22 +118,27 @@
+
+ static int ada_args_match (struct symbol *, struct value **, int);
+
+-static struct value *place_on_stack (struct value *, CORE_ADDR *);
++static struct value *ensure_lval (struct value *, CORE_ADDR *);
+
+ static struct value *convert_actual (struct value *, struct type *,
+- CORE_ADDR *);
++ CORE_ADDR *);
+
+ static struct value *make_array_descriptor (struct type *, struct value *,
+- CORE_ADDR *);
++ CORE_ADDR *);
+
+-static void ada_add_block_symbols (struct block *, const char *,
+- domain_enum, struct objfile *, int);
++static void ada_add_block_symbols (struct obstack *,
++ struct block *, const char *,
++ domain_enum, struct objfile *,
++ struct symtab *, int);
+
+-static void fill_in_ada_prototype (struct symbol *);
++static int is_nonfunction (struct ada_symbol_info *, int);
+
+-static int is_nonfunction (struct symbol **, int);
++static void add_defn_to_vec (struct obstack *, struct symbol *, struct block *,
++ struct symtab *);
+
+-static void add_defn_to_vec (struct symbol *, struct block *);
++static int num_defns_collected (struct obstack *);
++
++static struct ada_symbol_info *defns_collected (struct obstack *, int);
+
+ static struct partial_symbol *ada_lookup_partial_symbol (struct partial_symtab
+ *, const char *, int,
+@@ -105,15 +146,17 @@
+
+ static struct symtab *symtab_for_sym (struct symbol *);
+
+-static struct value *ada_resolve_subexp (struct expression **, int *, int,
+- struct type *);
++static struct value *resolve_subexp (struct expression **, int *, int,
++ struct type *);
+
+ static void replace_operator_with_call (struct expression **, int, int, int,
+- struct symbol *, struct block *);
++ struct symbol *, struct block *);
+
+ static int possible_user_operator_p (enum exp_opcode, struct value **);
+
+-static const char *ada_op_name (enum exp_opcode);
++static char *ada_op_name (enum exp_opcode);
++
++static const char *ada_decoded_op_name (enum exp_opcode);
+
+ static int numeric_type_p (struct type *);
+
+@@ -123,11 +166,14 @@
+
+ static int discrete_type_p (struct type *);
+
++static struct type *ada_lookup_struct_elt_type (struct type *, char *,
++ int, int, int *);
++
+ static char *extended_canonical_line_spec (struct symtab_and_line,
+- const char *);
++ const char *);
+
+ static struct value *evaluate_subexp (struct type *, struct expression *,
+- int *, enum noside);
++ int *, enum noside);
+
+ static struct value *evaluate_subexp_type (struct expression *, int *);
+
+@@ -136,10 +182,12 @@
+ static int is_dynamic_field (struct type *, int);
+
+ static struct type *to_fixed_variant_branch_type (struct type *, char *,
+- CORE_ADDR, struct value *);
++ CORE_ADDR, struct value *);
++
++static struct type *to_fixed_array_type (struct type *, struct value *, int);
+
+ static struct type *to_fixed_range_type (char *, struct value *,
+- struct objfile *);
++ struct objfile *);
+
+ static struct type *to_static_fixed_type (struct type *);
+
+@@ -152,10 +200,10 @@
+ static struct value *decode_packed_array (struct value *);
+
+ static struct value *value_subscript_packed (struct value *, int,
+- struct value **);
++ struct value **);
+
+-static struct value *coerce_unspec_val_to_type (struct value *, long,
+- struct type *);
++static struct value *coerce_unspec_val_to_type (struct value *,
++ struct type *);
+
+ static struct value *get_var_value (char *, char *);
+
+@@ -167,71 +215,225 @@
+
+ static int wild_match (const char *, int, const char *);
+
+-static struct symtabs_and_lines find_sal_from_funcs_and_line (const char *,
+- int,
+- struct symbol
+- **, int);
++static struct symtabs_and_lines
++find_sal_from_funcs_and_line (const char *, int,
++ struct ada_symbol_info *, int);
+
+-static int find_line_in_linetable (struct linetable *, int, struct symbol **,
++static int find_line_in_linetable (struct linetable *, int,
++ struct ada_symbol_info *,
+ int, int *);
+
+ static int find_next_line_in_linetable (struct linetable *, int, int, int);
+
+-static struct symtabs_and_lines all_sals_for_line (const char *, int,
+- char ***);
+-
+ static void read_all_symtabs (const char *);
+
+ static int is_plausible_func_for_line (struct symbol *, int);
+
+ static struct value *ada_coerce_ref (struct value *);
+
++static LONGEST pos_atr (struct value *);
++
+ static struct value *value_pos_atr (struct value *);
+
+ static struct value *value_val_atr (struct type *, struct value *);
+
+-static struct symbol *standard_lookup (const char *, domain_enum);
++static struct symbol *standard_lookup (const char *, const struct block *,
++ domain_enum);
+
+-extern void markTimeStart (int index);
+-extern void markTimeStop (int index);
+-\f
++extern void symtab_symbol_info (char *regexp, domain_enum kind,
++ int from_tty);
++
++static struct value *ada_search_struct_field (char *, struct value *, int,
++ struct type *);
++
++static struct value *ada_value_primitive_field (struct value *, int, int,
++ struct type *);
++
++static int find_struct_field (char *, struct type *, int,
++ struct type **, int *, int *, int *);
++
++static struct value *ada_to_fixed_value_create (struct type *, CORE_ADDR,
++ struct value *);
++
++static struct value *ada_to_fixed_value (struct value *);
++
++static void adjust_pc_past_prologue (CORE_ADDR *);
++
++static int ada_resolve_function (struct ada_symbol_info *, int,
++ struct value **, int, const char *,
++ struct type *);
+
++static struct value *ada_coerce_to_simple_array (struct value *);
+
+-/* Maximum-sized dynamic type. */
++static int ada_is_direct_array_type (struct type *);
++
++static void error_breakpoint_runtime_sym_not_found (const char *err_desc);
++
++static int is_runtime_sym_defined (const char *name, int allow_tramp);
++
++\f
++
++/* Maximum-sized dynamic type. */
+ static unsigned int varsize_limit;
+
+-static const char *ada_completer_word_break_characters =
++/* FIXME: brobecker/2003-09-17: No longer a const because it is
++ returned by a function that does not return a const char *. */
++static char *ada_completer_word_break_characters =
++#ifdef VMS
++ " \t\n!@#%^&*()+=|~`}{[]\";:?/,-";
++#else
+ " \t\n!@#$%^&*()+=|~`}{[]\";:?/,-";
++#endif
++
++/* The name of the symbol to use to get the name of the main subprogram. */
++static const char ADA_MAIN_PROGRAM_SYMBOL_NAME[]
++ = "__gnat_ada_main_program_name";
++
++/* The name of the runtime function called when an exception is raised. */
++static const char raise_sym_name[] = "__gnat_raise_nodefer_with_msg";
++
++/* The name of the runtime function called when an unhandled exception
++ is raised. */
++static const char raise_unhandled_sym_name[] = "__gnat_unhandled_exception";
++
++/* The name of the runtime function called when an assert failure is
++ raised. */
++static const char raise_assert_sym_name[] =
++ "system__assertions__raise_assert_failure";
++
++/* When GDB stops on an unhandled exception, GDB will go up the stack until
++ if finds a frame corresponding to this function, in order to extract the
++ name of the exception that has been raised from one of the parameters. */
++static const char process_raise_exception_name[] =
++ "ada__exceptions__process_raise_exception";
++
++/* A string that reflects the longest exception expression rewrite,
++ aside from the exception name. */
++static const char longest_exception_template[] =
++ "'__gnat_raise_nodefer_with_msg' if long_integer(e) = long_integer(&)";
++
++/* Limit on the number of warnings to raise per expression evaluation. */
++static int warning_limit = 2;
++
++/* Number of warning messages issued; reset to 0 by cleanups after
++ expression evaluation. */
++static int warnings_issued = 0;
+
+-/* The name of the symbol to use to get the name of the main subprogram */
+-#define ADA_MAIN_PROGRAM_SYMBOL_NAME "__gnat_ada_main_program_name"
++static const char *known_runtime_file_name_patterns[] = {
++ ADA_KNOWN_RUNTIME_FILE_NAME_PATTERNS NULL
++};
+
+- /* Utilities */
++static const char *known_auxiliary_function_name_patterns[] = {
++ ADA_KNOWN_AUXILIARY_FUNCTION_NAME_PATTERNS NULL
++};
+
+-/* extract_string
+- *
+- * read the string located at ADDR from the inferior and store the
+- * result into BUF
+- */
+-void
++/* Space for allocating results of ada_lookup_symbol_list. */
++static struct obstack symbol_list_obstack;
++
++ /* Utilities */
++
++/* Create a new empty string_vector struct with an initial size of
++ INITIAL_SIZE. */
++
++static struct string_vector
++xnew_string_vector (int initial_size)
++{
++ struct string_vector result;
++
++ result.array = (char **) xmalloc ((initial_size + 1) * sizeof (char *));
++ result.index = 0;
++ result.size = initial_size;
++
++ return result;
++}
++
++/* Add STR at the end of the given string vector SV. If SV is already
++ full, its size is automatically increased (doubled). */
++
++static void
++string_vector_append (struct string_vector *sv, char *str)
++{
++ if (sv->index >= sv->size)
++ GROW_VECT (sv->array, sv->size, sv->size * 2);
++
++ sv->array[sv->index] = str;
++ sv->index++;
++}
++
++/* Given DECODED_NAME a string holding a symbol name in its
++ decoded form (ie using the Ada dotted notation), returns
++ its unqualified name. */
++
++static const char *
++ada_unqualified_name (const char *decoded_name)
++{
++ const char *result = strrchr (decoded_name, '.');
++
++ if (result != NULL)
++ result++; /* Skip the dot... */
++ else
++ result = decoded_name;
++
++ return result;
++}
++
++/* Return a string starting with '<', followed by STR, and '>'.
++ The result is good until the next call. */
++
++static char *
++add_angle_brackets (const char *str)
++{
++ static char *result = NULL;
++
++ xfree (result);
++ result = (char *) xmalloc ((strlen (str) + 3) * sizeof (char));
++
++ sprintf (result, "<%s>", str);
++ return result;
++}
++
++static char *
++ada_get_gdb_completer_word_break_characters (void)
++{
++ return ada_completer_word_break_characters;
++}
++
++/* Read the string located at ADDR from the inferior and store the
++ result into BUF. */
++
++static void
+ extract_string (CORE_ADDR addr, char *buf)
+ {
+ int char_index = 0;
+
+- /* Loop, reading one byte at a time, until we reach the '\000'
+- end-of-string marker */
++ /* Loop, reading one byte at a time, until we reach the '\000'
++ end-of-string marker. */
+ do
+ {
+ target_read_memory (addr + char_index * sizeof (char),
+- buf + char_index * sizeof (char), sizeof (char));
++ buf + char_index * sizeof (char), sizeof (char));
+ char_index++;
+ }
+ while (buf[char_index - 1] != '\000');
+ }
+
++/* Return the name of the function owning the instruction located at PC.
++ Return NULL if no such function could be found. */
++
++static char *
++function_name_from_pc (CORE_ADDR pc)
++{
++ char *func_name;
++
++ if (!find_pc_partial_function (pc, &func_name, NULL, NULL))
++ return NULL;
++
++ return func_name;
++}
++
+ /* Assuming *OLD_VECT points to an array of *SIZE objects of size
+ ELEMENT_SIZE, grow it to contain at least MIN_SIZE objects,
+- updating *OLD_VECT and *SIZE as necessary. */
++ updating *OLD_VECT and *SIZE as necessary. */
+
+ void
+ grow_vect (void **old_vect, size_t * size, size_t min_size, int element_size)
+@@ -240,27 +442,50 @@
+ {
+ *size *= 2;
+ if (*size < min_size)
+- *size = min_size;
++ *size = min_size;
+ *old_vect = xrealloc (*old_vect, *size * element_size);
+ }
+ }
+
+ /* True (non-zero) iff TARGET matches FIELD_NAME up to any trailing
+- suffix of FIELD_NAME beginning "___" */
++ suffix of FIELD_NAME beginning "___". */
+
+ static int
+ field_name_match (const char *field_name, const char *target)
+ {
+ int len = strlen (target);
+ return
+- DEPRECATED_STREQN (field_name, target, len)
+- && (field_name[len] == '\0'
+- || (DEPRECATED_STREQN (field_name + len, "___", 3)
+- && !DEPRECATED_STREQ (field_name + strlen (field_name) - 6, "___XVN")));
++ (strncmp (field_name, target, len) == 0
++ && (field_name[len] == '\0'
++ || (strncmp (field_name + len, "___", 3) == 0
++ && strcmp (field_name + strlen (field_name) - 6, "___XVN") != 0)));
+ }
+
+
+-/* The length of the prefix of NAME prior to any "___" suffix. */
++/* Assuming TYPE is a TYPE_CODE_STRUCT, find the field whose name matches
++ FIELD_NAME, and return its index. This function also handles fields
++ whose name have ___ suffixes because the compiler sometimes alters
++ their name by adding such a suffix to represent fields with certain
++ constraints. If the field could not be found, return a negative
++ number if MAYBE_MISSING is set. Otherwise raise an error. */
++
++int
++ada_get_field_index (const struct type *type, const char *field_name,
++ int maybe_missing)
++{
++ int fieldno;
++ for (fieldno = 0; fieldno < TYPE_NFIELDS (type); fieldno++)
++ if (field_name_match (TYPE_FIELD_NAME (type, fieldno), field_name))
++ return fieldno;
++
++ if (!maybe_missing)
++ error ("Unable to find field %s in struct %s. Aborting",
++ field_name, TYPE_NAME (type));
++
++ return -1;
++}
++
++/* The length of the prefix of NAME prior to any "___" suffix. */
+
+ int
+ ada_name_prefix_len (const char *name)
+@@ -271,13 +496,15 @@
+ {
+ const char *p = strstr (name, "___");
+ if (p == NULL)
+- return strlen (name);
++ return strlen (name);
+ else
+- return p - name;
++ return p - name;
+ }
+ }
+
+-/* SUFFIX is a suffix of STR. False if STR is null. */
++/* Return non-zero if SUFFIX is a suffix of STR.
++ Return zero if STR is null. */
++
+ static int
+ is_suffix (const char *str, const char *suffix)
+ {
+@@ -286,15 +513,16 @@
+ return 0;
+ len1 = strlen (str);
+ len2 = strlen (suffix);
+- return (len1 >= len2 && DEPRECATED_STREQ (str + len1 - len2, suffix));
++ return (len1 >= len2 && strcmp (str + len1 - len2, suffix) == 0);
+ }
+
+ /* Create a value of type TYPE whose contents come from VALADDR, if it
+- * is non-null, and whose memory address (in the inferior) is
+- * ADDRESS. */
++ is non-null, and whose memory address (in the inferior) is
++ ADDRESS. */
++
+ struct value *
+ value_from_contents_and_address (struct type *type, char *valaddr,
+- CORE_ADDR address)
++ CORE_ADDR address)
+ {
+ struct value *v = allocate_value (type);
+ if (valaddr == NULL)
+@@ -307,31 +535,35 @@
+ return v;
+ }
+
+-/* The contents of value VAL, beginning at offset OFFSET, treated as a
+- value of type TYPE. The result is an lval in memory if VAL is. */
++/* The contents of value VAL, treated as a value of type TYPE. The
++ result is an lval in memory if VAL is. */
+
+ static struct value *
+-coerce_unspec_val_to_type (struct value *val, long offset, struct type *type)
++coerce_unspec_val_to_type (struct value *val, struct type *type)
+ {
+ CHECK_TYPEDEF (type);
+- if (VALUE_LVAL (val) == lval_memory)
+- return value_at_lazy (type,
+- VALUE_ADDRESS (val) + VALUE_OFFSET (val) + offset,
+- NULL);
++ if (VALUE_TYPE (val) == type)
++ return val;
+ else
+ {
+- struct value *result = allocate_value (type);
+- VALUE_LVAL (result) = not_lval;
+- if (VALUE_ADDRESS (val) == 0)
+- memcpy (VALUE_CONTENTS_RAW (result), VALUE_CONTENTS (val) + offset,
+- TYPE_LENGTH (type) > TYPE_LENGTH (VALUE_TYPE (val))
+- ? TYPE_LENGTH (VALUE_TYPE (val)) : TYPE_LENGTH (type));
++ struct value *result;
++
++ /* Make sure that the object size is not unreasonable before
++ trying to allocate some memory for it. */
++ if (TYPE_LENGTH (type) > varsize_limit)
++ error ("object size is larger than varsize-limit");
++
++ result = allocate_value (type);
++ VALUE_LVAL (result) = VALUE_LVAL (val);
++ VALUE_BITSIZE (result) = VALUE_BITSIZE (val);
++ VALUE_BITPOS (result) = VALUE_BITPOS (val);
++ VALUE_ADDRESS (result) = VALUE_ADDRESS (val) + VALUE_OFFSET (val);
++ if (VALUE_LAZY (val) ||
++ TYPE_LENGTH (type) > TYPE_LENGTH (VALUE_TYPE (val)))
++ VALUE_LAZY (result) = 1;
+ else
+- {
+- VALUE_ADDRESS (result) =
+- VALUE_ADDRESS (val) + VALUE_OFFSET (val) + offset;
+- VALUE_LAZY (result) = 1;
+- }
++ memcpy (VALUE_CONTENTS_RAW (result), VALUE_CONTENTS (val),
++ TYPE_LENGTH (type));
+ return result;
+ }
+ }
+@@ -354,59 +586,130 @@
+ return address + offset;
+ }
+
+-/* Perform execute_command on the result of concatenating all
+- arguments up to NULL. */
++/* Issue a warning (as for the definition of warning in utils.c, but
++ with exactly one argument rather than ...), unless the limit on the
++ number of warnings has passed during the evaluation of the current
++ expression. */
+ static void
+-do_command (const char *arg, ...)
++lim_warning (const char *format, long arg)
+ {
+- int len;
+- char *cmd;
+- const char *s;
+- va_list ap;
+-
+- va_start (ap, arg);
+- len = 0;
+- s = arg;
+- cmd = "";
+- for (; s != NULL; s = va_arg (ap, const char *))
+- {
+- char *cmd1;
+- len += strlen (s);
+- cmd1 = alloca (len + 1);
+- strcpy (cmd1, cmd);
+- strcat (cmd1, s);
+- cmd = cmd1;
++ warnings_issued += 1;
++ if (warnings_issued <= warning_limit)
++ warning (format, arg);
++}
++
++static const char *
++ada_translate_error_message (const char *string)
++{
++ if (strcmp (string, "Invalid cast.") == 0)
++ return "Invalid type conversion.";
++ else
++ return string;
++}
++
++static LONGEST
++MAX_OF_SIZE (int size)
++{
++ LONGEST top_bit = (LONGEST) 1 << (size*8-2);
++ return top_bit | (top_bit-1);
++}
++
++static LONGEST
++MIN_OF_SIZE (int size)
++{
++ return - MAX_OF_SIZE (size) - 1;
++}
++
++static ULONGEST
++UMAX_OF_SIZE (int size)
++{
++ ULONGEST top_bit = (ULONGEST) 1 << (size*8-1);
++ return top_bit | (top_bit-1);
++}
++
++static ULONGEST
++UMIN_OF_SIZE (int size)
++{
++ return 0;
++}
++
++/* The largest value in the domain of TYPE, a discrete type, as an integer. */
++static struct value *
++discrete_type_high_bound (struct type *type)
++{
++ switch (TYPE_CODE (type))
++ {
++ case TYPE_CODE_RANGE:
++ return value_from_longest (TYPE_TARGET_TYPE (type),
++ TYPE_HIGH_BOUND (type));
++ case TYPE_CODE_ENUM:
++ return
++ value_from_longest (type,
++ TYPE_FIELD_BITPOS (type, TYPE_NFIELDS (type)-1));
++ case TYPE_CODE_INT:
++ return value_from_longest (type, MAX_OF_TYPE (type));
++ default:
++ error ("Unexpected type in discrete_type_high_bound.");
+ }
+- va_end (ap);
+- execute_command (cmd, 0);
+ }
+-\f
+
+- /* Language Selection */
++/* The largest value in the domain of TYPE, a discrete type, as an integer. */
++static struct value *
++discrete_type_low_bound (struct type *type)
++{
++ switch (TYPE_CODE (type))
++ {
++ case TYPE_CODE_RANGE:
++ return value_from_longest (TYPE_TARGET_TYPE (type),
++ TYPE_LOW_BOUND (type));
++ case TYPE_CODE_ENUM:
++ return value_from_longest (type, TYPE_FIELD_BITPOS (type, 0));
++ case TYPE_CODE_INT:
++ return value_from_longest (type, MIN_OF_TYPE (type));
++ default:
++ error ("Unexpected type in discrete_type_low_bound.");
++ }
++}
++
++/* The identity on non-range types. For range types, the underlying
++ non-range scalar type. */
++
++static struct type *
++base_type (struct type *type)
++{
++ while (type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE)
++ {
++ if (type == TYPE_TARGET_TYPE (type)
++ || TYPE_TARGET_TYPE (type) == NULL)
++ return type;
++ type = TYPE_TARGET_TYPE (type);
++ }
++ return type;
++}
++
++\f
++ /* Language Selection */
+
+ /* If the main program is in Ada, return language_ada, otherwise return LANG
+ (the main program is in Ada iif the adainit symbol is found).
+
+- MAIN_PST is not used. */
++ MAIN_PST is not used. */
+
+ enum language
+ ada_update_initial_language (enum language lang,
+- struct partial_symtab *main_pst)
++ struct partial_symtab *main_pst)
+ {
+ if (lookup_minimal_symbol ("adainit", (const char *) NULL,
+- (struct objfile *) NULL) != NULL)
+- /* return language_ada; */
+- /* FIXME: language_ada should be defined in defs.h */
+- return language_unknown;
++ (struct objfile *) NULL) != NULL)
++ return language_ada;
+
+ return lang;
+ }
+ \f
++ /* Symbols */
+
+- /* Symbols */
+-
+-/* Table of Ada operators and their GNAT-mangled names. Last entry is pair
+- of NULLs. */
++/* Table of Ada operators and their GNAT-encoded names. Last entry is pair
++ of NULLs. */
+
+ const struct ada_opname_map ada_opname_table[] = {
+ {"Oadd", "\"+\"", BINOP_ADD},
+@@ -433,11 +736,12 @@
+ {NULL, NULL}
+ };
+
+-/* True if STR should be suppressed in info listings. */
++/* Return non-zero if STR should be suppressed in info listings. */
++
+ static int
+ is_suppressed_name (const char *str)
+ {
+- if (DEPRECATED_STREQN (str, "_ada_", 5))
++ if (strncmp (str, "_ada_", 5) == 0)
+ str += 5;
+ if (str[0] == '_' || str[0] == '\000')
+ return 1;
+@@ -446,81 +750,84 @@
+ const char *p;
+ const char *suffix = strstr (str, "___");
+ if (suffix != NULL && suffix[3] != 'X')
+- return 1;
++ return 1;
+ if (suffix == NULL)
+- suffix = str + strlen (str);
++ suffix = str + strlen (str);
+ for (p = suffix - 1; p != str; p -= 1)
+- if (isupper (*p))
+- {
+- int i;
+- if (p[0] == 'X' && p[-1] != '_')
+- goto OK;
+- if (*p != 'O')
+- return 1;
+- for (i = 0; ada_opname_table[i].mangled != NULL; i += 1)
+- if (DEPRECATED_STREQN (ada_opname_table[i].mangled, p,
+- strlen (ada_opname_table[i].mangled)))
+- goto OK;
+- return 1;
+- OK:;
+- }
++ if (isupper (*p))
++ {
++ int i;
++ if (p[0] == 'X' && p[-1] != '_')
++ goto OK;
++ if (*p != 'O')
++ return 1;
++ for (i = 0; ada_opname_table[i].encoded != NULL; i += 1)
++ if (strncmp (ada_opname_table[i].encoded, p,
++ strlen (ada_opname_table[i].encoded)) == 0)
++ goto OK;
++ return 1;
++ OK:;
++ }
+ return 0;
+ }
+ }
+
+-/* The "mangled" form of DEMANGLED, according to GNAT conventions.
+- * The result is valid until the next call to ada_mangle. */
++/* The "encoded" form of DECODED, according to GNAT conventions.
++ The result is valid until the next call to ada_encode. */
++
+ char *
+-ada_mangle (const char *demangled)
++ada_encode (const char *decoded)
+ {
+- static char *mangling_buffer = NULL;
+- static size_t mangling_buffer_size = 0;
++ static char *encoding_buffer = NULL;
++ static size_t encoding_buffer_size = 0;
+ const char *p;
+ int k;
+
+- if (demangled == NULL)
++ if (decoded == NULL)
+ return NULL;
+
+- GROW_VECT (mangling_buffer, mangling_buffer_size,
+- 2 * strlen (demangled) + 10);
++ GROW_VECT (encoding_buffer, encoding_buffer_size,
++ 2 * strlen (decoded) + 10);
+
+ k = 0;
+- for (p = demangled; *p != '\0'; p += 1)
++ for (p = decoded; *p != '\0'; p += 1)
+ {
+- if (*p == '.')
+- {
+- mangling_buffer[k] = mangling_buffer[k + 1] = '_';
+- k += 2;
+- }
++ if (!ADA_RETAIN_DOTS && *p == '.')
++ {
++ encoding_buffer[k] = encoding_buffer[k + 1] = '_';
++ k += 2;
++ }
+ else if (*p == '"')
+- {
+- const struct ada_opname_map *mapping;
++ {
++ const struct ada_opname_map *mapping;
+
+- for (mapping = ada_opname_table;
+- mapping->mangled != NULL &&
+- !DEPRECATED_STREQN (mapping->demangled, p, strlen (mapping->demangled));
+- p += 1)
+- ;
+- if (mapping->mangled == NULL)
+- error ("invalid Ada operator name: %s", p);
+- strcpy (mangling_buffer + k, mapping->mangled);
+- k += strlen (mapping->mangled);
+- break;
+- }
+- else
+- {
+- mangling_buffer[k] = *p;
+- k += 1;
+- }
++ for (mapping = ada_opname_table;
++ mapping->encoded != NULL &&
++ strncmp (mapping->decoded, p,
++ strlen (mapping->decoded)) != 0;
++ mapping += 1)
++ ;
++ if (mapping->encoded == NULL)
++ error ("invalid Ada operator name: %s", p);
++ strcpy (encoding_buffer + k, mapping->encoded);
++ k += strlen (mapping->encoded);
++ break;
++ }
++ else
++ {
++ encoding_buffer[k] = *p;
++ k += 1;
++ }
+ }
+
+- mangling_buffer[k] = '\0';
+- return mangling_buffer;
++ encoding_buffer[k] = '\0';
++ return encoding_buffer;
+ }
+
+ /* Return NAME folded to lower case, or, if surrounded by single
+- * quotes, unfolded, but with the quotes stripped away. Result good
+- * to next call. */
++ quotes, unfolded, but with the quotes stripped away. Result good
++ to next call. */
++
+ char *
+ ada_fold_name (const char *name)
+ {
+@@ -539,148 +846,241 @@
+ {
+ int i;
+ for (i = 0; i <= len; i += 1)
+- fold_buffer[i] = tolower (name[i]);
++ fold_buffer[i] = tolower (name[i]);
+ }
+
+ return fold_buffer;
+ }
+
+-/* Demangle:
+- 1. Discard final __{DIGIT}+ or ${DIGIT}+
++/* decode:
++ 0. Discard trailing .{DIGIT}+ or trailing ___{DIGIT}+
++ These are suffixes introduced by GNAT5 to nested subprogram
++ names, and do not serve any purpose for the debugger.
++ 1. Discard final __{DIGIT}+ or $({DIGIT}+(__{DIGIT}+)*)
+ 2. Convert other instances of embedded "__" to `.'.
+ 3. Discard leading _ada_.
+ 4. Convert operator names to the appropriate quoted symbols.
+- 5. Remove everything after first ___ if it is followed by
++ 5. Remove everything after first ___ if it is followed by
+ 'X'.
+ 6. Replace TK__ with __, and a trailing B or TKB with nothing.
+ 7. Put symbols that should be suppressed in <...> brackets.
+ 8. Remove trailing X[bn]* suffix (indicating names in package bodies).
+- The resulting string is valid until the next call of ada_demangle.
+- */
+
+-char *
+-ada_demangle (const char *mangled)
++ The resulting string is valid until the next call of ada_decode.
++ If the string is unchanged by demangling, the original string pointer
++ is returned. */
++
++const char *
++ada_decode (const char *encoded)
+ {
+ int i, j;
+ int len0;
+ const char *p;
+- char *demangled;
++ char *decoded;
+ int at_start_name;
+- static char *demangling_buffer = NULL;
+- static size_t demangling_buffer_size = 0;
++ static char *decoding_buffer = NULL;
++ static size_t decoding_buffer_size = 0;
+
+- if (DEPRECATED_STREQN (mangled, "_ada_", 5))
+- mangled += 5;
++ if (strncmp (encoded, "_ada_", 5) == 0)
++ encoded += 5;
+
+- if (mangled[0] == '_' || mangled[0] == '<')
++ if (encoded[0] == '_' || encoded[0] == '<')
+ goto Suppress;
+
+- p = strstr (mangled, "___");
+- if (p == NULL)
+- len0 = strlen (mangled);
+- else
++ /* Remove trailing .{DIGIT}+ or ___{DIGIT}+. */
++ len0 = strlen (encoded);
++ if (len0 > 1 && isdigit (encoded[len0 - 1]))
++ {
++ i = len0 - 2;
++ while (i > 0 && isdigit (encoded[i]))
++ i--;
++ if (i >= 0 && encoded[i] == '.')
++ len0 = i;
++ else if (i >= 2 && strncmp (encoded + i - 2, "___", 3) == 0)
++ len0 = i - 2;
++ }
++
++ /* Remove the ___X.* suffix if present. Do not forget to verify that
++ the suffix is located before the current "end" of ENCODED. We want
++ to avoid re-matching parts of ENCODED that have previously been
++ marked as discarded (by decrementing LEN0). */
++ p = strstr (encoded, "___");
++ if (p != NULL && p - encoded < len0 - 3)
+ {
+ if (p[3] == 'X')
+- len0 = p - mangled;
++ len0 = p - encoded;
+ else
+- goto Suppress;
++ goto Suppress;
+ }
+- if (len0 > 3 && DEPRECATED_STREQ (mangled + len0 - 3, "TKB"))
++
++ if (len0 > 3 && strncmp (encoded + len0 - 3, "TKB", 3) == 0)
+ len0 -= 3;
+- if (len0 > 1 && DEPRECATED_STREQ (mangled + len0 - 1, "B"))
++
++ if (len0 > 1 && strncmp (encoded + len0 - 1, "B", 1) == 0)
+ len0 -= 1;
+
+- /* Make demangled big enough for possible expansion by operator name. */
+- GROW_VECT (demangling_buffer, demangling_buffer_size, 2 * len0 + 1);
+- demangled = demangling_buffer;
+-
+- if (isdigit (mangled[len0 - 1]))
+- {
+- for (i = len0 - 2; i >= 0 && isdigit (mangled[i]); i -= 1)
+- ;
+- if (i > 1 && mangled[i] == '_' && mangled[i - 1] == '_')
+- len0 = i - 1;
+- else if (mangled[i] == '$')
+- len0 = i;
++ /* Make decoded big enough for possible expansion by operator name. */
++ GROW_VECT (decoding_buffer, decoding_buffer_size, 2 * len0 + 1);
++ decoded = decoding_buffer;
++
++ if (len0 > 1 && isdigit (encoded[len0 - 1]))
++ {
++ i = len0 - 2;
++ while ((i >= 0 && isdigit (encoded[i]))
++ || (i >= 1 && encoded[i] == '_' && isdigit (encoded[i - 1])))
++ i -= 1;
++ if (i > 1 && encoded[i] == '_' && encoded[i - 1] == '_')
++ len0 = i - 1;
++ else if (encoded[i] == '$')
++ len0 = i;
+ }
+
+- for (i = 0, j = 0; i < len0 && !isalpha (mangled[i]); i += 1, j += 1)
+- demangled[j] = mangled[i];
++ for (i = 0, j = 0; i < len0 && !isalpha (encoded[i]); i += 1, j += 1)
++ decoded[j] = encoded[i];
+
+ at_start_name = 1;
+ while (i < len0)
+ {
+- if (at_start_name && mangled[i] == 'O')
++ if (at_start_name && encoded[i] == 'O')
++ {
++ int k;
++ for (k = 0; ada_opname_table[k].encoded != NULL; k += 1)
++ {
++ int op_len = strlen (ada_opname_table[k].encoded);
++ if (strncmp (ada_opname_table[k].encoded + 1, encoded + i + 1,
++ op_len - 1) == 0
++ && !isalnum (encoded[i + op_len]))
++ {
++ strcpy (decoded + j, ada_opname_table[k].decoded);
++ at_start_name = 0;
++ i += op_len;
++ j += strlen (ada_opname_table[k].decoded);
++ break;
++ }
++ }
++ if (ada_opname_table[k].encoded != NULL)
++ continue;
++ }
++ at_start_name = 0;
++
++ if (i < len0 - 4 && strncmp (encoded + i, "TK__", 4) == 0)
++ i += 2;
++ if (encoded[i] == 'X' && i != 0 && isalnum (encoded[i - 1]))
++ {
++ do
++ i += 1;
++ while (i < len0 && (encoded[i] == 'b' || encoded[i] == 'n'));
++ if (i < len0)
++ goto Suppress;
++ }
++ else if (!ADA_RETAIN_DOTS
++ && i < len0 - 2 && encoded[i] == '_' && encoded[i + 1] == '_')
++ {
++ decoded[j] = '.';
++ at_start_name = 1;
++ i += 2;
++ j += 1;
++ }
++ else
++ {
++ decoded[j] = encoded[i];
++ i += 1;
++ j += 1;
++ }
++ }
++ decoded[j] = '\000';
++
++ for (i = 0; decoded[i] != '\0'; i += 1)
++ if (isupper (decoded[i]) || decoded[i] == ' ')
++ goto Suppress;
++
++ if (strcmp (decoded, encoded) == 0)
++ return encoded;
++ else
++ return decoded;
++
++Suppress:
++ GROW_VECT (decoding_buffer, decoding_buffer_size, strlen (encoded) + 3);
++ decoded = decoding_buffer;
++ if (encoded[0] == '<')
++ strcpy (decoded, encoded);
++ else
++ sprintf (decoded, "<%s>", encoded);
++ return decoded;
++
++}
++
++/* Table for keeping permanent unique copies of decoded names. Once
++ allocated, names in this table are never released. While this is a
++ storage leak, it should not be significant unless there are massive
++ changes in the set of decoded names in successive versions of a
++ symbol table loaded during a single session. */
++static struct htab *decoded_names_store;
++
++/* Returns the decoded name of GSYMBOL, as for ada_decode, caching it
++ in the language-specific part of GSYMBOL, if it has not been
++ previously computed. Tries to save the decoded name in the same
++ obstack as GSYMBOL, if possible, and otherwise on the heap (so that,
++ in any case, the decoded symbol has a lifetime at least that of
++ GSYMBOL).
++ The GSYMBOL parameter is "mutable" in the C++ sense: logically
++ const, but nevertheless modified to a semantically equivalent form
++ when a decoded name is cached in it.
++*/
++
++char *ada_decode_symbol (const struct general_symbol_info *gsymbol)
++{
++ char **resultp =
++ (char **) &gsymbol->language_specific.cplus_specific.demangled_name;
++ if (*resultp == NULL)
++ {
++ const char *decoded = ada_decode (gsymbol->name);
++ if (gsymbol->bfd_section != NULL)
+ {
+- int k;
+- for (k = 0; ada_opname_table[k].mangled != NULL; k += 1)
++ bfd *obfd = gsymbol->bfd_section->owner;
++ if (obfd != NULL)
+ {
+- int op_len = strlen (ada_opname_table[k].mangled);
+- if (DEPRECATED_STREQN
+- (ada_opname_table[k].mangled + 1, mangled + i + 1,
+- op_len - 1) && !isalnum (mangled[i + op_len]))
++ struct objfile *objf;
++ ALL_OBJFILES (objf)
+ {
+- strcpy (demangled + j, ada_opname_table[k].demangled);
+- at_start_name = 0;
+- i += op_len;
+- j += strlen (ada_opname_table[k].demangled);
+- break;
++ if (obfd == objf->obfd)
++ {
++ *resultp = obsavestring (decoded, strlen (decoded),
++ &objf->objfile_obstack);
++ break;
++ }
+ }
+ }
+- if (ada_opname_table[k].mangled != NULL)
+- continue;
+ }
+- at_start_name = 0;
+-
+- if (i < len0 - 4 && DEPRECATED_STREQN (mangled + i, "TK__", 4))
+- i += 2;
+- if (mangled[i] == 'X' && i != 0 && isalnum (mangled[i - 1]))
+- {
+- do
+- i += 1;
+- while (i < len0 && (mangled[i] == 'b' || mangled[i] == 'n'));
+- if (i < len0)
+- goto Suppress;
+- }
+- else if (i < len0 - 2 && mangled[i] == '_' && mangled[i + 1] == '_')
++ /* Sometimes, we can't find a corresponding objfile, in which
++ case, we put the result on the heap. Since we only decode
++ when needed, we hope this usually does not cause a
++ significant memory leak (FIXME). */
++ if (*resultp == NULL)
+ {
+- demangled[j] = '.';
+- at_start_name = 1;
+- i += 2;
+- j += 1;
+- }
+- else
+- {
+- demangled[j] = mangled[i];
+- i += 1;
+- j += 1;
++ char **slot =
++ (char **) htab_find_slot (decoded_names_store,
++ decoded, INSERT);
++ if (*slot == NULL)
++ *slot = xstrdup (decoded);
++ *resultp = *slot;
+ }
+ }
+- demangled[j] = '\000';
+-
+- for (i = 0; demangled[i] != '\0'; i += 1)
+- if (isupper (demangled[i]) || demangled[i] == ' ')
+- goto Suppress;
+-
+- return demangled;
+-
+-Suppress:
+- GROW_VECT (demangling_buffer, demangling_buffer_size, strlen (mangled) + 3);
+- demangled = demangling_buffer;
+- if (mangled[0] == '<')
+- strcpy (demangled, mangled);
+- else
+- sprintf (demangled, "<%s>", mangled);
+- return demangled;
+
++ return *resultp;
++}
++
++char *ada_la_decode (const char *encoded, int options)
++{
++ return xstrdup (ada_decode (encoded));
+ }
+
+ /* Returns non-zero iff SYM_NAME matches NAME, ignoring any trailing
+- * suffixes that encode debugging information or leading _ada_ on
+- * SYM_NAME (see is_name_suffix commentary for the debugging
+- * information that is ignored). If WILD, then NAME need only match a
+- * suffix of SYM_NAME minus the same suffixes. Also returns 0 if
+- * either argument is NULL. */
++ suffixes that encode debugging information or leading _ada_ on
++ SYM_NAME (see is_name_suffix commentary for the debugging
++ information that is ignored). If WILD, then NAME need only match a
++ suffix of SYM_NAME minus the same suffixes. Also returns 0 if
++ either argument is NULL. */
+
+ int
+ ada_match_name (const char *sym_name, const char *name, int wild)
+@@ -692,16 +1092,16 @@
+ else
+ {
+ int len_name = strlen (name);
+- return (DEPRECATED_STREQN (sym_name, name, len_name)
+- && is_name_suffix (sym_name + len_name))
+- || (DEPRECATED_STREQN (sym_name, "_ada_", 5)
+- && DEPRECATED_STREQN (sym_name + 5, name, len_name)
+- && is_name_suffix (sym_name + len_name + 5));
++ return (strncmp (sym_name, name, len_name) == 0
++ && is_name_suffix (sym_name + len_name))
++ || (strncmp (sym_name, "_ada_", 5) == 0
++ && strncmp (sym_name + 5, name, len_name) == 0
++ && is_name_suffix (sym_name + len_name + 5));
+ }
+ }
+
+-/* True (non-zero) iff in Ada mode, the symbol SYM should be
+- suppressed in info listings. */
++/* True (non-zero) iff, in Ada mode, the symbol SYM should be
++ suppressed in info listings. */
+
+ int
+ ada_suppress_symbol_printing (struct symbol *sym)
+@@ -709,14 +1109,13 @@
+ if (SYMBOL_DOMAIN (sym) == STRUCT_DOMAIN)
+ return 1;
+ else
+- return is_suppressed_name (DEPRECATED_SYMBOL_NAME (sym));
++ return is_suppressed_name (SYMBOL_LINKAGE_NAME (sym));
+ }
+ \f
+
+- /* Arrays */
++ /* Arrays */
+
+-/* Names of MAX_ADA_DIMENS bounds in P_BOUNDS fields of
+- array descriptors. */
++/* Names of MAX_ADA_DIMENS bounds in P_BOUNDS fields of array descriptors. */
+
+ static char *bound_name[] = {
+ "LB0", "UB0", "LB1", "UB1", "LB2", "UB2", "LB3", "UB3",
+@@ -725,36 +1124,39 @@
+
+ /* Maximum number of array dimensions we are prepared to handle. */
+
+-#define MAX_ADA_DIMENS (sizeof(bound_name) / (2*sizeof(char*)))
++#define MAX_ADA_DIMENS (sizeof(bound_name) / (2*sizeof(char *)))
+
+-/* Like modify_field, but allows bitpos > wordlength. */
++/* Like modify_field, but allows bitpos > wordlength. */
+
+ static void
+ modify_general_field (char *addr, LONGEST fieldval, int bitpos, int bitsize)
+ {
+- modify_field (addr + sizeof (LONGEST) * bitpos / (8 * sizeof (LONGEST)),
+- fieldval, bitpos % (8 * sizeof (LONGEST)), bitsize);
++ modify_field (addr + bitpos / 8, fieldval, bitpos % 8, bitsize);
+ }
+
+
+-/* The desc_* routines return primitive portions of array descriptors
+- (fat pointers). */
++/* The desc_* routines return primitive portions of array descriptors
++ (fat pointers). */
+
+ /* The descriptor or array type, if any, indicated by TYPE; removes
+- level of indirection, if needed. */
++ level of indirection, if needed. */
++
+ static struct type *
+ desc_base_type (struct type *type)
+ {
+ if (type == NULL)
+ return NULL;
+ CHECK_TYPEDEF (type);
+- if (type != NULL && TYPE_CODE (type) == TYPE_CODE_PTR)
++ if (type != NULL &&
++ (TYPE_CODE (type) == TYPE_CODE_PTR
++ || TYPE_CODE (type) == TYPE_CODE_REF))
+ return check_typedef (TYPE_TARGET_TYPE (type));
+ else
+ return type;
+ }
+
+-/* True iff TYPE indicates a "thin" array pointer type. */
++/* True iff TYPE indicates a "thin" array pointer type. */
++
+ static int
+ is_thin_pntr (struct type *type)
+ {
+@@ -763,7 +1165,8 @@
+ || is_suffix (ada_type_name (desc_base_type (type)), "___XUT___XVE");
+ }
+
+-/* The descriptor type for thin pointer type TYPE. */
++/* The descriptor type for thin pointer type TYPE. */
++
+ static struct type *
+ thin_descriptor_type (struct type *type)
+ {
+@@ -776,36 +1179,39 @@
+ {
+ struct type *alt_type = ada_find_parallel_type (base_type, "___XVE");
+ if (alt_type == NULL)
+- return base_type;
++ return base_type;
+ else
+- return alt_type;
++ return alt_type;
+ }
+ }
+
+-/* A pointer to the array data for thin-pointer value VAL. */
++/* A pointer to the array data for thin-pointer value VAL. */
++
+ static struct value *
+ thin_data_pntr (struct value *val)
+ {
+ struct type *type = VALUE_TYPE (val);
+ if (TYPE_CODE (type) == TYPE_CODE_PTR)
+ return value_cast (desc_data_type (thin_descriptor_type (type)),
+- value_copy (val));
++ value_copy (val));
+ else
+ return value_from_longest (desc_data_type (thin_descriptor_type (type)),
+- VALUE_ADDRESS (val) + VALUE_OFFSET (val));
++ VALUE_ADDRESS (val) + VALUE_OFFSET (val));
+ }
+
+-/* True iff TYPE indicates a "thick" array pointer type. */
++/* True iff TYPE indicates a "thick" array pointer type. */
++
+ static int
+ is_thick_pntr (struct type *type)
+ {
+ type = desc_base_type (type);
+ return (type != NULL && TYPE_CODE (type) == TYPE_CODE_STRUCT
+- && lookup_struct_elt_type (type, "P_BOUNDS", 1) != NULL);
++ && lookup_struct_elt_type (type, "P_BOUNDS", 1) != NULL);
+ }
+
+-/* If TYPE is the type of an array descriptor (fat or thin pointer) or a
+- pointer to one, the type of its bounds data; otherwise, NULL. */
++/* If TYPE is the type of an array descriptor (fat or thin pointer) or a
++ pointer to one, the type of its bounds data; otherwise, NULL. */
++
+ static struct type *
+ desc_bounds_type (struct type *type)
+ {
+@@ -819,22 +1225,23 @@
+ {
+ type = thin_descriptor_type (type);
+ if (type == NULL)
+- return NULL;
++ return NULL;
+ r = lookup_struct_elt_type (type, "BOUNDS", 1);
+ if (r != NULL)
+- return check_typedef (r);
++ return check_typedef (r);
+ }
+ else if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
+ {
+ r = lookup_struct_elt_type (type, "P_BOUNDS", 1);
+ if (r != NULL)
+- return check_typedef (TYPE_TARGET_TYPE (check_typedef (r)));
++ return check_typedef (TYPE_TARGET_TYPE (check_typedef (r)));
+ }
+ return NULL;
+ }
+
+ /* If ARR is an array descriptor (fat or thin pointer), or pointer to
+- one, a pointer to its bounds data. Otherwise NULL. */
++ one, a pointer to its bounds data. Otherwise NULL. */
++
+ static struct value *
+ desc_bounds (struct value *arr)
+ {
+@@ -842,34 +1249,35 @@
+ if (is_thin_pntr (type))
+ {
+ struct type *bounds_type =
+- desc_bounds_type (thin_descriptor_type (type));
++ desc_bounds_type (thin_descriptor_type (type));
+ LONGEST addr;
+
+ if (desc_bounds_type == NULL)
+- error ("Bad GNAT array descriptor");
++ error ("Bad GNAT array descriptor");
+
+ /* NOTE: The following calculation is not really kosher, but
+ since desc_type is an XVE-encoded type (and shouldn't be),
+- the correct calculation is a real pain. FIXME (and fix GCC). */
++ the correct calculation is a real pain. FIXME (and fix GCC). */
+ if (TYPE_CODE (type) == TYPE_CODE_PTR)
+- addr = value_as_long (arr);
++ addr = value_as_long (arr);
+ else
+- addr = VALUE_ADDRESS (arr) + VALUE_OFFSET (arr);
++ addr = VALUE_ADDRESS (arr) + VALUE_OFFSET (arr);
+
+ return
+- value_from_longest (lookup_pointer_type (bounds_type),
+- addr - TYPE_LENGTH (bounds_type));
++ value_from_longest (lookup_pointer_type (bounds_type),
++ addr - TYPE_LENGTH (bounds_type));
+ }
+
+ else if (is_thick_pntr (type))
+ return value_struct_elt (&arr, NULL, "P_BOUNDS", NULL,
+- "Bad GNAT array descriptor");
++ "Bad GNAT array descriptor");
+ else
+ return NULL;
+ }
+
+-/* If TYPE is the type of an array-descriptor (fat pointer), the bit
+- position of the field containing the address of the bounds data. */
++/* If TYPE is the type of an array-descriptor (fat pointer), the bit
++ position of the field containing the address of the bounds data. */
++
+ static int
+ fat_pntr_bounds_bitpos (struct type *type)
+ {
+@@ -877,7 +1285,8 @@
+ }
+
+ /* If TYPE is the type of an array-descriptor (fat pointer), the bit
+- size of the field containing the address of the bounds data. */
++ size of the field containing the address of the bounds data. */
++
+ static int
+ fat_pntr_bounds_bitsize (struct type *type)
+ {
+@@ -889,16 +1298,17 @@
+ return 8 * TYPE_LENGTH (check_typedef (TYPE_FIELD_TYPE (type, 1)));
+ }
+
+-/* If TYPE is the type of an array descriptor (fat or thin pointer) or a
++/* If TYPE is the type of an array descriptor (fat or thin pointer) or a
+ pointer to one, the type of its array data (a
+- pointer-to-array-with-no-bounds type); otherwise, NULL. Use
+- ada_type_of_array to get an array type with bounds data. */
++ pointer-to-array-with-no-bounds type); otherwise, NULL. Use
++ ada_type_of_array to get an array type with bounds data. */
++
+ static struct type *
+ desc_data_type (struct type *type)
+ {
+ type = desc_base_type (type);
+
+- /* NOTE: The following is bogus; see comment in desc_bounds. */
++ /* NOTE: The following is bogus; see comment in desc_bounds. */
+ if (is_thin_pntr (type))
+ return lookup_pointer_type
+ (desc_base_type (TYPE_FIELD_TYPE (thin_descriptor_type (type), 1)));
+@@ -910,6 +1320,7 @@
+
+ /* If ARR is an array descriptor (fat or thin pointer), a pointer to
+ its array data. */
++
+ static struct value *
+ desc_data (struct value *arr)
+ {
+@@ -918,14 +1329,15 @@
+ return thin_data_pntr (arr);
+ else if (is_thick_pntr (type))
+ return value_struct_elt (&arr, NULL, "P_ARRAY", NULL,
+- "Bad GNAT array descriptor");
++ "Bad GNAT array descriptor");
+ else
+ return NULL;
+ }
+
+
+ /* If TYPE is the type of an array-descriptor (fat pointer), the bit
+- position of the field containing the address of the data. */
++ position of the field containing the address of the data. */
++
+ static int
+ fat_pntr_data_bitpos (struct type *type)
+ {
+@@ -933,7 +1345,8 @@
+ }
+
+ /* If TYPE is the type of an array-descriptor (fat pointer), the bit
+- size of the field containing the address of the data. */
++ size of the field containing the address of the data. */
++
+ static int
+ fat_pntr_data_bitsize (struct type *type)
+ {
+@@ -945,19 +1358,21 @@
+ return TARGET_CHAR_BIT * TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0));
+ }
+
+-/* If BOUNDS is an array-bounds structure (or pointer to one), return
++/* If BOUNDS is an array-bounds structure (or pointer to one), return
+ the Ith lower bound stored in it, if WHICH is 0, and the Ith upper
+- bound, if WHICH is 1. The first bound is I=1. */
++ bound, if WHICH is 1. The first bound is I=1. */
++
+ 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,
+- "Bad GNAT array descriptor bounds");
++ "Bad GNAT array descriptor bounds");
+ }
+
+ /* If BOUNDS is an array-bounds structure type, return the bit position
+ of the Ith lower bound stored in it, if WHICH is 0, and the Ith upper
+- bound, if WHICH is 1. The first bound is I=1. */
++ bound, if WHICH is 1. The first bound is I=1. */
++
+ static int
+ desc_bound_bitpos (struct type *type, int i, int which)
+ {
+@@ -966,8 +1381,9 @@
+
+ /* If BOUNDS is an array-bounds structure type, return the bit field size
+ of the Ith lower bound stored in it, if WHICH is 0, and the Ith upper
+- bound, if WHICH is 1. The first bound is I=1. */
+-static int
++ bound, if WHICH is 1. The first bound is I=1. */
++
++ static int
+ desc_bound_bitsize (struct type *type, int i, int which)
+ {
+ type = desc_base_type (type);
+@@ -979,7 +1395,8 @@
+ }
+
+ /* If TYPE is the type of an array-bounds structure, the type of its
+- Ith bound (numbering from 1). Otherwise, NULL. */
++ Ith bound (numbering from 1). Otherwise, NULL. */
++
+ static struct type *
+ desc_index_type (struct type *type, int i)
+ {
+@@ -991,8 +1408,9 @@
+ return NULL;
+ }
+
+-/* The number of index positions in the array-bounds type TYPE. 0
+- if TYPE is NULL. */
++/* The number of index positions in the array-bounds type TYPE.
++ Return 0 if TYPE is NULL. */
++
+ static int
+ desc_arity (struct type *type)
+ {
+@@ -1003,22 +1421,37 @@
+ return 0;
+ }
+
++/* Non-zero iff TYPE is a simple array type (not a pointer to one) or
++ an array descriptor type (representing an unconstrained array
++ type). */
++
++static int
++ada_is_direct_array_type (struct type *type)
++{
++ if (type == NULL)
++ return 0;
++ CHECK_TYPEDEF (type);
++ return (TYPE_CODE (type) == TYPE_CODE_ARRAY
++ || ada_is_array_descriptor_type (type));
++}
++
++/* Non-zero iff TYPE is a simple array type or pointer to one. */
+
+-/* Non-zero iff type is a simple array type (or pointer to one). */
+ int
+-ada_is_simple_array (struct type *type)
++ada_is_simple_array_type (struct type *type)
+ {
+ if (type == NULL)
+ return 0;
+ CHECK_TYPEDEF (type);
+ return (TYPE_CODE (type) == TYPE_CODE_ARRAY
+- || (TYPE_CODE (type) == TYPE_CODE_PTR
+- && TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY));
++ || (TYPE_CODE (type) == TYPE_CODE_PTR
++ && TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY));
+ }
+
+-/* Non-zero iff type belongs to a GNAT array descriptor. */
++/* Non-zero iff TYPE belongs to a GNAT array descriptor. */
++
+ int
+-ada_is_array_descriptor (struct type *type)
++ada_is_array_descriptor_type (struct type *type)
+ {
+ struct type *data_type = desc_data_type (type);
+
+@@ -1028,17 +1461,18 @@
+ return
+ data_type != NULL
+ && ((TYPE_CODE (data_type) == TYPE_CODE_PTR
+- && TYPE_TARGET_TYPE (data_type) != NULL
+- && TYPE_CODE (TYPE_TARGET_TYPE (data_type)) == TYPE_CODE_ARRAY)
+- ||
+- TYPE_CODE (data_type) == TYPE_CODE_ARRAY)
++ && TYPE_TARGET_TYPE (data_type) != NULL
++ && TYPE_CODE (TYPE_TARGET_TYPE (data_type)) == TYPE_CODE_ARRAY)
++ ||
++ TYPE_CODE (data_type) == TYPE_CODE_ARRAY)
+ && desc_arity (desc_bounds_type (type)) > 0;
+ }
+
+ /* Non-zero iff type is a partially mal-formed GNAT array
+- descriptor. (FIXME: This is to compensate for some problems with
++ descriptor. FIXME: This is to compensate for some problems with
+ debugging output from GNAT. Re-examine periodically to see if it
+- is still needed. */
++ is still needed. */
++
+ int
+ ada_is_bogus_array_descriptor (struct type *type)
+ {
+@@ -1046,17 +1480,17 @@
+ type != NULL
+ && TYPE_CODE (type) == TYPE_CODE_STRUCT
+ && (lookup_struct_elt_type (type, "P_BOUNDS", 1) != NULL
+- || lookup_struct_elt_type (type, "P_ARRAY", 1) != NULL)
+- && !ada_is_array_descriptor (type);
++ || lookup_struct_elt_type (type, "P_ARRAY", 1) != NULL)
++ && !ada_is_array_descriptor_type (type);
+ }
+
+
+-/* If ARR has a record type in the form of a standard GNAT array descriptor,
++/* If ARR has a record type in the form of a standard GNAT array descriptor,
+ (fat pointer) returns the type of the array data described---specifically,
+- a pointer-to-array type. If BOUNDS is non-zero, the bounds data are filled
++ a pointer-to-array type. If BOUNDS is non-zero, the bounds data are filled
+ in from the descriptor; otherwise, they are left unspecified. If
+- the ARR denotes a null array descriptor and BOUNDS is non-zero,
+- returns NULL. The result is simply the type of ARR if ARR is not
++ the ARR denotes a null array descriptor and BOUNDS is non-zero,
++ returns NULL. The result is simply the type of ARR if ARR is not
+ a descriptor. */
+ struct type *
+ ada_type_of_array (struct value *arr, int bounds)
+@@ -1064,7 +1498,7 @@
+ if (ada_is_packed_array_type (VALUE_TYPE (arr)))
+ return decode_packed_array_type (VALUE_TYPE (arr));
+
+- if (!ada_is_array_descriptor (VALUE_TYPE (arr)))
++ if (!ada_is_array_descriptor_type (VALUE_TYPE (arr)))
+ return VALUE_TYPE (arr);
+
+ if (!bounds)
+@@ -1081,41 +1515,42 @@
+ arity = ada_array_arity (VALUE_TYPE (arr));
+
+ if (elt_type == NULL || arity == 0)
+- return check_typedef (VALUE_TYPE (arr));
++ return check_typedef (VALUE_TYPE (arr));
+
+ descriptor = desc_bounds (arr);
+ if (value_as_long (descriptor) == 0)
+- return NULL;
++ return NULL;
+ while (arity > 0)
+- {
+- struct type *range_type = alloc_type (objf);
+- struct type *array_type = alloc_type (objf);
+- struct value *low = desc_one_bound (descriptor, arity, 0);
+- struct value *high = desc_one_bound (descriptor, arity, 1);
+- arity -= 1;
+-
+- create_range_type (range_type, VALUE_TYPE (low),
+- (int) value_as_long (low),
+- (int) value_as_long (high));
+- elt_type = create_array_type (array_type, elt_type, range_type);
+- }
++ {
++ struct type *range_type = alloc_type (objf);
++ struct type *array_type = alloc_type (objf);
++ struct value *low = desc_one_bound (descriptor, arity, 0);
++ struct value *high = desc_one_bound (descriptor, arity, 1);
++ arity -= 1;
++
++ create_range_type (range_type, VALUE_TYPE (low),
++ (int) value_as_long (low),
++ (int) value_as_long (high));
++ elt_type = create_array_type (array_type, elt_type, range_type);
++ }
+
+ return lookup_pointer_type (elt_type);
+ }
+ }
+
+ /* If ARR does not represent an array, returns ARR unchanged.
+- Otherwise, returns either a standard GDB array with bounds set
+- appropriately or, if ARR is a non-null fat pointer, a pointer to a standard
+- GDB array. Returns NULL if ARR is a null fat pointer. */
++ Otherwise, returns either a standard GDB array with bounds set
++ appropriately or, if ARR is a non-null fat pointer, a pointer to a standard
++ GDB array. Returns NULL if ARR is a null fat pointer. */
++
+ struct value *
+ ada_coerce_to_simple_array_ptr (struct value *arr)
+ {
+- if (ada_is_array_descriptor (VALUE_TYPE (arr)))
++ if (ada_is_array_descriptor_type (VALUE_TYPE (arr)))
+ {
+ struct type *arrType = ada_type_of_array (arr, 1);
+ if (arrType == NULL)
+- return NULL;
++ return NULL;
+ return value_cast (arrType, value_copy (desc_data (arr)));
+ }
+ else if (ada_is_packed_array_type (VALUE_TYPE (arr)))
+@@ -1126,15 +1561,16 @@
+
+ /* If ARR does not represent an array, returns ARR unchanged.
+ Otherwise, returns a standard GDB array describing ARR (which may
+- be ARR itself if it already is in the proper form). */
+-struct value *
++ be ARR itself if it already is in the proper form). */
++
++static struct value *
+ ada_coerce_to_simple_array (struct value *arr)
+ {
+- if (ada_is_array_descriptor (VALUE_TYPE (arr)))
++ if (ada_is_array_descriptor_type (VALUE_TYPE (arr)))
+ {
+ struct value *arrVal = ada_coerce_to_simple_array_ptr (arr);
+ if (arrVal == NULL)
+- error ("Bounds unavailable for null array pointer.");
++ error ("Bounds unavailable for null array pointer.");
+ return value_ind (arrVal);
+ }
+ else if (ada_is_packed_array_type (VALUE_TYPE (arr)))
+@@ -1145,7 +1581,8 @@
+
+ /* If TYPE represents a GNAT array type, return it translated to an
+ ordinary GDB array type (possibly with BITSIZE fields indicating
+- packing). For other types, is the identity. */
++ packing). For other types, is the identity. */
++
+ struct type *
+ ada_coerce_to_simple_array_type (struct type *type)
+ {
+@@ -1154,16 +1591,18 @@
+ struct type *result;
+ VALUE_TYPE (dummy) = type;
+ result = ada_type_of_array (dummy, 0);
+- value_free_to_mark (dummy);
++ value_free_to_mark (mark);
+ return result;
+ }
+
+-/* Non-zero iff TYPE represents a standard GNAT packed-array type. */
++/* Non-zero iff TYPE represents a standard GNAT packed-array type. */
++
+ int
+ ada_is_packed_array_type (struct type *type)
+ {
+ if (type == NULL)
+ return 0;
++ type = desc_base_type (type);
+ CHECK_TYPEDEF (type);
+ return
+ ada_type_name (type) != NULL
+@@ -1176,8 +1615,9 @@
+ elements' elements, etc.) is *ELT_BITS, return an identical type,
+ but with the bit sizes of its elements (and those of any
+ constituent arrays) recorded in the BITSIZE components of its
+- TYPE_FIELD_BITSIZE values, and with *ELT_BITS set to its total size
+- in bits. */
++ TYPE_FIELD_BITSIZE values, and with *ELT_BITS set to its total size
++ in bits. */
++
+ static struct type *
+ packed_array_type (struct type *type, long *elt_bits)
+ {
+@@ -1191,13 +1631,13 @@
+
+ new_type = alloc_type (TYPE_OBJFILE (type));
+ new_elt_type = packed_array_type (check_typedef (TYPE_TARGET_TYPE (type)),
+- elt_bits);
++ elt_bits);
+ create_array_type (new_type, new_elt_type, TYPE_FIELD_TYPE (type, 0));
+ TYPE_FIELD_BITSIZE (new_type, 0) = *elt_bits;
+ TYPE_NAME (new_type) = ada_type_name (type);
+
+ if (get_discrete_bounds (TYPE_FIELD_TYPE (type, 0),
+- &low_bound, &high_bound) < 0)
++ &low_bound, &high_bound) < 0)
+ low_bound = high_bound = 0;
+ if (high_bound < low_bound)
+ *elt_bits = TYPE_LENGTH (new_type) = 0;
+@@ -1205,20 +1645,19 @@
+ {
+ *elt_bits *= (high_bound - low_bound + 1);
+ TYPE_LENGTH (new_type) =
+- (*elt_bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT;
++ (*elt_bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT;
+ }
+
+- /* TYPE_FLAGS (new_type) |= TYPE_FLAG_FIXED_INSTANCE; */
+- /* FIXME: TYPE_FLAG_FIXED_INSTANCE should be defined in gdbtypes.h */
++ TYPE_FLAGS (new_type) |= TYPE_FLAG_FIXED_INSTANCE;
+ return new_type;
+ }
+
+-/* The array type encoded by TYPE, where ada_is_packed_array_type (TYPE).
+- */
++/* The array type encoded by TYPE, where ada_is_packed_array_type (TYPE). */
++
+ static struct type *
+ decode_packed_array_type (struct type *type)
+ {
+- struct symbol **syms;
++ struct symbol *sym;
+ struct block **blocks;
+ const char *raw_name = ada_type_name (check_typedef (type));
+ char *name = (char *) alloca (strlen (raw_name) + 1);
+@@ -1227,62 +1666,63 @@
+ long bits;
+ int i, n;
+
++ type = desc_base_type (type);
++
+ memcpy (name, raw_name, tail - raw_name);
+ name[tail - raw_name] = '\000';
+
+- /* NOTE: Use ada_lookup_symbol_list because of bug in some versions
+- * of gcc (Solaris, e.g.). FIXME when compiler is fixed. */
+- n = ada_lookup_symbol_list (name, get_selected_block (NULL),
+- VAR_DOMAIN, &syms, &blocks);
+- for (i = 0; i < n; i += 1)
+- if (syms[i] != NULL && SYMBOL_CLASS (syms[i]) == LOC_TYPEDEF
+- && DEPRECATED_STREQ (name, ada_type_name (SYMBOL_TYPE (syms[i]))))
+- break;
+- if (i >= n)
++ sym = standard_lookup (name, get_selected_block (0), VAR_DOMAIN);
++ if (sym == NULL || SYMBOL_TYPE (sym) == NULL)
+ {
+- warning ("could not find bounds information on packed array");
++ lim_warning ("could not find bounds information on packed array", 0);
+ return NULL;
+ }
+- shadow_type = SYMBOL_TYPE (syms[i]);
++ shadow_type = SYMBOL_TYPE (sym);
+
+ if (TYPE_CODE (shadow_type) != TYPE_CODE_ARRAY)
+ {
+- warning ("could not understand bounds information on packed array");
++ lim_warning ("could not understand bounds information on packed array",
++ 0);
+ return NULL;
+ }
+
+ if (sscanf (tail + sizeof ("___XP") - 1, "%ld", &bits) != 1)
+ {
+- warning ("could not understand bit size information on packed array");
++ lim_warning
++ ("could not understand bit size information on packed array", 0);
+ return NULL;
+ }
+
+ return packed_array_type (shadow_type, &bits);
+ }
+
+-/* Given that ARR is a struct value* indicating a GNAT packed array,
++/* Given that ARR is a struct value *indicating a GNAT packed array,
+ returns a simple array that denotes that array. Its type is a
+ standard GDB array type except that the BITSIZEs of the array
+ target types are set to the number of bits in each element, and the
+- type length is set appropriately. */
++ type length is set appropriately. */
+
+ static struct value *
+ decode_packed_array (struct value *arr)
+ {
+- struct type *type = decode_packed_array_type (VALUE_TYPE (arr));
++ struct type *type;
+
++ arr = ada_coerce_ref (arr);
++ if (TYPE_CODE (VALUE_TYPE (arr)) == TYPE_CODE_PTR)
++ arr = ada_value_ind (arr);
++
++ type = decode_packed_array_type (VALUE_TYPE (arr));
+ if (type == NULL)
+ {
+ error ("can't unpack array");
+ return NULL;
+ }
+- else
+- return coerce_unspec_val_to_type (arr, 0, type);
++ return coerce_unspec_val_to_type (arr, type);
+ }
+
+
+ /* The value of the element of packed array ARR at the ARITY indices
+- given in IND. ARR must be a simple array. */
++ given in IND. ARR must be a simple array. */
+
+ static struct value *
+ value_subscript_packed (struct value *arr, int arity, struct value **ind)
+@@ -1299,34 +1739,34 @@
+ for (i = 0; i < arity; i += 1)
+ {
+ if (TYPE_CODE (elt_type) != TYPE_CODE_ARRAY
+- || TYPE_FIELD_BITSIZE (elt_type, 0) == 0)
+- error
+- ("attempt to do packed indexing of something other than a packed array");
+- else
+- {
+- struct type *range_type = TYPE_INDEX_TYPE (elt_type);
+- LONGEST lowerbound, upperbound;
+- LONGEST idx;
+-
+- if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
+- {
+- warning ("don't know bounds of array");
+- lowerbound = upperbound = 0;
+- }
+-
+- idx = value_as_long (value_pos_atr (ind[i]));
+- if (idx < lowerbound || idx > upperbound)
+- warning ("packed array index %ld out of bounds", (long) idx);
+- bits = TYPE_FIELD_BITSIZE (elt_type, 0);
+- elt_total_bit_offset += (idx - lowerbound) * bits;
+- elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type));
+- }
++ || TYPE_FIELD_BITSIZE (elt_type, 0) == 0)
++ error
++ ("attempt to do packed indexing of something other than a packed array");
++ else
++ {
++ struct type *range_type = TYPE_INDEX_TYPE (elt_type);
++ LONGEST lowerbound, upperbound;
++ LONGEST idx;
++
++ if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
++ {
++ lim_warning ("don't know bounds of array", 0);
++ lowerbound = upperbound = 0;
++ }
++
++ idx = value_as_long (value_pos_atr (ind[i]));
++ if (idx < lowerbound || idx > upperbound)
++ lim_warning ("packed array index %ld out of bounds", (long) idx);
++ bits = TYPE_FIELD_BITSIZE (elt_type, 0);
++ elt_total_bit_offset += (idx - lowerbound) * bits;
++ elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type));
++ }
+ }
+ elt_off = elt_total_bit_offset / HOST_CHAR_BIT;
+ bit_off = elt_total_bit_offset % HOST_CHAR_BIT;
+
+ v = ada_value_primitive_packed_val (arr, NULL, elt_off, bit_off,
+- bits, elt_type);
++ bits, elt_type);
+ if (VALUE_LVAL (arr) == lval_internalvar)
+ VALUE_LVAL (v) = lval_internalvar_component;
+ else
+@@ -1334,7 +1774,7 @@
+ return v;
+ }
+
+-/* Non-zero iff TYPE includes negative integer values. */
++/* Non-zero iff TYPE includes negative integer values. */
+
+ static int
+ has_negatives (struct type *type)
+@@ -1354,32 +1794,32 @@
+ /* Create a new value of type TYPE from the contents of OBJ starting
+ at byte OFFSET, and bit offset BIT_OFFSET within that byte,
+ proceeding for BIT_SIZE bits. If OBJ is an lval in memory, then
+- assigning through the result will set the field fetched from. OBJ
+- may also be NULL, in which case, VALADDR+OFFSET must address the
+- start of storage containing the packed value. The value returned
+- in this case is never an lval.
+- Assumes 0 <= BIT_OFFSET < HOST_CHAR_BIT. */
++ assigning through the result will set the field fetched from.
++ VALADDR is ignored unless OBJ is NULL, in which case,
++ VALADDR+OFFSET must address the start of storage containing the
++ packed value. The value returned in this case is never an lval.
++ Assumes 0 <= BIT_OFFSET < HOST_CHAR_BIT. */
+
+ struct value *
+ ada_value_primitive_packed_val (struct value *obj, char *valaddr, long offset,
+- int bit_offset, int bit_size,
+- struct type *type)
++ int bit_offset, int bit_size,
++ struct type *type)
+ {
+ struct value *v;
+- int src, /* Index into the source area. */
+- targ, /* Index into the target area. */
+- i, srcBitsLeft, /* Number of source bits left to move. */
+- nsrc, ntarg, /* Number of source and target bytes. */
+- unusedLS, /* Number of bits in next significant
+- * byte of source that are unused. */
+- accumSize; /* Number of meaningful bits in accum */
+- unsigned char *bytes; /* First byte containing data to unpack. */
++ int src, /* Index into the source area */
++ targ, /* Index into the target area */
++ srcBitsLeft, /* Number of source bits left to move */
++ nsrc, ntarg, /* Number of source and target bytes */
++ unusedLS, /* Number of bits in next significant
++ byte of source that are unused */
++ accumSize; /* Number of meaningful bits in accum */
++ unsigned char *bytes; /* First byte containing data to unpack */
+ unsigned char *unpacked;
+- unsigned long accum; /* Staging area for bits being transferred */
++ unsigned long accum; /* Staging area for bits being transferred */
+ unsigned char sign;
+ int len = (bit_size + bit_offset + HOST_CHAR_BIT - 1) / 8;
+- /* Transmit bytes from least to most significant; delta is the
+- * direction the indices move. */
++ /* Transmit bytes from least to most significant; delta is the direction
++ the indices move. */
+ int delta = BITS_BIG_ENDIAN ? -1 : 1;
+
+ CHECK_TYPEDEF (type);
+@@ -1392,7 +1832,7 @@
+ else if (VALUE_LAZY (obj))
+ {
+ v = value_at (type,
+- VALUE_ADDRESS (obj) + VALUE_OFFSET (obj) + offset, NULL);
++ VALUE_ADDRESS (obj) + VALUE_OFFSET (obj) + offset, NULL);
+ bytes = (unsigned char *) alloca (len);
+ read_memory (VALUE_ADDRESS (v), bytes, len);
+ }
+@@ -1406,15 +1846,15 @@
+ {
+ VALUE_LVAL (v) = VALUE_LVAL (obj);
+ if (VALUE_LVAL (obj) == lval_internalvar)
+- VALUE_LVAL (v) = lval_internalvar_component;
++ VALUE_LVAL (v) = lval_internalvar_component;
+ VALUE_ADDRESS (v) = VALUE_ADDRESS (obj) + VALUE_OFFSET (obj) + offset;
+ VALUE_BITPOS (v) = bit_offset + VALUE_BITPOS (obj);
+ VALUE_BITSIZE (v) = bit_size;
+ if (VALUE_BITPOS (v) >= HOST_CHAR_BIT)
+- {
+- VALUE_ADDRESS (v) += 1;
+- VALUE_BITPOS (v) -= HOST_CHAR_BIT;
+- }
++ {
++ VALUE_ADDRESS (v) += 1;
++ VALUE_BITPOS (v) -= HOST_CHAR_BIT;
++ }
+ }
+ else
+ VALUE_BITSIZE (v) = bit_size;
+@@ -1433,30 +1873,30 @@
+ {
+ src = len - 1;
+ if (has_negatives (type) &&
+- ((bytes[0] << bit_offset) & (1 << (HOST_CHAR_BIT - 1))))
+- sign = ~0;
++ ((bytes[0] << bit_offset) & (1 << (HOST_CHAR_BIT - 1))))
++ sign = ~0;
+
+ unusedLS =
+- (HOST_CHAR_BIT - (bit_size + bit_offset) % HOST_CHAR_BIT)
+- % HOST_CHAR_BIT;
++ (HOST_CHAR_BIT - (bit_size + bit_offset) % HOST_CHAR_BIT)
++ % HOST_CHAR_BIT;
+
+ switch (TYPE_CODE (type))
+- {
+- case TYPE_CODE_ARRAY:
+- case TYPE_CODE_UNION:
+- case TYPE_CODE_STRUCT:
+- /* Non-scalar values must be aligned at a byte boundary. */
+- accumSize =
+- (HOST_CHAR_BIT - bit_size % HOST_CHAR_BIT) % HOST_CHAR_BIT;
+- /* And are placed at the beginning (most-significant) bytes
+- * of the target. */
+- targ = src;
+- break;
+- default:
+- accumSize = 0;
+- targ = TYPE_LENGTH (type) - 1;
+- break;
+- }
++ {
++ case TYPE_CODE_ARRAY:
++ case TYPE_CODE_UNION:
++ case TYPE_CODE_STRUCT:
++ /* Non-scalar values must be aligned at a byte boundary... */
++ accumSize =
++ (HOST_CHAR_BIT - bit_size % HOST_CHAR_BIT) % HOST_CHAR_BIT;
++ /* ... And are placed at the beginning (most-significant) bytes
++ of the target. */
++ targ = src;
++ break;
++ default:
++ accumSize = 0;
++ targ = TYPE_LENGTH (type) - 1;
++ break;
++ }
+ }
+ else
+ {
+@@ -1467,30 +1907,30 @@
+ accumSize = 0;
+
+ if (has_negatives (type) && (bytes[len - 1] & (1 << sign_bit_offset)))
+- sign = ~0;
++ sign = ~0;
+ }
+
+ accum = 0;
+ while (nsrc > 0)
+ {
+ /* Mask for removing bits of the next source byte that are not
+- * part of the value. */
++ part of the value. */
+ unsigned int unusedMSMask =
+- (1 << (srcBitsLeft >= HOST_CHAR_BIT ? HOST_CHAR_BIT : srcBitsLeft)) -
+- 1;
+- /* Sign-extend bits for this byte. */
++ (1 << (srcBitsLeft >= HOST_CHAR_BIT ? HOST_CHAR_BIT : srcBitsLeft)) -
++ 1;
++ /* Sign-extend bits for this byte. */
+ unsigned int signMask = sign & ~unusedMSMask;
+ accum |=
+- (((bytes[src] >> unusedLS) & unusedMSMask) | signMask) << accumSize;
++ (((bytes[src] >> unusedLS) & unusedMSMask) | signMask) << accumSize;
+ accumSize += HOST_CHAR_BIT - unusedLS;
+ if (accumSize >= HOST_CHAR_BIT)
+- {
+- unpacked[targ] = accum & ~(~0L << HOST_CHAR_BIT);
+- accumSize -= HOST_CHAR_BIT;
+- accum >>= HOST_CHAR_BIT;
+- ntarg -= 1;
+- targ += delta;
+- }
++ {
++ unpacked[targ] = accum & ~(~0L << HOST_CHAR_BIT);
++ accumSize -= HOST_CHAR_BIT;
++ accum >>= HOST_CHAR_BIT;
++ ntarg -= 1;
++ targ += delta;
++ }
+ srcBitsLeft -= HOST_CHAR_BIT - unusedLS;
+ unusedLS = 0;
+ nsrc -= 1;
+@@ -1511,7 +1951,7 @@
+
+ /* Move N bits from SOURCE, starting at bit offset SRC_OFFSET to
+ TARGET, starting at bit offset TARG_OFFSET. SOURCE and TARGET must
+- not overlap. */
++ not overlap. */
+ static void
+ move_bits (char *target, int targ_offset, char *source, int src_offset, int n)
+ {
+@@ -1529,24 +1969,24 @@
+ accum_bits = HOST_CHAR_BIT - src_offset;
+
+ while (n > 0)
+- {
+- int unused_right;
+- accum = (accum << HOST_CHAR_BIT) + (unsigned char) *source;
+- accum_bits += HOST_CHAR_BIT;
+- source += 1;
+- chunk_size = HOST_CHAR_BIT - targ_offset;
+- if (chunk_size > n)
+- chunk_size = n;
+- unused_right = HOST_CHAR_BIT - (chunk_size + targ_offset);
+- mask = ((1 << chunk_size) - 1) << unused_right;
+- *target =
+- (*target & ~mask)
+- | ((accum >> (accum_bits - chunk_size - unused_right)) & mask);
+- n -= chunk_size;
+- accum_bits -= chunk_size;
+- target += 1;
+- targ_offset = 0;
+- }
++ {
++ int unused_right;
++ accum = (accum << HOST_CHAR_BIT) + (unsigned char) *source;
++ accum_bits += HOST_CHAR_BIT;
++ source += 1;
++ chunk_size = HOST_CHAR_BIT - targ_offset;
++ if (chunk_size > n)
++ chunk_size = n;
++ unused_right = HOST_CHAR_BIT - (chunk_size + targ_offset);
++ mask = ((1 << chunk_size) - 1) << unused_right;
++ *target =
++ (*target & ~mask)
++ | ((accum >> (accum_bits - chunk_size - unused_right)) & mask);
++ n -= chunk_size;
++ accum_bits -= chunk_size;
++ target += 1;
++ targ_offset = 0;
++ }
+ }
+ else
+ {
+@@ -1555,21 +1995,21 @@
+ accum_bits = HOST_CHAR_BIT - src_offset;
+
+ while (n > 0)
+- {
+- accum = accum + ((unsigned char) *source << accum_bits);
+- accum_bits += HOST_CHAR_BIT;
+- source += 1;
+- chunk_size = HOST_CHAR_BIT - targ_offset;
+- if (chunk_size > n)
+- chunk_size = n;
+- mask = ((1 << chunk_size) - 1) << targ_offset;
+- *target = (*target & ~mask) | ((accum << targ_offset) & mask);
+- n -= chunk_size;
+- accum_bits -= chunk_size;
+- accum >>= chunk_size;
+- target += 1;
+- targ_offset = 0;
+- }
++ {
++ accum = accum + ((unsigned char) *source << accum_bits);
++ accum_bits += HOST_CHAR_BIT;
++ source += 1;
++ chunk_size = HOST_CHAR_BIT - targ_offset;
++ if (chunk_size > n)
++ chunk_size = n;
++ mask = ((1 << chunk_size) - 1) << targ_offset;
++ *target = (*target & ~mask) | ((accum << targ_offset) & mask);
++ n -= chunk_size;
++ accum_bits -= chunk_size;
++ accum >>= chunk_size;
++ target += 1;
++ targ_offset = 0;
++ }
+ }
+ }
+
+@@ -1577,7 +2017,7 @@
+ /* Store the contents of FROMVAL into the location of TOVAL.
+ Return a new value with the location of TOVAL and contents of
+ FROMVAL. Handles assignment into packed fields that have
+- floating-point or non-scalar types. */
++ floating-point or non-scalar types. */
+
+ static struct value *
+ ada_value_assign (struct value *toval, struct value *fromval)
+@@ -1593,31 +2033,31 @@
+ if (VALUE_LVAL (toval) == lval_memory
+ && bits > 0
+ && (TYPE_CODE (type) == TYPE_CODE_FLT
+- || TYPE_CODE (type) == TYPE_CODE_STRUCT))
++ || TYPE_CODE (type) == TYPE_CODE_STRUCT))
+ {
+ int len =
+- (VALUE_BITPOS (toval) + bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT;
++ (VALUE_BITPOS (toval) + bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT;
+ char *buffer = (char *) alloca (len);
+ struct value *val;
+
+ if (TYPE_CODE (type) == TYPE_CODE_FLT)
+- fromval = value_cast (type, fromval);
++ fromval = value_cast (type, fromval);
+
+ read_memory (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval), buffer, len);
+ if (BITS_BIG_ENDIAN)
+- move_bits (buffer, VALUE_BITPOS (toval),
+- VALUE_CONTENTS (fromval),
+- TYPE_LENGTH (VALUE_TYPE (fromval)) * TARGET_CHAR_BIT -
+- bits, bits);
++ move_bits (buffer, VALUE_BITPOS (toval),
++ VALUE_CONTENTS (fromval),
++ TYPE_LENGTH (VALUE_TYPE (fromval)) * TARGET_CHAR_BIT -
++ bits, bits);
+ else
+- move_bits (buffer, VALUE_BITPOS (toval), VALUE_CONTENTS (fromval),
+- 0, bits);
++ move_bits (buffer, VALUE_BITPOS (toval), VALUE_CONTENTS (fromval),
++ 0, bits);
+ write_memory (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval), buffer,
+- len);
++ len);
+
+ val = value_copy (toval);
+ memcpy (VALUE_CONTENTS_RAW (val), VALUE_CONTENTS (fromval),
+- TYPE_LENGTH (type));
++ TYPE_LENGTH (type));
+ VALUE_TYPE (val) = type;
+
+ return val;
+@@ -1627,8 +2067,8 @@
+ }
+
+
+-/* The value of the element of array ARR at the ARITY indices given in IND.
+- ARR may be either a simple array, GNAT array descriptor, or pointer
++/* The value of the element of array ARR at the ARITY indices given in IND.
++ ARR may be either a simple array, GNAT array descriptor, or pointer
+ thereto. */
+
+ struct value *
+@@ -1648,7 +2088,7 @@
+ for (k = 0; k < arity; k += 1)
+ {
+ if (TYPE_CODE (elt_type) != TYPE_CODE_ARRAY)
+- error ("too many subscripts (%d expected)", k);
++ error ("too many subscripts (%d expected)", k);
+ elt = value_subscript (elt, value_pos_atr (ind[k]));
+ }
+ return elt;
+@@ -1656,11 +2096,11 @@
+
+ /* 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. */
++ IND. Does not read the entire array into memory. */
+
+ struct value *
+ ada_value_ptr_subscript (struct value *arr, struct type *type, int arity,
+- struct value **ind)
++ struct value **ind)
+ {
+ int k;
+
+@@ -1670,14 +2110,13 @@
+ struct value *idx;
+
+ if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
+- error ("too many subscripts (%d expected)", k);
++ error ("too many subscripts (%d expected)", k);
+ arr = value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
+- value_copy (arr));
++ value_copy (arr));
+ get_discrete_bounds (TYPE_INDEX_TYPE (type), &lwb, &upb);
+- if (lwb == 0)
+- idx = ind[k];
+- else
+- idx = value_sub (ind[k], value_from_longest (builtin_type_int, lwb));
++ idx = value_pos_atr (ind[k]);
++ if (lwb != 0)
++ idx = value_sub (idx, value_from_longest (builtin_type_int, lwb));
+ arr = value_add (arr, idx);
+ type = TYPE_TARGET_TYPE (type);
+ }
+@@ -1688,7 +2127,7 @@
+ /* If type is a record type in the form of a standard GNAT array
+ descriptor, returns the number of dimensions for type. If arr is a
+ simple array, returns the number of "array of"s that prefix its
+- type designation. Otherwise, returns 0. */
++ type designation. Otherwise, returns 0. */
+
+ int
+ ada_array_arity (struct type *type)
+@@ -1706,8 +2145,8 @@
+ else
+ while (TYPE_CODE (type) == TYPE_CODE_ARRAY)
+ {
+- arity += 1;
+- type = check_typedef (TYPE_TARGET_TYPE (type));
++ arity += 1;
++ type = check_typedef (TYPE_TARGET_TYPE (type));
+ }
+
+ return arity;
+@@ -1716,7 +2155,7 @@
+ /* If TYPE is a record type in the form of a standard GNAT array
+ descriptor or a simple array type, returns the element type for
+ TYPE after indexing by NINDICES indices, or by all indices if
+- NINDICES is -1. Otherwise, returns NULL. */
++ NINDICES is -1. Otherwise, returns NULL. */
+
+ struct type *
+ ada_array_element_type (struct type *type, int nindices)
+@@ -1732,51 +2171,60 @@
+
+ k = ada_array_arity (type);
+ if (k == 0)
+- return NULL;
++ return NULL;
+
+- /* Initially p_array_type = elt_type(*)[]...(k times)...[] */
++ /* Initially p_array_type = elt_type(*)[]...(k times)...[]. */
+ if (nindices >= 0 && k > nindices)
+- k = nindices;
++ k = nindices;
+ p_array_type = TYPE_TARGET_TYPE (p_array_type);
+ while (k > 0 && p_array_type != NULL)
+- {
+- p_array_type = check_typedef (TYPE_TARGET_TYPE (p_array_type));
+- k -= 1;
+- }
++ {
++ p_array_type = check_typedef (TYPE_TARGET_TYPE (p_array_type));
++ k -= 1;
++ }
+ return p_array_type;
+ }
+ else if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
+ {
+ while (nindices != 0 && TYPE_CODE (type) == TYPE_CODE_ARRAY)
+- {
+- type = TYPE_TARGET_TYPE (type);
+- nindices -= 1;
+- }
++ {
++ type = TYPE_TARGET_TYPE (type);
++ nindices -= 1;
++ }
+ return type;
+ }
+
+ return NULL;
+ }
+
+-/* The type of nth index in arrays of given type (n numbering from 1). Does
+- not examine memory. */
++/* The type of nth index in arrays of given type (n numbering from 1).
++ Does not examine memory. */
+
+ struct type *
+ ada_index_type (struct type *type, int n)
+ {
++ struct type *result_type;
++
+ type = desc_base_type (type);
+
+ if (n > ada_array_arity (type))
+ return NULL;
+
+- if (ada_is_simple_array (type))
++ if (ada_is_simple_array_type (type))
+ {
+ int i;
+
+ for (i = 1; i < n; i += 1)
+- type = TYPE_TARGET_TYPE (type);
++ type = TYPE_TARGET_TYPE (type);
++ result_type = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0));
++ /* 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. */
++ if (result_type == NULL
++ || TYPE_CODE (result_type) == TYPE_CODE_UNDEF)
++ result_type = builtin_type_int;
+
+- return TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0));
++ return result_type;
+ }
+ else
+ return desc_index_type (desc_bounds_type (type), n);
+@@ -1784,14 +2232,14 @@
+
+ /* Given that arr is an array type, returns the lower bound of the
+ Nth index (numbering from 1) if WHICH is 0, and the upper bound if
+- WHICH is 1. This returns bounds 0 .. -1 if ARR_TYPE is an
+- array-descriptor type. If TYPEP is non-null, *TYPEP is set to the
+- bounds type. It works for other arrays with bounds supplied by
+- run-time quantities other than discriminants. */
++ WHICH is 1. This returns bounds 0 .. -1 if ARR_TYPE is an
++ array-descriptor type. If TYPEP is non-null, *TYPEP is set to the
++ bounds type. It works for other arrays with bounds supplied by
++ run-time quantities other than discriminants. */
+
+ LONGEST
+ ada_array_bound_from_type (struct type * arr_type, int n, int which,
+- struct type ** typep)
++ struct type ** typep)
+ {
+ struct type *type;
+ struct type *index_type_desc;
+@@ -1799,10 +2247,10 @@
+ if (ada_is_packed_array_type (arr_type))
+ arr_type = decode_packed_array_type (arr_type);
+
+- if (arr_type == NULL || !ada_is_simple_array (arr_type))
++ if (arr_type == NULL || !ada_is_simple_array_type (arr_type))
+ {
+ if (typep != NULL)
+- *typep = builtin_type_int;
++ *typep = builtin_type_int;
+ return (LONGEST) - which;
+ }
+
+@@ -1818,40 +2266,40 @@
+ struct type *index_type;
+
+ while (n > 1)
+- {
+- type = TYPE_TARGET_TYPE (type);
+- n -= 1;
+- }
++ {
++ type = TYPE_TARGET_TYPE (type);
++ n -= 1;
++ }
+
+ range_type = TYPE_INDEX_TYPE (type);
+ index_type = TYPE_TARGET_TYPE (range_type);
+ if (TYPE_CODE (index_type) == TYPE_CODE_UNDEF)
+- index_type = builtin_type_long;
++ index_type = builtin_type_long;
+ if (typep != NULL)
+- *typep = index_type;
++ *typep = index_type;
+ return
+- (LONGEST) (which == 0
+- ? TYPE_LOW_BOUND (range_type)
+- : TYPE_HIGH_BOUND (range_type));
++ (LONGEST) (which == 0
++ ? TYPE_LOW_BOUND (range_type)
++ : TYPE_HIGH_BOUND (range_type));
+ }
+ else
+ {
+ struct type *index_type =
+- to_fixed_range_type (TYPE_FIELD_NAME (index_type_desc, n - 1),
+- NULL, TYPE_OBJFILE (arr_type));
++ to_fixed_range_type (TYPE_FIELD_NAME (index_type_desc, n - 1),
++ NULL, TYPE_OBJFILE (arr_type));
+ if (typep != NULL)
+- *typep = TYPE_TARGET_TYPE (index_type);
++ *typep = TYPE_TARGET_TYPE (index_type);
+ return
+- (LONGEST) (which == 0
+- ? TYPE_LOW_BOUND (index_type)
+- : TYPE_HIGH_BOUND (index_type));
++ (LONGEST) (which == 0
++ ? TYPE_LOW_BOUND (index_type)
++ : TYPE_HIGH_BOUND (index_type));
+ }
+ }
+
+ /* Given that arr is an array value, returns the lower bound of the
+ nth index (numbering from 1) if which is 0, and the upper bound if
+- which is 1. This routine will also work for arrays with bounds
+- supplied by run-time quantities other than discriminants. */
++ which is 1. This routine will also work for arrays with bounds
++ supplied by run-time quantities other than discriminants. */
+
+ struct value *
+ ada_array_bound (struct value *arr, int n, int which)
+@@ -1860,7 +2308,7 @@
+
+ if (ada_is_packed_array_type (arr_type))
+ return ada_array_bound (decode_packed_array (arr), n, which);
+- else if (ada_is_simple_array (arr_type))
++ else if (ada_is_simple_array_type (arr_type))
+ {
+ struct type *type;
+ LONGEST v = ada_array_bound_from_type (arr_type, n, which, &type);
+@@ -1872,369 +2320,356 @@
+
+ /* Given that arr is an array value, returns the length of the
+ nth index. This routine will also work for arrays with bounds
+- supplied by run-time quantities other than discriminants. Does not
+- work for arrays indexed by enumeration types with representation
+- clauses at the moment. */
++ supplied by run-time quantities other than discriminants.
++ Does not work for arrays indexed by enumeration types with representation
++ clauses at the moment. */
+
+ struct value *
+ ada_array_length (struct value *arr, int n)
+ {
+ struct type *arr_type = check_typedef (VALUE_TYPE (arr));
+- struct type *index_type_desc;
+
+ if (ada_is_packed_array_type (arr_type))
+ return ada_array_length (decode_packed_array (arr), n);
+
+- if (ada_is_simple_array (arr_type))
++ if (ada_is_simple_array_type (arr_type))
+ {
+ struct type *type;
+ LONGEST v =
+- ada_array_bound_from_type (arr_type, n, 1, &type) -
+- ada_array_bound_from_type (arr_type, n, 0, NULL) + 1;
++ ada_array_bound_from_type (arr_type, n, 1, &type) -
++ ada_array_bound_from_type (arr_type, n, 0, NULL) + 1;
+ return value_from_longest (type, v);
+ }
+ else
+ return
+ value_from_longest (builtin_type_ada_int,
+- value_as_long (desc_one_bound (desc_bounds (arr),
+- n, 1))
+- - value_as_long (desc_one_bound (desc_bounds (arr),
+- n, 0)) + 1);
++ value_as_long (desc_one_bound (desc_bounds (arr),
++ n, 1))
++ - value_as_long (desc_one_bound (desc_bounds (arr),
++ n, 0)) + 1);
++}
++
++/* An empty array whose type is that of ARR_TYPE (an array type),
++ with bounds LOW to LOW-1. */
++
++static struct value *
++empty_array (struct type *arr_type, int low)
++{
++ return allocate_value (create_range_type (NULL, TYPE_INDEX_TYPE (arr_type),
++ low, low - 1));
+ }
+ \f
+
+- /* Name resolution */
++ /* Name resolution */
+
+-/* The "demangled" name for the user-definable Ada operator corresponding
+- to op. */
++/* The "decoded" name for the user-definable Ada operator corresponding
++ to OP. */
+
+ static const char *
+-ada_op_name (enum exp_opcode op)
++ada_decoded_op_name (enum exp_opcode op)
+ {
+ int i;
+
+- for (i = 0; ada_opname_table[i].mangled != NULL; i += 1)
++ for (i = 0; ada_opname_table[i].encoded != NULL; i += 1)
+ {
+ if (ada_opname_table[i].op == op)
+- return ada_opname_table[i].demangled;
++ return ada_opname_table[i].decoded;
+ }
+ error ("Could not find operator name for opcode");
+ }
+
+
+-/* Same as evaluate_type (*EXP), but resolves ambiguous symbol
+- references (OP_UNRESOLVED_VALUES) and converts operators that are
+- user-defined into appropriate function calls. If CONTEXT_TYPE is
++/* 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. The variable unresolved_names contains a list
+- of character strings referenced by expout that should be freed.
+- May change (expand) *EXP. */
++ return type is preferred. May change (expand) *EXP. */
+
+-void
+-ada_resolve (struct expression **expp, struct type *context_type)
++static void
++resolve (struct expression **expp, int void_context_p)
+ {
+ int pc;
+ pc = 0;
+- ada_resolve_subexp (expp, &pc, 1, context_type);
++ resolve_subexp (expp, &pc, 1, void_context_p ? builtin_type_void : NULL);
+ }
+
+-/* Resolve the operator of the subexpression beginning at
+- position *POS of *EXPP. "Resolving" consists of replacing
+- OP_UNRESOLVED_VALUE with an appropriate OP_VAR_VALUE, replacing
+- built-in operators with function calls to user-defined operators,
+- where appropriate, and (when DEPROCEDURE_P is non-zero), converting
+- function-valued variables into parameterless calls. May expand
+- EXP. The CONTEXT_TYPE functions as in ada_resolve, above. */
++/* 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
++ with their resolutions, replacing built-in operators with
++ function calls to user-defined operators, where appropriate, and,
++ when DEPROCEDURE_P is non-zero, converting function-valued variables
++ into parameterless calls. May expand *EXPP. The CONTEXT_TYPE functions
++ are as in ada_resolve, above. */
+
+ static struct value *
+-ada_resolve_subexp (struct expression **expp, int *pos, int deprocedure_p,
+- struct type *context_type)
++resolve_subexp (struct expression **expp, int *pos, int deprocedure_p,
++ struct type *context_type)
+ {
+ int pc = *pos;
+ int i;
+- struct expression *exp; /* Convenience: == *expp */
++ struct expression *exp; /* Convenience: == *expp. */
+ enum exp_opcode op = (*expp)->elts[pc].opcode;
+- struct value **argvec; /* Vector of operand types (alloca'ed). */
+- int nargs; /* Number of operands */
++ struct value **argvec; /* Vector of operand types (alloca'ed). */
++ int nargs; /* Number of operands. */
+
+ argvec = NULL;
+ nargs = 0;
+ exp = *expp;
+
+- /* Pass one: resolve operands, saving their types and updating *pos. */
++ /* Pass one: resolve operands, saving their types and updating *pos. */
+ switch (op)
+ {
+- case OP_VAR_VALUE:
+- /* case OP_UNRESOLVED_VALUE: */
+- /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */
+- *pos += 4;
++ case OP_FUNCALL:
++ if (exp->elts[pc + 3].opcode == OP_VAR_VALUE
++ && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
++ *pos += 7;
++ else
++ {
++ *pos += 3;
++ resolve_subexp (expp, pos, 0, NULL);
++ }
++ nargs = longest_to_int (exp->elts[pc + 1].longconst);
++ break;
++
++ case UNOP_QUAL:
++ *pos += 3;
++ resolve_subexp (expp, pos, 1, exp->elts[pc + 1].type);
+ break;
+
+- case OP_FUNCALL:
+- nargs = longest_to_int (exp->elts[pc + 1].longconst) + 1;
+- /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */
+- /* if (exp->elts[pc+3].opcode == OP_UNRESOLVED_VALUE)
+- {
+- *pos += 7;
+-
+- argvec = (struct value* *) alloca (sizeof (struct value*) * (nargs + 1));
+- for (i = 0; i < nargs-1; i += 1)
+- argvec[i] = ada_resolve_subexp (expp, pos, 1, NULL);
+- argvec[i] = NULL;
+- }
+- else
+- {
+- *pos += 3;
+- ada_resolve_subexp (expp, pos, 0, NULL);
+- for (i = 1; i < nargs; i += 1)
+- ada_resolve_subexp (expp, pos, 1, NULL);
+- }
+- */
+- exp = *expp;
+- break;
+-
+- /* FIXME: UNOP_QUAL should be defined in expression.h */
+- /* case UNOP_QUAL:
+- nargs = 1;
+- *pos += 3;
+- ada_resolve_subexp (expp, pos, 1, exp->elts[pc + 1].type);
+- exp = *expp;
+- break;
+- */
+- /* FIXME: OP_ATTRIBUTE should be defined in expression.h */
+- /* case OP_ATTRIBUTE:
+- nargs = longest_to_int (exp->elts[pc + 1].longconst) + 1;
+- *pos += 4;
+- for (i = 0; i < nargs; i += 1)
+- ada_resolve_subexp (expp, pos, 1, NULL);
+- exp = *expp;
+- break;
+- */
+ case UNOP_ADDR:
++ *pos += 1;
++ resolve_subexp (expp, pos, 0, NULL);
++ break;
++
++ case OP_ATR_MODULUS:
++ *pos += 4;
++ break;
++
++ case OP_ATR_SIZE:
++ case OP_ATR_TAG:
++ *pos += 1;
+ nargs = 1;
++ break;
++
++ case OP_ATR_FIRST:
++ case OP_ATR_LAST:
++ case OP_ATR_LENGTH:
++ case OP_ATR_POS:
++ case OP_ATR_VAL:
++ *pos += 1;
++ nargs = 2;
++ break;
++
++ case OP_ATR_MIN:
++ case OP_ATR_MAX:
+ *pos += 1;
+- ada_resolve_subexp (expp, pos, 0, NULL);
+- exp = *expp;
++ nargs = 3;
+ break;
+
+ case BINOP_ASSIGN:
+ {
+- struct value *arg1;
+- nargs = 2;
+- *pos += 1;
+- arg1 = ada_resolve_subexp (expp, pos, 0, NULL);
+- if (arg1 == NULL)
+- ada_resolve_subexp (expp, pos, 1, NULL);
+- else
+- ada_resolve_subexp (expp, pos, 1, VALUE_TYPE (arg1));
+- break;
++ struct value *arg1;
++
++ *pos += 1;
++ arg1 = resolve_subexp (expp, pos, 0, NULL);
++ if (arg1 == NULL)
++ resolve_subexp (expp, pos, 1, NULL);
++ else
++ resolve_subexp (expp, pos, 1, VALUE_TYPE (arg1));
++ break;
+ }
+
+- default:
+- switch (op)
+- {
+- default:
+- error ("Unexpected operator during name resolution");
+- case UNOP_CAST:
+- /* case UNOP_MBR:
+- nargs = 1;
+- *pos += 3;
+- break;
+- */
+- case BINOP_ADD:
+- case BINOP_SUB:
+- case BINOP_MUL:
+- case BINOP_DIV:
+- case BINOP_REM:
+- case BINOP_MOD:
+- case BINOP_EXP:
+- case BINOP_CONCAT:
+- case BINOP_LOGICAL_AND:
+- case BINOP_LOGICAL_OR:
+- case BINOP_BITWISE_AND:
+- case BINOP_BITWISE_IOR:
+- case BINOP_BITWISE_XOR:
+-
+- case BINOP_EQUAL:
+- case BINOP_NOTEQUAL:
+- case BINOP_LESS:
+- case BINOP_GTR:
+- case BINOP_LEQ:
+- case BINOP_GEQ:
+-
+- case BINOP_REPEAT:
+- case BINOP_SUBSCRIPT:
+- case BINOP_COMMA:
+- nargs = 2;
+- *pos += 1;
+- break;
++ case UNOP_CAST:
++ case UNOP_IN_RANGE:
++ *pos += 3;
++ nargs = 1;
++ break;
+
+- case UNOP_NEG:
+- case UNOP_PLUS:
+- case UNOP_LOGICAL_NOT:
+- case UNOP_ABS:
+- case UNOP_IND:
+- nargs = 1;
+- *pos += 1;
+- break;
++ case BINOP_ADD:
++ case BINOP_SUB:
++ case BINOP_MUL:
++ case BINOP_DIV:
++ case BINOP_REM:
++ case BINOP_MOD:
++ case BINOP_EXP:
++ case BINOP_CONCAT:
++ case BINOP_LOGICAL_AND:
++ case BINOP_LOGICAL_OR:
++ case BINOP_BITWISE_AND:
++ case BINOP_BITWISE_IOR:
++ case BINOP_BITWISE_XOR:
+
+- case OP_LONG:
+- case OP_DOUBLE:
+- case OP_VAR_VALUE:
+- *pos += 4;
+- break;
++ case BINOP_EQUAL:
++ case BINOP_NOTEQUAL:
++ case BINOP_LESS:
++ case BINOP_GTR:
++ case BINOP_LEQ:
++ case BINOP_GEQ:
+
+- case OP_TYPE:
+- case OP_BOOL:
+- case OP_LAST:
+- case OP_REGISTER:
+- case OP_INTERNALVAR:
+- *pos += 3;
+- break;
++ case BINOP_REPEAT:
++ case BINOP_SUBSCRIPT:
++ case BINOP_COMMA:
++ *pos += 1;
++ nargs = 2;
++ break;
+
+- case UNOP_MEMVAL:
+- *pos += 3;
+- nargs = 1;
+- break;
++ case UNOP_NEG:
++ case UNOP_PLUS:
++ case UNOP_LOGICAL_NOT:
++ case UNOP_ABS:
++ case UNOP_IND:
++ *pos += 1;
++ nargs = 1;
++ break;
+
+- case STRUCTOP_STRUCT:
+- case STRUCTOP_PTR:
+- nargs = 1;
+- *pos += 4 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1);
+- break;
++ case OP_LONG:
++ case OP_DOUBLE:
++ case OP_VAR_VALUE:
++ *pos += 4;
++ break;
+
+- case OP_ARRAY:
+- *pos += 4;
+- nargs = longest_to_int (exp->elts[pc + 2].longconst) + 1;
+- nargs -= longest_to_int (exp->elts[pc + 1].longconst);
+- /* A null array contains one dummy element to give the type. */
+- /* if (nargs == 0)
+- nargs = 1;
+- break; */
+-
+- case TERNOP_SLICE:
+- /* FIXME: TERNOP_MBR should be defined in expression.h */
+- /* case TERNOP_MBR:
+- *pos += 1;
+- nargs = 3;
+- break;
+- */
+- /* FIXME: BINOP_MBR should be defined in expression.h */
+- /* case BINOP_MBR:
+- *pos += 3;
+- nargs = 2;
+- break; */
+- }
++ case OP_TYPE:
++ case OP_BOOL:
++ case OP_LAST:
++ case OP_REGISTER:
++ case OP_INTERNALVAR:
++ *pos += 3;
++ break;
+
+- argvec =
+- (struct value * *) alloca (sizeof (struct value *) * (nargs + 1));
+- for (i = 0; i < nargs; i += 1)
+- argvec[i] = ada_resolve_subexp (expp, pos, 1, NULL);
+- argvec[i] = NULL;
+- exp = *expp;
++ case UNOP_MEMVAL:
++ *pos += 3;
++ nargs = 1;
+ break;
++
++ case STRUCTOP_STRUCT:
++ *pos += 4 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1);
++ nargs = 1;
++ break;
++
++ case OP_STRING:
++ (*pos) += 3
++ + BYTES_TO_EXP_ELEM (longest_to_int (exp->elts[pc + 1].longconst) + 1);
++ break;
++
++ case TERNOP_SLICE:
++ case TERNOP_IN_RANGE:
++ *pos += 1;
++ nargs = 3;
++ break;
++
++ case BINOP_IN_BOUNDS:
++ *pos += 3;
++ nargs = 2;
++ break;
++
++ default:
++ error ("Unexpected operator during name resolution");
+ }
+
+- /* Pass two: perform any resolution on principal operator. */
++ argvec =
++ (struct value * *) alloca (sizeof (struct value *) * (nargs + 1));
++ for (i = 0; i < nargs; i += 1)
++ argvec[i] = resolve_subexp (expp, pos, 1, NULL);
++ argvec[i] = NULL;
++ exp = *expp;
++
++ /* Pass two: perform any resolution on principal operator. */
+ switch (op)
+ {
+ default:
+ break;
+
+- /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */
+- /* case OP_UNRESOLVED_VALUE:
+- {
+- struct symbol** candidate_syms;
+- struct block** candidate_blocks;
+- int n_candidates;
+-
+- n_candidates = ada_lookup_symbol_list (exp->elts[pc + 2].name,
+- exp->elts[pc + 1].block,
+- VAR_DOMAIN,
+- &candidate_syms,
+- &candidate_blocks);
+-
+- if (n_candidates > 1)
+- { */
+- /* Types tend to get re-introduced locally, so if there
+- are any local symbols that are not types, first filter
+- out all types. *//*
+- int j;
+- for (j = 0; j < n_candidates; j += 1)
+- switch (SYMBOL_CLASS (candidate_syms[j]))
+- {
+- case LOC_REGISTER:
+- case LOC_ARG:
+- case LOC_REF_ARG:
+- case LOC_REGPARM:
+- case LOC_REGPARM_ADDR:
+- case LOC_LOCAL:
+- case LOC_LOCAL_ARG:
+- case LOC_BASEREG:
+- case LOC_BASEREG_ARG:
+- case LOC_COMPUTED:
+- case LOC_COMPUTED_ARG:
+- goto FoundNonType;
+- default:
+- break;
+- }
+- FoundNonType:
+- if (j < n_candidates)
+- {
+- j = 0;
+- while (j < n_candidates)
+- {
+- if (SYMBOL_CLASS (candidate_syms[j]) == LOC_TYPEDEF)
+- {
+- candidate_syms[j] = candidate_syms[n_candidates-1];
+- candidate_blocks[j] = candidate_blocks[n_candidates-1];
+- n_candidates -= 1;
+- }
+- else
+- j += 1;
+- }
+- }
+- }
+-
+- if (n_candidates == 0)
+- error ("No definition found for %s",
+- ada_demangle (exp->elts[pc + 2].name));
+- else if (n_candidates == 1)
+- i = 0;
+- else if (deprocedure_p
+- && ! is_nonfunction (candidate_syms, n_candidates))
+- {
+- i = ada_resolve_function (candidate_syms, candidate_blocks,
+- n_candidates, NULL, 0,
+- exp->elts[pc + 2].name, context_type);
+- if (i < 0)
+- error ("Could not find a match for %s",
+- ada_demangle (exp->elts[pc + 2].name));
+- }
+- else
+- {
+- printf_filtered ("Multiple matches for %s\n",
+- ada_demangle (exp->elts[pc+2].name));
+- user_select_syms (candidate_syms, candidate_blocks,
+- n_candidates, 1);
+- i = 0;
+- }
+-
+- exp->elts[pc].opcode = exp->elts[pc + 3].opcode = OP_VAR_VALUE;
+- exp->elts[pc + 1].block = candidate_blocks[i];
+- exp->elts[pc + 2].symbol = candidate_syms[i];
+- if (innermost_block == NULL ||
+- contained_in (candidate_blocks[i], innermost_block))
+- innermost_block = candidate_blocks[i];
+- } */
+- /* FALL THROUGH */
+-
+ case OP_VAR_VALUE:
+- if (deprocedure_p &&
+- TYPE_CODE (SYMBOL_TYPE (exp->elts[pc + 2].symbol)) ==
+- TYPE_CODE_FUNC)
++ if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
++ {
++ struct ada_symbol_info *candidates;
++ int n_candidates;
++
++ n_candidates =
++ ada_lookup_symbol_list (SYMBOL_LINKAGE_NAME (exp->elts[pc + 2]
++ .symbol),
++ exp->elts[pc + 1].block,
++ VAR_DOMAIN, &candidates);
++
++ if (n_candidates > 1)
++ {
++ /* Types tend to get re-introduced locally, so if there
++ are any local symbols that are not types, first filter
++ out all types. */
++ int j;
++ for (j = 0; j < n_candidates; j += 1)
++ switch (SYMBOL_CLASS (candidates[j].sym))
++ {
++ case LOC_REGISTER:
++ case LOC_ARG:
++ case LOC_REF_ARG:
++ case LOC_REGPARM:
++ case LOC_REGPARM_ADDR:
++ case LOC_LOCAL:
++ case LOC_LOCAL_ARG:
++ case LOC_BASEREG:
++ case LOC_BASEREG_ARG:
++ case LOC_COMPUTED:
++ case LOC_COMPUTED_ARG:
++ goto FoundNonType;
++ default:
++ break;
++ }
++ FoundNonType:
++ if (j < n_candidates)
++ {
++ j = 0;
++ while (j < n_candidates)
++ {
++ if (SYMBOL_CLASS (candidates[j].sym) == LOC_TYPEDEF)
++ {
++ candidates[j] = candidates[n_candidates - 1];
++ n_candidates -= 1;
++ }
++ else
++ j += 1;
++ }
++ }
++ }
++
++ if (n_candidates == 0)
++ error ("No definition found for %s",
++ SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol));
++ else if (n_candidates == 1)
++ i = 0;
++ else if (deprocedure_p
++ && !is_nonfunction (candidates, n_candidates))
++ {
++ i = ada_resolve_function (candidates, n_candidates, NULL, 0,
++ SYMBOL_LINKAGE_NAME (exp->elts[pc + 2]
++ .symbol),
++ context_type);
++ if (i < 0)
++ error ("Could not find a match for %s",
++ SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol));
++ }
++ else
++ {
++ printf_filtered ("Multiple matches for %s\n",
++ SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol));
++ user_select_syms (candidates, n_candidates, 1);
++ i = 0;
++ }
++
++ exp->elts[pc + 1].block = candidates[i].block;
++ exp->elts[pc + 2].symbol = candidates[i].sym;
++ if (innermost_block == NULL ||
++ contained_in (candidates[i].block, innermost_block))
++ innermost_block = candidates[i].block;
++ }
++
++ if (deprocedure_p
++ && (TYPE_CODE (SYMBOL_TYPE (exp->elts[pc + 2].symbol))
++ == TYPE_CODE_FUNC))
+ {
+ replace_operator_with_call (expp, pc, 0, 0,
+ exp->elts[pc + 2].symbol,
+@@ -2245,38 +2680,37 @@
+
+ case OP_FUNCALL:
+ {
+- /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */
+- /* if (exp->elts[pc+3].opcode == OP_UNRESOLVED_VALUE)
+- {
+- struct symbol** candidate_syms;
+- struct block** candidate_blocks;
+- int n_candidates;
+-
+- n_candidates = ada_lookup_symbol_list (exp->elts[pc + 5].name,
+- exp->elts[pc + 4].block,
+- VAR_DOMAIN,
+- &candidate_syms,
+- &candidate_blocks);
+- if (n_candidates == 1)
+- i = 0;
+- else
+- {
+- i = ada_resolve_function (candidate_syms, candidate_blocks,
+- n_candidates, argvec, nargs-1,
+- exp->elts[pc + 5].name, context_type);
+- if (i < 0)
+- error ("Could not find a match for %s",
+- ada_demangle (exp->elts[pc + 5].name));
+- }
+-
+- exp->elts[pc + 3].opcode = exp->elts[pc + 6].opcode = OP_VAR_VALUE;
+- exp->elts[pc + 4].block = candidate_blocks[i];
+- exp->elts[pc + 5].symbol = candidate_syms[i];
+- if (innermost_block == NULL ||
+- contained_in (candidate_blocks[i], innermost_block))
+- innermost_block = candidate_blocks[i];
+- } */
+-
++ if (exp->elts[pc + 3].opcode == OP_VAR_VALUE
++ && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
++ {
++ struct ada_symbol_info *candidates;
++ int n_candidates;
++
++ n_candidates =
++ ada_lookup_symbol_list (SYMBOL_LINKAGE_NAME (exp->elts[pc + 5]
++ .symbol),
++ exp->elts[pc + 4].block,
++ VAR_DOMAIN, &candidates);
++ if (n_candidates == 1)
++ i = 0;
++ else
++ {
++ i = ada_resolve_function (candidates, n_candidates,
++ argvec, nargs,
++ SYMBOL_LINKAGE_NAME (exp->elts[pc+5]
++ .symbol),
++ context_type);
++ if (i < 0)
++ error ("Could not find a match for %s",
++ SYMBOL_PRINT_NAME (exp->elts[pc + 5].symbol));
++ }
++
++ exp->elts[pc + 4].block = candidates[i].block;
++ exp->elts[pc + 5].symbol = candidates[i].sym;
++ if (innermost_block == NULL ||
++ contained_in (candidates[i].block, innermost_block))
++ innermost_block = candidates[i].block;
++ }
+ }
+ break;
+ case BINOP_ADD:
+@@ -2301,27 +2735,27 @@
+ case UNOP_LOGICAL_NOT:
+ case UNOP_ABS:
+ if (possible_user_operator_p (op, argvec))
+- {
+- struct symbol **candidate_syms;
+- struct block **candidate_blocks;
+- int n_candidates;
+-
+- n_candidates =
+- ada_lookup_symbol_list (ada_mangle (ada_op_name (op)),
+- (struct block *) NULL, VAR_DOMAIN,
+- &candidate_syms, &candidate_blocks);
+- i =
+- ada_resolve_function (candidate_syms, candidate_blocks,
+- n_candidates, argvec, nargs,
+- ada_op_name (op), NULL);
+- if (i < 0)
+- break;
+-
+- replace_operator_with_call (expp, pc, nargs, 1,
+- candidate_syms[i], candidate_blocks[i]);
+- exp = *expp;
+- }
++ {
++ struct ada_symbol_info *candidates;
++ int n_candidates;
++
++ n_candidates =
++ ada_lookup_symbol_list (ada_encode (ada_decoded_op_name (op)),
++ (struct block *) NULL, VAR_DOMAIN,
++ &candidates);
++ i = ada_resolve_function (candidates, n_candidates, argvec, nargs,
++ ada_decoded_op_name (op), NULL);
++ if (i < 0)
++ break;
++
++ replace_operator_with_call (expp, pc, nargs, 1,
++ candidates[i].sym, candidates[i].block);
++ exp = *expp;
++ }
+ break;
++
++ case OP_TYPE:
++ return NULL;
+ }
+
+ *pos = pc;
+@@ -2329,10 +2763,11 @@
+ }
+
+ /* Return non-zero if formal type FTYPE matches actual type ATYPE. If
+- MAY_DEREF is non-zero, the formal may be a pointer and the actual
+- a non-pointer. */
++ MAY_DEREF is non-zero, the formal may be a pointer and the actual
++ a non-pointer. A type of 'void' (which is never a valid expression type)
++ by convention matches anything. */
+ /* The term "match" here is rather loose. The match is heuristic and
+- liberal. FIXME: TOO liberal, in fact. */
++ liberal. FIXME: TOO liberal, in fact. */
+
+ static int
+ ada_type_match (struct type *ftype, struct type *atype, int may_deref)
+@@ -2355,35 +2790,35 @@
+ return 1;
+ case TYPE_CODE_PTR:
+ if (TYPE_CODE (atype) == TYPE_CODE_PTR)
+- return ada_type_match (TYPE_TARGET_TYPE (ftype),
+- TYPE_TARGET_TYPE (atype), 0);
++ return ada_type_match (TYPE_TARGET_TYPE (ftype),
++ TYPE_TARGET_TYPE (atype), 0);
+ else
+- return (may_deref &&
+- ada_type_match (TYPE_TARGET_TYPE (ftype), atype, 0));
++ return (may_deref &&
++ ada_type_match (TYPE_TARGET_TYPE (ftype), atype, 0));
+ case TYPE_CODE_INT:
+ case TYPE_CODE_ENUM:
+ case TYPE_CODE_RANGE:
+ switch (TYPE_CODE (atype))
+- {
+- case TYPE_CODE_INT:
+- case TYPE_CODE_ENUM:
+- case TYPE_CODE_RANGE:
+- return 1;
+- default:
+- return 0;
+- }
++ {
++ case TYPE_CODE_INT:
++ case TYPE_CODE_ENUM:
++ case TYPE_CODE_RANGE:
++ return 1;
++ default:
++ return 0;
++ }
+
+ case TYPE_CODE_ARRAY:
+ return (TYPE_CODE (atype) == TYPE_CODE_ARRAY
+- || ada_is_array_descriptor (atype));
++ || ada_is_array_descriptor_type (atype));
+
+ case TYPE_CODE_STRUCT:
+- if (ada_is_array_descriptor (ftype))
+- return (TYPE_CODE (atype) == TYPE_CODE_ARRAY
+- || ada_is_array_descriptor (atype));
++ if (ada_is_array_descriptor_type (ftype))
++ return (TYPE_CODE (atype) == TYPE_CODE_ARRAY
++ || ada_is_array_descriptor_type (atype));
+ else
+- return (TYPE_CODE (atype) == TYPE_CODE_STRUCT
+- && !ada_is_array_descriptor (atype));
++ return (TYPE_CODE (atype) == TYPE_CODE_STRUCT
++ && !ada_is_array_descriptor_type (atype));
+
+ case TYPE_CODE_UNION:
+ case TYPE_CODE_FLT:
+@@ -2394,7 +2829,7 @@
+ /* Return non-zero if the formals of FUNC "sufficiently match" the
+ vector of actual argument types ACTUALS of size N_ACTUALS. FUNC
+ may also be an enumeral, in which case it is treated as a 0-
+- argument function. */
++ argument function. */
+
+ static int
+ ada_args_match (struct symbol *func, struct value **actuals, int n_actuals)
+@@ -2413,12 +2848,16 @@
+
+ for (i = 0; i < n_actuals; i += 1)
+ {
+- struct type *ftype = check_typedef (TYPE_FIELD_TYPE (func_type, i));
+- struct type *atype = check_typedef (VALUE_TYPE (actuals[i]));
+-
+- if (!ada_type_match (TYPE_FIELD_TYPE (func_type, i),
+- VALUE_TYPE (actuals[i]), 1))
++ if (actuals[i] == NULL)
+ return 0;
++ else
++ {
++ struct type *ftype = check_typedef (TYPE_FIELD_TYPE (func_type, i));
++ struct type *atype = check_typedef (VALUE_TYPE (actuals[i]));
++
++ if (!ada_type_match (ftype, atype, 1))
++ return 0;
++ }
+ }
+ return 1;
+ }
+@@ -2436,16 +2875,14 @@
+ if (func_type == NULL)
+ return 1;
+
+- /* FIXME: base_type should be declared in gdbtypes.h, implemented in valarith.c */
+- /* if (TYPE_CODE (func_type) == TYPE_CODE_FUNC)
+- return_type = base_type (TYPE_TARGET_TYPE (func_type));
+- else
+- return_type = base_type (func_type); */
++ if (TYPE_CODE (func_type) == TYPE_CODE_FUNC)
++ return_type = base_type (TYPE_TARGET_TYPE (func_type));
++ else
++ return_type = base_type (func_type);
+ if (return_type == NULL)
+ return 1;
+
+- /* FIXME: base_type should be declared in gdbtypes.h, implemented in valarith.c */
+- /* context_type = base_type (context_type); */
++ context_type = base_type (context_type);
+
+ if (TYPE_CODE (return_type) == TYPE_CODE_ENUM)
+ return context_type == NULL || return_type == context_type;
+@@ -2456,24 +2893,25 @@
+ }
+
+
+-/* Return the index in SYMS[0..NSYMS-1] of symbol for the
++/* Returns the index in SYMS[0..NSYMS-1] that contains the symbol for the
+ function (if any) that matches the types of the NARGS arguments in
+- ARGS. If CONTEXT_TYPE is non-null, and there is at least one match
+- that returns type CONTEXT_TYPE, then eliminate other matches. If
+- CONTEXT_TYPE is null, prefer a non-void-returning function.
++ ARGS. If CONTEXT_TYPE is non-null and there is at least one match
++ that returns that type, then eliminate matches that don't. If
++ CONTEXT_TYPE is void and there is at least one match that does not
++ return void, eliminate all matches that do.
++
+ Asks the user if there is more than one match remaining. Returns -1
+ if there is no such symbol or none is selected. NAME is used
+- solely for messages. May re-arrange and modify SYMS in
+- the process; the index returned is for the modified vector. BLOCKS
+- is modified in parallel to SYMS. */
++ solely for messages. May re-arrange and modify SYMS in
++ the process; the index returned is for the modified vector. */
+
+-int
+-ada_resolve_function (struct symbol *syms[], struct block *blocks[],
+- int nsyms, struct value **args, int nargs,
+- const char *name, struct type *context_type)
++static int
++ada_resolve_function (struct ada_symbol_info syms[],
++ int nsyms, struct value **args, int nargs,
++ const char *name, struct type *context_type)
+ {
+ int k;
+- int m; /* Number of hits */
++ int m; /* Number of hits */
+ struct type *fallback;
+ struct type *return_type;
+
+@@ -2487,22 +2925,20 @@
+ while (1)
+ {
+ for (k = 0; k < nsyms; k += 1)
+- {
+- struct type *type = check_typedef (SYMBOL_TYPE (syms[k]));
++ {
++ struct type *type = check_typedef (SYMBOL_TYPE (syms[k].sym));
+
+- if (ada_args_match (syms[k], args, nargs)
+- && return_match (SYMBOL_TYPE (syms[k]), return_type))
+- {
+- syms[m] = syms[k];
+- if (blocks != NULL)
+- blocks[m] = blocks[k];
+- m += 1;
+- }
+- }
++ if (ada_args_match (syms[k].sym, args, nargs)
++ && return_match (type, return_type))
++ {
++ syms[m] = syms[k];
++ m += 1;
++ }
++ }
+ if (m > 0 || return_type == fallback)
+- break;
++ break;
+ else
+- return_type = fallback;
++ return_type = fallback;
+ }
+
+ if (m == 0)
+@@ -2510,19 +2946,20 @@
+ else if (m > 1)
+ {
+ printf_filtered ("Multiple matches for %s\n", name);
+- user_select_syms (syms, blocks, m, 1);
++ user_select_syms (syms, m, 1);
+ return 0;
+ }
+ return 0;
+ }
+
+-/* Returns true (non-zero) iff demangled name N0 should appear before N1 */
+-/* in a listing of choices during disambiguation (see sort_choices, below). */
+-/* The idea is that overloadings of a subprogram name from the */
+-/* same package should sort in their source order. We settle for ordering */
+-/* such symbols by their trailing number (__N or $N). */
++/* Returns true (non-zero) iff decoded name N0 should appear before N1
++ in a listing of choices during disambiguation (see sort_choices, below).
++ The idea is that overloadings of a subprogram name from the
++ same package should sort in their source order. We settle for ordering
++ such symbols by their trailing number (__N or $N). */
++
+ static int
+-mangled_ordered_before (char *N0, char *N1)
++encoded_ordered_before (char *N0, char *N1)
+ {
+ if (N1 == NULL)
+ return 0;
+@@ -2532,65 +2969,59 @@
+ {
+ int k0, k1;
+ for (k0 = strlen (N0) - 1; k0 > 0 && isdigit (N0[k0]); k0 -= 1)
+- ;
++ ;
+ for (k1 = strlen (N1) - 1; k1 > 0 && isdigit (N1[k1]); k1 -= 1)
+- ;
++ ;
+ if ((N0[k0] == '_' || N0[k0] == '$') && N0[k0 + 1] != '\000'
+- && (N1[k1] == '_' || N1[k1] == '$') && N1[k1 + 1] != '\000')
+- {
+- int n0, n1;
+- n0 = k0;
+- while (N0[n0] == '_' && n0 > 0 && N0[n0 - 1] == '_')
+- n0 -= 1;
+- n1 = k1;
+- while (N1[n1] == '_' && n1 > 0 && N1[n1 - 1] == '_')
+- n1 -= 1;
+- if (n0 == n1 && DEPRECATED_STREQN (N0, N1, n0))
+- return (atoi (N0 + k0 + 1) < atoi (N1 + k1 + 1));
+- }
++ && (N1[k1] == '_' || N1[k1] == '$') && N1[k1 + 1] != '\000')
++ {
++ int n0, n1;
++ n0 = k0;
++ while (N0[n0] == '_' && n0 > 0 && N0[n0 - 1] == '_')
++ n0 -= 1;
++ n1 = k1;
++ while (N1[n1] == '_' && n1 > 0 && N1[n1 - 1] == '_')
++ n1 -= 1;
++ if (n0 == n1 && strncmp (N0, N1, n0) == 0)
++ return (atoi (N0 + k0 + 1) < atoi (N1 + k1 + 1));
++ }
+ return (strcmp (N0, N1) < 0);
+ }
+ }
+
+-/* Sort SYMS[0..NSYMS-1] to put the choices in a canonical order by their */
+-/* mangled names, rearranging BLOCKS[0..NSYMS-1] according to the same */
+-/* permutation. */
++/* Sort SYMS[0..NSYMS-1] to put the choices in a canonical order by the
++ encoded names. */
++
+ static void
+-sort_choices (struct symbol *syms[], struct block *blocks[], int nsyms)
++sort_choices (struct ada_symbol_info syms[], int nsyms)
+ {
+- int i, j;
++ int i;
+ for (i = 1; i < nsyms; i += 1)
+ {
+- struct symbol *sym = syms[i];
+- struct block *block = blocks[i];
++ struct ada_symbol_info sym = syms[i];
+ int j;
+
+ for (j = i - 1; j >= 0; j -= 1)
+- {
+- if (mangled_ordered_before (DEPRECATED_SYMBOL_NAME (syms[j]),
+- DEPRECATED_SYMBOL_NAME (sym)))
+- break;
+- syms[j + 1] = syms[j];
+- blocks[j + 1] = blocks[j];
+- }
++ {
++ if (encoded_ordered_before (SYMBOL_LINKAGE_NAME (syms[j].sym),
++ SYMBOL_LINKAGE_NAME (sym.sym)))
++ break;
++ syms[j + 1] = syms[j];
++ }
+ syms[j + 1] = sym;
+- blocks[j + 1] = block;
+ }
+ }
+
+-/* Given a list of NSYMS symbols in SYMS and corresponding blocks in */
+-/* BLOCKS, select up to MAX_RESULTS>0 by asking the user (if */
+-/* necessary), returning the number selected, and setting the first */
+-/* elements of SYMS and BLOCKS to the selected symbols and */
+-/* corresponding blocks. Error if no symbols selected. BLOCKS may */
+-/* be NULL, in which case it is ignored. */
++/* Given a list of NSYMS symbols in SYMS, select up to MAX_RESULTS>0
++ by asking the user (if necessary), returning the number selected,
++ and setting the first elements of SYMS items. Error if no symbols
++ selected. */
+
+ /* NOTE: Adapted from decode_line_2 in symtab.c, with which it ought
+- to be re-integrated one of these days. */
++ to be re-integrated one of these days. */
+
+ int
+-user_select_syms (struct symbol *syms[], struct block *blocks[], int nsyms,
+- int max_results)
++user_select_syms (struct ada_symbol_info *syms, int nsyms, int max_results)
+ {
+ int i;
+ int *chosen = (int *) alloca (sizeof (int) * nsyms);
+@@ -2606,94 +3037,90 @@
+ if (max_results > 1)
+ printf_unfiltered ("[1] all\n");
+
+- sort_choices (syms, blocks, nsyms);
++ sort_choices (syms, nsyms);
+
+ for (i = 0; i < nsyms; i += 1)
+ {
+- if (syms[i] == NULL)
+- continue;
++ if (syms[i].sym == NULL)
++ continue;
+
+- if (SYMBOL_CLASS (syms[i]) == LOC_BLOCK)
+- {
+- struct symtab_and_line sal = find_function_start_sal (syms[i], 1);
+- printf_unfiltered ("[%d] %s at %s:%d\n",
+- i + first_choice,
+- SYMBOL_PRINT_NAME (syms[i]),
+- sal.symtab == NULL
+- ? "<no source file available>"
+- : sal.symtab->filename, sal.line);
+- continue;
+- }
+- else
+- {
+- int is_enumeral =
+- (SYMBOL_CLASS (syms[i]) == LOC_CONST
+- && SYMBOL_TYPE (syms[i]) != NULL
+- && TYPE_CODE (SYMBOL_TYPE (syms[i])) == TYPE_CODE_ENUM);
+- struct symtab *symtab = symtab_for_sym (syms[i]);
+-
+- if (SYMBOL_LINE (syms[i]) != 0 && symtab != NULL)
+- printf_unfiltered ("[%d] %s at %s:%d\n",
+- i + first_choice,
+- SYMBOL_PRINT_NAME (syms[i]),
+- symtab->filename, SYMBOL_LINE (syms[i]));
+- else if (is_enumeral && TYPE_NAME (SYMBOL_TYPE (syms[i])) != NULL)
+- {
+- printf_unfiltered ("[%d] ", i + first_choice);
+- ada_print_type (SYMBOL_TYPE (syms[i]), NULL, gdb_stdout, -1, 0);
+- printf_unfiltered ("'(%s) (enumeral)\n",
+- SYMBOL_PRINT_NAME (syms[i]));
+- }
+- else if (symtab != NULL)
+- printf_unfiltered (is_enumeral
+- ? "[%d] %s in %s (enumeral)\n"
+- : "[%d] %s at %s:?\n",
+- i + first_choice,
+- SYMBOL_PRINT_NAME (syms[i]),
+- symtab->filename);
+- else
+- printf_unfiltered (is_enumeral
+- ? "[%d] %s (enumeral)\n"
+- : "[%d] %s at ?\n",
+- i + first_choice,
+- SYMBOL_PRINT_NAME (syms[i]));
+- }
++ if (SYMBOL_CLASS (syms[i].sym) == LOC_BLOCK)
++ {
++ struct symtab_and_line sal = find_function_start_sal (syms[i].sym, 1);
++ printf_unfiltered ("[%d] %s at %s:%d\n",
++ i + first_choice,
++ SYMBOL_PRINT_NAME (syms[i].sym),
++ sal.symtab == NULL
++ ? "<no source file available>"
++ : sal.symtab->filename, sal.line);
++ continue;
++ }
++ else
++ {
++ int is_enumeral =
++ (SYMBOL_CLASS (syms[i].sym) == LOC_CONST
++ && SYMBOL_TYPE (syms[i].sym) != NULL
++ && TYPE_CODE (SYMBOL_TYPE (syms[i].sym)) == TYPE_CODE_ENUM);
++ struct symtab *symtab = symtab_for_sym (syms[i].sym);
++
++ if (SYMBOL_LINE (syms[i].sym) != 0 && symtab != NULL)
++ printf_unfiltered ("[%d] %s at %s:%d\n",
++ i + first_choice,
++ SYMBOL_PRINT_NAME (syms[i].sym),
++ symtab->filename, SYMBOL_LINE (syms[i].sym));
++ else if (is_enumeral && TYPE_NAME (SYMBOL_TYPE (syms[i].sym)) != NULL)
++ {
++ printf_unfiltered ("[%d] ", i + first_choice);
++ ada_print_type (SYMBOL_TYPE (syms[i].sym), NULL,
++ gdb_stdout, -1, 0);
++ printf_unfiltered ("'(%s) (enumeral)\n",
++ SYMBOL_PRINT_NAME (syms[i].sym));
++ }
++ else if (symtab != NULL)
++ printf_unfiltered (is_enumeral
++ ? "[%d] %s in %s (enumeral)\n"
++ : "[%d] %s at %s:?\n",
++ i + first_choice,
++ SYMBOL_PRINT_NAME (syms[i].sym),
++ symtab->filename);
++ else
++ printf_unfiltered (is_enumeral
++ ? "[%d] %s (enumeral)\n"
++ : "[%d] %s at ?\n",
++ i + first_choice,
++ SYMBOL_PRINT_NAME (syms[i].sym));
++ }
+ }
+
+ n_chosen = get_selections (chosen, nsyms, max_results, max_results > 1,
+- "overload-choice");
++ "overload-choice");
+
+ for (i = 0; i < n_chosen; i += 1)
+- {
+- syms[i] = syms[chosen[i]];
+- if (blocks != NULL)
+- blocks[i] = blocks[chosen[i]];
+- }
++ syms[i] = syms[chosen[i]];
+
+ return n_chosen;
+ }
+
+ /* Read and validate a set of numeric choices from the user in the
+- range 0 .. N_CHOICES-1. Place the results in increasing
++ range 0 .. N_CHOICES-1. Place the results in increasing
+ order in CHOICES[0 .. N-1], and return N.
+
+ The user types choices as a sequence of numbers on one line
+ separated by blanks, encoding them as follows:
+
+- + A choice of 0 means to cancel the selection, throwing an error.
++ + A choice of 0 means to cancel the selection, throwing an error.
+ + If IS_ALL_CHOICE, a choice of 1 selects the entire set 0 .. N_CHOICES-1.
+ + The user chooses k by typing k+IS_ALL_CHOICE+1.
+
+- The user is not allowed to choose more than MAX_RESULTS values.
++ The user is not allowed to choose more than MAX_RESULTS values.
+
+ ANNOTATION_SUFFIX, if present, is used to annotate the input
+- prompts (for use with the -f switch). */
++ prompts (for use with the -f switch). */
+
+ int
+ get_selections (int *choices, int n_choices, int max_results,
+- int is_all_choice, char *annotation_suffix)
++ int is_all_choice, char *annotation_suffix)
+ {
+- int i;
+ char *args;
+ const char *prompt;
+ int n_chosen;
+@@ -2712,51 +3139,51 @@
+ error_no_arg ("one or more choice numbers");
+
+ n_chosen = 0;
+-
+- /* Set choices[0 .. n_chosen-1] to the users' choices in ascending
+- order, as given in args. Choices are validated. */
++
++ /* Set choices[0 .. n_chosen-1] to the users' choices in ascending
++ order, as given in args. Choices are validated. */
+ while (1)
+ {
+ char *args2;
+ int choice, j;
+
+ while (isspace (*args))
+- args += 1;
++ args += 1;
+ if (*args == '\0' && n_chosen == 0)
+- error_no_arg ("one or more choice numbers");
++ error_no_arg ("one or more choice numbers");
+ else if (*args == '\0')
+- break;
++ break;
+
+ choice = strtol (args, &args2, 10);
+ if (args == args2 || choice < 0
+- || choice > n_choices + first_choice - 1)
+- error ("Argument must be choice number");
++ || choice > n_choices + first_choice - 1)
++ error ("Argument must be choice number");
+ args = args2;
+
+ if (choice == 0)
+- error ("cancelled");
++ error ("cancelled");
+
+ if (choice < first_choice)
+- {
+- n_chosen = n_choices;
+- for (j = 0; j < n_choices; j += 1)
+- choices[j] = j;
+- break;
+- }
++ {
++ n_chosen = n_choices;
++ for (j = 0; j < n_choices; j += 1)
++ choices[j] = j;
++ break;
++ }
+ choice -= first_choice;
+
+ for (j = n_chosen - 1; j >= 0 && choice < choices[j]; j -= 1)
+- {
+- }
++ {
++ }
+
+ if (j < 0 || choice != choices[j])
+- {
+- int k;
+- for (k = n_chosen - 1; k > j; k -= 1)
+- choices[k + 1] = choices[k];
+- choices[j + 1] = choice;
+- n_chosen += 1;
+- }
++ {
++ int k;
++ for (k = n_chosen - 1; k > j; k -= 1)
++ choices[k + 1] = choices[k];
++ choices[j + 1] = choice;
++ n_chosen += 1;
++ }
+ }
+
+ if (n_chosen > max_results)
+@@ -2765,27 +3192,27 @@
+ return n_chosen;
+ }
+
+-/* Replace the operator of length OPLEN at position PC in *EXPP with a call */
+-/* on the function identified by SYM and BLOCK, and taking NARGS */
+-/* arguments. Update *EXPP as needed to hold more space. */
++/* Replace the operator of length OPLEN at position PC in *EXPP with a call
++ on the function identified by SYM and BLOCK, and taking NARGS
++ arguments. Update *EXPP as needed to hold more space. */
+
+ static void
+ replace_operator_with_call (struct expression **expp, int pc, int nargs,
+- int oplen, struct symbol *sym,
+- struct block *block)
++ int oplen, struct symbol *sym,
++ struct block *block)
+ {
+ /* A new expression, with 6 more elements (3 for funcall, 4 for function
+- symbol, -oplen for operator being replaced). */
++ symbol, -oplen for operator being replaced). */
+ struct expression *newexp = (struct expression *)
+ xmalloc (sizeof (struct expression)
+- + EXP_ELEM_TO_BYTES ((*expp)->nelts + 7 - oplen));
++ + EXP_ELEM_TO_BYTES ((*expp)->nelts + 7 - oplen));
+ struct expression *exp = *expp;
+
+ newexp->nelts = exp->nelts + 7 - oplen;
+ newexp->language_defn = exp->language_defn;
+ memcpy (newexp->elts, exp->elts, EXP_ELEM_TO_BYTES (pc));
+ memcpy (newexp->elts + pc + 7, exp->elts + pc + oplen,
+- EXP_ELEM_TO_BYTES (exp->nelts - pc - oplen));
++ EXP_ELEM_TO_BYTES (exp->nelts - pc - oplen));
+
+ newexp->elts[pc].opcode = newexp->elts[pc + 2].opcode = OP_FUNCALL;
+ newexp->elts[pc + 1].longconst = (LONGEST) nargs;
+@@ -2800,8 +3227,8 @@
+
+ /* Type-class predicates */
+
+-/* True iff TYPE is numeric (i.e., an INT, RANGE (of numeric type), or */
+-/* FLOAT.) */
++/* True iff TYPE is numeric (i.e., an INT, RANGE (of numeric type),
++ or FLOAT). */
+
+ static int
+ numeric_type_p (struct type *type)
+@@ -2811,20 +3238,20 @@
+ else
+ {
+ switch (TYPE_CODE (type))
+- {
+- case TYPE_CODE_INT:
+- case TYPE_CODE_FLT:
+- return 1;
+- case TYPE_CODE_RANGE:
+- return (type == TYPE_TARGET_TYPE (type)
+- || numeric_type_p (TYPE_TARGET_TYPE (type)));
+- default:
+- return 0;
+- }
++ {
++ case TYPE_CODE_INT:
++ case TYPE_CODE_FLT:
++ return 1;
++ case TYPE_CODE_RANGE:
++ return (type == TYPE_TARGET_TYPE (type)
++ || numeric_type_p (TYPE_TARGET_TYPE (type)));
++ default:
++ return 0;
++ }
+ }
+ }
+
+-/* True iff TYPE is integral (an INT or RANGE of INTs). */
++/* True iff TYPE is integral (an INT or RANGE of INTs). */
+
+ static int
+ integer_type_p (struct type *type)
+@@ -2834,19 +3261,19 @@
+ else
+ {
+ switch (TYPE_CODE (type))
+- {
+- case TYPE_CODE_INT:
+- return 1;
+- case TYPE_CODE_RANGE:
+- return (type == TYPE_TARGET_TYPE (type)
+- || integer_type_p (TYPE_TARGET_TYPE (type)));
+- default:
+- return 0;
+- }
++ {
++ case TYPE_CODE_INT:
++ return 1;
++ case TYPE_CODE_RANGE:
++ return (type == TYPE_TARGET_TYPE (type)
++ || integer_type_p (TYPE_TARGET_TYPE (type)));
++ default:
++ return 0;
++ }
+ }
+ }
+
+-/* True iff TYPE is scalar (INT, RANGE, FLOAT, ENUM). */
++/* True iff TYPE is scalar (INT, RANGE, FLOAT, ENUM). */
+
+ static int
+ scalar_type_p (struct type *type)
+@@ -2856,19 +3283,19 @@
+ else
+ {
+ switch (TYPE_CODE (type))
+- {
+- case TYPE_CODE_INT:
+- case TYPE_CODE_RANGE:
+- case TYPE_CODE_ENUM:
+- case TYPE_CODE_FLT:
+- return 1;
+- default:
+- return 0;
+- }
++ {
++ case TYPE_CODE_INT:
++ case TYPE_CODE_RANGE:
++ case TYPE_CODE_ENUM:
++ case TYPE_CODE_FLT:
++ return 1;
++ default:
++ return 0;
++ }
+ }
+ }
+
+-/* True iff TYPE is discrete (INT, RANGE, ENUM). */
++/* True iff TYPE is discrete (INT, RANGE, ENUM). */
+
+ static int
+ discrete_type_p (struct type *type)
+@@ -2878,28 +3305,32 @@
+ else
+ {
+ switch (TYPE_CODE (type))
+- {
+- case TYPE_CODE_INT:
+- case TYPE_CODE_RANGE:
+- case TYPE_CODE_ENUM:
+- return 1;
+- default:
+- return 0;
+- }
++ {
++ case TYPE_CODE_INT:
++ case TYPE_CODE_RANGE:
++ case TYPE_CODE_ENUM:
++ return 1;
++ default:
++ return 0;
++ }
+ }
+ }
+
+-/* Returns non-zero if OP with operatands in the vector ARGS could be
+- a user-defined function. Errs on the side of pre-defined operators
+- (i.e., result 0). */
++/* Returns non-zero if OP with operands in the vector ARGS could be
++ a user-defined function. Errs on the side of pre-defined operators
++ (i.e., result 0). */
+
+ static int
+ possible_user_operator_p (enum exp_opcode op, struct value *args[])
+ {
+- struct type *type0 = check_typedef (VALUE_TYPE (args[0]));
++ struct type *type0 =
++ (args[0] == NULL) ? NULL : check_typedef (VALUE_TYPE (args[0]));
+ struct type *type1 =
+ (args[1] == NULL) ? NULL : check_typedef (VALUE_TYPE (args[1]));
+
++ if (type0 == NULL)
++ return 0;
++
+ switch (op)
+ {
+ default:
+@@ -2928,12 +3359,12 @@
+
+ case BINOP_CONCAT:
+ return ((TYPE_CODE (type0) != TYPE_CODE_ARRAY &&
+- (TYPE_CODE (type0) != TYPE_CODE_PTR ||
+- TYPE_CODE (TYPE_TARGET_TYPE (type0))
+- != TYPE_CODE_ARRAY))
+- || (TYPE_CODE (type1) != TYPE_CODE_ARRAY &&
+- (TYPE_CODE (type1) != TYPE_CODE_PTR ||
+- TYPE_CODE (TYPE_TARGET_TYPE (type1)) != TYPE_CODE_ARRAY)));
++ (TYPE_CODE (type0) != TYPE_CODE_PTR ||
++ TYPE_CODE (TYPE_TARGET_TYPE (type0))
++ != TYPE_CODE_ARRAY))
++ || (TYPE_CODE (type1) != TYPE_CODE_ARRAY &&
++ (TYPE_CODE (type1) != TYPE_CODE_PTR ||
++ TYPE_CODE (TYPE_TARGET_TYPE (type1)) != TYPE_CODE_ARRAY)));
+
+ case BINOP_EXP:
+ return (!(numeric_type_p (type0) && integer_type_p (type1)));
+@@ -2947,16 +3378,17 @@
+ }
+ }
+ \f
+- /* Renaming */
++ /* Renaming */
+
+-/** NOTE: In the following, we assume that a renaming type's name may
+- * have an ___XD suffix. It would be nice if this went away at some
+- * point. */
++/* NOTE: In the following, we assume that a renaming type's name may
++ have an ___XD suffix. It would be nice if this went away at some
++ point. */
+
+ /* If TYPE encodes a renaming, returns the renaming suffix, which
+- * is XR for an object renaming, XRP for a procedure renaming, XRE for
+- * an exception renaming, and XRS for a subprogram renaming. Returns
+- * NULL if NAME encodes none of these. */
++ is XR for an object renaming, XRP for a procedure renaming, XRE for
++ an exception renaming, and XRS for a subprogram renaming. Returns
++ NULL if NAME encodes none of these. */
++
+ const char *
+ ada_renaming_type (struct type *type)
+ {
+@@ -2965,16 +3397,17 @@
+ const char *name = type_name_no_tag (type);
+ const char *suffix = (name == NULL) ? NULL : strstr (name, "___XR");
+ if (suffix == NULL
+- || (suffix[5] != '\000' && strchr ("PES_", suffix[5]) == NULL))
+- return NULL;
++ || (suffix[5] != '\000' && strchr ("PES_", suffix[5]) == NULL))
++ return NULL;
+ else
+- return suffix + 3;
++ return suffix + 3;
+ }
+ else
+ return NULL;
+ }
+
+-/* Return non-zero iff SYM encodes an object renaming. */
++/* Return non-zero iff SYM encodes an object renaming. */
++
+ int
+ ada_is_object_renaming (struct symbol *sym)
+ {
+@@ -2984,9 +3417,10 @@
+ }
+
+ /* Assuming that SYM encodes a non-object renaming, returns the original
+- * name of the renamed entity. The name is good until the end of
+- * parsing. */
+-const char *
++ name of the renamed entity. The name is good until the end of
++ parsing. */
++
++char *
+ ada_simple_renamed_entity (struct symbol *sym)
+ {
+ struct type *type;
+@@ -3004,32 +3438,34 @@
+ error ("Improperly encoded renaming.");
+
+ result = xmalloc (len + 1);
+- /* FIXME: add_name_string_cleanup should be defined in parse.c */
+- /* add_name_string_cleanup (result); */
+ strncpy (result, raw_name, len);
+ result[len] = '\000';
+ return result;
+ }
+ \f
+
+- /* Evaluation: Function Calls */
++ /* Evaluation: Function Calls */
+
+-/* Copy VAL onto the stack, using and updating *SP as the stack
+- pointer. Return VAL as an lvalue. */
++/* Return an lvalue containing the value VAL. This is the identity on
++ lvalues, and otherwise has the side-effect of pushing a copy of VAL
++ on the stack, using and updating *SP as the stack pointer, and
++ returning an lvalue whose VALUE_ADDRESS points to the copy. */
+
+ static struct value *
+-place_on_stack (struct value *val, CORE_ADDR *sp)
++ensure_lval (struct value *val, CORE_ADDR *sp)
+ {
+ CORE_ADDR old_sp = *sp;
+
+-#ifdef DEPRECATED_STACK_ALIGN
+- *sp = push_bytes (*sp, VALUE_CONTENTS_RAW (val),
+- DEPRECATED_STACK_ALIGN (TYPE_LENGTH
+- (check_typedef (VALUE_TYPE (val)))));
+-#else
+- *sp = push_bytes (*sp, VALUE_CONTENTS_RAW (val),
+- TYPE_LENGTH (check_typedef (VALUE_TYPE (val))));
+-#endif
++ if (VALUE_LVAL (val))
++ return val;
++
++ if (DEPRECATED_STACK_ALIGN_P ())
++ *sp = push_bytes (*sp, VALUE_CONTENTS_RAW (val),
++ DEPRECATED_STACK_ALIGN
++ (TYPE_LENGTH (check_typedef (VALUE_TYPE (val)))));
++ else
++ *sp = push_bytes (*sp, VALUE_CONTENTS_RAW (val),
++ TYPE_LENGTH (check_typedef (VALUE_TYPE (val))));
+
+ VALUE_LVAL (val) = lval_memory;
+ if (INNER_THAN (1, 2))
+@@ -3043,11 +3479,11 @@
+ /* Return the value ACTUAL, converted to be an appropriate value for a
+ formal of type FORMAL_TYPE. Use *SP as a stack pointer for
+ allocating any necessary descriptors (fat pointers), or copies of
+- values not residing in memory, updating it as needed. */
++ values not residing in memory, updating it as needed. */
+
+ static struct value *
+ convert_actual (struct value *actual, struct type *formal_type0,
+- CORE_ADDR *sp)
++ CORE_ADDR *sp)
+ {
+ struct type *actual_type = check_typedef (VALUE_TYPE (actual));
+ struct type *formal_type = check_typedef (formal_type0);
+@@ -3058,28 +3494,28 @@
+ TYPE_CODE (actual_type) == TYPE_CODE_PTR
+ ? check_typedef (TYPE_TARGET_TYPE (actual_type)) : actual_type;
+
+- if (ada_is_array_descriptor (formal_target)
++ if (ada_is_array_descriptor_type (formal_target)
+ && TYPE_CODE (actual_target) == TYPE_CODE_ARRAY)
+ return make_array_descriptor (formal_type, actual, sp);
+ else if (TYPE_CODE (formal_type) == TYPE_CODE_PTR)
+ {
+ if (TYPE_CODE (formal_target) == TYPE_CODE_ARRAY
+- && ada_is_array_descriptor (actual_target))
+- return desc_data (actual);
++ && ada_is_array_descriptor_type (actual_target))
++ return desc_data (actual);
+ else if (TYPE_CODE (actual_type) != TYPE_CODE_PTR)
+- {
+- if (VALUE_LVAL (actual) != lval_memory)
+- {
+- struct value *val;
+- actual_type = check_typedef (VALUE_TYPE (actual));
+- val = allocate_value (actual_type);
+- memcpy ((char *) VALUE_CONTENTS_RAW (val),
+- (char *) VALUE_CONTENTS (actual),
+- TYPE_LENGTH (actual_type));
+- actual = place_on_stack (val, sp);
+- }
+- return value_addr (actual);
+- }
++ {
++ if (VALUE_LVAL (actual) != lval_memory)
++ {
++ struct value *val;
++ actual_type = check_typedef (VALUE_TYPE (actual));
++ val = allocate_value (actual_type);
++ memcpy ((char *) VALUE_CONTENTS_RAW (val),
++ (char *) VALUE_CONTENTS (actual),
++ TYPE_LENGTH (actual_type));
++ actual = ensure_lval (val, sp);
++ }
++ return value_addr (actual);
++ }
+ }
+ else if (TYPE_CODE (actual_type) == TYPE_CODE_PTR)
+ return ada_value_ind (actual);
+@@ -3088,11 +3524,11 @@
+ }
+
+
+-/* Push a descriptor of type TYPE for array value ARR on the stack at
+- *SP, updating *SP to reflect the new descriptor. Return either
++/* Push a descriptor of type TYPE for array value ARR on the stack at
++ *SP, updating *SP to reflect the new descriptor. Return either
+ an lvalue representing the new descriptor, or (if TYPE is a pointer-
+- to-descriptor type rather than a descriptor type), a struct value*
+- representing a pointer to this descriptor. */
++ to-descriptor type rather than a descriptor type), a struct value *
++ representing a pointer to this descriptor. */
+
+ static struct value *
+ make_array_descriptor (struct type *type, struct value *arr, CORE_ADDR *sp)
+@@ -3101,33 +3537,33 @@
+ struct type *desc_type = desc_base_type (type);
+ struct value *descriptor = allocate_value (desc_type);
+ struct value *bounds = allocate_value (bounds_type);
+- CORE_ADDR bounds_addr;
+ int i;
+
+ for (i = ada_array_arity (check_typedef (VALUE_TYPE (arr))); i > 0; i -= 1)
+ {
+ modify_general_field (VALUE_CONTENTS (bounds),
+- value_as_long (ada_array_bound (arr, i, 0)),
+- desc_bound_bitpos (bounds_type, i, 0),
+- desc_bound_bitsize (bounds_type, i, 0));
++ value_as_long (ada_array_bound (arr, i, 0)),
++ desc_bound_bitpos (bounds_type, i, 0),
++ desc_bound_bitsize (bounds_type, i, 0));
+ modify_general_field (VALUE_CONTENTS (bounds),
+- value_as_long (ada_array_bound (arr, i, 1)),
+- desc_bound_bitpos (bounds_type, i, 1),
+- desc_bound_bitsize (bounds_type, i, 1));
++ value_as_long (ada_array_bound (arr, i, 1)),
++ desc_bound_bitpos (bounds_type, i, 1),
++ desc_bound_bitsize (bounds_type, i, 1));
+ }
+
+- bounds = place_on_stack (bounds, sp);
++ bounds = ensure_lval (bounds, sp);
+
+ modify_general_field (VALUE_CONTENTS (descriptor),
+- arr,
++ VALUE_ADDRESS (ensure_lval (arr, sp)),
+ fat_pntr_data_bitpos (desc_type),
+ fat_pntr_data_bitsize (desc_type));
++
+ modify_general_field (VALUE_CONTENTS (descriptor),
+- VALUE_ADDRESS (bounds),
+- fat_pntr_bounds_bitpos (desc_type),
+- fat_pntr_bounds_bitsize (desc_type));
++ VALUE_ADDRESS (bounds),
++ fat_pntr_bounds_bitpos (desc_type),
++ fat_pntr_bounds_bitsize (desc_type));
+
+- descriptor = place_on_stack (descriptor, sp);
++ descriptor = ensure_lval (descriptor, sp);
+
+ if (TYPE_CODE (type) == TYPE_CODE_PTR)
+ return value_addr (descriptor);
+@@ -3136,17 +3572,17 @@
+ }
+
+
+-/* Assuming a dummy frame has been established on the target, perform any
++/* Assuming a dummy frame has been established on the target, perform any
+ conversions needed for calling function FUNC on the NARGS actual
+- parameters in ARGS, other than standard C conversions. Does
++ parameters in ARGS, other than standard C conversions. Does
+ nothing if FUNC does not have Ada-style prototype data, or if NARGS
+- does not match the number of arguments expected. Use *SP as a
++ does not match the number of arguments expected. Use *SP as a
+ stack pointer for additional data that must be pushed, updating its
+- value as needed. */
++ value as needed. */
+
+ void
+ ada_convert_actuals (struct value *func, int nargs, struct value *args[],
+- CORE_ADDR *sp)
++ CORE_ADDR *sp)
+ {
+ int i;
+
+@@ -3159,52 +3595,137 @@
+ convert_actual (args[i], TYPE_FIELD_TYPE (VALUE_TYPE (func), i), sp);
+ }
+ \f
++ /* Experimental Symbol Cache Module */
+
+- /* Symbol Lookup */
++/* 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. */
+
++#define HASH_SIZE 1009
+
+-/* The vectors of symbols and blocks ultimately returned from */
+-/* ada_lookup_symbol_list. */
++struct cache_entry {
++ const char *name;
++ domain_enum namespace;
++ struct symbol *sym;
++ struct symtab *symtab;
++ struct block *block;
++ struct cache_entry *next;
++};
++
++static struct obstack cache_space;
++
++static struct cache_entry *cache[HASH_SIZE];
++
++/* Clear all entries from the symbol cache. */
++
++void
++clear_ada_sym_cache (void)
++{
++ obstack_free (&cache_space, NULL);
++ obstack_init (&cache_space);
++ memset (cache, '\000', sizeof (cache));
++}
++
++static struct cache_entry **
++find_entry (const char *name, domain_enum namespace)
++{
++ int h = msymbol_hash (name) % HASH_SIZE;
++ struct cache_entry **e;
++ for (e = &cache[h]; *e != NULL; e = &(*e)->next)
++ {
++ if (namespace == (*e)->namespace && strcmp (name, (*e)->name) == 0)
++ return e;
++ }
++ return NULL;
++}
++
++/* Return (in SYM) the last cached definition for global or static symbol NAME
++ in namespace DOMAIN. Returns 1 if entry found, 0 otherwise.
++ If SYMTAB is non-NULL, store the symbol
++ table in which the symbol was found there, or NULL if not found.
++ *BLOCK is set to the block in which NAME is found. */
+
+-/* Current size of defn_symbols and defn_blocks */
+-static size_t defn_vector_size = 0;
++static int
++lookup_cached_symbol (const char *name, domain_enum namespace,
++ struct symbol **sym, struct block **block,
++ struct symtab **symtab)
++{
++ struct cache_entry **e = find_entry (name, namespace);
++ if (e == NULL)
++ return 0;
++ if (sym != NULL)
++ *sym = (*e)->sym;
++ if (block != NULL)
++ *block = (*e)->block;
++ if (symtab != NULL)
++ *symtab = (*e)->symtab;
++ return 1;
++}
+
+-/* Current number of symbols found. */
+-static int ndefns = 0;
++/* Set the cached definition of NAME in DOMAIN to SYM in block
++ BLOCK and symbol table SYMTAB. */
+
+-static struct symbol **defn_symbols = NULL;
+-static struct block **defn_blocks = NULL;
++static void
++cache_symbol (const char *name, domain_enum namespace, struct symbol *sym,
++ struct block *block, struct symtab *symtab)
++{
++ int h = msymbol_hash (name) % HASH_SIZE;
++ char *copy;
++ struct cache_entry *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);
++ strcpy (copy, name);
++ e->sym = sym;
++ e->namespace = namespace;
++ e->symtab = symtab;
++ e->block = block;
++}
++\f
++ /* Symbol Lookup */
+
+-/* Return the result of a standard (literal, C-like) lookup of NAME in
+- * given DOMAIN. */
++/* Return the result of a standard (literal, C-like) lookup of NAME in
++ given DOMAIN, visible from lexical block BLOCK. */
+
+ static struct symbol *
+-standard_lookup (const char *name, domain_enum domain)
++standard_lookup (const char *name, const struct block *block,
++ domain_enum domain)
+ {
+ struct symbol *sym;
+- sym = lookup_symbol (name, (struct block *) NULL, domain, 0, NULL);
++ struct symtab *symtab;
++
++ if (lookup_cached_symbol (name, domain, &sym, NULL, NULL))
++ return sym;
++ sym = lookup_symbol_in_language (name, block, domain, language_c, 0, &symtab);
++ cache_symbol (name, domain, sym, block_found, symtab);
+ return sym;
+ }
+
+
+-/* Non-zero iff there is at least one non-function/non-enumeral symbol */
+-/* in SYMS[0..N-1]. We treat enumerals as functions, since they */
+-/* contend in overloading in the same way. */
++/* Non-zero iff there is at least one non-function/non-enumeral symbol
++ in the symbol fields of SYMS[0..N-1]. We treat enumerals as functions,
++ since they contend in overloading in the same way. */
+ static int
+-is_nonfunction (struct symbol *syms[], int n)
++is_nonfunction (struct ada_symbol_info syms[], int n)
+ {
+ int i;
+
+ for (i = 0; i < n; i += 1)
+- if (TYPE_CODE (SYMBOL_TYPE (syms[i])) != TYPE_CODE_FUNC
+- && TYPE_CODE (SYMBOL_TYPE (syms[i])) != TYPE_CODE_ENUM)
++ if (TYPE_CODE (SYMBOL_TYPE (syms[i].sym)) != TYPE_CODE_FUNC
++ && (TYPE_CODE (SYMBOL_TYPE (syms[i].sym)) != TYPE_CODE_ENUM
++ || SYMBOL_CLASS (syms[i].sym) != LOC_CONST))
+ return 1;
+
+ return 0;
+ }
+
+ /* If true (non-zero), then TYPE0 and TYPE1 represent equivalent
+- struct types. Otherwise, they may not. */
++ struct types. Otherwise, they may not. */
+
+ static int
+ equiv_types (struct type *type0, struct type *type1)
+@@ -3217,14 +3738,14 @@
+ if ((TYPE_CODE (type0) == TYPE_CODE_STRUCT
+ || TYPE_CODE (type0) == TYPE_CODE_ENUM)
+ && ada_type_name (type0) != NULL && ada_type_name (type1) != NULL
+- && DEPRECATED_STREQ (ada_type_name (type0), ada_type_name (type1)))
++ && strcmp (ada_type_name (type0), ada_type_name (type1)) == 0)
+ return 1;
+
+ return 0;
+ }
+
+ /* True iff SYM0 represents the same entity as SYM1, or one that is
+- no more defined than that of SYM1. */
++ no more defined than that of SYM1. */
+
+ static int
+ lesseq_defined_than (struct symbol *sym0, struct symbol *sym1)
+@@ -3241,65 +3762,379 @@
+ return 1;
+ case LOC_TYPEDEF:
+ {
+- struct type *type0 = SYMBOL_TYPE (sym0);
+- struct type *type1 = SYMBOL_TYPE (sym1);
+- char *name0 = DEPRECATED_SYMBOL_NAME (sym0);
+- char *name1 = DEPRECATED_SYMBOL_NAME (sym1);
+- int len0 = strlen (name0);
+- return
+- TYPE_CODE (type0) == TYPE_CODE (type1)
+- && (equiv_types (type0, type1)
+- || (len0 < strlen (name1) && DEPRECATED_STREQN (name0, name1, len0)
+- && DEPRECATED_STREQN (name1 + len0, "___XV", 5)));
++ struct type *type0 = SYMBOL_TYPE (sym0);
++ struct type *type1 = SYMBOL_TYPE (sym1);
++ char *name0 = SYMBOL_LINKAGE_NAME (sym0);
++ char *name1 = SYMBOL_LINKAGE_NAME (sym1);
++ int len0 = strlen (name0);
++ return
++ TYPE_CODE (type0) == TYPE_CODE (type1)
++ && (equiv_types (type0, type1)
++ || (len0 < strlen (name1) && strncmp (name0, name1, len0) == 0
++ && strncmp (name1 + len0, "___XV", 5) == 0));
+ }
+ case LOC_CONST:
+ return SYMBOL_VALUE (sym0) == SYMBOL_VALUE (sym1)
+- && equiv_types (SYMBOL_TYPE (sym0), SYMBOL_TYPE (sym1));
++ && equiv_types (SYMBOL_TYPE (sym0), SYMBOL_TYPE (sym1));
+ default:
+ return 0;
+ }
+ }
+
+-/* Append SYM to the end of defn_symbols, and BLOCK to the end of
+- defn_blocks, updating ndefns, and expanding defn_symbols and
+- defn_blocks as needed. Do not include SYM if it is a duplicate. */
++/* Append (SYM,BLOCK,SYMTAB) to the end of the array of struct ada_symbol_info
++ records in OBSTACKP. Do nothing if SYM is a duplicate. */
+
+ static void
+-add_defn_to_vec (struct symbol *sym, struct block *block)
++add_defn_to_vec (struct obstack *obstackp,
++ struct symbol *sym,
++ struct block *block,
++ struct symtab *symtab)
+ {
+ int i;
+ size_t tmp;
++ struct ada_symbol_info *prevDefns = defns_collected (obstackp, 0);
+
+ if (SYMBOL_TYPE (sym) != NULL)
+ CHECK_TYPEDEF (SYMBOL_TYPE (sym));
+- for (i = 0; i < ndefns; i += 1)
++ for (i = num_defns_collected (obstackp) - 1; i >= 0; i -= 1)
+ {
+- if (lesseq_defined_than (sym, defn_symbols[i]))
+- return;
+- else if (lesseq_defined_than (defn_symbols[i], sym))
+- {
+- defn_symbols[i] = sym;
+- defn_blocks[i] = block;
+- return;
++ if (lesseq_defined_than (sym, prevDefns[i].sym))
++ return;
++ else if (lesseq_defined_than (prevDefns[i].sym, sym))
++ {
++ prevDefns[i].sym = sym;
++ prevDefns[i].block = block;
++ prevDefns[i].symtab = symtab;
++ return;
+ }
+ }
+
+- tmp = defn_vector_size;
+- GROW_VECT (defn_symbols, tmp, ndefns + 2);
+- GROW_VECT (defn_blocks, defn_vector_size, ndefns + 2);
+-
+- defn_symbols[ndefns] = sym;
+- defn_blocks[ndefns] = block;
+- ndefns += 1;
+-}
++ {
++ struct ada_symbol_info info;
+
+-/* Look, in partial_symtab PST, for symbol NAME in given domain.
+- Check the global symbols if GLOBAL, the static symbols if not. Do
+- wild-card match if WILD. */
++ info.sym = sym;
++ info.block = block;
++ info.symtab = symtab;
++ obstack_grow (obstackp, &info, sizeof (struct ada_symbol_info));
++ }
++}
++
++/* Number of ada_symbol_info structures currently collected in
++ current vector in *OBSTACKP. */
++
++static int
++num_defns_collected (struct obstack *obstackp)
++{
++ return obstack_object_size (obstackp) / sizeof (struct ada_symbol_info);
++}
++
++/* Vector of ada_symbol_info structures currently collected in current
++ vector in *OBSTACKP. If FINISH, close off the vector and return
++ its final address. */
++
++static struct ada_symbol_info *
++defns_collected (struct obstack *obstackp, int finish)
++{
++ if (finish)
++ return obstack_finish (obstackp);
++ else
++ return (struct ada_symbol_info *) obstack_base (obstackp);
++}
++
++/* If SYM_NAME is a completion candidate for TEXT, return this symbol
++ name in a form that's appropriate for the completion. The result
++ does not need to be deallocated, but is only good until the next call.
++
++ TEXT_LEN is equal to the length of TEXT.
++ Perform a wild match if WILD_MATCH is set.
++ ENCODED should be set if TEXT represents the start of a symbol name
++ in its encoded form. */
++
++static const char *
++symbol_completion_match (const char *sym_name,
++ const char *text, int text_len,
++ int wild_match, int encoded)
++{
++ char *result;
++ const int verbatim_match = (text[0] == '<');
++ int match = 0;
++
++ if (verbatim_match)
++ {
++ /* Strip the leading angle bracket. */
++ text = text + 1;
++ text_len--;
++ }
++
++ /* First, test against the fully qualified name of the symbol. */
++
++ if (strncmp (sym_name, text, text_len) == 0)
++ match = 1;
++
++ if (match && !encoded)
++ {
++ /* One needed check before declaring a positive match is to verify
++ that iff we are doing a verbatim match, the decoded version
++ of the symbol name starts with '<'. Otherwise, this symbol name
++ is not a suitable completion. */
++ const char *sym_name_copy = sym_name;
++ int has_angle_bracket;
++
++ sym_name = ada_decode (sym_name);
++ has_angle_bracket = (sym_name [0] == '<');
++ match = (has_angle_bracket == verbatim_match);
++ sym_name = sym_name_copy;
++ }
++
++ if (match && !verbatim_match)
++ {
++ /* When doing non-verbatim match, another check that needs to
++ be done is to verify that the potentially matching symbol name
++ does not include capital letters, because the ada-mode would
++ not be able to understand these symbol names without the
++ angle bracket notation. */
++ const char *tmp;
++
++ for (tmp = sym_name; *tmp != '\0' && !isupper (*tmp); tmp++);
++ if (*tmp != '\0')
++ match = 0;
++ }
++
++ /* Second: Try wild matching... */
++
++ if (!match && wild_match)
++ {
++ /* Since we are doing wild matching, this means that TEXT
++ may represent an unqualified symbol name. We therefore must
++ also compare TEXT against the unqualified name of the symbol. */
++ sym_name = ada_unqualified_name (ada_decode (sym_name));
++
++ if (strncmp (sym_name, text, text_len) == 0)
++ match = 1;
++ }
++
++ /* Finally: If we found a mach, prepare the result to return. */
++
++ if (!match)
++ return NULL;
++
++ if (verbatim_match)
++ sym_name = add_angle_brackets (sym_name);
++
++ if (!encoded)
++ sym_name = ada_decode (sym_name);
++
++ return sym_name;
++}
++
++/* A companion function to ada_make_symbol_completion_list().
++ Check if SYM_NAME represents a symbol which name would be suitable
++ to complete TEXT (TEXT_LEN is the length of TEXT), in which case
++ it is appended at the end of the given string vector SV.
++
++ ORIG_TEXT is the string original string from the user command
++ that needs to be completed. WORD is the entire command on which
++ completion should be performed. These two parameters are used to
++ determine which part of the symbol name should be added to the
++ completion vector.
++ if WILD_MATCH is set, then wild matching is performed.
++ ENCODED should be set if TEXT represents a symbol name in its
++ encoded formed (in which case the completion should also be
++ encoded). */
++
++static void
++symbol_completion_add (struct string_vector *sv,
++ const char *sym_name,
++ const char *text, int text_len,
++ const char *orig_text, const char *word,
++ int wild_match, int encoded)
++{
++ const char *match = symbol_completion_match (sym_name, text, text_len,
++ wild_match, encoded);
++ char *completion;
++
++ if (match == NULL)
++ return;
++
++ /* We found a match, so add the appropriate completion to the given
++ string vector. */
++
++ if (word == orig_text)
++ {
++ completion = xmalloc (strlen (match) + 5);
++ strcpy (completion, match);
++ }
++ else if (word > orig_text)
++ {
++ /* Return some portion of sym_name. */
++ completion = xmalloc (strlen (match) + 5);
++ strcpy (completion, match + (word - orig_text));
++ }
++ else
++ {
++ /* Return some of ORIG_TEXT plus sym_name. */
++ completion = xmalloc (strlen (match) + (orig_text - word) + 5);
++ strncpy (completion, word, orig_text - word);
++ completion[orig_text - word] = '\0';
++ strcat (completion, match);
++ }
++
++ string_vector_append (sv, completion);
++}
++
++/* Return a list of possible symbol names completing TEXT0. The list
++ is NULL terminated. WORD is the entire command on which completion
++ is made. */
++
++char **
++ada_make_symbol_completion_list (const char *text0, const char *word)
++{
++ /* Note: This function is almost a copy of make_symbol_completion_list(),
++ except it has been adapted for Ada. It is somewhat of a shame to
++ duplicate so much code, but we don't really have the infrastructure
++ yet to develop a language-aware version of he symbol completer... */
++ char *text;
++ int text_len;
++ int wild_match;
++ int encoded;
++ struct string_vector result = xnew_string_vector (128);
++ struct symbol *sym;
++ struct symtab *s;
++ struct partial_symtab *ps;
++ struct minimal_symbol *msymbol;
++ struct objfile *objfile;
++ struct block *b, *surrounding_static_block = 0;
++ int i;
++ struct dict_iterator iter;
++
++ if (text0[0] == '<')
++ {
++ text = xstrdup (text0);
++ make_cleanup (xfree, text);
++ text_len = strlen (text);
++ wild_match = 0;
++ encoded = 1;
++ }
++ else
++ {
++ text = xstrdup (ada_encode (text0));
++ make_cleanup (xfree, text);
++ text_len = strlen (text);
++ for (i = 0; i < text_len; i++)
++ text[i] = tolower (text[i]);
++
++ /* FIXME: brobecker/2003-09-17: When we get rid of ADA_RETAIN_DOTS,
++ we can restrict the wild_match check to searching "__" only. */
++ wild_match = (strstr (text0, "__") == NULL
++ && strchr (text0, '.') == NULL);
++ encoded = (strstr (text0, "__") != NULL);
++ }
++
++ /* First, look at the partial symtab symbols. */
++ ALL_PSYMTABS (objfile, ps)
++ {
++ struct partial_symbol **psym;
++
++ /* If the psymtab's been read in we'll get it when we search
++ through the blockvector. */
++ if (ps->readin)
++ continue;
++
++ for (psym = objfile->global_psymbols.list + ps->globals_offset;
++ psym < (objfile->global_psymbols.list + ps->globals_offset
++ + ps->n_global_syms);
++ psym++)
++ {
++ QUIT;
++ symbol_completion_add (&result, SYMBOL_LINKAGE_NAME (*psym),
++ text, text_len, text0, word,
++ wild_match, encoded);
++ }
++
++ for (psym = objfile->static_psymbols.list + ps->statics_offset;
++ psym < (objfile->static_psymbols.list + ps->statics_offset
++ + ps->n_static_syms);
++ psym++)
++ {
++ QUIT;
++ symbol_completion_add (&result, SYMBOL_LINKAGE_NAME (*psym),
++ text, text_len, text0, word,
++ wild_match, encoded);
++ }
++ }
++
++ /* 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). */
++
++ ALL_MSYMBOLS (objfile, msymbol)
++ {
++ QUIT;
++ symbol_completion_add (&result, SYMBOL_LINKAGE_NAME (msymbol),
++ text, text_len, text0, word,
++ wild_match, encoded);
++ }
++
++ /* 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)
++ {
++ symbol_completion_add (&result, SYMBOL_LINKAGE_NAME (sym),
++ text, text_len, text0, word,
++ wild_match, encoded);
++ }
++ }
++
++ /* Go through the symtabs and check the externs and statics for
++ symbols which match. */
++
++ ALL_SYMTABS (objfile, s)
++ {
++ QUIT;
++ b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), GLOBAL_BLOCK);
++ ALL_BLOCK_SYMBOLS (b, iter, sym)
++ {
++ symbol_completion_add (&result, SYMBOL_LINKAGE_NAME (sym),
++ text, text_len, text0, word,
++ wild_match, encoded);
++ }
++ }
++
++ ALL_SYMTABS (objfile, s)
++ {
++ QUIT;
++ b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), STATIC_BLOCK);
++ /* Don't do this block twice. */
++ if (b == surrounding_static_block)
++ continue;
++ ALL_BLOCK_SYMBOLS (b, iter, sym)
++ {
++ symbol_completion_add (&result, SYMBOL_LINKAGE_NAME (sym),
++ text, text_len, text0, word,
++ wild_match, encoded);
++ }
++ }
++
++ /* Append the closing NULL entry. */
++ string_vector_append (&result, NULL);
++
++ return (result.array);
++}
++
++/* Look, in partial_symtab PST, for symbol NAME in given namespace.
++ Check the global symbols if GLOBAL, the static symbols if not.
++ Do wild-card match if WILD. */
+
+ static struct partial_symbol *
+ ada_lookup_partial_symbol (struct partial_symtab *pst, const char *name,
+- int global, domain_enum domain, int wild)
++ int global, domain_enum namespace, int wild)
+ {
+ struct partial_symbol **start;
+ int name_len = strlen (name);
+@@ -3312,121 +4147,123 @@
+ }
+
+ start = (global ?
+- pst->objfile->global_psymbols.list + pst->globals_offset :
+- pst->objfile->static_psymbols.list + pst->statics_offset);
++ pst->objfile->global_psymbols.list + pst->globals_offset :
++ pst->objfile->static_psymbols.list + pst->statics_offset);
+
+ if (wild)
+ {
+ for (i = 0; i < length; i += 1)
+- {
+- struct partial_symbol *psym = start[i];
++ {
++ struct partial_symbol *psym = start[i];
+
+- if (SYMBOL_DOMAIN (psym) == domain &&
+- wild_match (name, name_len, DEPRECATED_SYMBOL_NAME (psym)))
+- return psym;
+- }
++ if (SYMBOL_DOMAIN (psym) == namespace &&
++ wild_match (name, name_len, SYMBOL_LINKAGE_NAME (psym)))
++ return psym;
++ }
+ return NULL;
+ }
+ else
+ {
+ if (global)
+- {
+- int U;
+- i = 0;
+- U = length - 1;
+- while (U - i > 4)
+- {
+- int M = (U + i) >> 1;
+- struct partial_symbol *psym = start[M];
+- if (DEPRECATED_SYMBOL_NAME (psym)[0] < name[0])
+- i = M + 1;
+- else if (DEPRECATED_SYMBOL_NAME (psym)[0] > name[0])
+- U = M - 1;
+- else if (strcmp (DEPRECATED_SYMBOL_NAME (psym), name) < 0)
+- i = M + 1;
+- else
+- U = M;
+- }
+- }
++ {
++ int U;
++ i = 0;
++ U = length - 1;
++ while (U - i > 4)
++ {
++ int M = (U + i) >> 1;
++ struct partial_symbol *psym = start[M];
++ if (SYMBOL_LINKAGE_NAME (psym)[0] < name[0])
++ i = M + 1;
++ else if (SYMBOL_LINKAGE_NAME (psym)[0] > name[0])
++ U = M - 1;
++ else if (strcmp (SYMBOL_LINKAGE_NAME (psym), name) < 0)
++ i = M + 1;
++ else
++ U = M;
++ }
++ }
+ else
+- i = 0;
++ i = 0;
+
+ while (i < length)
+- {
+- struct partial_symbol *psym = start[i];
+-
+- if (SYMBOL_DOMAIN (psym) == domain)
+- {
+- int cmp = strncmp (name, DEPRECATED_SYMBOL_NAME (psym), name_len);
++ {
++ struct partial_symbol *psym = start[i];
+
+- if (cmp < 0)
+- {
+- if (global)
+- break;
+- }
+- else if (cmp == 0
+- && is_name_suffix (DEPRECATED_SYMBOL_NAME (psym) + name_len))
+- return psym;
+- }
+- i += 1;
+- }
++ if (SYMBOL_DOMAIN (psym) == namespace)
++ {
++ int cmp = strncmp (name, SYMBOL_LINKAGE_NAME (psym), name_len);
++
++ if (cmp < 0)
++ {
++ if (global)
++ break;
++ }
++ else if (cmp == 0
++ && is_name_suffix (SYMBOL_LINKAGE_NAME (psym)
++ + name_len))
++ return psym;
++ }
++ i += 1;
++ }
+
+ if (global)
+- {
+- int U;
+- i = 0;
+- U = length - 1;
+- while (U - i > 4)
+- {
+- int M = (U + i) >> 1;
+- struct partial_symbol *psym = start[M];
+- if (DEPRECATED_SYMBOL_NAME (psym)[0] < '_')
+- i = M + 1;
+- else if (DEPRECATED_SYMBOL_NAME (psym)[0] > '_')
+- U = M - 1;
+- else if (strcmp (DEPRECATED_SYMBOL_NAME (psym), "_ada_") < 0)
+- i = M + 1;
+- else
+- U = M;
+- }
+- }
++ {
++ int U;
++ i = 0;
++ U = length - 1;
++ while (U - i > 4)
++ {
++ int M = (U + i) >> 1;
++ struct partial_symbol *psym = start[M];
++ if (SYMBOL_LINKAGE_NAME (psym)[0] < '_')
++ i = M + 1;
++ else if (SYMBOL_LINKAGE_NAME (psym)[0] > '_')
++ U = M - 1;
++ else if (strcmp (SYMBOL_LINKAGE_NAME (psym), "_ada_") < 0)
++ i = M + 1;
++ else
++ U = M;
++ }
++ }
+ else
+- i = 0;
++ i = 0;
+
+ while (i < length)
+- {
+- struct partial_symbol *psym = start[i];
+-
+- if (SYMBOL_DOMAIN (psym) == domain)
+- {
+- int cmp;
+-
+- cmp = (int) '_' - (int) DEPRECATED_SYMBOL_NAME (psym)[0];
+- if (cmp == 0)
+- {
+- cmp = strncmp ("_ada_", DEPRECATED_SYMBOL_NAME (psym), 5);
+- if (cmp == 0)
+- cmp = strncmp (name, DEPRECATED_SYMBOL_NAME (psym) + 5, name_len);
+- }
+-
+- if (cmp < 0)
+- {
+- if (global)
+- break;
+- }
+- else if (cmp == 0
+- && is_name_suffix (DEPRECATED_SYMBOL_NAME (psym) + name_len + 5))
+- return psym;
+- }
+- i += 1;
+- }
++ {
++ struct partial_symbol *psym = start[i];
+
++ if (SYMBOL_DOMAIN (psym) == namespace)
++ {
++ int cmp;
++
++ cmp = (int) '_' - (int) SYMBOL_LINKAGE_NAME (psym)[0];
++ if (cmp == 0)
++ {
++ cmp = strncmp ("_ada_", SYMBOL_LINKAGE_NAME (psym), 5);
++ if (cmp == 0)
++ cmp = strncmp (name, SYMBOL_LINKAGE_NAME (psym) + 5,
++ name_len);
++ }
++
++ if (cmp < 0)
++ {
++ if (global)
++ break;
++ }
++ else if (cmp == 0
++ && is_name_suffix (SYMBOL_LINKAGE_NAME (psym)
++ + name_len + 5))
++ return psym;
++ }
++ i += 1;
++ }
+ }
+ return NULL;
+ }
+
+-
+ /* Find a symbol table containing symbol SYM or NULL if none. */
++
+ static struct symtab *
+ symtab_for_sym (struct symbol *sym)
+ {
+@@ -3454,9 +4291,9 @@
+ b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), STATIC_BLOCK);
+ ALL_BLOCK_SYMBOLS (b, iter, tmp_sym) if (sym == tmp_sym)
+ return s;
+- break;
++ break;
+ default:
+- break;
++ break;
+ }
+ switch (SYMBOL_CLASS (sym))
+ {
+@@ -3481,95 +4318,125 @@
+ }
+ break;
+ default:
+- break;
++ break;
+ }
+ }
+ return NULL;
+ }
+
+-/* Return a minimal symbol matching NAME according to Ada demangling
+- rules. Returns NULL if there is no such minimal symbol. */
++/* Return a minimal symbol matching NAME according to Ada decoding
++ rules. Returns NULL if there is no such minimal symbol. Names
++ prefixed with "standard__" are handled specially: "standard__" is
++ first stripped off, and only static and global symbols are searched. */
+
+ struct minimal_symbol *
+-ada_lookup_minimal_symbol (const char *name)
++ada_lookup_simple_minsym (const char *name)
+ {
+ struct objfile *objfile;
+ struct minimal_symbol *msymbol;
+- int wild_match = (strstr (name, "__") == NULL);
++ int wild_match;
++
++ if (strncmp (name, "standard__", sizeof ("standard__") - 1) == 0)
++ {
++ name += sizeof ("standard__") - 1;
++ wild_match = 0;
++ }
++ else
++ wild_match = (strstr (name, "__") == NULL);
+
+ ALL_MSYMBOLS (objfile, msymbol)
+ {
+- if (ada_match_name (DEPRECATED_SYMBOL_NAME (msymbol), name, wild_match)
+- && MSYMBOL_TYPE (msymbol) != mst_solib_trampoline)
++ if (ada_match_name (SYMBOL_LINKAGE_NAME (msymbol), name, wild_match)
++ && MSYMBOL_TYPE (msymbol) != mst_solib_trampoline)
+ return msymbol;
+ }
+
+ return NULL;
+ }
+
++/* Return up minimal symbol for NAME, folded and encoded according to
++ Ada conventions, or NULL if none. The last two arguments are ignored. */
++
++static struct minimal_symbol *
++ada_lookup_minimal_symbol (const char *name, const char *sfile,
++ struct objfile *objf)
++{
++ return ada_lookup_simple_minsym (ada_encode (name));
++}
++
+ /* For all subprograms that statically enclose the subprogram of the
+- * selected frame, add symbols matching identifier NAME in DOMAIN
+- * and their blocks to vectors *defn_symbols and *defn_blocks, as for
+- * ada_add_block_symbols (q.v.). If WILD, treat as NAME with a
+- * wildcard prefix. At the moment, this function uses a heuristic to
+- * find the frames of enclosing subprograms: it treats the
+- * pointer-sized value at location 0 from the local-variable base of a
+- * frame as a static link, and then searches up the call stack for a
+- * frame with that same local-variable base. */
++ selected frame, add symbols matching identifier NAME in DOMAIN
++ and their blocks to the list of data in OBSTACKP, as for
++ ada_add_block_symbols (q.v.). If WILD, treat as NAME with a
++ wildcard prefix. */
++
+ static void
+-add_symbols_from_enclosing_procs (const char *name, domain_enum domain,
+- int wild_match)
+-{
+-#ifdef i386
++add_symbols_from_enclosing_procs (struct obstack *obstackp,
++ const char *name, domain_enum namespace,
++ int wild_match)
++{
++#ifdef HAVE_ADD_SYMBOLS_FROM_ENCLOSING_PROCS
++ /* Use a heuristic to find the frames of enclosing subprograms: treat the
++ pointer-sized value at location 0 from the local-variable base of a
++ frame as a static link, and then search up the call stack for a
++ frame with that same local-variable base. */
+ static struct symbol static_link_sym;
+ static struct symbol *static_link;
++ struct value *target_link_val;
+
+ struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
+ struct frame_info *frame;
+- struct frame_info *target_frame;
++
++ if (! target_has_stack)
++ return;
+
+ if (static_link == NULL)
+ {
+ /* Initialize the local variable symbol that stands for the
+- * static link (when it exists). */
++ static link (when there is one). */
+ static_link = &static_link_sym;
+- DEPRECATED_SYMBOL_NAME (static_link) = "";
++ SYMBOL_LINKAGE_NAME (static_link) = "";
+ SYMBOL_LANGUAGE (static_link) = language_unknown;
+ SYMBOL_CLASS (static_link) = LOC_LOCAL;
+ SYMBOL_DOMAIN (static_link) = VAR_DOMAIN;
+ SYMBOL_TYPE (static_link) = lookup_pointer_type (builtin_type_void);
+ SYMBOL_VALUE (static_link) =
+- -(long) TYPE_LENGTH (SYMBOL_TYPE (static_link));
++ -(long) TYPE_LENGTH (SYMBOL_TYPE (static_link));
+ }
+
+- frame = deprecated_selected_frame;
+- while (frame != NULL && ndefns == 0)
++ frame = get_selected_frame ();
++ if (frame == NULL
++ || inside_main_func (get_frame_address_in_block (frame)))
++ return;
++
++ target_link_val = read_var_value (static_link, frame);
++ while (target_link_val != NULL
++ && num_defns_collected (obstackp) == 0
++ && frame_relative_level (frame) <= MAX_ENCLOSING_FRAME_LEVELS)
+ {
+- struct block *block;
+- struct value *target_link_val = read_var_value (static_link, frame);
+- CORE_ADDR target_link;
++ CORE_ADDR target_link = value_as_address (target_link_val);
+
+- if (target_link_val == NULL)
++ frame = get_prev_frame (frame);
++ if (frame == NULL)
+ break;
+- QUIT;
+
+- target_link = target_link_val;
+- do
++ if (get_frame_locals_address (frame) == target_link)
+ {
++ struct block *block;
++
+ QUIT;
+- frame = get_prev_frame (frame);
+- }
+- while (frame != NULL && DEPRECATED_FRAME_LOCALS_ADDRESS (frame) != target_link);
+-
+- if (frame == NULL)
+- break;
+
+- block = get_frame_block (frame, 0);
+- while (block != NULL && block_function (block) != NULL && ndefns == 0)
+- {
+- ada_add_block_symbols (block, name, domain, NULL, wild_match);
++ block = get_frame_block (frame, 0);
++ while (block != NULL && block_function (block) != NULL
++ && num_defns_collected (obstackp) == 0)
++ {
++ QUIT;
+
+- block = BLOCK_SUPERBLOCK (block);
++ ada_add_block_symbols (obstackp, block, name, namespace,
++ NULL, NULL, wild_match);
++
++ block = BLOCK_SUPERBLOCK (block);
++ }
+ }
+ }
+
+@@ -3578,54 +4445,52 @@
+ }
+
+ /* True if TYPE is definitely an artificial type supplied to a symbol
+- * for which no debugging information was given in the symbol file. */
++ for which no debugging information was given in the symbol file. */
++
+ static int
+ is_nondebugging_type (struct type *type)
+ {
+ char *name = ada_type_name (type);
+- return (name != NULL && DEPRECATED_STREQ (name, "<variable, no debug info>"));
++ return (name != NULL && strcmp (name, "<variable, no debug info>") == 0);
+ }
+
+-/* Remove any non-debugging symbols in SYMS[0 .. NSYMS-1] that definitely
+- * duplicate other symbols in the list. (The only case I know of where
+- * this happens is when object files containing stabs-in-ecoff are
+- * linked with files containing ordinary ecoff debugging symbols (or no
+- * debugging symbols)). Modifies SYMS to squeeze out deleted symbols,
+- * and applies the same modification to BLOCKS to maintain the
+- * correspondence between SYMS[i] and BLOCKS[i]. Returns the number
+- * of symbols in the modified list. */
++/* Remove any non-debugging symbols in SYMS[0 .. NSYMS-1] that definitely
++ duplicate other symbols in the list (The only case I know of where
++ this happens is when object files containing stabs-in-ecoff are
++ linked with files containing ordinary ecoff debugging symbols (or no
++ debugging symbols)). Modifies SYMS to squeeze out deleted entries.
++ Returns the number of items in the modified list. */
++
+ static int
+-remove_extra_symbols (struct symbol **syms, struct block **blocks, int nsyms)
++remove_extra_symbols (struct ada_symbol_info *syms, int nsyms)
+ {
+ int i, j;
+
+ i = 0;
+ while (i < nsyms)
+ {
+- if (DEPRECATED_SYMBOL_NAME (syms[i]) != NULL
+- && SYMBOL_CLASS (syms[i]) == LOC_STATIC
+- && is_nondebugging_type (SYMBOL_TYPE (syms[i])))
+- {
+- for (j = 0; j < nsyms; j += 1)
+- {
+- if (i != j
+- && DEPRECATED_SYMBOL_NAME (syms[j]) != NULL
+- && DEPRECATED_STREQ (DEPRECATED_SYMBOL_NAME (syms[i]), DEPRECATED_SYMBOL_NAME (syms[j]))
+- && SYMBOL_CLASS (syms[i]) == SYMBOL_CLASS (syms[j])
+- && SYMBOL_VALUE_ADDRESS (syms[i])
+- == SYMBOL_VALUE_ADDRESS (syms[j]))
+- {
+- int k;
+- for (k = i + 1; k < nsyms; k += 1)
+- {
+- syms[k - 1] = syms[k];
+- blocks[k - 1] = blocks[k];
+- }
+- nsyms -= 1;
+- goto NextSymbol;
+- }
+- }
+- }
++ if (SYMBOL_LINKAGE_NAME (syms[i].sym) != NULL
++ && SYMBOL_CLASS (syms[i].sym) == LOC_STATIC
++ && is_nondebugging_type (SYMBOL_TYPE (syms[i].sym)))
++ {
++ for (j = 0; j < nsyms; j += 1)
++ {
++ if (i != j
++ && SYMBOL_LINKAGE_NAME (syms[j].sym) != NULL
++ && strcmp (SYMBOL_LINKAGE_NAME (syms[i].sym),
++ SYMBOL_LINKAGE_NAME (syms[j].sym)) == 0
++ && SYMBOL_CLASS (syms[i].sym) == SYMBOL_CLASS (syms[j].sym)
++ && SYMBOL_VALUE_ADDRESS (syms[i].sym)
++ == SYMBOL_VALUE_ADDRESS (syms[j].sym))
++ {
++ int k;
++ for (k = i + 1; k < nsyms; k += 1)
++ syms[k - 1] = syms[k];
++ nsyms -= 1;
++ goto NextSymbol;
++ }
++ }
++ }
+ i += 1;
+ NextSymbol:
+ ;
+@@ -3633,63 +4498,264 @@
+ return nsyms;
+ }
+
+-/* Find symbols in DOMAIN matching NAME, in BLOCK0 and enclosing
+- scope and in global scopes, returning the number of matches. Sets
+- *SYMS to point to a vector of matching symbols, with *BLOCKS
+- pointing to the vector of corresponding blocks in which those
+- symbols reside. These two vectors are transient---good only to the
+- next call of ada_lookup_symbol_list. Any non-function/non-enumeral symbol
+- match within the nest of blocks whose innermost member is BLOCK0,
+- is the outermost match returned (no other matches in that or
+- enclosing blocks is returned). If there are any matches in or
+- surrounding BLOCK0, then these alone are returned. */
++/* Given a type that corresponds to a renaming entity, use the type name
++ to extract the scope (package name or function name, fully qualified,
++ and following the GNAT encoding convention) where this renaming has been
++ defined. The string returned needs to be deallocated after use. */
++
++static char *
++xget_renaming_scope (struct type *renaming_type)
++{
++ /* The renaming types adhere to the following convention:
++ <scope>__<rename>___<XR extension>.
++ So, to extract the scope, we search for the "___XR" extension,
++ and then backtrack until we find the first "__". */
++
++ const char *name = type_name_no_tag (renaming_type);
++ char *suffix = strstr (name, "___XR");
++ char *last;
++ int scope_len;
++ char *scope;
++
++ /* Now, backtrack a bit until we find the first "__". Start looking
++ at suffix - 3, as the <rename> part is at least one character long. */
++
++ for (last = suffix - 3; last > name; last--)
++ if (last[0] == '_' && last[1] == '_')
++ break;
++
++ /* Make a copy of scope and return it. */
++
++ scope_len = last - name;
++ scope = (char *) xmalloc ((scope_len + 1) * sizeof (char));
++
++ strncpy (scope, name, scope_len);
++ scope[scope_len] = '\0';
++
++ return scope;
++}
++
++/* Return nonzero if NAME corresponds to a package name. */
++
++static int
++is_package_name (const char *name)
++{
++ /* Here, We take advantage of the fact that no symbols are generated
++ for packages, while symbols are generated for each function.
++ So the condition for NAME represent a package becomes equivalent
++ to NAME not existing in our list of symbols. There is only one
++ small complication with library-level functions (see below). */
++
++ char *fun_name;
++
++ /* If it is a function that has not been defined at library level,
++ then we should be able to look it up in the symbols. */
++ if (standard_lookup (name, NULL, VAR_DOMAIN) != NULL)
++ return 0;
++
++ /* Library-level function names start with "_ada_". See if function
++ "_ada_" followed by NAME can be found. */
++
++ /* Do a quick check that NAME does not contain "__", since library-level
++ functions names can not contain "__" in them. */
++ if (strstr (name, "__") != NULL)
++ return 0;
++
++ fun_name = (char *) alloca (strlen (name) + 5 + 1);
++ xasprintf (&fun_name, "_ada_%s", name);
++
++ return (standard_lookup (fun_name, NULL, VAR_DOMAIN) == NULL);
++}
++
++/* Return nonzero if SYM corresponds to a renaming entity that is
++ visible from FUNCTION_NAME. */
++
++static int
++renaming_is_visible (const struct symbol *sym, char *function_name)
++{
++ char *scope = xget_renaming_scope (SYMBOL_TYPE (sym));
++
++ make_cleanup (xfree, scope);
++
++ /* If the rename has been defined in a package, then it is visible. */
++ if (is_package_name (scope))
++ return 1;
++
++ /* Check that the rename is in the current function scope by checking
++ that its name starts with SCOPE. */
++
++ /* If the function name starts with "_ada_", it means that it is
++ a library-level function. Strip this prefix before doing the
++ comparison, as the encoding for the renaming does not contain
++ this prefix. */
++ if (strncmp (function_name, "_ada_", 5) == 0)
++ function_name += 5;
++
++ return (strncmp (function_name, scope, strlen (scope)) == 0);
++}
++
++/* Iterates over the SYMS list and remove any entry that corresponds to
++ a renaming entity that is not visible from the function associated
++ with CURRENT_BLOCK.
++
++ Rationale:
++ GNAT emits a type following a specified encoding for each renaming
++ entity. Unfortunately, STABS currently does not support the definition
++ of types that are local to a given lexical block, so all renamings types
++ are emitted at library level. As a consequence, if an application
++ contains two renaming entities using the same name, and a user tries to
++ print the value of one of these entities, the result of the ada symbol
++ lookup will also contain the wrong renaming type.
++
++ This function partially covers for this limitation by attempting to
++ remove from the SYMS list renaming symbols that should be visible
++ from CURRENT_BLOCK. However, there does not seem be a 100% reliable
++ method with the current information available. The implementation
++ below has a couple of limitations (FIXME: brobecker-2003-05-12):
++
++ - When the user tries to print a rename in a function while there
++ is another rename entity defined in a package: Normally, the
++ rename in the function has precedence over the rename in the
++ package, so the latter should be removed from the list. This is
++ currently not the case.
++
++ - This function will incorrectly remove valid renames if
++ the CURRENT_BLOCK corresponds to a function which symbol name
++ has been changed by an "Export" pragma. As a consequence,
++ the user will be unable to print such rename entities. */
++
++static int
++remove_out_of_scope_renamings (struct ada_symbol_info *syms,
++ int nsyms,
++ struct block *current_block)
++{
++ struct symbol *current_function;
++ char *current_function_name;
++ int i;
++
++ /* Extract the function name associated to CURRENT_BLOCK.
++ Abort if unable to do so. */
++
++ if (current_block == NULL)
++ return nsyms;
++
++ current_function = block_function (current_block);
++ if (current_function == NULL)
++ return nsyms;
++
++ current_function_name = SYMBOL_LINKAGE_NAME (current_function);
++ if (current_function_name == NULL)
++ return nsyms;
++
++ /* Check each of the symbols, and remove it from the list if it is
++ a type corresponding to a renaming that is out of the scope of
++ the current block. */
++
++ i = 0;
++ while (i < nsyms)
++ {
++ if (ada_is_object_renaming (syms[i].sym)
++ && !renaming_is_visible (syms[i].sym, current_function_name))
++ {
++ int j;
++ for (j = i + 1; j < nsyms; j++)
++ syms[j - 1] = syms[j];
++ nsyms -= 1;
++ }
++ else
++ i += 1;
++ }
++
++ return nsyms;
++}
++
++/* Find symbols in DOMAIN matching NAME0, in BLOCK0 and enclosing
++ scope and in global scopes, returning the number of matches. Sets
++ *RESULTS to point to a vector of (SYM,BLOCK,SYMTAB) triples,
++ indicating the symbols found and the blocks and symbol tables (if
++ any) in which they were found. This vector are transient---good only to
++ the next call of ada_lookup_symbol_list. Any non-function/non-enumeral
++ symbol match within the nest of blocks whose innermost member is BLOCK0,
++ is the one match returned (no other matches in that or
++ enclosing blocks is returned). If there are any matches in or
++ surrounding BLOCK0, then these alone are returned. Otherwise, the
++ search extends to global and file-scope (static) symbol tables.
++ Names prefixed with "standard__" are handled specially: "standard__"
++ is first stripped off, and only static and global symbols are searched. */
+
+ int
+-ada_lookup_symbol_list (const char *name, struct block *block0,
+- domain_enum domain, struct symbol ***syms,
+- struct block ***blocks)
++ada_lookup_symbol_list (const char *name0, const struct block *block0,
++ domain_enum namespace,
++ struct ada_symbol_info **results)
+ {
+ struct symbol *sym;
+ struct symtab *s;
+ struct partial_symtab *ps;
+ struct blockvector *bv;
+ struct objfile *objfile;
+- struct block *b;
+ struct block *block;
++ const char *name;
+ struct minimal_symbol *msymbol;
+- int wild_match = (strstr (name, "__") == NULL);
++ int wild_match;
+ int cacheIfUnique;
++ int block_depth;
++ int ndefns;
+
+-#ifdef TIMING
+- markTimeStart (0);
+-#endif
++ obstack_free (&symbol_list_obstack, NULL);
++ obstack_init (&symbol_list_obstack);
+
+- ndefns = 0;
+ cacheIfUnique = 0;
+
+ /* Search specified block and its superiors. */
+
+- block = block0;
++ wild_match = (strstr (name0, "__") == NULL);
++ name = name0;
++ block = (struct block *) block0; /* FIXME: No cast ought to be
++ needed, but adding const will
++ have a cascade effect. */
++ if (strncmp (name0, "standard__", sizeof ("standard__") - 1) == 0)
++ {
++ wild_match = 0;
++ block = NULL;
++ name = name0 + sizeof ("standard__") - 1;
++ }
++
++ block_depth = 0;
+ while (block != NULL)
+ {
+- ada_add_block_symbols (block, name, domain, NULL, wild_match);
+-
+- /* If we found a non-function match, assume that's the one. */
+- if (is_nonfunction (defn_symbols, ndefns))
+- goto done;
++ block_depth += 1;
++ ada_add_block_symbols (&symbol_list_obstack, block, name,
++ namespace, NULL, NULL, wild_match);
++
++ /* If we found a non-function match, assume that's the one. */
++ if (is_nonfunction (defns_collected (&symbol_list_obstack, 0),
++ num_defns_collected (&symbol_list_obstack)))
++ goto done;
+
+ block = BLOCK_SUPERBLOCK (block);
+ }
+
+- /* If we found ANY matches in the specified BLOCK, we're done. */
++ /* If no luck so far, try to find NAME as a local symbol in some lexically
++ enclosing subprogram. */
++ if (num_defns_collected (&symbol_list_obstack) == 0 && block_depth > 2)
++ add_symbols_from_enclosing_procs (&symbol_list_obstack,
++ name, namespace, wild_match);
++
++ /* If we found ANY matches among non-global symbols, we're done. */
+
+- if (ndefns > 0)
++ if (num_defns_collected (&symbol_list_obstack) > 0)
+ goto done;
+
+ cacheIfUnique = 1;
++ if (lookup_cached_symbol (name0, namespace, &sym, &block, &s))
++ {
++ if (sym != NULL)
++ add_defn_to_vec (&symbol_list_obstack, sym, block, s);
++ goto done;
++ }
+
+ /* Now add symbols from all global blocks: symbol tables, minimal symbol
+- tables, and psymtab's */
++ tables, and psymtab's. */
+
+ ALL_SYMTABS (objfile, s)
+ {
+@@ -3698,41 +4764,43 @@
+ continue;
+ bv = BLOCKVECTOR (s);
+ block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
+- ada_add_block_symbols (block, name, domain, objfile, wild_match);
++ ada_add_block_symbols (&symbol_list_obstack, block, name, namespace,
++ objfile, s, wild_match);
+ }
+
+- if (domain == VAR_DOMAIN)
++ if (namespace == VAR_DOMAIN)
+ {
+ ALL_MSYMBOLS (objfile, msymbol)
+ {
+- if (ada_match_name (DEPRECATED_SYMBOL_NAME (msymbol), name, wild_match))
+- {
+- switch (MSYMBOL_TYPE (msymbol))
+- {
+- case mst_solib_trampoline:
+- break;
+- default:
+- s = find_pc_symtab (SYMBOL_VALUE_ADDRESS (msymbol));
+- if (s != NULL)
+- {
+- int old_ndefns = ndefns;
+- QUIT;
+- bv = BLOCKVECTOR (s);
+- block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
+- ada_add_block_symbols (block,
+- DEPRECATED_SYMBOL_NAME (msymbol),
+- domain, objfile, wild_match);
+- if (ndefns == old_ndefns)
+- {
+- block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
+- ada_add_block_symbols (block,
+- DEPRECATED_SYMBOL_NAME (msymbol),
+- domain, objfile,
+- wild_match);
+- }
+- }
+- }
+- }
++ if (ada_match_name (SYMBOL_LINKAGE_NAME (msymbol), name, wild_match))
++ {
++ switch (MSYMBOL_TYPE (msymbol))
++ {
++ case mst_solib_trampoline:
++ break;
++ default:
++ s = find_pc_symtab (SYMBOL_VALUE_ADDRESS (msymbol));
++ if (s != NULL)
++ {
++ int ndefns0 = num_defns_collected (&symbol_list_obstack);
++ QUIT;
++ bv = BLOCKVECTOR (s);
++ block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
++ ada_add_block_symbols (&symbol_list_obstack, block,
++ SYMBOL_LINKAGE_NAME (msymbol),
++ namespace, objfile, s, wild_match);
++
++ if (num_defns_collected (&symbol_list_obstack) == ndefns0)
++ {
++ block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
++ ada_add_block_symbols (&symbol_list_obstack, block,
++ SYMBOL_LINKAGE_NAME (msymbol),
++ namespace, objfile, s,
++ wild_match);
++ }
++ }
++ }
++ }
+ }
+ }
+
+@@ -3740,220 +4808,376 @@
+ {
+ QUIT;
+ if (!ps->readin
+- && ada_lookup_partial_symbol (ps, name, 1, domain, wild_match))
++ && ada_lookup_partial_symbol (ps, name, 1, namespace, wild_match))
+ {
+- s = PSYMTAB_TO_SYMTAB (ps);
+- if (!s->primary)
+- continue;
+- bv = BLOCKVECTOR (s);
+- block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
+- ada_add_block_symbols (block, name, domain, objfile, wild_match);
++ s = PSYMTAB_TO_SYMTAB (ps);
++ if (!s->primary)
++ continue;
++ bv = BLOCKVECTOR (s);
++ block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
++ ada_add_block_symbols (&symbol_list_obstack, block, name,
++ namespace, objfile, s, wild_match);
+ }
+ }
+
+- /* Now add symbols from all per-file blocks if we've gotten no hits.
++ /* Now add symbols from all per-file blocks if we've gotten no hits
+ (Not strictly correct, but perhaps better than an error).
+- Do the symtabs first, then check the psymtabs */
++ Do the symtabs first, then check the psymtabs. */
+
+- if (ndefns == 0)
++ if (num_defns_collected (&symbol_list_obstack) == 0)
+ {
+
+ ALL_SYMTABS (objfile, s)
+ {
+- QUIT;
+- if (!s->primary)
+- continue;
+- bv = BLOCKVECTOR (s);
+- block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
+- ada_add_block_symbols (block, name, domain, objfile, wild_match);
++ QUIT;
++ if (!s->primary)
++ continue;
++ bv = BLOCKVECTOR (s);
++ block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
++ ada_add_block_symbols (&symbol_list_obstack, block, name, namespace,
++ objfile, s, wild_match);
+ }
+
+ ALL_PSYMTABS (objfile, ps)
+ {
+- QUIT;
+- if (!ps->readin
+- && ada_lookup_partial_symbol (ps, name, 0, domain, wild_match))
+- {
+- s = PSYMTAB_TO_SYMTAB (ps);
+- bv = BLOCKVECTOR (s);
+- if (!s->primary)
+- continue;
+- block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
+- ada_add_block_symbols (block, name, domain,
+- objfile, wild_match);
+- }
++ QUIT;
++ if (!ps->readin
++ && ada_lookup_partial_symbol (ps, name, 0, namespace, wild_match))
++ {
++ s = PSYMTAB_TO_SYMTAB (ps);
++ bv = BLOCKVECTOR (s);
++ if (!s->primary)
++ continue;
++ block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
++ ada_add_block_symbols (&symbol_list_obstack, block, name,
++ namespace, objfile, s, wild_match);
++ }
+ }
+ }
+
+- /* Finally, we try to find NAME as a local symbol in some lexically
+- enclosing block. We do this last, expecting this case to be
+- rare. */
++done:
++ ndefns = num_defns_collected (&symbol_list_obstack);
++ *results = defns_collected (&symbol_list_obstack, 1);
++
++ ndefns = remove_extra_symbols (*results, ndefns);
++
+ if (ndefns == 0)
+- {
+- add_symbols_from_enclosing_procs (name, domain, wild_match);
+- if (ndefns > 0)
+- goto done;
+- }
++ cache_symbol (name0, namespace, NULL, NULL, NULL);
+
+-done:
+- ndefns = remove_extra_symbols (defn_symbols, defn_blocks, ndefns);
++ if (ndefns == 1 && cacheIfUnique)
++ cache_symbol (name0, namespace, (*results)[0].sym, (*results)[0].block,
++ (*results)[0].symtab);
+
++ ndefns = remove_out_of_scope_renamings (*results, ndefns,
++ (struct block *) block0);
+
+- *syms = defn_symbols;
+- *blocks = defn_blocks;
+-#ifdef TIMING
+- markTimeStop (0);
+-#endif
+ return ndefns;
+ }
+
+-/* Return a symbol in DOMAIN matching NAME, in BLOCK0 and enclosing
+- * scope and in global scopes, or NULL if none. NAME is folded to
+- * lower case first, unless it is surrounded in single quotes.
+- * Otherwise, the result is as for ada_lookup_symbol_list, but is
+- * disambiguated by user query if needed. */
++/* Return a symbol in DOMAIN matching NAME, in BLOCK0 and enclosing
++ scope and in global scopes, or NULL if none. NAME is folded and
++ encoded first. Otherwise, the result is as for ada_lookup_symbol_list,
++ but is disambiguated by user query if needed. *IS_A_FIELD_OF_THIS is
++ set to 0 and *SYMTAB is set to the symbol table in which the symbol
++ was found (in both cases, these assignments occur only if the
++ pointers are non-null). */
++
+
+ struct symbol *
+-ada_lookup_symbol (const char *name, struct block *block0,
+- domain_enum domain)
++ada_lookup_symbol (const char *name, const struct block *block0,
++ domain_enum namespace, int *is_a_field_of_this,
++ struct symtab **symtab)
+ {
+- struct symbol **candidate_syms;
+- struct block **candidate_blocks;
++ struct ada_symbol_info *candidates;
+ int n_candidates;
+
+- n_candidates = ada_lookup_symbol_list (name,
+- block0, domain,
+- &candidate_syms, &candidate_blocks);
++ n_candidates = ada_lookup_symbol_list (ada_encode (ada_fold_name (name)),
++ block0, namespace, &candidates);
+
+ if (n_candidates == 0)
+ return NULL;
+ else if (n_candidates != 1)
+- user_select_syms (candidate_syms, candidate_blocks, n_candidates, 1);
++ user_select_syms (candidates, n_candidates, 1);
++
++ if (is_a_field_of_this != NULL)
++ *is_a_field_of_this = 0;
+
+- return candidate_syms[0];
++ if (symtab != NULL)
++ {
++ *symtab = candidates[0].symtab;
++ if (*symtab == NULL && candidates[0].block != NULL)
++ {
++ struct objfile *objfile;
++ struct symtab *s;
++ struct block *b;
++ struct blockvector *bv;
++
++ /* Search the list of symtabs for one which contains the
++ address of the start of this block. */
++ ALL_SYMTABS (objfile, s)
++ {
++ bv = BLOCKVECTOR (s);
++ b = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
++ if (BLOCK_START (b) <= BLOCK_START (candidates[0].block)
++ && BLOCK_END (b) > BLOCK_START (candidates[0].block))
++ {
++ *symtab = s;
++ return fixup_symbol_section (candidates[0].sym, objfile);
++ }
++ return fixup_symbol_section (candidates[0].sym, NULL);
++ }
++ }
++ }
++ return candidates[0].sym;
+ }
+
++static struct symbol *
++ada_lookup_symbol_nonlocal (const char *name,
++ const char *linkage_name,
++ const struct block *block,
++ const domain_enum domain,
++ struct symtab **symtab)
++{
++ if (linkage_name == NULL)
++ linkage_name = name;
++ return ada_lookup_symbol (linkage_name, block_static_block (block), domain,
++ NULL, symtab);
++}
+
+-/* True iff STR is a possible encoded suffix of a normal Ada name
+- * that is to be ignored for matching purposes. Suffixes of parallel
+- * names (e.g., XVE) are not included here. Currently, the possible suffixes
+- * are given by the regular expression:
+- * (X[nb]*)?(__[0-9]+|\$[0-9]+|___(LJM|X([FDBUP].*|R[^T]?)))?$
+- *
++
++/* True iff STR is a possible encoded suffix of a normal Ada name
++ that is to be ignored for matching purposes. Suffixes of parallel
++ names (e.g., XVE) are not included here. Currently, the possible suffixes
++ are given by either of the regular expression:
++
++ (__[0-9]+)?\.[0-9]+ [nested subprogram suffix, on platforms such as Linux]
++ ___[0-9]+ [nested subprogram suffix, on platforms such as HP/UX]
++ (X[nb]*)?((\$|__)[0-9](_?[0-9]+)|___(LJM|X([FDBUP].*|R[^T]?)))?$
+ */
++
+ static int
+ is_name_suffix (const char *str)
+ {
+ int k;
++ const char *matching;
++ const int len = strlen (str);
++
++ /* (__[0-9]+)?\.[0-9]+ */
++ matching = str;
++ if (len > 3 && str[0] == '_' && str[1] == '_' && isdigit (str[2]))
++ {
++ matching += 3;
++ while (isdigit (matching[0]))
++ matching += 1;
++ if (matching[0] == '\0')
++ return 1;
++ }
++
++ if (matching[0] == '.')
++ {
++ matching += 1;
++ while (isdigit (matching[0]))
++ matching += 1;
++ if (matching[0] == '\0')
++ return 1;
++ }
++
++ /* ___[0-9]+ */
++ if (len > 3 && str[0] == '_' && str[1] == '_' && str[2] == '_')
++ {
++ matching = str + 3;
++ while (isdigit (matching[0]))
++ matching += 1;
++ if (matching[0] == '\0')
++ return 1;
++ }
++
++ /* ??? We should not modify STR directly, as we are doing below. This
++ is fine in this case, but may become problematic later if we find
++ that this alternative did not work, and want to try matching
++ another one from the begining of STR. Since we modified it, we
++ won't be able to find the begining of the string anymore! */
+ if (str[0] == 'X')
+ {
+ str += 1;
+ while (str[0] != '_' && str[0] != '\0')
+- {
+- if (str[0] != 'n' && str[0] != 'b')
+- return 0;
+- str += 1;
+- }
++ {
++ if (str[0] != 'n' && str[0] != 'b')
++ return 0;
++ str += 1;
++ }
+ }
+ if (str[0] == '\000')
+ return 1;
+ if (str[0] == '_')
+ {
+ if (str[1] != '_' || str[2] == '\000')
+- return 0;
++ return 0;
+ if (str[2] == '_')
+- {
+- if (DEPRECATED_STREQ (str + 3, "LJM"))
+- return 1;
+- if (str[3] != 'X')
+- return 0;
+- if (str[4] == 'F' || str[4] == 'D' || str[4] == 'B' ||
+- str[4] == 'U' || str[4] == 'P')
+- return 1;
+- if (str[4] == 'R' && str[5] != 'T')
+- return 1;
+- return 0;
+- }
+- for (k = 2; str[k] != '\0'; k += 1)
+- if (!isdigit (str[k]))
+- return 0;
++ {
++ if (strcmp (str + 3, "LJM") == 0)
++ return 1;
++ if (str[3] != 'X')
++ return 0;
++ if (str[4] == 'F' || str[4] == 'D' || str[4] == 'B' ||
++ str[4] == 'U' || str[4] == 'P')
++ return 1;
++ if (str[4] == 'R' && str[5] != 'T')
++ return 1;
++ return 0;
++ }
++ if (!isdigit (str[2]))
++ return 0;
++ for (k = 3; str[k] != '\0'; k += 1)
++ if (!isdigit (str[k]) && str[k] != '_')
++ return 0;
+ return 1;
+ }
+- if (str[0] == '$' && str[1] != '\000')
++ if (str[0] == '$' && isdigit (str[1]))
+ {
+- for (k = 1; str[k] != '\0'; k += 1)
+- if (!isdigit (str[k]))
+- return 0;
++ for (k = 2; str[k] != '\0'; k += 1)
++ if (!isdigit (str[k]) && str[k] != '_')
++ return 0;
+ return 1;
+ }
+ return 0;
+ }
+
+-/* True if NAME represents a name of the form A1.A2....An, n>=1 and
+- * PATN[0..PATN_LEN-1] = Ak.Ak+1.....An for some k >= 1. Ignores
+- * informational suffixes of NAME (i.e., for which is_name_suffix is
+- * true). */
++/* Return nonzero if the given string starts with a dot ('.')
++ followed by zero or more digits.
++
++ Note: brobecker/2003-11-10: A forward declaration has not been
++ added at the begining of this file yet, because this function
++ is only used to work around a problem found during wild matching
++ when trying to match minimal symbol names against symbol names
++ obtained from dwarf-2 data. This function is therefore currently
++ only used in wild_match() and is likely to be deleted when the
++ problem in dwarf-2 is fixed. */
++
++static int
++is_dot_digits_suffix (const char *str)
++{
++ if (str[0] != '.')
++ return 0;
++
++ str++;
++ while (isdigit (str[0]))
++ str++;
++ return (str[0] == '\0');
++}
++
++/* True if NAME represents a name of the form A1.A2....An, n>=1 and
++ PATN[0..PATN_LEN-1] = Ak.Ak+1.....An for some k >= 1. Ignores
++ informational suffixes of NAME (i.e., for which is_name_suffix is
++ true). */
++
+ static int
+-wild_match (const char *patn, int patn_len, const char *name)
++wild_match (const char *patn0, int patn_len, const char *name0)
+ {
+ int name_len;
+- int s, e;
++ char *name;
++ char *patn;
++
++ /* FIXME: brobecker/2003-11-10: For some reason, the symbol name
++ stored in the symbol table for nested function names is sometimes
++ different from the name of the associated entity stored in
++ the dwarf-2 data: This is the case for nested subprograms, where
++ the minimal symbol name contains a trailing ".[:digit:]+" suffix,
++ while the symbol name from the dwarf-2 data does not.
++
++ Although the DWARF-2 standard documents that entity names stored
++ in the dwarf-2 data should be identical to the name as seen in
++ the source code, GNAT takes a different approach as we already use
++ a special encoding mechanism to convey the information so that
++ a C debugger can still use the information generated to debug
++ Ada programs. A corollary is that the symbol names in the dwarf-2
++ data should match the names found in the symbol table. I therefore
++ consider this issue as a compiler defect.
++
++ Until the compiler is properly fixed, we work-around the problem
++ by ignoring such suffixes during the match. We do so by making
++ a copy of PATN0 and NAME0, and then by stripping such a suffix
++ if present. We then perform the match on the resulting strings. */
++ {
++ char *dot;
++ name_len = strlen (name0);
++
++ name = (char *) alloca ((name_len + 1) * sizeof (char));
++ strcpy (name, name0);
++ dot = strrchr (name, '.');
++ if (dot != NULL && is_dot_digits_suffix (dot))
++ *dot = '\0';
++
++ patn = (char *) alloca ((patn_len + 1) * sizeof (char));
++ strncpy (patn, patn0, patn_len);
++ patn[patn_len] = '\0';
++ dot = strrchr (patn, '.');
++ if (dot != NULL && is_dot_digits_suffix (dot))
++ {
++ *dot = '\0';
++ patn_len = dot - patn;
++ }
++ }
++
++ /* Now perform the wild match. */
+
+ name_len = strlen (name);
+- if (name_len >= patn_len + 5 && DEPRECATED_STREQN (name, "_ada_", 5)
+- && DEPRECATED_STREQN (patn, name + 5, patn_len)
++ if (name_len >= patn_len + 5 && strncmp (name, "_ada_", 5) == 0
++ && strncmp (patn, name + 5, patn_len) == 0
+ && is_name_suffix (name + patn_len + 5))
+ return 1;
+
+ while (name_len >= patn_len)
+ {
+- if (DEPRECATED_STREQN (patn, name, patn_len) && is_name_suffix (name + patn_len))
+- return 1;
++ if (strncmp (patn, name, patn_len) == 0
++ && is_name_suffix (name + patn_len))
++ return 1;
+ do
+- {
+- name += 1;
+- name_len -= 1;
+- }
++ {
++ name += 1;
++ name_len -= 1;
++ }
+ while (name_len > 0
+- && name[0] != '.' && (name[0] != '_' || name[1] != '_'));
++ && name[0] != '.' && (name[0] != '_' || name[1] != '_'));
+ if (name_len <= 0)
+- return 0;
++ return 0;
+ if (name[0] == '_')
+- {
+- if (!islower (name[2]))
+- return 0;
+- name += 2;
+- name_len -= 2;
+- }
+- else
+- {
+- if (!islower (name[1]))
+- return 0;
+- name += 1;
+- name_len -= 1;
+- }
++ {
++ if (!islower (name[2]))
++ return 0;
++ name += 2;
++ name_len -= 2;
++ }
++ else
++ {
++ if (!islower (name[1]))
++ return 0;
++ name += 1;
++ name_len -= 1;
++ }
+ }
+
+ return 0;
+ }
+
+
+-/* Add symbols from BLOCK matching identifier NAME in DOMAIN to
+- vector *defn_symbols, updating *defn_symbols (if necessary), *SZ (the size of
+- the vector *defn_symbols), and *ndefns (the number of symbols
+- currently stored in *defn_symbols). If WILD, treat as NAME with a
+- wildcard prefix. OBJFILE is the section containing BLOCK. */
++/* Add symbols from BLOCK matching identifier NAME in DOMAIN to
++ vector *defn_symbols, updating the list of symbols in OBSTACKP
++ (if necessary). If WILD, treat as NAME with a wildcard prefix.
++ OBJFILE is the section containing BLOCK.
++ SYMTAB is recorded with each symbol added. */
+
+ static void
+-ada_add_block_symbols (struct block *block, const char *name,
+- domain_enum domain, struct objfile *objfile,
+- int wild)
++ada_add_block_symbols (struct obstack *obstackp,
++ struct block *block, const char *name,
++ domain_enum domain, struct objfile *objfile,
++ struct symtab *symtab, int wild)
+ {
+ struct dict_iterator iter;
+ int name_len = strlen (name);
+- /* A matching argument symbol, if any. */
++ /* A matching argument symbol, if any. */
+ struct symbol *arg_sym;
+- /* Set true when we find a matching non-argument symbol */
++ /* Set true when we find a matching non-argument symbol. */
+ int found_sym;
+ struct symbol *sym;
+
+@@ -3963,72 +5187,73 @@
+ {
+ struct symbol *sym;
+ ALL_BLOCK_SYMBOLS (block, iter, sym)
+- {
+- if (SYMBOL_DOMAIN (sym) == domain &&
+- wild_match (name, name_len, DEPRECATED_SYMBOL_NAME (sym)))
+- {
+- switch (SYMBOL_CLASS (sym))
+- {
+- case LOC_ARG:
+- case LOC_LOCAL_ARG:
+- case LOC_REF_ARG:
+- case LOC_REGPARM:
+- case LOC_REGPARM_ADDR:
+- case LOC_BASEREG_ARG:
+- case LOC_COMPUTED_ARG:
+- arg_sym = sym;
+- break;
+- case LOC_UNRESOLVED:
+- continue;
+- default:
+- found_sym = 1;
+- fill_in_ada_prototype (sym);
+- add_defn_to_vec (fixup_symbol_section (sym, objfile), block);
+- break;
+- }
+- }
+- }
++ {
++ if (SYMBOL_DOMAIN (sym) == domain &&
++ wild_match (name, name_len, SYMBOL_LINKAGE_NAME (sym)))
++ {
++ switch (SYMBOL_CLASS (sym))
++ {
++ case LOC_ARG:
++ case LOC_LOCAL_ARG:
++ case LOC_REF_ARG:
++ case LOC_REGPARM:
++ case LOC_REGPARM_ADDR:
++ case LOC_BASEREG_ARG:
++ case LOC_COMPUTED_ARG:
++ arg_sym = sym;
++ break;
++ case LOC_UNRESOLVED:
++ continue;
++ default:
++ found_sym = 1;
++ add_defn_to_vec (obstackp,
++ fixup_symbol_section (sym, objfile),
++ block, symtab);
++ break;
++ }
++ }
++ }
+ }
+ else
+ {
+ ALL_BLOCK_SYMBOLS (block, iter, sym)
+- {
+- if (SYMBOL_DOMAIN (sym) == domain)
+- {
+- int cmp = strncmp (name, DEPRECATED_SYMBOL_NAME (sym), name_len);
+-
+- if (cmp == 0
+- && is_name_suffix (DEPRECATED_SYMBOL_NAME (sym) + name_len))
+- {
+- switch (SYMBOL_CLASS (sym))
+- {
+- case LOC_ARG:
+- case LOC_LOCAL_ARG:
+- case LOC_REF_ARG:
+- case LOC_REGPARM:
+- case LOC_REGPARM_ADDR:
+- case LOC_BASEREG_ARG:
+- case LOC_COMPUTED_ARG:
+- arg_sym = sym;
+- break;
+- case LOC_UNRESOLVED:
+- break;
+- default:
+- found_sym = 1;
+- fill_in_ada_prototype (sym);
+- add_defn_to_vec (fixup_symbol_section (sym, objfile),
+- block);
+- break;
+- }
+- }
+- }
+- }
++ {
++ if (SYMBOL_DOMAIN (sym) == domain)
++ {
++ int cmp = strncmp (name, SYMBOL_LINKAGE_NAME (sym), name_len);
++ if (cmp == 0
++ && is_name_suffix (SYMBOL_LINKAGE_NAME (sym) + name_len))
++ {
++ switch (SYMBOL_CLASS (sym))
++ {
++ case LOC_ARG:
++ case LOC_LOCAL_ARG:
++ case LOC_REF_ARG:
++ case LOC_REGPARM:
++ case LOC_REGPARM_ADDR:
++ case LOC_BASEREG_ARG:
++ case LOC_COMPUTED_ARG:
++ arg_sym = sym;
++ break;
++ case LOC_UNRESOLVED:
++ break;
++ default:
++ found_sym = 1;
++ add_defn_to_vec (obstackp,
++ fixup_symbol_section (sym, objfile),
++ block, symtab);
++ break;
++ }
++ }
++ }
++ }
+ }
+
+ if (!found_sym && arg_sym != NULL)
+ {
+- fill_in_ada_prototype (arg_sym);
+- add_defn_to_vec (fixup_symbol_section (arg_sym, objfile), block);
++ add_defn_to_vec (obstackp,
++ fixup_symbol_section (arg_sym, objfile),
++ block, symtab);
+ }
+
+ if (!wild)
+@@ -4042,16 +5267,17 @@
+ {
+ int cmp;
+
+- cmp = (int) '_' - (int) DEPRECATED_SYMBOL_NAME (sym)[0];
++ cmp = (int) '_' - (int) SYMBOL_LINKAGE_NAME (sym)[0];
+ if (cmp == 0)
+ {
+- cmp = strncmp ("_ada_", DEPRECATED_SYMBOL_NAME (sym), 5);
++ cmp = strncmp ("_ada_", SYMBOL_LINKAGE_NAME (sym), 5);
+ if (cmp == 0)
+- cmp = strncmp (name, DEPRECATED_SYMBOL_NAME (sym) + 5, name_len);
++ cmp = strncmp (name, SYMBOL_LINKAGE_NAME (sym) + 5,
++ name_len);
+ }
+
+ if (cmp == 0
+- && is_name_suffix (DEPRECATED_SYMBOL_NAME (sym) + name_len + 5))
++ && is_name_suffix (SYMBOL_LINKAGE_NAME (sym) + name_len + 5))
+ {
+ switch (SYMBOL_CLASS (sym))
+ {
+@@ -4068,136 +5294,41 @@
+ break;
+ default:
+ found_sym = 1;
+- fill_in_ada_prototype (sym);
+- add_defn_to_vec (fixup_symbol_section (sym, objfile),
+- block);
++ add_defn_to_vec (obstackp,
++ fixup_symbol_section (sym, objfile),
++ block, symtab);
+ break;
+ }
+ }
+ }
++ end_loop2: ;
+ }
+
+ /* NOTE: This really shouldn't be needed for _ada_ symbols.
+- They aren't parameters, right? */
++ They aren't parameters, right? */
+ if (!found_sym && arg_sym != NULL)
+- {
+- fill_in_ada_prototype (arg_sym);
+- add_defn_to_vec (fixup_symbol_section (arg_sym, objfile), block);
+- }
+- }
+-}
+-\f
+-
+- /* Function Types */
+-
+-/* Assuming that SYM is the symbol for a function, fill in its type
+- with prototype information, if it is not already there. */
+-
+-static void
+-fill_in_ada_prototype (struct symbol *func)
+-{
+- struct block *b;
+- int nargs, nsyms;
+- struct dict_iterator iter;
+- struct type *ftype;
+- struct type *rtype;
+- size_t max_fields;
+- struct symbol *sym;
+-
+- if (func == NULL
+- || TYPE_CODE (SYMBOL_TYPE (func)) != TYPE_CODE_FUNC
+- || TYPE_FIELDS (SYMBOL_TYPE (func)) != NULL)
+- return;
+-
+- /* We make each function type unique, so that each may have its own */
+- /* parameter types. This particular way of doing so wastes space: */
+- /* it would be nicer to build the argument types while the original */
+- /* function type is being built (FIXME). */
+- rtype = check_typedef (TYPE_TARGET_TYPE (SYMBOL_TYPE (func)));
+- ftype = alloc_type (TYPE_OBJFILE (SYMBOL_TYPE (func)));
+- make_function_type (rtype, &ftype);
+- SYMBOL_TYPE (func) = ftype;
+-
+- b = SYMBOL_BLOCK_VALUE (func);
+-
+- nargs = 0;
+- max_fields = 8;
+- TYPE_FIELDS (ftype) =
+- (struct field *) xmalloc (sizeof (struct field) * max_fields);
+- ALL_BLOCK_SYMBOLS (b, iter, sym)
+- {
+- GROW_VECT (TYPE_FIELDS (ftype), max_fields, nargs + 1);
+-
+- switch (SYMBOL_CLASS (sym))
+- {
+- case LOC_REF_ARG:
+- case LOC_REGPARM_ADDR:
+- TYPE_FIELD_BITPOS (ftype, nargs) = nargs;
+- TYPE_FIELD_BITSIZE (ftype, nargs) = 0;
+- TYPE_FIELD_STATIC_KIND (ftype, nargs) = 0;
+- TYPE_FIELD_TYPE (ftype, nargs) =
+- lookup_pointer_type (check_typedef (SYMBOL_TYPE (sym)));
+- TYPE_FIELD_NAME (ftype, nargs) = DEPRECATED_SYMBOL_NAME (sym);
+- nargs += 1;
+-
+- break;
+-
+- case LOC_ARG:
+- case LOC_REGPARM:
+- case LOC_LOCAL_ARG:
+- case LOC_BASEREG_ARG:
+- case LOC_COMPUTED_ARG:
+- TYPE_FIELD_BITPOS (ftype, nargs) = nargs;
+- TYPE_FIELD_BITSIZE (ftype, nargs) = 0;
+- TYPE_FIELD_STATIC_KIND (ftype, nargs) = 0;
+- TYPE_FIELD_TYPE (ftype, nargs) = check_typedef (SYMBOL_TYPE (sym));
+- TYPE_FIELD_NAME (ftype, nargs) = DEPRECATED_SYMBOL_NAME (sym);
+- nargs += 1;
+-
+- break;
+-
+- default:
+- break;
+- }
+- }
+-
+- /* Re-allocate fields vector; if there are no fields, make the */
+- /* fields pointer non-null anyway, to mark that this function type */
+- /* has been filled in. */
+-
+- TYPE_NFIELDS (ftype) = nargs;
+- if (nargs == 0)
+- {
+- static struct field dummy_field = { 0, 0, 0, 0 };
+- xfree (TYPE_FIELDS (ftype));
+- TYPE_FIELDS (ftype) = &dummy_field;
+- }
+- else
+- {
+- struct field *fields =
+- (struct field *) TYPE_ALLOC (ftype, nargs * sizeof (struct field));
+- memcpy ((char *) fields,
+- (char *) TYPE_FIELDS (ftype), nargs * sizeof (struct field));
+- xfree (TYPE_FIELDS (ftype));
+- TYPE_FIELDS (ftype) = fields;
++ {
++ add_defn_to_vec (obstackp,
++ fixup_symbol_section (arg_sym, objfile),
++ block, symtab);
++ }
+ }
+ }
+ \f
++ /* Breakpoint-related */
+
+- /* Breakpoint-related */
+-
+-char no_symtab_msg[] =
+- "No symbol table is loaded. Use the \"file\" command.";
++/* Import message from symtab.c. */
++extern char no_symtab_msg[];
+
+ /* Assuming that LINE is pointing at the beginning of an argument to
+ 'break', return a pointer to the delimiter for the initial segment
+- of that name. This is the first ':', ' ', or end of LINE.
+-*/
++ of that name. This is the first ':', ' ', or end of LINE. */
++
+ char *
+ ada_start_decode_line_1 (char *line)
+ {
+- /* [NOTE: strpbrk would be more elegant, but I am reluctant to be
+- the first to use such a library function in GDB code.] */
++ /* NOTE: strpbrk would be more elegant, but I am reluctant to be
++ the first to use such a library function in GDB code. */
+ char *p;
+ for (p = line; *p != '\000' && *p != ' ' && *p != ':'; p += 1)
+ ;
+@@ -4208,33 +5339,32 @@
+ command), following any initial file name specification.
+
+ Return all symbol table/line specfications (sals) consistent with the
+- information in *SPEC and FILE_TABLE in the
+- following sense:
++ information in *SPEC and FILE_TABLE in the following sense:
+ + FILE_TABLE is null, or the sal refers to a line in the file
+ named by FILE_TABLE.
+ + If *SPEC points to an argument with a trailing ':LINENUM',
+- then the sal refers to that line (or one following it as closely as
++ then the sal refers to that line (or one following it as closely as
+ possible).
+- + If *SPEC does not start with '*', the sal is in a function with
++ + If *SPEC does not start with '*', the sal is in a function with
+ that name.
+
+ Returns with 0 elements if no matching non-minimal symbols found.
+
+ If *SPEC begins with a function name of the form <NAME>, then NAME
+ is taken as a literal name; otherwise the function name is subject
+- to the usual mangling.
++ to the usual encoding.
+
+ *SPEC is updated to point after the function/line number specification.
+
+ FUNFIRSTLINE is non-zero if we desire the first line of real code
+- in each function (this is ignored in the presence of a LINENUM spec.).
++ in each function.
+
+ If CANONICAL is non-NULL, and if any of the sals require a
+ 'canonical line spec', then *CANONICAL is set to point to an array
+ of strings, corresponding to and equal in length to the returned
+- list of sals, such that (*CANONICAL)[i] is non-null and contains a
+- canonical line spec for the ith returned sal, if needed. If no
+- canonical line specs are required and CANONICAL is non-null,
++ list of sals, such that (*CANONICAL)[i] is non-null and contains a
++ canonical line spec for the ith returned sal, if needed. If no
++ canonical line specs are required and CANONICAL is non-null,
+ *CANONICAL is set to NULL.
+
+ A 'canonical line spec' is simply a name (in the format of the
+@@ -4242,43 +5372,48 @@
+ with no further contextual information or user selection. It is
+ needed whenever the file name, function name, and line number
+ information supplied is insufficient for this unique
+- identification. Currently overloaded functions, the name '*',
++ identification. Currently overloaded functions, the name '*',
+ or static functions without a filename yield a canonical line spec.
+ The array and the line spec strings are allocated on the heap; it
+- is the caller's responsibility to free them. */
++ is the caller's responsibility to free them. */
+
+ struct symtabs_and_lines
+ ada_finish_decode_line_1 (char **spec, struct symtab *file_table,
+- int funfirstline, char ***canonical)
++ int funfirstline, char ***canonical)
+ {
+- struct symbol **symbols;
+- struct block **blocks;
+- struct block *block;
++ struct ada_symbol_info *symbols;
++ const struct block *block;
+ int n_matches, i, line_num;
+ struct symtabs_and_lines selected;
+ struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
+ char *name;
++ int is_quoted;
+
+ int len;
+ char *lower_name;
+ char *unquoted_name;
+
+- if (file_table == NULL)
+- block = get_selected_block (NULL);
++ if (file_table == NULL)
++ block = block_static_block (get_selected_block (0));
+ else
+ block = BLOCKVECTOR_BLOCK (BLOCKVECTOR (file_table), STATIC_BLOCK);
+
+ if (canonical != NULL)
+ *canonical = (char **) NULL;
+
++ is_quoted = (**spec && strchr (get_gdb_completer_quote_characters (),
++ **spec) != NULL);
++
+ name = *spec;
+ if (**spec == '*')
+ *spec += 1;
+ else
+ {
++ if (is_quoted)
++ *spec = skip_quoted (*spec);
+ while (**spec != '\000' &&
+- !strchr (ada_completer_word_break_characters, **spec))
+- *spec += 1;
++ !strchr (ada_completer_word_break_characters, **spec))
++ *spec += 1;
+ }
+ len = *spec - name;
+
+@@ -4287,15 +5422,16 @@
+ {
+ line_num = strtol (*spec + 1, spec, 10);
+ while (**spec == ' ' || **spec == '\t')
+- *spec += 1;
++ *spec += 1;
+ }
+
+ if (name[0] == '*')
+ {
+ if (line_num == -1)
+- error ("Wild-card function with no line number or file name.");
++ error ("Wild-card function with no line number or file name.");
+
+- return all_sals_for_line (file_table->filename, line_num, canonical);
++ return ada_sals_for_line (file_table->filename, line_num,
++ funfirstline, canonical, 0);
+ }
+
+ if (name[0] == '\'')
+@@ -4318,17 +5454,17 @@
+ unquoted_name[len] = '\000';
+ lower_name = (char *) alloca (len + 1);
+ for (i = 0; i < len; i += 1)
+- lower_name[i] = tolower (name[i]);
++ lower_name[i] = tolower (name[i]);
+ lower_name[len] = '\000';
+ }
+
+ n_matches = 0;
+ if (lower_name != NULL)
+- n_matches = ada_lookup_symbol_list (ada_mangle (lower_name), block,
+- VAR_DOMAIN, &symbols, &blocks);
++ n_matches = ada_lookup_symbol_list (ada_encode (lower_name), block,
++ VAR_DOMAIN, &symbols);
+ if (n_matches == 0)
+ n_matches = ada_lookup_symbol_list (unquoted_name, block,
+- VAR_DOMAIN, &symbols, &blocks);
++ VAR_DOMAIN, &symbols);
+ if (n_matches == 0 && line_num >= 0)
+ error ("No line number information found for %s.", unquoted_name);
+ else if (n_matches == 0)
+@@ -4337,7 +5473,7 @@
+ /* FIXME: See comment in symtab.c::decode_line_1 */
+ #undef volatile
+ volatile struct symtab_and_line val;
+-#define volatile /*nothing */
++#define volatile /*nothing */
+ #else
+ struct symtab_and_line val;
+ #endif
+@@ -4347,43 +5483,46 @@
+
+ msymbol = NULL;
+ if (lower_name != NULL)
+- msymbol = ada_lookup_minimal_symbol (ada_mangle (lower_name));
++ msymbol = ada_lookup_simple_minsym (ada_encode (lower_name));
+ if (msymbol == NULL)
+- msymbol = ada_lookup_minimal_symbol (unquoted_name);
++ msymbol = ada_lookup_simple_minsym (unquoted_name);
+ if (msymbol != NULL)
+- {
+- val.pc = SYMBOL_VALUE_ADDRESS (msymbol);
+- val.section = SYMBOL_BFD_SECTION (msymbol);
+- if (funfirstline)
+- {
+- val.pc += FUNCTION_START_OFFSET;
+- SKIP_PROLOGUE (val.pc);
+- }
+- selected.sals = (struct symtab_and_line *)
+- xmalloc (sizeof (struct symtab_and_line));
+- selected.sals[0] = val;
+- selected.nelts = 1;
+- return selected;
+- }
++ {
++ val.pc = SYMBOL_VALUE_ADDRESS (msymbol);
++ val.section = SYMBOL_BFD_SECTION (msymbol);
++ if (funfirstline)
++ {
++ val.pc += FUNCTION_START_OFFSET;
++ SKIP_PROLOGUE (val.pc);
++ }
++ selected.sals = (struct symtab_and_line *)
++ xmalloc (sizeof (struct symtab_and_line));
++ selected.sals[0] = val;
++ selected.nelts = 1;
++ return selected;
++ }
+
+ if (!have_full_symbols () &&
+- !have_partial_symbols () && !have_minimal_symbols ())
+- error (no_symtab_msg);
++ !have_partial_symbols () && !have_minimal_symbols ())
++ error ("No symbol table is loaded. Use the \"file\" command.");
+
+ error ("Function \"%s\" not defined.", unquoted_name);
+- return selected; /* for lint */
++ return selected; /* for lint */
+ }
+
+ if (line_num >= 0)
+ {
+- return
+- find_sal_from_funcs_and_line (file_table->filename, line_num,
+- symbols, n_matches);
++ struct symtabs_and_lines best_sal =
++ find_sal_from_funcs_and_line (file_table->filename, line_num,
++ symbols, n_matches);
++ if (funfirstline)
++ adjust_pc_past_prologue (&best_sal.sals[0].pc);
++ return best_sal;
+ }
+ else
+ {
+ selected.nelts =
+- user_select_syms (symbols, blocks, n_matches, n_matches);
++ user_select_syms (symbols, n_matches, n_matches);
+ }
+
+ selected.sals = (struct symtab_and_line *)
+@@ -4394,23 +5533,25 @@
+ i = 0;
+ while (i < selected.nelts)
+ {
+- if (SYMBOL_CLASS (symbols[i]) == LOC_BLOCK)
+- selected.sals[i] = find_function_start_sal (symbols[i], funfirstline);
+- else if (SYMBOL_LINE (symbols[i]) != 0)
+- {
+- selected.sals[i].symtab = symtab_for_sym (symbols[i]);
+- selected.sals[i].line = SYMBOL_LINE (symbols[i]);
+- }
++ if (SYMBOL_CLASS (symbols[i].sym) == LOC_BLOCK)
++ selected.sals[i]
++ = find_function_start_sal (symbols[i].sym, funfirstline);
++ else if (SYMBOL_LINE (symbols[i].sym) != 0)
++ {
++ selected.sals[i].symtab =
++ symbols[i].symtab
++ ? symbols[i].symtab : symtab_for_sym (symbols[i].sym);
++ selected.sals[i].line = SYMBOL_LINE (symbols[i].sym);
++ }
+ else if (line_num >= 0)
+- {
+- /* Ignore this choice */
+- symbols[i] = symbols[selected.nelts - 1];
+- blocks[i] = blocks[selected.nelts - 1];
+- selected.nelts -= 1;
+- continue;
+- }
++ {
++ /* Ignore this choice */
++ symbols[i] = symbols[selected.nelts - 1];
++ selected.nelts -= 1;
++ continue;
++ }
+ else
+- error ("Line number not known for symbol \"%s\"", unquoted_name);
++ error ("Line number not known for symbol \"%s\"", unquoted_name);
+ i += 1;
+ }
+
+@@ -4418,9 +5559,9 @@
+ {
+ *canonical = (char **) xmalloc (sizeof (char *) * selected.nelts);
+ for (i = 0; i < selected.nelts; i += 1)
+- (*canonical)[i] =
+- extended_canonical_line_spec (selected.sals[i],
+- SYMBOL_PRINT_NAME (symbols[i]));
++ (*canonical)[i] =
++ extended_canonical_line_spec (selected.sals[i],
++ SYMBOL_PRINT_NAME (symbols[i].sym));
+ }
+
+ discard_cleanups (old_chain);
+@@ -4428,11 +5569,12 @@
+ }
+
+ /* The (single) sal corresponding to line LINE_NUM in a symbol table
+- with file name FILENAME that occurs in one of the functions listed
+- in SYMBOLS[0 .. NSYMS-1]. */
++ with file name FILENAME that occurs in one of the functions listed
++ in the symbol fields of SYMBOLS[0 .. NSYMS-1]. */
++
+ static struct symtabs_and_lines
+ find_sal_from_funcs_and_line (const char *filename, int line_num,
+- struct symbol **symbols, int nsyms)
++ struct ada_symbol_info *symbols, int nsyms)
+ {
+ struct symtabs_and_lines sals;
+ int best_index, best;
+@@ -4454,26 +5596,26 @@
+
+ QUIT;
+
+- if (!DEPRECATED_STREQ (filename, s->filename))
++ if (strcmp (filename, s->filename) != 0)
+ continue;
+ l = LINETABLE (s);
+ ind = find_line_in_linetable (l, line_num, symbols, nsyms, &exact);
+ if (ind >= 0)
+ {
+- if (exact)
+- {
+- best_index = ind;
+- best_linetable = l;
+- best_symtab = s;
+- goto done;
+- }
+- if (best == 0 || l->item[ind].line < best)
+- {
+- best = l->item[ind].line;
+- best_index = ind;
+- best_linetable = l;
+- best_symtab = s;
+- }
++ if (exact)
++ {
++ best_index = ind;
++ best_linetable = l;
++ best_symtab = s;
++ goto done;
++ }
++ if (best == 0 || l->item[ind].line < best)
++ {
++ best = l->item[ind].line;
++ best_index = ind;
++ best_linetable = l;
++ best_symtab = s;
++ }
+ }
+ }
+
+@@ -4495,11 +5637,13 @@
+ }
+
+ /* Return the index in LINETABLE of the best match for LINE_NUM whose
+- pc falls within one of the functions denoted by SYMBOLS[0..NSYMS-1].
+- Set *EXACTP to the 1 if the match is exact, and 0 otherwise. */
++ pc falls within one of the functions denoted by the symbol fields
++ of SYMBOLS[0..NSYMS-1]. Set *EXACTP to 1 if the match is exact,
++ and 0 otherwise. */
++
+ static int
+ find_line_in_linetable (struct linetable *linetable, int line_num,
+- struct symbol **symbols, int nsyms, int *exactp)
++ struct ada_symbol_info *symbols, int nsyms, int *exactp)
+ {
+ int i, len, best_index, best;
+
+@@ -4513,27 +5657,28 @@
+ struct linetable_entry *item = &(linetable->item[i]);
+
+ for (k = 0; k < nsyms; k += 1)
+- {
+- if (symbols[k] != NULL && SYMBOL_CLASS (symbols[k]) == LOC_BLOCK
+- && item->pc >= BLOCK_START (SYMBOL_BLOCK_VALUE (symbols[k]))
+- && item->pc < BLOCK_END (SYMBOL_BLOCK_VALUE (symbols[k])))
+- goto candidate;
+- }
++ {
++ if (symbols[k].sym != NULL
++ && SYMBOL_CLASS (symbols[k].sym) == LOC_BLOCK
++ && item->pc >= BLOCK_START (SYMBOL_BLOCK_VALUE (symbols[k].sym))
++ && item->pc < BLOCK_END (SYMBOL_BLOCK_VALUE (symbols[k].sym)))
++ goto candidate;
++ }
+ continue;
+
+ candidate:
+
+ if (item->line == line_num)
+- {
+- *exactp = 1;
+- return i;
+- }
++ {
++ *exactp = 1;
++ return i;
++ }
+
+ if (item->line > line_num && (best == 0 || item->line < best))
+- {
+- best = item->line;
+- best_index = i;
+- }
++ {
++ best = item->line;
++ best_index = i;
++ }
+ }
+
+ *exactp = 0;
+@@ -4542,7 +5687,8 @@
+
+ /* Find the smallest k >= LINE_NUM such that k is a line number in
+ LINETABLE, and k falls strictly within a named function that begins at
+- or before LINE_NUM. Return -1 if there is no such k. */
++ or before LINE_NUM. Return -1 if there is no such k. */
++
+ static int
+ nearest_line_number_in_linetable (struct linetable *linetable, int line_num)
+ {
+@@ -4556,37 +5702,36 @@
+ best = INT_MAX;
+ while (i < len)
+ {
+- int k;
+ struct linetable_entry *item = &(linetable->item[i]);
+
+ if (item->line >= line_num && item->line < best)
+- {
+- char *func_name;
+- CORE_ADDR start, end;
+-
+- func_name = NULL;
+- find_pc_partial_function (item->pc, &func_name, &start, &end);
+-
+- if (func_name != NULL && item->pc < end)
+- {
+- if (item->line == line_num)
+- return line_num;
+- else
+- {
+- struct symbol *sym =
+- standard_lookup (func_name, VAR_DOMAIN);
+- if (is_plausible_func_for_line (sym, line_num))
+- best = item->line;
+- else
+- {
+- do
+- i += 1;
+- while (i < len && linetable->item[i].pc < end);
+- continue;
+- }
+- }
+- }
+- }
++ {
++ char *func_name;
++ CORE_ADDR start, end;
++
++ func_name = NULL;
++ find_pc_partial_function (item->pc, &func_name, &start, &end);
++
++ if (func_name != NULL && item->pc < end)
++ {
++ if (item->line == line_num)
++ return line_num;
++ else
++ {
++ struct symbol *sym =
++ standard_lookup (func_name, NULL, VAR_DOMAIN);
++ if (is_plausible_func_for_line (sym, line_num))
++ best = item->line;
++ else
++ {
++ do
++ i += 1;
++ while (i < len && linetable->item[i].pc < end);
++ continue;
++ }
++ }
++ }
++ }
+
+ i += 1;
+ }
+@@ -4595,17 +5740,17 @@
+ }
+
+
+-/* Return the next higher index, k, into LINETABLE such that k > IND,
++/* Return the next higher index, k, into LINETABLE such that k > IND,
+ entry k in LINETABLE has a line number equal to LINE_NUM, k
+- corresponds to a PC that is in a function different from that
++ corresponds to a PC that is in a function different from that
+ corresponding to IND, and falls strictly within a named function
+- that begins at a line at or preceding STARTING_LINE.
+- Return -1 if there is no such k.
+- IND == -1 corresponds to no function. */
++ that begins at a line at or preceding STARTING_LINE.
++ Return -1 if there is no such k.
++ IND == -1 corresponds to no function. */
+
+ static int
+ find_next_line_in_linetable (struct linetable *linetable, int line_num,
+- int starting_line, int ind)
++ int starting_line, int ind)
+ {
+ int i, len;
+
+@@ -4618,13 +5763,13 @@
+ CORE_ADDR start, end;
+
+ if (find_pc_partial_function (linetable->item[ind].pc,
+- (char **) NULL, &start, &end))
+- {
+- while (ind < len && linetable->item[ind].pc < end)
+- ind += 1;
+- }
++ (char **) NULL, &start, &end))
++ {
++ while (ind < len && linetable->item[ind].pc < end)
++ ind += 1;
++ }
+ else
+- ind += 1;
++ ind += 1;
+ }
+ else
+ ind = 0;
+@@ -4632,33 +5777,32 @@
+ i = ind;
+ while (i < len)
+ {
+- int k;
+ struct linetable_entry *item = &(linetable->item[i]);
+
+ if (item->line >= line_num)
+- {
+- char *func_name;
+- CORE_ADDR start, end;
+-
+- func_name = NULL;
+- find_pc_partial_function (item->pc, &func_name, &start, &end);
+-
+- if (func_name != NULL && item->pc < end)
+- {
+- if (item->line == line_num)
+- {
+- struct symbol *sym =
+- standard_lookup (func_name, VAR_DOMAIN);
+- if (is_plausible_func_for_line (sym, starting_line))
+- return i;
+- else
+- {
+- while ((i + 1) < len && linetable->item[i + 1].pc < end)
+- i += 1;
+- }
+- }
+- }
+- }
++ {
++ char *func_name;
++ CORE_ADDR start, end;
++
++ func_name = NULL;
++ find_pc_partial_function (item->pc, &func_name, &start, &end);
++
++ if (func_name != NULL && item->pc < end)
++ {
++ if (item->line == line_num)
++ {
++ struct symbol *sym =
++ standard_lookup (func_name, NULL, VAR_DOMAIN);
++ if (is_plausible_func_for_line (sym, starting_line))
++ return i;
++ else
++ {
++ while ((i + 1) < len && linetable->item[i + 1].pc < end)
++ i += 1;
++ }
++ }
++ }
++ }
+ i += 1;
+ }
+
+@@ -4666,7 +5810,8 @@
+ }
+
+ /* True iff function symbol SYM starts somewhere at or before line #
+- LINE_NUM. */
++ LINE_NUM. */
++
+ static int
+ is_plausible_func_for_line (struct symbol *sym, int line_num)
+ {
+@@ -4680,68 +5825,9 @@
+ return (start_sal.line != 0 && line_num >= start_sal.line);
+ }
+
+-static void
+-debug_print_lines (struct linetable *lt)
+-{
+- int i;
+-
+- if (lt == NULL)
+- return;
+-
+- fprintf (stderr, "\t");
+- for (i = 0; i < lt->nitems; i += 1)
+- fprintf (stderr, "(%d->%p) ", lt->item[i].line, (void *) lt->item[i].pc);
+- fprintf (stderr, "\n");
+-}
+-
+-static void
+-debug_print_block (struct block *b)
+-{
+- struct dict_iterator iter;
+- struct symbol *sym;
+-
+- fprintf (stderr, "Block: %p; [0x%lx, 0x%lx]",
+- b, BLOCK_START (b), BLOCK_END (b));
+- if (BLOCK_FUNCTION (b) != NULL)
+- fprintf (stderr, " Function: %s", DEPRECATED_SYMBOL_NAME (BLOCK_FUNCTION (b)));
+- fprintf (stderr, "\n");
+- fprintf (stderr, "\t Superblock: %p\n", BLOCK_SUPERBLOCK (b));
+- fprintf (stderr, "\t Symbols:");
+- ALL_BLOCK_SYMBOLS (b, iter, sym)
+- {
+- fprintf (stderr, " %s", DEPRECATED_SYMBOL_NAME (sym));
+- }
+- fprintf (stderr, "\n");
+-}
+-
+-static void
+-debug_print_blocks (struct blockvector *bv)
+-{
+- int i;
+-
+- if (bv == NULL)
+- return;
+- for (i = 0; i < BLOCKVECTOR_NBLOCKS (bv); i += 1)
+- {
+- fprintf (stderr, "%6d. ", i);
+- debug_print_block (BLOCKVECTOR_BLOCK (bv, i));
+- }
+-}
+-
+-static void
+-debug_print_symtab (struct symtab *s)
+-{
+- fprintf (stderr, "Symtab %p\n File: %s; Dir: %s\n", s,
+- s->filename, s->dirname);
+- fprintf (stderr, " Blockvector: %p, Primary: %d\n",
+- BLOCKVECTOR (s), s->primary);
+- debug_print_blocks (BLOCKVECTOR (s));
+- fprintf (stderr, " Line table: %p\n", LINETABLE (s));
+- debug_print_lines (LINETABLE (s));
+-}
+-
+ /* Read in all symbol tables corresponding to partial symbol tables
+- with file name FILENAME. */
++ with file name FILENAME. */
++
+ static void
+ read_all_symtabs (const char *filename)
+ {
+@@ -4752,16 +5838,25 @@
+ {
+ QUIT;
+
+- if (DEPRECATED_STREQ (filename, ps->filename))
++ if (strcmp (filename, ps->filename) == 0)
+ PSYMTAB_TO_SYMTAB (ps);
+ }
+ }
+
+ /* All sals corresponding to line LINE_NUM in a symbol table from file
+- FILENAME, as filtered by the user. If CANONICAL is not null, set
+- it to a corresponding array of canonical line specs. */
+-static struct symtabs_and_lines
+-all_sals_for_line (const char *filename, int line_num, char ***canonical)
++ FILENAME, as filtered by the user. Filter out any lines that
++ reside in functions with "suppressed" names (not corresponding to
++ explicit Ada functions), if there is at least one in a function
++ with a non-suppressed name. If CANONICAL is not null, set
++ it to a corresponding array of canonical line specs.
++ If ONE_LOCATION_ONLY is set and several matches are found for
++ the given location, then automatically select the first match found
++ instead of asking the user which instance should be returned. */
++
++struct symtabs_and_lines
++ada_sals_for_line (const char *filename, int line_num,
++ int funfirstline, char ***canonical,
++ int one_location_only)
+ {
+ struct symtabs_and_lines result;
+ struct objfile *objfile;
+@@ -4783,7 +5878,7 @@
+
+ QUIT;
+
+- if (!DEPRECATED_STREQ (s->filename, filename))
++ if (strcmp (s->filename, filename) != 0)
+ continue;
+
+ target_line_num =
+@@ -4794,82 +5889,119 @@
+ ind = -1;
+ while (1)
+ {
+- ind =
+- find_next_line_in_linetable (LINETABLE (s),
+- target_line_num, line_num, ind);
++ ind =
++ find_next_line_in_linetable (LINETABLE (s),
++ target_line_num, line_num, ind);
++
++ if (ind < 0)
++ break;
++
++ GROW_VECT (result.sals, len, result.nelts + 1);
++ init_sal (&result.sals[result.nelts]);
++ result.sals[result.nelts].line = line_num;
++ result.sals[result.nelts].pc = LINETABLE (s)->item[ind].pc;
++ result.sals[result.nelts].symtab = s;
+
+- if (ind < 0)
+- break;
++ if (funfirstline)
++ adjust_pc_past_prologue (&result.sals[result.nelts].pc);
+
+- GROW_VECT (result.sals, len, result.nelts + 1);
+- init_sal (&result.sals[result.nelts]);
+- result.sals[result.nelts].line = LINETABLE (s)->item[ind].line;
+- result.sals[result.nelts].pc = LINETABLE (s)->item[ind].pc;
+- result.sals[result.nelts].symtab = s;
+- result.nelts += 1;
++ result.nelts += 1;
+ }
+ }
+
+ if (canonical != NULL || result.nelts > 1)
+ {
+- int k;
++ int k, j, n;
+ char **func_names = (char **) alloca (result.nelts * sizeof (char *));
+ int first_choice = (result.nelts > 1) ? 2 : 1;
+- int n;
+ int *choices = (int *) alloca (result.nelts * sizeof (int));
+
+ for (k = 0; k < result.nelts; k += 1)
+- {
+- find_pc_partial_function (result.sals[k].pc, &func_names[k],
+- (CORE_ADDR *) NULL, (CORE_ADDR *) NULL);
+- if (func_names[k] == NULL)
+- error ("Could not find function for one or more breakpoints.");
+- }
++ {
++ find_pc_partial_function (result.sals[k].pc, &func_names[k],
++ (CORE_ADDR *) NULL, (CORE_ADDR *) NULL);
++ if (func_names[k] == NULL)
++ error ("Could not find function for one or more breakpoints.");
++ }
++
++ /* Remove suppressed names, unless all are suppressed. */
++ for (j = 0; j < result.nelts; j += 1)
++ if (!is_suppressed_name (func_names[j]))
++ {
++ /* At least one name is unsuppressed, so remove all
++ suppressed names. */
++ for (k = n = 0; k < result.nelts; k += 1)
++ if (!is_suppressed_name (func_names[k]))
++ {
++ func_names[n] = func_names[k];
++ result.sals[n] = result.sals[k];
++ n += 1;
++ }
++ result.nelts = n;
++ break;
++ }
+
+ if (result.nelts > 1)
+- {
+- printf_unfiltered ("[0] cancel\n");
+- if (result.nelts > 1)
+- printf_unfiltered ("[1] all\n");
+- for (k = 0; k < result.nelts; k += 1)
+- printf_unfiltered ("[%d] %s\n", k + first_choice,
+- ada_demangle (func_names[k]));
+-
+- n = get_selections (choices, result.nelts, result.nelts,
+- result.nelts > 1, "instance-choice");
+-
+- for (k = 0; k < n; k += 1)
+- {
+- result.sals[k] = result.sals[choices[k]];
+- func_names[k] = func_names[choices[k]];
+- }
+- result.nelts = n;
+- }
+-
+- if (canonical != NULL)
+- {
+- *canonical = (char **) xmalloc (result.nelts * sizeof (char **));
+- make_cleanup (xfree, *canonical);
+- for (k = 0; k < result.nelts; k += 1)
+- {
+- (*canonical)[k] =
+- extended_canonical_line_spec (result.sals[k], func_names[k]);
+- if ((*canonical)[k] == NULL)
+- error ("Could not locate one or more breakpoints.");
+- make_cleanup (xfree, (*canonical)[k]);
+- }
+- }
++ {
++ if (one_location_only)
++ {
++ /* Automatically select the first of all possible choices. */
++ n = 1;
++ choices[0] = 0;
++ }
++ else
++ {
++ printf_unfiltered ("[0] cancel\n");
++ if (result.nelts > 1)
++ printf_unfiltered ("[1] all\n");
++ for (k = 0; k < result.nelts; k += 1)
++ printf_unfiltered ("[%d] %s\n", k + first_choice,
++ ada_decode (func_names[k]));
++
++ n = get_selections (choices, result.nelts, result.nelts,
++ result.nelts > 1, "instance-choice");
++ }
++
++ for (k = 0; k < n; k += 1)
++ {
++ result.sals[k] = result.sals[choices[k]];
++ func_names[k] = func_names[choices[k]];
++ }
++ result.nelts = n;
++ }
++
++ if (canonical != NULL && result.nelts == 0)
++ *canonical = NULL;
++ else if (canonical != NULL)
++ {
++ *canonical = (char **) xmalloc (result.nelts * sizeof (char **));
++ make_cleanup (xfree, *canonical);
++ for (k = 0; k < result.nelts; k += 1)
++ {
++ (*canonical)[k] =
++ extended_canonical_line_spec (result.sals[k], func_names[k]);
++ if ((*canonical)[k] == NULL)
++ error ("Could not locate one or more breakpoints.");
++ make_cleanup (xfree, (*canonical)[k]);
++ }
++ }
+ }
+
+- discard_cleanups (old_chain);
++ if (result.nelts == 0)
++ {
++ do_cleanups (old_chain);
++ result.sals = NULL;
++ }
++ else
++ discard_cleanups (old_chain);
+ return result;
+ }
+
+
+ /* A canonical line specification of the form FILE:NAME:LINENUM for
+ symbol table and line data SAL. NULL if insufficient
+- information. The caller is responsible for releasing any space
+- allocated. */
++ information. The caller is responsible for releasing any space
++ allocated. */
+
+ static char *
+ extended_canonical_line_spec (struct symtab_and_line sal, const char *name)
+@@ -4879,162 +6011,303 @@
+ if (sal.symtab == NULL || sal.symtab->filename == NULL || sal.line <= 0)
+ return NULL;
+
+- r = (char *) xmalloc (strlen (name) + strlen (sal.symtab->filename)
+- + sizeof (sal.line) * 3 + 3);
+- sprintf (r, "%s:'%s':%d", sal.symtab->filename, name, sal.line);
+- return r;
++ r = (char *) xmalloc (strlen (name) + strlen (sal.symtab->filename)
++ + sizeof (sal.line) * 3 + 3);
++ sprintf (r, "%s:'%s':%d", sal.symtab->filename, name, sal.line);
++ return r;
++}
++
++/* If the main procedure is written in Ada, then return its name.
++ The result is good until the next call. Return NULL if the main
++ procedure doesn't appear to be in Ada. */
++
++char *
++ada_main_name (void)
++{
++ struct minimal_symbol *msym;
++ CORE_ADDR main_program_name_addr;
++ static char main_program_name[1024];
++ /* For Ada, the name of the main procedure is stored in a specific
++ string constant, generated by the binder. Look for that symbol,
++ extract its address, and then read that string. If we didn't find
++ that string, then most probably the main procedure is not written
++ in Ada. */
++ msym = lookup_minimal_symbol (ADA_MAIN_PROGRAM_SYMBOL_NAME, NULL, NULL);
++
++ if (msym != NULL)
++ {
++ main_program_name_addr = SYMBOL_VALUE_ADDRESS (msym);
++ if (main_program_name_addr == 0)
++ error ("Invalid address for Ada main program name.");
++
++ extract_string (main_program_name_addr, main_program_name);
++ return main_program_name;
++ }
++
++ /* The main procedure doesn't seem to be in Ada. */
++ return NULL;
++}
++
++/* Return type of Ada breakpoint associated with bp_stat:
++ 0 if not an Ada-specific breakpoint, 1 for break on specific exception,
++ 2 for break on unhandled exception, 3 for assert. */
++
++static int
++ada_exception_breakpoint_type (bpstat bs)
++{
++#ifdef GNAT_GDB
++ return ((! bs || ! bs->breakpoint_at) ? 0
++ : bs->breakpoint_at->break_on_exception);
++#else
++ return 0;
++#endif
++}
++
++/* True iff FRAME is very likely to be that of a function that is
++ part of the runtime system. This is all very heuristic, but is
++ intended to be used as advice as to what frames are uninteresting
++ to most users. */
++
++static int
++is_known_support_routine (struct frame_info *frame)
++{
++ struct frame_info *next_frame = get_next_frame (frame);
++ /* If frame is not innermost, that normally means that frame->pc
++ points to *after* the call instruction, and we want to get the line
++ containing the call, never the next line. But if the next frame is
++ a signal_handler_caller or a dummy frame, then the next frame was
++ not entered as the result of a call, and we want to get the line
++ containing frame->pc. */
++ const int pc_is_after_call =
++ next_frame != NULL
++ && get_frame_type (next_frame) != SIGTRAMP_FRAME
++ && get_frame_type (next_frame) != DUMMY_FRAME;
++ struct symtab_and_line sal
++ = find_pc_line (get_frame_pc (frame), pc_is_after_call);
++ char *func_name;
++ int i;
++ struct stat st;
++
++ /* The heuristic:
++ 1. The symtab is null (indicating no debugging symbols)
++ 2. The symtab's filename does not exist.
++ 3. The object file's name is one of the standard libraries.
++ 4. The symtab's file name has the form of an Ada library source file.
++ 5. The function at frame's PC has a GNAT-compiler-generated name. */
++
++ if (sal.symtab == NULL)
++ return 1;
++
++ /* On some systems (e.g. VxWorks), the kernel contains debugging
++ symbols; in this case, the filename referenced by these symbols
++ does not exists. */
++
++ if (stat (sal.symtab->filename, &st))
++ return 1;
++
++ for (i = 0; known_runtime_file_name_patterns[i] != NULL; i += 1)
++ {
++ re_comp (known_runtime_file_name_patterns[i]);
++ if (re_exec (sal.symtab->filename))
++ return 1;
++ }
++ if (sal.symtab->objfile != NULL)
++ {
++ for (i = 0; known_runtime_file_name_patterns[i] != NULL; i += 1)
++ {
++ re_comp (known_runtime_file_name_patterns[i]);
++ if (re_exec (sal.symtab->objfile->name))
++ return 1;
++ }
++ }
++
++ /* If the frame PC points after the call instruction, then we need to
++ decrement it in order to search for the function associated to this
++ PC. Otherwise, if the associated call was the last instruction of
++ the function, we might either find the wrong function or even fail
++ during the function name lookup. */
++ if (pc_is_after_call)
++ func_name = function_name_from_pc (get_frame_pc (frame) - 1);
++ else
++ func_name = function_name_from_pc (get_frame_pc (frame));
++
++ if (func_name == NULL)
++ return 1;
++
++ for (i = 0; known_auxiliary_function_name_patterns[i] != NULL; i += 1)
++ {
++ re_comp (known_auxiliary_function_name_patterns[i]);
++ if (re_exec (func_name))
++ return 1;
++ }
++
++ return 0;
+ }
+
+-#if 0
+-int begin_bnum = -1;
+-#endif
+-int begin_annotate_level = 0;
++/* Find the first frame that contains debugging information and that is not
++ part of the Ada run-time, starting from FI and moving upward. */
+
+-static void
+-begin_cleanup (void *dummy)
++void
++ada_find_printable_frame (struct frame_info *fi)
+ {
+- begin_annotate_level = 0;
++ for (; fi != NULL; fi = get_prev_frame (fi))
++ {
++ if (!is_known_support_routine (fi))
++ {
++ select_frame (fi);
++ break;
++ }
++ }
++
+ }
+
+-static void
+-begin_command (char *args, int from_tty)
+-{
+- struct minimal_symbol *msym;
+- CORE_ADDR main_program_name_addr;
+- char main_program_name[1024];
+- struct cleanup *old_chain = make_cleanup (begin_cleanup, NULL);
+- begin_annotate_level = 2;
+-
+- /* Check that there is a program to debug */
+- if (!have_full_symbols () && !have_partial_symbols ())
+- error ("No symbol table is loaded. Use the \"file\" command.");
+-
+- /* Check that we are debugging an Ada program */
+- /* if (ada_update_initial_language (language_unknown, NULL) != language_ada)
+- error ("Cannot find the Ada initialization procedure. Is this an Ada main program?");
+- */
+- /* FIXME: language_ada should be defined in defs.h */
++/* Name found for exception associated with last bpstat sent to
++ ada_adjust_exception_stop. Set to the null string if that bpstat
++ did not correspond to an Ada exception or no name could be found. */
+
+- /* Get the address of the name of the main procedure */
+- msym = lookup_minimal_symbol (ADA_MAIN_PROGRAM_SYMBOL_NAME, NULL, NULL);
++static char last_exception_name[256];
+
+- if (msym != NULL)
+- {
+- main_program_name_addr = SYMBOL_VALUE_ADDRESS (msym);
+- if (main_program_name_addr == 0)
+- error ("Invalid address for Ada main program name.");
++/* If BS indicates a stop in an Ada exception, try to go up to a frame
++ that will be meaningful to the user, and save the name of the last
++ exception (truncated, if necessary) in last_exception_name. */
+
+- /* Read the name of the main procedure */
+- extract_string (main_program_name_addr, main_program_name);
++void
++ada_adjust_exception_stop (bpstat bs)
++{
++ CORE_ADDR addr;
++ struct frame_info *fi;
++ int frame_level;
++ char *selected_frame_func;
++
++ addr = 0;
++ last_exception_name[0] = '\0';
++ fi = get_selected_frame ();
++ selected_frame_func = function_name_from_pc (get_frame_pc (fi));
+
+- /* Put a temporary breakpoint in the Ada main program and run */
+- do_command ("tbreak ", main_program_name, 0);
+- do_command ("run ", args, 0);
+- }
+- else
++ switch (ada_exception_breakpoint_type (bs))
+ {
+- /* If we could not find the symbol containing the name of the
+- main program, that means that the compiler that was used to build
+- was not recent enough. In that case, we fallback to the previous
+- mechanism, which is a little bit less reliable, but has proved to work
+- in most cases. The only cases where it will fail is when the user
+- has set some breakpoints which will be hit before the end of the
+- begin command processing (eg in the initialization code).
+-
+- The begining of the main Ada subprogram is located by breaking
+- on the adainit procedure. Since we know that the binder generates
+- the call to this procedure exactly 2 calls before the call to the
+- Ada main subprogram, it is then easy to put a breakpoint on this
+- Ada main subprogram once we hit adainit.
+- */
+- do_command ("tbreak adainit", 0);
+- do_command ("run ", args, 0);
+- do_command ("up", 0);
+- do_command ("tbreak +2", 0);
+- do_command ("continue", 0);
+- do_command ("step", 0);
++ default:
++ return;
++ case 1:
++ break;
++ case 2:
++ /* Unhandled exceptions. Select the frame corresponding to
++ ada.exceptions.process_raise_exception. This frame is at
++ least 2 levels up, so we simply skip the first 2 frames
++ without checking the name of their associated function. */
++ for (frame_level = 0; frame_level < 2; frame_level += 1)
++ if (fi != NULL)
++ fi = get_prev_frame (fi);
++ while (fi != NULL)
++ {
++ const char *func_name = function_name_from_pc (get_frame_pc (fi));
++ if (func_name != NULL
++ && strcmp (func_name, process_raise_exception_name) == 0)
++ break; /* We found the frame we were looking for... */
++ fi = get_prev_frame (fi);
++ }
++ if (fi == NULL)
++ break;
++ select_frame (fi);
++ break;
+ }
+
+- do_cleanups (old_chain);
++ addr = parse_and_eval_address ("e.full_name");
++
++ if (addr != 0)
++ read_memory (addr, last_exception_name,
++ sizeof (last_exception_name) - 1);
++ last_exception_name[sizeof (last_exception_name) - 1] = '\0';
++ ada_find_printable_frame (get_selected_frame ());
+ }
+
+-int
+-is_ada_runtime_file (char *filename)
++/* Output Ada exception name (if any) associated with last call to
++ ada_adjust_exception_stop. */
++
++void
++ada_print_exception_stop (bpstat bs)
+ {
+- return (DEPRECATED_STREQN (filename, "s-", 2) ||
+- DEPRECATED_STREQN (filename, "a-", 2) ||
+- DEPRECATED_STREQN (filename, "g-", 2) || DEPRECATED_STREQN (filename, "i-", 2));
++ if (last_exception_name[0] != '\000')
++ {
++ ui_out_text (uiout, last_exception_name);
++ ui_out_text (uiout, " at ");
++ }
+ }
+
+-/* find the first frame that contains debugging information and that is not
+- part of the Ada run-time, starting from fi and moving upward. */
++/* Parses the CONDITION string associated with a breakpoint exception
++ to get the name of the exception on which the breakpoint has been
++ set. The returned string needs to be deallocated after use. */
+
+-int
+-find_printable_frame (struct frame_info *fi, int level)
++static char *
++exception_name_from_cond (const char *condition)
+ {
+- struct symtab_and_line sal;
++ char *start, *end, *exception_name;
++ int exception_name_len;
++
++ start = strrchr (condition, '&') + 1;
++ end = strchr (start, ')') - 1;
++ exception_name_len = end - start + 1;
++
++ exception_name =
++ (char *) xmalloc ((exception_name_len + 1) * sizeof (char));
++ sprintf (exception_name, "%.*s", exception_name_len, start);
+
+- for (; fi != NULL; level += 1, fi = get_prev_frame (fi))
++ return exception_name;
++}
++
++/* Print Ada-specific exception information about B, other than task
++ clause. Return non-zero iff B was an Ada exception breakpoint. */
++
++int
++ada_print_exception_breakpoint_nontask (struct breakpoint *b)
++{
++#ifdef GNAT_GDB
++ if (b->break_on_exception == 1)
+ {
+- find_frame_sal (fi, &sal);
+- if (sal.symtab && !is_ada_runtime_file (sal.symtab->filename))
+- {
+-#if defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET)
+- /* libpthread.so contains some debugging information that prevents us
+- from finding the right frame */
+-
+- if (sal.symtab->objfile &&
+- DEPRECATED_STREQ (sal.symtab->objfile->name, "/usr/shlib/libpthread.so"))
+- continue;
++ if (b->cond_string) /* the breakpoint is on a specific exception. */
++ {
++ char *exception_name = exception_name_from_cond (b->cond_string);
++
++ make_cleanup (xfree, exception_name);
++
++ ui_out_text (uiout, "on ");
++ if (ui_out_is_mi_like_p (uiout))
++ ui_out_field_string (uiout, "exception", exception_name);
++ else
++ {
++ ui_out_text (uiout, "exception ");
++ ui_out_text (uiout, exception_name);
++ ui_out_text (uiout, " ");
++ }
++ }
++ else
++ ui_out_text (uiout, "on all exceptions");
++ }
++ else if (b->break_on_exception == 2)
++ ui_out_text (uiout, "on unhandled exception");
++ else if (b->break_on_exception == 3)
++ ui_out_text (uiout, "on assert failure");
++ else
++ return 0;
++ return 1;
++#else
++ return 0;
+ #endif
+- deprecated_selected_frame = fi;
+- break;
+- }
+- }
+-
+- return level;
+ }
+
++/* Print task identifier for breakpoint B, if it is an Ada-specific
++ breakpoint with non-zero tasking information. */
++
+ void
+-ada_report_exception_break (struct breakpoint *b)
++ada_print_exception_breakpoint_task (struct breakpoint *b)
+ {
+- /* FIXME: break_on_exception should be defined in breakpoint.h */
+- /* if (b->break_on_exception == 1)
+- {
+- /* Assume that cond has 16 elements, the 15th
+- being the exception *//*
+- if (b->cond && b->cond->nelts == 16)
+- {
+- ui_out_text (uiout, "on ");
+- ui_out_field_string (uiout, "exception",
+- SYMBOL_NAME (b->cond->elts[14].symbol));
+- }
+- else
+- ui_out_text (uiout, "on all exceptions");
+- }
+- else if (b->break_on_exception == 2)
+- ui_out_text (uiout, "on unhandled exception");
+- else if (b->break_on_exception == 3)
+- ui_out_text (uiout, "on assert failure");
+- #else
+- if (b->break_on_exception == 1)
+- { */
+- /* Assume that cond has 16 elements, the 15th
+- being the exception *//*
+- if (b->cond && b->cond->nelts == 16)
+- {
+- fputs_filtered ("on ", gdb_stdout);
+- fputs_filtered (SYMBOL_NAME
+- (b->cond->elts[14].symbol), gdb_stdout);
+- }
+- else
+- fputs_filtered ("on all exceptions", gdb_stdout);
+- }
+- else if (b->break_on_exception == 2)
+- fputs_filtered ("on unhandled exception", gdb_stdout);
+- else if (b->break_on_exception == 3)
+- fputs_filtered ("on assert failure", gdb_stdout);
+- */
++#ifdef GNAT_GDB
++ if (b->task != 0)
++ {
++ ui_out_text (uiout, " task ");
++ ui_out_field_int (uiout, "task", b->task);
++ }
++#endif
+ }
+
+ int
+@@ -5043,91 +6316,148 @@
+ char *type_name = type_name_no_tag (SYMBOL_TYPE (sym));
+
+ return (SYMBOL_CLASS (sym) != LOC_TYPEDEF
+- && SYMBOL_CLASS (sym) != LOC_BLOCK
+- && SYMBOL_CLASS (sym) != LOC_CONST
+- && type_name != NULL && DEPRECATED_STREQ (type_name, "exception"));
++ && SYMBOL_CLASS (sym) != LOC_BLOCK
++ && SYMBOL_CLASS (sym) != LOC_CONST
++ && type_name != NULL && strcmp (type_name, "exception") == 0);
+ }
+
+ int
+ ada_maybe_exception_partial_symbol (struct partial_symbol *sym)
+ {
+ return (SYMBOL_CLASS (sym) != LOC_TYPEDEF
+- && SYMBOL_CLASS (sym) != LOC_BLOCK
+- && SYMBOL_CLASS (sym) != LOC_CONST);
++ && SYMBOL_CLASS (sym) != LOC_BLOCK
++ && SYMBOL_CLASS (sym) != LOC_CONST);
++}
++
++/* Cause the appropriate error if no appropriate runtime symbol is
++ found to set a breakpoint, using ERR_DESC to describe the
++ breakpoint. */
++
++static void
++error_breakpoint_runtime_sym_not_found (const char *err_desc)
++{
++ /* If we are not debugging an Ada program, we can not put exception
++ breakpoints! */
++
++ if (ada_update_initial_language (language_unknown, NULL) != language_ada)
++ error ("Unable to break on %s. Is this an Ada main program?", err_desc);
++
++ /* If the symbol does not exist, then check that the program is
++ already started, to make sure that shared libraries have been
++ loaded. If it is not started, this may mean that the symbol is
++ in a shared library. */
++
++ if (ptid_get_pid (inferior_ptid) == 0)
++ error ("Unable to break on %s. Try to start the program first.", err_desc);
++
++ /* At this point, we know that we are debugging an Ada program and
++ that the inferior has been started, but we still are not able to
++ find the run-time symbols. That can mean that we are in
++ configurable run time mode, or that a-except as been optimized
++ out by the linker... In any case, at this point it is not worth
++ supporting this feature. */
++
++ error ("Cannot break on %s in this configuration.", err_desc);
++}
++
++/* Test if NAME is currently defined, and that either ALLOW_TRAMP or
++ the symbol is not a shared-library trampoline. Return the result of
++ the test. */
++
++static int
++is_runtime_sym_defined (const char *name, int allow_tramp)
++{
++ struct minimal_symbol *msym;
++
++ msym = lookup_minimal_symbol (name, NULL, NULL);
++ return (msym != NULL && msym->type != mst_unknown
++ && (allow_tramp || msym->type != mst_solib_trampoline));
+ }
+
+ /* If ARG points to an Ada exception or assert breakpoint, rewrite
+- into equivalent form. Return resulting argument string. Set
++ into equivalent form. Return resulting argument string. Set
+ *BREAK_ON_EXCEPTIONP to 1 for ordinary break on exception, 2 for
+- break on unhandled, 3 for assert, 0 otherwise. */
++ break on unhandled, 3 for assert, 0 otherwise. */
++
+ char *
+ ada_breakpoint_rewrite (char *arg, int *break_on_exceptionp)
+ {
+ if (arg == NULL)
+ return arg;
+ *break_on_exceptionp = 0;
+- /* FIXME: language_ada should be defined in defs.h */
+- /* if (current_language->la_language == language_ada
+- && DEPRECATED_STREQN (arg, "exception", 9) &&
+- (arg[9] == ' ' || arg[9] == '\t' || arg[9] == '\0'))
+- {
+- char *tok, *end_tok;
+- int toklen;
+-
+- *break_on_exceptionp = 1;
+-
+- tok = arg+9;
+- while (*tok == ' ' || *tok == '\t')
+- tok += 1;
+-
+- end_tok = tok;
+-
+- while (*end_tok != ' ' && *end_tok != '\t' && *end_tok != '\000')
+- end_tok += 1;
+-
+- toklen = end_tok - tok;
+-
+- arg = (char*) xmalloc (sizeof ("__gnat_raise_nodefer_with_msg if "
+- "long_integer(e) = long_integer(&)")
+- + toklen + 1);
+- make_cleanup (xfree, arg);
+- if (toklen == 0)
+- strcpy (arg, "__gnat_raise_nodefer_with_msg");
+- else if (DEPRECATED_STREQN (tok, "unhandled", toklen))
+- {
+- *break_on_exceptionp = 2;
+- strcpy (arg, "__gnat_unhandled_exception");
+- }
+- else
+- {
+- sprintf (arg, "__gnat_raise_nodefer_with_msg if "
+- "long_integer(e) = long_integer(&%.*s)",
+- toklen, tok);
+- }
+- }
+- else if (current_language->la_language == language_ada
+- && DEPRECATED_STREQN (arg, "assert", 6) &&
+- (arg[6] == ' ' || arg[6] == '\t' || arg[6] == '\0'))
+- {
+- char *tok = arg + 6;
+-
+- *break_on_exceptionp = 3;
+-
+- arg = (char*)
+- xmalloc (sizeof ("system__assertions__raise_assert_failure")
+- + strlen (tok) + 1);
+- make_cleanup (xfree, arg);
+- sprintf (arg, "system__assertions__raise_assert_failure%s", tok);
+- }
+- */
++ if (current_language->la_language == language_ada
++ && strncmp (arg, "exception", 9) == 0
++ && (arg[9] == ' ' || arg[9] == '\t' || arg[9] == '\0'))
++ {
++ char *tok, *end_tok;
++ int toklen;
++ int has_exception_propagation =
++ is_runtime_sym_defined (raise_sym_name, 1);
++
++ *break_on_exceptionp = 1;
++
++ tok = arg + 9;
++ while (*tok == ' ' || *tok == '\t')
++ tok += 1;
++
++ end_tok = tok;
++
++ while (*end_tok != ' ' && *end_tok != '\t' && *end_tok != '\000')
++ end_tok += 1;
++
++ toklen = end_tok - tok;
++
++ arg = (char *) xmalloc (sizeof (longest_exception_template) + toklen);
++ make_cleanup (xfree, arg);
++ if (toklen == 0)
++ {
++ if (has_exception_propagation)
++ sprintf (arg, "'%s'", raise_sym_name);
++ else
++ error_breakpoint_runtime_sym_not_found ("exception");
++ }
++ else if (strncmp (tok, "unhandled", toklen) == 0)
++ {
++ if (is_runtime_sym_defined (raise_unhandled_sym_name, 1))
++ sprintf (arg, "'%s'", raise_unhandled_sym_name);
++ else
++ error_breakpoint_runtime_sym_not_found ("exception");
++
++ *break_on_exceptionp = 2;
++ }
++ else
++ {
++ if (is_runtime_sym_defined (raise_sym_name, 0))
++ sprintf (arg, "'%s' if long_integer(e) = long_integer(&%.*s)",
++ raise_sym_name, toklen, tok);
++ else
++ error_breakpoint_runtime_sym_not_found ("specific exception");
++ }
++ }
++ else if (current_language->la_language == language_ada
++ && strncmp (arg, "assert", 6) == 0
++ && (arg[6] == ' ' || arg[6] == '\t' || arg[6] == '\0'))
++ {
++ char *tok = arg + 6;
++
++ if (!is_runtime_sym_defined (raise_assert_sym_name, 1))
++ error_breakpoint_runtime_sym_not_found ("failed assertion");
++
++ *break_on_exceptionp = 3;
++
++ arg =
++ (char *) xmalloc (sizeof (raise_assert_sym_name) + strlen (tok) + 2);
++ make_cleanup (xfree, arg);
++ sprintf (arg, "'%s'%s", raise_assert_sym_name, tok);
++ }
+ return arg;
+ }
+ \f
+
+- /* Field Access */
++ /* Field Access */
+
+ /* True if field number FIELD_NUM in struct or union type TYPE is supposed
+- to be invisible to users. */
++ to be invisible to users. */
+
+ int
+ ada_is_ignored_field (struct type *type, int field_num)
+@@ -5138,30 +6468,42 @@
+ {
+ const char *name = TYPE_FIELD_NAME (type, field_num);
+ return (name == NULL
+- || (name[0] == '_' && !DEPRECATED_STREQN (name, "_parent", 7)));
++ || (name[0] == '_' && strncmp (name, "_parent", 7) != 0));
+ }
+ }
+
+-/* True iff structure type TYPE has a tag field. */
++/* True iff TYPE has a tag field. If REFOK, then TYPE may also be a
++ pointer or reference type whose ultimate target has a tag field. */
+
+ int
+-ada_is_tagged_type (struct type *type)
++ada_is_tagged_type (struct type *type, int refok)
+ {
+- if (type == NULL || TYPE_CODE (type) != TYPE_CODE_STRUCT)
+- return 0;
++ return (ada_lookup_struct_elt_type (type, "_tag", refok, 1, NULL) != NULL);
++}
+
+- return (ada_lookup_struct_elt_type (type, "_tag", 1, NULL) != NULL);
++/* True iff TYPE represents the type of X'Tag */
++
++int
++ada_is_tag_type (struct type *type)
++{
++ if (type == NULL || TYPE_CODE (type) != TYPE_CODE_PTR)
++ return 0;
++ else {
++ const char *name = ada_type_name (TYPE_TARGET_TYPE (type));
++ return (name != NULL
++ && strcmp (name, "ada__tags__dispatch_table") == 0);
++ }
+ }
+
+-/* The type of the tag on VAL. */
++/* The type of the tag on VAL. */
+
+ struct type *
+ ada_tag_type (struct value *val)
+ {
+- return ada_lookup_struct_elt_type (VALUE_TYPE (val), "_tag", 0, NULL);
++ return ada_lookup_struct_elt_type (VALUE_TYPE (val), "_tag", 1, 0, NULL);
+ }
+
+-/* The value of the tag on VAL. */
++/* The value of the tag on VAL. */
+
+ struct value *
+ ada_value_tag (struct value *val)
+@@ -5169,7 +6511,84 @@
+ return ada_value_struct_elt (val, "_tag", "record");
+ }
+
+-/* The parent type of TYPE, or NULL if none. */
++/* The value of the tag on the object of type TYPE whose contents are
++ saved at VALADDR, if it is non-null, or is at memory address
++ ADDRESS. */
++
++static struct value *
++value_tag_from_contents_and_address (struct type *type, char *valaddr,
++ CORE_ADDR address)
++{
++ int tag_byte_offset, dummy1, dummy2;
++ struct type *tag_type;
++ if (find_struct_field ("_tag", type, 0, &tag_type, &tag_byte_offset,
++ &dummy1, &dummy2))
++ {
++ char *valaddr1 = (valaddr == NULL) ? NULL : valaddr + tag_byte_offset;
++ CORE_ADDR address1 = (address == 0) ? 0 : address + tag_byte_offset;
++
++ return value_from_contents_and_address (tag_type, valaddr1, address1);
++ }
++ return NULL;
++}
++
++static struct type *
++type_from_tag (struct value *tag)
++{
++ const char *type_name = ada_tag_name (tag);
++ if (type_name != NULL)
++ return ada_find_any_type (ada_encode (type_name));
++ return NULL;
++}
++
++struct tag_args {
++ struct value *tag;
++ char *name;
++};
++
++/* Wrapper function used by ada_tag_name. Given a struct tag_args*
++ value ARGS, sets ARGS->name to the tag name of ARGS->tag.
++ The value stored in ARGS->name is valid until the next call to
++ ada_tag_name_1. */
++
++static int
++ada_tag_name_1 (void *args0)
++{
++ struct tag_args *args = (struct tag_args *) args0;
++ static char name[1024];
++ char* p;
++ struct value *val;
++ args->name = NULL;
++ val = ada_value_struct_elt (args->tag, "tsd", NULL);
++ if (val == NULL)
++ return 0;
++ val = ada_value_struct_elt (val, "expanded_name", NULL);
++ if (val == NULL)
++ return 0;
++ read_memory_string (value_as_address (val), name, sizeof (name) - 1);
++ for (p = name; *p != '\0'; p += 1)
++ if (isalpha (*p))
++ *p = tolower (*p);
++ args->name = name;
++ return 0;
++}
++
++/* The type name of the dynamic type denoted by the 'tag value TAG, as
++ * a C string. */
++
++const char *
++ada_tag_name (struct value *tag)
++{
++ struct tag_args args;
++ if (! ada_is_tag_type (VALUE_TYPE (tag)))
++ return NULL;
++ args.tag = tag;
++ args.name = NULL;
++ catch_errors (ada_tag_name_1, &args, NULL, RETURN_MASK_ALL);
++ return args.name;
++}
++
++/* The parent type of TYPE, or NULL if none. */
+
+ struct type *
+ ada_parent_type (struct type *type)
+@@ -5188,66 +6607,69 @@
+ return NULL;
+ }
+
+-/* True iff field number FIELD_NUM of structure type TYPE contains the
+- parent-type (inherited) fields of a derived type. Assumes TYPE is
+- a structure type with at least FIELD_NUM+1 fields. */
++/* True iff field number FIELD_NUM of structure type TYPE contains the
++ parent-type (inherited) fields of a derived type. Assumes TYPE is
++ a structure type with at least FIELD_NUM+1 fields. */
+
+ int
+ ada_is_parent_field (struct type *type, int field_num)
+ {
+ const char *name = TYPE_FIELD_NAME (check_typedef (type), field_num);
+- return (name != NULL &&
+- (DEPRECATED_STREQN (name, "PARENT", 6) || DEPRECATED_STREQN (name, "_parent", 7)));
++ return (name != NULL
++ && (strncmp (name, "PARENT", 6) == 0
++ || strncmp (name, "_parent", 7) == 0));
+ }
+
+-/* True iff field number FIELD_NUM of structure type TYPE is a
++/* True iff field number FIELD_NUM of structure type TYPE is a
+ transparent wrapper field (which should be silently traversed when doing
+- field selection and flattened when printing). Assumes TYPE is a
++ field selection and flattened when printing). Assumes TYPE is a
+ structure type with at least FIELD_NUM+1 fields. Such fields are always
+- structures. */
++ structures. */
+
+ int
+ ada_is_wrapper_field (struct type *type, int field_num)
+ {
+ const char *name = TYPE_FIELD_NAME (type, field_num);
+ return (name != NULL
+- && (DEPRECATED_STREQN (name, "PARENT", 6) || DEPRECATED_STREQ (name, "REP")
+- || DEPRECATED_STREQN (name, "_parent", 7)
+- || name[0] == 'S' || name[0] == 'R' || name[0] == 'O'));
++ && (strncmp (name, "PARENT", 6) == 0
++ || strcmp (name, "REP") == 0
++ || strncmp (name, "_parent", 7) == 0
++ || name[0] == 'S' || name[0] == 'R' || name[0] == 'O'));
+ }
+
+-/* True iff field number FIELD_NUM of structure or union type TYPE
+- is a variant wrapper. Assumes TYPE is a structure type with at least
+- FIELD_NUM+1 fields. */
++/* True iff field number FIELD_NUM of structure or union type TYPE
++ is a variant wrapper. Assumes TYPE is a structure type with at least
++ FIELD_NUM+1 fields. */
+
+ int
+ ada_is_variant_part (struct type *type, int field_num)
+ {
+ struct type *field_type = TYPE_FIELD_TYPE (type, field_num);
+ return (TYPE_CODE (field_type) == TYPE_CODE_UNION
+- || (is_dynamic_field (type, field_num)
+- && TYPE_CODE (TYPE_TARGET_TYPE (field_type)) ==
+- TYPE_CODE_UNION));
++ || (is_dynamic_field (type, field_num)
++ && TYPE_CODE (TYPE_TARGET_TYPE (field_type)) ==
++ TYPE_CODE_UNION));
+ }
+
+ /* Assuming that VAR_TYPE is a variant wrapper (type of the variant part)
+- whose discriminants are contained in the record type OUTER_TYPE,
++ whose discriminants are contained in the record type OUTER_TYPE,
+ returns the type of the controlling discriminant for the variant. */
+
+ struct type *
+ ada_variant_discrim_type (struct type *var_type, struct type *outer_type)
+ {
+ char *name = ada_variant_discrim_name (var_type);
+- struct type *type = ada_lookup_struct_elt_type (outer_type, name, 1, NULL);
++ struct type *type =
++ ada_lookup_struct_elt_type (outer_type, name, 1, 1, NULL);
+ if (type == NULL)
+ return builtin_type_int;
+ else
+ return type;
+ }
+
+-/* Assuming that TYPE is the type of a variant wrapper, and FIELD_NUM is a
++/* Assuming that TYPE is the type of a variant wrapper, and FIELD_NUM is a
+ valid field number within it, returns 1 iff field FIELD_NUM of TYPE
+- represents a 'when others' clause; otherwise 0. */
++ represents a 'when others' clause; otherwise 0. */
+
+ int
+ ada_is_others_clause (struct type *type, int field_num)
+@@ -5257,8 +6679,8 @@
+ }
+
+ /* Assuming that TYPE0 is the type of the variant part of a record,
+- returns the name of the discriminant controlling the variant. The
+- value is valid until the next call to ada_variant_discrim_name. */
++ returns the name of the discriminant controlling the variant.
++ The value is valid until the next call to ada_variant_discrim_name. */
+
+ char *
+ ada_variant_discrim_name (struct type *type0)
+@@ -5283,8 +6705,8 @@
+ for (discrim_end = name + strlen (name) - 6; discrim_end != name;
+ discrim_end -= 1)
+ {
+- if (DEPRECATED_STREQN (discrim_end, "___XVN", 6))
+- break;
++ if (strncmp (discrim_end, "___XVN", 6) == 0)
++ break;
+ }
+ if (discrim_end == name)
+ return "";
+@@ -5293,10 +6715,11 @@
+ discrim_start -= 1)
+ {
+ if (discrim_start == name + 1)
+- return "";
+- if ((discrim_start > name + 3 && DEPRECATED_STREQN (discrim_start - 3, "___", 3))
+- || discrim_start[-1] == '.')
+- break;
++ return "";
++ if ((discrim_start > name + 3
++ && strncmp (discrim_start - 3, "___", 3) == 0)
++ || discrim_start[-1] == '.')
++ break;
+ }
+
+ GROW_VECT (result, result_len, discrim_end - discrim_start + 1);
+@@ -5305,13 +6728,13 @@
+ return result;
+ }
+
+-/* Scan STR for a subtype-encoded number, beginning at position K. Put the
+- position of the character just past the number scanned in *NEW_K,
+- if NEW_K!=NULL. Put the scanned number in *R, if R!=NULL. Return 1
+- if there was a valid number at the given position, and 0 otherwise. A
+- "subtype-encoded" number consists of the absolute value in decimal,
+- followed by the letter 'm' to indicate a negative number. Assumes 0m
+- does not occur. */
++/* Scan STR for a subtype-encoded number, beginning at position K.
++ Put the position of the character just past the number scanned in
++ *NEW_K, if NEW_K!=NULL. Put the scanned number in *R, if R!=NULL.
++ Return 1 if there was a valid number at the given position, and 0
++ otherwise. A "subtype-encoded" number consists of the absolute value
++ in decimal, followed by the letter 'm' to indicate a negative number.
++ Assumes 0m does not occur. */
+
+ int
+ ada_scan_number (const char str[], int k, LONGEST * R, int *new_k)
+@@ -5321,9 +6744,9 @@
+ if (!isdigit (str[k]))
+ return 0;
+
+- /* Do it the hard way so as not to make any assumption about
++ /* Do it the hard way so as not to make any assumption about
+ the relationship of unsigned long (%lu scan format code) and
+- LONGEST. */
++ LONGEST. */
+ RU = 0;
+ while (isdigit (str[k]))
+ {
+@@ -5334,26 +6757,26 @@
+ if (str[k] == 'm')
+ {
+ if (R != NULL)
+- *R = (-(LONGEST) (RU - 1)) - 1;
++ *R = (-(LONGEST) (RU - 1)) - 1;
+ k += 1;
+ }
+ else if (R != NULL)
+ *R = (LONGEST) RU;
+
+- /* NOTE on the above: Technically, C does not say what the results of
++ /* NOTE on the above: Technically, C does not say what the results of
+ - (LONGEST) RU or (LONGEST) -RU are for RU == largest positive
+ number representable as a LONGEST (although either would probably work
+ in most implementations). When RU>0, the locution in the then branch
+- above is always equivalent to the negative of RU. */
++ above is always equivalent to the negative of RU. */
+
+ if (new_k != NULL)
+ *new_k = k;
+ return 1;
+ }
+
+-/* Assuming that TYPE is a variant part wrapper type (a VARIANTS field),
+- and FIELD_NUM is a valid field number within it, returns 1 iff VAL is
+- in the range encoded by field FIELD_NUM of TYPE; otherwise 0. */
++/* Assuming that TYPE is a variant part wrapper type (a VARIANTS field),
++ and FIELD_NUM is a valid field number within it, returns 1 iff VAL is
++ in the range encoded by field FIELD_NUM of TYPE; otherwise 0. */
+
+ int
+ ada_in_variant (LONGEST val, struct type *type, int field_num)
+@@ -5365,53 +6788,53 @@
+ while (1)
+ {
+ switch (name[p])
+- {
+- case '\0':
+- return 0;
+- case 'S':
+- {
+- LONGEST W;
+- if (!ada_scan_number (name, p + 1, &W, &p))
+- return 0;
+- if (val == W)
+- return 1;
+- break;
+- }
+- case 'R':
+- {
+- LONGEST L, U;
+- if (!ada_scan_number (name, p + 1, &L, &p)
+- || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
+- return 0;
+- if (val >= L && val <= U)
+- return 1;
+- break;
+- }
+- case 'O':
+- return 1;
+- default:
+- return 0;
+- }
++ {
++ case '\0':
++ return 0;
++ case 'S':
++ {
++ LONGEST W;
++ if (!ada_scan_number (name, p + 1, &W, &p))
++ return 0;
++ if (val == W)
++ return 1;
++ break;
++ }
++ case 'R':
++ {
++ LONGEST L, U;
++ if (!ada_scan_number (name, p + 1, &L, &p)
++ || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
++ return 0;
++ if (val >= L && val <= U)
++ return 1;
++ break;
++ }
++ case 'O':
++ return 1;
++ default:
++ return 0;
++ }
+ }
+ }
+
+-/* Given a value ARG1 (offset by OFFSET bytes)
+- of a struct or union type ARG_TYPE,
+- extract and return the value of one of its (non-static) fields.
+- FIELDNO says which field. Differs from value_primitive_field only
+- in that it can handle packed values of arbitrary type. */
++/* FIXME: Lots of redundancy below. Try to consolidate. */
++
++/* Given a value ARG1 (offset by OFFSET bytes) of a struct or union type
++ ARG_TYPE, extract and return the value of one of its (non-static)
++ fields. FIELDNO says which field. Differs from value_primitive_field
++ only in that it can handle packed values of arbitrary type. */
+
+-struct value *
++static struct value *
+ ada_value_primitive_field (struct value *arg1, int offset, int fieldno,
+- struct type *arg_type)
++ struct type *arg_type)
+ {
+- struct value *v;
+ struct type *type;
+
+ CHECK_TYPEDEF (arg_type);
+ type = TYPE_FIELD_TYPE (arg_type, fieldno);
+
+- /* Handle packed fields */
++ /* Handle packed fields. */
+
+ if (TYPE_FIELD_BITSIZE (arg_type, fieldno) != 0)
+ {
+@@ -5419,23 +6842,86 @@
+ int bit_size = TYPE_FIELD_BITSIZE (arg_type, fieldno);
+
+ return ada_value_primitive_packed_val (arg1, VALUE_CONTENTS (arg1),
+- offset + bit_pos / 8,
+- bit_pos % 8, bit_size, type);
++ offset + bit_pos / 8,
++ bit_pos % 8, bit_size, type);
+ }
+ else
+ return value_primitive_field (arg1, offset, fieldno, arg_type);
+ }
+
++/* Find field with name NAME in object of type TYPE. If found, return 1
++ after setting *FIELD_TYPE_P to the field's type, *BYTE_OFFSET_P to
++ OFFSET + the byte offset of the field within an object of that type,
++ *BIT_OFFSET_P to the bit offset modulo byte size of the field, and
++ *BIT_SIZE_P to its size in bits if the field is packed, and 0 otherwise.
++ Looks inside wrappers for the field. Returns 0 if field not
++ found. */
++static int
++find_struct_field (char *name, struct type *type, int offset,
++ struct type **field_type_p,
++ int *byte_offset_p, int *bit_offset_p, int *bit_size_p)
++{
++ int i;
++
++ CHECK_TYPEDEF (type);
++ *field_type_p = NULL;
++ *byte_offset_p = *bit_offset_p = *bit_size_p = 0;
++
++ for (i = TYPE_NFIELDS (type) - 1; i >= 0; i -= 1)
++ {
++ int bit_pos = TYPE_FIELD_BITPOS (type, i);
++ int fld_offset = offset + bit_pos / 8;
++ char *t_field_name = TYPE_FIELD_NAME (type, i);
++
++ if (t_field_name == NULL)
++ continue;
++
++ else if (field_name_match (t_field_name, name))
++ {
++ int bit_size = TYPE_FIELD_BITSIZE (type, i);
++ *field_type_p = TYPE_FIELD_TYPE (type, i);
++ *byte_offset_p = fld_offset;
++ *bit_offset_p = bit_pos % 8;
++ *bit_size_p = bit_size;
++ return 1;
++ }
++ else if (ada_is_wrapper_field (type, i))
++ {
++ if (find_struct_field (name, TYPE_FIELD_TYPE (type, i), fld_offset,
++ field_type_p, byte_offset_p, bit_offset_p,
++ bit_size_p))
++ return 1;
++ }
++ else if (ada_is_variant_part (type, i))
++ {
++ int j;
++ struct type *field_type = check_typedef (TYPE_FIELD_TYPE (type, i));
++
++ for (j = TYPE_NFIELDS (field_type) - 1; j >= 0; j -= 1)
++ {
++ if (find_struct_field (name, TYPE_FIELD_TYPE (field_type, j),
++ fld_offset
++ + TYPE_FIELD_BITPOS (field_type, j)/8,
++ field_type_p, byte_offset_p, bit_offset_p,
++ bit_size_p))
++ return 1;
++ }
++ }
++ }
++ return 0;
++}
++
++
+
+-/* Look for a field NAME in ARG. Adjust the address of ARG by OFFSET bytes,
++/* Look for a field NAME in ARG. Adjust the address of ARG by OFFSET bytes,
+ and search in it assuming it has (class) type TYPE.
+ If found, return value, else return NULL.
+
+- Searches recursively through wrapper fields (e.g., '_parent'). */
++ Searches recursively through wrapper fields (e.g., '_parent'). */
+
+-struct value *
++static struct value *
+ ada_search_struct_field (char *name, struct value *arg, int offset,
+- struct type *type)
++ struct type *type)
+ {
+ int i;
+ CHECK_TYPEDEF (type);
+@@ -5445,128 +6931,203 @@
+ char *t_field_name = TYPE_FIELD_NAME (type, i);
+
+ if (t_field_name == NULL)
+- continue;
++ continue;
+
+ else if (field_name_match (t_field_name, name))
+- return ada_value_primitive_field (arg, offset, i, type);
++ return ada_value_primitive_field (arg, offset, i, type);
+
+ else if (ada_is_wrapper_field (type, i))
+- {
+- struct value *v = ada_search_struct_field (name, arg,
+- offset +
+- TYPE_FIELD_BITPOS (type,
+- i) /
+- 8,
+- TYPE_FIELD_TYPE (type,
+- i));
+- if (v != NULL)
+- return v;
+- }
++ {
++ struct value *v =
++ ada_search_struct_field (name, arg,
++ offset + TYPE_FIELD_BITPOS (type, i) / 8,
++ TYPE_FIELD_TYPE (type, i));
++ if (v != NULL)
++ return v;
++ }
+
+ else if (ada_is_variant_part (type, i))
+- {
+- int j;
+- struct type *field_type = check_typedef (TYPE_FIELD_TYPE (type, i));
+- int var_offset = offset + TYPE_FIELD_BITPOS (type, i) / 8;
+-
+- for (j = TYPE_NFIELDS (field_type) - 1; j >= 0; j -= 1)
+- {
+- struct value *v = ada_search_struct_field (name, arg,
+- var_offset
+- +
+- TYPE_FIELD_BITPOS
+- (field_type, j) / 8,
+- TYPE_FIELD_TYPE
+- (field_type, j));
+- if (v != NULL)
+- return v;
+- }
+- }
++ {
++ int j;
++ struct type *field_type = check_typedef (TYPE_FIELD_TYPE (type, i));
++ int var_offset = offset + TYPE_FIELD_BITPOS (type, i) / 8;
++
++ for (j = TYPE_NFIELDS (field_type) - 1; j >= 0; j -= 1)
++ {
++ struct value *v =
++ ada_search_struct_field (name, arg,
++ var_offset
++ + TYPE_FIELD_BITPOS (field_type, j)/8,
++ TYPE_FIELD_TYPE (field_type, j));
++ if (v != NULL)
++ return v;
++ }
++ }
+ }
+ return NULL;
+ }
+
+-/* Given ARG, a value of type (pointer to a)* structure/union,
+- extract the component named NAME from the ultimate target structure/union
+- and return it as a value with its appropriate type.
++/* Given ARG, a value of type (pointer or reference to a)*
++ structure/union, extract the component named NAME from the ultimate
++ target structure/union and return it as a value with its
++ appropriate type. If ARG is a pointer or reference and the field
++ is not packed, returns a reference to the field, otherwise the
++ value of the field (an lvalue if ARG is an lvalue).
+
+- The routine searches for NAME among all members of the structure itself
+- and (recursively) among all members of any wrapper members
++ The routine searches for NAME among all members of the structure itself
++ and (recursively) among all members of any wrapper members
+ (e.g., '_parent').
+
+- ERR is a name (for use in error messages) that identifies the class
+- of entity that ARG is supposed to be. */
++ ERR is a name (for use in error messages) that identifies the class
++ of entity that ARG is supposed to be. ERR may be null, indicating
++ that on error, the function simply returns NULL, and does not
++ throw an error. (FIXME: True only if ARG is a pointer or reference
++ at the moment). */
+
+ struct value *
+ ada_value_struct_elt (struct value *arg, char *name, char *err)
+ {
+- struct type *t;
++ struct type *t, *t1;
+ struct value *v;
+
+- arg = ada_coerce_ref (arg);
+- t = check_typedef (VALUE_TYPE (arg));
++ v = NULL;
++ t1 = t = check_typedef (VALUE_TYPE (arg));
++ if (TYPE_CODE (t) == TYPE_CODE_REF)
++ {
++ t1 = TYPE_TARGET_TYPE (t);
++ if (t1 == NULL)
++ {
++ if (err == NULL)
++ return NULL;
++ else
++ error ("Bad value type in a %s.", err);
++ }
++ CHECK_TYPEDEF (t1);
++ if (TYPE_CODE (t1) == TYPE_CODE_PTR)
++ {
++ COERCE_REF (arg);
++ t = t1;
++ }
++ }
+
+- /* Follow pointers until we get to a non-pointer. */
++ while (TYPE_CODE (t) == TYPE_CODE_PTR)
++ {
++ t1 = TYPE_TARGET_TYPE (t);
++ if (t1 == NULL)
++ {
++ if (err == NULL)
++ return NULL;
++ else
++ error ("Bad value type in a %s.", err);
++ }
++ CHECK_TYPEDEF (t1);
++ if (TYPE_CODE (t1) == TYPE_CODE_PTR)
++ {
++ arg = value_ind (arg);
++ t = t1;
++ }
++ else
++ break;
++ }
+
+- while (TYPE_CODE (t) == TYPE_CODE_PTR || TYPE_CODE (t) == TYPE_CODE_REF)
++ if (TYPE_CODE (t1) != TYPE_CODE_STRUCT && TYPE_CODE (t1) != TYPE_CODE_UNION)
+ {
+- arg = ada_value_ind (arg);
+- t = check_typedef (VALUE_TYPE (arg));
++ if (err == NULL)
++ return NULL;
++ else
++ error ("Attempt to extract a component of a value that is not a %s.",
++ err);
+ }
+
+- if (TYPE_CODE (t) != TYPE_CODE_STRUCT && TYPE_CODE (t) != TYPE_CODE_UNION)
+- error ("Attempt to extract a component of a value that is not a %s.",
+- err);
++ if (t1 == t)
++ v = ada_search_struct_field (name, arg, 0, t);
++ else
++ {
++ int bit_offset, bit_size, byte_offset;
++ struct type *field_type;
++ CORE_ADDR address;
++
++ if (TYPE_CODE (t) == TYPE_CODE_PTR)
++ address = value_as_address (arg);
++ else
++ address = unpack_pointer (t, VALUE_CONTENTS (arg));
+
+- v = ada_search_struct_field (name, arg, 0, t);
+- if (v == NULL)
++ t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL, address, NULL);
++ if (find_struct_field (name, t1, 0,
++ &field_type, &byte_offset, &bit_offset, &bit_size))
++ {
++ if (bit_size != 0)
++ {
++ arg = ada_value_ind (arg);
++ v = ada_value_primitive_packed_val (arg, NULL, byte_offset,
++ bit_offset, bit_size,
++ field_type);
++ }
++ else
++ v = value_from_pointer (lookup_reference_type (field_type),
++ address + byte_offset);
++ }
++ }
++
++ if (v == NULL && err != NULL)
+ error ("There is no member named %s.", name);
+
+ return v;
+ }
+
+ /* Given a type TYPE, look up the type of the component of type named NAME.
+- If DISPP is non-null, add its byte displacement from the beginning of a
+- structure (pointed to by a value) of type TYPE to *DISPP (does not
++ If DISPP is non-null, add its byte displacement from the beginning of a
++ structure (pointed to by a value) of type TYPE to *DISPP (does not
+ work for packed fields).
+
+ Matches any field whose name has NAME as a prefix, possibly
+- followed by "___".
++ followed by "___".
+
+- TYPE can be either a struct or union, or a pointer or reference to
+- a struct or union. If it is a pointer or reference, its target
+- type is automatically used.
++ TYPE can be either a struct or union. If REFOK, TYPE may also
++ be a (pointer or reference)+ to a struct or union, and the
++ ultimate target type will be searched.
+
+ Looks recursively into variant clauses and parent types.
+
+- If NOERR is nonzero, return NULL if NAME is not suitably defined. */
++ If NOERR is nonzero, return NULL if NAME is not suitably defined or
++ TYPE is not a type of the right kind. */
+
+-struct type *
+-ada_lookup_struct_elt_type (struct type *type, char *name, int noerr,
+- int *dispp)
++static struct type *
++ada_lookup_struct_elt_type (struct type *type, char *name, int refok,
++ int noerr, int *dispp)
+ {
+ int i;
+
+ if (name == NULL)
+ goto BadName;
+
+- while (1)
+- {
+- CHECK_TYPEDEF (type);
+- if (TYPE_CODE (type) != TYPE_CODE_PTR
+- && TYPE_CODE (type) != TYPE_CODE_REF)
+- break;
+- type = TYPE_TARGET_TYPE (type);
+- }
++ if (refok && type != NULL)
++ while (1)
++ {
++ CHECK_TYPEDEF (type);
++ if (TYPE_CODE (type) != TYPE_CODE_PTR
++ && TYPE_CODE (type) != TYPE_CODE_REF)
++ break;
++ type = TYPE_TARGET_TYPE (type);
++ }
+
+- if (TYPE_CODE (type) != TYPE_CODE_STRUCT &&
+- TYPE_CODE (type) != TYPE_CODE_UNION)
++ if (type == NULL
++ || (TYPE_CODE (type) != TYPE_CODE_STRUCT &&
++ TYPE_CODE (type) != TYPE_CODE_UNION))
+ {
+- target_terminal_ours ();
+- gdb_flush (gdb_stdout);
+- fprintf_unfiltered (gdb_stderr, "Type ");
+- type_print (type, "", gdb_stderr, -1);
+- error (" is not a structure or union type");
++ if (noerr)
++ return NULL;
++ else
++ {
++ target_terminal_ours ();
++ gdb_flush (gdb_stdout);
++ fprintf_unfiltered (gdb_stderr, "Type ");
++ if (type == NULL)
++ fprintf_unfiltered (gdb_stderr, "(null)");
++ else
++ type_print (type, "", gdb_stderr, -1);
++ error (" is not a structure or union type");
++ }
+ }
+
+ type = to_static_fixed_type (type);
+@@ -5578,46 +7139,46 @@
+ int disp;
+
+ if (t_field_name == NULL)
+- continue;
++ continue;
+
+ else if (field_name_match (t_field_name, name))
+- {
+- if (dispp != NULL)
+- *dispp += TYPE_FIELD_BITPOS (type, i) / 8;
+- return check_typedef (TYPE_FIELD_TYPE (type, i));
+- }
++ {
++ if (dispp != NULL)
++ *dispp += TYPE_FIELD_BITPOS (type, i) / 8;
++ return check_typedef (TYPE_FIELD_TYPE (type, i));
++ }
+
+ else if (ada_is_wrapper_field (type, i))
+- {
+- disp = 0;
+- t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (type, i), name,
+- 1, &disp);
+- if (t != NULL)
+- {
+- if (dispp != NULL)
+- *dispp += disp + TYPE_FIELD_BITPOS (type, i) / 8;
+- return t;
+- }
+- }
++ {
++ disp = 0;
++ t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (type, i), name,
++ 0, 1, &disp);
++ if (t != NULL)
++ {
++ if (dispp != NULL)
++ *dispp += disp + TYPE_FIELD_BITPOS (type, i) / 8;
++ return t;
++ }
++ }
+
+ else if (ada_is_variant_part (type, i))
+- {
+- int j;
+- struct type *field_type = check_typedef (TYPE_FIELD_TYPE (type, i));
+-
+- for (j = TYPE_NFIELDS (field_type) - 1; j >= 0; j -= 1)
+- {
+- disp = 0;
+- t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (field_type, j),
+- name, 1, &disp);
+- if (t != NULL)
+- {
+- if (dispp != NULL)
+- *dispp += disp + TYPE_FIELD_BITPOS (type, i) / 8;
+- return t;
+- }
+- }
+- }
++ {
++ int j;
++ struct type *field_type = check_typedef (TYPE_FIELD_TYPE (type, i));
++
++ for (j = TYPE_NFIELDS (field_type) - 1; j >= 0; j -= 1)
++ {
++ disp = 0;
++ t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (field_type, j),
++ name, 0, 1, &disp);
++ if (t != NULL)
++ {
++ if (dispp != NULL)
++ *dispp += disp + TYPE_FIELD_BITPOS (type, i) / 8;
++ return t;
++ }
++ }
++ }
+
+ }
+
+@@ -5637,12 +7198,12 @@
+
+ /* Assuming that VAR_TYPE is the type of a variant part of a record (a union),
+ within a value of type OUTER_TYPE that is stored in GDB at
+- OUTER_VALADDR, determine which variant clause (field number in VAR_TYPE,
+- numbering from 0) is applicable. Returns -1 if none are. */
++ OUTER_VALADDR, determine which variant clause (field number in VAR_TYPE,
++ numbering from 0) is applicable. Returns -1 if none are. */
+
+ int
+ ada_which_variant_applies (struct type *var_type, struct type *outer_type,
+- char *outer_valaddr)
++ char *outer_valaddr)
+ {
+ int others_clause;
+ int i;
+@@ -5653,7 +7214,7 @@
+
+ disp = 0;
+ discrim_type =
+- ada_lookup_struct_elt_type (outer_type, discrim_name, 1, &disp);
++ ada_lookup_struct_elt_type (outer_type, discrim_name, 1, 1, &disp);
+ if (discrim_type == NULL)
+ return -1;
+ discrim_val = unpack_long (discrim_type, outer_valaddr + disp);
+@@ -5662,9 +7223,9 @@
+ for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
+ {
+ if (ada_is_others_clause (var_type, i))
+- others_clause = i;
++ others_clause = i;
+ else if (ada_in_variant (discrim_val, var_type, i))
+- return i;
++ return i;
+ }
+
+ return others_clause;
+@@ -5672,13 +7233,13 @@
+ \f
+
+
+- /* Dynamic-Sized Records */
++ /* Dynamic-Sized Records */
+
+ /* Strategy: The type ostensibly attached to a value with dynamic size
+ (i.e., a size that is not statically recorded in the debugging
+ data) does not accurately reflect the size or layout of the value.
+ Our strategy is to convert these values to values with accurate,
+- conventional types that are constructed on the fly. */
++ conventional types that are constructed on the fly. */
+
+ /* There is a subtle and tricky problem here. In general, we cannot
+ determine the size of dynamic records without its data. However,
+@@ -5687,7 +7248,7 @@
+ of the type at the time of its allocation in order to reserve space
+ for GDB's internal copy of the data. That's why the
+ 'to_fixed_xxx_type' routines take (target) addresses as parameters,
+- rather than struct value*s.
++ rather than struct value*s.
+
+ However, GDB's internal history variables ($1, $2, etc.) are
+ struct value*s containing internal copies of the data that are not, in
+@@ -5705,22 +7266,22 @@
+ address, target address) triple as arguments to represent a value.
+ The host address, if non-null, is supposed to contain an internal
+ copy of the relevant data; otherwise, the program is to consult the
+- target at the target address. */
++ target at the target address. */
+
+ /* Assuming that VAL0 represents a pointer value, the result of
+ dereferencing it. Differs from value_ind in its treatment of
+- dynamic-sized types. */
++ dynamic-sized types. */
+
+ struct value *
+ ada_value_ind (struct value *val0)
+ {
+ struct value *val = unwrap_value (value_ind (val0));
+- return ada_to_fixed_value (VALUE_TYPE (val), 0,
+- VALUE_ADDRESS (val) + VALUE_OFFSET (val), val);
++ return ada_to_fixed_value (val);
+ }
+
+ /* The value resulting from dereferencing any "reference to"
+- * qualifiers on VAL0. */
++ qualifiers on VAL0. */
++
+ static struct value *
+ ada_coerce_ref (struct value *val0)
+ {
+@@ -5729,16 +7290,14 @@
+ struct value *val = val0;
+ COERCE_REF (val);
+ val = unwrap_value (val);
+- return ada_to_fixed_value (VALUE_TYPE (val), 0,
+- VALUE_ADDRESS (val) + VALUE_OFFSET (val),
+- val);
++ return ada_to_fixed_value (val);
+ }
+ else
+ return val0;
+ }
+
+ /* Return OFF rounded upward if necessary to a multiple of
+- ALIGNMENT (a power of 2). */
++ ALIGNMENT (a power of 2). */
+
+ static unsigned int
+ align_value (unsigned int off, unsigned int alignment)
+@@ -5746,22 +7305,7 @@
+ return (off + alignment - 1) & ~(alignment - 1);
+ }
+
+-/* Return the additional bit offset required by field F of template
+- type TYPE. */
+-
+-static unsigned int
+-field_offset (struct type *type, int f)
+-{
+- int n = TYPE_FIELD_BITPOS (type, f);
+- /* Kludge (temporary?) to fix problem with dwarf output. */
+- if (n < 0)
+- return (unsigned int) n & 0xffff;
+- else
+- return n;
+-}
+-
+-
+-/* Return the bit alignment required for field #F of template type TYPE. */
++/* Return the bit alignment required for field #F of template type TYPE. */
+
+ static unsigned int
+ field_alignment (struct type *type, int f)
+@@ -5770,41 +7314,98 @@
+ int len = (name == NULL) ? 0 : strlen (name);
+ int align_offset;
+
+- if (len < 8 || !isdigit (name[len - 1]))
+- return TARGET_CHAR_BIT;
++ if (!isdigit (name[len - 1]))
++ return 1;
+
+ if (isdigit (name[len - 2]))
+ align_offset = len - 2;
+ else
+ align_offset = len - 1;
+
+- if (align_offset < 7 || !DEPRECATED_STREQN ("___XV", name + align_offset - 6, 5))
++ if (align_offset < 7 || strncmp ("___XV", name + align_offset - 6, 5) != 0)
+ return TARGET_CHAR_BIT;
+
+ return atoi (name + align_offset) * TARGET_CHAR_BIT;
+ }
+
++/* Find a symbol named NAME. Ignores ambiguity. */
++
++struct symbol *
++ada_find_any_symbol (const char *name)
++{
++ struct symbol *sym;
++
++ sym = standard_lookup (name, get_selected_block (NULL), VAR_DOMAIN);
++ if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
++ return sym;
++
++ sym = standard_lookup (name, NULL, STRUCT_DOMAIN);
++ return sym;
++}
++
+ /* Find a type named NAME. Ignores ambiguity. */
++
+ struct type *
+ ada_find_any_type (const char *name)
+ {
+- struct symbol *sym;
+-
+- sym = standard_lookup (name, VAR_DOMAIN);
+- if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
+- return SYMBOL_TYPE (sym);
++ struct symbol *sym = ada_find_any_symbol (name);
+
+- sym = standard_lookup (name, STRUCT_DOMAIN);
+ if (sym != NULL)
+ return SYMBOL_TYPE (sym);
+
+ return NULL;
+ }
+
++/* Given a symbol NAME and its associated BLOCK, search all symbols
++ for its ___XR counterpart, which is the ``renaming'' symbol
++ associated to NAME. Return this symbol if found, return
++ NULL otherwise. */
++
++struct symbol *
++ada_find_renaming_symbol (const char *name, struct block *block)
++{
++ const struct symbol *function_sym = block_function (block);
++ char *rename;
++
++ if (function_sym != NULL)
++ {
++ /* If the symbol is defined inside a function, NAME is not fully
++ qualified. This means we need to prepend the function name
++ as well as adding the ``___XR'' suffix to build the name of
++ the associated renaming symbol. */
++ char *function_name = SYMBOL_LINKAGE_NAME (function_sym);
++ const int function_name_len = strlen (function_name);
++ const int rename_len = function_name_len
++ + 2 /* "__" */
++ + strlen (name)
++ + 6 /* "___XR\0" */;
++
++ /* Library-level functions are a special case, as GNAT adds
++ a ``_ada_'' prefix to the function name to avoid namespace
++ pollution. However, the renaming symbol themselves do not
++ have this prefix, so we need to skip this prefix if present. */
++ if (function_name_len > 5 /* "_ada_" */
++ && strstr (function_name, "_ada_") == function_name)
++ function_name = function_name + 5;
++
++ rename = (char *) alloca (rename_len * sizeof (char));
++ sprintf (rename, "%s__%s___XR", function_name, name);
++ }
++ else
++ {
++ const int rename_len = strlen (name) + 6;
++ rename = (char *) alloca (rename_len * sizeof (char));
++ sprintf (rename, "%s___XR", name);
++ }
++
++ return ada_find_any_symbol (rename);
++}
++
+ /* Because of GNAT encoding conventions, several GDB symbols may match a
+- given type name. If the type denoted by TYPE0 is to be preferred to
++ given type name. If the type denoted by TYPE0 is to be preferred to
+ that of TYPE1 for purposes of type printing, return non-zero;
+- otherwise return 0. */
++ otherwise return 0. */
++
+ int
+ ada_prefer_type (struct type *type0, struct type *type1)
+ {
+@@ -5816,19 +7417,22 @@
+ return 1;
+ else if (TYPE_CODE (type0) == TYPE_CODE_VOID)
+ return 0;
++ else if (TYPE_NAME (type1) == NULL && TYPE_NAME (type0) != NULL)
++ return 1;
+ else if (ada_is_packed_array_type (type0))
+ return 1;
+- else if (ada_is_array_descriptor (type0)
+- && !ada_is_array_descriptor (type1))
++ else if (ada_is_array_descriptor_type (type0)
++ && !ada_is_array_descriptor_type (type1))
+ return 1;
+ else if (ada_renaming_type (type0) != NULL
+- && ada_renaming_type (type1) == NULL)
++ && ada_renaming_type (type1) == NULL)
+ return 1;
+ return 0;
+ }
+
+ /* The name of TYPE, which is either its TYPE_NAME, or, if that is
+- null, its TYPE_TAG_NAME. Null if TYPE is null. */
++ null, its TYPE_TAG_NAME. Null if TYPE is null. */
++
+ char *
+ ada_type_name (struct type *type)
+ {
+@@ -5841,16 +7445,13 @@
+ }
+
+ /* Find a parallel type to TYPE whose name is formed by appending
+- SUFFIX to the name of TYPE. */
++ SUFFIX to the name of TYPE. */
+
+ struct type *
+ ada_find_parallel_type (struct type *type, const char *suffix)
+ {
+ static char *name;
+ static size_t name_len = 0;
+- struct symbol **syms;
+- struct block **blocks;
+- int nsyms;
+ int len;
+ char *typename = ada_type_name (type);
+
+@@ -5869,7 +7470,7 @@
+
+
+ /* If TYPE is a variable-size record type, return the corresponding template
+- type describing its fields. Otherwise, return NULL. */
++ type describing its fields. Otherwise, return NULL. */
+
+ static struct type *
+ dynamic_template_type (struct type *type)
+@@ -5882,15 +7483,15 @@
+ else
+ {
+ int len = strlen (ada_type_name (type));
+- if (len > 6 && DEPRECATED_STREQ (ada_type_name (type) + len - 6, "___XVE"))
+- return type;
++ if (len > 6 && strcmp (ada_type_name (type) + len - 6, "___XVE") == 0)
++ return type;
+ else
+- return ada_find_parallel_type (type, "___XVE");
++ return ada_find_parallel_type (type, "___XVE");
+ }
+ }
+
+ /* Assuming that TEMPL_TYPE is a union or struct type, returns
+- non-zero iff field FIELD_NUM of TEMPL_TYPE has dynamic size. */
++ non-zero iff field FIELD_NUM of TEMPL_TYPE has dynamic size. */
+
+ static int
+ is_dynamic_field (struct type *templ_type, int field_num)
+@@ -5901,21 +7502,27 @@
+ && strstr (name, "___XVL") != NULL;
+ }
+
+-/* Assuming that TYPE is a struct type, returns non-zero iff TYPE
+- contains a variant part. */
++/* The index of the variant field of TYPE, or -1 if TYPE does not
++ represent a variant record type. */
+
+ static int
+-contains_variant_part (struct type *type)
++variant_field_index (struct type *type)
+ {
+ int f;
+
+- if (type == NULL || TYPE_CODE (type) != TYPE_CODE_STRUCT
+- || TYPE_NFIELDS (type) <= 0)
+- return 0;
+- return ada_is_variant_part (type, TYPE_NFIELDS (type) - 1);
++ if (type == NULL || TYPE_CODE (type) != TYPE_CODE_STRUCT)
++ return -1;
++
++ for (f = 0; f < TYPE_NFIELDS (type); f += 1)
++ {
++ if (ada_is_variant_part (type, f))
++ return f;
++ }
++ return -1;
+ }
+
+-/* A record type with no fields, . */
++/* A record type with no fields. */
++
+ static struct type *
+ empty_record (struct objfile *objfile)
+ {
+@@ -5931,29 +7538,50 @@
+ }
+
+ /* An ordinary record type (with fixed-length fields) that describes
+- the value of type TYPE at VALADDR or ADDRESS (see comments at
+- the beginning of this section) VAL according to GNAT conventions.
+- DVAL0 should describe the (portion of a) record that contains any
++ the value of type TYPE at VALADDR or ADDRESS (see comments at
++ the beginning of this section) VAL according to GNAT conventions.
++ DVAL0 should describe the (portion of a) record that contains any
+ necessary discriminants. It should be NULL if VALUE_TYPE (VAL) is
+ an outer-level type (i.e., as opposed to a branch of a variant.) A
+ variant field (unless unchecked) is replaced by a particular branch
+- of the variant. */
+-/* NOTE: Limitations: For now, we assume that dynamic fields and
+- * variants occupy whole numbers of bytes. However, they need not be
+- * byte-aligned. */
++ of the variant.
+
+-static struct type *
+-template_to_fixed_record_type (struct type *type, char *valaddr,
+- CORE_ADDR address, struct value *dval0)
++ If not KEEP_DYNAMIC_FIELDS, then all fields whose position or
++ length are not statically known are discarded. As a consequence,
++ VALADDR, ADDRESS and DVAL0 are ignored.
++
++ NOTE: Limitations: For now, we assume that dynamic fields and
++ variants occupy whole numbers of bytes. However, they need not be
++ byte-aligned. */
++
++struct type *
++ada_template_to_fixed_record_type_1 (struct type *type, char *valaddr,
++ CORE_ADDR address, struct value *dval0,
++ int keep_dynamic_fields)
+ {
+ struct value *mark = value_mark ();
+ struct value *dval;
+ struct type *rtype;
+ int nfields, bit_len;
++ int variant_field;
+ long off;
++ int fld_bit_len, bit_incr;
+ int f;
+
+- nfields = TYPE_NFIELDS (type);
++ /* Compute the number of fields in this record type that are going
++ 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);
++ else
++ {
++ nfields = 0;
++ while (nfields < TYPE_NFIELDS (type)
++ && !ada_is_variant_part (type, nfields)
++ && !is_dynamic_field (type, nfields))
++ nfields++;
++ }
++
+ rtype = alloc_type (TYPE_OBJFILE (type));
+ TYPE_CODE (rtype) = TYPE_CODE_STRUCT;
+ INIT_CPLUS_SPECIFIC (rtype);
+@@ -5963,83 +7591,100 @@
+ memset (TYPE_FIELDS (rtype), 0, sizeof (struct field) * nfields);
+ TYPE_NAME (rtype) = ada_type_name (type);
+ TYPE_TAG_NAME (rtype) = NULL;
+- /* FIXME: TYPE_FLAG_FIXED_INSTANCE should be defined in
+- gdbtypes.h */
+- /* TYPE_FLAGS (rtype) |= TYPE_FLAG_FIXED_INSTANCE; */
++ TYPE_FLAGS (rtype) |= TYPE_FLAG_FIXED_INSTANCE;
+
+ off = 0;
+ bit_len = 0;
++ variant_field = -1;
++
+ for (f = 0; f < nfields; f += 1)
+ {
+- int fld_bit_len, bit_incr;
+ off =
+- align_value (off,
+- field_alignment (type, f)) + TYPE_FIELD_BITPOS (type, f);
+- /* NOTE: used to use field_offset above, but that causes
+- * problems with really negative bit positions. So, let's
+- * rediscover why we needed field_offset and fix it properly. */
++ align_value (off,
++ field_alignment (type, f)) + TYPE_FIELD_BITPOS (type, f);
+ TYPE_FIELD_BITPOS (rtype, f) = off;
+ TYPE_FIELD_BITSIZE (rtype, f) = 0;
+- TYPE_FIELD_STATIC_KIND (rtype, f) = 0;
+
+ if (ada_is_variant_part (type, f))
+- {
+- struct type *branch_type;
+-
+- if (dval0 == NULL)
+- dval = value_from_contents_and_address (rtype, valaddr, address);
+- else
+- dval = dval0;
+-
+- branch_type =
+- to_fixed_variant_branch_type
+- (TYPE_FIELD_TYPE (type, f),
+- cond_offset_host (valaddr, off / TARGET_CHAR_BIT),
+- cond_offset_target (address, off / TARGET_CHAR_BIT), dval);
+- if (branch_type == NULL)
+- TYPE_NFIELDS (rtype) -= 1;
+- else
+- {
+- TYPE_FIELD_TYPE (rtype, f) = branch_type;
+- TYPE_FIELD_NAME (rtype, f) = "S";
+- }
+- bit_incr = 0;
+- fld_bit_len =
+- TYPE_LENGTH (TYPE_FIELD_TYPE (rtype, f)) * TARGET_CHAR_BIT;
+- }
++ {
++ variant_field = f;
++ fld_bit_len = bit_incr = 0;
++ }
+ else if (is_dynamic_field (type, f))
+- {
+- if (dval0 == NULL)
+- dval = value_from_contents_and_address (rtype, valaddr, address);
+- else
+- dval = dval0;
+-
+- TYPE_FIELD_TYPE (rtype, f) =
+- ada_to_fixed_type
+- (ada_get_base_type
+- (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, f))),
+- cond_offset_host (valaddr, off / TARGET_CHAR_BIT),
+- cond_offset_target (address, off / TARGET_CHAR_BIT), dval);
+- TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
+- bit_incr = fld_bit_len =
+- TYPE_LENGTH (TYPE_FIELD_TYPE (rtype, f)) * TARGET_CHAR_BIT;
+- }
+- else
+- {
+- TYPE_FIELD_TYPE (rtype, f) = TYPE_FIELD_TYPE (type, f);
+- TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
+- if (TYPE_FIELD_BITSIZE (type, f) > 0)
+- bit_incr = fld_bit_len =
+- TYPE_FIELD_BITSIZE (rtype, f) = TYPE_FIELD_BITSIZE (type, f);
+- else
+- bit_incr = fld_bit_len =
+- TYPE_LENGTH (TYPE_FIELD_TYPE (type, f)) * TARGET_CHAR_BIT;
+- }
++ {
++ if (dval0 == NULL)
++ dval = value_from_contents_and_address (rtype, valaddr, address);
++ else
++ dval = dval0;
++
++ TYPE_FIELD_TYPE (rtype, f) =
++ ada_to_fixed_type
++ (ada_get_base_type
++ (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, f))),
++ cond_offset_host (valaddr, off / TARGET_CHAR_BIT),
++ cond_offset_target (address, off / TARGET_CHAR_BIT), dval);
++ TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
++ bit_incr = fld_bit_len =
++ TYPE_LENGTH (TYPE_FIELD_TYPE (rtype, f)) * TARGET_CHAR_BIT;
++ }
++ else
++ {
++ TYPE_FIELD_TYPE (rtype, f) = TYPE_FIELD_TYPE (type, f);
++ TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
++ if (TYPE_FIELD_BITSIZE (type, f) > 0)
++ bit_incr = fld_bit_len =
++ TYPE_FIELD_BITSIZE (rtype, f) = TYPE_FIELD_BITSIZE (type, f);
++ else
++ bit_incr = fld_bit_len =
++ TYPE_LENGTH (TYPE_FIELD_TYPE (type, f)) * TARGET_CHAR_BIT;
++ }
+ if (off + fld_bit_len > bit_len)
+- bit_len = off + fld_bit_len;
++ bit_len = off + fld_bit_len;
+ off += bit_incr;
+- TYPE_LENGTH (rtype) = bit_len / TARGET_CHAR_BIT;
++ TYPE_LENGTH (rtype) =
++ align_value (bit_len, TARGET_CHAR_BIT) / TARGET_CHAR_BIT;
++ }
++
++ /* We handle the variant part, if any, at the end because of certain
++ odd cases in which it is re-ordered so as NOT the last field of
++ the record. This can happen in the presence of representation
++ clauses. */
++ if (variant_field >= 0)
++ {
++ struct type *branch_type;
++
++ off = TYPE_FIELD_BITPOS (rtype, variant_field);
++
++ if (dval0 == NULL)
++ dval = value_from_contents_and_address (rtype, valaddr, address);
++ else
++ dval = dval0;
++
++ branch_type =
++ to_fixed_variant_branch_type
++ (TYPE_FIELD_TYPE (type, variant_field),
++ 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;
++ }
++ else
++ {
++ TYPE_FIELD_TYPE (rtype, variant_field) = branch_type;
++ TYPE_FIELD_NAME (rtype, variant_field) = "S";
++ fld_bit_len =
++ TYPE_LENGTH (TYPE_FIELD_TYPE (rtype, variant_field)) *
++ TARGET_CHAR_BIT;
++ if (off + fld_bit_len > bit_len)
++ bit_len = off + fld_bit_len;
++ TYPE_LENGTH (rtype) =
++ align_value (bit_len, TARGET_CHAR_BIT) / TARGET_CHAR_BIT;
++ }
+ }
++
+ TYPE_LENGTH (rtype) = align_value (TYPE_LENGTH (rtype), TYPE_LENGTH (type));
+
+ value_free_to_mark (mark);
+@@ -6048,148 +7693,177 @@
+ return rtype;
+ }
+
+-/* As for template_to_fixed_record_type, but uses no run-time values.
+- As a result, this type can only be approximate, but that's OK,
+- since it is used only for type determinations. Works on both
+- structs and unions.
+- Representation note: to save space, we memoize the result of this
+- function in the TYPE_TARGET_TYPE of the template type. */
++/* As for ada_template_to_fixed_record_type_1 with KEEP_DYNAMIC_FIELDS
++ of 1. */
++
++static struct type *
++template_to_fixed_record_type (struct type *type, char *valaddr,
++ CORE_ADDR address, struct value *dval0)
++{
++ return ada_template_to_fixed_record_type_1 (type, valaddr,
++ address, dval0, 1);
++}
++
++/* An ordinary record type in which ___XVL-convention fields and
++ ___XVU- and ___XVN-convention field types in TYPE0 are replaced with
++ static approximations, containing all possible fields. Uses
++ no runtime values. Useless for use in values, but that's OK,
++ since the results are used only for type determinations. Works on both
++ structs and unions. Representation note: to save space, we memorize
++ the result of this function in the TYPE_TARGET_TYPE of the
++ template type. */
+
+ static struct type *
+-template_to_static_fixed_type (struct type *templ_type)
++template_to_static_fixed_type (struct type *type0)
+ {
+ struct type *type;
+ int nfields;
+ int f;
+
+- if (TYPE_TARGET_TYPE (templ_type) != NULL)
+- return TYPE_TARGET_TYPE (templ_type);
++ if (TYPE_TARGET_TYPE (type0) != NULL)
++ return TYPE_TARGET_TYPE (type0);
+
+- nfields = TYPE_NFIELDS (templ_type);
+- TYPE_TARGET_TYPE (templ_type) = type =
+- alloc_type (TYPE_OBJFILE (templ_type));
+- TYPE_CODE (type) = TYPE_CODE (templ_type);
+- INIT_CPLUS_SPECIFIC (type);
+- TYPE_NFIELDS (type) = nfields;
+- TYPE_FIELDS (type) = (struct field *)
+- TYPE_ALLOC (type, nfields * sizeof (struct field));
+- memset (TYPE_FIELDS (type), 0, sizeof (struct field) * nfields);
+- TYPE_NAME (type) = ada_type_name (templ_type);
+- TYPE_TAG_NAME (type) = NULL;
+- /* FIXME: TYPE_FLAG_FIXED_INSTANCE should be defined in gdbtypes.h */
+- /* TYPE_FLAGS (type) |= TYPE_FLAG_FIXED_INSTANCE; */
+- TYPE_LENGTH (type) = 0;
++ nfields = TYPE_NFIELDS (type0);
++ type = type0;
+
+ for (f = 0; f < nfields; f += 1)
+ {
+- TYPE_FIELD_BITPOS (type, f) = 0;
+- TYPE_FIELD_BITSIZE (type, f) = 0;
+- TYPE_FIELD_STATIC_KIND (type, f) = 0;
++ struct type *field_type = CHECK_TYPEDEF (TYPE_FIELD_TYPE (type0, f));
++ struct type *new_type;
+
+- if (is_dynamic_field (templ_type, f))
+- {
+- TYPE_FIELD_TYPE (type, f) =
+- to_static_fixed_type (TYPE_TARGET_TYPE
+- (TYPE_FIELD_TYPE (templ_type, f)));
+- TYPE_FIELD_NAME (type, f) = TYPE_FIELD_NAME (templ_type, f);
+- }
++ if (is_dynamic_field (type0, f))
++ new_type = to_static_fixed_type (TYPE_TARGET_TYPE (field_type));
+ else
+- {
+- TYPE_FIELD_TYPE (type, f) =
+- check_typedef (TYPE_FIELD_TYPE (templ_type, f));
+- TYPE_FIELD_NAME (type, f) = TYPE_FIELD_NAME (templ_type, f);
+- }
++ new_type = to_static_fixed_type (field_type);
++ if (type == type0 && new_type != field_type)
++ {
++ TYPE_TARGET_TYPE (type0) = type = alloc_type (TYPE_OBJFILE (type0));
++ TYPE_CODE (type) = TYPE_CODE (type0);
++ INIT_CPLUS_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),
++ sizeof (struct field) * nfields);
++ TYPE_NAME (type) = ada_type_name (type0);
++ TYPE_TAG_NAME (type) = NULL;
++ TYPE_FLAGS (type) |= TYPE_FLAG_FIXED_INSTANCE;
++ TYPE_LENGTH (type) = 0;
++ }
++ TYPE_FIELD_TYPE (type, f) = new_type;
++ TYPE_FIELD_NAME (type, f) = TYPE_FIELD_NAME (type0, f);
+ }
+-
+ return type;
+ }
+
+-/* A revision of TYPE0 -- a non-dynamic-sized record with a variant
+- part -- in which the variant part is replaced with the appropriate
+- branch. */
++/* Given an object of type TYPE whose contents are at VALADDR and
++ whose address in memory is ADDRESS, returns a revision of TYPE --
++ a non-dynamic-sized record with a variant part -- in which
++ the variant part is replaced with the appropriate branch. Looks
++ for discriminant values in DVAL0, which can be NULL if the record
++ contains the necessary discriminant values. */
++
+ static struct type *
+ to_record_with_fixed_variant_part (struct type *type, char *valaddr,
+- CORE_ADDR address, struct value *dval)
++ CORE_ADDR address, struct value *dval0)
+ {
+ struct value *mark = value_mark ();
++ struct value *dval;
+ struct type *rtype;
+ struct type *branch_type;
+ int nfields = TYPE_NFIELDS (type);
++ int variant_field = variant_field_index (type);
+
+- if (dval == NULL)
++ if (variant_field == -1)
+ return type;
+
++ if (dval0 == NULL)
++ dval = value_from_contents_and_address (type, valaddr, address);
++ else
++ dval = dval0;
++
+ rtype = alloc_type (TYPE_OBJFILE (type));
+ TYPE_CODE (rtype) = TYPE_CODE_STRUCT;
+- INIT_CPLUS_SPECIFIC (type);
+- TYPE_NFIELDS (rtype) = TYPE_NFIELDS (type);
++ INIT_CPLUS_SPECIFIC (rtype);
++ TYPE_NFIELDS (rtype) = nfields;
+ TYPE_FIELDS (rtype) =
+ (struct field *) TYPE_ALLOC (rtype, nfields * sizeof (struct field));
+ memcpy (TYPE_FIELDS (rtype), TYPE_FIELDS (type),
+- sizeof (struct field) * nfields);
++ sizeof (struct field) * nfields);
+ TYPE_NAME (rtype) = ada_type_name (type);
+ TYPE_TAG_NAME (rtype) = NULL;
+- /* FIXME: TYPE_FLAG_FIXED_INSTANCE should be defined in gdbtypes.h */
+- /* TYPE_FLAGS (rtype) |= TYPE_FLAG_FIXED_INSTANCE; */
++ TYPE_FLAGS (rtype) |= TYPE_FLAG_FIXED_INSTANCE;
+ TYPE_LENGTH (rtype) = TYPE_LENGTH (type);
+
+- branch_type =
+- to_fixed_variant_branch_type
+- (TYPE_FIELD_TYPE (type, nfields - 1),
++ branch_type = to_fixed_variant_branch_type
++ (TYPE_FIELD_TYPE (type, variant_field),
+ cond_offset_host (valaddr,
+- TYPE_FIELD_BITPOS (type,
+- nfields - 1) / TARGET_CHAR_BIT),
++ TYPE_FIELD_BITPOS (type, variant_field)
++ / TARGET_CHAR_BIT),
+ cond_offset_target (address,
+- TYPE_FIELD_BITPOS (type,
+- nfields - 1) / TARGET_CHAR_BIT),
+- dval);
++ TYPE_FIELD_BITPOS (type, variant_field)
++ / TARGET_CHAR_BIT), dval);
+ if (branch_type == NULL)
+ {
++ int f;
++ for (f = variant_field + 1; f < nfields; f += 1)
++ TYPE_FIELDS (rtype)[f - 1] = TYPE_FIELDS (rtype)[f];
+ TYPE_NFIELDS (rtype) -= 1;
+- TYPE_LENGTH (rtype) -=
+- TYPE_LENGTH (TYPE_FIELD_TYPE (type, nfields - 1));
+ }
+ else
+ {
+- TYPE_FIELD_TYPE (rtype, nfields - 1) = branch_type;
+- TYPE_FIELD_NAME (rtype, nfields - 1) = "S";
+- TYPE_FIELD_BITSIZE (rtype, nfields - 1) = 0;
+- TYPE_FIELD_STATIC_KIND (rtype, nfields - 1) = 0;
++ TYPE_FIELD_TYPE (rtype, variant_field) = 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 (TYPE_FIELD_TYPE (type, nfields - 1));
+ }
++ TYPE_LENGTH (rtype) -= TYPE_LENGTH (TYPE_FIELD_TYPE (type, variant_field));
+
++ value_free_to_mark (mark);
+ return rtype;
+ }
+
+ /* An ordinary record type (with fixed-length fields) that describes
+ the value at (TYPE0, VALADDR, ADDRESS) [see explanation at
+ beginning of this section]. Any necessary discriminants' values
+- should be in DVAL, a record value; it should be NULL if the object
+- at ADDR itself contains any necessary discriminant values. A
+- variant field (unless unchecked) is replaced by a particular branch
+- of the variant. */
++ should be in DVAL, a record value; it may be NULL if the object
++ at ADDR itself contains any necessary discriminant values.
++ Additionally, VALADDR and ADDRESS may also be NULL if no discriminant
++ values from the record are needed. Except in the case that DVAL,
++ VALADDR, and ADDRESS are all 0 or NULL, a variant field (unless
++ unchecked) is replaced by a particular branch of the variant.
++
++ NOTE: the case in which DVAL and VALADDR are NULL and ADDRESS is 0
++ is questionable and may be removed. It can arise during the
++ processing of an unconstrained-array-of-record type where all the
++ variant branches have exactly the same size. This is because in
++ such cases, the compiler does not bother to use the XVS convention
++ when encoding the record. I am currently dubious of this
++ shortcut and suspect the compiler should be altered. FIXME. */
+
+ static struct type *
+-to_fixed_record_type (struct type *type0, char *valaddr, CORE_ADDR address,
+- struct value *dval)
++to_fixed_record_type (struct type *type0, char *valaddr,
++ CORE_ADDR address, struct value *dval)
+ {
+ struct type *templ_type;
+
+- /* FIXME: TYPE_FLAG_FIXED_INSTANCE should be defined in gdbtypes.h */
+- /* if (TYPE_FLAGS (type0) & TYPE_FLAG_FIXED_INSTANCE)
+- return type0;
+- */
++ if (TYPE_FLAGS (type0) & TYPE_FLAG_FIXED_INSTANCE)
++ return type0;
++
+ templ_type = dynamic_template_type (type0);
+
+ if (templ_type != NULL)
+ return template_to_fixed_record_type (templ_type, valaddr, address, dval);
+- else if (contains_variant_part (type0))
+- return to_record_with_fixed_variant_part (type0, valaddr, address, dval);
++ else if (variant_field_index (type0) >= 0)
++ {
++ if (dval == NULL && valaddr == NULL && address == 0)
++ return type0;
++ return to_record_with_fixed_variant_part (type0, valaddr, address,
++ dval);
++ }
+ else
+ {
+- /* FIXME: TYPE_FLAG_FIXED_INSTANCE should be defined in gdbtypes.h */
+- /* TYPE_FLAGS (type0) |= TYPE_FLAG_FIXED_INSTANCE; */
++ TYPE_FLAGS (type0) |= TYPE_FLAG_FIXED_INSTANCE;
+ return type0;
+ }
+
+@@ -6200,11 +7874,11 @@
+ union type. Any necessary discriminants' values should be in DVAL,
+ a record value. That is, this routine selects the appropriate
+ branch of the union at ADDR according to the discriminant value
+- indicated in the union's type name. */
++ indicated in the union's type name. */
+
+ static struct type *
+ to_fixed_variant_branch_type (struct type *var_type0, char *valaddr,
+- CORE_ADDR address, struct value *dval)
++ CORE_ADDR address, struct value *dval)
+ {
+ int which;
+ struct type *templ_type;
+@@ -6222,16 +7896,15 @@
+
+ which =
+ ada_which_variant_applies (var_type,
+- VALUE_TYPE (dval), VALUE_CONTENTS (dval));
++ VALUE_TYPE (dval), VALUE_CONTENTS (dval));
+
+ if (which < 0)
+ return empty_record (TYPE_OBJFILE (var_type));
+ else if (is_dynamic_field (var_type, which))
+- return
+- to_fixed_record_type
++ return to_fixed_record_type
+ (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (var_type, which)),
+ valaddr, address, dval);
+- else if (contains_variant_part (TYPE_FIELD_TYPE (var_type, which)))
++ else if (variant_field_index (TYPE_FIELD_TYPE (var_type, which)) >= 0)
+ return
+ to_fixed_record_type
+ (TYPE_FIELD_TYPE (var_type, which), valaddr, address, dval);
+@@ -6245,35 +7918,33 @@
+ contains no dynamic components (that is, no components whose sizes
+ are determined by run-time quantities). Unless IGNORE_TOO_BIG is
+ true, gives an error message if the resulting type's size is over
+- varsize_limit.
+-*/
++ varsize_limit. */
+
+ static struct type *
+ to_fixed_array_type (struct type *type0, struct value *dval,
+- int ignore_too_big)
++ int ignore_too_big)
+ {
+ struct type *index_type_desc;
+ struct type *result;
+
+- /* FIXME: TYPE_FLAG_FIXED_INSTANCE should be defined in gdbtypes.h */
+-/* if (ada_is_packed_array_type (type0) /* revisit? *//*
+- || (TYPE_FLAGS (type0) & TYPE_FLAG_FIXED_INSTANCE))
+- return type0; */
++ if (ada_is_packed_array_type (type0) /* revisit? */
++ || (TYPE_FLAGS (type0) & TYPE_FLAG_FIXED_INSTANCE))
++ return type0;
+
+ index_type_desc = ada_find_parallel_type (type0, "___XA");
+ if (index_type_desc == NULL)
+ {
+ struct type *elt_type0 = check_typedef (TYPE_TARGET_TYPE (type0));
+ /* NOTE: elt_type---the fixed version of elt_type0---should never
+- * depend on the contents of the array in properly constructed
+- * debugging data. */
++ depend on the contents of the array in properly constructed
++ debugging data. */
+ struct type *elt_type = ada_to_fixed_type (elt_type0, 0, 0, dval);
+
+ if (elt_type0 == elt_type)
+- result = type0;
++ result = type0;
+ else
+- result = create_array_type (alloc_type (TYPE_OBJFILE (type0)),
+- elt_type, TYPE_INDEX_TYPE (type0));
++ result = create_array_type (alloc_type (TYPE_OBJFILE (type0)),
++ elt_type, TYPE_INDEX_TYPE (type0));
+ }
+ else
+ {
+@@ -6282,26 +7953,25 @@
+
+ elt_type0 = type0;
+ for (i = TYPE_NFIELDS (index_type_desc); i > 0; i -= 1)
+- elt_type0 = TYPE_TARGET_TYPE (elt_type0);
++ elt_type0 = TYPE_TARGET_TYPE (elt_type0);
+
+ /* NOTE: result---the fixed version of elt_type0---should never
+- * depend on the contents of the array in properly constructed
+- * debugging data. */
++ depend on the contents of the array in properly constructed
++ debugging data. */
+ result = ada_to_fixed_type (check_typedef (elt_type0), 0, 0, dval);
+ for (i = TYPE_NFIELDS (index_type_desc) - 1; i >= 0; i -= 1)
+- {
+- struct type *range_type =
+- to_fixed_range_type (TYPE_FIELD_NAME (index_type_desc, i),
+- dval, TYPE_OBJFILE (type0));
+- result = create_array_type (alloc_type (TYPE_OBJFILE (type0)),
+- result, range_type);
+- }
++ {
++ struct type *range_type =
++ to_fixed_range_type (TYPE_FIELD_NAME (index_type_desc, i),
++ dval, TYPE_OBJFILE (type0));
++ result = create_array_type (alloc_type (TYPE_OBJFILE (type0)),
++ result, range_type);
++ }
+ if (!ignore_too_big && TYPE_LENGTH (result) > varsize_limit)
+- error ("array type with dynamic size is larger than varsize-limit");
++ error ("array type with dynamic size is larger than varsize-limit");
+ }
+
+-/* FIXME: TYPE_FLAG_FIXED_INSTANCE should be defined in gdbtypes.h */
+-/* TYPE_FLAGS (result) |= TYPE_FLAG_FIXED_INSTANCE; */
++ TYPE_FLAGS (result) |= TYPE_FLAG_FIXED_INSTANCE;
+ return result;
+ }
+
+@@ -6309,11 +7979,12 @@
+ /* A standard type (containing no dynamically sized components)
+ corresponding to TYPE for the value (TYPE, VALADDR, ADDRESS)
+ DVAL describes a record containing any discriminants used in TYPE0,
+- and may be NULL if there are none. */
++ and may be NULL if there are none, or if the object of type TYPE at
++ ADDRESS or in VALADDR contains these discriminants. */
+
+ struct type *
+-ada_to_fixed_type (struct type *type, char *valaddr, CORE_ADDR address,
+- struct value *dval)
++ada_to_fixed_type (struct type *type, char *valaddr,
++ CORE_ADDR address, struct value *dval)
+ {
+ CHECK_TYPEDEF (type);
+ switch (TYPE_CODE (type))
+@@ -6321,19 +7992,31 @@
+ default:
+ return type;
+ case TYPE_CODE_STRUCT:
+- return to_fixed_record_type (type, valaddr, address, NULL);
++ {
++ struct type *static_type = to_static_fixed_type (type);
++ if (ada_is_tagged_type (static_type, 0))
++ {
++ struct type *real_type =
++ type_from_tag (value_tag_from_contents_and_address (static_type,
++ valaddr,
++ address));
++ if (real_type != NULL)
++ type = real_type;
++ }
++ return to_fixed_record_type (type, valaddr, address, NULL);
++ }
+ case TYPE_CODE_ARRAY:
+- return to_fixed_array_type (type, dval, 0);
++ return to_fixed_array_type (type, dval, 1);
+ case TYPE_CODE_UNION:
+ if (dval == NULL)
+- return type;
++ return type;
+ else
+- return to_fixed_variant_branch_type (type, valaddr, address, dval);
++ return to_fixed_variant_branch_type (type, valaddr, address, dval);
+ }
+ }
+
+ /* A standard (static-sized) type corresponding as well as possible to
+- TYPE0, but based on no runtime data. */
++ TYPE0, but based on no runtime data. */
+
+ static struct type *
+ to_static_fixed_type (struct type *type0)
+@@ -6343,10 +8026,9 @@
+ if (type0 == NULL)
+ return NULL;
+
+- /* FIXME: TYPE_FLAG_FIXED_INSTANCE should be defined in gdbtypes.h */
+- /* if (TYPE_FLAGS (type0) & TYPE_FLAG_FIXED_INSTANCE)
+- return type0;
+- */
++ if (TYPE_FLAGS (type0) & TYPE_FLAG_FIXED_INSTANCE)
++ return type0;
++
+ CHECK_TYPEDEF (type0);
+
+ switch (TYPE_CODE (type0))
+@@ -6356,17 +8038,20 @@
+ case TYPE_CODE_STRUCT:
+ type = dynamic_template_type (type0);
+ if (type != NULL)
+- return template_to_static_fixed_type (type);
+- return type0;
++ return template_to_static_fixed_type (type);
++ else
++ return template_to_static_fixed_type (type0);
+ case TYPE_CODE_UNION:
+ type = ada_find_parallel_type (type0, "___XVU");
+ if (type != NULL)
+- return template_to_static_fixed_type (type);
+- return type0;
++ return template_to_static_fixed_type (type);
++ else
++ return template_to_static_fixed_type (type0);
+ }
+ }
+
+-/* A static approximation of TYPE with all type wrappers removed. */
++/* A static approximation of TYPE with all type wrappers removed. */
++
+ static struct type *
+ static_unwrap_type (struct type *type)
+ {
+@@ -6374,7 +8059,7 @@
+ {
+ struct type *type1 = TYPE_FIELD_TYPE (check_typedef (type), 0);
+ if (ada_type_name (type1) == NULL)
+- TYPE_NAME (type1) = ada_type_name (type);
++ TYPE_NAME (type1) = ada_type_name (type);
+
+ return static_unwrap_type (type1);
+ }
+@@ -6382,25 +8067,26 @@
+ {
+ struct type *raw_real_type = ada_get_base_type (type);
+ if (raw_real_type == type)
+- return type;
++ return type;
+ else
+- return to_static_fixed_type (raw_real_type);
++ return to_static_fixed_type (raw_real_type);
+ }
+ }
+
+ /* In some cases, incomplete and private types require
+- cross-references that are not resolved as records (for example,
++ cross-references that are not resolved as records (for example,
+ type Foo;
+ type FooP is access Foo;
+ V: FooP;
+ type Foo is array ...;
+- ). In these cases, since there is no mechanism for producing
++ ). In these cases, since there is no mechanism for producing
+ cross-references to such types, we instead substitute for FooP a
+ stub enumeration type that is nowhere resolved, and whose tag is
+- the name of the actual type. Call these types "non-record stubs". */
++ the name of the actual type. Call these types "non-record stubs". */
+
+ /* A type equivalent to TYPE that is not a non-record stub, if one
+- exists, otherwise TYPE. */
++ exists, otherwise TYPE. */
++
+ struct type *
+ ada_completed_type (struct type *type)
+ {
+@@ -6421,23 +8107,52 @@
+ type TYPE0, but with a standard (static-sized) type that correctly
+ describes it. If VAL0 is not NULL and TYPE0 already is a standard
+ type, then return VAL0 [this feature is simply to avoid redundant
+- creation of struct values]. */
++ creation of struct values]. */
+
+-struct value *
+-ada_to_fixed_value (struct type *type0, char *valaddr, CORE_ADDR address,
+- struct value *val0)
++static struct value *
++ada_to_fixed_value_create (struct type *type0, CORE_ADDR address,
++ struct value *val0)
+ {
+- struct type *type = ada_to_fixed_type (type0, valaddr, address, NULL);
++ struct type *type = ada_to_fixed_type (type0, 0, address, NULL);
+ if (type == type0 && val0 != NULL)
+ return val0;
+ else
+- return value_from_contents_and_address (type, valaddr, address);
++ return value_from_contents_and_address (type, 0, address);
++}
++
++/* A value representing VAL, but with a standard (static-sized) type
++ that correctly describes it. Does not necessarily create a new
++ value. */
++
++static struct value *
++ada_to_fixed_value (struct value *val)
++{
++ return ada_to_fixed_value_create (VALUE_TYPE (val),
++ VALUE_ADDRESS (val) + VALUE_OFFSET (val),
++ val);
++}
++
++/* If the PC is pointing inside a function prologue, then re-adjust it
++ past this prologue. */
++
++static void
++adjust_pc_past_prologue (CORE_ADDR *pc)
++{
++ struct symbol *func_sym = find_pc_function (*pc);
++
++ if (func_sym)
++ {
++ const struct symtab_and_line sal = find_function_start_sal (func_sym, 1);
++
++ if (*pc <= sal.pc)
++ *pc = sal.pc;
++ }
+ }
+
+-/* A value representing VAL, but with a standard (static-sized) type
++/* A value representing VAL, but with a standard (static-sized) type
+ chosen to approximate the real type of VAL as well as possible, but
+ without consulting any runtime values. For Ada dynamic-sized
+- types, therefore, the type of the result is likely to be inaccurate. */
++ types, therefore, the type of the result is likely to be inaccurate. */
+
+ struct value *
+ ada_to_static_fixed_value (struct value *val)
+@@ -6447,17 +8162,14 @@
+ if (type == VALUE_TYPE (val))
+ return val;
+ else
+- return coerce_unspec_val_to_type (val, 0, type);
++ return coerce_unspec_val_to_type (val, type);
+ }
+ \f
+
+-
+-
+-
+ /* Attributes */
+
+-/* Table mapping attribute numbers to names */
+-/* NOTE: Keep up to date with enum ada_attribute definition in ada-lang.h */
++/* Table mapping attribute numbers to names.
++ NOTE: Keep up to date with enum ada_attribute definition in ada-lang.h. */
+
+ static const char *attribute_names[] = {
+ "<?>",
+@@ -6466,28 +8178,29 @@
+ "last",
+ "length",
+ "image",
+- "img",
+ "max",
+ "min",
+- "pos" "tag",
++ "modulus",
++ "pos",
++ "size",
++ "tag",
+ "val",
+-
+ 0
+ };
+
+ const char *
+-ada_attribute_name (int n)
++ada_attribute_name (enum exp_opcode n)
+ {
+- if (n > 0 && n < (int) ATR_END)
+- return attribute_names[n];
++ if (n >= OP_ATR_FIRST && n <= (int) OP_ATR_VAL)
++ return attribute_names[n - OP_ATR_FIRST + 1];
+ else
+ return attribute_names[0];
+ }
+
+-/* Evaluate the 'POS attribute applied to ARG. */
++/* Evaluate the 'POS attribute applied to ARG. */
+
+-static struct value *
+-value_pos_atr (struct value *arg)
++static LONGEST
++pos_atr (struct value *arg)
+ {
+ struct type *type = VALUE_TYPE (arg);
+
+@@ -6500,17 +8213,23 @@
+ LONGEST v = value_as_long (arg);
+
+ for (i = 0; i < TYPE_NFIELDS (type); i += 1)
+- {
+- if (v == TYPE_FIELD_BITPOS (type, i))
+- return value_from_longest (builtin_type_ada_int, i);
+- }
++ {
++ if (v == TYPE_FIELD_BITPOS (type, i))
++ return i;
++ }
+ error ("enumeration value is invalid: can't find 'POS");
+ }
+ else
+- return value_from_longest (builtin_type_ada_int, value_as_long (arg));
++ return value_as_long (arg);
++}
++
++static struct value *
++value_pos_atr (struct value *arg)
++{
++ return value_from_longest (builtin_type_ada_int, pos_atr (arg));
+ }
+
+-/* Evaluate the TYPE'VAL attribute applied to ARG. */
++/* Evaluate the TYPE'VAL attribute applied to ARG. */
+
+ static struct value *
+ value_val_atr (struct type *type, struct value *arg)
+@@ -6524,7 +8243,7 @@
+ {
+ long pos = value_as_long (arg);
+ if (pos < 0 || pos >= TYPE_NFIELDS (type))
+- error ("argument to 'VAL out of range");
++ error ("argument to 'VAL out of range");
+ return value_from_longest (type, TYPE_FIELD_BITPOS (type, pos));
+ }
+ else
+@@ -6532,11 +8251,11 @@
+ }
+ \f
+
+- /* Evaluation */
++ /* Evaluation */
+
+-/* True if TYPE appears to be an Ada character type.
+- * [At the moment, this is true only for Character and Wide_Character;
+- * It is a heuristic test that could stand improvement]. */
++/* True if TYPE appears to be an Ada character type.
++ [At the moment, this is true only for Character and Wide_Character;
++ It is a heuristic test that could stand improvement]. */
+
+ int
+ ada_is_character_type (struct type *type)
+@@ -6545,13 +8264,14 @@
+ return
+ name != NULL
+ && (TYPE_CODE (type) == TYPE_CODE_CHAR
+- || TYPE_CODE (type) == TYPE_CODE_INT
+- || TYPE_CODE (type) == TYPE_CODE_RANGE)
+- && (DEPRECATED_STREQ (name, "character") || DEPRECATED_STREQ (name, "wide_character")
+- || DEPRECATED_STREQ (name, "unsigned char"));
++ || TYPE_CODE (type) == TYPE_CODE_INT
++ || TYPE_CODE (type) == TYPE_CODE_RANGE)
++ && (strcmp (name, "character") == 0
++ || strcmp (name, "wide_character") == 0
++ || strcmp (name, "unsigned char") == 0);
+ }
+
+-/* True if TYPE appears to be an Ada string type. */
++/* True if TYPE appears to be an Ada string type. */
+
+ int
+ ada_is_string_type (struct type *type)
+@@ -6559,7 +8279,7 @@
+ CHECK_TYPEDEF (type);
+ if (type != NULL
+ && TYPE_CODE (type) != TYPE_CODE_PTR
+- && (ada_is_simple_array (type) || ada_is_array_descriptor (type))
++ && (ada_is_simple_array_type (type) || ada_is_array_descriptor_type (type))
+ && ada_array_arity (type) == 1)
+ {
+ struct type *elttype = ada_array_element_type (type, 1);
projects / packages / gdb.git / commitdiff