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