gdb/ada-exp.y

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