gdb/ada-exp.y

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