gdb/m2-exp.y

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