xref: /openbsd/gnu/usr.bin/gcc/gcc/f/sta.c (revision 4e43c760)
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 
149 /* Add possible statement to appropriate list.  */
150 
151 static void
ffesta_add_possible_(ffelexHandler fn,bool exec,bool named)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
ffesta_inhibited_exec_transition_()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
ffesta_reset_possibles_()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
ffesta_save_(ffelexToken t)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_.first)
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_.first)
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
ffesta_second_(ffelexToken t)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
ffesta_send_two_(ffelexToken t)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
ffesta_confirmed()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
ffesta_eof()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
ffesta_ffebad_here_current_stmt(ffebadIndex i)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
ffesta_ffebad_start(ffebad errnum)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
ffesta_first(ffelexToken t)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
ffesta_init_0()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
ffesta_init_3()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
ffesta_is_inhibited()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
ffesta_ffebad_1p(ffebad errnum,ffelexToken names_token,ffeTokenLength index,ffelexToken next_token)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
ffesta_ffebad_1sp(ffebad errnum,const char * s,ffelexToken names_token,ffeTokenLength index,ffelexToken next_token)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
ffesta_ffebad_1st(ffebad errnum,const char * s,ffelexToken t)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
ffesta_ffebad_1t(ffebad errnum,ffelexToken t)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
ffesta_ffebad_2st(ffebad errnum,const char * s,ffelexToken t1,ffelexToken t2)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
ffesta_ffebad_2t(ffebad errnum,ffelexToken t1,ffelexToken t2)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
ffesta_outpooldisp()1796 ffesta_outpooldisp ()
1797 {
1798   return ffesta_outpooldisp_;
1799 }
1800 
1801 void
ffesta_set_outpooldisp(ffestaPooldisp d)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
ffesta_shutdown()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
ffesta_two(ffelexToken first,ffelexToken second)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
ffesta_zero(ffelexToken t)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 }
1995