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