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