gdb/m2-exp.y

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