1 /* YACC parser for Fortran expressions, for GDB. 2 Copyright (C) 1986, 1989-1991, 1993-1996, 2000-2012 Free Software 3 Foundation, Inc. 4 5 Contributed by Motorola. Adapted from the C parser by Farooq Butt 6 (fmbutt@engage.sps.mot.com). 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 3 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, see <http://www.gnu.org/licenses/>. */ 22 23 /* This was blantantly ripped off the C expression parser, please 24 be aware of that as you look at its basic structure -FMB */ 25 26 /* Parse a F77 expression from text in a string, 27 and return the result as a struct expression pointer. 28 That structure contains arithmetic operations in reverse polish, 29 with constants represented by operations that are followed by special data. 30 See expression.h for the details of the format. 31 What is important here is that it can be built up sequentially 32 during the process of parsing; the lower levels of the tree always 33 come first in the result. 34 35 Note that malloc's and realloc's in this file are transformed to 36 xmalloc and xrealloc respectively by the same sed command in the 37 makefile that remaps any other malloc/realloc inserted by the parser 38 generator. Doing this with #defines and trying to control the interaction 39 with include files (<malloc.h> and <stdlib.h> for example) just became 40 too messy, particularly when such includes can be inserted at random 41 times by the parser generator. */ 42 43 %{ 44 45 #include "defs.h" 46 #include "gdb_string.h" 47 #include "expression.h" 48 #include "value.h" 49 #include "parser-defs.h" 50 #include "language.h" 51 #include "f-lang.h" 52 #include "bfd.h" /* Required by objfiles.h. */ 53 #include "symfile.h" /* Required by objfiles.h. */ 54 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */ 55 #include "block.h" 56 #include <ctype.h> 57 58 #define parse_type builtin_type (parse_gdbarch) 59 #define parse_f_type builtin_f_type (parse_gdbarch) 60 61 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc), 62 as well as gratuitiously global symbol names, so we can have multiple 63 yacc generated parsers in gdb. Note that these are only the variables 64 produced by yacc. If other parser generators (bison, byacc, etc) produce 65 additional global names that conflict at link time, then those parser 66 generators need to be fixed instead of adding those names to this list. */ 67 68 #define yymaxdepth f_maxdepth 69 #define yyparse f_parse 70 #define yylex f_lex 71 #define yyerror f_error 72 #define yylval f_lval 73 #define yychar f_char 74 #define yydebug f_debug 75 #define yypact f_pact 76 #define yyr1 f_r1 77 #define yyr2 f_r2 78 #define yydef f_def 79 #define yychk f_chk 80 #define yypgo f_pgo 81 #define yyact f_act 82 #define yyexca f_exca 83 #define yyerrflag f_errflag 84 #define yynerrs f_nerrs 85 #define yyps f_ps 86 #define yypv f_pv 87 #define yys f_s 88 #define yy_yys f_yys 89 #define yystate f_state 90 #define yytmp f_tmp 91 #define yyv f_v 92 #define yy_yyv f_yyv 93 #define yyval f_val 94 #define yylloc f_lloc 95 #define yyreds f_reds /* With YYDEBUG defined */ 96 #define yytoks f_toks /* With YYDEBUG defined */ 97 #define yyname f_name /* With YYDEBUG defined */ 98 #define yyrule f_rule /* With YYDEBUG defined */ 99 #define yylhs f_yylhs 100 #define yylen f_yylen 101 #define yydefred f_yydefred 102 #define yydgoto f_yydgoto 103 #define yysindex f_yysindex 104 #define yyrindex f_yyrindex 105 #define yygindex f_yygindex 106 #define yytable f_yytable 107 #define yycheck f_yycheck 108 109 #ifndef YYDEBUG 110 #define YYDEBUG 1 /* Default to yydebug support */ 111 #endif 112 113 #define YYFPRINTF parser_fprintf 114 115 int yyparse (void); 116 117 static int yylex (void); 118 119 void yyerror (char *); 120 121 static void growbuf_by_size (int); 122 123 static int match_string_literal (void); 124 125 %} 126 127 /* Although the yacc "value" of an expression is not used, 128 since the result is stored in the structure being created, 129 other node types do have values. */ 130 131 %union 132 { 133 LONGEST lval; 134 struct { 135 LONGEST val; 136 struct type *type; 137 } typed_val; 138 DOUBLEST dval; 139 struct symbol *sym; 140 struct type *tval; 141 struct stoken sval; 142 struct ttype tsym; 143 struct symtoken ssym; 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 %{ 154 /* YYSTYPE gets defined by %union */ 155 static int parse_number (char *, int, int, YYSTYPE *); 156 %} 157 158 %type <voidval> exp type_exp start variable 159 %type <tval> type typebase 160 %type <tvec> nonempty_typelist 161 /* %type <bval> block */ 162 163 /* Fancy type parsing. */ 164 %type <voidval> func_mod direct_abs_decl abs_decl 165 %type <tval> ptype 166 167 %token <typed_val> INT 168 %token <dval> FLOAT 169 170 /* Both NAME and TYPENAME tokens represent symbols in the input, 171 and both convey their data as strings. 172 But a TYPENAME is a string that happens to be defined as a typedef 173 or builtin type name (such as int or char) 174 and a NAME is any other symbol. 175 Contexts where this distinction is not important can use the 176 nonterminal "name", which matches either NAME or TYPENAME. */ 177 178 %token <sval> STRING_LITERAL 179 %token <lval> BOOLEAN_LITERAL 180 %token <ssym> NAME 181 %token <tsym> TYPENAME 182 %type <sval> name 183 %type <ssym> name_not_typename 184 185 /* A NAME_OR_INT is a symbol which is not known in the symbol table, 186 but which would parse as a valid number in the current input radix. 187 E.g. "c" when input_radix==16. Depending on the parse, it will be 188 turned into a name or into a number. */ 189 190 %token <ssym> NAME_OR_INT 191 192 %token SIZEOF 193 %token ERROR 194 195 /* Special type cases, put in to allow the parser to distinguish different 196 legal basetypes. */ 197 %token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD 198 %token LOGICAL_S8_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_S8_KEYWORD 610 { $$ = parse_f_type->builtin_logical_s8; } 611 | LOGICAL_KEYWORD 612 { $$ = parse_f_type->builtin_logical; } 613 | LOGICAL_S2_KEYWORD 614 { $$ = parse_f_type->builtin_logical_s2; } 615 | LOGICAL_S1_KEYWORD 616 { $$ = parse_f_type->builtin_logical_s1; } 617 | REAL_KEYWORD 618 { $$ = parse_f_type->builtin_real; } 619 | REAL_S8_KEYWORD 620 { $$ = parse_f_type->builtin_real_s8; } 621 | REAL_S16_KEYWORD 622 { $$ = parse_f_type->builtin_real_s16; } 623 | COMPLEX_S8_KEYWORD 624 { $$ = parse_f_type->builtin_complex_s8; } 625 | COMPLEX_S16_KEYWORD 626 { $$ = parse_f_type->builtin_complex_s16; } 627 | COMPLEX_S32_KEYWORD 628 { $$ = parse_f_type->builtin_complex_s32; } 629 ; 630 631 nonempty_typelist 632 : type 633 { $$ = (struct type **) malloc (sizeof (struct type *) * 2); 634 $<ivec>$[0] = 1; /* Number of types in vector */ 635 $$[1] = $1; 636 } 637 | nonempty_typelist ',' type 638 { int len = sizeof (struct type *) * (++($<ivec>1[0]) + 1); 639 $$ = (struct type **) realloc ((char *) $1, len); 640 $$[$<ivec>$[0]] = $3; 641 } 642 ; 643 644 name : NAME 645 { $$ = $1.stoken; } 646 ; 647 648 name_not_typename : NAME 649 /* These would be useful if name_not_typename was useful, but it is just 650 a fake for "variable", so these cause reduce/reduce conflicts because 651 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable, 652 =exp) or just an exp. If name_not_typename was ever used in an lvalue 653 context where only a name could occur, this might be useful. 654 | NAME_OR_INT 655 */ 656 ; 657 658 %% 659 660 /* Take care of parsing a number (anything that starts with a digit). 661 Set yylval and return the token type; update lexptr. 662 LEN is the number of characters in it. */ 663 664 /*** Needs some error checking for the float case ***/ 665 666 static int 667 parse_number (p, len, parsed_float, putithere) 668 char *p; 669 int len; 670 int parsed_float; 671 YYSTYPE *putithere; 672 { 673 LONGEST n = 0; 674 LONGEST prevn = 0; 675 int c; 676 int base = input_radix; 677 int unsigned_p = 0; 678 int long_p = 0; 679 ULONGEST high_bit; 680 struct type *signed_type; 681 struct type *unsigned_type; 682 683 if (parsed_float) 684 { 685 /* It's a float since it contains a point or an exponent. */ 686 /* [dD] is not understood as an exponent by atof, change it to 'e'. */ 687 char *tmp, *tmp2; 688 689 tmp = xstrdup (p); 690 for (tmp2 = tmp; *tmp2; ++tmp2) 691 if (*tmp2 == 'd' || *tmp2 == 'D') 692 *tmp2 = 'e'; 693 putithere->dval = atof (tmp); 694 free (tmp); 695 return FLOAT; 696 } 697 698 /* Handle base-switching prefixes 0x, 0t, 0d, 0 */ 699 if (p[0] == '0') 700 switch (p[1]) 701 { 702 case 'x': 703 case 'X': 704 if (len >= 3) 705 { 706 p += 2; 707 base = 16; 708 len -= 2; 709 } 710 break; 711 712 case 't': 713 case 'T': 714 case 'd': 715 case 'D': 716 if (len >= 3) 717 { 718 p += 2; 719 base = 10; 720 len -= 2; 721 } 722 break; 723 724 default: 725 base = 8; 726 break; 727 } 728 729 while (len-- > 0) 730 { 731 c = *p++; 732 if (isupper (c)) 733 c = tolower (c); 734 if (len == 0 && c == 'l') 735 long_p = 1; 736 else if (len == 0 && c == 'u') 737 unsigned_p = 1; 738 else 739 { 740 int i; 741 if (c >= '0' && c <= '9') 742 i = c - '0'; 743 else if (c >= 'a' && c <= 'f') 744 i = c - 'a' + 10; 745 else 746 return ERROR; /* Char not a digit */ 747 if (i >= base) 748 return ERROR; /* Invalid digit in this base */ 749 n *= base; 750 n += i; 751 } 752 /* Portably test for overflow (only works for nonzero values, so make 753 a second check for zero). */ 754 if ((prevn >= n) && n != 0) 755 unsigned_p=1; /* Try something unsigned */ 756 /* If range checking enabled, portably test for unsigned overflow. */ 757 if (RANGE_CHECK && n != 0) 758 { 759 if ((unsigned_p && (unsigned)prevn >= (unsigned)n)) 760 range_error (_("Overflow on numeric constant.")); 761 } 762 prevn = n; 763 } 764 765 /* If the number is too big to be an int, or it's got an l suffix 766 then it's a long. Work out if this has to be a long by 767 shifting right and seeing if anything remains, and the 768 target int size is different to the target long size. 769 770 In the expression below, we could have tested 771 (n >> gdbarch_int_bit (parse_gdbarch)) 772 to see if it was zero, 773 but too many compilers warn about that, when ints and longs 774 are the same size. So we shift it twice, with fewer bits 775 each time, for the same result. */ 776 777 if ((gdbarch_int_bit (parse_gdbarch) != gdbarch_long_bit (parse_gdbarch) 778 && ((n >> 2) 779 >> (gdbarch_int_bit (parse_gdbarch)-2))) /* Avoid shift warning */ 780 || long_p) 781 { 782 high_bit = ((ULONGEST)1) << (gdbarch_long_bit (parse_gdbarch)-1); 783 unsigned_type = parse_type->builtin_unsigned_long; 784 signed_type = parse_type->builtin_long; 785 } 786 else 787 { 788 high_bit = ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch)-1); 789 unsigned_type = parse_type->builtin_unsigned_int; 790 signed_type = parse_type->builtin_int; 791 } 792 793 putithere->typed_val.val = n; 794 795 /* If the high bit of the worked out type is set then this number 796 has to be unsigned. */ 797 798 if (unsigned_p || (n & high_bit)) 799 putithere->typed_val.type = unsigned_type; 800 else 801 putithere->typed_val.type = signed_type; 802 803 return INT; 804 } 805 806 struct token 807 { 808 char *operator; 809 int token; 810 enum exp_opcode opcode; 811 }; 812 813 static const struct token dot_ops[] = 814 { 815 { ".and.", BOOL_AND, BINOP_END }, 816 { ".AND.", BOOL_AND, BINOP_END }, 817 { ".or.", BOOL_OR, BINOP_END }, 818 { ".OR.", BOOL_OR, BINOP_END }, 819 { ".not.", BOOL_NOT, BINOP_END }, 820 { ".NOT.", BOOL_NOT, BINOP_END }, 821 { ".eq.", EQUAL, BINOP_END }, 822 { ".EQ.", EQUAL, BINOP_END }, 823 { ".eqv.", EQUAL, BINOP_END }, 824 { ".NEQV.", NOTEQUAL, BINOP_END }, 825 { ".neqv.", NOTEQUAL, BINOP_END }, 826 { ".EQV.", EQUAL, BINOP_END }, 827 { ".ne.", NOTEQUAL, BINOP_END }, 828 { ".NE.", NOTEQUAL, BINOP_END }, 829 { ".le.", LEQ, BINOP_END }, 830 { ".LE.", LEQ, BINOP_END }, 831 { ".ge.", GEQ, BINOP_END }, 832 { ".GE.", GEQ, BINOP_END }, 833 { ".gt.", GREATERTHAN, BINOP_END }, 834 { ".GT.", GREATERTHAN, BINOP_END }, 835 { ".lt.", LESSTHAN, BINOP_END }, 836 { ".LT.", LESSTHAN, BINOP_END }, 837 { NULL, 0, 0 } 838 }; 839 840 struct f77_boolean_val 841 { 842 char *name; 843 int value; 844 }; 845 846 static const struct f77_boolean_val boolean_values[] = 847 { 848 { ".true.", 1 }, 849 { ".TRUE.", 1 }, 850 { ".false.", 0 }, 851 { ".FALSE.", 0 }, 852 { NULL, 0 } 853 }; 854 855 static const struct token f77_keywords[] = 856 { 857 { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END }, 858 { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END }, 859 { "character", CHARACTER, BINOP_END }, 860 { "integer_2", INT_S2_KEYWORD, BINOP_END }, 861 { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END }, 862 { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END }, 863 { "logical_8", LOGICAL_S8_KEYWORD, BINOP_END }, 864 { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END }, 865 { "integer", INT_KEYWORD, BINOP_END }, 866 { "logical", LOGICAL_KEYWORD, BINOP_END }, 867 { "real_16", REAL_S16_KEYWORD, BINOP_END }, 868 { "complex", COMPLEX_S8_KEYWORD, BINOP_END }, 869 { "sizeof", SIZEOF, BINOP_END }, 870 { "real_8", REAL_S8_KEYWORD, BINOP_END }, 871 { "real", REAL_KEYWORD, BINOP_END }, 872 { NULL, 0, 0 } 873 }; 874 875 /* Implementation of a dynamically expandable buffer for processing input 876 characters acquired through lexptr and building a value to return in 877 yylval. Ripped off from ch-exp.y */ 878 879 static char *tempbuf; /* Current buffer contents */ 880 static int tempbufsize; /* Size of allocated buffer */ 881 static int tempbufindex; /* Current index into buffer */ 882 883 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */ 884 885 #define CHECKBUF(size) \ 886 do { \ 887 if (tempbufindex + (size) >= tempbufsize) \ 888 { \ 889 growbuf_by_size (size); \ 890 } \ 891 } while (0); 892 893 894 /* Grow the static temp buffer if necessary, including allocating the 895 first one on demand. */ 896 897 static void 898 growbuf_by_size (count) 899 int count; 900 { 901 int growby; 902 903 growby = max (count, GROWBY_MIN_SIZE); 904 tempbufsize += growby; 905 if (tempbuf == NULL) 906 tempbuf = (char *) malloc (tempbufsize); 907 else 908 tempbuf = (char *) realloc (tempbuf, tempbufsize); 909 } 910 911 /* Blatantly ripped off from ch-exp.y. This routine recognizes F77 912 string-literals. 913 914 Recognize a string literal. A string literal is a nonzero sequence 915 of characters enclosed in matching single quotes, except that 916 a single character inside single quotes is a character literal, which 917 we reject as a string literal. To embed the terminator character inside 918 a string, it is simply doubled (I.E. 'this''is''one''string') */ 919 920 static int 921 match_string_literal (void) 922 { 923 char *tokptr = lexptr; 924 925 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++) 926 { 927 CHECKBUF (1); 928 if (*tokptr == *lexptr) 929 { 930 if (*(tokptr + 1) == *lexptr) 931 tokptr++; 932 else 933 break; 934 } 935 tempbuf[tempbufindex++] = *tokptr; 936 } 937 if (*tokptr == '\0' /* no terminator */ 938 || tempbufindex == 0) /* no string */ 939 return 0; 940 else 941 { 942 tempbuf[tempbufindex] = '\0'; 943 yylval.sval.ptr = tempbuf; 944 yylval.sval.length = tempbufindex; 945 lexptr = ++tokptr; 946 return STRING_LITERAL; 947 } 948 } 949 950 /* Read one token, getting characters through lexptr. */ 951 952 static int 953 yylex (void) 954 { 955 int c; 956 int namelen; 957 unsigned int i,token; 958 char *tokstart; 959 960 retry: 961 962 prev_lexptr = lexptr; 963 964 tokstart = lexptr; 965 966 /* First of all, let us make sure we are not dealing with the 967 special tokens .true. and .false. which evaluate to 1 and 0. */ 968 969 if (*lexptr == '.') 970 { 971 for (i = 0; boolean_values[i].name != NULL; i++) 972 { 973 if (strncmp (tokstart, boolean_values[i].name, 974 strlen (boolean_values[i].name)) == 0) 975 { 976 lexptr += strlen (boolean_values[i].name); 977 yylval.lval = boolean_values[i].value; 978 return BOOLEAN_LITERAL; 979 } 980 } 981 } 982 983 /* See if it is a special .foo. operator. */ 984 985 for (i = 0; dot_ops[i].operator != NULL; i++) 986 if (strncmp (tokstart, dot_ops[i].operator, 987 strlen (dot_ops[i].operator)) == 0) 988 { 989 lexptr += strlen (dot_ops[i].operator); 990 yylval.opcode = dot_ops[i].opcode; 991 return dot_ops[i].token; 992 } 993 994 /* See if it is an exponentiation operator. */ 995 996 if (strncmp (tokstart, "**", 2) == 0) 997 { 998 lexptr += 2; 999 yylval.opcode = BINOP_EXP; 1000 return STARSTAR; 1001 } 1002 1003 switch (c = *tokstart) 1004 { 1005 case 0: 1006 return 0; 1007 1008 case ' ': 1009 case '\t': 1010 case '\n': 1011 lexptr++; 1012 goto retry; 1013 1014 case '\'': 1015 token = match_string_literal (); 1016 if (token != 0) 1017 return (token); 1018 break; 1019 1020 case '(': 1021 paren_depth++; 1022 lexptr++; 1023 return c; 1024 1025 case ')': 1026 if (paren_depth == 0) 1027 return 0; 1028 paren_depth--; 1029 lexptr++; 1030 return c; 1031 1032 case ',': 1033 if (comma_terminates && paren_depth == 0) 1034 return 0; 1035 lexptr++; 1036 return c; 1037 1038 case '.': 1039 /* Might be a floating point number. */ 1040 if (lexptr[1] < '0' || lexptr[1] > '9') 1041 goto symbol; /* Nope, must be a symbol. */ 1042 /* FALL THRU into number case. */ 1043 1044 case '0': 1045 case '1': 1046 case '2': 1047 case '3': 1048 case '4': 1049 case '5': 1050 case '6': 1051 case '7': 1052 case '8': 1053 case '9': 1054 { 1055 /* It's a number. */ 1056 int got_dot = 0, got_e = 0, got_d = 0, toktype; 1057 char *p = tokstart; 1058 int hex = input_radix > 10; 1059 1060 if (c == '0' && (p[1] == 'x' || p[1] == 'X')) 1061 { 1062 p += 2; 1063 hex = 1; 1064 } 1065 else if (c == '0' && (p[1]=='t' || p[1]=='T' 1066 || p[1]=='d' || p[1]=='D')) 1067 { 1068 p += 2; 1069 hex = 0; 1070 } 1071 1072 for (;; ++p) 1073 { 1074 if (!hex && !got_e && (*p == 'e' || *p == 'E')) 1075 got_dot = got_e = 1; 1076 else if (!hex && !got_d && (*p == 'd' || *p == 'D')) 1077 got_dot = got_d = 1; 1078 else if (!hex && !got_dot && *p == '.') 1079 got_dot = 1; 1080 else if (((got_e && (p[-1] == 'e' || p[-1] == 'E')) 1081 || (got_d && (p[-1] == 'd' || p[-1] == 'D'))) 1082 && (*p == '-' || *p == '+')) 1083 /* This is the sign of the exponent, not the end of the 1084 number. */ 1085 continue; 1086 /* We will take any letters or digits. parse_number will 1087 complain if past the radix, or if L or U are not final. */ 1088 else if ((*p < '0' || *p > '9') 1089 && ((*p < 'a' || *p > 'z') 1090 && (*p < 'A' || *p > 'Z'))) 1091 break; 1092 } 1093 toktype = parse_number (tokstart, p - tokstart, got_dot|got_e|got_d, 1094 &yylval); 1095 if (toktype == ERROR) 1096 { 1097 char *err_copy = (char *) alloca (p - tokstart + 1); 1098 1099 memcpy (err_copy, tokstart, p - tokstart); 1100 err_copy[p - tokstart] = 0; 1101 error (_("Invalid number \"%s\"."), err_copy); 1102 } 1103 lexptr = p; 1104 return toktype; 1105 } 1106 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 case '?': 1123 case ':': 1124 case '=': 1125 case '{': 1126 case '}': 1127 symbol: 1128 lexptr++; 1129 return c; 1130 } 1131 1132 if (!(c == '_' || c == '$' || c ==':' 1133 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'))) 1134 /* We must have come across a bad character (e.g. ';'). */ 1135 error (_("Invalid character '%c' in expression."), c); 1136 1137 namelen = 0; 1138 for (c = tokstart[namelen]; 1139 (c == '_' || c == '$' || c == ':' || (c >= '0' && c <= '9') 1140 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')); 1141 c = tokstart[++namelen]); 1142 1143 /* The token "if" terminates the expression and is NOT 1144 removed from the input stream. */ 1145 1146 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f') 1147 return 0; 1148 1149 lexptr += namelen; 1150 1151 /* Catch specific keywords. */ 1152 1153 for (i = 0; f77_keywords[i].operator != NULL; i++) 1154 if (strlen (f77_keywords[i].operator) == namelen 1155 && strncmp (tokstart, f77_keywords[i].operator, namelen) == 0) 1156 { 1157 /* lexptr += strlen(f77_keywords[i].operator); */ 1158 yylval.opcode = f77_keywords[i].opcode; 1159 return f77_keywords[i].token; 1160 } 1161 1162 yylval.sval.ptr = tokstart; 1163 yylval.sval.length = namelen; 1164 1165 if (*tokstart == '$') 1166 { 1167 write_dollar_variable (yylval.sval); 1168 return VARIABLE; 1169 } 1170 1171 /* Use token-type TYPENAME for symbols that happen to be defined 1172 currently as names of types; NAME for other symbols. 1173 The caller is not constrained to care about the distinction. */ 1174 { 1175 char *tmp = copy_name (yylval.sval); 1176 struct symbol *sym; 1177 int is_a_field_of_this = 0; 1178 int hextype; 1179 1180 sym = lookup_symbol (tmp, expression_context_block, 1181 VAR_DOMAIN, 1182 parse_language->la_language == language_cplus 1183 ? &is_a_field_of_this : NULL); 1184 if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF) 1185 { 1186 yylval.tsym.type = SYMBOL_TYPE (sym); 1187 return TYPENAME; 1188 } 1189 yylval.tsym.type 1190 = language_lookup_primitive_type_by_name (parse_language, 1191 parse_gdbarch, tmp); 1192 if (yylval.tsym.type != NULL) 1193 return TYPENAME; 1194 1195 /* Input names that aren't symbols but ARE valid hex numbers, 1196 when the input radix permits them, can be names or numbers 1197 depending on the parse. Note we support radixes > 16 here. */ 1198 if (!sym 1199 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10) 1200 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10))) 1201 { 1202 YYSTYPE newlval; /* Its value is ignored. */ 1203 hextype = parse_number (tokstart, namelen, 0, &newlval); 1204 if (hextype == INT) 1205 { 1206 yylval.ssym.sym = sym; 1207 yylval.ssym.is_a_field_of_this = is_a_field_of_this; 1208 return NAME_OR_INT; 1209 } 1210 } 1211 1212 /* Any other kind of symbol */ 1213 yylval.ssym.sym = sym; 1214 yylval.ssym.is_a_field_of_this = is_a_field_of_this; 1215 return NAME; 1216 } 1217 } 1218 1219 void 1220 yyerror (msg) 1221 char *msg; 1222 { 1223 if (prev_lexptr) 1224 lexptr = prev_lexptr; 1225 1226 error (_("A %s in expression, near `%s'."), (msg ? msg : "error"), lexptr); 1227 } 1228