gdb/ada-exp.y

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