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