gdb/ada-exp.y

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