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   /* Setting up the parser state.  */
 737   scoped_restore pstate_restore = make_scoped_restore (&pstate);
 738   gdb_assert (par_state != NULL);
 739   pstate = par_state;
 740
 741   lexer_init (yyin);            /* (Re-)initialize lexer.  */
 742   type_qualifier = NULL;
 743   obstack_free (&temp_parse_space, NULL);
 744   obstack_init (&temp_parse_space);
 745
 746   return yyparse ();
 747 }
 748
 749 void
 750 yyerror (const char *msg)
 751 {
 752   error (_("Error in expression, near `%s'."), lexptr);
 753 }
 754
 755 /* Emit expression to access an instance of SYM, in block BLOCK (if
 756  * non-NULL), and with :: qualification ORIG_LEFT_CONTEXT.  */
 757 static void
 758 write_var_from_sym (struct parser_state *par_state,
 759                     const struct block *orig_left_context,
 760                     const struct block *block,
 761                     struct symbol *sym)
 762 {
 763   if (orig_left_context == NULL && symbol_read_needs_frame (sym))
 764     {
 765       if (innermost_block == 0
 766           || contained_in (block, innermost_block))
 767         innermost_block = block;
 768     }
 769
 770   write_exp_elt_opcode (par_state, OP_VAR_VALUE);
 771   write_exp_elt_block (par_state, block);
 772   write_exp_elt_sym (par_state, sym);
 773   write_exp_elt_opcode (par_state, OP_VAR_VALUE);
 774 }
 775
 776 /* Write integer or boolean constant ARG of type TYPE.  */
 777
 778 static void
 779 write_int (struct parser_state *par_state, LONGEST arg, struct type *type)
 780 {
 781   write_exp_elt_opcode (par_state, OP_LONG);
 782   write_exp_elt_type (par_state, type);
 783   write_exp_elt_longcst (par_state, arg);
 784   write_exp_elt_opcode (par_state, OP_LONG);
 785 }
 786
 787 /* Write an OPCODE, string, OPCODE sequence to the current expression.  */
 788 static void
 789 write_exp_op_with_string (struct parser_state *par_state,
 790                           enum exp_opcode opcode, struct stoken token)
 791 {
 792   write_exp_elt_opcode (par_state, opcode);
 793   write_exp_string (par_state, token);
 794   write_exp_elt_opcode (par_state, opcode);
 795 }
 796
 797 /* Emit expression corresponding to the renamed object named
 798  * designated by RENAMED_ENTITY[0 .. RENAMED_ENTITY_LEN-1] in the
 799  * context of ORIG_LEFT_CONTEXT, to which is applied the operations
 800  * encoded by RENAMING_EXPR.  MAX_DEPTH is the maximum number of
 801  * cascaded renamings to allow.  If ORIG_LEFT_CONTEXT is null, it
 802  * defaults to the currently selected block. ORIG_SYMBOL is the
 803  * symbol that originally encoded the renaming.  It is needed only
 804  * because its prefix also qualifies any index variables used to index
 805  * or slice an array.  It should not be necessary once we go to the
 806  * new encoding entirely (FIXME pnh 7/20/2007).  */
 807
 808 static void
 809 write_object_renaming (struct parser_state *par_state,
 810                        const struct block *orig_left_context,
 811                        const char *renamed_entity, int renamed_entity_len,
 812                        const char *renaming_expr, int max_depth)
 813 {
 814   char *name;
 815   enum { SIMPLE_INDEX, LOWER_BOUND, UPPER_BOUND } slice_state;
 816   struct block_symbol sym_info;
 817
 818   if (max_depth <= 0)
 819     error (_("Could not find renamed symbol"));
 820
 821   if (orig_left_context == NULL)
 822     orig_left_context = get_selected_block (NULL);
 823
 824   name = (char *) obstack_copy0 (&temp_parse_space, renamed_entity,
 825                                  renamed_entity_len);
 826   ada_lookup_encoded_symbol (name, orig_left_context, VAR_DOMAIN, &sym_info);
 827   if (sym_info.symbol == NULL)
 828     error (_("Could not find renamed variable: %s"), ada_decode (name));
 829   else if (SYMBOL_CLASS (sym_info.symbol) == LOC_TYPEDEF)
 830     /* We have a renaming of an old-style renaming symbol.  Don't
 831        trust the block information.  */
 832     sym_info.block = orig_left_context;
 833
 834   {
 835     const char *inner_renamed_entity;
 836     int inner_renamed_entity_len;
 837     const char *inner_renaming_expr;
 838
 839     switch (ada_parse_renaming (sym_info.symbol, &inner_renamed_entity,
 840                                 &inner_renamed_entity_len,
 841                                 &inner_renaming_expr))
 842       {
 843       case ADA_NOT_RENAMING:
 844         write_var_from_sym (par_state, orig_left_context, sym_info.block,
 845                             sym_info.symbol);
 846         break;
 847       case ADA_OBJECT_RENAMING:
 848         write_object_renaming (par_state, sym_info.block,
 849                                inner_renamed_entity, inner_renamed_entity_len,
 850                                inner_renaming_expr, max_depth - 1);
 851         break;
 852       default:
 853         goto BadEncoding;
 854       }
 855   }
 856
 857   slice_state = SIMPLE_INDEX;
 858   while (*renaming_expr == 'X')
 859     {
 860       renaming_expr += 1;
 861
 862       switch (*renaming_expr) {
 863       case 'A':
 864         renaming_expr += 1;
 865         write_exp_elt_opcode (par_state, UNOP_IND);
 866         break;
 867       case 'L':
 868         slice_state = LOWER_BOUND;
 869         /* FALLTHROUGH */
 870       case 'S':
 871         renaming_expr += 1;
 872         if (isdigit (*renaming_expr))
 873           {
 874             char *next;
 875             long val = strtol (renaming_expr, &next, 10);
 876             if (next == renaming_expr)
 877               goto BadEncoding;
 878             renaming_expr = next;
 879             write_exp_elt_opcode (par_state, OP_LONG);
 880             write_exp_elt_type (par_state, type_int (par_state));
 881             write_exp_elt_longcst (par_state, (LONGEST) val);
 882             write_exp_elt_opcode (par_state, OP_LONG);
 883           }
 884         else
 885           {
 886             const char *end;
 887             char *index_name;
 888             struct block_symbol index_sym_info;
 889
 890             end = strchr (renaming_expr, 'X');
 891             if (end == NULL)
 892               end = renaming_expr + strlen (renaming_expr);
 893
 894             index_name
 895               = (char *) obstack_copy0 (&temp_parse_space, renaming_expr,
 896                                         end - renaming_expr);
 897             renaming_expr = end;
 898
 899             ada_lookup_encoded_symbol (index_name, NULL, VAR_DOMAIN,
 900                                        &index_sym_info);
 901             if (index_sym_info.symbol == NULL)
 902               error (_("Could not find %s"), index_name);
 903             else if (SYMBOL_CLASS (index_sym_info.symbol) == LOC_TYPEDEF)
 904               /* Index is an old-style renaming symbol.  */
 905               index_sym_info.block = orig_left_context;
 906             write_var_from_sym (par_state, NULL, index_sym_info.block,
 907                                 index_sym_info.symbol);
 908           }
 909         if (slice_state == SIMPLE_INDEX)
 910           {
 911             write_exp_elt_opcode (par_state, OP_FUNCALL);
 912             write_exp_elt_longcst (par_state, (LONGEST) 1);
 913             write_exp_elt_opcode (par_state, OP_FUNCALL);
 914           }
 915         else if (slice_state == LOWER_BOUND)
 916           slice_state = UPPER_BOUND;
 917         else if (slice_state == UPPER_BOUND)
 918           {
 919             write_exp_elt_opcode (par_state, TERNOP_SLICE);
 920             slice_state = SIMPLE_INDEX;
 921           }
 922         break;
 923
 924       case 'R':
 925         {
 926           struct stoken field_name;
 927           const char *end;
 928           char *buf;
 929
 930           renaming_expr += 1;
 931
 932           if (slice_state != SIMPLE_INDEX)
 933             goto BadEncoding;
 934           end = strchr (renaming_expr, 'X');
 935           if (end == NULL)
 936             end = renaming_expr + strlen (renaming_expr);
 937           field_name.length = end - renaming_expr;
 938           buf = (char *) malloc (end - renaming_expr + 1);
 939           field_name.ptr = buf;
 940           strncpy (buf, renaming_expr, end - renaming_expr);
 941           buf[end - renaming_expr] = '\000';
 942           renaming_expr = end;
 943           write_exp_op_with_string (par_state, STRUCTOP_STRUCT, field_name);
 944           break;
 945         }
 946
 947       default:
 948         goto BadEncoding;
 949       }
 950     }
 951   if (slice_state == SIMPLE_INDEX)
 952     return;
 953
 954  BadEncoding:
 955   error (_("Internal error in encoding of renaming declaration"));
 956 }
 957
 958 static const struct block*
 959 block_lookup (const struct block *context, const char *raw_name)
 960 {
 961   const char *name;
 962   struct block_symbol *syms;
 963   int nsyms;
 964   struct symtab *symtab;
 965
 966   if (raw_name[0] == '\'')
 967     {
 968       raw_name += 1;
 969       name = raw_name;
 970     }
 971   else
 972     name = ada_encode (raw_name);
 973
 974   nsyms = ada_lookup_symbol_list (name, context, VAR_DOMAIN, &syms);
 975   if (context == NULL
 976       && (nsyms == 0 || SYMBOL_CLASS (syms[0].symbol) != LOC_BLOCK))
 977     symtab = lookup_symtab (name);
 978   else
 979     symtab = NULL;
 980
 981   if (symtab != NULL)
 982     return BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (symtab), STATIC_BLOCK);
 983   else if (nsyms == 0 || SYMBOL_CLASS (syms[0].symbol) != LOC_BLOCK)
 984     {
 985       if (context == NULL)
 986         error (_("No file or function \"%s\"."), raw_name);
 987       else
 988         error (_("No function \"%s\" in specified context."), raw_name);
 989     }
 990   else
 991     {
 992       if (nsyms > 1)
 993         warning (_("Function name \"%s\" ambiguous here"), raw_name);
 994       return SYMBOL_BLOCK_VALUE (syms[0].symbol);
 995     }
 996 }
 997
 998 static struct symbol*
 999 select_possible_type_sym (struct block_symbol *syms, int nsyms)
