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