1/* YACC parser for Ada expressions, for GDB. 2 Copyright (C) 1986, 1989, 1990, 1991, 1993, 1994, 1997, 2000, 2003, 2004, 3 2007 Free Software Foundation, Inc. 4 5This file is part of GDB. 6 7This program is free software; you can redistribute it and/or modify 8it under the terms of the GNU General Public License as published by 9the Free Software Foundation; either version 2 of the License, or 10(at your option) any later version. 11 12This program is distributed in the hope that it will be useful, 13but WITHOUT ANY WARRANTY; without even the implied warranty of 14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15GNU General Public License for more details. 16 17You should have received a copy of the GNU General Public License 18along with this program; if not, write to the Free Software 19Foundation, Inc., 51 Franklin Street, Fifth Floor, 20Boston, MA 02110-1301, USA. */ 21 22/* Parse an Ada expression from text in a string, 23 and return the result as a struct expression pointer. 24 That structure contains arithmetic operations in reverse polish, 25 with constants represented by operations that are followed by special data. 26 See expression.h for the details of the format. 27 What is important here is that it can be built up sequentially 28 during the process of parsing; the lower levels of the tree always 29 come first in the result. 30 31 malloc's and realloc's in this file are transformed to 32 xmalloc and xrealloc respectively by the same sed command in the 33 makefile that remaps any other malloc/realloc inserted by the parser 34 generator. Doing this with #defines and trying to control the interaction 35 with include files (<malloc.h> and <stdlib.h> for example) just became 36 too messy, particularly when such includes can be inserted at random 37 times by the parser generator. */ 38 39%{ 40 41#include "defs.h" 42#include "gdb_string.h" 43#include <ctype.h> 44#include "expression.h" 45#include "value.h" 46#include "parser-defs.h" 47#include "language.h" 48#include "ada-lang.h" 49#include "bfd.h" /* Required by objfiles.h. */ 50#include "symfile.h" /* Required by objfiles.h. */ 51#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */ 52#include "frame.h" 53#include "block.h" 54 55/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc), 56 as well as gratuitiously global symbol names, so we can have multiple 57 yacc generated parsers in gdb. These are only the variables 58 produced by yacc. If other parser generators (bison, byacc, etc) produce 59 additional global names that conflict at link time, then those parser 60 generators need to be fixed instead of adding those names to this list. */ 61 62/* NOTE: This is clumsy, especially since BISON and FLEX provide --prefix 63 options. I presume we are maintaining it to accommodate systems 64 without BISON? (PNH) */ 65 66#define yymaxdepth ada_maxdepth 67#define yyparse _ada_parse /* ada_parse calls this after initialization */ 68#define yylex ada_lex 69#define yyerror ada_error 70#define yylval ada_lval 71#define yychar ada_char 72#define yydebug ada_debug 73#define yypact ada_pact 74#define yyr1 ada_r1 75#define yyr2 ada_r2 76#define yydef ada_def 77#define yychk ada_chk 78#define yypgo ada_pgo 79#define yyact ada_act 80#define yyexca ada_exca 81#define yyerrflag ada_errflag 82#define yynerrs ada_nerrs 83#define yyps ada_ps 84#define yypv ada_pv 85#define yys ada_s 86#define yy_yys ada_yys 87#define yystate ada_state 88#define yytmp ada_tmp 89#define yyv ada_v 90#define yy_yyv ada_yyv 91#define yyval ada_val 92#define yylloc ada_lloc 93#define yyreds ada_reds /* With YYDEBUG defined */ 94#define yytoks ada_toks /* With YYDEBUG defined */ 95#define yyname ada_name /* With YYDEBUG defined */ 96#define yyrule ada_rule /* With YYDEBUG defined */ 97 98#ifndef YYDEBUG 99#define YYDEBUG 1 /* Default to yydebug support */ 100#endif 101 102#define YYFPRINTF parser_fprintf 103 104struct name_info { 105 struct symbol *sym; 106 struct minimal_symbol *msym; 107 struct block *block; 108 struct stoken stoken; 109}; 110 111static struct stoken empty_stoken = { "", 0 }; 112 113/* If expression is in the context of TYPE'(...), then TYPE, else 114 * NULL. */ 115static struct type *type_qualifier; 116 117int yyparse (void); 118 119static int yylex (void); 120 121void yyerror (char *); 122 123static struct stoken string_to_operator (struct stoken); 124 125static void write_int (LONGEST, struct type *); 126 127static void write_object_renaming (struct block *, struct symbol *, int); 128 129static struct type* write_var_or_type (struct block *, struct stoken); 130 131static void write_name_assoc (struct stoken); 132 133static void write_exp_op_with_string (enum exp_opcode, struct stoken); 134 135static struct block *block_lookup (struct block *, char *); 136 137static LONGEST convert_char_literal (struct type *, LONGEST); 138 139static void write_ambiguous_var (struct block *, char *, int); 140 141static struct type *type_int (void); 142 143static struct type *type_long (void); 144 145static struct type *type_long_long (void); 146 147static struct type *type_float (void); 148 149static struct type *type_double (void); 150 151static struct type *type_long_double (void); 152 153static struct type *type_char (void); 154 155static struct type *type_system_address (void); 156 157%} 158 159%union 160 { 161 LONGEST lval; 162 struct { 163 LONGEST val; 164 struct type *type; 165 } typed_val; 166 struct { 167 DOUBLEST dval; 168 struct type *type; 169 } typed_val_float; 170 struct type *tval; 171 struct stoken sval; 172 struct block *bval; 173 struct internalvar *ivar; 174 } 175 176%type <lval> positional_list component_groups component_associations 177%type <lval> aggregate_component_list 178%type <tval> var_or_type 179 180%token <typed_val> INT NULL_PTR CHARLIT 181%token <typed_val_float> FLOAT 182%token COLONCOLON 183%token <sval> STRING NAME DOT_ID 184%type <bval> block 185%type <lval> arglist tick_arglist 186 187%type <tval> save_qualifier 188 189%token DOT_ALL 190 191/* Special type cases, put in to allow the parser to distinguish different 192 legal basetypes. */ 193%token <sval> SPECIAL_VARIABLE 194 195%nonassoc ASSIGN 196%left _AND_ OR XOR THEN ELSE 197%left '=' NOTEQUAL '<' '>' LEQ GEQ IN DOTDOT 198%left '@' 199%left '+' '-' '&' 200%left UNARY 201%left '*' '/' MOD REM 202%right STARSTAR ABS NOT 203 204/* Artificial token to give NAME => ... and NAME | priority over reducing 205 NAME to <primary> and to give <primary>' priority over reducing <primary> 206 to <simple_exp>. */ 207%nonassoc VAR 208 209%nonassoc ARROW '|' 210 211%right TICK_ACCESS TICK_ADDRESS TICK_FIRST TICK_LAST TICK_LENGTH 212%right TICK_MAX TICK_MIN TICK_MODULUS 213%right TICK_POS TICK_RANGE TICK_SIZE TICK_TAG TICK_VAL 214 /* The following are right-associative only so that reductions at this 215 precedence have lower precedence than '.' and '('. The syntax still 216 forces a.b.c, e.g., to be LEFT-associated. */ 217%right '.' '(' '[' DOT_ID DOT_ALL 218 219%token NEW OTHERS 220 221 222%% 223 224start : exp1 225 ; 226 227/* Expressions, including the sequencing operator. */ 228exp1 : exp 229 | exp1 ';' exp 230 { write_exp_elt_opcode (BINOP_COMMA); } 231 | primary ASSIGN exp /* Extension for convenience */ 232 { write_exp_elt_opcode (BINOP_ASSIGN); } 233 ; 234 235/* Expressions, not including the sequencing operator. */ 236primary : primary DOT_ALL 237 { write_exp_elt_opcode (UNOP_IND); } 238 ; 239 240primary : primary DOT_ID 241 { write_exp_op_with_string (STRUCTOP_STRUCT, $2); } 242 ; 243 244primary : primary '(' arglist ')' 245 { 246 write_exp_elt_opcode (OP_FUNCALL); 247 write_exp_elt_longcst ($3); 248 write_exp_elt_opcode (OP_FUNCALL); 249 } 250 | var_or_type '(' arglist ')' 251 { 252 if ($1 != NULL) 253 { 254 if ($3 != 1) 255 error (_("Invalid conversion")); 256 write_exp_elt_opcode (UNOP_CAST); 257 write_exp_elt_type ($1); 258 write_exp_elt_opcode (UNOP_CAST); 259 } 260 else 261 { 262 write_exp_elt_opcode (OP_FUNCALL); 263 write_exp_elt_longcst ($3); 264 write_exp_elt_opcode (OP_FUNCALL); 265 } 266 } 267 ; 268 269primary : var_or_type '\'' save_qualifier { type_qualifier = $1; } 270 '(' exp ')' 271 { 272 if ($1 == NULL) 273 error (_("Type required for qualification")); 274 write_exp_elt_opcode (UNOP_QUAL); 275 write_exp_elt_type ($1); 276 write_exp_elt_opcode (UNOP_QUAL); 277 type_qualifier = $3; 278 } 279 ; 280 281save_qualifier : { $$ = type_qualifier; } 282 ; 283 284primary : 285 primary '(' simple_exp DOTDOT simple_exp ')' 286 { write_exp_elt_opcode (TERNOP_SLICE); } 287 | var_or_type '(' simple_exp DOTDOT simple_exp ')' 288 { if ($1 == NULL) 289 write_exp_elt_opcode (TERNOP_SLICE); 290 else 291 error (_("Cannot slice a type")); 292 } 293 ; 294 295primary : '(' exp1 ')' { } 296 ; 297 298/* The following rule causes a conflict with the type conversion 299 var_or_type (exp) 300 To get around it, we give '(' higher priority and add bridge rules for 301 var_or_type (exp, exp, ...) 302 var_or_type (exp .. exp) 303 We also have the action for var_or_type(exp) generate a function call 304 when the first symbol does not denote a type. */ 305 306primary : var_or_type %prec VAR 307 { if ($1 != NULL) 308 { 309 write_exp_elt_opcode (OP_TYPE); 310 write_exp_elt_type ($1); 311 write_exp_elt_opcode (OP_TYPE); 312 } 313 } 314 ; 315 316primary : SPECIAL_VARIABLE /* Various GDB extensions */ 317 { write_dollar_variable ($1); } 318 ; 319 320primary : aggregate 321 ; 322 323simple_exp : primary 324 ; 325 326simple_exp : '-' simple_exp %prec UNARY 327 { write_exp_elt_opcode (UNOP_NEG); } 328 ; 329 330simple_exp : '+' simple_exp %prec UNARY 331 { write_exp_elt_opcode (UNOP_PLUS); } 332 ; 333 334simple_exp : NOT simple_exp %prec UNARY 335 { write_exp_elt_opcode (UNOP_LOGICAL_NOT); } 336 ; 337 338simple_exp : ABS simple_exp %prec UNARY 339 { write_exp_elt_opcode (UNOP_ABS); } 340 ; 341 342arglist : { $$ = 0; } 343 ; 344 345arglist : exp 346 { $$ = 1; } 347 | NAME ARROW exp 348 { $$ = 1; } 349 | arglist ',' exp 350 { $$ = $1 + 1; } 351 | arglist ',' NAME ARROW exp 352 { $$ = $1 + 1; } 353 ; 354 355simple_exp : '{' var_or_type '}' simple_exp %prec '.' 356 /* GDB extension */ 357 { 358 if ($2 == NULL) 359 error (_("Type required within braces in coercion")); 360 write_exp_elt_opcode (UNOP_MEMVAL); 361 write_exp_elt_type ($2); 362 write_exp_elt_opcode (UNOP_MEMVAL); 363 } 364 ; 365 366/* Binary operators in order of decreasing precedence. */ 367 368simple_exp : simple_exp STARSTAR simple_exp 369 { write_exp_elt_opcode (BINOP_EXP); } 370 ; 371 372simple_exp : simple_exp '*' simple_exp 373 { write_exp_elt_opcode (BINOP_MUL); } 374 ; 375 376simple_exp : simple_exp '/' simple_exp 377 { write_exp_elt_opcode (BINOP_DIV); } 378 ; 379 380simple_exp : simple_exp REM simple_exp /* May need to be fixed to give correct Ada REM */ 381 { write_exp_elt_opcode (BINOP_REM); } 382 ; 383 384simple_exp : simple_exp MOD simple_exp 385 { write_exp_elt_opcode (BINOP_MOD); } 386 ; 387 388simple_exp : simple_exp '@' simple_exp /* GDB extension */ 389 { write_exp_elt_opcode (BINOP_REPEAT); } 390 ; 391 392simple_exp : simple_exp '+' simple_exp 393 { write_exp_elt_opcode (BINOP_ADD); } 394 ; 395 396simple_exp : simple_exp '&' simple_exp 397 { write_exp_elt_opcode (BINOP_CONCAT); } 398 ; 399 400simple_exp : simple_exp '-' simple_exp 401 { write_exp_elt_opcode (BINOP_SUB); } 402 ; 403 404relation : simple_exp 405 ; 406 407relation : simple_exp '=' simple_exp 408 { write_exp_elt_opcode (BINOP_EQUAL); } 409 ; 410 411relation : simple_exp NOTEQUAL simple_exp 412 { write_exp_elt_opcode (BINOP_NOTEQUAL); } 413 ; 414 415relation : simple_exp LEQ simple_exp 416 { write_exp_elt_opcode (BINOP_LEQ); } 417 ; 418 419relation : simple_exp IN simple_exp DOTDOT simple_exp 420 { write_exp_elt_opcode (TERNOP_IN_RANGE); } 421 | simple_exp IN primary TICK_RANGE tick_arglist 422 { write_exp_elt_opcode (BINOP_IN_BOUNDS); 423 write_exp_elt_longcst ((LONGEST) $5); 424 write_exp_elt_opcode (BINOP_IN_BOUNDS); 425 } 426 | simple_exp IN var_or_type %prec TICK_ACCESS 427 { 428 if ($3 == NULL) 429 error (_("Right operand of 'in' must be type")); 430 write_exp_elt_opcode (UNOP_IN_RANGE); 431 write_exp_elt_type ($3); 432 write_exp_elt_opcode (UNOP_IN_RANGE); 433 } 434 | simple_exp NOT IN simple_exp DOTDOT simple_exp 435 { write_exp_elt_opcode (TERNOP_IN_RANGE); 436 write_exp_elt_opcode (UNOP_LOGICAL_NOT); 437 } 438 | simple_exp NOT IN primary TICK_RANGE tick_arglist 439 { write_exp_elt_opcode (BINOP_IN_BOUNDS); 440 write_exp_elt_longcst ((LONGEST) $6); 441 write_exp_elt_opcode (BINOP_IN_BOUNDS); 442 write_exp_elt_opcode (UNOP_LOGICAL_NOT); 443 } 444 | simple_exp NOT IN var_or_type %prec TICK_ACCESS 445 { 446 if ($4 == NULL) 447 error (_("Right operand of 'in' must be type")); 448 write_exp_elt_opcode (UNOP_IN_RANGE); 449 write_exp_elt_type ($4); 450 write_exp_elt_opcode (UNOP_IN_RANGE); 451 write_exp_elt_opcode (UNOP_LOGICAL_NOT); 452 } 453 ; 454 455relation : simple_exp GEQ simple_exp 456 { write_exp_elt_opcode (BINOP_GEQ); } 457 ; 458 459relation : simple_exp '<' simple_exp 460 { write_exp_elt_opcode (BINOP_LESS); } 461 ; 462 463relation : simple_exp '>' simple_exp 464 { write_exp_elt_opcode (BINOP_GTR); } 465 ; 466 467exp : relation 468 | and_exp 469 | and_then_exp 470 | or_exp 471 | or_else_exp 472 | xor_exp 473 ; 474 475and_exp : 476 relation _AND_ relation 477 { write_exp_elt_opcode (BINOP_BITWISE_AND); } 478 | and_exp _AND_ relation 479 { write_exp_elt_opcode (BINOP_BITWISE_AND); } 480 ; 481 482and_then_exp : 483 relation _AND_ THEN relation 484 { write_exp_elt_opcode (BINOP_LOGICAL_AND); } 485 | and_then_exp _AND_ THEN relation 486 { write_exp_elt_opcode (BINOP_LOGICAL_AND); } 487 ; 488 489or_exp : 490 relation OR relation 491 { write_exp_elt_opcode (BINOP_BITWISE_IOR); } 492 | or_exp OR relation 493 { write_exp_elt_opcode (BINOP_BITWISE_IOR); } 494 ; 495 496or_else_exp : 497 relation OR ELSE relation 498 { write_exp_elt_opcode (BINOP_LOGICAL_OR); } 499 | or_else_exp OR ELSE relation 500 { write_exp_elt_opcode (BINOP_LOGICAL_OR); } 501 ; 502 503xor_exp : relation XOR relation 504 { write_exp_elt_opcode (BINOP_BITWISE_XOR); } 505 | xor_exp XOR relation 506 { write_exp_elt_opcode (BINOP_BITWISE_XOR); } 507 ; 508 509/* Primaries can denote types (OP_TYPE). In cases such as 510 primary TICK_ADDRESS, where a type would be invalid, it will be 511 caught when evaluate_subexp in ada-lang.c tries to evaluate the 512 primary, expecting a value. Precedence rules resolve the ambiguity 513 in NAME TICK_ACCESS in favor of shifting to form a var_or_type. A 514 construct such as aType'access'access will again cause an error when 515 aType'access evaluates to a type that evaluate_subexp attempts to 516 evaluate. */ 517primary : primary TICK_ACCESS 518 { write_exp_elt_opcode (UNOP_ADDR); } 519 | primary TICK_ADDRESS 520 { write_exp_elt_opcode (UNOP_ADDR); 521 write_exp_elt_opcode (UNOP_CAST); 522 write_exp_elt_type (type_system_address ()); 523 write_exp_elt_opcode (UNOP_CAST); 524 } 525 | primary TICK_FIRST tick_arglist 526 { write_int ($3, type_int ()); 527 write_exp_elt_opcode (OP_ATR_FIRST); } 528 | primary TICK_LAST tick_arglist 529 { write_int ($3, type_int ()); 530 write_exp_elt_opcode (OP_ATR_LAST); } 531 | primary TICK_LENGTH tick_arglist 532 { write_int ($3, type_int ()); 533 write_exp_elt_opcode (OP_ATR_LENGTH); } 534 | primary TICK_SIZE 535 { write_exp_elt_opcode (OP_ATR_SIZE); } 536 | primary TICK_TAG 537 { write_exp_elt_opcode (OP_ATR_TAG); } 538 | opt_type_prefix TICK_MIN '(' exp ',' exp ')' 539 { write_exp_elt_opcode (OP_ATR_MIN); } 540 | opt_type_prefix TICK_MAX '(' exp ',' exp ')' 541 { write_exp_elt_opcode (OP_ATR_MAX); } 542 | opt_type_prefix TICK_POS '(' exp ')' 543 { write_exp_elt_opcode (OP_ATR_POS); } 544 | type_prefix TICK_VAL '(' exp ')' 545 { write_exp_elt_opcode (OP_ATR_VAL); } 546 | type_prefix TICK_MODULUS 547 { write_exp_elt_opcode (OP_ATR_MODULUS); } 548 ; 549 550tick_arglist : %prec '(' 551 { $$ = 1; } 552 | '(' INT ')' 553 { $$ = $2.val; } 554 ; 555 556type_prefix : 557 var_or_type 558 { 559 if ($1 == NULL) 560 error (_("Prefix must be type")); 561 write_exp_elt_opcode (OP_TYPE); 562 write_exp_elt_type ($1); 563 write_exp_elt_opcode (OP_TYPE); } 564 ; 565 566opt_type_prefix : 567 type_prefix 568 | /* EMPTY */ 569 { write_exp_elt_opcode (OP_TYPE); 570 write_exp_elt_type (builtin_type_void); 571 write_exp_elt_opcode (OP_TYPE); } 572 ; 573 574 575primary : INT 576 { write_int ((LONGEST) $1.val, $1.type); } 577 ; 578 579primary : CHARLIT 580 { write_int (convert_char_literal (type_qualifier, $1.val), 581 (type_qualifier == NULL) 582 ? $1.type : type_qualifier); 583 } 584 ; 585 586primary : FLOAT 587 { write_exp_elt_opcode (OP_DOUBLE); 588 write_exp_elt_type ($1.type); 589 write_exp_elt_dblcst ($1.dval); 590 write_exp_elt_opcode (OP_DOUBLE); 591 } 592 ; 593 594primary : NULL_PTR 595 { write_int (0, type_int ()); } 596 ; 597 598primary : STRING 599 { 600 write_exp_op_with_string (OP_STRING, $1); 601 } 602 ; 603 604primary : NEW NAME 605 { error (_("NEW not implemented.")); } 606 ; 607 608var_or_type: NAME %prec VAR 609 { $$ = write_var_or_type (NULL, $1); } 610 | block NAME %prec VAR 611 { $$ = write_var_or_type ($1, $2); } 612 | NAME TICK_ACCESS 613 { 614 $$ = write_var_or_type (NULL, $1); 615 if ($$ == NULL) 616 write_exp_elt_opcode (UNOP_ADDR); 617 else 618 $$ = lookup_pointer_type ($$); 619 } 620 | block NAME TICK_ACCESS 621 { 622 $$ = write_var_or_type ($1, $2); 623 if ($$ == NULL) 624 write_exp_elt_opcode (UNOP_ADDR); 625 else 626 $$ = lookup_pointer_type ($$); 627 } 628 ; 629 630/* GDB extension */ 631block : NAME COLONCOLON 632 { $$ = block_lookup (NULL, $1.ptr); } 633 | block NAME COLONCOLON 634 { $$ = block_lookup ($1, $2.ptr); } 635 ; 636 637aggregate : 638 '(' aggregate_component_list ')' 639 { 640 write_exp_elt_opcode (OP_AGGREGATE); 641 write_exp_elt_longcst ($2); 642 write_exp_elt_opcode (OP_AGGREGATE); 643 } 644 ; 645 646aggregate_component_list : 647 component_groups { $$ = $1; } 648 | positional_list exp 649 { write_exp_elt_opcode (OP_POSITIONAL); 650 write_exp_elt_longcst ($1); 651 write_exp_elt_opcode (OP_POSITIONAL); 652 $$ = $1 + 1; 653 } 654 | positional_list component_groups 655 { $$ = $1 + $2; } 656 ; 657 658positional_list : 659 exp ',' 660 { write_exp_elt_opcode (OP_POSITIONAL); 661 write_exp_elt_longcst (0); 662 write_exp_elt_opcode (OP_POSITIONAL); 663 $$ = 1; 664 } 665 | positional_list exp ',' 666 { write_exp_elt_opcode (OP_POSITIONAL); 667 write_exp_elt_longcst ($1); 668 write_exp_elt_opcode (OP_POSITIONAL); 669 $$ = $1 + 1; 670 } 671 ; 672 673component_groups: 674 others { $$ = 1; } 675 | component_group { $$ = 1; } 676 | component_group ',' component_groups 677 { $$ = $3 + 1; } 678 ; 679 680others : OTHERS ARROW exp 681 { write_exp_elt_opcode (OP_OTHERS); } 682 ; 683 684component_group : 685 component_associations 686 { 687 write_exp_elt_opcode (OP_CHOICES); 688 write_exp_elt_longcst ($1); 689 write_exp_elt_opcode (OP_CHOICES); 690 } 691 ; 692 693/* We use this somewhat obscure definition in order to handle NAME => and 694 NAME | differently from exp => and exp |. ARROW and '|' have a precedence 695 above that of the reduction of NAME to var_or_type. By delaying 696 decisions until after the => or '|', we convert the ambiguity to a 697 resolved shift/reduce conflict. */ 698component_associations : 699 NAME ARROW 700 { write_name_assoc ($1); } 701 exp { $$ = 1; } 702 | simple_exp ARROW exp 703 { $$ = 1; } 704 | simple_exp DOTDOT simple_exp ARROW 705 { write_exp_elt_opcode (OP_DISCRETE_RANGE); 706 write_exp_op_with_string (OP_NAME, empty_stoken); 707 } 708 exp { $$ = 1; } 709 | NAME '|' 710 { write_name_assoc ($1); } 711 component_associations { $$ = $4 + 1; } 712 | simple_exp '|' 713 component_associations { $$ = $3 + 1; } 714 | simple_exp DOTDOT simple_exp '|' 715 { write_exp_elt_opcode (OP_DISCRETE_RANGE); } 716 component_associations { $$ = $6 + 1; } 717 ; 718 719/* Some extensions borrowed from C, for the benefit of those who find they 720 can't get used to Ada notation in GDB. */ 721 722primary : '*' primary %prec '.' 723 { write_exp_elt_opcode (UNOP_IND); } 724 | '&' primary %prec '.' 725 { write_exp_elt_opcode (UNOP_ADDR); } 726 | primary '[' exp ']' 727 { write_exp_elt_opcode (BINOP_SUBSCRIPT); } 728 ; 729 730%% 731 732/* yylex defined in ada-lex.c: Reads one token, getting characters */ 733/* through lexptr. */ 734 735/* Remap normal flex interface names (yylex) as well as gratuitiously */ 736/* global symbol names, so we can have multiple flex-generated parsers */ 737/* in gdb. */ 738 739/* (See note above on previous definitions for YACC.) */ 740 741#define yy_create_buffer ada_yy_create_buffer 742#define yy_delete_buffer ada_yy_delete_buffer 743#define yy_init_buffer ada_yy_init_buffer 744#define yy_load_buffer_state ada_yy_load_buffer_state 745#define yy_switch_to_buffer ada_yy_switch_to_buffer 746#define yyrestart ada_yyrestart 747#define yytext ada_yytext 748#define yywrap ada_yywrap 749 750static struct obstack temp_parse_space; 751 752/* The following kludge was found necessary to prevent conflicts between */ 753/* defs.h and non-standard stdlib.h files. */ 754#define qsort __qsort__dummy 755#include "ada-lex.c" 756 757int 758ada_parse (void) 759{ 760 lexer_init (yyin); /* (Re-)initialize lexer. */ 761 type_qualifier = NULL; 762 obstack_free (&temp_parse_space, NULL); 763 obstack_init (&temp_parse_space); 764 765 return _ada_parse (); 766} 767 768void 769yyerror (char *msg) 770{ 771 error (_("Error in expression, near `%s'."), lexptr); 772} 773 774/* The operator name corresponding to operator symbol STRING (adds 775 quotes and maps to lower-case). Destroys the previous contents of 776 the array pointed to by STRING.ptr. Error if STRING does not match 777 a valid Ada operator. Assumes that STRING.ptr points to a 778 null-terminated string and that, if STRING is a valid operator 779 symbol, the array pointed to by STRING.ptr contains at least 780 STRING.length+3 characters. */ 781 782static struct stoken 783string_to_operator (struct stoken string) 784{ 785 int i; 786 787 for (i = 0; ada_opname_table[i].encoded != NULL; i += 1) 788 { 789 if (string.length == strlen (ada_opname_table[i].decoded)-2 790 && strncasecmp (string.ptr, ada_opname_table[i].decoded+1, 791 string.length) == 0) 792 { 793 strncpy (string.ptr, ada_opname_table[i].decoded, 794 string.length+2); 795 string.length += 2; 796 return string; 797 } 798 } 799 error (_("Invalid operator symbol `%s'"), string.ptr); 800} 801 802/* Emit expression to access an instance of SYM, in block BLOCK (if 803 * non-NULL), and with :: qualification ORIG_LEFT_CONTEXT. */ 804static void 805write_var_from_sym (struct block *orig_left_context, 806 struct block *block, 807 struct symbol *sym) 808{ 809 if (orig_left_context == NULL && symbol_read_needs_frame (sym)) 810 { 811 if (innermost_block == 0 812 || contained_in (block, innermost_block)) 813 innermost_block = block; 814 } 815 816 write_exp_elt_opcode (OP_VAR_VALUE); 817 write_exp_elt_block (block); 818 write_exp_elt_sym (sym); 819 write_exp_elt_opcode (OP_VAR_VALUE); 820} 821 822/* Write integer constant ARG of type TYPE. */ 823 824static void 825write_int (LONGEST arg, struct type *type) 826{ 827 write_exp_elt_opcode (OP_LONG); 828 write_exp_elt_type (type); 829 write_exp_elt_longcst (arg); 830 write_exp_elt_opcode (OP_LONG); 831} 832 833/* Write an OPCODE, string, OPCODE sequence to the current expression. */ 834static void 835write_exp_op_with_string (enum exp_opcode opcode, struct stoken token) 836{ 837 write_exp_elt_opcode (opcode); 838 write_exp_string (token); 839 write_exp_elt_opcode (opcode); 840} 841 842/* Emit expression corresponding to the renamed object designated by 843 * the type RENAMING, which must be the referent of an object renaming 844 * type, in the context of ORIG_LEFT_CONTEXT. MAX_DEPTH is the maximum 845 * number of cascaded renamings to allow. */ 846static void 847write_object_renaming (struct block *orig_left_context, 848 struct symbol *renaming, int max_depth) 849{ 850 const char *qualification = SYMBOL_LINKAGE_NAME (renaming); 851 const char *simple_tail; 852 const char *expr = TYPE_FIELD_NAME (SYMBOL_TYPE (renaming), 0); 853 const char *suffix; 854 char *name; 855 struct symbol *sym; 856 enum { SIMPLE_INDEX, LOWER_BOUND, UPPER_BOUND } slice_state; 857 858 if (max_depth <= 0) 859 error (_("Could not find renamed symbol")); 860 861 /* if orig_left_context is null, then use the currently selected 862 block; otherwise we might fail our symbol lookup below. */ 863 if (orig_left_context == NULL) 864 orig_left_context = get_selected_block (NULL); 865 866 for (simple_tail = qualification + strlen (qualification); 867 simple_tail != qualification; simple_tail -= 1) 868 { 869 if (*simple_tail == '.') 870 { 871 simple_tail += 1; 872 break; 873 } 874 else if (strncmp (simple_tail, "__", 2) == 0) 875 { 876 simple_tail += 2; 877 break; 878 } 879 } 880 881 suffix = strstr (expr, "___XE"); 882 if (suffix == NULL) 883 goto BadEncoding; 884 885 name = (char *) obstack_alloc (&temp_parse_space, suffix - expr + 1); 886 strncpy (name, expr, suffix-expr); 887 name[suffix-expr] = '\000'; 888 sym = lookup_symbol (name, orig_left_context, VAR_DOMAIN, 0, NULL); 889 if (sym == NULL) 890 error (_("Could not find renamed variable: %s"), ada_decode (name)); 891 if (ada_is_object_renaming (sym)) 892 write_object_renaming (orig_left_context, sym, max_depth-1); 893 else 894 write_var_from_sym (orig_left_context, block_found, sym); 895 896 suffix += 5; 897 slice_state = SIMPLE_INDEX; 898 while (*suffix == 'X') 899 { 900 suffix += 1; 901 902 switch (*suffix) { 903 case 'A': 904 suffix += 1; 905 write_exp_elt_opcode (UNOP_IND); 906 break; 907 case 'L': 908 slice_state = LOWER_BOUND; 909 case 'S': 910 suffix += 1; 911 if (isdigit (*suffix)) 912 { 913 char *next; 914 long val = strtol (suffix, &next, 10); 915 if (next == suffix) 916 goto BadEncoding; 917 suffix = next; 918 write_exp_elt_opcode (OP_LONG); 919 write_exp_elt_type (type_int ()); 920 write_exp_elt_longcst ((LONGEST) val); 921 write_exp_elt_opcode (OP_LONG); 922 } 923 else 924 { 925 const char *end; 926 char *index_name; 927 int index_len; 928 struct symbol *index_sym; 929 930 end = strchr (suffix, 'X'); 931 if (end == NULL) 932 end = suffix + strlen (suffix); 933 934 index_len = simple_tail - qualification + 2 + (suffix - end) + 1; 935 index_name 936 = (char *) obstack_alloc (&temp_parse_space, index_len); 937 memset (index_name, '\000', index_len); 938 strncpy (index_name, qualification, simple_tail - qualification); 939 index_name[simple_tail - qualification] = '\000'; 940 strncat (index_name, suffix, suffix-end); 941 suffix = end; 942 943 index_sym = 944 lookup_symbol (index_name, NULL, VAR_DOMAIN, 0, NULL); 945 if (index_sym == NULL) 946 error (_("Could not find %s"), index_name); 947 write_var_from_sym (NULL, block_found, sym); 948 } 949 if (slice_state == SIMPLE_INDEX) 950 { 951 write_exp_elt_opcode (OP_FUNCALL); 952 write_exp_elt_longcst ((LONGEST) 1); 953 write_exp_elt_opcode (OP_FUNCALL); 954 } 955 else if (slice_state == LOWER_BOUND) 956 slice_state = UPPER_BOUND; 957 else if (slice_state == UPPER_BOUND) 958 { 959 write_exp_elt_opcode (TERNOP_SLICE); 960 slice_state = SIMPLE_INDEX; 961 } 962 break; 963 964 case 'R': 965 { 966 struct stoken field_name; 967 const char *end; 968 suffix += 1; 969 970 if (slice_state != SIMPLE_INDEX) 971 goto BadEncoding; 972 end = strchr (suffix, 'X'); 973 if (end == NULL) 974 end = suffix + strlen (suffix); 975 field_name.length = end - suffix; 976 field_name.ptr = xmalloc (end - suffix + 1); 977 strncpy (field_name.ptr, suffix, end - suffix); 978 field_name.ptr[end - suffix] = '\000'; 979 suffix = end; 980 write_exp_op_with_string (STRUCTOP_STRUCT, field_name); 981 break; 982 } 983 984 default: 985 goto BadEncoding; 986 } 987 } 988 if (slice_state == SIMPLE_INDEX) 989 return; 990 991 BadEncoding: 992 error (_("Internal error in encoding of renaming declaration: %s"), 993 SYMBOL_LINKAGE_NAME (renaming)); 994} 995 996static struct block* 997block_lookup (struct block *context, char *raw_name) 998{ 999 char *name; 1000 struct ada_symbol_info *syms; 1001 int nsyms; 1002 struct symtab *symtab; 1003 1004 if (raw_name[0] == '\'') 1005 { 1006 raw_name += 1; 1007 name = raw_name; 1008 } 1009 else 1010 name = ada_encode (raw_name); 1011 1012 nsyms = ada_lookup_symbol_list (name, context, VAR_DOMAIN, &syms); 1013 if (context == NULL && 1014 (nsyms == 0 || SYMBOL_CLASS (syms[0].sym) != LOC_BLOCK)) 1015 symtab = lookup_symtab (name); 1016 else 1017 symtab = NULL; 1018 1019 if (symtab != NULL) 1020 return BLOCKVECTOR_BLOCK (BLOCKVECTOR (symtab), STATIC_BLOCK); 1021 else if (nsyms == 0 || SYMBOL_CLASS (syms[0].sym) != LOC_BLOCK) 1022 { 1023 if (context == NULL) 1024 error (_("No file or function \"%s\"."), raw_name); 1025 else 1026 error (_("No function \"%s\" in specified context."), raw_name); 1027 } 1028 else 1029 { 1030 if (nsyms > 1) 1031 warning (_("Function name \"%s\" ambiguous here"), raw_name); 1032 return SYMBOL_BLOCK_VALUE (syms[0].sym); 1033 } 1034} 1035 1036static struct symbol* 1037select_possible_type_sym (struct ada_symbol_info *syms, int nsyms) 1038{ 1039 int i; 1040 int preferred_index; 1041 struct type *preferred_type; 1042 1043 preferred_index = -1; preferred_type = NULL; 1044 for (i = 0; i < nsyms; i += 1) 1045 switch (SYMBOL_CLASS (syms[i].sym)) 1046 { 1047 case LOC_TYPEDEF: 1048 if (ada_prefer_type (SYMBOL_TYPE (syms[i].sym), preferred_type)) 1049 { 1050 preferred_index = i; 1051 preferred_type = SYMBOL_TYPE (syms[i].sym); 1052 } 1053 break; 1054 case LOC_REGISTER: 1055 case LOC_ARG: 1056 case LOC_REF_ARG: 1057 case LOC_REGPARM: 1058 case LOC_REGPARM_ADDR: 1059 case LOC_LOCAL: 1060 case LOC_LOCAL_ARG: 1061 case LOC_BASEREG: 1062 case LOC_BASEREG_ARG: 1063 case LOC_COMPUTED: 1064 case LOC_COMPUTED_ARG: 1065 return NULL; 1066 default: 1067 break; 1068 } 1069 if (preferred_type == NULL) 1070 return NULL; 1071 return syms[preferred_index].sym; 1072} 1073 1074static struct type* 1075find_primitive_type (char *name) 1076{ 1077 struct type *type; 1078 type = language_lookup_primitive_type_by_name (current_language, 1079 current_gdbarch, 1080 name); 1081 if (type == NULL && strcmp ("system__address", name) == 0) 1082 type = type_system_address (); 1083 1084 if (type != NULL) 1085 { 1086 /* Check to see if we have a regular definition of this 1087 type that just didn't happen to have been read yet. */ 1088 int ntypes; 1089 struct symbol *sym; 1090 char *expanded_name = 1091 (char *) alloca (strlen (name) + sizeof ("standard__")); 1092 strcpy (expanded_name, "standard__"); 1093 strcat (expanded_name, name); 1094 sym = ada_lookup_symbol (expanded_name, NULL, VAR_DOMAIN, NULL, NULL); 1095 if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF) 1096 type = SYMBOL_TYPE (sym); 1097 } 1098 1099 return type; 1100} 1101 1102static int 1103chop_selector (char *name, int end) 1104{ 1105 int i; 1106 for (i = end - 1; i > 0; i -= 1) 1107 if (name[i] == '.' || (name[i] == '_' && name[i+1] == '_')) 1108 return i; 1109 return -1; 1110} 1111 1112/* Given that SELS is a string of the form (<sep><identifier>)*, where 1113 <sep> is '__' or '.', write the indicated sequence of 1114 STRUCTOP_STRUCT expression operators. */ 1115static void 1116write_selectors (char *sels) 1117{ 1118 while (*sels != '\0') 1119 { 1120 struct stoken field_name; 1121 char *p; 1122 while (*sels == '_' || *sels == '.') 1123 sels += 1; 1124 p = sels; 1125 while (*sels != '\0' && *sels != '.' 1126 && (sels[0] != '_' || sels[1] != '_')) 1127 sels += 1; 1128 field_name.length = sels - p; 1129 field_name.ptr = p; 1130 write_exp_op_with_string (STRUCTOP_STRUCT, field_name); 1131 } 1132} 1133 1134/* Write a variable access (OP_VAR_VALUE) to ambiguous encoded name 1135 NAME[0..LEN-1], in block context BLOCK, to be resolved later. Writes 1136 a temporary symbol that is valid until the next call to ada_parse. 1137 */ 1138static void 1139write_ambiguous_var (struct block *block, char *name, int len) 1140{ 1141 struct symbol *sym = 1142 obstack_alloc (&temp_parse_space, sizeof (struct symbol)); 1143 memset (sym, 0, sizeof (struct symbol)); 1144 SYMBOL_DOMAIN (sym) = UNDEF_DOMAIN; 1145 SYMBOL_LINKAGE_NAME (sym) = obsavestring (name, len, &temp_parse_space); 1146 SYMBOL_LANGUAGE (sym) = language_ada; 1147 1148 write_exp_elt_opcode (OP_VAR_VALUE); 1149 write_exp_elt_block (block); 1150 write_exp_elt_sym (sym); 1151 write_exp_elt_opcode (OP_VAR_VALUE); 1152} 1153 1154 1155/* Look up NAME0 (an unencoded identifier or dotted name) in BLOCK (or 1156 expression_block_context if NULL). If it denotes a type, return 1157 that type. Otherwise, write expression code to evaluate it as an 1158 object and return NULL. In this second case, NAME0 will, in general, 1159 have the form <name>(.<selector_name>)*, where <name> is an object 1160 or renaming encoded in the debugging data. Calls error if no 1161 prefix <name> matches a name in the debugging data (i.e., matches 1162 either a complete name or, as a wild-card match, the final 1163 identifier). */ 1164 1165static struct type* 1166write_var_or_type (struct block *block, struct stoken name0) 1167{ 1168 int depth; 1169 char *encoded_name; 1170 int name_len; 1171 1172 if (block == NULL) 1173 block = expression_context_block; 1174 1175 encoded_name = ada_encode (name0.ptr); 1176 name_len = strlen (encoded_name); 1177 encoded_name = obsavestring (encoded_name, name_len, &temp_parse_space); 1178 for (depth = 0; depth < MAX_RENAMING_CHAIN_LENGTH; depth += 1) 1179 { 1180 int tail_index; 1181 1182 tail_index = name_len; 1183 while (tail_index > 0) 1184 { 1185 int nsyms; 1186 struct ada_symbol_info *syms; 1187 struct symbol *type_sym; 1188 int terminator = encoded_name[tail_index]; 1189 1190 encoded_name[tail_index] = '\0'; 1191 nsyms = ada_lookup_symbol_list (encoded_name, block, 1192 VAR_DOMAIN, &syms); 1193 encoded_name[tail_index] = terminator; 1194 1195 /* A single symbol may rename a package or object. */ 1196 1197 if (nsyms == 1 && !ada_is_object_renaming (syms[0].sym)) 1198 { 1199 struct symbol *renaming_sym = 1200 ada_find_renaming_symbol (SYMBOL_LINKAGE_NAME (syms[0].sym), 1201 syms[0].block); 1202 1203 if (renaming_sym != NULL) 1204 syms[0].sym = renaming_sym; 1205 } 1206 1207 type_sym = select_possible_type_sym (syms, nsyms); 1208 if (type_sym != NULL) 1209 { 1210 struct type *type = SYMBOL_TYPE (type_sym); 1211 1212 if (TYPE_CODE (type) == TYPE_CODE_VOID) 1213 error (_("`%s' matches only void type name(s)"), name0.ptr); 1214 else if (ada_is_object_renaming (type_sym)) 1215 { 1216 write_object_renaming (block, type_sym, 1217 MAX_RENAMING_CHAIN_LENGTH); 1218 write_selectors (encoded_name + tail_index); 1219 return NULL; 1220 } 1221 else if (ada_renaming_type (SYMBOL_TYPE (type_sym)) != NULL) 1222 { 1223 int result; 1224 char *renaming = ada_simple_renamed_entity (type_sym); 1225 int renaming_len = strlen (renaming); 1226 1227 char *new_name 1228 = obstack_alloc (&temp_parse_space, 1229 renaming_len + name_len - tail_index 1230 + 1); 1231 strcpy (new_name, renaming); 1232 xfree (renaming); 1233 strcpy (new_name + renaming_len, encoded_name + tail_index); 1234 encoded_name = new_name; 1235 name_len = renaming_len + name_len - tail_index; 1236 goto TryAfterRenaming; 1237 } 1238 else if (tail_index == name_len) 1239 return type; 1240 else 1241 error (_("Invalid attempt to select from type: \"%s\"."), name0.ptr); 1242 } 1243 else if (tail_index == name_len && nsyms == 0) 1244 { 1245 struct type *type = find_primitive_type (encoded_name); 1246 1247 if (type != NULL) 1248 return type; 1249 } 1250 1251 if (nsyms == 1) 1252 { 1253 write_var_from_sym (block, syms[0].block, syms[0].sym); 1254 write_selectors (encoded_name + tail_index); 1255 return NULL; 1256 } 1257 else if (nsyms == 0) 1258 { 1259 int i; 1260 struct minimal_symbol *msym 1261 = ada_lookup_simple_minsym (encoded_name); 1262 if (msym != NULL) 1263 { 1264 write_exp_msymbol (msym, lookup_function_type (type_int ()), 1265 type_int ()); 1266 /* Maybe cause error here rather than later? FIXME? */ 1267 write_selectors (encoded_name + tail_index); 1268 return NULL; 1269 } 1270 1271 if (tail_index == name_len 1272 && strncmp (encoded_name, "standard__", 1273 sizeof ("standard__") - 1) == 0) 1274 error (_("No definition of \"%s\" found."), name0.ptr); 1275 1276 tail_index = chop_selector (encoded_name, tail_index); 1277 } 1278 else 1279 { 1280 write_ambiguous_var (block, encoded_name, tail_index); 1281 write_selectors (encoded_name + tail_index); 1282 return NULL; 1283 } 1284 } 1285 1286 if (!have_full_symbols () && !have_partial_symbols () && block == NULL) 1287 error (_("No symbol table is loaded. Use the \"file\" command.")); 1288 if (block == expression_context_block) 1289 error (_("No definition of \"%s\" in current context."), name0.ptr); 1290 else 1291 error (_("No definition of \"%s\" in specified context."), name0.ptr); 1292 1293 TryAfterRenaming: ; 1294 } 1295 1296 error (_("Could not find renamed symbol \"%s\""), name0.ptr); 1297 1298} 1299 1300/* Write a left side of a component association (e.g., NAME in NAME => 1301 exp). If NAME has the form of a selected component, write it as an 1302 ordinary expression. If it is a simple variable that unambiguously 1303 corresponds to exactly one symbol that does not denote a type or an 1304 object renaming, also write it normally as an OP_VAR_VALUE. 1305 Otherwise, write it as an OP_NAME. 1306 1307 Unfortunately, we don't know at this point whether NAME is supposed 1308 to denote a record component name or the value of an array index. 1309 Therefore, it is not appropriate to disambiguate an ambiguous name 1310 as we normally would, nor to replace a renaming with its referent. 1311 As a result, in the (one hopes) rare case that one writes an 1312 aggregate such as (R => 42) where R renames an object or is an 1313 ambiguous name, one must write instead ((R) => 42). */ 1314 1315static void 1316write_name_assoc (struct stoken name) 1317{ 1318 if (strchr (name.ptr, '.') == NULL) 1319 { 1320 struct ada_symbol_info *syms; 1321 int nsyms = ada_lookup_symbol_list (name.ptr, expression_context_block, 1322 VAR_DOMAIN, &syms); 1323 if (nsyms != 1 || SYMBOL_CLASS (syms[0].sym) == LOC_TYPEDEF) 1324 write_exp_op_with_string (OP_NAME, name); 1325 else 1326 write_var_from_sym (NULL, syms[0].block, syms[0].sym); 1327 } 1328 else 1329 if (write_var_or_type (NULL, name) != NULL) 1330 error (_("Invalid use of type.")); 1331} 1332 1333/* Convert the character literal whose ASCII value would be VAL to the 1334 appropriate value of type TYPE, if there is a translation. 1335 Otherwise return VAL. Hence, in an enumeration type ('A', 'B'), 1336 the literal 'A' (VAL == 65), returns 0. */ 1337 1338static LONGEST 1339convert_char_literal (struct type *type, LONGEST val) 1340{ 1341 char name[7]; 1342 int f; 1343 1344 if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM) 1345 return val; 1346 sprintf (name, "QU%02x", (int) val); 1347 for (f = 0; f < TYPE_NFIELDS (type); f += 1) 1348 { 1349 if (strcmp (name, TYPE_FIELD_NAME (type, f)) == 0) 1350 return TYPE_FIELD_BITPOS (type, f); 1351 } 1352 return val; 1353} 1354 1355static struct type * 1356type_int (void) 1357{ 1358 return builtin_type (current_gdbarch)->builtin_int; 1359} 1360 1361static struct type * 1362type_long (void) 1363{ 1364 return builtin_type (current_gdbarch)->builtin_long; 1365} 1366 1367static struct type * 1368type_long_long (void) 1369{ 1370 return builtin_type (current_gdbarch)->builtin_long_long; 1371} 1372 1373static struct type * 1374type_float (void) 1375{ 1376 return builtin_type (current_gdbarch)->builtin_float; 1377} 1378 1379static struct type * 1380type_double (void) 1381{ 1382 return builtin_type (current_gdbarch)->builtin_double; 1383} 1384 1385static struct type * 1386type_long_double (void) 1387{ 1388 return builtin_type (current_gdbarch)->builtin_long_double; 1389} 1390 1391static struct type * 1392type_char (void) 1393{ 1394 return language_string_char_type (current_language, current_gdbarch); 1395} 1396 1397static struct type * 1398type_system_address (void) 1399{ 1400 struct type *type 1401 = language_lookup_primitive_type_by_name (current_language, 1402 current_gdbarch, 1403 "system__address"); 1404 return type != NULL ? type : lookup_pointer_type (builtin_type_void); 1405} 1406 1407void 1408_initialize_ada_exp (void) 1409{ 1410 obstack_init (&temp_parse_space); 1411} 1412 1413/* FIXME: hilfingr/2004-10-05: Hack to remove warning. The function 1414 string_to_operator is supposed to be used for cases where one 1415 calls an operator function with prefix notation, as in 1416 "+" (a, b), but at some point, this code seems to have gone 1417 missing. */ 1418 1419struct stoken (*dummy_string_to_ada_operator) (struct stoken) 1420 = string_to_operator; 1421