1000 {
1001   int i;
1002   int preferred_index;
1003   struct type *preferred_type;
1004
1005   preferred_index = -1; preferred_type = NULL;
1006   for (i = 0; i < nsyms; i += 1)
1007     switch (SYMBOL_CLASS (syms[i].symbol))
1008       {
1009       case LOC_TYPEDEF:
1010         if (ada_prefer_type (SYMBOL_TYPE (syms[i].symbol), preferred_type))
1011           {
1012             preferred_index = i;
1013             preferred_type = SYMBOL_TYPE (syms[i].symbol);
1014           }
1015         break;
1016       case LOC_REGISTER:
1017       case LOC_ARG:
1018       case LOC_REF_ARG:
1019       case LOC_REGPARM_ADDR:
1020       case LOC_LOCAL:
1021       case LOC_COMPUTED:
1022         return NULL;
1023       default:
1024         break;
1025       }
1026   if (preferred_type == NULL)
1027     return NULL;
1028   return syms[preferred_index].symbol;
1029 }
1030
1031 static struct type*
1032 find_primitive_type (struct parser_state *par_state, char *name)
1033 {
1034   struct type *type;
1035   type = language_lookup_primitive_type (parse_language (par_state),
1036                                          parse_gdbarch (par_state),
1037                                          name);
1038   if (type == NULL && strcmp ("system__address", name) == 0)
1039     type = type_system_address (par_state);
1040
1041   if (type != NULL)
1042     {
1043       /* Check to see if we have a regular definition of this
1044          type that just didn't happen to have been read yet.  */
1045       struct symbol *sym;
1046       char *expanded_name =
1047         (char *) alloca (strlen (name) + sizeof ("standard__"));
1048       strcpy (expanded_name, "standard__");
1049       strcat (expanded_name, name);
1050       sym = ada_lookup_symbol (expanded_name, NULL, VAR_DOMAIN, NULL).symbol;
1051       if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1052         type = SYMBOL_TYPE (sym);
1053     }
1054
1055   return type;
1056 }
1057
1058 static int
1059 chop_selector (char *name, int end)
1060 {
1061   int i;
1062   for (i = end - 1; i > 0; i -= 1)
1063     if (name[i] == '.' || (name[i] == '_' && name[i+1] == '_'))
1064       return i;
1065   return -1;
1066 }
1067
1068 /* If NAME is a string beginning with a separator (either '__', or
1069    '.'), chop this separator and return the result; else, return
1070    NAME.  */
1071
1072 static char *
1073 chop_separator (char *name)
1074 {
1075   if (*name == '.')
1076    return name + 1;
1077
1078   if (name[0] == '_' && name[1] == '_')
1079     return name + 2;
1080
1081   return name;
1082 }
1083
1084 /* Given that SELS is a string of the form (<sep><identifier>)*, where
1085    <sep> is '__' or '.', write the indicated sequence of
1086    STRUCTOP_STRUCT expression operators. */
1087 static void
1088 write_selectors (struct parser_state *par_state, char *sels)
1089 {
1090   while (*sels != '\0')
1091     {
1092       struct stoken field_name;
1093       char *p = chop_separator (sels);
1094       sels = p;
1095       while (*sels != '\0' && *sels != '.'
1096              && (sels[0] != '_' || sels[1] != '_'))
1097         sels += 1;
1098       field_name.length = sels - p;
1099       field_name.ptr = p;
1100       write_exp_op_with_string (par_state, STRUCTOP_STRUCT, field_name);
1101     }
1102 }
1103
1104 /* Write a variable access (OP_VAR_VALUE) to ambiguous encoded name
1105    NAME[0..LEN-1], in block context BLOCK, to be resolved later.  Writes
1106    a temporary symbol that is valid until the next call to ada_parse.
1107    */
1108 static void
1109 write_ambiguous_var (struct parser_state *par_state,
1110                      const struct block *block, char *name, int len)
1111 {
1112   struct symbol *sym = XOBNEW (&temp_parse_space, struct symbol);
1113
1114   memset (sym, 0, sizeof (struct symbol));
1115   SYMBOL_DOMAIN (sym) = UNDEF_DOMAIN;
1116   SYMBOL_LINKAGE_NAME (sym)
1117     = (const char *) obstack_copy0 (&temp_parse_space, name, len);
1118   SYMBOL_LANGUAGE (sym) = language_ada;
1119
1120   write_exp_elt_opcode (par_state, OP_VAR_VALUE);
1121   write_exp_elt_block (par_state, block);
1122   write_exp_elt_sym (par_state, sym);
1123   write_exp_elt_opcode (par_state, OP_VAR_VALUE);
1124 }
1125
1126 /* A convenient wrapper around ada_get_field_index that takes
1127    a non NUL-terminated FIELD_NAME0 and a FIELD_NAME_LEN instead
1128    of a NUL-terminated field name.  */
1129
1130 static int
1131 ada_nget_field_index (const struct type *type, const char *field_name0,
1132                       int field_name_len, int maybe_missing)
1133 {
1134   char *field_name = (char *) alloca ((field_name_len + 1) * sizeof (char));
1135
1136   strncpy (field_name, field_name0, field_name_len);
1137   field_name[field_name_len] = '\0';
1138   return ada_get_field_index (type, field_name, maybe_missing);
1139 }
1140
1141 /* If encoded_field_name is the name of a field inside symbol SYM,
1142    then return the type of that field.  Otherwise, return NULL.
1143
1144    This function is actually recursive, so if ENCODED_FIELD_NAME
1145    doesn't match one of the fields of our symbol, then try to see
1146    if ENCODED_FIELD_NAME could not be a succession of field names
1147    (in other words, the user entered an expression of the form
1148    TYPE_NAME.FIELD1.FIELD2.FIELD3), in which case we evaluate
1149    each field name sequentially to obtain the desired field type.
1150    In case of failure, we return NULL.  */
1151
1152 static struct type *
1153 get_symbol_field_type (struct symbol *sym, char *encoded_field_name)
1154 {
1155   char *field_name = encoded_field_name;
1156   char *subfield_name;
1157   struct type *type = SYMBOL_TYPE (sym);
1158   int fieldno;
1159
1160   if (type == NULL || field_name == NULL)
1161     return NULL;
1162   type = check_typedef (type);
1163
1164   while (field_name[0] != '\0')
1165     {
1166       field_name = chop_separator (field_name);
1167
1168       fieldno = ada_get_field_index (type, field_name, 1);
1169       if (fieldno >= 0)
1170         return TYPE_FIELD_TYPE (type, fieldno);
1171
1172       subfield_name = field_name;
1173       while (*subfield_name != '\0' && *subfield_name != '.'
1174              && (subfield_name[0] != '_' || subfield_name[1] != '_'))
1175         subfield_name += 1;
1176
1177       if (subfield_name[0] == '\0')
1178         return NULL;
1179
1180       fieldno = ada_nget_field_index (type, field_name,
1181                                       subfield_name - field_name, 1);
1182       if (fieldno < 0)
1183         return NULL;
1184
1185       type = TYPE_FIELD_TYPE (type, fieldno);
1186       field_name = subfield_name;
1187     }
1188
1189   return NULL;
1190 }
1191
1192 /* Look up NAME0 (an unencoded identifier or dotted name) in BLOCK (or
1193    expression_block_context if NULL).  If it denotes a type, return
1194    that type.  Otherwise, write expression code to evaluate it as an
1195    object and return NULL. In this second case, NAME0 will, in general,
1196    have the form <name>(.<selector_name>)*, where <name> is an object
1197    or renaming encoded in the debugging data.  Calls error if no
1198    prefix <name> matches a name in the debugging data (i.e., matches
1199    either a complete name or, as a wild-card match, the final
1200    identifier).  */
1201
1202 static struct type*
1203 write_var_or_type (struct parser_state *par_state,
1204                    const struct block *block, struct stoken name0)
1205 {
1206   int depth;
1207   char *encoded_name;
1208   int name_len;
1209
1210   if (block == NULL)
1211     block = expression_context_block;
1212
1213   encoded_name = ada_encode (name0.ptr);
1214   name_len = strlen (encoded_name);
1215   encoded_name
1216     = (char *) obstack_copy0 (&temp_parse_space, encoded_name, name_len);
1217   for (depth = 0; depth < MAX_RENAMING_CHAIN_LENGTH; depth += 1)
1218     {
1219       int tail_index;
1220
1221       tail_index = name_len;
1222       while (tail_index > 0)
1223         {
1224           int nsyms;
1225           struct block_symbol *syms;
1226           struct symbol *type_sym;
1227           struct symbol *renaming_sym;
1228           const char* renaming;
1229           int renaming_len;
1230           const char* renaming_expr;
1231           int terminator = encoded_name[tail_index];
1232
1233           encoded_name[tail_index] = '\0';
1234           nsyms = ada_lookup_symbol_list (encoded_name, block,
1235                                           VAR_DOMAIN, &syms);
1236           encoded_name[tail_index] = terminator;
1237
1238           /* A single symbol may rename a package or object. */
1239
1240           /* This should go away when we move entirely to new version.
1241              FIXME pnh 7/20/2007. */
1242           if (nsyms == 1)
1243             {
1244               struct symbol *ren_sym =
1245                 ada_find_renaming_symbol (syms[0].symbol, syms[0].block);
1246
1247               if (ren_sym != NULL)
1248                 syms[0].symbol = ren_sym;
1249             }
1250
1251           type_sym = select_possible_type_sym (syms, nsyms);
1252
1253           if (type_sym != NULL)
1254             renaming_sym = type_sym;
1255           else if (nsyms == 1)
1256             renaming_sym = syms[0].symbol;
1257           else
1258             renaming_sym = NULL;
1259
1260           switch (ada_parse_renaming (renaming_sym, &renaming,
1261                                       &renaming_len, &renaming_expr))
1262             {
1263             case ADA_NOT_RENAMING:
1264               break;
1265             case ADA_PACKAGE_RENAMING:
1266             case ADA_EXCEPTION_RENAMING:
1267             case ADA_SUBPROGRAM_RENAMING:
1268               {
1269                 int alloc_len = renaming_len + name_len - tail_index + 1;
1270                 char *new_name
1271                   = (char *) obstack_alloc (&temp_parse_space, alloc_len);
1272                 strncpy (new_name, renaming, renaming_len);
1273                 strcpy (new_name + renaming_len, encoded_name + tail_index);
1274                 encoded_name = new_name;
1275                 name_len = renaming_len + name_len - tail_index;
1276                 goto TryAfterRenaming;
1277               }
1278             case ADA_OBJECT_RENAMING:
1279               write_object_renaming (par_state, block, renaming, renaming_len,
1280                                      renaming_expr, MAX_RENAMING_CHAIN_LENGTH);
1281               write_selectors (par_state, encoded_name + tail_index);
1282               return NULL;
1283             default:
1284               internal_error (__FILE__, __LINE__,
1285                               _("impossible value from ada_parse_renaming"));
1286             }
1287
1288           if (type_sym != NULL)
1289             {
1290               struct type *field_type;
1291
1292               if (tail_index == name_len)
1293                 return SYMBOL_TYPE (type_sym);
1294
1295               /* We have some extraneous characters after the type name.
1296                  If this is an expression "TYPE_NAME.FIELD0.[...].FIELDN",
1297                  then try to get the type of FIELDN.  */
1298               field_type
1299                 = get_symbol_field_type (type_sym, encoded_name + tail_index);
1300               if (field_type != NULL)
1301                 return field_type;
1302               else
1303                 error (_("Invalid attempt to select from type: \"%s\"."),
1304                        name0.ptr);
1305             }
1306           else if (tail_index == name_len && nsyms == 0)
1307             {
1308               struct type *type = find_primitive_type (par_state,
1309                                                        encoded_name);
1310
1311               if (type != NULL)
1312                 return type;
1313             }
1314
1315           if (nsyms == 1)
1316             {
1317               write_var_from_sym (par_state, block, syms[0].block,
1318                                   syms[0].symbol);
1319               write_selectors (par_state, encoded_name + tail_index);
1320               return NULL;
1321             }
1322           else if (nsyms == 0)
1323             {
1324               struct bound_minimal_symbol msym
1325                 = ada_lookup_simple_minsym (encoded_name);
1326               if (msym.minsym != NULL)
1327                 {
1328                   write_exp_msymbol (par_state, msym);
1329                   /* Maybe cause error here rather than later? FIXME? */
1330                   write_selectors (par_state, encoded_name + tail_index);
1331                   return NULL;
1332                 }
1333
1334               if (tail_index == name_len
1335                   && strncmp (encoded_name, "standard__",
1336                               sizeof ("standard__") - 1) == 0)
1337                 error (_("No definition of \"%s\" found."), name0.ptr);
1338
1339               tail_index = chop_selector (encoded_name, tail_index);
1340             }
1341           else
1342             {
1343               write_ambiguous_var (par_state, block, encoded_name,
1344                                    tail_index);
1345               write_selectors (par_state, encoded_name + tail_index);
1346               return NULL;
1347             }
1348         }
1349
1350       if (!have_full_symbols () && !have_partial_symbols () && block == NULL)
1351         error (_("No symbol table is loaded.  Use the \"file\" command."));
1352       if (block == expression_context_block)
1353         error (_("No definition of \"%s\" in current context."), name0.ptr);
1354       else
1355         error (_("No definition of \"%s\" in specified context."), name0.ptr);
1356
1357     TryAfterRenaming: ;
1358     }
1359
1360   error (_("Could not find renamed symbol \"%s\""), name0.ptr);
1361
1362 }
1363
1364 /* Write a left side of a component association (e.g., NAME in NAME =>
1365    exp).  If NAME has the form of a selected component, write it as an
1366    ordinary expression.  If it is a simple variable that unambiguously
1367    corresponds to exactly one symbol that does not denote a type or an
1368    object renaming, also write it normally as an OP_VAR_VALUE.
1369    Otherwise, write it as an OP_NAME.
1370
1371    Unfortunately, we don't know at this point whether NAME is supposed
1372    to denote a record component name or the value of an array index.
1373    Therefore, it is not appropriate to disambiguate an ambiguous name
1374    as we normally would, nor to replace a renaming with its referent.
1375    As a result, in the (one hopes) rare case that one writes an
1376    aggregate such as (R => 42) where R renames an object or is an
1377    ambiguous name, one must write instead ((R) => 42). */
1378
1379 static void
1380 write_name_assoc (struct parser_state *par_state, struct stoken name)
1381 {
1382   if (strchr (name.ptr, '.') == NULL)
1383     {
1384       struct block_symbol *syms;
1385       int nsyms = ada_lookup_symbol_list (name.ptr, expression_context_block,
1386                                           VAR_DOMAIN, &syms);
1387
1388       if (nsyms != 1 || SYMBOL_CLASS (syms[0].symbol) == LOC_TYPEDEF)
1389         write_exp_op_with_string (par_state, OP_NAME, name);
1390       else
1391         write_var_from_sym (par_state, NULL, syms[0].block, syms[0].symbol);
1392     }
1393   else
1394     if (write_var_or_type (par_state, NULL, name) != NULL)
1395       error (_("Invalid use of type."));
1396 }
1397
1398 /* Convert the character literal whose ASCII value would be VAL to the
1399    appropriate value of type TYPE, if there is a translation.
1400    Otherwise return VAL.  Hence, in an enumeration type ('A', 'B'),
1401    the literal 'A' (VAL == 65), returns 0.  */
1402
1403 static LONGEST
1404 convert_char_literal (struct type *type, LONGEST val)
1405 {
1406   char name[7];
1407   int f;
1408
1409   if (type == NULL)
1410     return val;
1411   type = check_typedef (type);
1412   if (TYPE_CODE (type) != TYPE_CODE_ENUM)
1413     return val;
1414
1415   xsnprintf (name, sizeof (name), "QU%02x", (int) val);
1416   for (f = 0; f < TYPE_NFIELDS (type); f += 1)
1417     {
1418       if (strcmp (name, TYPE_FIELD_NAME (type, f)) == 0)
1419         return TYPE_FIELD_ENUMVAL (type, f);
1420     }
1421   return val;
1422 }
1423
1424 static struct type *
1425 type_int (struct parser_state *par_state)
1426 {
1427   return parse_type (par_state)->builtin_int;
1428 }
1429
1430 static struct type *
1431 type_long (struct parser_state *par_state)
1432 {
1433   return parse_type (par_state)->builtin_long;
1434 }
1435
1436 static struct type *
1437 type_long_long (struct parser_state *par_state)
1438 {
1439   return parse_type (par_state)->builtin_long_long;
1440 }
1441
1442 static struct type *
1443 type_float (struct parser_state *par_state)
1444 {
1445   return parse_type (par_state)->builtin_float;
1446 }
1447
1448 static struct type *
1449 type_double (struct parser_state *par_state)
1450 {
1451   return parse_type (par_state)->builtin_double;
1452 }
1453
1454 static struct type *
1455 type_long_double (struct parser_state *par_state)
1456 {
1457   return parse_type (par_state)->builtin_long_double;
1458 }
1459
1460 static struct type *
1461 type_char (struct parser_state *par_state)
1462 {
1463   return language_string_char_type (parse_language (par_state),
1464                                     parse_gdbarch (par_state));
1465 }
1466
1467 static struct type *
1468 type_boolean (struct parser_state *par_state)
1469 {
1470   return parse_type (par_state)->builtin_bool;
1471 }
1472
1473 static struct type *
1474 type_system_address (struct parser_state *par_state)
1475 {
1476   struct type *type
1477     = language_lookup_primitive_type (parse_language (par_state),
1478                                       parse_gdbarch (par_state),
1479                                       "system__address");
1480   return  type != NULL ? type : parse_type (par_state)->builtin_data_ptr;
1481 }
1482
1483 void
1484 _initialize_ada_exp (void)
1485 {
1486   obstack_init (&temp_parse_space);
1487 }