gcc/f/sta.c

   1 /* sta.c -- Implementation File (module.c template V1.0)
   2    Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
   3    Contributed by James Craig Burley.
   4
   5 This file is part of GNU Fortran.
   6
   7 GNU Fortran is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2, or (at your option)
  10 any later version.
  11
  12 GNU Fortran is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU Fortran; see the file COPYING.  If not, write to
  19 the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
  20 02111-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
  50 ffelexToken ffesta_tokens[FFESTA_tokensMAX];    /* For use by a possible. */
  51 ffestrFirst ffesta_first_kw;    /* First NAME(S) looked up. */
  52 ffestrSecond ffesta_second_kw;  /* Second NAME(S) looked up. */
  53 mallocPool ffesta_output_pool;  /* Pool for results of stmt handling. */
  54 mallocPool ffesta_scratch_pool; /* Pool for stmt scratch handling. */
  55 ffelexToken ffesta_construct_name;
  56 ffelexToken ffesta_label_token; /* Pending label stuff. */
  57 bool ffesta_seen_first_exec;
  58 bool ffesta_is_entry_valid = FALSE;     /* TRUE only in SUBROUTINE/FUNCTION. */
  59 bool 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
  85 typedef struct _ffesta_possible_ *ffestaPossible_;
  86
  87 /* Private include files. */
  88
  89
  90 /* Internal structure definitions. */
  91
  92 struct _ffesta_possible_
  93   {
  94     ffestaPossible_ next;
  95     ffestaPossible_ previous;
  96     ffelexHandler handler;
  97     bool named;
  98   };
  99
 100 struct _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
 109 static bool ffesta_is_inhibited_ = FALSE;
 110 static ffelexToken ffesta_token_0_;     /* For use by ffest possibility
 111                                            handling. */
 112 static ffestaPossible_ ffesta_possibles_[FFESTA_maxPOSSIBLES_];
 113 static int ffesta_num_possibles_ = 0;   /* Number of possibilities. */
 114 static struct _ffesta_possible_root_ ffesta_possible_nonexecs_;
 115 static struct _ffesta_possible_root_ ffesta_possible_execs_;
 116 static ffestaPossible_ ffesta_current_possible_;
 117 static ffelexHandler ffesta_current_handler_;
 118 static bool ffesta_confirmed_current_ = FALSE;
 119 static bool ffesta_confirmed_other_ = FALSE;
 120 static ffestaPossible_ ffesta_confirmed_possible_;
 121 static bool ffesta_current_shutdown_ = FALSE;
 122 #if !FFESTA_ABORT_ON_CONFIRM_
 123 static bool ffesta_is_two_into_statement_ = FALSE;      /* For IF, WHERE stmts. */
 124 static ffelexToken ffesta_twotokens_1_; /* For IF, WHERE stmts. */
 125 static ffelexToken ffesta_twotokens_2_; /* For IF, WHERE stmts. */
 126 #endif
 127 static ffestaPooldisp ffesta_outpooldisp_;      /* After statement dealt
 128                                                    with. */
 129 static bool ffesta_inhibit_confirmation_ = FALSE;
 130
 131 /* Static functions (internal). */
 132
 133 static void ffesta_add_possible_ (ffelexHandler fn, bool exec, bool named);
 134 static bool ffesta_inhibited_exec_transition_ (void);
 135 static void ffesta_reset_possibles_ (void);
 136 static ffelexHandler ffesta_save_ (ffelexToken t);
 137 static ffelexHandler ffesta_second_ (ffelexToken t);
 138 #if !FFESTA_ABORT_ON_CONFIRM_
 139 static 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 \f
 149 /* Add possible statement to appropriate list.  */
 150
 151 static void
 152 ffesta_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
 185 static bool
 186 ffesta_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
 210 static void
 211 ffesta_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
 233 static ffelexHandler
 234 ffesta_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
 577 static ffelexHandler
 578 ffesta_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_
