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