contrib/gdb/gdb/ada-exp.y

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