1 /* YACC parser for Fortran expressions, for GDB. 2 Copyright (C) 1986, 1989, 1990, 1991, 1993, 1994, 1995, 1996, 2000, 2001, 3 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 4 Free Software Foundation, Inc. 5 6 Contributed by Motorola. Adapted from the C parser by Farooq Butt 7 (fmbutt@engage.sps.mot.com). 8 9 This file is part of GDB. 10 11 This program is free software; you can redistribute it and/or modify 12 it under the terms of the GNU General Public License as published by 13 the Free Software Foundation; either version 3 of the License, or 14 (at your option) any later version. 15 16 This program is distributed in the hope that it will be useful, 17 but WITHOUT ANY WARRANTY; without even the implied warranty of 18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 GNU General Public License for more details. 20 21 You should have received a copy of the GNU General Public License 22 along with this program. If not, see <http://www.gnu.org/licenses/>. */ 23 24 /* This was blantantly ripped off the C expression parser, please 25 be aware of that as you look at its basic structure -FMB */ 26 27 /* Parse a F77 expression from text in a string, 28 and return the result as a struct expression pointer. 29 That structure contains arithmetic operations in reverse polish, 30 with constants represented by operations that are followed by special data. 31 See expression.h for the details of the format. 32 What is important here is that it can be built up sequentially 33 during the process of parsing; the lower levels of the tree always 34 come first in the result. 35 36 Note that malloc's and realloc's in this file are transformed to 37 xmalloc and xrealloc respectively by the same sed command in the 38 makefile that remaps any other malloc/realloc inserted by the parser 39 generator. Doing this with #defines and trying to control the interaction 40 with include files (<malloc.h> and <stdlib.h> for example) just became 41 too messy, particularly when such includes can be inserted at random 42 times by the parser generator. */ 43 44 %{ 45 46 #include "defs.h" 47 #include "gdb_string.h" 48 #include "expression.h" 49 #include "value.h" 50 #include "parser-defs.h" 51 #include "language.h" 52 #include "f-lang.h" 53 #include "bfd.h" /* Required by objfiles.h. */ 54 #include "symfile.h" /* Required by objfiles.h. */ 55 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */ 56 #include "block.h" 57 #include <ctype.h> 58 59 #define parse_type builtin_type (parse_gdbarch) 60 #define parse_f_type builtin_f_type (parse_gdbarch) 61 62 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc), 63 as well as gratuitiously global symbol names, so we can have multiple 64 yacc generated parsers in gdb. Note that these are only the variables 65 produced by yacc. If other parser generators (bison, byacc, etc) produce 66 additional global names that conflict at link time, then those parser 67 generators need to be fixed instead of adding those names to this list. */ 68 69 #define yymaxdepth f_maxdepth 70 #define yyparse f_parse 71 #define yylex f_lex 72 #define yyerror f_error 73 #define yylval f_lval 74 #define yychar f_char 75 #define yydebug f_debug 76 #define yypact f_pact 77 #define yyr1 f_r1 78 #define yyr2 f_r2 79 #define yydef f_def 80 #define yychk f_chk 81 #define yypgo f_pgo 82 #define yyact f_act 83 #define yyexca f_exca 84 #define yyerrflag f_errflag 85 #define yynerrs f_nerrs 86 #define yyps f_ps 87 #define yypv f_pv 88 #define yys f_s 89 #define yy_yys f_yys 90 #define yystate f_state 91 #define yytmp f_tmp 92 #define yyv f_v 93 #define yy_yyv f_yyv 94 #define yyval f_val 95 #define yylloc f_lloc 96 #define yyreds f_reds /* With YYDEBUG defined */ 97 #define yytoks f_toks /* With YYDEBUG defined */ 98 #define yyname f_name /* With YYDEBUG defined */ 99 #define yyrule f_rule /* With YYDEBUG defined */ 100 #define yylhs f_yylhs 101 #define yylen f_yylen 102 #define yydefred f_yydefred 103 #define yydgoto f_yydgoto 104 #define yysindex f_yysindex 105 #define yyrindex f_yyrindex 106 #define yygindex f_yygindex 107 #define yytable f_yytable 108 #define yycheck f_yycheck 109 110 #ifndef YYDEBUG 111 #define YYDEBUG 1 /* Default to yydebug support */ 112 #endif 113 114 #define YYFPRINTF parser_fprintf 115 116 int yyparse (void); 117 118 static int yylex (void); 119 120 void yyerror (char *); 121 122 static void growbuf_by_size (int); 123 124 static int match_string_literal (void); 125 126 %} 127 128 /* Although the yacc "value" of an expression is not used, 129 since the result is stored in the structure being created, 130 other node types do have values. */ 131 132 %union 133 { 134 LONGEST lval; 135 struct { 136 LONGEST val; 137 struct type *type; 138 } typed_val; 139 DOUBLEST dval; 140 struct symbol *sym; 141 struct type *tval; 142 struct stoken sval; 143 struct ttype tsym; 144 struct symtoken ssym; 145 int voidval; 146 struct block *bval; 147 enum exp_opcode opcode; 148 struct internalvar *ivar; 149 150 struct type **tvec; 151 int *ivec; 152 } 153 154 %{ 155 /* YYSTYPE gets defined by %union */ 156 static int parse_number (char *, int, int, YYSTYPE *); 157 %} 158 159 %type <voidval> exp type_exp start variable 160 %type <tval> type typebase 161 %type <tvec> nonempty_typelist 162 /* %type <bval> block */ 163 164 /* Fancy type parsing. */ 165 %type <voidval> func_mod direct_abs_decl abs_decl 166 %type <tval> ptype 167 168 %token <typed_val> INT 169 %token <dval> FLOAT 170 171 /* Both NAME and TYPENAME tokens represent symbols in the input, 172 and both convey their data as strings. 173 But a TYPENAME is a string that happens to be defined as a typedef 174 or builtin type name (such as int or char) 175 and a NAME is any other symbol. 176 Contexts where this distinction is not important can use the 177 nonterminal "name", which matches either NAME or TYPENAME. */ 178 179 %token <sval> STRING_LITERAL 180 %token <lval> BOOLEAN_LITERAL 181 %token <ssym> NAME 182 %token <tsym> TYPENAME 183 %type <sval> name 184 %type <ssym> name_not_typename 185 186 /* A NAME_OR_INT is a symbol which is not known in the symbol table, 187 but which would parse as a valid number in the current input radix. 188 E.g. "c" when input_radix==16. Depending on the parse, it will be 189 turned into a name or into a number. */ 190 191 %token <ssym> NAME_OR_INT 192 193 %token SIZEOF 194 %token ERROR 195 196 /* Special type cases, put in to allow the parser to distinguish different 197 legal basetypes. */ 198 %token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD 199 %token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD 200 %token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD 201 %token BOOL_AND BOOL_OR BOOL_NOT 202 %token <lval> CHARACTER 203 204 %token <voidval> VARIABLE 205 206 %token <opcode> ASSIGN_MODIFY 207 208 %left ',' 209 %left ABOVE_COMMA 210 %right '=' ASSIGN_MODIFY 211 %right '?' 212 %left BOOL_OR 213 %right BOOL_NOT 214 %left BOOL_AND 215 %left '|' 216 %left '^' 217 %left '&' 218 %left EQUAL NOTEQUAL 219 %left LESSTHAN GREATERTHAN LEQ GEQ 220 %left LSH RSH 221 %left '@' 222 %left '+' '-' 223 %left '*' '/' 224 %right STARSTAR 225 %right '%' 226 %right UNARY 227 %right '(' 228 229 230 %% 231 232 start : exp 233 | type_exp 234 ; 235 236 type_exp: type 237 { write_exp_elt_opcode(OP_TYPE); 238 write_exp_elt_type($1); 239 write_exp_elt_opcode(OP_TYPE); } 240 ; 241 242 exp : '(' exp ')' 243 { } 244 ; 245 246 /* Expressions, not including the comma operator. */ 247 exp : '*' exp %prec UNARY 248 { write_exp_elt_opcode (UNOP_IND); } 249 ; 250 251 exp : '&' exp %prec UNARY 252 { write_exp_elt_opcode (UNOP_ADDR); } 253 ; 254 255 exp : '-' exp %prec UNARY 256 { write_exp_elt_opcode (UNOP_NEG); } 257 ; 258 259 exp : BOOL_NOT exp %prec UNARY 260 { write_exp_elt_opcode (UNOP_LOGICAL_NOT); } 261 ; 262 263 exp : '~' exp %prec UNARY 264 { write_exp_elt_opcode (UNOP_COMPLEMENT); } 265 ; 266 267 exp : SIZEOF exp %prec UNARY 268 { write_exp_elt_opcode (UNOP_SIZEOF); } 269 ; 270 271 /* No more explicit array operators, we treat everything in F77 as 272 a function call. The disambiguation as to whether we are 273 doing a subscript operation or a function call is done 274 later in eval.c. */ 275 276 exp : exp '(' 277 { start_arglist (); } 278 arglist ')' 279 { write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST); 280 write_exp_elt_longcst ((LONGEST) end_arglist ()); 281 write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST); } 282 ; 283 284 arglist : 285 ; 286 287 arglist : exp 288 { arglist_len = 1; } 289 ; 290 291 arglist : subrange 292 { arglist_len = 1; } 293 ; 294 295 arglist : arglist ',' exp %prec ABOVE_COMMA 296 { arglist_len++; } 297 ; 298 299 /* There are four sorts of subrange types in F90. */ 300 301 subrange: exp ':' exp %prec ABOVE_COMMA 302 { write_exp_elt_opcode (OP_F90_RANGE); 303 write_exp_elt_longcst (NONE_BOUND_DEFAULT); 304 write_exp_elt_opcode (OP_F90_RANGE); } 305 ; 306 307 subrange: exp ':' %prec ABOVE_COMMA 308 { write_exp_elt_opcode (OP_F90_RANGE); 309 write_exp_elt_longcst (HIGH_BOUND_DEFAULT); 310 write_exp_elt_opcode (OP_F90_RANGE); } 311 ; 312 313 subrange: ':' exp %prec ABOVE_COMMA 314 { write_exp_elt_opcode (OP_F90_RANGE); 315 write_exp_elt_longcst (LOW_BOUND_DEFAULT); 316 write_exp_elt_opcode (OP_F90_RANGE); } 317 ; 318 319 subrange: ':' %prec ABOVE_COMMA 320 { write_exp_elt_opcode (OP_F90_RANGE); 321 write_exp_elt_longcst (BOTH_BOUND_DEFAULT); 322 write_exp_elt_opcode (OP_F90_RANGE); } 323 ; 324 325 complexnum: exp ',' exp 326 { } 327 ; 328 329 exp : '(' complexnum ')' 330 { write_exp_elt_opcode(OP_COMPLEX); 331 write_exp_elt_type (parse_f_type->builtin_complex_s16); 332 write_exp_elt_opcode(OP_COMPLEX); } 333 ; 334 335 exp : '(' type ')' exp %prec UNARY 336 { write_exp_elt_opcode (UNOP_CAST); 337 write_exp_elt_type ($2); 338 write_exp_elt_opcode (UNOP_CAST); } 339 ; 340 341 exp : exp '%' name 342 { write_exp_elt_opcode (STRUCTOP_STRUCT); 343 write_exp_string ($3); 344 write_exp_elt_opcode (STRUCTOP_STRUCT); } 345 ; 346 347 /* Binary operators in order of decreasing precedence. */ 348 349 exp : exp '@' exp 350 { write_exp_elt_opcode (BINOP_REPEAT); } 351 ; 352 353 exp : exp STARSTAR exp 354 { write_exp_elt_opcode (BINOP_EXP); } 355 ; 356 357 exp : exp '*' exp 358 { write_exp_elt_opcode (BINOP_MUL); } 359 ; 360 361 exp : exp '/' exp 362 { write_exp_elt_opcode (BINOP_DIV); } 363 ; 364 365 exp : exp '+' exp 366 { write_exp_elt_opcode (BINOP_ADD); } 367 ; 368 369 exp : exp '-' exp 370 { write_exp_elt_opcode (BINOP_SUB); } 371 ; 372 373 exp : exp LSH exp 374 { write_exp_elt_opcode (BINOP_LSH); } 375 ; 376 377 exp : exp RSH exp 378 { write_exp_elt_opcode (BINOP_RSH); } 379 ; 380 381 exp : exp EQUAL exp 382 { write_exp_elt_opcode (BINOP_EQUAL); } 383 ; 384 385 exp : exp NOTEQUAL exp 386 { write_exp_elt_opcode (BINOP_NOTEQUAL); } 387 ; 388 389 exp : exp LEQ exp 390 { write_exp_elt_opcode (BINOP_LEQ); } 391 ; 392 393 exp : exp GEQ exp 394 { write_exp_elt_opcode (BINOP_GEQ); } 395 ; 396 397 exp : exp LESSTHAN exp 398 { write_exp_elt_opcode (BINOP_LESS); } 399 ; 400 401 exp : exp GREATERTHAN exp 402 { write_exp_elt_opcode (BINOP_GTR); } 403 ; 404 405 exp : exp '&' exp 406 { write_exp_elt_opcode (BINOP_BITWISE_AND); } 407 ; 408 409 exp : exp '^' exp 410 { write_exp_elt_opcode (BINOP_BITWISE_XOR); } 411 ; 412 413 exp : exp '|' exp 414 { write_exp_elt_opcode (BINOP_BITWISE_IOR); } 415 ; 416 417 exp : exp BOOL_AND exp 418 { write_exp_elt_opcode (BINOP_LOGICAL_AND); } 419 ; 420 421 422 exp : exp BOOL_OR exp 423 { write_exp_elt_opcode (BINOP_LOGICAL_OR); } 424 ; 425 426 exp : exp '=' exp 427 { write_exp_elt_opcode (BINOP_ASSIGN); } 428 ; 429 430 exp : exp ASSIGN_MODIFY exp 431 { write_exp_elt_opcode (BINOP_ASSIGN_MODIFY); 432 write_exp_elt_opcode ($2); 433 write_exp_elt_opcode (BINOP_ASSIGN_MODIFY); } 434 ; 435 436 exp : INT 437 { write_exp_elt_opcode (OP_LONG); 438 write_exp_elt_type ($1.type); 439 write_exp_elt_longcst ((LONGEST)($1.val)); 440 write_exp_elt_opcode (OP_LONG); } 441 ; 442 443 exp : NAME_OR_INT 444 { YYSTYPE val; 445 parse_number ($1.stoken.ptr, $1.stoken.length, 0, &val); 446 write_exp_elt_opcode (OP_LONG); 447 write_exp_elt_type (val.typed_val.type); 448 write_exp_elt_longcst ((LONGEST)val.typed_val.val); 449 write_exp_elt_opcode (OP_LONG); } 450 ; 451 452 exp : FLOAT 453 { write_exp_elt_opcode (OP_DOUBLE); 454 write_exp_elt_type (parse_f_type->builtin_real_s8); 455 write_exp_elt_dblcst ($1); 456 write_exp_elt_opcode (OP_DOUBLE); } 457 ; 458 459 exp : variable 460 ; 461 462 exp : VARIABLE 463 ; 464 465 exp : SIZEOF '(' type ')' %prec UNARY 466 { write_exp_elt_opcode (OP_LONG); 467 write_exp_elt_type (parse_f_type->builtin_integer); 468 CHECK_TYPEDEF ($3); 469 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3)); 470 write_exp_elt_opcode (OP_LONG); } 471 ; 472 473 exp : BOOLEAN_LITERAL 474 { write_exp_elt_opcode (OP_BOOL); 475 write_exp_elt_longcst ((LONGEST) $1); 476 write_exp_elt_opcode (OP_BOOL); 477 } 478 ; 479 480 exp : STRING_LITERAL 481 { 482 write_exp_elt_opcode (OP_STRING); 483 write_exp_string ($1); 484 write_exp_elt_opcode (OP_STRING); 485 } 486 ; 487 488 variable: name_not_typename 489 { struct symbol *sym = $1.sym; 490 491 if (sym) 492 { 493 if (symbol_read_needs_frame (sym)) 494 { 495 if (innermost_block == 0 || 496 contained_in (block_found, 497 innermost_block)) 498 innermost_block = block_found; 499 } 500 write_exp_elt_opcode (OP_VAR_VALUE); 501 /* We want to use the selected frame, not 502 another more inner frame which happens to 503 be in the same block. */ 504 write_exp_elt_block (NULL); 505 write_exp_elt_sym (sym); 506 write_exp_elt_opcode (OP_VAR_VALUE); 507 break; 508 } 509 else 510 { 511 struct minimal_symbol *msymbol; 512 char *arg = copy_name ($1.stoken); 513 514 msymbol = 515 lookup_minimal_symbol (arg, NULL, NULL); 516 if (msymbol != NULL) 517 write_exp_msymbol (msymbol); 518 else if (!have_full_symbols () && !have_partial_symbols ()) 519 error ("No symbol table is loaded. Use the \"file\" command."); 520 else 521 error ("No symbol \"%s\" in current context.", 522 copy_name ($1.stoken)); 523 } 524 } 525 ; 526 527 528 type : ptype 529 ; 530 531 ptype : typebase 532 | typebase abs_decl 533 { 534 /* This is where the interesting stuff happens. */ 535 int done = 0; 536 int array_size; 537 struct type *follow_type = $1; 538 struct type *range_type; 539 540 while (!done) 541 switch (pop_type ()) 542 { 543 case tp_end: 544 done = 1; 545 break; 546 case tp_pointer: 547 follow_type = lookup_pointer_type (follow_type); 548 break; 549 case tp_reference: 550 follow_type = lookup_reference_type (follow_type); 551 break; 552 case tp_array: 553 array_size = pop_type_int (); 554 if (array_size != -1) 555 { 556 range_type = 557 create_range_type ((struct type *) NULL, 558 parse_f_type->builtin_integer, 559 0, array_size - 1); 560 follow_type = 561 create_array_type ((struct type *) NULL, 562 follow_type, range_type); 563 } 564 else 565 follow_type = lookup_pointer_type (follow_type); 566 break; 567 case tp_function: 568 follow_type = lookup_function_type (follow_type); 569 break; 570 } 571 $$ = follow_type; 572 } 573 ; 574 575 abs_decl: '*' 576 { push_type (tp_pointer); $$ = 0; } 577 | '*' abs_decl 578 { push_type (tp_pointer); $$ = $2; } 579 | '&' 580 { push_type (tp_reference); $$ = 0; } 581 | '&' abs_decl 582 { push_type (tp_reference); $$ = $2; } 583 | direct_abs_decl 584 ; 585 586 direct_abs_decl: '(' abs_decl ')' 587 { $$ = $2; } 588 | direct_abs_decl func_mod 589 { push_type (tp_function); } 590 | func_mod 591 { push_type (tp_function); } 592 ; 593 594 func_mod: '(' ')' 595 { $$ = 0; } 596 | '(' nonempty_typelist ')' 597 { free ($2); $$ = 0; } 598 ; 599 600 typebase /* Implements (approximately): (type-qualifier)* type-specifier */ 601 : TYPENAME 602 { $$ = $1.type; } 603 | INT_KEYWORD 604 { $$ = parse_f_type->builtin_integer; } 605 | INT_S2_KEYWORD 606 { $$ = parse_f_type->builtin_integer_s2; } 607 | CHARACTER 608 { $$ = parse_f_type->builtin_character; } 609 | LOGICAL_KEYWORD 610 { $$ = parse_f_type->builtin_logical; } 611 | LOGICAL_S2_KEYWORD 612 { $$ = parse_f_type->builtin_logical_s2; } 613 | LOGICAL_S1_KEYWORD 614 { $$ = parse_f_type->builtin_logical_s1; } 615 | REAL_KEYWORD 616 { $$ = parse_f_type->builtin_real; } 617 | REAL_S8_KEYWORD 618 { $$ = parse_f_type->builtin_real_s8; } 619 | REAL_S16_KEYWORD 620 { $$ = parse_f_type->builtin_real_s16; } 621 | COMPLEX_S8_KEYWORD 622 { $$ = parse_f_type->builtin_complex_s8; } 623 | COMPLEX_S16_KEYWORD 624 { $$ = parse_f_type->builtin_complex_s16; } 625 | COMPLEX_S32_KEYWORD 626 { $$ = parse_f_type->builtin_complex_s32; } 627 ; 628 629 nonempty_typelist 630 : type 631 { $$ = (struct type **) malloc (sizeof (struct type *) * 2); 632 $<ivec>$[0] = 1; /* Number of types in vector */ 633 $$[1] = $1; 634 } 635 | nonempty_typelist ',' type 636 { int len = sizeof (struct type *) * (++($<ivec>1[0]) + 1); 637 $$ = (struct type **) realloc ((char *) $1, len); 638 $$[$<ivec>$[0]] = $3; 639 } 640 ; 641 642 name : NAME 643 { $$ = $1.stoken; } 644 ; 645 646 name_not_typename : NAME 647 /* These would be useful if name_not_typename was useful, but it is just 648 a fake for "variable", so these cause reduce/reduce conflicts because 649 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable, 650 =exp) or just an exp. If name_not_typename was ever used in an lvalue 651 context where only a name could occur, this might be useful. 652 | NAME_OR_INT 653 */ 654 ; 655 656 %% 657 658 /* Take care of parsing a number (anything that starts with a digit). 659 Set yylval and return the token type; update lexptr. 660 LEN is the number of characters in it. */ 661 662 /*** Needs some error checking for the float case ***/ 663 664 static int 665 parse_number (p, len, parsed_float, putithere) 666 char *p; 667 int len; 668 int parsed_float; 669 YYSTYPE *putithere; 670 { 671 LONGEST n = 0; 672 LONGEST prevn = 0; 673 int c; 674 int base = input_radix; 675 int unsigned_p = 0; 676 int long_p = 0; 677 ULONGEST high_bit; 678 struct type *signed_type; 679 struct type *unsigned_type; 680 681 if (parsed_float) 682 { 683 /* It's a float since it contains a point or an exponent. */ 684 /* [dD] is not understood as an exponent by atof, change it to 'e'. */ 685 char *tmp, *tmp2; 686 687 tmp = xstrdup (p); 688 for (tmp2 = tmp; *tmp2; ++tmp2) 689 if (*tmp2 == 'd' || *tmp2 == 'D') 690 *tmp2 = 'e'; 691 putithere->dval = atof (tmp); 692 free (tmp); 693 return FLOAT; 694 } 695 696 /* Handle base-switching prefixes 0x, 0t, 0d, 0 */ 697 if (p[0] == '0') 698 switch (p[1]) 699 { 700 case 'x': 701 case 'X': 702 if (len >= 3) 703 { 704 p += 2; 705 base = 16; 706 len -= 2; 707 } 708 break; 709 710 case 't': 711 case 'T': 712 case 'd': 713 case 'D': 714 if (len >= 3) 715 { 716 p += 2; 717 base = 10; 718 len -= 2; 719 } 720 break; 721 722 default: 723 base = 8; 724 break; 725 } 726 727 while (len-- > 0) 728 { 729 c = *p++; 730 if (isupper (c)) 731 c = tolower (c); 732 if (len == 0 && c == 'l') 733 long_p = 1; 734 else if (len == 0 && c == 'u') 735 unsigned_p = 1; 736 else 737 { 738 int i; 739 if (c >= '0' && c <= '9') 740 i = c - '0'; 741 else if (c >= 'a' && c <= 'f') 742 i = c - 'a' + 10; 743 else 744 return ERROR; /* Char not a digit */ 745 if (i >= base) 746 return ERROR; /* Invalid digit in this base */ 747 n *= base; 748 n += i; 749 } 750 /* Portably test for overflow (only works for nonzero values, so make 751 a second check for zero). */ 752 if ((prevn >= n) && n != 0) 753 unsigned_p=1; /* Try something unsigned */ 754 /* If range checking enabled, portably test for unsigned overflow. */ 755 if (RANGE_CHECK && n != 0) 756 { 757 if ((unsigned_p && (unsigned)prevn >= (unsigned)n)) 758 range_error("Overflow on numeric constant."); 759 } 760 prevn = n; 761 } 762 763 /* If the number is too big to be an int, or it's got an l suffix 764 then it's a long. Work out if this has to be a long by 765 shifting right and and seeing if anything remains, and the 766 target int size is different to the target long size. 767 768 In the expression below, we could have tested 769 (n >> gdbarch_int_bit (parse_gdbarch)) 770 to see if it was zero, 771 but too many compilers warn about that, when ints and longs 772 are the same size. So we shift it twice, with fewer bits 773 each time, for the same result. */ 774 775 if ((gdbarch_int_bit (parse_gdbarch) != gdbarch_long_bit (parse_gdbarch) 776 && ((n >> 2) 777 >> (gdbarch_int_bit (parse_gdbarch)-2))) /* Avoid shift warning */ 778 || long_p) 779 { 780 high_bit = ((ULONGEST)1) << (gdbarch_long_bit (parse_gdbarch)-1); 781 unsigned_type = parse_type->builtin_unsigned_long; 782 signed_type = parse_type->builtin_long; 783 } 784 else 785 { 786 high_bit = ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch)-1); 787 unsigned_type = parse_type->builtin_unsigned_int; 788 signed_type = parse_type->builtin_int; 789 } 790 791 putithere->typed_val.val = n; 792 793 /* If the high bit of the worked out type is set then this number 794 has to be unsigned. */ 795 796 if (unsigned_p || (n & high_bit)) 797 putithere->typed_val.type = unsigned_type; 798 else 799 putithere->typed_val.type = signed_type; 800 801 return INT; 802 } 803 804 struct token 805 { 806 char *operator; 807 int token; 808 enum exp_opcode opcode; 809 }; 810 811 static const struct token dot_ops[] = 812 { 813 { ".and.", BOOL_AND, BINOP_END }, 814 { ".AND.", BOOL_AND, BINOP_END }, 815 { ".or.", BOOL_OR, BINOP_END }, 816 { ".OR.", BOOL_OR, BINOP_END }, 817 { ".not.", BOOL_NOT, BINOP_END }, 818 { ".NOT.", BOOL_NOT, BINOP_END }, 819 { ".eq.", EQUAL, BINOP_END }, 820 { ".EQ.", EQUAL, BINOP_END }, 821 { ".eqv.", EQUAL, BINOP_END }, 822 { ".NEQV.", NOTEQUAL, BINOP_END }, 823 { ".neqv.", NOTEQUAL, BINOP_END }, 824 { ".EQV.", EQUAL, BINOP_END }, 825 { ".ne.", NOTEQUAL, BINOP_END }, 826 { ".NE.", NOTEQUAL, BINOP_END }, 827 { ".le.", LEQ, BINOP_END }, 828 { ".LE.", LEQ, BINOP_END }, 829 { ".ge.", GEQ, BINOP_END }, 830 { ".GE.", GEQ, BINOP_END }, 831 { ".gt.", GREATERTHAN, BINOP_END }, 832 { ".GT.", GREATERTHAN, BINOP_END }, 833 { ".lt.", LESSTHAN, BINOP_END }, 834 { ".LT.", LESSTHAN, BINOP_END }, 835 { NULL, 0, 0 } 836 }; 837 838 struct f77_boolean_val 839 { 840 char *name; 841 int value; 842 }; 843 844 static const struct f77_boolean_val boolean_values[] = 845 { 846 { ".true.", 1 }, 847 { ".TRUE.", 1 }, 848 { ".false.", 0 }, 849 { ".FALSE.", 0 }, 850 { NULL, 0 } 851 }; 852 853 static const struct token f77_keywords[] = 854 { 855 { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END }, 856 { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END }, 857 { "character", CHARACTER, BINOP_END }, 858 { "integer_2", INT_S2_KEYWORD, BINOP_END }, 859 { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END }, 860 { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END }, 861 { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END }, 862 { "integer", INT_KEYWORD, BINOP_END }, 863 { "logical", LOGICAL_KEYWORD, BINOP_END }, 864 { "real_16", REAL_S16_KEYWORD, BINOP_END }, 865 { "complex", COMPLEX_S8_KEYWORD, BINOP_END }, 866 { "sizeof", SIZEOF, BINOP_END }, 867 { "real_8", REAL_S8_KEYWORD, BINOP_END }, 868 { "real", REAL_KEYWORD, BINOP_END }, 869 { NULL, 0, 0 } 870 }; 871 872 /* Implementation of a dynamically expandable buffer for processing input 873 characters acquired through lexptr and building a value to return in 874 yylval. Ripped off from ch-exp.y */ 875 876 static char *tempbuf; /* Current buffer contents */ 877 static int tempbufsize; /* Size of allocated buffer */ 878 static int tempbufindex; /* Current index into buffer */ 879 880 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */ 881 882 #define CHECKBUF(size) \ 883 do { \ 884 if (tempbufindex + (size) >= tempbufsize) \ 885 { \ 886 growbuf_by_size (size); \ 887 } \ 888 } while (0); 889 890 891 /* Grow the static temp buffer if necessary, including allocating the first one 892 on demand. */ 893 894 static void 895 growbuf_by_size (count) 896 int count; 897 { 898 int growby; 899 900 growby = max (count, GROWBY_MIN_SIZE); 901 tempbufsize += growby; 902 if (tempbuf == NULL) 903 tempbuf = (char *) malloc (tempbufsize); 904 else 905 tempbuf = (char *) realloc (tempbuf, tempbufsize); 906 } 907 908 /* Blatantly ripped off from ch-exp.y. This routine recognizes F77 909 string-literals. 910 911 Recognize a string literal. A string literal is a nonzero sequence 912 of characters enclosed in matching single quotes, except that 913 a single character inside single quotes is a character literal, which 914 we reject as a string literal. To embed the terminator character inside 915 a string, it is simply doubled (I.E. 'this''is''one''string') */ 916 917 static int 918 match_string_literal () 919 { 920 char *tokptr = lexptr; 921 922 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++) 923 { 924 CHECKBUF (1); 925 if (*tokptr == *lexptr) 926 { 927 if (*(tokptr + 1) == *lexptr) 928 tokptr++; 929 else 930 break; 931 } 932 tempbuf[tempbufindex++] = *tokptr; 933 } 934 if (*tokptr == '\0' /* no terminator */ 935 || tempbufindex == 0) /* no string */ 936 return 0; 937 else 938 { 939 tempbuf[tempbufindex] = '\0'; 940 yylval.sval.ptr = tempbuf; 941 yylval.sval.length = tempbufindex; 942 lexptr = ++tokptr; 943 return STRING_LITERAL; 944 } 945 } 946 947 /* Read one token, getting characters through lexptr. */ 948 949 static int 950 yylex () 951 { 952 int c; 953 int namelen; 954 unsigned int i,token; 955 char *tokstart; 956 957 retry: 958 959 prev_lexptr = lexptr; 960 961 tokstart = lexptr; 962 963 /* First of all, let us make sure we are not dealing with the 964 special tokens .true. and .false. which evaluate to 1 and 0. */ 965 966 if (*lexptr == '.') 967 { 968 for (i = 0; boolean_values[i].name != NULL; i++) 969 { 970 if (strncmp (tokstart, boolean_values[i].name, 971 strlen (boolean_values[i].name)) == 0) 972 { 973 lexptr += strlen (boolean_values[i].name); 974 yylval.lval = boolean_values[i].value; 975 return BOOLEAN_LITERAL; 976 } 977 } 978 } 979 980 /* See if it is a special .foo. operator. */ 981 982 for (i = 0; dot_ops[i].operator != NULL; i++) 983 if (strncmp (tokstart, dot_ops[i].operator, strlen (dot_ops[i].operator)) == 0) 984 { 985 lexptr += strlen (dot_ops[i].operator); 986 yylval.opcode = dot_ops[i].opcode; 987 return dot_ops[i].token; 988 } 989 990 /* See if it is an exponentiation operator. */ 991 992 if (strncmp (tokstart, "**", 2) == 0) 993 { 994 lexptr += 2; 995 yylval.opcode = BINOP_EXP; 996 return STARSTAR; 997 } 998 999 switch (c = *tokstart) 1000 { 1001 case 0: 1002 return 0; 1003 1004 case ' ': 1005 case '\t': 1006 case '\n': 1007 lexptr++; 1008 goto retry; 1009 1010 case '\'': 1011 token = match_string_literal (); 1012 if (token != 0) 1013 return (token); 1014 break; 1015 1016 case '(': 1017 paren_depth++; 1018 lexptr++; 1019 return c; 1020 1021 case ')': 1022 if (paren_depth == 0) 1023 return 0; 1024 paren_depth--; 1025 lexptr++; 1026 return c; 1027 1028 case ',': 1029 if (comma_terminates && paren_depth == 0) 1030 return 0; 1031 lexptr++; 1032 return c; 1033 1034 case '.': 1035 /* Might be a floating point number. */ 1036 if (lexptr[1] < '0' || lexptr[1] > '9') 1037 goto symbol; /* Nope, must be a symbol. */ 1038 /* FALL THRU into number case. */ 1039 1040 case '0': 1041 case '1': 1042 case '2': 1043 case '3': 1044 case '4': 1045 case '5': 1046 case '6': 1047 case '7': 1048 case '8': 1049 case '9': 1050 { 1051 /* It's a number. */ 1052 int got_dot = 0, got_e = 0, got_d = 0, toktype; 1053 char *p = tokstart; 1054 int hex = input_radix > 10; 1055 1056 if (c == '0' && (p[1] == 'x' || p[1] == 'X')) 1057 { 1058 p += 2; 1059 hex = 1; 1060 } 1061 else if (c == '0' && (p[1]=='t' || p[1]=='T' || p[1]=='d' || p[1]=='D')) 1062 { 1063 p += 2; 1064 hex = 0; 1065 } 1066 1067 for (;; ++p) 1068 { 1069 if (!hex && !got_e && (*p == 'e' || *p == 'E')) 1070 got_dot = got_e = 1; 1071 else if (!hex && !got_d && (*p == 'd' || *p == 'D')) 1072 got_dot = got_d = 1; 1073 else if (!hex && !got_dot && *p == '.') 1074 got_dot = 1; 1075 else if (((got_e && (p[-1] == 'e' || p[-1] == 'E')) 1076 || (got_d && (p[-1] == 'd' || p[-1] == 'D'))) 1077 && (*p == '-' || *p == '+')) 1078 /* This is the sign of the exponent, not the end of the 1079 number. */ 1080 continue; 1081 /* We will take any letters or digits. parse_number will 1082 complain if past the radix, or if L or U are not final. */ 1083 else if ((*p < '0' || *p > '9') 1084 && ((*p < 'a' || *p > 'z') 1085 && (*p < 'A' || *p > 'Z'))) 1086 break; 1087 } 1088 toktype = parse_number (tokstart, p - tokstart, got_dot|got_e|got_d, 1089 &yylval); 1090 if (toktype == ERROR) 1091 { 1092 char *err_copy = (char *) alloca (p - tokstart + 1); 1093 1094 memcpy (err_copy, tokstart, p - tokstart); 1095 err_copy[p - tokstart] = 0; 1096 error ("Invalid number \"%s\".", err_copy); 1097 } 1098 lexptr = p; 1099 return toktype; 1100 } 1101 1102 case '+': 1103 case '-': 1104 case '*': 1105 case '/': 1106 case '%': 1107 case '|': 1108 case '&': 1109 case '^': 1110 case '~': 1111 case '!': 1112 case '@': 1113 case '<': 1114 case '>': 1115 case '[': 1116 case ']': 1117 case '?': 1118 case ':': 1119 case '=': 1120 case '{': 1121 case '}': 1122 symbol: 1123 lexptr++; 1124 return c; 1125 } 1126 1127 if (!(c == '_' || c == '$' 1128 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'))) 1129 /* We must have come across a bad character (e.g. ';'). */ 1130 error ("Invalid character '%c' in expression.", c); 1131 1132 namelen = 0; 1133 for (c = tokstart[namelen]; 1134 (c == '_' || c == '$' || (c >= '0' && c <= '9') 1135 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')); 1136 c = tokstart[++namelen]); 1137 1138 /* The token "if" terminates the expression and is NOT 1139 removed from the input stream. */ 1140 1141 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f') 1142 return 0; 1143 1144 lexptr += namelen; 1145 1146 /* Catch specific keywords. */ 1147 1148 for (i = 0; f77_keywords[i].operator != NULL; i++) 1149 if (strncmp (tokstart, f77_keywords[i].operator, 1150 strlen(f77_keywords[i].operator)) == 0) 1151 { 1152 /* lexptr += strlen(f77_keywords[i].operator); */ 1153 yylval.opcode = f77_keywords[i].opcode; 1154 return f77_keywords[i].token; 1155 } 1156 1157 yylval.sval.ptr = tokstart; 1158 yylval.sval.length = namelen; 1159 1160 if (*tokstart == '$') 1161 { 1162 write_dollar_variable (yylval.sval); 1163 return VARIABLE; 1164 } 1165 1166 /* Use token-type TYPENAME for symbols that happen to be defined 1167 currently as names of types; NAME for other symbols. 1168 The caller is not constrained to care about the distinction. */ 1169 { 1170 char *tmp = copy_name (yylval.sval); 1171 struct symbol *sym; 1172 int is_a_field_of_this = 0; 1173 int hextype; 1174 1175 sym = lookup_symbol (tmp, expression_context_block, 1176 VAR_DOMAIN, 1177 parse_language->la_language == language_cplus 1178 ? &is_a_field_of_this : NULL); 1179 if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF) 1180 { 1181 yylval.tsym.type = SYMBOL_TYPE (sym); 1182 return TYPENAME; 1183 } 1184 yylval.tsym.type 1185 = language_lookup_primitive_type_by_name (parse_language, 1186 parse_gdbarch, tmp); 1187 if (yylval.tsym.type != NULL) 1188 return TYPENAME; 1189 1190 /* Input names that aren't symbols but ARE valid hex numbers, 1191 when the input radix permits them, can be names or numbers 1192 depending on the parse. Note we support radixes > 16 here. */ 1193 if (!sym 1194 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10) 1195 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10))) 1196 { 1197 YYSTYPE newlval; /* Its value is ignored. */ 1198 hextype = parse_number (tokstart, namelen, 0, &newlval); 1199 if (hextype == INT) 1200 { 1201 yylval.ssym.sym = sym; 1202 yylval.ssym.is_a_field_of_this = is_a_field_of_this; 1203 return NAME_OR_INT; 1204 } 1205 } 1206 1207 /* Any other kind of symbol */ 1208 yylval.ssym.sym = sym; 1209 yylval.ssym.is_a_field_of_this = is_a_field_of_this; 1210 return NAME; 1211 } 1212 } 1213 1214 void 1215 yyerror (msg) 1216 char *msg; 1217 { 1218 if (prev_lexptr) 1219 lexptr = prev_lexptr; 1220 1221 error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr); 1222 } 1223