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 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 case 'S': 924 renaming_expr += 1; 925 if (isdigit (*renaming_expr)) 926 { 927 char *next; 928 long val = strtol (renaming_expr, &next, 10); 929 if (next == renaming_expr) 930 goto BadEncoding; 931 renaming_expr = next; 932 write_exp_elt_opcode (OP_LONG); 933 write_exp_elt_type (type_int ()); 934 write_exp_elt_longcst ((LONGEST) val); 935 write_exp_elt_opcode (OP_LONG); 936 } 937 else 938 { 939 const char *end; 940 char *index_name; 941 struct symbol *index_sym; 942 943 end = strchr (renaming_expr, 'X'); 944 if (end == NULL) 945 end = renaming_expr + strlen (renaming_expr); 946 947 index_name = 948 obsavestring (renaming_expr, end - renaming_expr, 949 &temp_parse_space); 950 renaming_expr = end; 951 952 index_sym = ada_lookup_encoded_symbol (index_name, NULL, 953 VAR_DOMAIN, &block); 954 if (index_sym == NULL) 955 error (_("Could not find %s"), index_name); 956 else if (SYMBOL_CLASS (index_sym) == LOC_TYPEDEF) 957 /* Index is an old-style renaming symbol. */ 958 block = orig_left_context; 959 write_var_from_sym (NULL, block, index_sym); 960 } 961 if (slice_state == SIMPLE_INDEX) 962 { 963 write_exp_elt_opcode (OP_FUNCALL); 964 write_exp_elt_longcst ((LONGEST) 1); 965 write_exp_elt_opcode (OP_FUNCALL); 966 } 967 else if (slice_state == LOWER_BOUND) 968 slice_state = UPPER_BOUND; 969 else if (slice_state == UPPER_BOUND) 970 { 971 write_exp_elt_opcode (TERNOP_SLICE); 972 slice_state = SIMPLE_INDEX; 973 } 974 break; 975 976 case 'R': 977 { 978 struct stoken field_name; 979 const char *end; 980 renaming_expr += 1; 981 982 if (slice_state != SIMPLE_INDEX) 983 goto BadEncoding; 984 end = strchr (renaming_expr, 'X'); 985 if (end == NULL) 986 end = renaming_expr + strlen (renaming_expr); 987 field_name.length = end - renaming_expr; 988 field_name.ptr = malloc (end - renaming_expr + 1); 989 strncpy (field_name.ptr, renaming_expr, end - renaming_expr); 990 field_name.ptr[end - renaming_expr] = '\000'; 991 renaming_expr = end; 992 write_exp_op_with_string (STRUCTOP_STRUCT, field_name); 993 break; 994 } 995 996 default: 997 goto BadEncoding; 998 } 999 } 1000 if (slice_state == SIMPLE_INDEX) 1001 return; 1002 1003 BadEncoding: 1004 error (_("Internal error in encoding of renaming declaration")); 1005 } 1006 1007 static struct block* 1008 block_lookup (struct block *context, char *raw_name) 1009 { 1010 char *name; 1011 struct ada_symbol_info *syms; 1012 int nsyms; 1013 struct symtab *symtab; 1014 1015 if (raw_name[0] == '\'') 1016 { 1017 raw_name += 1; 1018 name = raw_name; 1019 } 1020 else 1021 name = ada_encode (raw_name); 1022 1023 nsyms = ada_lookup_symbol_list (name, context, VAR_DOMAIN, &syms); 1024 if (context == NULL 1025 && (nsyms == 0 || SYMBOL_CLASS (syms[0].sym) != LOC_BLOCK)) 1026 symtab = lookup_symtab (name); 1027 else 1028 symtab = NULL; 1029 1030 if (symtab != NULL) 1031 return BLOCKVECTOR_BLOCK (BLOCKVECTOR (symtab), STATIC_BLOCK); 1032 else if (nsyms == 0 || SYMBOL_CLASS (syms[0].sym) != LOC_BLOCK) 1033 { 1034 if (context == NULL) 1035 error (_("No file or function \"%s\"."), raw_name); 1036 else 1037 error (_("No function \"%s\" in specified context."), raw_name); 1038 } 1039 else 1040 { 1041 if (nsyms > 1) 1042 warning (_("Function name \"%s\" ambiguous here"), raw_name); 1043 return SYMBOL_BLOCK_VALUE (syms[0].sym); 1044 } 1045 } 1046 1047 static struct symbol* 1048 select_possible_type_sym (struct ada_symbol_info *syms, int nsyms) 1049 { 1050 int i; 1051 int preferred_index; 1052 struct type *preferred_type; 1053 1054 preferred_index = -1; preferred_type = NULL; 1055 for (i = 0; i < nsyms; i += 1) 1056 switch (SYMBOL_CLASS (syms[i].sym)) 1057 { 1058 case LOC_TYPEDEF: 1059 if (ada_prefer_type (SYMBOL_TYPE (syms[i].sym), preferred_type)) 1060 { 1061 preferred_index = i; 1062 preferred_type = SYMBOL_TYPE (syms[i].sym); 1063 } 1064 break; 1065 case LOC_REGISTER: 1066 case LOC_ARG: 1067 case LOC_REF_ARG: 1068 case LOC_REGPARM_ADDR: 1069 case LOC_LOCAL: 1070 case LOC_COMPUTED: 1071 return NULL; 1072 default: 1073 break; 1074 } 1075 if (preferred_type == NULL) 1076 return NULL; 1077 return syms[preferred_index].sym; 1078 } 1079 1080 static struct type* 1081 find_primitive_type (char *name) 1082 { 1083 struct type *type; 1084 type = language_lookup_primitive_type_by_name (parse_language, 1085 parse_gdbarch, 1086 name); 1087 if (type == NULL && strcmp ("system__address", name) == 0) 1088 type = type_system_address (); 1089 1090 if (type != NULL) 1091 { 1092 /* Check to see if we have a regular definition of this 1093 type that just didn't happen to have been read yet. */ 1094 struct symbol *sym; 1095 char *expanded_name = 1096 (char *) alloca (strlen (name) + sizeof ("standard__")); 1097 strcpy (expanded_name, "standard__"); 1098 strcat (expanded_name, name); 1099 sym = ada_lookup_symbol (expanded_name, NULL, VAR_DOMAIN, NULL); 1100 if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF) 1101 type = SYMBOL_TYPE (sym); 1102 } 1103 1104 return type; 1105 } 1106 1107 static int 1108 chop_selector (char *name, int end) 1109 { 1110 int i; 1111 for (i = end - 1; i > 0; i -= 1) 1112 if (name[i] == '.' || (name[i] == '_' && name[i+1] == '_')) 1113 return i; 1114 return -1; 1115 } 1116 1117 /* If NAME is a string beginning with a separator (either '__', or 1118 '.'), chop this separator and return the result; else, return 1119 NAME. */ 1120 1121 static char * 1122 chop_separator (char *name) 1123 { 1124 if (*name == '.') 1125 return name + 1; 1126 1127 if (name[0] == '_' && name[1] == '_') 1128 return name + 2; 1129 1130 return name; 1131 } 1132 1133 /* Given that SELS is a string of the form (<sep><identifier>)*, where 1134 <sep> is '__' or '.', write the indicated sequence of 1135 STRUCTOP_STRUCT expression operators. */ 1136 static void 1137 write_selectors (char *sels) 1138 { 1139 while (*sels != '\0') 1140 { 1141 struct stoken field_name; 1142 char *p = chop_separator (sels); 1143 sels = p; 1144 while (*sels != '\0' && *sels != '.' 1145 && (sels[0] != '_' || sels[1] != '_')) 1146 sels += 1; 1147 field_name.length = sels - p; 1148 field_name.ptr = p; 1149 write_exp_op_with_string (STRUCTOP_STRUCT, field_name); 1150 } 1151 } 1152 1153 /* Write a variable access (OP_VAR_VALUE) to ambiguous encoded name 1154 NAME[0..LEN-1], in block context BLOCK, to be resolved later. Writes 1155 a temporary symbol that is valid until the next call to ada_parse. 1156 */ 1157 static void 1158 write_ambiguous_var (struct block *block, char *name, int len) 1159 { 1160 struct symbol *sym = 1161 obstack_alloc (&temp_parse_space, sizeof (struct symbol)); 1162 memset (sym, 0, sizeof (struct symbol)); 1163 SYMBOL_DOMAIN (sym) = UNDEF_DOMAIN; 1164 SYMBOL_LINKAGE_NAME (sym) = obsavestring (name, len, &temp_parse_space); 1165 SYMBOL_LANGUAGE (sym) = language_ada; 1166 1167 write_exp_elt_opcode (OP_VAR_VALUE); 1168 write_exp_elt_block (block); 1169 write_exp_elt_sym (sym); 1170 write_exp_elt_opcode (OP_VAR_VALUE); 1171 } 1172 1173 /* A convenient wrapper around ada_get_field_index that takes 1174 a non NUL-terminated FIELD_NAME0 and a FIELD_NAME_LEN instead 1175 of a NUL-terminated field name. */ 1176 1177 static int 1178 ada_nget_field_index (const struct type *type, const char *field_name0, 1179 int field_name_len, int maybe_missing) 1180 { 1181 char *field_name = alloca ((field_name_len + 1) * sizeof (char)); 1182 1183 strncpy (field_name, field_name0, field_name_len); 1184 field_name[field_name_len] = '\0'; 1185 return ada_get_field_index (type, field_name, maybe_missing); 1186 } 1187 1188 /* If encoded_field_name is the name of a field inside symbol SYM, 1189 then return the type of that field. Otherwise, return NULL. 1190 1191 This function is actually recursive, so if ENCODED_FIELD_NAME 1192 doesn't match one of the fields of our symbol, then try to see 1193 if ENCODED_FIELD_NAME could not be a succession of field names 1194 (in other words, the user entered an expression of the form 1195 TYPE_NAME.FIELD1.FIELD2.FIELD3), in which case we evaluate 1196 each field name sequentially to obtain the desired field type. 1197 In case of failure, we return NULL. */ 1198 1199 static struct type * 1200 get_symbol_field_type (struct symbol *sym, char *encoded_field_name) 1201 { 1202 char *field_name = encoded_field_name; 1203 char *subfield_name; 1204 struct type *type = SYMBOL_TYPE (sym); 1205 int fieldno; 1206 1207 if (type == NULL || field_name == NULL) 1208 return NULL; 1209 type = check_typedef (type); 1210 1211 while (field_name[0] != '\0') 1212 { 1213 field_name = chop_separator (field_name); 1214 1215 fieldno = ada_get_field_index (type, field_name, 1); 1216 if (fieldno >= 0) 1217 return TYPE_FIELD_TYPE (type, fieldno); 1218 1219 subfield_name = field_name; 1220 while (*subfield_name != '\0' && *subfield_name != '.' 1221 && (subfield_name[0] != '_' || subfield_name[1] != '_')) 1222 subfield_name += 1; 1223 1224 if (subfield_name[0] == '\0') 1225 return NULL; 1226 1227 fieldno = ada_nget_field_index (type, field_name, 1228 subfield_name - field_name, 1); 1229 if (fieldno < 0) 1230 return NULL; 1231 1232 type = TYPE_FIELD_TYPE (type, fieldno); 1233 field_name = subfield_name; 1234 } 1235 1236 return NULL; 1237 } 1238 1239 /* Look up NAME0 (an unencoded identifier or dotted name) in BLOCK (or 1240 expression_block_context if NULL). If it denotes a type, return 1241 that type. Otherwise, write expression code to evaluate it as an 1242 object and return NULL. In this second case, NAME0 will, in general, 1243 have the form <name>(.<selector_name>)*, where <name> is an object 1244 or renaming encoded in the debugging data. Calls error if no 1245 prefix <name> matches a name in the debugging data (i.e., matches 1246 either a complete name or, as a wild-card match, the final 1247 identifier). */ 1248 1249 static struct type* 1250 write_var_or_type (struct block *block, struct stoken name0) 1251 { 1252 int depth; 1253 char *encoded_name; 1254 int name_len; 1255 1256 if (block == NULL) 1257 block = expression_context_block; 1258 1259 encoded_name = ada_encode (name0.ptr); 1260 name_len = strlen (encoded_name); 1261 encoded_name = obsavestring (encoded_name, name_len, &temp_parse_space); 1262 for (depth = 0; depth < MAX_RENAMING_CHAIN_LENGTH; depth += 1) 1263 { 1264 int tail_index; 1265 1266 tail_index = name_len; 1267 while (tail_index > 0) 1268 { 1269 int nsyms; 1270 struct ada_symbol_info *syms; 1271 struct symbol *type_sym; 1272 struct symbol *renaming_sym; 1273 const char* renaming; 1274 int renaming_len; 1275 const char* renaming_expr; 1276 int terminator = encoded_name[tail_index]; 1277 1278 encoded_name[tail_index] = '\0'; 1279 nsyms = ada_lookup_symbol_list (encoded_name, block, 1280 VAR_DOMAIN, &syms); 1281 encoded_name[tail_index] = terminator; 1282 1283 /* A single symbol may rename a package or object. */ 1284 1285 /* This should go away when we move entirely to new version. 1286 FIXME pnh 7/20/2007. */ 1287 if (nsyms == 1) 1288 { 1289 struct symbol *renaming = 1290 ada_find_renaming_symbol (SYMBOL_LINKAGE_NAME (syms[0].sym), 1291 syms[0].block); 1292 1293 if (renaming != NULL) 1294 syms[0].sym = renaming; 1295 } 1296 1297 type_sym = select_possible_type_sym (syms, nsyms); 1298 1299 if (type_sym != NULL) 1300 renaming_sym = type_sym; 1301 else if (nsyms == 1) 1302 renaming_sym = syms[0].sym; 1303 else 1304 renaming_sym = NULL; 1305 1306 switch (ada_parse_renaming (renaming_sym, &renaming, 1307 &renaming_len, &renaming_expr)) 1308 { 1309 case ADA_NOT_RENAMING: 1310 break; 1311 case ADA_PACKAGE_RENAMING: 1312 case ADA_EXCEPTION_RENAMING: 1313 case ADA_SUBPROGRAM_RENAMING: 1314 { 1315 char *new_name 1316 = obstack_alloc (&temp_parse_space, 1317 renaming_len + name_len - tail_index + 1); 1318 strncpy (new_name, renaming, renaming_len); 1319 strcpy (new_name + renaming_len, encoded_name + tail_index); 1320 encoded_name = new_name; 1321 name_len = renaming_len + name_len - tail_index; 1322 goto TryAfterRenaming; 1323 } 1324 case ADA_OBJECT_RENAMING: 1325 write_object_renaming (block, renaming, renaming_len, 1326 renaming_expr, MAX_RENAMING_CHAIN_LENGTH); 1327 write_selectors (encoded_name + tail_index); 1328 return NULL; 1329 default: 1330 internal_error (__FILE__, __LINE__, 1331 _("impossible value from ada_parse_renaming")); 1332 } 1333 1334 if (type_sym != NULL) 1335 { 1336 struct type *field_type; 1337 1338 if (tail_index == name_len) 1339 return SYMBOL_TYPE (type_sym); 1340 1341 /* We have some extraneous characters after the type name. 1342 If this is an expression "TYPE_NAME.FIELD0.[...].FIELDN", 1343 then try to get the type of FIELDN. */ 1344 field_type 1345 = get_symbol_field_type (type_sym, encoded_name + tail_index); 1346 if (field_type != NULL) 1347 return field_type; 1348 else 1349 error (_("Invalid attempt to select from type: \"%s\"."), 1350 name0.ptr); 1351 } 1352 else if (tail_index == name_len && nsyms == 0) 1353 { 1354 struct type *type = find_primitive_type (encoded_name); 1355 1356 if (type != NULL) 1357 return type; 1358 } 1359 1360 if (nsyms == 1) 1361 { 1362 write_var_from_sym (block, syms[0].block, syms[0].sym); 1363 write_selectors (encoded_name + tail_index); 1364 return NULL; 1365 } 1366 else if (nsyms == 0) 1367 { 1368 struct minimal_symbol *msym 1369 = ada_lookup_simple_minsym (encoded_name); 1370 if (msym != NULL) 1371 { 1372 write_exp_msymbol (msym); 1373 /* Maybe cause error here rather than later? FIXME? */ 1374 write_selectors (encoded_name + tail_index); 1375 return NULL; 1376 } 1377 1378 if (tail_index == name_len 1379 && strncmp (encoded_name, "standard__", 1380 sizeof ("standard__") - 1) == 0) 1381 error (_("No definition of \"%s\" found."), name0.ptr); 1382 1383 tail_index = chop_selector (encoded_name, tail_index); 1384 } 1385 else 1386 { 1387 write_ambiguous_var (block, encoded_name, tail_index); 1388 write_selectors (encoded_name + tail_index); 1389 return NULL; 1390 } 1391 } 1392 1393 if (!have_full_symbols () && !have_partial_symbols () && block == NULL) 1394 error (_("No symbol table is loaded. Use the \"file\" command.")); 1395 if (block == expression_context_block) 1396 error (_("No definition of \"%s\" in current context."), name0.ptr); 1397 else 1398 error (_("No definition of \"%s\" in specified context."), name0.ptr); 1399 1400 TryAfterRenaming: ; 1401 } 1402 1403 error (_("Could not find renamed symbol \"%s\""), name0.ptr); 1404 1405 } 1406 1407 /* Write a left side of a component association (e.g., NAME in NAME => 1408 exp). If NAME has the form of a selected component, write it as an 1409 ordinary expression. If it is a simple variable that unambiguously 1410 corresponds to exactly one symbol that does not denote a type or an 1411 object renaming, also write it normally as an OP_VAR_VALUE. 1412 Otherwise, write it as an OP_NAME. 1413 1414 Unfortunately, we don't know at this point whether NAME is supposed 1415 to denote a record component name or the value of an array index. 1416 Therefore, it is not appropriate to disambiguate an ambiguous name 1417 as we normally would, nor to replace a renaming with its referent. 1418 As a result, in the (one hopes) rare case that one writes an 1419 aggregate such as (R => 42) where R renames an object or is an 1420 ambiguous name, one must write instead ((R) => 42). */ 1421 1422 static void 1423 write_name_assoc (struct stoken name) 1424 { 1425 if (strchr (name.ptr, '.') == NULL) 1426 { 1427 struct ada_symbol_info *syms; 1428 int nsyms = ada_lookup_symbol_list (name.ptr, expression_context_block, 1429 VAR_DOMAIN, &syms); 1430 if (nsyms != 1 || SYMBOL_CLASS (syms[0].sym) == LOC_TYPEDEF) 1431 write_exp_op_with_string (OP_NAME, name); 1432 else 1433 write_var_from_sym (NULL, syms[0].block, syms[0].sym); 1434 } 1435 else 1436 if (write_var_or_type (NULL, name) != NULL) 1437 error (_("Invalid use of type.")); 1438 } 1439 1440 /* Convert the character literal whose ASCII value would be VAL to the 1441 appropriate value of type TYPE, if there is a translation. 1442 Otherwise return VAL. Hence, in an enumeration type ('A', 'B'), 1443 the literal 'A' (VAL == 65), returns 0. */ 1444 1445 static LONGEST 1446 convert_char_literal (struct type *type, LONGEST val) 1447 { 1448 char name[7]; 1449 int f; 1450 1451 if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM) 1452 return val; 1453 xsnprintf (name, sizeof (name), "QU%02x", (int) val); 1454 for (f = 0; f < TYPE_NFIELDS (type); f += 1) 1455 { 1456 if (strcmp (name, TYPE_FIELD_NAME (type, f)) == 0) 1457 return TYPE_FIELD_BITPOS (type, f); 1458 } 1459 return val; 1460 } 1461 1462 static struct type * 1463 type_int (void) 1464 { 1465 return parse_type->builtin_int; 1466 } 1467 1468 static struct type * 1469 type_long (void) 1470 { 1471 return parse_type->builtin_long; 1472 } 1473 1474 static struct type * 1475 type_long_long (void) 1476 { 1477 return parse_type->builtin_long_long; 1478 } 1479 1480 static struct type * 1481 type_float (void) 1482 { 1483 return parse_type->builtin_float; 1484 } 1485 1486 static struct type * 1487 type_double (void) 1488 { 1489 return parse_type->builtin_double; 1490 } 1491 1492 static struct type * 1493 type_long_double (void) 1494 { 1495 return parse_type->builtin_long_double; 1496 } 1497 1498 static struct type * 1499 type_char (void) 1500 { 1501 return language_string_char_type (parse_language, parse_gdbarch); 1502 } 1503 1504 static struct type * 1505 type_boolean (void) 1506 { 1507 return parse_type->builtin_bool; 1508 } 1509 1510 static struct type * 1511 type_system_address (void) 1512 { 1513 struct type *type 1514 = language_lookup_primitive_type_by_name (parse_language, 1515 parse_gdbarch, 1516 "system__address"); 1517 return type != NULL ? type : parse_type->builtin_data_ptr; 1518 } 1519 1520 /* Provide a prototype to silence -Wmissing-prototypes. */ 1521 extern initialize_file_ftype _initialize_ada_exp; 1522 1523 void 1524 _initialize_ada_exp (void) 1525 { 1526 obstack_init (&temp_parse_space); 1527 } 1528 1529 /* FIXME: hilfingr/2004-10-05: Hack to remove warning. The function 1530 string_to_operator is supposed to be used for cases where one 1531 calls an operator function with prefix notation, as in 1532 "+" (a, b), but at some point, this code seems to have gone 1533 missing. */ 1534 1535 struct stoken (*dummy_string_to_ada_operator) (struct stoken) 1536 = string_to_operator; 1537