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