gdb/m2-exp.y

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