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