gdb/m2-exp.y

   1 /* YACC grammar for Modula-2 expressions, for GDB.
   2    Copyright (C) 1986-2016 Free Software Foundation, Inc.
   3    Generated from expread.y (now c-exp.y) and contributed by the Department
   4    of Computer Science at the State University of New York at Buffalo, 1991.
   5
   6    This file is part of GDB.
   7
   8    This program is free software; you can redistribute it and/or modify
   9    it under the terms of the GNU General Public License as published by
  10    the Free Software Foundation; either version 3 of the License, or
  11    (at your option) any later version.
  12
  13    This program is distributed in the hope that it will be useful,
  14    but WITHOUT ANY WARRANTY; without even the implied warranty of
  15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16    GNU General Public License for more details.
  17
  18    You should have received a copy of the GNU General Public License
  19    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  20
  21 /* Parse a Modula-2 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    Note that 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 "expression.h"
  42 #include "language.h"
  43 #include "value.h"
  44 #include "parser-defs.h"
  45 #include "m2-lang.h"
  46 #include "bfd.h" /* Required by objfiles.h.  */
  47 #include "symfile.h" /* Required by objfiles.h.  */
  48 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
  49 #include "block.h"
  50
  51 #define parse_type(ps) builtin_type (parse_gdbarch (ps))
  52 #define parse_m2_type(ps) builtin_m2_type (parse_gdbarch (ps))
  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.  Note that 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 #define yymaxdepth m2_maxdepth
  62 #define yyparse m2_parse_internal
  63 #define yylex   m2_lex
  64 #define yyerror m2_error
  65 #define yylval  m2_lval
  66 #define yychar  m2_char
  67 #define yydebug m2_debug
  68 #define yypact  m2_pact
  69 #define yyr1    m2_r1
  70 #define yyr2    m2_r2
  71 #define yydef   m2_def
  72 #define yychk   m2_chk
  73 #define yypgo   m2_pgo
  74 #define yyact   m2_act
  75 #define yyexca  m2_exca
  76 #define yyerrflag m2_errflag
  77 #define yynerrs m2_nerrs
  78 #define yyps    m2_ps
  79 #define yypv    m2_pv
  80 #define yys     m2_s
  81 #define yy_yys  m2_yys
  82 #define yystate m2_state
  83 #define yytmp   m2_tmp
  84 #define yyv     m2_v
  85 #define yy_yyv  m2_yyv
  86 #define yyval   m2_val
  87 #define yylloc  m2_lloc
  88 #define yyreds  m2_reds         /* With YYDEBUG defined */
  89 #define yytoks  m2_toks         /* With YYDEBUG defined */
  90 #define yyname  m2_name         /* With YYDEBUG defined */
  91 #define yyrule  m2_rule         /* With YYDEBUG defined */
  92 #define yylhs   m2_yylhs
  93 #define yylen   m2_yylen
  94 #define yydefred m2_yydefred
  95 #define yydgoto m2_yydgoto
  96 #define yysindex m2_yysindex
  97 #define yyrindex m2_yyrindex
  98 #define yygindex m2_yygindex
  99 #define yytable  m2_yytable
 100 #define yycheck  m2_yycheck
 101 #define yyss    m2_yyss
 102 #define yysslim m2_yysslim
 103 #define yyssp   m2_yyssp
 104 #define yystacksize m2_yystacksize
 105 #define yyvs    m2_yyvs
 106 #define yyvsp   m2_yyvsp
 107
 108 #ifndef YYDEBUG
 109 #define YYDEBUG 1               /* Default to yydebug support */
 110 #endif
 111
 112 #define YYFPRINTF parser_fprintf
 113
 114 /* The state of the parser, used internally when we are parsing the
 115    expression.  */
 116
 117 static struct parser_state *pstate = NULL;
 118
 119 int yyparse (void);
 120
 121 static int yylex (void);
 122
 123 void yyerror (char *);
 124
 125 static int parse_number (int);
 126
 127 /* The sign of the number being parsed.  */
 128 static int number_sign = 1;
 129
 130 %}
 131
 132 /* Although the yacc "value" of an expression is not used,
 133    since the result is stored in the structure being created,
 134    other node types do have values.  */
 135
 136 %union
 137   {
 138     LONGEST lval;
 139     ULONGEST ulval;
 140     DOUBLEST dval;
 141     struct symbol *sym;
 142     struct type *tval;
 143     struct stoken sval;
 144     int voidval;
 145     const struct block *bval;
 146     enum exp_opcode opcode;
 147     struct internalvar *ivar;
 148
 149     struct type **tvec;
 150     int *ivec;
 151   }
 152
 153 %type <voidval> exp type_exp start set
 154 %type <voidval> variable
 155 %type <tval> type
 156 %type <bval> block
 157 %type <sym> fblock
 158
 159 %token <lval> INT HEX ERROR
 160 %token <ulval> UINT M2_TRUE M2_FALSE CHAR
 161 %token <dval> FLOAT
 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
 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 <sval> NAME BLOCKNAME IDENT VARNAME
 174 %token <sval> TYPENAME
 175
 176 %token SIZE CAP ORD HIGH ABS MIN_FUNC MAX_FUNC FLOAT_FUNC VAL CHR ODD TRUNC
 177 %token TSIZE
 178 %token INC DEC INCL EXCL
 179
 180 /* The GDB scope operator */
 181 %token COLONCOLON
 182
 183 %token <voidval> INTERNAL_VAR
 184
 185 /* M2 tokens */
 186 %left ','
 187 %left ABOVE_COMMA
 188 %nonassoc ASSIGN
 189 %left '<' '>' LEQ GEQ '=' NOTEQUAL '#' IN
 190 %left OROR
 191 %left LOGICAL_AND '&'
 192 %left '@'
 193 %left '+' '-'
 194 %left '*' '/' DIV MOD
 195 %right UNARY
 196 %right '^' DOT '[' '('
 197 %right NOT '~'
 198 %left COLONCOLON QID
 199 /* This is not an actual token ; it is used for precedence.
 200 %right QID
 201 */
 202
 203 \f
 204 %%
 205
 206 start   :       exp
 207         |       type_exp
 208         ;
 209
 210 type_exp:       type
 211                 { write_exp_elt_opcode (pstate, OP_TYPE);
 212                   write_exp_elt_type (pstate, $1);
 213                   write_exp_elt_opcode (pstate, OP_TYPE);
 214                 }
 215         ;
 216
 217 /* Expressions */
 218
 219 exp     :       exp '^'   %prec UNARY
 220                         { write_exp_elt_opcode (pstate, UNOP_IND); }
 221         ;
 222
 223 exp     :       '-'
 224                         { number_sign = -1; }
 225                 exp    %prec UNARY
 226                         { number_sign = 1;
 227                           write_exp_elt_opcode (pstate, UNOP_NEG); }
 228         ;
 229
 230 exp     :       '+' exp    %prec UNARY
 231                 { write_exp_elt_opcode (pstate, UNOP_PLUS); }
 232         ;
 233
 234 exp     :       not_exp exp %prec UNARY
 235                         { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
 236         ;
 237
 238 not_exp :       NOT
 239         |       '~'
 240         ;
 241
 242 exp     :       CAP '(' exp ')'
 243                         { write_exp_elt_opcode (pstate, UNOP_CAP); }
 244         ;
 245
 246 exp     :       ORD '(' exp ')'
 247                         { write_exp_elt_opcode (pstate, UNOP_ORD); }
 248         ;
 249
 250 exp     :       ABS '(' exp ')'
 251                         { write_exp_elt_opcode (pstate, UNOP_ABS); }
 252         ;
 253
 254 exp     :       HIGH '(' exp ')'
 255                         { write_exp_elt_opcode (pstate, UNOP_HIGH); }
 256         ;
 257
 258 exp     :       MIN_FUNC '(' type ')'
 259                         { write_exp_elt_opcode (pstate, UNOP_MIN);
 260                           write_exp_elt_type (pstate, $3);
 261                           write_exp_elt_opcode (pstate, UNOP_MIN); }
 262         ;
 263
 264 exp     :       MAX_FUNC '(' type ')'
 265                         { write_exp_elt_opcode (pstate, UNOP_MAX);
 266                           write_exp_elt_type (pstate, $3);
 267                           write_exp_elt_opcode (pstate, UNOP_MAX); }
 268         ;
 269
 270 exp     :       FLOAT_FUNC '(' exp ')'
 271                         { write_exp_elt_opcode (pstate, UNOP_FLOAT); }
 272         ;
 273
 274 exp     :       VAL '(' type ',' exp ')'
 275                         { write_exp_elt_opcode (pstate, BINOP_VAL);
 276                           write_exp_elt_type (pstate, $3);
 277                           write_exp_elt_opcode (pstate, BINOP_VAL); }
 278         ;
 279
 280 exp     :       CHR '(' exp ')'
 281                         { write_exp_elt_opcode (pstate, UNOP_CHR); }
 282         ;
 283
 284 exp     :       ODD '(' exp ')'
 285                         { write_exp_elt_opcode (pstate, UNOP_ODD); }
 286         ;
 287
 288 exp     :       TRUNC '(' exp ')'
 289                         { write_exp_elt_opcode (pstate, UNOP_TRUNC); }
 290         ;
 291
 292 exp     :       TSIZE '(' exp ')'
 293                         { write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
 294         ;
 295
 296 exp     :       SIZE exp       %prec UNARY
 297                         { write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
 298         ;
 299
 300
 301 exp     :       INC '(' exp ')'
 302                         { write_exp_elt_opcode (pstate, UNOP_PREINCREMENT); }
 303         ;
 304
 305 exp     :       INC '(' exp ',' exp ')'
 306                         { write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY);
 307                           write_exp_elt_opcode (pstate, BINOP_ADD);
 308                           write_exp_elt_opcode (pstate,
 309                                                 BINOP_ASSIGN_MODIFY); }
 310         ;
 311
 312 exp     :       DEC '(' exp ')'
 313                         { write_exp_elt_opcode (pstate, UNOP_PREDECREMENT);}
 314         ;
 315
 316 exp     :       DEC '(' exp ',' exp ')'
 317                         { write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY);
 318                           write_exp_elt_opcode (pstate, BINOP_SUB);
 319                           write_exp_elt_opcode (pstate,
 320                                                 BINOP_ASSIGN_MODIFY); }
 321         ;
 322
 323 exp     :       exp DOT NAME
 324                         { write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
 325                           write_exp_string (pstate, $3);
 326                           write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
 327         ;
 328
 329 exp     :       set
 330         ;
 331
 332 exp     :       exp IN set
 333                         { error (_("Sets are not implemented."));}
 334         ;
 335
 336 exp     :       INCL '(' exp ',' exp ')'
 337                         { error (_("Sets are not implemented."));}
 338         ;
 339
 340 exp     :       EXCL '(' exp ',' exp ')'
 341                         { error (_("Sets are not implemented."));}
 342         ;
 343
 344 set     :       '{' arglist '}'
 345                         { error (_("Sets are not implemented."));}
 346         |       type '{' arglist '}'
 347                         { error (_("Sets are not implemented."));}
 348         ;
 349
 350
 351 /* Modula-2 array subscript notation [a,b,c...] */
 352 exp     :       exp '['
 353                         /* This function just saves the number of arguments
 354                            that follow in the list.  It is *not* specific to
 355                            function types */
 356                         { start_arglist(); }
 357                 non_empty_arglist ']'  %prec DOT
 358                         { write_exp_elt_opcode (pstate, MULTI_SUBSCRIPT);
 359                           write_exp_elt_longcst (pstate,
 360                                                  (LONGEST) end_arglist());
 361                           write_exp_elt_opcode (pstate, MULTI_SUBSCRIPT); }
 362         ;
 363
 364 exp     :       exp '[' exp ']'
 365                         { write_exp_elt_opcode (pstate, BINOP_SUBSCRIPT); }
 366         ;
 367
 368 exp     :       exp '('
 369                         /* This is to save the value of arglist_len
 370                            being accumulated by an outer function call.  */
 371                         { start_arglist (); }
 372                 arglist ')'     %prec DOT
 373                         { write_exp_elt_opcode (pstate, OP_FUNCALL);
 374                           write_exp_elt_longcst (pstate,
 375                                                  (LONGEST) end_arglist ());
 376                           write_exp_elt_opcode (pstate, OP_FUNCALL); }
 377         ;
 378
 379 arglist :
 380         ;
 381
 382 arglist :       exp
 383                         { arglist_len = 1; }
 384         ;
 385
 386 arglist :       arglist ',' exp   %prec ABOVE_COMMA
 387                         { arglist_len++; }
 388         ;
 389
 390 non_empty_arglist
 391         :       exp
 392                         { arglist_len = 1; }
 393         ;
 394
 395 non_empty_arglist
 396         :       non_empty_arglist ',' exp %prec ABOVE_COMMA
 397                         { arglist_len++; }
 398         ;
 399
 400 /* GDB construct */
 401 exp     :       '{' type '}' exp  %prec UNARY
 402                         { write_exp_elt_opcode (pstate, UNOP_MEMVAL);
 403                           write_exp_elt_type (pstate, $2);
 404                           write_exp_elt_opcode (pstate, UNOP_MEMVAL); }
 405         ;
 406
 407 exp     :       type '(' exp ')' %prec UNARY
 408                         { write_exp_elt_opcode (pstate, UNOP_CAST);
 409                           write_exp_elt_type (pstate, $1);
 410                           write_exp_elt_opcode (pstate, UNOP_CAST); }
 411         ;
 412
 413 exp     :       '(' exp ')'
 414                         { }
 415         ;
 416
 417 /* Binary operators in order of decreasing precedence.  Note that some
 418    of these operators are overloaded!  (ie. sets) */
 419
 420 /* GDB construct */
 421 exp     :       exp '@' exp
 422                         { write_exp_elt_opcode (pstate, BINOP_REPEAT); }
 423         ;
 424
 425 exp     :       exp '*' exp
 426                         { write_exp_elt_opcode (pstate, BINOP_MUL); }
 427         ;
 428
 429 exp     :       exp '/' exp
 430                         { write_exp_elt_opcode (pstate, BINOP_DIV); }
 431         ;
 432
 433 exp     :       exp DIV exp
 434                         { write_exp_elt_opcode (pstate, BINOP_INTDIV); }
 435         ;
 436
 437 exp     :       exp MOD exp
 438                         { write_exp_elt_opcode (pstate, BINOP_REM); }
 439         ;
 440
 441 exp     :       exp '+' exp
 442                         { write_exp_elt_opcode (pstate, BINOP_ADD); }
 443         ;
 444
 445 exp     :       exp '-' exp
 446                         { write_exp_elt_opcode (pstate, BINOP_SUB); }
 447         ;
 448
 449 exp     :       exp '=' exp
 450                         { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
 451         ;
 452
 453 exp     :       exp NOTEQUAL exp
 454                         { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
 455         |       exp '#' exp
 456                         { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
 457         ;
 458
 459 exp     :       exp LEQ exp
 460                         { write_exp_elt_opcode (pstate, BINOP_LEQ); }
 461         ;
 462
 463 exp     :       exp GEQ exp
 464                         { write_exp_elt_opcode (pstate, BINOP_GEQ); }
 465         ;
 466
 467 exp     :       exp '<' exp
 468                         { write_exp_elt_opcode (pstate, BINOP_LESS); }
 469         ;
 470
 471 exp     :       exp '>' exp
 472                         { write_exp_elt_opcode (pstate, BINOP_GTR); }
 473         ;
 474
 475 exp     :       exp LOGICAL_AND exp
 476                         { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
 477         ;
 478
 479 exp     :       exp OROR exp
 480                         { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
 481         ;
 482
 483 exp     :       exp ASSIGN exp
 484                         { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
 485         ;
 486
 487
 488 /* Constants */
 489
 490 exp     :       M2_TRUE
 491                         { write_exp_elt_opcode (pstate, OP_BOOL);
 492                           write_exp_elt_longcst (pstate, (LONGEST) $1);
 493                           write_exp_elt_opcode (pstate, OP_BOOL); }
 494         ;
 495
 496 exp     :       M2_FALSE
 497                         { write_exp_elt_opcode (pstate, OP_BOOL);
 498                           write_exp_elt_longcst (pstate, (LONGEST) $1);
 499                           write_exp_elt_opcode (pstate, OP_BOOL); }
 500         ;
 501
 502 exp     :       INT
 503                         { write_exp_elt_opcode (pstate, OP_LONG);
 504                           write_exp_elt_type (pstate,
 505                                         parse_m2_type (pstate)->builtin_int);
 506                           write_exp_elt_longcst (pstate, (LONGEST) $1);
 507                           write_exp_elt_opcode (pstate, OP_LONG); }
 508         ;
 509
 510 exp     :       UINT
 511                         {
 512                           write_exp_elt_opcode (pstate, OP_LONG);
 513                           write_exp_elt_type (pstate,
 514                                               parse_m2_type (pstate)
 515                                               ->builtin_card);
 516                           write_exp_elt_longcst (pstate, (LONGEST) $1);
 517                           write_exp_elt_opcode (pstate, OP_LONG);
 518                         }
 519         ;
 520
 521 exp     :       CHAR
 522                         { write_exp_elt_opcode (pstate, OP_LONG);
 523                           write_exp_elt_type (pstate,
 524                                               parse_m2_type (pstate)
 525                                               ->builtin_char);
 526                           write_exp_elt_longcst (pstate, (LONGEST) $1);
 527                           write_exp_elt_opcode (pstate, OP_LONG); }
 528         ;
 529
 530
 531 exp     :       FLOAT
 532                         { write_exp_elt_opcode (pstate, OP_DOUBLE);
 533                           write_exp_elt_type (pstate,
 534                                               parse_m2_type (pstate)
 535                                               ->builtin_real);
 536                           write_exp_elt_dblcst (pstate, $1);
 537                           write_exp_elt_opcode (pstate, OP_DOUBLE); }
 538         ;
 539
 540 exp     :       variable
 541         ;
 542
 543 exp     :       SIZE '(' type ')'       %prec UNARY
 544                         { write_exp_elt_opcode (pstate, OP_LONG);
 545                           write_exp_elt_type (pstate,
 546                                             parse_type (pstate)->builtin_int);
 547                           write_exp_elt_longcst (pstate,
 548                                                  (LONGEST) TYPE_LENGTH ($3));
 549                           write_exp_elt_opcode (pstate, OP_LONG); }
 550         ;
 551
 552 exp     :       STRING
 553                         { write_exp_elt_opcode (pstate, OP_M2_STRING);
 554                           write_exp_string (pstate, $1);
 555                           write_exp_elt_opcode (pstate, OP_M2_STRING); }
 556         ;
 557
 558 /* This will be used for extensions later.  Like adding modules.  */
 559 block   :       fblock
 560                         { $$ = SYMBOL_BLOCK_VALUE($1); }
 561         ;
 562
 563 fblock  :       BLOCKNAME
 564                         { struct symbol *sym
 565                             = lookup_symbol (copy_name ($1),
 566                                              expression_context_block,
 567                                              VAR_DOMAIN, 0).symbol;
 568                           $$ = sym;}
 569         ;
 570
 571
 572 /* GDB scope operator */
 573 fblock  :       block COLONCOLON BLOCKNAME
 574                         { struct symbol *tem
 575                             = lookup_symbol (copy_name ($3), $1,
 576                                              VAR_DOMAIN, 0).symbol;
 577                           if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
 578                             error (_("No function \"%s\" in specified context."),
 579                                    copy_name ($3));
 580                           $$ = tem;
 581                         }
 582         ;
 583
 584 /* Useful for assigning to PROCEDURE variables */
 585 variable:       fblock
 586                         { write_exp_elt_opcode (pstate, OP_VAR_VALUE);
 587                           write_exp_elt_block (pstate, NULL);
 588                           write_exp_elt_sym (pstate, $1);
 589                           write_exp_elt_opcode (pstate, OP_VAR_VALUE); }
 590         ;
 591
 592 /* GDB internal ($foo) variable */
 593 variable:       INTERNAL_VAR
 594         ;
 595
 596 /* GDB scope operator */
 597 variable:       block COLONCOLON NAME
 598                         { struct block_symbol sym
 599                             = lookup_symbol (copy_name ($3), $1,
 600                                              VAR_DOMAIN, 0);
 601
 602                           if (sym.symbol == 0)
 603                             error (_("No symbol \"%s\" in specified context."),
 604                                    copy_name ($3));
 605                           if (symbol_read_needs_frame (sym.symbol))
 606                             {
 607                               if (innermost_block == 0
 608                                   || contained_in (sym.block,
 609                                                    innermost_block))
 610                                 innermost_block = sym.block;
 611                             }
 612
 613                           write_exp_elt_opcode (pstate, OP_VAR_VALUE);
 614                           write_exp_elt_block (pstate, sym.block);
 615                           write_exp_elt_sym (pstate, sym.symbol);
 616                           write_exp_elt_opcode (pstate, OP_VAR_VALUE); }
 617         ;
 618
 619 /* Base case for variables.  */
 620 variable:       NAME
 621                         { struct block_symbol sym;
 622                           struct field_of_this_result is_a_field_of_this;
 623
 624                           sym = lookup_symbol (copy_name ($1),
 625                                                expression_context_block,
 626                                                VAR_DOMAIN,
 627                                                &is_a_field_of_this);
 628
 629                           if (sym.symbol)
 630                             {
 631                               if (symbol_read_needs_frame (sym.symbol))
 632                                 {
 633                                   if (innermost_block == 0 ||
 634                                       contained_in (sym.block,
 635                                                     innermost_block))
 636                                     innermost_block = sym.block;
 637                                 }
 638
 639                               write_exp_elt_opcode (pstate, OP_VAR_VALUE);
 640                               write_exp_elt_block (pstate, sym.block);
 641                               write_exp_elt_sym (pstate, sym.symbol);
 642                               write_exp_elt_opcode (pstate, OP_VAR_VALUE);
 643                             }
 644                           else
 645                             {
 646                               struct bound_minimal_symbol msymbol;
 647                               char *arg = copy_name ($1);
 648
 649                               msymbol =
 650                                 lookup_bound_minimal_symbol (arg);
 651                               if (msymbol.minsym != NULL)
 652                                 write_exp_msymbol (pstate, msymbol);
 653                               else if (!have_full_symbols () && !have_partial_symbols ())
 654                                 error (_("No symbol table is loaded.  Use the \"symbol-file\" command."));
 655                               else
 656                                 error (_("No symbol \"%s\" in current context."),
 657                                        copy_name ($1));
 658                             }
 659                         }
 660         ;
 661
 662 type
 663         :       TYPENAME
 664                         { $$ = lookup_typename (parse_language (pstate),
 665                                                 parse_gdbarch (pstate),
 666                                                 copy_name ($1),
 667                                                 expression_context_block, 0); }
 668
 669         ;
 670
 671 %%
 672
 673 /* Take care of parsing a number (anything that starts with a digit).
 674    Set yylval and return the token type; update lexptr.
 675    LEN is the number of characters in it.  */
 676
 677 /*** Needs some error checking for the float case ***/
 678
 679 static int
 680 parse_number (int olen)
 681 {
 682   const char *p = lexptr;
 683   LONGEST n = 0;
 684   LONGEST prevn = 0;
 685   int c,i,ischar=0;
 686   int base = input_radix;
 687   int len = olen;
 688   int unsigned_p = number_sign == 1 ? 1 : 0;
 689
 690   if(p[len-1] == 'H')
 691   {
 692      base = 16;
 693      len--;
 694   }
 695   else if(p[len-1] == 'C' || p[len-1] == 'B')
 696   {
 697      base = 8;
 698      ischar = p[len-1] == 'C';
 699      len--;
 700   }
 701
 702   /* Scan the number */
 703   for (c = 0; c < len; c++)
 704   {
 705     if (p[c] == '.' && base == 10)
 706       {
 707         /* It's a float since it contains a point.  */
 708         yylval.dval = atof (p);
 709         lexptr += len;
 710         return FLOAT;
 711       }
 712     if (p[c] == '.' && base != 10)
 713        error (_("Floating point numbers must be base 10."));
 714     if (base == 10 && (p[c] < '0' || p[c] > '9'))
 715        error (_("Invalid digit \'%c\' in number."),p[c]);
 716  }
 717
 718   while (len-- > 0)
 719     {
 720       c = *p++;
 721       n *= base;
 722       if( base == 8 && (c == '8' || c == '9'))
 723          error (_("Invalid digit \'%c\' in octal number."),c);
 724       if (c >= '0' && c <= '9')
 725         i = c - '0';
 726       else
 727         {
 728           if (base == 16 && c >= 'A' && c <= 'F')
 729             i = c - 'A' + 10;
 730           else
 731              return ERROR;
 732         }
 733       n+=i;
 734       if(i >= base)
 735          return ERROR;
 736       if(!unsigned_p && number_sign == 1 && (prevn >= n))
 737          unsigned_p=1;          /* Try something unsigned */
 738       /* Don't do the range check if n==i and i==0, since that special
 739          case will give an overflow error.  */
 740       if(RANGE_CHECK && n!=i && i)
 741       {
 742          if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
 743             ((!unsigned_p && number_sign==-1) && -prevn <= -n))
 744             range_error (_("Overflow on numeric constant."));
 745       }
 746          prevn=n;
 747     }
 748
 749   lexptr = p;
 750   if(*p == 'B' || *p == 'C' || *p == 'H')
 751      lexptr++;                  /* Advance past B,C or H */
 752
 753   if (ischar)
 754   {
 755      yylval.ulval = n;
 756      return CHAR;
 757   }
 758   else if ( unsigned_p && number_sign == 1)
 759   {
 760      yylval.ulval = n;
 761      return UINT;
 762   }
 763   else if((unsigned_p && (n<0))) {
 764      range_error (_("Overflow on numeric constant -- number too large."));
 765      /* But, this can return if range_check == range_warn.  */
 766   }
 767   yylval.lval = n;
 768   return INT;
 769 }
 770
 771
 772 /* Some tokens */
 773
 774 static struct
 775 {
 776    char name[2];
 777    int token;
 778 } tokentab2[] =
 779 {
 780     { {'<', '>'},    NOTEQUAL   },
 781     { {':', '='},    ASSIGN     },
 782     { {'<', '='},    LEQ        },
 783     { {'>', '='},    GEQ        },
 784     { {':', ':'},    COLONCOLON },
 785
 786 };
 787
 788 /* Some specific keywords */
 789
 790 struct keyword {
 791    char keyw[10];
 792    int token;
 793 };
 794
 795 static struct keyword keytab[] =
 796 {
 797     {"OR" ,   OROR       },
 798     {"IN",    IN         },/* Note space after IN */
 799     {"AND",   LOGICAL_AND},
 800     {"ABS",   ABS        },
 801     {"CHR",   CHR        },
 802     {"DEC",   DEC        },
 803     {"NOT",   NOT        },
 804     {"DIV",   DIV        },
 805     {"INC",   INC        },
 806     {"MAX",   MAX_FUNC   },
 807     {"MIN",   MIN_FUNC   },
 808     {"MOD",   MOD        },
 809     {"ODD",   ODD        },
 810     {"CAP",   CAP        },
 811     {"ORD",   ORD        },
 812     {"VAL",   VAL        },
 813     {"EXCL",  EXCL       },
 814     {"HIGH",  HIGH       },
 815     {"INCL",  INCL       },
 816     {"SIZE",  SIZE       },
 817     {"FLOAT", FLOAT_FUNC },
 818     {"TRUNC", TRUNC      },
 819     {"TSIZE", SIZE       },
 820 };
 821
 822
 823 /* Read one token, getting characters through lexptr.  */
 824
 825 /* This is where we will check to make sure that the language and the
 826    operators used are compatible  */
 827
 828 static int
 829 yylex (void)
 830 {
 831   int c;
 832   int namelen;
 833   int i;
 834   const char *tokstart;
 835   char quote;
 836
 837  retry:
 838
 839   prev_lexptr = lexptr;
 840
 841   tokstart = lexptr;
 842
 843
 844   /* See if it is a special token of length 2 */
 845   for( i = 0 ; i < (int) (sizeof tokentab2 / sizeof tokentab2[0]) ; i++)
 846      if (strncmp (tokentab2[i].name, tokstart, 2) == 0)
 847      {
 848         lexptr += 2;
 849         return tokentab2[i].token;
 850      }
 851
 852   switch (c = *tokstart)
 853     {
 854     case 0:
 855       return 0;
 856
 857     case ' ':
 858     case '\t':
 859     case '\n':
 860       lexptr++;
 861       goto retry;
 862
 863     case '(':
 864       paren_depth++;
 865       lexptr++;
 866       return c;
 867
 868     case ')':
 869       if (paren_depth == 0)
 870         return 0;
 871       paren_depth--;
 872       lexptr++;
 873       return c;
 874
 875     case ',':
 876       if (comma_terminates && paren_depth == 0)
 877         return 0;
 878       lexptr++;
 879       return c;
 880
 881     case '.':
 882       /* Might be a floating point number.  */
 883       if (lexptr[1] >= '0' && lexptr[1] <= '9')
 884         break;                  /* Falls into number code.  */
 885       else
 886       {
 887          lexptr++;
 888          return DOT;
 889       }
 890
 891 /* These are character tokens that appear as-is in the YACC grammar */
 892     case '+':
 893     case '-':
 894     case '*':
 895     case '/':
 896     case '^':
 897     case '<':
 898     case '>':
 899     case '[':
 900     case ']':
 901     case '=':
 902     case '{':
 903     case '}':
 904     case '#':
 905     case '@':
 906     case '~':
 907     case '&':
 908       lexptr++;
 909       return c;
 910
 911     case '\'' :
 912     case '"':
 913       quote = c;
 914       for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
 915         if (c == '\\')
 916           {
 917             c = tokstart[++namelen];
 918             if (c >= '0' && c <= '9')
 919               {
 920                 c = tokstart[++namelen];
 921                 if (c >= '0' && c <= '9')
 922                   c = tokstart[++namelen];
 923               }
 924           }
 925       if(c != quote)
 926          error (_("Unterminated string or character constant."));
 927       yylval.sval.ptr = tokstart + 1;
 928       yylval.sval.length = namelen - 1;
 929       lexptr += namelen + 1;
 930
 931       if(namelen == 2)          /* Single character */
 932       {
 933            yylval.ulval = tokstart[1];
 934            return CHAR;
 935       }
 936       else
 937          return STRING;
 938     }
 939
 940   /* Is it a number?  */
 941   /* Note:  We have already dealt with the case of the token '.'.
 942      See case '.' above.  */
 943   if ((c >= '0' && c <= '9'))
 944     {
 945       /* It's a number.  */
 946       int got_dot = 0, got_e = 0;
 947       const char *p = tokstart;
 948       int toktype;
 949
 950       for (++p ;; ++p)
 951         {
 952           if (!got_e && (*p == 'e' || *p == 'E'))
 953             got_dot = got_e = 1;
 954           else if (!got_dot && *p == '.')
 955             got_dot = 1;
 956           else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
 957                    && (*p == '-' || *p == '+'))
 958             /* This is the sign of the exponent, not the end of the
 959                number.  */
 960             continue;
 961           else if ((*p < '0' || *p > '9') &&
 962                    (*p < 'A' || *p > 'F') &&
 963                    (*p != 'H'))  /* Modula-2 hexadecimal number */
 964             break;
 965         }
 966         toktype = parse_number (p - tokstart);
 967         if (toktype == ERROR)
 968           {
 969             char *err_copy = (char *) alloca (p - tokstart + 1);
 970
 971             memcpy (err_copy, tokstart, p - tokstart);
 972             err_copy[p - tokstart] = 0;
 973             error (_("Invalid number \"%s\"."), err_copy);
 974           }
 975         lexptr = p;
 976         return toktype;
 977     }
 978
 979   if (!(c == '_' || c == '$'
 980         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
 981     /* We must have come across a bad character (e.g. ';').  */
 982     error (_("Invalid character '%c' in expression."), c);
 983
 984   /* It's a name.  See how long it is.  */
 985   namelen = 0;
 986   for (c = tokstart[namelen];
 987        (c == '_' || c == '$' || (c >= '0' && c <= '9')
 988         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
 989        c = tokstart[++namelen])
 990     ;
 991
 992   /* The token "if" terminates the expression and is NOT
 993      removed from the input stream.  */
 994   if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
 995     {
 996       return 0;
 997     }
 998
 999   lexptr += namelen;
1000
1001   /*  Lookup special keywords */
1002   for(i = 0 ; i < (int) (sizeof(keytab) / sizeof(keytab[0])) ; i++)
1003      if (namelen == strlen (keytab[i].keyw)
1004          && strncmp (tokstart, keytab[i].keyw, namelen) == 0)
1005            return keytab[i].token;
1006
1007   yylval.sval.ptr = tokstart;
1008   yylval.sval.length = namelen;
1009
1010   if (*tokstart == '$')
1011     {
1012       write_dollar_variable (pstate, yylval.sval);
1013       return INTERNAL_VAR;
1014     }
1015
1016   /* Use token-type BLOCKNAME for symbols that happen to be defined as
1017      functions.  If this is not so, then ...
1018      Use token-type TYPENAME for symbols that happen to be defined
1019      currently as names of types; NAME for other symbols.
1020      The caller is not constrained to care about the distinction.  */
1021  {
1022
1023
1024     char *tmp = copy_name (yylval.sval);
1025     struct symbol *sym;
1026
1027     if (lookup_symtab (tmp))
1028       return BLOCKNAME;
1029     sym = lookup_symbol (tmp, expression_context_block, VAR_DOMAIN, 0).symbol;
1030     if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1031       return BLOCKNAME;
1032     if (lookup_typename (parse_language (pstate), parse_gdbarch (pstate),
1033                          copy_name (yylval.sval),
1034                          expression_context_block, 1))
1035       return TYPENAME;
1036
1037     if(sym)
1038     {
1039       switch(SYMBOL_CLASS (sym))
1040        {
1041        case LOC_STATIC:
1042        case LOC_REGISTER:
1043        case LOC_ARG:
1044        case LOC_REF_ARG:
1045        case LOC_REGPARM_ADDR:
1046        case LOC_LOCAL:
1047        case LOC_CONST:
1048        case LOC_CONST_BYTES:
1049        case LOC_OPTIMIZED_OUT:
1050        case LOC_COMPUTED:
1051           return NAME;
1052
1053        case LOC_TYPEDEF:
1054           return TYPENAME;
1055
1056        case LOC_BLOCK:
1057           return BLOCKNAME;
1058
1059        case LOC_UNDEF:
1060           error (_("internal:  Undefined class in m2lex()"));
1061
1062        case LOC_LABEL:
1063        case LOC_UNRESOLVED:
1064           error (_("internal:  Unforseen case in m2lex()"));
1065
1066        default:
1067           error (_("unhandled token in m2lex()"));
1068           break;
1069        }
1070     }
1071     else
1072     {
1073        /* Built-in BOOLEAN type.  This is sort of a hack.  */
1074        if (strncmp (tokstart, "TRUE", 4) == 0)
1075        {
1076           yylval.ulval = 1;
1077           return M2_TRUE;
1078        }
1079        else if (strncmp (tokstart, "FALSE", 5) == 0)
1080        {
1081           yylval.ulval = 0;
1082           return M2_FALSE;
1083        }
1084     }
1085
1086     /* Must be another type of name...  */
1087     return NAME;
1088  }
1089 }
1090
1091 int
1092 m2_parse (struct parser_state *par_state)
1093 {
1094   int result;
1095   struct cleanup *c = make_cleanup_clear_parser_state (&pstate);
1096
1097   /* Setting up the parser state.  */
1098   gdb_assert (par_state != NULL);
1099   pstate = par_state;
1100
1101   result = yyparse ();
1102   do_cleanups (c);
1103
1104   return result;
1105 }
1106
1107 void
1108 yyerror (char *msg)
1109 {
1110   if (prev_lexptr)
1111     lexptr = prev_lexptr;
1112
1113   error (_("A %s in expression, near `%s'."), (msg ? msg : "error"), lexptr);
1114 }