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