contrib/gcc/f/sta.c

   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
   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 #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
1470 void
1471 ffesta_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
1493 bool
1494 ffesta_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
1512 ffelexHandler
1513 ffesta_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
1587 void
1588 ffesta_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
1612 void
1613 ffesta_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
1649 bool
1650 ffesta_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
1670 void
1671 ffesta_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
1703 void
1704 ffesta_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
1737 void
1738 ffesta_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
1756 void
1757 ffesta_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
1766 void
1767 ffesta_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
1787 void
1788 ffesta_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
1798 ffestaPooldisp
1799 ffesta_outpooldisp ()
1800 {
1801   return ffesta_outpooldisp_;
1802 }
1803
1804 void
1805 ffesta_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
1813 void
1814 ffesta_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
1838 ffelexHandler
1839 ffesta_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
1921 ffelexHandler
1922 ffesta_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 }