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