gdb/ada-exp.y

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