gdb/m2-exp.y

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