gdb/ada-exp.y

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