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