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