gdb/m2-exp.y

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