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, 2010, 2011 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_S8_KEYWORD 200 %token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD 201 %token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD 202 %token BOOL_AND BOOL_OR BOOL_NOT 203 %token <lval> CHARACTER 204 205 %token <voidval> VARIABLE 206 207 %token <opcode> ASSIGN_MODIFY 208 209 %left ',' 210 %left ABOVE_COMMA 211 %right '=' ASSIGN_MODIFY 212 %right '?' 213 %left BOOL_OR 214 %right BOOL_NOT 215 %left BOOL_AND 216 %left '|' 217 %left '^' 218 %left '&' 219 %left EQUAL NOTEQUAL 220 %left LESSTHAN GREATERTHAN LEQ GEQ 221 %left LSH RSH 222 %left '@' 223 %left '+' '-' 224 %left '*' '/' 225 %right STARSTAR 226 %right '%' 227 %right UNARY 228 %right '(' 229 230 231 %% 232 233 start : exp 234 | type_exp 235 ; 236 237 type_exp: type 238 { write_exp_elt_opcode(OP_TYPE); 239 write_exp_elt_type($1); 240 write_exp_elt_opcode(OP_TYPE); } 241 ; 242 243 exp : '(' exp ')' 244 { } 245 ; 246 247 /* Expressions, not including the comma operator. */ 248 exp : '*' exp %prec UNARY 249 { write_exp_elt_opcode (UNOP_IND); } 250 ; 251 252 exp : '&' exp %prec UNARY 253 { write_exp_elt_opcode (UNOP_ADDR); } 254 ; 255 256 exp : '-' exp %prec UNARY 257 { write_exp_elt_opcode (UNOP_NEG); } 258 ; 259 260 exp : BOOL_NOT exp %prec UNARY 261 { write_exp_elt_opcode (UNOP_LOGICAL_NOT); } 262 ; 263 264 exp : '~' exp %prec UNARY 265 { write_exp_elt_opcode (UNOP_COMPLEMENT); } 266 ; 267 268 exp : SIZEOF exp %prec UNARY 269 { write_exp_elt_opcode (UNOP_SIZEOF); } 270 ; 271 272 /* No more explicit array operators, we treat everything in F77 as 273 a function call. The disambiguation as to whether we are 274 doing a subscript operation or a function call is done 275 later in eval.c. */ 276 277 exp : exp '(' 278 { start_arglist (); } 279 arglist ')' 280 { write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST); 281 write_exp_elt_longcst ((LONGEST) end_arglist ()); 282 write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST); } 283 ; 284 285 arglist : 286 ; 287 288 arglist : exp 289 { arglist_len = 1; } 290 ; 291 292 arglist : subrange 293 { arglist_len = 1; } 294 ; 295 296 arglist : arglist ',' exp %prec ABOVE_COMMA 297 { arglist_len++; } 298 ; 299 300 /* There are four sorts of subrange types in F90. */ 301 302 subrange: exp ':' exp %prec ABOVE_COMMA 303 { write_exp_elt_opcode (OP_F90_RANGE); 304 write_exp_elt_longcst (NONE_BOUND_DEFAULT); 305 write_exp_elt_opcode (OP_F90_RANGE); } 306 ; 307 308 subrange: exp ':' %prec ABOVE_COMMA 309 { write_exp_elt_opcode (OP_F90_RANGE); 310 write_exp_elt_longcst (HIGH_BOUND_DEFAULT); 311 write_exp_elt_opcode (OP_F90_RANGE); } 312 ; 313 314 subrange: ':' exp %prec ABOVE_COMMA 315 { write_exp_elt_opcode (OP_F90_RANGE); 316 write_exp_elt_longcst (LOW_BOUND_DEFAULT); 317 write_exp_elt_opcode (OP_F90_RANGE); } 318 ; 319 320 subrange: ':' %prec ABOVE_COMMA 321 { write_exp_elt_opcode (OP_F90_RANGE); 322 write_exp_elt_longcst (BOTH_BOUND_DEFAULT); 323 write_exp_elt_opcode (OP_F90_RANGE); } 324 ; 325 326 complexnum: exp ',' exp 327 { } 328 ; 329 330 exp : '(' complexnum ')' 331 { write_exp_elt_opcode(OP_COMPLEX); 332 write_exp_elt_type (parse_f_type->builtin_complex_s16); 333 write_exp_elt_opcode(OP_COMPLEX); } 334 ; 335 336 exp : '(' type ')' exp %prec UNARY 337 { write_exp_elt_opcode (UNOP_CAST); 338 write_exp_elt_type ($2); 339 write_exp_elt_opcode (UNOP_CAST); } 340 ; 341 342 exp : exp '%' name 343 { write_exp_elt_opcode (STRUCTOP_STRUCT); 344 write_exp_string ($3); 345 write_exp_elt_opcode (STRUCTOP_STRUCT); } 346 ; 347 348 /* Binary operators in order of decreasing precedence. */ 349 350 exp : exp '@' exp 351 { write_exp_elt_opcode (BINOP_REPEAT); } 352 ; 353 354 exp : exp STARSTAR exp 355 { write_exp_elt_opcode (BINOP_EXP); } 356 ; 357 358 exp : exp '*' exp 359 { write_exp_elt_opcode (BINOP_MUL); } 360 ; 361 362 exp : exp '/' exp 363 { write_exp_elt_opcode (BINOP_DIV); } 364 ; 365 366 exp : exp '+' exp 367 { write_exp_elt_opcode (BINOP_ADD); } 368 ; 369 370 exp : exp '-' exp 371 { write_exp_elt_opcode (BINOP_SUB); } 372 ; 373 374 exp : exp LSH exp 375 { write_exp_elt_opcode (BINOP_LSH); } 376 ; 377 378 exp : exp RSH exp 379 { write_exp_elt_opcode (BINOP_RSH); } 380 ; 381 382 exp : exp EQUAL exp 383 { write_exp_elt_opcode (BINOP_EQUAL); } 384 ; 385 386 exp : exp NOTEQUAL exp 387 { write_exp_elt_opcode (BINOP_NOTEQUAL); } 388 ; 389 390 exp : exp LEQ exp 391 { write_exp_elt_opcode (BINOP_LEQ); } 392 ; 393 394 exp : exp GEQ exp 395 { write_exp_elt_opcode (BINOP_GEQ); } 396 ; 397 398 exp : exp LESSTHAN exp 399 { write_exp_elt_opcode (BINOP_LESS); } 400 ; 401 402 exp : exp GREATERTHAN exp 403 { write_exp_elt_opcode (BINOP_GTR); } 404 ; 405 406 exp : exp '&' exp 407 { write_exp_elt_opcode (BINOP_BITWISE_AND); } 408 ; 409 410 exp : exp '^' exp 411 { write_exp_elt_opcode (BINOP_BITWISE_XOR); } 412 ; 413 414 exp : exp '|' exp 415 { write_exp_elt_opcode (BINOP_BITWISE_IOR); } 416 ; 417 418 exp : exp BOOL_AND exp 419 { write_exp_elt_opcode (BINOP_LOGICAL_AND); } 420 ; 421 422 423 exp : exp BOOL_OR exp 424 { write_exp_elt_opcode (BINOP_LOGICAL_OR); } 425 ; 426 427 exp : exp '=' exp 428 { write_exp_elt_opcode (BINOP_ASSIGN); } 429 ; 430 431 exp : exp ASSIGN_MODIFY exp 432 { write_exp_elt_opcode (BINOP_ASSIGN_MODIFY); 433 write_exp_elt_opcode ($2); 434 write_exp_elt_opcode (BINOP_ASSIGN_MODIFY); } 435 ; 436 437 exp : INT 438 { write_exp_elt_opcode (OP_LONG); 439 write_exp_elt_type ($1.type); 440 write_exp_elt_longcst ((LONGEST)($1.val)); 441 write_exp_elt_opcode (OP_LONG); } 442 ; 443 444 exp : NAME_OR_INT 445 { YYSTYPE val; 446 parse_number ($1.stoken.ptr, $1.stoken.length, 0, &val); 447 write_exp_elt_opcode (OP_LONG); 448 write_exp_elt_type (val.typed_val.type); 449 write_exp_elt_longcst ((LONGEST)val.typed_val.val); 450 write_exp_elt_opcode (OP_LONG); } 451 ; 452 453 exp : FLOAT 454 { write_exp_elt_opcode (OP_DOUBLE); 455 write_exp_elt_type (parse_f_type->builtin_real_s8); 456 write_exp_elt_dblcst ($1); 457 write_exp_elt_opcode (OP_DOUBLE); } 458 ; 459 460 exp : variable 461 ; 462 463 exp : VARIABLE 464 ; 465 466 exp : SIZEOF '(' type ')' %prec UNARY 467 { write_exp_elt_opcode (OP_LONG); 468 write_exp_elt_type (parse_f_type->builtin_integer); 469 CHECK_TYPEDEF ($3); 470 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3)); 471 write_exp_elt_opcode (OP_LONG); } 472 ; 473 474 exp : BOOLEAN_LITERAL 475 { write_exp_elt_opcode (OP_BOOL); 476 write_exp_elt_longcst ((LONGEST) $1); 477 write_exp_elt_opcode (OP_BOOL); 478 } 479 ; 480 481 exp : STRING_LITERAL 482 { 483 write_exp_elt_opcode (OP_STRING); 484 write_exp_string ($1); 485 write_exp_elt_opcode (OP_STRING); 486 } 487 ; 488 489 variable: name_not_typename 490 { struct symbol *sym = $1.sym; 491 492 if (sym) 493 { 494 if (symbol_read_needs_frame (sym)) 495 { 496 if (innermost_block == 0 497 || contained_in (block_found, 498 innermost_block)) 499 innermost_block = block_found; 500 } 501 write_exp_elt_opcode (OP_VAR_VALUE); 502 /* We want to use the selected frame, not 503 another more inner frame which happens to 504 be in the same block. */ 505 write_exp_elt_block (NULL); 506 write_exp_elt_sym (sym); 507 write_exp_elt_opcode (OP_VAR_VALUE); 508 break; 509 } 510 else 511 { 512 struct minimal_symbol *msymbol; 513 char *arg = copy_name ($1.stoken); 514 515 msymbol = 516 lookup_minimal_symbol (arg, NULL, NULL); 517 if (msymbol != NULL) 518 write_exp_msymbol (msymbol); 519 else if (!have_full_symbols () && !have_partial_symbols ()) 520 error (_("No symbol table is loaded. Use the \"file\" command.")); 521 else 522 error (_("No symbol \"%s\" in current context."), 523 copy_name ($1.stoken)); 524 } 525 } 526 ; 527 528 529 type : ptype 530 ; 531 532 ptype : typebase 533 | typebase abs_decl 534 { 535 /* This is where the interesting stuff happens. */ 536 int done = 0; 537 int array_size; 538 struct type *follow_type = $1; 539 struct type *range_type; 540 541 while (!done) 542 switch (pop_type ()) 543 { 544 case tp_end: 545 done = 1; 546 break; 547 case tp_pointer: 548 follow_type = lookup_pointer_type (follow_type); 549 break; 550 case tp_reference: 551 follow_type = lookup_reference_type (follow_type); 552 break; 553 case tp_array: 554 array_size = pop_type_int (); 555 if (array_size != -1) 556 { 557 range_type = 558 create_range_type ((struct type *) NULL, 559 parse_f_type->builtin_integer, 560 0, array_size - 1); 561 follow_type = 562 create_array_type ((struct type *) NULL, 563 follow_type, range_type); 564 } 565 else 566 follow_type = lookup_pointer_type (follow_type); 567 break; 568 case tp_function: 569 follow_type = lookup_function_type (follow_type); 570 break; 571 } 572 $$ = follow_type; 573 } 574 ; 575 576 abs_decl: '*' 577 { push_type (tp_pointer); $$ = 0; } 578 | '*' abs_decl 579 { push_type (tp_pointer); $$ = $2; } 580 | '&' 581 { push_type (tp_reference); $$ = 0; } 582 | '&' abs_decl 583 { push_type (tp_reference); $$ = $2; } 584 | direct_abs_decl 585 ; 586 587 direct_abs_decl: '(' abs_decl ')' 588 { $$ = $2; } 589 | direct_abs_decl func_mod 590 { push_type (tp_function); } 591 | func_mod 592 { push_type (tp_function); } 593 ; 594 595 func_mod: '(' ')' 596 { $$ = 0; } 597 | '(' nonempty_typelist ')' 598 { free ($2); $$ = 0; } 599 ; 600 601 typebase /* Implements (approximately): (type-qualifier)* type-specifier */ 602 : TYPENAME 603 { $$ = $1.type; } 604 | INT_KEYWORD 605 { $$ = parse_f_type->builtin_integer; } 606 | INT_S2_KEYWORD 607 { $$ = parse_f_type->builtin_integer_s2; } 608 | CHARACTER 609 { $$ = parse_f_type->builtin_character; } 610 | LOGICAL_S8_KEYWORD 611 { $$ = parse_f_type->builtin_logical_s8; } 612 | LOGICAL_KEYWORD 613 { $$ = parse_f_type->builtin_logical; } 614 | LOGICAL_S2_KEYWORD 615 { $$ = parse_f_type->builtin_logical_s2; } 616 | LOGICAL_S1_KEYWORD 617 { $$ = parse_f_type->builtin_logical_s1; } 618 | REAL_KEYWORD 619 { $$ = parse_f_type->builtin_real; } 620 | REAL_S8_KEYWORD 621 { $$ = parse_f_type->builtin_real_s8; } 622 | REAL_S16_KEYWORD 623 { $$ = parse_f_type->builtin_real_s16; } 624 | COMPLEX_S8_KEYWORD 625 { $$ = parse_f_type->builtin_complex_s8; } 626 | COMPLEX_S16_KEYWORD 627 { $$ = parse_f_type->builtin_complex_s16; } 628 | COMPLEX_S32_KEYWORD 629 { $$ = parse_f_type->builtin_complex_s32; } 630 ; 631 632 nonempty_typelist 633 : type 634 { $$ = (struct type **) malloc (sizeof (struct type *) * 2); 635 $<ivec>$[0] = 1; /* Number of types in vector */ 636 $$[1] = $1; 637 } 638 | nonempty_typelist ',' type 639 { int len = sizeof (struct type *) * (++($<ivec>1[0]) + 1); 640 $$ = (struct type **) realloc ((char *) $1, len); 641 $$[$<ivec>$[0]] = $3; 642 } 643 ; 644 645 name : NAME 646 { $$ = $1.stoken; } 647 ; 648 649 name_not_typename : NAME 650 /* These would be useful if name_not_typename was useful, but it is just 651 a fake for "variable", so these cause reduce/reduce conflicts because 652 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable, 653 =exp) or just an exp. If name_not_typename was ever used in an lvalue 654 context where only a name could occur, this might be useful. 655 | NAME_OR_INT 656 */ 657 ; 658 659 %% 660 661 /* Take care of parsing a number (anything that starts with a digit). 662 Set yylval and return the token type; update lexptr. 663 LEN is the number of characters in it. */ 664 665 /*** Needs some error checking for the float case ***/ 666 667 static int 668 parse_number (p, len, parsed_float, putithere) 669 char *p; 670 int len; 671 int parsed_float; 672 YYSTYPE *putithere; 673 { 674 LONGEST n = 0; 675 LONGEST prevn = 0; 676 int c; 677 int base = input_radix; 678 int unsigned_p = 0; 679 int long_p = 0; 680 ULONGEST high_bit; 681 struct type *signed_type; 682 struct type *unsigned_type; 683 684 if (parsed_float) 685 { 686 /* It's a float since it contains a point or an exponent. */ 687 /* [dD] is not understood as an exponent by atof, change it to 'e'. */ 688 char *tmp, *tmp2; 689 690 tmp = xstrdup (p); 691 for (tmp2 = tmp; *tmp2; ++tmp2) 692 if (*tmp2 == 'd' || *tmp2 == 'D') 693 *tmp2 = 'e'; 694 putithere->dval = atof (tmp); 695 free (tmp); 696 return FLOAT; 697 } 698 699 /* Handle base-switching prefixes 0x, 0t, 0d, 0 */ 700 if (p[0] == '0') 701 switch (p[1]) 702 { 703 case 'x': 704 case 'X': 705 if (len >= 3) 706 { 707 p += 2; 708 base = 16; 709 len -= 2; 710 } 711 break; 712 713 case 't': 714 case 'T': 715 case 'd': 716 case 'D': 717 if (len >= 3) 718 { 719 p += 2; 720 base = 10; 721 len -= 2; 722 } 723 break; 724 725 default: 726 base = 8; 727 break; 728 } 729 730 while (len-- > 0) 731 { 732 c = *p++; 733 if (isupper (c)) 734 c = tolower (c); 735 if (len == 0 && c == 'l') 736 long_p = 1; 737 else if (len == 0 && c == 'u') 738 unsigned_p = 1; 739 else 740 { 741 int i; 742 if (c >= '0' && c <= '9') 743 i = c - '0'; 744 else if (c >= 'a' && c <= 'f') 745 i = c - 'a' + 10; 746 else 747 return ERROR; /* Char not a digit */ 748 if (i >= base) 749 return ERROR; /* Invalid digit in this base */ 750 n *= base; 751 n += i; 752 } 753 /* Portably test for overflow (only works for nonzero values, so make 754 a second check for zero). */ 755 if ((prevn >= n) && n != 0) 756 unsigned_p=1; /* Try something unsigned */ 757 /* If range checking enabled, portably test for unsigned overflow. */ 758 if (RANGE_CHECK && n != 0) 759 { 760 if ((unsigned_p && (unsigned)prevn >= (unsigned)n)) 761 range_error (_("Overflow on numeric constant.")); 762 } 763 prevn = n; 764 } 765 766 /* If the number is too big to be an int, or it's got an l suffix 767 then it's a long. Work out if this has to be a long by 768 shifting right and and seeing if anything remains, and the 769 target int size is different to the target long size. 770 771 In the expression below, we could have tested 772 (n >> gdbarch_int_bit (parse_gdbarch)) 773 to see if it was zero, 774 but too many compilers warn about that, when ints and longs 775 are the same size. So we shift it twice, with fewer bits 776 each time, for the same result. */ 777 778 if ((gdbarch_int_bit (parse_gdbarch) != gdbarch_long_bit (parse_gdbarch) 779 && ((n >> 2) 780 >> (gdbarch_int_bit (parse_gdbarch)-2))) /* Avoid shift warning */ 781 || long_p) 782 { 783 high_bit = ((ULONGEST)1) << (gdbarch_long_bit (parse_gdbarch)-1); 784 unsigned_type = parse_type->builtin_unsigned_long; 785 signed_type = parse_type->builtin_long; 786 } 787 else 788 { 789 high_bit = ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch)-1); 790 unsigned_type = parse_type->builtin_unsigned_int; 791 signed_type = parse_type->builtin_int; 792 } 793 794 putithere->typed_val.val = n; 795 796 /* If the high bit of the worked out type is set then this number 797 has to be unsigned. */ 798 799 if (unsigned_p || (n & high_bit)) 800 putithere->typed_val.type = unsigned_type; 801 else 802 putithere->typed_val.type = signed_type; 803 804 return INT; 805 } 806 807 struct token 808 { 809 char *operator; 810 int token; 811 enum exp_opcode opcode; 812 }; 813 814 static const struct token dot_ops[] = 815 { 816 { ".and.", BOOL_AND, BINOP_END }, 817 { ".AND.", BOOL_AND, BINOP_END }, 818 { ".or.", BOOL_OR, BINOP_END }, 819 { ".OR.", BOOL_OR, BINOP_END }, 820 { ".not.", BOOL_NOT, BINOP_END }, 821 { ".NOT.", BOOL_NOT, BINOP_END }, 822 { ".eq.", EQUAL, BINOP_END }, 823 { ".EQ.", EQUAL, BINOP_END }, 824 { ".eqv.", EQUAL, BINOP_END }, 825 { ".NEQV.", NOTEQUAL, BINOP_END }, 826 { ".neqv.", NOTEQUAL, BINOP_END }, 827 { ".EQV.", EQUAL, BINOP_END }, 828 { ".ne.", NOTEQUAL, BINOP_END }, 829 { ".NE.", NOTEQUAL, BINOP_END }, 830 { ".le.", LEQ, BINOP_END }, 831 { ".LE.", LEQ, BINOP_END }, 832 { ".ge.", GEQ, BINOP_END }, 833 { ".GE.", GEQ, BINOP_END }, 834 { ".gt.", GREATERTHAN, BINOP_END }, 835 { ".GT.", GREATERTHAN, BINOP_END }, 836 { ".lt.", LESSTHAN, BINOP_END }, 837 { ".LT.", LESSTHAN, BINOP_END }, 838 { NULL, 0, 0 } 839 }; 840 841 struct f77_boolean_val 842 { 843 char *name; 844 int value; 845 }; 846 847 static const struct f77_boolean_val boolean_values[] = 848 { 849 { ".true.", 1 }, 850 { ".TRUE.", 1 }, 851 { ".false.", 0 }, 852 { ".FALSE.", 0 }, 853 { NULL, 0 } 854 }; 855 856 static const struct token f77_keywords[] = 857 { 858 { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END }, 859 { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END }, 860 { "character", CHARACTER, BINOP_END }, 861 { "integer_2", INT_S2_KEYWORD, BINOP_END }, 862 { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END }, 863 { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END }, 864 { "logical_8", LOGICAL_S8_KEYWORD, BINOP_END }, 865 { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END }, 866 { "integer", INT_KEYWORD, BINOP_END }, 867 { "logical", LOGICAL_KEYWORD, BINOP_END }, 868 { "real_16", REAL_S16_KEYWORD, BINOP_END }, 869 { "complex", COMPLEX_S8_KEYWORD, BINOP_END }, 870 { "sizeof", SIZEOF, BINOP_END }, 871 { "real_8", REAL_S8_KEYWORD, BINOP_END }, 872 { "real", REAL_KEYWORD, BINOP_END }, 873 { NULL, 0, 0 } 874 }; 875 876 /* Implementation of a dynamically expandable buffer for processing input 877 characters acquired through lexptr and building a value to return in 878 yylval. Ripped off from ch-exp.y */ 879 880 static char *tempbuf; /* Current buffer contents */ 881 static int tempbufsize; /* Size of allocated buffer */ 882 static int tempbufindex; /* Current index into buffer */ 883 884 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */ 885 886 #define CHECKBUF(size) \ 887 do { \ 888 if (tempbufindex + (size) >= tempbufsize) \ 889 { \ 890 growbuf_by_size (size); \ 891 } \ 892 } while (0); 893 894 895 /* Grow the static temp buffer if necessary, including allocating the 896 first one on demand. */ 897 898 static void 899 growbuf_by_size (count) 900 int count; 901 { 902 int growby; 903 904 growby = max (count, GROWBY_MIN_SIZE); 905 tempbufsize += growby; 906 if (tempbuf == NULL) 907 tempbuf = (char *) malloc (tempbufsize); 908 else 909 tempbuf = (char *) realloc (tempbuf, tempbufsize); 910 } 911 912 /* Blatantly ripped off from ch-exp.y. This routine recognizes F77 913 string-literals. 914 915 Recognize a string literal. A string literal is a nonzero sequence 916 of characters enclosed in matching single quotes, except that 917 a single character inside single quotes is a character literal, which 918 we reject as a string literal. To embed the terminator character inside 919 a string, it is simply doubled (I.E. 'this''is''one''string') */ 920 921 static int 922 match_string_literal (void) 923 { 924 char *tokptr = lexptr; 925 926 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++) 927 { 928 CHECKBUF (1); 929 if (*tokptr == *lexptr) 930 { 931 if (*(tokptr + 1) == *lexptr) 932 tokptr++; 933 else 934 break; 935 } 936 tempbuf[tempbufindex++] = *tokptr; 937 } 938 if (*tokptr == '\0' /* no terminator */ 939 || tempbufindex == 0) /* no string */ 940 return 0; 941 else 942 { 943 tempbuf[tempbufindex] = '\0'; 944 yylval.sval.ptr = tempbuf; 945 yylval.sval.length = tempbufindex; 946 lexptr = ++tokptr; 947 return STRING_LITERAL; 948 } 949 } 950 951 /* Read one token, getting characters through lexptr. */ 952 953 static int 954 yylex (void) 955 { 956 int c; 957 int namelen; 958 unsigned int i,token; 959 char *tokstart; 960 961 retry: 962 963 prev_lexptr = lexptr; 964 965 tokstart = lexptr; 966 967 /* First of all, let us make sure we are not dealing with the 968 special tokens .true. and .false. which evaluate to 1 and 0. */ 969 970 if (*lexptr == '.') 971 { 972 for (i = 0; boolean_values[i].name != NULL; i++) 973 { 974 if (strncmp (tokstart, boolean_values[i].name, 975 strlen (boolean_values[i].name)) == 0) 976 { 977 lexptr += strlen (boolean_values[i].name); 978 yylval.lval = boolean_values[i].value; 979 return BOOLEAN_LITERAL; 980 } 981 } 982 } 983 984 /* See if it is a special .foo. operator. */ 985 986 for (i = 0; dot_ops[i].operator != NULL; i++) 987 if (strncmp (tokstart, dot_ops[i].operator, 988 strlen (dot_ops[i].operator)) == 0) 989 { 990 lexptr += strlen (dot_ops[i].operator); 991 yylval.opcode = dot_ops[i].opcode; 992 return dot_ops[i].token; 993 } 994 995 /* See if it is an exponentiation operator. */ 996 997 if (strncmp (tokstart, "**", 2) == 0) 998 { 999 lexptr += 2; 1000 yylval.opcode = BINOP_EXP; 1001 return STARSTAR; 1002 } 1003 1004 switch (c = *tokstart) 1005 { 1006 case 0: 1007 return 0; 1008 1009 case ' ': 1010 case '\t': 1011 case '\n': 1012 lexptr++; 1013 goto retry; 1014 1015 case '\'': 1016 token = match_string_literal (); 1017 if (token != 0) 1018 return (token); 1019 break; 1020 1021 case '(': 1022 paren_depth++; 1023 lexptr++; 1024 return c; 1025 1026 case ')': 1027 if (paren_depth == 0) 1028 return 0; 1029 paren_depth--; 1030 lexptr++; 1031 return c; 1032 1033 case ',': 1034 if (comma_terminates && paren_depth == 0) 1035 return 0; 1036 lexptr++; 1037 return c; 1038 1039 case '.': 1040 /* Might be a floating point number. */ 1041 if (lexptr[1] < '0' || lexptr[1] > '9') 1042 goto symbol; /* Nope, must be a symbol. */ 1043 /* FALL THRU into number case. */ 1044 1045 case '0': 1046 case '1': 1047 case '2': 1048 case '3': 1049 case '4': 1050 case '5': 1051 case '6': 1052 case '7': 1053 case '8': 1054 case '9': 1055 { 1056 /* It's a number. */ 1057 int got_dot = 0, got_e = 0, got_d = 0, toktype; 1058 char *p = tokstart; 1059 int hex = input_radix > 10; 1060 1061 if (c == '0' && (p[1] == 'x' || p[1] == 'X')) 1062 { 1063 p += 2; 1064 hex = 1; 1065 } 1066 else if (c == '0' && (p[1]=='t' || p[1]=='T' 1067 || p[1]=='d' || p[1]=='D')) 1068 { 1069 p += 2; 1070 hex = 0; 1071 } 1072 1073 for (;; ++p) 1074 { 1075 if (!hex && !got_e && (*p == 'e' || *p == 'E')) 1076 got_dot = got_e = 1; 1077 else if (!hex && !got_d && (*p == 'd' || *p == 'D')) 1078 got_dot = got_d = 1; 1079 else if (!hex && !got_dot && *p == '.') 1080 got_dot = 1; 1081 else if (((got_e && (p[-1] == 'e' || p[-1] == 'E')) 1082 || (got_d && (p[-1] == 'd' || p[-1] == 'D'))) 1083 && (*p == '-' || *p == '+')) 1084 /* This is the sign of the exponent, not the end of the 1085 number. */ 1086 continue; 1087 /* We will take any letters or digits. parse_number will 1088 complain if past the radix, or if L or U are not final. */ 1089 else if ((*p < '0' || *p > '9') 1090 && ((*p < 'a' || *p > 'z') 1091 && (*p < 'A' || *p > 'Z'))) 1092 break; 1093 } 1094 toktype = parse_number (tokstart, p - tokstart, got_dot|got_e|got_d, 1095 &yylval); 1096 if (toktype == ERROR) 1097 { 1098 char *err_copy = (char *) alloca (p - tokstart + 1); 1099 1100 memcpy (err_copy, tokstart, p - tokstart); 1101 err_copy[p - tokstart] = 0; 1102 error (_("Invalid number \"%s\"."), err_copy); 1103 } 1104 lexptr = p; 1105 return toktype; 1106 } 1107 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 case '}': 1128 symbol: 1129 lexptr++; 1130 return c; 1131 } 1132 1133 if (!(c == '_' || c == '$' || c ==':' 1134 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'))) 1135 /* We must have come across a bad character (e.g. ';'). */ 1136 error (_("Invalid character '%c' in expression."), c); 1137 1138 namelen = 0; 1139 for (c = tokstart[namelen]; 1140 (c == '_' || c == '$' || c == ':' || (c >= '0' && c <= '9') 1141 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')); 1142 c = tokstart[++namelen]); 1143 1144 /* The token "if" terminates the expression and is NOT 1145 removed from the input stream. */ 1146 1147 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f') 1148 return 0; 1149 1150 lexptr += namelen; 1151 1152 /* Catch specific keywords. */ 1153 1154 for (i = 0; f77_keywords[i].operator != NULL; i++) 1155 if (strlen (f77_keywords[i].operator) == namelen 1156 && strncmp (tokstart, f77_keywords[i].operator, namelen) == 0) 1157 { 1158 /* lexptr += strlen(f77_keywords[i].operator); */ 1159 yylval.opcode = f77_keywords[i].opcode; 1160 return f77_keywords[i].token; 1161 } 1162 1163 yylval.sval.ptr = tokstart; 1164 yylval.sval.length = namelen; 1165 1166 if (*tokstart == '$') 1167 { 1168 write_dollar_variable (yylval.sval); 1169 return VARIABLE; 1170 } 1171 1172 /* Use token-type TYPENAME for symbols that happen to be defined 1173 currently as names of types; NAME for other symbols. 1174 The caller is not constrained to care about the distinction. */ 1175 { 1176 char *tmp = copy_name (yylval.sval); 1177 struct symbol *sym; 1178 int is_a_field_of_this = 0; 1179 int hextype; 1180 1181 sym = lookup_symbol (tmp, expression_context_block, 1182 VAR_DOMAIN, 1183 parse_language->la_language == language_cplus 1184 ? &is_a_field_of_this : NULL); 1185 if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF) 1186 { 1187 yylval.tsym.type = SYMBOL_TYPE (sym); 1188 return TYPENAME; 1189 } 1190 yylval.tsym.type 1191 = language_lookup_primitive_type_by_name (parse_language, 1192 parse_gdbarch, tmp); 1193 if (yylval.tsym.type != NULL) 1194 return TYPENAME; 1195 1196 /* Input names that aren't symbols but ARE valid hex numbers, 1197 when the input radix permits them, can be names or numbers 1198 depending on the parse. Note we support radixes > 16 here. */ 1199 if (!sym 1200 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10) 1201 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10))) 1202 { 1203 YYSTYPE newlval; /* Its value is ignored. */ 1204 hextype = parse_number (tokstart, namelen, 0, &newlval); 1205 if (hextype == INT) 1206 { 1207 yylval.ssym.sym = sym; 1208 yylval.ssym.is_a_field_of_this = is_a_field_of_this; 1209 return NAME_OR_INT; 1210 } 1211 } 1212 1213 /* Any other kind of symbol */ 1214 yylval.ssym.sym = sym; 1215 yylval.ssym.is_a_field_of_this = is_a_field_of_this; 1216 return NAME; 1217 } 1218 } 1219 1220 void 1221 yyerror (msg) 1222 char *msg; 1223 { 1224 if (prev_lexptr) 1225 lexptr = prev_lexptr; 1226 1227 error (_("A %s in expression, near `%s'."), (msg ? msg : "error"), lexptr); 1228 } 1229