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                           pstate->push_new<var_value_operation>
 521                             ($1, nullptr);
 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>
 543                             (sym.symbol, sym.block);
 544                         }
 545         ;
 546
 547 /* Base case for variables.  */
 548 variable:       NAME
 549                         { struct block_symbol sym;
 550                           struct field_of_this_result is_a_field_of_this;
 551
 552                           std::string name = copy_name ($1);
 553                           sym
 554                             = lookup_symbol (name.c_str (),
 555                                              pstate->expression_context_block,
 556                                              VAR_DOMAIN,
 557                                              &is_a_field_of_this);
 558
 559                           pstate->push_symbol (name.c_str (), sym);
 560                         }
 561         ;
 562
 563 type
 564         :       TYPENAME
 565                         { $$
 566                             = lookup_typename (pstate->language (),
 567                                                copy_name ($1).c_str (),
 568                                                pstate->expression_context_block,
 569                                                0);
 570                         }
 571
 572         ;
 573
 574 %%
 575
 576 /* Take care of parsing a number (anything that starts with a digit).
 577    Set yylval and return the token type; update lexptr.
 578    LEN is the number of characters in it.  */
 579
 580 /*** Needs some error checking for the float case ***/
 581
 582 static int
 583 parse_number (int olen)
 584 {
 585   const char *p = pstate->lexptr;
 586   LONGEST n = 0;
 587   LONGEST prevn = 0;
 588   int c,i,ischar=0;
 589   int base = input_radix;
 590   int len = olen;
 591   int unsigned_p = number_sign == 1 ? 1 : 0;
 592
 593   if(p[len-1] == 'H')
 594   {
 595      base = 16;
 596      len--;
 597   }
 598   else if(p[len-1] == 'C' || p[len-1] == 'B')
 599   {
 600      base = 8;
 601      ischar = p[len-1] == 'C';
 602      len--;
 603   }
 604
 605   /* Scan the number */
 606   for (c = 0; c < len; c++)
 607   {
 608     if (p[c] == '.' && base == 10)
 609       {
 610         /* It's a float since it contains a point.  */
 611         if (!parse_float (p, len,
 612                           parse_m2_type (pstate)->builtin_real,
 613                           yylval.val))
 614           return ERROR;
 615
 616         pstate->lexptr += len;
 617         return FLOAT;
 618       }
 619     if (p[c] == '.' && base != 10)
 620        error (_("Floating point numbers must be base 10."));
 621     if (base == 10 && (p[c] < '0' || p[c] > '9'))
 622        error (_("Invalid digit \'%c\' in number."),p[c]);
 623  }
 624
 625   while (len-- > 0)
 626     {
 627       c = *p++;
 628       n *= base;
 629       if( base == 8 && (c == '8' || c == '9'))
 630          error (_("Invalid digit \'%c\' in octal number."),c);
 631       if (c >= '0' && c <= '9')
 632         i = c - '0';
 633       else
 634         {
 635           if (base == 16 && c >= 'A' && c <= 'F')
 636             i = c - 'A' + 10;
 637           else
 638              return ERROR;
 639         }
 640       n+=i;
 641       if(i >= base)
 642          return ERROR;
 643       if(!unsigned_p && number_sign == 1 && (prevn >= n))
 644          unsigned_p=1;          /* Try something unsigned */
 645       /* Don't do the range check if n==i and i==0, since that special
 646          case will give an overflow error.  */
 647       if(RANGE_CHECK && n!=i && i)
 648       {
 649          if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
 650             ((!unsigned_p && number_sign==-1) && -prevn <= -n))
 651             range_error (_("Overflow on numeric constant."));
 652       }
 653          prevn=n;
 654     }
 655
 656   pstate->lexptr = p;
 657   if(*p == 'B' || *p == 'C' || *p == 'H')
 658      pstate->lexptr++;                  /* Advance past B,C or H */
 659
 660   if (ischar)
 661   {
 662      yylval.ulval = n;
 663      return CHAR;
 664   }
 665   else if ( unsigned_p && number_sign == 1)
 666   {
 667      yylval.ulval = n;
 668      return UINT;
 669   }
 670   else if((unsigned_p && (n<0))) {
 671      range_error (_("Overflow on numeric constant -- number too large."));
 672      /* But, this can return if range_check == range_warn.  */
 673   }
 674   yylval.lval = n;
 675   return INT;
 676 }
 677
 678
 679 /* Some tokens */
 680
 681 static struct
 682 {
 683    char name[2];
 684    int token;
 685 } tokentab2[] =
 686 {
 687     { {'<', '>'},    NOTEQUAL   },
 688     { {':', '='},    ASSIGN     },
 689     { {'<', '='},    LEQ        },
 690     { {'>', '='},    GEQ        },
 691     { {':', ':'},    COLONCOLON },
 692
 693 };
 694
 695 /* Some specific keywords */
 696
 697 struct keyword {
 698    char keyw[10];
 699    int token;
 700 };
 701
 702 static struct keyword keytab[] =
 703 {
 704     {"OR" ,   OROR       },
 705     {"IN",    IN         },/* Note space after IN */
 706     {"AND",   LOGICAL_AND},
 707     {"ABS",   ABS        },
 708     {"CHR",   CHR        },
 709     {"DEC",   DEC        },
 710     {"NOT",   NOT        },
 711     {"DIV",   DIV        },
 712     {"INC",   INC        },
 713     {"MAX",   MAX_FUNC   },
 714     {"MIN",   MIN_FUNC   },
 715     {"MOD",   MOD        },
 716     {"ODD",   ODD        },
 717     {"CAP",   CAP        },
 718     {"ORD",   ORD        },
 719     {"VAL",   VAL        },
 720     {"EXCL",  EXCL       },
 721     {"HIGH",  HIGH       },
 722     {"INCL",  INCL       },
 723     {"SIZE",  SIZE       },
 724     {"FLOAT", FLOAT_FUNC },
 725     {"TRUNC", TRUNC      },
 726     {"TSIZE", SIZE       },
 727 };
 728
 729
 730 /* Depth of parentheses.  */
 731 static int paren_depth;
 732
 733 /* Read one token, getting characters through lexptr.  */
 734
 735 /* This is where we will check to make sure that the language and the
 736    operators used are compatible  */
 737
 738 static int
 739 yylex (void)
 740 {
 741   int c;
 742   int namelen;
 743   int i;
 744   const char *tokstart;
 745   char quote;
 746
 747  retry:
 748
 749   pstate->prev_lexptr = pstate->lexptr;
 750
 751   tokstart = pstate->lexptr;
 752
 753
 754   /* See if it is a special token of length 2 */
 755   for( i = 0 ; i < (int) (sizeof tokentab2 / sizeof tokentab2[0]) ; i++)
 756      if (strncmp (tokentab2[i].name, tokstart, 2) == 0)
 757      {
 758         pstate->lexptr += 2;
 759         return tokentab2[i].token;
 760      }
 761
 762   switch (c = *tokstart)
 763     {
 764     case 0:
 765       return 0;
 766
 767     case ' ':
 768     case '\t':
 769     case '\n':
 770       pstate->lexptr++;
 771       goto retry;
 772
 773     case '(':
 774       paren_depth++;
 775       pstate->lexptr++;
 776       return c;
 777
 778     case ')':
 779       if (paren_depth == 0)
 780         return 0;
 781       paren_depth--;
 782       pstate->lexptr++;
 783       return c;
 784
 785     case ',':
 786       if (pstate->comma_terminates && paren_depth == 0)
 787         return 0;
 788       pstate->lexptr++;
 789       return c;
 790
 791     case '.':
 792       /* Might be a floating point number.  */
 793       if (pstate->lexptr[1] >= '0' && pstate->lexptr[1] <= '9')
 794         break;                  /* Falls into number code.  */
 795       else
 796       {
 797          pstate->lexptr++;
 798          return DOT;
 799       }
 800
 801 /* These are character tokens that appear as-is in the YACC grammar */
 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     case '&':
 818       pstate->lexptr++;
 819       return c;
 820
 821     case '\'' :
 822     case '"':
 823       quote = c;
 824       for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
 825         if (c == '\\')
 826           {
 827             c = tokstart[++namelen];
 828             if (c >= '0' && c <= '9')
 829               {
 830                 c = tokstart[++namelen];
 831                 if (c >= '0' && c <= '9')
 832                   c = tokstart[++namelen];
 833               }
 834           }
 835       if(c != quote)
 836          error (_("Unterminated string or character constant."));
 837       yylval.sval.ptr = tokstart + 1;
 838       yylval.sval.length = namelen - 1;
 839       pstate->lexptr += namelen + 1;
 840
 841       if(namelen == 2)          /* Single character */
 842       {
 843            yylval.ulval = tokstart[1];
 844            return CHAR;
 845       }
 846       else
 847          return STRING;
 848     }
 849
 850   /* Is it a number?  */
 851   /* Note:  We have already dealt with the case of the token '.'.
 852      See case '.' above.  */
 853   if ((c >= '0' && c <= '9'))
 854     {
 855       /* It's a number.  */
 856       int got_dot = 0, got_e = 0;
 857       const char *p = tokstart;
 858       int toktype;
 859
 860       for (++p ;; ++p)
 861         {
 862           if (!got_e && (*p == 'e' || *p == 'E'))
 863             got_dot = got_e = 1;
 864           else if (!got_dot && *p == '.')
 865             got_dot = 1;
 866           else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
 867                    && (*p == '-' || *p == '+'))
 868             /* This is the sign of the exponent, not the end of the
 869                number.  */
 870             continue;
 871           else if ((*p < '0' || *p > '9') &&
 872                    (*p < 'A' || *p > 'F') &&
 873                    (*p != 'H'))  /* Modula-2 hexadecimal number */
 874             break;
 875         }
 876         toktype = parse_number (p - tokstart);
 877         if (toktype == ERROR)
 878           {
 879             char *err_copy = (char *) alloca (p - tokstart + 1);
 880
 881             memcpy (err_copy, tokstart, p - tokstart);
 882             err_copy[p - tokstart] = 0;
 883             error (_("Invalid number \"%s\"."), err_copy);
 884           }
 885         pstate->lexptr = p;
 886         return toktype;
 887     }
 888
 889   if (!(c == '_' || c == '$'
 890         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
 891     /* We must have come across a bad character (e.g. ';').  */
 892     error (_("Invalid character '%c' in expression."), c);
 893
 894   /* It's a name.  See how long it is.  */
 895   namelen = 0;
 896   for (c = tokstart[namelen];
 897        (c == '_' || c == '$' || (c >= '0' && c <= '9')
 898         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
 899        c = tokstart[++namelen])
 900     ;
 901
 902   /* The token "if" terminates the expression and is NOT
 903      removed from the input stream.  */
 904   if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
 905     {
 906       return 0;
 907     }
 908
 909   pstate->lexptr += namelen;
 910
 911   /*  Lookup special keywords */
 912   for(i = 0 ; i < (int) (sizeof(keytab) / sizeof(keytab[0])) ; i++)
 913      if (namelen == strlen (keytab[i].keyw)
 914          && strncmp (tokstart, keytab[i].keyw, namelen) == 0)
 915            return keytab[i].token;
 916
 917   yylval.sval.ptr = tokstart;
 918   yylval.sval.length = namelen;
 919
 920   if (*tokstart == '$')
 921     return DOLLAR_VARIABLE;
 922
 923   /* Use token-type BLOCKNAME for symbols that happen to be defined as
 924      functions.  If this is not so, then ...
 925      Use token-type TYPENAME for symbols that happen to be defined
 926      currently as names of types; NAME for other symbols.
 927      The caller is not constrained to care about the distinction.  */
 928  {
 929     std::string tmp = copy_name (yylval.sval);
 930     struct symbol *sym;
 931
 932     if (lookup_symtab (tmp.c_str ()))
 933       return BLOCKNAME;
 934     sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
 935                          VAR_DOMAIN, 0).symbol;
 936     if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
 937       return BLOCKNAME;
 938     if (lookup_typename (pstate->language (),
 939                          tmp.c_str (), pstate->expression_context_block, 1))
 940       return TYPENAME;
 941
 942     if(sym)
 943     {
 944       switch(SYMBOL_CLASS (sym))
 945        {
 946        case LOC_STATIC:
 947        case LOC_REGISTER:
 948        case LOC_ARG:
 949        case LOC_REF_ARG:
 950        case LOC_REGPARM_ADDR:
 951        case LOC_LOCAL:
 952        case LOC_CONST:
 953        case LOC_CONST_BYTES:
 954        case LOC_OPTIMIZED_OUT:
 955        case LOC_COMPUTED:
 956           return NAME;
 957
 958        case LOC_TYPEDEF:
 959           return TYPENAME;
 960
 961        case LOC_BLOCK:
 962           return BLOCKNAME;
 963
 964        case LOC_UNDEF:
 965           error (_("internal:  Undefined class in m2lex()"));
 966
 967        case LOC_LABEL:
 968        case LOC_UNRESOLVED:
 969           error (_("internal:  Unforseen case in m2lex()"));
 970
 971        default:
 972           error (_("unhandled token in m2lex()"));
 973           break;
 974        }
 975     }
 976     else
 977     {
 978        /* Built-in BOOLEAN type.  This is sort of a hack.  */
 979        if (startswith (tokstart, "TRUE"))
 980        {
 981           yylval.ulval = 1;
 982           return M2_TRUE;
 983        }
 984        else if (startswith (tokstart, "FALSE"))
 985        {
 986           yylval.ulval = 0;
 987           return M2_FALSE;
 988        }
 989     }
 990
 991     /* Must be another type of name...  */
 992     return NAME;
 993  }
 994 }
 995
 996 int
 997 m2_language::parser (struct parser_state *par_state) const
 998 {
 999   /* Setting up the parser state.  */
1000   scoped_restore pstate_restore = make_scoped_restore (&pstate);
1001   gdb_assert (par_state != NULL);
1002   pstate = par_state;
1003   paren_depth = 0;
1004
1005   int result = yyparse ();
1006   if (!result)
1007     pstate->set_operation (pstate->pop ());
1008   return result;
1009 }
1010
1011 static void
1012 yyerror (const char *msg)
1013 {
1014   if (pstate->prev_lexptr)
1015     pstate->lexptr = pstate->prev_lexptr;
1016
1017   error (_("A %s in expression, near `%s'."), msg, pstate->lexptr);
1018 }