gdb/ada-exp.y

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