1377 static ffelexHandler
1378 ffesta_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
1393 void
1394 ffesta_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
1417 void
1418 ffesta_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     }
1456 }
1457
1458 /* ffesta_ffebad_here_current_stmt -- ffebad_here with ptr to current stmt
1459
1460    ffesta_ffebad_here_current_stmt(0);
1461
1462    Outsiders can call this fn if they have no more convenient place to
1463    point to (via a token or pair of ffewhere objects) and they know a
1464    current, useful statement is being evaluted by ffest (i.e. they are
1465    being called from ffestb, ffestc, ffestd, ... functions).  */
1466
1467 void
1468 ffesta_ffebad_here_current_stmt (ffebadIndex i)
1469 {
1470   assert (ffesta_tokens[0] != NULL);
1471   ffebad_here (i, ffelex_token_where_line (ffesta_tokens[0]),
1472                ffelex_token_where_column (ffesta_tokens[0]));
1473 }
1474
1475 /* ffesta_ffebad_start -- Start a possibly inhibited error report
1476
1477    if (ffesta_ffebad_start(FFEBAD_SOME_ERROR))
1478        {
1479        ffebad_here, ffebad_string ...;
1480        ffebad_finish();
1481        }
1482
1483    Call if the error might indicate that ffest is evaluating the wrong
1484    statement form, instead of calling ffebad_start directly.  If ffest
1485    is choosing between forms, it will return FALSE, send an EOS/SEMICOLON
1486    token through as the next token (if the current one isn't already one
1487    of those), and try another possible form.  Otherwise, ffebad_start is
1488    called with the argument and TRUE returned.  */
1489
1490 bool
1491 ffesta_ffebad_start (ffebad errnum)
1492 {
1493   if (!ffesta_is_inhibited_)
1494     {
1495       ffebad_start (errnum);
1496       return TRUE;
1497     }
1498
1499   if (!ffesta_confirmed_current_)
1500     ffesta_current_shutdown_ = TRUE;
1501
1502   return FALSE;
1503 }
1504
1505 /* ffesta_first -- Parse the first token in a statement
1506
1507    return ffesta_first;  // to lexer.  */
1508
1509 ffelexHandler
1510 ffesta_first (ffelexToken t)
1511 {
1512   switch (ffelex_token_type (t))
1513     {
1514     case FFELEX_typeSEMICOLON:
1515     case FFELEX_typeEOS:
1516       ffesta_tokens[0] = ffelex_token_use (t);
1517       if (ffesta_label_token != NULL)
1518         {
1519           ffebad_start (FFEBAD_LABEL_WITHOUT_STMT);
1520           ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
1521                        ffelex_token_where_column (ffesta_label_token));
1522           ffebad_string (ffelex_token_text (ffesta_label_token));
1523           ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
1524           ffebad_finish ();
1525         }
1526       return (ffelexHandler) ffesta_zero (t);
1527
1528     case FFELEX_typeNAME:
1529     case FFELEX_typeNAMES:
1530       ffesta_token_0_ = ffelex_token_use (t);
1531       ffesta_first_kw = ffestr_first (t);
1532       return (ffelexHandler) ffesta_second_;
1533
1534     case FFELEX_typeNUMBER:
1535       if (ffesta_line_has_semicolons
1536           && !ffe_is_free_form ()
1537           && ffe_is_pedantic ())
1538         {
1539           ffebad_start (FFEBAD_LABEL_WRONG_PLACE);
1540           ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
1541           ffebad_string (ffelex_token_text (t));
1542           ffebad_finish ();
1543         }
1544       if (ffesta_label_token == NULL)
1545         {
1546           ffesta_label_token = ffelex_token_use (t);
1547           return (ffelexHandler) ffesta_first;
1548         }
1549       else
1550         {
1551           ffebad_start (FFEBAD_EXTRA_LABEL_DEF);
1552           ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
1553           ffebad_string (ffelex_token_text (t));
1554           ffebad_here (1, ffelex_token_where_line (ffesta_label_token),
1555                        ffelex_token_where_column (ffesta_label_token));
1556           ffebad_string (ffelex_token_text (ffesta_label_token));
1557           ffebad_finish ();
1558
1559           return (ffelexHandler) ffesta_first;
1560         }
1561
1562     default:                    /* Invalid first token. */
1563       ffesta_tokens[0] = ffelex_token_use (t);
1564       ffebad_start (FFEBAD_STMT_BEGINS_BAD);
1565       ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
1566       ffebad_finish ();
1567       return (ffelexHandler) ffelex_swallow_tokens (t,
1568                                                (ffelexHandler) ffesta_zero);
1569     }
1570 }
1571
1572 /* ffesta_init_0 -- Initialize for entire image invocation
1573
1574    ffesta_init_0();
1575
1576    Call just once per invocation of the compiler (not once per invocation
1577    of the front end).
1578
1579    Gets memory for the list of possibles once and for all, since this
1580    list never gets larger than a certain size (FFESTA_maxPOSSIBLES_)
1581    and is not particularly large.  Initializes the array of pointers to
1582    this list.  Initializes the executable and nonexecutable lists.  */
1583
1584 void
1585 ffesta_init_0 ()
1586 {
1587   ffestaPossible_ ptr;
1588   int i;
1589
1590   ptr = (ffestaPossible_) malloc_new_kp (malloc_pool_image (),
1591                                          "FFEST possibles",
1592                                          FFESTA_maxPOSSIBLES_
1593                                          * sizeof (*ptr));
1594
1595   for (i = 0; i < FFESTA_maxPOSSIBLES_; ++i)
1596     ffesta_possibles_[i] = ptr++;
1597
1598   ffesta_possible_execs_.first = ffesta_possible_execs_.last
1599     = (ffestaPossible_) &ffesta_possible_execs_.first;
1600   ffesta_possible_nonexecs_.first = ffesta_possible_nonexecs_.last
1601     = (ffestaPossible_) &ffesta_possible_nonexecs_.first;
1602   ffesta_possible_execs_.nil = ffesta_possible_nonexecs_.nil = NULL;
1603 }
1604
1605 /* ffesta_init_3 -- Initialize for any program unit
1606
1607    ffesta_init_3();  */
1608
1609 void
1610 ffesta_init_3 ()
1611 {
1612   ffesta_output_pool = NULL;    /* May be doing this just before reaching */
1613   ffesta_scratch_pool = NULL;   /* ffesta_zero or ffesta_two. */
1614   /* NOTE: we let the ffe_terminate_2 action of killing the program_unit pool
1615      handle the killing of the output and scratch pools for us, which is why
1616      we don't have a terminate_3 action to do so. */
1617   ffesta_construct_name = NULL;
1618   ffesta_label_token = NULL;
1619   ffesta_seen_first_exec = FALSE;
1620 }
1621
1622 /* ffesta_is_inhibited -- Test whether the current possibility is inhibited
1623
1624    if (!ffesta_is_inhibited())
1625        // implement the statement.
1626
1627    Just make sure the current possibility has been confirmed.  If anyone
1628    really needs to test whether the current possibility is inhibited prior
1629    to confirming it, that indicates a need to begin statement processing
1630    before it is certain that the given possibility is indeed the statement
1631    to be processed.  As of this writing, there does not appear to be such
1632    a need.  If there is, then when confirming a statement would normally
1633    immediately disable the inhibition (whereas currently we leave the
1634    confirmed statement disabled until we've tried the other possibilities,
1635    to check for ambiguities), we must check to see if the possibility has
1636    already tested for inhibition prior to confirmation and, if so, maintain
1637    inhibition until the end of the statement (which may be forced right
1638    away) and then rerun the entire statement from the beginning.  Otherwise,
1639    initial calls to ffestb functions won't have been made, but subsequent
1640    calls (after confirmation) will, which is wrong.  Of course, this all
1641    applies only to those statements implemented via multiple calls to
1642    ffestb, although if a statement requiring only a single ffestb call
1643    tested for inhibition prior to confirmation, it would likely mean that
1644    the ffestb call would be completely dropped without this mechanism.  */
1645
1646 bool
1647 ffesta_is_inhibited ()
1648 {
1649   assert (ffesta_confirmed_current_ || ffesta_inhibit_confirmation_);
1650   return ffesta_is_inhibited_;
1651 }
1652
1653 /* ffesta_ffebad_1p -- Issue diagnostic with one source character
1654
1655    ffelexToken names_token;
1656    ffeTokenLength index;
1657    ffelexToken next_token;
1658    ffesta_ffebad_1p(FFEBAD_SOME_ERROR,names_token,index,next_token);
1659
1660    Equivalent to "if (ffest_ffebad_start(FFEBAD_SOME_ERROR))" followed by
1661    sending one argument, the location of index with names_token, if TRUE is
1662    returned.  If index is equal to the length of names_token, meaning it
1663    points to the end of the token, then uses the location in next_token
1664    (which should be the token sent by the lexer after it sent names_token)
1665    instead.  */
1666
1667 void
1668 ffesta_ffebad_1p (ffebad errnum, ffelexToken names_token, ffeTokenLength index,
1669                   ffelexToken next_token)
1670 {
1671   ffewhereLine line;
1672   ffewhereColumn col;
1673
1674   assert (index <= ffelex_token_length (names_token));
1675
1676   if (ffesta_ffebad_start (errnum))
1677     {
1678       if (index == ffelex_token_length (names_token))
1679         {
1680           assert (next_token != NULL);
1681           line = ffelex_token_where_line (next_token);
1682           col = ffelex_token_where_column (next_token);
1683           ffebad_here (0, line, col);
1684         }
1685       else
1686         {
1687           ffewhere_set_from_track (&line, &col,
1688                                    ffelex_token_where_line (names_token),
1689                                    ffelex_token_where_column (names_token),
1690                                    ffelex_token_wheretrack (names_token),
1691                                    index);
1692           ffebad_here (0, line, col);
1693           ffewhere_line_kill (line);
1694           ffewhere_column_kill (col);
1695         }
1696       ffebad_finish ();
1697     }
1698 }
1699
1700 void
1701 ffesta_ffebad_1sp (ffebad errnum, const char *s, ffelexToken names_token,
1702                    ffeTokenLength index, ffelexToken next_token)
1703 {
1704   ffewhereLine line;
1705   ffewhereColumn col;
1706
1707   assert (index <= ffelex_token_length (names_token));
1708
1709   if (ffesta_ffebad_start (errnum))
1710     {
1711       ffebad_string (s);
1712       if (index == ffelex_token_length (names_token))
1713         {
1714           assert (next_token != NULL);
1715           line = ffelex_token_where_line (next_token);
1716           col = ffelex_token_where_column (next_token);
1717           ffebad_here (0, line, col);
1718         }
1719       else
1720         {
1721           ffewhere_set_from_track (&line, &col,
1722                                    ffelex_token_where_line (names_token),
1723                                    ffelex_token_where_column (names_token),
1724                                    ffelex_token_wheretrack (names_token),
1725                                    index);
1726           ffebad_here (0, line, col);
1727           ffewhere_line_kill (line);
1728           ffewhere_column_kill (col);
1729         }
1730       ffebad_finish ();
1731     }
1732 }
1733
1734 void
1735 ffesta_ffebad_1st (ffebad errnum, const char *s, ffelexToken t)
1736 {
1737   if (ffesta_ffebad_start (errnum))
1738     {
1739       ffebad_string (s);
1740       ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
1741       ffebad_finish ();
1742     }
1743 }
1744
1745 /* ffesta_ffebad_1t -- Issue diagnostic with one source token
1746
1747    ffelexToken t;
1748    ffesta_ffebad_1t(FFEBAD_SOME_ERROR,t);
1749
1750    Equivalent to "if (ffesta_ffebad_start(FFEBAD_SOME_ERROR))" followed by
1751    sending one argument, the location of the token t, if TRUE is returned.  */
1752
1753 void
1754 ffesta_ffebad_1t (ffebad errnum, ffelexToken t)
1755 {
1756   if (ffesta_ffebad_start (errnum))
1757     {
1758       ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
1759       ffebad_finish ();
1760     }
1761 }
1762
1763 void
1764 ffesta_ffebad_2st (ffebad errnum, const char *s, ffelexToken t1, ffelexToken t2)
1765 {
1766   if (ffesta_ffebad_start (errnum))
1767     {
1768       ffebad_string (s);
1769       ffebad_here (0, ffelex_token_where_line (t1), ffelex_token_where_column (t1));
1770       ffebad_here (1, ffelex_token_where_line (t2), ffelex_token_where_column (t2));
1771       ffebad_finish ();
1772     }
1773 }
1774
1775 /* ffesta_ffebad_2t -- Issue diagnostic with two source tokens
1776
1777    ffelexToken t1, t2;
1778    ffesta_ffebad_2t(FFEBAD_SOME_ERROR,t1,t2);
1779
1780    Equivalent to "if (ffesta_ffebad_start(FFEBAD_SOME_ERROR))" followed by
1781    sending two argument, the locations of the tokens t1 and t2, if TRUE is
1782    returned.  */
1783
1784 void
1785 ffesta_ffebad_2t (ffebad errnum, ffelexToken t1, ffelexToken t2)
1786 {
1787   if (ffesta_ffebad_start (errnum))
1788     {
1789       ffebad_here (0, ffelex_token_where_line (t1), ffelex_token_where_column (t1));
1790       ffebad_here (1, ffelex_token_where_line (t2), ffelex_token_where_column (t2));
1791       ffebad_finish ();
1792     }
1793 }
1794
1795 ffestaPooldisp
1796 ffesta_outpooldisp ()
1797 {
1798   return ffesta_outpooldisp_;
1799 }
1800
1801 void
1802 ffesta_set_outpooldisp (ffestaPooldisp d)
1803 {
1804   ffesta_outpooldisp_ = d;
1805 }
1806
1807 /* Shut down current parsing possibility, but without bothering the
1808    user with a diagnostic if we're not inhibited.  */
1809
1810 void
1811 ffesta_shutdown ()
1812 {
1813   if (ffesta_is_inhibited_)
1814     ffesta_current_shutdown_ = TRUE;
1815 }
1816
1817 /* ffesta_two -- Deal with the first two tokens after a swallowed statement
1818
1819    return ffesta_two(first_token,second_token);  // to lexer.
1820
1821    Like ffesta_zero, except instead of expecting an EOS or SEMICOLON, it
1822    expects the first two tokens of a statement that is part of another
1823    statement: the first two tokens of statement in "IF (expr) statement" or
1824    "WHERE (expr) statement", in particular.  The first token must be a NAME
1825    or NAMES, the second can be basically anything.  The statement type MUST
1826    be confirmed by now.
1827
1828    If we're not inhibited, just handle things as if we were ffesta_zero
1829    and saw an EOS just before the two tokens.
1830
1831    If we're inhibited, set ffesta_current_shutdown_ to shut down the current
1832    statement and continue with other possibilities, then (presumably) come
1833    back to this one for real when not inhibited.  */
1834
1835 ffelexHandler
1836 ffesta_two (ffelexToken first, ffelexToken second)
1837 {
1838 #if FFESTA_ABORT_ON_CONFIRM_
1839   ffelexHandler next;
1840 #endif
1841
1842   assert ((ffelex_token_type (first) == FFELEX_typeNAME)
1843           || (ffelex_token_type (first) == FFELEX_typeNAMES));
1844   assert (ffesta_tokens[0] != NULL);
1845
1846   if (ffesta_is_inhibited_)     /* Oh, not really done with statement. */
1847     {
1848       ffesta_current_shutdown_ = TRUE;
1849       /* To catch the EOS on shutdown. */
1850       return (ffelexHandler) ffelex_swallow_tokens (second,
1851                                                (ffelexHandler) ffesta_zero);
1852     }
1853
1854   ffestw_display_state ();
1855
1856   ffelex_token_kill (ffesta_tokens[0]);
1857
1858   if (ffesta_output_pool != NULL)
1859     {
1860       if (ffesta_outpooldisp_ == FFESTA_pooldispDISCARD)
1861         malloc_pool_kill (ffesta_output_pool);
1862       ffesta_output_pool = NULL;
1863     }
1864
1865   if (ffesta_scratch_pool != NULL)
1866     {
1867       malloc_pool_kill (ffesta_scratch_pool);
1868       ffesta_scratch_pool = NULL;
1869     }
1870
1871   ffesta_reset_possibles_ ();
1872   ffesta_confirmed_current_ = FALSE;
1873
1874   /* What happens here is somewhat interesting.  We effectively derail the
1875      line of handlers for these two tokens, the first two in a statement, by
1876      setting a flag to TRUE.  This flag tells ffesta_save_ (or, conceivably,
1877      the lexer via ffesta_second_'s case 1:, where it has only one possible
1878      kind of statement -- someday this will be more likely, i.e. after
1879      confirmation causes an immediate switch to only the one context rather
1880      than just setting a flag and running through the remaining possibles to
1881      look for ambiguities) that the last two tokens it sent did not reach the
1882      truly desired targets (ffest_first and ffesta_second_) since that would
1883      otherwise attempt to recursively invoke ffesta_save_ in most cases,
1884      while the existing ffesta_save_ was still alive and making use of static
1885      (nonrecursive) variables.  Instead, ffesta_save_, upon seeing this flag
1886      set TRUE, sets it to FALSE and resubmits the two tokens copied here to
1887      ffest_first and, presumably, ffesta_second_, kills them, and returns the
1888      handler returned by the handler for the second token.  Thus, even though
1889      ffesta_save_ is still (likely to be) recursively invoked, the former
1890      invocation is past the use of any static variables possibly changed
1891      during the first-two-token invocation of the latter invocation. */
1892
1893 #if FFESTA_ABORT_ON_CONFIRM_
1894   /* Shouldn't be in ffesta_save_ at all here. */
1895
1896   next = (ffelexHandler) ffesta_first (first);
1897   return (ffelexHandler) (*next) (second);
1898 #else
1899   ffesta_twotokens_1_ = ffelex_token_use (first);
1900   ffesta_twotokens_2_ = ffelex_token_use (second);
1901
1902   ffesta_is_two_into_statement_ = TRUE;
1903   return (ffelexHandler) ffesta_send_two_;      /* Shouldn't get called. */
1904 #endif
1905 }
1906
1907 /* ffesta_zero -- Deal with the end of a swallowed statement
1908
1909    return ffesta_zero;  // to lexer.
1910
1911    NOTICE that this code is COPIED, largely, into a
1912    similar function named ffesta_two that gets invoked in place of
1913    _zero_ when the end of the statement happens before EOS or SEMICOLON and
1914    to tokens into the next statement have been read (as is the case with the
1915    logical-IF and WHERE-stmt statements).  So any changes made here should
1916    probably be made in _two_ at the same time.  */
1917
1918 ffelexHandler
1919 ffesta_zero (ffelexToken t)
1920 {
1921   assert ((ffelex_token_type (t) == FFELEX_typeEOS)
1922           || (ffelex_token_type (t) == FFELEX_typeSEMICOLON));
1923   assert (ffesta_tokens[0] != NULL);
1924
1925   if (ffesta_is_inhibited_)
1926     ffesymbol_retract (TRUE);
1927   else
1928     ffestw_display_state ();
1929
1930   /* Do CONTINUE if nothing else.  This is done specifically so that "IF
1931      (...) BLAH" causes the same things to happen as if "IF (...) CONTINUE"
1932      was done, so that tracking of labels and such works.  (Try a small
1933      program like "DO 10 ...", "IF (...) BLAH", "10 CONTINUE", "END".)
1934
1935      But it turns out that just testing "!ffesta_confirmed_current_"
1936      isn't enough, because then typing "GOTO" instead of "BLAH" above
1937      doesn't work -- the statement is confirmed (we know the user
1938      attempted a GOTO) but ffestc hasn't seen it.  So, instead, just
1939      always tell ffestc to do "any" statement it needs to reset.  */
1940
1941   if (!ffesta_is_inhibited_
1942       && ffesta_seen_first_exec)
1943     {
1944       ffestc_any ();
1945     }
1946
1947   ffelex_token_kill (ffesta_tokens[0]);
1948
1949   if (ffesta_is_inhibited_)     /* Oh, not really done with statement. */
1950     return (ffelexHandler) ffesta_zero; /* Call me again when done! */
1951
1952   if (ffesta_output_pool != NULL)
1953     {
1954       if (ffesta_outpooldisp_ == FFESTA_pooldispDISCARD)
1955         malloc_pool_kill (ffesta_output_pool);
1956       ffesta_output_pool = NULL;
1957     }
1958
1959   if (ffesta_scratch_pool != NULL)
1960     {
1961       malloc_pool_kill (ffesta_scratch_pool);
1962       ffesta_scratch_pool = NULL;
1963     }
1964
1965   ffesta_reset_possibles_ ();
1966   ffesta_confirmed_current_ = FALSE;
1967
1968   if (ffelex_token_type (t) == FFELEX_typeSEMICOLON)
1969     {
1970       ffesta_line_has_semicolons = TRUE;
1971       if (ffe_is_pedantic_not_90 ())
1972         {
1973           ffebad_start (FFEBAD_SEMICOLON);
1974           ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
1975           ffebad_finish ();
1976         }
1977     }
1978   else
1979     ffesta_line_has_semicolons = FALSE;
1980
1981   if (ffesta_label_token != NULL)
1982     {
1983       ffelex_token_kill (ffesta_label_token);
1984       ffesta_label_token = NULL;
1985     }
1986
1987   if (ffe_is_ffedebug ())
1988     {
1989       ffestorag_report ();
1990     }
1991
1992   ffelex_set_names (TRUE);
1993   return (ffelexHandler) ffesta_first;
1994 }