gdb/m2-exp.y

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