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 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
  49    as well as gratuitiously global symbol names, so we can have multiple
  50    yacc generated parsers in gdb.  Note that these are only the variables
  51    produced by yacc.  If other parser generators (bison, byacc, etc) produce
  52    additional global names that conflict at link time, then those parser
  53    generators need to be fixed instead of adding those names to this list. */
  54
  55 #define yymaxdepth m2_maxdepth
  56 #define yyparse m2_parse
  57 #define yylex   m2_lex
  58 #define yyerror m2_error
  59 #define yylval  m2_lval
  60 #define yychar  m2_char
  61 #define yydebug m2_debug
  62 #define yypact  m2_pact
  63 #define yyr1    m2_r1
  64 #define yyr2    m2_r2
  65 #define yydef   m2_def
  66 #define yychk   m2_chk
  67 #define yypgo   m2_pgo
  68 #define yyact   m2_act
  69 #define yyexca  m2_exca
  70 #define yyerrflag m2_errflag
  71 #define yynerrs m2_nerrs
  72 #define yyps    m2_ps
  73 #define yypv    m2_pv
  74 #define yys     m2_s
  75 #define yy_yys  m2_yys
  76 #define yystate m2_state
  77 #define yytmp   m2_tmp
  78 #define yyv     m2_v
  79 #define yy_yyv  m2_yyv
  80 #define yyval   m2_val
  81 #define yylloc  m2_lloc
  82 #define yyreds  m2_reds         /* With YYDEBUG defined */
  83 #define yytoks  m2_toks         /* With YYDEBUG defined */
  84
  85 #ifndef YYDEBUG
  86 #define YYDEBUG 0               /* Default to no yydebug support */
  87 #endif
  88
  89 int
  90 yyparse PARAMS ((void));
  91
  92 static int
  93 yylex PARAMS ((void));
  94
  95 void
  96 yyerror PARAMS ((char *));
  97
  98 #if 0
  99 static char *
 100 make_qualname PARAMS ((char *, char *));
 101 #endif
 102
 103 static int
 104 parse_number PARAMS ((int));
 105
 106 /* The sign of the number being parsed. */
 107 static int number_sign = 1;
 108
 109 /* The block that the module specified by the qualifer on an identifer is
 110    contained in, */
 111 #if 0
 112 static struct block *modblock=0;
 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 (MULTI_SUBSCRIPT);
 337                           write_exp_elt_longcst ((LONGEST) end_arglist());
 338                           write_exp_elt_opcode (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_block (NULL);
 563                           write_exp_elt_sym ($1);
 564                           write_exp_elt_opcode (OP_VAR_VALUE); }
 565         ;
 566
 567 /* GDB internal ($foo) variable */
 568 variable:       INTERNAL_VAR
 569                         { write_exp_elt_opcode (OP_INTERNALVAR);
 570                           write_exp_elt_intern ($1);
 571                           write_exp_elt_opcode (OP_INTERNALVAR); }
 572         ;
 573
 574 /* GDB scope operator */
 575 variable:       block COLONCOLON NAME
 576                         { struct symbol *sym;
 577                           sym = lookup_symbol (copy_name ($3), $1,
 578                                                VAR_NAMESPACE, 0, NULL);
 579                           if (sym == 0)
 580                             error ("No symbol \"%s\" in specified context.",
 581                                    copy_name ($3));
 582
 583                           write_exp_elt_opcode (OP_VAR_VALUE);
 584                           /* block_found is set by lookup_symbol.  */
 585                           write_exp_elt_block (block_found);
 586                           write_exp_elt_sym (sym);
 587                           write_exp_elt_opcode (OP_VAR_VALUE); }
 588         ;
 589
 590 /* Base case for variables. */
 591 variable:       NAME
 592                         { struct symbol *sym;
 593                           int is_a_field_of_this;
 594
 595                           sym = lookup_symbol (copy_name ($1),
 596                                                expression_context_block,
 597                                                VAR_NAMESPACE,
 598                                                &is_a_field_of_this,
 599                                                NULL);
 600                           if (sym)
 601                             {
 602                               switch (sym->class)
 603                                 {
 604                                 case LOC_REGISTER:
 605                                 case LOC_ARG:
 606                                 case LOC_LOCAL:
 607                                 case LOC_REF_ARG:
 608                                 case LOC_REGPARM:
 609                                 case LOC_REGPARM_ADDR:
 610                                 case LOC_LOCAL_ARG:
 611                                 case LOC_BASEREG:
 612                                 case LOC_BASEREG_ARG:
 613                                   if (innermost_block == 0 ||
 614                                       contained_in (block_found,
 615                                                     innermost_block))
 616                                     innermost_block = block_found;
 617                                   break;
 618
 619                                 case LOC_UNDEF:
 620                                 case LOC_CONST:
 621                                 case LOC_STATIC:
 622                                 case LOC_TYPEDEF:
 623                                 case LOC_LABEL: /* maybe should go above? */
 624                                 case LOC_BLOCK:
 625                                 case LOC_CONST_BYTES:
 626                                 case LOC_OPTIMIZED_OUT:
 627                                   /* These are listed so gcc -Wall will reveal
 628                                      un-handled cases.  */
 629                                   break;
 630                                 }
 631                               write_exp_elt_opcode (OP_VAR_VALUE);
 632                               /* We want to use the selected frame, not
 633                                  another more inner frame which happens to
 634                                  be in the same block.  */
 635                               write_exp_elt_block (NULL);
 636                               write_exp_elt_sym (sym);
 637                               write_exp_elt_opcode (OP_VAR_VALUE);
 638                             }
 639                           else
 640                             {
 641                               struct minimal_symbol *msymbol;
 642                               register char *arg = copy_name ($1);
 643
 644                               msymbol = lookup_minimal_symbol (arg,
 645                                           (struct objfile *) NULL);
 646                               if (msymbol != NULL)
 647                                 {
 648                                   write_exp_elt_opcode (OP_LONG);
 649                                   write_exp_elt_type (builtin_type_long);
 650                                   write_exp_elt_longcst ((LONGEST) SYMBOL_VALUE_ADDRESS (msymbol));
 651                                   write_exp_elt_opcode (OP_LONG);
 652                                   write_exp_elt_opcode (UNOP_MEMVAL);
 653                                   if (msymbol -> type == mst_data ||
 654                                       msymbol -> type == mst_bss)
 655                                     write_exp_elt_type (builtin_type_int);
 656                                   else if (msymbol -> type == mst_text)
 657                                     write_exp_elt_type (lookup_function_type (builtin_type_int));
 658                                   else
 659                                     write_exp_elt_type (builtin_type_char);
 660                                   write_exp_elt_opcode (UNOP_MEMVAL);
 661                                 }
 662                               else if (!have_full_symbols () && !have_partial_symbols ())
 663                                 error ("No symbol table is loaded.  Use the \"symbol-file\" command.");
 664                               else
 665                                 error ("No symbol \"%s\" in current context.",
 666                                        copy_name ($1));
 667                             }
 668                         }
 669         ;
 670
 671 type
 672         :       TYPENAME
 673                         { $$ = lookup_typename (copy_name ($1),
 674                                                 expression_context_block, 0); }
 675
 676         ;
 677
 678 %%
 679
 680 #if 0  /* FIXME! */
 681 int
 682 overflow(a,b)
 683    long a,b;
 684 {
 685    return (MAX_OF_TYPE(builtin_type_m2_int) - b) < a;
 686 }
 687
 688 int
 689 uoverflow(a,b)
 690    unsigned long a,b;
 691 {
 692    return (MAX_OF_TYPE(builtin_type_m2_card) - b) < a;
 693 }
 694 #endif /* FIXME */
 695
 696 /* Take care of parsing a number (anything that starts with a digit).
 697    Set yylval and return the token type; update lexptr.
 698    LEN is the number of characters in it.  */
 699
 700 /*** Needs some error checking for the float case ***/
 701
 702 static int
 703 parse_number (olen)
 704      int olen;
 705 {
 706   register char *p = lexptr;
 707   register LONGEST n = 0;
 708   register LONGEST prevn = 0;
 709   register int c,i,ischar=0;
 710   register int base = input_radix;
 711   register int len = olen;
 712   int unsigned_p = number_sign == 1 ? 1 : 0;
 713
 714   if(p[len-1] == 'H')
 715   {
 716      base = 16;
 717      len--;
 718   }
 719   else if(p[len-1] == 'C' || p[len-1] == 'B')
 720   {
 721      base = 8;
 722      ischar = p[len-1] == 'C';
 723      len--;
 724   }
 725
 726   /* Scan the number */
 727   for (c = 0; c < len; c++)
 728   {
 729     if (p[c] == '.' && base == 10)
 730       {
 731         /* It's a float since it contains a point.  */
 732         yylval.dval = atof (p);
 733         lexptr += len;
 734         return FLOAT;
 735       }
 736     if (p[c] == '.' && base != 10)
 737        error("Floating point numbers must be base 10.");
 738     if (base == 10 && (p[c] < '0' || p[c] > '9'))
 739        error("Invalid digit \'%c\' in number.",p[c]);
 740  }
 741
 742   while (len-- > 0)
 743     {
 744       c = *p++;
 745       n *= base;
 746       if( base == 8 && (c == '8' || c == '9'))
 747          error("Invalid digit \'%c\' in octal number.",c);
 748       if (c >= '0' && c <= '9')
 749         i = c - '0';
 750       else
 751         {
 752           if (base == 16 && c >= 'A' && c <= 'F')
 753             i = c - 'A' + 10;
 754           else
 755              return ERROR;
 756         }
 757       n+=i;
 758       if(i >= base)
 759          return ERROR;
 760       if(!unsigned_p && number_sign == 1 && (prevn >= n))
 761          unsigned_p=1;          /* Try something unsigned */
 762       /* Don't do the range check if n==i and i==0, since that special
 763          case will give an overflow error. */
 764       if(RANGE_CHECK && n!=i && i)
 765       {
 766          if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
 767             ((!unsigned_p && number_sign==-1) && -prevn <= -n))
 768             range_error("Overflow on numeric constant.");
 769       }
 770          prevn=n;
 771     }
 772
 773   lexptr = p;
 774   if(*p == 'B' || *p == 'C' || *p == 'H')
 775      lexptr++;                  /* Advance past B,C or H */
 776
 777   if (ischar)
 778   {
 779      yylval.ulval = n;
 780      return CHAR;
 781   }
 782   else if ( unsigned_p && number_sign == 1)
 783   {
 784      yylval.ulval = n;
 785      return UINT;
 786   }
 787   else if((unsigned_p && (n<0))) {
 788      range_error("Overflow on numeric constant -- number too large.");
 789      /* But, this can return if range_check == range_warn.  */
 790   }
 791   yylval.lval = n;
 792   return INT;
 793 }
 794
 795
 796 /* Some tokens */
 797
 798 static struct
 799 {
 800    char name[2];
 801    int token;
 802 } tokentab2[] =
 803 {
 804     { {'<', '>'},    NOTEQUAL   },
 805     { {':', '='},    ASSIGN     },
 806     { {'<', '='},    LEQ        },
 807     { {'>', '='},    GEQ        },
 808     { {':', ':'},    COLONCOLON },
 809
 810 };
 811
 812 /* Some specific keywords */
 813
 814 struct keyword {
 815    char keyw[10];
 816    int token;
 817 };
 818
 819 static struct keyword keytab[] =
 820 {
 821     {"OR" ,   OROR       },
 822     {"IN",    IN         },/* Note space after IN */
 823     {"AND",   LOGICAL_AND},
 824     {"ABS",   ABS        },
 825     {"CHR",   CHR        },
 826     {"DEC",   DEC        },
 827     {"NOT",   NOT        },
 828     {"DIV",   DIV        },
 829     {"INC",   INC        },
 830     {"MAX",   MAX_FUNC   },
 831     {"MIN",   MIN_FUNC   },
 832     {"MOD",   MOD        },
 833     {"ODD",   ODD        },
 834     {"CAP",   CAP        },
 835     {"ORD",   ORD        },
 836     {"VAL",   VAL        },
 837     {"EXCL",  EXCL       },
 838     {"HIGH",  HIGH       },
 839     {"INCL",  INCL       },
 840     {"SIZE",  SIZE       },
 841     {"FLOAT", FLOAT_FUNC },
 842     {"TRUNC", TRUNC      },
 843 };
 844
 845
 846 /* Read one token, getting characters through lexptr.  */
 847
 848 /* This is where we will check to make sure that the language and the operators used are
 849    compatible  */
 850
 851 static int
 852 yylex ()
 853 {
 854   register int c;
 855   register int namelen;
 856   register int i;
 857   register char *tokstart;
 858   register char quote;
 859
 860  retry:
 861
 862   tokstart = lexptr;
 863
 864
 865   /* See if it is a special token of length 2 */
 866   for( i = 0 ; i < sizeof tokentab2 / sizeof tokentab2[0] ; i++)
 867      if(STREQN(tokentab2[i].name, tokstart, 2))
 868      {
 869         lexptr += 2;
 870         return tokentab2[i].token;
 871      }
 872
 873   switch (c = *tokstart)
 874     {
 875     case 0:
 876       return 0;
 877
 878     case ' ':
 879     case '\t':
 880     case '\n':
 881       lexptr++;
 882       goto retry;
 883
 884     case '(':
 885       paren_depth++;
 886       lexptr++;
 887       return c;
 888
 889     case ')':
 890       if (paren_depth == 0)
 891         return 0;
 892       paren_depth--;
 893       lexptr++;
 894       return c;
 895
 896     case ',':
 897       if (comma_terminates && paren_depth == 0)
 898         return 0;
 899       lexptr++;
 900       return c;
 901
 902     case '.':
 903       /* Might be a floating point number.  */
 904       if (lexptr[1] >= '0' && lexptr[1] <= '9')
 905         break;                  /* Falls into number code.  */
 906       else
 907       {
 908          lexptr++;
 909          return DOT;
 910       }
 911
 912 /* These are character tokens that appear as-is in the YACC grammar */
 913     case '+':
 914     case '-':
 915     case '*':
 916     case '/':
 917     case '^':
 918     case '<':
 919     case '>':
 920     case '[':
 921     case ']':
 922     case '=':
 923     case '{':
 924     case '}':
 925     case '#':
 926     case '@':
 927     case '~':
 928     case '&':
 929       lexptr++;
 930       return c;
 931
 932     case '\'' :
 933     case '"':
 934       quote = c;
 935       for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
 936         if (c == '\\')
 937           {
 938             c = tokstart[++namelen];
 939             if (c >= '0' && c <= '9')
 940               {
 941                 c = tokstart[++namelen];
 942                 if (c >= '0' && c <= '9')
 943                   c = tokstart[++namelen];
 944               }
 945           }
 946       if(c != quote)
 947          error("Unterminated string or character constant.");
 948       yylval.sval.ptr = tokstart + 1;
 949       yylval.sval.length = namelen - 1;
 950       lexptr += namelen + 1;
 951
 952       if(namelen == 2)          /* Single character */
 953       {
 954            yylval.ulval = tokstart[1];
 955            return CHAR;
 956       }
 957       else
 958          return STRING;
 959     }
 960
 961   /* Is it a number?  */
 962   /* Note:  We have already dealt with the case of the token '.'.
 963      See case '.' above.  */
 964   if ((c >= '0' && c <= '9'))
 965     {
 966       /* It's a number.  */
 967       int got_dot = 0, got_e = 0;
 968       register char *p = tokstart;
 969       int toktype;
 970
 971       for (++p ;; ++p)
 972         {
 973           if (!got_e && (*p == 'e' || *p == 'E'))
 974             got_dot = got_e = 1;
 975           else if (!got_dot && *p == '.')
 976             got_dot = 1;
 977           else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
 978                    && (*p == '-' || *p == '+'))
 979             /* This is the sign of the exponent, not the end of the
 980                number.  */
 981             continue;
 982           else if ((*p < '0' || *p > '9') &&
 983                    (*p < 'A' || *p > 'F') &&
 984                    (*p != 'H'))  /* Modula-2 hexadecimal number */
 985             break;
 986         }
 987         toktype = parse_number (p - tokstart);
 988         if (toktype == ERROR)
 989           {
 990             char *err_copy = (char *) alloca (p - tokstart + 1);
 991
 992             memcpy (err_copy, tokstart, p - tokstart);
 993             err_copy[p - tokstart] = 0;
 994             error ("Invalid number \"%s\".", err_copy);
 995           }
 996         lexptr = p;
 997         return toktype;
 998     }
 999
