+++ /dev/null
---- gdb-6.1.1/gdb/ada-lang.c.orig 2004-06-23 17:49:34.000000000 +0200
-+++ gdb-6.1.1/gdb/ada-lang.c 2004-06-23 18:58:04.000000000 +0200
-@@ -10141,7 +10141,7 @@
- &ada_exp_descriptor,
- parse,
- ada_error,
-- resolve,
-+ /* resolve, CVS gdb */
- ada_printchar, /* Print a character constant */
- ada_printstr, /* Function to print string constant */
- emit_char, /* Function to print single char (not used) */
+++ /dev/null
-===================================================================
-RCS file: /cvs/src/src/gdb/ada-tasks.c,v
-retrieving revision 1.7
-retrieving revision 1.8
-diff -u -r1.7 -r1.8
---- gdb/ada-tasks.c 2003/06/17 20:58:32 1.7
-+++ gdb/ada-tasks.c 2004/04/28 16:36:25 1.8
-@@ -4,7 +4,7 @@
- .
- This file is part of GDB.
-
-- [$Id$]
-+ [$Id$]
- Authors: Roch-Alexandre Nomine Beguin, Arnaud Charlet <charlet@gnat.com>
-
- This program is free software; you can redistribute it and/or modify
-@@ -794,10 +794,8 @@
- {
- /* FIXME: find_printable_frame should be defined in frame.h, and
- implemented in ada-lang.c */
-- /* find_printable_frame (deprecated_selected_frame, frame_relative_level (deprecated_selected_frame)); */
- printf_filtered ("[Switching to task %d]\n", num);
-- print_stack_frame (deprecated_selected_frame,
-- frame_relative_level (deprecated_selected_frame), 1);
-+ print_stack_frame (get_selected_frame (), 1, SRC_AND_LOC);
- }
- else
- printf_filtered ("Unable to switch to task %d\n", num);
+++ /dev/null
-From gdb-patches-return-33534-listarch-gdb-patches=sources dot redhat dot com at sources dot redhat dot com Wed Jun 02 10:03:07 2004
-Return-Path: <gdb-patches-return-33534-listarch-gdb-patches=sources dot redhat dot com at sources dot redhat dot com>
-Delivered-To: listarch-gdb-patches at sources dot redhat dot com
-Received: (qmail 5503 invoked by alias); 2 Jun 2004 10:03:05 -0000
-Mailing-List: contact gdb-patches-help at sources dot redhat dot com; run by ezmlm
-Precedence: bulk
-List-Subscribe: <mailto:gdb-patches-subscribe at sources dot redhat dot com>
-List-Archive: <http://sources.redhat.com/ml/gdb-patches/>
-List-Post: <mailto:gdb-patches at sources dot redhat dot com>
-List-Help: <mailto:gdb-patches-help at sources dot redhat dot com>, <http://sources dot redhat dot com/ml/#faqs>
-Sender: gdb-patches-owner at sources dot redhat dot com
-Delivered-To: mailing list gdb-patches at sources dot redhat dot com
-Received: (qmail 5443 invoked from network); 2 Jun 2004 10:02:47 -0000
-Received: from unknown (HELO nile.gnat.com) (205.232.38.5)
- by sourceware dot org with SMTP; 2 Jun 2004 10:02:47 -0000
-Received: from localhost (localhost [127.0.0.1])
- by nile dot gnat dot com (Postfix) with ESMTP id 76E9FF282A
- for <gdb-patches at sources dot redhat dot com>; Wed, 2 Jun 2004 06:02:46 -0400 (EDT)
-Received: from nile.gnat.com ([127.0.0.1])
- by localhost (nile dot gnat dot com [127 dot 0 dot 0 dot 1]) (amavisd-new, port 10024) with LMTP
- id 04925-01-3 for <gdb-patches at sources dot redhat dot com>;
- Wed, 2 Jun 2004 06:02:46 -0400 (EDT)
-Received: by nile.gnat.com (Postfix, from userid 1345)
- id BFFC7F282B; Wed, 2 Jun 2004 06:02:45 -0400 (EDT)
-From: Paul Hilfinger <hilfingr at gnat dot com>
-To: gdb-patches at sources dot redhat dot com
-Subject: [PATCH]: Updates to Ada sources, part 1 (longish)
-Message-Id: <20040602100245.BFFC7F282B@nile.gnat.com>
-Date: Wed, 2 Jun 2004 06:02:45 -0400 (EDT)
-X-Virus-Scanned: by amavisd-new at nile.gnat.com
-
-
-I have checked in the following patch, which synchronizes the public
-sources with our current development version (since these sources are not
-at the moment compiled, it is harmless to do so). Since the patch is
-large, I have broken it up. This is part 1.
-
-Paul Hilfinger
-
-
-Changelog:
-
-2004-06-02 Paul N. Hilfinger <hilfinger@gnat.com>
-
- * ada-exp.y: Synchronize with current ACT sources.
- * ada-lang.c: Ditto.
- * ada-lang.h: Ditto.
- * ada-lex.l: Ditto.
- * ada-tasks.c: Ditto.
- * ada-typeprint.c: Ditto.
- * ada-valprint.c: Ditto.
-
-
-Index: gdb/ada-exp.y
-===================================================================
-RCS file: /cvs/src/src/gdb/ada-exp.y,v
-retrieving revision 1.8
-diff -u -p -r1.8 ada-exp.y
---- gdb/ada-exp.y 23 Nov 2003 20:41:16 -0000 1.8
-+++ gdb/ada-exp.y 2 Jun 2004 09:52:54 -0000
-@@ -1,6 +1,6 @@
- /* YACC parser for Ada expressions, for GDB.
-- Copyright (C) 1986, 1989, 1990, 1991, 1993, 1994, 1997, 2000, 2003
-- Free Software Foundation, Inc.
-+ Copyright (C) 1986, 1989, 1990, 1991, 1993, 1994, 1997, 2000, 2003,
-+ 2004 Free Software Foundation, Inc.
-
- This file is part of GDB.
-
-@@ -34,7 +34,7 @@ Foundation, Inc., 675 Mass Ave, Cambridg
- with include files (<malloc.h> and <stdlib.h> for example) just became
- too messy, particularly when such includes can be inserted at random
- times by the parser generator. */
--
-+
- %{
-
- #include "defs.h"
-@@ -56,9 +56,9 @@ Foundation, Inc., 675 Mass Ave, Cambridg
- yacc generated parsers in gdb. These are only the variables
- produced by yacc. If other parser generators (bison, byacc, etc) produce
- additional global names that conflict at link time, then those parser
-- generators need to be fixed instead of adding those names to this list. */
-+ generators need to be fixed instead of adding those names to this list. */
-
--/* NOTE: This is clumsy, especially since BISON and FLEX provide --prefix
-+/* NOTE: This is clumsy, especially since BISON and FLEX provide --prefix
- options. I presume we are maintaining it to accommodate systems
- without BISON? (PNH) */
-
-@@ -69,13 +69,13 @@ Foundation, Inc., 675 Mass Ave, Cambridg
- #define yylval ada_lval
- #define yychar ada_char
- #define yydebug ada_debug
--#define yypact ada_pact
--#define yyr1 ada_r1
--#define yyr2 ada_r2
--#define yydef ada_def
--#define yychk ada_chk
--#define yypgo ada_pgo
--#define yyact ada_act
-+#define yypact ada_pact
-+#define yyr1 ada_r1
-+#define yyr2 ada_r2
-+#define yydef ada_def
-+#define yychk ada_chk
-+#define yypgo ada_pgo
-+#define yyact ada_act
- #define yyexca ada_exca
- #define yyerrflag ada_errflag
- #define yynerrs ada_nerrs
-@@ -101,15 +101,15 @@ Foundation, Inc., 675 Mass Ave, Cambridg
- #define YYFPRINTF parser_fprintf
-
- struct name_info {
-- struct symbol* sym;
-- struct minimal_symbol* msym;
-- struct block* block;
-+ struct symbol *sym;
-+ struct minimal_symbol *msym;
-+ struct block *block;
- struct stoken stoken;
- };
-
- /* If expression is in the context of TYPE'(...), then TYPE, else
-- * NULL. */
--static struct type* type_qualifier;
-+ * NULL. */
-+static struct type *type_qualifier;
-
- int yyparse (void);
-
-@@ -119,19 +119,15 @@ void yyerror (char *);
-
- static struct stoken string_to_operator (struct stoken);
-
--static void write_attribute_call0 (enum ada_attribute);
--
--static void write_attribute_call1 (enum ada_attribute, LONGEST);
--
--static void write_attribute_calln (enum ada_attribute, int);
-+static void write_int (LONGEST, struct type *);
-
--static void write_object_renaming (struct block*, struct symbol*);
-+static void write_object_renaming (struct block *, struct symbol *, int);
-
--static void write_var_from_name (struct block*, struct name_info);
-+static void write_var_from_name (struct block *, struct name_info);
-
- static LONGEST
--convert_char_literal (struct type*, LONGEST);
--%}
-+convert_char_literal (struct type *, LONGEST);
-+%}
-
- %union
- {
-@@ -169,9 +165,9 @@ convert_char_literal (struct type*, LONG
- Contexts where this distinction is not important can use the
- nonterminal "name", which matches either NAME or TYPENAME. */
-
--%token <sval> STRING
-+%token <sval> STRING
- %token <ssym> NAME DOT_ID OBJECT_RENAMING
--%type <bval> block
-+%type <bval> block
- %type <lval> arglist tick_arglist
-
- %type <tval> save_qualifier
-@@ -180,9 +176,7 @@ convert_char_literal (struct type*, LONG
-
- /* Special type cases, put in to allow the parser to distinguish different
- legal basetypes. */
--%token <lval> LAST REGNAME
--
--%token <ivar> INTERNAL_VARIABLE
-+%token <sval> SPECIAL_VARIABLE
-
- %nonassoc ASSIGN
- %left _AND_ OR XOR THEN ELSE
-@@ -192,9 +186,9 @@ convert_char_literal (struct type*, LONG
- %left UNARY
- %left '*' '/' MOD REM
- %right STARSTAR ABS NOT
-- /* The following are right-associative only so that reductions at this
-- precedence have lower precedence than '.' and '('. The syntax still
-- forces a.b.c, e.g., to be LEFT-associated. */
-+ /* The following are right-associative only so that reductions at this
-+ precedence have lower precedence than '.' and '('. The syntax still
-+ forces a.b.c, e.g., to be LEFT-associated. */
- %right TICK_ACCESS TICK_ADDRESS TICK_FIRST TICK_LAST TICK_LENGTH
- %right TICK_MAX TICK_MIN TICK_MODULUS
- %right TICK_POS TICK_RANGE TICK_SIZE TICK_TAG TICK_VAL
-@@ -225,7 +219,7 @@ simple_exp : simple_exp DOT_ALL
- simple_exp : simple_exp DOT_ID
- { write_exp_elt_opcode (STRUCTOP_STRUCT);
- write_exp_string ($2.stoken);
-- write_exp_elt_opcode (STRUCTOP_STRUCT);
-+ write_exp_elt_opcode (STRUCTOP_STRUCT);
- }
- ;
-
-@@ -241,17 +235,15 @@ simple_exp : type '(' exp ')'
- {
- write_exp_elt_opcode (UNOP_CAST);
- write_exp_elt_type ($1);
-- write_exp_elt_opcode (UNOP_CAST);
-+ write_exp_elt_opcode (UNOP_CAST);
- }
- ;
-
- simple_exp : type '\'' save_qualifier { type_qualifier = $1; } '(' exp ')'
- {
-- /* write_exp_elt_opcode (UNOP_QUAL); */
-- /* FIXME: UNOP_QUAL should be defined in expression.h */
-+ write_exp_elt_opcode (UNOP_QUAL);
- write_exp_elt_type ($1);
-- /* write_exp_elt_opcode (UNOP_QUAL); */
-- /* FIXME: UNOP_QUAL should be defined in expression.h */
-+ write_exp_elt_opcode (UNOP_QUAL);
- type_qualifier = $3;
- }
- ;
-@@ -267,34 +259,16 @@ simple_exp :
- simple_exp : '(' exp1 ')' { }
- ;
-
--simple_exp : variable
-+simple_exp : variable
- ;
-
--simple_exp: REGNAME /* GDB extension */
-- { write_exp_elt_opcode (OP_REGISTER);
-- write_exp_elt_longcst ((LONGEST) $1);
-- write_exp_elt_opcode (OP_REGISTER);
-- }
-+simple_exp: SPECIAL_VARIABLE /* Various GDB extensions */
-+ { write_dollar_variable ($1); }
- ;
-
--simple_exp: INTERNAL_VARIABLE /* GDB extension */
-- { write_exp_elt_opcode (OP_INTERNALVAR);
-- write_exp_elt_intern ($1);
-- write_exp_elt_opcode (OP_INTERNALVAR);
-- }
-- ;
--
--
- exp : simple_exp
- ;
-
--simple_exp: LAST
-- { write_exp_elt_opcode (OP_LAST);
-- write_exp_elt_longcst ((LONGEST) $1);
-- write_exp_elt_opcode (OP_LAST);
-- }
-- ;
--
- exp : exp ASSIGN exp /* Extension for convenience */
- { write_exp_elt_opcode (BINOP_ASSIGN); }
- ;
-@@ -332,7 +306,7 @@ exp : '{' type '}' exp %prec '.'
- /* GDB extension */
- { write_exp_elt_opcode (UNOP_MEMVAL);
- write_exp_elt_type ($2);
-- write_exp_elt_opcode (UNOP_MEMVAL);
-+ write_exp_elt_opcode (UNOP_MEMVAL);
- }
- ;
-
-@@ -387,42 +361,32 @@ exp : exp LEQ exp
- ;
-
- exp : exp IN exp DOTDOT exp
-- { /*write_exp_elt_opcode (TERNOP_MBR); */ }
-- /* FIXME: TERNOP_MBR should be defined in
-- expression.h */
-+ { write_exp_elt_opcode (TERNOP_IN_RANGE); }
- | exp IN exp TICK_RANGE tick_arglist
-- { /*write_exp_elt_opcode (BINOP_MBR); */
-- /* FIXME: BINOP_MBR should be defined in expression.h */
-+ { write_exp_elt_opcode (BINOP_IN_BOUNDS);
- write_exp_elt_longcst ((LONGEST) $5);
-- /*write_exp_elt_opcode (BINOP_MBR); */
-+ write_exp_elt_opcode (BINOP_IN_BOUNDS);
- }
- | exp IN TYPENAME %prec TICK_ACCESS
-- { /*write_exp_elt_opcode (UNOP_MBR); */
-- /* FIXME: UNOP_QUAL should be defined in expression.h */
-+ { write_exp_elt_opcode (UNOP_IN_RANGE);
- write_exp_elt_type ($3);
-- /* write_exp_elt_opcode (UNOP_MBR); */
-- /* FIXME: UNOP_MBR should be defined in expression.h */
-+ write_exp_elt_opcode (UNOP_IN_RANGE);
- }
- | exp NOT IN exp DOTDOT exp
-- { /*write_exp_elt_opcode (TERNOP_MBR); */
-- /* FIXME: TERNOP_MBR should be defined in expression.h */
-- write_exp_elt_opcode (UNOP_LOGICAL_NOT);
-+ { write_exp_elt_opcode (TERNOP_IN_RANGE);
-+ write_exp_elt_opcode (UNOP_LOGICAL_NOT);
- }
- | exp NOT IN exp TICK_RANGE tick_arglist
-- { /* write_exp_elt_opcode (BINOP_MBR); */
-- /* FIXME: BINOP_MBR should be defined in expression.h */
-+ { write_exp_elt_opcode (BINOP_IN_BOUNDS);
- write_exp_elt_longcst ((LONGEST) $6);
-- /*write_exp_elt_opcode (BINOP_MBR);*/
-- /* FIXME: BINOP_MBR should be defined in expression.h */
-- write_exp_elt_opcode (UNOP_LOGICAL_NOT);
-+ write_exp_elt_opcode (BINOP_IN_BOUNDS);
-+ write_exp_elt_opcode (UNOP_LOGICAL_NOT);
- }
- | exp NOT IN TYPENAME %prec TICK_ACCESS
-- { /*write_exp_elt_opcode (UNOP_MBR);*/
-- /* FIXME: UNOP_MBR should be defined in expression.h */
-+ { write_exp_elt_opcode (UNOP_IN_RANGE);
- write_exp_elt_type ($4);
-- /* write_exp_elt_opcode (UNOP_MBR);*/
-- /* FIXME: UNOP_MBR should be defined in expression.h */
-- write_exp_elt_opcode (UNOP_LOGICAL_NOT);
-+ write_exp_elt_opcode (UNOP_IN_RANGE);
-+ write_exp_elt_opcode (UNOP_LOGICAL_NOT);
- }
- ;
-
-@@ -438,7 +402,7 @@ exp : exp '>' exp
- { write_exp_elt_opcode (BINOP_GTR); }
- ;
-
--exp : exp _AND_ exp /* Fix for Ada elementwise AND. */
-+exp : exp _AND_ exp /* Fix for Ada elementwise AND. */
- { write_exp_elt_opcode (BINOP_BITWISE_AND); }
- ;
-
-@@ -450,7 +414,7 @@ exp : exp OR exp /* Fix for Ada
- { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
- ;
-
--exp : exp OR ELSE exp
-+exp : exp OR ELSE exp
- { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
- ;
-
-@@ -467,31 +431,37 @@ simple_exp : simple_exp TICK_ACCESS
- write_exp_elt_opcode (UNOP_CAST);
- }
- | simple_exp TICK_FIRST tick_arglist
-- { write_attribute_call1 (ATR_FIRST, $3); }
-+ { write_int ($3, builtin_type_int);
-+ write_exp_elt_opcode (OP_ATR_FIRST); }
- | simple_exp TICK_LAST tick_arglist
-- { write_attribute_call1 (ATR_LAST, $3); }
-+ { write_int ($3, builtin_type_int);
-+ write_exp_elt_opcode (OP_ATR_LAST); }
- | simple_exp TICK_LENGTH tick_arglist
-- { write_attribute_call1 (ATR_LENGTH, $3); }
-- | simple_exp TICK_SIZE
-- { write_attribute_call0 (ATR_SIZE); }
-+ { write_int ($3, builtin_type_int);
-+ write_exp_elt_opcode (OP_ATR_LENGTH); }
-+ | simple_exp TICK_SIZE
-+ { write_exp_elt_opcode (OP_ATR_SIZE); }
- | simple_exp TICK_TAG
-- { write_attribute_call0 (ATR_TAG); }
-+ { write_exp_elt_opcode (OP_ATR_TAG); }
- | opt_type_prefix TICK_MIN '(' exp ',' exp ')'
-- { write_attribute_calln (ATR_MIN, 2); }
-+ { write_exp_elt_opcode (OP_ATR_MIN); }
- | opt_type_prefix TICK_MAX '(' exp ',' exp ')'
-- { write_attribute_calln (ATR_MAX, 2); }
-+ { write_exp_elt_opcode (OP_ATR_MAX); }
- | opt_type_prefix TICK_POS '(' exp ')'
-- { write_attribute_calln (ATR_POS, 1); }
-+ { write_exp_elt_opcode (OP_ATR_POS); }
- | type_prefix TICK_FIRST tick_arglist
-- { write_attribute_call1 (ATR_FIRST, $3); }
-+ { write_int ($3, builtin_type_int);
-+ write_exp_elt_opcode (OP_ATR_FIRST); }
- | type_prefix TICK_LAST tick_arglist
-- { write_attribute_call1 (ATR_LAST, $3); }
-+ { write_int ($3, builtin_type_int);
-+ write_exp_elt_opcode (OP_ATR_LAST); }
- | type_prefix TICK_LENGTH tick_arglist
-- { write_attribute_call1 (ATR_LENGTH, $3); }
-+ { write_int ($3, builtin_type_int);
-+ write_exp_elt_opcode (OP_ATR_LENGTH); }
- | type_prefix TICK_VAL '(' exp ')'
-- { write_attribute_calln (ATR_VAL, 1); }
-- | type_prefix TICK_MODULUS
-- { write_attribute_call0 (ATR_MODULUS); }
-+ { write_exp_elt_opcode (OP_ATR_VAL); }
-+ | type_prefix TICK_MODULUS
-+ { write_exp_elt_opcode (OP_ATR_MODULUS); }
- ;
-
- tick_arglist : %prec '('
-@@ -509,74 +479,42 @@ type_prefix :
-
- opt_type_prefix :
- type_prefix
-- | /* EMPTY */
-+ | /* EMPTY */
- { write_exp_elt_opcode (OP_TYPE);
- write_exp_elt_type (builtin_type_void);
- write_exp_elt_opcode (OP_TYPE); }
- ;
--
-+
-
- exp : INT
-- { write_exp_elt_opcode (OP_LONG);
-- write_exp_elt_type ($1.type);
-- write_exp_elt_longcst ((LONGEST)($1.val));
-- write_exp_elt_opcode (OP_LONG);
-- }
-+ { write_int ((LONGEST) $1.val, $1.type); }
- ;
-
- exp : CHARLIT
-- { write_exp_elt_opcode (OP_LONG);
-- if (type_qualifier == NULL)
-- write_exp_elt_type ($1.type);
-- else
-- write_exp_elt_type (type_qualifier);
-- write_exp_elt_longcst
-- (convert_char_literal (type_qualifier, $1.val));
-- write_exp_elt_opcode (OP_LONG);
-- }
-+ { write_int (convert_char_literal (type_qualifier, $1.val),
-+ (type_qualifier == NULL)
-+ ? $1.type : type_qualifier);
-+ }
- ;
--
-+
- exp : FLOAT
- { write_exp_elt_opcode (OP_DOUBLE);
- write_exp_elt_type ($1.type);
- write_exp_elt_dblcst ($1.dval);
-- write_exp_elt_opcode (OP_DOUBLE);
-+ write_exp_elt_opcode (OP_DOUBLE);
- }
- ;
-
- exp : NULL_PTR
-- { write_exp_elt_opcode (OP_LONG);
-- write_exp_elt_type (builtin_type_int);
-- write_exp_elt_longcst ((LONGEST)(0));
-- write_exp_elt_opcode (OP_LONG);
-- }
-+ { write_int (0, builtin_type_int); }
- ;
-
- exp : STRING
-- { /* Ada strings are converted into array constants
-- a lower bound of 1. Thus, the array upper bound
-- is the string length. */
-- char *sp = $1.ptr; int count;
-- if ($1.length == 0)
-- { /* One dummy character for the type */
-- write_exp_elt_opcode (OP_LONG);
-- write_exp_elt_type (builtin_type_ada_char);
-- write_exp_elt_longcst ((LONGEST)(0));
-- write_exp_elt_opcode (OP_LONG);
-- }
-- for (count = $1.length; count > 0; count -= 1)
-- {
-- write_exp_elt_opcode (OP_LONG);
-- write_exp_elt_type (builtin_type_ada_char);
-- write_exp_elt_longcst ((LONGEST)(*sp));
-- sp += 1;
-- write_exp_elt_opcode (OP_LONG);
-- }
-- write_exp_elt_opcode (OP_ARRAY);
-- write_exp_elt_longcst ((LONGEST) 1);
-- write_exp_elt_longcst ((LONGEST) ($1.length));
-- write_exp_elt_opcode (OP_ARRAY);
-- }
-+ {
-+ write_exp_elt_opcode (OP_STRING);
-+ write_exp_string ($1);
-+ write_exp_elt_opcode (OP_STRING);
-+ }
- ;
-
- exp : NEW TYPENAME
-@@ -586,9 +524,12 @@ exp : NEW TYPENAME
- variable: NAME { write_var_from_name (NULL, $1); }
- | block NAME /* GDB extension */
- { write_var_from_name ($1, $2); }
-- | OBJECT_RENAMING { write_object_renaming (NULL, $1.sym); }
-- | block OBJECT_RENAMING
-- { write_object_renaming ($1, $2.sym); }
-+ | OBJECT_RENAMING
-+ { write_object_renaming (NULL, $1.sym,
-+ MAX_RENAMING_CHAIN_LENGTH); }
-+ | block OBJECT_RENAMING
-+ { write_object_renaming ($1, $2.sym,
-+ MAX_RENAMING_CHAIN_LENGTH); }
- ;
-
- any_name : NAME { }
-@@ -605,14 +546,14 @@ block : BLOCKNAME /* GDB extension */
-
- type : TYPENAME { $$ = $1; }
- | block TYPENAME { $$ = $2; }
-- | TYPENAME TICK_ACCESS
-+ | TYPENAME TICK_ACCESS
- { $$ = lookup_pointer_type ($1); }
- | block TYPENAME TICK_ACCESS
- { $$ = lookup_pointer_type ($2); }
- ;
-
- /* Some extensions borrowed from C, for the benefit of those who find they
-- can't get used to Ada notation in GDB. */
-+ can't get used to Ada notation in GDB. */
-
- exp : '*' exp %prec '.'
- { write_exp_elt_opcode (UNOP_IND); }
-@@ -642,49 +583,51 @@ exp : '*' exp %prec '.'
- #define yytext ada_yytext
- #define yywrap ada_yywrap
-
-+static struct obstack temp_parse_space;
-+
- /* The following kludge was found necessary to prevent conflicts between */
- /* defs.h and non-standard stdlib.h files. */
- #define qsort __qsort__dummy
- #include "ada-lex.c"
-
- int
--ada_parse ()
-+ada_parse (void)
- {
-- lexer_init (yyin); /* (Re-)initialize lexer. */
-+ lexer_init (yyin); /* (Re-)initialize lexer. */
- left_block_context = NULL;
- type_qualifier = NULL;
--
-+ obstack_free (&temp_parse_space, NULL);
-+ obstack_init (&temp_parse_space);
-+
- return _ada_parse ();
- }
-
- void
--yyerror (msg)
-- char *msg;
-+yyerror (char *msg)
- {
- error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
- }
-
--/* The operator name corresponding to operator symbol STRING (adds
-+/* The operator name corresponding to operator symbol STRING (adds
- quotes and maps to lower-case). Destroys the previous contents of
- the array pointed to by STRING.ptr. Error if STRING does not match
- a valid Ada operator. Assumes that STRING.ptr points to a
- null-terminated string and that, if STRING is a valid operator
- symbol, the array pointed to by STRING.ptr contains at least
-- STRING.length+3 characters. */
-+ STRING.length+3 characters. */
-
- static struct stoken
--string_to_operator (string)
-- struct stoken string;
-+string_to_operator (struct stoken string)
- {
- 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 (string.length == strlen (ada_opname_table[i].demangled)-2
-- && strncasecmp (string.ptr, ada_opname_table[i].demangled+1,
-+ if (string.length == strlen (ada_opname_table[i].decoded)-2
-+ && strncasecmp (string.ptr, ada_opname_table[i].decoded+1,
- string.length) == 0)
- {
-- strncpy (string.ptr, ada_opname_table[i].demangled,
-+ strncpy (string.ptr, ada_opname_table[i].decoded,
- string.length+2);
- string.length += 2;
- return string;
-@@ -694,12 +637,11 @@ string_to_operator (string)
- }
-
- /* Emit expression to access an instance of SYM, in block BLOCK (if
-- * non-NULL), and with :: qualification ORIG_LEFT_CONTEXT. */
-+ * non-NULL), and with :: qualification ORIG_LEFT_CONTEXT. */
- static void
--write_var_from_sym (orig_left_context, block, sym)
-- struct block* orig_left_context;
-- struct block* block;
-- struct symbol* sym;
-+write_var_from_sym (struct block *orig_left_context,
-+ struct block *block,
-+ struct symbol *sym)
- {
- if (orig_left_context == NULL && symbol_read_needs_frame (sym))
- {
-@@ -709,121 +651,91 @@ write_var_from_sym (orig_left_context, b
- }
-
- write_exp_elt_opcode (OP_VAR_VALUE);
-- /* We want to use the selected frame, not another more inner frame
-- which happens to be in the same block */
-- write_exp_elt_block (NULL);
-+ write_exp_elt_block (block);
- write_exp_elt_sym (sym);
- write_exp_elt_opcode (OP_VAR_VALUE);
- }
-
--/* Emit expression to access an instance of NAME. */
-+/* Emit expression to access an instance of NAME in :: context
-+ * ORIG_LEFT_CONTEXT. If no unique symbol for NAME has been found,
-+ * output a dummy symbol (good to the next call of ada_parse) for NAME
-+ * in the UNDEF_DOMAIN, for later resolution by ada_resolve. */
- static void
--write_var_from_name (orig_left_context, name)
-- struct block* orig_left_context;
-- struct name_info name;
-+write_var_from_name (struct block *orig_left_context,
-+ struct name_info name)
- {
- if (name.msym != NULL)
- {
-- write_exp_msymbol (name.msym,
-+ write_exp_msymbol (name.msym,
- lookup_function_type (builtin_type_int),
- builtin_type_int);
- }
-- else if (name.sym == NULL)
-+ else if (name.sym == NULL)
- {
-- /* Multiple matches: record name and starting block for later
-- resolution by ada_resolve. */
-- /* write_exp_elt_opcode (OP_UNRESOLVED_VALUE); */
-- /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */
-+ /* Multiple matches: record name and starting block for later
-+ resolution by ada_resolve. */
-+ char *encoded_name = ada_encode (name.stoken.ptr);
-+ struct symbol *sym =
-+ obstack_alloc (&temp_parse_space, sizeof (struct symbol));
-+ memset (sym, 0, sizeof (struct symbol));
-+ SYMBOL_DOMAIN (sym) = UNDEF_DOMAIN;
-+ SYMBOL_LINKAGE_NAME (sym)
-+ = obsavestring (encoded_name, strlen (encoded_name), &temp_parse_space);
-+ SYMBOL_LANGUAGE (sym) = language_ada;
-+
-+ write_exp_elt_opcode (OP_VAR_VALUE);
- write_exp_elt_block (name.block);
-- /* write_exp_elt_name (name.stoken.ptr); */
-- /* FIXME: write_exp_elt_name should be defined in defs.h, located in parse.c */
-- /* write_exp_elt_opcode (OP_UNRESOLVED_VALUE); */
-- /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */
-+ write_exp_elt_sym (sym);
-+ write_exp_elt_opcode (OP_VAR_VALUE);
- }
- else
- write_var_from_sym (orig_left_context, name.block, name.sym);
- }
-
--/* Write a call on parameterless attribute ATR. */
--
--static void
--write_attribute_call0 (atr)
-- enum ada_attribute atr;
--{
-- /* write_exp_elt_opcode (OP_ATTRIBUTE); */
-- /* FIXME: OP_ATTRIBUTE should be defined in expression.h */
-- write_exp_elt_longcst ((LONGEST) 0);
-- write_exp_elt_longcst ((LONGEST) atr);
-- /* write_exp_elt_opcode (OP_ATTRIBUTE); */
-- /* FIXME: OP_ATTRIBUTE should be defined in expression.h */
--}
--
--/* Write a call on an attribute ATR with one constant integer
-- * parameter. */
-+/* Write integer constant ARG of type TYPE. */
-
- static void
--write_attribute_call1 (atr, arg)
-- enum ada_attribute atr;
-- LONGEST arg;
-+write_int (LONGEST arg, struct type *type)
- {
- write_exp_elt_opcode (OP_LONG);
-- write_exp_elt_type (builtin_type_int);
-+ write_exp_elt_type (type);
- write_exp_elt_longcst (arg);
- write_exp_elt_opcode (OP_LONG);
-- /*write_exp_elt_opcode (OP_ATTRIBUTE);*/
-- /* FIXME: OP_ATTRIBUTE should be defined in expression.h */
-- write_exp_elt_longcst ((LONGEST) 1);
-- write_exp_elt_longcst ((LONGEST) atr);
-- /*write_exp_elt_opcode (OP_ATTRIBUTE);*/
-- /* FIXME: OP_ATTRIBUTE should be defined in expression.h */
--}
--
--/* Write a call on an attribute ATR with N parameters, whose code must have
-- * been generated previously. */
--
--static void
--write_attribute_calln (atr, n)
-- enum ada_attribute atr;
-- int n;
--{
-- /*write_exp_elt_opcode (OP_ATTRIBUTE);*/
-- /* FIXME: OP_ATTRIBUTE should be defined in expression.h */
-- write_exp_elt_longcst ((LONGEST) n);
-- write_exp_elt_longcst ((LONGEST) atr);
-- /* write_exp_elt_opcode (OP_ATTRIBUTE);*/
-- /* FIXME: OP_ATTRIBUTE should be defined in expression.h */
--}
-+}
-
--/* Emit expression corresponding to the renamed object designated by
-+/* Emit expression corresponding to the renamed object designated by
- * the type RENAMING, which must be the referent of an object renaming
-- * type, in the context of ORIG_LEFT_CONTEXT (?). */
-+ * type, in the context of ORIG_LEFT_CONTEXT. MAX_DEPTH is the maximum
-+ * number of cascaded renamings to allow. */
- static void
--write_object_renaming (orig_left_context, renaming)
-- struct block* orig_left_context;
-- struct symbol* renaming;
-+write_object_renaming (struct block *orig_left_context,
-+ struct symbol *renaming, int max_depth)
- {
-- const char* qualification = DEPRECATED_SYMBOL_NAME (renaming);
-- const char* simple_tail;
-- const char* expr = TYPE_FIELD_NAME (SYMBOL_TYPE (renaming), 0);
-- const char* suffix;
-- char* name;
-- struct symbol* sym;
-+ const char *qualification = SYMBOL_LINKAGE_NAME (renaming);
-+ const char *simple_tail;
-+ const char *expr = TYPE_FIELD_NAME (SYMBOL_TYPE (renaming), 0);
-+ const char *suffix;
-+ char *name;
-+ struct symbol *sym;
- enum { SIMPLE_INDEX, LOWER_BOUND, UPPER_BOUND } slice_state;
-
-+ if (max_depth <= 0)
-+ error ("Could not find renamed symbol");
-+
- /* if orig_left_context is null, then use the currently selected
-- block, otherwise we might fail our symbol lookup below */
-+ block; otherwise we might fail our symbol lookup below. */
- if (orig_left_context == NULL)
- orig_left_context = get_selected_block (NULL);
-
-- for (simple_tail = qualification + strlen (qualification);
-+ for (simple_tail = qualification + strlen (qualification);
- simple_tail != qualification; simple_tail -= 1)
- {
- if (*simple_tail == '.')
- {
- simple_tail += 1;
- break;
-- }
-- else if (DEPRECATED_STREQN (simple_tail, "__", 2))
-+ }
-+ else if (strncmp (simple_tail, "__", 2) == 0)
- {
- simple_tail += 2;
- break;
-@@ -834,72 +746,72 @@ write_object_renaming (orig_left_context
- if (suffix == NULL)
- goto BadEncoding;
-
-- name = (char*) malloc (suffix - expr + 1);
-- /* add_name_string_cleanup (name); */
-- /* FIXME: add_name_string_cleanup should be defined in
-- parser-defs.h, implemented in parse.c */
-+ name = (char *) obstack_alloc (&temp_parse_space, suffix - expr + 1);
- strncpy (name, expr, suffix-expr);
- name[suffix-expr] = '\000';
- sym = lookup_symbol (name, orig_left_context, VAR_DOMAIN, 0, NULL);
-- /* if (sym == NULL)
-- error ("Could not find renamed variable: %s", ada_demangle (name));
-- */
-- /* FIXME: ada_demangle should be defined in defs.h, implemented in ada-lang.c */
-- write_var_from_sym (orig_left_context, block_found, sym);
-+ if (sym == NULL)
-+ error ("Could not find renamed variable: %s", ada_decode (name));
-+ if (ada_is_object_renaming (sym))
-+ write_object_renaming (orig_left_context, sym, max_depth-1);
-+ else
-+ write_var_from_sym (orig_left_context, block_found, sym);
-
- suffix += 5;
- slice_state = SIMPLE_INDEX;
-- while (*suffix == 'X')
-+ while (*suffix == 'X')
- {
- suffix += 1;
-
- switch (*suffix) {
-+ case 'A':
-+ suffix += 1;
-+ write_exp_elt_opcode (UNOP_IND);
-+ break;
- case 'L':
- slice_state = LOWER_BOUND;
- case 'S':
- suffix += 1;
-- if (isdigit (*suffix))
-+ if (isdigit (*suffix))
- {
-- char* next;
-+ char *next;
- long val = strtol (suffix, &next, 10);
-- if (next == suffix)
-+ if (next == suffix)
- goto BadEncoding;
- suffix = next;
- write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (builtin_type_ada_int);
- write_exp_elt_longcst ((LONGEST) val);
- write_exp_elt_opcode (OP_LONG);
-- }
-+ }
- else
- {
-- const char* end;
-- char* index_name;
-+ const char *end;
-+ char *index_name;
- int index_len;
-- struct symbol* index_sym;
-+ struct symbol *index_sym;
-
- end = strchr (suffix, 'X');
-- if (end == NULL)
-+ if (end == NULL)
- end = suffix + strlen (suffix);
--
-+
- index_len = simple_tail - qualification + 2 + (suffix - end) + 1;
-- index_name = (char*) malloc (index_len);
-+ index_name
-+ = (char *) obstack_alloc (&temp_parse_space, index_len);
- memset (index_name, '\000', index_len);
-- /* add_name_string_cleanup (index_name);*/
-- /* FIXME: add_name_string_cleanup should be defined in
-- parser-defs.h, implemented in parse.c */
- strncpy (index_name, qualification, simple_tail - qualification);
- index_name[simple_tail - qualification] = '\000';
- strncat (index_name, suffix, suffix-end);
- suffix = end;
-
-- index_sym =
-+ index_sym =
- lookup_symbol (index_name, NULL, VAR_DOMAIN, 0, NULL);
- if (index_sym == NULL)
- error ("Could not find %s", index_name);
- write_var_from_sym (NULL, block_found, sym);
- }
- if (slice_state == SIMPLE_INDEX)
-- {
-+ {
- write_exp_elt_opcode (OP_FUNCALL);
- write_exp_elt_longcst ((LONGEST) 1);
- write_exp_elt_opcode (OP_FUNCALL);
-@@ -916,25 +828,25 @@ write_object_renaming (orig_left_context
- case 'R':
- {
- struct stoken field_name;
-- const char* end;
-+ const char *end;
- suffix += 1;
--
-+
- if (slice_state != SIMPLE_INDEX)
- goto BadEncoding;
- end = strchr (suffix, 'X');
-- if (end == NULL)
-+ if (end == NULL)
- end = suffix + strlen (suffix);
- field_name.length = end - suffix;
-- field_name.ptr = (char*) malloc (end - suffix + 1);
-+ field_name.ptr = (char *) malloc (end - suffix + 1);
- strncpy (field_name.ptr, suffix, end - suffix);
- field_name.ptr[end - suffix] = '\000';
- suffix = end;
- write_exp_elt_opcode (STRUCTOP_STRUCT);
- write_exp_string (field_name);
-- write_exp_elt_opcode (STRUCTOP_STRUCT);
-+ write_exp_elt_opcode (STRUCTOP_STRUCT);
- break;
- }
--
-+
- default:
- goto BadEncoding;
- }
-@@ -944,15 +856,15 @@ write_object_renaming (orig_left_context
-
- BadEncoding:
- error ("Internal error in encoding of renaming declaration: %s",
-- DEPRECATED_SYMBOL_NAME (renaming));
-+ SYMBOL_LINKAGE_NAME (renaming));
- }
-
- /* Convert the character literal whose ASCII value would be VAL to the
- appropriate value of type TYPE, if there is a translation.
-- Otherwise return VAL. Hence, in an enumeration type ('A', 'B'),
-- the literal 'A' (VAL == 65), returns 0. */
-+ Otherwise return VAL. Hence, in an enumeration type ('A', 'B'),
-+ the literal 'A' (VAL == 65), returns 0. */
- static LONGEST
--convert_char_literal (struct type* type, LONGEST val)
-+convert_char_literal (struct type *type, LONGEST val)
- {
- char name[7];
- int f;
-@@ -960,10 +872,16 @@ convert_char_literal (struct type* type,
- if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM)
- return val;
- sprintf (name, "QU%02x", (int) val);
-- for (f = 0; f < TYPE_NFIELDS (type); f += 1)
-+ for (f = 0; f < TYPE_NFIELDS (type); f += 1)
- {
-- if (DEPRECATED_STREQ (name, TYPE_FIELD_NAME (type, f)))
-+ if (strcmp (name, TYPE_FIELD_NAME (type, f)) == 0)
- return TYPE_FIELD_BITPOS (type, f);
- }
- return val;
- }
-+
-+void
-+_initialize_ada_exp (void)
-+{
-+ obstack_init (&temp_parse_space);
-+}
-Index: gdb/ada-lex.l
-===================================================================
-RCS file: /cvs/src/src/gdb/ada-lex.l,v
-retrieving revision 1.3
-diff -u -p -r1.3 ada-lex.l
---- gdb/ada-lex.l 23 Nov 2003 20:41:16 -0000 1.3
-+++ gdb/ada-lex.l 2 Jun 2004 09:52:56 -0000
-@@ -1,5 +1,5 @@
- /* FLEX lexer for Ada expressions, for GDB.
-- Copyright (C) 1994, 1997, 2000
-+ Copyright (C) 1994, 1997, 1998, 2000, 2001, 2002, 2003
- Free Software Foundation, Inc.
-
- This file is part of GDB.
-@@ -45,20 +45,23 @@ EXP (e[+-]{NUM10})
- POSEXP (e"+"?{NUM10})
-
- %{
-+#define malloc xmalloc
-+#define free xfree
-+
- #define NUMERAL_WIDTH 256
- #define LONGEST_SIGN ((ULONGEST) 1 << (sizeof(LONGEST) * HOST_CHAR_BIT - 1))
-
--/* Temporary staging for numeric literals. */
--static char numbuf[NUMERAL_WIDTH];
-- static void canonicalizeNumeral (char* s1, const char*);
--static int processInt (const char*, const char*, const char*);
--static int processReal (const char*);
--static int processId (const char*, int);
--static int processAttribute (const char*);
--static int find_dot_all (const char*);
-+/* Temporary staging for numeric literals. */
-+static char numbuf[NUMERAL_WIDTH];
-+ static void canonicalizeNumeral (char *s1, const char *);
-+static int processInt (const char *, const char *, const char *);
-+static int processReal (const char *);
-+static int processId (const char *, int);
-+static int processAttribute (const char *);
-+static int find_dot_all (const char *);
-
- #undef YY_DECL
--#define YY_DECL static int yylex ( void )
-+#define YY_DECL static int yylex ( void )
-
- #undef YY_INPUT
- #define YY_INPUT(BUF, RESULT, MAX_SIZE) \
-@@ -74,15 +77,15 @@ static int find_dot_all (const char*);
- static char *tempbuf = NULL;
- static int tempbufsize = 0;
- static int tempbuf_len;
--static struct block* left_block_context;
-+static struct block *left_block_context;
-
- static void resize_tempbuf (unsigned int);
-
--static void block_lookup (char*, char*);
-+static void block_lookup (char *, char *);
-
--static int name_lookup (char*, char*, int*);
-+static int name_lookup (char *, char *, int *, int);
-
--static int find_dot_all (const char*);
-+static int find_dot_all (const char *);
-
- %}
-
-@@ -94,20 +97,20 @@ static int find_dot_all (const char*);
-
- "--".* { yyterminate(); }
-
--{NUM10}{POSEXP} {
-- canonicalizeNumeral (numbuf, yytext);
-+{NUM10}{POSEXP} {
-+ canonicalizeNumeral (numbuf, yytext);
- return processInt (NULL, numbuf, strrchr(numbuf, 'e')+1);
- }
-
--{NUM10} {
-- canonicalizeNumeral (numbuf, yytext);
-+{NUM10} {
-+ canonicalizeNumeral (numbuf, yytext);
- return processInt (NULL, numbuf, NULL);
- }
-
- {NUM10}"#"{HEXDIG}({HEXDIG}|_)*"#"{POSEXP} {
- canonicalizeNumeral (numbuf, yytext);
- return processInt (numbuf,
-- strchr (numbuf, '#') + 1,
-+ strchr (numbuf, '#') + 1,
- strrchr(numbuf, '#') + 1);
- }
-
-@@ -123,12 +126,12 @@ static int find_dot_all (const char*);
-
-
- {NUM10}"."{NUM10}{EXP} {
-- canonicalizeNumeral (numbuf, yytext);
-+ canonicalizeNumeral (numbuf, yytext);
- return processReal (numbuf);
- }
-
- {NUM10}"."{NUM10} {
-- canonicalizeNumeral (numbuf, yytext);
-+ canonicalizeNumeral (numbuf, yytext);
- return processReal (numbuf);
- }
-
-@@ -156,7 +159,7 @@ static int find_dot_all (const char*);
-
- \"{OPER}\"/{WHITE}*"(" { return processId (yytext, yyleng); }
-
--<INITIAL>\" {
-+<INITIAL>\" {
- tempbuf_len = 0;
- BEGIN IN_STRING;
- }
-@@ -188,10 +191,10 @@ static int find_dot_all (const char*);
- tempbuf_len += yyleng-4;
- }
-
--if {
-- while (*lexptr != 'i' && *lexptr != 'I')
-- lexptr -= 1;
-- yyrestart(NULL);
-+if {
-+ while (*lexptr != 'i' && *lexptr != 'I')
-+ lexptr -= 1;
-+ yyrestart(NULL);
- return 0;
- }
-
-@@ -234,51 +237,53 @@ xor { return XOR; }
- yyrestart(NULL);
- return 0;
- }
-- else
-+ else
- return ',';
- }
-
- "(" { paren_depth += 1; return '('; }
--")" { if (paren_depth == 0)
-+")" { if (paren_depth == 0)
- {
- lexptr -= 1;
- yyrestart(NULL);
- return 0;
- }
-- else
-+ else
- {
-- paren_depth -= 1;
-+ paren_depth -= 1;
- return ')';
- }
- }
-
- "."{WHITE}*all { return DOT_ALL; }
-
--"."{WHITE}*{ID} {
-+"."{WHITE}*{ID} {
- processId (yytext+1, yyleng-1);
-- return DOT_ID;
-+ return DOT_ID;
- }
-
--{ID}({WHITE}*"."{WHITE}*({ID}|\"{OPER}\"))*(" "*"'")? {
-+{ID}({WHITE}*"."{WHITE}*({ID}|\"{OPER}\"))*(" "*"'")? {
- int all_posn = find_dot_all (yytext);
- int token_type, segments, k;
- int quote_follows;
-
-- if (all_posn == -1 && yytext[yyleng-1] == '\'')
-+ if (all_posn == -1 && yytext[yyleng-1] == '\'')
- {
- quote_follows = 1;
-- do {
-- yyless (yyleng-1);
-+ do {
-+ yyless (yyleng-1);
- } while (yytext[yyleng-1] == ' ');
- }
- else
-- quote_follows = 0;
--
-+ quote_follows = 0;
-+
- if (all_posn >= 0)
- yyless (all_posn);
- processId(yytext, yyleng);
-- segments = name_lookup (ada_mangle (yylval.ssym.stoken.ptr),
-- yylval.ssym.stoken.ptr, &token_type);
-+ segments = name_lookup (ada_encode (yylval.ssym.stoken.ptr),
-+ yylval.ssym.stoken.ptr,
-+ &token_type,
-+ MAX_RENAMING_CHAIN_LENGTH);
- left_block_context = NULL;
- for (k = yyleng; segments > 0 && k > 0; k -= 1)
- {
-@@ -289,7 +294,7 @@ xor { return XOR; }
- if (k <= 0)
- error ("confused by name %s", yytext);
- yyless (k);
-- if (quote_follows)
-+ if (quote_follows)
- BEGIN BEFORE_QUAL_QUOTE;
- return token_type;
- }
-@@ -303,37 +308,21 @@ xor { return XOR; }
- return BLOCKNAME;
- }
-
--{ID}({WHITE}*"."{WHITE}*({ID}|\"{OPER}\"))*{WHITE}*:: {
-+{ID}({WHITE}*"."{WHITE}*({ID}|\"{OPER}\"))*{WHITE}*:: {
- processId(yytext, yyleng-2);
-- block_lookup (ada_mangle (yylval.ssym.stoken.ptr),
-+ block_lookup (ada_encode (yylval.ssym.stoken.ptr),
- yylval.ssym.stoken.ptr);
- return BLOCKNAME;
- }
-
- [{}@] { return yytext[0]; }
-
--"$$" { yylval.lval = -1; return LAST; }
--"$$"{DIG}+ { yylval.lval = -atoi(yytext+2); return LAST; }
--"$" { yylval.lval = 0; return LAST; }
--"$"{DIG}+ { yylval.lval = atoi(yytext+1); return LAST; }
--
--
- /* REGISTERS AND GDB CONVENIENCE VARIABLES */
-
--"$"({LETTER}|{DIG}|"$")+ {
-- int c;
-- for (c = 0; c < NUM_REGS; c++)
-- if (REGISTER_NAME (c) &&
-- strcmp (yytext + 1, REGISTER_NAME (c)) == 0)
-- {
-- yylval.lval = c;
-- return REGNAME;
-- }
-+"$"({LETTER}|{DIG}|"$")* {
- yylval.sval.ptr = yytext;
- yylval.sval.length = yyleng;
-- yylval.ivar =
-- lookup_internalvar (copy_name (yylval.sval) + 1);
-- return INTERNAL_VARIABLE;
-+ return SPECIAL_VARIABLE;
- }
-
- /* CATCH-ALL ERROR CASE */
-@@ -346,34 +335,31 @@ xor { return XOR; }
-
- /* Initialize the lexer for processing new expression */
- void
--lexer_init (FILE* inp)
-+lexer_init (FILE *inp)
- {
- BEGIN INITIAL;
- yyrestart (inp);
- }
-
-
--/* Make sure that tempbuf points at an array at least N characters long. */
-+/* Make sure that tempbuf points at an array at least N characters long. */
-
- static void
--resize_tempbuf (n)
-- unsigned int n;
-+resize_tempbuf (unsigned int n)
- {
- if (tempbufsize < n)
- {
- tempbufsize = (n+63) & ~63;
-- tempbuf = (char*) xrealloc (tempbuf, tempbufsize);
-+ tempbuf = (char *) xrealloc (tempbuf, tempbufsize);
- }
- }
--
--/* Copy S2 to S1, removing all underscores, and downcasing all letters. */
-+
-+/* Copy S2 to S1, removing all underscores, and downcasing all letters. */
-
- static void
--canonicalizeNumeral (s1,s2)
-- char* s1;
-- const char* s2;
-+canonicalizeNumeral (char *s1, const char *s2)
- {
-- for (; *s2 != '\000'; s2 += 1)
-+ for (; *s2 != '\000'; s2 += 1)
- {
- if (*s2 != '_')
- {
-@@ -386,25 +372,22 @@ canonicalizeNumeral (s1,s2)
-
- #define HIGH_BYTE_POSN ((sizeof (ULONGEST) - 1) * HOST_CHAR_BIT)
-
--/* True (non-zero) iff DIGIT is a valid digit in radix BASE,
-+/* True (non-zero) iff DIGIT is a valid digit in radix BASE,
- where 2 <= BASE <= 16. */
-
- static int
--is_digit_in_base (digit, base)
-- unsigned char digit;
-- int base;
-+is_digit_in_base (unsigned char digit, int base)
- {
- if (!isxdigit (digit))
- return 0;
- if (base <= 10)
- return (isdigit (digit) && digit < base + '0');
-- else
-+ else
- return (isdigit (digit) || tolower (digit) < base - 10 + 'a');
- }
-
- static int
--digit_to_int (c)
-- unsigned char c;
-+digit_to_int (unsigned char c)
- {
- if (isdigit (c))
- return c - '0';
-@@ -412,12 +395,9 @@ digit_to_int (c)
- return tolower (c) - 'a' + 10;
- }
-
--/* As for strtoul, but for ULONGEST results. */
-+/* As for strtoul, but for ULONGEST results. */
- ULONGEST
--strtoulst (num, trailer, base)
-- const char *num;
-- const char **trailer;
-- int base;
-+strtoulst (const char *num, const char **trailer, int base)
- {
- unsigned int high_part;
- ULONGEST result;
-@@ -437,7 +417,7 @@ strtoulst (num, trailer, base)
- result = result*base + digit_to_int (num[i]);
- high_part = high_part*base + (unsigned int) (result >> HIGH_BYTE_POSN);
- result &= ((ULONGEST) 1 << HIGH_BYTE_POSN) - 1;
-- if (high_part > 0xff)
-+ if (high_part > 0xff)
- {
- errno = ERANGE;
- result = high_part = 0;
-@@ -456,26 +436,23 @@ strtoulst (num, trailer, base)
- /* Interprets the prefix of NUM that consists of digits of the given BASE
- as an integer of that BASE, with the string EXP as an exponent.
- Puts value in yylval, and returns INT, if the string is valid. Causes
-- an error if the number is improperly formated. BASE, if NULL, defaults
-- to "10", and EXP to "1". The EXP does not contain a leading 'e' or 'E'. */
-+ an error if the number is improperly formated. BASE, if NULL, defaults
-+ to "10", and EXP to "1". The EXP does not contain a leading 'e' or 'E'. */
-
- static int
--processInt (base0, num0, exp0)
-- const char* num0;
-- const char* base0;
-- const char* exp0;
-+processInt (const char *base0, const char *num0, const char *exp0)
- {
- ULONGEST result;
- long exp;
- int base;
-
-- char* trailer;
-+ char *trailer;
-
- if (base0 == NULL)
- base = 10;
- else
-- {
-- base = strtol (base0, (char**) NULL, 10);
-+ {
-+ base = strtol (base0, (char **) NULL, 10);
- if (base < 2 || base > 16)
- error ("Invalid base: %d.", base);
- }
-@@ -483,23 +460,23 @@ processInt (base0, num0, exp0)
- if (exp0 == NULL)
- exp = 0;
- else
-- exp = strtol(exp0, (char**) NULL, 10);
-+ exp = strtol(exp0, (char **) NULL, 10);
-
- errno = 0;
-- result = strtoulst (num0, &trailer, base);
-+ result = strtoulst (num0, (const char **) &trailer, base);
- if (errno == ERANGE)
- error ("Integer literal out of range");
- if (isxdigit(*trailer))
- error ("Invalid digit `%c' in based literal", *trailer);
-
-- while (exp > 0)
-+ while (exp > 0)
- {
- if (result > (ULONG_MAX / base))
- error ("Integer literal out of range");
- result *= base;
- exp -= 1;
- }
--
-+
- if ((result >> (TARGET_INT_BIT-1)) == 0)
- yylval.typed_val.type = builtin_type_ada_int;
- else if ((result >> (TARGET_LONG_BIT-1)) == 0)
-@@ -507,48 +484,47 @@ processInt (base0, num0, exp0)
- else if (((result >> (TARGET_LONG_BIT-1)) >> 1) == 0)
- {
- /* We have a number representable as an unsigned integer quantity.
-- For consistency with the C treatment, we will treat it as an
-+ For consistency with the C treatment, we will treat it as an
- anonymous modular (unsigned) quantity. Alas, the types are such
-- that we need to store .val as a signed quantity. Sorry
-+ that we need to store .val as a signed quantity. Sorry
- for the mess, but C doesn't officially guarantee that a simple
- assignment does the trick (no, it doesn't; read the reference manual).
- */
- yylval.typed_val.type = builtin_type_unsigned_long;
- if (result & LONGEST_SIGN)
-- yylval.typed_val.val =
-- (LONGEST) (result & ~LONGEST_SIGN)
-+ yylval.typed_val.val =
-+ (LONGEST) (result & ~LONGEST_SIGN)
- - (LONGEST_SIGN>>1) - (LONGEST_SIGN>>1);
- else
- yylval.typed_val.val = (LONGEST) result;
- return INT;
- }
-- else
-+ else
- yylval.typed_val.type = builtin_type_ada_long_long;
-
- yylval.typed_val.val = (LONGEST) result;
- return INT;
- }
-
-+#if defined (PRINTF_HAS_LONG_DOUBLE)
-+# undef PRINTF_HAS_LONG_DOUBLE
-+# define PRINTF_HAS_LONG_DOUBLE 1
-+#else
-+# define PRINTF_HAS_LONG_DOUBLE 0
-+#endif
-+
- static int
--processReal (num0)
-- const char* num0;
-+processReal (const char *num0)
- {
-- if (sizeof (DOUBLEST) <= sizeof (float))
-- sscanf (num0, "%g", &yylval.typed_val_float.dval);
-- else if (sizeof (DOUBLEST) <= sizeof (double))
-- sscanf (num0, "%lg", &yylval.typed_val_float.dval);
-+#if defined (PRINTF_HAS_LONG_DOUBLE)
-+ if (sizeof (DOUBLEST) > sizeof (double))
-+ sscanf (num0, "%Lg", &yylval.typed_val_float.dval);
- else
-+#endif
- {
--#ifdef PRINTF_HAS_LONG_DOUBLE
-- sscanf (num0, "%Lg", &yylval.typed_val_float.dval);
--#else
-- /* Scan it into a double, then convert and assign it to the
-- long double. This at least wins with values representable
-- in the range of doubles. */
- double temp;
- sscanf (num0, "%lg", &temp);
- yylval.typed_val_float.dval = temp;
--#endif
- }
-
- yylval.typed_val_float.type = builtin_type_ada_float;
-@@ -561,26 +537,22 @@ processReal (num0)
- }
-
- static int
--processId (name0, len)
-- const char *name0;
-- int len;
-+processId (const char *name0, int len)
- {
-- char* name = xmalloc (len + 11);
-+ char *name = obstack_alloc (&temp_parse_space, len + 11);
- int i0, i;
--
--/* add_name_string_cleanup (name); */
--/* FIXME: add_name_string_cleanup should be defined in parse.c */
-+
- while (len > 0 && isspace (name0[len-1]))
- len -= 1;
- i = i0 = 0;
-- while (i0 < len)
-+ while (i0 < len)
- {
- if (isalnum (name0[i0]))
- {
- name[i] = tolower (name0[i0]);
- i += 1; i0 += 1;
- }
-- else switch (name0[i0])
-+ else switch (name0[i0])
- {
- default:
- name[i] = name0[i0];
-@@ -617,19 +589,16 @@ processId (name0, len)
- return NAME;
- }
-
--static void
--block_lookup (name, err_name)
-- char* name;
-- char* err_name;
-+static void
-+block_lookup (char *name, char *err_name)
- {
-- struct symbol** syms;
-- struct block** blocks;
-+ struct ada_symbol_info *syms;
- int nsyms;
- struct symtab *symtab;
- nsyms = ada_lookup_symbol_list (name, left_block_context,
-- VAR_DOMAIN, &syms, &blocks);
-+ VAR_DOMAIN, &syms);
- if (left_block_context == NULL &&
-- (nsyms == 0 || SYMBOL_CLASS (syms[0]) != LOC_BLOCK))
-+ (nsyms == 0 || SYMBOL_CLASS (syms[0].sym) != LOC_BLOCK))
- symtab = lookup_symtab (name);
- else
- symtab = NULL;
-@@ -637,72 +606,85 @@ block_lookup (name, err_name)
- if (symtab != NULL)
- left_block_context = yylval.bval =
- BLOCKVECTOR_BLOCK (BLOCKVECTOR (symtab), STATIC_BLOCK);
-- else if (nsyms == 0 || SYMBOL_CLASS (syms[0]) != LOC_BLOCK)
-+ else if (nsyms == 0 || SYMBOL_CLASS (syms[0].sym) != LOC_BLOCK)
- {
- if (left_block_context == NULL)
- error ("No file or function \"%s\".", err_name);
- else
- error ("No function \"%s\" in specified context.", err_name);
- }
-- else
-+ else
- {
-- left_block_context = yylval.bval = SYMBOL_BLOCK_VALUE (syms[0]);
-+ left_block_context = yylval.bval = SYMBOL_BLOCK_VALUE (syms[0].sym);
- if (nsyms > 1)
- warning ("Function name \"%s\" ambiguous here", err_name);
- }
- }
-
--/* Look up NAME0 (assumed to be mangled) as a name in VAR_DOMAIN,
-+/* Look up NAME0 (assumed to be encoded) as a name in VAR_DOMAIN,
- setting *TOKEN_TYPE to NAME or TYPENAME, depending on what is
-- found. Try first the entire name, then the name without the last
-+ found. Try first the entire name, then the name without the last
- segment (i.e., after the last .id), etc., and return the number of
-- segments that had to be removed to get a match. Calls error if no
-+ segments that had to be removed to get a match. Try only the full
-+ name if it starts with "standard__". Calls error if no
- matches are found, using ERR_NAME in any error message. When
-- exactly one symbol match is found, it is placed in yylval. */
--
-+ exactly one symbol match is found, it is placed in yylval. When
-+ the symbol is a renaming, follow at most DEPTH steps to find the
-+ ultimate definition; cause error if depth exceeded. */
-+
- static int
--name_lookup (name0, err_name, token_type)
-- char* name0;
-- char* err_name;
-- int* token_type;
--{
-- struct symbol** syms;
-- struct block** blocks;
-- struct type* type;
-+name_lookup (char *name0, char *err_name, int *token_type, int depth)
-+{
-+ struct ada_symbol_info *syms;
-+ struct type *type;
- int len0 = strlen (name0);
-- char* name = savestring (name0, len0);
-+ char *name = obsavestring (name0, len0, &temp_parse_space);
- int nsyms;
- int segments;
--
--/* add_name_string_cleanup (name);*/
--/* FIXME: add_name_string_cleanup should be defined in parse.c */
-+
-+ if (depth <= 0)
-+ error ("Could not find renamed symbol \"%s\"", err_name);
-+
- yylval.ssym.stoken.ptr = name;
- yylval.ssym.stoken.length = strlen (name);
- for (segments = 0; ; segments += 1)
- {
-- struct type* preferred_type;
-+ struct type *preferred_type;
- int i, preferred_index;
-
-- if (left_block_context == NULL)
-- nsyms = ada_lookup_symbol_list (name, expression_context_block,
-- VAR_DOMAIN, &syms, &blocks);
-+ if (left_block_context == NULL)
-+ nsyms = ada_lookup_symbol_list (name, expression_context_block,
-+ VAR_DOMAIN, &syms);
- else
-- nsyms = ada_lookup_symbol_list (name, left_block_context,
-- VAR_DOMAIN, &syms, &blocks);
-+ nsyms = ada_lookup_symbol_list (name, left_block_context,
-+ VAR_DOMAIN, &syms);
-+
-
-- /* Check for a type definition. */
-+ /* Check for a type renaming. */
-+
-+ if (nsyms == 1 && !ada_is_object_renaming (syms[0].sym))
-+ {
-+ struct symbol *renaming_sym =
-+ ada_find_renaming_symbol (SYMBOL_LINKAGE_NAME (syms[0].sym),
-+ syms[0].block);
-+
-+ if (renaming_sym != NULL)
-+ syms[0].sym = renaming_sym;
-+ }
-+
-+ /* Check for a type definition. */
-
- /* Look for a symbol that doesn't denote void. This is (I think) a */
-- /* temporary kludge to get around problems in GNAT output. */
-+ /* temporary kludge to get around problems in GNAT output. */
- preferred_index = -1; preferred_type = NULL;
- for (i = 0; i < nsyms; i += 1)
-- switch (SYMBOL_CLASS (syms[i]))
-+ switch (SYMBOL_CLASS (syms[i].sym))
- {
- case LOC_TYPEDEF:
-- if (ada_prefer_type (SYMBOL_TYPE (syms[i]), preferred_type))
-+ if (ada_prefer_type (SYMBOL_TYPE (syms[i].sym), preferred_type))
- {
- preferred_index = i;
-- preferred_type = SYMBOL_TYPE (syms[i]);
-+ preferred_type = SYMBOL_TYPE (syms[i].sym);
- }
- break;
- case LOC_REGISTER:
-@@ -714,37 +696,38 @@ name_lookup (name0, err_name, token_type
- case LOC_LOCAL_ARG:
- case LOC_BASEREG:
- case LOC_BASEREG_ARG:
-+ case LOC_COMPUTED:
-+ case LOC_COMPUTED_ARG:
- goto NotType;
- default:
- break;
- }
- if (preferred_type != NULL)
- {
--/* if (TYPE_CODE (preferred_type) == TYPE_CODE_VOID)
-- error ("`%s' matches only void type name(s)",
-- ada_demangle (name));
--*/
--/* FIXME: ada_demangle should be defined in defs.h, and is located in ada-lang.c */
--/* else*/ if (ada_is_object_renaming (syms[preferred_index]))
-+ if (TYPE_CODE (preferred_type) == TYPE_CODE_VOID)
-+ error ("`%s' matches only void type name(s)",
-+ ada_decode (name));
-+ else if (ada_is_object_renaming (syms[preferred_index].sym))
- {
-- yylval.ssym.sym = syms[preferred_index];
-+ yylval.ssym.sym = syms[preferred_index].sym;
- *token_type = OBJECT_RENAMING;
- return segments;
-- }
-- else if (ada_renaming_type (SYMBOL_TYPE (syms[preferred_index]))
-+ }
-+ else if (ada_renaming_type (SYMBOL_TYPE (syms[preferred_index].sym))
- != NULL)
- {
- int result;
-- const char* renaming =
-- ada_simple_renamed_entity (syms[preferred_index]);
-- char* new_name = xmalloc (strlen (renaming) + len0
-- - yylval.ssym.stoken.length + 1);
--/* add_name_string_cleanup (new_name);*/
--/* FIXME: add_name_string_cleanup should be defined in parse.c */
-+ char *renaming
-+ = ada_simple_renamed_entity (syms[preferred_index].sym);
-+ char *new_name
-+ = (char *) obstack_alloc (&temp_parse_space,
-+ strlen (renaming) + len0
-+ - yylval.ssym.stoken.length + 1);
- strcpy (new_name, renaming);
-+ free (renaming);
- strcat (new_name, name0 + yylval.ssym.stoken.length);
-- result = name_lookup (new_name, err_name, token_type);
-- if (result > segments)
-+ result = name_lookup (new_name, err_name, token_type, depth - 1);
-+ if (result > segments)
- error ("Confused by renamed symbol.");
- return result;
- }
-@@ -753,16 +736,29 @@ name_lookup (name0, err_name, token_type
- yylval.tval = preferred_type;
- *token_type = TYPENAME;
- return 0;
-- }
-+ }
- }
-
- if (segments == 0)
- {
- type = lookup_primitive_typename (name);
-- if (type == NULL && DEPRECATED_STREQ ("system__address", name))
-+ if (type == NULL && strcmp ("system__address", name) == 0)
- type = builtin_type_ada_system_address;
- if (type != NULL)
- {
-+ /* First check to see if we have a regular definition of this
-+ type that just didn't happen to have been read yet. */
-+ int ntypes;
-+ struct symbol *sym;
-+ char *expanded_name =
-+ (char *) alloca (strlen (name) + sizeof ("standard__"));
-+ strcpy (expanded_name, "standard__");
-+ strcat (expanded_name, name);
-+ sym = ada_lookup_symbol (expanded_name, NULL,
-+ VAR_DOMAIN, NULL, NULL);
-+ if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
-+ type = SYMBOL_TYPE (sym);
-+
- yylval.tval = type;
- *token_type = TYPENAME;
- return 0;
-@@ -770,17 +766,17 @@ name_lookup (name0, err_name, token_type
- }
-
- NotType:
-- if (nsyms == 1)
-+ if (nsyms == 1)
- {
- *token_type = NAME;
-- yylval.ssym.sym = syms[0];
-+ yylval.ssym.sym = syms[0].sym;
- yylval.ssym.msym = NULL;
-- yylval.ssym.block = blocks[0];
-+ yylval.ssym.block = syms[0].block;
- return segments;
- }
- else if (nsyms == 0) {
- int i;
-- yylval.ssym.msym = ada_lookup_minimal_symbol (name);
-+ yylval.ssym.msym = ada_lookup_simple_minsym (name);
- if (yylval.ssym.msym != NULL)
- {
- yylval.ssym.sym = NULL;
-@@ -789,10 +785,14 @@ name_lookup (name0, err_name, token_type
- return segments;
- }
-
-+ if (segments == 0
-+ && strncmp (name, "standard__", sizeof ("standard__") - 1) == 0)
-+ error ("No definition of \"%s\" found.", err_name);
-+
- for (i = yylval.ssym.stoken.length - 1; i > 0; i -= 1)
- {
- if (name[i] == '.')
-- {
-+ {
- name[i] = '\0';
- yylval.ssym.stoken.length = i;
- break;
-@@ -805,20 +805,20 @@ name_lookup (name0, err_name, token_type
- break;
- }
- }
-- if (i <= 0)
-+ if (i <= 0)
- {
- if (!have_full_symbols () && !have_partial_symbols ()
- && left_block_context == NULL)
- error ("No symbol table is loaded. Use the \"file\" command.");
- if (left_block_context == NULL)
-- error ("No definition of \"%s\" in current context.",
-+ error ("No definition of \"%s\" in current context.",
- err_name);
- else
-- error ("No definition of \"%s\" in specified context.",
-+ error ("No definition of \"%s\" in specified context.",
- err_name);
- }
- }
-- else
-+ else
- {
- *token_type = NAME;
- yylval.ssym.sym = NULL;
-@@ -833,10 +833,9 @@ name_lookup (name0, err_name, token_type
- }
-
- /* Returns the position within STR of the '.' in a
-- '.{WHITE}*all' component of a dotted name, or -1 if there is none. */
-+ '.{WHITE}*all' component of a dotted name, or -1 if there is none. */
- static int
--find_dot_all (str)
-- const char* str;
-+find_dot_all (const char *str)
- {
- int i;
- for (i = 0; str[i] != '\000'; i += 1)
-@@ -844,7 +843,7 @@ find_dot_all (str)
- if (str[i] == '.')
- {
- int i0 = i;
-- do
-+ do
- i += 1;
- while (isspace (str[i]));
- if (strcmp (str+i, "all") == 0
-@@ -853,15 +852,13 @@ find_dot_all (str)
- }
- }
- return -1;
--}
-+}
-
- /* Returns non-zero iff string SUBSEQ matches a subsequence of STR, ignoring
-- case. */
-+ case. */
-
- static int
--subseqMatch (subseq, str)
-- const char* subseq;
-- const char* str;
-+subseqMatch (const char *subseq, const char *str)
- {
- if (subseq[0] == '\0')
- return 1;
-@@ -872,9 +869,9 @@ subseqMatch (subseq, str)
- else
- return subseqMatch (subseq, str+1);
- }
--
-
--static struct { const char* name; int code; }
-+
-+static struct { const char *name; int code; }
- attributes[] = {
- { "address", TICK_ADDRESS },
- { "unchecked_access", TICK_ACCESS },
-@@ -898,8 +895,7 @@ attributes[] = {
- abbreviation STR. */
-
- static int
--processAttribute (str)
-- const char* str;
-+processAttribute (const char *str)
- {
- int i, k;
-
-@@ -908,11 +904,11 @@ processAttribute (str)
- return attributes[i].code;
-
- for (i = 0, k = -1; attributes[i].code != -1; i += 1)
-- if (subseqMatch (str, attributes[i].name))
-+ if (subseqMatch (str, attributes[i].name))
- {
- if (k == -1)
- k = i;
-- else
-+ else
- error ("ambiguous attribute name: `%s'", str);
- }
- if (k == -1)
-@@ -922,7 +918,7 @@ processAttribute (str)
- }
-
- int
--yywrap()
-+yywrap(void)
- {
- return 1;
- }
-
+++ /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);
+++ /dev/null
-From gdb-patches-return-33536-listarch-gdb-patches=sources dot redhat dot com at sources dot redhat dot com Wed Jun 02 10:17:17 2004
-Return-Path: <gdb-patches-return-33536-listarch-gdb-patches=sources dot redhat dot com at sources dot redhat dot com>
-Delivered-To: listarch-gdb-patches at sources dot redhat dot com
-Received: (qmail 11944 invoked by alias); 2 Jun 2004 10:17:15 -0000
-Mailing-List: contact gdb-patches-help at sources dot redhat dot com; run by ezmlm
-Precedence: bulk
-List-Subscribe: <mailto:gdb-patches-subscribe at sources dot redhat dot com>
-List-Archive: <http://sources.redhat.com/ml/gdb-patches/>
-List-Post: <mailto:gdb-patches at sources dot redhat dot com>
-List-Help: <mailto:gdb-patches-help at sources dot redhat dot com>, <http://sources dot redhat dot com/ml/#faqs>
-Sender: gdb-patches-owner at sources dot redhat dot com
-Delivered-To: mailing list gdb-patches at sources dot redhat dot com
-Received: (qmail 11801 invoked from network); 2 Jun 2004 10:16:55 -0000
-Received: from unknown (HELO nile.gnat.com) (205.232.38.5)
- by sourceware dot org with SMTP; 2 Jun 2004 10:16:55 -0000
-Received: from localhost (localhost [127.0.0.1])
- by nile dot gnat dot com (Postfix) with ESMTP id E93EEF28CC
- for <gdb-patches at sources dot redhat dot com>; Wed, 2 Jun 2004 06:16:49 -0400 (EDT)
-Received: from nile.gnat.com ([127.0.0.1])
- by localhost (nile dot gnat dot com [127 dot 0 dot 0 dot 1]) (amavisd-new, port 10024) with LMTP
- id 16597-01-4 for <gdb-patches at sources dot redhat dot com>;
- Wed, 2 Jun 2004 06:16:49 -0400 (EDT)
-Received: by nile.gnat.com (Postfix, from userid 1345)
- id 1C85DF28D3; Wed, 2 Jun 2004 06:16:49 -0400 (EDT)
-From: Paul Hilfinger <hilfingr at gnat dot com>
-To: gdb-patches at sources dot redhat dot com
-Subject: [PATCH]: Updates to Ada sources, part 2b (long)
-Message-Id: <20040602101649.1C85DF28D3@nile.gnat.com>
-Date: Wed, 2 Jun 2004 06:16:49 -0400 (EDT)
-X-Virus-Scanned: by amavisd-new at nile.gnat.com
-
-
-
-
-Index: gdb/ada-lang.c
-===================================================================
-RCS file: /cvs/src/src/gdb/ada-lang.c,v
-retrieving revision 1.35
-diff -u -p -r1.35 ada-lang.c
---- gdb/ada-lang.c 23 Jan 2004 23:03:28 -0000 1.35
-+++ gdb/ada-lang.c 2 Jun 2004 09:52:56 -0000
-@@ -6573,26 +8293,25 @@ ada_is_string_type (struct type *type)
-
- /* True if TYPE is a struct type introduced by the compiler to force the
- alignment of a value. Such types have a single field with a
-- distinctive name. */
-+ distinctive name. */
-
- int
- ada_is_aligner_type (struct type *type)
- {
- CHECK_TYPEDEF (type);
- return (TYPE_CODE (type) == TYPE_CODE_STRUCT
-- && TYPE_NFIELDS (type) == 1
-- && DEPRECATED_STREQ (TYPE_FIELD_NAME (type, 0), "F"));
-+ && TYPE_NFIELDS (type) == 1
-+ && strcmp (TYPE_FIELD_NAME (type, 0), "F") == 0);
- }
-
- /* If there is an ___XVS-convention type parallel to SUBTYPE, return
-- the parallel type. */
-+ the parallel type. */
-
- struct type *
- ada_get_base_type (struct type *raw_type)
- {
- struct type *real_type_namer;
- struct type *raw_real_type;
-- struct type *real_type;
-
- if (raw_type == NULL || TYPE_CODE (raw_type) != TYPE_CODE_STRUCT)
- return raw_type;
-@@ -6610,7 +8329,7 @@ ada_get_base_type (struct type *raw_type
- return raw_real_type;
- }
-
--/* The type of value designated by TYPE, with all aligners removed. */
-+/* The type of value designated by TYPE, with all aligners removed. */
-
- struct type *
- ada_aligned_type (struct type *type)
-@@ -6623,82 +8342,110 @@ ada_aligned_type (struct type *type)
-
-
- /* The address of the aligned value in an object at address VALADDR
-- having type TYPE. Assumes ada_is_aligner_type (TYPE). */
-+ having type TYPE. Assumes ada_is_aligner_type (TYPE). */
-
- char *
- ada_aligned_value_addr (struct type *type, char *valaddr)
- {
- if (ada_is_aligner_type (type))
- return ada_aligned_value_addr (TYPE_FIELD_TYPE (type, 0),
-- valaddr +
-- TYPE_FIELD_BITPOS (type,
-- 0) / TARGET_CHAR_BIT);
-+ valaddr +
-+ TYPE_FIELD_BITPOS (type,
-+ 0) / TARGET_CHAR_BIT);
- else
- return valaddr;
- }
-
-+
-+
- /* The printed representation of an enumeration literal with encoded
-- name NAME. The value is good to the next call of ada_enum_name. */
-+ name NAME. The value is good to the next call of ada_enum_name. */
- const char *
- ada_enum_name (const char *name)
- {
-+ static char *result;
-+ static size_t result_len = 0;
- char *tmp;
-
-- while (1)
-- {
-- if ((tmp = strstr (name, "__")) != NULL)
-- name = tmp + 2;
-- else if ((tmp = strchr (name, '.')) != NULL)
-- name = tmp + 1;
-- else
-- break;
-+ /* First, unqualify the enumeration name:
-+ 1. Search for the last '.' character. If we find one, then skip
-+ all the preceeding characters, the unqualified name starts
-+ right after that dot.
-+ 2. Otherwise, we may be debugging on a target where the compiler
-+ translates dots into "__". Search forward for double underscores,
-+ but stop searching when we hit an overloading suffix, which is
-+ of the form "__" followed by digits. */
-+
-+ if ((tmp = strrchr (name, '.')) != NULL)
-+ name = tmp + 1;
-+ else
-+ {
-+ while ((tmp = strstr (name, "__")) != NULL)
-+ {
-+ if (isdigit (tmp[2]))
-+ break;
-+ else
-+ name = tmp + 2;
-+ }
- }
-
- if (name[0] == 'Q')
- {
-- static char result[16];
- int v;
- if (name[1] == 'U' || name[1] == 'W')
-- {
-- if (sscanf (name + 2, "%x", &v) != 1)
-- return name;
-- }
-+ {
-+ if (sscanf (name + 2, "%x", &v) != 1)
-+ return name;
-+ }
- else
-- return name;
-+ return name;
-
-+ GROW_VECT (result, result_len, 16);
- if (isascii (v) && isprint (v))
-- sprintf (result, "'%c'", v);
-+ sprintf (result, "'%c'", v);
- else if (name[1] == 'U')
-- sprintf (result, "[\"%02x\"]", v);
-+ sprintf (result, "[\"%02x\"]", v);
- else
-- sprintf (result, "[\"%04x\"]", v);
-+ sprintf (result, "[\"%04x\"]", v);
-
- return result;
- }
- else
-- return name;
-+ {
-+ if ((tmp = strstr (name, "__")) != NULL
-+ || (tmp = strstr (name, "$")) != NULL)
-+ {
-+ GROW_VECT (result, result_len, tmp - name + 1);
-+ strncpy (result, name, tmp - name);
-+ result[tmp - name] = '\0';
-+ return result;
-+ }
-+
-+ return name;
-+ }
- }
-
- static struct value *
- evaluate_subexp (struct type *expect_type, struct expression *exp, int *pos,
-- enum noside noside)
-+ enum noside noside)
- {
-- return (*exp->language_defn->evaluate_exp) (expect_type, exp, pos, noside);
-+ return (*exp->language_defn->la_exp_desc->evaluate_exp)
-+ (expect_type, exp, pos, noside);
- }
-
- /* Evaluate the subexpression of EXP starting at *POS as for
- evaluate_type, updating *POS to point just past the evaluated
-- expression. */
-+ expression. */
-
- static struct value *
- evaluate_subexp_type (struct expression *exp, int *pos)
- {
-- return (*exp->language_defn->evaluate_exp)
-+ return (*exp->language_defn->la_exp_desc->evaluate_exp)
- (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
- }
-
- /* If VAL is wrapped in an aligner or subtype wrapper, return the
-- value it wraps. */
-+ value it wraps. */
-
- static struct value *
- unwrap_value (struct value *val)
-@@ -6707,26 +8454,26 @@ unwrap_value (struct value *val)
- if (ada_is_aligner_type (type))
- {
- struct value *v = value_struct_elt (&val, NULL, "F",
-- NULL, "internal structure");
-+ NULL, "internal structure");
- struct type *val_type = check_typedef (VALUE_TYPE (v));
- if (ada_type_name (val_type) == NULL)
-- TYPE_NAME (val_type) = ada_type_name (type);
-+ TYPE_NAME (val_type) = ada_type_name (type);
-
- return unwrap_value (v);
- }
- else
- {
- struct type *raw_real_type =
-- ada_completed_type (ada_get_base_type (type));
-+ ada_completed_type (ada_get_base_type (type));
-
- if (type == raw_real_type)
-- return val;
-+ return val;
-
- return
-- coerce_unspec_val_to_type
-- (val, 0, ada_to_fixed_type (raw_real_type, 0,
-- VALUE_ADDRESS (val) + VALUE_OFFSET (val),
-- NULL));
-+ coerce_unspec_val_to_type
-+ (val, ada_to_fixed_type (raw_real_type, 0,
-+ VALUE_ADDRESS (val) + VALUE_OFFSET (val),
-+ NULL));
- }
- }
-
-@@ -6739,12 +8486,12 @@ cast_to_fixed (struct type *type, struct
- return arg;
- else if (ada_is_fixed_point_type (VALUE_TYPE (arg)))
- val = ada_float_to_fixed (type,
-- ada_fixed_to_float (VALUE_TYPE (arg),
-- value_as_long (arg)));
-+ ada_fixed_to_float (VALUE_TYPE (arg),
-+ value_as_long (arg)));
- else
- {
- DOUBLEST argd =
-- value_as_double (value_cast (builtin_type_double, value_copy (arg)));
-+ value_as_double (value_cast (builtin_type_double, value_copy (arg)));
- val = ada_float_to_fixed (type, argd);
- }
-
-@@ -6755,12 +8502,13 @@ static struct value *
- cast_from_fixed_to_double (struct value *arg)
- {
- DOUBLEST val = ada_fixed_to_float (VALUE_TYPE (arg),
-- value_as_long (arg));
-+ value_as_long (arg));
- return value_from_double (builtin_type_double, val);
- }
-
--/* Coerce VAL as necessary for assignment to an lval of type TYPE, and
-- * return the converted value. */
-+/* Coerce VAL as necessary for assignment to an lval of type TYPE, and
-+ return the converted value. */
-+
- static struct value *
- coerce_for_assign (struct type *type, struct value *val)
- {
-@@ -6782,20 +8530,98 @@ coerce_for_assign (struct type *type, st
- && TYPE_CODE (type) == TYPE_CODE_ARRAY)
- {
- if (TYPE_LENGTH (type2) != TYPE_LENGTH (type)
-- || TYPE_LENGTH (TYPE_TARGET_TYPE (type2))
-- != TYPE_LENGTH (TYPE_TARGET_TYPE (type2)))
-- error ("Incompatible types in assignment");
-+ || TYPE_LENGTH (TYPE_TARGET_TYPE (type2))
-+ != TYPE_LENGTH (TYPE_TARGET_TYPE (type2)))
-+ error ("Incompatible types in assignment");
- VALUE_TYPE (val) = type;
- }
- return val;
- }
-
-+static struct value *
-+ada_value_binop (struct value *arg1, struct value *arg2, enum exp_opcode op)
-+{
-+ struct value *val;
-+ struct type *type1, *type2;
-+ LONGEST v, v1, v2;
-+
-+ COERCE_REF (arg1);
-+ COERCE_REF (arg2);
-+ type1 = base_type (check_typedef (VALUE_TYPE (arg1)));
-+ type2 = base_type (check_typedef (VALUE_TYPE (arg2)));
-+
-+ if (TYPE_CODE (type1) != TYPE_CODE_INT || TYPE_CODE (type2) != TYPE_CODE_INT)
-+ return value_binop (arg1, arg2, op);
-+
-+ switch (op)
-+ {
-+ case BINOP_MOD:
-+ case BINOP_DIV:
-+ case BINOP_REM:
-+ break;
-+ default:
-+ return value_binop (arg1, arg2, op);
-+ }
-+
-+ v2 = value_as_long (arg2);
-+ if (v2 == 0)
-+ error ("second operand of %s must not be zero.", op_string (op));
-+
-+ if (TYPE_UNSIGNED (type1) || op == BINOP_MOD)
-+ return value_binop (arg1, arg2, op);
-+
-+ v1 = value_as_long (arg1);
-+ switch (op)
-+ {
-+ case BINOP_DIV:
-+ v = v1 / v2;
-+ if (! TRUNCATION_TOWARDS_ZERO && v1 * (v1%v2) < 0)
-+ v += v > 0 ? -1 : 1;
-+ break;
-+ case BINOP_REM:
-+ v = v1 % v2;
-+ if (v*v1 < 0)
-+ v -= v2;
-+ break;
-+ default:
-+ /* Should not reach this point. */
-+ v = 0;
-+ }
-+
-+ val = allocate_value (type1);
-+ store_unsigned_integer (VALUE_CONTENTS_RAW (val),
-+ TYPE_LENGTH (VALUE_TYPE (val)),
-+ v);
-+ return val;
-+}
-+
-+static int
-+ada_value_equal (struct value *arg1, struct value *arg2)
-+{
-+ if (ada_is_direct_array_type (VALUE_TYPE (arg1))
-+ || ada_is_direct_array_type (VALUE_TYPE (arg2)))
-+ {
-+ arg1 = ada_coerce_to_simple_array (arg1);
-+ arg2 = ada_coerce_to_simple_array (arg2);
-+ if (TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_ARRAY
-+ || TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_ARRAY)
-+ error ("Attempt to compare array with non-array");
-+ /* FIXME: The following works only for types whose
-+ representations use all bits (no padding or undefined bits)
-+ and do not have user-defined equality. */
-+ return
-+ TYPE_LENGTH (VALUE_TYPE (arg1)) == TYPE_LENGTH (VALUE_TYPE (arg2))
-+ && memcmp (VALUE_CONTENTS (arg1), VALUE_CONTENTS (arg2),
-+ TYPE_LENGTH (VALUE_TYPE (arg1))) == 0;
-+ }
-+ return value_equal (arg1, arg2);
-+}
-+
- struct value *
- ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
-- int *pos, enum noside noside)
-+ int *pos, enum noside noside)
- {
- enum exp_opcode op;
-- enum ada_attribute atr;
- int tem, tem2, tem3;
- int pc;
- struct value *arg1 = NULL, *arg2 = NULL, *arg3;
-@@ -6812,752 +8638,734 @@ ada_evaluate_subexp (struct type *expect
- default:
- *pos -= 1;
- return
-- unwrap_value (evaluate_subexp_standard
-- (expect_type, exp, pos, noside));
-+ unwrap_value (evaluate_subexp_standard
-+ (expect_type, exp, pos, noside));
-+
-+ case OP_STRING:
-+ {
-+ struct value *result;
-+ *pos -= 1;
-+ result = evaluate_subexp_standard (expect_type, exp, pos, noside);
-+ /* The result type will have code OP_STRING, bashed there from
-+ OP_ARRAY. Bash it back. */
-+ if (TYPE_CODE (VALUE_TYPE (result)) == TYPE_CODE_STRING)
-+ TYPE_CODE (VALUE_TYPE (result)) = TYPE_CODE_ARRAY;
-+ return result;
-+ }
-
- case UNOP_CAST:
- (*pos) += 2;
- type = exp->elts[pc + 1].type;
- arg1 = evaluate_subexp (type, exp, pos, noside);
- if (noside == EVAL_SKIP)
-- goto nosideret;
-+ goto nosideret;
- if (type != check_typedef (VALUE_TYPE (arg1)))
-- {
-- if (ada_is_fixed_point_type (type))
-- arg1 = cast_to_fixed (type, arg1);
-- else if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
-- arg1 = value_cast (type, cast_from_fixed_to_double (arg1));
-- else if (VALUE_LVAL (arg1) == lval_memory)
-- {
-- /* This is in case of the really obscure (and undocumented,
-- but apparently expected) case of (Foo) Bar.all, where Bar
-- is an integer constant and Foo is a dynamic-sized type.
-- If we don't do this, ARG1 will simply be relabeled with
-- TYPE. */
-- if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- return value_zero (to_static_fixed_type (type), not_lval);
-- arg1 =
-- ada_to_fixed_value
-- (type, 0, VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1), 0);
-- }
-- else
-- arg1 = value_cast (type, arg1);
-- }
-+ {
-+ if (ada_is_fixed_point_type (type))
-+ arg1 = cast_to_fixed (type, arg1);
-+ else if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
-+ arg1 = value_cast (type, cast_from_fixed_to_double (arg1));
-+ else if (VALUE_LVAL (arg1) == lval_memory)
-+ {
-+ /* This is in case of the really obscure (and undocumented,
-+ but apparently expected) case of (Foo) Bar.all, where Bar
-+ is an integer constant and Foo is a dynamic-sized type.
-+ If we don't do this, ARG1 will simply be relabeled with
-+ TYPE. */
-+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
-+ return value_zero (to_static_fixed_type (type), not_lval);
-+ arg1 =
-+ ada_to_fixed_value_create
-+ (type, VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1), 0);
-+ }
-+ else
-+ arg1 = value_cast (type, arg1);
-+ }
- return arg1;
-
-- /* FIXME: UNOP_QUAL should be defined in expression.h */
-- /* case UNOP_QUAL:
-- (*pos) += 2;
-- type = exp->elts[pc + 1].type;
-- return ada_evaluate_subexp (type, exp, pos, noside);
-- */
-+ case UNOP_QUAL:
-+ (*pos) += 2;
-+ type = exp->elts[pc + 1].type;
-+ return ada_evaluate_subexp (type, exp, pos, noside);
-+
- case BINOP_ASSIGN:
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
- if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
-- return arg1;
-- if (binop_user_defined_p (op, arg1, arg2))
-- return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL);
-+ return arg1;
-+ if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
-+ arg2 = cast_to_fixed (VALUE_TYPE (arg1), arg2);
-+ else if (ada_is_fixed_point_type (VALUE_TYPE (arg2)))
-+ error
-+ ("Fixed-point values must be assigned to fixed-point variables");
- else
-- {
-- if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
-- arg2 = cast_to_fixed (VALUE_TYPE (arg1), arg2);
-- else if (ada_is_fixed_point_type (VALUE_TYPE (arg2)))
-- error
-- ("Fixed-point values must be assigned to fixed-point variables");
-- else
-- arg2 = coerce_for_assign (VALUE_TYPE (arg1), arg2);
-- return ada_value_assign (arg1, arg2);
-- }
-+ arg2 = coerce_for_assign (VALUE_TYPE (arg1), arg2);
-+ return ada_value_assign (arg1, arg2);
-
- case BINOP_ADD:
- arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
- arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
- if (noside == EVAL_SKIP)
-- goto nosideret;
-- if (binop_user_defined_p (op, arg1, arg2))
-- return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL);
-- else
-- {
-- if ((ada_is_fixed_point_type (VALUE_TYPE (arg1))
-- || ada_is_fixed_point_type (VALUE_TYPE (arg2)))
-- && VALUE_TYPE (arg1) != VALUE_TYPE (arg2))
-- error
-- ("Operands of fixed-point addition must have the same type");
-- return value_cast (VALUE_TYPE (arg1), value_add (arg1, arg2));
-- }
-+ goto nosideret;
-+ if ((ada_is_fixed_point_type (VALUE_TYPE (arg1))
-+ || ada_is_fixed_point_type (VALUE_TYPE (arg2)))
-+ && VALUE_TYPE (arg1) != VALUE_TYPE (arg2))
-+ error
-+ ("Operands of fixed-point addition must have the same type");
-+ return value_cast (VALUE_TYPE (arg1), value_add (arg1, arg2));
-
- case BINOP_SUB:
- arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
- arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
- if (noside == EVAL_SKIP)
-- goto nosideret;
-- if (binop_user_defined_p (op, arg1, arg2))
-- return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL);
-- else
-- {
-- if ((ada_is_fixed_point_type (VALUE_TYPE (arg1))
-- || ada_is_fixed_point_type (VALUE_TYPE (arg2)))
-- && VALUE_TYPE (arg1) != VALUE_TYPE (arg2))
-- error
-- ("Operands of fixed-point subtraction must have the same type");
-- return value_cast (VALUE_TYPE (arg1), value_sub (arg1, arg2));
-- }
-+ goto nosideret;
-+ if ((ada_is_fixed_point_type (VALUE_TYPE (arg1))
-+ || ada_is_fixed_point_type (VALUE_TYPE (arg2)))
-+ && VALUE_TYPE (arg1) != VALUE_TYPE (arg2))
-+ error
-+ ("Operands of fixed-point subtraction must have the same type");
-+ return value_cast (VALUE_TYPE (arg1), value_sub (arg1, arg2));
-
- case BINOP_MUL:
- case BINOP_DIV:
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- if (noside == EVAL_SKIP)
-+ goto nosideret;
-+ else if (noside == EVAL_AVOID_SIDE_EFFECTS
-+ && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
-+ return value_zero (VALUE_TYPE (arg1), not_lval);
-+ else
-+ {
-+ if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
-+ arg1 = cast_from_fixed_to_double (arg1);
-+ if (ada_is_fixed_point_type (VALUE_TYPE (arg2)))
-+ arg2 = cast_from_fixed_to_double (arg2);
-+ return ada_value_binop (arg1, arg2, op);
-+ }
-+
-+ case BINOP_REM:
-+ case BINOP_MOD:
-+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ if (noside == EVAL_SKIP)
- goto nosideret;
-- if (binop_user_defined_p (op, arg1, arg2))
-- return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL);
-- else
-- if (noside == EVAL_AVOID_SIDE_EFFECTS
-- && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
-+ else if (noside == EVAL_AVOID_SIDE_EFFECTS
-+ && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
- return value_zero (VALUE_TYPE (arg1), not_lval);
- else
-- {
-- if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
-- arg1 = cast_from_fixed_to_double (arg1);
-- if (ada_is_fixed_point_type (VALUE_TYPE (arg2)))
-- arg2 = cast_from_fixed_to_double (arg2);
-- return value_binop (arg1, arg2, op);
-- }
-+ return ada_value_binop (arg1, arg2, op);
-
-- case UNOP_NEG:
-+ case BINOP_EQUAL:
-+ case BINOP_NOTEQUAL:
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
-- if (unop_user_defined_p (op, arg1))
-- return value_x_unop (arg1, op, EVAL_NORMAL);
-+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
-+ tem = 0;
-+ else
-+ tem = ada_value_equal (arg1, arg2);
-+ if (op == BINOP_NOTEQUAL)
-+ tem = ! tem;
-+ return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
-+
-+ case UNOP_NEG:
-+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ if (noside == EVAL_SKIP)
-+ goto nosideret;
- else if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
-- return value_cast (VALUE_TYPE (arg1), value_neg (arg1));
-+ return value_cast (VALUE_TYPE (arg1), value_neg (arg1));
- else
-- return value_neg (arg1);
-+ return value_neg (arg1);
-
-- /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */
-- /* case OP_UNRESOLVED_VALUE:
-- /* Only encountered when an unresolved symbol occurs in a
-- context other than a function call, in which case, it is
-- illegal. *//*
-- (*pos) += 3;
-- if (noside == EVAL_SKIP)
-- goto nosideret;
-- else
-- error ("Unexpected unresolved symbol, %s, during evaluation",
-- ada_demangle (exp->elts[pc + 2].name));
-- */
- case OP_VAR_VALUE:
- *pos -= 1;
- if (noside == EVAL_SKIP)
-- {
-- *pos += 4;
-- goto nosideret;
-- }
-+ {
-+ *pos += 4;
-+ goto nosideret;
-+ }
-+ else if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
-+ /* Only encountered when an unresolved symbol occurs in a
-+ context other than a function call, in which case, it is
-+ illegal. */
-+ error ("Unexpected unresolved symbol, %s, during evaluation",
-+ SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol));
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- {
-- *pos += 4;
-- return value_zero
-- (to_static_fixed_type
-- (static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol))),
-- not_lval);
-- }
-- else
-- {
-- arg1 =
-- unwrap_value (evaluate_subexp_standard
-- (expect_type, exp, pos, noside));
-- return ada_to_fixed_value (VALUE_TYPE (arg1), 0,
-- VALUE_ADDRESS (arg1) +
-- VALUE_OFFSET (arg1), arg1);
-- }
-+ {
-+ *pos += 4;
-+ return value_zero
-+ (to_static_fixed_type
-+ (static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol))),
-+ not_lval);
-+ }
-+ else
-+ {
-+ arg1 =
-+ unwrap_value (evaluate_subexp_standard
-+ (expect_type, exp, pos, noside));
-+ return ada_to_fixed_value (arg1);
-+ }
-+
-+ case OP_FUNCALL:
-+ (*pos) += 2;
-+
-+ /* Allocate arg vector, including space for the function to be
-+ called in argvec[0] and a terminating NULL. */
-+ nargs = longest_to_int (exp->elts[pc + 1].longconst);
-+ argvec =
-+ (struct value **) alloca (sizeof (struct value *) * (nargs + 2));
-+
-+ if (exp->elts[*pos].opcode == OP_VAR_VALUE
-+ && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
-+ error ("Unexpected unresolved symbol, %s, during evaluation",
-+ SYMBOL_PRINT_NAME (exp->elts[pc + 5].symbol));
-+ else
-+ {
-+ for (tem = 0; tem <= nargs; tem += 1)
-+ argvec[tem] = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ argvec[tem] = 0;
-+
-+ if (noside == EVAL_SKIP)
-+ goto nosideret;
-+ }
-+
-+ if (ada_is_packed_array_type (desc_base_type (VALUE_TYPE (argvec[0]))))
-+ argvec[0] = ada_coerce_to_simple_array (argvec[0]);
-+ else if (TYPE_CODE (VALUE_TYPE (argvec[0])) == TYPE_CODE_REF
-+ || (TYPE_CODE (VALUE_TYPE (argvec[0])) == TYPE_CODE_ARRAY
-+ && VALUE_LVAL (argvec[0]) == lval_memory))
-+ argvec[0] = value_addr (argvec[0]);
-+
-+ type = check_typedef (VALUE_TYPE (argvec[0]));
-+ if (TYPE_CODE (type) == TYPE_CODE_PTR)
-+ {
-+ switch (TYPE_CODE (check_typedef (TYPE_TARGET_TYPE (type))))
-+ {
-+ case TYPE_CODE_FUNC:
-+ type = check_typedef (TYPE_TARGET_TYPE (type));
-+ break;
-+ case TYPE_CODE_ARRAY:
-+ break;
-+ case TYPE_CODE_STRUCT:
-+ if (noside != EVAL_AVOID_SIDE_EFFECTS)
-+ argvec[0] = ada_value_ind (argvec[0]);
-+ type = check_typedef (TYPE_TARGET_TYPE (type));
-+ break;
-+ default:
-+ error ("cannot subscript or call something of type `%s'",
-+ ada_type_name (VALUE_TYPE (argvec[0])));
-+ break;
-+ }
-+ }
-+
-+ switch (TYPE_CODE (type))
-+ {
-+ case TYPE_CODE_FUNC:
-+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
-+ return allocate_value (TYPE_TARGET_TYPE (type));
-+ return call_function_by_hand (argvec[0], nargs, argvec + 1);
-+ case TYPE_CODE_STRUCT:
-+ {
-+ int arity;
-+
-+ /* Make sure to use the parallel ___XVS type if any.
-+ Otherwise, we won't be able to find the array arity
-+ and element type. */
-+ type = ada_get_base_type (type);
-+
-+ arity = ada_array_arity (type);
-+ type = ada_array_element_type (type, nargs);
-+ if (type == NULL)
-+ error ("cannot subscript or call a record");
-+ if (arity != nargs)
-+ error ("wrong number of subscripts; expecting %d", arity);
-+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
-+ return allocate_value (ada_aligned_type (type));
-+ return
-+ unwrap_value (ada_value_subscript
-+ (argvec[0], nargs, argvec + 1));
-+ }
-+ case TYPE_CODE_ARRAY:
-+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
-+ {
-+ type = ada_array_element_type (type, nargs);
-+ if (type == NULL)
-+ error ("element type of array unknown");
-+ else
-+ return allocate_value (ada_aligned_type (type));
-+ }
-+ return
-+ unwrap_value (ada_value_subscript
-+ (ada_coerce_to_simple_array (argvec[0]),
-+ nargs, argvec + 1));
-+ case TYPE_CODE_PTR: /* Pointer to array */
-+ type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
-+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
-+ {
-+ type = ada_array_element_type (type, nargs);
-+ if (type == NULL)
-+ error ("element type of array unknown");
-+ else
-+ return allocate_value (ada_aligned_type (type));
-+ }
-+ return
-+ unwrap_value (ada_value_ptr_subscript (argvec[0], type,
-+ nargs, argvec + 1));
-+
-+ default:
-+ error ("Internal error in evaluate_subexp");
-+ }
-+
-+ case TERNOP_SLICE:
-+ {
-+ struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ struct value *low_bound_val =
-+ evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ LONGEST low_bound = pos_atr (low_bound_val);
-+ LONGEST high_bound
-+ = pos_atr (evaluate_subexp (NULL_TYPE, exp, pos, noside));
-+ if (noside == EVAL_SKIP)
-+ goto nosideret;
-+
-+ /* If this is a reference type or a pointer type, and
-+ the target type has an XVS parallel type, then get
-+ the real target type. */
-+ if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_REF
-+ || TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_PTR)
-+ TYPE_TARGET_TYPE (VALUE_TYPE (array)) =
-+ ada_get_base_type (TYPE_TARGET_TYPE (VALUE_TYPE (array)));
-+
-+ /* If this is a reference to an aligner type, then remove all
-+ the aligners. */
-+ if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_REF
-+ && ada_is_aligner_type (TYPE_TARGET_TYPE (VALUE_TYPE (array))))
-+ TYPE_TARGET_TYPE (VALUE_TYPE (array)) =
-+ ada_aligned_type (TYPE_TARGET_TYPE (VALUE_TYPE (array)));
-+
-+ if (ada_is_packed_array_type (VALUE_TYPE (array)))
-+ error ("cannot slice a packed array");
-+
-+ /* If this is a reference to an array or an array lvalue,
-+ convert to a pointer. */
-+ if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_REF
-+ || (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_ARRAY
-+ && VALUE_LVAL (array) == lval_memory))
-+ array = value_addr (array);
-+
-+ if (noside == EVAL_AVOID_SIDE_EFFECTS &&
-+ ada_is_array_descriptor_type (check_typedef (VALUE_TYPE (array))))
-+ {
-+ /* Try dereferencing the array, in case it is an access
-+ to array. */
-+ struct type *arrType = ada_type_of_array (array, 0);
-+ if (arrType != NULL)
-+ array = value_at_lazy (arrType, 0, NULL);
-+ }
-+
-+ array = ada_coerce_to_simple_array_ptr (array);
-+
-+ /* When EVAL_AVOID_SIDE_EFFECTS, we may get the bounds wrong,
-+ but only in contexts where the value is not being requested
-+ (FIXME?). */
-+ if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_PTR)
-+ {
-+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
-+ return ada_value_ind (array);
-+ else if (high_bound < low_bound)
-+ return empty_array (TYPE_TARGET_TYPE (VALUE_TYPE (array)),
-+ low_bound);
-+ else
-+ {
-+ struct type *arr_type0 =
-+ to_fixed_array_type (TYPE_TARGET_TYPE (VALUE_TYPE (array)),
-+ NULL, 1);
-+ struct value *item0 =
-+ ada_value_ptr_subscript (array, arr_type0, 1,
-+ &low_bound_val);
-+ struct value *slice =
-+ value_repeat (item0, high_bound - low_bound + 1);
-+ struct type *arr_type1 = VALUE_TYPE (slice);
-+ TYPE_LOW_BOUND (TYPE_INDEX_TYPE (arr_type1)) = low_bound;
-+ TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (arr_type1)) += low_bound;
-+ return slice;
-+ }
-+ }
-+ else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-+ return array;
-+ else if (high_bound < low_bound)
-+ return empty_array (VALUE_TYPE (array), low_bound);
-+ else
-+ return value_slice (array, low_bound, high_bound - low_bound + 1);
-+ }
-+
-+ case UNOP_IN_RANGE:
-+ (*pos) += 2;
-+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ type = exp->elts[pc + 1].type;
-+
-+ if (noside == EVAL_SKIP)
-+ goto nosideret;
-+
-+ switch (TYPE_CODE (type))
-+ {
-+ default:
-+ lim_warning ("Membership test incompletely implemented; "
-+ "always returns true", 0);
-+ return value_from_longest (builtin_type_int, (LONGEST) 1);
-+
-+ case TYPE_CODE_RANGE:
-+ arg2 = value_from_longest (builtin_type_int,
-+ TYPE_LOW_BOUND (type));
-+ arg3 = value_from_longest (builtin_type_int,
-+ TYPE_HIGH_BOUND (type));
-+ return
-+ value_from_longest (builtin_type_int,
-+ (value_less (arg1, arg3)
-+ || value_equal (arg1, arg3))
-+ && (value_less (arg2, arg1)
-+ || value_equal (arg2, arg1)));
-+ }
-
-- case OP_ARRAY:
-- (*pos) += 3;
-- tem2 = longest_to_int (exp->elts[pc + 1].longconst);
-- tem3 = longest_to_int (exp->elts[pc + 2].longconst);
-- nargs = tem3 - tem2 + 1;
-- type = expect_type ? check_typedef (expect_type) : NULL_TYPE;
-+ case BINOP_IN_BOUNDS:
-+ (*pos) += 2;
-+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-
-- argvec =
-- (struct value * *) alloca (sizeof (struct value *) * (nargs + 1));
-- for (tem = 0; tem == 0 || tem < nargs; tem += 1)
-- /* At least one element gets inserted for the type */
-- {
-- /* Ensure that array expressions are coerced into pointer objects. */
-- argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
-- }
- if (noside == EVAL_SKIP)
-- goto nosideret;
-- return value_array (tem2, tem3, argvec);
-+ goto nosideret;
-
-- case OP_FUNCALL:
-- (*pos) += 2;
-+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
-+ return value_zero (builtin_type_int, not_lval);
-
-- /* Allocate arg vector, including space for the function to be
-- called in argvec[0] and a terminating NULL */
-- nargs = longest_to_int (exp->elts[pc + 1].longconst);
-- argvec =
-- (struct value * *) alloca (sizeof (struct value *) * (nargs + 2));
-+ tem = longest_to_int (exp->elts[pc + 1].longconst);
-
-- /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */
-- /* FIXME: name should be defined in expresion.h */
-- /* if (exp->elts[*pos].opcode == OP_UNRESOLVED_VALUE)
-- error ("Unexpected unresolved symbol, %s, during evaluation",
-- ada_demangle (exp->elts[pc + 5].name));
-- */
-- if (0)
-- {
-- error ("unexpected code path, FIXME");
-- }
-- else
-- {
-- for (tem = 0; tem <= nargs; tem += 1)
-- argvec[tem] = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-- argvec[tem] = 0;
-+ if (tem < 1 || tem > ada_array_arity (VALUE_TYPE (arg2)))
-+ error ("invalid dimension number to '%s", "range");
-
-- if (noside == EVAL_SKIP)
-- goto nosideret;
-- }
-+ arg3 = ada_array_bound (arg2, tem, 1);
-+ arg2 = ada_array_bound (arg2, tem, 0);
-
-- if (TYPE_CODE (VALUE_TYPE (argvec[0])) == TYPE_CODE_REF)
-- argvec[0] = value_addr (argvec[0]);
-+ return
-+ value_from_longest (builtin_type_int,
-+ (value_less (arg1, arg3)
-+ || value_equal (arg1, arg3))
-+ && (value_less (arg2, arg1)
-+ || value_equal (arg2, arg1)));
-
-- if (ada_is_packed_array_type (VALUE_TYPE (argvec[0])))
-- argvec[0] = ada_coerce_to_simple_array (argvec[0]);
-+ case TERNOP_IN_RANGE:
-+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ arg3 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-
-- type = check_typedef (VALUE_TYPE (argvec[0]));
-- if (TYPE_CODE (type) == TYPE_CODE_PTR)
-- {
-- switch (TYPE_CODE (check_typedef (TYPE_TARGET_TYPE (type))))
-- {
-- case TYPE_CODE_FUNC:
-- type = check_typedef (TYPE_TARGET_TYPE (type));
-- break;
-- case TYPE_CODE_ARRAY:
-- break;
-- case TYPE_CODE_STRUCT:
-- if (noside != EVAL_AVOID_SIDE_EFFECTS)
-- argvec[0] = ada_value_ind (argvec[0]);
-- type = check_typedef (TYPE_TARGET_TYPE (type));
-- break;
-- default:
-- error ("cannot subscript or call something of type `%s'",
-- ada_type_name (VALUE_TYPE (argvec[0])));
-- break;
-- }
-- }
-+ if (noside == EVAL_SKIP)
-+ goto nosideret;
-
-- switch (TYPE_CODE (type))
-- {
-- case TYPE_CODE_FUNC:
-- if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- return allocate_value (TYPE_TARGET_TYPE (type));
-- return call_function_by_hand (argvec[0], nargs, argvec + 1);
-- case TYPE_CODE_STRUCT:
-+ return
-+ value_from_longest (builtin_type_int,
-+ (value_less (arg1, arg3)
-+ || value_equal (arg1, arg3))
-+ && (value_less (arg2, arg1)
-+ || value_equal (arg2, arg1)));
-+
-+ case OP_ATR_FIRST:
-+ case OP_ATR_LAST:
-+ case OP_ATR_LENGTH:
-+ {
-+ struct type *type_arg;
-+ if (exp->elts[*pos].opcode == OP_TYPE)
- {
-- int arity = ada_array_arity (type);
-- type = ada_array_element_type (type, nargs);
-- if (type == NULL)
-- error ("cannot subscript or call a record");
-- if (arity != nargs)
-- error ("wrong number of subscripts; expecting %d", arity);
-- if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- return allocate_value (ada_aligned_type (type));
-- return
-- unwrap_value (ada_value_subscript
-- (argvec[0], nargs, argvec + 1));
-+ evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
-+ arg1 = NULL;
-+ type_arg = exp->elts[pc + 2].type;
-+ }
-+ else
-+ {
-+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ type_arg = NULL;
- }
-- case TYPE_CODE_ARRAY:
-- if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- {
-- type = ada_array_element_type (type, nargs);
-- if (type == NULL)
-- error ("element type of array unknown");
-- else
-- return allocate_value (ada_aligned_type (type));
-- }
-- return
-- unwrap_value (ada_value_subscript
-- (ada_coerce_to_simple_array (argvec[0]),
-- nargs, argvec + 1));
-- case TYPE_CODE_PTR: /* Pointer to array */
-- type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
-- if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- {
-- type = ada_array_element_type (type, nargs);
-- if (type == NULL)
-- error ("element type of array unknown");
-- else
-- return allocate_value (ada_aligned_type (type));
-- }
-- return
-- unwrap_value (ada_value_ptr_subscript (argvec[0], type,
-- nargs, argvec + 1));
-
-- default:
-- error ("Internal error in evaluate_subexp");
-- }
-+ if (exp->elts[*pos].opcode != OP_LONG)
-+ error ("illegal operand to '%s", ada_attribute_name (op));
-+ tem = longest_to_int (exp->elts[*pos + 2].longconst);
-+ *pos += 4;
-
-- case TERNOP_SLICE:
-- {
-- struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-- int lowbound
-- = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
-- int upper
-- = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
- if (noside == EVAL_SKIP)
- goto nosideret;
-
-- /* If this is a reference to an array, then dereference it */
-- if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_REF
-- && TYPE_TARGET_TYPE (VALUE_TYPE (array)) != NULL
-- && TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (array))) ==
-- TYPE_CODE_ARRAY
-- && !ada_is_array_descriptor (check_typedef (VALUE_TYPE (array))))
-+ if (type_arg == NULL)
- {
-- array = ada_coerce_ref (array);
-- }
-+ arg1 = ada_coerce_ref (arg1);
-
-- if (noside == EVAL_AVOID_SIDE_EFFECTS &&
-- ada_is_array_descriptor (check_typedef (VALUE_TYPE (array))))
-- {
-- /* Try to dereference the array, in case it is an access to array */
-- struct type *arrType = ada_type_of_array (array, 0);
-- if (arrType != NULL)
-- array = value_at_lazy (arrType, 0, NULL);
-- }
-- if (ada_is_array_descriptor (VALUE_TYPE (array)))
-- array = ada_coerce_to_simple_array (array);
-+ if (ada_is_packed_array_type (VALUE_TYPE (arg1)))
-+ arg1 = ada_coerce_to_simple_array (arg1);
-+
-+ if (tem < 1 || tem > ada_array_arity (VALUE_TYPE (arg1)))
-+ error ("invalid dimension number to '%s",
-+ ada_attribute_name (op));
-+
-+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
-+ {
-+ type = ada_index_type (VALUE_TYPE (arg1), tem);
-+ if (type == NULL)
-+ error
-+ ("attempt to take bound of something that is not an array");
-+ return allocate_value (type);
-+ }
-
-- /* If at this point we have a pointer to an array, it means that
-- it is a pointer to a simple (non-ada) array. We just then
-- dereference it */
-- if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_PTR
-- && TYPE_TARGET_TYPE (VALUE_TYPE (array)) != NULL
-- && TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (array))) ==
-- TYPE_CODE_ARRAY)
-+ switch (op)
-+ {
-+ default: /* Should never happen. */
-+ error ("unexpected attribute encountered");
-+ case OP_ATR_FIRST:
-+ return ada_array_bound (arg1, tem, 0);
-+ case OP_ATR_LAST:
-+ return ada_array_bound (arg1, tem, 1);
-+ case OP_ATR_LENGTH:
-+ return ada_array_length (arg1, tem);
-+ }
-+ }
-+ else if (discrete_type_p (type_arg))
- {
-- array = ada_value_ind (array);
-+ struct type *range_type;
-+ char *name = ada_type_name (type_arg);
-+ range_type = NULL;
-+ if (name != NULL && TYPE_CODE (type_arg) != TYPE_CODE_ENUM)
-+ range_type =
-+ to_fixed_range_type (name, NULL, TYPE_OBJFILE (type_arg));
-+ if (range_type == NULL)
-+ range_type = type_arg;
-+ switch (op)
-+ {
-+ default:
-+ error ("unexpected attribute encountered");
-+ case OP_ATR_FIRST:
-+ return discrete_type_low_bound (range_type);
-+ case OP_ATR_LAST:
-+ return discrete_type_high_bound (range_type);
-+ case OP_ATR_LENGTH:
-+ error ("the 'length attribute applies only to array types");
-+ }
- }
--
-- if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- /* The following will get the bounds wrong, but only in contexts
-- where the value is not being requested (FIXME?). */
-- return array;
-+ else if (TYPE_CODE (type_arg) == TYPE_CODE_FLT)
-+ error ("unimplemented type attribute");
- else
-- return value_slice (array, lowbound, upper - lowbound + 1);
-+ {
-+ LONGEST low, high;
-+
-+ if (ada_is_packed_array_type (type_arg))
-+ type_arg = decode_packed_array_type (type_arg);
-+
-+ if (tem < 1 || tem > ada_array_arity (type_arg))
-+ error ("invalid dimension number to '%s",
-+ ada_attribute_name (op));
-+
-+ type = ada_index_type (type_arg, tem);
-+ if (type == NULL)
-+ error ("attempt to take bound of something that is not an array");
-+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
-+ return allocate_value (type);
-+
-+ switch (op)
-+ {
-+ default:
-+ error ("unexpected attribute encountered");
-+ case OP_ATR_FIRST:
-+ low = ada_array_bound_from_type (type_arg, tem, 0, &type);
-+ return value_from_longest (type, low);
-+ case OP_ATR_LAST:
-+ high =
-+ ada_array_bound_from_type (type_arg, tem, 1, &type);
-+ return value_from_longest (type, high);
-+ case OP_ATR_LENGTH:
-+ low = ada_array_bound_from_type (type_arg, tem, 0, &type);
-+ high = ada_array_bound_from_type (type_arg, tem, 1, NULL);
-+ return value_from_longest (type, high - low + 1);
-+ }
-+ }
- }
-
-- /* FIXME: UNOP_MBR should be defined in expression.h */
-- /* case UNOP_MBR:
-- (*pos) += 2;
-- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-- type = exp->elts[pc + 1].type;
--
-- if (noside == EVAL_SKIP)
-- goto nosideret;
--
-- switch (TYPE_CODE (type))
-- {
-- default:
-- warning ("Membership test incompletely implemented; always returns true");
-- return value_from_longest (builtin_type_int, (LONGEST) 1);
--
-- case TYPE_CODE_RANGE:
-- arg2 = value_from_longest (builtin_type_int,
-- (LONGEST) TYPE_LOW_BOUND (type));
-- arg3 = value_from_longest (builtin_type_int,
-- (LONGEST) TYPE_HIGH_BOUND (type));
-- return
-- value_from_longest (builtin_type_int,
-- (value_less (arg1,arg3)
-- || value_equal (arg1,arg3))
-- && (value_less (arg2,arg1)
-- || value_equal (arg2,arg1)));
-- }
-- */
-- /* FIXME: BINOP_MBR should be defined in expression.h */
-- /* case BINOP_MBR:
-- (*pos) += 2;
-- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-- arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
--
-- if (noside == EVAL_SKIP)
-- goto nosideret;
--
-- if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- return value_zero (builtin_type_int, not_lval);
--
-- tem = longest_to_int (exp->elts[pc + 1].longconst);
--
-- if (tem < 1 || tem > ada_array_arity (VALUE_TYPE (arg2)))
-- error ("invalid dimension number to '%s", "range");
--
-- arg3 = ada_array_bound (arg2, tem, 1);
-- arg2 = ada_array_bound (arg2, tem, 0);
--
-- return
-- value_from_longest (builtin_type_int,
-- (value_less (arg1,arg3)
-- || value_equal (arg1,arg3))
-- && (value_less (arg2,arg1)
-- || value_equal (arg2,arg1)));
-- */
-- /* FIXME: TERNOP_MBR should be defined in expression.h */
-- /* case TERNOP_MBR:
-- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-- arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-- arg3 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
--
-- if (noside == EVAL_SKIP)
-- goto nosideret;
--
-- return
-- value_from_longest (builtin_type_int,
-- (value_less (arg1,arg3)
-- || value_equal (arg1,arg3))
-- && (value_less (arg2,arg1)
-- || value_equal (arg2,arg1)));
-- */
-- /* FIXME: OP_ATTRIBUTE should be defined in expression.h */
-- /* case OP_ATTRIBUTE:
-- *pos += 3;
-- atr = (enum ada_attribute) longest_to_int (exp->elts[pc + 2].longconst);
-- switch (atr)
-- {
-- default:
-- error ("unexpected attribute encountered");
--
-- case ATR_FIRST:
-- case ATR_LAST:
-- case ATR_LENGTH:
-- {
-- struct type* type_arg;
-- if (exp->elts[*pos].opcode == OP_TYPE)
-- {
-- evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
-- arg1 = NULL;
-- type_arg = exp->elts[pc + 5].type;
-- }
-- else
-- {
-- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-- type_arg = NULL;
-- }
--
-- if (exp->elts[*pos].opcode != OP_LONG)
-- error ("illegal operand to '%s", ada_attribute_name (atr));
-- tem = longest_to_int (exp->elts[*pos+2].longconst);
-- *pos += 4;
--
-- if (noside == EVAL_SKIP)
-- goto nosideret;
--
-- if (type_arg == NULL)
-- {
-- arg1 = ada_coerce_ref (arg1);
--
-- if (ada_is_packed_array_type (VALUE_TYPE (arg1)))
-- arg1 = ada_coerce_to_simple_array (arg1);
--
-- if (tem < 1 || tem > ada_array_arity (VALUE_TYPE (arg1)))
-- error ("invalid dimension number to '%s",
-- ada_attribute_name (atr));
--
-- if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- {
-- type = ada_index_type (VALUE_TYPE (arg1), tem);
-- if (type == NULL)
-- error ("attempt to take bound of something that is not an array");
-- return allocate_value (type);
-- }
--
-- switch (atr)
-- {
-- default:
-- error ("unexpected attribute encountered");
-- case ATR_FIRST:
-- return ada_array_bound (arg1, tem, 0);
-- case ATR_LAST:
-- return ada_array_bound (arg1, tem, 1);
-- case ATR_LENGTH:
-- return ada_array_length (arg1, tem);
-- }
-- }
-- else if (TYPE_CODE (type_arg) == TYPE_CODE_RANGE
-- || TYPE_CODE (type_arg) == TYPE_CODE_INT)
-- {
-- struct type* range_type;
-- char* name = ada_type_name (type_arg);
-- if (name == NULL)
-- {
-- if (TYPE_CODE (type_arg) == TYPE_CODE_RANGE)
-- range_type = type_arg;
-- else
-- error ("unimplemented type attribute");
-- }
-- else
-- range_type =
-- to_fixed_range_type (name, NULL, TYPE_OBJFILE (type_arg));
-- switch (atr)
-- {
-- default:
-- error ("unexpected attribute encountered");
-- case ATR_FIRST:
-- return value_from_longest (TYPE_TARGET_TYPE (range_type),
-- TYPE_LOW_BOUND (range_type));
-- case ATR_LAST:
-- return value_from_longest (TYPE_TARGET_TYPE (range_type),
-- TYPE_HIGH_BOUND (range_type));
-- }
-- }
-- else if (TYPE_CODE (type_arg) == TYPE_CODE_ENUM)
-- {
-- switch (atr)
-- {
-- default:
-- error ("unexpected attribute encountered");
-- case ATR_FIRST:
-- return value_from_longest
-- (type_arg, TYPE_FIELD_BITPOS (type_arg, 0));
-- case ATR_LAST:
-- return value_from_longest
-- (type_arg,
-- TYPE_FIELD_BITPOS (type_arg,
-- TYPE_NFIELDS (type_arg) - 1));
-- }
-- }
-- else if (TYPE_CODE (type_arg) == TYPE_CODE_FLT)
-- error ("unimplemented type attribute");
-- else
-- {
-- LONGEST low, high;
--
-- if (ada_is_packed_array_type (type_arg))
-- type_arg = decode_packed_array_type (type_arg);
--
-- if (tem < 1 || tem > ada_array_arity (type_arg))
-- error ("invalid dimension number to '%s",
-- ada_attribute_name (atr));
--
-- if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- {
-- type = ada_index_type (type_arg, tem);
-- if (type == NULL)
-- error ("attempt to take bound of something that is not an array");
-- return allocate_value (type);
-- }
--
-- switch (atr)
-- {
-- default:
-- error ("unexpected attribute encountered");
-- case ATR_FIRST:
-- low = ada_array_bound_from_type (type_arg, tem, 0, &type);
-- return value_from_longest (type, low);
-- case ATR_LAST:
-- high = ada_array_bound_from_type (type_arg, tem, 1, &type);
-- return value_from_longest (type, high);
-- case ATR_LENGTH:
-- low = ada_array_bound_from_type (type_arg, tem, 0, &type);
-- high = ada_array_bound_from_type (type_arg, tem, 1, NULL);
-- return value_from_longest (type, high-low+1);
-- }
-- }
-- }
--
-- case ATR_TAG:
-- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-- if (noside == EVAL_SKIP)
-- goto nosideret;
--
-- if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- return
-- value_zero (ada_tag_type (arg1), not_lval);
--
-- return ada_value_tag (arg1);
--
-- case ATR_MIN:
-- case ATR_MAX:
-- evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
-- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-- arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-- if (noside == EVAL_SKIP)
-- goto nosideret;
-- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- return value_zero (VALUE_TYPE (arg1), not_lval);
-- else
-- return value_binop (arg1, arg2,
-- atr == ATR_MIN ? BINOP_MIN : BINOP_MAX);
--
-- case ATR_MODULUS:
-- {
-- struct type* type_arg = exp->elts[pc + 5].type;
-- evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
-- *pos += 4;
--
-- if (noside == EVAL_SKIP)
-- goto nosideret;
--
-- if (! ada_is_modular_type (type_arg))
-- error ("'modulus must be applied to modular type");
--
-- return value_from_longest (TYPE_TARGET_TYPE (type_arg),
-- ada_modulus (type_arg));
-- }
--
--
-- case ATR_POS:
-- evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
-- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-- if (noside == EVAL_SKIP)
-- goto nosideret;
-- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- return value_zero (builtin_type_ada_int, not_lval);
-- else
-- return value_pos_atr (arg1);
--
-- case ATR_SIZE:
-- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-- if (noside == EVAL_SKIP)
-- goto nosideret;
-- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- return value_zero (builtin_type_ada_int, not_lval);
-- else
-- return value_from_longest (builtin_type_ada_int,
-- TARGET_CHAR_BIT
-- * TYPE_LENGTH (VALUE_TYPE (arg1)));
--
-- case ATR_VAL:
-- evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
-- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-- type = exp->elts[pc + 5].type;
-- if (noside == EVAL_SKIP)
-- goto nosideret;
-- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- return value_zero (type, not_lval);
-- else
-- return value_val_atr (type, arg1);
-- } */
-- case BINOP_EXP:
-+ case OP_ATR_TAG:
-+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ if (noside == EVAL_SKIP)
-+ goto nosideret;
-+
-+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
-+ return value_zero (ada_tag_type (arg1), not_lval);
-+
-+ return ada_value_tag (arg1);
-+
-+ case OP_ATR_MIN:
-+ case OP_ATR_MAX:
-+ evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
-- if (binop_user_defined_p (op, arg1, arg2))
-- return unwrap_value (value_x_binop (arg1, arg2, op, OP_NULL,
-- EVAL_NORMAL));
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (VALUE_TYPE (arg1), not_lval);
- else
-- return value_binop (arg1, arg2, op);
-+ return value_binop (arg1, arg2,
-+ op == OP_ATR_MIN ? BINOP_MIN : BINOP_MAX);
-
-- case UNOP_PLUS:
-+ case OP_ATR_MODULUS:
-+ {
-+ struct type *type_arg = exp->elts[pc + 2].type;
-+ evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
-+
-+ if (noside == EVAL_SKIP)
-+ goto nosideret;
-+
-+ if (!ada_is_modular_type (type_arg))
-+ error ("'modulus must be applied to modular type");
-+
-+ return value_from_longest (TYPE_TARGET_TYPE (type_arg),
-+ ada_modulus (type_arg));
-+ }
-+
-+
-+ case OP_ATR_POS:
-+ evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
-- if (unop_user_defined_p (op, arg1))
-- return unwrap_value (value_x_unop (arg1, op, EVAL_NORMAL));
-+ else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-+ return value_zero (builtin_type_ada_int, not_lval);
- else
-- return arg1;
-+ return value_pos_atr (arg1);
-
-- case UNOP_ABS:
-+ case OP_ATR_SIZE:
-+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ if (noside == EVAL_SKIP)
-+ goto nosideret;
-+ else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-+ return value_zero (builtin_type_ada_int, not_lval);
-+ else
-+ return value_from_longest (builtin_type_ada_int,
-+ TARGET_CHAR_BIT
-+ * TYPE_LENGTH (VALUE_TYPE (arg1)));
-+
-+ case OP_ATR_VAL:
-+ evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ type = exp->elts[pc + 2].type;
- if (noside == EVAL_SKIP)
- goto nosideret;
-+ else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-+ return value_zero (type, not_lval);
-+ else
-+ return value_val_atr (type, arg1);
-+
-+ case BINOP_EXP:
-+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ if (noside == EVAL_SKIP)
-+ goto nosideret;
-+ else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-+ return value_zero (VALUE_TYPE (arg1), not_lval);
-+ else
-+ return value_binop (arg1, arg2, op);
-+
-+ case UNOP_PLUS:
-+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ if (noside == EVAL_SKIP)
-+ goto nosideret;
-+ else
-+ return arg1;
-+
-+ case UNOP_ABS:
-+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-+ if (noside == EVAL_SKIP)
-+ goto nosideret;
- if (value_less (arg1, value_zero (VALUE_TYPE (arg1), not_lval)))
-- return value_neg (arg1);
-+ return value_neg (arg1);
- else
-- return arg1;
-+ return arg1;
-
- case UNOP_IND:
- if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
-- expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
-+ expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
- arg1 = evaluate_subexp (expect_type, exp, pos, noside);
- if (noside == EVAL_SKIP)
-- goto nosideret;
-+ goto nosideret;
- type = check_typedef (VALUE_TYPE (arg1));
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- {
-- if (ada_is_array_descriptor (type))
-- /* GDB allows dereferencing GNAT array descriptors. */
-- {
-- struct type *arrType = ada_type_of_array (arg1, 0);
-- if (arrType == NULL)
-- error ("Attempt to dereference null array pointer.");
-- return value_at_lazy (arrType, 0, NULL);
-- }
-- else if (TYPE_CODE (type) == TYPE_CODE_PTR
-- || TYPE_CODE (type) == TYPE_CODE_REF
-- /* In C you can dereference an array to get the 1st elt. */
-- || TYPE_CODE (type) == TYPE_CODE_ARRAY)
-- return
-- value_zero
-- (to_static_fixed_type
-- (ada_aligned_type (check_typedef (TYPE_TARGET_TYPE (type)))),
-- lval_memory);
-- else if (TYPE_CODE (type) == TYPE_CODE_INT)
-- /* GDB allows dereferencing an int. */
-- return value_zero (builtin_type_int, lval_memory);
-- else
-- error ("Attempt to take contents of a non-pointer value.");
-- }
-- arg1 = ada_coerce_ref (arg1);
-+ {
-+ if (ada_is_array_descriptor_type (type))
-+ /* GDB allows dereferencing GNAT array descriptors. */
-+ {
-+ struct type *arrType = ada_type_of_array (arg1, 0);
-+ if (arrType == NULL)
-+ error ("Attempt to dereference null array pointer.");
-+ return value_at_lazy (arrType, 0, NULL);
-+ }
-+ else if (TYPE_CODE (type) == TYPE_CODE_PTR
-+ || TYPE_CODE (type) == TYPE_CODE_REF
-+ /* In C you can dereference an array to get the 1st elt. */
-+ || TYPE_CODE (type) == TYPE_CODE_ARRAY)
-+ return
-+ value_zero
-+ (to_static_fixed_type
-+ (ada_aligned_type (check_typedef (TYPE_TARGET_TYPE (type)))),
-+ lval_memory);
-+ else if (TYPE_CODE (type) == TYPE_CODE_INT)
-+ /* GDB allows dereferencing an int. */
-+ return value_zero (builtin_type_int, lval_memory);
-+ else
-+ error ("Attempt to take contents of a non-pointer value.");
-+ }
-+ arg1 = ada_coerce_ref (arg1); /* FIXME: What is this for?? */
- type = check_typedef (VALUE_TYPE (arg1));
-
-- if (ada_is_array_descriptor (type))
-- /* GDB allows dereferencing GNAT array descriptors. */
-- return ada_coerce_to_simple_array (arg1);
-+ if (ada_is_array_descriptor_type (type))
-+ /* GDB allows dereferencing GNAT array descriptors. */
-+ return ada_coerce_to_simple_array (arg1);
- else
-- return ada_value_ind (arg1);
-+ return ada_value_ind (arg1);
-
- case STRUCTOP_STRUCT:
- tem = longest_to_int (exp->elts[pc + 1].longconst);
- (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
- if (noside == EVAL_SKIP)
-- goto nosideret;
-+ goto nosideret;
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- return value_zero (ada_aligned_type
-- (ada_lookup_struct_elt_type (VALUE_TYPE (arg1),
-- &exp->elts[pc +
-- 2].string,
-- 0, NULL)),
-- lval_memory);
-- else
-- return unwrap_value (ada_value_struct_elt (arg1,
-- &exp->elts[pc + 2].string,
-- "record"));
-+ {
-+ struct type *type1 = VALUE_TYPE (arg1);
-+ if (ada_is_tagged_type (type1, 1))
-+ {
-+ type = ada_lookup_struct_elt_type (type1,
-+ &exp->elts[pc + 2].string,
-+ 1, 1, NULL);
-+ if (type == NULL)
-+ /* In this case, we assume that the field COULD exist
-+ in some extension of the type. Return an object of
-+ "type" void, which will match any formal
-+ (see ada_type_match). */
-+ return value_zero (builtin_type_void, lval_memory);
-+ }
-+ else
-+ type = ada_lookup_struct_elt_type (type1, &exp->elts[pc + 2].string,
-+ 1, 0, NULL);
-+
-+ return value_zero (ada_aligned_type (type), lval_memory);
-+ }
-+ else
-+ return
-+ ada_to_fixed_value (unwrap_value
-+ (ada_value_struct_elt
-+ (arg1, &exp->elts[pc + 2].string, "record")));
- case OP_TYPE:
-- /* The value is not supposed to be used. This is here to make it
-- easier to accommodate expressions that contain types. */
-+ /* The value is not supposed to be used. This is here to make it
-+ easier to accommodate expressions that contain types. */
- (*pos) += 2;
- if (noside == EVAL_SKIP)
-- goto nosideret;
-+ goto nosideret;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- return allocate_value (builtin_type_void);
-+ return allocate_value (builtin_type_void);
- else
-- error ("Attempt to use a type name as an expression");
--
-- case STRUCTOP_PTR:
-- tem = longest_to_int (exp->elts[pc + 1].longconst);
-- (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
-- arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-- if (noside == EVAL_SKIP)
-- goto nosideret;
-- if (noside == EVAL_AVOID_SIDE_EFFECTS)
-- return value_zero (ada_aligned_type
-- (ada_lookup_struct_elt_type (VALUE_TYPE (arg1),
-- &exp->elts[pc +
-- 2].string,
-- 0, NULL)),
-- lval_memory);
-- else
-- return unwrap_value (ada_value_struct_elt (arg1,
-- &exp->elts[pc + 2].string,
-- "record access"));
-+ error ("Attempt to use a type name as an expression");
- }
-
- nosideret:
-@@ -7565,11 +9373,11 @@ nosideret:
- }
- \f
-
-- /* Fixed point */
-+ /* Fixed point */
-
- /* If TYPE encodes an Ada fixed-point type, return the suffix of the
- type name that encodes the 'small and 'delta information.
-- Otherwise, return NULL. */
-+ Otherwise, return NULL. */
-
- static const char *
- fixed_type_info (struct type *type)
-@@ -7581,9 +9389,9 @@ fixed_type_info (struct type *type)
- {
- const char *tail = strstr (name, "___XF_");
- if (tail == NULL)
-- return NULL;
-+ return NULL;
- else
-- return tail + 5;
-+ return tail + 5;
- }
- else if (code == TYPE_CODE_RANGE && TYPE_TARGET_TYPE (type) != type)
- return fixed_type_info (TYPE_TARGET_TYPE (type));
-@@ -7591,7 +9399,7 @@ fixed_type_info (struct type *type)
- return NULL;
- }
-
--/* Returns non-zero iff TYPE represents an Ada fixed-point type. */
-+/* Returns non-zero iff TYPE represents an Ada fixed-point type. */
-
- int
- ada_is_fixed_point_type (struct type *type)
-@@ -7599,9 +9407,18 @@ ada_is_fixed_point_type (struct type *ty
- return fixed_type_info (type) != NULL;
- }
-
-+/* Return non-zero iff TYPE represents a System.Address type. */
-+
-+int
-+ada_is_system_address_type (struct type *type)
-+{
-+ return (TYPE_NAME (type)
-+ && strcmp (TYPE_NAME (type), "system__address") == 0);
-+}
-+
- /* Assuming that TYPE is the representation of an Ada fixed-point
- type, return its delta, or -1 if the type is malformed and the
-- delta cannot be determined. */
-+ delta cannot be determined. */
-
- DOUBLEST
- ada_delta (struct type *type)
-@@ -7616,7 +9433,7 @@ ada_delta (struct type *type)
- }
-
- /* Assuming that ada_is_fixed_point_type (TYPE), return the scaling
-- factor ('SMALL value) associated with the type. */
-+ factor ('SMALL value) associated with the type. */
-
- static DOUBLEST
- scaling_factor (struct type *type)
-@@ -7637,7 +9454,7 @@ scaling_factor (struct type *type)
-
-
- /* Assuming that X is the representation of a value of fixed-point
-- type TYPE, return its floating-point equivalent. */
-+ type TYPE, return its floating-point equivalent. */
-
- DOUBLEST
- ada_fixed_to_float (struct type *type, LONGEST x)
-@@ -7645,8 +9462,8 @@ ada_fixed_to_float (struct type *type, L
- return (DOUBLEST) x *scaling_factor (type);
- }
-
--/* The representation of a fixed-point value of type TYPE
-- corresponding to the value X. */
-+/* The representation of a fixed-point value of type TYPE
-+ corresponding to the value X. */
-
- LONGEST
- ada_float_to_fixed (struct type *type, DOUBLEST x)
-@@ -7655,10 +9472,11 @@ ada_float_to_fixed (struct type *type, D
- }
-
-
-- /* VAX floating formats */
-+ /* VAX floating formats */
-
- /* Non-zero iff TYPE represents one of the special VAX floating-point
-- types. */
-+ types. */
-+
- int
- ada_is_vax_floating_type (struct type *type)
- {
-@@ -7667,21 +9485,23 @@ ada_is_vax_floating_type (struct type *t
- return
- name_len > 6
- && (TYPE_CODE (type) == TYPE_CODE_INT
-- || TYPE_CODE (type) == TYPE_CODE_RANGE)
-- && DEPRECATED_STREQN (ada_type_name (type) + name_len - 6, "___XF", 5);
-+ || TYPE_CODE (type) == TYPE_CODE_RANGE)
-+ && strncmp (ada_type_name (type) + name_len - 6, "___XF", 5) == 0;
- }
-
- /* The type of special VAX floating-point type this is, assuming
-- ada_is_vax_floating_point */
-+ ada_is_vax_floating_point. */
-+
- int
- ada_vax_float_type_suffix (struct type *type)
- {
- return ada_type_name (type)[strlen (ada_type_name (type)) - 1];
- }
-
--/* A value representing the special debugging function that outputs
-+/* A value representing the special debugging function that outputs
- VAX floating-point values of the type represented by TYPE. Assumes
-- ada_is_vax_floating_type (TYPE). */
-+ ada_is_vax_floating_type (TYPE). */
-+
- struct value *
- ada_vax_float_print_function (struct type *type)
- {
-@@ -7699,13 +9519,13 @@ ada_vax_float_print_function (struct typ
- }
- \f
-
-- /* Range types */
-+ /* Range types */
-
- /* Scan STR beginning at position K for a discriminant name, and
- return the value of that discriminant field of DVAL in *PX. If
- PNEW_K is not null, put the position of the character beyond the
- name scanned in *PNEW_K. Return 1 if successful; return 0 and do
-- not alter *PX and *PNEW_K if unsuccessful. */
-+ not alter *PX and *PNEW_K if unsuccessful. */
-
- static int
- scan_discrim_bound (char *str, int k, struct value *dval, LONGEST * px,
-@@ -7747,47 +9567,47 @@ scan_discrim_bound (char *str, int k, st
-
- /* Value of variable named NAME in the current environment. If
- no such variable found, then if ERR_MSG is null, returns 0, and
-- otherwise causes an error with message ERR_MSG. */
-+ otherwise causes an error with message ERR_MSG. */
-+
- static struct value *
- get_var_value (char *name, char *err_msg)
- {
-- struct symbol **syms;
-- struct block **blocks;
-+ struct ada_symbol_info *syms;
- int nsyms;
-
-- nsyms =
-- ada_lookup_symbol_list (name, get_selected_block (NULL), VAR_DOMAIN,
-- &syms, &blocks);
-+ nsyms = ada_lookup_symbol_list (name, get_selected_block (0), VAR_DOMAIN,
-+ &syms);
-
- if (nsyms != 1)
- {
- if (err_msg == NULL)
-- return 0;
-+ return 0;
- else
-- error ("%s", err_msg);
-+ error ("%s", err_msg);
- }
-
-- return value_of_variable (syms[0], blocks[0]);
-+ return value_of_variable (syms[0].sym, syms[0].block);
- }
-
- /* Value of integer variable named NAME in the current environment. If
-- no such variable found, then if ERR_MSG is null, returns 0, and sets
-- *FLAG to 0. If successful, sets *FLAG to 1. */
-+ no such variable found, returns 0, and sets *FLAG to 0. If
-+ successful, sets *FLAG to 1. */
-+
- LONGEST
--get_int_var_value (char *name, char *err_msg, int *flag)
-+get_int_var_value (char *name, int *flag)
- {
-- struct value *var_val = get_var_value (name, err_msg);
-+ struct value *var_val = get_var_value (name, 0);
-
- if (var_val == 0)
- {
- if (flag != NULL)
-- *flag = 0;
-+ *flag = 0;
- return 0;
- }
- else
- {
- if (flag != NULL)
-- *flag = 1;
-+ *flag = 1;
- return value_as_long (var_val);
- }
- }
-@@ -7795,18 +9615,17 @@ get_int_var_value (char *name, char *err
-
- /* Return a range type whose base type is that of the range type named
- NAME in the current environment, and whose bounds are calculated
-- from NAME according to the GNAT range encoding conventions.
-+ from NAME according to the GNAT range encoding conventions.
- Extract discriminant values, if needed, from DVAL. If a new type
- must be created, allocate in OBJFILE's space. The bounds
- information, in general, is encoded in NAME, the base type given in
-- the named range type. */
-+ the named range type. */
-
- static struct type *
- to_fixed_range_type (char *name, struct value *dval, struct objfile *objfile)
- {
- struct type *raw_type = ada_find_any_type (name);
- struct type *base_type;
-- LONGEST low, high;
- char *subtype_info;
-
- if (raw_type == NULL)
-@@ -7838,43 +9657,56 @@ to_fixed_range_type (char *name, struct
- n = 1;
-
- if (*subtype_info == 'L')
-- {
-- if (!ada_scan_number (bounds_str, n, &L, &n)
-- && !scan_discrim_bound (bounds_str, n, dval, &L, &n))
-- return raw_type;
-- if (bounds_str[n] == '_')
-- n += 2;
-- else if (bounds_str[n] == '.') /* FIXME? SGI Workshop kludge. */
-- n += 1;
-- subtype_info += 1;
-- }
-- else
-- {
-- strcpy (name_buf + prefix_len, "___L");
-- L = get_int_var_value (name_buf, "Index bound unknown.", NULL);
-- }
-+ {
-+ if (!ada_scan_number (bounds_str, n, &L, &n)
-+ && !scan_discrim_bound (bounds_str, n, dval, &L, &n))
-+ return raw_type;
-+ if (bounds_str[n] == '_')
-+ n += 2;
-+ else if (bounds_str[n] == '.') /* FIXME? SGI Workshop kludge. */
-+ n += 1;
-+ subtype_info += 1;
-+ }
-+ else
-+ {
-+ int ok;
-+ strcpy (name_buf + prefix_len, "___L");
-+ L = get_int_var_value (name_buf, &ok);
-+ if (!ok)
-+ {
-+ lim_warning ("Unknown lower bound, using 1.", 1);
-+ L = 1;
-+ }
-+ }
-
- if (*subtype_info == 'U')
-- {
-- if (!ada_scan_number (bounds_str, n, &U, &n)
-- && !scan_discrim_bound (bounds_str, n, dval, &U, &n))
-- return raw_type;
-- }
-- else
-- {
-- strcpy (name_buf + prefix_len, "___U");
-- U = get_int_var_value (name_buf, "Index bound unknown.", NULL);
-- }
-+ {
-+ if (!ada_scan_number (bounds_str, n, &U, &n)
-+ && !scan_discrim_bound (bounds_str, n, dval, &U, &n))
-+ return raw_type;
-+ }
-+ else
-+ {
-+ int ok;
-+ strcpy (name_buf + prefix_len, "___U");
-+ U = get_int_var_value (name_buf, &ok);
-+ if (!ok)
-+ {
-+ lim_warning ("Unknown upper bound, using %ld.", (long) L);
-+ U = L;
-+ }
-+ }
-
- if (objfile == NULL)
-- objfile = TYPE_OBJFILE (base_type);
-+ objfile = TYPE_OBJFILE (base_type);
- type = create_range_type (alloc_type (objfile), base_type, L, U);
- TYPE_NAME (type) = name;
- return type;
- }
- }
-
--/* True iff NAME is the name of a range type. */
-+/* True iff NAME is the name of a range type. */
-+
- int
- ada_is_range_type_name (const char *name)
- {
-@@ -7882,31 +9714,246 @@ ada_is_range_type_name (const char *name
- }
- \f
-
-- /* Modular types */
-+ /* Modular types */
-+
-+/* True iff TYPE is an Ada modular type. */
-
--/* True iff TYPE is an Ada modular type. */
- int
- ada_is_modular_type (struct type *type)
- {
-- /* FIXME: base_type should be declared in gdbtypes.h, implemented in
-- valarith.c */
-- struct type *subranged_type; /* = base_type (type); */
-+ struct type *subranged_type = base_type (type);
-
- return (subranged_type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE
-- && TYPE_CODE (subranged_type) != TYPE_CODE_ENUM
-- && TYPE_UNSIGNED (subranged_type));
-+ && TYPE_CODE (subranged_type) != TYPE_CODE_ENUM
-+ && TYPE_UNSIGNED (subranged_type));
- }
-
--/* Assuming ada_is_modular_type (TYPE), the modulus of TYPE. */
-+/* Assuming ada_is_modular_type (TYPE), the modulus of TYPE. */
-+
- LONGEST
- ada_modulus (struct type * type)
- {
- return TYPE_HIGH_BOUND (type) + 1;
- }
- \f
-+ /* Operators */
-+/* Information about operators given special treatment in functions
-+ below. */
-+/* Format: OP_DEFN (<operator>, <operator length>, <# args>, <binop>). */
-+
-+#define ADA_OPERATORS \
-+ OP_DEFN (OP_VAR_VALUE, 4, 0, 0) \
-+ OP_DEFN (BINOP_IN_BOUNDS, 3, 2, 0) \
-+ OP_DEFN (TERNOP_IN_RANGE, 1, 3, 0) \
-+ OP_DEFN (OP_ATR_FIRST, 1, 2, 0) \
-+ OP_DEFN (OP_ATR_LAST, 1, 2, 0) \
-+ OP_DEFN (OP_ATR_LENGTH, 1, 2, 0) \
-+ OP_DEFN (OP_ATR_IMAGE, 1, 2, 0) \
-+ OP_DEFN (OP_ATR_MAX, 1, 3, 0) \
-+ OP_DEFN (OP_ATR_MIN, 1, 3, 0) \
-+ OP_DEFN (OP_ATR_MODULUS, 1, 1, 0) \
-+ OP_DEFN (OP_ATR_POS, 1, 2, 0) \
-+ OP_DEFN (OP_ATR_SIZE, 1, 1, 0) \
-+ OP_DEFN (OP_ATR_TAG, 1, 1, 0) \
-+ OP_DEFN (OP_ATR_VAL, 1, 2, 0) \
-+ OP_DEFN (UNOP_QUAL, 3, 1, 0) \
-+ OP_DEFN (UNOP_IN_RANGE, 3, 1, 0)
-+
-+static void
-+ada_operator_length (struct expression *exp, int pc, int *oplenp, int *argsp)
-+{
-+ switch (exp->elts[pc - 1].opcode)
-+ {
-+ default:
-+ operator_length_standard (exp, pc, oplenp, argsp);
-+ break;
-+
-+#define OP_DEFN(op, len, args, binop) \
-+ case op: *oplenp = len; *argsp = args; break;
-+ ADA_OPERATORS;
-+#undef OP_DEFN
-+ }
-+}
-+
-+static char *
-+ada_op_name (enum exp_opcode opcode)
-+{
-+ switch (opcode)
-+ {
-+ default:
-+ return op_name_standard (opcode);
-+#define OP_DEFN(op, len, args, binop) case op: return #op;
-+ ADA_OPERATORS;
-+#undef OP_DEFN
-+ }
-+}
-+
-+/* As for operator_length, but assumes PC is pointing at the first
-+ element of the operator, and gives meaningful results only for the
-+ Ada-specific operators. */
-+
-+static void
-+ada_forward_operator_length (struct expression *exp, int pc,
-+ int *oplenp, int *argsp)
-+{
-+ switch (exp->elts[pc].opcode)
-+ {
-+ default:
-+ *oplenp = *argsp = 0;
-+ break;
-+#define OP_DEFN(op, len, args, binop) \
-+ case op: *oplenp = len; *argsp = args; break;
-+ ADA_OPERATORS;
-+#undef OP_DEFN
-+ }
-+}
-+
-+static int
-+ada_dump_subexp_body (struct expression *exp, struct ui_file *stream, int elt)
-+{
-+ enum exp_opcode op = exp->elts[elt].opcode;
-+ int oplen, nargs;
-+ int pc = elt;
-+ int i;
-+
-+ ada_forward_operator_length (exp, elt, &oplen, &nargs);
-+
-+ switch (op)
-+ {
-+ /* Ada attributes ('Foo). */
-+ case OP_ATR_FIRST:
-+ case OP_ATR_LAST:
-+ case OP_ATR_LENGTH:
-+ case OP_ATR_IMAGE:
-+ case OP_ATR_MAX:
-+ case OP_ATR_MIN:
-+ case OP_ATR_MODULUS:
-+ case OP_ATR_POS:
-+ case OP_ATR_SIZE:
-+ case OP_ATR_TAG:
-+ case OP_ATR_VAL:
-+ break;
-+
-+ case UNOP_IN_RANGE:
-+ case UNOP_QUAL:
-+ fprintf_filtered (stream, "Type @");
-+ gdb_print_host_address (exp->elts[pc + 1].type, stream);
-+ fprintf_filtered (stream, " (");
-+ type_print (exp->elts[pc + 1].type, NULL, stream, 0);
-+ fprintf_filtered (stream, ")");
-+ break;
-+ case BINOP_IN_BOUNDS:
-+ fprintf_filtered (stream, " (%d)", (int) exp->elts[pc + 2].longconst);
-+ break;
-+ case TERNOP_IN_RANGE:
-+ break;
-+
-+ default:
-+ return dump_subexp_body_standard (exp, stream, elt);
-+ }
-+
-+ elt += oplen;
-+ for (i = 0; i < nargs; i += 1)
-+ elt = dump_subexp (exp, stream, elt);
-+
-+ return elt;
-+}
-
-+/* The Ada extension of print_subexp (q.v.). */
-+
-+static void
-+ada_print_subexp (struct expression *exp, int *pos,
-+ struct ui_file *stream, enum precedence prec)
-+{
-+ int oplen, nargs;
-+ int pc = *pos;
-+ enum exp_opcode op = exp->elts[pc].opcode;
-+
-+ ada_forward_operator_length (exp, pc, &oplen, &nargs);
-+
-+ switch (op)
-+ {
-+ default:
-+ print_subexp_standard (exp, pos, stream, prec);
-+ return;
-+
-+ case OP_VAR_VALUE:
-+ *pos += oplen;
-+ fputs_filtered (SYMBOL_NATURAL_NAME (exp->elts[pc + 2].symbol), stream);
-+ return;
-+
-+ case BINOP_IN_BOUNDS:
-+ *pos += oplen;
-+ print_subexp (exp, pos, stream, PREC_SUFFIX);
-+ fputs_filtered (" in ", stream);
-+ print_subexp (exp, pos, stream, PREC_SUFFIX);
-+ fputs_filtered ("'range", stream);
-+ if (exp->elts[pc + 1].longconst > 1)
-+ fprintf_filtered (stream, "(%ld)", (long) exp->elts[pc + 1].longconst);
-+ return;
-+
-+ case TERNOP_IN_RANGE:
-+ *pos += oplen;
-+ if (prec >= PREC_EQUAL)
-+ fputs_filtered ("(", stream);
-+ print_subexp (exp, pos, stream, PREC_SUFFIX);
-+ fputs_filtered (" in ", stream);
-+ print_subexp (exp, pos, stream, PREC_EQUAL);
-+ fputs_filtered (" .. ", stream);
-+ print_subexp (exp, pos, stream, PREC_EQUAL);
-+ if (prec >= PREC_EQUAL)
-+ fputs_filtered (")", stream);
-+ return;
-+
-+ case OP_ATR_FIRST:
-+ case OP_ATR_LAST:
-+ case OP_ATR_LENGTH:
-+ case OP_ATR_IMAGE:
-+ case OP_ATR_MAX:
-+ case OP_ATR_MIN:
-+ case OP_ATR_MODULUS:
-+ case OP_ATR_POS:
-+ case OP_ATR_SIZE:
-+ case OP_ATR_TAG:
-+ case OP_ATR_VAL:
-+ *pos += oplen;
-+ if (exp->elts[*pos].opcode == OP_TYPE)
-+ {
-+ if (TYPE_CODE (exp->elts[*pos + 1].type) != TYPE_CODE_VOID)
-+ LA_PRINT_TYPE (exp->elts[*pos + 1].type, "", stream, 0, 0);
-+ *pos += 3;
-+ }
-+ else
-+ print_subexp (exp, pos, stream, PREC_SUFFIX);
-+ fprintf_filtered (stream, "'%s", ada_attribute_name (op));
-+ if (nargs > 1)
-+ {
-+ int tem;
-+ for (tem = 1; tem < nargs; tem += 1)
-+ {
-+ fputs_filtered ( (tem == 1) ? " (" : ", ", stream);
-+ print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
-+ }
-+ fputs_filtered (")", stream);
-+ }
-+ return;
-
-- /* Operators */
-+ case UNOP_QUAL:
-+ *pos += oplen;
-+ type_print (exp->elts[pc + 1].type, "", stream, 0);
-+ fputs_filtered ("'(", stream);
-+ print_subexp (exp, pos, stream, PREC_PREFIX);
-+ fputs_filtered (")", stream);
-+ return;
-+
-+ case UNOP_IN_RANGE:
-+ *pos += oplen;
-+ print_subexp (exp, pos, stream, PREC_SUFFIX);
-+ fputs_filtered (" in ", stream);
-+ LA_PRINT_TYPE (exp->elts[pc + 1].type, "", stream, 1, 0);
-+ return;
-+ }
-+}
-
- /* Table mapping opcodes into strings for printing operators
- and precedences of the operators. */
-@@ -7940,12 +9987,13 @@ static const struct op_print ada_op_prin
- {"not ", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
- {"not ", UNOP_COMPLEMENT, PREC_PREFIX, 0},
- {"abs ", UNOP_ABS, PREC_PREFIX, 0},
-- {".all", UNOP_IND, PREC_SUFFIX, 1}, /* FIXME: postfix .ALL */
-- {"'access", UNOP_ADDR, PREC_SUFFIX, 1}, /* FIXME: postfix 'ACCESS */
-+ {".all", UNOP_IND, PREC_SUFFIX, 1},
-+ {"'access", UNOP_ADDR, PREC_SUFFIX, 1},
-+ {"'size", OP_ATR_SIZE, PREC_SUFFIX, 1},
- {NULL, 0, 0, 0}
- };
- \f
-- /* Assorted Types and Interfaces */
-+ /* Assorted Types and Interfaces */
-
- struct type *builtin_type_ada_int;
- struct type *builtin_type_ada_short;
-@@ -7961,54 +10009,76 @@ struct type *builtin_type_ada_system_add
-
- struct type **const (ada_builtin_types[]) =
- {
--
- &builtin_type_ada_int,
-- &builtin_type_ada_long,
-- &builtin_type_ada_short,
-- &builtin_type_ada_char,
-- &builtin_type_ada_float,
-- &builtin_type_ada_double,
-- &builtin_type_ada_long_long,
-- &builtin_type_ada_long_double,
-- &builtin_type_ada_natural, &builtin_type_ada_positive,
-- /* The following types are carried over from C for convenience. */
--&builtin_type_int,
-- &builtin_type_long,
-- &builtin_type_short,
-- &builtin_type_char,
-- &builtin_type_float,
-- &builtin_type_double,
-- &builtin_type_long_long,
-- &builtin_type_void,
-- &builtin_type_signed_char,
-- &builtin_type_unsigned_char,
-- &builtin_type_unsigned_short,
-- &builtin_type_unsigned_int,
-- &builtin_type_unsigned_long,
-- &builtin_type_unsigned_long_long,
-- &builtin_type_long_double,
-- &builtin_type_complex, &builtin_type_double_complex, 0};
-+ &builtin_type_ada_long,
-+ &builtin_type_ada_short,
-+ &builtin_type_ada_char,
-+ &builtin_type_ada_float,
-+ &builtin_type_ada_double,
-+ &builtin_type_ada_long_long,
-+ &builtin_type_ada_long_double,
-+ &builtin_type_ada_natural, &builtin_type_ada_positive,
-+ /* The following types are carried over from C for convenience. */
-+ &builtin_type_int,
-+ &builtin_type_long,
-+ &builtin_type_short,
-+ &builtin_type_char,
-+ &builtin_type_float,
-+ &builtin_type_double,
-+ &builtin_type_long_long,
-+ &builtin_type_void,
-+ &builtin_type_signed_char,
-+ &builtin_type_unsigned_char,
-+ &builtin_type_unsigned_short,
-+ &builtin_type_unsigned_int,
-+ &builtin_type_unsigned_long,
-+ &builtin_type_unsigned_long_long,
-+ &builtin_type_long_double,
-+ &builtin_type_complex,
-+ &builtin_type_double_complex,
-+ 0
-+};
-+
-+/* Not really used, but needed in the ada_language_defn. */
-
--/* Not really used, but needed in the ada_language_defn. */
- static void
- emit_char (int c, struct ui_file *stream, int quoter)
- {
- ada_emit_char (c, stream, quoter, 1);
- }
-
-+static int
-+parse ()
-+{
-+ warnings_issued = 0;
-+ return ada_parse ();
-+}
-+
-+static const struct exp_descriptor ada_exp_descriptor =
-+{
-+ ada_print_subexp,
-+ ada_operator_length,
-+ ada_op_name,
-+ ada_dump_subexp_body,
-+ ada_evaluate_subexp
-+};
-+
- const struct language_defn ada_language_defn = {
-- "ada", /* Language name */
-- /* language_ada, */
-- language_unknown,
-- /* FIXME: language_ada should be defined in defs.h */
-+ "ada", /* Language name */
-+ language_ada,
- ada_builtin_types,
- range_check_off,
- type_check_off,
-- case_sensitive_on, /* Yes, Ada is case-insensitive, but
-- * that's not quite what this means. */
-- ada_parse,
-+ case_sensitive_on, /* Yes, Ada is case-insensitive, but
-+ that's not quite what this means. */
-+#ifdef GNAT_GDB
-+ ada_lookup_symbol,
-+ ada_lookup_minimal_symbol,
-+#endif
-+ &ada_exp_descriptor,
-+ parse,
- ada_error,
-- ada_evaluate_subexp,
-+ resolve,
- ada_printchar, /* Print a character constant */
- ada_printstr, /* Function to print string constant */
- emit_char, /* Function to print single char (not used) */
-@@ -8017,84 +10087,97 @@ const struct language_defn ada_language_
- ada_val_print, /* Print a value using appropriate syntax */
- ada_value_print, /* Print a top-level value */
- NULL, /* Language specific skip_trampoline */
-- value_of_this, /* value_of_this */
-- basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
-+ NULL, /* value_of_this */
-+ ada_lookup_symbol_nonlocal, /* Looking up non-local symbols. */
- basic_lookup_transparent_type,/* lookup_transparent_type */
-- NULL, /* Language specific symbol demangler */
-+ ada_la_decode, /* Language specific symbol demangler */
- {"", "", "", ""}, /* Binary format info */
- #if 0
-- {"8#%lo#", "8#", "o", "#"}, /* Octal format info */
-- {"%ld", "", "d", ""}, /* Decimal format info */
-- {"16#%lx#", "16#", "x", "#"}, /* Hex format info */
-+ {"8#%lo#", "8#", "o", "#"}, /* Octal format info */
-+ {"%ld", "", "d", ""}, /* Decimal format info */
-+ {"16#%lx#", "16#", "x", "#"}, /* Hex format info */
- #else
-- /* Copied from c-lang.c. */
-- {"0%lo", "0", "o", ""}, /* Octal format info */
-- {"%ld", "", "d", ""}, /* Decimal format info */
-- {"0x%lx", "0x", "x", ""}, /* Hex format info */
-+ /* Copied from c-lang.c. */
-+ {"0%lo", "0", "o", ""}, /* Octal format info */
-+ {"%ld", "", "d", ""}, /* Decimal format info */
-+ {"0x%lx", "0x", "x", ""}, /* Hex format info */
- #endif
-- ada_op_print_tab, /* expression operators for printing */
-- 1, /* c-style arrays (FIXME?) */
-- 0, /* String lower bound (FIXME?) */
-+ ada_op_print_tab, /* expression operators for printing */
-+ 0, /* c-style arrays */
-+ 1, /* String lower bound */
- &builtin_type_ada_char,
-- default_word_break_characters,
-+ ada_get_gdb_completer_word_break_characters,
-+#ifdef GNAT_GDB
-+ ada_translate_error_message, /* Substitute Ada-specific terminology
-+ in errors and warnings. */
-+#endif
- LANG_MAGIC
- };
-
--void
--_initialize_ada_language (void)
--{
-+static void
-+build_ada_types (void) {
- builtin_type_ada_int =
- init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
-- 0, "integer", (struct objfile *) NULL);
-+ 0, "integer", (struct objfile *) NULL);
- builtin_type_ada_long =
- init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
-- 0, "long_integer", (struct objfile *) NULL);
-+ 0, "long_integer", (struct objfile *) NULL);
- builtin_type_ada_short =
- init_type (TYPE_CODE_INT, TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-- 0, "short_integer", (struct objfile *) NULL);
-+ 0, "short_integer", (struct objfile *) NULL);
- builtin_type_ada_char =
- init_type (TYPE_CODE_INT, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-- 0, "character", (struct objfile *) NULL);
-+ 0, "character", (struct objfile *) NULL);
- builtin_type_ada_float =
- init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
-- 0, "float", (struct objfile *) NULL);
-+ 0, "float", (struct objfile *) NULL);
- builtin_type_ada_double =
- init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
-- 0, "long_float", (struct objfile *) NULL);
-+ 0, "long_float", (struct objfile *) NULL);
- builtin_type_ada_long_long =
- init_type (TYPE_CODE_INT, TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
-- 0, "long_long_integer", (struct objfile *) NULL);
-+ 0, "long_long_integer", (struct objfile *) NULL);
- builtin_type_ada_long_double =
- init_type (TYPE_CODE_FLT, TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
-- 0, "long_long_float", (struct objfile *) NULL);
-+ 0, "long_long_float", (struct objfile *) NULL);
- builtin_type_ada_natural =
- init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
-- 0, "natural", (struct objfile *) NULL);
-+ 0, "natural", (struct objfile *) NULL);
- builtin_type_ada_positive =
- init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
-- 0, "positive", (struct objfile *) NULL);
-+ 0, "positive", (struct objfile *) NULL);
-
-
- builtin_type_ada_system_address =
- lookup_pointer_type (init_type (TYPE_CODE_VOID, 1, 0, "void",
-- (struct objfile *) NULL));
-+ (struct objfile *) NULL));
- TYPE_NAME (builtin_type_ada_system_address) = "system__address";
-+}
-+
-+void
-+_initialize_ada_language (void)
-+{
-
-+ build_ada_types ();
-+ deprecated_register_gdbarch_swap (NULL, 0, build_ada_types);
- add_language (&ada_language_defn);
-
-+#ifdef GNAT_GDB
- add_show_from_set
- (add_set_cmd ("varsize-limit", class_support, var_uinteger,
-- (char *) &varsize_limit,
-- "Set maximum bytes in dynamic-sized object.",
-- &setlist), &showlist);
-+ (char *) &varsize_limit,
-+ "Set maximum bytes in dynamic-sized object.",
-+ &setlist), &showlist);
-+#endif
- varsize_limit = 65536;
-
-- add_com ("begin", class_breakpoint, begin_command,
-- "Start the debugged program, stopping at the beginning of the\n\
--main program. You may specify command-line arguments to give it, as for\n\
--the \"run\" command (q.v.).");
--}
-+ obstack_init (&symbol_list_obstack);
-+ obstack_init (&cache_space);
-
-+ decoded_names_store = htab_create_alloc_ex
-+ (256, htab_hash_string, (int (*) (const void *, const void *)) streq,
-+ NULL, NULL, xmcalloc, xmfree);
-+}
-
- /* Create a fundamental Ada type using default reasonable for the current
- target machine.
-@@ -8130,104 +10213,104 @@ ada_create_fundamental_type (struct objf
- /* FIXME: For now, if we are asked to produce a type not in this
- language, create the equivalent of a C integer type with the
- name "<?type?>". When all the dust settles from the type
-- reconstruction work, this should probably become an error. */
-+ reconstruction work, this should probably become an error. */
- type = init_type (TYPE_CODE_INT,
-- TARGET_INT_BIT / TARGET_CHAR_BIT,
-- 0, "<?type?>", objfile);
-+ TARGET_INT_BIT / TARGET_CHAR_BIT,
-+ 0, "<?type?>", objfile);
- warning ("internal error: no Ada fundamental type %d", typeid);
- break;
- case FT_VOID:
- type = init_type (TYPE_CODE_VOID,
-- TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-- 0, "void", objfile);
-+ TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-+ 0, "void", objfile);
- break;
- case FT_CHAR:
- type = init_type (TYPE_CODE_INT,
-- TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-- 0, "character", objfile);
-+ TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-+ 0, "character", objfile);
- break;
- case FT_SIGNED_CHAR:
- type = init_type (TYPE_CODE_INT,
-- TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-- 0, "signed char", objfile);
-+ TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-+ 0, "signed char", objfile);
- break;
- case FT_UNSIGNED_CHAR:
- type = init_type (TYPE_CODE_INT,
-- TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-- TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
-+ TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-+ TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
- break;
- case FT_SHORT:
- type = init_type (TYPE_CODE_INT,
-- TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-- 0, "short_integer", objfile);
-+ TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-+ 0, "short_integer", objfile);
- break;
- case FT_SIGNED_SHORT:
- type = init_type (TYPE_CODE_INT,
-- TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-- 0, "short_integer", objfile);
-+ TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-+ 0, "short_integer", objfile);
- break;
- case FT_UNSIGNED_SHORT:
- type = init_type (TYPE_CODE_INT,
-- TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-- TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
-+ TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-+ TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
- break;
- case FT_INTEGER:
- type = init_type (TYPE_CODE_INT,
-- TARGET_INT_BIT / TARGET_CHAR_BIT,
-- 0, "integer", objfile);
-+ TARGET_INT_BIT / TARGET_CHAR_BIT,
-+ 0, "integer", objfile);
- break;
- case FT_SIGNED_INTEGER:
-- type = init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT, 0, "integer", objfile); /* FIXME -fnf */
-+ type = init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT, 0, "integer", objfile); /* FIXME -fnf */
- break;
- case FT_UNSIGNED_INTEGER:
- type = init_type (TYPE_CODE_INT,
-- TARGET_INT_BIT / TARGET_CHAR_BIT,
-- TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
-+ TARGET_INT_BIT / TARGET_CHAR_BIT,
-+ TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
- break;
- case FT_LONG:
- type = init_type (TYPE_CODE_INT,
-- TARGET_LONG_BIT / TARGET_CHAR_BIT,
-- 0, "long_integer", objfile);
-+ TARGET_LONG_BIT / TARGET_CHAR_BIT,
-+ 0, "long_integer", objfile);
- break;
- case FT_SIGNED_LONG:
- type = init_type (TYPE_CODE_INT,
-- TARGET_LONG_BIT / TARGET_CHAR_BIT,
-- 0, "long_integer", objfile);
-+ TARGET_LONG_BIT / TARGET_CHAR_BIT,
-+ 0, "long_integer", objfile);
- break;
- case FT_UNSIGNED_LONG:
- type = init_type (TYPE_CODE_INT,
-- TARGET_LONG_BIT / TARGET_CHAR_BIT,
-- TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
-+ TARGET_LONG_BIT / TARGET_CHAR_BIT,
-+ TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
- break;
- case FT_LONG_LONG:
- type = init_type (TYPE_CODE_INT,
-- TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
-- 0, "long_long_integer", objfile);
-+ TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
-+ 0, "long_long_integer", objfile);
- break;
- case FT_SIGNED_LONG_LONG:
- type = init_type (TYPE_CODE_INT,
-- TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
-- 0, "long_long_integer", objfile);
-+ TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
-+ 0, "long_long_integer", objfile);
- break;
- case FT_UNSIGNED_LONG_LONG:
- type = init_type (TYPE_CODE_INT,
-- TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
-- TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
-+ TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
-+ TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
- break;
- case FT_FLOAT:
- type = init_type (TYPE_CODE_FLT,
-- TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
-- 0, "float", objfile);
-+ TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
-+ 0, "float", objfile);
- break;
- case FT_DBL_PREC_FLOAT:
- type = init_type (TYPE_CODE_FLT,
-- TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
-- 0, "long_float", objfile);
-+ TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
-+ 0, "long_float", objfile);
- break;
- case FT_EXT_PREC_FLOAT:
- type = init_type (TYPE_CODE_FLT,
-- TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
-- 0, "long_long_float", objfile);
-+ TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
-+ 0, "long_long_float", objfile);
- break;
- }
- return (type);
-@@ -8239,16 +10322,16 @@ ada_dump_symtab (struct symtab *s)
- int i;
- fprintf (stderr, "New symtab: [\n");
- fprintf (stderr, " Name: %s/%s;\n",
-- s->dirname ? s->dirname : "?", s->filename ? s->filename : "?");
-+ s->dirname ? s->dirname : "?", s->filename ? s->filename : "?");
- fprintf (stderr, " Format: %s;\n", s->debugformat);
- if (s->linetable != NULL)
- {
- fprintf (stderr, " Line table (section %d):\n", s->block_line_section);
- for (i = 0; i < s->linetable->nitems; i += 1)
-- {
-- struct linetable_entry *e = s->linetable->item + i;
-- fprintf (stderr, " %4ld: %8lx\n", (long) e->line, (long) e->pc);
-- }
-+ {
-+ struct linetable_entry *e = s->linetable->item + i;
-+ fprintf (stderr, " %4ld: %8lx\n", (long) e->line, (long) e->pc);
-+ }
- }
- fprintf (stderr, "]\n");
- }
-Index: gdb/ada-lang.h
-===================================================================
-RCS file: /cvs/src/src/gdb/ada-lang.h,v
-retrieving revision 1.6
-diff -u -p -r1.6 ada-lang.h
---- gdb/ada-lang.h 24 May 2003 03:21:42 -0000 1.6
-+++ gdb/ada-lang.h 2 Jun 2004 09:52:56 -0000
-@@ -1,5 +1,6 @@
- /* Ada language support definitions for GDB, the GNU debugger.
-- Copyright 1992, 1997 Free Software Foundation, Inc.
-+ Copyright 1992, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
-+ Free Software Foundation, Inc.
-
- This file is part of GDB.
-
-@@ -24,130 +25,103 @@ struct partial_symbol;
-
- #include "value.h"
- #include "gdbtypes.h"
-+#include "breakpoint.h"
-
--struct block;
-+/* Names of specific files known to be part of the runtime
-+ system and that might consider (confusing) debugging information.
-+ Each name (a basic regular expression string) is followed by a
-+ comma. FIXME: Should be part of a configuration file. */
-+#if defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET)
-+#define ADA_KNOWN_RUNTIME_FILE_NAME_PATTERNS \
-+ "^[agis]-.*\\.ad[bs]$", \
-+ "/usr/shlib/libpthread\\.so",
-+#elif defined (__linux__)
-+#define ADA_KNOWN_RUNTIME_FILE_NAME_PATTERNS \
-+ "^[agis]-.*\\.ad[bs]$", \
-+ "/lib.*/libpthread\\.so[.0-9]*$", "/lib.*/libpthread\\.a$", \
-+ "/lib.*/libc\\.so[.0-9]*$", "/lib.*/libc\\.a$",
-+#endif
-+
-+#if !defined (ADA_KNOWN_RUNTIME_FILE_NAME_PATTERNS)
-+#define ADA_KNOWN_RUNTIME_FILE_NAME_PATTERNS \
-+ "^[agis]-.*\\.ad[bs]$",
-+#endif
-
--/* A macro to reorder the bytes of an address depending on the
-- endiannes of the target. */
--#define EXTRACT_ADDRESS(x) ((void *) extract_unsigned_integer (&(x), sizeof (x)))
--/* A macro to reorder the bytes of an int depending on the endiannes
-- of the target */
--#define EXTRACT_INT(x) ((int) extract_signed_integer (&(x), sizeof (x)))
--
--/* Chain of cleanups for arguments of OP_UNRESOLVED_VALUE names. Created in
-- yyparse and freed in ada_resolve. */
--extern struct cleanup *unresolved_names;
-+/* Names of compiler-generated auxiliary functions probably of no
-+ interest to users. Each name (a basic regular expression string)
-+ is followed by a comma. */
-+#define ADA_KNOWN_AUXILIARY_FUNCTION_NAME_PATTERNS \
-+ "___clean[.a-zA-Z0-9_]*$",
-+
-+/* The maximum number of frame levels searched for non-local,
-+ * non-global symbols. This limit exists as a precaution to prevent
-+ * infinite search loops when the stack is screwed up. */
-+#define MAX_ENCLOSING_FRAME_LEVELS 7
-+
-+/* Maximum number of steps followed in looking for the ultimate
-+ referent of a renaming. This prevents certain infinite loops that
-+ can otherwise result. */
-+#define MAX_RENAMING_CHAIN_LENGTH 10
-
--/* Corresponding mangled/demangled names and opcodes for Ada user-definable
-+struct block;
-+
-+/* Corresponding encoded/decoded names and opcodes for Ada user-definable
- operators. */
- struct ada_opname_map
- {
-- const char *mangled;
-- const char *demangled;
-+ const char *encoded;
-+ const char *decoded;
- enum exp_opcode op;
- };
-
--/* Table of Ada operators in mangled and demangled forms. */
-+/* Table of Ada operators in encoded and decoded forms. */
- /* Defined in ada-lang.c */
- extern const struct ada_opname_map ada_opname_table[];
-
--/* The maximum number of tasks known to the Ada runtime */
--extern const int MAX_NUMBER_OF_KNOWN_TASKS;
--
--/* Identifiers for Ada attributes that need special processing. Be sure
-- to update the table attribute_names in ada-lang.c whenever you change this.
-- */
--
--enum ada_attribute
--{
-- /* Invalid attribute for error checking. */
-- ATR_INVALID,
--
-- ATR_FIRST,
-- ATR_LAST,
-- ATR_LENGTH,
-- ATR_IMAGE,
-- ATR_IMG,
-- ATR_MAX,
-- ATR_MIN,
-- ATR_MODULUS,
-- ATR_POS,
-- ATR_SIZE,
-- ATR_TAG,
-- ATR_VAL,
--
-- /* Dummy last attribute. */
-- ATR_END
--};
--
--enum task_states
--{
-- Unactivated,
-- Runnable,
-- Terminated,
-- Activator_Sleep,
-- Acceptor_Sleep,
-- Entry_Caller_Sleep,
-- Async_Select_Sleep,
-- Delay_Sleep,
-- Master_Completion_Sleep,
-- Master_Phase_2_Sleep
--};
--
--extern char *ada_task_states[];
--
--typedef struct
--{
-- char *P_ARRAY;
-- int *P_BOUNDS;
--}
--fat_string;
--
--typedef struct entry_call
--{
-- void *self;
--}
-- *entry_call_link;
--
--struct task_fields
--{
-- int entry_num;
--#if (defined (VXWORKS_TARGET) || !defined (i386)) \
-- && !(defined (VXWORKS_TARGET) && defined (M68K_TARGET))
-- int pad1;
--#endif
-- char state;
--#if (defined (VXWORKS_TARGET) && defined (M68K_TARGET))
-- char pad_8bits;
--#endif
-- void *parent;
-- int priority;
-- int current_priority;
-- fat_string image;
-- entry_call_link call;
--#if (defined (sun) && defined (__SVR4)) && !defined (VXWORKS_TARGET)
-- int pad2;
-- unsigned thread;
-- unsigned lwp;
--#else
-- void *thread;
-- void *lwp;
--#endif
--}
--#if (defined (VXWORKS_TARGET) && defined (M68K_TARGET))
--__attribute__ ((packed))
--#endif
-- ;
--
--struct task_entry
--{
-- void *task_id;
-- int task_num;
-- int known_tasks_index;
-- struct task_entry *next_task;
-- void *thread;
-- void *lwp;
-- int stack_per;
-+enum ada_operator
-+ {
-+ /* X IN A'RANGE(N). N is an immediate operand, surrounded by
-+ BINOP_IN_BOUNDS before and after. A is an array, X an index
-+ value. Evaluates to true iff X is within range of the Nth
-+ dimension (1-based) of A. (A multi-dimensional array
-+ type is represented as array of array of ...) */
-+ BINOP_IN_BOUNDS = OP_EXTENDED0,
-+
-+ /* X IN L .. U. True iff L <= X <= U. */
-+ TERNOP_IN_RANGE,
-+
-+ /* Ada attributes ('Foo). */
-+ OP_ATR_FIRST,
-+ OP_ATR_LAST,
-+ OP_ATR_LENGTH,
-+ OP_ATR_IMAGE,
-+ OP_ATR_MAX,
-+ OP_ATR_MIN,
-+ OP_ATR_MODULUS,
-+ OP_ATR_POS,
-+ OP_ATR_SIZE,
-+ OP_ATR_TAG,
-+ OP_ATR_VAL,
-+
-+ /* Ada type qualification. It is encoded as for UNOP_CAST, above,
-+ and denotes the TYPE'(EXPR) construct. */
-+ UNOP_QUAL,
-+
-+ /* X IN TYPE. The `TYPE' argument is immediate, with
-+ UNOP_IN_RANGE before and after it. True iff X is a member of
-+ type TYPE (typically a subrange). */
-+ UNOP_IN_RANGE,
-+
-+ /* End marker */
-+ OP_ADA_LAST
-+ };
-+
-+/* A triple, (symbol, block, symtab), representing one instance of a
-+ * symbol-lookup operation. */
-+struct ada_symbol_info {
-+ struct symbol* sym;
-+ struct block* block;
-+ struct symtab* symtab;
- };
-
- extern struct type *builtin_type_ada_int;
-@@ -162,33 +136,40 @@ extern struct type *builtin_type_ada_nat
- extern struct type *builtin_type_ada_positive;
- extern struct type *builtin_type_ada_system_address;
-
--/* Assuming V points to an array of S objects, make sure that it contains at
-+/* The maximum number of tasks known to the Ada runtime */
-+extern const int MAX_NUMBER_OF_KNOWN_TASKS;
-+
-+/* Assuming V points to an array of S objects, make sure that it contains at
- least M objects, updating V and S as necessary. */
-
--#define GROW_VECT(v, s, m) \
-+#define GROW_VECT(v, s, m) \
- if ((s) < (m)) grow_vect ((void**) &(v), &(s), (m), sizeof(*(v)));
-
- extern void grow_vect (void **, size_t *, size_t, int);
-
--extern int ada_parse (void); /* Defined in ada-exp.y */
-+extern int ada_get_field_index (const struct type *type,
-+ const char *field_name,
-+ int maybe_missing);
-+
-+extern int ada_parse (void); /* Defined in ada-exp.y */
-
--extern void ada_error (char *); /* Defined in ada-exp.y */
-+extern void ada_error (char *); /* Defined in ada-exp.y */
-
-- /* Defined in ada-typeprint.c */
-+ /* Defined in ada-typeprint.c */
- extern void ada_print_type (struct type *, char *, struct ui_file *, int,
-- int);
-+ int);
-
- extern int ada_val_print (struct type *, char *, int, CORE_ADDR,
-- struct ui_file *, int, int, int,
-- enum val_prettyprint);
-+ struct ui_file *, int, int, int,
-+ enum val_prettyprint);
-
- extern int ada_value_print (struct value *, struct ui_file *, int,
-- enum val_prettyprint);
-+ enum val_prettyprint);
-
-- /* Defined in ada-lang.c */
-+ /* Defined in ada-lang.c */
-
- extern struct value *value_from_contents_and_address (struct type *, char *,
-- CORE_ADDR);
-+ CORE_ADDR);
-
- extern void ada_emit_char (int, struct ui_file *, int, int);
-
-@@ -197,10 +178,10 @@ extern void ada_printchar (int, struct u
- extern void ada_printstr (struct ui_file *, char *, unsigned int, int, int);
-
- extern void ada_convert_actuals (struct value *, int, struct value **,
-- CORE_ADDR *);
-+ CORE_ADDR *);
-
- extern struct value *ada_value_subscript (struct value *, int,
-- struct value **);
-+ struct value **);
-
- extern struct type *ada_array_element_type (struct type *, int);
-
-@@ -208,13 +189,11 @@ extern int ada_array_arity (struct type
-
- struct type *ada_type_of_array (struct value *, int);
-
--extern struct value *ada_coerce_to_simple_array (struct value *);
--
- extern struct value *ada_coerce_to_simple_array_ptr (struct value *);
-
--extern int ada_is_simple_array (struct type *);
-+extern int ada_is_simple_array_type (struct type *);
-
--extern int ada_is_array_descriptor (struct type *);
-+extern int ada_is_array_descriptor_type (struct type *);
-
- extern int ada_is_bogus_array_descriptor (struct type *);
-
-@@ -222,34 +201,43 @@ extern struct type *ada_index_type (stru
-
- extern struct value *ada_array_bound (struct value *, int, int);
-
--extern int ada_lookup_symbol_list (const char *, struct block *,
-- domain_enum, struct symbol ***,
-- struct block ***);
-+extern char *ada_decode_symbol (const struct general_symbol_info*);
-
--extern char *ada_fold_name (const char *);
-+extern const char *ada_decode (const char*);
-+
-+extern enum language ada_update_initial_language (enum language,
-+ struct partial_symtab*);
-
--extern struct symbol *ada_lookup_symbol (const char *, struct block *,
-- domain_enum);
-+extern void clear_ada_sym_cache (void);
-
--extern struct minimal_symbol *ada_lookup_minimal_symbol (const char *);
-+extern char **ada_make_symbol_completion_list (const char *text0,
-+ const char *word);
-
--extern void ada_resolve (struct expression **, struct type *);
-+extern int ada_lookup_symbol_list (const char *, const struct block *,
-+ domain_enum, struct ada_symbol_info**);
-+
-+extern char *ada_fold_name (const char *);
-
--extern int ada_resolve_function (struct symbol **, struct block **, int,
-- struct value **, int, const char *,
-- struct type *);
-+extern struct symbol *ada_lookup_symbol (const char *, const struct block *,
-+ domain_enum, int *,
-+ struct symtab **);
-+
-+extern struct minimal_symbol *ada_lookup_simple_minsym (const char *);
-
- extern void ada_fill_in_ada_prototype (struct symbol *);
-
--extern int user_select_syms (struct symbol **, struct block **, int, int);
-+extern int user_select_syms (struct ada_symbol_info *, int, int);
-
- extern int get_selections (int *, int, int, int, char *);
-
- extern char *ada_start_decode_line_1 (char *);
-
- extern struct symtabs_and_lines ada_finish_decode_line_1 (char **,
-- struct symtab *,
-- int, char ***);
-+ struct symtab *,
-+ int, char ***);
-+
-+extern struct symtabs_and_lines ada_sals_for_line (const char*, int,
-+ int, char***, int);
-
- extern int ada_scan_number (const char *, int, LONGEST *, int *);
-
-@@ -260,8 +248,8 @@ extern int ada_is_ignored_field (struct
- extern int ada_is_packed_array_type (struct type *);
-
- extern struct value *ada_value_primitive_packed_val (struct value *, char *,
-- long, int, int,
-- struct type *);
-+ long, int, int,
-+ struct type *);
-
- extern struct type *ada_coerce_to_simple_array_type (struct type *);
-
-@@ -269,12 +257,16 @@ extern int ada_is_character_type (struct
-
- extern int ada_is_string_type (struct type *);
-
--extern int ada_is_tagged_type (struct type *);
-+extern int ada_is_tagged_type (struct type *, int);
-+
-+extern int ada_is_tag_type (struct type *);
-
- extern struct type *ada_tag_type (struct value *);
-
- extern struct value *ada_value_tag (struct value *);
-
-+extern const char *ada_tag_name (struct value *);
-+
- extern int ada_is_parent_field (struct type *, int);
-
- extern int ada_is_wrapper_field (struct type *, int);
-@@ -289,24 +281,20 @@ extern int ada_in_variant (LONGEST, stru
-
- extern char *ada_variant_discrim_name (struct type *);
-
--extern struct type *ada_lookup_struct_elt_type (struct type *, char *, int,
-- int *);
--
- extern struct value *ada_value_struct_elt (struct value *, char *, char *);
-
--extern struct value *ada_search_struct_field (char *, struct value *, int,
-- struct type *);
--
- extern int ada_is_aligner_type (struct type *);
-
- extern struct type *ada_aligned_type (struct type *);
-
- extern char *ada_aligned_value_addr (struct type *, char *);
-
--extern const char *ada_attribute_name (int);
-+extern const char *ada_attribute_name (enum exp_opcode);
-
- extern int ada_is_fixed_point_type (struct type *);
-
-+extern int ada_is_system_address_type (struct type *);
-+
- extern DOUBLEST ada_delta (struct type *);
-
- extern DOUBLEST ada_fixed_to_float (struct type *, LONGEST);
-@@ -323,30 +311,37 @@ extern struct type *ada_system_address_t
-
- extern int ada_which_variant_applies (struct type *, struct type *, char *);
-
--extern struct value *ada_to_fixed_value (struct type *, char *, CORE_ADDR,
-- struct value *);
--
- extern struct type *ada_to_fixed_type (struct type *, char *, CORE_ADDR,
-- struct value *);
-+ struct value *);
-+
-+extern struct type *
-+ ada_template_to_fixed_record_type_1 (struct type *type, char *valaddr,
-+ CORE_ADDR address, struct value *dval0,
-+ int keep_dynamic_fields);
-
- extern int ada_name_prefix_len (const char *);
-
- extern char *ada_type_name (struct type *);
-
- extern struct type *ada_find_parallel_type (struct type *,
-- const char *suffix);
-+ const char *suffix);
-+
-+extern LONGEST get_int_var_value (char *, int *);
-
--extern LONGEST get_int_var_value (char *, char *, int *);
-+extern struct symbol *ada_find_any_symbol (const char *name);
-
- extern struct type *ada_find_any_type (const char *name);
-
-+extern struct symbol *ada_find_renaming_symbol (const char *name,
-+ struct block *block);
-+
- extern int ada_prefer_type (struct type *, struct type *);
-
- extern struct type *ada_get_base_type (struct type *);
-
- extern struct type *ada_completed_type (struct type *);
-
--extern char *ada_mangle (const char *);
-+extern char *ada_encode (const char *);
-
- extern const char *ada_enum_name (const char *);
-
-@@ -364,29 +359,38 @@ extern const char *ada_renaming_type (st
-
- extern int ada_is_object_renaming (struct symbol *);
-
--extern const char *ada_simple_renamed_entity (struct symbol *);
-+extern char *ada_simple_renamed_entity (struct symbol *);
-
- extern char *ada_breakpoint_rewrite (char *, int *);
-
-+extern char *ada_main_name (void);
-+
- /* Tasking-related: ada-tasks.c */
-
- extern int valid_task_id (int);
-
--extern int get_current_task (void);
--
- extern void init_task_list (void);
-
--extern void *get_self_id (void);
-+extern int ada_is_exception_breakpoint (bpstat bs);
-+
-+extern void ada_adjust_exception_stop (bpstat bs);
-
--extern int get_current_task (void);
-+extern void ada_print_exception_stop (bpstat bs);
-
--extern int get_entry_number (void *);
-+extern int ada_get_current_task (ptid_t);
-
--extern void ada_report_exception_break (struct breakpoint *);
-+extern int breakpoint_ada_task_match (CORE_ADDR, ptid_t);
-+
-+extern int ada_print_exception_breakpoint_nontask (struct breakpoint *);
-+
-+extern void ada_print_exception_breakpoint_task (struct breakpoint *);
-
- extern int ada_maybe_exception_partial_symbol (struct partial_symbol *sym);
-
- extern int ada_is_exception_sym (struct symbol *sym);
-
-+extern void ada_find_printable_frame (struct frame_info *fi);
-+
-+extern void ada_reset_thread_registers (void);
-
- #endif
-
+++ /dev/null
-From gdb-patches-return-33535-listarch-gdb-patches=sources dot redhat dot com at sources dot redhat dot com Wed Jun 02 10:06:52 2004
-Return-Path: <gdb-patches-return-33535-listarch-gdb-patches=sources dot redhat dot com at sources dot redhat dot com>
-Delivered-To: listarch-gdb-patches at sources dot redhat dot com
-Received: (qmail 7737 invoked by alias); 2 Jun 2004 10:06:52 -0000
-Mailing-List: contact gdb-patches-help at sources dot redhat dot com; run by ezmlm
-Precedence: bulk
-List-Subscribe: <mailto:gdb-patches-subscribe at sources dot redhat dot com>
-List-Archive: <http://sources.redhat.com/ml/gdb-patches/>
-List-Post: <mailto:gdb-patches at sources dot redhat dot com>
-List-Help: <mailto:gdb-patches-help at sources dot redhat dot com>, <http://sources dot redhat dot com/ml/#faqs>
-Sender: gdb-patches-owner at sources dot redhat dot com
-Delivered-To: mailing list gdb-patches at sources dot redhat dot com
-Received: (qmail 7632 invoked from network); 2 Jun 2004 10:06:33 -0000
-Received: from unknown (HELO nile.gnat.com) (205.232.38.5)
- by sourceware dot org with SMTP; 2 Jun 2004 10:06:33 -0000
-Received: from localhost (localhost [127.0.0.1])
- by nile dot gnat dot com (Postfix) with ESMTP id 63F48F2854
- for <gdb-patches at sources dot redhat dot com>; Wed, 2 Jun 2004 06:06:32 -0400 (EDT)
-Received: from nile.gnat.com ([127.0.0.1])
- by localhost (nile dot gnat dot com [127 dot 0 dot 0 dot 1]) (amavisd-new, port 10024) with LMTP
- id 11617-01-3 for <gdb-patches at sources dot redhat dot com>;
- Wed, 2 Jun 2004 06:06:31 -0400 (EDT)
-Received: by nile.gnat.com (Postfix, from userid 1345)
- id 50E19F283F; Wed, 2 Jun 2004 06:06:31 -0400 (EDT)
-From: Paul Hilfinger <hilfingr at gnat dot com>
-To: gdb-patches at sources dot redhat dot com
-Subject: [PATCH]: Updates to Ada sources, part 3 (long)
-Message-Id: <20040602100631.50E19F283F@nile.gnat.com>
-Date: Wed, 2 Jun 2004 06:06:31 -0400 (EDT)
-X-Virus-Scanned: by amavisd-new at nile.gnat.com
-
-
-Part 3/3 of synchronizing patch with ACT sources.
-
-Paul Hilfinger
-
-Index: gdb/ada-tasks.c
-===================================================================
-RCS file: /cvs/src/src/gdb/ada-tasks.c,v
-retrieving revision 1.8
-diff -u -p -r1.8 ada-tasks.c
---- gdb/ada-tasks.c 28 Apr 2004 16:36:25 -0000 1.8
-+++ gdb/ada-tasks.c 2 Jun 2004 09:52:56 -0000
-@@ -1,10 +1,10 @@
--/* file ada-tasks.c: Ada tasking control for GDB
-- Copyright 1997 Free Software Foundation, Inc.
-- Contributed by Ada Core Technologies, Inc
--.
-+/* File ada-tasks.c: Ada tasking control for GDB
-+ Copyright 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
-+ Free Software Foundation, Inc.
-+ Contributed by Ada Core Technologies, Inc.
-+
- This file is part of GDB.
-
-- [$Id$]
- Authors: Roch-Alexandre Nomine Beguin, Arnaud Charlet <charlet@gnat.com>
-
- This program is free software; you can redistribute it and/or modify
-@@ -15,6 +15,7 @@
- */
-
- #include <ctype.h>
-+#include <gdb_string.h>
- #include "defs.h"
- #include "command.h"
- #include "value.h"
-@@ -22,94 +23,294 @@
- #include "inferior.h"
- #include "symtab.h"
- #include "target.h"
--#include "regcache.h"
- #include "gdbcore.h"
-+#include "gdbthread.h"
-+#include "regcache.h" /* for registers_changed */
-
--#if (defined(__alpha__) && defined(__osf__) && !defined(__alpha_vxworks))
-+#if defined (__fsu__) || defined (HAVE_SPYTHREAD) \
-+ || (defined(__alpha__) && defined(__osf__) && !defined(__alpha_vxworks))
- #include <sys/procfs.h>
- #endif
-
--#if (defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET))
-+#if defined (__fsu__) || defined (HAVE_SPYTHREAD) \
-+ || (defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET))
- #include "gregset.h"
- #endif
-
-+#ifdef I386_GNULINUX_TARGET
-+#include "gdb_thread_db.h"
-+#endif
-+
-+#if defined (HAVE_SPYTHREAD)
-+#include "irix6-spyThread.h"
-+#endif
-+
- #include "ada-lang.h"
-+#include "observer.h"
-
--/* FIXME: move all this conditional compilation in description
-- files or in configure.in */
-+enum task_states
-+{
-+ Unactivated,
-+ Runnable,
-+ Terminated,
-+ Activator_Sleep,
-+ Acceptor_Sleep,
-+ Entry_Caller_Sleep,
-+ Async_Select_Sleep,
-+ Delay_Sleep,
-+ Master_Completion_Sleep,
-+ Master_Phase_2_Sleep
-+};
-
--#if defined (VXWORKS_TARGET)
--#define THREAD_TO_PID(tid,lwpid) (tid)
-+struct task_control_block
-+{
-+ char state;
-+ CORE_ADDR parent;
-+ int priority;
-+ char image [32];
-+ int image_len; /* This field is not always present in the ATCB. */
-+ CORE_ADDR call;
-+ CORE_ADDR thread;
-+ CORE_ADDR lwp; /* This field is not always present in the ATCB. */
-+};
-
--#elif defined (linux)
--#define THREAD_TO_PID(tid,lwpid) (0)
-+/* The index of certain important fields in the Ada Task Control Block
-+ record and sub-records. */
-
--#elif (defined (sun) && defined (__SVR4))
--#define THREAD_TO_PID thread_to_pid
-+struct tcb_fieldnos
-+{
-+ /* Fields in record Ada_Task_Control_Block. */
-+ int common;
-
--#elif defined (sgi) || defined (__WIN32__) || defined (hpux)
--#define THREAD_TO_PID(tid,lwpid) ((int)lwpid)
-+ /* Fields in record Common_ATCB. */
-+ int state;
-+ int parent;
-+ int priority;
-+ int image;
-+ int image_len; /* This field may be missing. */
-+ int call;
-+ int ll;
-+
-+ /* Fields in Task_Primitives.Private_Data. */
-+ int ll_thread;
-+ int ll_lwp; /* This field may be missing. */
-+};
-
-+#if defined (linux)
-+#define TASK_LWP(atcb) 0L
- #else
--#define THREAD_TO_PID(tid,lwpid) (0)
-+#define TASK_LWP(atcb) extract_unsigned_integer (&(atcb).lwp, sizeof ((atcb).lwp))
- #endif
-
-+struct task_ptid
-+{
-+ int pid; /* The Process id */
-+ long lwp; /* The Light Weight Process id */
-+ long tid; /* The Thread id */
-+};
-+typedef struct task_ptid task_ptid_t;
-+
-+struct task_entry
-+{
-+ CORE_ADDR task_id;
-+ struct task_control_block atcb;
-+ int task_num;
-+ int known_tasks_index;
-+ struct task_entry *next_task;
-+ task_ptid_t task_ptid;
-+ int stack_per;
-+};
-+
-+/* FIXME: move all this conditional compilation in description
-+ files or in configure.in */
-+
- #if defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET)
-+#define SPECIAL_THREAD_SUPPORT_ACTIVE() thread_support
-+#define SAVE_TASK_REGISTERS(task) \
-+ do { fill_gregset (&gregset_saved, -1); \
-+ fill_fpregset (&fpregset_saved, -1); \
-+ } while (0)
-+#define RESTORE_TASK_REGISTERS(task) \
-+ do { supply_gregset (&gregset_saved); \
-+ supply_fpregset (&fpregset_saved); \
-+ } while (0)
-+
- #define THREAD_FETCH_REGISTERS dec_thread_fetch_registers
--#define GET_CURRENT_THREAD dec_thread_get_current_thread
-+#define GET_CURRENT_THREAD(PTID) dec_thread_get_current_thread ()
-+extern unsigned long dec_thread_get_current_thread (void);
- extern int dec_thread_get_registers (gdb_gregset_t *, gdb_fpregset_t *);
-+extern int dec_thread_fetch_registers (void);
- #endif
-
--#if defined (_AIX)
--#define THREAD_FETCH_REGISTERS aix_thread_fetch_registers
--#define GET_CURRENT_THREAD aix_thread_get_current_thread
-+#ifdef __fsu__
-+#define SPECIAL_THREAD_SUPPORT_ACTIVE() \
-+ (thread_support && pthread_kern_addr != 0)
-+#define SAVE_TASK_REGISTERS(task) \
-+ do { \
-+ if (pthread_kern_addr != 0) \
-+ { \
-+ fill_gregset (&gregset_saved, -1); \
-+ fill_fpregset (&fpregset_saved, -1); \
-+ } \
-+ } while (0)
-+#define RESTORE_TASK_REGISTERS(task) \
-+ do { \
-+ if (pthread_kern_addr != 0) \
-+ { \
-+ supply_gregset (&gregset_saved); \
-+ supply_fpregset (&fpregset_saved); \
-+ } \
-+ } while (0)
-+
-+extern int fsu_thread_fetch_registers (void);
-+extern unsigned long fsu_thread_get_current_thread (void);
-+static int fsu_or_linux_thread_fetch_registers (void);
-+static long fsu_or_linux_thread_get_current_thread (ptid_t);
-+#define THREAD_FETCH_REGISTERS fsu_or_linux_thread_fetch_registers
-+#define GET_CURRENT_THREAD(PTID) fsu_or_linux_thread_get_current_thread (PTID)
-+#define PTHREAD_KERN "pthread_kern"
-+#endif
-+
-+#ifdef I386_GNULINUX_TARGET
-+extern td_thrinfo_t thread_db_pid_to_thread_info (int pid);
-+extern int thread_db_tid_to_pid (void *tid);
- #endif
-
- #if defined(VXWORKS_TARGET)
--#define GET_CURRENT_THREAD() ((void*)inferior_pid)
-+#define GET_CURRENT_THREAD(PTID) (unsigned long) ptid_get_pid (PTID)
- #define THREAD_FETCH_REGISTERS() (-1)
-
--#elif defined (sun) && defined (__SVR4)
--#define GET_CURRENT_THREAD solaris_thread_get_current_thread
-+#elif defined (__WIN32__) || defined (__CYGWIN__) || defined (hpux)
-+#define GET_CURRENT_THREAD(PTID) ptid_get_pid (PTID)
- #define THREAD_FETCH_REGISTERS() (-1)
--extern void *GET_CURRENT_THREAD ();
-+#endif
-
--#elif defined (_AIX) || (defined(__alpha__) && defined(__osf__))
--extern void *GET_CURRENT_THREAD ();
-+#if defined (HAVE_SPYTHREAD)
-+#define GET_CURRENT_THREAD(PTID) (unsigned long) TIDGET (PTID)
-+#endif
-
--#elif defined (__WIN32__) || defined (hpux)
--#define GET_CURRENT_THREAD() (inferior_pid)
--#define THREAD_FETCH_REGISTERS() (-1)
-+#if !defined(GET_CURRENT_THREAD)
-+#define GET_CURRENT_THREAD(PTID) (unsigned long) ptid_get_tid (PTID)
-+#endif
-
--#else
--#define GET_CURRENT_THREAD() (NULL)
--#define THREAD_FETCH_REGISTERS() (-1)
-+#if !defined(THREAD_FETCH_REGISTERS)
-+#define THREAD_FETCH_REGISTERS() (target_fetch_registers (-1), 0)
-+#endif
-+
-+#if !defined(SAVE_TASK_REGISTERS)
-+#define SAVE_TASK_REGISTERS(task)
-+#define RESTORE_TASK_REGISTERS(task)
-+#endif
-+
-+#if !defined(SPECIAL_THREAD_SUPPORT_ACTIVE)
-+#define SPECIAL_THREAD_SUPPORT_ACTIVE() 0
- #endif
-
- #define KNOWN_TASKS_NAME "system__tasking__debug__known_tasks"
-
--#define READ_MEMORY(addr, var) read_memory (addr, (char*) &var, sizeof (var))
--/* external declarations */
-+#define READ_MEMORY(addr, var) read_memory (addr, (char *) &var, sizeof (var))
-+
-+/* If defined to 1, means that the thread ptids maintained by core GDB
-+ follow this format : first field (pid) contains the tid
-+ second field (lwp) contains 0
-+ third field (tid) contains 0 */
-+#ifndef THREAD_PTID_CONTAINS_TID_NULL_NULL
-+#define THREAD_PTID_CONTAINS_TID_NULL_NULL (0)
-+#endif
-+
-+/* If defined to 1, means that the thread ptids maintained by core GDB
-+ follow this format: first field (pid) contains the LWP id
-+ second field (lwp) contains 0
-+ third field (tid) contains 0 */
-+#ifndef THREAD_PTID_CONTAINS_LWP_NULL_NULL
-+#define THREAD_PTID_CONTAINS_LWP_NULL_NULL (0)
-+#endif
-+
-+/* If defined to 1, means that the thread ptids maintained by core GDB
-+ follow this format: first field (pid) contains the PID
-+ second field (lwp) contains 0
-+ third field (tid) contains the TID */
-+#ifndef THREAD_PTID_CONTAINS_PID_NULL_TID
-+#define THREAD_PTID_CONTAINS_PID_NULL_TID (0)
-+#endif
-+
-+/* If defined to 1, means that the thread ptids maintained by core GDB
-+ follow this format: first field (pid) contains the PID
-+ second field (lwp) contains the TID
-+ third field (tid) contains the 0 */
-+
-+#ifndef THREAD_PTID_CONTAINS_PID_TID_NULL
-+#define THREAD_PTID_CONTAINS_PID_TID_NULL (0)
-+#endif
-+
-+/* If defined to 1, means that the thread id is not stored in the tid
-+ field of the task_ptid, but rather in the lwp field. */
-+#ifndef ADA_THREAD_ID_IN_LWP
-+#define ADA_THREAD_ID_IN_LWP (0)
-+#endif
-+
-+static int task_ptid_get_pid (task_ptid_t task_ptid);
-+static long task_ptid_get_lwp (task_ptid_t task_ptid);
-+static long task_ptid_get_tid (task_ptid_t task_ptid);
-+static task_ptid_t task_ptid_build (int pid, long lwp, long tid);
-+static ptid_t task_ptid_get_ptid (task_ptid_t task_ptid);
-+static long task_ptid_get_thread_id (task_ptid_t task_ptid);
-+
-+static int task_is_alive (enum task_states state);
-+static CORE_ADDR get_self_id (ptid_t);
-+static int get_entry_number (CORE_ADDR);
-+static void get_tcb_types_info (struct type **atcb_type,
-+ struct type **atcb_common_type,
-+ struct type **atcb_ll_type,
-+ struct tcb_fieldnos *atcb_fieldnos);
-+static void get_tcb_call_type_info (struct type **atcb_call_type,
-+ int *atcb_call_self_fieldno);
-+static CORE_ADDR get_known_tasks_addr (void);
-+static int read_known_tasks_array (void);
-+static int build_task_list (void);
-+static void value_as_string (char *dest, struct value *val, int length);
-+static struct task_control_block read_atcb (CORE_ADDR atcb_addr);
-+static CORE_ADDR read_caller (const CORE_ADDR call);
-+static void display_current_task_id (void);
-+static void task_command_1 (char *tidstr, int from_tty);
-+
-+/* Ada-tasks observers. */
-+
-+static void normal_stop_notification (void);
-+static void ada_tasks_attach_observers (void);
-
- /* Global visible variables */
-
--struct task_entry *task_list = NULL;
- int ada__tasks_check_symbol_table = 1;
--void *pthread_kern_addr = NULL;
-+CORE_ADDR pthread_kern_addr = 0;
-+
-+/* Local global variables. */
-+static struct task_entry *task_list = NULL;
-+
-+/* When non-zero, this flag indicates that the current task_list
-+ is obsolete, and should be recomputed before it is accessed. */
-+static int stale_task_list_p = 1;
-
--#if (defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET))
-+#if defined (__fsu__) || (defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET))
- gdb_gregset_t gregset_saved;
- gdb_fpregset_t fpregset_saved;
- #endif
-
- /* The maximum number of tasks known to the Ada runtime */
--const int MAX_NUMBER_OF_KNOWN_TASKS = 1000;
-+static const int MAX_NUMBER_OF_KNOWN_TASKS = 1000;
-
--/* the current task */
--int current_task = -1, current_task_id = -1, current_task_index;
--void *current_thread, *current_lwp;
-+/* the current task, as seen by the user. Modified everytime the user
-+ does a task switch. */
-+static int current_task = -1;
-
--char *ada_task_states[] = {
-+unsigned long current_thread;
-+
-+/* The task where the debugger stopped, giving control back to the user.
-+ Not affected by task switching. Used to restore the registers before
-+ continuing the inferior. */
-+int current_task_id = -1;
-+
-+static char *task_states[] = {
- "Unactivated",
- "Runnable",
- "Terminated",
-@@ -129,7 +330,7 @@ char *ada_task_states[] = {
-
- /* Global internal types */
-
--static char *ada_long_task_states[] = {
-+static char *long_task_states[] = {
- "Unactivated",
- "Runnable",
- "Terminated",
-@@ -150,11 +351,34 @@ static char *ada_long_task_states[] = {
- /* Global internal variables */
-
- static int highest_task_num = 0;
--int thread_support = 0; /* 1 if the thread library in use is supported */
--static int gdbtk_task_initialization = 0;
-+static int thread_support = 0; /* 1 if the thread library in use is
-+ supported. FIXME: Not reinitialized
-+ properly when program reloaded.
-+ */
-+#ifdef __fsu__
-+static int
-+fsu_or_linux_thread_fetch_registers (void)
-+{
-+ if (pthread_kern_addr != 0)
-+ return fsu_thread_fetch_registers ();
-+
-+ target_fetch_registers (-1);
-+ return 0L;
-+}
-+
-+static long
-+fsu_or_linux_thread_get_current_thread (ptid_t ptid)
-+{
-+ if (pthread_kern_addr != 0)
-+ return fsu_thread_get_current_thread ();
-+
-+ return ptid_get_tid (ptid);
-+}
-+
-+#endif /* __fsu__ */
-
- static int
--add_task_entry (void *p_task_id, int index)
-+add_task_entry (CORE_ADDR p_task_id, int index)
- {
- struct task_entry *new_task_entry = NULL;
- struct task_entry *pt;
-@@ -163,13 +387,18 @@ add_task_entry (void *p_task_id, int ind
- new_task_entry = xmalloc (sizeof (struct task_entry));
- new_task_entry->task_num = highest_task_num;
- new_task_entry->task_id = p_task_id;
-+ new_task_entry->atcb = read_atcb (p_task_id);
- new_task_entry->known_tasks_index = index;
-+ new_task_entry->task_ptid =
-+ task_ptid_build (ptid_get_pid (inferior_ptid), /* ? */
-+ TASK_LWP (new_task_entry->atcb),
-+ new_task_entry->atcb.thread);
- new_task_entry->next_task = NULL;
- pt = task_list;
- if (pt)
- {
- while (pt->next_task)
-- pt = pt->next_task;
-+ pt = pt->next_task;
- pt->next_task = new_task_entry;
- pt->stack_per = 0;
- }
-@@ -178,8 +407,8 @@ add_task_entry (void *p_task_id, int ind
- return new_task_entry->task_num;
- }
-
--int
--get_entry_number (void *p_task_id)
-+static int
-+get_entry_number (CORE_ADDR p_task_id)
- {
- struct task_entry *pt;
-
-@@ -187,22 +416,22 @@ get_entry_number (void *p_task_id)
- while (pt != NULL)
- {
- if (pt->task_id == p_task_id)
-- return pt->task_num;
-+ return pt->task_num;
- pt = pt->next_task;
- }
- return 0;
- }
-
- static struct task_entry *
--get_thread_entry_vptr (void *thread)
-+get_thread_entry_vptr (long thread)
- {
- struct task_entry *pt;
-
- pt = task_list;
- while (pt != NULL)
- {
-- if (pt->thread == thread)
-- return pt;
-+ if (task_ptid_get_thread_id (pt->task_ptid) == thread)
-+ return pt;
- pt = pt->next_task;
- }
- return 0;
-@@ -217,7 +446,7 @@ get_entry_vptr (int p_task_num)
- while (pt)
- {
- if (pt->task_num == p_task_num)
-- return pt;
-+ return pt;
- pt = pt->next_task;
- }
- return NULL;
-@@ -228,6 +457,8 @@ init_task_list (void)
- {
- struct task_entry *pt, *old_pt;
-
-+ target_find_new_threads ();
-+
- pt = task_list;
- while (pt)
- {
-@@ -245,64 +476,592 @@ valid_task_id (int task)
- return get_entry_vptr (task) != NULL;
- }
-
--void *
--get_self_id (void)
-+/* Return the pid of a given task ptid. */
-+
-+static int
-+task_ptid_get_pid (task_ptid_t task_ptid)
-+{
-+ return task_ptid.pid;
-+}
-+
-+/* Return the lwp of a given task ptid. */
-+
-+static long
-+task_ptid_get_lwp (task_ptid_t task_ptid)
- {
-- struct value *val;
-- void *self_id;
-- int result;
-+ return task_ptid.lwp;
-+}
-+
-+/* Return the tid of a given task ptid. */
-+
-+static long
-+task_ptid_get_tid (task_ptid_t task_ptid)
-+{
-+ return task_ptid.tid;
-+}
-+
-+/* Build a task ptid from the associated pid, lwp, and tid. */
-+
-+static task_ptid_t
-+task_ptid_build (int pid, long lwp, long tid)
-+{
-+ task_ptid_t task_ptid;
-+
-+ task_ptid.pid = pid;
-+ task_ptid.lwp = lwp;
-+ task_ptid.tid = tid;
-+ return task_ptid;
-+}
-+
-+/* Translate a task ptid into a ptid (the ptid maintained by core GDB).
-+
-+ On most platforms, they are equivalent, and this function can be
-+ regarded as the identity. However, there are other platforms where
-+ the task ptid and the ptid are not equivalent. For instance, the task
-+ LWP value is sometimes stored by GDB-core as a pid! This translation
-+ therefore becomes necessary before invoking the GDB thread services. */
-+
-+static ptid_t
-+task_ptid_get_ptid (task_ptid_t task_ptid)
-+{
-+ ptid_t ptid;
-+
-+ if (THREAD_PTID_CONTAINS_TID_NULL_NULL)
-+ ptid = ptid_build (task_ptid_get_tid (task_ptid), 0, 0);
-+ else if (THREAD_PTID_CONTAINS_LWP_NULL_NULL)
-+ ptid = ptid_build (task_ptid_get_lwp (task_ptid), 0, 0);
-+ else if (THREAD_PTID_CONTAINS_PID_NULL_TID)
-+ ptid = ptid_build (task_ptid_get_pid (task_ptid),
-+ 0, task_ptid_get_tid (task_ptid));
-+ else if (THREAD_PTID_CONTAINS_PID_TID_NULL)
-+ ptid = ptid_build (task_ptid_get_pid (task_ptid),
-+ task_ptid_get_tid (task_ptid), 0);
-+ else
-+ ptid = ptid_build (task_ptid_get_pid (task_ptid),
-+ task_ptid_get_lwp (task_ptid),
-+ task_ptid_get_tid (task_ptid));
-+
-+ return ptid;
-+}
-+
-+/* Extract and return the thread_id for the given TASK_PTID. */
-+
-+static long
-+task_ptid_get_thread_id (task_ptid_t task_ptid)
-+{
-+ /* On most platforms, the thread_id is stored in task_ptid.tid.
-+ Unfortunately, some other platforms store it as the task_ptid.lwp... */
-+
-+ if (ADA_THREAD_ID_IN_LWP)
-+ return task_ptid_get_lwp (task_ptid);
-+ else
-+ return task_ptid_get_tid (task_ptid);
-+}
-+
-+/* Return non-zero iff the task STATE corresponds to a non-terminated
-+ task state. */
-+
-+static int
-+task_is_alive (enum task_states state)
-+{
-+ return (state != Terminated);
-+}
-+
-+static CORE_ADDR
-+get_self_id (ptid_t ptid)
-+{
-+#ifdef GNAT_GDB
- struct task_entry *ent;
-- extern int do_not_insert_breakpoints;
-
- #if !((defined(sun) && defined(__SVR4)) || defined(VXWORKS_TARGET) || defined(__WIN32__))
- if (thread_support)
- #endif
- {
-- ent = get_thread_entry_vptr (GET_CURRENT_THREAD ());
-+ ent = get_thread_entry_vptr (GET_CURRENT_THREAD (ptid));
- return ent ? ent->task_id : 0;
- }
-+#endif
-
- /* FIXME: calling a function in the inferior with a multithreaded application
-- is not reliable, so return NULL if there is no safe way to get the current
-- task */
-- return NULL;
-+ is not reliable, so return a null address if there is no safe way to
-+ get the current task */
-+ return 0;
- }
-
- int
--get_current_task (void)
-+ada_get_current_task (ptid_t ptid)
- {
- int result;
-
-- /* FIXME: language_ada should be defined in defs.h */
-- /* if (current_language->la_language != language_ada) return -1; */
-+ if (current_language->la_language != language_ada)
-+ return -1;
-
-- result = get_entry_number (get_self_id ());
-+ result = get_entry_number (get_self_id (ptid));
-
- /* return -1 if not found */
- return result == 0 ? -1 : result;
- }
-
-+/* Get from the debugging information the type description of all types
-+ related to the Ada Task Control Block that will be needed in order to
-+ read the list of known tasks in the Ada runtime. Also return the
-+ associated ATCB_FIELDNOS.
-+
-+ Error handling: Any data missing from the debugging info will cause
-+ an error to be raised, and none of the return values to be set.
-+ Users of this function can depend on the fact that all or none of the
-+ return values will be set. */
-+
-+static void
-+get_tcb_types_info (struct type **atcb_type,
-+ struct type **atcb_common_type,
-+ struct type **atcb_ll_type,
-+ struct tcb_fieldnos *atcb_fieldnos)
-+{
-+ struct type *type;
-+ struct type *common_type;
-+ struct type *ll_type;
-+ struct tcb_fieldnos fieldnos;
-+
-+#ifndef ADA_RETAIN_DOTS
-+ const char *atcb_name = "system__tasking__ada_task_control_block___XVE";
-+ const char *common_atcb_name = "system__tasking__common_atcb";
-+ const char *private_data_name = "system__task_primitives__private_data";
-+#else
-+ const char *atcb_name = "system.tasking.ada_task_control_block___XVE";
-+ const char *common_atcb_name = "system.tasking.common_atcb";
-+ const char *private_data_name = "system.task_primitives.private_data";
-+#endif
-+
-+ const struct symbol *atcb_sym =
-+ lookup_symbol (atcb_name, NULL, VAR_DOMAIN, NULL, NULL);
-+ const struct symbol *common_atcb_sym =
-+ lookup_symbol (common_atcb_name, NULL, VAR_DOMAIN, NULL, NULL);
-+ const struct symbol *private_data_sym =
-+ lookup_symbol (private_data_name, NULL, VAR_DOMAIN, NULL, NULL);
-+
-+ if (atcb_sym == NULL || atcb_sym->type == NULL)
-+ error ("Can not find Ada_Task_Control_Block type. Aborting");
-+ if (common_atcb_sym == NULL || common_atcb_sym->type == NULL)
-+ error ("Can not find Common_ATCB type. Aborting");
-+ if (private_data_sym == NULL || private_data_sym->type == NULL)
-+ error ("Can not find Private_Data type. Aborting");
-+
-+ /* Get a static representation of the type record Ada_Task_Control_Block. */
-+ type = atcb_sym->type;
-+ type = ada_template_to_fixed_record_type_1 (type, NULL, 0, NULL, 0);
-+
-+ /* Get the type for Ada_Task_Control_Block.Common. */
-+ common_type = common_atcb_sym->type;
-+
-+ /* Get the type for Ada_Task_Control_Bloc.Common.Call.LL. */
-+ ll_type = private_data_sym->type;
-+
-+ /* Get the field indices. */
-+ fieldnos.common = ada_get_field_index (type, "common", 0);
-+ fieldnos.state = ada_get_field_index (common_type, "state", 0);
-+ fieldnos.parent = ada_get_field_index (common_type, "parent", 0);
-+ fieldnos.priority = ada_get_field_index (common_type, "base_priority", 0);
-+ fieldnos.image = ada_get_field_index (common_type, "task_image", 0);
-+ fieldnos.image_len = ada_get_field_index (common_type, "task_image_len", 1);
-+ fieldnos.call = ada_get_field_index (common_type, "call", 0);
-+ fieldnos.ll = ada_get_field_index (common_type, "ll", 0);
-+ fieldnos.ll_thread = ada_get_field_index (ll_type, "thread", 0);
-+ fieldnos.ll_lwp = ada_get_field_index (ll_type, "lwp", 1);
-+
-+ /* On certain platforms such as x86-windows, the "lwp" field has been
-+ named "thread_id". This field will likely be renamed in the future,
-+ but we need to support both possibilities to avoid an unnecessary
-+ dependency on a recent compiler. We therefore try locating the
-+ "thread_id" field in place of the "lwp" field if we did not find
-+ the latter. */
-+ if (fieldnos.ll_lwp < 0)
-+ fieldnos.ll_lwp = ada_get_field_index (ll_type, "thread_id", 1);
-+
-+ /* Set all the out parameters all at once, now that we are certain
-+ that there are no potential error() anymore. */
-+ *atcb_type = type;
-+ *atcb_common_type = common_type;
-+ *atcb_ll_type = ll_type;
-+ *atcb_fieldnos = fieldnos;
-+}
-+
-+/* Get from the debugging information the type description of the
-+ record type Entry_Call_Record (this is the type of the field
-+ Call.all in the Common_ATCB record type). Also return the index
-+ of the field "Self" in Entry_Call_Record.
-+
-+ Error handling: Any data missing from the debugging info will cause
-+ an error to be raised, and none of the return values to be set.
-+ Users of this function can depend on the fact that all or none of the
-+ return values will be set. */
-+
-+static void
-+get_tcb_call_type_info (struct type **atcb_call_type,
-+ int *atcb_call_self_fieldno)
-+{
-+ struct type *call_type;
-+ int call_self_fieldno;
-+
-+#ifndef ADA_RETAIN_DOTS
-+ const char *entry_call_record_name = "system__tasking__entry_call_record";
-+#else
-+ const char *entry_call_record_name = "system.tasking.entry_call_record";
-+#endif
-+
-+ const struct symbol *entry_call_record_sym =
-+ lookup_symbol (entry_call_record_name, NULL, VAR_DOMAIN, NULL, NULL);
-+
-+ if (entry_call_record_sym == NULL || entry_call_record_sym->type == NULL)
-+ error ("Can not find Entry_Call_Record type. Aborting");
-+
-+ call_type = entry_call_record_sym->type;
-+ call_self_fieldno = ada_get_field_index (call_type, "self", 0);
-+
-+ /* Set all the out parameters all at once, now that we are certain
-+ that there are no potential error() anymore. */
-+ *atcb_call_type = call_type;
-+ *atcb_call_self_fieldno = call_self_fieldno;
-+}
-+
-+/* Return the address of the Known_Tasks array maintained in
-+ the Ada Runtime. Return NULL if the array could not be found,
-+ meaning that the inferior program probably does not use tasking.
-+
-+ In order to provide a fast response time, this function caches
-+ the Known_Tasks array address after the lookup during the first
-+ call. Subsequent calls will simply return this cached address. */
-+
-+static CORE_ADDR
-+get_known_tasks_addr (void)
-+{
-+ static CORE_ADDR known_tasks_addr = 0;
-+
-+ if (ada__tasks_check_symbol_table)
-+ {
-+ struct symbol *sym;
-+ struct minimal_symbol *msym;
-+
-+ thread_support = 0;
-+#if (defined(__alpha__) && defined(__osf__) & !defined(VXWORKS_TARGET)) \
-+ || defined (_AIX) || defined (__CYGWIN__)
-+ thread_support = 1;
-+#elif defined (__fsu__)
-+ msym = lookup_minimal_symbol (PTHREAD_KERN, NULL, NULL);
-+ if (msym != NULL)
-+ {
-+ pthread_kern_addr = SYMBOL_VALUE_ADDRESS (msym);
-+ thread_support = 1;
-+ }
-+#elif defined (HAVE_SPYTHREAD)
-+ thread_support = libspy_enabled;
-+#endif
-+
-+#ifdef I386_GNULINUX_TARGET
-+ /* We support threads via the Linux Threads... */
-+ thread_support = 1;
-+#endif
-+
-+ msym = lookup_minimal_symbol (KNOWN_TASKS_NAME, NULL, NULL);
-+ if (msym != NULL)
-+ known_tasks_addr = SYMBOL_VALUE_ADDRESS (msym);
-+ else
-+#ifndef VXWORKS_TARGET
-+ return 0;
-+#else
-+ {
-+ if (target_lookup_symbol (KNOWN_TASKS_NAME, &known_tasks_addr) != 0)
-+ return 0;
-+ }
-+#endif
-+
-+ /* FIXME: brobecker 2003-03-05: Here would be a much better place
-+ to attach the ada-tasks observers, instead of doing this
-+ unconditionaly in _initialize_tasks. This would avoid an
-+ unecessary notification when the inferior does not use tasking
-+ or as long as the user does not use the ada-tasks commands.
-+ Unfortunately, this is not possible for the moment: the current
-+ code resets ada__tasks_check_symbol_table back to 1 whenever
-+ symbols for a new program are being loaded. If we place the
-+ observers intialization here, we will end up adding new observers
-+ everytime we do the check for Ada tasking-related symbols
-+ above. This would currently have benign effects, but is still
-+ undesirable. The cleanest approach is probably to create a new
-+ observer to notify us when the user is debugging a new program.
-+ We would then reset ada__tasks_check_symbol_table back to 1
-+ during the notification, but also detach all observers.
-+ BTW: observers are probably not reentrant, so detaching during
-+ a notification may not be the safest thing to do... Sigh...
-+ But creating the new observer would be a good idea in any case,
-+ since this allow us to make ada__tasks_check_symbol_table
-+ static, which is a good bonus. */
-+ ada__tasks_check_symbol_table = 0;
-+ }
-+
-+ return known_tasks_addr;
-+}
-+
-+/* Read the Known_Tasks array from the inferior memory, and store
-+ it in task_list. Return non-zero upon success. */
-+
-+static int
-+read_known_tasks_array (void)
-+{
-+ const int target_ptr_byte = TARGET_PTR_BIT / TARGET_CHAR_BIT;
-+ const int temp_tasks_size = target_ptr_byte * MAX_NUMBER_OF_KNOWN_TASKS;
-+ const CORE_ADDR known_tasks_addr = get_known_tasks_addr ();
-+ char *temp_tasks = (char *) alloca (temp_tasks_size);
-+ CORE_ADDR temp_task;
-+ int i;
-+
-+ /* Step 1: Clear the current list, if any. */
-+ init_task_list ();
-+
-+ /* If the application does not use task, then no more needs to be done.
-+ It is important to have the task list cleared (see above) before we
-+ return, as we don't want a stale task list to be used... This can
-+ happen for instance when debugging a non-multitasking program after
-+ having debugged a multitasking one. */
-+ if (known_tasks_addr == 0)
-+ return 0;
-+
-+ /* Step 2: Build a new list by reading the ATCBs from the Known_Tasks
-+ array in the Ada runtime. */
-+ read_memory (known_tasks_addr, temp_tasks, temp_tasks_size);
-+ for (i = 0; i < MAX_NUMBER_OF_KNOWN_TASKS; i++)
-+ {
-+ temp_task = extract_typed_address (temp_tasks + i * target_ptr_byte,
-+ builtin_type_void_data_ptr);
-+
-+ if (temp_task != 0)
-+ {
-+ if (get_entry_number (temp_task) == 0)
-+ add_task_entry (temp_task, i);
-+ }
-+ }
-+
-+ /* Step 3: Unset stale_task_list_p, to avoid re-reading the Known_Tasks
-+ array unless needed. Then report a success. */
-+ stale_task_list_p = 0;
-+ return 1;
-+}
-+
-+/* Builds the task_list by reading the Known_Tasks array from
-+ the inferior. Prints an appropriate message and returns non-zero
-+ if it failed to build this list. */
-+
-+static int
-+build_task_list (void)
-+{
-+ if (!target_has_stack)
-+ error ("No stack");
-+
-+ if (stale_task_list_p)
-+ read_known_tasks_array ();
-+
-+ if (task_list == NULL)
-+ {
-+ printf_filtered ("Your application does not use any Ada task.\n");
-+ return 0;
-+ }
-+
-+ return 1;
-+}
-+
-+/* Extract the contents of the value as a string whose length is LENGTH,
-+ and store the result in DEST. */
-+
-+static void
-+value_as_string (char *dest, struct value *val, int length)
-+{
-+ memcpy (dest, VALUE_CONTENTS (val), length);
-+}
-+
-+/* Extract the string image from the fat string corresponding to VAL,
-+ and store it in DEST. The length of the string is stored in LEN. If
-+ the string length is greater than MAX_LEN, then truncate the result
-+ to the first MAX_LEN characters of the fat string. */
-+
-+static void
-+read_fat_string_value (char *dest, int *len, struct value *val, int max_len)
-+{
-+ struct value *array_val;
-+ struct value *bounds_val;
-+
-+ /* The following variables are made static to avoid recomputing them
-+ each time this function is called. */
-+ static int initialize_fieldnos = 1;
-+ static int array_fieldno;
-+ static int bounds_fieldno;
-+ static int upper_bound_fieldno;
-+
-+ /* Get the index of the fields that we will need to read in order
-+ to extract the string from the fat string. */
-+ if (initialize_fieldnos)
-+ {
-+ struct type *type = VALUE_TYPE (val);
-+ struct type *bounds_type;
-+
-+ array_fieldno = ada_get_field_index (type, "P_ARRAY", 0);
-+ bounds_fieldno = ada_get_field_index (type, "P_BOUNDS", 0);
-+
-+ bounds_type = TYPE_FIELD_TYPE (type, bounds_fieldno);
-+ if (TYPE_CODE (bounds_type) == TYPE_CODE_PTR)
-+ bounds_type = TYPE_TARGET_TYPE (bounds_type);
-+ if (TYPE_CODE (bounds_type) != TYPE_CODE_STRUCT)
-+ error ("Unknown task name format. Aborting");
-+ upper_bound_fieldno = ada_get_field_index (bounds_type, "UB0", 0);
-+
-+ initialize_fieldnos = 0;
-+ }
-+
-+ /* Get the size of the task image by checking the value of the bounds.
-+ The lower bound is always 1, so we only need to read the upper bound. */
-+ bounds_val = value_ind (value_field (val, bounds_fieldno));
-+ *len = value_as_long (value_field (bounds_val, upper_bound_fieldno));
-+
-+ /* Make sure that we do not read more than max_len characters... */
-+ if (*len > max_len)
-+ *len = max_len;
-+
-+ /* Extract LEN characters from the fat string. */
-+ array_val = value_ind (value_field (val, array_fieldno));
-+ read_memory (VALUE_ADDRESS (array_val), dest, *len);
-+}
-+
-+/* Read the ATCB stored at ATCB_ADDR from the inferior memory. */
-+
-+static struct task_control_block
-+read_atcb (CORE_ADDR atcb_addr)
-+{
-+ /* The type description for the ATCB record and subrecords, and
-+ the associated tcb_fieldnos. For efficiency reasons, these are made
-+ static so that we can compute them only once the first time and
-+ reuse them later. */
-+ static struct type *atcb_type = NULL;
-+ static struct type *atcb_common_type = NULL;
-+ static struct type *atcb_ll_type = NULL;
-+ static struct tcb_fieldnos fieldno;
-+
-+ struct task_control_block result;
-+ struct value *tcb_value;
-+ struct value *ll_value;
-+
-+ if (atcb_type == NULL)
-+ get_tcb_types_info (&atcb_type, &atcb_common_type, &atcb_ll_type, &fieldno);
-+
-+ tcb_value = value_from_contents_and_address (atcb_type, NULL, atcb_addr);
-+ tcb_value = value_field (tcb_value, fieldno.common);
-+
-+ result.state = value_as_long (value_field (tcb_value, fieldno.state));
-+ result.parent = value_as_address (value_field (tcb_value, fieldno.parent));
-+ result.priority = value_as_long (value_field (tcb_value, fieldno.priority));
-+
-+ /* Depending on the GNAT version used, the task image is either a fat
-+ string, or a thin array of characters. Older versions of GNAT used
-+ to use fat strings, and therefore did not need an extra field in
-+ the ATCB to store the string length. For efficiency reasons, newer
-+ versions of GNAT replaced the fat string by a static buffer, but this
-+ also required the addition of a new field named "Image_Len" containing
-+ the length of the task name. The method used to extract the task name
-+ is selected depending on the existence of this field. */
-+ if (fieldno.image_len == -1)
-+ {
-+ read_fat_string_value (result.image, &result.image_len,
-+ value_field (tcb_value, fieldno.image),
-+ sizeof (result.image));
-+ }
-+ else
-+ {
-+ value_as_string (result.image, value_field (tcb_value, fieldno.image),
-+ sizeof (result.image));
-+ result.image_len =
-+ value_as_long (value_field (tcb_value, fieldno.image_len));
-+ }
-+
-+ result.call = value_as_address (value_field (tcb_value, fieldno.call));
-+
-+ ll_value = value_field (tcb_value, fieldno.ll);
-+ result.thread = value_as_address (value_field (ll_value, fieldno.ll_thread));
-+ if (fieldno.ll_lwp >= 0)
-+ result.lwp = value_as_address (value_field (ll_value, fieldno.ll_lwp));
-+ else
-+ result.lwp = 0;
-+
-+ return result;
-+}
-+
-+/* Read the ID of the task with which a task is attempting a rendez-vous
-+ from the address of its Entry_Call_Record in the Ada TCB.
-+ If the address of the Entry_Call_Record is null, then return null. */
-+
-+static CORE_ADDR
-+read_caller (const CORE_ADDR call)
-+{
-+ /* The type description for the Entry_Call_Record, and the index of
-+ the field "Self". For efficiency reasons, these are made static
-+ so that we can compute them only once the first time and reuse them
-+ later. */
-+ static struct type *atcb_call_type;
-+ static int self_fieldno = -1;
-+
-+ struct value *call_value;
-+
-+ if (call == 0)
-+ return 0;
-+
-+ if (atcb_call_type == NULL)
-+ get_tcb_call_type_info (&atcb_call_type, &self_fieldno);
-+
-+ call_value = value_from_contents_and_address (atcb_call_type, NULL, call);
-+ return value_as_address (value_field (call_value, self_fieldno));
-+}
-+
-+#if 0
-+/* FIXME: Now modified and back in breakpoint.c */
-+/* breakpoint_task_match (PC) returns true if the breakpoint at PC
-+ is valid for current task. */
-+
-+int
-+breakpoint_task_match (CORE_ADDR pc)
-+{
-+ const int this_task = get_current_task ();
-+ const struct breakpoint *breakpoints = get_breakpoint_chain ();
-+ const struct breakpoint *b;
-+
-+ for (b = breakpoints; b; b = b->next)
-+ {
-+ if (b->enable_state != bp_disabled
-+ && b->enable_state != bp_shlib_disabled
-+ && (b->address == 0 || b->address == pc)
-+ && (b->task == 0 || b->task == this_task))
-+ {
-+ return 1;
-+ }
-+ }
-+
-+ return 0;
-+}
-+#endif
-+
- /* Print detailed information about specified task */
-
- static void
- info_task (char *arg, int from_tty)
- {
-- void *temp_task;
-+#ifdef GNAT_GDB
- struct task_entry *pt, *pt2;
-- void *self_id, *caller;
-- struct task_fields atcb, atcb2;
-- struct entry_call call;
-- int bounds[2];
-- char image[256];
-+ CORE_ADDR caller;
- int num;
-
-- /* FIXME: language_ada should be defined in defs.h */
-- /* if (current_language->la_language != language_ada)
-- {
-- printf_filtered ("The current language does not support tasks.\n");
-- return;
-- }
-- */
-+ if (current_language->la_language != language_ada)
-+ {
-+ printf_filtered ("The current language does not support tasks.\n");
-+ return;
-+ }
-+
-+ target_find_new_threads ();
-+
- pt = get_entry_vptr (atoi (arg));
- if (pt == NULL)
- {
-@@ -310,59 +1069,44 @@ info_task (char *arg, int from_tty)
- return;
- }
-
-- temp_task = pt->task_id;
--
-- /* read the atcb in the inferior */
-- READ_MEMORY ((CORE_ADDR) temp_task, atcb);
--
- /* print the Ada task id */
-- printf_filtered ("Ada Task: %p\n", temp_task);
-+ printf_filtered ("Ada Task: %s\n", paddr_nz (pt->task_id));
-
- /* print the name of the task */
-- if (atcb.image.P_ARRAY != NULL)
-- {
-- READ_MEMORY ((CORE_ADDR) EXTRACT_ADDRESS (atcb.image.P_BOUNDS), bounds);
-- bounds[1] = EXTRACT_INT (bounds[1]);
-- read_memory ((CORE_ADDR) EXTRACT_ADDRESS (atcb.image.P_ARRAY),
-- (char *) &image, bounds[1]);
-- printf_filtered ("Name: %.*s\n", bounds[1], image);
-- }
-+ if (pt->atcb.image_len != 0)
-+ printf_filtered ("Name: %.*s\n", pt->atcb.image_len, pt->atcb.image);
- else
- printf_filtered ("<no name>\n");
-
- /* print the thread id */
-
-- if ((long) pt->thread < 65536)
-- printf_filtered ("Thread: %ld\n", (long int) pt->thread);
-+ if (task_ptid_get_tid (pt->task_ptid) < 65536)
-+ printf_filtered
-+ ("Thread: %ld\n", (long int) task_ptid_get_tid (pt->task_ptid));
- else
-- printf_filtered ("Thread: %p\n", pt->thread);
-+ printf_filtered
-+ ("Thread: %#lx\n", (long int) task_ptid_get_tid (pt->task_ptid));
-
-- if ((long) pt->lwp != 0)
-+ if (task_ptid_get_lwp (pt->task_ptid) != 0)
- {
-- if ((long) pt->lwp < 65536)
-- printf_filtered ("LWP: %ld\n", (long int) pt->lwp);
-+ if ((long) task_ptid_get_lwp (pt->task_ptid) < 65536)
-+ printf_filtered
-+ ("LWP: %ld\n", (long int) task_ptid_get_lwp (pt->task_ptid));
- else
-- printf_filtered ("LWP: %p\n", pt->lwp);
-+ printf_filtered
-+ ("LWP: %#lx\n", (long int) task_ptid_get_lwp (pt->task_ptid));
- }
-
- /* print the parent gdb task id */
-- num = get_entry_number (EXTRACT_ADDRESS (atcb.parent));
-+ num = get_entry_number (pt->atcb.parent);
- if (num != 0)
- {
- printf_filtered ("Parent: %d", num);
- pt2 = get_entry_vptr (num);
-- READ_MEMORY ((CORE_ADDR) pt2->task_id, atcb2);
-
- /* print the name of the task */
-- if (atcb2.image.P_ARRAY != NULL)
-- {
-- READ_MEMORY ((CORE_ADDR) EXTRACT_ADDRESS (atcb2.image.P_BOUNDS),
-- bounds);
-- bounds[1] = EXTRACT_INT (bounds[1]);
-- read_memory ((CORE_ADDR) EXTRACT_ADDRESS (atcb2.image.P_ARRAY),
-- (char *) &image, bounds[1]);
-- printf_filtered (" (%.*s)\n", bounds[1], image);
-- }
-+ if (pt2->atcb.image_len != 0)
-+ printf_filtered (" (%.*s)\n", pt2->atcb.image_len, pt2->atcb.image);
- else
- printf_filtered ("\n");
- }
-@@ -370,20 +1114,13 @@ info_task (char *arg, int from_tty)
- printf_filtered ("No parent\n");
-
- /* print the base priority of the task */
-- printf_filtered ("Base Priority: %d\n", EXTRACT_INT (atcb.priority));
-+ printf_filtered ("Base Priority: %d\n", pt->atcb.priority);
-
- /* print the current state of the task */
-
- /* check if this task is accepting a rendezvous */
-- if (atcb.call == NULL)
-- caller = NULL;
-- else
-- {
-- READ_MEMORY ((CORE_ADDR) EXTRACT_ADDRESS (atcb.call), call);
-- caller = EXTRACT_ADDRESS (call.self);
-- }
--
-- if (caller != NULL)
-+ caller = read_caller (pt->atcb.call);
-+ if (caller != 0)
- {
- num = get_entry_number (caller);
- printf_filtered ("Accepting rendezvous with %d", num);
-@@ -391,164 +1128,46 @@ info_task (char *arg, int from_tty)
- if (num != 0)
- {
- pt2 = get_entry_vptr (num);
-- READ_MEMORY ((CORE_ADDR) pt2->task_id, atcb2);
-
- /* print the name of the task */
-- if (atcb2.image.P_ARRAY != NULL)
-- {
-- READ_MEMORY ((CORE_ADDR) EXTRACT_ADDRESS (atcb2.image.P_BOUNDS),
-- bounds);
-- bounds[1] = EXTRACT_INT (bounds[1]);
-- read_memory ((CORE_ADDR) EXTRACT_ADDRESS (atcb2.image.P_ARRAY),
-- (char *) &image, bounds[1]);
-- printf_filtered (" (%.*s)\n", bounds[1], image);
-- }
-+ if (pt2->atcb.image_len != 0) {
-+ printf_filtered (" (%.*s)\n", pt2->atcb.image_len, pt2->atcb.image);
-+ }
- else
- printf_filtered ("\n");
- }
- else
-- printf_filtered ("\n");
-+ printf_filtered ("\n");
- }
- else
-- printf_filtered ("State: %s\n", ada_long_task_states[atcb.state]);
--}
--
--#if 0
--
--/* A useful function that shows the alignment of all the fields in the
-- tasks_fields structure
-- */
--
--print_align (void)
--{
-- struct task_fields tf;
-- void *tf_base = &(tf);
-- void *tf_state = &(tf.state);
-- void *tf_entry_num = &(tf.entry_num);
-- void *tf_parent = &(tf.parent);
-- void *tf_priority = &(tf.priority);
-- void *tf_current_priority = &(tf.current_priority);
-- void *tf_image = &(tf.image);
-- void *tf_call = &(tf.call);
-- void *tf_thread = &(tf.thread);
-- void *tf_lwp = &(tf.lwp);
-- printf_filtered ("\n");
-- printf_filtered ("(tf_base = 0x%x)\n", tf_base);
-- printf_filtered ("task_fields.entry_num at %3d (0x%x)\n",
-- tf_entry_num - tf_base, tf_entry_num);
-- printf_filtered ("task_fields.state at %3d (0x%x)\n",
-- tf_state - tf_base, tf_state);
-- printf_filtered ("task_fields.parent at %3d (0x%x)\n",
-- tf_parent - tf_base, tf_parent);
-- printf_filtered ("task_fields.priority at %3d (0x%x)\n",
-- tf_priority - tf_base, tf_priority);
-- printf_filtered ("task_fields.current_priority at %3d (0x%x)\n",
-- tf_current_priority - tf_base, tf_current_priority);
-- printf_filtered ("task_fields.image at %3d (0x%x)\n",
-- tf_image - tf_base, tf_image);
-- printf_filtered ("task_fields.call at %3d (0x%x)\n",
-- tf_call - tf_base, tf_call);
-- printf_filtered ("task_fields.thread at %3d (0x%x)\n",
-- tf_thread - tf_base, tf_thread);
-- printf_filtered ("task_fields.lwp at %3d (0x%x)\n",
-- tf_lwp - tf_base, tf_lwp);
-- printf_filtered ("\n");
--}
-+ printf_filtered ("State: %s\n", long_task_states[pt->atcb.state]);
- #endif
-+}
-
- /* Print information about currently known tasks */
-
- static void
- info_tasks (char *arg, int from_tty)
- {
-- struct value *val;
-- int i, task_number, state;
-- void *temp_task, *temp_tasks[MAX_NUMBER_OF_KNOWN_TASKS];
-+#ifdef GNAT_GDB
- struct task_entry *pt;
-- void *self_id, *caller, *thread_id = NULL;
-- struct task_fields atcb;
-- struct entry_call call;
-- int bounds[2];
-- char image[256];
-+ CORE_ADDR caller;
-+ long thread_id = 0L;
- int size;
- char car;
-+ ptid_t current_ptid;
-
- #if defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET)
- pthreadTeb_t thr;
- gdb_gregset_t regs;
- #endif
-
-- static struct symbol *sym;
-- static struct minimal_symbol *msym;
-- static void *known_tasks_addr = NULL;
--
-- int init_only = gdbtk_task_initialization;
-- gdbtk_task_initialization = 0;
--
-- task_number = 0;
--
-- if (PIDGET (inferior_ptid) == 0)
-- {
-- printf_filtered ("The program is not being run under gdb. ");
-- printf_filtered ("Use 'run' or 'attach' first.\n");
-- return;
-- }
--
-- if (ada__tasks_check_symbol_table)
-- {
-- thread_support = 0;
--#if (defined(__alpha__) && defined(__osf__) & !defined(VXWORKS_TARGET)) || \
-- defined (_AIX)
-- thread_support = 1;
--#endif
--
-- msym = lookup_minimal_symbol (KNOWN_TASKS_NAME, NULL, NULL);
-- if (msym != NULL)
-- known_tasks_addr = (void *) SYMBOL_VALUE_ADDRESS (msym);
-- else
--#ifndef VXWORKS_TARGET
-- return;
--#else
-- {
-- if (target_lookup_symbol (KNOWN_TASKS_NAME, &known_tasks_addr) != 0)
-- return;
-- }
--#endif
--
-- ada__tasks_check_symbol_table = 0;
-- }
--
-- if (known_tasks_addr == NULL)
-- return;
-+ current_ptid = inferior_ptid;
-
- #if !((defined(sun) && defined(__SVR4)) || defined(VXWORKS_TARGET) || defined(__WIN32__) || defined (hpux))
- if (thread_support)
- #endif
-- thread_id = GET_CURRENT_THREAD ();
--
-- /* then we get a list of tasks created */
--
-- init_task_list ();
--
-- READ_MEMORY ((CORE_ADDR) known_tasks_addr, temp_tasks);
--
-- for (i = 0; i < MAX_NUMBER_OF_KNOWN_TASKS; i++)
-- {
-- temp_task = EXTRACT_ADDRESS (temp_tasks[i]);
--
-- if (temp_task != NULL)
-- {
-- task_number = get_entry_number (temp_task);
-- if (task_number == 0)
-- task_number = add_task_entry (temp_task, i);
-- }
-- }
--
-- /* Return without printing anything if this function was called in
-- order to init GDBTK tasking. */
--
-- if (init_only)
-- return;
-+ thread_id = GET_CURRENT_THREAD (inferior_ptid);
-
- /* print the header */
-
-@@ -563,255 +1182,301 @@ info_tasks (char *arg, int from_tty)
- pt = task_list;
- while (pt)
- {
-- temp_task = pt->task_id;
--
-- /* read the atcb in the inferior */
-- READ_MEMORY ((CORE_ADDR) temp_task, atcb);
--
-- /* store the thread id for future use */
-- pt->thread = EXTRACT_ADDRESS (atcb.thread);
--
--#if defined (linux)
-- pt->lwp = (void *) THREAD_TO_PID (atcb.thread, 0);
--#else
-- pt->lwp = EXTRACT_ADDRESS (atcb.lwp);
--#endif
--
- /* print a star if this task is the current one */
- if (thread_id)
- #if defined (__WIN32__) || defined (SGI) || defined (hpux)
-- printf_filtered (pt->lwp == thread_id ? "*" : " ");
-+ printf_filtered
-+ (task_ptid_get_lwp (pt->task_ptid) == thread_id ? "*" : " ");
- #else
-- printf_filtered (pt->thread == thread_id ? "*" : " ");
-+ printf_filtered
-+ (task_ptid_get_thread_id (pt->task_ptid) == thread_id ? "*" : " ");
- #endif
-
- /* print the gdb task id */
- printf_filtered ("%3d", pt->task_num);
-
- /* print the Ada task id */
--#ifndef VXWORKS_TARGET
-- printf_filtered (" %9lx", (long) temp_task);
--#else
--#ifdef TARGET_64
-- printf_filtered (" %#9lx", (unsigned long) pt->thread & 0x3ffffffffff);
--#else
-- printf_filtered (" %#9lx", (long) pt->thread);
--#endif
--#endif
-+ printf_filtered (" %9lx", (long) pt->task_id);
-
- /* print the parent gdb task id */
-- printf_filtered
-- (" %4d", get_entry_number (EXTRACT_ADDRESS (atcb.parent)));
-+ printf_filtered (" %4d", get_entry_number (pt->atcb.parent));
-
- /* print the base priority of the task */
-- printf_filtered (" %3d", EXTRACT_INT (atcb.priority));
-+ printf_filtered (" %3d", pt->atcb.priority);
-
- #if defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET)
-- if (pt->task_num == 1 || atcb.state == Terminated)
-- {
-- printf_filtered (" Unknown");
-- goto next;
-- }
--
-- read_memory ((CORE_ADDR) atcb.thread, &thr, sizeof (thr));
-- current_thread = atcb.thread;
-+ if (pt->task_num == 1 || pt->atcb.state == Terminated)
-+ {
-+ printf_filtered (" Unknown");
-+ goto next;
-+ }
-+
-+ READ_MEMORY (pt->atcb.thread, thr);
-+ switch_to_thread (task_ptid_get_ptid (pt->task_ptid));
-+ /* ??? Brobecker 2003-03-13: Not sure what the next line is used for.
-+ And even if useful, it should probably be replaced by call to
-+ task_ptid_get_thread_id. */
-+ current_thread = task_ptid_get_tid (pt->task_ptid);
- regs.regs[SP_REGNUM] = 0;
- if (dec_thread_get_registers (®s, NULL) == 0)
-- {
-- pt->stack_per = (100 * ((long) thr.__stack_base -
-- regs.regs[SP_REGNUM])) / thr.__stack_size;
-- /* if the thread is terminated but still there, the
-- stack_base/size values are erroneous. Try to patch it */
-- if (pt->stack_per < 0 || pt->stack_per > 100)
-- pt->stack_per = 0;
-- }
-+ {
-+ pt->stack_per = (100 * ((long) thr.__stack_base -
-+ regs.regs[SP_REGNUM])) / thr.__stack_size;
-+ /* if the thread is terminated but still there, the
-+ stack_base/size values are erroneous. Try to patch it */
-+ if (pt->stack_per < 0 || pt->stack_per > 100)
-+ pt->stack_per = 0;
-+ }
-+ else
-+ {
-+ /* Set stack_per to an invalid value to signal that we did not
-+ manage to compute its value. */
-+ pt->stack_per = -1;
-+ }
-
- /* print information about stack space used in the thread */
- if (thr.__stack_size < 1024 * 1024)
-- {
-- size = thr.__stack_size / 1024;
-- car = 'K';
-- }
-+ {
-+ size = thr.__stack_size / 1024;
-+ car = 'K';
-+ }
- else if (thr.__stack_size < 1024 * 1024 * 1024)
-- {
-- size = thr.__stack_size / 1024 / 1024;
-- car = 'M';
-- }
-- else /* Who knows... */
-- {
-- size = thr.__stack_size / 1024 / 1024 / 1024;
-- car = 'G';
-- }
-- printf_filtered (" %4d%c %2d", size, car, pt->stack_per);
-+ {
-+ size = thr.__stack_size / 1024 / 1024;
-+ car = 'M';
-+ }
-+ else /* Who knows... */
-+ {
-+ size = thr.__stack_size / 1024 / 1024 / 1024;
-+ car = 'G';
-+ }
-+
-+ /* print the stack usage in percent, if available. */
-+ if (pt->stack_per != -1)
-+ printf_filtered (" %4d%c %2d", size, car, pt->stack_per);
-+ else
-+ {
-+ /* This error is not serious enough that we should raise
-+ an internal error, but print '???' to make it unambiguous
-+ that we failed to compute this value. */
-+ printf_filtered (" ???");
-+ }
-+
- next:
- #endif
-
- /* print the current state of the task */
-
- /* check if this task is accepting a rendezvous */
-- if (atcb.call == NULL)
-- caller = NULL;
-- else
-- {
-- READ_MEMORY ((CORE_ADDR) EXTRACT_ADDRESS (atcb.call), call);
-- caller = EXTRACT_ADDRESS (call.self);
-- }
--
-- if (caller != NULL)
-- printf_filtered (" Accepting RV with %-4d",
-- get_entry_number (caller));
-+ caller = read_caller (pt->atcb.call);
-+ if (caller != 0)
-+ printf_filtered (" Accepting RV with %-4d",
-+ get_entry_number (caller));
- else
-- {
-- state = atcb.state;
-+ {
- #if defined (__WIN32__) || defined (SGI) || defined (hpux)
-- if (state == Runnable && (thread_id && pt->lwp == thread_id))
-+ if (pt->atcb.state == Runnable
-+ && (thread_id
-+ && task_ptid_get_lwp (pt->task_ptid) == thread_id))
- #else
-- if (state == Runnable && (thread_id && pt->thread == thread_id))
--#endif
-- /* Replace "Runnable" by "Running" if this is the current task */
-- printf_filtered (" %-22s", "Running");
-- else
-- printf_filtered (" %-22s", ada_task_states[state]);
-- }
-+ if (pt->atcb.state == Runnable
-+ && (thread_id
-+ && task_ptid_get_thread_id (pt->task_ptid) == thread_id))
-+#endif
-+ /* Replace "Runnable" by "Running" if this is the current task */
-+ printf_filtered (" %-22s", "Running");
-+ else
-+ printf_filtered (" %-22s", task_states[pt->atcb.state]);
-+ }
-
- /* finally, print the name of the task */
-- if (atcb.image.P_ARRAY != NULL)
-- {
-- READ_MEMORY ((CORE_ADDR) EXTRACT_ADDRESS (atcb.image.P_BOUNDS),
-- bounds);
-- bounds[1] = EXTRACT_INT (bounds[1]);
-- read_memory ((CORE_ADDR) EXTRACT_ADDRESS (atcb.image.P_ARRAY),
-- (char *) &image, bounds[1]);
-- printf_filtered (" %.*s\n", bounds[1], image);
-- }
-+ if (pt->atcb.image_len != 0) {
-+ printf_filtered (" %.*s\n", pt->atcb.image_len, pt->atcb.image);
-+ }
- else
- printf_filtered (" <no name>\n");
-
- pt = pt->next_task;
- }
--}
--
--/* Task list initialization for GDB-Tk. We basically use info_tasks()
-- to initialize our variables, but abort that function before we
-- actually print anything. */
--
--int
--gdbtk_tcl_tasks_initialize (void)
--{
-- gdbtk_task_initialization = 1;
-- info_tasks ("", gdb_stdout);
--
-- return (task_list != NULL);
-+ if (!ptid_equal (inferior_ptid, current_ptid))
-+ switch_to_thread (current_ptid);
-+#endif
- }
-
- static void
- info_tasks_command (char *arg, int from_tty)
- {
-+ const int task_list_built = build_task_list ();
-+
-+ if (!task_list_built)
-+ return;
-+
- if (arg == NULL || *arg == '\000')
- info_tasks (arg, from_tty);
- else
- info_task (arg, from_tty);
- }
-
--/* Switch from one thread to another. */
-+/* Switch to task indicated by NEW_TASK. Return 0 iff successful. */
-
--static void
--switch_to_thread (ptid_t ptid)
-+static int
-+switch_to_task (struct task_entry *new_task)
- {
-- if (ptid_equal (ptid, inferior_ptid))
-- return;
--
-- inferior_ptid = ptid;
-- flush_cached_frames ();
-- registers_changed ();
-- stop_pc = read_pc ();
-- select_frame (get_current_frame ());
--}
-+#ifdef GNAT_GDB
-+ /* Raise an error if task-switching is currently not allowed. */
-+ if (!THREAD_SWITCH_ALLOWED ())
-+ error ("Task switching is currently not allowed.");
-+
-+ if (!task_is_alive (new_task->atcb.state))
-+ error ("Can not switch to task %d: Task is no longer running",
-+ new_task->task_num);
-
--/* Switch to a specified task. */
-+ current_task = new_task->task_num;
-+ current_thread = task_ptid_get_thread_id (new_task->task_ptid);
-
--static int
--task_switch (void *tid, void *lwpid)
--{
-- int res = 0, pid;
-+ if (current_task_id == -1)
-+ {
-+ SAVE_TASK_REGISTERS (new_task);
-+ current_task_id = ada_get_current_task (inferior_ptid);
-+ }
-
-- if (thread_support)
-+ if (SPECIAL_THREAD_SUPPORT_ACTIVE ())
- {
-+ /* FIXME: Integrate with switch_to_thread */
-+ int ret_code;
- flush_cached_frames ();
--
-- if (current_task != current_task_id)
-- {
-- res = THREAD_FETCH_REGISTERS ();
-- }
-+ registers_changed ();
-+ if (current_task == current_task_id)
-+ {
-+ RESTORE_TASK_REGISTERS (new_task);
-+ ret_code = 0;
-+ }
- else
-- {
--#if (defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET))
-- supply_gregset (&gregset_saved);
-- supply_fpregset (&fpregset_saved);
--#endif
-- }
--
-- if (res == 0)
-- stop_pc = read_pc ();
-+ ret_code = THREAD_FETCH_REGISTERS ();
-+ if (ret_code == 0)
-+ stop_pc = read_pc ();
- select_frame (get_current_frame ());
-- return res;
-+ return ret_code;
- }
--
-+ else if (task_ptid_get_pid (new_task->task_ptid) != 0) /* ?? */
-+ {
-+ switch_to_thread (task_ptid_get_ptid (new_task->task_ptid));
-+ return 0;
-+ }
-+#endif
- return -1;
- }
-
-+/* Print a message telling the user id of the current task.
-+ Print an error message if the application does not appear to
-+ be using any Ada task. */
-+
- static void
--task_command (char *tidstr, int from_tty)
-+display_current_task_id (void)
- {
-- int num;
-- struct task_entry *e;
-+ const int current_task = ada_get_current_task (inferior_ptid);
-+
-+ if (current_task == -1)
-+ printf_filtered ("[Current task is unknown]\n");
-+ else
-+ printf_filtered ("[Current task is %d]\n", current_task);
-+}
-
-- if (!tidstr)
-- error ("Please specify a task ID. Use the \"info tasks\" command to\n"
-- "see the IDs of currently known tasks.");
-+/* Parse and evaluate TIDSTR into a task id, and try to switch to
-+ that task. Print an error message if the task switch failed. */
-
-- num = atoi (tidstr);
-- e = get_entry_vptr (num);
-+static void
-+task_command_1 (char *tidstr, int from_tty)
-+{
-+ const int num = value_as_long (parse_and_eval (tidstr));
-+ struct task_entry *e = get_entry_vptr (num);
-
- if (e == NULL)
- error ("Task ID %d not known. Use the \"info tasks\" command to\n"
-- "see the IDs of currently known tasks.", num);
--
-- if (current_task_id == -1)
-- {
--#if (defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET))
-- fill_gregset (&gregset_saved, -1);
-- fill_fpregset (&fpregset_saved, -1);
--#endif
-- current_task_id = get_current_task ();
-- }
-+ "see the IDs of currently known tasks", num);
-
-- current_task = num;
-- current_task_index = e->known_tasks_index;
-- current_thread = e->thread;
-- current_lwp = e->lwp;
-- if (task_switch (e->thread, e->lwp) == 0)
-+ if (switch_to_task (e) == 0)
- {
-- /* FIXME: find_printable_frame should be defined in frame.h, and
-- implemented in ada-lang.c */
-+ ada_find_printable_frame (get_selected_frame ());
- printf_filtered ("[Switching to task %d]\n", num);
-- print_stack_frame (get_selected_frame (), 1, SRC_AND_LOC);
-+ print_stack_frame (get_selected_frame (),
-+ frame_relative_level (get_selected_frame ()), 1);
- }
- else
- printf_filtered ("Unable to switch to task %d\n", num);
- }
-
-+/* Switch to task indicated in TIDSTR. Simply print the current task
-+ if TIDSTR is empty or NULL. */
-+
-+static void
-+task_command (char *tidstr, int from_tty)
-+{
-+ const int task_list_built = build_task_list ();
-+
-+ if (!task_list_built)
-+ return;
-+
-+ if (tidstr == NULL || tidstr[0] == '\0')
-+ display_current_task_id ();
-+ else
-+ task_command_1 (tidstr, from_tty);
-+}
-+
-+#if defined (__fsu__) || (defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET))
-+/* Restore saved registers if there was a task switch. */
-+void
-+ada_reset_thread_registers (void)
-+{
-+ if (current_task_id != -1 && SPECIAL_THREAD_SUPPORT_ACTIVE ())
-+ {
-+ supply_gregset (&gregset_saved);
-+ supply_fpregset (&fpregset_saved);
-+ reinit_frame_cache ();
-+ stop_pc = read_pc ();
-+ }
-+ current_task_id = -1;
-+}
-+#else
-+void
-+ada_reset_thread_registers (void)
-+{
-+}
-+#endif
-+
-+/* The 'normal_stop' observer notification callback. */
-+
-+static void
-+normal_stop_notification (void)
-+{
-+ /* The inferior has been resumed, and just stopped. This means that
-+ our task_list needs to be recomputed before it can be used again. */
-+ stale_task_list_p = 1;
-+}
-+
-+/* Attach all the observers needed by the ada-tasks module. */
-+
-+static void
-+ada_tasks_attach_observers (void)
-+{
-+ observer_attach_normal_stop (&normal_stop_notification);
-+}
-+
- void
- _initialize_tasks (void)
- {
-- static struct cmd_list_element *task_cmd_list = NULL;
-+#ifdef GNAT_GDB
- extern struct cmd_list_element *cmdlist;
-
-+ ada_tasks_attach_observers ();
-+
- add_info ("tasks", info_tasks_command,
-- "Without argument: list all known Ada tasks, with status information.\n"
-- "info tasks n: print detailed information of task n.\n");
-+ "Without argument: list all known Ada tasks, with status information.\n"
-+ "info tasks n: print detailed information of task n.");
-
-- add_prefix_cmd ("task", class_run, task_command,
-- "Use this command to switch between tasks.\n\
-- The new task ID must be currently known.", &task_cmd_list, "task ", 1, &cmdlist);
-+ add_cmd ("task", class_run, task_command,
-+ "Without argument: print the current task ID.\n"
-+ "task n: Use this command to switch to task n.",
-+ &cmdlist);
-+#endif
- }
-Index: gdb/ada-typeprint.c
-===================================================================
-RCS file: /cvs/src/src/gdb/ada-typeprint.c,v
-retrieving revision 1.6
-diff -u -p -r1.6 ada-typeprint.c
---- gdb/ada-typeprint.c 20 Feb 2003 17:17:23 -0000 1.6
-+++ gdb/ada-typeprint.c 2 Jun 2004 09:52:56 -0000
-@@ -1,6 +1,6 @@
- /* Support for printing Ada types for GDB, the GNU debugger.
-- Copyright 1986, 1988, 1989, 1991, 1997, 2003 Free Software
-- Foundation, Inc.
-+ Copyright 1986, 1988, 1989, 1991, 1997, 1998, 1999, 2000,
-+ 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
-
- This file is part of GDB.
-
-@@ -63,11 +63,11 @@ static void print_range_type_named (char
- static char *name_buffer;
- static int name_buffer_len;
-
--/* The (demangled) Ada name of TYPE. This value persists until the
-- next call. */
-+/* The (decoded) Ada name of TYPE. This value persists until the
-+ next call. */
-
- static char *
--demangled_type_name (struct type *type)
-+decoded_type_name (struct type *type)
- {
- if (ada_type_name (type) == NULL)
- return NULL;
-@@ -116,9 +116,9 @@ demangled_type_name (struct type *type)
- }
-
-
--/* Print a description of a type in the format of a
-+/* Print a description of a type in the format of a
- typedef for the current language.
-- NEW is the new name for a type TYPE. */
-+ NEW is the new name for a type TYPE. */
-
- void
- ada_typedef_print (struct type *type, struct symbol *new,
-@@ -130,7 +130,7 @@ ada_typedef_print (struct type *type, st
- type_print (type, "", stream, 1);
- }
-
--/* Print range type TYPE on STREAM. */
-+/* Print range type TYPE on STREAM. */
-
- static void
- print_range (struct type *type, struct ui_file *stream)
-@@ -155,9 +155,9 @@ print_range (struct type *type, struct u
-
- if (TYPE_NFIELDS (type) < 2)
- {
-- /* A range needs at least 2 bounds to be printed. If there are less
-+ /* A range needs at least 2 bounds to be printed. If there are less
- than 2, just print the type name instead of the range itself.
-- This check handles cases such as characters, for example.
-+ This check handles cases such as characters, for example.
-
- Note that if the name is not defined, then we don't print anything.
- */
-@@ -180,7 +180,7 @@ print_range (struct type *type, struct u
- }
-
- /* Print the number or discriminant bound at BOUNDS+*N on STREAM, and
-- set *N past the bound and its delimiter, if any. */
-+ set *N past the bound and its delimiter, if any. */
-
- static void
- print_range_bound (struct type *type, char *bounds, int *n,
-@@ -189,6 +189,19 @@ print_range_bound (struct type *type, ch
- LONGEST B;
- if (ada_scan_number (bounds, *n, &B, n))
- {
-+ /* STABS decodes all range types which bounds are 0 .. -1 as
-+ unsigned integers (ie. the type code is TYPE_CODE_INT, not
-+ TYPE_CODE_RANGE). Unfortunately, ada_print_scalar() relies
-+ on the unsigned flag to determine whether the bound should
-+ be printed as a signed or an unsigned value. This causes
-+ the upper bound of the 0 .. -1 range types to be printed as
-+ a very large unsigned number instead of -1.
-+ To workaround this stabs deficiency, we replace the TYPE by
-+ builtin_type_long when we detect that the bound is negative,
-+ and the type is a TYPE_CODE_INT. The bound is negative when
-+ 'm' is the last character of the number scanned in BOUNDS. */
-+ if (bounds[*n - 1] == 'm' && TYPE_CODE (type) == TYPE_CODE_INT)
-+ type = builtin_type_long;
- ada_print_scalar (type, B, stream);
- if (bounds[*n] == '_')
- *n += 2;
-@@ -213,7 +226,7 @@ print_range_bound (struct type *type, ch
-
- /* Assuming NAME[0 .. NAME_LEN-1] is the name of a range type, print
- the value (if found) of the bound indicated by SUFFIX ("___L" or
-- "___U") according to the ___XD conventions. */
-+ "___U") according to the ___XD conventions. */
-
- static void
- print_dynamic_range_bound (struct type *type, const char *name, int name_len,
-@@ -228,21 +241,20 @@ print_dynamic_range_bound (struct type *
- strncpy (name_buf, name, name_len);
- strcpy (name_buf + name_len, suffix);
-
-- B = get_int_var_value (name_buf, 0, &OK);
-+ B = get_int_var_value (name_buf, &OK);
- if (OK)
- ada_print_scalar (type, B, stream);
- else
- fprintf_filtered (stream, "?");
- }
-
--/* Print the range type named NAME. */
-+/* Print the range type named NAME. */
-
- static void
- print_range_type_named (char *name, struct ui_file *stream)
- {
- struct type *raw_type = ada_find_any_type (name);
- struct type *base_type;
-- LONGEST low, high;
- char *subtype_info;
-
- if (raw_type == NULL)
-@@ -269,24 +281,24 @@ print_range_type_named (char *name, stru
-
- if (*subtype_info == 'L')
- {
-- print_range_bound (raw_type, bounds_str, &n, stream);
-+ print_range_bound (base_type, bounds_str, &n, stream);
- subtype_info += 1;
- }
- else
-- print_dynamic_range_bound (raw_type, name, prefix_len, "___L",
-+ print_dynamic_range_bound (base_type, name, prefix_len, "___L",
- stream);
-
- fprintf_filtered (stream, " .. ");
-
- if (*subtype_info == 'U')
-- print_range_bound (raw_type, bounds_str, &n, stream);
-+ print_range_bound (base_type, bounds_str, &n, stream);
- else
-- print_dynamic_range_bound (raw_type, name, prefix_len, "___U",
-+ print_dynamic_range_bound (base_type, name, prefix_len, "___U",
- stream);
- }
- }
-
--/* Print enumerated type TYPE on STREAM. */
-+/* Print enumerated type TYPE on STREAM. */
-
- static void
- print_enum_type (struct type *type, struct ui_file *stream)
-@@ -315,7 +327,7 @@ print_enum_type (struct type *type, stru
- fprintf_filtered (stream, ")");
- }
-
--/* Print representation of Ada fixed-point type TYPE on STREAM. */
-+/* Print representation of Ada fixed-point type TYPE on STREAM. */
-
- static void
- print_fixed_point_type (struct type *type, struct ui_file *stream)
-@@ -333,7 +345,7 @@ print_fixed_point_type (struct type *typ
- }
- }
-
--/* Print representation of special VAX floating-point type TYPE on STREAM. */
-+/* Print representation of special VAX floating-point type TYPE on STREAM. */
-
- static void
- print_vax_floating_point_type (struct type *type, struct ui_file *stream)
-@@ -342,10 +354,10 @@ print_vax_floating_point_type (struct ty
- ada_vax_float_type_suffix (type));
- }
-
--/* Print simple (constrained) array type TYPE on STREAM. LEVEL is the
-- recursion (indentation) level, in case the element type itself has
-+/* Print simple (constrained) array type TYPE on STREAM. LEVEL is the
-+ recursion (indentation) level, in case the element type itself has
- nested structure, and SHOW is the number of levels of internal
-- structure to show (see ada_print_type). */
-+ structure to show (see ada_print_type). */
-
- static void
- print_array_type (struct type *type, struct ui_file *stream, int show,
-@@ -364,7 +376,12 @@ print_array_type (struct type *type, str
- {
- if (ada_is_packed_array_type (type))
- type = ada_coerce_to_simple_array_type (type);
-- if (ada_is_simple_array (type))
-+ if (type == NULL)
-+ {
-+ fprintf_filtered (stream, "<undecipherable array type>");
-+ return;
-+ }
-+ if (ada_is_simple_array_type (type))
- {
- struct type *range_desc_type =
- ada_find_parallel_type (type, "___XA");
-@@ -417,7 +434,7 @@ print_array_type (struct type *type, str
- }
-
- /* Print the choices encoded by field FIELD_NUM of variant-part TYPE on
-- STREAM, assuming the VAL_TYPE is the type of the values. */
-+ STREAM, assuming the VAL_TYPE is the type of the values. */
-
- static void
- print_choices (struct type *type, int field_num, struct ui_file *stream,
-@@ -429,7 +446,7 @@ print_choices (struct type *type, int fi
-
- have_output = 0;
-
-- /* Skip over leading 'V': NOTE soon to be obsolete. */
-+ /* Skip over leading 'V': NOTE soon to be obsolete. */
- if (name[0] == 'V')
- {
- if (!ada_scan_number (name, 1, NULL, &p))
-@@ -486,14 +503,14 @@ Huh:
-
- }
-
--/* Assuming that field FIELD_NUM of TYPE is a VARIANTS field whose
-- discriminant is contained in OUTER_TYPE, print its variants on STREAM.
-+/* Assuming that field FIELD_NUM of TYPE is a VARIANTS field whose
-+ discriminant is contained in OUTER_TYPE, print its variants on STREAM.
- LEVEL is the recursion
- (indentation) level, in case any of the fields themselves have
- nested structure, and SHOW is the number of levels of internal structure
-- to show (see ada_print_type). For this purpose, fields nested in a
-+ to show (see ada_print_type). For this purpose, fields nested in a
- variant part are taken to be at the same level as the fields
-- immediately outside the variant part. */
-+ immediately outside the variant part. */
-
- static void
- print_variant_clauses (struct type *type, int field_num,
-@@ -501,7 +518,7 @@ print_variant_clauses (struct type *type
- int show, int level)
- {
- int i;
-- struct type *var_type;
-+ struct type *var_type, *par_type;
- struct type *discr_type;
-
- var_type = TYPE_FIELD_TYPE (type, field_num);
-@@ -510,14 +527,14 @@ print_variant_clauses (struct type *type
- if (TYPE_CODE (var_type) == TYPE_CODE_PTR)
- {
- var_type = TYPE_TARGET_TYPE (var_type);
-- if (TYPE_FLAGS (var_type) & TYPE_FLAG_STUB)
-- {
-- var_type = ada_find_parallel_type (var_type, "___XVU");
-- if (var_type == NULL)
-- return;
-- }
-+ if (var_type == NULL || TYPE_CODE (var_type) != TYPE_CODE_UNION)
-+ return;
- }
-
-+ par_type = ada_find_parallel_type (var_type, "___XVU");
-+ if (par_type != NULL)
-+ var_type = par_type;
-+
- for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
- {
- fprintf_filtered (stream, "\n%*swhen ", level + 4, "");
-@@ -529,13 +546,13 @@ print_variant_clauses (struct type *type
- }
- }
-
--/* Assuming that field FIELD_NUM of TYPE is a variant part whose
-+/* Assuming that field FIELD_NUM of TYPE is a variant part whose
- discriminants are contained in OUTER_TYPE, print a description of it
-- on STREAM. LEVEL is the recursion (indentation) level, in case any of
-- the fields themselves have nested structure, and SHOW is the number of
-- levels of internal structure to show (see ada_print_type). For this
-- purpose, fields nested in a variant part are taken to be at the same
-- level as the fields immediately outside the variant part. */
-+ on STREAM. LEVEL is the recursion (indentation) level, in case any of
-+ the fields themselves have nested structure, and SHOW is the number of
-+ levels of internal structure to show (see ada_print_type). For this
-+ purpose, fields nested in a variant part are taken to be at the same
-+ level as the fields immediately outside the variant part. */
-
- static void
- print_variant_part (struct type *type, int field_num, struct type *outer_type,
-@@ -549,14 +566,14 @@ print_variant_part (struct type *type, i
- fprintf_filtered (stream, "\n%*send case;", level + 4, "");
- }
-
--/* Print a description on STREAM of the fields in record type TYPE, whose
-- discriminants are in OUTER_TYPE. LEVEL is the recursion (indentation)
-- level, in case any of the fields themselves have nested structure,
-- and SHOW is the number of levels of internal structure to show
-- (see ada_print_type). Does not print parent type information of TYPE.
-- Returns 0 if no fields printed, -1 for an incomplete type, else > 0.
-+/* Print a description on STREAM of the fields in record type TYPE, whose
-+ discriminants are in OUTER_TYPE. LEVEL is the recursion (indentation)
-+ level, in case any of the fields themselves have nested structure,
-+ and SHOW is the number of levels of internal structure to show
-+ (see ada_print_type). Does not print parent type information of TYPE.
-+ Returns 0 if no fields printed, -1 for an incomplete type, else > 0.
- Prints each field beginning on a new line, but does not put a new line at
-- end. */
-+ end. */
-
- static int
- print_record_field_types (struct type *type, struct type *outer_type,
-@@ -598,9 +615,9 @@ print_record_field_types (struct type *t
- return flds;
- }
-
--/* Print record type TYPE on STREAM. LEVEL is the recursion (indentation)
-- level, in case the element type itself has nested structure, and SHOW is
-- the number of levels of internal structure to show (see ada_print_type). */
-+/* Print record type TYPE on STREAM. LEVEL is the recursion (indentation)
-+ level, in case the element type itself has nested structure, and SHOW is
-+ the number of levels of internal structure to show (see ada_print_type). */
-
- static void
- print_record_type (struct type *type0, struct ui_file *stream, int show,
-@@ -609,19 +626,15 @@ print_record_type (struct type *type0, s
- struct type *parent_type;
- struct type *type;
-
-- type = type0;
-- if (TYPE_FLAGS (type) & TYPE_FLAG_STUB)
-- {
-- struct type *type1 = ada_find_parallel_type (type, "___XVE");
-- if (type1 != NULL)
-- type = type1;
-- }
-+ type = ada_find_parallel_type (type0, "___XVE");
-+ if (type == NULL)
-+ type = type0;
-
- parent_type = ada_parent_type (type);
- if (ada_type_name (parent_type) != NULL)
- fprintf_filtered (stream, "new %s with ",
-- demangled_type_name (parent_type));
-- else if (parent_type == NULL && ada_is_tagged_type (type))
-+ decoded_type_name (parent_type));
-+ else if (parent_type == NULL && ada_is_tagged_type (type, 0))
- fprintf_filtered (stream, "tagged ");
-
- fprintf_filtered (stream, "record");
-@@ -648,9 +661,9 @@ print_record_type (struct type *type0, s
- }
-
- /* Print the unchecked union type TYPE in something resembling Ada
-- format on STREAM. LEVEL is the recursion (indentation) level
-+ format on STREAM. LEVEL is the recursion (indentation) level
- in case the element type itself has nested structure, and SHOW is the
-- number of levels of internal structure to show (see ada_print_type). */
-+ number of levels of internal structure to show (see ada_print_type). */
- static void
- print_unchecked_union_type (struct type *type, struct ui_file *stream,
- int show, int level)
-@@ -685,7 +698,7 @@ print_unchecked_union_type (struct type
-
-
- /* Print function or procedure type TYPE on STREAM. Make it a header
-- for function or procedure NAME if NAME is not null. */
-+ for function or procedure NAME if NAME is not null. */
-
- static void
- print_func_type (struct type *type, struct ui_file *stream, char *name)
-@@ -728,23 +741,21 @@ print_func_type (struct type *type, stru
- Output goes to STREAM (via stdio).
- If VARSTRING is a non-empty string, print as an Ada variable/field
- declaration.
-- SHOW+1 is the maximum number of levels of internal type structure
-+ SHOW+1 is the maximum number of levels of internal type structure
- to show (this applies to record types, enumerated types, and
- array types).
- SHOW is the number of levels of internal type structure to show
-- when there is a type name for the SHOWth deepest level (0th is
-+ when there is a type name for the SHOWth deepest level (0th is
- outer level).
- When SHOW<0, no inner structure is shown.
-- LEVEL indicates level of recursion (for nested definitions). */
-+ LEVEL indicates level of recursion (for nested definitions). */
-
- void
- ada_print_type (struct type *type0, char *varstring, struct ui_file *stream,
- int show, int level)
- {
-- enum type_code code;
-- int demangled_args;
- struct type *type = ada_completed_type (ada_get_base_type (type0));
-- char *type_name = demangled_type_name (type);
-+ char *type_name = decoded_type_name (type);
- int is_var_decl = (varstring != NULL && varstring[0] != '\0');
-
- if (type == NULL)
-@@ -834,7 +845,7 @@ ada_print_type (struct type *type0, char
- print_enum_type (type, stream);
- break;
- case TYPE_CODE_STRUCT:
-- if (ada_is_array_descriptor (type))
-+ if (ada_is_array_descriptor_type (type))
- print_array_type (type, stream, show, level);
- else if (ada_is_bogus_array_descriptor (type))
- fprintf_filtered (stream,
-Index: gdb/ada-valprint.c
-===================================================================
-RCS file: /cvs/src/src/gdb/ada-valprint.c,v
-retrieving revision 1.9
-diff -u -p -r1.9 ada-valprint.c
---- gdb/ada-valprint.c 24 May 2003 03:21:42 -0000 1.9
-+++ gdb/ada-valprint.c 2 Jun 2004 09:52:57 -0000
-@@ -1,5 +1,6 @@
--/* Support for printing Ada values for GDB, the GNU debugger.
-- Copyright 1986, 1988, 1989, 1991, 1992, 1993, 1994, 1997, 2001
-+/* Support for printing Ada values for GDB, the GNU debugger.
-+ Copyright 1986, 1988, 1989, 1991, 1992, 1993, 1994, 1997, 2001,
-+ 2002, 2003, 2004.
- Free Software Foundation, Inc.
-
- This file is part of GDB.
-@@ -20,6 +21,7 @@ Foundation, Inc., 675 Mass Ave, Cambridg
-
- #include <ctype.h>
- #include "defs.h"
-+#include "gdb_string.h"
- #include "symtab.h"
- #include "gdbtypes.h"
- #include "expression.h"
-@@ -32,7 +34,7 @@ Foundation, Inc., 675 Mass Ave, Cambridg
- #include "c-lang.h"
- #include "infcall.h"
-
--/* Encapsulates arguments to ada_val_print. */
-+/* Encapsulates arguments to ada_val_print. */
- struct ada_val_print_args
- {
- struct type *type;
-@@ -46,6 +48,9 @@ struct ada_val_print_args
- enum val_prettyprint pretty;
- };
-
-+extern int inspect_it;
-+extern unsigned int repeat_count_threshold;
-+
- static void print_record (struct type *, char *, struct ui_file *, int,
- int, enum val_prettyprint);
-
-@@ -64,14 +69,15 @@ static void val_print_packed_array_eleme
-
- static void adjust_type_signedness (struct type *);
-
--static int ada_val_print_stub (void *args0);
-+static int ada_val_print_stub (PTR args0);
-
- static int ada_val_print_1 (struct type *, char *, int, CORE_ADDR,
- struct ui_file *, int, int, int,
- enum val_prettyprint);
-+static void ada_print_floating (char *, struct type *, struct ui_file *);
- \f
-
--/* Make TYPE unsigned if its range of values includes no negatives. */
-+/* Make TYPE unsigned if its range of values includes no negatives. */
- static void
- adjust_type_signedness (struct type *type)
- {
-@@ -82,8 +88,8 @@ adjust_type_signedness (struct type *typ
-
- /* Assuming TYPE is a simple array type, prints its lower bound on STREAM,
- if non-standard (i.e., other than 1 for numbers, other than lower bound
-- of index type for enumerated type). Returns 1 if something printed,
-- otherwise 0. */
-+ of index type for enumerated type). Returns 1 if something printed,
-+ otherwise 0. */
-
- static int
- print_optional_low_bound (struct ui_file *stream, struct type *type)
-@@ -127,8 +133,8 @@ print_optional_low_bound (struct ui_file
- /* Version of val_print_array_elements for GNAT-style packed arrays.
- Prints elements of packed array of type TYPE at bit offset
- BITOFFSET from VALADDR on STREAM. Formats according to FORMAT and
-- separates with commas. RECURSE is the recursion (nesting) level.
-- If PRETTY, uses "prettier" format. TYPE must have been decoded (as
-+ separates with commas. RECURSE is the recursion (nesting) level.
-+ If PRETTY, uses "prettier" format. TYPE must have been decoded (as
- by ada_coerce_to_simple_array). */
-
- static void
-@@ -142,11 +148,6 @@ val_print_packed_array_elements (struct
- unsigned len;
- struct type *elttype;
- unsigned eltlen;
-- /* Position of the array element we are examining to see
-- whether it is repeated. */
-- unsigned int rep1;
-- /* Number of repetitions we have detected so far. */
-- unsigned int reps;
- unsigned long bitsize = TYPE_FIELD_BITSIZE (type, 0);
- struct value *mark = value_mark ();
-
-@@ -252,7 +253,7 @@ printable_val_type (struct type *type, c
-
- /* Print the character C on STREAM as part of the contents of a literal
- string whose delimiter is QUOTER. TYPE_LEN is the length in bytes
-- (1 or 2) of the character. */
-+ (1 or 2) of the character. */
-
- void
- ada_emit_char (int c, struct ui_file *stream, int quoter, int type_len)
-@@ -274,7 +275,7 @@ ada_emit_char (int c, struct ui_file *st
- }
-
- /* Character #I of STRING, given that TYPE_LEN is the size in bytes (1
-- or 2) of a character. */
-+ or 2) of a character. */
-
- static int
- char_at (char *string, int i, int type_len)
-@@ -285,6 +286,58 @@ char_at (char *string, int i, int type_l
- return (int) extract_unsigned_integer (string + 2 * i, 2);
- }
-
-+/* Wrapper around memcpy to make it legal argument to ui_file_put */
-+static void
-+ui_memcpy (void *dest, const char *buffer, long len)
-+{
-+ memcpy (dest, buffer, (size_t) len);
-+ ((char *) dest)[len] = '\0';
-+}
-+
-+/* Print a floating-point value of type TYPE, pointed to in GDB by
-+ VALADDR, on STREAM. Use Ada formatting conventions: there must be
-+ a decimal point, and at least one digit before and after the
-+ point. We use GNAT format for NaNs and infinities. */
-+static void
-+ada_print_floating (char *valaddr, struct type *type, struct ui_file *stream)
-+{
-+ char buffer[64];
-+ char *s, *result;
-+ int len;
-+ struct ui_file *tmp_stream = mem_fileopen ();
-+ struct cleanup *cleanups = make_cleanup_ui_file_delete (tmp_stream);
-+
-+ print_floating (valaddr, type, tmp_stream);
-+ ui_file_put (tmp_stream, ui_memcpy, buffer);
-+ do_cleanups (cleanups);
-+
-+ result = buffer;
-+ len = strlen (result);
-+
-+ /* Modify for Ada rules. */
-+ if ((s = strstr (result, "inf")) != NULL
-+ || (s = strstr (result, "Inf")) != NULL
-+ || (s = strstr (result, "INF")) != NULL)
-+ strcpy (s, "Inf");
-+ else if ((s = strstr (result, "nan")) != NULL
-+ || (s = strstr (result, "NaN")) != NULL
-+ || (s = strstr (result, "Nan")) != NULL)
-+ {
-+ s[0] = s[2] = 'N';
-+ if (result[0] == '-')
-+ result += 1;
-+ }
-+ else if (strchr (result, '.') == NULL)
-+ {
-+ if ((s = strchr (result, 'e')) == NULL)
-+ fprintf_filtered (stream, "%s.0", result);
-+ else
-+ fprintf_filtered (stream, "%.*s.0%s", (int) (s-result), result, s);
-+ return;
-+ }
-+ fprintf_filtered (stream, "%s", result);
-+}
-+
- void
- ada_printchar (int c, struct ui_file *stream)
- {
-@@ -294,7 +347,7 @@ ada_printchar (int c, struct ui_file *st
- }
-
- /* [From print_type_scalar in typeprint.c]. Print VAL on STREAM in a
-- form appropriate for TYPE. */
-+ form appropriate for TYPE. */
-
- void
- ada_print_scalar (struct type *type, LONGEST val, struct ui_file *stream)
-@@ -463,7 +516,7 @@ printstr (struct ui_file *stream, char *
-
- void
- ada_printstr (struct ui_file *stream, char *string, unsigned int length,
-- int force_ellipses, int width)
-+ int width, int force_ellipses)
- {
- printstr (stream, string, length, force_ellipses, width);
- }
-@@ -471,7 +524,7 @@ ada_printstr (struct ui_file *stream, ch
-
- /* Print data of type TYPE located at VALADDR (within GDB), which came from
- the inferior at address ADDRESS, onto stdio stream STREAM according to
-- FORMAT (a letter as for the printf % codes or 0 for natural format).
-+ FORMAT (a letter as for the printf % codes or 0 for natural format).
- The data at VALADDR is in target byte order.
-
- If the data is printed as a string, returns the number of string characters
-@@ -508,9 +561,9 @@ ada_val_print (struct type *type, char *
- }
-
- /* Helper for ada_val_print; used as argument to catch_errors to
-- unmarshal the arguments to ada_val_print_1, which does the work. */
-+ unmarshal the arguments to ada_val_print_1, which does the work. */
- static int
--ada_val_print_stub (void * args0)
-+ada_val_print_stub (PTR args0)
- {
- struct ada_val_print_args *argsp = (struct ada_val_print_args *) args0;
- return ada_val_print_1 (argsp->type, argsp->valaddr0,
-@@ -520,7 +573,7 @@ ada_val_print_stub (void * args0)
- }
-
- /* See the comment on ada_val_print. This function differs in that it
-- * does not catch evaluation errors (leaving that to ada_val_print). */
-+ * does not catch evaluation errors (leaving that to ada_val_print). */
-
- static int
- ada_val_print_1 (struct type *type, char *valaddr0, int embedded_offset,
-@@ -532,12 +585,11 @@ ada_val_print_1 (struct type *type, char
- struct type *elttype;
- unsigned int eltlen;
- LONGEST val;
-- CORE_ADDR addr;
- char *valaddr = valaddr0 + embedded_offset;
-
- CHECK_TYPEDEF (type);
-
-- if (ada_is_array_descriptor (type) || ada_is_packed_array_type (type))
-+ if (ada_is_array_descriptor_type (type) || ada_is_packed_array_type (type))
- {
- int retn;
- struct value *mark = value_mark ();
-@@ -567,6 +619,22 @@ ada_val_print_1 (struct type *type, char
- return c_val_print (type, valaddr0, embedded_offset, address, stream,
- format, deref_ref, recurse, pretty);
-
-+ case TYPE_CODE_PTR:
-+ {
-+ int ret = c_val_print (type, valaddr0, embedded_offset, address,
-+ stream, format, deref_ref, recurse, pretty);
-+ if (ada_is_tag_type (type))
-+ {
-+ struct value *val =
-+ value_from_contents_and_address (type, valaddr, address);
-+ const char *name = ada_tag_name (val);
-+ if (name != NULL)
-+ fprintf_filtered (stream, " (%s)", name);
-+ return 0;
-+ }
-+ return ret;
-+ }
-+
- case TYPE_CODE_INT:
- case TYPE_CODE_RANGE:
- if (ada_is_fixed_point_type (type))
-@@ -603,7 +671,7 @@ ada_val_print_1 (struct type *type, char
- fprintf_filtered (stream, "%s", VALUE_CONTENTS (printable_val));
- return 0;
- }
-- /* No special printing function. Do as best we can. */
-+ /* No special printing function. Do as best we can. */
- }
- else if (TYPE_CODE (type) == TYPE_CODE_RANGE)
- {
-@@ -613,7 +681,7 @@ ada_val_print_1 (struct type *type, char
- /* Obscure case of range type that has different length from
- its base type. Perform a conversion, or we will get a
- nonsense value. Actually, we could use the same
-- code regardless of lengths; I'm just avoiding a cast. */
-+ code regardless of lengths; I'm just avoiding a cast. */
- struct value *v = value_cast (target_type,
- value_from_contents_and_address
- (type, valaddr, 0));
-@@ -633,6 +701,20 @@ ada_val_print_1 (struct type *type, char
- {
- print_scalar_formatted (valaddr, type, format, 0, stream);
- }
-+ else if (ada_is_system_address_type (type))
-+ {
-+ /* FIXME: We want to print System.Address variables using
-+ the same format as for any access type. But for some
-+ reason GNAT encodes the System.Address type as an int,
-+ so we have to work-around this deficiency by handling
-+ System.Address values as a special case. */
-+ fprintf_filtered (stream, "(");
-+ type_print (type, "", stream, -1);
-+ fprintf_filtered (stream, ") ");
-+ print_address_numeric
-+ (extract_typed_address (valaddr, builtin_type_void_data_ptr),
-+ 1, stream);
-+ }
- else
- {
- val_print_type_code_int (type, valaddr, stream);
-@@ -676,6 +758,14 @@ ada_val_print_1 (struct type *type, char
- }
- break;
-
-+ case TYPE_CODE_FLT:
-+ if (format)
-+ return c_val_print (type, valaddr0, embedded_offset, address, stream,
-+ format, deref_ref, recurse, pretty);
-+ else
-+ ada_print_floating (valaddr0 + embedded_offset, type, stream);
-+ break;
-+
- case TYPE_CODE_UNION:
- case TYPE_CODE_STRUCT:
- if (ada_is_bogus_array_descriptor (type))
-@@ -690,66 +780,60 @@ ada_val_print_1 (struct type *type, char
- }
-
- case TYPE_CODE_ARRAY:
-- if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
-- {
-- elttype = TYPE_TARGET_TYPE (type);
-- eltlen = TYPE_LENGTH (elttype);
-- len = TYPE_LENGTH (type) / eltlen;
-+ elttype = TYPE_TARGET_TYPE (type);
-+ if (elttype == NULL)
-+ eltlen = 0;
-+ else
-+ eltlen = TYPE_LENGTH (elttype);
-+ /* FIXME: This doesn't deal with non-empty arrays of
-+ 0-length items (not a typical case!) */
-+ if (eltlen == 0)
-+ len = 0;
-+ else
-+ len = TYPE_LENGTH (type) / eltlen;
-
- /* For an array of chars, print with string syntax. */
-- if (ada_is_string_type (type) && (format == 0 || format == 's'))
-+ if (ada_is_string_type (type) && (format == 0 || format == 's'))
-+ {
-+ if (prettyprint_arrays)
- {
-- if (prettyprint_arrays)
-- {
-- print_spaces_filtered (2 + 2 * recurse, stream);
-- }
-- /* If requested, look for the first null char and only print
-- elements up to it. */
-- if (stop_print_at_null)
-- {
-- int temp_len;
--
-- /* Look for a NULL char. */
-- for (temp_len = 0;
-- temp_len < len && temp_len < print_max
-- && char_at (valaddr, temp_len, eltlen) != 0;
-- temp_len += 1);
-- len = temp_len;
-- }
--
-- printstr (stream, valaddr, len, 0, eltlen);
-+ print_spaces_filtered (2 + 2 * recurse, stream);
- }
-- else
-+ /* If requested, look for the first null char and only print
-+ elements up to it. */
-+ if (stop_print_at_null)
- {
-- len = 0;
-- fprintf_filtered (stream, "(");
-- print_optional_low_bound (stream, type);
-- if (TYPE_FIELD_BITSIZE (type, 0) > 0)
-- val_print_packed_array_elements (type, valaddr, 0, stream,
-- format, recurse, pretty);
-- else
-- val_print_array_elements (type, valaddr, address, stream,
-- format, deref_ref, recurse,
-- pretty, 0);
-- fprintf_filtered (stream, ")");
-+ int temp_len;
-+
-+ /* Look for a NULL char. */
-+ for (temp_len = 0;
-+ temp_len < len && temp_len < print_max
-+ && char_at (valaddr, temp_len, eltlen) != 0;
-+ temp_len += 1);
-+ len = temp_len;
- }
-- gdb_flush (stream);
-- return len;
-+
-+ printstr (stream, valaddr, len, 0, eltlen);
-+ }
-+ else
-+ {
-+ len = 0;
-+ fprintf_filtered (stream, "(");
-+ print_optional_low_bound (stream, type);
-+ if (TYPE_FIELD_BITSIZE (type, 0) > 0)
-+ val_print_packed_array_elements (type, valaddr, 0, stream,
-+ format, recurse, pretty);
-+ else
-+ val_print_array_elements (type, valaddr, address, stream,
-+ format, deref_ref, recurse,
-+ pretty, 0);
-+ fprintf_filtered (stream, ")");
- }
-+ gdb_flush (stream);
-+ return len;
-
- case TYPE_CODE_REF:
- elttype = check_typedef (TYPE_TARGET_TYPE (type));
-- if (addressprint)
-- {
-- fprintf_filtered (stream, "@");
-- /* Extract an address, assume that the address is unsigned. */
-- print_address_numeric
-- (extract_unsigned_integer (valaddr,
-- TARGET_PTR_BIT / HOST_CHAR_BIT),
-- 1, stream);
-- if (deref_ref)
-- fputs_filtered (": ", stream);
-- }
- /* De-reference the reference */
- if (deref_ref)
- {
-@@ -777,6 +861,7 @@ ada_val_print_1 (struct type *type, char
- }
- break;
- }
-+ gdb_flush (stream);
- return 0;
- }
-
-@@ -811,26 +896,21 @@ ada_value_print (struct value *val0, str
- struct value *val =
- value_from_contents_and_address (type, valaddr, address);
-
-- /* If it is a pointer, indicate what it points to. */
-- if (TYPE_CODE (type) == TYPE_CODE_PTR || TYPE_CODE (type) == TYPE_CODE_REF)
-+ /* If it is a pointer, indicate what it points to. */
-+ if (TYPE_CODE (type) == TYPE_CODE_PTR)
- {
-- /* Hack: remove (char *) for char strings. Their
-- type is indicated by the quoted string anyway. */
-- if (TYPE_CODE (type) == TYPE_CODE_PTR &&
-- TYPE_LENGTH (TYPE_TARGET_TYPE (type)) == sizeof (char) &&
-- TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_INT &&
-- !TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
-- {
-- /* Print nothing */
-- }
-- else
-+ /* Hack: don't print (char *) for char strings. Their
-+ type is indicated by the quoted string anyway. */
-+ if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) != sizeof (char)
-+ || TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_INT
-+ || TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
- {
- fprintf_filtered (stream, "(");
- type_print (type, "", stream, -1);
- fprintf_filtered (stream, ") ");
- }
- }
-- else if (ada_is_array_descriptor (type))
-+ else if (ada_is_array_descriptor_type (type))
- {
- fprintf_filtered (stream, "(");
- type_print (type, "", stream, -1);
-@@ -843,6 +923,23 @@ ada_value_print (struct value *val0, str
- fprintf_filtered (stream, ") (...?)");
- return 0;
- }
-+
-+ if (TYPE_CODE (type) == TYPE_CODE_ARRAY
-+ && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) == 0
-+ && TYPE_CODE (TYPE_INDEX_TYPE (type)) == TYPE_CODE_RANGE)
-+ {
-+ /* This is an array of zero-length elements, that is an array
-+ of null records. This array needs to be printed by hand,
-+ as the standard routine to print arrays relies on the size of
-+ the array elements to be nonzero. This is because it computes
-+ the number of elements in the array by dividing the array size
-+ by the array element size. */
-+ fprintf_filtered (stream, "(%d .. %d => ())",
-+ TYPE_LOW_BOUND (TYPE_INDEX_TYPE (type)),
-+ TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (type)));
-+ return 0;
-+ }
-+
- return (val_print (type, VALUE_CONTENTS (val), 0, address,
- stream, format, 1, 0, pretty));
- }
-@@ -866,18 +963,18 @@ print_record (struct type *type, char *v
- }
-
- /* Print out fields of value at VALADDR having structure type TYPE.
--
-+
- TYPE, VALADDR, STREAM, FORMAT, RECURSE, and PRETTY have the
-- same meanings as in ada_print_value and ada_val_print.
-+ same meanings as in ada_print_value and ada_val_print.
-
- OUTER_TYPE and OUTER_VALADDR give type and address of enclosing record
- (used to get discriminant values when printing variant parts).
-
-- COMMA_NEEDED is 1 if fields have been printed at the current recursion
-+ COMMA_NEEDED is 1 if fields have been printed at the current recursion
- level, so that a comma is needed before any field printed by this
-- call.
-+ call.
-
-- Returns 1 if COMMA_NEEDED or any fields were printed. */
-+ Returns 1 if COMMA_NEEDED or any fields were printed. */
-
- static int
- print_field_values (struct type *type, char *valaddr, struct ui_file *stream,
-
+++ /dev/null
-===================================================================
-RCS file: /cvs/src/src/gdb/ada-lang.h,v
-retrieving revision 1.7
-retrieving revision 1.8
-diff -u -r1.7 -r1.8
---- gdb/ada-lang.h 2004/06/02 09:55:36 1.7
-+++ gdb/ada-lang.h 2004/06/08 08:42:04 1.8
-@@ -393,4 +393,15 @@
-
- extern void ada_reset_thread_registers (void);
-
-+/* Look up a symbol by name using the search conventions of
-+ a specific language (optional block, optional symtab).
-+ FIXME: Should be symtab.h. */
-+
-+extern struct symbol *lookup_symbol_in_language (const char *,
-+ const struct block *,
-+ domain_enum,
-+ enum language,
-+ int *,
-+ struct symtab **);
-+
- #endif
-===================================================================
-RCS file: /cvs/src/src/gdb/ada-lang.c,v
-retrieving revision 1.36
-retrieving revision 1.37
-diff -u -r1.36 -r1.37
---- gdb/ada-lang.c 2004/06/02 09:55:36 1.36
-+++ gdb/ada-lang.c 2004/06/08 08:42:03 1.37
-@@ -4444,6 +4444,30 @@
- #endif
- }
-
-+/* FIXME: The next two routines belong in symtab.c */
-+
-+static void restore_language (void* lang)
-+{
-+ set_language ((enum language) lang);
-+}
-+
-+/* As for lookup_symbol, but performed as if the current language
-+ were LANG. */
-+
-+struct symbol *
-+lookup_symbol_in_language (const char *name, const struct block *block,
-+ domain_enum domain, enum language lang,
-+ int *is_a_field_of_this, struct symtab **symtab)
-+{
-+ struct cleanup *old_chain
-+ = make_cleanup (restore_language, (void*) current_language->la_language);
-+ struct symbol *result;
-+ set_language (lang);
-+ result = lookup_symbol (name, block, domain, is_a_field_of_this, symtab);
-+ do_cleanups (old_chain);
-+ return result;
-+}
-+
- /* True if TYPE is definitely an artificial type supplied to a symbol
- for which no debugging information was given in the symbol file. */
-
+++ /dev/null
-From gdb-patches-return-33876-listarch-gdb-patches=sources dot redhat dot com at sources dot redhat dot com Wed Jun 16 08:34:43 2004
-Return-Path: <gdb-patches-return-33876-listarch-gdb-patches=sources dot redhat dot com at sources dot redhat dot com>
-Delivered-To: listarch-gdb-patches at sources dot redhat dot com
-Received: (qmail 1499 invoked by alias); 16 Jun 2004 08:34:41 -0000
-Mailing-List: contact gdb-patches-help at sources dot redhat dot com; run by ezmlm
-Precedence: bulk
-List-Subscribe: <mailto:gdb-patches-subscribe at sources dot redhat dot com>
-List-Archive: <http://sources.redhat.com/ml/gdb-patches/>
-List-Post: <mailto:gdb-patches at sources dot redhat dot com>
-List-Help: <mailto:gdb-patches-help at sources dot redhat dot com>, <http://sources dot redhat dot com/ml/#faqs>
-Sender: gdb-patches-owner at sources dot redhat dot com
-Delivered-To: mailing list gdb-patches at sources dot redhat dot com
-Received: (qmail 1426 invoked from network); 16 Jun 2004 08:34:24 -0000
-Received: from unknown (HELO nile.gnat.com) (205.232.38.5)
- by sourceware dot org with SMTP; 16 Jun 2004 08:34:24 -0000
-Received: from localhost (localhost [127.0.0.1])
- by nile dot gnat dot com (Postfix) with ESMTP id B2980F281F
- for <gdb-patches at sources dot redhat dot com>; Wed, 16 Jun 2004 04:34:23 -0400 (EDT)
-Received: from nile.gnat.com ([127.0.0.1])
- by localhost (nile dot gnat dot com [127 dot 0 dot 0 dot 1]) (amavisd-new, port 10024) with LMTP
- id 22648-01-4 for <gdb-patches at sources dot redhat dot com>;
- Wed, 16 Jun 2004 04:34:22 -0400 (EDT)
-Received: by nile.gnat.com (Postfix, from userid 1345)
- id C3B5CF2C03; Wed, 16 Jun 2004 04:34:22 -0400 (EDT)
-From: Paul Hilfinger <hilfingr at gnat dot com>
-To: gdb-patches at sources dot redhat dot com
-Cc:
-In-reply-to: <vt2aczd8aah dot fsf at zenia dot home> (message from Jim Blandy on 09 Jun
- 2004 02:23:18 -0500)
-Subject: [PATCH]: Further updates to ada-* files
-References: <20040608090758.C59CAF2940@nile.gnat.com> <vt2aczd8aah.fsf@zenia.home>
-Message-Id: <20040616083422.C3B5CF2C03@nile.gnat.com>
-Date: Wed, 16 Jun 2004 04:34:22 -0400 (EDT)
-X-Virus-Scanned: by amavisd-new at nile.gnat.com
-
-
-I have committed the following patch to some Ada files, first to keep
-up-to-date with ACT's sources, and second to conditionalize out a
-bunch of source code that we are not yet using in the public version
-for the benefit of reviewers.
-
-Paul Hilfinger
-ACT, Inc.
-
-
-2004-06-16 Paul N. Hilfinger <Hilfinger@gnat.com>
-
- * ada-tasks.c: Rename build_task_list to ada_build_task_list, and
- make it non-static.
- * ada-lang.h (task_control_block): declaration moved from ada-task.c
- to ada-lang.h; this is needed to be able to implement the kill command
- in multi-task mode.
- (task_ptid): Ditto.
- (task_entry): Ditto.
- (task_list): Ditto.
- (ada_build_task_list): Ditto.
-
- * ada-lang.c: Conditionalize routines and data structures related
- to breakpoints, exceptions, completion, and symbol caching on
- GNAT_GDB, since these are not yet used in the submitted public sources.
- (ada_main_name): Editorial: Move definition out of exception-related
- code.
-
-
-
-
-Index: gdb/ada-lang.c
-===================================================================
-RCS file: /cvs/src/src/gdb/ada-lang.c,v
-retrieving revision 1.37
-diff -u -p -r1.37 ada-lang.c
---- gdb/ada-lang.c 8 Jun 2004 08:42:03 -0000 1.37
-+++ gdb/ada-lang.c 16 Jun 2004 08:10:22 -0000
-@@ -18,6 +18,19 @@ You should have received a copy of the G
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
-
-+
-+/* Sections of code marked
-+
-+ #ifdef GNAT_GDB
-+ ...
-+ #endif
-+
-+ indicate sections that are used in sources distributed by
-+ ACT, Inc., but not yet integrated into the public tree (where
-+ GNAT_GDB is not defined). They are retained here nevertheless
-+ to minimize the problems of maintaining different versions
-+ of the source and to make the full source available. */
-+
- #include "defs.h"
- #include <stdio.h>
- #include "gdb_string.h"
-@@ -62,6 +75,7 @@ Foundation, Inc., 675 Mass Ave, Cambridg
- #define TRUNCATION_TOWARDS_ZERO ((-5 / 2) == -2)
- #endif
-
-+#ifdef GNAT_GDB
- /* 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
-@@ -76,6 +90,7 @@ struct string_vector
-
- static struct string_vector xnew_string_vector (int initial_size);
- static void string_vector_append (struct string_vector *sv, char *str);
-+#endif /* GNAT_GDB */
-
- static const char *ada_unqualified_name (const char *decoded_name);
- static char *add_angle_brackets (const char *str);
-@@ -332,6 +347,8 @@ static struct obstack symbol_list_obstac
-
- /* Utilities */
-
-+#ifdef GNAT_GDB
-+
- /* Create a new empty string_vector struct with an initial size of
- INITIAL_SIZE. */
-
-@@ -392,6 +409,8 @@ add_angle_brackets (const char *str)
- return result;
- }
-
-+#endif /* GNAT_GDB */
-+
- static char *
- ada_get_gdb_completer_word_break_characters (void)
- {
-@@ -705,6 +724,37 @@ ada_update_initial_language (enum langua
-
- return lang;
- }
-+
-+/* 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;
-+}
- \f
- /* Symbols */
-
-@@ -3597,6 +3647,13 @@ ada_convert_actuals (struct value *func,
- \f
- /* Experimental Symbol Cache Module */
-
-+/* This module may well have been OBE, due to improvements in the
-+ symbol-table module. So until proven otherwise, it is disabled in
-+ the submitted public code, and may be removed from all sources
-+ in the future. */
-+
-+#ifdef GNAT_GDB
-+
- /* 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
-@@ -3686,6 +3743,22 @@ cache_symbol (const char *name, domain_e
- e->symtab = symtab;
- e->block = block;
- }
-+
-+#else
-+static int
-+lookup_cached_symbol (const char *name, domain_enum namespace,
-+ struct symbol **sym, struct block **block,
-+ struct symtab **symtab)
-+{
-+ return 0;
-+}
-+
-+static void
-+cache_symbol (const char *name, domain_enum namespace, struct symbol *sym,
-+ struct block *block, struct symtab *symtab)
-+{
-+}
-+#endif /* GNAT_GDB */
- \f
- /* Symbol Lookup */
-
-@@ -3841,817 +3914,530 @@ defns_collected (struct obstack *obstack
- 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. */
-+/* 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 const char *
--symbol_completion_match (const char *sym_name,
-- const char *text, int text_len,
-- int wild_match, int encoded)
-+static struct partial_symbol *
-+ada_lookup_partial_symbol (struct partial_symtab *pst, const char *name,
-+ int global, domain_enum namespace, int wild)
- {
-- char *result;
-- const int verbatim_match = (text[0] == '<');
-- int match = 0;
-+ struct partial_symbol **start;
-+ int name_len = strlen (name);
-+ int length = (global ? pst->n_global_syms : pst->n_static_syms);
-+ int i;
-
-- if (verbatim_match)
-+ if (length == 0)
- {
-- /* Strip the leading angle bracket. */
-- text = text + 1;
-- text_len--;
-+ return (NULL);
- }
-
-- /* 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;
-- }
-+ start = (global ?
-+ pst->objfile->global_psymbols.list + pst->globals_offset :
-+ pst->objfile->static_psymbols.list + pst->statics_offset);
-
-- if (match && !verbatim_match)
-+ if (wild)
- {
-- /* 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 (i = 0; i < length; i += 1)
-+ {
-+ struct partial_symbol *psym = start[i];
-
-- for (tmp = sym_name; *tmp != '\0' && !isupper (*tmp); tmp++);
-- if (*tmp != '\0')
-- match = 0;
-+ 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 (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;
-
-- /* Second: Try wild matching... */
-+ while (i < length)
-+ {
-+ struct partial_symbol *psym = start[i];
-
-- 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 (SYMBOL_DOMAIN (psym) == namespace)
-+ {
-+ int cmp = strncmp (name, SYMBOL_LINKAGE_NAME (psym), name_len);
-
-- if (strncmp (sym_name, text, text_len) == 0)
-- match = 1;
-- }
-+ if (cmp < 0)
-+ {
-+ if (global)
-+ break;
-+ }
-+ else if (cmp == 0
-+ && is_name_suffix (SYMBOL_LINKAGE_NAME (psym)
-+ + name_len))
-+ return psym;
-+ }
-+ i += 1;
-+ }
-
-- /* Finally: If we found a mach, prepare the result to return. */
-+ 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 (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;
-
-- if (!match)
-- return NULL;
-+ while (i < length)
-+ {
-+ struct partial_symbol *psym = start[i];
-
-- if (verbatim_match)
-- sym_name = add_angle_brackets (sym_name);
-+ if (SYMBOL_DOMAIN (psym) == namespace)
-+ {
-+ int cmp;
-
-- if (!encoded)
-- sym_name = ada_decode (sym_name);
-+ 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);
-+ }
-
-- return sym_name;
-+ 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;
- }
-
--/* 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.
-+/* Find a symbol table containing symbol SYM or NULL if none. */
-
-- 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)
-+static struct symtab *
-+symtab_for_sym (struct symbol *sym)
- {
-- 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);
-- }
-+ struct symtab *s;
-+ struct objfile *objfile;
-+ struct block *b;
-+ struct symbol *tmp_sym;
-+ struct dict_iterator iter;
-+ int j;
-
-- string_vector_append (sv, completion);
-+ ALL_SYMTABS (objfile, s)
-+ {
-+ switch (SYMBOL_CLASS (sym))
-+ {
-+ case LOC_CONST:
-+ case LOC_STATIC:
-+ case LOC_TYPEDEF:
-+ case LOC_REGISTER:
-+ case LOC_LABEL:
-+ case LOC_BLOCK:
-+ case LOC_CONST_BYTES:
-+ b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), GLOBAL_BLOCK);
-+ ALL_BLOCK_SYMBOLS (b, iter, tmp_sym) if (sym == tmp_sym)
-+ return s;
-+ b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), STATIC_BLOCK);
-+ ALL_BLOCK_SYMBOLS (b, iter, tmp_sym) if (sym == tmp_sym)
-+ return s;
-+ break;
-+ default:
-+ break;
-+ }
-+ switch (SYMBOL_CLASS (sym))
-+ {
-+ case LOC_REGISTER:
-+ case LOC_ARG:
-+ case LOC_REF_ARG:
-+ case LOC_REGPARM:
-+ case LOC_REGPARM_ADDR:
-+ case LOC_LOCAL:
-+ case LOC_TYPEDEF:
-+ case LOC_LOCAL_ARG:
-+ case LOC_BASEREG:
-+ case LOC_BASEREG_ARG:
-+ case LOC_COMPUTED:
-+ case LOC_COMPUTED_ARG:
-+ for (j = FIRST_LOCAL_BLOCK;
-+ j < BLOCKVECTOR_NBLOCKS (BLOCKVECTOR (s)); j += 1)
-+ {
-+ b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), j);
-+ ALL_BLOCK_SYMBOLS (b, iter, tmp_sym) if (sym == tmp_sym)
-+ return s;
-+ }
-+ break;
-+ default:
-+ break;
-+ }
-+ }
-+ return NULL;
- }
-
--/* Return a list of possible symbol names completing TEXT0. The list
-- is NULL terminated. WORD is the entire command on which completion
-- is made. */
-+/* 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. */
-
--char **
--ada_make_symbol_completion_list (const char *text0, const char *word)
-+struct minimal_symbol *
-+ada_lookup_simple_minsym (const char *name)
- {
-- /* 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;
-+ struct minimal_symbol *msymbol;
-+ int wild_match;
-
-- if (text0[0] == '<')
-+ if (strncmp (name, "standard__", sizeof ("standard__") - 1) == 0)
- {
-- text = xstrdup (text0);
-- make_cleanup (xfree, text);
-- text_len = strlen (text);
-+ name += sizeof ("standard__") - 1;
- 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]);
-+ wild_match = (strstr (name, "__") == NULL);
-
-- /* 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);
-- }
-+ ALL_MSYMBOLS (objfile, msymbol)
-+ {
-+ if (ada_match_name (SYMBOL_LINKAGE_NAME (msymbol), name, wild_match)
-+ && MSYMBOL_TYPE (msymbol) != mst_solib_trampoline)
-+ return msymbol;
-+ }
-
-- /* First, look at the partial symtab symbols. */
-- ALL_PSYMTABS (objfile, ps)
-- {
-- struct partial_symbol **psym;
-+ return NULL;
-+}
-
-- /* If the psymtab's been read in we'll get it when we search
-- through the blockvector. */
-- if (ps->readin)
-- continue;
-+/* Return up minimal symbol for NAME, folded and encoded according to
-+ Ada conventions, or NULL if none. The last two arguments are ignored. */
-
-- 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);
-- }
-+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 (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);
-- }
-- }
-+/* For all subprograms that statically enclose the subprogram of the
-+ 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. */
-
-- /* 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). */
-+static void
-+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;
-
-- ALL_MSYMBOLS (objfile, msymbol)
-- {
-- QUIT;
-- symbol_completion_add (&result, SYMBOL_LINKAGE_NAME (msymbol),
-- text, text_len, text0, word,
-- wild_match, encoded);
-- }
-+ struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
-+ struct frame_info *frame;
-
-- /* Search upwards from currently selected frame (so that we can
-- complete on local vars. */
-+ if (! target_has_stack)
-+ return;
-
-- for (b = get_selected_block (0); b != NULL; b = BLOCK_SUPERBLOCK (b))
-+ if (static_link == NULL)
- {
-- 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);
-- }
-+ /* Initialize the local variable symbol that stands for the
-+ static link (when there is one). */
-+ static_link = &static_link_sym;
-+ 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));
- }
-
-- /* 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);
-- }
-- }
-+ frame = get_selected_frame ();
-+ if (frame == NULL
-+ || inside_main_func (get_frame_address_in_block (frame)))
-+ return;
-
-- 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);
-+ 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)
-+ {
-+ CORE_ADDR target_link = value_as_address (target_link_val);
-
-- return (result.array);
--}
-+ frame = get_prev_frame (frame);
-+ if (frame == NULL)
-+ break;
-
--/* 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. */
-+ if (get_frame_locals_address (frame) == target_link)
-+ {
-+ struct block *block;
-+
-+ QUIT;
-
--static struct partial_symbol *
--ada_lookup_partial_symbol (struct partial_symtab *pst, const char *name,
-- int global, domain_enum namespace, int wild)
--{
-- struct partial_symbol **start;
-- int name_len = strlen (name);
-- int length = (global ? pst->n_global_syms : pst->n_static_syms);
-- int i;
-+ block = get_frame_block (frame, 0);
-+ while (block != NULL && block_function (block) != NULL
-+ && num_defns_collected (obstackp) == 0)
-+ {
-+ QUIT;
-
-- if (length == 0)
-- {
-- return (NULL);
-+ ada_add_block_symbols (obstackp, block, name, namespace,
-+ NULL, NULL, wild_match);
-+
-+ block = BLOCK_SUPERBLOCK (block);
-+ }
-+ }
- }
-
-- start = (global ?
-- 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];
-+ do_cleanups (old_chain);
-+#endif
-+}
-
-- 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 (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;
-+/* FIXME: The next two routines belong in symtab.c */
-
-- while (i < length)
-- {
-- struct partial_symbol *psym = start[i];
-+static void restore_language (void* lang)
-+{
-+ set_language ((enum language) lang);
-+}
-
-- if (SYMBOL_DOMAIN (psym) == namespace)
-- {
-- int cmp = strncmp (name, SYMBOL_LINKAGE_NAME (psym), name_len);
-+/* As for lookup_symbol, but performed as if the current language
-+ were LANG. */
-
-- if (cmp < 0)
-- {
-- if (global)
-- break;
-- }
-- else if (cmp == 0
-- && is_name_suffix (SYMBOL_LINKAGE_NAME (psym)
-- + name_len))
-- return psym;
-- }
-- i += 1;
-- }
-+struct symbol *
-+lookup_symbol_in_language (const char *name, const struct block *block,
-+ domain_enum domain, enum language lang,
-+ int *is_a_field_of_this, struct symtab **symtab)
-+{
-+ struct cleanup *old_chain
-+ = make_cleanup (restore_language, (void*) current_language->la_language);
-+ struct symbol *result;
-+ set_language (lang);
-+ result = lookup_symbol (name, block, domain, is_a_field_of_this, symtab);
-+ do_cleanups (old_chain);
-+ return result;
-+}
-
-- 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 (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;
-+/* True if TYPE is definitely an artificial type supplied to a symbol
-+ for which no debugging information was given in the symbol file. */
-
-- while (i < length)
-- {
-- struct partial_symbol *psym = start[i];
-+static int
-+is_nondebugging_type (struct type *type)
-+{
-+ char *name = ada_type_name (type);
-+ return (name != NULL && strcmp (name, "<variable, no debug info>") == 0);
-+}
-
-- if (SYMBOL_DOMAIN (psym) == namespace)
-- {
-- int cmp;
-+/* 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. */
-
-- 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);
-- }
-+static int
-+remove_extra_symbols (struct ada_symbol_info *syms, int nsyms)
-+{
-+ int i, j;
-
-- if (cmp < 0)
-+ i = 0;
-+ while (i < nsyms)
-+ {
-+ 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))
- {
-- if (global)
-- break;
-+ int k;
-+ for (k = i + 1; k < nsyms; k += 1)
-+ syms[k - 1] = syms[k];
-+ nsyms -= 1;
-+ goto NextSymbol;
- }
-- else if (cmp == 0
-- && is_name_suffix (SYMBOL_LINKAGE_NAME (psym)
-- + name_len + 5))
-- return psym;
- }
-- i += 1;
- }
-+ i += 1;
-+ NextSymbol:
-+ ;
- }
-- return NULL;
-+ return nsyms;
- }
-
--/* Find a symbol table containing symbol SYM or NULL if none. */
-+/* 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 struct symtab *
--symtab_for_sym (struct symbol *sym)
-+static char *
-+xget_renaming_scope (struct type *renaming_type)
- {
-- struct symtab *s;
-- struct objfile *objfile;
-- struct block *b;
-- struct symbol *tmp_sym;
-- struct dict_iterator iter;
-- int j;
-+ /* 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;
-
-- ALL_SYMTABS (objfile, s)
-- {
-- switch (SYMBOL_CLASS (sym))
-- {
-- case LOC_CONST:
-- case LOC_STATIC:
-- case LOC_TYPEDEF:
-- case LOC_REGISTER:
-- case LOC_LABEL:
-- case LOC_BLOCK:
-- case LOC_CONST_BYTES:
-- b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), GLOBAL_BLOCK);
-- ALL_BLOCK_SYMBOLS (b, iter, tmp_sym) if (sym == tmp_sym)
-- return s;
-- b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), STATIC_BLOCK);
-- ALL_BLOCK_SYMBOLS (b, iter, tmp_sym) if (sym == tmp_sym)
-- return s;
-- break;
-- default:
-- break;
-- }
-- switch (SYMBOL_CLASS (sym))
-- {
-- case LOC_REGISTER:
-- case LOC_ARG:
-- case LOC_REF_ARG:
-- case LOC_REGPARM:
-- case LOC_REGPARM_ADDR:
-- case LOC_LOCAL:
-- case LOC_TYPEDEF:
-- case LOC_LOCAL_ARG:
-- case LOC_BASEREG:
-- case LOC_BASEREG_ARG:
-- case LOC_COMPUTED:
-- case LOC_COMPUTED_ARG:
-- for (j = FIRST_LOCAL_BLOCK;
-- j < BLOCKVECTOR_NBLOCKS (BLOCKVECTOR (s)); j += 1)
-- {
-- b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), j);
-- ALL_BLOCK_SYMBOLS (b, iter, tmp_sym) if (sym == tmp_sym)
-- return s;
-- }
-- break;
-- default:
-- break;
-- }
-- }
-- return NULL;
--}
--
--/* 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_simple_minsym (const char *name)
--{
-- struct objfile *objfile;
-- struct minimal_symbol *msymbol;
-- int wild_match;
--
-- if (strncmp (name, "standard__", sizeof ("standard__") - 1) == 0)
-- {
-- name += sizeof ("standard__") - 1;
-- wild_match = 0;
-- }
-- else
-- wild_match = (strstr (name, "__") == NULL);
-+ /* Now, backtrack a bit until we find the first "__". Start looking
-+ at suffix - 3, as the <rename> part is at least one character long. */
-
-- ALL_MSYMBOLS (objfile, msymbol)
-- {
-- if (ada_match_name (SYMBOL_LINKAGE_NAME (msymbol), name, wild_match)
-- && MSYMBOL_TYPE (msymbol) != mst_solib_trampoline)
-- return msymbol;
-- }
-+ for (last = suffix - 3; last > name; last--)
-+ if (last[0] == '_' && last[1] == '_')
-+ break;
-+
-+ /* Make a copy of scope and return it. */
-
-- return NULL;
--}
-+ scope_len = last - name;
-+ scope = (char *) xmalloc ((scope_len + 1) * sizeof (char));
-
--/* Return up minimal symbol for NAME, folded and encoded according to
-- Ada conventions, or NULL if none. The last two arguments are ignored. */
-+ strncpy (scope, name, scope_len);
-+ scope[scope_len] = '\0';
-
--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));
-+ return scope;
- }
-
--/* For all subprograms that statically enclose the subprogram of the
-- 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. */
-+/* Return nonzero if NAME corresponds to a package name. */
-
--static void
--add_symbols_from_enclosing_procs (struct obstack *obstackp,
-- const char *name, domain_enum namespace,
-- int wild_match)
-+static int
-+is_package_name (const char *name)
- {
--#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;
-+ /* 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). */
-
-- if (! target_has_stack)
-- return;
-+ 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;
-
-- if (static_link == NULL)
-- {
-- /* Initialize the local variable symbol that stands for the
-- static link (when there is one). */
-- static_link = &static_link_sym;
-- 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));
-- }
-+ /* Library-level function names start with "_ada_". See if function
-+ "_ada_" followed by NAME can be found. */
-
-- frame = get_selected_frame ();
-- if (frame == NULL
-- || inside_main_func (get_frame_address_in_block (frame)))
-- return;
-+ /* 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;
-
-- 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)
-- {
-- CORE_ADDR target_link = value_as_address (target_link_val);
-+ fun_name = (char *) alloca (strlen (name) + 5 + 1);
-+ xasprintf (&fun_name, "_ada_%s", name);
-
-- frame = get_prev_frame (frame);
-- if (frame == NULL)
-- break;
-+ return (standard_lookup (fun_name, NULL, VAR_DOMAIN) == NULL);
-+}
-
-- if (get_frame_locals_address (frame) == target_link)
-- {
-- struct block *block;
--
-- QUIT;
-+/* Return nonzero if SYM corresponds to a renaming entity that is
-+ visible from FUNCTION_NAME. */
-
-- block = get_frame_block (frame, 0);
-- while (block != NULL && block_function (block) != NULL
-- && num_defns_collected (obstackp) == 0)
-- {
-- QUIT;
-+static int
-+renaming_is_visible (const struct symbol *sym, char *function_name)
-+{
-+ char *scope = xget_renaming_scope (SYMBOL_TYPE (sym));
-
-- ada_add_block_symbols (obstackp, block, name, namespace,
-- NULL, NULL, wild_match);
--
-- block = BLOCK_SUPERBLOCK (block);
-- }
-- }
-- }
-+ make_cleanup (xfree, scope);
-
-- do_cleanups (old_chain);
--#endif
--}
-+ /* If the rename has been defined in a package, then it is visible. */
-+ if (is_package_name (scope))
-+ return 1;
-
--/* FIXME: The next two routines belong in symtab.c */
-+ /* 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;
-
--static void restore_language (void* lang)
--{
-- set_language ((enum language) lang);
-+ return (strncmp (function_name, scope, strlen (scope)) == 0);
- }
-
--/* As for lookup_symbol, but performed as if the current language
-- were LANG. */
--
--struct symbol *
--lookup_symbol_in_language (const char *name, const struct block *block,
-- domain_enum domain, enum language lang,
-- int *is_a_field_of_this, struct symtab **symtab)
--{
-- struct cleanup *old_chain
-- = make_cleanup (restore_language, (void*) current_language->la_language);
-- struct symbol *result;
-- set_language (lang);
-- result = lookup_symbol (name, block, domain, is_a_field_of_this, symtab);
-- do_cleanups (old_chain);
-- return result;
--}
-+/* 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.
-
--/* True if TYPE is definitely an artificial type supplied to a symbol
-- for which no debugging information was given in the symbol file. */
-+ 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
--is_nondebugging_type (struct type *type)
--{
-- char *name = ada_type_name (type);
-- 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 entries.
-- Returns the number of items in the modified list. */
--
--static int
--remove_extra_symbols (struct ada_symbol_info *syms, int nsyms)
--{
-- int i, j;
--
-- i = 0;
-- while (i < nsyms)
-- {
-- 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:
-- ;
-- }
-- return nsyms;
--}
--
--/* 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)
-+remove_out_of_scope_renamings (struct ada_symbol_info *syms,
-+ int nsyms,
-+ struct block *current_block)
- {
- struct symbol *current_function;
- char *current_function_name;
-@@ -5179,166 +4965,460 @@ wild_match (const char *patn0, int patn_
- name += 1;
- name_len -= 1;
- }
-- }
--
-- return 0;
--}
-+ }
-+
-+ return 0;
-+}
-+
-+
-+/* 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 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. */
-+ struct symbol *arg_sym;
-+ /* Set true when we find a matching non-argument symbol. */
-+ int found_sym;
-+ struct symbol *sym;
-+
-+ arg_sym = NULL;
-+ found_sym = 0;
-+ if (wild)
-+ {
-+ struct symbol *sym;
-+ ALL_BLOCK_SYMBOLS (block, iter, sym)
-+ {
-+ 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, 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)
-+ {
-+ add_defn_to_vec (obstackp,
-+ fixup_symbol_section (arg_sym, objfile),
-+ block, symtab);
-+ }
-+
-+ if (!wild)
-+ {
-+ arg_sym = NULL;
-+ found_sym = 0;
-+
-+ ALL_BLOCK_SYMBOLS (block, iter, sym)
-+ {
-+ if (SYMBOL_DOMAIN (sym) == domain)
-+ {
-+ int cmp;
-+
-+ cmp = (int) '_' - (int) SYMBOL_LINKAGE_NAME (sym)[0];
-+ if (cmp == 0)
-+ {
-+ cmp = strncmp ("_ada_", SYMBOL_LINKAGE_NAME (sym), 5);
-+ if (cmp == 0)
-+ cmp = strncmp (name, SYMBOL_LINKAGE_NAME (sym) + 5,
-+ name_len);
-+ }
-+
-+ if (cmp == 0
-+ && is_name_suffix (SYMBOL_LINKAGE_NAME (sym) + name_len + 5))
-+ {
-+ switch (SYMBOL_CLASS (sym))
-+ {
-+ case LOC_ARG:
-+ case LOC_LOCAL_ARG:
-+ case LOC_REF_ARG:
-+ case LOC_REGPARM:
-+ case LOC_REGPARM_ADDR:
-+ case LOC_BASEREG_ARG:
-+ case LOC_COMPUTED_ARG:
-+ arg_sym = sym;
-+ break;
-+ case LOC_UNRESOLVED:
-+ break;
-+ default:
-+ found_sym = 1;
-+ add_defn_to_vec (obstackp,
-+ fixup_symbol_section (sym, objfile),
-+ block, symtab);
-+ break;
-+ }
-+ }
-+ }
-+ end_loop2: ;
-+ }
-+
-+ /* NOTE: This really shouldn't be needed for _ada_ symbols.
-+ They aren't parameters, right? */
-+ if (!found_sym && arg_sym != NULL)
-+ {
-+ add_defn_to_vec (obstackp,
-+ fixup_symbol_section (arg_sym, objfile),
-+ block, symtab);
-+ }
-+ }
-+}
-+\f
-+#ifdef GNAT_GDB
-+
-+ /* Symbol Completion */
-+
-+/* 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). */
-
--/* 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. */
-+ ALL_MSYMBOLS (objfile, msymbol)
-+ {
-+ QUIT;
-+ symbol_completion_add (&result, SYMBOL_LINKAGE_NAME (msymbol),
-+ text, text_len, text0, word,
-+ wild_match, encoded);
-+ }
-
--static void
--ada_add_block_symbols (struct obstack *obstackp,
-- struct block *block, const char *name,
-- domain_enum domain, struct objfile *objfile,
-- struct symtab *symtab, int wild)
--{
-- struct dict_iterator iter;
-- int name_len = strlen (name);
-- /* A matching argument symbol, if any. */
-- struct symbol *arg_sym;
-- /* Set true when we find a matching non-argument symbol. */
-- int found_sym;
-- struct symbol *sym;
-+ /* Search upwards from currently selected frame (so that we can
-+ complete on local vars. */
-
-- arg_sym = NULL;
-- found_sym = 0;
-- if (wild)
-- {
-- struct symbol *sym;
-- ALL_BLOCK_SYMBOLS (block, iter, sym)
-- {
-- 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
-+ for (b = get_selected_block (0); b != NULL; b = BLOCK_SUPERBLOCK (b))
- {
-- ALL_BLOCK_SYMBOLS (block, iter, sym)
-+ if (!BLOCK_SUPERBLOCK (b))
-+ surrounding_static_block = b; /* For elmin of dups */
-+
-+ ALL_BLOCK_SYMBOLS (b, iter, sym)
- {
-- 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;
-- }
-- }
-- }
-+ symbol_completion_add (&result, SYMBOL_LINKAGE_NAME (sym),
-+ text, text_len, text0, word,
-+ wild_match, encoded);
- }
- }
-
-- if (!found_sym && arg_sym != NULL)
-- {
-- add_defn_to_vec (obstackp,
-- fixup_symbol_section (arg_sym, objfile),
-- block, symtab);
-- }
--
-- if (!wild)
-- {
-- arg_sym = NULL;
-- found_sym = 0;
-+ /* Go through the symtabs and check the externs and statics for
-+ symbols which match. */
-
-- ALL_BLOCK_SYMBOLS (block, iter, sym)
-- {
-- if (SYMBOL_DOMAIN (sym) == domain)
-- {
-- int cmp;
-+ 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);
-+ }
-+ }
-
-- cmp = (int) '_' - (int) SYMBOL_LINKAGE_NAME (sym)[0];
-- if (cmp == 0)
-- {
-- cmp = strncmp ("_ada_", SYMBOL_LINKAGE_NAME (sym), 5);
-- if (cmp == 0)
-- cmp = strncmp (name, SYMBOL_LINKAGE_NAME (sym) + 5,
-- name_len);
-- }
-+ 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);
-+ }
-+ }
-
-- if (cmp == 0
-- && is_name_suffix (SYMBOL_LINKAGE_NAME (sym) + name_len + 5))
-- {
-- switch (SYMBOL_CLASS (sym))
-- {
-- case LOC_ARG:
-- case LOC_LOCAL_ARG:
-- case LOC_REF_ARG:
-- case LOC_REGPARM:
-- case LOC_REGPARM_ADDR:
-- case LOC_BASEREG_ARG:
-- case LOC_COMPUTED_ARG:
-- arg_sym = sym;
-- break;
-- case LOC_UNRESOLVED:
-- break;
-- default:
-- found_sym = 1;
-- add_defn_to_vec (obstackp,
-- fixup_symbol_section (sym, objfile),
-- block, symtab);
-- break;
-- }
-- }
-- }
-- end_loop2: ;
-- }
-+ /* Append the closing NULL entry. */
-+ string_vector_append (&result, NULL);
-
-- /* NOTE: This really shouldn't be needed for _ada_ symbols.
-- They aren't parameters, right? */
-- if (!found_sym && arg_sym != NULL)
-- {
-- add_defn_to_vec (obstackp,
-- fixup_symbol_section (arg_sym, objfile),
-- block, symtab);
-- }
-- }
-+ return (result.array);
- }
-+
-+#endif /* GNAT_GDB */
- \f
-+#ifdef GNAT_GDB
- /* Breakpoint-related */
-
- /* Import message from symtab.c. */
-@@ -6041,37 +6121,6 @@ extended_canonical_line_spec (struct sym
- 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. */
-@@ -6079,12 +6128,8 @@ ada_main_name (void)
- 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
-@@ -6285,7 +6330,6 @@ exception_name_from_cond (const char *co
- int
- ada_print_exception_breakpoint_nontask (struct breakpoint *b)
- {
--#ifdef GNAT_GDB
- if (b->break_on_exception == 1)
- {
- if (b->cond_string) /* the breakpoint is on a specific exception. */
-@@ -6314,9 +6358,6 @@ ada_print_exception_breakpoint_nontask (
- else
- return 0;
- return 1;
--#else
-- return 0;
--#endif
- }
-
- /* Print task identifier for breakpoint B, if it is an Ada-specific
-@@ -6325,13 +6366,11 @@ ada_print_exception_breakpoint_nontask (
- void
- ada_print_exception_breakpoint_task (struct breakpoint *b)
- {
--#ifdef GNAT_GDB
- if (b->task != 0)
- {
- ui_out_text (uiout, " task ");
- ui_out_field_int (uiout, "task", b->task);
- }
--#endif
- }
-
- int
-@@ -6476,8 +6515,8 @@ ada_breakpoint_rewrite (char *arg, int *
- }
- return arg;
- }
-+#endif
- \f
--
- /* Field Access */
-
- /* True if field number FIELD_NUM in struct or union type TYPE is supposed
-@@ -10098,7 +10137,7 @@ const struct language_defn ada_language_
- #ifdef GNAT_GDB
- ada_lookup_symbol,
- ada_lookup_minimal_symbol,
--#endif
-+#endif /* GNAT_GDB */
- &ada_exp_descriptor,
- parse,
- ada_error,
-@@ -10134,7 +10173,7 @@ const struct language_defn ada_language_
- #ifdef GNAT_GDB
- ada_translate_error_message, /* Substitute Ada-specific terminology
- in errors and warnings. */
--#endif
-+#endif /* GNAT_GDB */
- LANG_MAGIC
- };
-
-@@ -10186,17 +10225,17 @@ _initialize_ada_language (void)
- deprecated_register_gdbarch_swap (NULL, 0, build_ada_types);
- add_language (&ada_language_defn);
-
-+ varsize_limit = 65536;
- #ifdef GNAT_GDB
- add_show_from_set
- (add_set_cmd ("varsize-limit", class_support, var_uinteger,
- (char *) &varsize_limit,
- "Set maximum bytes in dynamic-sized object.",
- &setlist), &showlist);
--#endif
-- varsize_limit = 65536;
-+ obstack_init (&cache_space);
-+#endif /* GNAT_GDB */
-
- obstack_init (&symbol_list_obstack);
-- obstack_init (&cache_space);
-
- decoded_names_store = htab_create_alloc_ex
- (256, htab_hash_string, (int (*) (const void *, const void *)) streq,
-Index: gdb/ada-lang.h
-===================================================================
-RCS file: /cvs/src/src/gdb/ada-lang.h,v
-retrieving revision 1.8
-diff -u -p -r1.8 ada-lang.h
---- gdb/ada-lang.h 8 Jun 2004 08:42:04 -0000 1.8
-+++ gdb/ada-lang.h 16 Jun 2004 08:10:22 -0000
-@@ -124,6 +124,41 @@ struct ada_symbol_info {
- struct symtab* symtab;
- };
-
-+/* Ada task structures. */
-+
-+/* Ada task control block, as defined in the GNAT runt-time library. */
-+
-+struct task_control_block
-+{
-+ char state;
-+ CORE_ADDR parent;
-+ int priority;
-+ char image [32];
-+ int image_len; /* This field is not always present in the ATCB. */
-+ CORE_ADDR call;
-+ CORE_ADDR thread;
-+ CORE_ADDR lwp; /* This field is not always present in the ATCB. */
-+};
-+
-+struct task_ptid
-+{
-+ int pid; /* The Process id */
-+ long lwp; /* The Light Weight Process id */
-+ long tid; /* The Thread id */
-+};
-+typedef struct task_ptid task_ptid_t;
-+
-+struct task_entry
-+{
-+ CORE_ADDR task_id;
-+ struct task_control_block atcb;
-+ int task_num;
-+ int known_tasks_index;
-+ struct task_entry *next_task;
-+ task_ptid_t task_ptid;
-+ int stack_per;
-+};
-+
- extern struct type *builtin_type_ada_int;
- extern struct type *builtin_type_ada_short;
- extern struct type *builtin_type_ada_long;
-@@ -136,9 +171,13 @@ extern struct type *builtin_type_ada_nat
- extern struct type *builtin_type_ada_positive;
- extern struct type *builtin_type_ada_system_address;
-
--/* The maximum number of tasks known to the Ada runtime */
-+/* The maximum number of tasks known to the Ada runtime. */
- extern const int MAX_NUMBER_OF_KNOWN_TASKS;
-
-+/* task entry list. */
-+extern struct task_entry *task_list;
-+
-+
- /* Assuming V points to an array of S objects, make sure that it contains at
- least M objects, updating V and S as necessary. */
-
-@@ -393,6 +432,8 @@ extern void ada_find_printable_frame (st
-
- extern void ada_reset_thread_registers (void);
-
-+extern int ada_build_task_list (void);
-+
- /* Look up a symbol by name using the search conventions of
- a specific language (optional block, optional symtab).
- FIXME: Should be symtab.h. */
-@@ -403,5 +444,4 @@ extern struct symbol *lookup_symbol_in_l
- enum language,
- int *,
- struct symtab **);
--
- #endif
-Index: gdb/ada-tasks.c
-===================================================================
-RCS file: /cvs/src/src/gdb/ada-tasks.c,v
-retrieving revision 1.9
-diff -u -p -r1.9 ada-tasks.c
---- gdb/ada-tasks.c 2 Jun 2004 09:55:36 -0000 1.9
-+++ gdb/ada-tasks.c 16 Jun 2004 08:10:22 -0000
-@@ -62,18 +62,6 @@ enum task_states
- Master_Phase_2_Sleep
- };
-
--struct task_control_block
--{
-- char state;
-- CORE_ADDR parent;
-- int priority;
-- char image [32];
-- int image_len; /* This field is not always present in the ATCB. */
-- CORE_ADDR call;
-- CORE_ADDR thread;
-- CORE_ADDR lwp; /* This field is not always present in the ATCB. */
--};
--
- /* The index of certain important fields in the Ada Task Control Block
- record and sub-records. */
-
-@@ -102,25 +90,6 @@ struct tcb_fieldnos
- #define TASK_LWP(atcb) extract_unsigned_integer (&(atcb).lwp, sizeof ((atcb).lwp))
- #endif
-
--struct task_ptid
--{
-- int pid; /* The Process id */
-- long lwp; /* The Light Weight Process id */
-- long tid; /* The Thread id */
--};
--typedef struct task_ptid task_ptid_t;
--
--struct task_entry
--{
-- CORE_ADDR task_id;
-- struct task_control_block atcb;
-- int task_num;
-- int known_tasks_index;
-- struct task_entry *next_task;
-- task_ptid_t task_ptid;
-- int stack_per;
--};
--
- /* FIXME: move all this conditional compilation in description
- files or in configure.in */
-
-@@ -267,7 +236,6 @@ static void get_tcb_call_type_info (stru
- int *atcb_call_self_fieldno);
- static CORE_ADDR get_known_tasks_addr (void);
- static int read_known_tasks_array (void);
--static int build_task_list (void);
- static void value_as_string (char *dest, struct value *val, int length);
- static struct task_control_block read_atcb (CORE_ADDR atcb_addr);
- static CORE_ADDR read_caller (const CORE_ADDR call);
-@@ -283,9 +251,9 @@ static void ada_tasks_attach_observers (
-
- int ada__tasks_check_symbol_table = 1;
- CORE_ADDR pthread_kern_addr = 0;
-+struct task_entry *task_list = NULL;
-
- /* Local global variables. */
--static struct task_entry *task_list = NULL;
-
- /* When non-zero, this flag indicates that the current task_list
- is obsolete, and should be recomputed before it is accessed. */
-@@ -850,8 +818,8 @@ read_known_tasks_array (void)
- the inferior. Prints an appropriate message and returns non-zero
- if it failed to build this list. */
-
--static int
--build_task_list (void)
-+int
-+ada_build_task_list (void)
- {
- if (!target_has_stack)
- error ("No stack");
-@@ -1306,7 +1274,7 @@ info_tasks (char *arg, int from_tty)
- static void
- info_tasks_command (char *arg, int from_tty)
- {
-- const int task_list_built = build_task_list ();
-+ const int task_list_built = ada_build_task_list ();
-
- if (!task_list_built)
- return;
-@@ -1358,13 +1326,10 @@ switch_to_task (struct task_entry *new_t
- select_frame (get_current_frame ());
- return ret_code;
- }
-- else if (task_ptid_get_pid (new_task->task_ptid) != 0) /* ?? */
-- {
-- switch_to_thread (task_ptid_get_ptid (new_task->task_ptid));
-- return 0;
-- }
-+
-+ switch_to_thread (task_ptid_get_ptid (new_task->task_ptid));
- #endif
-- return -1;
-+ return 0;
- }
-
- /* Print a message telling the user id of the current task.
-@@ -1412,7 +1377,7 @@ task_command_1 (char *tidstr, int from_t
- static void
- task_command (char *tidstr, int from_tty)
- {
-- const int task_list_built = build_task_list ();
-+ const int task_list_built = ada_build_task_list ();
-
- if (!task_list_built)
- return;
-
projects / packages / gdb.git / commitdiff