Initial integration of G77.

Please do a make cleandir before rebuilding gcc!

1 files changed, 13786 insertions, 0 deletions

diff --git a/gnu/usr.bin/gcc/f/stc.c b/gnu/usr.bin/gcc/f/stc.c
new file mode 100644
index 00000000000..5512bcbab6b
--- /dev/null
+++ b/gnu/usr.bin/gcc/f/stc.c
@@ -0,0 +1,13786 @@
+/* stc.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Related Modules:
+      st.c
+
+   Description:
+      Verifies the proper semantics for statements, checking expressions already
+      semantically analyzed individually, collectively, checking label defs and
+      refs, and so on.	Uses ffebad to indicate errors in semantics.
+
+      In many cases, both a token and a keyword (ffestrFirst, ffestrSecond,
+      or ffestrOther) is provided.  ONLY USE THE TOKEN as a pointer to the
+      source-code location for an error message or similar; use the keyword
+      as the semantic matching for the token, since the token's text might
+      not match the keyword's code.  For example, INTENT(IN OUT) A in free
+      source form passes to ffestc_R519_start the token "IN" but the keyword
+      FFESTR_otherINOUT, and the latter is correct.
+
+      Generally, either a single ffestc function handles an entire statement,
+      in which case its name is ffestc_xyz_, or more than one function is
+      needed, in which case its names are ffestc_xyz_start_,
+      ffestc_xyz_item_ or ffestc_xyz_item_abc_, and ffestc_xyz_finish_.
+      The caller must call _start_ before calling any _item_ functions, and
+      must call _finish_ afterwards.  If it is clearly a syntactic matter as
+      to restrictions on the number and variety of _item_ calls, then the caller
+      should report any errors and ffestc_ should presume it has been taken
+      care of and handle any semantic problems with grace and no error messages.
+      If the permitted number and variety of _item_ calls has some basis in
+      semantics, then the caller should not generate any messages and ffestc
+      should do all the checking.
+
+      A few ffestc functions have names rather than grammar numbers, like
+      ffestc_elsewhere and ffestc_end.	These are cases where the actual
+      statement depends on its context rather than just its form; ELSE WHERE
+      may be the obvious (WHERE...ELSE WHERE...END WHERE) or something a little
+      more subtle (WHERE: IF THEN...ELSE WHERE...END IF WHERE).	 The actual
+      ffestc functions do exist and do work, but may or may not be invoked
+      by ffestb depending on whether some form of resolution is possible.
+      For example, ffestc_R1103 end-program-stmt is reachable directly when
+      END PROGRAM [name] is specified, or via ffestc_end when END is specified
+      and the context is a main program.  So ffestc_xyz_ should make a quick
+      determination of the context and pick the appropriate ffestc_Nxyz_
+      function to invoke, without a lot of ceremony.
+
+   Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "stc.h"
+#include "bad.h"
+#include "bld.h"
+#include "data.h"
+#include "expr.h"
+#include "global.h"
+#include "implic.h"
+#include "lex.h"
+#include "malloc.h"
+#include "src.h"
+#include "sta.h"
+#include "std.h"
+#include "stp.h"
+#include "str.h"
+#include "stt.h"
+#include "stw.h"
+
+/* Externals defined here. */
+
+ffeexprContext ffestc_iolist_context_ = FFEEXPR_contextIOLIST;
+/* Valid only from READ/WRITE start to finish. */
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+  {
+    FFESTC_orderOK_,		/* Statement ok in this context, process. */
+    FFESTC_orderBAD_,		/* Statement not ok in this context, don't
+				   process. */
+    FFESTC_orderBADOK_,		/* Don't process but push block if
+				   applicable. */
+    FFESTC
+  } ffestcOrder_;
+
+typedef enum
+  {
+    FFESTC_stateletSIMPLE_,	/* Expecting simple/start. */
+    FFESTC_stateletATTRIB_,	/* Expecting attrib/item/itemstart. */
+    FFESTC_stateletITEM_,	/* Expecting item/itemstart/finish. */
+    FFESTC_stateletITEMVALS_,	/* Expecting itemvalue/itemendvals. */
+    FFESTC_
+  } ffestcStatelet_;
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+union ffestc_local_u_
+  {
+    struct
+      {
+	ffebld initlist;	/* For list of one sym in INTEGER I/3/ case. */
+	ffetargetCharacterSize stmt_size;
+	ffetargetCharacterSize size;
+	ffeinfoBasictype basic_type;
+	ffeinfoKindtype stmt_kind_type;
+	ffeinfoKindtype kind_type;
+	bool per_var_kind_ok;
+	char is_R426;		/* 1=R426, 2=R501. */
+      }
+    decl;
+    struct
+      {
+	ffebld objlist;		/* For list of target objects. */
+	ffebldListBottom list_bottom;	/* For building lists. */
+      }
+    data;
+    struct
+      {
+	ffebldListBottom list_bottom;	/* For building lists. */
+	int entry_num;
+      }
+    dummy;
+    struct
+      {
+	ffesymbol symbol;	/* NML symbol. */
+      }
+    namelist;
+    struct
+      {
+	ffelexToken t;		/* First token in list. */
+	ffeequiv eq;		/* Current equivalence being built up. */
+	ffebld list;		/* List of expressions in equivalence. */
+	ffebldListBottom bottom;
+	bool ok;		/* TRUE while current list still being
+				   processed. */
+	bool save;		/* TRUE if any var in list is SAVEd. */
+      }
+    equiv;
+    struct
+      {
+	ffesymbol symbol;	/* BCB/NCB symbol. */
+      }
+    common;
+    struct
+      {
+	ffesymbol symbol;	/* SFN symbol. */
+      }
+    sfunc;
+#if FFESTR_VXT
+    struct
+      {
+	char list_state;	/* 0=>no field names allowed, 1=>error
+				   reported already, 2=>field names req'd,
+				   3=>have a field name. */
+      }
+    V003;
+#endif
+  };				/* Merge with the one in ffestc later. */
+
+/* Static objects accessed by functions in this module. */
+
+static bool ffestc_ok_;		/* _start_ fn's send this to _xyz_ fn's. */
+static bool ffestc_parent_ok_;	/* Parent sym for baby sym fn's ok. */
+static char ffestc_namelist_;	/* 0=>not namelist, 1=>namelist, 2=>error. */
+static union ffestc_local_u_ ffestc_local_;
+static ffestcStatelet_ ffestc_statelet_ = FFESTC_stateletSIMPLE_;
+static ffestwShriek ffestc_shriek_after1_ = NULL;
+static unsigned long ffestc_blocknum_ = 0;	/* Next block# to assign. */
+static int ffestc_entry_num_;
+static int ffestc_sfdummy_argno_;
+static int ffestc_saved_entry_num_;
+static ffelab ffestc_label_;
+
+/* Static functions (internal). */
+
+static void ffestc_R544_equiv_ (ffebld expr, ffelexToken t);
+static void ffestc_establish_declinfo_ (ffebld kind, ffelexToken kindt,
+					ffebld len, ffelexToken lent);
+static void ffestc_establish_declstmt_ (ffestpType type, ffelexToken typet,
+					ffebld kind, ffelexToken kindt,
+					ffebld len, ffelexToken lent);
+static void ffestc_establish_impletter_ (ffelexToken first, ffelexToken last);
+static ffeinfoKindtype ffestc_kindtype_kind_ (ffeinfoBasictype bt,
+					      ffetargetCharacterSize val);
+static ffeinfoKindtype ffestc_kindtype_star_ (ffeinfoBasictype bt,
+					      ffetargetCharacterSize val);
+static void ffestc_labeldef_any_ (void);
+static bool ffestc_labeldef_begin_ (void);
+static void ffestc_labeldef_branch_begin_ (void);
+static void ffestc_labeldef_branch_end_ (void);
+static void ffestc_labeldef_endif_ (void);
+static void ffestc_labeldef_format_ (void);
+static void ffestc_labeldef_invalid_ (void);
+static void ffestc_labeldef_notloop_ (void);
+static void ffestc_labeldef_notloop_begin_ (void);
+static void ffestc_labeldef_useless_ (void);
+static bool ffestc_labelref_is_assignable_ (ffelexToken label_token,
+					    ffelab *label);
+static bool ffestc_labelref_is_branch_ (ffelexToken label_token,
+					ffelab *label);
+static bool ffestc_labelref_is_format_ (ffelexToken label_token,
+					ffelab *label);
+static bool ffestc_labelref_is_loopend_ (ffelexToken label_token,
+					 ffelab *label);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_access_ (void);
+#endif
+static ffestcOrder_ ffestc_order_actiondo_ (void);
+static ffestcOrder_ ffestc_order_actionif_ (void);
+static ffestcOrder_ ffestc_order_actionwhere_ (void);
+static void ffestc_order_any_ (void);
+static void ffestc_order_bad_ (void);
+static ffestcOrder_ ffestc_order_blockdata_ (void);
+static ffestcOrder_ ffestc_order_blockspec_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_component_ (void);
+#endif
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_contains_ (void);
+#endif
+static ffestcOrder_ ffestc_order_data_ (void);
+static ffestcOrder_ ffestc_order_data77_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_derivedtype_ (void);
+#endif
+static ffestcOrder_ ffestc_order_do_ (void);
+static ffestcOrder_ ffestc_order_entry_ (void);
+static ffestcOrder_ ffestc_order_exec_ (void);
+static ffestcOrder_ ffestc_order_format_ (void);
+static ffestcOrder_ ffestc_order_function_ (void);
+static ffestcOrder_ ffestc_order_iface_ (void);
+static ffestcOrder_ ffestc_order_ifthen_ (void);
+static ffestcOrder_ ffestc_order_implicit_ (void);
+static ffestcOrder_ ffestc_order_implicitnone_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_interface_ (void);
+#endif
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_map_ (void);
+#endif
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_module_ (void);
+#endif
+static ffestcOrder_ ffestc_order_parameter_ (void);
+static ffestcOrder_ ffestc_order_program_ (void);
+static ffestcOrder_ ffestc_order_progspec_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_record_ (void);
+#endif
+static ffestcOrder_ ffestc_order_selectcase_ (void);
+static ffestcOrder_ ffestc_order_sfunc_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_spec_ (void);
+#endif
+#if FFESTR_VXT
+static ffestcOrder_ ffestc_order_structure_ (void);
+#endif
+static ffestcOrder_ ffestc_order_subroutine_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_type_ (void);
+#endif
+static ffestcOrder_ ffestc_order_typedecl_ (void);
+#if FFESTR_VXT
+static ffestcOrder_ ffestc_order_union_ (void);
+#endif
+static ffestcOrder_ ffestc_order_unit_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_use_ (void);
+#endif
+#if FFESTR_VXT
+static ffestcOrder_ ffestc_order_vxtstructure_ (void);
+#endif
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_where_ (void);
+#endif
+static void ffestc_promote_dummy_ (ffelexToken t);
+static void ffestc_promote_execdummy_ (ffelexToken t);
+static void ffestc_promote_sfdummy_ (ffelexToken t);
+static void ffestc_shriek_begin_program_ (void);
+#if FFESTR_F90
+static void ffestc_shriek_begin_uses_ (void);
+#endif
+static void ffestc_shriek_blockdata_ (bool ok);
+static void ffestc_shriek_do_ (bool ok);
+static void ffestc_shriek_end_program_ (bool ok);
+#if FFESTR_F90
+static void ffestc_shriek_end_uses_ (bool ok);
+#endif
+static void ffestc_shriek_function_ (bool ok);
+static void ffestc_shriek_if_ (bool ok);
+static void ffestc_shriek_ifthen_ (bool ok);
+#if FFESTR_F90
+static void ffestc_shriek_interface_ (bool ok);
+#endif
+#if FFESTR_F90
+static void ffestc_shriek_map_ (bool ok);
+#endif
+#if FFESTR_F90
+static void ffestc_shriek_module_ (bool ok);
+#endif
+static void ffestc_shriek_select_ (bool ok);
+#if FFESTR_VXT
+static void ffestc_shriek_structure_ (bool ok);
+#endif
+static void ffestc_shriek_subroutine_ (bool ok);
+#if FFESTR_F90
+static void ffestc_shriek_type_ (bool ok);
+#endif
+#if FFESTR_VXT
+static void ffestc_shriek_union_ (bool ok);
+#endif
+#if FFESTR_F90
+static void ffestc_shriek_where_ (bool ok);
+#endif
+#if FFESTR_F90
+static void ffestc_shriek_wherethen_ (bool ok);
+#endif
+static int ffestc_subr_binsrch_ (char **list, int size, ffestpFile *spec,
+				 char *whine);
+static ffestvFormat ffestc_subr_format_ (ffestpFile *spec);
+static bool ffestc_subr_is_branch_ (ffestpFile *spec);
+static bool ffestc_subr_is_format_ (ffestpFile *spec);
+static bool ffestc_subr_is_present_ (char *name, ffestpFile *spec);
+static int ffestc_subr_speccmp_ (char *string, ffestpFile *spec,
+				 char **target, int *length);
+static ffestvUnit ffestc_subr_unit_ (ffestpFile *spec);
+static void ffestc_try_shriek_do_ (void);
+
+/* Internal macros. */
+
+#define ffestc_check_simple_() \
+      assert(ffestc_statelet_ == FFESTC_stateletSIMPLE_)
+#define ffestc_check_start_() \
+      assert(ffestc_statelet_ == FFESTC_stateletSIMPLE_); \
+      ffestc_statelet_ = FFESTC_stateletATTRIB_
+#define ffestc_check_attrib_() \
+      assert(ffestc_statelet_ == FFESTC_stateletATTRIB_)
+#define ffestc_check_item_() \
+      assert(ffestc_statelet_ == FFESTC_stateletATTRIB_	 \
+	    || ffestc_statelet_ == FFESTC_stateletITEM_); \
+      ffestc_statelet_ = FFESTC_stateletITEM_
+#define ffestc_check_item_startvals_() \
+      assert(ffestc_statelet_ == FFESTC_stateletATTRIB_	 \
+	    || ffestc_statelet_ == FFESTC_stateletITEM_); \
+      ffestc_statelet_ = FFESTC_stateletITEMVALS_
+#define ffestc_check_item_value_() \
+      assert(ffestc_statelet_ == FFESTC_stateletITEMVALS_)
+#define ffestc_check_item_endvals_() \
+      assert(ffestc_statelet_ == FFESTC_stateletITEMVALS_); \
+      ffestc_statelet_ = FFESTC_stateletITEM_
+#define ffestc_check_finish_() \
+      assert(ffestc_statelet_ == FFESTC_stateletATTRIB_	 \
+	    || ffestc_statelet_ == FFESTC_stateletITEM_); \
+      ffestc_statelet_ = FFESTC_stateletSIMPLE_
+#define ffestc_order_action_() ffestc_order_exec_()
+#if FFESTR_F90
+#define ffestc_order_interfacespec_() ffestc_order_derivedtype_()
+#endif
+#define ffestc_shriek_if_lost_ ffestc_shriek_if_
+#if FFESTR_F90
+#define ffestc_shriek_where_lost_ ffestc_shriek_where_
+#endif
+
+/* ffestc_establish_declinfo_ -- Determine specific type/params info for entity
+
+   ffestc_establish_declinfo_(kind,kind_token,len,len_token);
+
+   Must be called after _declstmt_ called to establish base type.  */
+
+static void
+ffestc_establish_declinfo_ (ffebld kind, ffelexToken kindt, ffebld len,
+			    ffelexToken lent)
+{
+  ffeinfoBasictype bt = ffestc_local_.decl.basic_type;
+  ffeinfoKindtype kt;
+  ffetargetCharacterSize val;
+
+  if (kindt == NULL)
+    kt = ffestc_local_.decl.stmt_kind_type;
+  else if (!ffestc_local_.decl.per_var_kind_ok)
+    {
+      ffebad_start (FFEBAD_KINDTYPE);
+      ffebad_here (0, ffelex_token_where_line (kindt),
+		   ffelex_token_where_column (kindt));
+      ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_finish ();
+      kt = ffestc_local_.decl.stmt_kind_type;
+    }
+  else
+    {
+      if (kind == NULL)
+	{
+	  assert (ffelex_token_type (kindt) == FFELEX_typeNUMBER);
+	  val = atol (ffelex_token_text (kindt));
+	  kt = ffestc_kindtype_star_ (bt, val);
+	}
+      else if (ffebld_op (kind) == FFEBLD_opANY)
+	kt = ffestc_local_.decl.stmt_kind_type;
+      else
+	{
+	  assert (ffebld_op (kind) == FFEBLD_opCONTER);
+	  assert (ffeinfo_basictype (ffebld_info (kind))
+		  == FFEINFO_basictypeINTEGER);
+	  assert (ffeinfo_kindtype (ffebld_info (kind))
+		  == FFEINFO_kindtypeINTEGERDEFAULT);
+	  val = ffebld_constant_integerdefault (ffebld_conter (kind));
+	  kt = ffestc_kindtype_kind_ (bt, val);
+	}
+
+      if (kt == FFEINFO_kindtypeNONE)
+	{			/* Not valid kind type. */
+	  ffebad_start (FFEBAD_KINDTYPE);
+	  ffebad_here (0, ffelex_token_where_line (kindt),
+		       ffelex_token_where_column (kindt));
+	  ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]),
+		       ffelex_token_where_column (ffesta_tokens[0]));
+	  ffebad_finish ();
+	  kt = ffestc_local_.decl.stmt_kind_type;
+	}
+    }
+
+  ffestc_local_.decl.kind_type = kt;
+
+  /* Now check length specification for CHARACTER data type. */
+
+  if (((len == NULL) && (lent == NULL))
+      || (bt != FFEINFO_basictypeCHARACTER))
+    val = ffestc_local_.decl.stmt_size;
+  else
+    {
+      if (len == NULL)
+	{
+	  assert (ffelex_token_type (lent) == FFELEX_typeNUMBER);
+	  val = atol (ffelex_token_text (lent));
+	}
+      else if (ffebld_op (len) == FFEBLD_opSTAR)
+	val = FFETARGET_charactersizeNONE;
+      else if (ffebld_op (len) == FFEBLD_opANY)
+	val = FFETARGET_charactersizeNONE;
+      else
+	{
+	  assert (ffebld_op (len) == FFEBLD_opCONTER);
+	  assert (ffeinfo_basictype (ffebld_info (len))
+		  == FFEINFO_basictypeINTEGER);
+	  assert (ffeinfo_kindtype (ffebld_info (len))
+		  == FFEINFO_kindtypeINTEGERDEFAULT);
+	  val = ffebld_constant_integerdefault (ffebld_conter (len));
+	}
+    }
+
+  if ((val == 0) && !(0 && ffe_is_90 ()))
+    {
+      val = 1;
+      ffebad_start (FFEBAD_ZERO_SIZE);
+      ffebad_here (0, ffelex_token_where_line (lent), ffelex_token_where_column (lent));
+      ffebad_finish ();
+    }
+  ffestc_local_.decl.size = val;
+}
+
+/* ffestc_establish_declstmt_ -- Establish host-specific type/params info
+
+   ffestc_establish_declstmt_(type,type_token,kind,kind_token,len,
+	 len_token);  */
+
+static void
+ffestc_establish_declstmt_ (ffestpType type, ffelexToken typet, ffebld kind,
+			    ffelexToken kindt, ffebld len, ffelexToken lent)
+{
+  ffeinfoBasictype bt;
+  ffeinfoKindtype ktd;		/* Default kindtype. */
+  ffeinfoKindtype kt;
+  ffetargetCharacterSize val;
+  bool per_var_kind_ok = TRUE;
+
+  /* Determine basictype and default kindtype. */
+
+  switch (type)
+    {
+    case FFESTP_typeINTEGER:
+      bt = FFEINFO_basictypeINTEGER;
+      ktd = FFEINFO_kindtypeINTEGERDEFAULT;
+      break;
+
+    case FFESTP_typeBYTE:
+      bt = FFEINFO_basictypeINTEGER;
+      ktd = FFEINFO_kindtypeINTEGER2;
+      break;
+
+    case FFESTP_typeWORD:
+      bt = FFEINFO_basictypeINTEGER;
+      ktd = FFEINFO_kindtypeINTEGER3;
+      break;
+
+    case FFESTP_typeREAL:
+      bt = FFEINFO_basictypeREAL;
+      ktd = FFEINFO_kindtypeREALDEFAULT;
+      break;
+
+    case FFESTP_typeCOMPLEX:
+      bt = FFEINFO_basictypeCOMPLEX;
+      ktd = FFEINFO_kindtypeREALDEFAULT;
+      break;
+
+    case FFESTP_typeLOGICAL:
+      bt = FFEINFO_basictypeLOGICAL;
+      ktd = FFEINFO_kindtypeLOGICALDEFAULT;
+      break;
+
+    case FFESTP_typeCHARACTER:
+      bt = FFEINFO_basictypeCHARACTER;
+      ktd = FFEINFO_kindtypeCHARACTERDEFAULT;
+      break;
+
+    case FFESTP_typeDBLPRCSN:
+      bt = FFEINFO_basictypeREAL;
+      ktd = FFEINFO_kindtypeREALDOUBLE;
+      per_var_kind_ok = FALSE;
+      break;
+
+    case FFESTP_typeDBLCMPLX:
+      bt = FFEINFO_basictypeCOMPLEX;
+#if FFETARGET_okCOMPLEX2
+      ktd = FFEINFO_kindtypeREALDOUBLE;
+#else
+      ktd = FFEINFO_kindtypeREALDEFAULT;
+      ffebad_start (FFEBAD_BAD_DBLCMPLX);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_finish ();
+#endif
+      per_var_kind_ok = FALSE;
+      break;
+
+    default:
+      assert ("Unexpected type (F90 TYPE?)!" == NULL);
+      bt = FFEINFO_basictypeNONE;
+      ktd = FFEINFO_kindtypeNONE;
+      break;
+    }
+
+  if (kindt == NULL)
+    kt = ktd;
+  else
+    {				/* Not necessarily default kind type. */
+      if (kind == NULL)
+	{			/* Shouldn't happen for CHARACTER. */
+	  assert (ffelex_token_type (kindt) == FFELEX_typeNUMBER);
+	  val = atol (ffelex_token_text (kindt));
+	  kt = ffestc_kindtype_star_ (bt, val);
+	}
+      else if (ffebld_op (kind) == FFEBLD_opANY)
+	kt = ktd;
+      else
+	{
+	  assert (ffebld_op (kind) == FFEBLD_opCONTER);
+	  assert (ffeinfo_basictype (ffebld_info (kind))
+		  == FFEINFO_basictypeINTEGER);
+	  assert (ffeinfo_kindtype (ffebld_info (kind))
+		  == FFEINFO_kindtypeINTEGERDEFAULT);
+	  val = ffebld_constant_integerdefault (ffebld_conter (kind));
+	  kt = ffestc_kindtype_kind_ (bt, val);
+	}
+
+      if (kt == FFEINFO_kindtypeNONE)
+	{			/* Not valid kind type. */
+	  ffebad_start (FFEBAD_KINDTYPE);
+	  ffebad_here (0, ffelex_token_where_line (kindt),
+		       ffelex_token_where_column (kindt));
+	  ffebad_here (1, ffelex_token_where_line (typet),
+		       ffelex_token_where_column (typet));
+	  ffebad_finish ();
+	  kt = ktd;
+	}
+    }
+
+  ffestc_local_.decl.basic_type = bt;
+  ffestc_local_.decl.stmt_kind_type = kt;
+  ffestc_local_.decl.per_var_kind_ok = per_var_kind_ok;
+
+  /* Now check length specification for CHARACTER data type. */
+
+  if (((len == NULL) && (lent == NULL))
+      || (type != FFESTP_typeCHARACTER))
+    val = (type == FFESTP_typeCHARACTER) ? 1 : FFETARGET_charactersizeNONE;
+  else
+    {
+      if (len == NULL)
+	{
+	  assert (ffelex_token_type (lent) == FFELEX_typeNUMBER);
+	  val = atol (ffelex_token_text (lent));
+	}
+      else if (ffebld_op (len) == FFEBLD_opSTAR)
+	val = FFETARGET_charactersizeNONE;
+      else if (ffebld_op (len) == FFEBLD_opANY)
+	val = FFETARGET_charactersizeNONE;
+      else
+	{
+	  assert (ffebld_op (len) == FFEBLD_opCONTER);
+	  assert (ffeinfo_basictype (ffebld_info (len))
+		  == FFEINFO_basictypeINTEGER);
+	  assert (ffeinfo_kindtype (ffebld_info (len))
+		  == FFEINFO_kindtypeINTEGERDEFAULT);
+	  val = ffebld_constant_integerdefault (ffebld_conter (len));
+	}
+    }
+
+  if ((val == 0) && !(0 && ffe_is_90 ()))
+    {
+      val = 1;
+      ffebad_start (FFEBAD_ZERO_SIZE);
+      ffebad_here (0, ffelex_token_where_line (lent), ffelex_token_where_column (lent));
+      ffebad_finish ();
+    }
+  ffestc_local_.decl.stmt_size = val;
+}
+
+/* ffestc_establish_impletter_ -- Establish type/params for IMPLICIT letter(s)
+
+   ffestc_establish_impletter_(first_letter_token,last_letter_token);  */
+
+static void
+ffestc_establish_impletter_ (ffelexToken first, ffelexToken last)
+{
+  bool ok = FALSE;		/* Stays FALSE if first letter > last. */
+  char c;
+
+  if (last == NULL)
+    ok = ffeimplic_establish_initial (c = *(ffelex_token_text (first)),
+				      ffestc_local_.decl.basic_type,
+				      ffestc_local_.decl.kind_type,
+				      ffestc_local_.decl.size);
+  else
+    {
+      for (c = *(ffelex_token_text (first));
+	   c <= *(ffelex_token_text (last));
+	   c++)
+	{
+	  ok = ffeimplic_establish_initial (c,
+					    ffestc_local_.decl.basic_type,
+					    ffestc_local_.decl.kind_type,
+					    ffestc_local_.decl.size);
+	  if (!ok)
+	    break;
+	}
+    }
+
+  if (!ok)
+    {
+      char cs[2];
+
+      cs[0] = c;
+      cs[1] = '\0';
+
+      ffebad_start (FFEBAD_BAD_IMPLICIT);
+      ffebad_here (0, ffelex_token_where_line (first), ffelex_token_where_column (first));
+      ffebad_string (cs);
+      ffebad_finish ();
+    }
+}
+
+/* ffestc_init_3 -- Initialize ffestc for new program unit
+
+   ffestc_init_3();  */
+
+void
+ffestc_init_3 ()
+{
+  ffestv_save_state_ = FFESTV_savestateNONE;
+  ffestc_entry_num_ = 0;
+  ffestv_num_label_defines_ = 0;
+}
+
+/* ffestc_init_4 -- Initialize ffestc for new scoping unit
+
+   ffestc_init_4();
+
+   For SUBROUTINEs/FUNCTIONs within INTERFACE/END INTERFACE, derived-TYPE-
+   defs, and statement function defs.  */
+
+void
+ffestc_init_4 ()
+{
+  ffestc_saved_entry_num_ = ffestc_entry_num_;
+  ffestc_entry_num_ = 0;
+}
+
+/* ffestc_kindtype_kind_ -- Determine kindtype from basictype and KIND= value
+
+   ffeinfoKindtype kt;
+   ffeinfoBasictype bt;
+   ffetargetCharacterSize val;
+   kt = ffestc_kindtype_kind_(bt,val);
+   if (kt == FFEINFO_kindtypeNONE)
+       // unsupported/invalid KIND= value for type  */
+
+static ffeinfoKindtype
+ffestc_kindtype_kind_ (ffeinfoBasictype bt, ffetargetCharacterSize val)
+{
+  ffetype type;
+  ffetype base_type;
+  ffeinfoKindtype kt;
+
+  base_type = ffeinfo_type (bt, 1);	/* ~~ */
+  assert (base_type != NULL);
+
+  type = ffetype_lookup_kind (base_type, (int) val);
+  if (type == NULL)
+    return FFEINFO_kindtypeNONE;
+
+  for (kt = 1; kt < FFEINFO_kindtype; ++kt)
+    if (ffeinfo_type (bt, kt) == type)
+      return kt;
+
+  return FFEINFO_kindtypeNONE;
+}
+
+/* ffestc_kindtype_star_ -- Determine kindtype from basictype and * value
+
+   ffeinfoKindtype kt;
+   ffeinfoBasictype bt;
+   ffetargetCharacterSize val;
+   kt = ffestc_kindtype_star_(bt,val);
+   if (kt == FFEINFO_kindtypeNONE)
+       // unsupported/invalid * value for type	*/
+
+static ffeinfoKindtype
+ffestc_kindtype_star_ (ffeinfoBasictype bt, ffetargetCharacterSize val)
+{
+  ffetype type;
+  ffetype base_type;
+  ffeinfoKindtype kt;
+
+  base_type = ffeinfo_type (bt, 1);	/* ~~ */
+  assert (base_type != NULL);
+
+  type = ffetype_lookup_star (base_type, (int) val);
+  if (type == NULL)
+    return FFEINFO_kindtypeNONE;
+
+  for (kt = 1; kt < FFEINFO_kindtype; ++kt)
+    if (ffeinfo_type (bt, kt) == type)
+      return kt;
+
+  return FFEINFO_kindtypeNONE;
+}
+
+/* Define label as usable for anything without complaint.  */
+
+static void
+ffestc_labeldef_any_ ()
+{
+  if ((ffesta_label_token == NULL)
+      || !ffestc_labeldef_begin_ ())
+    return;
+
+  ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+  ffestd_labeldef_any (ffestc_label_);
+
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_labeldef_begin_ -- Define label as unknown, initially
+
+   ffestc_labeldef_begin_();  */
+
+static bool
+ffestc_labeldef_begin_ ()
+{
+  ffelabValue label_value;
+  ffelab label;
+
+  label_value = (ffelabValue) atol (ffelex_token_text (ffesta_label_token));
+  if ((label_value == 0) || (label_value > FFELAB_valueMAX))
+    {
+      ffebad_start (FFEBAD_LABEL_NUMBER_INVALID);
+      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+		   ffelex_token_where_column (ffesta_label_token));
+      ffebad_finish ();
+    }
+
+  label = ffelab_find (label_value);
+  if (label == NULL)
+    {
+      label = ffestc_label_ = ffelab_new (label_value);
+      ffestv_num_label_defines_++;
+      ffelab_set_definition_line (label,
+	  ffewhere_line_use (ffelex_token_where_line (ffesta_label_token)));
+      ffelab_set_definition_column (label,
+      ffewhere_column_use (ffelex_token_where_column (ffesta_label_token)));
+
+      return TRUE;
+    }
+
+  if (ffewhere_line_is_unknown (ffelab_definition_line (label)))
+    {
+      ffestv_num_label_defines_++;
+      ffestc_label_ = label;
+      ffelab_set_definition_line (label,
+	  ffewhere_line_use (ffelex_token_where_line (ffesta_label_token)));
+      ffelab_set_definition_column (label,
+      ffewhere_column_use (ffelex_token_where_column (ffesta_label_token)));
+
+      return TRUE;
+    }
+
+  ffebad_start (FFEBAD_LABEL_ALREADY_DEFINED);
+  ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+	       ffelex_token_where_column (ffesta_label_token));
+  ffebad_here (1, ffelab_definition_line (label),
+	       ffelab_definition_column (label));
+  ffebad_string (ffelex_token_text (ffesta_label_token));
+  ffebad_finish ();
+
+  ffelex_token_kill (ffesta_label_token);
+  ffesta_label_token = NULL;
+  return FALSE;
+}
+
+/* ffestc_labeldef_branch_begin_ -- Define label as a branch target one
+
+   ffestc_labeldef_branch_begin_();  */
+
+static void
+ffestc_labeldef_branch_begin_ ()
+{
+  if ((ffesta_label_token == NULL)
+      || (ffestc_shriek_after1_ != NULL)
+      || !ffestc_labeldef_begin_ ())
+    return;
+
+  switch (ffelab_type (ffestc_label_))
+    {
+    case FFELAB_typeUNKNOWN:
+    case FFELAB_typeASSIGNABLE:
+      ffelab_set_type (ffestc_label_, FFELAB_typeNOTLOOP);
+      ffelab_set_blocknum (ffestc_label_,
+			   ffestw_blocknum (ffestw_stack_top ()));
+      ffestd_labeldef_branch (ffestc_label_);
+      break;
+
+    case FFELAB_typeNOTLOOP:
+      if (ffelab_blocknum (ffestc_label_)
+	  < ffestw_blocknum (ffestw_stack_top ()))
+	{
+	  ffebad_start (FFEBAD_LABEL_BLOCK);
+	  ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+		       ffelex_token_where_column (ffesta_label_token));
+	  ffebad_here (1, ffelab_firstref_line (ffestc_label_),
+		       ffelab_firstref_column (ffestc_label_));
+	  ffebad_finish ();
+	}
+      ffelab_set_blocknum (ffestc_label_,
+			   ffestw_blocknum (ffestw_stack_top ()));
+      ffestd_labeldef_branch (ffestc_label_);
+      break;
+
+    case FFELAB_typeLOOPEND:
+      if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
+	  || (ffestw_label (ffestw_stack_top ()) != ffestc_label_))
+	{			/* Unterminated block. */
+	  ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+	  ffestd_labeldef_any (ffestc_label_);
+
+	  ffebad_start (FFEBAD_LABEL_DO_BLOCK_END);
+	  ffebad_here (0, ffelab_doref_line (ffestc_label_),
+		       ffelab_doref_column (ffestc_label_));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_here (2, ffelex_token_where_line (ffesta_label_token),
+		       ffelex_token_where_column (ffesta_label_token));
+	  ffebad_finish ();
+	  break;
+	}
+      ffestd_labeldef_branch (ffestc_label_);
+      /* Leave something around for _branch_end_() to handle. */
+      return;
+
+    case FFELAB_typeFORMAT:
+      ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+      ffestd_labeldef_any (ffestc_label_);
+
+      ffebad_start (FFEBAD_LABEL_USE_DEF);
+      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+		   ffelex_token_where_column (ffesta_label_token));
+      ffebad_here (1, ffelab_firstref_line (ffestc_label_),
+		   ffelab_firstref_column (ffestc_label_));
+      ffebad_finish ();
+      break;
+
+    default:
+      assert ("bad label" == NULL);
+      /* Fall through.  */
+    case FFELAB_typeANY:
+      break;
+    }
+
+  ffestc_try_shriek_do_ ();
+
+  ffelex_token_kill (ffesta_label_token);
+  ffesta_label_token = NULL;
+}
+
+/* Define possible end of labeled-DO-loop.  Call only after calling
+   ffestc_labeldef_branch_begin_, or when other branch_* functions
+   recognize that a label might also be serving as a branch end (in
+   which case they must issue a diagnostic).  */
+
+static void
+ffestc_labeldef_branch_end_ ()
+{
+  if (ffesta_label_token == NULL)
+    return;
+
+  assert (ffestc_label_ != NULL);
+  assert ((ffelab_type (ffestc_label_) == FFELAB_typeLOOPEND)
+	  || (ffelab_type (ffestc_label_) == FFELAB_typeANY));
+
+  while ((ffestw_state (ffestw_stack_top ()) == FFESTV_stateDO)
+	 && (ffestw_label (ffestw_stack_top ()) == ffestc_label_))
+    ffestc_shriek_do_ (TRUE);
+
+  ffestc_try_shriek_do_ ();
+
+  ffelex_token_kill (ffesta_label_token);
+  ffesta_label_token = NULL;
+}
+
+/* ffestc_labeldef_endif_ -- Define label as an END IF one
+
+   ffestc_labeldef_endif_();  */
+
+static void
+ffestc_labeldef_endif_ ()
+{
+  if ((ffesta_label_token == NULL)
+      || (ffestc_shriek_after1_ != NULL)
+      || !ffestc_labeldef_begin_ ())
+    return;
+
+  switch (ffelab_type (ffestc_label_))
+    {
+    case FFELAB_typeUNKNOWN:
+    case FFELAB_typeASSIGNABLE:
+      ffelab_set_type (ffestc_label_, FFELAB_typeENDIF);
+      ffelab_set_blocknum (ffestc_label_,
+		   ffestw_blocknum (ffestw_previous (ffestw_stack_top ())));
+      ffestd_labeldef_endif (ffestc_label_);
+      break;
+
+    case FFELAB_typeNOTLOOP:
+      if (ffelab_blocknum (ffestc_label_)
+	  < ffestw_blocknum (ffestw_previous (ffestw_stack_top ())))
+	{
+	  ffebad_start (FFEBAD_LABEL_BLOCK);
+	  ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+		       ffelex_token_where_column (ffesta_label_token));
+	  ffebad_here (1, ffelab_firstref_line (ffestc_label_),
+		       ffelab_firstref_column (ffestc_label_));
+	  ffebad_finish ();
+	}
+      ffelab_set_blocknum (ffestc_label_,
+		   ffestw_blocknum (ffestw_previous (ffestw_stack_top ())));
+      ffestd_labeldef_endif (ffestc_label_);
+      break;
+
+    case FFELAB_typeLOOPEND:
+      if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
+	  || (ffestw_label (ffestw_stack_top ()) != ffestc_label_))
+	{			/* Unterminated block. */
+	  ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+	  ffestd_labeldef_any (ffestc_label_);
+
+	  ffebad_start (FFEBAD_LABEL_DO_BLOCK_END);
+	  ffebad_here (0, ffelab_doref_line (ffestc_label_),
+		       ffelab_doref_column (ffestc_label_));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_here (2, ffelex_token_where_line (ffesta_label_token),
+		       ffelex_token_where_column (ffesta_label_token));
+	  ffebad_finish ();
+	  break;
+	}
+      ffestd_labeldef_endif (ffestc_label_);
+      ffebad_start (FFEBAD_LABEL_USE_DEF);
+      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+		   ffelex_token_where_column (ffesta_label_token));
+      ffebad_here (1, ffelab_doref_line (ffestc_label_),
+		   ffelab_doref_column (ffestc_label_));
+      ffebad_finish ();
+      ffestc_labeldef_branch_end_ ();
+      return;
+
+    case FFELAB_typeFORMAT:
+      ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+      ffestd_labeldef_any (ffestc_label_);
+
+      ffebad_start (FFEBAD_LABEL_USE_DEF);
+      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+		   ffelex_token_where_column (ffesta_label_token));
+      ffebad_here (1, ffelab_firstref_line (ffestc_label_),
+		   ffelab_firstref_column (ffestc_label_));
+      ffebad_finish ();
+      break;
+
+    default:
+      assert ("bad label" == NULL);
+      /* Fall through.  */
+    case FFELAB_typeANY:
+      break;
+    }
+
+  ffestc_try_shriek_do_ ();
+
+  ffelex_token_kill (ffesta_label_token);
+  ffesta_label_token = NULL;
+}
+
+/* ffestc_labeldef_format_ -- Define label as a FORMAT one
+
+   ffestc_labeldef_format_();  */
+
+static void
+ffestc_labeldef_format_ ()
+{
+  if ((ffesta_label_token == NULL)
+      || (ffestc_shriek_after1_ != NULL))
+    {
+      ffebad_start (FFEBAD_FORMAT_NO_LABEL_DEF);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_finish ();
+      return;
+    }
+
+  if (!ffestc_labeldef_begin_ ())
+    return;
+
+  switch (ffelab_type (ffestc_label_))
+    {
+    case FFELAB_typeUNKNOWN:
+    case FFELAB_typeASSIGNABLE:
+      ffelab_set_type (ffestc_label_, FFELAB_typeFORMAT);
+      ffestd_labeldef_format (ffestc_label_);
+      break;
+
+    case FFELAB_typeFORMAT:
+      ffestd_labeldef_format (ffestc_label_);
+      break;
+
+    case FFELAB_typeLOOPEND:
+      if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
+	  || (ffestw_label (ffestw_stack_top ()) != ffestc_label_))
+	{			/* Unterminated block. */
+	  ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+	  ffestd_labeldef_any (ffestc_label_);
+
+	  ffebad_start (FFEBAD_LABEL_DO_BLOCK_END);
+	  ffebad_here (0, ffelab_doref_line (ffestc_label_),
+		       ffelab_doref_column (ffestc_label_));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_here (2, ffelex_token_where_line (ffesta_label_token),
+		       ffelex_token_where_column (ffesta_label_token));
+	  ffebad_finish ();
+	  break;
+	}
+      ffestd_labeldef_format (ffestc_label_);
+      ffebad_start (FFEBAD_LABEL_USE_DEF);
+      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+		   ffelex_token_where_column (ffesta_label_token));
+      ffebad_here (1, ffelab_doref_line (ffestc_label_),
+		   ffelab_doref_column (ffestc_label_));
+      ffebad_finish ();
+      ffestc_labeldef_branch_end_ ();
+      return;
+
+    case FFELAB_typeNOTLOOP:
+      ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+      ffestd_labeldef_any (ffestc_label_);
+
+      ffebad_start (FFEBAD_LABEL_USE_DEF);
+      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+		   ffelex_token_where_column (ffesta_label_token));
+      ffebad_here (1, ffelab_firstref_line (ffestc_label_),
+		   ffelab_firstref_column (ffestc_label_));
+      ffebad_finish ();
+      break;
+
+    default:
+      assert ("bad label" == NULL);
+      /* Fall through.  */
+    case FFELAB_typeANY:
+      break;
+    }
+
+  ffestc_try_shriek_do_ ();
+
+  ffelex_token_kill (ffesta_label_token);
+  ffesta_label_token = NULL;
+}
+
+/* ffestc_labeldef_invalid_ -- Label definition invalid, complain if present
+
+   ffestc_labeldef_invalid_();	*/
+
+static void
+ffestc_labeldef_invalid_ ()
+{
+  if ((ffesta_label_token == NULL)
+      || (ffestc_shriek_after1_ != NULL)
+      || !ffestc_labeldef_begin_ ())
+    return;
+
+  ffebad_start (FFEBAD_INVALID_LABEL_DEF);
+  ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+	       ffelex_token_where_column (ffesta_label_token));
+  ffebad_finish ();
+
+  ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+  ffestd_labeldef_any (ffestc_label_);
+
+  ffestc_try_shriek_do_ ();
+
+  ffelex_token_kill (ffesta_label_token);
+  ffesta_label_token = NULL;
+}
+
+/* Define label as a non-loop-ending one on a statement that can't
+   be in the "then" part of a logical IF, such as a block-IF statement.  */
+
+static void
+ffestc_labeldef_notloop_ ()
+{
+  if (ffesta_label_token == NULL)
+    return;
+
+  assert (ffestc_shriek_after1_ == NULL);
+
+  ffestc_labeldef_notloop_begin_ ();
+}
+
+/* Define label as a non-loop-ending one.  Use this when it is
+   possible that the pending label is inhibited because we're in
+   the midst of a logical-IF, and thus _branch_end_ is going to
+   be called after the current statement to resolve a potential
+   loop-ending label.  */
+
+static void
+ffestc_labeldef_notloop_begin_ ()
+{
+  if ((ffesta_label_token == NULL)
+      || (ffestc_shriek_after1_ != NULL)
+      || !ffestc_labeldef_begin_ ())
+    return;
+
+  switch (ffelab_type (ffestc_label_))
+    {
+    case FFELAB_typeUNKNOWN:
+    case FFELAB_typeASSIGNABLE:
+      ffelab_set_type (ffestc_label_, FFELAB_typeNOTLOOP);
+      ffelab_set_blocknum (ffestc_label_,
+			   ffestw_blocknum (ffestw_stack_top ()));
+      ffestd_labeldef_notloop (ffestc_label_);
+      break;
+
+    case FFELAB_typeNOTLOOP:
+      if (ffelab_blocknum (ffestc_label_)
+	  < ffestw_blocknum (ffestw_stack_top ()))
+	{
+	  ffebad_start (FFEBAD_LABEL_BLOCK);
+	  ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+		       ffelex_token_where_column (ffesta_label_token));
+	  ffebad_here (1, ffelab_firstref_line (ffestc_label_),
+		       ffelab_firstref_column (ffestc_label_));
+	  ffebad_finish ();
+	}
+      ffelab_set_blocknum (ffestc_label_,
+			   ffestw_blocknum (ffestw_stack_top ()));
+      ffestd_labeldef_notloop (ffestc_label_);
+      break;
+
+    case FFELAB_typeLOOPEND:
+      if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
+	  || (ffestw_label (ffestw_stack_top ()) != ffestc_label_))
+	{			/* Unterminated block. */
+	  ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+	  ffestd_labeldef_any (ffestc_label_);
+
+	  ffebad_start (FFEBAD_LABEL_DO_BLOCK_END);
+	  ffebad_here (0, ffelab_doref_line (ffestc_label_),
+		       ffelab_doref_column (ffestc_label_));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_here (2, ffelex_token_where_line (ffesta_label_token),
+		       ffelex_token_where_column (ffesta_label_token));
+	  ffebad_finish ();
+	  break;
+	}
+      ffestd_labeldef_notloop (ffestc_label_);
+      ffebad_start (FFEBAD_LABEL_USE_DEF);
+      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+		   ffelex_token_where_column (ffesta_label_token));
+      ffebad_here (1, ffelab_doref_line (ffestc_label_),
+		   ffelab_doref_column (ffestc_label_));
+      ffebad_finish ();
+      ffestc_labeldef_branch_end_ ();
+      return;
+
+    case FFELAB_typeFORMAT:
+      ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+      ffestd_labeldef_any (ffestc_label_);
+
+      ffebad_start (FFEBAD_LABEL_USE_DEF);
+      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+		   ffelex_token_where_column (ffesta_label_token));
+      ffebad_here (1, ffelab_firstref_line (ffestc_label_),
+		   ffelab_firstref_column (ffestc_label_));
+      ffebad_finish ();
+      break;
+
+    default:
+      assert ("bad label" == NULL);
+      /* Fall through.  */
+    case FFELAB_typeANY:
+      break;
+    }
+
+  ffestc_try_shriek_do_ ();
+
+  ffelex_token_kill (ffesta_label_token);
+  ffesta_label_token = NULL;
+}
+
+/* ffestc_labeldef_useless_ -- Define label as a useless one
+
+   ffestc_labeldef_useless_();	*/
+
+static void
+ffestc_labeldef_useless_ ()
+{
+  if ((ffesta_label_token == NULL)
+      || (ffestc_shriek_after1_ != NULL)
+      || !ffestc_labeldef_begin_ ())
+    return;
+
+  switch (ffelab_type (ffestc_label_))
+    {
+    case FFELAB_typeUNKNOWN:
+      ffelab_set_type (ffestc_label_, FFELAB_typeUSELESS);
+      ffestd_labeldef_useless (ffestc_label_);
+      break;
+
+    case FFELAB_typeLOOPEND:
+      ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+      ffestd_labeldef_any (ffestc_label_);
+
+      if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
+	  || (ffestw_label (ffestw_stack_top ()) != ffestc_label_))
+	{			/* Unterminated block. */
+	  ffebad_start (FFEBAD_LABEL_DO_BLOCK_END);
+	  ffebad_here (0, ffelab_doref_line (ffestc_label_),
+		       ffelab_doref_column (ffestc_label_));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_here (2, ffelex_token_where_line (ffesta_label_token),
+		       ffelex_token_where_column (ffesta_label_token));
+	  ffebad_finish ();
+	  break;
+	}
+      ffebad_start (FFEBAD_LABEL_USE_DEF);
+      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+		   ffelex_token_where_column (ffesta_label_token));
+      ffebad_here (1, ffelab_doref_line (ffestc_label_),
+		   ffelab_doref_column (ffestc_label_));
+      ffebad_finish ();
+      ffestc_labeldef_branch_end_ ();
+      return;
+
+    case FFELAB_typeASSIGNABLE:
+    case FFELAB_typeFORMAT:
+    case FFELAB_typeNOTLOOP:
+      ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+      ffestd_labeldef_any (ffestc_label_);
+
+      ffebad_start (FFEBAD_LABEL_USE_DEF);
+      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+		   ffelex_token_where_column (ffesta_label_token));
+      ffebad_here (1, ffelab_firstref_line (ffestc_label_),
+		   ffelab_firstref_column (ffestc_label_));
+      ffebad_finish ();
+      break;
+
+    default:
+      assert ("bad label" == NULL);
+      /* Fall through.  */
+    case FFELAB_typeANY:
+      break;
+    }
+
+  ffestc_try_shriek_do_ ();
+
+  ffelex_token_kill (ffesta_label_token);
+  ffesta_label_token = NULL;
+}
+
+/* ffestc_labelref_is_assignable_ -- Reference to label in ASSIGN stmt
+
+   if (ffestc_labelref_is_assignable_(label_token,&label))
+       // label ref is ok, label is filled in with ffelab object  */
+
+static bool
+ffestc_labelref_is_assignable_ (ffelexToken label_token, ffelab *x_label)
+{
+  ffelab label;
+  ffelabValue label_value;
+
+  label_value = (ffelabValue) atol (ffelex_token_text (label_token));
+  if ((label_value == 0) || (label_value > FFELAB_valueMAX))
+    {
+      ffebad_start (FFEBAD_LABEL_NUMBER_INVALID);
+      ffebad_here (0, ffelex_token_where_line (label_token),
+		   ffelex_token_where_column (label_token));
+      ffebad_finish ();
+      return FALSE;
+    }
+
+  label = ffelab_find (label_value);
+  if (label == NULL)
+    {
+      label = ffelab_new (label_value);
+      ffelab_set_firstref_line (label,
+		 ffewhere_line_use (ffelex_token_where_line (label_token)));
+      ffelab_set_firstref_column (label,
+	     ffewhere_column_use (ffelex_token_where_column (label_token)));
+    }
+
+  switch (ffelab_type (label))
+    {
+    case FFELAB_typeUNKNOWN:
+      ffelab_set_type (label, FFELAB_typeASSIGNABLE);
+      break;
+
+    case FFELAB_typeASSIGNABLE:
+    case FFELAB_typeLOOPEND:
+    case FFELAB_typeFORMAT:
+    case FFELAB_typeNOTLOOP:
+    case FFELAB_typeENDIF:
+      break;
+
+    case FFELAB_typeUSELESS:
+      ffelab_set_type (label, FFELAB_typeANY);
+      ffestd_labeldef_any (label);
+
+      ffebad_start (FFEBAD_LABEL_USE_DEF);
+      ffebad_here (0, ffelab_firstref_line (label), ffelab_firstref_column (label));
+      ffebad_here (1, ffelex_token_where_line (label_token),
+		   ffelex_token_where_column (label_token));
+      ffebad_finish ();
+
+      ffestc_try_shriek_do_ ();
+
+      return FALSE;
+
+    default:
+      assert ("bad label" == NULL);
+      /* Fall through.  */
+    case FFELAB_typeANY:
+      break;
+    }
+
+  *x_label = label;
+  return TRUE;
+}
+
+/* ffestc_labelref_is_branch_ -- Reference to label in branch stmt
+
+   if (ffestc_labelref_is_branch_(label_token,&label))
+       // label ref is ok, label is filled in with ffelab object  */
+
+static bool
+ffestc_labelref_is_branch_ (ffelexToken label_token, ffelab *x_label)
+{
+  ffelab label;
+  ffelabValue label_value;
+  ffestw block;
+  unsigned long blocknum;
+
+  label_value = (ffelabValue) atol (ffelex_token_text (label_token));
+  if ((label_value == 0) || (label_value > FFELAB_valueMAX))
+    {
+      ffebad_start (FFEBAD_LABEL_NUMBER_INVALID);
+      ffebad_here (0, ffelex_token_where_line (label_token),
+		   ffelex_token_where_column (label_token));
+      ffebad_finish ();
+      return FALSE;
+    }
+
+  label = ffelab_find (label_value);
+  if (label == NULL)
+    {
+      label = ffelab_new (label_value);
+      ffelab_set_firstref_line (label,
+		 ffewhere_line_use (ffelex_token_where_line (label_token)));
+      ffelab_set_firstref_column (label,
+	     ffewhere_column_use (ffelex_token_where_column (label_token)));
+    }
+
+  switch (ffelab_type (label))
+    {
+    case FFELAB_typeUNKNOWN:
+    case FFELAB_typeASSIGNABLE:
+      ffelab_set_type (label, FFELAB_typeNOTLOOP);
+      ffelab_set_blocknum (label, ffestw_blocknum (ffestw_stack_top ()));
+      break;
+
+    case FFELAB_typeLOOPEND:
+      if (ffelab_blocknum (label) != 0)
+	break;			/* Already taken care of. */
+      for (block = ffestw_top_do (ffestw_stack_top ());
+	   (block != NULL) && (ffestw_label (block) != label);
+	   block = ffestw_top_do (ffestw_previous (block)))
+	;			/* Find most recent DO <label> ancestor. */
+      if (block == NULL)
+	{			/* Reference to within a (dead) block. */
+	  ffebad_start (FFEBAD_LABEL_BLOCK);
+	  ffebad_here (0, ffelab_definition_line (label),
+		       ffelab_definition_column (label));
+	  ffebad_here (1, ffelex_token_where_line (label_token),
+		       ffelex_token_where_column (label_token));
+	  ffebad_finish ();
+	  break;
+	}
+      ffelab_set_blocknum (label, ffestw_blocknum (block));
+      ffelab_set_firstref_line (label,
+		 ffewhere_line_use (ffelex_token_where_line (label_token)));
+      ffelab_set_firstref_column (label,
+	     ffewhere_column_use (ffelex_token_where_column (label_token)));
+      break;
+
+    case FFELAB_typeNOTLOOP:
+    case FFELAB_typeENDIF:
+      if (ffelab_blocknum (label) == ffestw_blocknum (ffestw_stack_top ()))
+	break;
+      blocknum = ffelab_blocknum (label);
+      for (block = ffestw_stack_top ();
+	   ffestw_blocknum (block) > blocknum;
+	   block = ffestw_previous (block))
+	;			/* Find most recent common ancestor. */
+      if (ffelab_blocknum (label) == ffestw_blocknum (block))
+	break;			/* Check again. */
+      if (!ffewhere_line_is_unknown (ffelab_definition_line (label)))
+	{			/* Reference to within a (dead) block. */
+	  ffebad_start (FFEBAD_LABEL_BLOCK);
+	  ffebad_here (0, ffelab_definition_line (label),
+		       ffelab_definition_column (label));
+	  ffebad_here (1, ffelex_token_where_line (label_token),
+		       ffelex_token_where_column (label_token));
+	  ffebad_finish ();
+	  break;
+	}
+      ffelab_set_blocknum (label, ffestw_blocknum (block));
+      break;
+
+    case FFELAB_typeFORMAT:
+      if (ffewhere_line_is_unknown (ffelab_definition_line (label)))
+	{
+	  ffelab_set_type (label, FFELAB_typeANY);
+	  ffestd_labeldef_any (label);
+
+	  ffebad_start (FFEBAD_LABEL_USE_USE);
+	  ffebad_here (0, ffelab_firstref_line (label), ffelab_firstref_column (label));
+	  ffebad_here (1, ffelex_token_where_line (label_token),
+		       ffelex_token_where_column (label_token));
+	  ffebad_finish ();
+
+	  ffestc_try_shriek_do_ ();
+
+	  return FALSE;
+	}
+      /* Fall through. */
+    case FFELAB_typeUSELESS:
+      ffelab_set_type (label, FFELAB_typeANY);
+      ffestd_labeldef_any (label);
+
+      ffebad_start (FFEBAD_LABEL_USE_DEF);
+      ffebad_here (0, ffelab_definition_line (label), ffelab_definition_column (label));
+      ffebad_here (1, ffelex_token_where_line (label_token),
+		   ffelex_token_where_column (label_token));
+      ffebad_finish ();
+
+      ffestc_try_shriek_do_ ();
+
+      return FALSE;
+
+    default:
+      assert ("bad label" == NULL);
+      /* Fall through.  */
+    case FFELAB_typeANY:
+      break;
+    }
+
+  *x_label = label;
+  return TRUE;
+}
+
+/* ffestc_labelref_is_format_ -- Reference to label in [FMT=] specification
+
+   if (ffestc_labelref_is_format_(label_token,&label))
+       // label ref is ok, label is filled in with ffelab object  */
+
+static bool
+ffestc_labelref_is_format_ (ffelexToken label_token, ffelab *x_label)
+{
+  ffelab label;
+  ffelabValue label_value;
+
+  label_value = (ffelabValue) atol (ffelex_token_text (label_token));
+  if ((label_value == 0) || (label_value > FFELAB_valueMAX))
+    {
+      ffebad_start (FFEBAD_LABEL_NUMBER_INVALID);
+      ffebad_here (0, ffelex_token_where_line (label_token),
+		   ffelex_token_where_column (label_token));
+      ffebad_finish ();
+      return FALSE;
+    }
+
+  label = ffelab_find (label_value);
+  if (label == NULL)
+    {
+      label = ffelab_new (label_value);
+      ffelab_set_firstref_line (label,
+		 ffewhere_line_use (ffelex_token_where_line (label_token)));
+      ffelab_set_firstref_column (label,
+	     ffewhere_column_use (ffelex_token_where_column (label_token)));
+    }
+
+  switch (ffelab_type (label))
+    {
+    case FFELAB_typeUNKNOWN:
+    case FFELAB_typeASSIGNABLE:
+      ffelab_set_type (label, FFELAB_typeFORMAT);
+      break;
+
+    case FFELAB_typeFORMAT:
+      break;
+
+    case FFELAB_typeLOOPEND:
+    case FFELAB_typeNOTLOOP:
+      if (ffewhere_line_is_unknown (ffelab_definition_line (label)))
+	{
+	  ffelab_set_type (label, FFELAB_typeANY);
+	  ffestd_labeldef_any (label);
+
+	  ffebad_start (FFEBAD_LABEL_USE_USE);
+	  ffebad_here (0, ffelab_firstref_line (label), ffelab_firstref_column (label));
+	  ffebad_here (1, ffelex_token_where_line (label_token),
+		       ffelex_token_where_column (label_token));
+	  ffebad_finish ();
+
+	  ffestc_try_shriek_do_ ();
+
+	  return FALSE;
+	}
+      /* Fall through. */
+    case FFELAB_typeUSELESS:
+    case FFELAB_typeENDIF:
+      ffelab_set_type (label, FFELAB_typeANY);
+      ffestd_labeldef_any (label);
+
+      ffebad_start (FFEBAD_LABEL_USE_DEF);
+      ffebad_here (0, ffelab_definition_line (label), ffelab_definition_column (label));
+      ffebad_here (1, ffelex_token_where_line (label_token),
+		   ffelex_token_where_column (label_token));
+      ffebad_finish ();
+
+      ffestc_try_shriek_do_ ();
+
+      return FALSE;
+
+    default:
+      assert ("bad label" == NULL);
+      /* Fall through.  */
+    case FFELAB_typeANY:
+      break;
+    }
+
+  ffestc_try_shriek_do_ ();
+
+  *x_label = label;
+  return TRUE;
+}
+
+/* ffestc_labelref_is_loopend_ -- Reference to label in DO stmt
+
+   if (ffestc_labelref_is_loopend_(label_token,&label))
+       // label ref is ok, label is filled in with ffelab object  */
+
+static bool
+ffestc_labelref_is_loopend_ (ffelexToken label_token, ffelab *x_label)
+{
+  ffelab label;
+  ffelabValue label_value;
+
+  label_value = (ffelabValue) atol (ffelex_token_text (label_token));
+  if ((label_value == 0) || (label_value > FFELAB_valueMAX))
+    {
+      ffebad_start (FFEBAD_LABEL_NUMBER_INVALID);
+      ffebad_here (0, ffelex_token_where_line (label_token),
+		   ffelex_token_where_column (label_token));
+      ffebad_finish ();
+      return FALSE;
+    }
+
+  label = ffelab_find (label_value);
+  if (label == NULL)
+    {
+      label = ffelab_new (label_value);
+      ffelab_set_doref_line (label,
+		 ffewhere_line_use (ffelex_token_where_line (label_token)));
+      ffelab_set_doref_column (label,
+	     ffewhere_column_use (ffelex_token_where_column (label_token)));
+    }
+
+  switch (ffelab_type (label))
+    {
+    case FFELAB_typeASSIGNABLE:
+      ffelab_set_doref_line (label,
+		 ffewhere_line_use (ffelex_token_where_line (label_token)));
+      ffelab_set_doref_column (label,
+	     ffewhere_column_use (ffelex_token_where_column (label_token)));
+      ffewhere_line_kill (ffelab_firstref_line (label));
+      ffelab_set_firstref_line (label, ffewhere_line_unknown ());
+      ffewhere_column_kill (ffelab_firstref_column (label));
+      ffelab_set_firstref_column (label, ffewhere_column_unknown ());
+      /* Fall through. */
+    case FFELAB_typeUNKNOWN:
+      ffelab_set_type (label, FFELAB_typeLOOPEND);
+      ffelab_set_blocknum (label, 0);
+      break;
+
+    case FFELAB_typeLOOPEND:
+      if (!ffewhere_line_is_unknown (ffelab_definition_line (label)))
+	{			/* Def must follow all refs. */
+	  ffelab_set_type (label, FFELAB_typeANY);
+	  ffestd_labeldef_any (label);
+
+	  ffebad_start (FFEBAD_LABEL_DEF_DO);
+	  ffebad_here (0, ffelab_definition_line (label),
+		       ffelab_definition_column (label));
+	  ffebad_here (1, ffelex_token_where_line (label_token),
+		       ffelex_token_where_column (label_token));
+	  ffebad_finish ();
+
+	  ffestc_try_shriek_do_ ();
+
+	  return FALSE;
+	}
+      if (ffelab_blocknum (label) != 0)
+	{			/* Had a branch ref earlier, can't go inside
+				   this new block! */
+	  ffelab_set_type (label, FFELAB_typeANY);
+	  ffestd_labeldef_any (label);
+
+	  ffebad_start (FFEBAD_LABEL_USE_USE);
+	  ffebad_here (0, ffelab_firstref_line (label),
+		       ffelab_firstref_column (label));
+	  ffebad_here (1, ffelex_token_where_line (label_token),
+		       ffelex_token_where_column (label_token));
+	  ffebad_finish ();
+
+	  ffestc_try_shriek_do_ ();
+
+	  return FALSE;
+	}
+      if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
+	  || (ffestw_label (ffestw_stack_top ()) != label))
+	{			/* Top of stack interrupts flow between two
+				   DOs specifying label. */
+	  ffelab_set_type (label, FFELAB_typeANY);
+	  ffestd_labeldef_any (label);
+
+	  ffebad_start (FFEBAD_LABEL_DO_BLOCK_DO);
+	  ffebad_here (0, ffelab_doref_line (label),
+		       ffelab_doref_column (label));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_here (2, ffelex_token_where_line (label_token),
+		       ffelex_token_where_column (label_token));
+	  ffebad_finish ();
+
+	  ffestc_try_shriek_do_ ();
+
+	  return FALSE;
+	}
+      break;
+
+    case FFELAB_typeNOTLOOP:
+    case FFELAB_typeFORMAT:
+      if (ffewhere_line_is_unknown (ffelab_definition_line (label)))
+	{
+	  ffelab_set_type (label, FFELAB_typeANY);
+	  ffestd_labeldef_any (label);
+
+	  ffebad_start (FFEBAD_LABEL_USE_USE);
+	  ffebad_here (0, ffelab_firstref_line (label), ffelab_firstref_column (label));
+	  ffebad_here (1, ffelex_token_where_line (label_token),
+		       ffelex_token_where_column (label_token));
+	  ffebad_finish ();
+
+	  ffestc_try_shriek_do_ ();
+
+	  return FALSE;
+	}
+      /* Fall through. */
+    case FFELAB_typeUSELESS:
+    case FFELAB_typeENDIF:
+      ffelab_set_type (label, FFELAB_typeANY);
+      ffestd_labeldef_any (label);
+
+      ffebad_start (FFEBAD_LABEL_USE_DEF);
+      ffebad_here (0, ffelab_definition_line (label), ffelab_definition_column (label));
+      ffebad_here (1, ffelex_token_where_line (label_token),
+		   ffelex_token_where_column (label_token));
+      ffebad_finish ();
+
+      ffestc_try_shriek_do_ ();
+
+      return FALSE;
+
+    default:
+      assert ("bad label" == NULL);
+      /* Fall through.  */
+    case FFELAB_typeANY:
+      break;
+    }
+
+  *x_label = label;
+  return TRUE;
+}
+
+/* ffestc_order_access_ -- Check ordering on <access> statement
+
+   if (ffestc_order_access_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_access_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateMODULE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateMODULE3:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_actiondo_ -- Check ordering on <actiondo> statement
+
+   if (ffestc_order_actiondo_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_actiondo_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateDO:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateIFTHEN:
+    case FFESTV_stateSELECT1:
+      if (ffestw_top_do (ffestw_stack_top ()) == NULL)
+	break;
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateIF:
+      if (ffestw_top_do (ffestw_stack_top ()) == NULL)
+	break;
+      ffestc_shriek_after1_ = ffestc_shriek_if_;
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    default:
+      break;
+    }
+  ffestc_order_bad_ ();
+  return FFESTC_orderBAD_;
+}
+
+/* ffestc_order_actionif_ -- Check ordering on <actionif> statement
+
+   if (ffestc_order_actionif_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_actionif_ ()
+{
+  bool update;
+
+recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_statePROGRAM2:
+    case FFESTV_statePROGRAM3:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM4);
+      update = TRUE;
+      break;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+    case FFESTV_stateSUBROUTINE3:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE4);
+      update = TRUE;
+      break;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+    case FFESTV_stateFUNCTION3:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION4);
+      update = TRUE;
+      break;
+
+    case FFESTV_statePROGRAM4:
+    case FFESTV_stateSUBROUTINE4:
+    case FFESTV_stateFUNCTION4:
+      update = FALSE;
+      break;
+
+    case FFESTV_stateIFTHEN:
+    case FFESTV_stateDO:
+    case FFESTV_stateSELECT1:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateIF:
+      ffestc_shriek_after1_ = ffestc_shriek_if_;
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+
+  switch (ffestw_state (ffestw_previous (ffestw_stack_top ())))
+    {
+    case FFESTV_stateINTERFACE0:
+      ffestc_order_bad_ ();
+      if (update)
+	ffestw_update (NULL);
+      return FFESTC_orderBAD_;
+
+    default:
+      if (update)
+	ffestw_update (NULL);
+      return FFESTC_orderOK_;
+    }
+}
+
+/* ffestc_order_actionwhere_ -- Check ordering on <actionwhere> statement
+
+   if (ffestc_order_actionwhere_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_actionwhere_ ()
+{
+  bool update;
+
+recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_statePROGRAM2:
+    case FFESTV_statePROGRAM3:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM4);
+      update = TRUE;
+      break;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+    case FFESTV_stateSUBROUTINE3:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE4);
+      update = TRUE;
+      break;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+    case FFESTV_stateFUNCTION3:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION4);
+      update = TRUE;
+      break;
+
+    case FFESTV_statePROGRAM4:
+    case FFESTV_stateSUBROUTINE4:
+    case FFESTV_stateFUNCTION4:
+      update = FALSE;
+      break;
+
+    case FFESTV_stateWHERETHEN:
+    case FFESTV_stateIFTHEN:
+    case FFESTV_stateDO:
+    case FFESTV_stateSELECT1:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+#if FFESTR_F90
+      ffestc_shriek_after1_ = ffestc_shriek_where_;
+#endif
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateIF:
+      ffestc_shriek_after1_ = ffestc_shriek_if_;
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+
+  switch (ffestw_state (ffestw_previous (ffestw_stack_top ())))
+    {
+    case FFESTV_stateINTERFACE0:
+      ffestc_order_bad_ ();
+      if (update)
+	ffestw_update (NULL);
+      return FFESTC_orderBAD_;
+
+    default:
+      if (update)
+	ffestw_update (NULL);
+      return FFESTC_orderOK_;
+    }
+}
+
+/* Check ordering on "any" statement.  Like _actionwhere_, but
+   doesn't produce any diagnostics.  */
+
+static void
+ffestc_order_any_ ()
+{
+  bool update;
+
+recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_statePROGRAM2:
+    case FFESTV_statePROGRAM3:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM4);
+      update = TRUE;
+      break;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+    case FFESTV_stateSUBROUTINE3:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE4);
+      update = TRUE;
+      break;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+    case FFESTV_stateFUNCTION3:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION4);
+      update = TRUE;
+      break;
+
+    case FFESTV_statePROGRAM4:
+    case FFESTV_stateSUBROUTINE4:
+    case FFESTV_stateFUNCTION4:
+      update = FALSE;
+      break;
+
+    case FFESTV_stateWHERETHEN:
+    case FFESTV_stateIFTHEN:
+    case FFESTV_stateDO:
+    case FFESTV_stateSELECT1:
+      return;
+
+    case FFESTV_stateWHERE:
+#if FFESTR_F90
+      ffestc_shriek_after1_ = ffestc_shriek_where_;
+#endif
+      return;
+
+    case FFESTV_stateIF:
+      ffestc_shriek_after1_ = ffestc_shriek_if_;
+      return;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    default:
+      return;
+    }
+
+  switch (ffestw_state (ffestw_previous (ffestw_stack_top ())))
+    {
+    case FFESTV_stateINTERFACE0:
+      if (update)
+	ffestw_update (NULL);
+      return;
+
+    default:
+      if (update)
+	ffestw_update (NULL);
+      return;
+    }
+}
+
+/* ffestc_order_bad_ -- Whine about statement ordering violation
+
+   ffestc_order_bad_();
+
+   Uses current ffesta_tokens[0] and, if available, info on where current
+   state started to produce generic message.  Someday we should do
+   fancier things than this, but this just gets things creaking along for
+   now.	 */
+
+static void
+ffestc_order_bad_ ()
+{
+  if (ffewhere_line_is_unknown (ffestw_line (ffestw_stack_top ())))
+    {
+      ffebad_start (FFEBAD_ORDER_1);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_finish ();
+    }
+  else
+    {
+      ffebad_start (FFEBAD_ORDER_2);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+    }
+  ffestc_labeldef_useless_ ();	/* Any label definition is useless. */
+}
+
+/* ffestc_order_blockdata_ -- Check ordering on <blockdata> statement
+
+   if (ffestc_order_blockdata_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_blockdata_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateBLOCKDATA0:
+    case FFESTV_stateBLOCKDATA1:
+    case FFESTV_stateBLOCKDATA2:
+    case FFESTV_stateBLOCKDATA3:
+    case FFESTV_stateBLOCKDATA4:
+    case FFESTV_stateBLOCKDATA5:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_blockspec_ -- Check ordering on <blockspec> statement
+
+   if (ffestc_order_blockspec_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_blockspec_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_statePROGRAM2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateMODULE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateBLOCKDATA0:
+    case FFESTV_stateBLOCKDATA1:
+    case FFESTV_stateBLOCKDATA2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_statePROGRAM3:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateMODULE3:
+    case FFESTV_stateBLOCKDATA3:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_component_ -- Check ordering on <component-decl> statement
+
+   if (ffestc_order_component_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_component_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateTYPE:
+    case FFESTV_stateSTRUCTURE:
+    case FFESTV_stateMAP:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+      ffestc_shriek_where_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_contains_ -- Check ordering on CONTAINS statement
+
+   if (ffestc_order_contains_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_contains_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_statePROGRAM2:
+    case FFESTV_statePROGRAM3:
+    case FFESTV_statePROGRAM4:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM5);
+      break;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateSUBROUTINE4:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE5);
+      break;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateFUNCTION4:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION5);
+      break;
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateMODULE2:
+    case FFESTV_stateMODULE3:
+    case FFESTV_stateMODULE4:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE5);
+      break;
+
+    case FFESTV_stateUSE:
+      ffestc_shriek_end_uses_ (TRUE);
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+      ffestc_shriek_where_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+
+  switch (ffestw_state (ffestw_previous (ffestw_stack_top ())))
+    {
+    case FFESTV_stateNIL:
+      ffestw_update (NULL);
+      return FFESTC_orderOK_;
+
+    default:
+      ffestc_order_bad_ ();
+      ffestw_update (NULL);
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_data_ -- Check ordering on DATA statement
+
+   if (ffestc_order_data_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_data_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM2);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE2);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION2);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateBLOCKDATA0:
+    case FFESTV_stateBLOCKDATA1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA2);
+      return FFESTC_orderOK_;
+
+    case FFESTV_statePROGRAM2:
+    case FFESTV_stateSUBROUTINE2:
+    case FFESTV_stateFUNCTION2:
+    case FFESTV_stateBLOCKDATA2:
+    case FFESTV_statePROGRAM3:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateBLOCKDATA3:
+    case FFESTV_statePROGRAM4:
+    case FFESTV_stateSUBROUTINE4:
+    case FFESTV_stateFUNCTION4:
+    case FFESTV_stateBLOCKDATA4:
+    case FFESTV_stateWHERETHEN:
+    case FFESTV_stateIFTHEN:
+    case FFESTV_stateDO:
+    case FFESTV_stateSELECT0:
+    case FFESTV_stateSELECT1:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_data77_ -- Check ordering on pedantic-F77 DATA statement
+
+   if (ffestc_order_data77_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_data77_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_statePROGRAM2:
+    case FFESTV_statePROGRAM3:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM4);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+    case FFESTV_stateSUBROUTINE3:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE4);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+    case FFESTV_stateFUNCTION3:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION4);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateBLOCKDATA0:
+    case FFESTV_stateBLOCKDATA1:
+    case FFESTV_stateBLOCKDATA2:
+    case FFESTV_stateBLOCKDATA3:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA4);
+      return FFESTC_orderOK_;
+
+    case FFESTV_statePROGRAM4:
+    case FFESTV_stateSUBROUTINE4:
+    case FFESTV_stateFUNCTION4:
+    case FFESTV_stateBLOCKDATA4:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERETHEN:
+    case FFESTV_stateIFTHEN:
+    case FFESTV_stateDO:
+    case FFESTV_stateSELECT0:
+    case FFESTV_stateSELECT1:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_derivedtype_ -- Check ordering on derived TYPE statement
+
+   if (ffestc_order_derivedtype_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_derivedtype_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_statePROGRAM2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateMODULE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_statePROGRAM3:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateMODULE3:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+      ffestc_shriek_end_uses_ (TRUE);
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+      ffestc_shriek_where_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_do_ -- Check ordering on <do> statement
+
+   if (ffestc_order_do_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_do_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateDO:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_entry_ -- Check ordering on ENTRY statement
+
+   if (ffestc_order_entry_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_entry_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE2);
+      break;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION2);
+      break;
+
+    case FFESTV_stateSUBROUTINE2:
+    case FFESTV_stateFUNCTION2:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateSUBROUTINE4:
+    case FFESTV_stateFUNCTION4:
+      break;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+
+  switch (ffestw_state (ffestw_previous (ffestw_stack_top ())))
+    {
+    case FFESTV_stateNIL:
+    case FFESTV_stateMODULE5:
+      ffestw_update (NULL);
+      return FFESTC_orderOK_;
+
+    default:
+      ffestc_order_bad_ ();
+      ffestw_update (NULL);
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_exec_ -- Check ordering on <exec> statement
+
+   if (ffestc_order_exec_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_exec_ ()
+{
+  bool update;
+
+recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_statePROGRAM2:
+    case FFESTV_statePROGRAM3:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM4);
+      update = TRUE;
+      break;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+    case FFESTV_stateSUBROUTINE3:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE4);
+      update = TRUE;
+      break;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+    case FFESTV_stateFUNCTION3:
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION4);
+      update = TRUE;
+      break;
+
+    case FFESTV_statePROGRAM4:
+    case FFESTV_stateSUBROUTINE4:
+    case FFESTV_stateFUNCTION4:
+      update = FALSE;
+      break;
+
+    case FFESTV_stateIFTHEN:
+    case FFESTV_stateDO:
+    case FFESTV_stateSELECT1:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+
+  switch (ffestw_state (ffestw_previous (ffestw_stack_top ())))
+    {
+    case FFESTV_stateINTERFACE0:
+      ffestc_order_bad_ ();
+      if (update)
+	ffestw_update (NULL);
+      return FFESTC_orderBAD_;
+
+    default:
+      if (update)
+	ffestw_update (NULL);
+      return FFESTC_orderOK_;
+    }
+}
+
+/* ffestc_order_format_ -- Check ordering on FORMAT statement
+
+   if (ffestc_order_format_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_format_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM2);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE2);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION2);
+      return FFESTC_orderOK_;
+
+    case FFESTV_statePROGRAM2:
+    case FFESTV_stateSUBROUTINE2:
+    case FFESTV_stateFUNCTION2:
+    case FFESTV_statePROGRAM3:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_statePROGRAM4:
+    case FFESTV_stateSUBROUTINE4:
+    case FFESTV_stateFUNCTION4:
+    case FFESTV_stateWHERETHEN:
+    case FFESTV_stateIFTHEN:
+    case FFESTV_stateDO:
+    case FFESTV_stateSELECT0:
+    case FFESTV_stateSELECT1:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_function_ -- Check ordering on <function> statement
+
+   if (ffestc_order_function_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_function_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateFUNCTION4:
+    case FFESTV_stateFUNCTION5:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_iface_ -- Check ordering on <iface> statement
+
+   if (ffestc_order_iface_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_iface_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+    case FFESTV_statePROGRAM5:
+    case FFESTV_stateSUBROUTINE5:
+    case FFESTV_stateFUNCTION5:
+    case FFESTV_stateMODULE5:
+    case FFESTV_stateINTERFACE0:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_ifthen_ -- Check ordering on <ifthen> statement
+
+   if (ffestc_order_ifthen_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_ifthen_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateIFTHEN:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_implicit_ -- Check ordering on IMPLICIT statement
+
+   if (ffestc_order_implicit_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_implicit_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM2);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE2);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION2);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE2);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateBLOCKDATA0:
+    case FFESTV_stateBLOCKDATA1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA2);
+      return FFESTC_orderOK_;
+
+    case FFESTV_statePROGRAM2:
+    case FFESTV_stateSUBROUTINE2:
+    case FFESTV_stateFUNCTION2:
+    case FFESTV_stateMODULE2:
+    case FFESTV_stateBLOCKDATA2:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_implicitnone_ -- Check ordering on IMPLICIT NONE statement
+
+   if (ffestc_order_implicitnone_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_implicitnone_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateBLOCKDATA0:
+    case FFESTV_stateBLOCKDATA1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_interface_ -- Check ordering on <interface> statement
+
+   if (ffestc_order_interface_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_interface_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateINTERFACE0:
+    case FFESTV_stateINTERFACE1:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+      ffestc_shriek_where_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_map_ -- Check ordering on <map> statement
+
+   if (ffestc_order_map_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_VXT
+static ffestcOrder_
+ffestc_order_map_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateMAP:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+      ffestc_shriek_where_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_module_ -- Check ordering on <module> statement
+
+   if (ffestc_order_module_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_module_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateMODULE2:
+    case FFESTV_stateMODULE3:
+    case FFESTV_stateMODULE4:
+    case FFESTV_stateMODULE5:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+      ffestc_shriek_end_uses_ (TRUE);
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+      ffestc_shriek_where_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_parameter_ -- Check ordering on <parameter> statement
+
+   if (ffestc_order_parameter_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_parameter_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM2);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE2);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION2);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE2);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateBLOCKDATA0:
+    case FFESTV_stateBLOCKDATA1:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA2);
+      return FFESTC_orderOK_;
+
+    case FFESTV_statePROGRAM2:
+    case FFESTV_stateSUBROUTINE2:
+    case FFESTV_stateFUNCTION2:
+    case FFESTV_stateMODULE2:
+    case FFESTV_stateBLOCKDATA2:
+    case FFESTV_statePROGRAM3:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateMODULE3:
+    case FFESTV_stateBLOCKDATA3:
+    case FFESTV_stateTYPE:	/* GNU extension here! */
+    case FFESTV_stateSTRUCTURE:
+    case FFESTV_stateUNION:
+    case FFESTV_stateMAP:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_program_ -- Check ordering on <program> statement
+
+   if (ffestc_order_program_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_program_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_statePROGRAM2:
+    case FFESTV_statePROGRAM3:
+    case FFESTV_statePROGRAM4:
+    case FFESTV_statePROGRAM5:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_progspec_ -- Check ordering on <progspec> statement
+
+   if (ffestc_order_progspec_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_progspec_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_statePROGRAM2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateMODULE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_statePROGRAM3:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateMODULE3:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateBLOCKDATA0:
+    case FFESTV_stateBLOCKDATA1:
+    case FFESTV_stateBLOCKDATA2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA2);
+      if (ffe_is_pedantic ())
+	{
+	  ffebad_start (FFEBAD_BLOCKDATA_STMT);
+	  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		       ffelex_token_where_column (ffesta_tokens[0]));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_finish ();
+	}
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_record_ -- Check ordering on RECORD statement
+
+   if (ffestc_order_record_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_VXT
+static ffestcOrder_
+ffestc_order_record_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_statePROGRAM2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateMODULE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateBLOCKDATA0:
+    case FFESTV_stateBLOCKDATA1:
+    case FFESTV_stateBLOCKDATA2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_statePROGRAM3:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateMODULE3:
+    case FFESTV_stateBLOCKDATA3:
+    case FFESTV_stateSTRUCTURE:
+    case FFESTV_stateMAP:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_selectcase_ -- Check ordering on <selectcase> statement
+
+   if (ffestc_order_selectcase_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_selectcase_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateSELECT0:
+    case FFESTV_stateSELECT1:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_sfunc_ -- Check ordering on statement-function definition
+
+   if (ffestc_order_sfunc_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_sfunc_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_statePROGRAM2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_statePROGRAM3:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateFUNCTION3:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_spec_ -- Check ordering on <spec> statement
+
+   if (ffestc_order_spec_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_spec_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateMODULE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateMODULE3:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_structure_ -- Check ordering on <structure> statement
+
+   if (ffestc_order_structure_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_VXT
+static ffestcOrder_
+ffestc_order_structure_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateSTRUCTURE:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_subroutine_ -- Check ordering on <subroutine> statement
+
+   if (ffestc_order_subroutine_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_subroutine_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateSUBROUTINE4:
+    case FFESTV_stateSUBROUTINE5:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_type_ -- Check ordering on <type> statement
+
+   if (ffestc_order_type_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_type_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateTYPE:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+      ffestc_shriek_where_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_typedecl_ -- Check ordering on <typedecl> statement
+
+   if (ffestc_order_typedecl_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_typedecl_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_statePROGRAM2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateMODULE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateBLOCKDATA0:
+    case FFESTV_stateBLOCKDATA1:
+    case FFESTV_stateBLOCKDATA2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_statePROGRAM3:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateMODULE3:
+    case FFESTV_stateBLOCKDATA3:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_union_ -- Check ordering on <union> statement
+
+   if (ffestc_order_union_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_VXT
+static ffestcOrder_
+ffestc_order_union_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateUNION:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_unit_ -- Check ordering on <unit> statement
+
+   if (ffestc_order_unit_() != FFESTC_orderOK_)
+       return;	*/
+
+static ffestcOrder_
+ffestc_order_unit_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+/* ffestc_order_use_ -- Check ordering on USE statement
+
+   if (ffestc_order_use_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_use_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM1);
+      ffestc_shriek_begin_uses_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateSUBROUTINE0:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE1);
+      ffestc_shriek_begin_uses_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateFUNCTION0:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION1);
+      ffestc_shriek_begin_uses_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateMODULE0:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE1);
+      ffestc_shriek_begin_uses_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateUSE:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+      ffestc_shriek_where_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_vxtstructure_ -- Check ordering on STRUCTURE statement
+
+   if (ffestc_order_vxtstructure_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_VXT
+static ffestcOrder_
+ffestc_order_vxtstructure_ ()
+{
+  recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_statePROGRAM2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateMODULE2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateBLOCKDATA0:
+    case FFESTV_stateBLOCKDATA1:
+    case FFESTV_stateBLOCKDATA2:
+      ffestw_update (NULL);
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA3);
+      return FFESTC_orderOK_;
+
+    case FFESTV_statePROGRAM3:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateMODULE3:
+    case FFESTV_stateBLOCKDATA3:
+    case FFESTV_stateSTRUCTURE:
+    case FFESTV_stateMAP:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+#if FFESTR_F90
+      ffestc_shriek_where_ (FALSE);
+#endif
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* ffestc_order_where_ -- Check ordering on <where> statement
+
+   if (ffestc_order_where_() != FFESTC_orderOK_)
+       return;	*/
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_where_ ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateWHERETHEN:
+      return FFESTC_orderOK_;
+
+    case FFESTV_stateWHERE:
+      ffestc_order_bad_ ();
+      ffestc_shriek_where_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    case FFESTV_stateIF:
+      ffestc_order_bad_ ();
+      ffestc_shriek_if_ (FALSE);
+      return FFESTC_orderBAD_;
+
+    default:
+      ffestc_order_bad_ ();
+      return FFESTC_orderBAD_;
+    }
+}
+
+#endif
+/* Invoked for each token in dummy arg list of FUNCTION, SUBROUTINE, and
+   ENTRY (prior to the first executable statement).  */
+
+static void
+ffestc_promote_dummy_ (ffelexToken t)
+{
+  ffesymbol s;
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffebld e;
+  bool sfref_ok;
+
+  assert (t != NULL);
+
+  if (ffelex_token_type (t) == FFELEX_typeASTERISK)
+    {
+      ffebld_append_item (&ffestc_local_.dummy.list_bottom,
+			  ffebld_new_star ());
+      return;			/* Don't bother with alternate returns! */
+    }
+
+  s = ffesymbol_declare_local (t, FALSE);
+  sa = ffesymbol_attrs (s);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  sfref_ok = FALSE;
+
+  if (sa & FFESYMBOL_attrsANY)
+    na = sa;
+  else if (sa & FFESYMBOL_attrsDUMMY)
+    {
+      if (ffestc_entry_num_ == ffesymbol_maxentrynum (s))
+	{			/* Seen this one twice in this list! */
+	  na = FFESYMBOL_attrsetNONE;
+	}
+      else
+	na = sa;
+      sfref_ok = TRUE;		/* Ok for sym to be ref'd in sfuncdef
+				   previously, since already declared as a
+				   dummy arg. */
+    }
+  else if (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
+		    | FFESYMBOL_attrsADJUSTS
+		    | FFESYMBOL_attrsANY
+		    | FFESYMBOL_attrsANYLEN
+		    | FFESYMBOL_attrsANYSIZE
+		    | FFESYMBOL_attrsARRAY
+		    | FFESYMBOL_attrsDUMMY
+		    | FFESYMBOL_attrsEXTERNAL
+		    | FFESYMBOL_attrsSFARG
+		    | FFESYMBOL_attrsTYPE)))
+    na = sa | FFESYMBOL_attrsDUMMY;
+  else
+    na = FFESYMBOL_attrsetNONE;
+
+  if (!ffesymbol_is_specable (s)
+      && (!sfref_ok
+	  || (ffesymbol_where (s) != FFEINFO_whereDUMMY)))
+    na = FFESYMBOL_attrsetNONE;	/* Can't dcl sym ref'd in sfuncdef. */
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (na == FFESYMBOL_attrsetNONE)
+    ffesymbol_error (s, t);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_set_attrs (s, na);
+      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+	ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+      ffesymbol_set_maxentrynum (s, ffestc_entry_num_);
+      ffesymbol_set_numentries (s, ffesymbol_numentries (s) + 1);
+      e = ffebld_new_symter (s, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
+			     FFEINTRIN_impNONE);
+      ffebld_set_info (e,
+		       ffeinfo_new (FFEINFO_basictypeNONE,
+				    FFEINFO_kindtypeNONE,
+				    0,
+				    FFEINFO_kindNONE,
+				    FFEINFO_whereNONE,
+				    FFETARGET_charactersizeNONE));
+      ffebld_append_item (&ffestc_local_.dummy.list_bottom, e);
+      ffesymbol_signal_unreported (s);
+    }
+}
+
+/* ffestc_promote_execdummy_ -- Declare token as dummy variable in exec context
+
+   ffestc_promote_execdummy_(t);
+
+   Invoked for each token in dummy arg list of ENTRY when the statement
+   follows the first executable statement.  */
+
+static void
+ffestc_promote_execdummy_ (ffelexToken t)
+{
+  ffesymbol s;
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffesymbolState ss;
+  ffesymbolState ns;
+  ffeinfoKind kind;
+  ffeinfoWhere where;
+  ffebld e;
+
+  assert (t != NULL);
+
+  if (ffelex_token_type (t) == FFELEX_typeASTERISK)
+    {
+      ffebld_append_item (&ffestc_local_.dummy.list_bottom,
+			  ffebld_new_star ());
+      return;			/* Don't bother with alternate returns! */
+    }
+
+  s = ffesymbol_declare_local (t, FALSE);
+  na = sa = ffesymbol_attrs (s);
+  ss = ffesymbol_state (s);
+  kind = ffesymbol_kind (s);
+  where = ffesymbol_where (s);
+
+  if (ffestc_entry_num_ == ffesymbol_maxentrynum (s))
+    {				/* Seen this one twice in this list! */
+      na = FFESYMBOL_attrsetNONE;
+    }
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  ns = FFESYMBOL_stateUNDERSTOOD;	/* Assume we know it all know. */
+
+  switch (kind)
+    {
+    case FFEINFO_kindENTITY:
+    case FFEINFO_kindFUNCTION:
+    case FFEINFO_kindSUBROUTINE:
+      break;			/* These are fine, as far as we know. */
+
+    case FFEINFO_kindNONE:
+      if (sa & FFESYMBOL_attrsDUMMY)
+	ns = FFESYMBOL_stateUNCERTAIN;	/* Learned nothing new. */
+      else if (sa & FFESYMBOL_attrsANYLEN)
+	{
+	  kind = FFEINFO_kindENTITY;
+	  where = FFEINFO_whereDUMMY;
+	}
+      else if (sa & FFESYMBOL_attrsACTUALARG)
+	na = FFESYMBOL_attrsetNONE;
+      else
+	{
+	  na = sa | FFESYMBOL_attrsDUMMY;
+	  ns = FFESYMBOL_stateUNCERTAIN;
+	}
+      break;
+
+    default:
+      na = FFESYMBOL_attrsetNONE;	/* Error. */
+      break;
+    }
+
+  switch (where)
+    {
+    case FFEINFO_whereDUMMY:
+      break;			/* This is fine. */
+
+    case FFEINFO_whereNONE:
+      where = FFEINFO_whereDUMMY;
+      break;
+
+    default:
+      na = FFESYMBOL_attrsetNONE;	/* Error. */
+      break;
+    }
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (na == FFESYMBOL_attrsetNONE)
+    ffesymbol_error (s, t);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_set_attrs (s, na);
+      ffesymbol_set_state (s, ns);
+      ffesymbol_set_maxentrynum (s, ffestc_entry_num_);
+      ffesymbol_set_numentries (s, ffesymbol_numentries (s) + 1);
+      if ((ns == FFESYMBOL_stateUNDERSTOOD)
+	  && (kind != FFEINFO_kindSUBROUTINE)
+	  && !ffeimplic_establish_symbol (s))
+	{
+	  ffesymbol_error (s, t);
+	  return;
+	}
+      ffesymbol_set_info (s,
+			  ffeinfo_new (ffesymbol_basictype (s),
+				       ffesymbol_kindtype (s),
+				       ffesymbol_rank (s),
+				       kind,
+				       where,
+				       ffesymbol_size (s)));
+      e = ffebld_new_symter (s, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
+			     FFEINTRIN_impNONE);
+      ffebld_set_info (e, ffeinfo_use (ffesymbol_info (s)));
+      ffebld_append_item (&ffestc_local_.dummy.list_bottom, e);
+      s = ffecom_sym_learned (s);
+      ffesymbol_signal_unreported (s);
+    }
+}
+
+/* ffestc_promote_sfdummy_ -- Declare token as stmt-func dummy variable
+
+   ffestc_promote_sfdummy_(t);
+
+   Invoked for each token in dummy arg list of statement function.
+
+   22-Oct-91  JCB  1.1
+      Reject arg if CHARACTER*(*).  */
+
+static void
+ffestc_promote_sfdummy_ (ffelexToken t)
+{
+  ffesymbol s;
+  ffesymbol sp;			/* Parent symbol. */
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffebld e;
+
+  assert (t != NULL);
+
+  s = ffesymbol_declare_sfdummy (t);	/* Sets maxentrynum to 0 for new obj;
+					   also sets sfa_dummy_parent to
+					   parent symbol. */
+  if (ffesymbol_state (s) != FFESYMBOL_stateNONE)
+    {
+      ffesymbol_error (s, t);	/* Dummy already in list. */
+      return;
+    }
+
+  sp = ffesymbol_sfdummyparent (s);	/* Now flag dummy's parent as used
+					   for dummy. */
+  sa = ffesymbol_attrs (sp);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (!ffesymbol_is_specable (sp)
+      && ((ffesymbol_kind (sp) != FFEINFO_kindENTITY)
+	  || ((ffesymbol_where (sp) != FFEINFO_whereLOCAL)
+	      && (ffesymbol_where (sp) != FFEINFO_whereCOMMON)
+	      && (ffesymbol_where (sp) != FFEINFO_whereDUMMY)
+	      && (ffesymbol_where (sp) != FFEINFO_whereNONE))))
+    na = FFESYMBOL_attrsetNONE;	/* Can't be PARAMETER etc., must be a var. */
+  else if (sa & FFESYMBOL_attrsANY)
+    na = sa;
+  else if (!(sa & ~(FFESYMBOL_attrsADJUSTS
+		    | FFESYMBOL_attrsCOMMON
+		    | FFESYMBOL_attrsDUMMY
+		    | FFESYMBOL_attrsEQUIV
+		    | FFESYMBOL_attrsINIT
+		    | FFESYMBOL_attrsNAMELIST
+		    | FFESYMBOL_attrsRESULT
+		    | FFESYMBOL_attrsSAVE
+		    | FFESYMBOL_attrsSFARG
+		    | FFESYMBOL_attrsTYPE)))
+    na = sa | FFESYMBOL_attrsSFARG;
+  else
+    na = FFESYMBOL_attrsetNONE;
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (na == FFESYMBOL_attrsetNONE)
+    {
+      ffesymbol_error (sp, t);
+      ffesymbol_set_info (s, ffeinfo_new_any ());
+    }
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_set_state (sp, FFESYMBOL_stateSEEN);
+      ffesymbol_set_attrs (sp, na);
+      if (!ffeimplic_establish_symbol (sp)
+	  || ((ffesymbol_basictype (sp) == FFEINFO_basictypeCHARACTER)
+	      && (ffesymbol_size (sp) == FFETARGET_charactersizeNONE)))
+	ffesymbol_error (sp, t);
+      else
+	ffesymbol_set_info (s,
+			    ffeinfo_new (ffesymbol_basictype (sp),
+					 ffesymbol_kindtype (sp),
+					 0,
+					 FFEINFO_kindENTITY,
+					 FFEINFO_whereDUMMY,
+					 ffesymbol_size (sp)));
+
+      ffesymbol_signal_unreported (sp);
+    }
+
+  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+  ffesymbol_set_maxentrynum (s, ffestc_sfdummy_argno_++);
+  ffesymbol_signal_unreported (s);
+  e = ffebld_new_symter (s, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
+			 FFEINTRIN_impNONE);
+  ffebld_set_info (e, ffeinfo_use (ffesymbol_info (s)));
+  ffebld_append_item (&ffestc_local_.dummy.list_bottom, e);
+}
+
+/* ffestc_shriek_begin_program_ -- Implicit PROGRAM statement
+
+   ffestc_shriek_begin_program_();
+
+   Invoked only when a PROGRAM statement is NOT present at the beginning
+   of a main program unit.  */
+
+static void
+ffestc_shriek_begin_program_ ()
+{
+  ffestw b;
+  ffesymbol s;
+
+  ffestc_blocknum_ = 0;
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_statePROGRAM0);
+  ffestw_set_blocknum (b, ffestc_blocknum_++);
+  ffestw_set_shriek (b, ffestc_shriek_end_program_);
+  ffestw_set_name (b, NULL);
+
+  s = ffesymbol_declare_programunit (NULL,
+				 ffelex_token_where_line (ffesta_tokens[0]),
+			      ffelex_token_where_column (ffesta_tokens[0]));
+
+  /* Special case: this is one symbol that won't go through
+     ffestu_exec_transition_ when the first statement in a main program is
+     executable, because the transition happens in ffest before ffestc is
+     reached and triggers the implicit generation of a main program.  So we
+     do the exec transition for the implicit main program right here, just
+     for cleanliness' sake (at the very least). */
+
+  ffesymbol_set_info (s,
+		      ffeinfo_new (FFEINFO_basictypeNONE,
+				   FFEINFO_kindtypeNONE,
+				   0,
+				   FFEINFO_kindPROGRAM,
+				   FFEINFO_whereLOCAL,
+				   FFETARGET_charactersizeNONE));
+  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+
+  ffesymbol_signal_unreported (s);
+
+  ffestd_R1102 (s, NULL);
+}
+
+/* ffestc_shriek_begin_uses_ -- Start a bunch of USE statements
+
+   ffestc_shriek_begin_uses_();
+
+   Invoked before handling the first USE statement in a block of one or
+   more USE statements.	 _end_uses_(bool ok) is invoked before handling
+   the first statement after the block (there are no BEGIN USE and END USE
+   statements, but the semantics of USE statements effectively requires
+   handling them as a single block rather than one statement at a time).  */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_begin_uses_ ()
+{
+  ffestw b;
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_stateUSE);
+  ffestw_set_blocknum (b, 0);
+  ffestw_set_shriek (b, ffestc_shriek_end_uses_);
+
+  ffestd_begin_uses ();
+}
+
+#endif
+/* ffestc_shriek_blockdata_ -- End a BLOCK DATA
+
+   ffestc_shriek_blockdata_(TRUE);  */
+
+static void
+ffestc_shriek_blockdata_ (bool ok)
+{
+  if (!ffesta_seen_first_exec)
+    {
+      ffesta_seen_first_exec = TRUE;
+      ffestd_exec_begin ();
+    }
+
+  ffestd_R1112 (ok);
+
+  ffestd_exec_end ();
+
+  if (ffestw_name (ffestw_stack_top ()) != NULL)
+    ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+  ffestw_kill (ffestw_pop ());
+
+  ffe_terminate_2 ();
+  ffe_init_2 ();
+}
+
+/* ffestc_shriek_do_ -- End of statement following DO-term-stmt etc
+
+   ffestc_shriek_do_(TRUE);
+
+   Also invoked by _labeldef_branch_end_ (or, in cases
+   of errors, other _labeldef_ functions) when the label definition is
+   for a DO-target (LOOPEND) label, once per matching/outstanding DO
+   block on the stack.	These cases invoke this function with ok==TRUE, so
+   only forced stack popping (via ffestc_eof()) invokes it with ok==FALSE.  */
+
+static void
+ffestc_shriek_do_ (bool ok)
+{
+  ffelab l;
+
+  if (((l = ffestw_label (ffestw_stack_top ())) != NULL)
+      && (ffewhere_line_is_unknown (ffelab_definition_line (l))))
+    {				/* DO target is label that is still
+				   undefined. */
+      assert ((ffelab_type (l) == FFELAB_typeLOOPEND)
+	      || (ffelab_type (l) == FFELAB_typeANY));
+      if (ffelab_type (l) != FFELAB_typeANY)
+	{
+	  ffelab_set_definition_line (l,
+				      ffewhere_line_use (ffelab_doref_line (l)));
+	  ffelab_set_definition_column (l,
+					ffewhere_column_use (ffelab_doref_column (l)));
+	  ffestv_num_label_defines_++;
+	}
+      ffestd_labeldef_branch (l);
+    }
+
+  ffestd_do (ok);
+
+  if (ffestw_name (ffestw_stack_top ()) != NULL)
+    ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+  if (ffestw_do_iter_var_t (ffestw_stack_top ()) != NULL)
+    ffelex_token_kill (ffestw_do_iter_var_t (ffestw_stack_top ()));
+  if (ffestw_do_iter_var (ffestw_stack_top ()) != NULL)
+    ffesymbol_set_is_doiter (ffestw_do_iter_var (ffestw_stack_top ()), FALSE);
+  ffestw_kill (ffestw_pop ());
+}
+
+/* ffestc_shriek_end_program_ -- End a PROGRAM
+
+   ffestc_shriek_end_program_();  */
+
+static void
+ffestc_shriek_end_program_ (bool ok)
+{
+  if (!ffesta_seen_first_exec)
+    {
+      ffesta_seen_first_exec = TRUE;
+      ffestd_exec_begin ();
+    }
+
+  ffestd_R1103 (ok);
+
+  ffestd_exec_end ();
+
+  if (ffestw_name (ffestw_stack_top ()) != NULL)
+    ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+  ffestw_kill (ffestw_pop ());
+
+  ffe_terminate_2 ();
+  ffe_init_2 ();
+}
+
+/* ffestc_shriek_end_uses_ -- End a bunch of USE statements
+
+   ffestc_shriek_end_uses_(TRUE);
+
+   ok==TRUE means simply not popping due to ffestc_eof()
+   being called, because there is no formal END USES statement in Fortran.  */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_end_uses_ (bool ok)
+{
+  ffestd_end_uses (ok);
+
+  ffestw_kill (ffestw_pop ());
+}
+
+#endif
+/* ffestc_shriek_function_ -- End a FUNCTION
+
+   ffestc_shriek_function_(TRUE);  */
+
+static void
+ffestc_shriek_function_ (bool ok)
+{
+  if (!ffesta_seen_first_exec)
+    {
+      ffesta_seen_first_exec = TRUE;
+      ffestd_exec_begin ();
+    }
+
+  ffestd_R1221 (ok);
+
+  ffestd_exec_end ();
+
+  ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+  ffestw_kill (ffestw_pop ());
+  ffesta_is_entry_valid = FALSE;
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffe_terminate_2 ();
+      ffe_init_2 ();
+      break;
+
+    default:
+      ffe_terminate_3 ();
+      ffe_init_3 ();
+      break;
+
+    case FFESTV_stateINTERFACE0:
+      ffe_terminate_4 ();
+      ffe_init_4 ();
+      break;
+    }
+}
+
+/* ffestc_shriek_if_ -- End of statement following logical IF
+
+   ffestc_shriek_if_(TRUE);
+
+   Applies ONLY to logical IF, not to IF-THEN.	For example, does not
+   ffelex_token_kill the construct name for an IF-THEN block (the name
+   field is invalid for logical IF).  ok==TRUE iff statement following
+   logical IF (substatement) is valid; else, statement is invalid or
+   stack forcibly popped due to ffestc_eof().  */
+
+static void
+ffestc_shriek_if_ (bool ok)
+{
+  ffestd_end_R807 (ok);
+
+  ffestw_kill (ffestw_pop ());
+  ffestc_shriek_after1_ = NULL;
+
+  ffestc_try_shriek_do_ ();
+}
+
+/* ffestc_shriek_ifthen_ -- End an IF-THEN
+
+   ffestc_shriek_ifthen_(TRUE);	 */
+
+static void
+ffestc_shriek_ifthen_ (bool ok)
+{
+  ffestd_R806 (ok);
+
+  if (ffestw_name (ffestw_stack_top ()) != NULL)
+    ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+  ffestw_kill (ffestw_pop ());
+
+  ffestc_try_shriek_do_ ();
+}
+
+/* ffestc_shriek_interface_ -- End an INTERFACE
+
+   ffestc_shriek_interface_(TRUE);  */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_interface_ (bool ok)
+{
+  ffestd_R1203 (ok);
+
+  ffestw_kill (ffestw_pop ());
+
+  ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_shriek_map_ -- End a MAP
+
+   ffestc_shriek_map_(TRUE);  */
+
+#if FFESTR_VXT
+static void
+ffestc_shriek_map_ (bool ok)
+{
+  ffestd_V013 (ok);
+
+  ffestw_kill (ffestw_pop ());
+
+  ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_shriek_module_ -- End a MODULE
+
+   ffestc_shriek_module_(TRUE);	 */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_module_ (bool ok)
+{
+  if (!ffesta_seen_first_exec)
+    {
+      ffesta_seen_first_exec = TRUE;
+      ffestd_exec_begin ();
+    }
+
+  ffestd_R1106 (ok);
+
+  ffestd_exec_end ();
+
+  ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+  ffestw_kill (ffestw_pop ());
+
+  ffe_terminate_2 ();
+  ffe_init_2 ();
+}
+
+#endif
+/* ffestc_shriek_select_ -- End a SELECT
+
+   ffestc_shriek_select_(TRUE);	 */
+
+static void
+ffestc_shriek_select_ (bool ok)
+{
+  ffestwSelect s;
+  ffestwCase c;
+
+  ffestd_R811 (ok);
+
+  if (ffestw_name (ffestw_stack_top ()) != NULL)
+    ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+  s = ffestw_select (ffestw_stack_top ());
+  ffelex_token_kill (s->t);
+  for (c = s->first_rel; c != (ffestwCase) &s->first_rel; c = c->next_rel)
+    ffelex_token_kill (c->t);
+  malloc_pool_kill (s->pool);
+
+  ffestw_kill (ffestw_pop ());
+
+  ffestc_try_shriek_do_ ();
+}
+
+/* ffestc_shriek_structure_ -- End a STRUCTURE
+
+   ffestc_shriek_structure_(TRUE);  */
+
+#if FFESTR_VXT
+static void
+ffestc_shriek_structure_ (bool ok)
+{
+  ffestd_V004 (ok);
+
+  ffestw_kill (ffestw_pop ());
+
+  ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_shriek_subroutine_ -- End a SUBROUTINE
+
+   ffestc_shriek_subroutine_(TRUE);  */
+
+static void
+ffestc_shriek_subroutine_ (bool ok)
+{
+  if (!ffesta_seen_first_exec)
+    {
+      ffesta_seen_first_exec = TRUE;
+      ffestd_exec_begin ();
+    }
+
+  ffestd_R1225 (ok);
+
+  ffestd_exec_end ();
+
+  ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+  ffestw_kill (ffestw_pop ());
+  ffesta_is_entry_valid = FALSE;
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffe_terminate_2 ();
+      ffe_init_2 ();
+      break;
+
+    default:
+      ffe_terminate_3 ();
+      ffe_init_3 ();
+      break;
+
+    case FFESTV_stateINTERFACE0:
+      ffe_terminate_4 ();
+      ffe_init_4 ();
+      break;
+    }
+}
+
+/* ffestc_shriek_type_ -- End a TYPE
+
+   ffestc_shriek_type_(TRUE);  */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_type_ (bool ok)
+{
+  ffestd_R425 (ok);
+
+  ffe_terminate_4 ();
+
+  ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+  ffestw_kill (ffestw_pop ());
+
+  ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_shriek_union_ -- End a UNION
+
+   ffestc_shriek_union_(TRUE);	*/
+
+#if FFESTR_VXT
+static void
+ffestc_shriek_union_ (bool ok)
+{
+  ffestd_V010 (ok);
+
+  ffestw_kill (ffestw_pop ());
+
+  ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_shriek_where_ -- Implicit END WHERE statement
+
+   ffestc_shriek_where_(TRUE);
+
+   Implement the end of the current WHERE "block".  ok==TRUE iff statement
+   following WHERE (substatement) is valid; else, statement is invalid
+   or stack forcibly popped due to ffestc_eof().  */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_where_ (bool ok)
+{
+  ffestd_R745 (ok);
+
+  ffestw_kill (ffestw_pop ());
+  ffestc_shriek_after1_ = NULL;
+  if (ffestw_state (ffestw_stack_top ()) == FFESTV_stateIF)
+    ffestc_shriek_if_ (TRUE);	/* "IF (x) WHERE (y) stmt" is only valid
+				   case. */
+
+  ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_shriek_wherethen_ -- End a WHERE(-THEN)
+
+   ffestc_shriek_wherethen_(TRUE);  */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_wherethen_ (bool ok)
+{
+  ffestd_end_R740 (ok);
+
+  ffestw_kill (ffestw_pop ());
+
+  ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_subr_binsrch_ -- Binary search of char const in list of strings
+
+   i = ffestc_subr_binsrch_(search_list,search_list_size,&spec,"etc");
+
+   search_list contains search_list_size char *'s, spec is checked to see
+   if it is a char constant and, if so, is binary-searched against the list.
+   0 is returned if not found, else the "classic" index (beginning with 1)
+   is returned.	 Before returning 0 where the search was performed but
+   fruitless, if "etc" is a non-NULL char *, an error message is displayed
+   using "etc" as the pick-one-of-these string.	 */
+
+static int
+ffestc_subr_binsrch_ (char **list, int size, ffestpFile *spec, char *whine)
+{
+  int lowest_tested;
+  int highest_tested;
+  int halfway;
+  int offset;
+  int c;
+  char *str;
+  int len;
+
+  if (size == 0)
+    return 0;			/* Nobody should pass size == 0, but for
+				   elegance.... */
+
+  lowest_tested = -1;
+  highest_tested = size;
+  halfway = size >> 1;
+
+  list += halfway;
+
+  c = ffestc_subr_speccmp_ (*list, spec, &str, &len);
+  if (c == 2)
+    return 0;
+  c = -c;			/* Sigh.  */
+
+next:				/* :::::::::::::::::::: */
+  switch (c)
+    {
+    case -1:
+      offset = (halfway - lowest_tested) >> 1;
+      if (offset == 0)
+	goto nope;		/* :::::::::::::::::::: */
+      highest_tested = halfway;
+      list -= offset;
+      halfway -= offset;
+      c = ffesrc_strcmp_1ns2i (ffe_case_match (), str, len, *list);
+      goto next;		/* :::::::::::::::::::: */
+
+    case 0:
+      return halfway + 1;
+
+    case 1:
+      offset = (highest_tested - halfway) >> 1;
+      if (offset == 0)
+	goto nope;		/* :::::::::::::::::::: */
+      lowest_tested = halfway;
+      list += offset;
+      halfway += offset;
+      c = ffesrc_strcmp_1ns2i (ffe_case_match (), str, len, *list);
+      goto next;		/* :::::::::::::::::::: */
+
+    default:
+      assert ("unexpected return from ffesrc_strcmp_1ns2i" == NULL);
+      break;
+    }
+
+nope:				/* :::::::::::::::::::: */
+  ffebad_start (FFEBAD_SPEC_VALUE);
+  ffebad_here (0, ffelex_token_where_line (spec->value),
+	       ffelex_token_where_column (spec->value));
+  ffebad_string (whine);
+  ffebad_finish ();
+  return 0;
+}
+
+/* ffestc_subr_format_ -- Return summary of format specifier
+
+   ffestc_subr_format_(&specifier);  */
+
+static ffestvFormat
+ffestc_subr_format_ (ffestpFile *spec)
+{
+  if (!spec->kw_or_val_present)
+    return FFESTV_formatNONE;
+  assert (spec->value_present);
+  if (spec->value_is_label)
+    return FFESTV_formatLABEL;	/* Ok if not a label. */
+
+  assert (spec->value != NULL);
+  if (ffebld_op (spec->u.expr) == FFEBLD_opSTAR)
+    return FFESTV_formatASTERISK;
+
+  if (ffeinfo_kind (ffebld_info (spec->u.expr)) == FFEINFO_kindNAMELIST)
+    return FFESTV_formatNAMELIST;
+
+  if (ffeinfo_rank (ffebld_info (spec->u.expr)) != 0)
+    return FFESTV_formatCHAREXPR;	/* F77 C5. */
+
+  switch (ffeinfo_basictype (ffebld_info (spec->u.expr)))
+    {
+    case FFEINFO_basictypeINTEGER:
+      return FFESTV_formatINTEXPR;
+
+    case FFEINFO_basictypeCHARACTER:
+      return FFESTV_formatCHAREXPR;
+
+    case FFEINFO_basictypeANY:
+      return FFESTV_formatASTERISK;
+
+    default:
+      assert ("bad basictype" == NULL);
+      return FFESTV_formatINTEXPR;
+    }
+}
+
+/* ffestc_subr_is_branch_ -- Handle specifier as branch target label
+
+   ffestc_subr_is_branch_(&specifier);	*/
+
+static bool
+ffestc_subr_is_branch_ (ffestpFile *spec)
+{
+  if (!spec->kw_or_val_present)
+    return TRUE;
+  assert (spec->value_present);
+  assert (spec->value_is_label);
+  spec->value_is_label++;	/* For checking purposes only; 1=>2. */
+  return ffestc_labelref_is_branch_ (spec->value, &spec->u.label);
+}
+
+/* ffestc_subr_is_format_ -- Handle specifier as format target label
+
+   ffestc_subr_is_format_(&specifier);	*/
+
+static bool
+ffestc_subr_is_format_ (ffestpFile *spec)
+{
+  if (!spec->kw_or_val_present)
+    return TRUE;
+  assert (spec->value_present);
+  if (!spec->value_is_label)
+    return TRUE;		/* Ok if not a label. */
+
+  spec->value_is_label++;	/* For checking purposes only; 1=>2. */
+  return ffestc_labelref_is_format_ (spec->value, &spec->u.label);
+}
+
+/* ffestc_subr_is_present_ -- Ensure specifier is present, else error
+
+   ffestc_subr_is_present_("SPECIFIER",&specifier);  */
+
+static bool
+ffestc_subr_is_present_ (char *name, ffestpFile *spec)
+{
+  if (spec->kw_or_val_present)
+    {
+      assert (spec->value_present);
+      return TRUE;
+    }
+
+  ffebad_start (FFEBAD_MISSING_SPECIFIER);
+  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+	       ffelex_token_where_column (ffesta_tokens[0]));
+  ffebad_string (name);
+  ffebad_finish ();
+  return FALSE;
+}
+
+/* ffestc_subr_speccmp_ -- Compare string to constant expression, if present
+
+   if (ffestc_subr_speccmp_("Constant",&specifier,NULL,NULL) == 0)
+       // specifier value is present and is a char constant "CONSTANT"
+
+   Like strcmp, except the return values are defined as: -1 returned in place
+   of strcmp's generic negative value, 1 in place of it's generic positive
+   value, and 2 when there is no character constant string to compare.	Also,
+   a case-insensitive comparison is performed, where string is assumed to
+   already be in InitialCaps form.
+
+   If a non-NULL pointer is provided as the char **target, then *target is
+   written with NULL if 2 is returned, a pointer to the constant string
+   value of the specifier otherwise.  Similarly, length is written with
+   0 if 2 is returned, the length of the constant string value otherwise.  */
+
+static int
+ffestc_subr_speccmp_ (char *string, ffestpFile *spec, char **target,
+		      int *length)
+{
+  ffebldConstant c;
+  int i;
+
+  if (!spec->kw_or_val_present || !spec->value_present
+      || (spec->u.expr == NULL)
+      || (ffebld_op (spec->u.expr) != FFEBLD_opCONTER))
+    {
+      if (target != NULL)
+	*target = NULL;
+      if (length != NULL)
+	*length = 0;
+      return 2;
+    }
+
+  if (ffebld_constant_type (c = ffebld_conter (spec->u.expr))
+      != FFEBLD_constCHARACTERDEFAULT)
+    {
+      if (target != NULL)
+	*target = NULL;
+      if (length != NULL)
+	*length = 0;
+      return 2;
+    }
+
+  if (target != NULL)
+    *target = ffebld_constant_characterdefault (c).text;
+  if (length != NULL)
+    *length = ffebld_constant_characterdefault (c).length;
+
+  i = ffesrc_strcmp_1ns2i (ffe_case_match (),
+			   ffebld_constant_characterdefault (c).text,
+			   ffebld_constant_characterdefault (c).length,
+			   string);
+  if (i == 0)
+    return 0;
+  if (i > 0)
+    return -1;			/* Yes indeed, we reverse the strings to
+				   _strcmpin_.	 */
+  return 1;
+}
+
+/* ffestc_subr_unit_ -- Return summary of unit specifier
+
+   ffestc_subr_unit_(&specifier);  */
+
+static ffestvUnit
+ffestc_subr_unit_ (ffestpFile *spec)
+{
+  if (!spec->kw_or_val_present)
+    return FFESTV_unitNONE;
+  assert (spec->value_present);
+  assert (spec->value != NULL);
+
+  if (ffebld_op (spec->u.expr) == FFEBLD_opSTAR)
+    return FFESTV_unitASTERISK;
+
+  switch (ffeinfo_basictype (ffebld_info (spec->u.expr)))
+    {
+    case FFEINFO_basictypeINTEGER:
+      return FFESTV_unitINTEXPR;
+
+    case FFEINFO_basictypeCHARACTER:
+      return FFESTV_unitCHAREXPR;
+
+    case FFEINFO_basictypeANY:
+      return FFESTV_unitASTERISK;
+
+    default:
+      assert ("bad basictype" == NULL);
+      return FFESTV_unitINTEXPR;
+    }
+}
+
+/* Call this function whenever it's possible that one or more top
+   stack items are label-targeting DO blocks that have had their
+   labels defined, but at a time when they weren't at the top of the
+   stack.  This prevents uninformative diagnostics for programs
+   like "DO 10", "IF (...) THEN", "10 ELSE", "END IF", "END".  */
+
+static void
+ffestc_try_shriek_do_ ()
+{
+  ffelab lab;
+  ffelabType ty;
+
+  while ((ffestw_state (ffestw_stack_top ()) == FFESTV_stateDO)
+	 && ((lab = (ffestw_label (ffestw_stack_top ()))) != NULL)
+	 && (((ty = (ffelab_type (lab)))
+	      == FFELAB_typeANY)
+	     || (ty == FFELAB_typeUSELESS)
+	     || (ty == FFELAB_typeFORMAT)
+	     || (ty == FFELAB_typeNOTLOOP)
+	     || (ty == FFELAB_typeENDIF)))
+    ffestc_shriek_do_ (FALSE);
+}
+
+/* ffestc_decl_start -- R426 or R501
+
+   ffestc_decl_start(...);
+
+   Verify that R426 component-def-stmt or R501 type-declaration-stmt are
+   valid here, figure out which one, and implement.  */
+
+void
+ffestc_decl_start (ffestpType type, ffelexToken typet, ffebld kind,
+		   ffelexToken kindt, ffebld len, ffelexToken lent)
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+    case FFESTV_statePROGRAM0:
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateBLOCKDATA0:
+    case FFESTV_statePROGRAM1:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateBLOCKDATA1:
+    case FFESTV_statePROGRAM2:
+    case FFESTV_stateSUBROUTINE2:
+    case FFESTV_stateFUNCTION2:
+    case FFESTV_stateMODULE2:
+    case FFESTV_stateBLOCKDATA2:
+    case FFESTV_statePROGRAM3:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateMODULE3:
+    case FFESTV_stateBLOCKDATA3:
+    case FFESTV_stateUSE:
+      ffestc_local_.decl.is_R426 = 2;
+      break;
+
+    case FFESTV_stateTYPE:
+    case FFESTV_stateSTRUCTURE:
+    case FFESTV_stateMAP:
+      ffestc_local_.decl.is_R426 = 1;
+      break;
+
+    default:
+      ffestc_order_bad_ ();
+      ffestc_labeldef_useless_ ();
+      ffestc_local_.decl.is_R426 = 0;
+      return;
+    }
+
+  switch (ffestc_local_.decl.is_R426)
+    {
+#if FFESTR_F90
+    case 1:
+      ffestc_R426_start (type, typet, kind, kindt, len, lent);
+      break;
+#endif
+
+    case 2:
+      ffestc_R501_start (type, typet, kind, kindt, len, lent);
+      break;
+
+    default:
+      ffestc_labeldef_useless_ ();
+      break;
+    }
+}
+
+/* ffestc_decl_attrib -- R426 or R501 type attribute
+
+   ffestc_decl_attrib(...);
+
+   Verify that R426 component-def-stmt or R501 type-declaration-stmt attribute
+   is valid here and implement.	 */
+
+void
+ffestc_decl_attrib (ffestpAttrib attrib UNUSED,
+		    ffelexToken attribt UNUSED,
+		    ffestrOther intent_kw UNUSED,
+		    ffesttDimList dims UNUSED)
+{
+#if FFESTR_F90
+  switch (ffestc_local_.decl.is_R426)
+    {
+    case 1:
+      ffestc_R426_attrib (attrib, attribt, intent_kw, dims);
+      break;
+
+    case 2:
+      ffestc_R501_attrib (attrib, attribt, intent_kw, dims);
+      break;
+
+    default:
+      break;
+    }
+#else
+  ffebad_start (FFEBAD_F90);
+  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+	       ffelex_token_where_column (ffesta_tokens[0]));
+  ffebad_finish ();
+  return;
+#endif
+}
+
+/* ffestc_decl_item -- R426 or R501
+
+   ffestc_decl_item(...);
+
+   Establish type for a particular object.  */
+
+void
+ffestc_decl_item (ffelexToken name, ffebld kind, ffelexToken kindt,
+	      ffesttDimList dims, ffebld len, ffelexToken lent, ffebld init,
+		  ffelexToken initt, bool clist)
+{
+  switch (ffestc_local_.decl.is_R426)
+    {
+#if FFESTR_F90
+    case 1:
+      ffestc_R426_item (name, kind, kindt, dims, len, lent, init, initt,
+			clist);
+      break;
+#endif
+
+    case 2:
+      ffestc_R501_item (name, kind, kindt, dims, len, lent, init, initt,
+			clist);
+      break;
+
+    default:
+      break;
+    }
+}
+
+/* ffestc_decl_itemstartvals -- R426 or R501 start list of values
+
+   ffestc_decl_itemstartvals();
+
+   Gonna specify values for the object now.  */
+
+void
+ffestc_decl_itemstartvals ()
+{
+  switch (ffestc_local_.decl.is_R426)
+    {
+#if FFESTR_F90
+    case 1:
+      ffestc_R426_itemstartvals ();
+      break;
+#endif
+
+    case 2:
+      ffestc_R501_itemstartvals ();
+      break;
+
+    default:
+      break;
+    }
+}
+
+/* ffestc_decl_itemvalue -- R426 or R501 source value
+
+   ffestc_decl_itemvalue(repeat,repeat_token,value,value_token);
+
+   Make sure repeat and value are valid for the object being initialized.  */
+
+void
+ffestc_decl_itemvalue (ffebld repeat, ffelexToken repeat_token,
+		       ffebld value, ffelexToken value_token)
+{
+  switch (ffestc_local_.decl.is_R426)
+    {
+#if FFESTR_F90
+    case 1:
+      ffestc_R426_itemvalue (repeat, repeat_token, value, value_token);
+      break;
+#endif
+
+    case 2:
+      ffestc_R501_itemvalue (repeat, repeat_token, value, value_token);
+      break;
+
+    default:
+      break;
+    }
+}
+
+/* ffestc_decl_itemendvals -- R426 or R501 end list of values
+
+   ffelexToken t;  // the SLASH token that ends the list.
+   ffestc_decl_itemendvals(t);
+
+   No more values, might specify more objects now.  */
+
+void
+ffestc_decl_itemendvals (ffelexToken t)
+{
+  switch (ffestc_local_.decl.is_R426)
+    {
+#if FFESTR_F90
+    case 1:
+      ffestc_R426_itemendvals (t);
+      break;
+#endif
+
+    case 2:
+      ffestc_R501_itemendvals (t);
+      break;
+
+    default:
+      break;
+    }
+}
+
+/* ffestc_decl_finish -- R426 or R501
+
+   ffestc_decl_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_decl_finish ()
+{
+  switch (ffestc_local_.decl.is_R426)
+    {
+#if FFESTR_F90
+    case 1:
+      ffestc_R426_finish ();
+      break;
+#endif
+
+    case 2:
+      ffestc_R501_finish ();
+      break;
+
+    default:
+      break;
+    }
+}
+
+/* ffestc_elsewhere -- Generic ELSE WHERE statement
+
+   ffestc_end();
+
+   Decide whether ELSEWHERE or ELSE w/if-construct-name=="WHERE" is meant.  */
+
+void
+ffestc_elsewhere (ffelexToken where)
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateIFTHEN:
+      ffestc_R805 (where);
+      break;
+
+    default:
+#if FFESTR_F90
+      ffestc_R744 ();
+#endif
+      break;
+    }
+}
+
+/* ffestc_end -- Generic END statement
+
+   ffestc_end();
+
+   Make sure a generic END is valid in the current context, and implement
+   it.	*/
+
+void
+ffestc_end ()
+{
+  ffestw b;
+
+  b = ffestw_stack_top ();
+
+recurse:
+
+  switch (ffestw_state (b))
+    {
+    case FFESTV_stateBLOCKDATA0:
+    case FFESTV_stateBLOCKDATA1:
+    case FFESTV_stateBLOCKDATA2:
+    case FFESTV_stateBLOCKDATA3:
+    case FFESTV_stateBLOCKDATA4:
+    case FFESTV_stateBLOCKDATA5:
+      ffestc_R1112 (NULL);
+      break;
+
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateFUNCTION4:
+    case FFESTV_stateFUNCTION5:
+      if ((ffestw_state (ffestw_previous (b)) != FFESTV_stateNIL)
+	  && (ffestw_state (ffestw_previous (b)) != FFESTV_stateINTERFACE0))
+	{
+	  ffebad_start (FFEBAD_END_WO);
+	  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		       ffelex_token_where_column (ffesta_tokens[0]));
+	  ffebad_here (1, ffestw_line (ffestw_previous (b)), ffestw_col (ffestw_previous (b)));
+	  ffebad_string ("FUNCTION");
+	  ffebad_finish ();
+	}
+      ffestc_R1221 (NULL);
+      break;
+
+    case FFESTV_stateMODULE0:
+    case FFESTV_stateMODULE1:
+    case FFESTV_stateMODULE2:
+    case FFESTV_stateMODULE3:
+    case FFESTV_stateMODULE4:
+    case FFESTV_stateMODULE5:
+#if FFESTR_F90
+      ffestc_R1106 (NULL);
+#endif
+      break;
+
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateSUBROUTINE2:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateSUBROUTINE4:
+    case FFESTV_stateSUBROUTINE5:
+      if ((ffestw_state (ffestw_previous (b)) != FFESTV_stateNIL)
+	  && (ffestw_state (ffestw_previous (b)) != FFESTV_stateINTERFACE0))
+	{
+	  ffebad_start (FFEBAD_END_WO);
+	  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		       ffelex_token_where_column (ffesta_tokens[0]));
+	  ffebad_here (1, ffestw_line (ffestw_previous (b)), ffestw_col (ffestw_previous (b)));
+	  ffebad_string ("SUBROUTINE");
+	  ffebad_finish ();
+	}
+      ffestc_R1225 (NULL);
+      break;
+
+    case FFESTV_stateUSE:
+      b = ffestw_previous (ffestw_stack_top ());
+      goto recurse;		/* :::::::::::::::::::: */
+
+    default:
+      ffestc_R1103 (NULL);
+      break;
+    }
+}
+
+/* ffestc_eof -- Generic EOF
+
+   ffestc_eof();
+
+   Make sure we're at state NIL, or issue an error message and use each
+   block's shriek function to clean up to state NIL.  */
+
+void
+ffestc_eof ()
+{
+  if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateNIL)
+    {
+      ffebad_start (FFEBAD_EOF_BEFORE_BLOCK_END);
+      ffebad_here (0, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+      do
+	(*ffestw_shriek (ffestw_stack_top ()))(FALSE);
+      while (ffestw_state (ffestw_stack_top ()) != FFESTV_stateNIL);
+    }
+}
+
+/* ffestc_exec_transition -- Check if ok and move stmt state to executable
+
+   if (ffestc_exec_transition())
+       // Transition successful (kind of like a CONTINUE stmt was seen).
+
+   If the current statement state is a non-nested specification state in
+   which, say, a CONTINUE statement would be valid, then enter the state
+   we'd be in after seeing CONTINUE (without, of course, generating any
+   CONTINUE code), call ffestd_exec_begin, and return TRUE.  Otherwise
+   return FALSE.
+
+   This function cannot be invoked once the first executable statement
+   is seen.  This function may choose to always return TRUE by shrieking
+   away any interceding state stack entries to reach the base level of
+   specification state, but right now it doesn't, and it is (or should
+   be) purely an issue of how one wishes errors to be handled (for example,
+   an unrecognized statement in the middle of a STRUCTURE construct: after
+   the error message, should subsequent statements still be interpreted as
+   being within the construct, or should the construct be terminated upon
+   seeing the unrecognized statement?  we do the former at the moment).  */
+
+bool
+ffestc_exec_transition ()
+{
+  bool update;
+
+recurse:
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+      ffestc_shriek_begin_program_ ();
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFESTV_statePROGRAM0:
+    case FFESTV_stateSUBROUTINE0:
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateBLOCKDATA0:
+      ffestw_state (ffestw_stack_top ()) += 4;	/* To state UNIT4. */
+      update = TRUE;
+      break;
+
+    case FFESTV_statePROGRAM1:
+    case FFESTV_stateSUBROUTINE1:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateBLOCKDATA1:
+      ffestw_state (ffestw_stack_top ()) += 3;	/* To state UNIT4. */
+      update = TRUE;
+      break;
+
+    case FFESTV_statePROGRAM2:
+    case FFESTV_stateSUBROUTINE2:
+    case FFESTV_stateFUNCTION2:
+    case FFESTV_stateBLOCKDATA2:
+      ffestw_state (ffestw_stack_top ()) += 2;	/* To state UNIT4. */
+      update = TRUE;
+      break;
+
+    case FFESTV_statePROGRAM3:
+    case FFESTV_stateSUBROUTINE3:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateBLOCKDATA3:
+      ffestw_state (ffestw_stack_top ()) += 1;	/* To state UNIT4. */
+      update = TRUE;
+      break;
+
+    case FFESTV_stateUSE:
+#if FFESTR_F90
+      ffestc_shriek_end_uses_ (TRUE);
+#endif
+      goto recurse;		/* :::::::::::::::::::: */
+
+    default:
+      return FALSE;
+    }
+
+  if (update)
+    ffestw_update (NULL);	/* Update state line/col info. */
+
+  ffesta_seen_first_exec = TRUE;
+  ffestd_exec_begin ();
+
+  return TRUE;
+}
+
+/* ffestc_ffebad_here_doiter -- Calls ffebad_here with ptr to DO iter var
+
+   ffesymbol s;
+   // call ffebad_start first, of course.
+   ffestc_ffebad_here_doiter(0,s);
+   // call ffebad_finish afterwards, naturally.
+
+   Searches the stack of blocks backwards for a DO loop that has s
+   as its iteration variable, then calls ffebad_here with pointers to
+   that particular reference to the variable.  Crashes if the DO loop
+   can't be found.  */
+
+void
+ffestc_ffebad_here_doiter (ffebadIndex i, ffesymbol s)
+{
+  ffestw block;
+
+  for (block = ffestw_top_do (ffestw_stack_top ());
+       (block != NULL) && (ffestw_blocknum (block) != 0);
+       block = ffestw_top_do (ffestw_previous (block)))
+    {
+      if (ffestw_do_iter_var (block) == s)
+	{
+	  ffebad_here (i, ffelex_token_where_line (ffestw_do_iter_var_t (block)),
+		  ffelex_token_where_column (ffestw_do_iter_var_t (block)));
+	  return;
+	}
+    }
+  assert ("no do block found" == NULL);
+}
+
+/* ffestc_is_decl_not_R1219 -- Context information for FFESTB
+
+   if (ffestc_is_decl_not_R1219()) ...
+
+   When a statement with the form "type[RECURSIVE]FUNCTIONname(name-list)"
+   is seen, call this function.	 It returns TRUE if the statement's context
+   is such that it is a declaration of an object named
+   "[RECURSIVE]FUNCTIONname" with an array-decl spec of "name-list", FALSE
+   if the statement's context is such that it begins the definition of a
+   function named "name" havin the dummy argument list "name-list" (this
+   is the R1219 function-stmt case).  */
+
+bool
+ffestc_is_decl_not_R1219 ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateNIL:
+    case FFESTV_statePROGRAM5:
+    case FFESTV_stateSUBROUTINE5:
+    case FFESTV_stateFUNCTION5:
+    case FFESTV_stateMODULE5:
+    case FFESTV_stateINTERFACE0:
+      return FALSE;
+
+    default:
+      return TRUE;
+    }
+}
+
+/* ffestc_is_entry_in_subr -- Context information for FFESTB
+
+   if (ffestc_is_entry_in_subr()) ...
+
+   When a statement with the form "ENTRY name(name-list)"
+   is seen, call this function.	 It returns TRUE if the statement's context
+   is such that it may have "*", meaning alternate return, in place of
+   names in the name list (i.e. if the ENTRY is in a subroutine context).
+   It also returns TRUE if the ENTRY is not in a function context (invalid
+   but prevents extra complaints about "*", if present).  It returns FALSE
+   if the ENTRY is in a function context.  */
+
+bool
+ffestc_is_entry_in_subr ()
+{
+  ffestvState s;
+
+  s = ffestw_state (ffestw_stack_top ());
+
+recurse:
+
+  switch (s)
+    {
+    case FFESTV_stateFUNCTION0:
+    case FFESTV_stateFUNCTION1:
+    case FFESTV_stateFUNCTION2:
+    case FFESTV_stateFUNCTION3:
+    case FFESTV_stateFUNCTION4:
+      return FALSE;
+
+    case FFESTV_stateUSE:
+      s = ffestw_state (ffestw_previous (ffestw_stack_top ()));
+      goto recurse;		/* :::::::::::::::::::: */
+
+    default:
+      return TRUE;
+    }
+}
+
+/* ffestc_is_let_not_V027 -- Context information for FFESTB
+
+   if (ffestc_is_let_not_V027()) ...
+
+   When a statement with the form "PARAMETERname=expr"
+   is seen, call this function.	 It returns TRUE if the statement's context
+   is such that it is an assignment to an object named "PARAMETERname", FALSE
+   if the statement's context is such that it is a V-extension PARAMETER
+   statement that is like a PARAMETER(name=expr) statement except that the
+   type of name is determined by the type of expr, not the implicit or
+   explicit typing of name.  */
+
+bool
+ffestc_is_let_not_V027 ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_statePROGRAM4:
+    case FFESTV_stateSUBROUTINE4:
+    case FFESTV_stateFUNCTION4:
+    case FFESTV_stateWHERETHEN:
+    case FFESTV_stateIFTHEN:
+    case FFESTV_stateDO:
+    case FFESTV_stateSELECT0:
+    case FFESTV_stateSELECT1:
+    case FFESTV_stateWHERE:
+    case FFESTV_stateIF:
+      return TRUE;
+
+    default:
+      return FALSE;
+    }
+}
+
+/* ffestc_module -- MODULE or MODULE PROCEDURE statement
+
+   ffestc_module(module_name_token,procedure_name_token);
+
+   Decide which is intended, and implement it by calling _R1105_ or
+   _R1205_.  */
+
+#if FFESTR_F90
+void
+ffestc_module (ffelexToken module, ffelexToken procedure)
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateINTERFACE0:
+    case FFESTV_stateINTERFACE1:
+      ffestc_R1205_start ();
+      ffestc_R1205_item (procedure);
+      ffestc_R1205_finish ();
+      break;
+
+    default:
+      ffestc_R1105 (module);
+      break;
+    }
+}
+
+#endif
+/* ffestc_private -- Generic PRIVATE statement
+
+   ffestc_end();
+
+   This is either a PRIVATE within R422 derived-type statement or an
+   R521 PRIVATE statement.  Figure it out based on context and implement
+   it, or produce an error.  */
+
+#if FFESTR_F90
+void
+ffestc_private ()
+{
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateTYPE:
+      ffestc_R423A ();
+      break;
+
+    default:
+      ffestc_R521B ();
+      break;
+    }
+}
+
+#endif
+/* ffestc_terminate_4 -- Terminate ffestc after scoping unit
+
+   ffestc_terminate_4();
+
+   For SUBROUTINEs/FUNCTIONs within INTERFACE/END INTERFACE, derived-TYPE-
+   defs, and statement function defs.  */
+
+void
+ffestc_terminate_4 ()
+{
+  ffestc_entry_num_ = ffestc_saved_entry_num_;
+}
+
+/* ffestc_R423A -- PRIVATE statement (in R422 derived-type statement)
+
+   ffestc_R423A();  */
+
+#if FFESTR_F90
+void
+ffestc_R423A ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_type_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (ffestw_substate (ffestw_stack_top ()) != 0)
+    {
+      ffebad_start (FFEBAD_DERIVTYP_ACCESS_FIRST);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+      return;
+    }
+
+  if (ffestw_state (ffestw_previous (ffestw_stack_top ())) != FFESTV_stateMODULE3)
+    {
+      ffebad_start (FFEBAD_DERIVTYP_ACCESS);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_finish ();
+      return;
+    }
+
+  ffestw_set_substate (ffestw_stack_top (), 1);	/* Seen
+						   private-sequence-stmt. */
+
+  ffestd_R423A ();
+}
+
+/* ffestc_R423B -- SEQUENCE statement (in R422 derived-type-stmt)
+
+   ffestc_R423B();  */
+
+void
+ffestc_R423B ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_type_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (ffestw_substate (ffestw_stack_top ()) != 0)
+    {
+      ffebad_start (FFEBAD_DERIVTYP_ACCESS_FIRST);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+      return;
+    }
+
+  ffestw_set_substate (ffestw_stack_top (), 1);	/* Seen
+						   private-sequence-stmt. */
+
+  ffestd_R423B ();
+}
+
+/* ffestc_R424 -- derived-TYPE-def statement
+
+   ffestc_R424(access_token,access_kw,name_token);
+
+   Handle a derived-type definition.  */
+
+void
+ffestc_R424 (ffelexToken access, ffestrOther access_kw, ffelexToken name)
+{
+  ffestw b;
+
+  assert (name != NULL);
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_derivedtype_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if ((access != NULL)
+      && (ffestw_state (ffestw_stack_top ()) != FFESTV_stateMODULE3))
+    {
+      ffebad_start (FFEBAD_DERIVTYP_ACCESS);
+      ffebad_here (0, ffelex_token_where_line (access),
+		   ffelex_token_where_column (access));
+      ffebad_finish ();
+      access = NULL;
+    }
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_stateTYPE);
+  ffestw_set_blocknum (b, 0);
+  ffestw_set_shriek (b, ffestc_shriek_type_);
+  ffestw_set_name (b, ffelex_token_use (name));
+  ffestw_set_substate (b, 0);	/* Awaiting private-sequence-stmt and one
+				   component-def-stmt. */
+
+  ffestd_R424 (access, access_kw, name);
+
+  ffe_init_4 ();
+}
+
+/* ffestc_R425 -- END TYPE statement
+
+   ffestc_R425(name_token);
+
+   Make sure ffestc_kind_ identifies a TYPE definition.	 If not
+   NULL, make sure name_token gives the correct name.  Implement the end
+   of the type definition.  */
+
+void
+ffestc_R425 (ffelexToken name)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_type_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (ffestw_substate (ffestw_stack_top ()) != 2)
+    {
+      ffebad_start (FFEBAD_DERIVTYP_NO_COMPONENTS);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+    }
+
+  if ((name != NULL)
+    && (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0))
+    {
+      ffebad_start (FFEBAD_TYPE_WRONG_NAME);
+      ffebad_here (0, ffelex_token_where_line (name),
+		   ffelex_token_where_column (name));
+      ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+	     ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+      ffebad_finish ();
+    }
+
+  ffestc_shriek_type_ (TRUE);
+}
+
+/* ffestc_R426_start -- component-declaration-stmt
+
+   ffestc_R426_start(...);
+
+   Verify that R426 component-declaration-stmt is
+   valid here and implement.  */
+
+void
+ffestc_R426_start (ffestpType type, ffelexToken typet, ffebld kind,
+		   ffelexToken kindt, ffebld len, ffelexToken lent)
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_component_ () != FFESTC_orderOK_)
+    {
+      ffestc_local_.decl.is_R426 = 0;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateSTRUCTURE:
+    case FFESTV_stateMAP:
+      ffestw_set_substate (ffestw_stack_top (), 1);	/* Seen at least one
+							   member. */
+      break;
+
+    case FFESTV_stateTYPE:
+      ffestw_set_substate (ffestw_stack_top (), 2);
+      break;
+
+    default:
+      assert ("Component parent state invalid" == NULL);
+      break;
+    }
+}
+
+/* ffestc_R426_attrib -- type attribute
+
+   ffestc_R426_attrib(...);
+
+   Verify that R426 component-declaration-stmt attribute
+   is valid here and implement.	 */
+
+void
+ffestc_R426_attrib (ffestpAttrib attrib, ffelexToken attribt,
+		    ffestrOther intent_kw, ffesttDimList dims)
+{
+  ffestc_check_attrib_ ();
+}
+
+/* ffestc_R426_item -- declared object
+
+   ffestc_R426_item(...);
+
+   Establish type for a particular object.  */
+
+void
+ffestc_R426_item (ffelexToken name, ffebld kind, ffelexToken kindt,
+	      ffesttDimList dims, ffebld len, ffelexToken lent, ffebld init,
+		  ffelexToken initt, bool clist)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  assert (ffelex_token_type (name) == FFELEX_typeNAME);	/* Not NAMES. */
+  assert (kind == NULL);	/* No way an expression should get here. */
+
+  if ((dims != NULL) || (init != NULL) || clist)
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+}
+
+/* ffestc_R426_itemstartvals -- Start list of values
+
+   ffestc_R426_itemstartvals();
+
+   Gonna specify values for the object now.  */
+
+void
+ffestc_R426_itemstartvals ()
+{
+  ffestc_check_item_startvals_ ();
+}
+
+/* ffestc_R426_itemvalue -- Source value
+
+   ffestc_R426_itemvalue(repeat,repeat_token,value,value_token);
+
+   Make sure repeat and value are valid for the object being initialized.  */
+
+void
+ffestc_R426_itemvalue (ffebld repeat, ffelexToken repeat_token,
+		       ffebld value, ffelexToken value_token)
+{
+  ffestc_check_item_value_ ();
+}
+
+/* ffestc_R426_itemendvals -- End list of values
+
+   ffelexToken t;  // the SLASH token that ends the list.
+   ffestc_R426_itemendvals(t);
+
+   No more values, might specify more objects now.  */
+
+void
+ffestc_R426_itemendvals (ffelexToken t)
+{
+  ffestc_check_item_endvals_ ();
+}
+
+/* ffestc_R426_finish -- Done
+
+   ffestc_R426_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R426_finish ()
+{
+  ffestc_check_finish_ ();
+}
+
+#endif
+/* ffestc_R501_start -- type-declaration-stmt
+
+   ffestc_R501_start(...);
+
+   Verify that R501 type-declaration-stmt is
+   valid here and implement.  */
+
+void
+ffestc_R501_start (ffestpType type, ffelexToken typet, ffebld kind,
+		   ffelexToken kindt, ffebld len, ffelexToken lent)
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_typedecl_ () != FFESTC_orderOK_)
+    {
+      ffestc_local_.decl.is_R426 = 0;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestc_establish_declstmt_ (type, typet, kind, kindt, len, lent);
+}
+
+/* ffestc_R501_attrib -- type attribute
+
+   ffestc_R501_attrib(...);
+
+   Verify that R501 type-declaration-stmt attribute
+   is valid here and implement.	 */
+
+void
+ffestc_R501_attrib (ffestpAttrib attrib, ffelexToken attribt,
+		    ffestrOther intent_kw UNUSED,
+		    ffesttDimList dims UNUSED)
+{
+  ffestc_check_attrib_ ();
+
+  switch (attrib)
+    {
+#if FFESTR_F90
+    case FFESTP_attribALLOCATABLE:
+      break;
+#endif
+
+    case FFESTP_attribDIMENSION:
+      ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+      break;
+
+    case FFESTP_attribEXTERNAL:
+      break;
+
+#if FFESTR_F90
+    case FFESTP_attribINTENT:
+      break;
+#endif
+
+    case FFESTP_attribINTRINSIC:
+      break;
+
+#if FFESTR_F90
+    case FFESTP_attribOPTIONAL:
+      break;
+#endif
+
+    case FFESTP_attribPARAMETER:
+      break;
+
+#if FFESTR_F90
+    case FFESTP_attribPOINTER:
+      break;
+#endif
+
+#if FFESTR_F90
+    case FFESTP_attribPRIVATE:
+      break;
+
+    case FFESTP_attribPUBLIC:
+      break;
+#endif
+
+    case FFESTP_attribSAVE:
+      switch (ffestv_save_state_)
+	{
+	case FFESTV_savestateNONE:
+	  ffestv_save_state_ = FFESTV_savestateSPECIFIC;
+	  ffestv_save_line_
+	    = ffewhere_line_use (ffelex_token_where_line (attribt));
+	  ffestv_save_col_
+	    = ffewhere_column_use (ffelex_token_where_column (attribt));
+	  break;
+
+	case FFESTV_savestateSPECIFIC:
+	case FFESTV_savestateANY:
+	  break;
+
+	case FFESTV_savestateALL:
+	  if (ffe_is_pedantic ())
+	    {
+	      ffebad_start (FFEBAD_CONFLICTING_SAVES);
+	      ffebad_here (0, ffestv_save_line_, ffestv_save_col_);
+	      ffebad_here (1, ffelex_token_where_line (attribt),
+			   ffelex_token_where_column (attribt));
+	      ffebad_finish ();
+	    }
+	  ffestv_save_state_ = FFESTV_savestateANY;
+	  break;
+
+	default:
+	  assert ("unexpected save state" == NULL);
+	  break;
+	}
+      break;
+
+#if FFESTR_F90
+    case FFESTP_attribTARGET:
+      break;
+#endif
+
+    default:
+      assert ("unexpected attribute" == NULL);
+      break;
+    }
+}
+
+/* ffestc_R501_item -- declared object
+
+   ffestc_R501_item(...);
+
+   Establish type for a particular object.  */
+
+void
+ffestc_R501_item (ffelexToken name, ffebld kind, ffelexToken kindt,
+		  ffesttDimList dims, ffebld len, ffelexToken lent,
+		  ffebld init, ffelexToken initt, bool clist)
+{
+  ffesymbol s;
+  ffesymbol sfn;		/* FUNCTION symbol. */
+  ffebld array_size;
+  ffebld extents;
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffestpDimtype nd;
+  bool is_init = (init != NULL) || clist;
+  bool is_assumed;
+  ffeinfoRank rank;
+
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  assert (ffelex_token_type (name) == FFELEX_typeNAME);	/* Not NAMES. */
+  assert (kind == NULL);	/* No way an expression should get here. */
+
+  ffestc_establish_declinfo_ (kind, kindt, len, lent);
+
+  is_assumed = (ffestc_local_.decl.basic_type == FFEINFO_basictypeCHARACTER)
+    && (ffestc_local_.decl.size == FFETARGET_charactersizeNONE);
+
+  if ((dims != NULL) || is_init)
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+  s = ffesymbol_declare_local (name, TRUE);
+  sa = ffesymbol_attrs (s);
+
+  /* First figure out what kind of object this is based solely on the current
+     object situation (type params, dimension list, and initialization). */
+
+  na = FFESYMBOL_attrsTYPE;
+
+  if (is_assumed)
+    na |= FFESYMBOL_attrsANYLEN;
+
+  nd = ffestt_dimlist_type (dims);
+  switch (nd)
+    {
+    case FFESTP_dimtypeNONE:
+      break;
+
+    case FFESTP_dimtypeKNOWN:
+      na |= FFESYMBOL_attrsARRAY;
+      break;
+
+    case FFESTP_dimtypeADJUSTABLE:
+      na |= FFESYMBOL_attrsARRAY | FFESYMBOL_attrsADJUSTABLE;
+      break;
+
+    case FFESTP_dimtypeASSUMED:
+      na |= FFESYMBOL_attrsARRAY | FFESYMBOL_attrsANYSIZE;
+      break;
+
+    case FFESTP_dimtypeADJUSTABLEASSUMED:
+      na |= FFESYMBOL_attrsARRAY | FFESYMBOL_attrsADJUSTABLE
+	| FFESYMBOL_attrsANYSIZE;
+      break;
+
+    default:
+      assert ("unexpected dimtype" == NULL);
+      na = FFESYMBOL_attrsetNONE;
+      break;
+    }
+
+  if (!ffesta_is_entry_valid
+      && (((na & (FFESYMBOL_attrsANYLEN | FFESYMBOL_attrsARRAY))
+	   == (FFESYMBOL_attrsANYLEN | FFESYMBOL_attrsARRAY))))
+    na = FFESYMBOL_attrsetNONE;
+
+  if (is_init)
+    {
+      if (na == FFESYMBOL_attrsetNONE)
+	;
+      else if (na & (FFESYMBOL_attrsANYLEN
+		     | FFESYMBOL_attrsADJUSTABLE
+		     | FFESYMBOL_attrsANYSIZE))
+	na = FFESYMBOL_attrsetNONE;
+      else
+	na |= FFESYMBOL_attrsINIT;
+    }
+
+  /* Now figure out what kind of object we've got based on previous
+     declarations of or references to the object. */
+
+  if (na == FFESYMBOL_attrsetNONE)
+    ;
+  else if (!ffesymbol_is_specable (s)
+	   && (((ffesymbol_where (s) != FFEINFO_whereCONSTANT)
+		&& (ffesymbol_where (s) != FFEINFO_whereINTRINSIC))
+	       || (na & (FFESYMBOL_attrsARRAY | FFESYMBOL_attrsINIT))))
+    na = FFESYMBOL_attrsetNONE;	/* Can't dcl sym ref'd in sfuncdef, and can't
+				   dimension/init UNDERSTOODs. */
+  else if (sa & FFESYMBOL_attrsANY)
+    na = sa;
+  else if ((sa & na)
+	   || ((sa & (FFESYMBOL_attrsSFARG
+		      | FFESYMBOL_attrsADJUSTS))
+	       && (na & (FFESYMBOL_attrsARRAY
+			 | FFESYMBOL_attrsANYLEN)))
+	   || ((sa & FFESYMBOL_attrsRESULT)
+	       && (na & (FFESYMBOL_attrsARRAY
+			 | FFESYMBOL_attrsINIT)))
+	   || ((sa & (FFESYMBOL_attrsSFUNC
+		      | FFESYMBOL_attrsEXTERNAL
+		      | FFESYMBOL_attrsINTRINSIC
+		      | FFESYMBOL_attrsINIT))
+	       && (na & (FFESYMBOL_attrsARRAY
+			 | FFESYMBOL_attrsANYLEN
+			 | FFESYMBOL_attrsINIT)))
+	   || ((sa & FFESYMBOL_attrsARRAY)
+	       && !ffesta_is_entry_valid
+	       && (na & FFESYMBOL_attrsANYLEN))
+	   || ((sa & (FFESYMBOL_attrsADJUSTABLE
+		      | FFESYMBOL_attrsANYLEN
+		      | FFESYMBOL_attrsANYSIZE
+		      | FFESYMBOL_attrsDUMMY))
+	       && (na & FFESYMBOL_attrsINIT))
+	   || ((sa & (FFESYMBOL_attrsSAVE
+		      | FFESYMBOL_attrsNAMELIST
+		      | FFESYMBOL_attrsCOMMON
+		      | FFESYMBOL_attrsEQUIV))
+	       && (na & (FFESYMBOL_attrsADJUSTABLE
+			 | FFESYMBOL_attrsANYLEN
+			 | FFESYMBOL_attrsANYSIZE))))
+    na = FFESYMBOL_attrsetNONE;
+  else if ((ffesymbol_kind (s) == FFEINFO_kindENTITY)
+	   && (ffesymbol_where (s) == FFEINFO_whereCONSTANT)
+	   && (na & FFESYMBOL_attrsANYLEN))
+    {				/* If CHARACTER*(*) FOO after PARAMETER FOO. */
+      na |= FFESYMBOL_attrsTYPE;
+      ffestc_local_.decl.size = ffebld_size (ffesymbol_init (s));
+    }
+  else
+    na |= sa;
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (na == FFESYMBOL_attrsetNONE)
+    {
+      ffesymbol_error (s, name);
+      ffestc_parent_ok_ = FALSE;
+    }
+  else if (na & FFESYMBOL_attrsANY)
+    ffestc_parent_ok_ = FALSE;
+  else
+    {
+      ffesymbol_set_attrs (s, na);
+      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+	ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+      rank = ffesymbol_rank (s);
+      if (dims != NULL)
+	{
+	  ffesymbol_set_dims (s, ffestt_dimlist_as_expr (dims, &rank,
+							 &array_size,
+							 &extents));
+	  ffesymbol_set_arraysize (s, array_size);
+	  ffesymbol_set_extents (s, extents);
+	  if (!(0 && ffe_is_90 ())
+	      && (ffebld_op (array_size) == FFEBLD_opCONTER)
+	      && (ffebld_constant_integerdefault (ffebld_conter (array_size))
+		  == 0))
+	    {
+	      ffebad_start (FFEBAD_ZERO_ARRAY);
+	      ffebad_here (0, ffelex_token_where_line (name),
+			   ffelex_token_where_column (name));
+	      ffebad_finish ();
+	    }
+	}
+      if (init != NULL)
+	{
+	  ffesymbol_set_init (s,
+			      ffeexpr_convert (init, initt, name,
+					       ffestc_local_.decl.basic_type,
+					       ffestc_local_.decl.kind_type,
+					       rank,
+					       ffestc_local_.decl.size,
+					       FFEEXPR_contextDATA));
+	  ffecom_notify_init_symbol (s);
+	  ffesymbol_update_init (s);
+#if FFEGLOBAL_ENABLED
+	  if (ffesymbol_common (s) != NULL)
+	    ffeglobal_init_common (ffesymbol_common (s), initt);
+#endif
+	}
+      else if (clist)
+	{
+	  ffebld symter;
+
+	  symter = ffebld_new_symter (s, FFEINTRIN_genNONE,
+				      FFEINTRIN_specNONE,
+				      FFEINTRIN_impNONE);
+
+	  ffebld_set_info (symter,
+			   ffeinfo_new (ffestc_local_.decl.basic_type,
+					ffestc_local_.decl.kind_type,
+					rank,
+					FFEINFO_kindNONE,
+					FFEINFO_whereNONE,
+					ffestc_local_.decl.size));
+	  ffestc_local_.decl.initlist = ffebld_new_item (symter, NULL);
+	}
+      if (na & FFESYMBOL_attrsINTRINSIC)
+	;			/* Do none of the below. */
+      else if (ffesymbol_basictype (s) == FFEINFO_basictypeNONE)
+	{
+	  ffesymbol_set_info (s,
+			      ffeinfo_new (ffestc_local_.decl.basic_type,
+					   ffestc_local_.decl.kind_type,
+					   rank,
+					   ffesymbol_kind (s),
+					   ffesymbol_where (s),
+					   ffestc_local_.decl.size));
+	  if ((na & FFESYMBOL_attrsRESULT)
+	      && ((sfn = ffesymbol_funcresult (s)) != NULL))
+	    {
+	      ffesymbol_set_info (sfn,
+				  ffeinfo_new (ffestc_local_.decl.basic_type,
+					       ffestc_local_.decl.kind_type,
+					       rank,
+					       ffesymbol_kind (sfn),
+					       ffesymbol_where (sfn),
+					       ffestc_local_.decl.size));
+	      ffesymbol_signal_unreported (sfn);
+	    }
+	}
+      else if ((ffestc_local_.decl.basic_type != ffesymbol_basictype (s))
+	       || (ffestc_local_.decl.kind_type != ffesymbol_kindtype (s))
+	       || ((ffestc_local_.decl.basic_type
+		    == FFEINFO_basictypeCHARACTER)
+		   && (ffestc_local_.decl.size != ffesymbol_size (s))))
+	{			/* Explicit type disagrees with established
+				   implicit type. */
+	  ffesymbol_error (s, name);
+	}
+
+      if ((na & FFESYMBOL_attrsADJUSTS)
+	  && ((ffestc_local_.decl.basic_type != FFEINFO_basictypeINTEGER)
+	      || (ffestc_local_.decl.kind_type != FFEINFO_kindtypeINTEGER1)))
+	ffesymbol_error (s, name);
+
+      ffesymbol_signal_unreported (s);
+      ffestc_parent_ok_ = TRUE;
+    }
+}
+
+/* ffestc_R501_itemstartvals -- Start list of values
+
+   ffestc_R501_itemstartvals();
+
+   Gonna specify values for the object now.  */
+
+void
+ffestc_R501_itemstartvals ()
+{
+  ffestc_check_item_startvals_ ();
+
+  if (ffestc_parent_ok_)
+    ffedata_begin (ffestc_local_.decl.initlist);
+}
+
+/* ffestc_R501_itemvalue -- Source value
+
+   ffestc_R501_itemvalue(repeat,repeat_token,value,value_token);
+
+   Make sure repeat and value are valid for the object being initialized.  */
+
+void
+ffestc_R501_itemvalue (ffebld repeat, ffelexToken repeat_token,
+		       ffebld value, ffelexToken value_token)
+{
+  ffetargetIntegerDefault rpt;
+
+  ffestc_check_item_value_ ();
+
+  if (!ffestc_parent_ok_)
+    return;
+
+  if (repeat == NULL)
+    rpt = 1;
+  else if (ffebld_op (repeat) == FFEBLD_opCONTER)
+    rpt = ffebld_constant_integerdefault (ffebld_conter (repeat));
+  else
+    {
+      ffestc_parent_ok_ = FALSE;
+      ffedata_end (TRUE, NULL);
+      return;
+    }
+
+  if (!(ffestc_parent_ok_ = ffedata_value (rpt, value,
+		      (repeat_token == NULL) ? value_token : repeat_token)))
+    ffedata_end (TRUE, NULL);
+}
+
+/* ffestc_R501_itemendvals -- End list of values
+
+   ffelexToken t;  // the SLASH token that ends the list.
+   ffestc_R501_itemendvals(t);
+
+   No more values, might specify more objects now.  */
+
+void
+ffestc_R501_itemendvals (ffelexToken t)
+{
+  ffestc_check_item_endvals_ ();
+
+  if (ffestc_parent_ok_)
+    ffestc_parent_ok_ = ffedata_end (FALSE, t);
+
+  if (ffestc_parent_ok_)
+    ffesymbol_signal_unreported (ffebld_symter (ffebld_head
+					     (ffestc_local_.decl.initlist)));
+}
+
+/* ffestc_R501_finish -- Done
+
+   ffestc_R501_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R501_finish ()
+{
+  ffestc_check_finish_ ();
+}
+
+/* ffestc_R519_start -- INTENT statement list begin
+
+   ffestc_R519_start();
+
+   Verify that INTENT is valid here, and begin accepting items in the list.  */
+
+#if FFESTR_F90
+void
+ffestc_R519_start (ffelexToken intent, ffestrOther intent_kw)
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_spec_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R519_start (intent_kw);
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R519_item -- INTENT statement for name
+
+   ffestc_R519_item(name_token);
+
+   Make sure name_token identifies a valid object to be INTENTed.  */
+
+void
+ffestc_R519_item (ffelexToken name)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R519_item (name);
+}
+
+/* ffestc_R519_finish -- INTENT statement list complete
+
+   ffestc_R519_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R519_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R519_finish ();
+}
+
+/* ffestc_R520_start -- OPTIONAL statement list begin
+
+   ffestc_R520_start();
+
+   Verify that OPTIONAL is valid here, and begin accepting items in the list.  */
+
+void
+ffestc_R520_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_spec_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R520_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R520_item -- OPTIONAL statement for name
+
+   ffestc_R520_item(name_token);
+
+   Make sure name_token identifies a valid object to be OPTIONALed.  */
+
+void
+ffestc_R520_item (ffelexToken name)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R520_item (name);
+}
+
+/* ffestc_R520_finish -- OPTIONAL statement list complete
+
+   ffestc_R520_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R520_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R520_finish ();
+}
+
+/* ffestc_R521A -- PUBLIC statement
+
+   ffestc_R521A();
+
+   Verify that PUBLIC is valid here.  */
+
+void
+ffestc_R521A ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_access_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  switch (ffestv_access_state_)
+    {
+    case FFESTV_accessstateNONE:
+      ffestv_access_state_ = FFESTV_accessstatePUBLIC;
+      ffestv_access_line_
+	= ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
+      ffestv_access_col_
+	= ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
+      break;
+
+    case FFESTV_accessstateANY:
+      break;
+
+    case FFESTV_accessstatePUBLIC:
+    case FFESTV_accessstatePRIVATE:
+      ffebad_start (FFEBAD_CONFLICTING_ACCESSES);
+      ffebad_here (0, ffestv_access_line_, ffestv_access_col_);
+      ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_finish ();
+      ffestv_access_state_ = FFESTV_accessstateANY;
+      break;
+
+    default:
+      assert ("unexpected access state" == NULL);
+      break;
+    }
+
+  ffestd_R521A ();
+}
+
+/* ffestc_R521Astart -- PUBLIC statement list begin
+
+   ffestc_R521Astart();
+
+   Verify that PUBLIC is valid here, and begin accepting items in the list.  */
+
+void
+ffestc_R521Astart ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_access_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R521Astart ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R521Aitem -- PUBLIC statement for name
+
+   ffestc_R521Aitem(name_token);
+
+   Make sure name_token identifies a valid object to be PUBLICed.  */
+
+void
+ffestc_R521Aitem (ffelexToken name)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R521Aitem (name);
+}
+
+/* ffestc_R521Afinish -- PUBLIC statement list complete
+
+   ffestc_R521Afinish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R521Afinish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R521Afinish ();
+}
+
+/* ffestc_R521B -- PRIVATE statement
+
+   ffestc_R521B();
+
+   Verify that PRIVATE is valid here (outside a derived-type statement).  */
+
+void
+ffestc_R521B ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_access_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  switch (ffestv_access_state_)
+    {
+    case FFESTV_accessstateNONE:
+      ffestv_access_state_ = FFESTV_accessstatePRIVATE;
+      ffestv_access_line_
+	= ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
+      ffestv_access_col_
+	= ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
+      break;
+
+    case FFESTV_accessstateANY:
+      break;
+
+    case FFESTV_accessstatePUBLIC:
+    case FFESTV_accessstatePRIVATE:
+      ffebad_start (FFEBAD_CONFLICTING_ACCESSES);
+      ffebad_here (0, ffestv_access_line_, ffestv_access_col_);
+      ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_finish ();
+      ffestv_access_state_ = FFESTV_accessstateANY;
+      break;
+
+    default:
+      assert ("unexpected access state" == NULL);
+      break;
+    }
+
+  ffestd_R521B ();
+}
+
+/* ffestc_R521Bstart -- PRIVATE statement list begin
+
+   ffestc_R521Bstart();
+
+   Verify that PRIVATE is valid here, and begin accepting items in the list.  */
+
+void
+ffestc_R521Bstart ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_access_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R521Bstart ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R521Bitem -- PRIVATE statement for name
+
+   ffestc_R521Bitem(name_token);
+
+   Make sure name_token identifies a valid object to be PRIVATEed.  */
+
+void
+ffestc_R521Bitem (ffelexToken name)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R521Bitem (name);
+}
+
+/* ffestc_R521Bfinish -- PRIVATE statement list complete
+
+   ffestc_R521Bfinish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R521Bfinish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R521Bfinish ();
+}
+
+#endif
+/* ffestc_R522 -- SAVE statement with no list
+
+   ffestc_R522();
+
+   Verify that SAVE is valid here, and flag everything as SAVEd.  */
+
+void
+ffestc_R522 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_blockspec_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  switch (ffestv_save_state_)
+    {
+    case FFESTV_savestateNONE:
+      ffestv_save_state_ = FFESTV_savestateALL;
+      ffestv_save_line_
+	= ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
+      ffestv_save_col_
+	= ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
+      break;
+
+    case FFESTV_savestateANY:
+      break;
+
+    case FFESTV_savestateSPECIFIC:
+    case FFESTV_savestateALL:
+      if (ffe_is_pedantic ())
+	{
+	  ffebad_start (FFEBAD_CONFLICTING_SAVES);
+	  ffebad_here (0, ffestv_save_line_, ffestv_save_col_);
+	  ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]),
+		       ffelex_token_where_column (ffesta_tokens[0]));
+	  ffebad_finish ();
+	}
+      ffestv_save_state_ = FFESTV_savestateALL;
+      break;
+
+    default:
+      assert ("unexpected save state" == NULL);
+      break;
+    }
+
+  ffe_set_is_saveall (TRUE);
+
+  ffestd_R522 ();
+}
+
+/* ffestc_R522start -- SAVE statement list begin
+
+   ffestc_R522start();
+
+   Verify that SAVE is valid here, and begin accepting items in the list.  */
+
+void
+ffestc_R522start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_blockspec_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  switch (ffestv_save_state_)
+    {
+    case FFESTV_savestateNONE:
+      ffestv_save_state_ = FFESTV_savestateSPECIFIC;
+      ffestv_save_line_
+	= ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
+      ffestv_save_col_
+	= ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
+      break;
+
+    case FFESTV_savestateSPECIFIC:
+    case FFESTV_savestateANY:
+      break;
+
+    case FFESTV_savestateALL:
+      if (ffe_is_pedantic ())
+	{
+	  ffebad_start (FFEBAD_CONFLICTING_SAVES);
+	  ffebad_here (0, ffestv_save_line_, ffestv_save_col_);
+	  ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]),
+		       ffelex_token_where_column (ffesta_tokens[0]));
+	  ffebad_finish ();
+	}
+      ffestv_save_state_ = FFESTV_savestateANY;
+      break;
+
+    default:
+      assert ("unexpected save state" == NULL);
+      break;
+    }
+
+  ffestd_R522start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R522item_object -- SAVE statement for object-name
+
+   ffestc_R522item_object(name_token);
+
+   Make sure name_token identifies a valid object to be SAVEd.	*/
+
+void
+ffestc_R522item_object (ffelexToken name)
+{
+  ffesymbol s;
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  s = ffesymbol_declare_local (name, FALSE);
+  sa = ffesymbol_attrs (s);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (!ffesymbol_is_specable (s)
+      && ((ffesymbol_kind (s) != FFEINFO_kindENTITY)
+	  || (ffesymbol_where (s) != FFEINFO_whereLOCAL)))
+    na = FFESYMBOL_attrsetNONE;	/* Can't dcl sym ref'd in sfuncdef. */
+  else if (sa & FFESYMBOL_attrsANY)
+    na = sa;
+  else if (!(sa & ~(FFESYMBOL_attrsARRAY
+		    | FFESYMBOL_attrsEQUIV
+		    | FFESYMBOL_attrsINIT
+		    | FFESYMBOL_attrsNAMELIST
+		    | FFESYMBOL_attrsSFARG
+		    | FFESYMBOL_attrsTYPE)))
+    na = sa | FFESYMBOL_attrsSAVE;
+  else
+    na = FFESYMBOL_attrsetNONE;
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (na == FFESYMBOL_attrsetNONE)
+    ffesymbol_error (s, name);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_set_attrs (s, na);
+      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+	ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+      ffesymbol_update_save (s);
+      ffesymbol_signal_unreported (s);
+    }
+
+  ffestd_R522item_object (name);
+}
+
+/* ffestc_R522item_cblock -- SAVE statement for common-block-name
+
+   ffestc_R522item_cblock(name_token);
+
+   Make sure name_token identifies a valid common block to be SAVEd.  */
+
+void
+ffestc_R522item_cblock (ffelexToken name)
+{
+  ffesymbol s;
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  s = ffesymbol_declare_cblock (name, ffelex_token_where_line (ffesta_tokens[0]),
+			      ffelex_token_where_column (ffesta_tokens[0]));
+  sa = ffesymbol_attrs (s);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (!ffesymbol_is_specable (s))
+    na = FFESYMBOL_attrsetNONE;
+  else if (sa & FFESYMBOL_attrsANY)
+    na = sa;			/* Already have an error here, say nothing. */
+  else if (!(sa & ~(FFESYMBOL_attrsCBLOCK)))
+    na = sa | FFESYMBOL_attrsSAVECBLOCK;
+  else
+    na = FFESYMBOL_attrsetNONE;
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (na == FFESYMBOL_attrsetNONE)
+    ffesymbol_error (s, (name == NULL) ? ffesta_tokens[0] : name);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_set_attrs (s, na);
+      ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+      ffesymbol_update_save (s);
+      ffesymbol_signal_unreported (s);
+    }
+
+  ffestd_R522item_cblock (name);
+}
+
+/* ffestc_R522finish -- SAVE statement list complete
+
+   ffestc_R522finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R522finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R522finish ();
+}
+
+/* ffestc_R524_start -- DIMENSION statement list begin
+
+   ffestc_R524_start(bool virtual);
+
+   Verify that DIMENSION is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_R524_start (bool virtual)
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_blockspec_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R524_start (virtual);
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R524_item -- DIMENSION statement for object-name
+
+   ffestc_R524_item(name_token,dim_list);
+
+   Make sure name_token identifies a valid object to be DIMENSIONd.  */
+
+void
+ffestc_R524_item (ffelexToken name, ffesttDimList dims)
+{
+  ffesymbol s;
+  ffebld array_size;
+  ffebld extents;
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffestpDimtype nd;
+  ffeinfoRank rank;
+
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  assert (dims != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+  s = ffesymbol_declare_local (name, FALSE);
+  sa = ffesymbol_attrs (s);
+
+  /* First figure out what kind of object this is based solely on the current
+     object situation (dimension list). */
+
+  nd = ffestt_dimlist_type (dims);
+  switch (nd)
+    {
+    case FFESTP_dimtypeKNOWN:
+      na = FFESYMBOL_attrsARRAY;
+      break;
+
+    case FFESTP_dimtypeADJUSTABLE:
+      na = FFESYMBOL_attrsARRAY | FFESYMBOL_attrsADJUSTABLE;
+      break;
+
+    case FFESTP_dimtypeASSUMED:
+      na = FFESYMBOL_attrsARRAY | FFESYMBOL_attrsANYSIZE;
+      break;
+
+    case FFESTP_dimtypeADJUSTABLEASSUMED:
+      na = FFESYMBOL_attrsARRAY | FFESYMBOL_attrsADJUSTABLE
+	| FFESYMBOL_attrsANYSIZE;
+      break;
+
+    default:
+      assert ("Unexpected dims type" == NULL);
+      na = FFESYMBOL_attrsetNONE;
+      break;
+    }
+
+  /* Now figure out what kind of object we've got based on previous
+     declarations of or references to the object. */
+
+  if (!ffesymbol_is_specable (s))
+    na = FFESYMBOL_attrsetNONE;	/* Can't dcl sym ref'd in sfuncdef. */
+  else if (sa & FFESYMBOL_attrsANY)
+    na = FFESYMBOL_attrsANY;
+  else if (!ffesta_is_entry_valid
+	   && (sa & FFESYMBOL_attrsANYLEN))
+    na = FFESYMBOL_attrsetNONE;
+  else if ((sa & FFESYMBOL_attrsARRAY)
+	   || ((sa & (FFESYMBOL_attrsCOMMON
+		      | FFESYMBOL_attrsEQUIV
+		      | FFESYMBOL_attrsNAMELIST
+		      | FFESYMBOL_attrsSAVE))
+	       && (na & (FFESYMBOL_attrsADJUSTABLE
+			 | FFESYMBOL_attrsANYSIZE))))
+    na = FFESYMBOL_attrsetNONE;
+  else if (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
+		    | FFESYMBOL_attrsANYLEN
+		    | FFESYMBOL_attrsANYSIZE
+		    | FFESYMBOL_attrsCOMMON
+		    | FFESYMBOL_attrsDUMMY
+		    | FFESYMBOL_attrsEQUIV
+		    | FFESYMBOL_attrsNAMELIST
+		    | FFESYMBOL_attrsSAVE
+		    | FFESYMBOL_attrsTYPE)))
+    na |= sa;
+  else
+    na = FFESYMBOL_attrsetNONE;
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (na == FFESYMBOL_attrsetNONE)
+    ffesymbol_error (s, name);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_set_attrs (s, na);
+      ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+      ffesymbol_set_dims (s, ffestt_dimlist_as_expr (dims, &rank,
+						     &array_size,
+						     &extents));
+      ffesymbol_set_arraysize (s, array_size);
+      ffesymbol_set_extents (s, extents);
+      if (!(0 && ffe_is_90 ())
+	  && (ffebld_op (array_size) == FFEBLD_opCONTER)
+	  && (ffebld_constant_integerdefault (ffebld_conter (array_size))
+	      == 0))
+	{
+	  ffebad_start (FFEBAD_ZERO_ARRAY);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_finish ();
+	}
+      ffesymbol_set_info (s,
+			  ffeinfo_new (ffesymbol_basictype (s),
+				       ffesymbol_kindtype (s),
+				       rank,
+				       ffesymbol_kind (s),
+				       ffesymbol_where (s),
+				       ffesymbol_size (s)));
+    }
+
+  ffesymbol_signal_unreported (s);
+
+  ffestd_R524_item (name, dims);
+}
+
+/* ffestc_R524_finish -- DIMENSION statement list complete
+
+   ffestc_R524_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R524_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R524_finish ();
+}
+
+/* ffestc_R525_start -- ALLOCATABLE statement list begin
+
+   ffestc_R525_start();
+
+   Verify that ALLOCATABLE is valid here, and begin accepting items in the
+   list.  */
+
+#if FFESTR_F90
+void
+ffestc_R525_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_progspec_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R525_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R525_item -- ALLOCATABLE statement for object-name
+
+   ffestc_R525_item(name_token,dim_list);
+
+   Make sure name_token identifies a valid object to be ALLOCATABLEd.  */
+
+void
+ffestc_R525_item (ffelexToken name, ffesttDimList dims)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+  ffestd_R525_item (name, dims);
+}
+
+/* ffestc_R525_finish -- ALLOCATABLE statement list complete
+
+   ffestc_R525_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R525_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R525_finish ();
+}
+
+/* ffestc_R526_start -- POINTER statement list begin
+
+   ffestc_R526_start();
+
+   Verify that POINTER is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_R526_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_progspec_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R526_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R526_item -- POINTER statement for object-name
+
+   ffestc_R526_item(name_token,dim_list);
+
+   Make sure name_token identifies a valid object to be POINTERd.  */
+
+void
+ffestc_R526_item (ffelexToken name, ffesttDimList dims)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+  ffestd_R526_item (name, dims);
+}
+
+/* ffestc_R526_finish -- POINTER statement list complete
+
+   ffestc_R526_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R526_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R526_finish ();
+}
+
+/* ffestc_R527_start -- TARGET statement list begin
+
+   ffestc_R527_start();
+
+   Verify that TARGET is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_R527_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_progspec_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R527_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R527_item -- TARGET statement for object-name
+
+   ffestc_R527_item(name_token,dim_list);
+
+   Make sure name_token identifies a valid object to be TARGETd.  */
+
+void
+ffestc_R527_item (ffelexToken name, ffesttDimList dims)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+  ffestd_R527_item (name, dims);
+}
+
+/* ffestc_R527_finish -- TARGET statement list complete
+
+   ffestc_R527_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R527_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R527_finish ();
+}
+
+#endif
+/* ffestc_R528_start -- DATA statement list begin
+
+   ffestc_R528_start();
+
+   Verify that DATA is valid here, and begin accepting items in the list.  */
+
+void
+ffestc_R528_start ()
+{
+  ffestcOrder_ order;
+
+  ffestc_check_start_ ();
+  if (ffe_is_pedantic_not_90 ())
+    order = ffestc_order_data77_ ();
+  else
+    order = ffestc_order_data_ ();
+  if (order != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+#if 1
+  ffestc_local_.data.objlist = NULL;
+#else
+  ffestd_R528_start_ ();
+#endif
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R528_item_object -- DATA statement target object
+
+   ffestc_R528_item_object(object,object_token);
+
+   Make sure object is valid to be DATAd.  */
+
+void
+ffestc_R528_item_object (ffebld expr, ffelexToken expr_token UNUSED)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+#if 1
+  if (ffestc_local_.data.objlist == NULL)
+    ffebld_init_list (&ffestc_local_.data.objlist,
+		      &ffestc_local_.data.list_bottom);
+
+  ffebld_append_item (&ffestc_local_.data.list_bottom, expr);
+#else
+  ffestd_R528_item_object_ (expr, expr_token);
+#endif
+}
+
+/* ffestc_R528_item_startvals -- DATA statement start list of values
+
+   ffestc_R528_item_startvals();
+
+   No more objects, gonna specify values for the list of objects now.  */
+
+void
+ffestc_R528_item_startvals ()
+{
+  ffestc_check_item_startvals_ ();
+  if (!ffestc_ok_)
+    return;
+
+#if 1
+  assert (ffestc_local_.data.objlist != NULL);
+  ffebld_end_list (&ffestc_local_.data.list_bottom);
+  ffedata_begin (ffestc_local_.data.objlist);
+#else
+  ffestd_R528_item_startvals_ ();
+#endif
+}
+
+/* ffestc_R528_item_value -- DATA statement source value
+
+   ffestc_R528_item_value(repeat,repeat_token,value,value_token);
+
+   Make sure repeat and value are valid for the objects being initialized.  */
+
+void
+ffestc_R528_item_value (ffebld repeat, ffelexToken repeat_token,
+			ffebld value, ffelexToken value_token)
+{
+  ffetargetIntegerDefault rpt;
+
+  ffestc_check_item_value_ ();
+  if (!ffestc_ok_)
+    return;
+
+#if 1
+  if (repeat == NULL)
+    rpt = 1;
+  else if (ffebld_op (repeat) == FFEBLD_opCONTER)
+    rpt = ffebld_constant_integerdefault (ffebld_conter (repeat));
+  else
+    {
+      ffestc_ok_ = FALSE;
+      ffedata_end (TRUE, NULL);
+      return;
+    }
+
+  if (!(ffestc_ok_ = ffedata_value (rpt, value,
+				    (repeat_token == NULL)
+				    ? value_token
+				    : repeat_token)))
+    ffedata_end (TRUE, NULL);
+
+#else
+  ffestd_R528_item_value_ (repeat, value);
+#endif
+}
+
+/* ffestc_R528_item_endvals -- DATA statement start list of values
+
+   ffelexToken t;  // the SLASH token that ends the list.
+   ffestc_R528_item_endvals(t);
+
+   No more values, might specify more objects now.  */
+
+void
+ffestc_R528_item_endvals (ffelexToken t)
+{
+  ffestc_check_item_endvals_ ();
+  if (!ffestc_ok_)
+    return;
+
+#if 1
+  ffedata_end (!ffestc_ok_, t);
+  ffestc_local_.data.objlist = NULL;
+#else
+  ffestd_R528_item_endvals_ (t);
+#endif
+}
+
+/* ffestc_R528_finish -- DATA statement list complete
+
+   ffestc_R528_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R528_finish ()
+{
+  ffestc_check_finish_ ();
+
+#if 1
+#else
+  ffestd_R528_finish_ ();
+#endif
+}
+
+/* ffestc_R537_start -- PARAMETER statement list begin
+
+   ffestc_R537_start();
+
+   Verify that PARAMETER is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_R537_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_parameter_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+  ffestd_R537_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R537_item -- PARAMETER statement assignment
+
+   ffestc_R537_item(dest,dest_token,source,source_token);
+
+   Make sure the source is a valid source for the destination; make the
+   assignment.	*/
+
+void
+ffestc_R537_item (ffebld dest, ffelexToken dest_token, ffebld source,
+		  ffelexToken source_token)
+{
+  ffesymbol s;
+
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  if ((ffebld_op (dest) == FFEBLD_opANY)
+      || (ffebld_op (source) == FFEBLD_opANY))
+    {
+      if (ffebld_op (dest) == FFEBLD_opSYMTER)
+	{
+	  s = ffebld_symter (dest);
+	  ffesymbol_set_init (s, ffebld_new_any ());
+	  ffebld_set_info (ffesymbol_init (s), ffeinfo_new_any ());
+	  ffesymbol_signal_unreported (s);
+	}
+      ffestd_R537_item (dest, source);
+      return;
+    }
+
+  assert (ffebld_op (dest) == FFEBLD_opSYMTER);
+  assert (ffebld_op (source) == FFEBLD_opCONTER);
+
+  s = ffebld_symter (dest);
+  if ((ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)
+      && (ffesymbol_size (s) == FFETARGET_charactersizeNONE))
+    {				/* Destination has explicit/implicit
+				   CHARACTER*(*) type; set length. */
+      ffesymbol_set_info (s,
+			  ffeinfo_new (ffesymbol_basictype (s),
+				       ffesymbol_kindtype (s),
+				       0,
+				       ffesymbol_kind (s),
+				       ffesymbol_where (s),
+				       ffebld_size (source)));
+      ffebld_set_info (dest, ffeinfo_use (ffesymbol_info (s)));
+    }
+
+  source = ffeexpr_convert_expr (source, source_token, dest, dest_token,
+				 FFEEXPR_contextDATA);
+
+  ffesymbol_set_init (s, source);
+
+  ffesymbol_signal_unreported (s);
+
+  ffestd_R537_item (dest, source);
+}
+
+/* ffestc_R537_finish -- PARAMETER statement list complete
+
+   ffestc_R537_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R537_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R537_finish ();
+}
+
+/* ffestc_R539 -- IMPLICIT NONE statement
+
+   ffestc_R539();
+
+   Verify that the IMPLICIT NONE statement is ok here and implement.  */
+
+void
+ffestc_R539 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_implicitnone_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  ffeimplic_none ();
+
+  ffestd_R539 ();
+}
+
+/* ffestc_R539start -- IMPLICIT statement
+
+   ffestc_R539start();
+
+   Verify that the IMPLICIT statement is ok here and implement.	 */
+
+void
+ffestc_R539start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_implicit_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R539start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R539item -- IMPLICIT statement specification (R540)
+
+   ffestc_R539item(...);
+
+   Verify that the type and letter list are all ok and implement.  */
+
+void
+ffestc_R539item (ffestpType type, ffebld kind, ffelexToken kindt,
+		 ffebld len, ffelexToken lent, ffesttImpList letters)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  if ((type == FFESTP_typeCHARACTER) && (len != NULL)
+      && (ffebld_op (len) == FFEBLD_opSTAR))
+    {				/* Complain and pretend they're CHARACTER
+				   [*1]. */
+      ffebad_start (FFEBAD_IMPLICIT_ADJLEN);
+      ffebad_here (0, ffelex_token_where_line (lent),
+		   ffelex_token_where_column (lent));
+      ffebad_finish ();
+      len = NULL;
+      lent = NULL;
+    }
+  ffestc_establish_declstmt_ (type, ffesta_tokens[0], kind, kindt, len, lent);
+  ffestc_establish_declinfo_ (NULL, NULL, NULL, NULL);
+
+  ffestt_implist_drive (letters, ffestc_establish_impletter_);
+
+  ffestd_R539item (type, kind, kindt, len, lent, letters);
+}
+
+/* ffestc_R539finish -- IMPLICIT statement
+
+   ffestc_R539finish();
+
+   Finish up any local activities.  */
+
+void
+ffestc_R539finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R539finish ();
+}
+
+/* ffestc_R542_start -- NAMELIST statement list begin
+
+   ffestc_R542_start();
+
+   Verify that NAMELIST is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_R542_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_progspec_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  if (ffe_is_f2c_library ()
+      && (ffe_case_source () == FFE_caseNONE))
+    {
+      ffebad_start (FFEBAD_NAMELIST_CASE);
+      ffesta_ffebad_here_current_stmt (0);
+      ffebad_finish ();
+    }
+
+  ffestd_R542_start ();
+
+  ffestc_local_.namelist.symbol = NULL;
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R542_item_nlist -- NAMELIST statement for group-name
+
+   ffestc_R542_item_nlist(groupname_token);
+
+   Make sure name_token identifies a valid object to be NAMELISTd.  */
+
+void
+ffestc_R542_item_nlist (ffelexToken name)
+{
+  ffesymbol s;
+
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  if (ffestc_local_.namelist.symbol != NULL)
+    ffesymbol_signal_unreported (ffestc_local_.namelist.symbol);
+
+  s = ffesymbol_declare_local (name, FALSE);
+
+  if ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
+      || ((ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+	  && (ffesymbol_kind (s) == FFEINFO_kindNAMELIST)))
+    {
+      ffestc_parent_ok_ = TRUE;
+      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+	{
+	  ffebld_init_list (ffesymbol_ptr_to_namelist (s),
+			    ffesymbol_ptr_to_listbottom (s));
+	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+	  ffesymbol_set_info (s,
+			      ffeinfo_new (FFEINFO_basictypeNONE,
+					   FFEINFO_kindtypeNONE,
+					   0,
+					   FFEINFO_kindNAMELIST,
+					   FFEINFO_whereLOCAL,
+					   FFETARGET_charactersizeNONE));
+	}
+    }
+  else
+    {
+      if (ffesymbol_kind (s) != FFEINFO_kindANY)
+	ffesymbol_error (s, name);
+      ffestc_parent_ok_ = FALSE;
+    }
+
+  ffestc_local_.namelist.symbol = s;
+
+  ffestd_R542_item_nlist (name);
+}
+
+/* ffestc_R542_item_nitem -- NAMELIST statement for variable-name
+
+   ffestc_R542_item_nitem(name_token);
+
+   Make sure name_token identifies a valid object to be NAMELISTd.  */
+
+void
+ffestc_R542_item_nitem (ffelexToken name)
+{
+  ffesymbol s;
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffebld e;
+
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  s = ffesymbol_declare_local (name, FALSE);
+  sa = ffesymbol_attrs (s);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (!ffesymbol_is_specable (s)
+      && ((ffesymbol_kind (s) != FFEINFO_kindENTITY)
+	  || ((ffesymbol_where (s) != FFEINFO_whereLOCAL)
+	      && (ffesymbol_where (s) != FFEINFO_whereCOMMON))))
+    na = FFESYMBOL_attrsetNONE;
+  else if (sa & FFESYMBOL_attrsANY)
+    na = FFESYMBOL_attrsANY;
+  else if (!(sa & ~(FFESYMBOL_attrsADJUSTS
+		    | FFESYMBOL_attrsARRAY
+		    | FFESYMBOL_attrsCOMMON
+		    | FFESYMBOL_attrsEQUIV
+		    | FFESYMBOL_attrsINIT
+		    | FFESYMBOL_attrsNAMELIST
+		    | FFESYMBOL_attrsSAVE
+		    | FFESYMBOL_attrsSFARG
+		    | FFESYMBOL_attrsTYPE)))
+    na = sa | FFESYMBOL_attrsNAMELIST;
+  else
+    na = FFESYMBOL_attrsetNONE;
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (na == FFESYMBOL_attrsetNONE)
+    ffesymbol_error (s, name);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_set_attrs (s, na);
+      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+	ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+      ffesymbol_set_namelisted (s, TRUE);
+      ffesymbol_signal_unreported (s);
+#if 0				/* No need to establish type yet! */
+      if (!ffeimplic_establish_symbol (s))
+	ffesymbol_error (s, name);
+#endif
+    }
+
+  if (ffestc_parent_ok_)
+    {
+      e = ffebld_new_symter (s, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
+			     FFEINTRIN_impNONE);
+      ffebld_set_info (e,
+		       ffeinfo_new (FFEINFO_basictypeNONE,
+				    FFEINFO_kindtypeNONE, 0,
+				    FFEINFO_kindNONE,
+				    FFEINFO_whereNONE,
+				    FFETARGET_charactersizeNONE));
+      ffebld_append_item
+	(ffesymbol_ptr_to_listbottom (ffestc_local_.namelist.symbol), e);
+    }
+
+  ffestd_R542_item_nitem (name);
+}
+
+/* ffestc_R542_finish -- NAMELIST statement list complete
+
+   ffestc_R542_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R542_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffesymbol_signal_unreported (ffestc_local_.namelist.symbol);
+
+  ffestd_R542_finish ();
+}
+
+/* ffestc_R544_start -- EQUIVALENCE statement list begin
+
+   ffestc_R544_start();
+
+   Verify that EQUIVALENCE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_R544_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_blockspec_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R544_item -- EQUIVALENCE statement assignment
+
+   ffestc_R544_item(exprlist);
+
+   Make sure the equivalence is valid, then implement it.  */
+
+void
+ffestc_R544_item (ffesttExprList exprlist)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  /* First we go through the list and come up with one ffeequiv object that
+     will describe all items in the list.  When an ffeequiv object is first
+     found, it is used (else we create one as a "local equiv" for the time
+     being).  If subsequent ffeequiv objects are found, they are merged with
+     the first so we end up with one.  However, if more than one COMMON
+     variable is involved, then an error condition occurs. */
+
+  ffestc_local_.equiv.ok = TRUE;
+  ffestc_local_.equiv.t = NULL;	/* No token yet. */
+  ffestc_local_.equiv.eq = NULL;/* No equiv yet. */
+  ffestc_local_.equiv.save = FALSE;	/* No SAVEd variables yet. */
+
+  ffebld_init_list (&ffestc_local_.equiv.list, &ffestc_local_.equiv.bottom);
+  ffestt_exprlist_drive (exprlist, ffestc_R544_equiv_);	/* Get one equiv. */
+  ffebld_end_list (&ffestc_local_.equiv.bottom);
+
+  if (!ffestc_local_.equiv.ok)
+    return;			/* Something went wrong, stop bothering with
+				   this stuff. */
+
+  if (ffestc_local_.equiv.eq == NULL)
+    ffestc_local_.equiv.eq = ffeequiv_new ();	/* Make local equivalence. */
+
+  /* Append this list of equivalences to list of such lists for this
+     equivalence. */
+
+  ffeequiv_add (ffestc_local_.equiv.eq, ffestc_local_.equiv.list,
+		ffestc_local_.equiv.t);
+  if (ffestc_local_.equiv.save)
+    ffeequiv_update_save (ffestc_local_.equiv.eq);
+}
+
+/* ffestc_R544_equiv_ -- EQUIVALENCE statement handler for item in list
+
+   ffebld expr;
+   ffelexToken t;
+   ffestc_R544_equiv_(expr,t);
+
+   Record information, if any, on symbol in expr; if symbol has equivalence
+   object already, merge with outstanding object if present or make it
+   the outstanding object.  */
+
+static void
+ffestc_R544_equiv_ (ffebld expr, ffelexToken t)
+{
+  ffesymbol s;
+
+  if (!ffestc_local_.equiv.ok)
+    return;
+
+  if (ffestc_local_.equiv.t == NULL)
+    ffestc_local_.equiv.t = t;
+
+  switch (ffebld_op (expr))
+    {
+    case FFEBLD_opANY:
+      return;			/* Don't put this on the list. */
+
+    case FFEBLD_opSYMTER:
+    case FFEBLD_opARRAYREF:
+    case FFEBLD_opSUBSTR:
+      break;			/* All of these are ok. */
+
+    default:
+      assert ("ffestc_R544_equiv_ bad op" == NULL);
+      return;
+    }
+
+  ffebld_append_item (&ffestc_local_.equiv.bottom, expr);
+
+  s = ffeequiv_symbol (expr);
+
+  /* See if symbol has an equivalence object already. */
+
+  if (ffesymbol_equiv (s) != NULL)
+    if (ffestc_local_.equiv.eq == NULL)
+      ffestc_local_.equiv.eq = ffesymbol_equiv (s);	/* New equiv obj. */
+    else if (ffestc_local_.equiv.eq != ffesymbol_equiv (s))
+      {
+	ffestc_local_.equiv.eq = ffeequiv_merge (ffesymbol_equiv (s),
+						 ffestc_local_.equiv.eq,
+						 t);
+	if (ffestc_local_.equiv.eq == NULL)
+	  ffestc_local_.equiv.ok = FALSE;	/* Couldn't merge. */
+      }
+
+  if (ffesymbol_is_save (s))
+    ffestc_local_.equiv.save = TRUE;
+}
+
+/* ffestc_R544_finish -- EQUIVALENCE statement list complete
+
+   ffestc_R544_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R544_finish ()
+{
+  ffestc_check_finish_ ();
+}
+
+/* ffestc_R547_start -- COMMON statement list begin
+
+   ffestc_R547_start();
+
+   Verify that COMMON is valid here, and begin accepting items in the list.  */
+
+void
+ffestc_R547_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_blockspec_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestc_local_.common.symbol = NULL;	/* Blank common is the default. */
+  ffestc_parent_ok_ = TRUE;
+
+  ffestd_R547_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R547_item_object -- COMMON statement for object-name
+
+   ffestc_R547_item_object(name_token,dim_list);
+
+   Make sure name_token identifies a valid object to be COMMONd.  */
+
+void
+ffestc_R547_item_object (ffelexToken name, ffesttDimList dims)
+{
+  ffesymbol s;
+  ffebld array_size;
+  ffebld extents;
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffestpDimtype nd;
+  ffebld e;
+  ffeinfoRank rank;
+
+  if (ffestc_parent_ok_ && (ffestc_local_.common.symbol == NULL))
+    ffestc_R547_item_cblock (NULL);	/* As if "COMMON [//] ...". */
+
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  if (dims != NULL)
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+  s = ffesymbol_declare_local (name, FALSE);
+  sa = ffesymbol_attrs (s);
+
+  /* First figure out what kind of object this is based solely on the current
+     object situation (dimension list). */
+
+  nd = ffestt_dimlist_type (dims);
+  switch (nd)
+    {
+    case FFESTP_dimtypeNONE:
+      na = FFESYMBOL_attrsCOMMON;
+      break;
+
+    case FFESTP_dimtypeKNOWN:
+      na = FFESYMBOL_attrsCOMMON | FFESYMBOL_attrsARRAY;
+      break;
+
+    default:
+      na = FFESYMBOL_attrsetNONE;
+      break;
+    }
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (na == FFESYMBOL_attrsetNONE)
+    ;
+  else if (!ffesymbol_is_specable (s))
+    na = FFESYMBOL_attrsetNONE;	/* Can't dcl sym ref'd in sfuncdef. */
+  else if (sa & FFESYMBOL_attrsANY)
+    na = FFESYMBOL_attrsANY;
+  else if ((sa & (FFESYMBOL_attrsADJUSTS
+		  | FFESYMBOL_attrsARRAY
+		  | FFESYMBOL_attrsINIT
+		  | FFESYMBOL_attrsSFARG))
+	   && (na & FFESYMBOL_attrsARRAY))
+    na = FFESYMBOL_attrsetNONE;
+  else if (!(sa & ~(FFESYMBOL_attrsADJUSTS
+		    | FFESYMBOL_attrsARRAY
+		    | FFESYMBOL_attrsEQUIV
+		    | FFESYMBOL_attrsINIT
+		    | FFESYMBOL_attrsNAMELIST
+		    | FFESYMBOL_attrsSFARG
+		    | FFESYMBOL_attrsTYPE)))
+    na |= sa;
+  else
+    na = FFESYMBOL_attrsetNONE;
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (na == FFESYMBOL_attrsetNONE)
+    ffesymbol_error (s, name);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_set_attrs (s, na);
+      ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+      ffesymbol_set_common (s, ffestc_local_.common.symbol);
+#if FFEGLOBAL_ENABLED
+      if (ffesymbol_is_init (s))
+	ffeglobal_init_common (ffestc_local_.common.symbol, name);
+#endif
+      if (ffesymbol_is_save (ffestc_local_.common.symbol))
+	ffesymbol_update_save (s);
+      if (ffesymbol_equiv (s) != NULL)
+	{			/* Is this newly COMMONed symbol involved in
+				   an equivalence? */
+	  if (ffeequiv_common (ffesymbol_equiv (s)) == NULL)
+	    ffeequiv_set_common (ffesymbol_equiv (s),	/* Yes, tell equiv obj. */
+				 ffestc_local_.common.symbol);
+	  else
+	    {			/* Oops, just COMMONed a symbol to a
+				   different area (via equiv). */
+	      ffebad_start (FFEBAD_EQUIV_COMMON);
+	      ffebad_here (0, ffelex_token_where_line (name),
+			   ffelex_token_where_column (name));
+	      ffebad_string (ffesymbol_text (ffestc_local_.common.symbol));
+	      ffebad_string (ffesymbol_text (ffeequiv_common (ffesymbol_equiv (s))));
+	      ffebad_finish ();
+	    }
+#if FFEGLOBAL_ENABLED
+	  if (ffeequiv_is_init (ffesymbol_equiv (s)))
+	    ffeglobal_init_common (ffestc_local_.common.symbol, name);
+#endif
+	  if (ffesymbol_is_save (ffestc_local_.common.symbol))
+	    ffeequiv_update_save (ffesymbol_equiv (s));
+	}
+      if (dims != NULL)
+	{
+	  ffesymbol_set_dims (s, ffestt_dimlist_as_expr (dims, &rank,
+							 &array_size,
+							 &extents));
+	  ffesymbol_set_arraysize (s, array_size);
+	  ffesymbol_set_extents (s, extents);
+	  if (!(0 && ffe_is_90 ())
+	      && (ffebld_op (array_size) == FFEBLD_opCONTER)
+	      && (ffebld_constant_integerdefault (ffebld_conter (array_size))
+		  == 0))
+	    {
+	      ffebad_start (FFEBAD_ZERO_ARRAY);
+	      ffebad_here (0, ffelex_token_where_line (name),
+			   ffelex_token_where_column (name));
+	      ffebad_finish ();
+	    }
+	  ffesymbol_set_info (s,
+			      ffeinfo_new (ffesymbol_basictype (s),
+					   ffesymbol_kindtype (s),
+					   rank,
+					   ffesymbol_kind (s),
+					   ffesymbol_where (s),
+					   ffesymbol_size (s)));
+	}
+      ffesymbol_signal_unreported (s);
+    }
+
+  if (ffestc_parent_ok_)
+    {
+      e = ffebld_new_symter (s, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
+			     FFEINTRIN_impNONE);
+      ffebld_set_info (e,
+		       ffeinfo_new (FFEINFO_basictypeNONE,
+				    FFEINFO_kindtypeNONE,
+				    0,
+				    FFEINFO_kindNONE,
+				    FFEINFO_whereNONE,
+				    FFETARGET_charactersizeNONE));
+      ffebld_append_item
+	(ffesymbol_ptr_to_listbottom (ffestc_local_.common.symbol), e);
+    }
+
+  ffestd_R547_item_object (name, dims);
+}
+
+/* ffestc_R547_item_cblock -- COMMON statement for common-block-name
+
+   ffestc_R547_item_cblock(name_token);
+
+   Make sure name_token identifies a valid common block to be COMMONd.	*/
+
+void
+ffestc_R547_item_cblock (ffelexToken name)
+{
+  ffesymbol s;
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  if (ffestc_local_.common.symbol != NULL)
+    ffesymbol_signal_unreported (ffestc_local_.common.symbol);
+
+  s = ffesymbol_declare_cblock (name,
+				ffelex_token_where_line (ffesta_tokens[0]),
+			      ffelex_token_where_column (ffesta_tokens[0]));
+  sa = ffesymbol_attrs (s);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (!ffesymbol_is_specable (s))
+    na = FFESYMBOL_attrsetNONE;
+  else if (sa & FFESYMBOL_attrsANY)
+    na = FFESYMBOL_attrsANY;	/* Already have an error here, say nothing. */
+  else if (!(sa & ~(FFESYMBOL_attrsCBLOCK
+		    | FFESYMBOL_attrsSAVECBLOCK)))
+    {
+      if (!(sa & FFESYMBOL_attrsCBLOCK))
+	ffebld_init_list (ffesymbol_ptr_to_commonlist (s),
+			  ffesymbol_ptr_to_listbottom (s));
+      na = sa | FFESYMBOL_attrsCBLOCK;
+    }
+  else
+    na = FFESYMBOL_attrsetNONE;
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (na == FFESYMBOL_attrsetNONE)
+    {
+      ffesymbol_error (s, name == NULL ? ffesta_tokens[0] : name);
+      ffestc_parent_ok_ = FALSE;
+    }
+  else if (na & FFESYMBOL_attrsANY)
+    ffestc_parent_ok_ = FALSE;
+  else
+    {
+      ffesymbol_set_attrs (s, na);
+      ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+      if (name == NULL)
+	ffesymbol_update_save (s);
+      ffestc_parent_ok_ = TRUE;
+    }
+
+  ffestc_local_.common.symbol = s;
+
+  ffestd_R547_item_cblock (name);
+}
+
+/* ffestc_R547_finish -- COMMON statement list complete
+
+   ffestc_R547_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R547_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  if (ffestc_local_.common.symbol != NULL)
+    ffesymbol_signal_unreported (ffestc_local_.common.symbol);
+
+  ffestd_R547_finish ();
+}
+
+/* ffestc_R620 -- ALLOCATE statement
+
+   ffestc_R620(exprlist,stat,stat_token);
+
+   Make sure the expression list is valid, then implement it.  */
+
+#if FFESTR_F90
+void
+ffestc_R620 (ffesttExprList exprlist, ffebld stat, ffelexToken stat_token)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  ffestd_R620 (exprlist, stat);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R624 -- NULLIFY statement
+
+   ffestc_R624(pointer_name_list);
+
+   Make sure pointer_name_list identifies valid pointers for a NULLIFY.	 */
+
+void
+ffestc_R624 (ffesttExprList pointers)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  ffestd_R624 (pointers);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R625 -- DEALLOCATE statement
+
+   ffestc_R625(exprlist,stat,stat_token);
+
+   Make sure the equivalence is valid, then implement it.  */
+
+void
+ffestc_R625 (ffesttExprList exprlist, ffebld stat, ffelexToken stat_token)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  ffestd_R625 (exprlist, stat);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+#endif
+/* ffestc_let -- R1213 or R737
+
+   ffestc_let(...);
+
+   Verify that R1213 defined-assignment or R737 assignment-stmt are
+   valid here, figure out which one, and implement.  */
+
+#if FFESTR_F90
+void
+ffestc_let (ffebld dest, ffebld source, ffelexToken source_token)
+{
+  ffestc_R737 (dest, source, source_token);
+}
+
+#endif
+/* ffestc_R737 -- Assignment statement
+
+   ffestc_R737(dest_expr,source_expr,source_token);
+
+   Make sure the assignment is valid.  */
+
+void
+ffestc_R737 (ffebld dest, ffebld source, ffelexToken source_token)
+{
+  ffestc_check_simple_ ();
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+#if FFESTR_F90
+    case FFESTV_stateWHERE:
+    case FFESTV_stateWHERETHEN:
+      if (ffestc_order_actionwhere_ () != FFESTC_orderOK_)
+	return;
+      ffestc_labeldef_useless_ ();
+
+      ffestd_R737B (dest, source);
+
+      if (ffestc_shriek_after1_ != NULL)
+	(*ffestc_shriek_after1_) (TRUE);
+      return;
+#endif
+
+    default:
+      break;
+    }
+
+  if (ffestc_order_actionwhere_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  source = ffeexpr_convert_expr (source, source_token, dest, ffesta_tokens[0],
+				 FFEEXPR_contextLET);
+
+  ffestd_R737A (dest, source);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R738 -- Pointer assignment statement
+
+   ffestc_R738(dest_expr,source_expr,source_token);
+
+   Make sure the assignment is valid.  */
+
+#if FFESTR_F90
+void
+ffestc_R738 (ffebld dest, ffebld source, ffelexToken source_token)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  ffestd_R738 (dest, source);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R740 -- WHERE statement
+
+   ffestc_R740(expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffestc_R740 (ffebld expr, ffelexToken expr_token)
+{
+  ffestw b;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, ffestw_top_do (ffestw_previous (b)));
+  ffestw_set_state (b, FFESTV_stateWHERE);
+  ffestw_set_blocknum (b, ffestc_blocknum_++);
+  ffestw_set_shriek (b, ffestc_shriek_where_lost_);
+
+  ffestd_R740 (expr);
+
+  /* Leave label finishing to next statement. */
+
+}
+
+/* ffestc_R742 -- WHERE-construct statement
+
+   ffestc_R742(expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffestc_R742 (ffebld expr, ffelexToken expr_token)
+{
+  ffestw b;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_exec_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_probably_this_wont_work_ ();
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, ffestw_top_do (ffestw_previous (b)));
+  ffestw_set_state (b, FFESTV_stateWHERETHEN);
+  ffestw_set_blocknum (b, ffestc_blocknum_++);
+  ffestw_set_shriek (b, ffestc_shriek_wherethen_);
+  ffestw_set_substate (b, 0);	/* Haven't seen ELSEWHERE yet. */
+
+  ffestd_R742 (expr);
+}
+
+/* ffestc_R744 -- ELSE WHERE statement
+
+   ffestc_R744();
+
+   Make sure ffestc_kind_ identifies a WHERE block.
+   Implement the ELSE of the current WHERE block.  */
+
+void
+ffestc_R744 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_where_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (ffestw_substate (ffestw_stack_top ()) != 0)
+    {
+      ffebad_start (FFEBAD_SECOND_ELSE_WHERE);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+    }
+
+  ffestw_set_substate (ffestw_stack_top (), 1);	/* Saw ELSEWHERE. */
+
+  ffestd_R744 ();
+}
+
+/* ffestc_R745 -- END WHERE statement
+
+   ffestc_R745();
+
+   Make sure ffestc_kind_ identifies a WHERE block.
+   Implement the end of the current WHERE block.  */
+
+void
+ffestc_R745 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_where_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  ffestc_shriek_wherethen_ (TRUE);
+}
+
+#endif
+/* ffestc_R803 -- Block IF (IF-THEN) statement
+
+   ffestc_R803(construct_name,expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffestc_R803 (ffelexToken construct_name, ffebld expr,
+	     ffelexToken expr_token UNUSED)
+{
+  ffestw b;
+  ffesymbol s;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_exec_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_ ();
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, ffestw_top_do (ffestw_previous (b)));
+  ffestw_set_state (b, FFESTV_stateIFTHEN);
+  ffestw_set_blocknum (b, ffestc_blocknum_++);
+  ffestw_set_shriek (b, ffestc_shriek_ifthen_);
+  ffestw_set_substate (b, 0);	/* Haven't seen ELSE yet. */
+
+  if (construct_name == NULL)
+    ffestw_set_name (b, NULL);
+  else
+    {
+      ffestw_set_name (b, ffelex_token_use (construct_name));
+
+      s = ffesymbol_declare_local (construct_name, FALSE);
+
+      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+	{
+	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+	  ffesymbol_set_info (s,
+			      ffeinfo_new (FFEINFO_basictypeNONE,
+					   FFEINFO_kindtypeNONE,
+					   0,
+					   FFEINFO_kindCONSTRUCT,
+					   FFEINFO_whereLOCAL,
+					   FFETARGET_charactersizeNONE));
+	  s = ffecom_sym_learned (s);
+	  ffesymbol_signal_unreported (s);
+	}
+      else
+	ffesymbol_error (s, construct_name);
+    }
+
+  ffestd_R803 (construct_name, expr);
+}
+
+/* ffestc_R804 -- ELSE IF statement
+
+   ffestc_R804(expr,expr_token,name_token);
+
+   Make sure ffestc_kind_ identifies an IF block.  If not
+   NULL, make sure name_token gives the correct name.  Implement the else
+   of the IF block.  */
+
+void
+ffestc_R804 (ffebld expr, ffelexToken expr_token UNUSED,
+	     ffelexToken name)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_ifthen_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (name != NULL)
+    {
+      if (ffestw_name (ffestw_stack_top ()) == NULL)
+	{
+	  ffebad_start (FFEBAD_CONSTRUCT_NOT_NAMED);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_finish ();
+	}
+      else if (ffelex_token_strcmp (name,
+				    ffestw_name (ffestw_stack_top ()))
+	       != 0)
+	{
+	  ffebad_start (FFEBAD_CONSTRUCT_WRONG_NAME);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+	     ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+	  ffebad_finish ();
+	}
+    }
+
+  if (ffestw_substate (ffestw_stack_top ()) != 0)
+    {
+      ffebad_start (FFEBAD_AFTER_ELSE);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+      return;			/* Don't upset back end with ELSEIF
+				   after ELSE. */
+    }
+
+  ffestd_R804 (expr, name);
+}
+
+/* ffestc_R805 -- ELSE statement
+
+   ffestc_R805(name_token);
+
+   Make sure ffestc_kind_ identifies an IF block.  If not
+   NULL, make sure name_token gives the correct name.  Implement the ELSE
+   of the IF block.  */
+
+void
+ffestc_R805 (ffelexToken name)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_ifthen_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (name != NULL)
+    {
+      if (ffestw_name (ffestw_stack_top ()) == NULL)
+	{
+	  ffebad_start (FFEBAD_CONSTRUCT_NOT_NAMED);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_finish ();
+	}
+      else if (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0)
+	{
+	  ffebad_start (FFEBAD_CONSTRUCT_WRONG_NAME);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+	     ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+	  ffebad_finish ();
+	}
+    }
+
+  if (ffestw_substate (ffestw_stack_top ()) != 0)
+    {
+      ffebad_start (FFEBAD_AFTER_ELSE);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+      return;			/* Tell back end about only one ELSE. */
+    }
+
+  ffestw_set_substate (ffestw_stack_top (), 1);	/* Saw ELSE. */
+
+  ffestd_R805 (name);
+}
+
+/* ffestc_R806 -- END IF statement
+
+   ffestc_R806(name_token);
+
+   Make sure ffestc_kind_ identifies an IF block.  If not
+   NULL, make sure name_token gives the correct name.  Implement the end
+   of the IF block.  */
+
+void
+ffestc_R806 (ffelexToken name)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_ifthen_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_endif_ ();
+
+  if (name == NULL)
+    {
+      if (ffestw_name (ffestw_stack_top ()) != NULL)
+	{
+	  ffebad_start (FFEBAD_CONSTRUCT_NAMED);
+	  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		       ffelex_token_where_column (ffesta_tokens[0]));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_finish ();
+	}
+    }
+  else
+    {
+      if (ffestw_name (ffestw_stack_top ()) == NULL)
+	{
+	  ffebad_start (FFEBAD_CONSTRUCT_NOT_NAMED);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_finish ();
+	}
+      else if (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0)
+	{
+	  ffebad_start (FFEBAD_CONSTRUCT_WRONG_NAME);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+	     ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+	  ffebad_finish ();
+	}
+    }
+
+  ffestc_shriek_ifthen_ (TRUE);
+}
+
+/* ffestc_R807 -- Logical IF statement
+
+   ffestc_R807(expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffestc_R807 (ffebld expr, ffelexToken expr_token UNUSED)
+{
+  ffestw b;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_action_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, ffestw_top_do (ffestw_previous (b)));
+  ffestw_set_state (b, FFESTV_stateIF);
+  ffestw_set_blocknum (b, ffestc_blocknum_++);
+  ffestw_set_shriek (b, ffestc_shriek_if_lost_);
+
+  ffestd_R807 (expr);
+
+  /* Do the label finishing in the next statement. */
+
+}
+
+/* ffestc_R809 -- SELECT CASE statement
+
+   ffestc_R809(construct_name,expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffestc_R809 (ffelexToken construct_name, ffebld expr, ffelexToken expr_token)
+{
+  ffestw b;
+  mallocPool pool;
+  ffestwSelect s;
+  ffesymbol sym;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_exec_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_ ();
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, ffestw_top_do (ffestw_previous (b)));
+  ffestw_set_state (b, FFESTV_stateSELECT0);
+  ffestw_set_blocknum (b, ffestc_blocknum_++);
+  ffestw_set_shriek (b, ffestc_shriek_select_);
+  ffestw_set_substate (b, 0);	/* Haven't seen CASE DEFAULT yet. */
+
+  /* Init block to manage CASE list. */
+
+  pool = malloc_pool_new ("Select", ffe_pool_any_unit (), 1024);
+  s = (ffestwSelect) malloc_new_kp (pool, "Select", sizeof (*s));
+  s->first_rel = (ffestwCase) &s->first_rel;
+  s->last_rel = (ffestwCase) &s->first_rel;
+  s->first_stmt = (ffestwCase) &s->first_rel;
+  s->last_stmt = (ffestwCase) &s->first_rel;
+  s->pool = pool;
+  s->cases = 1;
+  s->t = ffelex_token_use (expr_token);
+  s->type = ffeinfo_basictype (ffebld_info (expr));
+  s->kindtype = ffeinfo_kindtype (ffebld_info (expr));
+  ffestw_set_select (b, s);
+
+  if (construct_name == NULL)
+    ffestw_set_name (b, NULL);
+  else
+    {
+      ffestw_set_name (b, ffelex_token_use (construct_name));
+
+      sym = ffesymbol_declare_local (construct_name, FALSE);
+
+      if (ffesymbol_state (sym) == FFESYMBOL_stateNONE)
+	{
+	  ffesymbol_set_state (sym, FFESYMBOL_stateUNDERSTOOD);
+	  ffesymbol_set_info (sym,
+			      ffeinfo_new (FFEINFO_basictypeNONE,
+					   FFEINFO_kindtypeNONE, 0,
+					   FFEINFO_kindCONSTRUCT,
+					   FFEINFO_whereLOCAL,
+					   FFETARGET_charactersizeNONE));
+	  sym = ffecom_sym_learned (sym);
+	  ffesymbol_signal_unreported (sym);
+	}
+      else
+	ffesymbol_error (sym, construct_name);
+    }
+
+  ffestd_R809 (construct_name, expr);
+}
+
+/* ffestc_R810 -- CASE statement
+
+   ffestc_R810(case_value_range_list,name);
+
+   If case_value_range_list is NULL, it's CASE DEFAULT.	 name is the case-
+   construct-name.  Make sure no more than one CASE DEFAULT is present for
+   a given case-construct and that there aren't any overlapping ranges or
+   duplicate case values.  */
+
+void
+ffestc_R810 (ffesttCaseList cases, ffelexToken name)
+{
+  ffesttCaseList caseobj;
+  ffestwSelect s;
+  ffestwCase c, nc;
+  ffebldConstant expr1c, expr2c;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_selectcase_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  s = ffestw_select (ffestw_stack_top ());
+
+  if (ffestw_state (ffestw_stack_top ()) == FFESTV_stateSELECT0)
+    {
+#if 0				/* Not sure we want to have msgs point here
+				   instead of SELECT CASE. */
+      ffestw_update (NULL);	/* Update state line/col info. */
+#endif
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSELECT1);
+    }
+
+  if (name != NULL)
+    {
+      if (ffestw_name (ffestw_stack_top ()) == NULL)
+	{
+	  ffebad_start (FFEBAD_CONSTRUCT_NOT_NAMED);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_finish ();
+	}
+      else if (ffelex_token_strcmp (name,
+				    ffestw_name (ffestw_stack_top ()))
+	       != 0)
+	{
+	  ffebad_start (FFEBAD_CONSTRUCT_WRONG_NAME);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+	     ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+	  ffebad_finish ();
+	}
+    }
+
+  if (cases == NULL)
+    {
+      if (ffestw_substate (ffestw_stack_top ()) != 0)
+	{
+	  ffebad_start (FFEBAD_CASE_SECOND_DEFAULT);
+	  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		       ffelex_token_where_column (ffesta_tokens[0]));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_finish ();
+	}
+
+      ffestw_set_substate (ffestw_stack_top (), 1);	/* Saw ELSE. */
+    }
+  else
+    {				/* For each case, try to fit into sorted list
+				   of ranges. */
+      for (caseobj = cases->next; caseobj != cases; caseobj = caseobj->next)
+	{
+	  if ((caseobj->expr1 == NULL)
+	      && (!caseobj->range
+		  || (caseobj->expr2 == NULL)))
+	    {			/* "CASE (:)". */
+	      ffebad_start (FFEBAD_CASE_BAD_RANGE);
+	      ffebad_here (0, ffelex_token_where_line (caseobj->t),
+			   ffelex_token_where_column (caseobj->t));
+	      ffebad_finish ();
+	      continue;
+	    }
+
+	  if (((caseobj->expr1 != NULL)
+	       && ((ffeinfo_basictype (ffebld_info (caseobj->expr1))
+		    != s->type)
+		   || (ffeinfo_kindtype (ffebld_info (caseobj->expr1))
+		       != s->kindtype)))
+	      || ((caseobj->range)
+		  && (caseobj->expr2 != NULL)
+		  && ((ffeinfo_basictype (ffebld_info (caseobj->expr2))
+		       != s->type)
+		      || (ffeinfo_kindtype (ffebld_info (caseobj->expr2))
+			  != s->kindtype))))
+	    {
+	      ffebad_start (FFEBAD_CASE_TYPE_DISAGREE);
+	      ffebad_here (0, ffelex_token_where_line (caseobj->t),
+			   ffelex_token_where_column (caseobj->t));
+	      ffebad_here (1, ffelex_token_where_line (s->t),
+			   ffelex_token_where_column (s->t));
+	      ffebad_finish ();
+	      continue;
+	    }
+
+	  if ((s->type == FFEINFO_basictypeLOGICAL) && (caseobj->range))
+	    {
+	      ffebad_start (FFEBAD_CASE_LOGICAL_RANGE);
+	      ffebad_here (0, ffelex_token_where_line (caseobj->t),
+			   ffelex_token_where_column (caseobj->t));
+	      ffebad_finish ();
+	      continue;
+	    }
+
+	  if (caseobj->expr1 == NULL)
+	    expr1c = NULL;
+	  else if (ffebld_op (caseobj->expr1) != FFEBLD_opCONTER)
+	    continue;		/* opANY. */
+	  else
+	    expr1c = ffebld_conter (caseobj->expr1);
+
+	  if (!caseobj->range)
+	    expr2c = expr1c;	/* expr1c and expr2c are NOT NULL in this
+				   case. */
+	  else if (caseobj->expr2 == NULL)
+	    expr2c = NULL;
+	  else if (ffebld_op (caseobj->expr2) != FFEBLD_opCONTER)
+	    continue;		/* opANY. */
+	  else
+	    expr2c = ffebld_conter (caseobj->expr2);
+
+	  if (expr1c == NULL)
+	    {			/* "CASE (:high)", must be first in list. */
+	      c = s->first_rel;
+	      if ((c != (ffestwCase) &s->first_rel)
+		  && ((c->low == NULL)
+		      || (ffebld_constant_cmp (expr2c, c->low) >= 0)))
+		{		/* Other "CASE (:high)" or lowest "CASE
+				   (low[:high])" low. */
+		  ffebad_start (FFEBAD_CASE_DUPLICATE);
+		  ffebad_here (0, ffelex_token_where_line (caseobj->t),
+			       ffelex_token_where_column (caseobj->t));
+		  ffebad_here (1, ffelex_token_where_line (c->t),
+			       ffelex_token_where_column (c->t));
+		  ffebad_finish ();
+		  continue;
+		}
+	    }
+	  else if (expr2c == NULL)
+	    {			/* "CASE (low:)", must be last in list. */
+	      c = s->last_rel;
+	      if ((c != (ffestwCase) &s->first_rel)
+		  && ((c->high == NULL)
+		      || (ffebld_constant_cmp (expr1c, c->high) <= 0)))
+		{		/* Other "CASE (low:)" or lowest "CASE
+				   ([low:]high)" high. */
+		  ffebad_start (FFEBAD_CASE_DUPLICATE);
+		  ffebad_here (0, ffelex_token_where_line (caseobj->t),
+			       ffelex_token_where_column (caseobj->t));
+		  ffebad_here (1, ffelex_token_where_line (c->t),
+			       ffelex_token_where_column (c->t));
+		  ffebad_finish ();
+		  continue;
+		}
+	      c = c->next_rel;	/* Same as c = (ffestwCase) &s->first;. */
+	    }
+	  else
+	    {			/* (expr1c != NULL) && (expr2c != NULL). */
+	      if (ffebld_constant_cmp (expr1c, expr2c) > 0)
+		{		/* Such as "CASE (3:1)" or "CASE ('B':'A')". */
+		  ffebad_start (FFEBAD_CASE_RANGE_USELESS);	/* Warn/inform only. */
+		  ffebad_here (0, ffelex_token_where_line (caseobj->t),
+			       ffelex_token_where_column (caseobj->t));
+		  ffebad_finish ();
+		  continue;
+		}
+	      for (c = s->first_rel;
+		   (c != (ffestwCase) &s->first_rel)
+		   && ((c->low == NULL)
+		       || (ffebld_constant_cmp (expr1c, c->low) > 0));
+		   c = c->next_rel)
+		;
+	      nc = c;		/* Which one to report? */
+	      if (((c != (ffestwCase) &s->first_rel)
+		   && (ffebld_constant_cmp (expr2c, c->low) >= 0))
+		  || (((nc = c->previous_rel) != (ffestwCase) &s->first_rel)
+		      && (ffebld_constant_cmp (expr1c, nc->high) <= 0)))
+		{		/* Interference with range in case nc. */
+		  ffebad_start (FFEBAD_CASE_DUPLICATE);
+		  ffebad_here (0, ffelex_token_where_line (caseobj->t),
+			       ffelex_token_where_column (caseobj->t));
+		  ffebad_here (1, ffelex_token_where_line (nc->t),
+			       ffelex_token_where_column (nc->t));
+		  ffebad_finish ();
+		  continue;
+		}
+	    }
+
+	  /* If we reach here for this case range/value, it's ok (sorts into
+	     the list of ranges/values) so we give it its own case object
+	     sorted into the list of case statements. */
+
+	  nc = malloc_new_kp (s->pool, "Case range", sizeof (*nc));
+	  nc->next_rel = c;
+	  nc->previous_rel = c->previous_rel;
+	  nc->next_stmt = (ffestwCase) &s->first_rel;
+	  nc->previous_stmt = s->last_stmt;
+	  nc->low = expr1c;
+	  nc->high = expr2c;
+	  nc->casenum = s->cases;
+	  nc->t = ffelex_token_use (caseobj->t);
+	  nc->next_rel->previous_rel = nc;
+	  nc->previous_rel->next_rel = nc;
+	  nc->next_stmt->previous_stmt = nc;
+	  nc->previous_stmt->next_stmt = nc;
+	}
+    }
+
+  ffestd_R810 ((cases == NULL) ? 0 : s->cases);
+
+  s->cases++;			/* Increment # of cases. */
+}
+
+/* ffestc_R811 -- END SELECT statement
+
+   ffestc_R811(name_token);
+
+   Make sure ffestc_kind_ identifies a SELECT block.  If not
+   NULL, make sure name_token gives the correct name.  Implement the end
+   of the SELECT block.	 */
+
+void
+ffestc_R811 (ffelexToken name)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_selectcase_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_ ();
+
+  if (name == NULL)
+    {
+      if (ffestw_name (ffestw_stack_top ()) != NULL)
+	{
+	  ffebad_start (FFEBAD_CONSTRUCT_NAMED);
+	  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		       ffelex_token_where_column (ffesta_tokens[0]));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_finish ();
+	}
+    }
+  else
+    {
+      if (ffestw_name (ffestw_stack_top ()) == NULL)
+	{
+	  ffebad_start (FFEBAD_CONSTRUCT_NOT_NAMED);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_finish ();
+	}
+      else if (ffelex_token_strcmp (name,
+				    ffestw_name (ffestw_stack_top ()))
+	       != 0)
+	{
+	  ffebad_start (FFEBAD_CONSTRUCT_WRONG_NAME);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+	     ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+	  ffebad_finish ();
+	}
+    }
+
+  ffestc_shriek_select_ (TRUE);
+}
+
+/* ffestc_R819A -- Iterative labeled DO statement
+
+   ffestc_R819A(construct_name,label_token,expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffestc_R819A (ffelexToken construct_name, ffelexToken label_token, ffebld var,
+   ffelexToken var_token, ffebld start, ffelexToken start_token, ffebld end,
+	      ffelexToken end_token, ffebld incr, ffelexToken incr_token)
+{
+  ffestw b;
+  ffelab label;
+  ffesymbol s;
+  ffesymbol varsym;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_exec_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_ ();
+
+  if (!ffestc_labelref_is_loopend_ (label_token, &label))
+    return;
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, b);
+  ffestw_set_state (b, FFESTV_stateDO);
+  ffestw_set_blocknum (b, ffestc_blocknum_++);
+  ffestw_set_shriek (b, ffestc_shriek_do_);
+  ffestw_set_label (b, label);
+  switch (ffebld_op (var))
+    {
+    case FFEBLD_opSYMTER:
+      if ((ffeinfo_basictype (ffebld_info (var)) == FFEINFO_basictypeREAL)
+	  && ffe_is_warn_surprising ())
+	{
+	  ffebad_start (FFEBAD_DO_REAL);	/* See error message!!! */
+	  ffebad_here (0, ffelex_token_where_line (var_token),
+		       ffelex_token_where_column (var_token));
+	  ffebad_string (ffesymbol_text (ffebld_symter (var)));
+	  ffebad_finish ();
+	}
+      if (!ffesymbol_is_doiter (varsym = ffebld_symter (var)))
+	{			/* Presumably already complained about by
+				   ffeexpr_lhs_. */
+	  ffesymbol_set_is_doiter (varsym, TRUE);
+	  ffestw_set_do_iter_var (b, varsym);
+	  ffestw_set_do_iter_var_t (b, ffelex_token_use (var_token));
+	  break;
+	}
+      /* Fall through. */
+    case FFEBLD_opANY:
+      ffestw_set_do_iter_var (b, NULL);
+      ffestw_set_do_iter_var_t (b, NULL);
+      break;
+
+    default:
+      assert ("bad iter var" == NULL);
+      break;
+    }
+
+  if (construct_name == NULL)
+    ffestw_set_name (b, NULL);
+  else
+    {
+      ffestw_set_name (b, ffelex_token_use (construct_name));
+
+      s = ffesymbol_declare_local (construct_name, FALSE);
+
+      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+	{
+	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+	  ffesymbol_set_info (s,
+			      ffeinfo_new (FFEINFO_basictypeNONE,
+					   FFEINFO_kindtypeNONE,
+					   0,
+					   FFEINFO_kindCONSTRUCT,
+					   FFEINFO_whereLOCAL,
+					   FFETARGET_charactersizeNONE));
+	  s = ffecom_sym_learned (s);
+	  ffesymbol_signal_unreported (s);
+	}
+      else
+	ffesymbol_error (s, construct_name);
+    }
+
+  if (incr == NULL)
+    {
+      incr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (1));
+      ffebld_set_info (incr, ffeinfo_new
+		       (FFEINFO_basictypeINTEGER,
+			FFEINFO_kindtypeINTEGERDEFAULT,
+			0,
+			FFEINFO_kindENTITY,
+			FFEINFO_whereCONSTANT,
+			FFETARGET_charactersizeNONE));
+    }
+
+  start = ffeexpr_convert_expr (start, start_token, var, var_token,
+				FFEEXPR_contextLET);
+  end = ffeexpr_convert_expr (end, end_token, var, var_token,
+			      FFEEXPR_contextLET);
+  incr = ffeexpr_convert_expr (incr, incr_token, var, var_token,
+			       FFEEXPR_contextLET);
+
+  ffestd_R819A (construct_name, label, var,
+		start, start_token,
+		end, end_token,
+		incr, incr_token);
+}
+
+/* ffestc_R819B -- Labeled DO WHILE statement
+
+   ffestc_R819B(construct_name,label_token,expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffestc_R819B (ffelexToken construct_name, ffelexToken label_token,
+	      ffebld expr, ffelexToken expr_token UNUSED)
+{
+  ffestw b;
+  ffelab label;
+  ffesymbol s;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_exec_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_ ();
+
+  if (!ffestc_labelref_is_loopend_ (label_token, &label))
+    return;
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, b);
+  ffestw_set_state (b, FFESTV_stateDO);
+  ffestw_set_blocknum (b, ffestc_blocknum_++);
+  ffestw_set_shriek (b, ffestc_shriek_do_);
+  ffestw_set_label (b, label);
+  ffestw_set_do_iter_var (b, NULL);
+  ffestw_set_do_iter_var_t (b, NULL);
+
+  if (construct_name == NULL)
+    ffestw_set_name (b, NULL);
+  else
+    {
+      ffestw_set_name (b, ffelex_token_use (construct_name));
+
+      s = ffesymbol_declare_local (construct_name, FALSE);
+
+      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+	{
+	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+	  ffesymbol_set_info (s,
+			      ffeinfo_new (FFEINFO_basictypeNONE,
+					   FFEINFO_kindtypeNONE,
+					   0,
+					   FFEINFO_kindCONSTRUCT,
+					   FFEINFO_whereLOCAL,
+					   FFETARGET_charactersizeNONE));
+	  s = ffecom_sym_learned (s);
+	  ffesymbol_signal_unreported (s);
+	}
+      else
+	ffesymbol_error (s, construct_name);
+    }
+
+  ffestd_R819B (construct_name, label, expr);
+}
+
+/* ffestc_R820A -- Iterative nonlabeled DO statement
+
+   ffestc_R820A(construct_name,expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffestc_R820A (ffelexToken construct_name, ffebld var, ffelexToken var_token,
+   ffebld start, ffelexToken start_token, ffebld end, ffelexToken end_token,
+	      ffebld incr, ffelexToken incr_token)
+{
+  ffestw b;
+  ffesymbol s;
+  ffesymbol varsym;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_exec_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_ ();
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, b);
+  ffestw_set_state (b, FFESTV_stateDO);
+  ffestw_set_blocknum (b, ffestc_blocknum_++);
+  ffestw_set_shriek (b, ffestc_shriek_do_);
+  ffestw_set_label (b, NULL);
+  switch (ffebld_op (var))
+    {
+    case FFEBLD_opSYMTER:
+      if ((ffeinfo_basictype (ffebld_info (var)) == FFEINFO_basictypeREAL)
+	  && ffe_is_warn_surprising ())
+	{
+	  ffebad_start (FFEBAD_DO_REAL);	/* See error message!!! */
+	  ffebad_here (0, ffelex_token_where_line (var_token),
+		       ffelex_token_where_column (var_token));
+	  ffebad_string (ffesymbol_text (ffebld_symter (var)));
+	  ffebad_finish ();
+	}
+      if (!ffesymbol_is_doiter (varsym = ffebld_symter (var)))
+	{			/* Presumably already complained about by
+				   ffeexpr_lhs_. */
+	  ffesymbol_set_is_doiter (varsym, TRUE);
+	  ffestw_set_do_iter_var (b, varsym);
+	  ffestw_set_do_iter_var_t (b, ffelex_token_use (var_token));
+	  break;
+	}
+      /* Fall through. */
+    case FFEBLD_opANY:
+      ffestw_set_do_iter_var (b, NULL);
+      ffestw_set_do_iter_var_t (b, NULL);
+      break;
+
+    default:
+      assert ("bad iter var" == NULL);
+      break;
+    }
+
+  if (construct_name == NULL)
+    ffestw_set_name (b, NULL);
+  else
+    {
+      ffestw_set_name (b, ffelex_token_use (construct_name));
+
+      s = ffesymbol_declare_local (construct_name, FALSE);
+
+      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+	{
+	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+	  ffesymbol_set_info (s,
+			      ffeinfo_new (FFEINFO_basictypeNONE,
+					   FFEINFO_kindtypeNONE,
+					   0,
+					   FFEINFO_kindCONSTRUCT,
+					   FFEINFO_whereLOCAL,
+					   FFETARGET_charactersizeNONE));
+	  s = ffecom_sym_learned (s);
+	  ffesymbol_signal_unreported (s);
+	}
+      else
+	ffesymbol_error (s, construct_name);
+    }
+
+  if (incr == NULL)
+    {
+      incr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (1));
+      ffebld_set_info (incr, ffeinfo_new
+		       (FFEINFO_basictypeINTEGER,
+			FFEINFO_kindtypeINTEGERDEFAULT,
+			0,
+			FFEINFO_kindENTITY,
+			FFEINFO_whereCONSTANT,
+			FFETARGET_charactersizeNONE));
+    }
+
+  start = ffeexpr_convert_expr (start, start_token, var, var_token,
+				FFEEXPR_contextLET);
+  end = ffeexpr_convert_expr (end, end_token, var, var_token,
+			      FFEEXPR_contextLET);
+  incr = ffeexpr_convert_expr (incr, incr_token, var, var_token,
+			       FFEEXPR_contextLET);
+
+#if 0
+  if ((ffebld_op (incr) == FFEBLD_opCONTER)
+      && (ffebld_constant_is_zero (ffebld_conter (incr))))
+    {
+      ffebad_start (FFEBAD_DO_STEP_ZERO);
+      ffebad_here (0, ffelex_token_where_line (incr_token),
+		   ffelex_token_where_column (incr_token));
+      ffebad_string ("Iterative DO loop");
+      ffebad_finish ();
+    }
+#endif
+
+  ffestd_R819A (construct_name, NULL, var,
+		start, start_token,
+		end, end_token,
+		incr, incr_token);
+}
+
+/* ffestc_R820B -- Nonlabeled DO WHILE statement
+
+   ffestc_R820B(construct_name,expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffestc_R820B (ffelexToken construct_name, ffebld expr,
+	      ffelexToken expr_token UNUSED)
+{
+  ffestw b;
+  ffesymbol s;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_exec_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_ ();
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, b);
+  ffestw_set_state (b, FFESTV_stateDO);
+  ffestw_set_blocknum (b, ffestc_blocknum_++);
+  ffestw_set_shriek (b, ffestc_shriek_do_);
+  ffestw_set_label (b, NULL);
+  ffestw_set_do_iter_var (b, NULL);
+  ffestw_set_do_iter_var_t (b, NULL);
+
+  if (construct_name == NULL)
+    ffestw_set_name (b, NULL);
+  else
+    {
+      ffestw_set_name (b, ffelex_token_use (construct_name));
+
+      s = ffesymbol_declare_local (construct_name, FALSE);
+
+      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+	{
+	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+	  ffesymbol_set_info (s,
+			      ffeinfo_new (FFEINFO_basictypeNONE,
+					   FFEINFO_kindtypeNONE,
+					   0,
+					   FFEINFO_kindCONSTRUCT,
+					   FFEINFO_whereLOCAL,
+					   FFETARGET_charactersizeNONE));
+	  s = ffecom_sym_learned (s);
+	  ffesymbol_signal_unreported (s);
+	}
+      else
+	ffesymbol_error (s, construct_name);
+    }
+
+  ffestd_R819B (construct_name, NULL, expr);
+}
+
+/* ffestc_R825 -- END DO statement
+
+   ffestc_R825(name_token);
+
+   Make sure ffestc_kind_ identifies a DO block.  If not
+   NULL, make sure name_token gives the correct name.  Implement the end
+   of the DO block.  */
+
+void
+ffestc_R825 (ffelexToken name)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_do_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  if (name == NULL)
+    {
+      if (ffestw_name (ffestw_stack_top ()) != NULL)
+	{
+	  ffebad_start (FFEBAD_CONSTRUCT_NAMED);
+	  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		       ffelex_token_where_column (ffesta_tokens[0]));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_finish ();
+	}
+    }
+  else
+    {
+      if (ffestw_name (ffestw_stack_top ()) == NULL)
+	{
+	  ffebad_start (FFEBAD_CONSTRUCT_NOT_NAMED);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_finish ();
+	}
+      else if (ffelex_token_strcmp (name,
+				    ffestw_name (ffestw_stack_top ()))
+	       != 0)
+	{
+	  ffebad_start (FFEBAD_CONSTRUCT_WRONG_NAME);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+	     ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+	  ffebad_finish ();
+	}
+    }
+
+  if (ffesta_label_token == NULL)
+    {				/* If top of stack has label, its an error! */
+      if (ffestw_label (ffestw_stack_top ()) != NULL)
+	{
+	  ffebad_start (FFEBAD_DO_HAD_LABEL);
+	  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		       ffelex_token_where_column (ffesta_tokens[0]));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_finish ();
+	}
+
+      ffestc_shriek_do_ (TRUE);
+
+      ffestc_try_shriek_do_ ();
+
+      return;
+    }
+
+  ffestd_R825 (name);
+
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R834 -- CYCLE statement
+
+   ffestc_R834(name_token);
+
+   Handle a CYCLE within a loop.  */
+
+void
+ffestc_R834 (ffelexToken name)
+{
+  ffestw block;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_actiondo_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_begin_ ();
+
+  if (name == NULL)
+    block = ffestw_top_do (ffestw_stack_top ());
+  else
+    {				/* Search for name. */
+      for (block = ffestw_top_do (ffestw_stack_top ());
+	   (block != NULL) && (ffestw_blocknum (block) != 0);
+	   block = ffestw_top_do (ffestw_previous (block)))
+	{
+	  if ((ffestw_name (block) != NULL)
+	      && (ffelex_token_strcmp (name, ffestw_name (block)) == 0))
+	    break;
+	}
+      if ((block == NULL) || (ffestw_blocknum (block) == 0))
+	{
+	  block = ffestw_top_do (ffestw_stack_top ());
+	  ffebad_start (FFEBAD_CONSTRUCT_NO_DO_NAME);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_finish ();
+	}
+    }
+
+  ffestd_R834 (block);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+
+  /* notloop's that are actionif's can be the target of a loop-end
+     statement if they're in the "then" part of a logical IF, as
+     in "DO 10", "10 IF (...) CYCLE".  */
+
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R835 -- EXIT statement
+
+   ffestc_R835(name_token);
+
+   Handle a EXIT within a loop.	 */
+
+void
+ffestc_R835 (ffelexToken name)
+{
+  ffestw block;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_actiondo_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_begin_ ();
+
+  if (name == NULL)
+    block = ffestw_top_do (ffestw_stack_top ());
+  else
+    {				/* Search for name. */
+      for (block = ffestw_top_do (ffestw_stack_top ());
+	   (block != NULL) && (ffestw_blocknum (block) != 0);
+	   block = ffestw_top_do (ffestw_previous (block)))
+	{
+	  if ((ffestw_name (block) != NULL)
+	      && (ffelex_token_strcmp (name, ffestw_name (block)) == 0))
+	    break;
+	}
+      if ((block == NULL) || (ffestw_blocknum (block) == 0))
+	{
+	  block = ffestw_top_do (ffestw_stack_top ());
+	  ffebad_start (FFEBAD_CONSTRUCT_NO_DO_NAME);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_finish ();
+	}
+    }
+
+  ffestd_R835 (block);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+
+  /* notloop's that are actionif's can be the target of a loop-end
+     statement if they're in the "then" part of a logical IF, as
+     in "DO 10", "10 IF (...) EXIT".  */
+
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R836 -- GOTO statement
+
+   ffestc_R836(label_token);
+
+   Make sure label_token identifies a valid label for a GOTO.  Update
+   that label's info to indicate it is the target of a GOTO.  */
+
+void
+ffestc_R836 (ffelexToken label_token)
+{
+  ffelab label;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_begin_ ();
+
+  if (ffestc_labelref_is_branch_ (label_token, &label))
+    ffestd_R836 (label);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+
+  /* notloop's that are actionif's can be the target of a loop-end
+     statement if they're in the "then" part of a logical IF, as
+     in "DO 10", "10 IF (...) GOTO 100".  */
+
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R837 -- Computed GOTO statement
+
+   ffestc_R837(label_list,expr,expr_token);
+
+   Make sure label_list identifies valid labels for a GOTO.  Update
+   each label's info to indicate it is the target of a GOTO.  */
+
+void
+ffestc_R837 (ffesttTokenList label_toks, ffebld expr,
+	     ffelexToken expr_token UNUSED)
+{
+  ffesttTokenItem ti;
+  bool ok = TRUE;
+  int i;
+  ffelab *labels;
+
+  assert (label_toks != NULL);
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  labels = malloc_new_kp (ffesta_output_pool, "FFESTC labels",
+			  sizeof (*labels)
+			  * ffestt_tokenlist_count (label_toks));
+
+  for (ti = label_toks->first, i = 0;
+       ti != (ffesttTokenItem) &label_toks->first;
+       ti = ti->next, ++i)
+    {
+      if (!ffestc_labelref_is_branch_ (ti->t, &labels[i]))
+	{
+	  ok = FALSE;
+	  break;
+	}
+    }
+
+  if (ok)
+    ffestd_R837 (labels, ffestt_tokenlist_count (label_toks), expr);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R838 -- ASSIGN statement
+
+   ffestc_R838(label_token,target_variable,target_token);
+
+   Make sure label_token identifies a valid label for an assignment.  Update
+   that label's info to indicate it is the source of an assignment.  Update
+   target_variable's info to indicate it is the target the assignment of that
+   label.  */
+
+void
+ffestc_R838 (ffelexToken label_token, ffebld target,
+	     ffelexToken target_token UNUSED)
+{
+  ffelab label;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  if (ffestc_labelref_is_assignable_ (label_token, &label))
+    ffestd_R838 (label, target);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R839 -- Assigned GOTO statement
+
+   ffestc_R839(target,target_token,label_list);
+
+   Make sure label_list identifies valid labels for a GOTO.  Update
+   each label's info to indicate it is the target of a GOTO.  */
+
+void
+ffestc_R839 (ffebld target, ffelexToken target_token UNUSED,
+	     ffesttTokenList label_toks)
+{
+  ffesttTokenItem ti;
+  bool ok = TRUE;
+  int i;
+  ffelab *labels;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_begin_ ();
+
+  if (label_toks == NULL)
+    {
+      labels = NULL;
+      i = 0;
+    }
+  else
+    {
+      labels = malloc_new_kp (ffesta_output_pool, "FFESTC labels",
+		    sizeof (*labels) * ffestt_tokenlist_count (label_toks));
+
+      for (ti = label_toks->first, i = 0;
+	   ti != (ffesttTokenItem) &label_toks->first;
+	   ti = ti->next, ++i)
+	{
+	  if (!ffestc_labelref_is_branch_ (ti->t, &labels[i]))
+	    {
+	      ok = FALSE;
+	      break;
+	    }
+	}
+    }
+
+  if (ok)
+    ffestd_R839 (target, labels, i);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+
+  /* notloop's that are actionif's can be the target of a loop-end
+     statement if they're in the "then" part of a logical IF, as
+     in "DO 10", "10 IF (...) GOTO I".  */
+
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R840 -- Arithmetic IF statement
+
+   ffestc_R840(expr,expr_token,neg,zero,pos);
+
+   Make sure the labels are valid; implement.  */
+
+void
+ffestc_R840 (ffebld expr, ffelexToken expr_token UNUSED,
+	     ffelexToken neg_token, ffelexToken zero_token,
+	     ffelexToken pos_token)
+{
+  ffelab neg;
+  ffelab zero;
+  ffelab pos;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_begin_ ();
+
+  if (ffestc_labelref_is_branch_ (neg_token, &neg)
+      && ffestc_labelref_is_branch_ (zero_token, &zero)
+      && ffestc_labelref_is_branch_ (pos_token, &pos))
+    ffestd_R840 (expr, neg, zero, pos);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+
+  /* notloop's that are actionif's can be the target of a loop-end
+     statement if they're in the "then" part of a logical IF, as
+     in "DO 10", "10 IF (...) GOTO (100,200,300), I".  */
+
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R841 -- CONTINUE statement
+
+   ffestc_R841();  */
+
+void
+ffestc_R841 ()
+{
+  ffestc_check_simple_ ();
+
+  if (ffestc_order_actionwhere_ () != FFESTC_orderOK_)
+    return;
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+#if FFESTR_F90
+    case FFESTV_stateWHERE:
+    case FFESTV_stateWHERETHEN:
+      ffestc_labeldef_useless_ ();
+
+      ffestd_R841 (TRUE);
+
+      /* It's okay that we call ffestc_labeldef_branch_end_ () below,
+	 since that will be a no-op after calling _useless_ () above.  */
+      break;
+#endif
+
+    default:
+      ffestc_labeldef_branch_begin_ ();
+
+      ffestd_R841 (FALSE);
+
+      break;
+    }
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R842 -- STOP statement
+
+   ffestc_R842(expr,expr_token);
+
+   Make sure statement is valid here; implement.  expr and expr_token are
+   both NULL if there was no expression.  */
+
+void
+ffestc_R842 (ffebld expr, ffelexToken expr_token UNUSED)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_begin_ ();
+
+  ffestd_R842 (expr);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+
+  /* notloop's that are actionif's can be the target of a loop-end
+     statement if they're in the "then" part of a logical IF, as
+     in "DO 10", "10 IF (...) STOP".  */
+
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R843 -- PAUSE statement
+
+   ffestc_R843(expr,expr_token);
+
+   Make sure statement is valid here; implement.  expr and expr_token are
+   both NULL if there was no expression.  */
+
+void
+ffestc_R843 (ffebld expr, ffelexToken expr_token UNUSED)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  ffestd_R843 (expr);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R904 -- OPEN statement
+
+   ffestc_R904();
+
+   Make sure an OPEN is valid in the current context, and implement it.	 */
+
+void
+ffestc_R904 ()
+{
+  int i;
+  int expect_file;
+  char *status_strs[]
+  =
+  {
+    "New",
+    "Old",
+    "Replace",
+    "Scratch",
+    "Unknown"
+  };
+  char *access_strs[]
+  =
+  {
+    "Append",
+    "Direct",
+    "Keyed",
+    "Sequential"
+  };
+  char *blank_strs[]
+  =
+  {
+    "Null",
+    "Zero"
+  };
+  char *carriagecontrol_strs[]
+  =
+  {
+    "Fortran",
+    "List",
+    "None"
+  };
+  char *dispose_strs[]
+  =
+  {
+    "Delete",
+    "Keep",
+    "Print",
+    "Print/Delete",
+    "Save",
+    "Submit",
+    "Submit/Delete"
+  };
+  char *form_strs[]
+  =
+  {
+    "Formatted",
+    "Unformatted"
+  };
+  char *organization_strs[]
+  =
+  {
+    "Indexed",
+    "Relative",
+    "Sequential"
+  };
+  char *position_strs[]
+  =
+  {
+    "Append",
+    "AsIs",
+    "Rewind"
+  };
+  char *action_strs[]
+  =
+  {
+    "Read",
+    "ReadWrite",
+    "Write"
+  };
+  char *delim_strs[]
+  =
+  {
+    "Apostrophe",
+    "None",
+    "Quote"
+  };
+  char *recordtype_strs[]
+  =
+  {
+    "Fixed",
+    "Segmented",
+    "Stream",
+    "Stream_CR",
+    "Stream_LF",
+    "Variable"
+  };
+  char *pad_strs[]
+  =
+  {
+    "No",
+    "Yes"
+  };
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  if (ffestc_subr_is_branch_
+      (&ffestp_file.open.open_spec[FFESTP_openixERR])
+      && ffestc_subr_is_present_ ("UNIT",
+			    &ffestp_file.open.open_spec[FFESTP_openixUNIT]))
+    {
+      i = ffestc_subr_binsrch_ (status_strs,
+				ARRAY_SIZE (status_strs),
+			   &ffestp_file.open.open_spec[FFESTP_openixSTATUS],
+				"NEW, OLD, REPLACE, SCRATCH, or UNKNOWN");
+      switch (i)
+	{
+	case 0:		/* Unknown. */
+	case 5:		/* UNKNOWN. */
+	  expect_file = 2;	/* Unknown, don't care about FILE=. */
+	  break;
+
+	case 1:		/* NEW. */
+	case 2:		/* OLD. */
+	  if (ffe_is_pedantic ())
+	    expect_file = 1;	/* Yes, need FILE=. */
+	  else
+	    expect_file = 2;	/* f2clib doesn't care about FILE=. */
+	  break;
+
+	case 3:		/* REPLACE. */
+	  expect_file = 1;	/* Yes, need FILE=. */
+	  break;
+
+	case 4:		/* SCRATCH. */
+	  expect_file = 0;	/* No, disallow FILE=. */
+	  break;
+
+	default:
+	  assert ("invalid _binsrch_ result" == NULL);
+	  expect_file = 0;
+	  break;
+	}
+      if ((expect_file == 0)
+	  && ffestp_file.open.open_spec[FFESTP_openixFILE].kw_or_val_present)
+	{
+	  ffebad_start (FFEBAD_CONFLICTING_SPECS);
+	  assert (ffestp_file.open.open_spec[FFESTP_openixFILE].kw_or_val_present);
+	  if (ffestp_file.open.open_spec[FFESTP_openixFILE].kw_present)
+	    {
+	      ffebad_here (0, ffelex_token_where_line
+			 (ffestp_file.open.open_spec[FFESTP_openixFILE].kw),
+			   ffelex_token_where_column
+			(ffestp_file.open.open_spec[FFESTP_openixFILE].kw));
+	    }
+	  else
+	    {
+	      ffebad_here (0, ffelex_token_where_line
+		      (ffestp_file.open.open_spec[FFESTP_openixFILE].value),
+			   ffelex_token_where_column
+		     (ffestp_file.open.open_spec[FFESTP_openixFILE].value));
+	    }
+	  assert (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw_or_val_present);
+	  if (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw_present)
+	    {
+	      ffebad_here (1, ffelex_token_where_line
+		       (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw),
+			   ffelex_token_where_column
+		      (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw));
+	    }
+	  else
+	    {
+	      ffebad_here (1, ffelex_token_where_line
+		    (ffestp_file.open.open_spec[FFESTP_openixSTATUS].value),
+			   ffelex_token_where_column
+		   (ffestp_file.open.open_spec[FFESTP_openixSTATUS].value));
+	    }
+	  ffebad_finish ();
+	}
+      else if ((expect_file == 1)
+	&& !ffestp_file.open.open_spec[FFESTP_openixFILE].kw_or_val_present)
+	{
+	  ffebad_start (FFEBAD_MISSING_SPECIFIER);
+	  assert (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw_or_val_present);
+	  if (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw_present)
+	    {
+	      ffebad_here (0, ffelex_token_where_line
+		       (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw),
+			   ffelex_token_where_column
+		      (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw));
+	    }
+	  else
+	    {
+	      ffebad_here (0, ffelex_token_where_line
+		    (ffestp_file.open.open_spec[FFESTP_openixSTATUS].value),
+			   ffelex_token_where_column
+		   (ffestp_file.open.open_spec[FFESTP_openixSTATUS].value));
+	    }
+	  ffebad_string ("FILE=");
+	  ffebad_finish ();
+	}
+
+      ffestc_subr_binsrch_ (access_strs, ARRAY_SIZE (access_strs),
+			    &ffestp_file.open.open_spec[FFESTP_openixACCESS],
+			    "APPEND, DIRECT, KEYED, or SEQUENTIAL");
+
+      ffestc_subr_binsrch_ (blank_strs, ARRAY_SIZE (blank_strs),
+			    &ffestp_file.open.open_spec[FFESTP_openixBLANK],
+			    "NULL or ZERO");
+
+      ffestc_subr_binsrch_ (carriagecontrol_strs,
+			    ARRAY_SIZE (carriagecontrol_strs),
+		  &ffestp_file.open.open_spec[FFESTP_openixCARRIAGECONTROL],
+			    "FORTRAN, LIST, or NONE");
+
+      ffestc_subr_binsrch_ (dispose_strs, ARRAY_SIZE (dispose_strs),
+			  &ffestp_file.open.open_spec[FFESTP_openixDISPOSE],
+       "DELETE, KEEP, PRINT, PRINT/DELETE, SAVE, SUBMIT, or SUBMIT/DELETE");
+
+      ffestc_subr_binsrch_ (form_strs, ARRAY_SIZE (form_strs),
+			    &ffestp_file.open.open_spec[FFESTP_openixFORM],
+			    "FORMATTED or UNFORMATTED");
+
+      ffestc_subr_binsrch_ (organization_strs, ARRAY_SIZE (organization_strs),
+		     &ffestp_file.open.open_spec[FFESTP_openixORGANIZATION],
+			    "INDEXED, RELATIVE, or SEQUENTIAL");
+
+      ffestc_subr_binsrch_ (position_strs, ARRAY_SIZE (position_strs),
+			 &ffestp_file.open.open_spec[FFESTP_openixPOSITION],
+			    "APPEND, ASIS, or REWIND");
+
+      ffestc_subr_binsrch_ (action_strs, ARRAY_SIZE (action_strs),
+			    &ffestp_file.open.open_spec[FFESTP_openixACTION],
+			    "READ, READWRITE, or WRITE");
+
+      ffestc_subr_binsrch_ (delim_strs, ARRAY_SIZE (delim_strs),
+			    &ffestp_file.open.open_spec[FFESTP_openixDELIM],
+			    "APOSTROPHE, NONE, or QUOTE");
+
+      ffestc_subr_binsrch_ (recordtype_strs, ARRAY_SIZE (recordtype_strs),
+		       &ffestp_file.open.open_spec[FFESTP_openixRECORDTYPE],
+	     "FIXED, SEGMENTED, STREAM, STREAM_CR, STREAM_LF, or VARIABLE");
+
+      ffestc_subr_binsrch_ (pad_strs, ARRAY_SIZE (pad_strs),
+			    &ffestp_file.open.open_spec[FFESTP_openixPAD],
+			    "NO or YES");
+
+      ffestd_R904 ();
+    }
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R907 -- CLOSE statement
+
+   ffestc_R907();
+
+   Make sure a CLOSE is valid in the current context, and implement it.	 */
+
+void
+ffestc_R907 ()
+{
+  char *status_strs[]
+  =
+  {
+    "Delete",
+    "Keep",
+    "Print",
+    "Print/Delete",
+    "Save",
+    "Submit",
+    "Submit/Delete"
+  };
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  if (ffestc_subr_is_branch_
+      (&ffestp_file.close.close_spec[FFESTP_closeixERR])
+      && ffestc_subr_is_present_ ("UNIT",
+			 &ffestp_file.close.close_spec[FFESTP_closeixUNIT]))
+    {
+      ffestc_subr_binsrch_ (status_strs, ARRAY_SIZE (status_strs),
+			&ffestp_file.close.close_spec[FFESTP_closeixSTATUS],
+       "DELETE, KEEP, PRINT, PRINT/DELETE, SAVE, SUBMIT, or SUBMIT/DELETE");
+
+      ffestd_R907 ();
+    }
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R909_start -- READ(...) statement list begin
+
+   ffestc_R909_start(FALSE);
+
+   Verify that READ is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_R909_start (bool only_format)
+{
+  ffestvUnit unit;
+  ffestvFormat format;
+  bool rec;
+  bool key;
+  ffestpReadIx keyn;
+  ffestpReadIx spec1;
+  ffestpReadIx spec2;
+
+  ffestc_check_start_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_branch_begin_ ();
+
+  if (!ffestc_subr_is_format_
+      (&ffestp_file.read.read_spec[FFESTP_readixFORMAT]))
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+
+  format = ffestc_subr_format_
+    (&ffestp_file.read.read_spec[FFESTP_readixFORMAT]);
+  ffestc_namelist_ = (format == FFESTV_formatNAMELIST);
+
+  if (only_format)
+    {
+      ffestd_R909_start (TRUE, FFESTV_unitNONE, format, FALSE, FALSE);
+
+      ffestc_ok_ = TRUE;
+      return;
+    }
+
+  if (!ffestc_subr_is_branch_
+      (&ffestp_file.read.read_spec[FFESTP_readixEOR])
+      || !ffestc_subr_is_branch_
+      (&ffestp_file.read.read_spec[FFESTP_readixERR])
+      || !ffestc_subr_is_branch_
+      (&ffestp_file.read.read_spec[FFESTP_readixEND]))
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+
+  unit = ffestc_subr_unit_
+    (&ffestp_file.read.read_spec[FFESTP_readixUNIT]);
+  if (unit == FFESTV_unitNONE)
+    {
+      ffebad_start (FFEBAD_NO_UNIT_SPEC);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_finish ();
+      ffestc_ok_ = FALSE;
+      return;
+    }
+
+  rec = ffestp_file.read.read_spec[FFESTP_readixREC].kw_or_val_present;
+
+  if (ffestp_file.read.read_spec[FFESTP_readixKEYEQ].kw_or_val_present)
+    {
+      key = TRUE;
+      keyn = spec1 = FFESTP_readixKEYEQ;
+    }
+  else
+    {
+      key = FALSE;
+      keyn = spec1 = FFESTP_readix;
+    }
+
+  if (ffestp_file.read.read_spec[FFESTP_readixKEYGT].kw_or_val_present)
+    {
+      if (key)
+	{
+	  spec2 = FFESTP_readixKEYGT;
+	whine:			/* :::::::::::::::::::: */
+	  ffebad_start (FFEBAD_CONFLICTING_SPECS);
+	  assert (ffestp_file.read.read_spec[spec1].kw_or_val_present);
+	  if (ffestp_file.read.read_spec[spec1].kw_present)
+	    {
+	      ffebad_here (0, ffelex_token_where_line
+			   (ffestp_file.read.read_spec[spec1].kw),
+			   ffelex_token_where_column
+			   (ffestp_file.read.read_spec[spec1].kw));
+	    }
+	  else
+	    {
+	      ffebad_here (0, ffelex_token_where_line
+			   (ffestp_file.read.read_spec[spec1].value),
+			   ffelex_token_where_column
+			   (ffestp_file.read.read_spec[spec1].value));
+	    }
+	  assert (ffestp_file.read.read_spec[spec2].kw_or_val_present);
+	  if (ffestp_file.read.read_spec[spec2].kw_present)
+	    {
+	      ffebad_here (1, ffelex_token_where_line
+			   (ffestp_file.read.read_spec[spec2].kw),
+			   ffelex_token_where_column
+			   (ffestp_file.read.read_spec[spec2].kw));
+	    }
+	  else
+	    {
+	      ffebad_here (1, ffelex_token_where_line
+			   (ffestp_file.read.read_spec[spec2].value),
+			   ffelex_token_where_column
+			   (ffestp_file.read.read_spec[spec2].value));
+	    }
+	  ffebad_finish ();
+	  ffestc_ok_ = FALSE;
+	  return;
+	}
+      key = TRUE;
+      keyn = spec1 = FFESTP_readixKEYGT;
+    }
+
+  if (ffestp_file.read.read_spec[FFESTP_readixKEYGE].kw_or_val_present)
+    {
+      if (key)
+	{
+	  spec2 = FFESTP_readixKEYGT;
+	  goto whine;		/* :::::::::::::::::::: */
+	}
+      key = TRUE;
+      keyn = FFESTP_readixKEYGT;
+    }
+
+  if (rec)
+    {
+      spec1 = FFESTP_readixREC;
+      if (key)
+	{
+	  spec2 = keyn;
+	  goto whine;		/* :::::::::::::::::::: */
+	}
+      if (unit == FFESTV_unitCHAREXPR)
+	{
+	  spec2 = FFESTP_readixUNIT;
+	  goto whine;		/* :::::::::::::::::::: */
+	}
+      if ((format == FFESTV_formatASTERISK)
+	  || (format == FFESTV_formatNAMELIST))
+	{
+	  spec2 = FFESTP_readixFORMAT;
+	  goto whine;		/* :::::::::::::::::::: */
+	}
+      if (ffestp_file.read.read_spec[FFESTP_readixADVANCE].kw_or_val_present)
+	{
+	  spec2 = FFESTP_readixADVANCE;
+	  goto whine;		/* :::::::::::::::::::: */
+	}
+      if (ffestp_file.read.read_spec[FFESTP_readixEND].kw_or_val_present)
+	{
+	  spec2 = FFESTP_readixEND;
+	  goto whine;		/* :::::::::::::::::::: */
+	}
+      if (ffestp_file.read.read_spec[FFESTP_readixNULLS].kw_or_val_present)
+	{
+	  spec2 = FFESTP_readixNULLS;
+	  goto whine;		/* :::::::::::::::::::: */
+	}
+    }
+  else if (key)
+    {
+      spec1 = keyn;
+      if (unit == FFESTV_unitCHAREXPR)
+	{
+	  spec2 = FFESTP_readixUNIT;
+	  goto whine;		/* :::::::::::::::::::: */
+	}
+      if ((format == FFESTV_formatASTERISK)
+	  || (format == FFESTV_formatNAMELIST))
+	{
+	  spec2 = FFESTP_readixFORMAT;
+	  goto whine;		/* :::::::::::::::::::: */
+	}
+      if (ffestp_file.read.read_spec[FFESTP_readixADVANCE].kw_or_val_present)
+	{
+	  spec2 = FFESTP_readixADVANCE;
+	  goto whine;		/* :::::::::::::::::::: */
+	}
+      if (ffestp_file.read.read_spec[FFESTP_readixEND].kw_or_val_present)
+	{
+	  spec2 = FFESTP_readixEND;
+	  goto whine;		/* :::::::::::::::::::: */
+	}
+      if (ffestp_file.read.read_spec[FFESTP_readixEOR].kw_or_val_present)
+	{
+	  spec2 = FFESTP_readixEOR;
+	  goto whine;		/* :::::::::::::::::::: */
+	}
+      if (ffestp_file.read.read_spec[FFESTP_readixNULLS].kw_or_val_present)
+	{
+	  spec2 = FFESTP_readixNULLS;
+	  goto whine;		/* :::::::::::::::::::: */
+	}
+      if (ffestp_file.read.read_spec[FFESTP_readixREC].kw_or_val_present)
+	{
+	  spec2 = FFESTP_readixREC;
+	  goto whine;		/* :::::::::::::::::::: */
+	}
+      if (ffestp_file.read.read_spec[FFESTP_readixSIZE].kw_or_val_present)
+	{
+	  spec2 = FFESTP_readixSIZE;
+	  goto whine;		/* :::::::::::::::::::: */
+	}
+    }
+  else
+    {				/* Sequential/Internal. */
+      if (unit == FFESTV_unitCHAREXPR)
+	{			/* Internal file. */
+	  spec1 = FFESTP_readixUNIT;
+	  if (format == FFESTV_formatNAMELIST)
+	    {
+	      spec2 = FFESTP_readixFORMAT;
+	      goto whine;	/* :::::::::::::::::::: */
+	    }
+	  if (ffestp_file.read.read_spec[FFESTP_readixADVANCE].kw_or_val_present)
+	    {
+	      spec2 = FFESTP_readixADVANCE;
+	      goto whine;	/* :::::::::::::::::::: */
+	    }
+	}
+      if (ffestp_file.read.read_spec[FFESTP_readixADVANCE].kw_or_val_present)
+	{			/* ADVANCE= specified. */
+	  spec1 = FFESTP_readixADVANCE;
+	  if (format == FFESTV_formatNONE)
+	    {
+	      ffebad_start (FFEBAD_MISSING_FORMAT_SPEC);
+	      ffebad_here (0, ffelex_token_where_line
+			   (ffestp_file.read.read_spec[spec1].kw),
+			   ffelex_token_where_column
+			   (ffestp_file.read.read_spec[spec1].kw));
+	      ffebad_finish ();
+
+	      ffestc_ok_ = FALSE;
+	      return;
+	    }
+	  if (format == FFESTV_formatNAMELIST)
+	    {
+	      spec2 = FFESTP_readixFORMAT;
+	      goto whine;	/* :::::::::::::::::::: */
+	    }
+	}
+      if (ffestp_file.read.read_spec[FFESTP_readixEOR].kw_or_val_present)
+	{			/* EOR= specified. */
+	  spec1 = FFESTP_readixEOR;
+	  if (ffestc_subr_speccmp_ ("No",
+			  &ffestp_file.read.read_spec[FFESTP_readixADVANCE],
+				    NULL, NULL) != 0)
+	    {
+	      goto whine_advance;	/* :::::::::::::::::::: */
+	    }
+	}
+      if (ffestp_file.read.read_spec[FFESTP_readixNULLS].kw_or_val_present)
+	{			/* NULLS= specified. */
+	  spec1 = FFESTP_readixNULLS;
+	  if (format != FFESTV_formatASTERISK)
+	    {
+	      spec2 = FFESTP_readixFORMAT;
+	      goto whine;	/* :::::::::::::::::::: */
+	    }
+	}
+      if (ffestp_file.read.read_spec[FFESTP_readixSIZE].kw_or_val_present)
+	{			/* SIZE= specified. */
+	  spec1 = FFESTP_readixSIZE;
+	  if (ffestc_subr_speccmp_ ("No",
+			  &ffestp_file.read.read_spec[FFESTP_readixADVANCE],
+				    NULL, NULL) != 0)
+	    {
+	    whine_advance:	/* :::::::::::::::::::: */
+	      if (ffestp_file.read.read_spec[FFESTP_readixADVANCE]
+		  .kw_or_val_present)
+		{
+		  ffebad_start (FFEBAD_CONFLICTING_SPECS);
+		  ffebad_here (0, ffelex_token_where_line
+			       (ffestp_file.read.read_spec[spec1].kw),
+			       ffelex_token_where_column
+			       (ffestp_file.read.read_spec[spec1].kw));
+		  ffebad_here (1, ffelex_token_where_line
+		      (ffestp_file.read.read_spec[FFESTP_readixADVANCE].kw),
+			       ffelex_token_where_column
+		     (ffestp_file.read.read_spec[FFESTP_readixADVANCE].kw));
+		  ffebad_finish ();
+		}
+	      else
+		{
+		  ffebad_start (FFEBAD_MISSING_ADVANCE_SPEC);
+		  ffebad_here (0, ffelex_token_where_line
+			       (ffestp_file.read.read_spec[spec1].kw),
+			       ffelex_token_where_column
+			       (ffestp_file.read.read_spec[spec1].kw));
+		  ffebad_finish ();
+		}
+
+	      ffestc_ok_ = FALSE;
+	      return;
+	    }
+	}
+    }
+
+  if (unit == FFESTV_unitCHAREXPR)
+    ffestc_iolist_context_ = FFEEXPR_contextIOLISTDF;
+  else
+    ffestc_iolist_context_ = FFEEXPR_contextIOLIST;
+
+  ffestd_R909_start (FALSE, unit, format, rec, key);
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R909_item -- READ statement i/o item
+
+   ffestc_R909_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestc_R909_item (ffebld expr, ffelexToken expr_token)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  if (ffestc_namelist_ != 0)
+    {
+      if (ffestc_namelist_ == 1)
+	{
+	  ffestc_namelist_ = 2;
+	  ffebad_start (FFEBAD_NAMELIST_ITEMS);
+	  ffebad_here (0, ffelex_token_where_line (expr_token),
+		       ffelex_token_where_column (expr_token));
+	  ffebad_finish ();
+	}
+      return;
+    }
+
+  ffestd_R909_item (expr, expr_token);
+}
+
+/* ffestc_R909_finish -- READ statement list complete
+
+   ffestc_R909_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R909_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R909_finish ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R910_start -- WRITE(...) statement list begin
+
+   ffestc_R910_start();
+
+   Verify that WRITE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_R910_start ()
+{
+  ffestvUnit unit;
+  ffestvFormat format;
+  bool rec;
+  ffestpWriteIx spec1;
+  ffestpWriteIx spec2;
+
+  ffestc_check_start_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_branch_begin_ ();
+
+  if (!ffestc_subr_is_branch_
+      (&ffestp_file.write.write_spec[FFESTP_writeixEOR])
+      || !ffestc_subr_is_branch_
+      (&ffestp_file.write.write_spec[FFESTP_writeixERR])
+      || !ffestc_subr_is_format_
+      (&ffestp_file.write.write_spec[FFESTP_writeixFORMAT]))
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+
+  format = ffestc_subr_format_
+    (&ffestp_file.write.write_spec[FFESTP_writeixFORMAT]);
+  ffestc_namelist_ = (format == FFESTV_formatNAMELIST);
+
+  unit = ffestc_subr_unit_
+    (&ffestp_file.write.write_spec[FFESTP_writeixUNIT]);
+  if (unit == FFESTV_unitNONE)
+    {
+      ffebad_start (FFEBAD_NO_UNIT_SPEC);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_finish ();
+      ffestc_ok_ = FALSE;
+      return;
+    }
+
+  rec = ffestp_file.write.write_spec[FFESTP_writeixREC].kw_or_val_present;
+
+  if (rec)
+    {
+      spec1 = FFESTP_writeixREC;
+      if (unit == FFESTV_unitCHAREXPR)
+	{
+	  spec2 = FFESTP_writeixUNIT;
+	whine:			/* :::::::::::::::::::: */
+	  ffebad_start (FFEBAD_CONFLICTING_SPECS);
+	  assert (ffestp_file.write.write_spec[spec1].kw_or_val_present);
+	  if (ffestp_file.write.write_spec[spec1].kw_present)
+	    {
+	      ffebad_here (0, ffelex_token_where_line
+			   (ffestp_file.write.write_spec[spec1].kw),
+			   ffelex_token_where_column
+			   (ffestp_file.write.write_spec[spec1].kw));
+	    }
+	  else
+	    {
+	      ffebad_here (0, ffelex_token_where_line
+			   (ffestp_file.write.write_spec[spec1].value),
+			   ffelex_token_where_column
+			   (ffestp_file.write.write_spec[spec1].value));
+	    }
+	  assert (ffestp_file.write.write_spec[spec2].kw_or_val_present);
+	  if (ffestp_file.write.write_spec[spec2].kw_present)
+	    {
+	      ffebad_here (1, ffelex_token_where_line
+			   (ffestp_file.write.write_spec[spec2].kw),
+			   ffelex_token_where_column
+			   (ffestp_file.write.write_spec[spec2].kw));
+	    }
+	  else
+	    {
+	      ffebad_here (1, ffelex_token_where_line
+			   (ffestp_file.write.write_spec[spec2].value),
+			   ffelex_token_where_column
+			   (ffestp_file.write.write_spec[spec2].value));
+	    }
+	  ffebad_finish ();
+	  ffestc_ok_ = FALSE;
+	  return;
+	}
+      if ((format == FFESTV_formatASTERISK)
+	  || (format == FFESTV_formatNAMELIST))
+	{
+	  spec2 = FFESTP_writeixFORMAT;
+	  goto whine;		/* :::::::::::::::::::: */
+	}
+      if (ffestp_file.write.write_spec[FFESTP_writeixADVANCE].kw_or_val_present)
+	{
+	  spec2 = FFESTP_writeixADVANCE;
+	  goto whine;		/* :::::::::::::::::::: */
+	}
+    }
+  else
+    {				/* Sequential/Indexed/Internal. */
+      if (unit == FFESTV_unitCHAREXPR)
+	{			/* Internal file. */
+	  spec1 = FFESTP_writeixUNIT;
+	  if (format == FFESTV_formatNAMELIST)
+	    {
+	      spec2 = FFESTP_writeixFORMAT;
+	      goto whine;	/* :::::::::::::::::::: */
+	    }
+	  if (ffestp_file.write.write_spec[FFESTP_writeixADVANCE].kw_or_val_present)
+	    {
+	      spec2 = FFESTP_writeixADVANCE;
+	      goto whine;	/* :::::::::::::::::::: */
+	    }
+	}
+      if (ffestp_file.write.write_spec[FFESTP_writeixADVANCE].kw_or_val_present)
+	{			/* ADVANCE= specified. */
+	  spec1 = FFESTP_writeixADVANCE;
+	  if (format == FFESTV_formatNONE)
+	    {
+	      ffebad_start (FFEBAD_MISSING_FORMAT_SPEC);
+	      ffebad_here (0, ffelex_token_where_line
+			   (ffestp_file.write.write_spec[spec1].kw),
+			   ffelex_token_where_column
+			   (ffestp_file.write.write_spec[spec1].kw));
+	      ffebad_finish ();
+
+	      ffestc_ok_ = FALSE;
+	      return;
+	    }
+	  if (format == FFESTV_formatNAMELIST)
+	    {
+	      spec2 = FFESTP_writeixFORMAT;
+	      goto whine;	/* :::::::::::::::::::: */
+	    }
+	}
+      if (ffestp_file.write.write_spec[FFESTP_writeixEOR].kw_or_val_present)
+	{			/* EOR= specified. */
+	  spec1 = FFESTP_writeixEOR;
+	  if (ffestc_subr_speccmp_ ("No",
+		       &ffestp_file.write.write_spec[FFESTP_writeixADVANCE],
+				    NULL, NULL) != 0)
+	    {
+	      if (ffestp_file.write.write_spec[FFESTP_writeixADVANCE]
+		  .kw_or_val_present)
+		{
+		  ffebad_start (FFEBAD_CONFLICTING_SPECS);
+		  ffebad_here (0, ffelex_token_where_line
+			       (ffestp_file.write.write_spec[spec1].kw),
+			       ffelex_token_where_column
+			       (ffestp_file.write.write_spec[spec1].kw));
+		  ffebad_here (1, ffelex_token_where_line
+		   (ffestp_file.write.write_spec[FFESTP_writeixADVANCE].kw),
+			       ffelex_token_where_column
+		  (ffestp_file.write.write_spec[FFESTP_writeixADVANCE].kw));
+		  ffebad_finish ();
+		}
+	      else
+		{
+		  ffebad_start (FFEBAD_MISSING_ADVANCE_SPEC);
+		  ffebad_here (0, ffelex_token_where_line
+			       (ffestp_file.write.write_spec[spec1].kw),
+			       ffelex_token_where_column
+			       (ffestp_file.write.write_spec[spec1].kw));
+		  ffebad_finish ();
+		}
+
+	      ffestc_ok_ = FALSE;
+	      return;
+	    }
+	}
+    }
+
+  if (unit == FFESTV_unitCHAREXPR)
+    ffestc_iolist_context_ = FFEEXPR_contextIOLISTDF;
+  else
+    ffestc_iolist_context_ = FFEEXPR_contextIOLIST;
+
+  ffestd_R910_start (unit, format, rec);
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R910_item -- WRITE statement i/o item
+
+   ffestc_R910_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestc_R910_item (ffebld expr, ffelexToken expr_token)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  if (ffestc_namelist_ != 0)
+    {
+      if (ffestc_namelist_ == 1)
+	{
+	  ffestc_namelist_ = 2;
+	  ffebad_start (FFEBAD_NAMELIST_ITEMS);
+	  ffebad_here (0, ffelex_token_where_line (expr_token),
+		       ffelex_token_where_column (expr_token));
+	  ffebad_finish ();
+	}
+      return;
+    }
+
+  ffestd_R910_item (expr, expr_token);
+}
+
+/* ffestc_R910_finish -- WRITE statement list complete
+
+   ffestc_R910_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R910_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R910_finish ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R911_start -- PRINT(...) statement list begin
+
+   ffestc_R911_start();
+
+   Verify that PRINT is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_R911_start ()
+{
+  ffestvFormat format;
+
+  ffestc_check_start_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_branch_begin_ ();
+
+  if (!ffestc_subr_is_format_
+      (&ffestp_file.print.print_spec[FFESTP_printixFORMAT]))
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+
+  format = ffestc_subr_format_
+    (&ffestp_file.print.print_spec[FFESTP_printixFORMAT]);
+  ffestc_namelist_ = (format == FFESTV_formatNAMELIST);
+
+  ffestd_R911_start (format);
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R911_item -- PRINT statement i/o item
+
+   ffestc_R911_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestc_R911_item (ffebld expr, ffelexToken expr_token)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  if (ffestc_namelist_ != 0)
+    {
+      if (ffestc_namelist_ == 1)
+	{
+	  ffestc_namelist_ = 2;
+	  ffebad_start (FFEBAD_NAMELIST_ITEMS);
+	  ffebad_here (0, ffelex_token_where_line (expr_token),
+		       ffelex_token_where_column (expr_token));
+	  ffebad_finish ();
+	}
+      return;
+    }
+
+  ffestd_R911_item (expr, expr_token);
+}
+
+/* ffestc_R911_finish -- PRINT statement list complete
+
+   ffestc_R911_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R911_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R911_finish ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R919 -- BACKSPACE statement
+
+   ffestc_R919();
+
+   Make sure a BACKSPACE is valid in the current context, and implement it.  */
+
+void
+ffestc_R919 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  if (ffestc_subr_is_branch_
+      (&ffestp_file.beru.beru_spec[FFESTP_beruixERR])
+      && ffestc_subr_is_present_ ("UNIT",
+			    &ffestp_file.beru.beru_spec[FFESTP_beruixUNIT]))
+    ffestd_R919 ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R920 -- ENDFILE statement
+
+   ffestc_R920();
+
+   Make sure a ENDFILE is valid in the current context, and implement it.  */
+
+void
+ffestc_R920 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  if (ffestc_subr_is_branch_
+      (&ffestp_file.beru.beru_spec[FFESTP_beruixERR])
+      && ffestc_subr_is_present_ ("UNIT",
+			    &ffestp_file.beru.beru_spec[FFESTP_beruixUNIT]))
+    ffestd_R920 ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R921 -- REWIND statement
+
+   ffestc_R921();
+
+   Make sure a REWIND is valid in the current context, and implement it.  */
+
+void
+ffestc_R921 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  if (ffestc_subr_is_branch_
+      (&ffestp_file.beru.beru_spec[FFESTP_beruixERR])
+      && ffestc_subr_is_present_ ("UNIT",
+			    &ffestp_file.beru.beru_spec[FFESTP_beruixUNIT]))
+    ffestd_R921 ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R923A -- INQUIRE statement (non-IOLENGTH version)
+
+   ffestc_R923A();
+
+   Make sure an INQUIRE is valid in the current context, and implement it.  */
+
+void
+ffestc_R923A ()
+{
+  bool by_file;
+  bool by_unit;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  if (ffestc_subr_is_branch_
+      (&ffestp_file.inquire.inquire_spec[FFESTP_inquireixERR]))
+    {
+      by_file = ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE]
+	.kw_or_val_present;
+      by_unit = ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT]
+	.kw_or_val_present;
+      if (by_file && by_unit)
+	{
+	  ffebad_start (FFEBAD_CONFLICTING_SPECS);
+	  assert (ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_or_val_present);
+	  if (ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_present)
+	    {
+	      ffebad_here (0, ffelex_token_where_line
+		(ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw),
+			   ffelex_token_where_column
+	       (ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw));
+	    }
+	  else
+	    {
+	      ffebad_here (0, ffelex_token_where_line
+	      (ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value),
+			   ffelex_token_where_column
+			   (ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value));
+	    }
+	  assert (ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE].kw_or_val_present);
+	  if (ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE].kw_present)
+	    {
+	      ffebad_here (1, ffelex_token_where_line
+		(ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE].kw),
+			   ffelex_token_where_column
+	       (ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE].kw));
+	    }
+	  else
+	    {
+	      ffebad_here (1, ffelex_token_where_line
+	      (ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE].value),
+			   ffelex_token_where_column
+			   (ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE].value));
+	    }
+	  ffebad_finish ();
+	}
+      else if (!by_file && !by_unit)
+	{
+	  ffebad_start (FFEBAD_MISSING_SPECIFIER);
+	  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		       ffelex_token_where_column (ffesta_tokens[0]));
+	  ffebad_string ("UNIT= or FILE=");
+	  ffebad_finish ();
+	}
+      else
+	ffestd_R923A (by_file);
+    }
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R923B_start -- INQUIRE(IOLENGTH=expr) statement list begin
+
+   ffestc_R923B_start();
+
+   Verify that INQUIRE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_R923B_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_branch_begin_ ();
+
+  ffestd_R923B_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R923B_item -- INQUIRE statement i/o item
+
+   ffestc_R923B_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestc_R923B_item (ffebld expr, ffelexToken expr_token UNUSED)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R923B_item (expr);
+}
+
+/* ffestc_R923B_finish -- INQUIRE statement list complete
+
+   ffestc_R923B_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R923B_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R923B_finish ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R1001 -- FORMAT statement
+
+   ffestc_R1001(format_list);
+
+   Make sure format_list is valid.  Update label's info to indicate it is a
+   FORMAT label, and (perhaps) warn if there is no label!  */
+
+void
+ffestc_R1001 (ffesttFormatList f)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_format_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_format_ ();
+
+  ffestd_R1001 (f);
+}
+
+/* ffestc_R1102 -- PROGRAM statement
+
+   ffestc_R1102(name_token);
+
+   Make sure ffestc_kind_ identifies an empty block.  Make sure name_token
+   gives a valid name.	Implement the beginning of a main program.  */
+
+void
+ffestc_R1102 (ffelexToken name)
+{
+  ffestw b;
+  ffesymbol s;
+
+  assert (name != NULL);
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_unit_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  ffestc_blocknum_ = 0;
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_statePROGRAM0);
+  ffestw_set_blocknum (b, ffestc_blocknum_++);
+  ffestw_set_shriek (b, ffestc_shriek_end_program_);
+
+  ffestw_set_name (b, ffelex_token_use (name));
+
+  s = ffesymbol_declare_programunit (name,
+				 ffelex_token_where_line (ffesta_tokens[0]),
+			      ffelex_token_where_column (ffesta_tokens[0]));
+
+  if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+    {
+      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+      ffesymbol_set_info (s,
+			  ffeinfo_new (FFEINFO_basictypeNONE,
+				       FFEINFO_kindtypeNONE,
+				       0,
+				       FFEINFO_kindPROGRAM,
+				       FFEINFO_whereLOCAL,
+				       FFETARGET_charactersizeNONE));
+      ffesymbol_signal_unreported (s);
+    }
+  else
+    ffesymbol_error (s, name);
+
+  ffestd_R1102 (s, name);
+}
+
+/* ffestc_R1103 -- END PROGRAM statement
+
+   ffestc_R1103(name_token);
+
+   Make sure ffestc_kind_ identifies the current kind of program unit.	If not
+   NULL, make sure name_token gives the correct name.  Implement the end
+   of the current program unit.	 */
+
+void
+ffestc_R1103 (ffelexToken name)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_program_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_ ();
+
+  if (name != NULL)
+    {
+      if (ffestw_name (ffestw_stack_top ()) == NULL)
+	{
+	  ffebad_start (FFEBAD_PROGRAM_NOT_NAMED);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_finish ();
+	}
+      else if (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0)
+	{
+	  ffebad_start (FFEBAD_UNIT_WRONG_NAME);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+	     ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+	  ffebad_finish ();
+	}
+    }
+
+  ffestc_shriek_end_program_ (TRUE);
+}
+
+/* ffestc_R1105 -- MODULE statement
+
+   ffestc_R1105(name_token);
+
+   Make sure ffestc_kind_ identifies an empty block.  Make sure name_token
+   gives a valid name.	Implement the beginning of a module.  */
+
+#if FFESTR_F90
+void
+ffestc_R1105 (ffelexToken name)
+{
+  ffestw b;
+
+  assert (name != NULL);
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_unit_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  ffestc_blocknum_ = 0;
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_stateMODULE0);
+  ffestw_set_blocknum (b, ffestc_blocknum_++);
+  ffestw_set_shriek (b, ffestc_shriek_module_);
+  ffestw_set_name (b, ffelex_token_use (name));
+
+  ffestd_R1105 (name);
+}
+
+/* ffestc_R1106 -- END MODULE statement
+
+   ffestc_R1106(name_token);
+
+   Make sure ffestc_kind_ identifies the current kind of program unit.	If not
+   NULL, make sure name_token gives the correct name.  Implement the end
+   of the current program unit.	 */
+
+void
+ffestc_R1106 (ffelexToken name)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_module_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if ((name != NULL)
+      && (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0))
+    {
+      ffebad_start (FFEBAD_UNIT_WRONG_NAME);
+      ffebad_here (0, ffelex_token_where_line (name),
+		   ffelex_token_where_column (name));
+      ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+	     ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+      ffebad_finish ();
+    }
+
+  ffestc_shriek_module_ (TRUE);
+}
+
+/* ffestc_R1107_start -- USE statement list begin
+
+   ffestc_R1107_start();
+
+   Verify that USE is valid here, and begin accepting items in the list.  */
+
+void
+ffestc_R1107_start (ffelexToken name, bool only)
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_use_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R1107_start (name, only);
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R1107_item -- USE statement for name
+
+   ffestc_R1107_item(local_token,use_token);
+
+   Make sure name_token identifies a valid object to be USEed.	local_token
+   may be NULL if _start_ was called with only==TRUE.  */
+
+void
+ffestc_R1107_item (ffelexToken local, ffelexToken use)
+{
+  ffestc_check_item_ ();
+  assert (use != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R1107_item (local, use);
+}
+
+/* ffestc_R1107_finish -- USE statement list complete
+
+   ffestc_R1107_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R1107_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R1107_finish ();
+}
+
+#endif
+/* ffestc_R1111 -- BLOCK DATA statement
+
+   ffestc_R1111(name_token);
+
+   Make sure ffestc_kind_ identifies no current program unit.  If not
+   NULL, make sure name_token gives a valid name.  Implement the beginning
+   of a block data program unit.  */
+
+void
+ffestc_R1111 (ffelexToken name)
+{
+  ffestw b;
+  ffesymbol s;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_unit_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  ffestc_blocknum_ = 0;
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_stateBLOCKDATA0);
+  ffestw_set_blocknum (b, ffestc_blocknum_++);
+  ffestw_set_shriek (b, ffestc_shriek_blockdata_);
+
+  if (name == NULL)
+    ffestw_set_name (b, NULL);
+  else
+    ffestw_set_name (b, ffelex_token_use (name));
+
+  s = ffesymbol_declare_blockdataunit (name,
+				 ffelex_token_where_line (ffesta_tokens[0]),
+			      ffelex_token_where_column (ffesta_tokens[0]));
+
+  if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+    {
+      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+      ffesymbol_set_info (s,
+			  ffeinfo_new (FFEINFO_basictypeNONE,
+				       FFEINFO_kindtypeNONE,
+				       0,
+				       FFEINFO_kindBLOCKDATA,
+				       FFEINFO_whereLOCAL,
+				       FFETARGET_charactersizeNONE));
+      ffesymbol_signal_unreported (s);
+    }
+  else
+    ffesymbol_error (s, name);
+
+  ffestd_R1111 (s, name);
+}
+
+/* ffestc_R1112 -- END BLOCK DATA statement
+
+   ffestc_R1112(name_token);
+
+   Make sure ffestc_kind_ identifies the current kind of program unit.	If not
+   NULL, make sure name_token gives the correct name.  Implement the end
+   of the current program unit.	 */
+
+void
+ffestc_R1112 (ffelexToken name)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_blockdata_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (name != NULL)
+    {
+      if (ffestw_name (ffestw_stack_top ()) == NULL)
+	{
+	  ffebad_start (FFEBAD_BLOCKDATA_NOT_NAMED);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+	  ffebad_finish ();
+	}
+      else if (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0)
+	{
+	  ffebad_start (FFEBAD_UNIT_WRONG_NAME);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+	     ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+	  ffebad_finish ();
+	}
+    }
+
+  ffestc_shriek_blockdata_ (TRUE);
+}
+
+/* ffestc_R1202 -- INTERFACE statement
+
+   ffestc_R1202(operator,defined_name);
+
+   Make sure ffestc_kind_ identifies an INTERFACE block.
+   Implement the end of the current interface.
+
+   15-May-90  JCB  1.1
+      Allow no operator or name to mean INTERFACE by itself; missed this
+      valid form when originally doing syntactic analysis code.	 */
+
+#if FFESTR_F90
+void
+ffestc_R1202 (ffestpDefinedOperator operator, ffelexToken name)
+{
+  ffestw b;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_interfacespec_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_stateINTERFACE0);
+  ffestw_set_blocknum (b, 0);
+  ffestw_set_shriek (b, ffestc_shriek_interface_);
+
+  if ((operator == FFESTP_definedoperatorNone) && (name == NULL))
+    ffestw_set_substate (b, 0);	/* No generic-spec, so disallow MODULE
+				   PROCEDURE. */
+  else
+    ffestw_set_substate (b, 1);	/* MODULE PROCEDURE ok. */
+
+  ffestd_R1202 (operator, name);
+
+  ffe_init_4 ();
+}
+
+/* ffestc_R1203 -- END INTERFACE statement
+
+   ffestc_R1203();
+
+   Make sure ffestc_kind_ identifies an INTERFACE block.
+   Implement the end of the current interface.	*/
+
+void
+ffestc_R1203 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_interface_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  ffestc_shriek_interface_ (TRUE);
+
+  ffe_terminate_4 ();
+}
+
+/* ffestc_R1205_start -- MODULE PROCEDURE statement list begin
+
+   ffestc_R1205_start();
+
+   Verify that MODULE PROCEDURE is valid here, and begin accepting items in
+   the list.  */
+
+void
+ffestc_R1205_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_interface_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  if (ffestw_substate (ffestw_stack_top ()) == 0)
+    {
+      ffebad_start (FFEBAD_INVALID_MODULE_PROCEDURE);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+      ffestc_ok_ = FALSE;
+      return;
+    }
+
+  if (ffestw_state (ffestw_stack_top ()) == FFESTV_stateINTERFACE0)
+    {
+      ffestw_update (NULL);	/* Update state line/col info. */
+      ffestw_set_state (ffestw_stack_top (), FFESTV_stateINTERFACE1);
+    }
+
+  ffestd_R1205_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R1205_item -- MODULE PROCEDURE statement for name
+
+   ffestc_R1205_item(name_token);
+
+   Make sure name_token identifies a valid object to be MODULE PROCEDUREed.  */
+
+void
+ffestc_R1205_item (ffelexToken name)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R1205_item (name);
+}
+
+/* ffestc_R1205_finish -- MODULE PROCEDURE statement list complete
+
+   ffestc_R1205_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R1205_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R1205_finish ();
+}
+
+#endif
+/* ffestc_R1207_start -- EXTERNAL statement list begin
+
+   ffestc_R1207_start();
+
+   Verify that EXTERNAL is valid here, and begin accepting items in the list.  */
+
+void
+ffestc_R1207_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_progspec_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R1207_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R1207_item -- EXTERNAL statement for name
+
+   ffestc_R1207_item(name_token);
+
+   Make sure name_token identifies a valid object to be EXTERNALd.  */
+
+void
+ffestc_R1207_item (ffelexToken name)
+{
+  ffesymbol s;
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  s = ffesymbol_declare_local (name, FALSE);
+  sa = ffesymbol_attrs (s);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (!ffesymbol_is_specable (s))
+    na = FFESYMBOL_attrsetNONE;	/* Can't dcl sym ref'd in sfuncdef. */
+  else if (sa & FFESYMBOL_attrsANY)
+    na = FFESYMBOL_attrsANY;
+  else if (!(sa & ~(FFESYMBOL_attrsDUMMY
+		    | FFESYMBOL_attrsTYPE)))
+    na = sa | FFESYMBOL_attrsEXTERNAL;
+  else
+    na = FFESYMBOL_attrsetNONE;
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (na == FFESYMBOL_attrsetNONE)
+    ffesymbol_error (s, name);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_set_attrs (s, na);
+      ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+      ffesymbol_set_explicitwhere (s, TRUE);
+      ffesymbol_signal_unreported (s);
+    }
+
+  ffestd_R1207_item (name);
+}
+
+/* ffestc_R1207_finish -- EXTERNAL statement list complete
+
+   ffestc_R1207_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R1207_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R1207_finish ();
+}
+
+/* ffestc_R1208_start -- INTRINSIC statement list begin
+
+   ffestc_R1208_start();
+
+   Verify that INTRINSIC is valid here, and begin accepting items in the list.	*/
+
+void
+ffestc_R1208_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_progspec_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R1208_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R1208_item -- INTRINSIC statement for name
+
+   ffestc_R1208_item(name_token);
+
+   Make sure name_token identifies a valid object to be INTRINSICd.  */
+
+void
+ffestc_R1208_item (ffelexToken name)
+{
+  ffesymbol s;
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffeintrinGen gen;
+  ffeintrinSpec spec;
+  ffeintrinImp imp;
+  ffeinfoKind kind;
+
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  s = ffesymbol_declare_local (name, TRUE);
+  sa = ffesymbol_attrs (s);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (!ffesymbol_is_specable (s))
+    na = FFESYMBOL_attrsetNONE;	/* Can't dcl sym ref'd in sfuncdef. */
+  else if (sa & FFESYMBOL_attrsANY)
+    na = sa;
+  else if (!(sa & ~FFESYMBOL_attrsTYPE))
+    {
+      if (ffeintrin_is_intrinsic (ffelex_token_text (name), name, TRUE,
+				  &gen, &spec, &imp, &kind)
+	  && ((imp == FFEINTRIN_impNONE)
+#if 0	/* Don't bother with this for now. */
+	      || ((ffeintrin_basictype (spec)
+		   == ffesymbol_basictype (s))
+		  && (ffeintrin_kindtype (spec)
+		      == ffesymbol_kindtype (s)))
+#else
+	      || 1
+#endif
+	      || !(sa & FFESYMBOL_attrsTYPE)))
+	na = sa | FFESYMBOL_attrsINTRINSIC;
+      else if (kind == FFEINFO_kindANY)
+	{			/* Already diagnosed. */
+	  na = sa | FFESYMBOL_attrsINTRINSIC | FFESYMBOL_attrsANY;
+	  ffesymbol_set_attrs (s, na);
+	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+	  ffesymbol_set_info (s, ffeinfo_new_any ());
+	}
+      else
+	na = FFESYMBOL_attrsetNONE;
+    }
+  else
+    na = FFESYMBOL_attrsetNONE;
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (na == FFESYMBOL_attrsetNONE)
+    ffesymbol_error (s, name);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_set_attrs (s, na);
+      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+      ffesymbol_set_generic (s, gen);
+      ffesymbol_set_specific (s, spec);
+      ffesymbol_set_implementation (s, imp);
+      ffesymbol_set_info (s,
+			  ffeinfo_new (FFEINFO_basictypeNONE,
+				       FFEINFO_kindtypeNONE,
+				       0,
+				       kind,
+				       FFEINFO_whereINTRINSIC,
+				       FFETARGET_charactersizeNONE));
+      ffesymbol_set_explicitwhere (s, TRUE);
+    }
+
+  ffesymbol_signal_unreported (s);
+
+  ffestd_R1208_item (name);
+}
+
+/* ffestc_R1208_finish -- INTRINSIC statement list complete
+
+   ffestc_R1208_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_R1208_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_R1208_finish ();
+}
+
+/* ffestc_R1212 -- CALL statement
+
+   ffestc_R1212(expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffestc_R1212 (ffebld expr, ffelexToken expr_token UNUSED)
+{
+  ffebld item;			/* ITEM. */
+  ffebld labexpr;		/* LABTOK=>LABTER. */
+  ffelab label;
+  bool ok;			/* TRUE if all LABTOKs were ok. */
+  bool ok1;			/* TRUE if a particular LABTOK is ok. */
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  if (ffebld_op (expr) != FFEBLD_opSUBRREF)
+    ffestd_R841 (FALSE);	/* CONTINUE. */
+  else
+    {
+      ok = TRUE;
+
+      for (item = ffebld_right (expr);
+	   item != NULL;
+	   item = ffebld_trail (item))
+	{
+	  if (((labexpr = ffebld_head (item)) != NULL)
+	      && (ffebld_op (labexpr) == FFEBLD_opLABTOK))
+	    {
+	      ok1 = ffestc_labelref_is_branch_ (ffebld_labtok (labexpr),
+						&label);
+	      ffelex_token_kill (ffebld_labtok (labexpr));
+	      if (!ok1)
+		{
+		  label = NULL;
+		  ok = FALSE;
+		}
+	      ffebld_set_op (labexpr, FFEBLD_opLABTER);
+	      ffebld_set_labter (labexpr, label);
+	    }
+	}
+
+      if (ok)
+	ffestd_R1212 (expr);
+    }
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R1213 -- Defined assignment statement
+
+   ffestc_R1213(dest_expr,source_expr,source_token);
+
+   Make sure the assignment is valid.  */
+
+#if FFESTR_F90
+void
+ffestc_R1213 (ffebld dest, ffebld source, ffelexToken source_token)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  ffestd_R1213 (dest, source);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+#endif
+/* ffestc_R1219 -- FUNCTION statement
+
+   ffestc_R1219(funcname,arglist,ending_token,kind,kindt,len,lent,
+	 recursive);
+
+   Make sure statement is valid here, register arguments for the
+   function name, and so on.
+
+   06-Apr-90  JCB  2.0
+      Added the kind, len, and recursive arguments.  */
+
+void
+ffestc_R1219 (ffelexToken funcname, ffesttTokenList args,
+	      ffelexToken final UNUSED, ffestpType type, ffebld kind,
+	      ffelexToken kindt, ffebld len, ffelexToken lent,
+	      ffelexToken recursive, ffelexToken result)
+{
+  ffestw b;
+  ffesymbol s;
+  ffesymbol fs;			/* FUNCTION symbol when dealing with RESULT
+				   symbol. */
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffelexToken res;
+  bool separate_result;
+
+  assert ((funcname != NULL)
+	  && (ffelex_token_type (funcname) == FFELEX_typeNAME));
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_iface_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  ffestc_blocknum_ = 0;
+  ffesta_is_entry_valid =
+    (ffestw_state (ffestw_stack_top ()) == FFESTV_stateNIL);
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_stateFUNCTION0);
+  ffestw_set_blocknum (b, ffestc_blocknum_++);
+  ffestw_set_shriek (b, ffestc_shriek_function_);
+  ffestw_set_name (b, ffelex_token_use (funcname));
+
+  if (type == FFESTP_typeNone)
+    {
+      ffestc_local_.decl.basic_type = FFEINFO_basictypeNONE;
+      ffestc_local_.decl.kind_type = FFEINFO_kindtypeNONE;
+      ffestc_local_.decl.size = FFETARGET_charactersizeNONE;
+    }
+  else
+    {
+      ffestc_establish_declstmt_ (type, ffesta_tokens[0],
+				  kind, kindt, len, lent);
+      ffestc_establish_declinfo_ (NULL, NULL, NULL, NULL);
+    }
+
+  separate_result = (result != NULL)
+    && (ffelex_token_strcmp (funcname, result) != 0);
+
+  if (separate_result)
+    fs = ffesymbol_declare_funcnotresunit (funcname);	/* Global/local. */
+  else
+    fs = ffesymbol_declare_funcunit (funcname);	/* Global only. */
+
+  if (ffesymbol_state (fs) == FFESYMBOL_stateNONE)
+    {
+      ffesymbol_set_state (fs, FFESYMBOL_stateUNDERSTOOD);
+      ffesymbol_signal_unreported (fs);
+
+      /* Note that .basic_type and .kind_type might be NONE here. */
+
+      ffesymbol_set_info (fs,
+			  ffeinfo_new (ffestc_local_.decl.basic_type,
+				       ffestc_local_.decl.kind_type,
+				       0,
+				       FFEINFO_kindFUNCTION,
+				       FFEINFO_whereLOCAL,
+				       ffestc_local_.decl.size));
+      ffestc_parent_ok_ = TRUE;
+    }
+  else
+    {
+      if (ffesymbol_kind (fs) != FFEINFO_kindANY)
+	ffesymbol_error (fs, funcname);
+      ffestc_parent_ok_ = FALSE;
+    }
+
+  if (ffestc_parent_ok_)
+    {
+      ffebld_init_list (&fs->dummy_args, &ffestc_local_.dummy.list_bottom);
+      ffestt_tokenlist_drive (args, ffestc_promote_dummy_);
+      ffebld_end_list (&ffestc_local_.dummy.list_bottom);
+    }
+
+  if (result == NULL)
+    res = funcname;
+  else
+    res = result;
+
+  s = ffesymbol_declare_funcresult (res);
+  sa = ffesymbol_attrs (s);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (sa & FFESYMBOL_attrsANY)
+    na = FFESYMBOL_attrsANY;
+  else if (ffesymbol_state (s) != FFESYMBOL_stateNONE)
+    na = FFESYMBOL_attrsetNONE;
+  else
+    {
+      na = FFESYMBOL_attrsRESULT;
+      if (ffestc_local_.decl.basic_type != FFEINFO_basictypeNONE)
+	{
+	  na |= FFESYMBOL_attrsTYPE;
+	  if ((ffestc_local_.decl.basic_type == FFEINFO_basictypeCHARACTER)
+	      && (ffestc_local_.decl.size == FFETARGET_charactersizeNONE))
+	    na |= FFESYMBOL_attrsANYLEN;
+	}
+    }
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if ((na & ~FFESYMBOL_attrsANY) == FFESYMBOL_attrsetNONE)
+    {
+      if (!(na & FFESYMBOL_attrsANY))
+	ffesymbol_error (s, res);
+      ffesymbol_set_funcresult (fs, NULL);
+      ffesymbol_set_funcresult (s, NULL);
+      ffestc_parent_ok_ = FALSE;
+    }
+  else
+    {
+      ffesymbol_set_attrs (s, na);
+      ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+      ffesymbol_set_funcresult (fs, s);
+      ffesymbol_set_funcresult (s, fs);
+      if (ffestc_local_.decl.basic_type != FFEINFO_basictypeNONE)
+	{
+	  ffesymbol_set_info (s,
+			      ffeinfo_new (ffestc_local_.decl.basic_type,
+					   ffestc_local_.decl.kind_type,
+					   0,
+					   FFEINFO_kindNONE,
+					   FFEINFO_whereNONE,
+					   ffestc_local_.decl.size));
+	}
+    }
+
+  ffesymbol_signal_unreported (fs);
+
+  ffestd_R1219 (fs, funcname, args, type, kind, kindt, len, lent,
+		(recursive != NULL), result, separate_result);
+}
+
+/* ffestc_R1221 -- END FUNCTION statement
+
+   ffestc_R1221(name_token);
+
+   Make sure ffestc_kind_ identifies the current kind of program unit.	If
+   not NULL, make sure name_token gives the correct name.  Implement the end
+   of the current program unit.	 */
+
+void
+ffestc_R1221 (ffelexToken name)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_function_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_ ();
+
+  if ((name != NULL)
+    && (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0))
+    {
+      ffebad_start (FFEBAD_UNIT_WRONG_NAME);
+      ffebad_here (0, ffelex_token_where_line (name),
+		   ffelex_token_where_column (name));
+      ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+	     ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+      ffebad_finish ();
+    }
+
+  ffestc_shriek_function_ (TRUE);
+}
+
+/* ffestc_R1223 -- SUBROUTINE statement
+
+   ffestc_R1223(subrname,arglist,ending_token,recursive_token);
+
+   Make sure statement is valid here, register arguments for the
+   subroutine name, and so on.
+
+   06-Apr-90  JCB  2.0
+      Added the recursive argument.  */
+
+void
+ffestc_R1223 (ffelexToken subrname, ffesttTokenList args,
+	      ffelexToken final, ffelexToken recursive)
+{
+  ffestw b;
+  ffesymbol s;
+
+  assert ((subrname != NULL)
+	  && (ffelex_token_type (subrname) == FFELEX_typeNAME));
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_iface_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  ffestc_blocknum_ = 0;
+  ffesta_is_entry_valid
+    = (ffestw_state (ffestw_stack_top ()) == FFESTV_stateNIL);
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_stateSUBROUTINE0);
+  ffestw_set_blocknum (b, ffestc_blocknum_++);
+  ffestw_set_shriek (b, ffestc_shriek_subroutine_);
+  ffestw_set_name (b, ffelex_token_use (subrname));
+
+  s = ffesymbol_declare_subrunit (subrname);
+  if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+    {
+      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+      ffesymbol_set_info (s,
+			  ffeinfo_new (FFEINFO_basictypeNONE,
+				       FFEINFO_kindtypeNONE,
+				       0,
+				       FFEINFO_kindSUBROUTINE,
+				       FFEINFO_whereLOCAL,
+				       FFETARGET_charactersizeNONE));
+      ffestc_parent_ok_ = TRUE;
+    }
+  else
+    {
+      if (ffesymbol_kind (s) != FFEINFO_kindANY)
+	ffesymbol_error (s, subrname);
+      ffestc_parent_ok_ = FALSE;
+    }
+
+  if (ffestc_parent_ok_)
+    {
+      ffebld_init_list (&s->dummy_args, &ffestc_local_.dummy.list_bottom);
+      ffestt_tokenlist_drive (args, ffestc_promote_dummy_);
+      ffebld_end_list (&ffestc_local_.dummy.list_bottom);
+    }
+
+  ffesymbol_signal_unreported (s);
+
+  ffestd_R1223 (s, subrname, args, final, (recursive != NULL));
+}
+
+/* ffestc_R1225 -- END SUBROUTINE statement
+
+   ffestc_R1225(name_token);
+
+   Make sure ffestc_kind_ identifies the current kind of program unit.	If
+   not NULL, make sure name_token gives the correct name.  Implement the end
+   of the current program unit.	 */
+
+void
+ffestc_R1225 (ffelexToken name)
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_subroutine_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_ ();
+
+  if ((name != NULL)
+    && (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0))
+    {
+      ffebad_start (FFEBAD_UNIT_WRONG_NAME);
+      ffebad_here (0, ffelex_token_where_line (name),
+		   ffelex_token_where_column (name));
+      ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+	     ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+      ffebad_finish ();
+    }
+
+  ffestc_shriek_subroutine_ (TRUE);
+}
+
+/* ffestc_R1226 -- ENTRY statement
+
+   ffestc_R1226(entryname,arglist,ending_token);
+
+   Make sure we're in a SUBROUTINE or FUNCTION, register arguments for the
+   entry point name, and so on.	 */
+
+void
+ffestc_R1226 (ffelexToken entryname, ffesttTokenList args,
+	      ffelexToken final UNUSED)
+{
+  ffesymbol s;
+  ffesymbol fs;
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  bool in_spec;			/* TRUE if further specification statements
+				   may follow, FALSE if executable stmts. */
+  bool in_func;			/* TRUE if ENTRY is a FUNCTION, not
+				   SUBROUTINE. */
+
+  assert ((entryname != NULL)
+	  && (ffelex_token_type (entryname) == FFELEX_typeNAME));
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_entry_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateFUNCTION2:
+    case FFESTV_stateFUNCTION3:
+      in_func = TRUE;
+      in_spec = TRUE;
+      break;
+
+    case FFESTV_stateFUNCTION4:
+      in_func = TRUE;
+      in_spec = FALSE;
+      break;
+
+    case FFESTV_stateSUBROUTINE2:
+    case FFESTV_stateSUBROUTINE3:
+      in_func = FALSE;
+      in_spec = TRUE;
+      break;
+
+    case FFESTV_stateSUBROUTINE4:
+      in_func = FALSE;
+      in_spec = FALSE;
+      break;
+
+    default:
+      assert ("ENTRY not in FUNCTION or SUBROUTINE?" == NULL);
+      in_func = FALSE;
+      in_spec = FALSE;
+      break;
+    }
+
+  if (in_func)
+    fs = ffesymbol_declare_funcunit (entryname);
+  else
+    fs = ffesymbol_declare_subrunit (entryname);
+
+  if (ffesymbol_state (fs) == FFESYMBOL_stateNONE)
+    ffesymbol_set_state (fs, FFESYMBOL_stateUNDERSTOOD);
+  else
+    {
+      if (ffesymbol_kind (fs) != FFEINFO_kindANY)
+	ffesymbol_error (fs, entryname);
+    }
+
+  ++ffestc_entry_num_;
+
+  ffebld_init_list (&fs->dummy_args, &ffestc_local_.dummy.list_bottom);
+  if (in_spec)
+    ffestt_tokenlist_drive (args, ffestc_promote_dummy_);
+  else
+    ffestt_tokenlist_drive (args, ffestc_promote_execdummy_);
+  ffebld_end_list (&ffestc_local_.dummy.list_bottom);
+
+  if (in_func)
+    {
+      s = ffesymbol_declare_funcresult (entryname);
+      ffesymbol_set_funcresult (fs, s);
+      ffesymbol_set_funcresult (s, fs);
+      sa = ffesymbol_attrs (s);
+
+      /* Figure out what kind of object we've got based on previous
+	 declarations of or references to the object. */
+
+      if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+	na = FFESYMBOL_attrsetNONE;
+      else if (sa & FFESYMBOL_attrsANY)
+	na = FFESYMBOL_attrsANY;
+      else if (!(sa & ~(FFESYMBOL_attrsANYLEN
+			| FFESYMBOL_attrsTYPE)))
+	na = sa | FFESYMBOL_attrsRESULT;
+      else
+	na = FFESYMBOL_attrsetNONE;
+
+      /* Now see what we've got for a new object: NONE means a new error
+	 cropped up; ANY means an old error to be ignored; otherwise,
+	 everything's ok, update the object (symbol) and continue on. */
+
+      if (na == FFESYMBOL_attrsetNONE)
+	{
+	  ffesymbol_error (s, entryname);
+	  ffestc_parent_ok_ = FALSE;
+	}
+      else if (na & FFESYMBOL_attrsANY)
+	{
+	  ffestc_parent_ok_ = FALSE;
+	}
+      else
+	{
+	  ffesymbol_set_attrs (s, na);
+	  if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+	    ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+	  else if (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN)
+	    {
+	      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+	      ffesymbol_set_info (s,
+				  ffeinfo_new (ffesymbol_basictype (s),
+					       ffesymbol_kindtype (s),
+					       0,
+					       FFEINFO_kindENTITY,
+					       FFEINFO_whereRESULT,
+					       ffesymbol_size (s)));
+	      ffesymbol_resolve_intrin (s);
+	      ffestorag_exec_layout (s);
+	    }
+	}
+
+      /* Since ENTRY might appear after executable stmts, do what would have
+	 been done if it hadn't -- give symbol implicit type and
+	 exec-transition it.  */
+
+      if (!in_spec && ffesymbol_is_specable (s))
+	{
+	  if (!ffeimplic_establish_symbol (s))	/* Do implicit typing. */
+	    ffesymbol_error (s, entryname);
+	  s = ffecom_sym_exec_transition (s);
+	}
+
+      /* Use whatever type info is available for ENTRY to set up type for its
+	 global-name-space function symbol relative.  */
+
+      ffesymbol_set_info (fs,
+			  ffeinfo_new (ffesymbol_basictype (s),
+				       ffesymbol_kindtype (s),
+				       0,
+				       FFEINFO_kindFUNCTION,
+				       FFEINFO_whereLOCAL,
+				       ffesymbol_size (s)));
+
+      /* Now implicit-type and exec-transition the FUNCTION. ~~Question??:
+	 When ENTRY FOO() RESULT(IBAR) is supported, what will the typing be
+	 if FOO and IBAR would normally end up with different types?  I think
+	 the answer is that FOO is always given whatever type would be chosen
+	 for IBAR, rather than the other way around, and I think it ends up
+	 working that way for FUNCTION FOO() RESULT(IBAR), but this should be
+	 checked out in all its different combos. Related question is, is
+	 there any way that FOO in either case ends up without type info
+	 filled in?  Does anyone care?  */
+
+      ffesymbol_signal_unreported (s);
+    }
+  else
+    {
+      ffesymbol_set_info (fs,
+			  ffeinfo_new (FFEINFO_basictypeNONE,
+				       FFEINFO_kindtypeNONE,
+				       0,
+				       FFEINFO_kindSUBROUTINE,
+				       FFEINFO_whereLOCAL,
+				       FFETARGET_charactersizeNONE));
+    }
+
+  if (!in_spec)
+    fs = ffecom_sym_exec_transition (fs);
+
+  ffesymbol_signal_unreported (fs);
+
+  ffestd_R1226 (fs);
+}
+
+/* ffestc_R1227 -- RETURN statement
+
+   ffestc_R1227(expr,expr_token);
+
+   Make sure statement is valid here; implement.  expr and expr_token are
+   both NULL if there was no expression.  */
+
+void
+ffestc_R1227 (ffebld expr, ffelexToken expr_token)
+{
+  ffestw b;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_notloop_begin_ ();
+
+  for (b = ffestw_stack_top (); ; b = ffestw_previous (b))
+    {
+      switch (ffestw_state (b))
+	{
+	case FFESTV_statePROGRAM4:
+	case FFESTV_stateSUBROUTINE4:
+	case FFESTV_stateFUNCTION4:
+	  goto base;		/* :::::::::::::::::::: */
+
+	case FFESTV_stateNIL:
+	  assert ("bad state" == NULL);
+	  break;
+
+	default:
+	  break;
+	}
+    }
+
+ base:
+  switch (ffestw_state (b))
+    {
+    case FFESTV_statePROGRAM4:
+      if (ffe_is_pedantic ())
+	{
+	  ffebad_start (FFEBAD_RETURN_IN_MAIN);
+	  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		       ffelex_token_where_column (ffesta_tokens[0]));
+	  ffebad_finish ();
+	}
+      if (expr != NULL)
+	{
+	  ffebad_start (FFEBAD_ALTRETURN_IN_PROGRAM);
+	  ffebad_here (0, ffelex_token_where_line (expr_token),
+		       ffelex_token_where_column (expr_token));
+	  ffebad_finish ();
+	  expr = NULL;
+	}
+      break;
+
+    case FFESTV_stateSUBROUTINE4:
+      break;
+
+    case FFESTV_stateFUNCTION4:
+      if (expr != NULL)
+	{
+	  ffebad_start (FFEBAD_ALTRETURN_IN_FUNCTION);
+	  ffebad_here (0, ffelex_token_where_line (expr_token),
+		       ffelex_token_where_column (expr_token));
+	  ffebad_finish ();
+	  expr = NULL;
+	}
+      break;
+
+    default:
+      assert ("bad state #2" == NULL);
+      break;
+    }
+
+  ffestd_R1227 (expr);
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+
+  /* notloop's that are actionif's can be the target of a loop-end
+     statement if they're in the "then" part of a logical IF, as
+     in "DO 10", "10 IF (...) RETURN".  */
+
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R1228 -- CONTAINS statement
+
+   ffestc_R1228();  */
+
+#if FFESTR_F90
+void
+ffestc_R1228 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_contains_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  ffestd_R1228 ();
+
+  ffe_terminate_3 ();
+  ffe_init_3 ();
+}
+
+#endif
+/* ffestc_R1229_start -- STMTFUNCTION statement begin
+
+   ffestc_R1229_start(func_name,func_arg_list,close_paren);
+
+   Verify that STMTFUNCTION is valid here, establish func_arg_list in a new
+   "live" scope within the current scope, and expect the actual expression
+   (or NULL) in ffestc_R1229_finish.  The reason there are two ffestc
+   functions to handle this is so the scope can be established, allowing
+   ffeexpr to assign proper characteristics to references to the dummy
+   arguments.  */
+
+void
+ffestc_R1229_start (ffelexToken name, ffesttTokenList args,
+		    ffelexToken final UNUSED)
+{
+  ffesymbol s;
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+
+  ffestc_check_start_ ();
+  if (ffestc_order_sfunc_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  assert (name != NULL);
+  assert (args != NULL);
+
+  s = ffesymbol_declare_local (name, FALSE);
+  sa = ffesymbol_attrs (s);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (!ffesymbol_is_specable (s))
+    na = FFESYMBOL_attrsetNONE;	/* Can't dcl sym ref'd in sfuncdef. */
+  else if (sa & FFESYMBOL_attrsANY)
+    na = FFESYMBOL_attrsANY;
+  else if (!(sa & ~FFESYMBOL_attrsTYPE))
+    na = sa | FFESYMBOL_attrsSFUNC;
+  else
+    na = FFESYMBOL_attrsetNONE;
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (na == FFESYMBOL_attrsetNONE)
+    {
+      ffesymbol_error (s, name);
+      ffestc_parent_ok_ = FALSE;
+    }
+  else if (na & FFESYMBOL_attrsANY)
+    ffestc_parent_ok_ = FALSE;
+  else
+    {
+      ffesymbol_set_attrs (s, na);
+      ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+      if (!ffeimplic_establish_symbol (s)
+	  || ((ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)
+	      && (ffesymbol_size (s) == FFETARGET_charactersizeNONE)))
+	{
+	  ffesymbol_error (s, ffesta_tokens[0]);
+	  ffestc_parent_ok_ = FALSE;
+	}
+      else
+	{
+	  /* Tell ffeexpr that sfunc def is in progress.  */
+	  ffesymbol_set_sfexpr (s, ffebld_new_any ());
+	  ffestc_parent_ok_ = TRUE;
+	}
+    }
+
+  ffe_init_4 ();
+
+  if (ffestc_parent_ok_)
+    {
+      ffebld_init_list (&s->dummy_args, &ffestc_local_.dummy.list_bottom);
+      ffestc_sfdummy_argno_ = 0;
+      ffestt_tokenlist_drive (args, ffestc_promote_sfdummy_);
+      ffebld_end_list (&ffestc_local_.dummy.list_bottom);
+    }
+
+  ffestc_local_.sfunc.symbol = s;
+
+  ffestd_R1229_start (name, args);
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R1229_finish -- STMTFUNCTION statement list complete
+
+   ffestc_R1229_finish(expr,expr_token);
+
+   If expr is NULL, an error occurred parsing the expansion expression, so
+   just cancel the effects of ffestc_R1229_start and pretend nothing
+   happened.  Otherwise, install the expression as the expansion for the
+   statement function named in _start_, then clean up.	*/
+
+void
+ffestc_R1229_finish (ffebld expr, ffelexToken expr_token)
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  if (ffestc_parent_ok_ && (expr != NULL))
+    ffesymbol_set_sfexpr (ffestc_local_.sfunc.symbol,
+			  ffeexpr_convert_to_sym (expr,
+						  expr_token,
+						  ffestc_local_.sfunc.symbol,
+						  ffesta_tokens[0]));
+
+  ffestd_R1229_finish (ffestc_local_.sfunc.symbol);
+
+  ffesymbol_signal_unreported (ffestc_local_.sfunc.symbol);
+
+  ffe_terminate_4 ();
+}
+
+/* ffestc_S3P4 -- INCLUDE line
+
+   ffestc_S3P4(filename,filename_token);
+
+   Make sure INCLUDE not preceded by any semicolons or a label def; implement.	*/
+
+void
+ffestc_S3P4 (ffebld filename, ffelexToken filename_token UNUSED)
+{
+  ffestc_check_simple_ ();
+  ffestc_labeldef_invalid_ ();
+
+  ffestd_S3P4 (filename);
+}
+
+/* ffestc_V003_start -- STRUCTURE statement list begin
+
+   ffestc_V003_start(structure_name);
+
+   Verify that STRUCTURE is valid here, and begin accepting items in the list.	*/
+
+#if FFESTR_VXT
+void
+ffestc_V003_start (ffelexToken structure_name)
+{
+  ffestw b;
+
+  ffestc_check_start_ ();
+  if (ffestc_order_vxtstructure_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateSTRUCTURE:
+    case FFESTV_stateMAP:
+      ffestc_local_.V003.list_state = 2;	/* Require at least one field
+						   name. */
+      ffestw_set_substate (ffestw_stack_top (), 1);	/* Seen at least one
+							   member. */
+      break;
+
+    default:
+      ffestc_local_.V003.list_state = 0;	/* No field names required. */
+      if (structure_name == NULL)
+	{
+	  ffebad_start (FFEBAD_STRUCT_MISSING_NAME);
+	  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		       ffelex_token_where_column (ffesta_tokens[0]));
+	  ffebad_finish ();
+	}
+      break;
+    }
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_stateSTRUCTURE);
+  ffestw_set_blocknum (b, 0);
+  ffestw_set_shriek (b, ffestc_shriek_structure_);
+  ffestw_set_substate (b, 0);	/* No field-declarations seen yet. */
+
+  ffestd_V003_start (structure_name);
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V003_item -- STRUCTURE statement for object-name
+
+   ffestc_V003_item(name_token,dim_list);
+
+   Make sure name_token identifies a valid object to be STRUCTUREd.  */
+
+void
+ffestc_V003_item (ffelexToken name, ffesttDimList dims)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  if (ffestc_local_.V003.list_state < 2)
+    {
+      if (ffestc_local_.V003.list_state == 0)
+	{
+	  ffestc_local_.V003.list_state = 1;
+	  ffebad_start (FFEBAD_STRUCT_IGNORING_FIELD);
+	  ffebad_here (0, ffelex_token_where_line (name),
+		       ffelex_token_where_column (name));
+	  ffebad_finish ();
+	}
+      return;
+    }
+  ffestc_local_.V003.list_state = 3;	/* Have at least one field name. */
+
+  if (dims != NULL)
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+  ffestd_V003_item (name, dims);
+}
+
+/* ffestc_V003_finish -- STRUCTURE statement list complete
+
+   ffestc_V003_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_V003_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  if (ffestc_local_.V003.list_state == 2)
+    {
+      ffebad_start (FFEBAD_STRUCT_MISSING_FIELD);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_previous (ffestw_stack_top ())),
+		   ffestw_col (ffestw_previous (ffestw_stack_top ())));
+      ffebad_finish ();
+    }
+
+  ffestd_V003_finish ();
+}
+
+/* ffestc_V004 -- END STRUCTURE statement
+
+   ffestc_V004();
+
+   Make sure ffestc_kind_ identifies a STRUCTURE block.
+   Implement the end of the current STRUCTURE block.  */
+
+void
+ffestc_V004 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_structure_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (ffestw_substate (ffestw_stack_top ()) != 1)
+    {
+      ffebad_start (FFEBAD_STRUCT_NO_COMPONENTS);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+    }
+
+  ffestc_shriek_structure_ (TRUE);
+}
+
+/* ffestc_V009 -- UNION statement
+
+   ffestc_V009();  */
+
+void
+ffestc_V009 ()
+{
+  ffestw b;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_structure_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  ffestw_set_substate (ffestw_stack_top (), 1);	/* Seen at least one member. */
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_stateUNION);
+  ffestw_set_blocknum (b, 0);
+  ffestw_set_shriek (b, ffestc_shriek_union_);
+  ffestw_set_substate (b, 0);	/* No map decls seen yet. */
+
+  ffestd_V009 ();
+}
+
+/* ffestc_V010 -- END UNION statement
+
+   ffestc_V010();
+
+   Make sure ffestc_kind_ identifies a UNION block.
+   Implement the end of the current UNION block.  */
+
+void
+ffestc_V010 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_union_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (ffestw_substate (ffestw_stack_top ()) != 2)
+    {
+      ffebad_start (FFEBAD_UNION_NO_TWO_MAPS);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+    }
+
+  ffestc_shriek_union_ (TRUE);
+}
+
+/* ffestc_V012 -- MAP statement
+
+   ffestc_V012();  */
+
+void
+ffestc_V012 ()
+{
+  ffestw b;
+
+  ffestc_check_simple_ ();
+  if (ffestc_order_union_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (ffestw_substate (ffestw_stack_top ()) != 2)
+    ffestw_substate (ffestw_stack_top ())++;	/* 0=>1, 1=>2. */
+
+  b = ffestw_update (ffestw_push (NULL));
+  ffestw_set_top_do (b, NULL);
+  ffestw_set_state (b, FFESTV_stateMAP);
+  ffestw_set_blocknum (b, 0);
+  ffestw_set_shriek (b, ffestc_shriek_map_);
+  ffestw_set_substate (b, 0);	/* No field-declarations seen yet. */
+
+  ffestd_V012 ();
+}
+
+/* ffestc_V013 -- END MAP statement
+
+   ffestc_V013();
+
+   Make sure ffestc_kind_ identifies a MAP block.
+   Implement the end of the current MAP block.	*/
+
+void
+ffestc_V013 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_map_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_useless_ ();
+
+  if (ffestw_substate (ffestw_stack_top ()) != 1)
+    {
+      ffebad_start (FFEBAD_MAP_NO_COMPONENTS);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+      ffebad_finish ();
+    }
+
+  ffestc_shriek_map_ (TRUE);
+}
+
+#endif
+/* ffestc_V014_start -- VOLATILE statement list begin
+
+   ffestc_V014_start();
+
+   Verify that VOLATILE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_V014_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_progspec_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_V014_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V014_item_object -- VOLATILE statement for object-name
+
+   ffestc_V014_item_object(name_token);
+
+   Make sure name_token identifies a valid object to be VOLATILEd.  */
+
+void
+ffestc_V014_item_object (ffelexToken name)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V014_item_object (name);
+}
+
+/* ffestc_V014_item_cblock -- VOLATILE statement for common-block-name
+
+   ffestc_V014_item_cblock(name_token);
+
+   Make sure name_token identifies a valid common block to be VOLATILEd.  */
+
+void
+ffestc_V014_item_cblock (ffelexToken name)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V014_item_cblock (name);
+}
+
+/* ffestc_V014_finish -- VOLATILE statement list complete
+
+   ffestc_V014_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_V014_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V014_finish ();
+}
+
+/* ffestc_V016_start -- RECORD statement list begin
+
+   ffestc_V016_start();
+
+   Verify that RECORD is valid here, and begin accepting items in the list.  */
+
+#if FFESTR_VXT
+void
+ffestc_V016_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_record_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  switch (ffestw_state (ffestw_stack_top ()))
+    {
+    case FFESTV_stateSTRUCTURE:
+    case FFESTV_stateMAP:
+      ffestw_set_substate (ffestw_stack_top (), 1);	/* Seen at least one
+							   member. */
+      break;
+
+    default:
+      break;
+    }
+
+  ffestd_V016_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V016_item_structure -- RECORD statement for common-block-name
+
+   ffestc_V016_item_structure(name_token);
+
+   Make sure name_token identifies a valid structure to be RECORDed.  */
+
+void
+ffestc_V016_item_structure (ffelexToken name)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V016_item_structure (name);
+}
+
+/* ffestc_V016_item_object -- RECORD statement for object-name
+
+   ffestc_V016_item_object(name_token,dim_list);
+
+   Make sure name_token identifies a valid object to be RECORDd.  */
+
+void
+ffestc_V016_item_object (ffelexToken name, ffesttDimList dims)
+{
+  ffestc_check_item_ ();
+  assert (name != NULL);
+  if (!ffestc_ok_)
+    return;
+
+  if (dims != NULL)
+    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+  ffestd_V016_item_object (name, dims);
+}
+
+/* ffestc_V016_finish -- RECORD statement list complete
+
+   ffestc_V016_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_V016_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V016_finish ();
+}
+
+/* ffestc_V018_start -- REWRITE(...) statement list begin
+
+   ffestc_V018_start();
+
+   Verify that REWRITE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_V018_start ()
+{
+  ffestvFormat format;
+
+  ffestc_check_start_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_branch_begin_ ();
+
+  if (!ffestc_subr_is_branch_
+      (&ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixERR])
+      || !ffestc_subr_is_format_
+      (&ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT])
+      || !ffestc_subr_is_present_ ("UNIT",
+		   &ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT]))
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+
+  format = ffestc_subr_format_
+    (&ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT]);
+  switch (format)
+    {
+    case FFESTV_formatNAMELIST:
+    case FFESTV_formatASTERISK:
+      ffebad_start (FFEBAD_CONFLICTING_SPECS);
+      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+		   ffelex_token_where_column (ffesta_tokens[0]));
+      assert (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_or_val_present);
+      if (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_present)
+	{
+	  ffebad_here (0, ffelex_token_where_line
+		 (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw),
+		       ffelex_token_where_column
+		(ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw));
+	}
+      else
+	{
+	  ffebad_here (1, ffelex_token_where_line
+	      (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value),
+		       ffelex_token_where_column
+	     (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value));
+	}
+      ffebad_finish ();
+      ffestc_ok_ = FALSE;
+      return;
+
+    default:
+      break;
+    }
+
+  ffestd_V018_start (format);
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V018_item -- REWRITE statement i/o item
+
+   ffestc_V018_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestc_V018_item (ffebld expr, ffelexToken expr_token)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V018_item (expr);
+}
+
+/* ffestc_V018_finish -- REWRITE statement list complete
+
+   ffestc_V018_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_V018_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V018_finish ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V019_start -- ACCEPT statement list begin
+
+   ffestc_V019_start();
+
+   Verify that ACCEPT is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_V019_start ()
+{
+  ffestvFormat format;
+
+  ffestc_check_start_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_branch_begin_ ();
+
+  if (!ffestc_subr_is_format_
+      (&ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT]))
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+
+  format = ffestc_subr_format_
+    (&ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT]);
+  ffestc_namelist_ = (format == FFESTV_formatNAMELIST);
+
+  ffestd_V019_start (format);
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V019_item -- ACCEPT statement i/o item
+
+   ffestc_V019_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestc_V019_item (ffebld expr, ffelexToken expr_token)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  if (ffestc_namelist_ != 0)
+    {
+      if (ffestc_namelist_ == 1)
+	{
+	  ffestc_namelist_ = 2;
+	  ffebad_start (FFEBAD_NAMELIST_ITEMS);
+	  ffebad_here (0, ffelex_token_where_line (expr_token),
+		       ffelex_token_where_column (expr_token));
+	  ffebad_finish ();
+	}
+      return;
+    }
+
+  ffestd_V019_item (expr);
+}
+
+/* ffestc_V019_finish -- ACCEPT statement list complete
+
+   ffestc_V019_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_V019_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V019_finish ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+#endif
+/* ffestc_V020_start -- TYPE statement list begin
+
+   ffestc_V020_start();
+
+   Verify that TYPE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_V020_start ()
+{
+  ffestvFormat format;
+
+  ffestc_check_start_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_branch_begin_ ();
+
+  if (!ffestc_subr_is_format_
+      (&ffestp_file.type.type_spec[FFESTP_typeixFORMAT]))
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+
+  format = ffestc_subr_format_
+    (&ffestp_file.type.type_spec[FFESTP_typeixFORMAT]);
+  ffestc_namelist_ = (format == FFESTV_formatNAMELIST);
+
+  ffestd_V020_start (format);
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V020_item -- TYPE statement i/o item
+
+   ffestc_V020_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestc_V020_item (ffebld expr, ffelexToken expr_token)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  if (ffestc_namelist_ != 0)
+    {
+      if (ffestc_namelist_ == 1)
+	{
+	  ffestc_namelist_ = 2;
+	  ffebad_start (FFEBAD_NAMELIST_ITEMS);
+	  ffebad_here (0, ffelex_token_where_line (expr_token),
+		       ffelex_token_where_column (expr_token));
+	  ffebad_finish ();
+	}
+      return;
+    }
+
+  ffestd_V020_item (expr);
+}
+
+/* ffestc_V020_finish -- TYPE statement list complete
+
+   ffestc_V020_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_V020_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V020_finish ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V021 -- DELETE statement
+
+   ffestc_V021();
+
+   Make sure a DELETE is valid in the current context, and implement it.  */
+
+#if FFESTR_VXT
+void
+ffestc_V021 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  if (ffestc_subr_is_branch_
+      (&ffestp_file.delete.delete_spec[FFESTP_deleteixERR])
+      && ffestc_subr_is_present_ ("UNIT",
+		      &ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT]))
+    ffestd_V021 ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V022 -- UNLOCK statement
+
+   ffestc_V022();
+
+   Make sure a UNLOCK is valid in the current context, and implement it.  */
+
+void
+ffestc_V022 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  if (ffestc_subr_is_branch_
+      (&ffestp_file.beru.beru_spec[FFESTP_beruixERR])
+      && ffestc_subr_is_present_ ("UNIT",
+			    &ffestp_file.beru.beru_spec[FFESTP_beruixUNIT]))
+    ffestd_V022 ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V023_start -- ENCODE(...) statement list begin
+
+   ffestc_V023_start();
+
+   Verify that ENCODE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_V023_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_branch_begin_ ();
+
+  if (!ffestc_subr_is_branch_
+      (&ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixERR]))
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+
+  ffestd_V023_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V023_item -- ENCODE statement i/o item
+
+   ffestc_V023_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestc_V023_item (ffebld expr, ffelexToken expr_token)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V023_item (expr);
+}
+
+/* ffestc_V023_finish -- ENCODE statement list complete
+
+   ffestc_V023_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_V023_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V023_finish ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V024_start -- DECODE(...) statement list begin
+
+   ffestc_V024_start();
+
+   Verify that DECODE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_V024_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_branch_begin_ ();
+
+  if (!ffestc_subr_is_branch_
+      (&ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixERR]))
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+
+  ffestd_V024_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V024_item -- DECODE statement i/o item
+
+   ffestc_V024_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffestc_V024_item (ffebld expr, ffelexToken expr_token)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V024_item (expr);
+}
+
+/* ffestc_V024_finish -- DECODE statement list complete
+
+   ffestc_V024_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_V024_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V024_finish ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V025_start -- DEFINEFILE statement list begin
+
+   ffestc_V025_start();
+
+   Verify that DEFINEFILE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffestc_V025_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_branch_begin_ ();
+
+  ffestd_V025_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V025_item -- DEFINE FILE statement item
+
+   ffestc_V025_item(u,ut,m,mt,n,nt,asv,asvt);
+
+   Implement item.  */
+
+void
+ffestc_V025_item (ffebld u, ffelexToken ut, ffebld m, ffelexToken mt,
+		  ffebld n, ffelexToken nt, ffebld asv, ffelexToken asvt)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V025_item (u, m, n, asv);
+}
+
+/* ffestc_V025_finish -- DEFINE FILE statement list complete
+
+   ffestc_V025_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_V025_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V025_finish ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V026 -- FIND statement
+
+   ffestc_V026();
+
+   Make sure a FIND is valid in the current context, and implement it.	*/
+
+void
+ffestc_V026 ()
+{
+  ffestc_check_simple_ ();
+  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+    return;
+  ffestc_labeldef_branch_begin_ ();
+
+  if (ffestc_subr_is_branch_
+      (&ffestp_file.find.find_spec[FFESTP_findixERR])
+      && ffestc_subr_is_present_ ("UNIT",
+			     &ffestp_file.find.find_spec[FFESTP_findixUNIT])
+      && ffestc_subr_is_present_ ("REC",
+			     &ffestp_file.find.find_spec[FFESTP_findixREC]))
+    ffestd_V026 ();
+
+  if (ffestc_shriek_after1_ != NULL)
+    (*ffestc_shriek_after1_) (TRUE);
+  ffestc_labeldef_branch_end_ ();
+}
+
+#endif
+/* ffestc_V027_start -- VXT PARAMETER statement list begin
+
+   ffestc_V027_start();
+
+   Verify that PARAMETER is valid here, and begin accepting items in the list.	*/
+
+void
+ffestc_V027_start ()
+{
+  ffestc_check_start_ ();
+  if (ffestc_order_parameter_ () != FFESTC_orderOK_)
+    {
+      ffestc_ok_ = FALSE;
+      return;
+    }
+  ffestc_labeldef_useless_ ();
+
+  ffestd_V027_start ();
+
+  ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V027_item -- VXT PARAMETER statement assignment
+
+   ffestc_V027_item(dest,dest_token,source,source_token);
+
+   Make sure the source is a valid source for the destination; make the
+   assignment.	*/
+
+void
+ffestc_V027_item (ffelexToken dest_token, ffebld source,
+		  ffelexToken source_token UNUSED)
+{
+  ffestc_check_item_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V027_item (dest_token, source);
+}
+
+/* ffestc_V027_finish -- VXT PARAMETER statement list complete
+
+   ffestc_V027_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffestc_V027_finish ()
+{
+  ffestc_check_finish_ ();
+  if (!ffestc_ok_)
+    return;
+
+  ffestd_V027_finish ();
+}
+
+/* Any executable statement.  Mainly make sure that one-shot things
+   like the statement for a logical IF are reset.  */
+
+void
+ffestc_any ()
+{
+  ffestc_check_simple_ ();
+
+  ffestc_order_any_ ();
+
+  ffestc_labeldef_any_ ();
+
+  if (ffestc_shriek_after1_ == NULL)
+    return;
+
+  ffestd_any ();
+
+  (*ffestc_shriek_after1_) (TRUE);
+}