From: Jakub Bogusz Date: Wed, 23 Jun 2004 18:24:18 +0000 (+0000) Subject: - ada updates (from gdb-patches) X-Git-Tag: auto/ac/gdb-6_1_1-1~4 X-Git-Url: http://git.pld-linux.org/?a=commitdiff_plain;h=78c1db5edb536133bacc989910c287f13d0a2770;p=packages%2Fgdb.git - ada updates (from gdb-patches) Changed files: gdb-ada-update1.patch -> 1.1 gdb-ada-update2b.patch -> 1.1 gdb-ada-update3.patch -> 1.1 gdb-ada-update5.patch -> 1.1 --- diff --git a/gdb-ada-update1.patch b/gdb-ada-update1.patch new file mode 100644 index 0000000..846eb90 --- /dev/null +++ b/gdb-ada-update1.patch @@ -0,0 +1,1825 @@ +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: +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: +List-Archive: +List-Post: +List-Help: , +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 ; 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 ; + 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 +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 + + * 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 ( and 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 STRING ++%token STRING + %token NAME DOT_ID OBJECT_RENAMING +-%type block ++%type block + %type arglist tick_arglist + + %type 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 LAST REGNAME +- +-%token INTERNAL_VARIABLE ++%token 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); } + +-\" { ++\" { + 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; + } + diff --git a/gdb-ada-update2b.patch b/gdb-ada-update2b.patch new file mode 100644 index 0000000..2603732 --- /dev/null +++ b/gdb-ada-update2b.patch @@ -0,0 +1,3279 @@ +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: +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: +List-Archive: +List-Post: +List-Help: , +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 ; 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 ; + 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 +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: + } + + +- /* 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 + } + + +- /* 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 + } + + +- /* 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; + } + ++ /* Operators */ ++/* Information about operators given special treatment in functions ++ below. */ ++/* Format: OP_DEFN (, , <# args>, ). */ ++ ++#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} + }; + +- /* 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 "". 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, "", objfile); ++ TARGET_INT_BIT / TARGET_CHAR_BIT, ++ 0, "", 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 + diff --git a/gdb-ada-update3.patch b/gdb-ada-update3.patch new file mode 100644 index 0000000..3d6efae --- /dev/null +++ b/gdb-ada-update3.patch @@ -0,0 +1,2813 @@ +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: +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: +List-Archive: +List-Post: +List-Help: , +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 ; 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 ; + 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 +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 + + This program is free software; you can redistribute it and/or modify +@@ -15,6 +15,7 @@ + */ + + #include ++#include + #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 + #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 ("\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 (" \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, ""); ++ 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 + #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 *); + + +-/* 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, + diff --git a/gdb-ada-update5.patch b/gdb-ada-update5.patch new file mode 100644 index 0000000..70abb7f --- /dev/null +++ b/gdb-ada-update5.patch @@ -0,0 +1,2384 @@ +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: +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: +List-Archive: +List-Post: +List-Help: , +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 ; 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 ; + 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 +To: gdb-patches at sources dot redhat dot com +Cc: +In-reply-to: (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> +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 + + * 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 + #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; ++} + + /* Symbols */ + +@@ -3597,6 +3647,13 @@ ada_convert_actuals (struct value *func, + + /* 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 */ + + /* 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, "") == 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: ++ _____. ++ 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 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, "") == 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: +- _____. +- 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 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); ++ } ++ } ++} ++ ++#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 */ + ++#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 + +- + /* 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; +