--- /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
+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
+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