1/* sta.c -- Implementation File (module.c template V1.0) 2 Copyright (C) 1995-1997 Free Software Foundation, Inc. 3 Contributed by James Craig Burley. 4 5This file is part of GNU Fortran. 6 7GNU Fortran is free software; you can redistribute it and/or modify 8it under the terms of the GNU General Public License as published by 9the Free Software Foundation; either version 2, or (at your option) 10any later version. 11 12GNU Fortran is distributed in the hope that it will be useful, 13but WITHOUT ANY WARRANTY; without even the implied warranty of 14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15GNU General Public License for more details. 16 17You should have received a copy of the GNU General Public License 18along with GNU Fortran; see the file COPYING. If not, write to 19the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA 2002111-1307, USA. 21 22 Related Modules: 23 None 24 25 Description: 26 Analyzes the first two tokens, figures out what statements are 27 possible, tries parsing the possible statements by calling on 28 the ffestb functions. 29 30 Modifications: 31*/ 32 33/* Include files. */ 34 35#include "proj.h" 36#include "sta.h" 37#include "bad.h" 38#include "implic.h" 39#include "lex.h" 40#include "malloc.h" 41#include "stb.h" 42#include "stc.h" 43#include "std.h" 44#include "str.h" 45#include "storag.h" 46#include "symbol.h" 47 48/* Externals defined here. */ 49 50ffelexToken ffesta_tokens[FFESTA_tokensMAX]; /* For use by a possible. */ 51ffestrFirst ffesta_first_kw; /* First NAME(S) looked up. */ 52ffestrSecond ffesta_second_kw; /* Second NAME(S) looked up. */ 53mallocPool ffesta_output_pool; /* Pool for results of stmt handling. */ 54mallocPool ffesta_scratch_pool; /* Pool for stmt scratch handling. */ 55ffelexToken ffesta_construct_name; 56ffelexToken ffesta_label_token; /* Pending label stuff. */ 57bool ffesta_seen_first_exec; 58bool ffesta_is_entry_valid = FALSE; /* TRUE only in SUBROUTINE/FUNCTION. */ 59bool ffesta_line_has_semicolons = FALSE; 60 61/* Simple definitions and enumerations. */ 62 63#define FFESTA_ABORT_ON_CONFIRM_ 1 /* 0=slow, tested way; 1=faster way 64 that might not always work. Here's 65 the old description of what used 66 to not work with ==1: (try 67 "CONTINUE\10 68 FORMAT('hi',I11)\END"). Problem 69 is that the "topology" of the 70 confirmed stmt's tokens with 71 regard to CHARACTER, HOLLERITH, 72 NAME/NAMES/NUMBER tokens (like hex 73 numbers), isn't traced if we abort 74 early, then other stmts might get 75 their grubby hands on those 76 unprocessed tokens and commit them 77 improperly. Ideal fix is to rerun 78 the confirmed stmt and forget the 79 rest. */ 80 81#define FFESTA_maxPOSSIBLES_ 8/* Never more than this # of possibles. */ 82 83/* Internal typedefs. */ 84 85typedef struct _ffesta_possible_ *ffestaPossible_; 86 87/* Private include files. */ 88 89 90/* Internal structure definitions. */ 91 92struct _ffesta_possible_ 93 { 94 ffestaPossible_ next; 95 ffestaPossible_ previous; 96 ffelexHandler handler; 97 bool named; 98 }; 99 100struct _ffesta_possible_root_ 101 { 102 ffestaPossible_ first; 103 ffestaPossible_ last; 104 ffelexHandler nil; 105 }; 106 107/* Static objects accessed by functions in this module. */ 108 109static bool ffesta_is_inhibited_ = FALSE; 110static ffelexToken ffesta_token_0_; /* For use by ffest possibility 111 handling. */ 112static ffestaPossible_ ffesta_possibles_[FFESTA_maxPOSSIBLES_]; 113static int ffesta_num_possibles_ = 0; /* Number of possibilities. */ 114static struct _ffesta_possible_root_ ffesta_possible_nonexecs_; 115static struct _ffesta_possible_root_ ffesta_possible_execs_; 116static ffestaPossible_ ffesta_current_possible_; 117static ffelexHandler ffesta_current_handler_; 118static bool ffesta_confirmed_current_ = FALSE; 119static bool ffesta_confirmed_other_ = FALSE; 120static ffestaPossible_ ffesta_confirmed_possible_; 121static bool ffesta_current_shutdown_ = FALSE; 122#if !FFESTA_ABORT_ON_CONFIRM_ 123static bool ffesta_is_two_into_statement_ = FALSE; /* For IF, WHERE stmts. */ 124static ffelexToken ffesta_twotokens_1_; /* For IF, WHERE stmts. */ 125static ffelexToken ffesta_twotokens_2_; /* For IF, WHERE stmts. */ 126#endif 127static ffestaPooldisp ffesta_outpooldisp_; /* After statement dealt 128 with. */ 129static bool ffesta_inhibit_confirmation_ = FALSE; 130 131/* Static functions (internal). */ 132 133static void ffesta_add_possible_ (ffelexHandler fn, bool exec, bool named); 134static bool ffesta_inhibited_exec_transition_ (void); 135static void ffesta_reset_possibles_ (void); 136static ffelexHandler ffesta_save_ (ffelexToken t); 137static ffelexHandler ffesta_second_ (ffelexToken t); 138#if !FFESTA_ABORT_ON_CONFIRM_ 139static ffelexHandler ffesta_send_two_ (ffelexToken t); 140#endif 141 142/* Internal macros. */ 143 144#define ffesta_add_possible_exec_(fn) (ffesta_add_possible_ (fn, TRUE, TRUE)) 145#define ffesta_add_possible_nonexec_(fn) (ffesta_add_possible_ (fn, FALSE, TRUE)) 146#define ffesta_add_possible_unnamed_exec_(fn) (ffesta_add_possible_ (fn, TRUE, FALSE)) 147#define ffesta_add_possible_unnamed_nonexec_(fn) (ffesta_add_possible_ (fn, FALSE, FALSE)) 148 149/* Add possible statement to appropriate list. */ 150 151static void 152ffesta_add_possible_ (ffelexHandler fn, bool exec, bool named) 153{ 154 ffestaPossible_ p; 155 156 assert (ffesta_num_possibles_ < FFESTA_maxPOSSIBLES_); 157 158 p = ffesta_possibles_[ffesta_num_possibles_++]; 159 160 if (exec) 161 { 162 p->next = (ffestaPossible_) &ffesta_possible_execs_.first; 163 p->previous = ffesta_possible_execs_.last; 164 } 165 else 166 { 167 p->next = (ffestaPossible_) &ffesta_possible_nonexecs_.first; 168 p->previous = ffesta_possible_nonexecs_.last; 169 } 170 p->next->previous = p; 171 p->previous->next = p; 172 173 p->handler = fn; 174 p->named = named; 175} 176 177/* ffesta_inhibited_exec_transition_ -- Do exec transition while inhibited 178 179 if (!ffesta_inhibited_exec_transition_()) // couldn't transition... 180 181 Invokes ffestc_exec_transition, but first enables ffebad and ffesta and 182 afterwards disables them again. Then returns the result of the 183 invocation of ffestc_exec_transition. */ 184 185static bool 186ffesta_inhibited_exec_transition_ () 187{ 188 bool result; 189 190 assert (ffebad_inhibit ()); 191 assert (ffesta_is_inhibited_); 192 193 ffebad_set_inhibit (FALSE); 194 ffesta_is_inhibited_ = FALSE; 195 196 result = ffestc_exec_transition (); 197 198 ffebad_set_inhibit (TRUE); 199 ffesta_is_inhibited_ = TRUE; 200 201 return result; 202} 203 204/* ffesta_reset_possibles_ -- Reset (clear) lists of possible statements 205 206 ffesta_reset_possibles_(); 207 208 Clears the lists of executable and nonexecutable statements. */ 209 210static void 211ffesta_reset_possibles_ () 212{ 213 ffesta_num_possibles_ = 0; 214 215 ffesta_possible_execs_.first = ffesta_possible_execs_.last 216 = (ffestaPossible_) &ffesta_possible_execs_.first; 217 ffesta_possible_nonexecs_.first = ffesta_possible_nonexecs_.last 218 = (ffestaPossible_) &ffesta_possible_nonexecs_.first; 219} 220 221/* ffesta_save_ -- Save token on list, pass thru to current handler 222 223 return ffesta_save_; // to lexer. 224 225 Receives a token from the lexer. Saves it in the list of tokens. Calls 226 the current handler with the token. 227 228 If no shutdown error occurred (via 229 ffest_ffebad_start), then if the token was EOS or SEMICOLON, mark the 230 current possible as successful and confirmed but try the next possible 231 anyway until ambiguities in the form handling are ironed out. */ 232 233static ffelexHandler 234ffesta_save_ (ffelexToken t) 235{ 236 static ffelexToken *saved_tokens = NULL; /* A variable-sized array. */ 237 static unsigned int num_saved_tokens = 0; /* Number currently saved. */ 238 static unsigned int max_saved_tokens = 0; /* Maximum to be saved. */ 239 unsigned int toknum; /* Index into saved_tokens array. */ 240 ffelexToken eos; /* EOS created on-the-fly for shutdown 241 purposes. */ 242 ffelexToken t2; /* Another temporary token (no intersect with 243 eos, btw). */ 244 245 /* Save the current token. */ 246 247 if (saved_tokens == NULL) 248 { 249 saved_tokens 250 = (ffelexToken *) malloc_new_ksr (malloc_pool_image (), 251 "FFEST Saved Tokens", 252 (max_saved_tokens = 8) * sizeof (ffelexToken)); 253 /* Start off with 8. */ 254 } 255 else if (num_saved_tokens >= max_saved_tokens) 256 { 257 toknum = max_saved_tokens; 258 max_saved_tokens <<= 1; /* Multiply by two. */ 259 assert (max_saved_tokens > toknum); 260 saved_tokens 261 = (ffelexToken *) malloc_resize_ksr (malloc_pool_image (), 262 saved_tokens, 263 max_saved_tokens * sizeof (ffelexToken), 264 toknum * sizeof (ffelexToken)); 265 } 266 267 *(saved_tokens + num_saved_tokens++) = ffelex_token_use (t); 268 269 /* Transmit the current token to the current handler. */ 270 271 ffesta_current_handler_ = (ffelexHandler) (*ffesta_current_handler_) (t); 272 273 /* See if this possible has been shut down, or confirmed in which case we 274 might as well shut it down anyway to save time. */ 275 276 if ((ffesta_current_shutdown_ || (FFESTA_ABORT_ON_CONFIRM_ 277 && ffesta_confirmed_current_)) 278 && !ffelex_expecting_character ()) 279 { 280 switch (ffelex_token_type (t)) 281 { 282 case FFELEX_typeEOS: 283 case FFELEX_typeSEMICOLON: 284 break; 285 286 default: 287 eos = ffelex_token_new_eos (ffelex_token_where_line (t), 288 ffelex_token_where_column (t)); 289 ffesta_inhibit_confirmation_ = ffesta_current_shutdown_; 290 (*ffesta_current_handler_) (eos); 291 ffesta_inhibit_confirmation_ = FALSE; 292 ffelex_token_kill (eos); 293 break; 294 } 295 } 296 else 297 { 298 299 /* If this is an EOS or SEMICOLON token, switch to next handler, else 300 return self as next handler for lexer. */ 301 302 switch (ffelex_token_type (t)) 303 { 304 case FFELEX_typeEOS: 305 case FFELEX_typeSEMICOLON: 306 break; 307 308 default: 309 return (ffelexHandler) ffesta_save_; 310 } 311 } 312 313 next_handler: /* :::::::::::::::::::: */ 314 315 /* Note that a shutdown also happens after seeing the first two tokens 316 after "IF (expr)" or "WHERE (expr)" where a statement follows, even 317 though there is no error. This causes the IF or WHERE form to be 318 implemented first before ffest_first is called for the first token in 319 the following statement. */ 320 321 if (ffesta_current_shutdown_) 322 ffesta_current_shutdown_ = FALSE; /* Only after sending EOS! */ 323 else 324 assert (ffesta_confirmed_current_); 325 326 if (ffesta_confirmed_current_) 327 { 328 ffesta_confirmed_current_ = FALSE; 329 ffesta_confirmed_other_ = TRUE; 330 } 331 332 /* Pick next handler. */ 333 334 ffesta_current_possible_ = ffesta_current_possible_->next; 335 ffesta_current_handler_ = ffesta_current_possible_->handler; 336 if (ffesta_current_handler_ == NULL) 337 { /* No handler in this list, try exec list if 338 not tried yet. */ 339 if (ffesta_current_possible_ 340 == (ffestaPossible_) &ffesta_possible_nonexecs_) 341 { 342 ffesta_current_possible_ = ffesta_possible_execs_.first; 343 ffesta_current_handler_ = ffesta_current_possible_->handler; 344 } 345 if ((ffesta_current_handler_ == NULL) 346 || (!ffesta_seen_first_exec 347 && ((ffesta_confirmed_possible_ != NULL) 348 || !ffesta_inhibited_exec_transition_ ()))) 349 /* Don't run execs if: (decoding the "if" ^^^ up here ^^^) - we 350 have no exec handler available, or - we haven't seen the first 351 executable statement yet, and - we've confirmed a nonexec 352 (otherwise even a nonexec would cause a transition), or - a 353 nonexec-to-exec transition can't be made at the statement context 354 level (as in an executable statement in the middle of a STRUCTURE 355 definition); if it can be made, ffestc_exec_transition makes the 356 corresponding transition at the statement state level so 357 specification statements are no longer accepted following an 358 unrecognized statement. (Note: it is valid for f_e_t_ to decide 359 to always return TRUE by "shrieking" away the statement state 360 stack until a transitionable state is reached. Or it can leave 361 the stack as is and return FALSE.) 362 363 If we decide not to run execs, enter this block to rerun the 364 confirmed statement, if any. */ 365 { /* At end of both lists! Pick confirmed or 366 first possible. */ 367 ffebad_set_inhibit (FALSE); 368 ffesta_is_inhibited_ = FALSE; 369 ffesta_confirmed_other_ = FALSE; 370 ffesta_tokens[0] = ffesta_token_0_; 371 if (ffesta_confirmed_possible_ == NULL) 372 { /* No confirmed success, just use first 373 named possible, or first possible if 374 no named possibles. */ 375 ffestaPossible_ possible = ffesta_possible_nonexecs_.first; 376 ffestaPossible_ first = NULL; 377 ffestaPossible_ first_named = NULL; 378 ffestaPossible_ first_exec = NULL; 379 380 for (;;) 381 { 382 if (possible->handler == NULL) 383 { 384 if (possible == (ffestaPossible_) &ffesta_possible_nonexecs_) 385 { 386 possible = first_exec = ffesta_possible_execs_.first; 387 continue; 388 } 389 else 390 break; 391 } 392 if (first == NULL) 393 first = possible; 394 if (possible->named 395 && (first_named == NULL)) 396 first_named = possible; 397 398 possible = possible->next; 399 } 400 401 if (first_named != NULL) 402 ffesta_current_possible_ = first_named; 403 else if (ffesta_seen_first_exec 404 && (first_exec != NULL)) 405 ffesta_current_possible_ = first_exec; 406 else 407 ffesta_current_possible_ = first; 408 409 ffesta_current_handler_ = ffesta_current_possible_->handler; 410 assert (ffesta_current_handler_ != NULL); 411 } 412 else 413 { /* Confirmed success, use it. */ 414 ffesta_current_possible_ = ffesta_confirmed_possible_; 415 ffesta_current_handler_ = ffesta_confirmed_possible_->handler; 416 } 417 ffesta_reset_possibles_ (); 418 } 419 else 420 { /* Switching from [empty?] list of nonexecs 421 to nonempty list of execs at this point. */ 422 ffesta_tokens[0] = ffelex_token_use (ffesta_token_0_); 423 ffesymbol_set_retractable (ffesta_scratch_pool); 424 } 425 } 426 else 427 { 428 ffesta_tokens[0] = ffelex_token_use (ffesta_token_0_); 429 ffesymbol_set_retractable (ffesta_scratch_pool); 430 } 431 432 /* Send saved tokens to current handler until either shut down or all 433 tokens sent. */ 434 435 for (toknum = 0; toknum < num_saved_tokens; ++toknum) 436 { 437 t = *(saved_tokens + toknum); 438 switch (ffelex_token_type (t)) 439 { 440 case FFELEX_typeCHARACTER: 441 ffelex_set_expecting_hollerith (0, '\0', 442 ffewhere_line_unknown (), 443 ffewhere_column_unknown ()); 444 ffesta_current_handler_ 445 = (ffelexHandler) (*ffesta_current_handler_) (t); 446 break; 447 448 case FFELEX_typeNAMES: 449 if (ffelex_is_names_expected ()) 450 ffesta_current_handler_ 451 = (ffelexHandler) (*ffesta_current_handler_) (t); 452 else 453 { 454 t2 = ffelex_token_name_from_names (t, 0, 0); 455 ffesta_current_handler_ 456 = (ffelexHandler) (*ffesta_current_handler_) (t2); 457 ffelex_token_kill (t2); 458 } 459 break; 460 461 default: 462 ffesta_current_handler_ 463 = (ffelexHandler) (*ffesta_current_handler_) (t); 464 break; 465 } 466 467 if (!ffesta_is_inhibited_) 468 ffelex_token_kill (t); /* Won't need this any more. */ 469 470 /* See if this possible has been shut down. */ 471 472 else if ((ffesta_current_shutdown_ || (FFESTA_ABORT_ON_CONFIRM_ 473 && ffesta_confirmed_current_)) 474 && !ffelex_expecting_character ()) 475 { 476 switch (ffelex_token_type (t)) 477 { 478 case FFELEX_typeEOS: 479 case FFELEX_typeSEMICOLON: 480 break; 481 482 default: 483 eos = ffelex_token_new_eos (ffelex_token_where_line (t), 484 ffelex_token_where_column (t)); 485 ffesta_inhibit_confirmation_ = ffesta_current_shutdown_; 486 (*ffesta_current_handler_) (eos); 487 ffesta_inhibit_confirmation_ = FALSE; 488 ffelex_token_kill (eos); 489 break; 490 } 491 goto next_handler; /* :::::::::::::::::::: */ 492 } 493 } 494 495 /* Finished sending all the tokens so far. If still trying possibilities, 496 then if we've just sent an EOS or SEMICOLON token through, go to the 497 next handler. Otherwise, return self so we can gather and process more 498 tokens. */ 499 500 if (ffesta_is_inhibited_) 501 { 502 switch (ffelex_token_type (t)) 503 { 504 case FFELEX_typeEOS: 505 case FFELEX_typeSEMICOLON: 506 goto next_handler; /* :::::::::::::::::::: */ 507 508 default: 509#if FFESTA_ABORT_ON_CONFIRM_ 510 assert (!ffesta_confirmed_other_); /* Catch ambiguities. */ 511#endif 512 return (ffelexHandler) ffesta_save_; 513 } 514 } 515 516 /* This was the one final possibility, uninhibited, so send the final 517 handler it sent. */ 518 519 num_saved_tokens = 0; 520#if !FFESTA_ABORT_ON_CONFIRM_ 521 if (ffesta_is_two_into_statement_) 522 { /* End of the line for the previous two 523 tokens, resurrect them. */ 524 ffelexHandler next; 525 526 ffesta_is_two_into_statement_ = FALSE; 527 next = (ffelexHandler) ffesta_first (ffesta_twotokens_1_); 528 ffelex_token_kill (ffesta_twotokens_1_); 529 next = (ffelexHandler) (*next) (ffesta_twotokens_2_); 530 ffelex_token_kill (ffesta_twotokens_2_); 531 return (ffelexHandler) next; 532 } 533#endif 534 535 assert (ffesta_current_handler_ != NULL); 536 return (ffelexHandler) ffesta_current_handler_; 537} 538 539/* ffesta_second_ -- Parse the token after a NAME/NAMES in a statement 540 541 return ffesta_second_; // to lexer. 542 543 The second token cannot be a NAMES, since the first token is a NAME or 544 NAMES. If the second token is a NAME, look up its name in the list of 545 second names for use by whoever needs it. 546 547 Then make a list of all the possible statements this could be, based on 548 looking at the first two tokens. Two lists of possible statements are 549 created, one consisting of nonexecutable statements, the other consisting 550 of executable statements. 551 552 If the total number of possibilities is one, just fire up that 553 possibility by calling its handler function, passing the first two 554 tokens through it and so on. 555 556 Otherwise, start up a process whereby tokens are passed to the first 557 possibility on the list until EOS or SEMICOLON is reached or an error 558 is detected. But inhibit any actual reporting of errors; just record 559 their existence in the list. If EOS or SEMICOLON is reached with no 560 errors (other than non-form errors happening downstream, such as an 561 overflowing value for an integer or a GOTO statement identifying a label 562 on a FORMAT statement), then that is the only possible statement. Rerun 563 the statement with error-reporting turned on if any non-form errors were 564 generated, otherwise just use its results, then erase the list of tokens 565 memorized during the search process. If a form error occurs, immediately 566 cancel that possibility by sending EOS as the next token, remember the 567 error code for that possibility, and try the next possibility on the list, 568 first sending it the list of tokens memorized while handling the first 569 possibility, then continuing on as before. 570 571 Ultimately, either the end of the list of possibilities will be reached 572 without any successful forms being detected, in which case we pick one 573 based on hueristics (usually the first possibility) and rerun it with 574 error reporting turned on using the list of memorized tokens so the user 575 sees the error, or one of the possibilities will effectively succeed. */ 576 577static ffelexHandler 578ffesta_second_ (ffelexToken t) 579{ 580 ffelexHandler next; 581 ffesymbol s; 582 583 assert (ffelex_token_type (t) != FFELEX_typeNAMES); 584 585 if (ffelex_token_type (t) == FFELEX_typeNAME) 586 ffesta_second_kw = ffestr_second (t); 587 588 /* Here we use switch on the first keyword name and handle each possible 589 recognizable name by looking at the second token, and building the list 590 of possible names accordingly. For now, just put every possible 591 statement on the list for ambiguity checking. */ 592 593 switch (ffesta_first_kw) 594 { 595#if FFESTR_VXT 596 case FFESTR_firstACCEPT: 597 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V019); 598 break; 599#endif 600 601#if FFESTR_F90 602 case FFESTR_firstALLOCATABLE: 603 ffestb_args.dimlist.len = FFESTR_firstlALLOCATABLE; 604 ffestb_args.dimlist.badname = "ALLOCATABLE"; 605 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dimlist); 606 break; 607#endif 608 609#if FFESTR_F90 610 case FFESTR_firstALLOCATE: 611 ffestb_args.heap.len = FFESTR_firstlALLOCATE; 612 ffestb_args.heap.badname = "ALLOCATE"; 613 ffestb_args.heap.ctx = FFEEXPR_contextALLOCATE; 614 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_heap); 615 break; 616#endif 617 618 case FFESTR_firstASSIGN: 619 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R838); 620 break; 621 622 case FFESTR_firstBACKSPACE: 623 ffestb_args.beru.len = FFESTR_firstlBACKSPACE; 624 ffestb_args.beru.badname = "BACKSPACE"; 625 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_beru); 626 break; 627 628 case FFESTR_firstBLOCK: 629 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_block); 630 break; 631 632 case FFESTR_firstBLOCKDATA: 633 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_blockdata); 634 break; 635 636 case FFESTR_firstBYTE: 637 ffestb_args.decl.len = FFESTR_firstlBYTE; 638 ffestb_args.decl.type = FFESTP_typeBYTE; 639 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype); 640 break; 641 642 case FFESTR_firstCALL: 643 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R1212); 644 break; 645 646 case FFESTR_firstCASE: 647 case FFESTR_firstCASEDEFAULT: 648 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R810); 649 break; 650 651 case FFESTR_firstCHRCTR: 652 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_chartype); 653 break; 654 655 case FFESTR_firstCLOSE: 656 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R907); 657 break; 658 659 case FFESTR_firstCOMMON: 660 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R547); 661 break; 662 663 case FFESTR_firstCMPLX: 664 ffestb_args.decl.len = FFESTR_firstlCMPLX; 665 ffestb_args.decl.type = FFESTP_typeCOMPLEX; 666 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype); 667 break; 668 669#if FFESTR_F90 670 case FFESTR_firstCONTAINS: 671 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R1228); 672 break; 673#endif 674 675 case FFESTR_firstCONTINUE: 676 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R841); 677 break; 678 679 case FFESTR_firstCYCLE: 680 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R834); 681 break; 682 683 case FFESTR_firstDATA: 684 if (ffe_is_pedantic_not_90 ()) 685 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R528); 686 else 687 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R528); 688 break; 689 690#if FFESTR_F90 691 case FFESTR_firstDEALLOCATE: 692 ffestb_args.heap.len = FFESTR_firstlDEALLOCATE; 693 ffestb_args.heap.badname = "DEALLOCATE"; 694 ffestb_args.heap.ctx = FFEEXPR_contextDEALLOCATE; 695 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_heap); 696 break; 697#endif 698 699#if FFESTR_VXT 700 case FFESTR_firstDECODE: 701 ffestb_args.vxtcode.len = FFESTR_firstlDECODE; 702 ffestb_args.vxtcode.badname = "DECODE"; 703 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_vxtcode); 704 break; 705#endif 706 707#if FFESTR_VXT 708 case FFESTR_firstDEFINEFILE: 709 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V025); 710 break; 711 712 case FFESTR_firstDELETE: 713 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V021); 714 break; 715#endif 716 case FFESTR_firstDIMENSION: 717 ffestb_args.R524.len = FFESTR_firstlDIMENSION; 718 ffestb_args.R524.badname = "DIMENSION"; 719 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R524); 720 break; 721 722 case FFESTR_firstDO: 723 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_do); 724 break; 725 726 case FFESTR_firstDBL: 727 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_double); 728 break; 729 730 case FFESTR_firstDBLCMPLX: 731 ffestb_args.decl.len = FFESTR_firstlDBLCMPLX; 732 ffestb_args.decl.type = FFESTP_typeDBLCMPLX; 733 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_dbltype); 734 break; 735 736 case FFESTR_firstDBLPRCSN: 737 ffestb_args.decl.len = FFESTR_firstlDBLPRCSN; 738 ffestb_args.decl.type = FFESTP_typeDBLPRCSN; 739 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_dbltype); 740 break; 741 742 case FFESTR_firstDOWHILE: 743 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_dowhile); 744 break; 745 746 case FFESTR_firstELSE: 747 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_else); 748 break; 749 750 case FFESTR_firstELSEIF: 751 ffestb_args.elsexyz.second = FFESTR_secondIF; 752 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_elsexyz); 753 break; 754 755#if FFESTR_F90 756 case FFESTR_firstELSEWHERE: 757 ffestb_args.elsexyz.second = FFESTR_secondWHERE; 758 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_elsexyz); 759 break; 760#endif 761 762#if FFESTR_VXT 763 case FFESTR_firstENCODE: 764 ffestb_args.vxtcode.len = FFESTR_firstlENCODE; 765 ffestb_args.vxtcode.badname = "ENCODE"; 766 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_vxtcode); 767 break; 768#endif 769 770 case FFESTR_firstEND: 771 if ((ffelex_token_type (ffesta_token_0_) == FFELEX_typeNAMES) 772 || (ffelex_token_type (t) != FFELEX_typeNAME)) 773 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_end); 774 else 775 { 776 switch (ffesta_second_kw) 777 { 778 case FFESTR_secondBLOCK: 779 case FFESTR_secondBLOCKDATA: 780 case FFESTR_secondDO: 781 case FFESTR_secondFILE: 782 case FFESTR_secondFUNCTION: 783 case FFESTR_secondIF: 784#if FFESTR_F90 785 case FFESTR_secondMODULE: 786#endif 787 case FFESTR_secondPROGRAM: 788 case FFESTR_secondSELECT: 789 case FFESTR_secondSUBROUTINE: 790#if FFESTR_F90 791 case FFESTR_secondWHERE: 792#endif 793 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_end); 794 break; 795 796 default: 797 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_end); 798 break; 799 } 800 } 801 break; 802 803 case FFESTR_firstENDBLOCK: 804 ffestb_args.endxyz.len = FFESTR_firstlENDBLOCK; 805 ffestb_args.endxyz.second = FFESTR_secondBLOCK; 806 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz); 807 break; 808 809 case FFESTR_firstENDBLOCKDATA: 810 ffestb_args.endxyz.len = FFESTR_firstlENDBLOCKDATA; 811 ffestb_args.endxyz.second = FFESTR_secondBLOCKDATA; 812 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz); 813 break; 814 815 case FFESTR_firstENDDO: 816 ffestb_args.endxyz.len = FFESTR_firstlENDDO; 817 ffestb_args.endxyz.second = FFESTR_secondDO; 818 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz); 819 break; 820 821 case FFESTR_firstENDFILE: 822 ffestb_args.beru.len = FFESTR_firstlENDFILE; 823 ffestb_args.beru.badname = "ENDFILE"; 824 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_beru); 825 break; 826 827 case FFESTR_firstENDFUNCTION: 828 ffestb_args.endxyz.len = FFESTR_firstlENDFUNCTION; 829 ffestb_args.endxyz.second = FFESTR_secondFUNCTION; 830 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz); 831 break; 832 833 case FFESTR_firstENDIF: 834 ffestb_args.endxyz.len = FFESTR_firstlENDIF; 835 ffestb_args.endxyz.second = FFESTR_secondIF; 836 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz); 837 break; 838 839#if FFESTR_F90 840 case FFESTR_firstENDINTERFACE: 841 ffestb_args.endxyz.len = FFESTR_firstlENDINTERFACE; 842 ffestb_args.endxyz.second = FFESTR_secondINTERFACE; 843 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz); 844 break; 845#endif 846 847#if FFESTR_VXT 848 case FFESTR_firstENDMAP: 849 ffestb_args.endxyz.len = FFESTR_firstlENDMAP; 850 ffestb_args.endxyz.second = FFESTR_secondMAP; 851 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz); 852 break; 853#endif 854 855#if FFESTR_F90 856 case FFESTR_firstENDMODULE: 857 ffestb_args.endxyz.len = FFESTR_firstlENDMODULE; 858 ffestb_args.endxyz.second = FFESTR_secondMODULE; 859 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz); 860 break; 861#endif 862 863 case FFESTR_firstENDPROGRAM: 864 ffestb_args.endxyz.len = FFESTR_firstlENDPROGRAM; 865 ffestb_args.endxyz.second = FFESTR_secondPROGRAM; 866 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz); 867 break; 868 869 case FFESTR_firstENDSELECT: 870 ffestb_args.endxyz.len = FFESTR_firstlENDSELECT; 871 ffestb_args.endxyz.second = FFESTR_secondSELECT; 872 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz); 873 break; 874 875#if FFESTR_VXT 876 case FFESTR_firstENDSTRUCTURE: 877 ffestb_args.endxyz.len = FFESTR_firstlENDSTRUCTURE; 878 ffestb_args.endxyz.second = FFESTR_secondSTRUCTURE; 879 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz); 880 break; 881#endif 882 883 case FFESTR_firstENDSUBROUTINE: 884 ffestb_args.endxyz.len = FFESTR_firstlENDSUBROUTINE; 885 ffestb_args.endxyz.second = FFESTR_secondSUBROUTINE; 886 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz); 887 break; 888 889#if FFESTR_F90 890 case FFESTR_firstENDTYPE: 891 ffestb_args.endxyz.len = FFESTR_firstlENDTYPE; 892 ffestb_args.endxyz.second = FFESTR_secondTYPE; 893 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz); 894 break; 895#endif 896 897#if FFESTR_VXT 898 case FFESTR_firstENDUNION: 899 ffestb_args.endxyz.len = FFESTR_firstlENDUNION; 900 ffestb_args.endxyz.second = FFESTR_secondUNION; 901 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz); 902 break; 903#endif 904 905#if FFESTR_F90 906 case FFESTR_firstENDWHERE: 907 ffestb_args.endxyz.len = FFESTR_firstlENDWHERE; 908 ffestb_args.endxyz.second = FFESTR_secondWHERE; 909 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz); 910 break; 911#endif 912 913 case FFESTR_firstENTRY: 914 ffestb_args.dummy.len = FFESTR_firstlENTRY; 915 ffestb_args.dummy.badname = "ENTRY"; 916 ffestb_args.dummy.is_subr = ffestc_is_entry_in_subr (); 917 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dummy); 918 break; 919 920 case FFESTR_firstEQUIVALENCE: 921 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R544); 922 break; 923 924 case FFESTR_firstEXIT: 925 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R835); 926 break; 927 928 case FFESTR_firstEXTERNAL: 929 ffestb_args.varlist.len = FFESTR_firstlEXTERNAL; 930 ffestb_args.varlist.badname = "EXTERNAL"; 931 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist); 932 break; 933 934#if FFESTR_VXT 935 case FFESTR_firstFIND: 936 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V026); 937 break; 938#endif 939 940 /* WARNING: don't put anything that might cause an item to precede 941 FORMAT in the list of possible statements (it's added below) without 942 making sure FORMAT still is first. It has to run with 943 ffelex_set_names_pure(TRUE), to make sure the lexer delivers NAMES 944 tokens. */ 945 946 case FFESTR_firstFORMAT: 947 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R1001); 948 break; 949 950 case FFESTR_firstFUNCTION: 951 ffestb_args.dummy.len = FFESTR_firstlFUNCTION; 952 ffestb_args.dummy.badname = "FUNCTION"; 953 ffestb_args.dummy.is_subr = FALSE; 954 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dummy); 955 break; 956 957 case FFESTR_firstGOTO: 958 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_goto); 959 break; 960 961 case FFESTR_firstIF: 962 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_if); 963 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R840); 964 break; 965 966 case FFESTR_firstIMPLICIT: 967 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_R539); 968 break; 969 970 case FFESTR_firstINCLUDE: 971 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_S3P4); 972 switch (ffelex_token_type (t)) 973 { 974 case FFELEX_typeNUMBER: 975 case FFELEX_typeNAME: 976 case FFELEX_typeAPOSTROPHE: 977 case FFELEX_typeQUOTE: 978 break; 979 980 default: 981 break; 982 } 983 break; 984 985 case FFESTR_firstINQUIRE: 986 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R923); 987 break; 988 989 case FFESTR_firstINTGR: 990 ffestb_args.decl.len = FFESTR_firstlINTGR; 991 ffestb_args.decl.type = FFESTP_typeINTEGER; 992 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype); 993 break; 994 995#if FFESTR_F90 996 case FFESTR_firstINTENT: 997 ffestb_args.varlist.len = FFESTR_firstlINTENT; 998 ffestb_args.varlist.badname = "INTENT"; 999 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist); 1000 break; 1001#endif 1002 1003#if FFESTR_F90 1004 case FFESTR_firstINTERFACE: 1005 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R1202); 1006 break; 1007#endif 1008 1009 case FFESTR_firstINTRINSIC: 1010 ffestb_args.varlist.len = FFESTR_firstlINTRINSIC; 1011 ffestb_args.varlist.badname = "INTRINSIC"; 1012 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist); 1013 break; 1014 1015 case FFESTR_firstLGCL: 1016 ffestb_args.decl.len = FFESTR_firstlLGCL; 1017 ffestb_args.decl.type = FFESTP_typeLOGICAL; 1018 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype); 1019 break; 1020 1021#if FFESTR_VXT 1022 case FFESTR_firstMAP: 1023 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V012); 1024 break; 1025#endif 1026 1027#if FFESTR_F90 1028 case FFESTR_firstMODULE: 1029 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_module); 1030 break; 1031#endif 1032 1033 case FFESTR_firstNAMELIST: 1034 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R542); 1035 break; 1036 1037#if FFESTR_F90 1038 case FFESTR_firstNULLIFY: 1039 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R624); 1040 break; 1041#endif 1042 1043 case FFESTR_firstOPEN: 1044 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R904); 1045 break; 1046 1047#if FFESTR_F90 1048 case FFESTR_firstOPTIONAL: 1049 ffestb_args.varlist.len = FFESTR_firstlOPTIONAL; 1050 ffestb_args.varlist.badname = "OPTIONAL"; 1051 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist); 1052 break; 1053#endif 1054 1055 case FFESTR_firstPARAMETER: 1056 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R537); 1057 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V027); 1058 break; 1059 1060 case FFESTR_firstPAUSE: 1061 ffestb_args.halt.len = FFESTR_firstlPAUSE; 1062 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_halt); 1063 break; 1064 1065#if FFESTR_F90 1066 case FFESTR_firstPOINTER: 1067 ffestb_args.dimlist.len = FFESTR_firstlPOINTER; 1068 ffestb_args.dimlist.badname = "POINTER"; 1069 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dimlist); 1070 break; 1071#endif 1072 1073 case FFESTR_firstPRINT: 1074 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R911); 1075 break; 1076 1077#if HARD_F90 1078 case FFESTR_firstPRIVATE: 1079 ffestb_args.varlist.len = FFESTR_firstlPRIVATE; 1080 ffestb_args.varlist.badname = "ACCESS"; 1081 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist); 1082 break; 1083#endif 1084 1085 case FFESTR_firstPROGRAM: 1086 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R1102); 1087 break; 1088 1089#if HARD_F90 1090 case FFESTR_firstPUBLIC: 1091 ffestb_args.varlist.len = FFESTR_firstlPUBLIC; 1092 ffestb_args.varlist.badname = "ACCESS"; 1093 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist); 1094 break; 1095#endif 1096 1097 case FFESTR_firstREAD: 1098 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R909); 1099 break; 1100 1101 case FFESTR_firstREAL: 1102 ffestb_args.decl.len = FFESTR_firstlREAL; 1103 ffestb_args.decl.type = FFESTP_typeREAL; 1104 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype); 1105 break; 1106 1107#if FFESTR_VXT 1108 case FFESTR_firstRECORD: 1109 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V016); 1110 break; 1111#endif 1112 1113#if FFESTR_F90 1114 case FFESTR_firstRECURSIVE: 1115 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_recursive); 1116 break; 1117#endif 1118 1119 case FFESTR_firstRETURN: 1120 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R1227); 1121 break; 1122 1123 case FFESTR_firstREWIND: 1124 ffestb_args.beru.len = FFESTR_firstlREWIND; 1125 ffestb_args.beru.badname = "REWIND"; 1126 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_beru); 1127 break; 1128 1129#if FFESTR_VXT 1130 case FFESTR_firstREWRITE: 1131 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V018); 1132 break; 1133#endif 1134 1135 case FFESTR_firstSAVE: 1136 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R522); 1137 break; 1138 1139 case FFESTR_firstSELECT: 1140 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R809); 1141 break; 1142 1143 case FFESTR_firstSELECTCASE: 1144 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R809); 1145 break; 1146 1147#if HARD_F90 1148 case FFESTR_firstSEQUENCE: 1149 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R423B); 1150 break; 1151#endif 1152 1153 case FFESTR_firstSTOP: 1154 ffestb_args.halt.len = FFESTR_firstlSTOP; 1155 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_halt); 1156 break; 1157 1158#if FFESTR_VXT 1159 case FFESTR_firstSTRUCTURE: 1160 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V003); 1161 break; 1162#endif 1163 1164 case FFESTR_firstSUBROUTINE: 1165 ffestb_args.dummy.len = FFESTR_firstlSUBROUTINE; 1166 ffestb_args.dummy.badname = "SUBROUTINE"; 1167 ffestb_args.dummy.is_subr = TRUE; 1168 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dummy); 1169 break; 1170 1171#if FFESTR_F90 1172 case FFESTR_firstTARGET: 1173 ffestb_args.dimlist.len = FFESTR_firstlTARGET; 1174 ffestb_args.dimlist.badname = "TARGET"; 1175 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dimlist); 1176 break; 1177#endif 1178 1179 case FFESTR_firstTYPE: 1180 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V020); 1181 break; 1182 1183#if FFESTR_F90 1184 case FFESTR_firstTYPE: 1185 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_type); 1186 break; 1187#endif 1188 1189#if HARD_F90 1190 case FFESTR_firstTYPE: 1191 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_typetype); 1192 break; 1193#endif 1194 1195#if FFESTR_VXT 1196 case FFESTR_firstUNLOCK: 1197 ffestb_args.beru.len = FFESTR_firstlUNLOCK; 1198 ffestb_args.beru.badname = "UNLOCK"; 1199 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_beru); 1200 break; 1201#endif 1202 1203#if FFESTR_VXT 1204 case FFESTR_firstUNION: 1205 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V009); 1206 break; 1207#endif 1208 1209#if FFESTR_F90 1210 case FFESTR_firstUSE: 1211 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R1107); 1212 break; 1213#endif 1214 1215 case FFESTR_firstVIRTUAL: 1216 ffestb_args.R524.len = FFESTR_firstlVIRTUAL; 1217 ffestb_args.R524.badname = "VIRTUAL"; 1218 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R524); 1219 break; 1220 1221 case FFESTR_firstVOLATILE: 1222 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V014); 1223 break; 1224 1225#if HARD_F90 1226 case FFESTR_firstWHERE: 1227 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_where); 1228 break; 1229#endif 1230 1231 case FFESTR_firstWORD: 1232 ffestb_args.decl.len = FFESTR_firstlWORD; 1233 ffestb_args.decl.type = FFESTP_typeWORD; 1234 ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype); 1235 break; 1236 1237 case FFESTR_firstWRITE: 1238 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R910); 1239 break; 1240 1241 default: 1242 break; 1243 } 1244 1245 /* Now check the default cases, which are always "live" (meaning that no 1246 other possibility can override them). These are where the second token 1247 is OPEN_PAREN, PERCENT, EQUALS, POINTS, or COLON. */ 1248 1249 switch (ffelex_token_type (t)) 1250 { 1251 case FFELEX_typeOPEN_PAREN: 1252 s = ffesymbol_lookup_local (ffesta_token_0_); 1253 if (((s == NULL) || (ffesymbol_dims (s) == NULL)) 1254 && !ffesta_seen_first_exec) 1255 { /* Not known as array; may be stmt function. */ 1256 ffesta_add_possible_unnamed_nonexec_ ((ffelexHandler) ffestb_R1229); 1257 1258 /* If the symbol is (or will be due to implicit typing) of 1259 CHARACTER type, then the statement might be an assignment 1260 statement. If so, since it can't be a function invocation nor 1261 an array element reference, the open paren following the symbol 1262 name must be followed by an expression and a colon. Without the 1263 colon (which cannot appear in a stmt function definition), the 1264 let stmt rejects. So CHARACTER_NAME(...)=expr, unlike any other 1265 type, is not ambiguous alone. */ 1266 1267 if (ffeimplic_peek_symbol_type (s, 1268 ffelex_token_text (ffesta_token_0_)) 1269 == FFEINFO_basictypeCHARACTER) 1270 ffesta_add_possible_unnamed_exec_ ((ffelexHandler) ffestb_let); 1271 } 1272 else /* Not statement function if known as an 1273 array. */ 1274 ffesta_add_possible_unnamed_exec_ ((ffelexHandler) ffestb_let); 1275 break; 1276 1277#if FFESTR_F90 1278 case FFELEX_typePERCENT: 1279#endif 1280 case FFELEX_typeEQUALS: 1281#if FFESTR_F90 1282 case FFELEX_typePOINTS: 1283#endif 1284 ffesta_add_possible_unnamed_exec_ ((ffelexHandler) ffestb_let); 1285 break; 1286 1287 case FFELEX_typeCOLON: 1288 ffesta_add_possible_exec_ ((ffelexHandler) ffestb_construct); 1289 break; 1290 1291 default: 1292 ; 1293 } 1294 1295 /* Now see how many possibilities are on the list. */ 1296 1297 switch (ffesta_num_possibles_) 1298 { 1299 case 0: /* None, so invalid statement. */ 1300 no_stmts: /* :::::::::::::::::::: */ 1301 ffesta_tokens[0] = ffesta_token_0_; 1302 ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_token_0_, t); 1303 next = (ffelexHandler) ffelex_swallow_tokens (NULL, 1304 (ffelexHandler) ffesta_zero); 1305 break; 1306 1307 case 1: /* One, so just do it! */ 1308 ffesta_tokens[0] = ffesta_token_0_; 1309 next = ffesta_possible_execs_.first->handler; 1310 if (next == NULL) 1311 { /* Have a nonexec stmt. */ 1312 next = ffesta_possible_nonexecs_.first->handler; 1313 assert (next != NULL); 1314 } 1315 else if (ffesta_seen_first_exec) 1316 ; /* Have an exec stmt after exec transition. */ 1317 else if (!ffestc_exec_transition ()) 1318 /* 1 exec stmt only, but not valid in context, so pretend as though 1319 statement is unrecognized. */ 1320 goto no_stmts; /* :::::::::::::::::::: */ 1321 break; 1322 1323 default: /* More than one, so try them in order. */ 1324 ffesta_confirmed_possible_ = NULL; 1325 ffesta_current_possible_ = ffesta_possible_nonexecs_.first; 1326 ffesta_current_handler_ = ffesta_current_possible_->handler; 1327 if (ffesta_current_handler_ == NULL) 1328 { 1329 ffesta_current_possible_ = ffesta_possible_execs_.first; 1330 ffesta_current_handler_ = ffesta_current_possible_->handler; 1331 assert (ffesta_current_handler_ != NULL); 1332 if (!ffesta_seen_first_exec) 1333 { /* Need to do exec transition now. */ 1334 ffesta_tokens[0] = ffesta_token_0_; 1335 if (!ffestc_exec_transition ()) 1336 goto no_stmts; /* :::::::::::::::::::: */ 1337 } 1338 } 1339 ffesta_tokens[0] = ffelex_token_use (ffesta_token_0_); 1340 next = (ffelexHandler) ffesta_save_; 1341 ffebad_set_inhibit (TRUE); 1342 ffesta_is_inhibited_ = TRUE; 1343 break; 1344 } 1345 1346 ffesta_output_pool 1347 = malloc_pool_new ("Statement Output", ffe_pool_program_unit (), 1024); 1348 ffesta_scratch_pool 1349 = malloc_pool_new ("Statement Scratch", ffe_pool_program_unit (), 1024); 1350 ffesta_outpooldisp_ = FFESTA_pooldispDISCARD; 1351 1352 if (ffesta_is_inhibited_) 1353 ffesymbol_set_retractable (ffesta_scratch_pool); 1354 1355 ffelex_set_names (FALSE); /* Most handlers will want this. If not, 1356 they have to set it TRUE again (its value 1357 at the beginning of a statement). */ 1358 1359 return (ffelexHandler) (*next) (t); 1360} 1361 1362/* ffesta_send_two_ -- Send the two tokens saved by ffesta_two after all 1363 1364 return ffesta_send_two_; // to lexer. 1365 1366 Currently, if this function gets called, it means that the two tokens 1367 saved by ffesta_two did not have their handlers derailed by 1368 ffesta_save_, which probably means they weren't sent by ffesta_save_ 1369 but directly by the lexer, which probably means the original statement 1370 (which should be IF (expr) or WHERE (expr)) somehow evaluated to only 1371 one possibility in ffesta_second_ or somebody optimized FFEST to 1372 immediately revert to one possibility upon confirmation but forgot to 1373 change this function (and thus perhaps the entire resubmission 1374 mechanism). */ 1375 1376#if !FFESTA_ABORT_ON_CONFIRM_ 1377static ffelexHandler 1378ffesta_send_two_ (ffelexToken t) 1379{ 1380 assert ("what am I doing here?" == NULL); 1381 return NULL; 1382} 1383 1384#endif 1385/* ffesta_confirmed -- Confirm current possibility as only one 1386 1387 ffesta_confirmed(); 1388 1389 Sets the confirmation flag. During debugging for ambiguous constructs, 1390 asserts that the confirmation flag for a previous possibility has not 1391 yet been set. */ 1392 1393void 1394ffesta_confirmed () 1395{ 1396 if (ffesta_inhibit_confirmation_) 1397 return; 1398 ffesta_confirmed_current_ = TRUE; 1399 assert (!ffesta_confirmed_other_ 1400 || (ffesta_confirmed_possible_ == ffesta_current_possible_)); 1401 ffesta_confirmed_possible_ = ffesta_current_possible_; 1402} 1403 1404/* ffesta_eof -- End of (non-INCLUDEd) source file 1405 1406 ffesta_eof(); 1407 1408 Call after piping tokens through ffest_first, where the most recent 1409 token sent through must be EOS. 1410 1411 20-Feb-91 JCB 1.1 1412 Put new EOF token in ffesta_tokens[0], not NULL, because too much 1413 code expects something there for error reporting and the like. Also, 1414 do basically the same things ffest_second and ffesta_zero do for 1415 processing a statement (make and destroy pools, et cetera). */ 1416 1417void 1418ffesta_eof () 1419{ 1420 ffesta_tokens[0] = ffelex_token_new_eof (); 1421 1422 ffesta_output_pool 1423 = malloc_pool_new ("Statement Output", ffe_pool_program_unit (), 1024); 1424 ffesta_scratch_pool 1425 = malloc_pool_new ("Statement Scratch", ffe_pool_program_unit (), 1024); 1426 ffesta_outpooldisp_ = FFESTA_pooldispDISCARD; 1427 1428 ffestc_eof (); 1429 1430 if (ffesta_tokens[0] != NULL) 1431 ffelex_token_kill (ffesta_tokens[0]); 1432 1433 if (ffesta_output_pool != NULL) 1434 { 1435 if (ffesta_outpooldisp_ == FFESTA_pooldispDISCARD) 1436 malloc_pool_kill (ffesta_output_pool); 1437 ffesta_output_pool = NULL; 1438 } 1439 1440 if (ffesta_scratch_pool != NULL) 1441 { 1442 malloc_pool_kill (ffesta_scratch_pool); 1443 ffesta_scratch_pool = NULL; 1444 } 1445 1446 if (ffesta_label_token != NULL) 1447 { 1448 ffelex_token_kill (ffesta_label_token); 1449 ffesta_label_token = NULL; 1450 } 1451 1452 if (ffe_is_ffedebug ()) 1453 { 1454 ffestorag_report (); 1455#if FFECOM_targetCURRENT == FFECOM_targetFFE 1456 ffesymbol_report_all (); 1457#endif 1458 } 1459} 1460 1461/* ffesta_ffebad_here_current_stmt -- ffebad_here with ptr to current stmt 1462 1463 ffesta_ffebad_here_current_stmt(0); 1464 1465 Outsiders can call this fn if they have no more convenient place to 1466 point to (via a token or pair of ffewhere objects) and they know a 1467 current, useful statement is being evaluted by ffest (i.e. they are 1468 being called from ffestb, ffestc, ffestd, ... functions). */ 1469 1470void 1471ffesta_ffebad_here_current_stmt (ffebadIndex i) 1472{ 1473 assert (ffesta_tokens[0] != NULL); 1474 ffebad_here (i, ffelex_token_where_line (ffesta_tokens[0]), 1475 ffelex_token_where_column (ffesta_tokens[0])); 1476} 1477 1478/* ffesta_ffebad_start -- Start a possibly inhibited error report 1479 1480 if (ffesta_ffebad_start(FFEBAD_SOME_ERROR)) 1481 { 1482 ffebad_here, ffebad_string ...; 1483 ffebad_finish(); 1484 } 1485 1486 Call if the error might indicate that ffest is evaluating the wrong 1487 statement form, instead of calling ffebad_start directly. If ffest 1488 is choosing between forms, it will return FALSE, send an EOS/SEMICOLON 1489 token through as the next token (if the current one isn't already one 1490 of those), and try another possible form. Otherwise, ffebad_start is 1491 called with the argument and TRUE returned. */ 1492 1493bool 1494ffesta_ffebad_start (ffebad errnum) 1495{ 1496 if (!ffesta_is_inhibited_) 1497 { 1498 ffebad_start (errnum); 1499 return TRUE; 1500 } 1501 1502 if (!ffesta_confirmed_current_) 1503 ffesta_current_shutdown_ = TRUE; 1504 1505 return FALSE; 1506} 1507 1508/* ffesta_first -- Parse the first token in a statement 1509 1510 return ffesta_first; // to lexer. */ 1511 1512ffelexHandler 1513ffesta_first (ffelexToken t) 1514{ 1515 switch (ffelex_token_type (t)) 1516 { 1517 case FFELEX_typeSEMICOLON: 1518 case FFELEX_typeEOS: 1519 ffesta_tokens[0] = ffelex_token_use (t); 1520 if (ffesta_label_token != NULL) 1521 { 1522 ffebad_start (FFEBAD_LABEL_WITHOUT_STMT); 1523 ffebad_here (0, ffelex_token_where_line (ffesta_label_token), 1524 ffelex_token_where_column (ffesta_label_token)); 1525 ffebad_string (ffelex_token_text (ffesta_label_token)); 1526 ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t)); 1527 ffebad_finish (); 1528 } 1529 return (ffelexHandler) ffesta_zero (t); 1530 1531 case FFELEX_typeNAME: 1532 case FFELEX_typeNAMES: 1533 ffesta_token_0_ = ffelex_token_use (t); 1534 ffesta_first_kw = ffestr_first (t); 1535 return (ffelexHandler) ffesta_second_; 1536 1537 case FFELEX_typeNUMBER: 1538 if (ffesta_line_has_semicolons 1539 && !ffe_is_free_form () 1540 && ffe_is_pedantic ()) 1541 { 1542 ffebad_start (FFEBAD_LABEL_WRONG_PLACE); 1543 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); 1544 ffebad_string (ffelex_token_text (t)); 1545 ffebad_finish (); 1546 } 1547 if (ffesta_label_token == NULL) 1548 { 1549 ffesta_label_token = ffelex_token_use (t); 1550 return (ffelexHandler) ffesta_first; 1551 } 1552 else 1553 { 1554 ffebad_start (FFEBAD_EXTRA_LABEL_DEF); 1555 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); 1556 ffebad_string (ffelex_token_text (t)); 1557 ffebad_here (1, ffelex_token_where_line (ffesta_label_token), 1558 ffelex_token_where_column (ffesta_label_token)); 1559 ffebad_string (ffelex_token_text (ffesta_label_token)); 1560 ffebad_finish (); 1561 1562 return (ffelexHandler) ffesta_first; 1563 } 1564 1565 default: /* Invalid first token. */ 1566 ffesta_tokens[0] = ffelex_token_use (t); 1567 ffebad_start (FFEBAD_STMT_BEGINS_BAD); 1568 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); 1569 ffebad_finish (); 1570 return (ffelexHandler) ffelex_swallow_tokens (t, 1571 (ffelexHandler) ffesta_zero); 1572 } 1573} 1574 1575/* ffesta_init_0 -- Initialize for entire image invocation 1576 1577 ffesta_init_0(); 1578 1579 Call just once per invocation of the compiler (not once per invocation 1580 of the front end). 1581 1582 Gets memory for the list of possibles once and for all, since this 1583 list never gets larger than a certain size (FFESTA_maxPOSSIBLES_) 1584 and is not particularly large. Initializes the array of pointers to 1585 this list. Initializes the executable and nonexecutable lists. */ 1586 1587void 1588ffesta_init_0 () 1589{ 1590 ffestaPossible_ ptr; 1591 int i; 1592 1593 ptr = (ffestaPossible_) malloc_new_kp (malloc_pool_image (), 1594 "FFEST possibles", 1595 FFESTA_maxPOSSIBLES_ 1596 * sizeof (*ptr)); 1597 1598 for (i = 0; i < FFESTA_maxPOSSIBLES_; ++i) 1599 ffesta_possibles_[i] = ptr++; 1600 1601 ffesta_possible_execs_.first = ffesta_possible_execs_.last 1602 = (ffestaPossible_) &ffesta_possible_execs_.first; 1603 ffesta_possible_nonexecs_.first = ffesta_possible_nonexecs_.last 1604 = (ffestaPossible_) &ffesta_possible_nonexecs_.first; 1605 ffesta_possible_execs_.nil = ffesta_possible_nonexecs_.nil = NULL; 1606} 1607 1608/* ffesta_init_3 -- Initialize for any program unit 1609 1610 ffesta_init_3(); */ 1611 1612void 1613ffesta_init_3 () 1614{ 1615 ffesta_output_pool = NULL; /* May be doing this just before reaching */ 1616 ffesta_scratch_pool = NULL; /* ffesta_zero or ffesta_two. */ 1617 /* NOTE: we let the ffe_terminate_2 action of killing the program_unit pool 1618 handle the killing of the output and scratch pools for us, which is why 1619 we don't have a terminate_3 action to do so. */ 1620 ffesta_construct_name = NULL; 1621 ffesta_label_token = NULL; 1622 ffesta_seen_first_exec = FALSE; 1623} 1624 1625/* ffesta_is_inhibited -- Test whether the current possibility is inhibited 1626 1627 if (!ffesta_is_inhibited()) 1628 // implement the statement. 1629 1630 Just make sure the current possibility has been confirmed. If anyone 1631 really needs to test whether the current possibility is inhibited prior 1632 to confirming it, that indicates a need to begin statement processing 1633 before it is certain that the given possibility is indeed the statement 1634 to be processed. As of this writing, there does not appear to be such 1635 a need. If there is, then when confirming a statement would normally 1636 immediately disable the inhibition (whereas currently we leave the 1637 confirmed statement disabled until we've tried the other possibilities, 1638 to check for ambiguities), we must check to see if the possibility has 1639 already tested for inhibition prior to confirmation and, if so, maintain 1640 inhibition until the end of the statement (which may be forced right 1641 away) and then rerun the entire statement from the beginning. Otherwise, 1642 initial calls to ffestb functions won't have been made, but subsequent 1643 calls (after confirmation) will, which is wrong. Of course, this all 1644 applies only to those statements implemented via multiple calls to 1645 ffestb, although if a statement requiring only a single ffestb call 1646 tested for inhibition prior to confirmation, it would likely mean that 1647 the ffestb call would be completely dropped without this mechanism. */ 1648 1649bool 1650ffesta_is_inhibited () 1651{ 1652 assert (ffesta_confirmed_current_ || ffesta_inhibit_confirmation_); 1653 return ffesta_is_inhibited_; 1654} 1655 1656/* ffesta_ffebad_1p -- Issue diagnostic with one source character 1657 1658 ffelexToken names_token; 1659 ffeTokenLength index; 1660 ffelexToken next_token; 1661 ffesta_ffebad_1p(FFEBAD_SOME_ERROR,names_token,index,next_token); 1662 1663 Equivalent to "if (ffest_ffebad_start(FFEBAD_SOME_ERROR))" followed by 1664 sending one argument, the location of index with names_token, if TRUE is 1665 returned. If index is equal to the length of names_token, meaning it 1666 points to the end of the token, then uses the location in next_token 1667 (which should be the token sent by the lexer after it sent names_token) 1668 instead. */ 1669 1670void 1671ffesta_ffebad_1p (ffebad errnum, ffelexToken names_token, ffeTokenLength index, 1672 ffelexToken next_token) 1673{ 1674 ffewhereLine line; 1675 ffewhereColumn col; 1676 1677 assert (index <= ffelex_token_length (names_token)); 1678 1679 if (ffesta_ffebad_start (errnum)) 1680 { 1681 if (index == ffelex_token_length (names_token)) 1682 { 1683 assert (next_token != NULL); 1684 line = ffelex_token_where_line (next_token); 1685 col = ffelex_token_where_column (next_token); 1686 ffebad_here (0, line, col); 1687 } 1688 else 1689 { 1690 ffewhere_set_from_track (&line, &col, 1691 ffelex_token_where_line (names_token), 1692 ffelex_token_where_column (names_token), 1693 ffelex_token_wheretrack (names_token), 1694 index); 1695 ffebad_here (0, line, col); 1696 ffewhere_line_kill (line); 1697 ffewhere_column_kill (col); 1698 } 1699 ffebad_finish (); 1700 } 1701} 1702 1703void 1704ffesta_ffebad_1sp (ffebad errnum, const char *s, ffelexToken names_token, 1705 ffeTokenLength index, ffelexToken next_token) 1706{ 1707 ffewhereLine line; 1708 ffewhereColumn col; 1709 1710 assert (index <= ffelex_token_length (names_token)); 1711 1712 if (ffesta_ffebad_start (errnum)) 1713 { 1714 ffebad_string (s); 1715 if (index == ffelex_token_length (names_token)) 1716 { 1717 assert (next_token != NULL); 1718 line = ffelex_token_where_line (next_token); 1719 col = ffelex_token_where_column (next_token); 1720 ffebad_here (0, line, col); 1721 } 1722 else 1723 { 1724 ffewhere_set_from_track (&line, &col, 1725 ffelex_token_where_line (names_token), 1726 ffelex_token_where_column (names_token), 1727 ffelex_token_wheretrack (names_token), 1728 index); 1729 ffebad_here (0, line, col); 1730 ffewhere_line_kill (line); 1731 ffewhere_column_kill (col); 1732 } 1733 ffebad_finish (); 1734 } 1735} 1736 1737void 1738ffesta_ffebad_1st (ffebad errnum, const char *s, ffelexToken t) 1739{ 1740 if (ffesta_ffebad_start (errnum)) 1741 { 1742 ffebad_string (s); 1743 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); 1744 ffebad_finish (); 1745 } 1746} 1747 1748/* ffesta_ffebad_1t -- Issue diagnostic with one source token 1749 1750 ffelexToken t; 1751 ffesta_ffebad_1t(FFEBAD_SOME_ERROR,t); 1752 1753 Equivalent to "if (ffesta_ffebad_start(FFEBAD_SOME_ERROR))" followed by 1754 sending one argument, the location of the token t, if TRUE is returned. */ 1755 1756void 1757ffesta_ffebad_1t (ffebad errnum, ffelexToken t) 1758{ 1759 if (ffesta_ffebad_start (errnum)) 1760 { 1761 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); 1762 ffebad_finish (); 1763 } 1764} 1765 1766void 1767ffesta_ffebad_2st (ffebad errnum, const char *s, ffelexToken t1, ffelexToken t2) 1768{ 1769 if (ffesta_ffebad_start (errnum)) 1770 { 1771 ffebad_string (s); 1772 ffebad_here (0, ffelex_token_where_line (t1), ffelex_token_where_column (t1)); 1773 ffebad_here (1, ffelex_token_where_line (t2), ffelex_token_where_column (t2)); 1774 ffebad_finish (); 1775 } 1776} 1777 1778/* ffesta_ffebad_2t -- Issue diagnostic with two source tokens 1779 1780 ffelexToken t1, t2; 1781 ffesta_ffebad_2t(FFEBAD_SOME_ERROR,t1,t2); 1782 1783 Equivalent to "if (ffesta_ffebad_start(FFEBAD_SOME_ERROR))" followed by 1784 sending two argument, the locations of the tokens t1 and t2, if TRUE is 1785 returned. */ 1786 1787void 1788ffesta_ffebad_2t (ffebad errnum, ffelexToken t1, ffelexToken t2) 1789{ 1790 if (ffesta_ffebad_start (errnum)) 1791 { 1792 ffebad_here (0, ffelex_token_where_line (t1), ffelex_token_where_column (t1)); 1793 ffebad_here (1, ffelex_token_where_line (t2), ffelex_token_where_column (t2)); 1794 ffebad_finish (); 1795 } 1796} 1797 1798ffestaPooldisp 1799ffesta_outpooldisp () 1800{ 1801 return ffesta_outpooldisp_; 1802} 1803 1804void 1805ffesta_set_outpooldisp (ffestaPooldisp d) 1806{ 1807 ffesta_outpooldisp_ = d; 1808} 1809 1810/* Shut down current parsing possibility, but without bothering the 1811 user with a diagnostic if we're not inhibited. */ 1812 1813void 1814ffesta_shutdown () 1815{ 1816 if (ffesta_is_inhibited_) 1817 ffesta_current_shutdown_ = TRUE; 1818} 1819 1820/* ffesta_two -- Deal with the first two tokens after a swallowed statement 1821 1822 return ffesta_two(first_token,second_token); // to lexer. 1823 1824 Like ffesta_zero, except instead of expecting an EOS or SEMICOLON, it 1825 expects the first two tokens of a statement that is part of another 1826 statement: the first two tokens of statement in "IF (expr) statement" or 1827 "WHERE (expr) statement", in particular. The first token must be a NAME 1828 or NAMES, the second can be basically anything. The statement type MUST 1829 be confirmed by now. 1830 1831 If we're not inhibited, just handle things as if we were ffesta_zero 1832 and saw an EOS just before the two tokens. 1833 1834 If we're inhibited, set ffesta_current_shutdown_ to shut down the current 1835 statement and continue with other possibilities, then (presumably) come 1836 back to this one for real when not inhibited. */ 1837 1838ffelexHandler 1839ffesta_two (ffelexToken first, ffelexToken second) 1840{ 1841#if FFESTA_ABORT_ON_CONFIRM_ 1842 ffelexHandler next; 1843#endif 1844 1845 assert ((ffelex_token_type (first) == FFELEX_typeNAME) 1846 || (ffelex_token_type (first) == FFELEX_typeNAMES)); 1847 assert (ffesta_tokens[0] != NULL); 1848 1849 if (ffesta_is_inhibited_) /* Oh, not really done with statement. */ 1850 { 1851 ffesta_current_shutdown_ = TRUE; 1852 /* To catch the EOS on shutdown. */ 1853 return (ffelexHandler) ffelex_swallow_tokens (second, 1854 (ffelexHandler) ffesta_zero); 1855 } 1856 1857 ffestw_display_state (); 1858 1859 ffelex_token_kill (ffesta_tokens[0]); 1860 1861 if (ffesta_output_pool != NULL) 1862 { 1863 if (ffesta_outpooldisp_ == FFESTA_pooldispDISCARD) 1864 malloc_pool_kill (ffesta_output_pool); 1865 ffesta_output_pool = NULL; 1866 } 1867 1868 if (ffesta_scratch_pool != NULL) 1869 { 1870 malloc_pool_kill (ffesta_scratch_pool); 1871 ffesta_scratch_pool = NULL; 1872 } 1873 1874 ffesta_reset_possibles_ (); 1875 ffesta_confirmed_current_ = FALSE; 1876 1877 /* What happens here is somewhat interesting. We effectively derail the 1878 line of handlers for these two tokens, the first two in a statement, by 1879 setting a flag to TRUE. This flag tells ffesta_save_ (or, conceivably, 1880 the lexer via ffesta_second_'s case 1:, where it has only one possible 1881 kind of statement -- someday this will be more likely, i.e. after 1882 confirmation causes an immediate switch to only the one context rather 1883 than just setting a flag and running through the remaining possibles to 1884 look for ambiguities) that the last two tokens it sent did not reach the 1885 truly desired targets (ffest_first and ffesta_second_) since that would 1886 otherwise attempt to recursively invoke ffesta_save_ in most cases, 1887 while the existing ffesta_save_ was still alive and making use of static 1888 (nonrecursive) variables. Instead, ffesta_save_, upon seeing this flag 1889 set TRUE, sets it to FALSE and resubmits the two tokens copied here to 1890 ffest_first and, presumably, ffesta_second_, kills them, and returns the 1891 handler returned by the handler for the second token. Thus, even though 1892 ffesta_save_ is still (likely to be) recursively invoked, the former 1893 invocation is past the use of any static variables possibly changed 1894 during the first-two-token invocation of the latter invocation. */ 1895 1896#if FFESTA_ABORT_ON_CONFIRM_ 1897 /* Shouldn't be in ffesta_save_ at all here. */ 1898 1899 next = (ffelexHandler) ffesta_first (first); 1900 return (ffelexHandler) (*next) (second); 1901#else 1902 ffesta_twotokens_1_ = ffelex_token_use (first); 1903 ffesta_twotokens_2_ = ffelex_token_use (second); 1904 1905 ffesta_is_two_into_statement_ = TRUE; 1906 return (ffelexHandler) ffesta_send_two_; /* Shouldn't get called. */ 1907#endif 1908} 1909 1910/* ffesta_zero -- Deal with the end of a swallowed statement 1911 1912 return ffesta_zero; // to lexer. 1913 1914 NOTICE that this code is COPIED, largely, into a 1915 similar function named ffesta_two that gets invoked in place of 1916 _zero_ when the end of the statement happens before EOS or SEMICOLON and 1917 to tokens into the next statement have been read (as is the case with the 1918 logical-IF and WHERE-stmt statements). So any changes made here should 1919 probably be made in _two_ at the same time. */ 1920 1921ffelexHandler 1922ffesta_zero (ffelexToken t) 1923{ 1924 assert ((ffelex_token_type (t) == FFELEX_typeEOS) 1925 || (ffelex_token_type (t) == FFELEX_typeSEMICOLON)); 1926 assert (ffesta_tokens[0] != NULL); 1927 1928 if (ffesta_is_inhibited_) 1929 ffesymbol_retract (TRUE); 1930 else 1931 ffestw_display_state (); 1932 1933 /* Do CONTINUE if nothing else. This is done specifically so that "IF 1934 (...) BLAH" causes the same things to happen as if "IF (...) CONTINUE" 1935 was done, so that tracking of labels and such works. (Try a small 1936 program like "DO 10 ...", "IF (...) BLAH", "10 CONTINUE", "END".) 1937 1938 But it turns out that just testing "!ffesta_confirmed_current_" 1939 isn't enough, because then typing "GOTO" instead of "BLAH" above 1940 doesn't work -- the statement is confirmed (we know the user 1941 attempted a GOTO) but ffestc hasn't seen it. So, instead, just 1942 always tell ffestc to do "any" statement it needs to reset. */ 1943 1944 if (!ffesta_is_inhibited_ 1945 && ffesta_seen_first_exec) 1946 { 1947 ffestc_any (); 1948 } 1949 1950 ffelex_token_kill (ffesta_tokens[0]); 1951 1952 if (ffesta_is_inhibited_) /* Oh, not really done with statement. */ 1953 return (ffelexHandler) ffesta_zero; /* Call me again when done! */ 1954 1955 if (ffesta_output_pool != NULL) 1956 { 1957 if (ffesta_outpooldisp_ == FFESTA_pooldispDISCARD) 1958 malloc_pool_kill (ffesta_output_pool); 1959 ffesta_output_pool = NULL; 1960 } 1961 1962 if (ffesta_scratch_pool != NULL) 1963 { 1964 malloc_pool_kill (ffesta_scratch_pool); 1965 ffesta_scratch_pool = NULL; 1966 } 1967 1968 ffesta_reset_possibles_ (); 1969 ffesta_confirmed_current_ = FALSE; 1970 1971 if (ffelex_token_type (t) == FFELEX_typeSEMICOLON) 1972 { 1973 ffesta_line_has_semicolons = TRUE; 1974 if (ffe_is_pedantic_not_90 ()) 1975 { 1976 ffebad_start (FFEBAD_SEMICOLON); 1977 ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t)); 1978 ffebad_finish (); 1979 } 1980 } 1981 else 1982 ffesta_line_has_semicolons = FALSE; 1983 1984 if (ffesta_label_token != NULL) 1985 { 1986 ffelex_token_kill (ffesta_label_token); 1987 ffesta_label_token = NULL; 1988 } 1989 1990 if (ffe_is_ffedebug ()) 1991 { 1992 ffestorag_report (); 1993#if FFECOM_targetCURRENT == FFECOM_targetFFE 1994 ffesymbol_report_all (); 1995#endif 1996 } 1997 1998 ffelex_set_names (TRUE); 1999 return (ffelexHandler) ffesta_first; 2000} 2001