gdb/ada-exp.y

   1 /* YACC parser for Ada expressions, for GDB.
   2    Copyright (C) 1986, 1989, 1990, 1991, 1993, 1994, 1997, 2000
   3    Free Software Foundation, Inc.
   4
   5 This file is part of GDB.
   6
   7 This program is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2 of the License, or
  10 (at your option) any later version.
  11
  12 This program is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with this program; if not, write to the Free Software
  19 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
  20
  21 /* Parse an Ada expression from text in a string,
  22    and return the result as a  struct expression  pointer.
  23    That structure contains arithmetic operations in reverse polish,
  24    with constants represented by operations that are followed by special data.
  25    See expression.h for the details of the format.
  26    What is important here is that it can be built up sequentially
  27    during the process of parsing; the lower levels of the tree always
  28    come first in the result.
  29
  30    malloc's and realloc's in this file are transformed to
  31    xmalloc and xrealloc respectively by the same sed command in the
  32    makefile that remaps any other malloc/realloc inserted by the parser
  33    generator.  Doing this with #defines and trying to control the interaction
  34    with include files (<malloc.h> and <stdlib.h> for example) just became
  35    too messy, particularly when such includes can be inserted at random
  36    times by the parser generator.  */
  37
  38 %{
  39
  40 #include "defs.h"
  41 #include <string.h>
  42 #include <ctype.h>
  43 #include "expression.h"
  44 #include "value.h"
  45 #include "parser-defs.h"
  46 #include "language.h"
  47 #include "ada-lang.h"
  48 #include "bfd.h" /* Required by objfiles.h.  */
  49 #include "symfile.h" /* Required by objfiles.h.  */
  50 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
  51 #include "frame.h"
  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 #define yyparse _ada_parse      /* ada_parse calls this after  initialization */
  66 #define yylex   ada_lex
  67 #define yyerror ada_error
  68 #define yylval  ada_lval
  69 #define yychar  ada_char
  70 #define yydebug ada_debug
  71 #define yypact  ada_pact
  72 #define yyr1    ada_r1
  73 #define yyr2    ada_r2
  74 #define yydef   ada_def
  75 #define yychk   ada_chk
  76 #define yypgo   ada_pgo
  77 #define yyact   ada_act
  78 #define yyexca  ada_exca
  79 #define yyerrflag ada_errflag
  80 #define yynerrs ada_nerrs
  81 #define yyps    ada_ps
  82 #define yypv    ada_pv
  83 #define yys     ada_s
  84 #define yy_yys  ada_yys
  85 #define yystate ada_state
  86 #define yytmp   ada_tmp
  87 #define yyv     ada_v
  88 #define yy_yyv  ada_yyv
  89 #define yyval   ada_val
  90 #define yylloc  ada_lloc
  91 #define yyreds  ada_reds                /* With YYDEBUG defined */
  92 #define yytoks  ada_toks                /* With YYDEBUG defined */
  93
  94 #ifndef YYDEBUG
  95 #define YYDEBUG 0               /* Default to no yydebug support */
  96 #endif
  97
  98 struct name_info {
  99   struct symbol* sym;
 100   struct minimal_symbol* msym;
 101   struct block* block;
 102   struct stoken stoken;
 103 };
 104
 105 /* If expression is in the context of TYPE'(...), then TYPE, else
 106  * NULL. */
 107 static struct type* type_qualifier;
 108
 109 int yyparse (void);
 110
 111 static int yylex (void);
 112
 113 void yyerror (char *);
 114
 115 static struct stoken string_to_operator (struct stoken);
 116
 117 static void write_attribute_call0 (enum ada_attribute);
 118
 119 static void write_attribute_call1 (enum ada_attribute, LONGEST);
 120
 121 static void write_attribute_calln (enum ada_attribute, int);
 122
 123 static void write_object_renaming (struct block*, struct symbol*);
 124
 125 static void write_var_from_name (struct block*, struct name_info);
 126
 127 static LONGEST
 128 convert_char_literal (struct type*, LONGEST);
 129 %}
 130
 131 %union
 132   {
 133     LONGEST lval;
 134     struct {
 135       LONGEST val;
 136       struct type *type;
 137     } typed_val;
 138     struct {
 139       DOUBLEST dval;
 140       struct type *type;
 141     } typed_val_float;
 142     struct type *tval;
 143     struct stoken sval;
 144     struct name_info ssym;
 145     int voidval;
 146     struct block *bval;
 147     struct internalvar *ivar;
 148
 149   }
 150
 151 %type <voidval> exp exp1 simple_exp start variable
 152 %type <tval> type
 153
 154 %token <typed_val> INT NULL_PTR CHARLIT
 155 %token <typed_val_float> FLOAT
 156 %token <tval> TYPENAME
 157 %token <bval> BLOCKNAME
 158
 159 /* Both NAME and TYPENAME tokens represent symbols in the input,
 160    and both convey their data as strings.
 161    But a TYPENAME is a string that happens to be defined as a typedef
 162    or builtin type name (such as int or char)
 163    and a NAME is any other symbol.
 164    Contexts where this distinction is not important can use the
 165    nonterminal "name", which matches either NAME or TYPENAME.  */
 166
 167 %token <sval> STRING
 168 %token <ssym> NAME DOT_ID OBJECT_RENAMING
 169 %type <bval> block
 170 %type <lval> arglist tick_arglist
 171
 172 %type <tval> save_qualifier
 173
 174 %token DOT_ALL
 175
 176 /* Special type cases, put in to allow the parser to distinguish different
 177    legal basetypes.  */
 178 %token <lval> LAST REGNAME
 179
 180 %token <ivar> INTERNAL_VARIABLE
 181
 182 %nonassoc ASSIGN
 183 %left _AND_ OR XOR THEN ELSE
 184 %left '=' NOTEQUAL '<' '>' LEQ GEQ IN DOTDOT
 185 %left '@'
 186 %left '+' '-' '&'
 187 %left UNARY
 188 %left '*' '/' MOD REM
 189 %right STARSTAR ABS NOT
 190  /* The following are right-associative only so that reductions at this
 191     precedence have lower precedence than '.' and '('. The syntax still
 192     forces a.b.c, e.g., to be LEFT-associated. */
 193 %right TICK_ACCESS TICK_ADDRESS TICK_FIRST TICK_LAST TICK_LENGTH
 194 %right TICK_MAX TICK_MIN TICK_MODULUS
 195 %right TICK_POS TICK_RANGE TICK_SIZE TICK_TAG TICK_VAL
 196 %right '.' '(' '[' DOT_ID DOT_ALL
 197
 198 %token ARROW NEW
 199
 200 \f
 201 %%
 202
 203 start   :       exp1
 204         |       type    { write_exp_elt_opcode (OP_TYPE);
 205                           write_exp_elt_type ($1);
 206                           write_exp_elt_opcode (OP_TYPE); }
 207         ;
 208
 209 /* Expressions, including the sequencing operator.  */
 210 exp1    :       exp
 211         |       exp1 ';' exp
 212                         { write_exp_elt_opcode (BINOP_COMMA); }
 213         ;
 214
 215 /* Expressions, not including the sequencing operator.  */
 216 simple_exp :    simple_exp DOT_ALL
 217                         { write_exp_elt_opcode (UNOP_IND); }
 218         ;
 219
 220 simple_exp :    simple_exp DOT_ID
 221                         { write_exp_elt_opcode (STRUCTOP_STRUCT);
 222                           write_exp_string ($2.stoken);
 223                           write_exp_elt_opcode (STRUCTOP_STRUCT);
 224                           }
 225         ;
 226
 227 simple_exp :    simple_exp '(' arglist ')'
 228                         {
 229                           write_exp_elt_opcode (OP_FUNCALL);
 230                           write_exp_elt_longcst ($3);
 231                           write_exp_elt_opcode (OP_FUNCALL);
 232                         }
 233         ;
 234
 235 simple_exp :    type '(' exp ')'
 236                         {
 237                           write_exp_elt_opcode (UNOP_CAST);
 238                           write_exp_elt_type ($1);
 239                           write_exp_elt_opcode (UNOP_CAST);
 240                         }
 241         ;
 242
 243 simple_exp :    type '\'' save_qualifier { type_qualifier = $1; } '(' exp ')'
 244                         {
 245                           /*                      write_exp_elt_opcode (UNOP_QUAL); */
 246                           /* FIXME: UNOP_QUAL should be defined in expression.h */
 247                           write_exp_elt_type ($1);
 248                           /* write_exp_elt_opcode (UNOP_QUAL); */
 249                           /* FIXME: UNOP_QUAL should be defined in expression.h */
 250                           type_qualifier = $3;
 251                         }
 252         ;
 253
 254 save_qualifier :        { $$ = type_qualifier; }
 255
 256 simple_exp :
 257                 simple_exp '(' exp DOTDOT exp ')'
 258                         { write_exp_elt_opcode (TERNOP_SLICE); }
 259         ;
 260
 261 simple_exp :    '(' exp1 ')'    { }
 262         ;
 263
 264 simple_exp :    variable
 265         ;
 266
 267 simple_exp:     REGNAME /* GDB extension */
 268                         { write_exp_elt_opcode (OP_REGISTER);
 269                           write_exp_elt_longcst ((LONGEST) $1);
 270                           write_exp_elt_opcode (OP_REGISTER);
 271                         }
 272         ;
 273
 274 simple_exp:     INTERNAL_VARIABLE /* GDB extension */
 275                         { write_exp_elt_opcode (OP_INTERNALVAR);
 276                           write_exp_elt_intern ($1);
 277                           write_exp_elt_opcode (OP_INTERNALVAR);
 278                         }
 279         ;
 280
 281
 282 exp     :       simple_exp
 283         ;
 284
 285 simple_exp:     LAST
 286                         { write_exp_elt_opcode (OP_LAST);
 287                           write_exp_elt_longcst ((LONGEST) $1);
 288                           write_exp_elt_opcode (OP_LAST);
 289                          }
 290         ;
 291
 292 exp     :       exp ASSIGN exp   /* Extension for convenience */
 293                         { write_exp_elt_opcode (BINOP_ASSIGN); }
 294         ;
 295
 296 exp     :       '-' exp    %prec UNARY
 297                         { write_exp_elt_opcode (UNOP_NEG); }
 298         ;
 299
 300 exp     :       '+' exp    %prec UNARY
 301                         { write_exp_elt_opcode (UNOP_PLUS); }
 302         ;
 303
 304 exp     :       NOT exp    %prec UNARY
 305                         { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
 306         ;
 307
 308 exp     :       ABS exp    %prec UNARY
 309                         { write_exp_elt_opcode (UNOP_ABS); }
 310         ;
 311
 312 arglist :               { $$ = 0; }
 313         ;
 314
 315 arglist :       exp
 316                         { $$ = 1; }
 317         |       any_name ARROW exp
 318                         { $$ = 1; }
 319         |       arglist ',' exp
 320                         { $$ = $1 + 1; }
 321         |       arglist ',' any_name ARROW exp
 322                         { $$ = $1 + 1; }
 323         ;
 324
 325 exp     :       '{' type '}' exp  %prec '.'
 326                 /* GDB extension */
 327                         { write_exp_elt_opcode (UNOP_MEMVAL);
 328                           write_exp_elt_type ($2);
 329                           write_exp_elt_opcode (UNOP_MEMVAL);
 330                         }
 331         ;
 332
 333 /* Binary operators in order of decreasing precedence.  */
 334
 335 exp     :       exp STARSTAR exp
 336                         { write_exp_elt_opcode (BINOP_EXP); }
 337         ;
 338
 339 exp     :       exp '*' exp
 340                         { write_exp_elt_opcode (BINOP_MUL); }
 341         ;
 342
 343 exp     :       exp '/' exp
 344                         { write_exp_elt_opcode (BINOP_DIV); }
 345         ;
 346
 347 exp     :       exp REM exp /* May need to be fixed to give correct Ada REM */
 348                         { write_exp_elt_opcode (BINOP_REM); }
 349         ;
 350
 351 exp     :       exp MOD exp
 352                         { write_exp_elt_opcode (BINOP_MOD); }
 353         ;
 354
 355 exp     :       exp '@' exp     /* GDB extension */
 356                         { write_exp_elt_opcode (BINOP_REPEAT); }
 357         ;
 358
 359 exp     :       exp '+' exp
 360                         { write_exp_elt_opcode (BINOP_ADD); }
 361         ;
 362
 363 exp     :       exp '&' exp
 364                         { write_exp_elt_opcode (BINOP_CONCAT); }
 365         ;
 366
 367 exp     :       exp '-' exp
 368                         { write_exp_elt_opcode (BINOP_SUB); }
 369         ;
 370
 371 exp     :       exp '=' exp
 372                         { write_exp_elt_opcode (BINOP_EQUAL); }
 373         ;
 374
 375 exp     :       exp NOTEQUAL exp
 376                         { write_exp_elt_opcode (BINOP_NOTEQUAL); }
 377         ;
 378
 379 exp     :       exp LEQ exp
 380                         { write_exp_elt_opcode (BINOP_LEQ); }
 381         ;
 382
 383 exp     :       exp IN exp DOTDOT exp
 384                         { /*write_exp_elt_opcode (TERNOP_MBR); */ }
 385                           /* FIXME: TERNOP_MBR should be defined in
 386                              expression.h */
 387         |       exp IN exp TICK_RANGE tick_arglist
 388                         { /*write_exp_elt_opcode (BINOP_MBR); */
 389                           /* FIXME: BINOP_MBR should be defined in expression.h */
 390                           write_exp_elt_longcst ((LONGEST) $5);
 391                           /*write_exp_elt_opcode (BINOP_MBR); */
 392                         }
 393         |       exp IN TYPENAME         %prec TICK_ACCESS
 394                         { /*write_exp_elt_opcode (UNOP_MBR); */
 395                           /* FIXME: UNOP_QUAL should be defined in expression.h */
 396                           write_exp_elt_type ($3);
 397                           /*                      write_exp_elt_opcode (UNOP_MBR); */
 398                           /* FIXME: UNOP_MBR should be defined in expression.h */
 399                         }
 400         |       exp NOT IN exp DOTDOT exp
 401                         { /*write_exp_elt_opcode (TERNOP_MBR); */
 402                           /* FIXME: TERNOP_MBR should be defined in expression.h */
 403                           write_exp_elt_opcode (UNOP_LOGICAL_NOT);
 404                         }
 405         |       exp NOT IN exp TICK_RANGE tick_arglist
 406                         { /* write_exp_elt_opcode (BINOP_MBR); */
 407                           /* FIXME: BINOP_MBR should be defined in expression.h */
 408                           write_exp_elt_longcst ((LONGEST) $6);
 409                           /*write_exp_elt_opcode (BINOP_MBR);*/
 410                           /* FIXME: BINOP_MBR should be defined in expression.h */
 411                           write_exp_elt_opcode (UNOP_LOGICAL_NOT);
 412                         }
 413         |       exp NOT IN TYPENAME     %prec TICK_ACCESS
 414                         { /*write_exp_elt_opcode (UNOP_MBR);*/
 415                           /* FIXME: UNOP_MBR should be defined in expression.h */
 416                           write_exp_elt_type ($4);
 417                           /*                      write_exp_elt_opcode (UNOP_MBR);*/
 418                           /* FIXME: UNOP_MBR should be defined in expression.h */
 419                           write_exp_elt_opcode (UNOP_LOGICAL_NOT);
 420                         }
 421         ;
 422
 423 exp     :       exp GEQ exp
 424                         { write_exp_elt_opcode (BINOP_GEQ); }
 425         ;
 426
 427 exp     :       exp '<' exp
 428                         { write_exp_elt_opcode (BINOP_LESS); }
 429         ;
 430
 431 exp     :       exp '>' exp
 432                         { write_exp_elt_opcode (BINOP_GTR); }
 433         ;
 434
 435 exp     :       exp _AND_ exp  /* Fix for Ada elementwise AND. */
 436                         { write_exp_elt_opcode (BINOP_BITWISE_AND); }
 437         ;
 438
 439 exp     :       exp _AND_ THEN exp      %prec _AND_
 440                         { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
 441         ;
 442
 443 exp     :       exp OR exp     /* Fix for Ada elementwise OR */
 444                         { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
 445         ;
 446
 447 exp     :       exp OR ELSE exp
 448                         { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
 449         ;
 450
 451 exp     :       exp XOR exp    /* Fix for Ada elementwise XOR */
 452                         { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
 453         ;
 454
 455 simple_exp :    simple_exp TICK_ACCESS
 456                         { write_exp_elt_opcode (UNOP_ADDR); }
 457         |       simple_exp TICK_ADDRESS
 458                         { write_exp_elt_opcode (UNOP_ADDR);
 459                           write_exp_elt_opcode (UNOP_CAST);
 460                           write_exp_elt_type (builtin_type_ada_system_address);
 461                           write_exp_elt_opcode (UNOP_CAST);
 462                         }
 463         |       simple_exp TICK_FIRST tick_arglist
 464                         { write_attribute_call1 (ATR_FIRST, $3); }
 465         |       simple_exp TICK_LAST tick_arglist
 466                         { write_attribute_call1 (ATR_LAST, $3); }
 467         |       simple_exp TICK_LENGTH tick_arglist
 468                         { write_attribute_call1 (ATR_LENGTH, $3); }
 469         |       simple_exp TICK_SIZE
 470                         { write_attribute_call0 (ATR_SIZE); }
 471         |       simple_exp TICK_TAG
 472                         { write_attribute_call0 (ATR_TAG); }
 473         |       opt_type_prefix TICK_MIN '(' exp ',' exp ')'
 474                         { write_attribute_calln (ATR_MIN, 2); }
 475         |       opt_type_prefix TICK_MAX '(' exp ',' exp ')'
 476                         { write_attribute_calln (ATR_MAX, 2); }
 477         |       opt_type_prefix TICK_POS '(' exp ')'
 478                         { write_attribute_calln (ATR_POS, 1); }
 479         |       type_prefix TICK_FIRST tick_arglist
 480                         { write_attribute_call1 (ATR_FIRST, $3); }
 481         |       type_prefix TICK_LAST tick_arglist
 482                         { write_attribute_call1 (ATR_LAST, $3); }
 483         |       type_prefix TICK_LENGTH tick_arglist
 484                         { write_attribute_call1 (ATR_LENGTH, $3); }
 485         |       type_prefix TICK_VAL '(' exp ')'
 486                         { write_attribute_calln (ATR_VAL, 1); }
 487         |       type_prefix TICK_MODULUS
 488                         { write_attribute_call0 (ATR_MODULUS); }
 489         ;
 490
 491 tick_arglist :                  %prec '('
 492                         { $$ = 1; }
 493         |       '(' INT ')'
 494                         { $$ = $2.val; }
 495         ;
 496
 497 type_prefix :
 498                 TYPENAME
 499                         { write_exp_elt_opcode (OP_TYPE);
 500                           write_exp_elt_type ($1);
 501                           write_exp_elt_opcode (OP_TYPE); }
 502         ;
 503
 504 opt_type_prefix :
 505                 type_prefix
 506         |       /* EMPTY */
 507                         { write_exp_elt_opcode (OP_TYPE);
 508                           write_exp_elt_type (builtin_type_void);
 509                           write_exp_elt_opcode (OP_TYPE); }
 510         ;
 511
 512
 513 exp     :       INT
 514                         { write_exp_elt_opcode (OP_LONG);
 515                           write_exp_elt_type ($1.type);
 516                           write_exp_elt_longcst ((LONGEST)($1.val));
 517                           write_exp_elt_opcode (OP_LONG);
 518                         }
 519         ;
 520
 521 exp     :       CHARLIT
 522                         { write_exp_elt_opcode (OP_LONG);
 523                           if (type_qualifier == NULL)
 524                             write_exp_elt_type ($1.type);
 525                           else
 526                             write_exp_elt_type (type_qualifier);
 527                           write_exp_elt_longcst
 528                             (convert_char_literal (type_qualifier, $1.val));
 529                           write_exp_elt_opcode (OP_LONG);
 530                         }
 531
 532
 533 exp     :       FLOAT
 534                         { write_exp_elt_opcode (OP_DOUBLE);
 535                           write_exp_elt_type ($1.type);
 536                           write_exp_elt_dblcst ($1.dval);
 537                           write_exp_elt_opcode (OP_DOUBLE);
 538                         }
 539         ;
 540
 541 exp     :       NULL_PTR
 542                         { write_exp_elt_opcode (OP_LONG);
 543                           write_exp_elt_type (builtin_type_int);
 544                           write_exp_elt_longcst ((LONGEST)(0));
 545                           write_exp_elt_opcode (OP_LONG);
 546                          }
 547
 548 exp     :       STRING
 549                         { /* Ada strings are converted into array constants
 550                              a lower bound of 1.  Thus, the array upper bound
 551                              is the string length. */
 552                           char *sp = $1.ptr; int count;
 553                           if ($1.length == 0)
 554                             { /* One dummy character for the type */
 555                               write_exp_elt_opcode (OP_LONG);
 556                               write_exp_elt_type (builtin_type_ada_char);
 557                               write_exp_elt_longcst ((LONGEST)(0));
 558                               write_exp_elt_opcode (OP_LONG);
 559                             }
 560                           for (count = $1.length; count > 0; count -= 1)
 561                             {
 562                               write_exp_elt_opcode (OP_LONG);
 563                               write_exp_elt_type (builtin_type_ada_char);
 564                               write_exp_elt_longcst ((LONGEST)(*sp));
 565                               sp += 1;
 566                               write_exp_elt_opcode (OP_LONG);
 567                             }
 568                           write_exp_elt_opcode (OP_ARRAY);
 569                           write_exp_elt_longcst ((LONGEST) 1);
 570                           write_exp_elt_longcst ((LONGEST) ($1.length));
 571                           write_exp_elt_opcode (OP_ARRAY);
 572                          }
 573         ;
 574
 575 exp     :       NEW TYPENAME
 576                         { error ("NEW not implemented."); }
 577         ;
 578
 579 variable:       NAME            { write_var_from_name (NULL, $1); }
 580         |       block NAME      /* GDB extension */
 581                                 { write_var_from_name ($1, $2); }
 582         |       OBJECT_RENAMING { write_object_renaming (NULL, $1.sym); }
 583         |       block OBJECT_RENAMING
 584                                 { write_object_renaming ($1, $2.sym); }
 585         ;
 586
 587 any_name :      NAME            { }
 588         |       TYPENAME        { }
 589         |       OBJECT_RENAMING { }
 590         ;
 591
 592 block   :       BLOCKNAME  /* GDB extension */
 593                         { $$ = $1; }
 594         |       block BLOCKNAME /* GDB extension */
 595                         { $$ = $2; }
 596         ;
 597
 598
 599 type    :       TYPENAME        { $$ = $1; }
 600         |       block TYPENAME  { $$ = $2; }
 601         |       TYPENAME TICK_ACCESS
 602                                 { $$ = lookup_pointer_type ($1); }
 603         |       block TYPENAME TICK_ACCESS
 604                                 { $$ = lookup_pointer_type ($2); }
 605         ;
 606
 607 /* Some extensions borrowed from C, for the benefit of those who find they
 608    can't get used to Ada notation in GDB. */
 609
 610 exp     :       '*' exp         %prec '.'
 611                         { write_exp_elt_opcode (UNOP_IND); }
 612         |       '&' exp         %prec '.'
 613                         { write_exp_elt_opcode (UNOP_ADDR); }
 614         |       exp '[' exp ']'
 615                         { write_exp_elt_opcode (BINOP_SUBSCRIPT); }
 616         ;
 617
 618 %%
 619
 620 /* yylex defined in ada-lex.c: Reads one token, getting characters */
 621 /* through lexptr.  */
 622
 623 /* Remap normal flex interface names (yylex) as well as gratuitiously */
 624 /* global symbol names, so we can have multiple flex-generated parsers */
 625 /* in gdb.  */
 626
 627 /* (See note above on previous definitions for YACC.) */
 628
 629 #define yy_create_buffer ada_yy_create_buffer
 630 #define yy_delete_buffer ada_yy_delete_buffer
 631 #define yy_init_buffer ada_yy_init_buffer
 632 #define yy_load_buffer_state ada_yy_load_buffer_state
 633 #define yy_switch_to_buffer ada_yy_switch_to_buffer
 634 #define yyrestart ada_yyrestart
 635 #define yytext ada_yytext
 636 #define yywrap ada_yywrap
 637
 638 /* The following kludge was found necessary to prevent conflicts between */
 639 /* defs.h and non-standard stdlib.h files.  */
 640 #define qsort __qsort__dummy
 641 #include "ada-lex.c"
 642
 643 int
 644 ada_parse ()
 645 {
 646   lexer_init (yyin);            /* (Re-)initialize lexer. */
 647   left_block_context = NULL;
 648   type_qualifier = NULL;
 649
 650   return _ada_parse ();
 651 }
 652
 653 void
 654 yyerror (msg)
 655      char *msg;
 656 {
 657   error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
 658 }
 659
 660 /* The operator name corresponding to operator symbol STRING (adds
 661    quotes and maps to lower-case).  Destroys the previous contents of
 662    the array pointed to by STRING.ptr.  Error if STRING does not match
 663    a valid Ada operator.  Assumes that STRING.ptr points to a
 664    null-terminated string and that, if STRING is a valid operator
 665    symbol, the array pointed to by STRING.ptr contains at least
 666    STRING.length+3 characters. */
 667
 668 static struct stoken
 669 string_to_operator (string)
 670      struct stoken string;
 671 {
 672   int i;
 673
 674   for (i = 0; ada_opname_table[i].mangled != NULL; i += 1)
 675     {
 676       if (string.length == strlen (ada_opname_table[i].demangled)-2
 677           && strncasecmp (string.ptr, ada_opname_table[i].demangled+1,
 678                           string.length) == 0)
 679         {
 680           strncpy (string.ptr, ada_opname_table[i].demangled,
 681                    string.length+2);
 682           string.length += 2;
 683           return string;
 684         }
 685     }
 686   error ("Invalid operator symbol `%s'", string.ptr);
 687 }
 688
 689 /* Emit expression to access an instance of SYM, in block BLOCK (if
 690  * non-NULL), and with :: qualification ORIG_LEFT_CONTEXT. */
 691 static void
 692 write_var_from_sym (orig_left_context, block, sym)
 693      struct block* orig_left_context;
 694      struct block* block;
 695      struct symbol* sym;
 696 {
 697   if (orig_left_context == NULL && symbol_read_needs_frame (sym))
 698     {
 699       if (innermost_block == 0 ||
 700           contained_in (block, innermost_block))
 701         innermost_block = block;
 702     }
 703
 704   write_exp_elt_opcode (OP_VAR_VALUE);
 705   /* We want to use the selected frame, not another more inner frame
 706      which happens to be in the same block */
 707   write_exp_elt_block (NULL);
 708   write_exp_elt_sym (sym);
 709   write_exp_elt_opcode (OP_VAR_VALUE);
 710 }
 711
 712 /* Emit expression to access an instance of NAME. */
 713 static void
 714 write_var_from_name (orig_left_context, name)
 715      struct block* orig_left_context;
 716      struct name_info name;
 717 {
 718   if (name.msym != NULL)
 719     {
 720       write_exp_msymbol (name.msym,
 721                          lookup_function_type (builtin_type_int),
 722                          builtin_type_int);
 723     }
 724   else if (name.sym == NULL)
 725     {
 726       /* Multiple matches: record name and starting block for later
 727          resolution by ada_resolve. */
 728       /*      write_exp_elt_opcode (OP_UNRESOLVED_VALUE); */
 729       /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */
 730       write_exp_elt_block (name.block);
 731       /*      write_exp_elt_name (name.stoken.ptr); */
 732       /* FIXME: write_exp_elt_name should be defined in defs.h, located in parse.c */
 733       /*      write_exp_elt_opcode (OP_UNRESOLVED_VALUE); */
 734       /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */
 735     }
 736   else
 737     write_var_from_sym (orig_left_context, name.block, name.sym);
 738 }
 739
 740 /* Write a call on parameterless attribute ATR.  */
 741
 742 static void
 743 write_attribute_call0 (atr)
 744      enum ada_attribute atr;
 745 {
 746   /*  write_exp_elt_opcode (OP_ATTRIBUTE); */
 747   /* FIXME: OP_ATTRIBUTE should be defined in expression.h */
 748   write_exp_elt_longcst ((LONGEST) 0);
 749   write_exp_elt_longcst ((LONGEST) atr);
 750   /*  write_exp_elt_opcode (OP_ATTRIBUTE); */
 751   /* FIXME: OP_ATTRIBUTE should be defined in expression.h */
 752 }
 753
 754 /* Write a call on an attribute ATR with one constant integer
 755  * parameter. */
 756
 757 static void
 758 write_attribute_call1 (atr, arg)
 759      enum ada_attribute atr;
 760      LONGEST arg;
 761 {
 762   write_exp_elt_opcode (OP_LONG);
 763   write_exp_elt_type (builtin_type_int);
 764   write_exp_elt_longcst (arg);
 765   write_exp_elt_opcode (OP_LONG);
 766   /*write_exp_elt_opcode (OP_ATTRIBUTE);*/
 767   /* FIXME: OP_ATTRIBUTE should be defined in expression.h */
 768   write_exp_elt_longcst ((LONGEST) 1);
 769   write_exp_elt_longcst ((LONGEST) atr);
 770   /*write_exp_elt_opcode (OP_ATTRIBUTE);*/
 771   /* FIXME: OP_ATTRIBUTE should be defined in expression.h */
 772 }
 773
 774 /* Write a call on an attribute ATR with N parameters, whose code must have
 775  * been generated previously. */
 776
 777 static void
 778 write_attribute_calln (atr, n)
 779      enum ada_attribute atr;
 780      int n;
 781 {
 782   /*write_exp_elt_opcode (OP_ATTRIBUTE);*/
 783   /* FIXME: OP_ATTRIBUTE should be defined in expression.h */
 784   write_exp_elt_longcst ((LONGEST) n);
 785   write_exp_elt_longcst ((LONGEST) atr);
 786   /*  write_exp_elt_opcode (OP_ATTRIBUTE);*/
 787   /* FIXME: OP_ATTRIBUTE should be defined in expression.h */
 788 }
 789
 790 /* Emit expression corresponding to the renamed object designated by
 791  * the type RENAMING, which must be the referent of an object renaming
 792  * type, in the context of ORIG_LEFT_CONTEXT (?). */
 793 static void
 794 write_object_renaming (orig_left_context, renaming)
 795      struct block* orig_left_context;
 796      struct symbol* renaming;
 797 {
 798   const char* qualification = SYMBOL_NAME (renaming);
 799   const char* simple_tail;
 800   const char* expr = TYPE_FIELD_NAME (SYMBOL_TYPE (renaming), 0);
 801   const char* suffix;
 802   char* name;
 803   struct symbol* sym;
 804   enum { SIMPLE_INDEX, LOWER_BOUND, UPPER_BOUND } slice_state;
 805
 806   /* if orig_left_context is null, then use the currently selected
 807      block, otherwise we might fail our symbol lookup below */
 808   if (orig_left_context == NULL)
 809     orig_left_context = get_selected_block (NULL);
 810
 811   for (simple_tail = qualification + strlen (qualification);
 812        simple_tail != qualification; simple_tail -= 1)
 813     {
 814       if (*simple_tail == '.')
 815         {
 816           simple_tail += 1;
 817           break;
 818         }
 819       else if (STREQN (simple_tail, "__", 2))
 820         {
 821           simple_tail += 2;
 822           break;
 823         }
 824     }
 825
 826   suffix = strstr (expr, "___XE");
 827   if (suffix == NULL)
 828     goto BadEncoding;
 829
 830   name = (char*) malloc (suffix - expr + 1);
 831   /*  add_name_string_cleanup (name); */
 832   /* FIXME: add_name_string_cleanup should be defined in
 833      parser-defs.h, implemented in parse.c */
 834   strncpy (name, expr, suffix-expr);
 835   name[suffix-expr] = '\000';
 836   sym = lookup_symbol (name, orig_left_context, VAR_NAMESPACE, 0, NULL);
 837   /*  if (sym == NULL)
 838     error ("Could not find renamed variable: %s", ada_demangle (name));
 839   */
 840   /* FIXME: ada_demangle should be defined in defs.h, implemented in ada-lang.c */
 841   write_var_from_sym (orig_left_context, block_found, sym);
 842
 843   suffix += 5;
 844   slice_state = SIMPLE_INDEX;
 845   while (*suffix == 'X')
 846     {
 847       suffix += 1;
 848
 849       switch (*suffix) {
 850       case 'L':
 851         slice_state = LOWER_BOUND;
 852       case 'S':
 853         suffix += 1;
 854         if (isdigit (*suffix))
 855           {
 856             char* next;
 857             long val = strtol (suffix, &next, 10);
 858             if (next == suffix)
 859               goto BadEncoding;
 860             suffix = next;
 861             write_exp_elt_opcode (OP_LONG);
 862             write_exp_elt_type (builtin_type_ada_int);
 863             write_exp_elt_longcst ((LONGEST) val);
 864             write_exp_elt_opcode (OP_LONG);
 865           }
 866         else
 867           {
 868             const char* end;
 869             char* index_name;
 870             int index_len;
 871             struct symbol* index_sym;
 872
 873             end = strchr (suffix, 'X');
 874             if (end == NULL)
 875               end = suffix + strlen (suffix);
 876
 877             index_len = simple_tail - qualification + 2 + (suffix - end) + 1;
 878             index_name = (char*) malloc (index_len);
 879             memset (index_name, '\000', index_len);
 880             /*      add_name_string_cleanup (index_name);*/
 881             /* FIXME: add_name_string_cleanup should be defined in
 882                parser-defs.h, implemented in parse.c */
 883             strncpy (index_name, qualification, simple_tail - qualification);
 884             index_name[simple_tail - qualification] = '\000';
 885             strncat (index_name, suffix, suffix-end);
 886             suffix = end;
 887
 888             index_sym =
 889               lookup_symbol (index_name, NULL, VAR_NAMESPACE, 0, NULL);
 890             if (index_sym == NULL)
 891               error ("Could not find %s", index_name);
 892             write_var_from_sym (NULL, block_found, sym);
 893           }
 894         if (slice_state == SIMPLE_INDEX)
 895           {
 896             write_exp_elt_opcode (OP_FUNCALL);
 897             write_exp_elt_longcst ((LONGEST) 1);
 898             write_exp_elt_opcode (OP_FUNCALL);
 899           }
 900         else if (slice_state == LOWER_BOUND)
 901           slice_state = UPPER_BOUND;
 902         else if (slice_state == UPPER_BOUND)
 903           {
 904             write_exp_elt_opcode (TERNOP_SLICE);
 905             slice_state = SIMPLE_INDEX;
 906           }
 907         break;
 908
 909       case 'R':
 910         {
 911           struct stoken field_name;
 912           const char* end;
 913           suffix += 1;
 914
 915           if (slice_state != SIMPLE_INDEX)
 916             goto BadEncoding;
 917           end = strchr (suffix, 'X');
 918           if (end == NULL)
 919             end = suffix + strlen (suffix);
 920           field_name.length = end - suffix;
 921           field_name.ptr = (char*) malloc (end - suffix + 1);
 922           strncpy (field_name.ptr, suffix, end - suffix);
 923           field_name.ptr[end - suffix] = '\000';
 924           suffix = end;
 925           write_exp_elt_opcode (STRUCTOP_STRUCT);
 926           write_exp_string (field_name);
 927           write_exp_elt_opcode (STRUCTOP_STRUCT);
 928           break;
 929         }
 930
 931       default:
 932         goto BadEncoding;
 933       }
 934     }
 935   if (slice_state == SIMPLE_INDEX)
 936     return;
 937
 938  BadEncoding:
 939   error ("Internal error in encoding of renaming declaration: %s",
 940          SYMBOL_NAME (renaming));
 941 }
 942
 943 /* Convert the character literal whose ASCII value would be VAL to the
 944    appropriate value of type TYPE, if there is a translation.
 945    Otherwise return VAL.  Hence, in an enumeration type ('A', 'B'),
 946    the literal 'A' (VAL == 65), returns 0. */
 947 static LONGEST
 948 convert_char_literal (struct type* type, LONGEST val)
 949 {
 950   char name[7];
 951   int f;
 952
 953   if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM)
 954     return val;
 955   sprintf (name, "QU%02x", (int) val);
 956   for (f = 0; f < TYPE_NFIELDS (type); f += 1)
 957     {
 958       if (STREQ (name, TYPE_FIELD_NAME (type, f)))
 959         return TYPE_FIELD_BITPOS (type, f);
 960     }
 961   return val;
 962 }