1000   if (!(c == '_' || c == '$'
1001         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1002     /* We must have come across a bad character (e.g. ';').  */
1003     error ("Invalid character '%c' in expression.", c);
1004
1005   /* It's a name.  See how long it is.  */
1006   namelen = 0;
1007   for (c = tokstart[namelen];
1008        (c == '_' || c == '$' || (c >= '0' && c <= '9')
1009         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
1010        c = tokstart[++namelen])
1011     ;
1012
1013   /* The token "if" terminates the expression and is NOT
1014      removed from the input stream.  */
1015   if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1016     {
1017       return 0;
1018     }
1019
1020   lexptr += namelen;
1021
1022   /* Handle the tokens $digits; also $ (short for $0) and $$ (short for $$1)
1023      and $$digits (equivalent to $<-digits> if you could type that).
1024      Make token type LAST, and put the number (the digits) in yylval.  */
1025
1026   if (*tokstart == '$')
1027     {
1028       register int negate = 0;
1029       c = 1;
1030       /* Double dollar means negate the number and add -1 as well.
1031          Thus $$ alone means -1.  */
1032       if (namelen >= 2 && tokstart[1] == '$')
1033         {
1034           negate = 1;
1035           c = 2;
1036         }
1037       if (c == namelen)
1038         {
1039           /* Just dollars (one or two) */
1040           yylval.lval = - negate;
1041           return LAST;
1042         }
1043       /* Is the rest of the token digits?  */
1044       for (; c < namelen; c++)
1045         if (!(tokstart[c] >= '0' && tokstart[c] <= '9'))
1046           break;
1047       if (c == namelen)
1048         {
1049           yylval.lval = atoi (tokstart + 1 + negate);
1050           if (negate)
1051             yylval.lval = - yylval.lval;
1052           return LAST;
1053         }
1054     }
1055
1056   /* Handle tokens that refer to machine registers:
1057      $ followed by a register name.  */
1058
1059   if (*tokstart == '$') {
1060     for (c = 0; c < NUM_REGS; c++)
1061       if (namelen - 1 == strlen (reg_names[c])
1062           && STREQN (tokstart + 1, reg_names[c], namelen - 1))
1063         {
1064           yylval.lval = c;
1065           return REGNAME;
1066         }
1067     for (c = 0; c < num_std_regs; c++)
1068      if (namelen - 1 == strlen (std_regs[c].name)
1069          && STREQN (tokstart + 1, std_regs[c].name, namelen - 1))
1070        {
1071          yylval.lval = std_regs[c].regnum;
1072          return REGNAME;
1073        }
1074   }
1075
1076
1077   /*  Lookup special keywords */
1078   for(i = 0 ; i < sizeof(keytab) / sizeof(keytab[0]) ; i++)
1079      if(namelen == strlen(keytab[i].keyw) && STREQN(tokstart,keytab[i].keyw,namelen))
1080            return keytab[i].token;
1081
1082   yylval.sval.ptr = tokstart;
1083   yylval.sval.length = namelen;
1084
1085   /* Any other names starting in $ are debugger internal variables.  */
1086
1087   if (*tokstart == '$')
1088     {
1089       yylval.ivar = (struct internalvar *) lookup_internalvar (copy_name (yylval.sval) + 1);
1090       return INTERNAL_VAR;
1091     }
1092
1093
1094   /* Use token-type BLOCKNAME for symbols that happen to be defined as
1095      functions.  If this is not so, then ...
1096      Use token-type TYPENAME for symbols that happen to be defined
1097      currently as names of types; NAME for other symbols.
1098      The caller is not constrained to care about the distinction.  */
1099  {
1100
1101
1102     char *tmp = copy_name (yylval.sval);
1103     struct symbol *sym;
1104
1105     if (lookup_partial_symtab (tmp))
1106       return BLOCKNAME;
1107     sym = lookup_symbol (tmp, expression_context_block,
1108                          VAR_NAMESPACE, 0, NULL);
1109     if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1110       return BLOCKNAME;
1111     if (lookup_typename (copy_name (yylval.sval), expression_context_block, 1))
1112       return TYPENAME;
1113
1114     if(sym)
1115     {
1116        switch(sym->class)
1117        {
1118        case LOC_STATIC:
1119        case LOC_REGISTER:
1120        case LOC_ARG:
1121        case LOC_REF_ARG:
1122        case LOC_REGPARM:
1123        case LOC_REGPARM_ADDR:
1124        case LOC_LOCAL:
1125        case LOC_LOCAL_ARG:
1126        case LOC_BASEREG:
1127        case LOC_BASEREG_ARG:
1128        case LOC_CONST:
1129        case LOC_CONST_BYTES:
1130        case LOC_OPTIMIZED_OUT:
1131           return NAME;
1132
1133        case LOC_TYPEDEF:
1134           return TYPENAME;
1135
1136        case LOC_BLOCK:
1137           return BLOCKNAME;
1138
1139        case LOC_UNDEF:
1140           error("internal:  Undefined class in m2lex()");
1141
1142        case LOC_LABEL:
1143           error("internal:  Unforseen case in m2lex()");
1144        }
1145     }
1146     else
1147     {
1148        /* Built-in BOOLEAN type.  This is sort of a hack. */
1149        if(STREQN(tokstart,"TRUE",4))
1150        {
1151           yylval.ulval = 1;
1152           return M2_TRUE;
1153        }
1154        else if(STREQN(tokstart,"FALSE",5))
1155        {
1156           yylval.ulval = 0;
1157           return M2_FALSE;
1158        }
1159     }
1160
1161     /* Must be another type of name... */
1162     return NAME;
1163  }
1164 }
1165
1166 #if 0           /* Unused */
1167 static char *
1168 make_qualname(mod,ident)
1169    char *mod, *ident;
1170 {
1171    char *new = malloc(strlen(mod)+strlen(ident)+2);
1172
1173    strcpy(new,mod);
1174    strcat(new,".");
1175    strcat(new,ident);
1176    return new;
1177 }
1178 #endif  /* 0 */
1179
1180 void
1181 yyerror(msg)
1182      char *msg; /* unused */
1183 {
1184    printf("Parsing:  %s\n",lexptr);
1185    if (yychar < 256)
1186      error("Invalid syntax in expression near character '%c'.",yychar);
1187    else
1188      error("Invalid syntax in expression");
1189 }
1190