gdb/m2-exp.y

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