gdb/ada-exp.y

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