X-Git-Url: http://drtracing.org/?a=blobdiff_plain;f=gdb%2Fada-exp.y;h=0a33e10485a6be6cd41ff49b70f840bbc5fc11b0;hb=a3405d124e1388b613a35af49f19f0cc1b8d959d;hp=70e6e089dd554eb50d0e2e9545f39db2e47ac250;hpb=22abf04a5d5485d051adac9d2447ad2fcbfb2704;p=deliverable%2Fbinutils-gdb.git diff --git a/gdb/ada-exp.y b/gdb/ada-exp.y index 70e6e089dd..0a33e10485 100644 --- a/gdb/ada-exp.y +++ b/gdb/ada-exp.y @@ -1,22 +1,20 @@ /* 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-2016 Free Software Foundation, Inc. -This file is part of GDB. + This file is part of GDB. -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ /* Parse an Ada expression from text in a string, and return the result as a struct expression pointer. @@ -34,11 +32,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ 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" -#include #include #include "expression.h" #include "value.h" @@ -51,65 +48,30 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "frame.h" #include "block.h" -/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc), - as well as gratuitiously global symbol names, so we can have multiple - 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. */ - -/* NOTE: This is clumsy, especially since BISON and FLEX provide --prefix - options. I presume we are maintaining it to accommodate systems - without BISON? (PNH) */ - -#define yymaxdepth ada_maxdepth -#define yyparse _ada_parse /* ada_parse calls this after initialization */ -#define yylex ada_lex -#define yyerror ada_error -#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 yyexca ada_exca -#define yyerrflag ada_errflag -#define yynerrs ada_nerrs -#define yyps ada_ps -#define yypv ada_pv -#define yys ada_s -#define yy_yys ada_yys -#define yystate ada_state -#define yytmp ada_tmp -#define yyv ada_v -#define yy_yyv ada_yyv -#define yyval ada_val -#define yylloc ada_lloc -#define yyreds ada_reds /* With YYDEBUG defined */ -#define yytoks ada_toks /* With YYDEBUG defined */ -#define yyname ada_name /* With YYDEBUG defined */ -#define yyrule ada_rule /* With YYDEBUG defined */ - -#ifndef YYDEBUG -#define YYDEBUG 1 /* Default to yydebug support */ -#endif - -#define YYFPRINTF parser_fprintf +#define parse_type(ps) builtin_type (parse_gdbarch (ps)) + +/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, + etc). */ +#define GDB_YY_REMAP_PREFIX ada_ +#include "yy-remap.h" struct name_info { - struct symbol* sym; - struct minimal_symbol* msym; - struct block* block; + struct symbol *sym; + struct minimal_symbol *msym; + const struct block *block; struct stoken stoken; }; +/* The state of the parser, used internally when we are parsing the + expression. */ + +static struct parser_state *pstate = NULL; + +static struct stoken empty_stoken = { "", 0 }; + /* 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); @@ -117,21 +79,46 @@ static int yylex (void); void yyerror (char *); -static struct stoken string_to_operator (struct stoken); +static void write_int (struct parser_state *, LONGEST, struct type *); -static void write_attribute_call0 (enum ada_attribute); +static void write_object_renaming (struct parser_state *, + const struct block *, const char *, int, + const char *, int); -static void write_attribute_call1 (enum ada_attribute, LONGEST); +static struct type* write_var_or_type (struct parser_state *, + const struct block *, struct stoken); -static void write_attribute_calln (enum ada_attribute, int); +static void write_name_assoc (struct parser_state *, struct stoken); -static void write_object_renaming (struct block*, struct symbol*); +static void write_exp_op_with_string (struct parser_state *, enum exp_opcode, + struct stoken); -static void write_var_from_name (struct block*, struct name_info); +static const struct block *block_lookup (const struct block *, const char *); -static LONGEST -convert_char_literal (struct type*, LONGEST); -%} +static LONGEST convert_char_literal (struct type *, LONGEST); + +static void write_ambiguous_var (struct parser_state *, + const struct block *, char *, int); + +static struct type *type_int (struct parser_state *); + +static struct type *type_long (struct parser_state *); + +static struct type *type_long_long (struct parser_state *); + +static struct type *type_float (struct parser_state *); + +static struct type *type_double (struct parser_state *); + +static struct type *type_long_double (struct parser_state *); + +static struct type *type_char (struct parser_state *); + +static struct type *type_boolean (struct parser_state *); + +static struct type *type_system_address (struct parser_state *); + +%} %union { @@ -146,32 +133,20 @@ convert_char_literal (struct type*, LONGEST); } typed_val_float; struct type *tval; struct stoken sval; - struct name_info ssym; - int voidval; - struct block *bval; + const struct block *bval; struct internalvar *ivar; - } -%type exp exp1 simple_exp start variable -%type type +%type positional_list component_groups component_associations +%type aggregate_component_list +%type var_or_type %token INT NULL_PTR CHARLIT %token FLOAT -%token TYPENAME -%token BLOCKNAME - -/* Both NAME and TYPENAME tokens represent symbols in the input, - and both convey their data as strings. - But a TYPENAME is a string that happens to be defined as a typedef - or builtin type name (such as int or char) - and a NAME is any other symbol. - Contexts where this distinction is not important can use the - nonterminal "name", which matches either NAME or TYPENAME. */ - -%token STRING -%token NAME DOT_ID OBJECT_RENAMING -%type block +%token TRUEKEYWORD FALSEKEYWORD +%token COLONCOLON +%token STRING NAME DOT_ID +%type block %type arglist tick_arglist %type save_qualifier @@ -180,9 +155,7 @@ convert_char_literal (struct type*, LONGEST); /* 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,66 +165,81 @@ convert_char_literal (struct type*, LONGEST); %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. */ + +/* Artificial token to give NAME => ... and NAME | priority over reducing + NAME to and to give ' priority over reducing + to . */ +%nonassoc VAR + +%nonassoc ARROW '|' + %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 + /* 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 '.' '(' '[' DOT_ID DOT_ALL -%token ARROW NEW +%token NEW OTHERS %% start : exp1 - | type { write_exp_elt_opcode (OP_TYPE); - write_exp_elt_type ($1); - write_exp_elt_opcode (OP_TYPE); } ; /* Expressions, including the sequencing operator. */ exp1 : exp | exp1 ';' exp - { write_exp_elt_opcode (BINOP_COMMA); } + { write_exp_elt_opcode (pstate, BINOP_COMMA); } + | primary ASSIGN exp /* Extension for convenience */ + { write_exp_elt_opcode (pstate, BINOP_ASSIGN); } ; /* Expressions, not including the sequencing operator. */ -simple_exp : simple_exp DOT_ALL - { write_exp_elt_opcode (UNOP_IND); } +primary : primary DOT_ALL + { write_exp_elt_opcode (pstate, UNOP_IND); } ; -simple_exp : simple_exp DOT_ID - { write_exp_elt_opcode (STRUCTOP_STRUCT); - write_exp_string ($2.stoken); - write_exp_elt_opcode (STRUCTOP_STRUCT); - } +primary : primary DOT_ID + { write_exp_op_with_string (pstate, STRUCTOP_STRUCT, + $2); } ; -simple_exp : simple_exp '(' arglist ')' +primary : primary '(' arglist ')' { - write_exp_elt_opcode (OP_FUNCALL); - write_exp_elt_longcst ($3); - write_exp_elt_opcode (OP_FUNCALL); + write_exp_elt_opcode (pstate, OP_FUNCALL); + write_exp_elt_longcst (pstate, $3); + write_exp_elt_opcode (pstate, OP_FUNCALL); } - ; - -simple_exp : type '(' exp ')' + | var_or_type '(' arglist ')' { - write_exp_elt_opcode (UNOP_CAST); - write_exp_elt_type ($1); - write_exp_elt_opcode (UNOP_CAST); + if ($1 != NULL) + { + if ($3 != 1) + error (_("Invalid conversion")); + write_exp_elt_opcode (pstate, UNOP_CAST); + write_exp_elt_type (pstate, $1); + write_exp_elt_opcode (pstate, UNOP_CAST); + } + else + { + write_exp_elt_opcode (pstate, OP_FUNCALL); + write_exp_elt_longcst (pstate, $3); + write_exp_elt_opcode (pstate, OP_FUNCALL); + } } ; -simple_exp : type '\'' save_qualifier { type_qualifier = $1; } '(' exp ')' +primary : var_or_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_type ($1); - /* write_exp_elt_opcode (UNOP_QUAL); */ - /* FIXME: UNOP_QUAL should be defined in expression.h */ + if ($1 == NULL) + error (_("Type required for qualification")); + write_exp_elt_opcode (pstate, UNOP_QUAL); + write_exp_elt_type (pstate, $1); + write_exp_elt_opcode (pstate, UNOP_QUAL); type_qualifier = $3; } ; @@ -259,60 +247,62 @@ simple_exp : type '\'' save_qualifier { type_qualifier = $1; } '(' exp ')' save_qualifier : { $$ = type_qualifier; } ; -simple_exp : - simple_exp '(' exp DOTDOT exp ')' - { write_exp_elt_opcode (TERNOP_SLICE); } - ; - -simple_exp : '(' exp1 ')' { } +primary : + primary '(' simple_exp DOTDOT simple_exp ')' + { write_exp_elt_opcode (pstate, TERNOP_SLICE); } + | var_or_type '(' simple_exp DOTDOT simple_exp ')' + { if ($1 == NULL) + write_exp_elt_opcode (pstate, TERNOP_SLICE); + else + error (_("Cannot slice a type")); + } ; -simple_exp : variable +primary : '(' exp1 ')' { } ; -simple_exp: REGNAME /* GDB extension */ - { write_exp_elt_opcode (OP_REGISTER); - write_exp_elt_longcst ((LONGEST) $1); - write_exp_elt_opcode (OP_REGISTER); - } - ; +/* The following rule causes a conflict with the type conversion + var_or_type (exp) + To get around it, we give '(' higher priority and add bridge rules for + var_or_type (exp, exp, ...) + var_or_type (exp .. exp) + We also have the action for var_or_type(exp) generate a function call + when the first symbol does not denote a type. */ -simple_exp: INTERNAL_VARIABLE /* GDB extension */ - { write_exp_elt_opcode (OP_INTERNALVAR); - write_exp_elt_intern ($1); - write_exp_elt_opcode (OP_INTERNALVAR); +primary : var_or_type %prec VAR + { if ($1 != NULL) + { + write_exp_elt_opcode (pstate, OP_TYPE); + write_exp_elt_type (pstate, $1); + write_exp_elt_opcode (pstate, OP_TYPE); + } } ; - -exp : simple_exp +primary : SPECIAL_VARIABLE /* Various GDB extensions */ + { write_dollar_variable (pstate, $1); } ; -simple_exp: LAST - { write_exp_elt_opcode (OP_LAST); - write_exp_elt_longcst ((LONGEST) $1); - write_exp_elt_opcode (OP_LAST); - } - ; +primary : aggregate + ; -exp : exp ASSIGN exp /* Extension for convenience */ - { write_exp_elt_opcode (BINOP_ASSIGN); } +simple_exp : primary ; -exp : '-' exp %prec UNARY - { write_exp_elt_opcode (UNOP_NEG); } +simple_exp : '-' simple_exp %prec UNARY + { write_exp_elt_opcode (pstate, UNOP_NEG); } ; -exp : '+' exp %prec UNARY - { write_exp_elt_opcode (UNOP_PLUS); } +simple_exp : '+' simple_exp %prec UNARY + { write_exp_elt_opcode (pstate, UNOP_PLUS); } ; -exp : NOT exp %prec UNARY - { write_exp_elt_opcode (UNOP_LOGICAL_NOT); } +simple_exp : NOT simple_exp %prec UNARY + { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); } ; -exp : ABS exp %prec UNARY - { write_exp_elt_opcode (UNOP_ABS); } +simple_exp : ABS simple_exp %prec UNARY + { write_exp_elt_opcode (pstate, UNOP_ABS); } ; arglist : { $$ = 0; } @@ -320,178 +310,208 @@ arglist : { $$ = 0; } arglist : exp { $$ = 1; } - | any_name ARROW exp + | NAME ARROW exp { $$ = 1; } | arglist ',' exp { $$ = $1 + 1; } - | arglist ',' any_name ARROW exp + | arglist ',' NAME ARROW exp { $$ = $1 + 1; } ; -exp : '{' type '}' exp %prec '.' +primary : '{' var_or_type '}' primary %prec '.' /* GDB extension */ - { write_exp_elt_opcode (UNOP_MEMVAL); - write_exp_elt_type ($2); - write_exp_elt_opcode (UNOP_MEMVAL); + { + if ($2 == NULL) + error (_("Type required within braces in coercion")); + write_exp_elt_opcode (pstate, UNOP_MEMVAL); + write_exp_elt_type (pstate, $2); + write_exp_elt_opcode (pstate, UNOP_MEMVAL); } ; /* Binary operators in order of decreasing precedence. */ -exp : exp STARSTAR exp - { write_exp_elt_opcode (BINOP_EXP); } +simple_exp : simple_exp STARSTAR simple_exp + { write_exp_elt_opcode (pstate, BINOP_EXP); } + ; + +simple_exp : simple_exp '*' simple_exp + { write_exp_elt_opcode (pstate, BINOP_MUL); } ; -exp : exp '*' exp - { write_exp_elt_opcode (BINOP_MUL); } +simple_exp : simple_exp '/' simple_exp + { write_exp_elt_opcode (pstate, BINOP_DIV); } ; -exp : exp '/' exp - { write_exp_elt_opcode (BINOP_DIV); } +simple_exp : simple_exp REM simple_exp /* May need to be fixed to give correct Ada REM */ + { write_exp_elt_opcode (pstate, BINOP_REM); } ; -exp : exp REM exp /* May need to be fixed to give correct Ada REM */ - { write_exp_elt_opcode (BINOP_REM); } +simple_exp : simple_exp MOD simple_exp + { write_exp_elt_opcode (pstate, BINOP_MOD); } ; -exp : exp MOD exp - { write_exp_elt_opcode (BINOP_MOD); } +simple_exp : simple_exp '@' simple_exp /* GDB extension */ + { write_exp_elt_opcode (pstate, BINOP_REPEAT); } ; -exp : exp '@' exp /* GDB extension */ - { write_exp_elt_opcode (BINOP_REPEAT); } +simple_exp : simple_exp '+' simple_exp + { write_exp_elt_opcode (pstate, BINOP_ADD); } ; -exp : exp '+' exp - { write_exp_elt_opcode (BINOP_ADD); } +simple_exp : simple_exp '&' simple_exp + { write_exp_elt_opcode (pstate, BINOP_CONCAT); } ; -exp : exp '&' exp - { write_exp_elt_opcode (BINOP_CONCAT); } +simple_exp : simple_exp '-' simple_exp + { write_exp_elt_opcode (pstate, BINOP_SUB); } ; -exp : exp '-' exp - { write_exp_elt_opcode (BINOP_SUB); } +relation : simple_exp ; -exp : exp '=' exp - { write_exp_elt_opcode (BINOP_EQUAL); } +relation : simple_exp '=' simple_exp + { write_exp_elt_opcode (pstate, BINOP_EQUAL); } ; -exp : exp NOTEQUAL exp - { write_exp_elt_opcode (BINOP_NOTEQUAL); } +relation : simple_exp NOTEQUAL simple_exp + { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); } ; -exp : exp LEQ exp - { write_exp_elt_opcode (BINOP_LEQ); } +relation : simple_exp LEQ simple_exp + { write_exp_elt_opcode (pstate, BINOP_LEQ); } ; -exp : exp IN exp DOTDOT exp - { /*write_exp_elt_opcode (TERNOP_MBR); */ } - /* FIXME: TERNOP_MBR should be defined in - expression.h */ - | 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_longcst ((LONGEST) $5); - /*write_exp_elt_opcode (BINOP_MBR); */ +relation : simple_exp IN simple_exp DOTDOT simple_exp + { write_exp_elt_opcode (pstate, TERNOP_IN_RANGE); } + | simple_exp IN primary TICK_RANGE tick_arglist + { write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS); + write_exp_elt_longcst (pstate, (LONGEST) $5); + write_exp_elt_opcode (pstate, 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_type ($3); - /* write_exp_elt_opcode (UNOP_MBR); */ - /* FIXME: UNOP_MBR should be defined in expression.h */ + | simple_exp IN var_or_type %prec TICK_ACCESS + { + if ($3 == NULL) + error (_("Right operand of 'in' must be type")); + write_exp_elt_opcode (pstate, UNOP_IN_RANGE); + write_exp_elt_type (pstate, $3); + write_exp_elt_opcode (pstate, 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); + | simple_exp NOT IN simple_exp DOTDOT simple_exp + { write_exp_elt_opcode (pstate, TERNOP_IN_RANGE); + write_exp_elt_opcode (pstate, 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_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); + | simple_exp NOT IN primary TICK_RANGE tick_arglist + { write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS); + write_exp_elt_longcst (pstate, (LONGEST) $6); + write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS); + write_exp_elt_opcode (pstate, 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_type ($4); - /* write_exp_elt_opcode (UNOP_MBR);*/ - /* FIXME: UNOP_MBR should be defined in expression.h */ - write_exp_elt_opcode (UNOP_LOGICAL_NOT); + | simple_exp NOT IN var_or_type %prec TICK_ACCESS + { + if ($4 == NULL) + error (_("Right operand of 'in' must be type")); + write_exp_elt_opcode (pstate, UNOP_IN_RANGE); + write_exp_elt_type (pstate, $4); + write_exp_elt_opcode (pstate, UNOP_IN_RANGE); + write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); } ; -exp : exp GEQ exp - { write_exp_elt_opcode (BINOP_GEQ); } +relation : simple_exp GEQ simple_exp + { write_exp_elt_opcode (pstate, BINOP_GEQ); } ; -exp : exp '<' exp - { write_exp_elt_opcode (BINOP_LESS); } +relation : simple_exp '<' simple_exp + { write_exp_elt_opcode (pstate, BINOP_LESS); } ; -exp : exp '>' exp - { write_exp_elt_opcode (BINOP_GTR); } +relation : simple_exp '>' simple_exp + { write_exp_elt_opcode (pstate, BINOP_GTR); } ; -exp : exp _AND_ exp /* Fix for Ada elementwise AND. */ - { write_exp_elt_opcode (BINOP_BITWISE_AND); } - ; +exp : relation + | and_exp + | and_then_exp + | or_exp + | or_else_exp + | xor_exp + ; -exp : exp _AND_ THEN exp %prec _AND_ - { write_exp_elt_opcode (BINOP_LOGICAL_AND); } - ; +and_exp : + relation _AND_ relation + { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); } + | and_exp _AND_ relation + { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); } + ; -exp : exp OR exp /* Fix for Ada elementwise OR */ - { write_exp_elt_opcode (BINOP_BITWISE_IOR); } +and_then_exp : + relation _AND_ THEN relation + { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); } + | and_then_exp _AND_ THEN relation + { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); } ; -exp : exp OR ELSE exp - { write_exp_elt_opcode (BINOP_LOGICAL_OR); } +or_exp : + relation OR relation + { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); } + | or_exp OR relation + { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); } + ; + +or_else_exp : + relation OR ELSE relation + { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); } + | or_else_exp OR ELSE relation + { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); } ; -exp : exp XOR exp /* Fix for Ada elementwise XOR */ - { write_exp_elt_opcode (BINOP_BITWISE_XOR); } +xor_exp : relation XOR relation + { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); } + | xor_exp XOR relation + { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); } ; -simple_exp : simple_exp TICK_ACCESS - { write_exp_elt_opcode (UNOP_ADDR); } - | simple_exp TICK_ADDRESS - { write_exp_elt_opcode (UNOP_ADDR); - write_exp_elt_opcode (UNOP_CAST); - write_exp_elt_type (builtin_type_ada_system_address); - write_exp_elt_opcode (UNOP_CAST); +/* Primaries can denote types (OP_TYPE). In cases such as + primary TICK_ADDRESS, where a type would be invalid, it will be + caught when evaluate_subexp in ada-lang.c tries to evaluate the + primary, expecting a value. Precedence rules resolve the ambiguity + in NAME TICK_ACCESS in favor of shifting to form a var_or_type. A + construct such as aType'access'access will again cause an error when + aType'access evaluates to a type that evaluate_subexp attempts to + evaluate. */ +primary : primary TICK_ACCESS + { write_exp_elt_opcode (pstate, UNOP_ADDR); } + | primary TICK_ADDRESS + { write_exp_elt_opcode (pstate, UNOP_ADDR); + write_exp_elt_opcode (pstate, UNOP_CAST); + write_exp_elt_type (pstate, + type_system_address (pstate)); + write_exp_elt_opcode (pstate, UNOP_CAST); } - | simple_exp TICK_FIRST tick_arglist - { write_attribute_call1 (ATR_FIRST, $3); } - | simple_exp TICK_LAST tick_arglist - { write_attribute_call1 (ATR_LAST, $3); } - | simple_exp TICK_LENGTH tick_arglist - { write_attribute_call1 (ATR_LENGTH, $3); } - | simple_exp TICK_SIZE - { write_attribute_call0 (ATR_SIZE); } - | simple_exp TICK_TAG - { write_attribute_call0 (ATR_TAG); } + | primary TICK_FIRST tick_arglist + { write_int (pstate, $3, type_int (pstate)); + write_exp_elt_opcode (pstate, OP_ATR_FIRST); } + | primary TICK_LAST tick_arglist + { write_int (pstate, $3, type_int (pstate)); + write_exp_elt_opcode (pstate, OP_ATR_LAST); } + | primary TICK_LENGTH tick_arglist + { write_int (pstate, $3, type_int (pstate)); + write_exp_elt_opcode (pstate, OP_ATR_LENGTH); } + | primary TICK_SIZE + { write_exp_elt_opcode (pstate, OP_ATR_SIZE); } + | primary TICK_TAG + { write_exp_elt_opcode (pstate, OP_ATR_TAG); } | opt_type_prefix TICK_MIN '(' exp ',' exp ')' - { write_attribute_calln (ATR_MIN, 2); } + { write_exp_elt_opcode (pstate, OP_ATR_MIN); } | opt_type_prefix TICK_MAX '(' exp ',' exp ')' - { write_attribute_calln (ATR_MAX, 2); } + { write_exp_elt_opcode (pstate, OP_ATR_MAX); } | opt_type_prefix TICK_POS '(' exp ')' - { write_attribute_calln (ATR_POS, 1); } - | type_prefix TICK_FIRST tick_arglist - { write_attribute_call1 (ATR_FIRST, $3); } - | type_prefix TICK_LAST tick_arglist - { write_attribute_call1 (ATR_LAST, $3); } - | type_prefix TICK_LENGTH tick_arglist - { write_attribute_call1 (ATR_LENGTH, $3); } + { write_exp_elt_opcode (pstate, OP_ATR_POS); } | type_prefix TICK_VAL '(' exp ')' - { write_attribute_calln (ATR_VAL, 1); } - | type_prefix TICK_MODULUS - { write_attribute_call0 (ATR_MODULUS); } + { write_exp_elt_opcode (pstate, OP_ATR_VAL); } + | type_prefix TICK_MODULUS + { write_exp_elt_opcode (pstate, OP_ATR_MODULUS); } ; tick_arglist : %prec '(' @@ -501,125 +521,186 @@ tick_arglist : %prec '(' ; type_prefix : - TYPENAME - { write_exp_elt_opcode (OP_TYPE); - write_exp_elt_type ($1); - write_exp_elt_opcode (OP_TYPE); } + var_or_type + { + if ($1 == NULL) + error (_("Prefix must be type")); + write_exp_elt_opcode (pstate, OP_TYPE); + write_exp_elt_type (pstate, $1); + write_exp_elt_opcode (pstate, OP_TYPE); } ; opt_type_prefix : type_prefix - | /* 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); + | /* EMPTY */ + { write_exp_elt_opcode (pstate, OP_TYPE); + write_exp_elt_type (pstate, + parse_type (pstate)->builtin_void); + write_exp_elt_opcode (pstate, OP_TYPE); } + ; + + +primary : INT + { write_int (pstate, (LONGEST) $1.val, $1.type); } + ; + +primary : CHARLIT + { write_int (pstate, + convert_char_literal (type_qualifier, $1.val), + (type_qualifier == NULL) + ? $1.type : type_qualifier); + } + ; + +primary : FLOAT + { write_exp_elt_opcode (pstate, OP_DOUBLE); + write_exp_elt_type (pstate, $1.type); + write_exp_elt_dblcst (pstate, $1.dval); + write_exp_elt_opcode (pstate, OP_DOUBLE); } ; -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); +primary : NULL_PTR + { write_int (pstate, 0, type_int (pstate)); } + ; + +primary : STRING + { + write_exp_op_with_string (pstate, OP_STRING, $1); } ; - -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); + +primary : TRUEKEYWORD + { write_int (pstate, 1, type_boolean (pstate)); } + | FALSEKEYWORD + { write_int (pstate, 0, type_boolean (pstate)); } + ; + +primary : NEW NAME + { error (_("NEW not implemented.")); } + ; + +var_or_type: NAME %prec VAR + { $$ = write_var_or_type (pstate, NULL, $1); } + | block NAME %prec VAR + { $$ = write_var_or_type (pstate, $1, $2); } + | NAME TICK_ACCESS + { + $$ = write_var_or_type (pstate, NULL, $1); + if ($$ == NULL) + write_exp_elt_opcode (pstate, UNOP_ADDR); + else + $$ = lookup_pointer_type ($$); + } + | block NAME TICK_ACCESS + { + $$ = write_var_or_type (pstate, $1, $2); + if ($$ == NULL) + write_exp_elt_opcode (pstate, UNOP_ADDR); + else + $$ = lookup_pointer_type ($$); } ; -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); - } - ; - -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); - } +/* GDB extension */ +block : NAME COLONCOLON + { $$ = block_lookup (NULL, $1.ptr); } + | block NAME COLONCOLON + { $$ = block_lookup ($1, $2.ptr); } ; -exp : NEW TYPENAME - { error ("NEW not implemented."); } +aggregate : + '(' aggregate_component_list ')' + { + write_exp_elt_opcode (pstate, OP_AGGREGATE); + write_exp_elt_longcst (pstate, $2); + write_exp_elt_opcode (pstate, OP_AGGREGATE); + } ; -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); } +aggregate_component_list : + component_groups { $$ = $1; } + | positional_list exp + { write_exp_elt_opcode (pstate, OP_POSITIONAL); + write_exp_elt_longcst (pstate, $1); + write_exp_elt_opcode (pstate, OP_POSITIONAL); + $$ = $1 + 1; + } + | positional_list component_groups + { $$ = $1 + $2; } ; -any_name : NAME { } - | TYPENAME { } - | OBJECT_RENAMING { } - ; +positional_list : + exp ',' + { write_exp_elt_opcode (pstate, OP_POSITIONAL); + write_exp_elt_longcst (pstate, 0); + write_exp_elt_opcode (pstate, OP_POSITIONAL); + $$ = 1; + } + | positional_list exp ',' + { write_exp_elt_opcode (pstate, OP_POSITIONAL); + write_exp_elt_longcst (pstate, $1); + write_exp_elt_opcode (pstate, OP_POSITIONAL); + $$ = $1 + 1; + } + ; -block : BLOCKNAME /* GDB extension */ - { $$ = $1; } - | block BLOCKNAME /* GDB extension */ - { $$ = $2; } +component_groups: + others { $$ = 1; } + | component_group { $$ = 1; } + | component_group ',' component_groups + { $$ = $3 + 1; } ; +others : OTHERS ARROW exp + { write_exp_elt_opcode (pstate, OP_OTHERS); } + ; -type : TYPENAME { $$ = $1; } - | block TYPENAME { $$ = $2; } - | TYPENAME TICK_ACCESS - { $$ = lookup_pointer_type ($1); } - | block TYPENAME TICK_ACCESS - { $$ = lookup_pointer_type ($2); } - ; +component_group : + component_associations + { + write_exp_elt_opcode (pstate, OP_CHOICES); + write_exp_elt_longcst (pstate, $1); + write_exp_elt_opcode (pstate, OP_CHOICES); + } + ; -/* Some extensions borrowed from C, for the benefit of those who find they - can't get used to Ada notation in GDB. */ +/* We use this somewhat obscure definition in order to handle NAME => and + NAME | differently from exp => and exp |. ARROW and '|' have a precedence + above that of the reduction of NAME to var_or_type. By delaying + decisions until after the => or '|', we convert the ambiguity to a + resolved shift/reduce conflict. */ +component_associations : + NAME ARROW + { write_name_assoc (pstate, $1); } + exp { $$ = 1; } + | simple_exp ARROW exp + { $$ = 1; } + | simple_exp DOTDOT simple_exp ARROW + { write_exp_elt_opcode (pstate, OP_DISCRETE_RANGE); + write_exp_op_with_string (pstate, OP_NAME, + empty_stoken); + } + exp { $$ = 1; } + | NAME '|' + { write_name_assoc (pstate, $1); } + component_associations { $$ = $4 + 1; } + | simple_exp '|' + component_associations { $$ = $3 + 1; } + | simple_exp DOTDOT simple_exp '|' + { write_exp_elt_opcode (pstate, OP_DISCRETE_RANGE); } + component_associations { $$ = $6 + 1; } + ; -exp : '*' exp %prec '.' - { write_exp_elt_opcode (UNOP_IND); } - | '&' exp %prec '.' - { write_exp_elt_opcode (UNOP_ADDR); } - | exp '[' exp ']' - { write_exp_elt_opcode (BINOP_SUBSCRIPT); } +/* Some extensions borrowed from C, for the benefit of those who find they + can't get used to Ada notation in GDB. */ + +primary : '*' primary %prec '.' + { write_exp_elt_opcode (pstate, UNOP_IND); } + | '&' primary %prec '.' + { write_exp_elt_opcode (pstate, UNOP_ADDR); } + | primary '[' exp ']' + { write_exp_elt_opcode (pstate, BINOP_SUBSCRIPT); } ; %% @@ -642,273 +723,204 @@ 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 (struct parser_state *par_state) { - lexer_init (yyin); /* (Re-)initialize lexer. */ - left_block_context = NULL; + int result; + struct cleanup *c = make_cleanup_clear_parser_state (&pstate); + + /* Setting up the parser state. */ + gdb_assert (par_state != NULL); + pstate = par_state; + + lexer_init (yyin); /* (Re-)initialize lexer. */ type_qualifier = NULL; - - return _ada_parse (); -} + obstack_free (&temp_parse_space, NULL); + obstack_init (&temp_parse_space); -void -yyerror (msg) - char *msg; -{ - error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr); + result = yyparse (); + do_cleanups (c); + return result; } -/* 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. */ - -static struct stoken -string_to_operator (string) - struct stoken string; +void +yyerror (char *msg) { - int i; - - for (i = 0; ada_opname_table[i].mangled != NULL; i += 1) - { - if (string.length == strlen (ada_opname_table[i].demangled)-2 - && strncasecmp (string.ptr, ada_opname_table[i].demangled+1, - string.length) == 0) - { - strncpy (string.ptr, ada_opname_table[i].demangled, - string.length+2); - string.length += 2; - return string; - } - } - error ("Invalid operator symbol `%s'", string.ptr); + error (_("Error in expression, near `%s'."), lexptr); } /* 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 parser_state *par_state, + const struct block *orig_left_context, + const struct block *block, + struct symbol *sym) { if (orig_left_context == NULL && symbol_read_needs_frame (sym)) { - if (innermost_block == 0 || - contained_in (block, innermost_block)) + if (innermost_block == 0 + || contained_in (block, innermost_block)) innermost_block = block; } - 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_sym (sym); - write_exp_elt_opcode (OP_VAR_VALUE); + write_exp_elt_opcode (par_state, OP_VAR_VALUE); + write_exp_elt_block (par_state, block); + write_exp_elt_sym (par_state, sym); + write_exp_elt_opcode (par_state, OP_VAR_VALUE); } -/* Emit expression to access an instance of NAME. */ -static void -write_var_from_name (orig_left_context, name) - struct block* orig_left_context; - struct name_info name; -{ - if (name.msym != NULL) - { - write_exp_msymbol (name.msym, - lookup_function_type (builtin_type_int), - builtin_type_int); - } - 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 */ - 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 */ - } - else - write_var_from_sym (orig_left_context, name.block, name.sym); -} - -/* Write a call on parameterless attribute ATR. */ +/* Write integer or boolean constant ARG of type TYPE. */ static void -write_attribute_call0 (atr) - enum ada_attribute atr; +write_int (struct parser_state *par_state, LONGEST arg, struct type *type) { - /* 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_exp_elt_opcode (par_state, OP_LONG); + write_exp_elt_type (par_state, type); + write_exp_elt_longcst (par_state, arg); + write_exp_elt_opcode (par_state, OP_LONG); } -/* Write a call on an attribute ATR with one constant integer - * parameter. */ - +/* Write an OPCODE, string, OPCODE sequence to the current expression. */ static void -write_attribute_call1 (atr, arg) - enum ada_attribute atr; - LONGEST arg; +write_exp_op_with_string (struct parser_state *par_state, + enum exp_opcode opcode, struct stoken token) { - write_exp_elt_opcode (OP_LONG); - write_exp_elt_type (builtin_type_int); - 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. */ + write_exp_elt_opcode (par_state, opcode); + write_exp_string (par_state, token); + write_exp_elt_opcode (par_state, opcode); +} + +/* Emit expression corresponding to the renamed object named + * designated by RENAMED_ENTITY[0 .. RENAMED_ENTITY_LEN-1] in the + * context of ORIG_LEFT_CONTEXT, to which is applied the operations + * encoded by RENAMING_EXPR. MAX_DEPTH is the maximum number of + * cascaded renamings to allow. If ORIG_LEFT_CONTEXT is null, it + * defaults to the currently selected block. ORIG_SYMBOL is the + * symbol that originally encoded the renaming. It is needed only + * because its prefix also qualifies any index variables used to index + * or slice an array. It should not be necessary once we go to the + * new encoding entirely (FIXME pnh 7/20/2007). */ static void -write_attribute_calln (atr, n) - enum ada_attribute atr; - int n; +write_object_renaming (struct parser_state *par_state, + const struct block *orig_left_context, + const char *renamed_entity, int renamed_entity_len, + const char *renaming_expr, int max_depth) { - /*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 - * the type RENAMING, which must be the referent of an object renaming - * type, in the context of ORIG_LEFT_CONTEXT (?). */ -static void -write_object_renaming (orig_left_context, renaming) - struct block* orig_left_context; - struct symbol* renaming; -{ - 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; + char *name; enum { SIMPLE_INDEX, LOWER_BOUND, UPPER_BOUND } slice_state; + struct block_symbol sym_info; + + 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 */ if (orig_left_context == NULL) orig_left_context = get_selected_block (NULL); - for (simple_tail = qualification + strlen (qualification); - simple_tail != qualification; simple_tail -= 1) - { - if (*simple_tail == '.') - { - simple_tail += 1; - break; - } - else if (STREQN (simple_tail, "__", 2)) - { - simple_tail += 2; - break; - } - } + name = (char *) obstack_copy0 (&temp_parse_space, renamed_entity, + renamed_entity_len); + ada_lookup_encoded_symbol (name, orig_left_context, VAR_DOMAIN, &sym_info); + if (sym_info.symbol == NULL) + error (_("Could not find renamed variable: %s"), ada_decode (name)); + else if (SYMBOL_CLASS (sym_info.symbol) == LOC_TYPEDEF) + /* We have a renaming of an old-style renaming symbol. Don't + trust the block information. */ + sym_info.block = orig_left_context; + + { + const char *inner_renamed_entity; + int inner_renamed_entity_len; + const char *inner_renaming_expr; + + switch (ada_parse_renaming (sym_info.symbol, &inner_renamed_entity, + &inner_renamed_entity_len, + &inner_renaming_expr)) + { + case ADA_NOT_RENAMING: + write_var_from_sym (par_state, orig_left_context, sym_info.block, + sym_info.symbol); + break; + case ADA_OBJECT_RENAMING: + write_object_renaming (par_state, sym_info.block, + inner_renamed_entity, inner_renamed_entity_len, + inner_renaming_expr, max_depth - 1); + break; + default: + goto BadEncoding; + } + } - suffix = strstr (expr, "___XE"); - 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 */ - strncpy (name, expr, suffix-expr); - name[suffix-expr] = '\000'; - sym = lookup_symbol (name, orig_left_context, VAR_NAMESPACE, 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); - - suffix += 5; slice_state = SIMPLE_INDEX; - while (*suffix == 'X') + while (*renaming_expr == 'X') { - suffix += 1; + renaming_expr += 1; - switch (*suffix) { + switch (*renaming_expr) { + case 'A': + renaming_expr += 1; + write_exp_elt_opcode (par_state, UNOP_IND); + break; case 'L': slice_state = LOWER_BOUND; + /* FALLTHROUGH */ case 'S': - suffix += 1; - if (isdigit (*suffix)) + renaming_expr += 1; + if (isdigit (*renaming_expr)) { - char* next; - long val = strtol (suffix, &next, 10); - if (next == suffix) + char *next; + long val = strtol (renaming_expr, &next, 10); + if (next == renaming_expr) 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); - } + renaming_expr = next; + write_exp_elt_opcode (par_state, OP_LONG); + write_exp_elt_type (par_state, type_int (par_state)); + write_exp_elt_longcst (par_state, (LONGEST) val); + write_exp_elt_opcode (par_state, OP_LONG); + } else { - const char* end; - char* index_name; - int index_len; - struct symbol* index_sym; - - end = strchr (suffix, 'X'); - if (end == NULL) - end = suffix + strlen (suffix); - - index_len = simple_tail - qualification + 2 + (suffix - end) + 1; - index_name = (char*) malloc (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 = - lookup_symbol (index_name, NULL, VAR_NAMESPACE, 0, NULL); - if (index_sym == NULL) - error ("Could not find %s", index_name); - write_var_from_sym (NULL, block_found, sym); + const char *end; + char *index_name; + struct block_symbol index_sym_info; + + end = strchr (renaming_expr, 'X'); + if (end == NULL) + end = renaming_expr + strlen (renaming_expr); + + index_name + = (char *) obstack_copy0 (&temp_parse_space, renaming_expr, + end - renaming_expr); + renaming_expr = end; + + ada_lookup_encoded_symbol (index_name, NULL, VAR_DOMAIN, + &index_sym_info); + if (index_sym_info.symbol == NULL) + error (_("Could not find %s"), index_name); + else if (SYMBOL_CLASS (index_sym_info.symbol) == LOC_TYPEDEF) + /* Index is an old-style renaming symbol. */ + index_sym_info.block = orig_left_context; + write_var_from_sym (par_state, NULL, index_sym_info.block, + index_sym_info.symbol); } if (slice_state == SIMPLE_INDEX) - { - write_exp_elt_opcode (OP_FUNCALL); - write_exp_elt_longcst ((LONGEST) 1); - write_exp_elt_opcode (OP_FUNCALL); + { + write_exp_elt_opcode (par_state, OP_FUNCALL); + write_exp_elt_longcst (par_state, (LONGEST) 1); + write_exp_elt_opcode (par_state, OP_FUNCALL); } else if (slice_state == LOWER_BOUND) slice_state = UPPER_BOUND; else if (slice_state == UPPER_BOUND) { - write_exp_elt_opcode (TERNOP_SLICE); + write_exp_elt_opcode (par_state, TERNOP_SLICE); slice_state = SIMPLE_INDEX; } break; @@ -916,25 +928,26 @@ write_object_renaming (orig_left_context, renaming) case 'R': { struct stoken field_name; - const char* end; - suffix += 1; - + const char *end; + char *buf; + + renaming_expr += 1; + if (slice_state != SIMPLE_INDEX) goto BadEncoding; - end = strchr (suffix, 'X'); - if (end == NULL) - end = suffix + strlen (suffix); - field_name.length = end - suffix; - 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); + end = strchr (renaming_expr, 'X'); + if (end == NULL) + end = renaming_expr + strlen (renaming_expr); + field_name.length = end - renaming_expr; + buf = (char *) malloc (end - renaming_expr + 1); + field_name.ptr = buf; + strncpy (buf, renaming_expr, end - renaming_expr); + buf[end - renaming_expr] = '\000'; + renaming_expr = end; + write_exp_op_with_string (par_state, STRUCTOP_STRUCT, field_name); break; } - + default: goto BadEncoding; } @@ -943,27 +956,539 @@ write_object_renaming (orig_left_context, renaming) return; BadEncoding: - error ("Internal error in encoding of renaming declaration: %s", - DEPRECATED_SYMBOL_NAME (renaming)); + error (_("Internal error in encoding of renaming declaration")); +} + +static const struct block* +block_lookup (const struct block *context, const char *raw_name) +{ + const char *name; + struct block_symbol *syms; + int nsyms; + struct symtab *symtab; + + if (raw_name[0] == '\'') + { + raw_name += 1; + name = raw_name; + } + else + name = ada_encode (raw_name); + + nsyms = ada_lookup_symbol_list (name, context, VAR_DOMAIN, &syms); + if (context == NULL + && (nsyms == 0 || SYMBOL_CLASS (syms[0].symbol) != LOC_BLOCK)) + symtab = lookup_symtab (name); + else + symtab = NULL; + + if (symtab != NULL) + return BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (symtab), STATIC_BLOCK); + else if (nsyms == 0 || SYMBOL_CLASS (syms[0].symbol) != LOC_BLOCK) + { + if (context == NULL) + error (_("No file or function \"%s\"."), raw_name); + else + error (_("No function \"%s\" in specified context."), raw_name); + } + else + { + if (nsyms > 1) + warning (_("Function name \"%s\" ambiguous here"), raw_name); + return SYMBOL_BLOCK_VALUE (syms[0].symbol); + } +} + +static struct symbol* +select_possible_type_sym (struct block_symbol *syms, int nsyms) +{ + int i; + int preferred_index; + struct type *preferred_type; + + preferred_index = -1; preferred_type = NULL; + for (i = 0; i < nsyms; i += 1) + switch (SYMBOL_CLASS (syms[i].symbol)) + { + case LOC_TYPEDEF: + if (ada_prefer_type (SYMBOL_TYPE (syms[i].symbol), preferred_type)) + { + preferred_index = i; + preferred_type = SYMBOL_TYPE (syms[i].symbol); + } + break; + case LOC_REGISTER: + case LOC_ARG: + case LOC_REF_ARG: + case LOC_REGPARM_ADDR: + case LOC_LOCAL: + case LOC_COMPUTED: + return NULL; + default: + break; + } + if (preferred_type == NULL) + return NULL; + return syms[preferred_index].symbol; +} + +static struct type* +find_primitive_type (struct parser_state *par_state, char *name) +{ + struct type *type; + type = language_lookup_primitive_type (parse_language (par_state), + parse_gdbarch (par_state), + name); + if (type == NULL && strcmp ("system__address", name) == 0) + type = type_system_address (par_state); + + if (type != NULL) + { + /* Check to see if we have a regular definition of this + type that just didn't happen to have been read yet. */ + 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).symbol; + if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF) + type = SYMBOL_TYPE (sym); + } + + return type; +} + +static int +chop_selector (char *name, int end) +{ + int i; + for (i = end - 1; i > 0; i -= 1) + if (name[i] == '.' || (name[i] == '_' && name[i+1] == '_')) + return i; + return -1; +} + +/* If NAME is a string beginning with a separator (either '__', or + '.'), chop this separator and return the result; else, return + NAME. */ + +static char * +chop_separator (char *name) +{ + if (*name == '.') + return name + 1; + + if (name[0] == '_' && name[1] == '_') + return name + 2; + + return name; +} + +/* Given that SELS is a string of the form ()*, where + is '__' or '.', write the indicated sequence of + STRUCTOP_STRUCT expression operators. */ +static void +write_selectors (struct parser_state *par_state, char *sels) +{ + while (*sels != '\0') + { + struct stoken field_name; + char *p = chop_separator (sels); + sels = p; + while (*sels != '\0' && *sels != '.' + && (sels[0] != '_' || sels[1] != '_')) + sels += 1; + field_name.length = sels - p; + field_name.ptr = p; + write_exp_op_with_string (par_state, STRUCTOP_STRUCT, field_name); + } +} + +/* Write a variable access (OP_VAR_VALUE) to ambiguous encoded name + NAME[0..LEN-1], in block context BLOCK, to be resolved later. Writes + a temporary symbol that is valid until the next call to ada_parse. + */ +static void +write_ambiguous_var (struct parser_state *par_state, + const struct block *block, char *name, int len) +{ + struct symbol *sym = XOBNEW (&temp_parse_space, struct symbol); + + memset (sym, 0, sizeof (struct symbol)); + SYMBOL_DOMAIN (sym) = UNDEF_DOMAIN; + SYMBOL_LINKAGE_NAME (sym) + = (const char *) obstack_copy0 (&temp_parse_space, name, len); + SYMBOL_LANGUAGE (sym) = language_ada; + + write_exp_elt_opcode (par_state, OP_VAR_VALUE); + write_exp_elt_block (par_state, block); + write_exp_elt_sym (par_state, sym); + write_exp_elt_opcode (par_state, OP_VAR_VALUE); +} + +/* A convenient wrapper around ada_get_field_index that takes + a non NUL-terminated FIELD_NAME0 and a FIELD_NAME_LEN instead + of a NUL-terminated field name. */ + +static int +ada_nget_field_index (const struct type *type, const char *field_name0, + int field_name_len, int maybe_missing) +{ + char *field_name = (char *) alloca ((field_name_len + 1) * sizeof (char)); + + strncpy (field_name, field_name0, field_name_len); + field_name[field_name_len] = '\0'; + return ada_get_field_index (type, field_name, maybe_missing); +} + +/* If encoded_field_name is the name of a field inside symbol SYM, + then return the type of that field. Otherwise, return NULL. + + This function is actually recursive, so if ENCODED_FIELD_NAME + doesn't match one of the fields of our symbol, then try to see + if ENCODED_FIELD_NAME could not be a succession of field names + (in other words, the user entered an expression of the form + TYPE_NAME.FIELD1.FIELD2.FIELD3), in which case we evaluate + each field name sequentially to obtain the desired field type. + In case of failure, we return NULL. */ + +static struct type * +get_symbol_field_type (struct symbol *sym, char *encoded_field_name) +{ + char *field_name = encoded_field_name; + char *subfield_name; + struct type *type = SYMBOL_TYPE (sym); + int fieldno; + + if (type == NULL || field_name == NULL) + return NULL; + type = check_typedef (type); + + while (field_name[0] != '\0') + { + field_name = chop_separator (field_name); + + fieldno = ada_get_field_index (type, field_name, 1); + if (fieldno >= 0) + return TYPE_FIELD_TYPE (type, fieldno); + + subfield_name = field_name; + while (*subfield_name != '\0' && *subfield_name != '.' + && (subfield_name[0] != '_' || subfield_name[1] != '_')) + subfield_name += 1; + + if (subfield_name[0] == '\0') + return NULL; + + fieldno = ada_nget_field_index (type, field_name, + subfield_name - field_name, 1); + if (fieldno < 0) + return NULL; + + type = TYPE_FIELD_TYPE (type, fieldno); + field_name = subfield_name; + } + + return NULL; +} + +/* Look up NAME0 (an unencoded identifier or dotted name) in BLOCK (or + expression_block_context if NULL). If it denotes a type, return + that type. Otherwise, write expression code to evaluate it as an + object and return NULL. In this second case, NAME0 will, in general, + have the form (.)*, where is an object + or renaming encoded in the debugging data. Calls error if no + prefix matches a name in the debugging data (i.e., matches + either a complete name or, as a wild-card match, the final + identifier). */ + +static struct type* +write_var_or_type (struct parser_state *par_state, + const struct block *block, struct stoken name0) +{ + int depth; + char *encoded_name; + int name_len; + + if (block == NULL) + block = expression_context_block; + + encoded_name = ada_encode (name0.ptr); + name_len = strlen (encoded_name); + encoded_name + = (char *) obstack_copy0 (&temp_parse_space, encoded_name, name_len); + for (depth = 0; depth < MAX_RENAMING_CHAIN_LENGTH; depth += 1) + { + int tail_index; + + tail_index = name_len; + while (tail_index > 0) + { + int nsyms; + struct block_symbol *syms; + struct symbol *type_sym; + struct symbol *renaming_sym; + const char* renaming; + int renaming_len; + const char* renaming_expr; + int terminator = encoded_name[tail_index]; + + encoded_name[tail_index] = '\0'; + nsyms = ada_lookup_symbol_list (encoded_name, block, + VAR_DOMAIN, &syms); + encoded_name[tail_index] = terminator; + + /* A single symbol may rename a package or object. */ + + /* This should go away when we move entirely to new version. + FIXME pnh 7/20/2007. */ + if (nsyms == 1) + { + struct symbol *ren_sym = + ada_find_renaming_symbol (syms[0].symbol, syms[0].block); + + if (ren_sym != NULL) + syms[0].symbol = ren_sym; + } + + type_sym = select_possible_type_sym (syms, nsyms); + + if (type_sym != NULL) + renaming_sym = type_sym; + else if (nsyms == 1) + renaming_sym = syms[0].symbol; + else + renaming_sym = NULL; + + switch (ada_parse_renaming (renaming_sym, &renaming, + &renaming_len, &renaming_expr)) + { + case ADA_NOT_RENAMING: + break; + case ADA_PACKAGE_RENAMING: + case ADA_EXCEPTION_RENAMING: + case ADA_SUBPROGRAM_RENAMING: + { + int alloc_len = renaming_len + name_len - tail_index + 1; + char *new_name + = (char *) obstack_alloc (&temp_parse_space, alloc_len); + strncpy (new_name, renaming, renaming_len); + strcpy (new_name + renaming_len, encoded_name + tail_index); + encoded_name = new_name; + name_len = renaming_len + name_len - tail_index; + goto TryAfterRenaming; + } + case ADA_OBJECT_RENAMING: + write_object_renaming (par_state, block, renaming, renaming_len, + renaming_expr, MAX_RENAMING_CHAIN_LENGTH); + write_selectors (par_state, encoded_name + tail_index); + return NULL; + default: + internal_error (__FILE__, __LINE__, + _("impossible value from ada_parse_renaming")); + } + + if (type_sym != NULL) + { + struct type *field_type; + + if (tail_index == name_len) + return SYMBOL_TYPE (type_sym); + + /* We have some extraneous characters after the type name. + If this is an expression "TYPE_NAME.FIELD0.[...].FIELDN", + then try to get the type of FIELDN. */ + field_type + = get_symbol_field_type (type_sym, encoded_name + tail_index); + if (field_type != NULL) + return field_type; + else + error (_("Invalid attempt to select from type: \"%s\"."), + name0.ptr); + } + else if (tail_index == name_len && nsyms == 0) + { + struct type *type = find_primitive_type (par_state, + encoded_name); + + if (type != NULL) + return type; + } + + if (nsyms == 1) + { + write_var_from_sym (par_state, block, syms[0].block, + syms[0].symbol); + write_selectors (par_state, encoded_name + tail_index); + return NULL; + } + else if (nsyms == 0) + { + struct bound_minimal_symbol msym + = ada_lookup_simple_minsym (encoded_name); + if (msym.minsym != NULL) + { + write_exp_msymbol (par_state, msym); + /* Maybe cause error here rather than later? FIXME? */ + write_selectors (par_state, encoded_name + tail_index); + return NULL; + } + + if (tail_index == name_len + && strncmp (encoded_name, "standard__", + sizeof ("standard__") - 1) == 0) + error (_("No definition of \"%s\" found."), name0.ptr); + + tail_index = chop_selector (encoded_name, tail_index); + } + else + { + write_ambiguous_var (par_state, block, encoded_name, + tail_index); + write_selectors (par_state, encoded_name + tail_index); + return NULL; + } + } + + if (!have_full_symbols () && !have_partial_symbols () && block == NULL) + error (_("No symbol table is loaded. Use the \"file\" command.")); + if (block == expression_context_block) + error (_("No definition of \"%s\" in current context."), name0.ptr); + else + error (_("No definition of \"%s\" in specified context."), name0.ptr); + + TryAfterRenaming: ; + } + + error (_("Could not find renamed symbol \"%s\""), name0.ptr); + +} + +/* Write a left side of a component association (e.g., NAME in NAME => + exp). If NAME has the form of a selected component, write it as an + ordinary expression. If it is a simple variable that unambiguously + corresponds to exactly one symbol that does not denote a type or an + object renaming, also write it normally as an OP_VAR_VALUE. + Otherwise, write it as an OP_NAME. + + Unfortunately, we don't know at this point whether NAME is supposed + to denote a record component name or the value of an array index. + Therefore, it is not appropriate to disambiguate an ambiguous name + as we normally would, nor to replace a renaming with its referent. + As a result, in the (one hopes) rare case that one writes an + aggregate such as (R => 42) where R renames an object or is an + ambiguous name, one must write instead ((R) => 42). */ + +static void +write_name_assoc (struct parser_state *par_state, struct stoken name) +{ + if (strchr (name.ptr, '.') == NULL) + { + struct block_symbol *syms; + int nsyms = ada_lookup_symbol_list (name.ptr, expression_context_block, + VAR_DOMAIN, &syms); + + if (nsyms != 1 || SYMBOL_CLASS (syms[0].symbol) == LOC_TYPEDEF) + write_exp_op_with_string (par_state, OP_NAME, name); + else + write_var_from_sym (par_state, NULL, syms[0].block, syms[0].symbol); + } + else + if (write_var_or_type (par_state, NULL, name) != NULL) + error (_("Invalid use of type.")); } /* 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; - if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM) + if (type == NULL) return val; - sprintf (name, "QU%02x", (int) val); - for (f = 0; f < TYPE_NFIELDS (type); f += 1) + type = check_typedef (type); + if (TYPE_CODE (type) != TYPE_CODE_ENUM) + return val; + + xsnprintf (name, sizeof (name), "QU%02x", (int) val); + for (f = 0; f < TYPE_NFIELDS (type); f += 1) { - if (STREQ (name, TYPE_FIELD_NAME (type, f))) - return TYPE_FIELD_BITPOS (type, f); + if (strcmp (name, TYPE_FIELD_NAME (type, f)) == 0) + return TYPE_FIELD_ENUMVAL (type, f); } return val; } + +static struct type * +type_int (struct parser_state *par_state) +{ + return parse_type (par_state)->builtin_int; +} + +static struct type * +type_long (struct parser_state *par_state) +{ + return parse_type (par_state)->builtin_long; +} + +static struct type * +type_long_long (struct parser_state *par_state) +{ + return parse_type (par_state)->builtin_long_long; +} + +static struct type * +type_float (struct parser_state *par_state) +{ + return parse_type (par_state)->builtin_float; +} + +static struct type * +type_double (struct parser_state *par_state) +{ + return parse_type (par_state)->builtin_double; +} + +static struct type * +type_long_double (struct parser_state *par_state) +{ + return parse_type (par_state)->builtin_long_double; +} + +static struct type * +type_char (struct parser_state *par_state) +{ + return language_string_char_type (parse_language (par_state), + parse_gdbarch (par_state)); +} + +static struct type * +type_boolean (struct parser_state *par_state) +{ + return parse_type (par_state)->builtin_bool; +} + +static struct type * +type_system_address (struct parser_state *par_state) +{ + struct type *type + = language_lookup_primitive_type (parse_language (par_state), + parse_gdbarch (par_state), + "system__address"); + return type != NULL ? type : parse_type (par_state)->builtin_data_ptr; +} + +/* Provide a prototype to silence -Wmissing-prototypes. */ +extern initialize_file_ftype _initialize_ada_exp; + +void +_initialize_ada_exp (void) +{ + obstack_init (&temp_parse_space); +}