Initial revision

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@14772 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 5414 insertions, 0 deletions

diff --git a/gcc/f/ste.c b/gcc/f/ste.c
new file mode 100644
index 00000000000..a5e9757cca3
--- /dev/null
+++ b/gcc/f/ste.c
@@ -0,0 +1,5414 @@
+/* ste.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 1996 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:
+      ste.c
+
+   Description:
+      Implements the various statements and such like.
+
+   Modifications:
+*/
+
+/* As of 0.5.4, any statement that calls on ffecom to transform an
+   expression might need to be wrapped in ffecom_push_calltemps ()
+   and ffecom_pop_calltemps () as are some other cases.  That is
+   the case when the transformation might involve generation of
+   a temporary that must be auto-popped, the specific case being
+   when a COMPLEX operation requiring a call to libf2c being
+   generated, whereby a temp is needed to hold the result since
+   libf2c doesn't return COMPLEX results directly.  Cases where it
+   is known that ffecom_expr () won't need to do this, such as
+   the CALL statement (where it's the transformation of the
+   call expr itself that does the wrapping), don't need to bother
+   with this wrapping.  Forgetting to do the wrapping currently
+   means a crash at an assertion when the wrapping would be helpful
+   to keep temporaries from being wasted -- see ffecom_push_tempvar.  */
+
+/* Include files. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#include "config.j"
+#include "rtl.j"
+#endif
+
+#include "proj.h"
+#include "ste.h"
+#include "bld.h"
+#include "com.h"
+#include "expr.h"
+#include "lab.h"
+#include "lex.h"
+#include "sta.h"
+#include "stp.h"
+#include "str.h"
+#include "sts.h"
+#include "stt.h"
+#include "stv.h"
+#include "stw.h"
+#include "symbol.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+  {
+    FFESTE_stateletSIMPLE_,	/* Expecting simple/start. */
+    FFESTE_stateletATTRIB_,	/* Expecting attrib/item/itemstart. */
+    FFESTE_stateletITEM_,	/* Expecting item/itemstart/finish. */
+    FFESTE_stateletITEMVALS_,	/* Expecting itemvalue/itemendvals. */
+    FFESTE_
+  } ffesteStatelet_;
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+static ffesteStatelet_ ffeste_statelet_ = FFESTE_stateletSIMPLE_;
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static ffelab ffeste_label_formatdef_ = NULL;
+static tree (*ffeste_io_driver_) (ffebld expr);	/* do?io. */
+static ffecomGfrt ffeste_io_endgfrt_;	/* end function to call. */
+static tree ffeste_io_abort_;	/* abort-io label or NULL_TREE. */
+static bool ffeste_io_abort_is_temp_;	/* abort-io label is a temp. */
+static tree ffeste_io_end_;	/* END= label or NULL_TREE. */
+static tree ffeste_io_err_;	/* ERR= label or NULL_TREE. */
+static tree ffeste_io_iostat_;	/* IOSTAT= var or NULL_TREE. */
+static bool ffeste_io_iostat_is_temp_;	/* IOSTAT= var is a temp. */
+#endif
+
+/* Static functions (internal). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void ffeste_begin_iterdo_ (ffestw block, tree *tvar, tree *tincr,
+				  tree *xitersvar, ffebld var,
+				  ffebld start, ffelexToken start_token,
+				  ffebld end, ffelexToken end_token,
+				  ffebld incr, ffelexToken incr_token,
+				  char *msg);
+static void ffeste_end_iterdo_ (tree tvar, tree tincr, tree itersvar);
+static void ffeste_io_call_ (tree call, bool do_check);
+static tree ffeste_io_dofio_ (ffebld expr);
+static tree ffeste_io_dolio_ (ffebld expr);
+static tree ffeste_io_douio_ (ffebld expr);
+static tree ffeste_io_ialist_ (bool have_err, ffestvUnit unit,
+			       ffebld unit_expr, int unit_dflt);
+static tree ffeste_io_cilist_ (bool have_err, ffestvUnit unit,
+			       ffebld unit_expr, int unit_dflt,
+			       bool have_end, ffestvFormat format,
+			       ffestpFile *format_spec, bool rec,
+			       ffebld rec_expr);
+static tree ffeste_io_cllist_ (bool have_err, ffebld unit_expr,
+			       ffestpFile *stat_spec);
+static tree ffeste_io_icilist_ (bool have_err, ffebld unit_expr,
+				bool have_end, ffestvFormat format,
+				ffestpFile *format_spec);
+static void ffeste_io_impdo_ (ffebld impdo, ffelexToken impdo_token);
+static tree ffeste_io_olist_ (bool have_err, ffebld unit_expr,
+			      ffestpFile *file_spec,
+			      ffestpFile *stat_spec,
+			      ffestpFile *access_spec,
+			      ffestpFile *form_spec,
+			      ffestpFile *recl_spec,
+			      ffestpFile *blank_spec);
+static void ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt);
+#elif FFECOM_targetCURRENT == FFECOM_targetFFE
+static void ffeste_subr_file_ (char *kw, ffestpFile *spec);
+#else
+#error
+#endif
+
+/* Internal macros. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#define ffeste_emit_line_note_() \
+  emit_line_note (input_filename, lineno)
+#endif
+#define ffeste_check_simple_() \
+  assert(ffeste_statelet_ == FFESTE_stateletSIMPLE_)
+#define ffeste_check_start_() \
+  assert(ffeste_statelet_ == FFESTE_stateletSIMPLE_); \
+  ffeste_statelet_ = FFESTE_stateletATTRIB_
+#define ffeste_check_attrib_() \
+  assert(ffeste_statelet_ == FFESTE_stateletATTRIB_)
+#define ffeste_check_item_() \
+  assert(ffeste_statelet_ == FFESTE_stateletATTRIB_	 \
+	 || ffeste_statelet_ == FFESTE_stateletITEM_); \
+  ffeste_statelet_ = FFESTE_stateletITEM_
+#define ffeste_check_item_startvals_() \
+  assert(ffeste_statelet_ == FFESTE_stateletATTRIB_	 \
+	 || ffeste_statelet_ == FFESTE_stateletITEM_); \
+  ffeste_statelet_ = FFESTE_stateletITEMVALS_
+#define ffeste_check_item_value_() \
+  assert(ffeste_statelet_ == FFESTE_stateletITEMVALS_)
+#define ffeste_check_item_endvals_() \
+  assert(ffeste_statelet_ == FFESTE_stateletITEMVALS_); \
+  ffeste_statelet_ = FFESTE_stateletITEM_
+#define ffeste_check_finish_() \
+  assert(ffeste_statelet_ == FFESTE_stateletATTRIB_	 \
+	 || ffeste_statelet_ == FFESTE_stateletITEM_); \
+  ffeste_statelet_ = FFESTE_stateletSIMPLE_
+
+#define ffeste_f2c_charnolenspec_(Spec,Exp,Init)			    \
+  do									      \
+    {									      \
+    if (Spec->kw_or_val_present)					      \
+	Exp = ffecom_arg_ptr_to_expr(Spec->u.expr,&ignore);		 \
+      else								      \
+	Exp = null_pointer_node;					      \
+    if (TREE_CONSTANT(Exp))						      \
+	{								      \
+	Init = Exp;							      \
+	Exp = NULL_TREE;						      \
+	}								      \
+      else								      \
+	{								      \
+	Init = null_pointer_node;					      \
+	constantp = FALSE;						      \
+	}								      \
+    } while(0)
+
+#define ffeste_f2c_charspec_(Spec,Exp,Init,Lenexp,Leninit)		    \
+  do									      \
+    {									      \
+    if (Spec->kw_or_val_present)					      \
+	Exp = ffecom_arg_ptr_to_expr(Spec->u.expr,&Lenexp);		      \
+      else								      \
+	{								      \
+	Exp = null_pointer_node;					      \
+	Lenexp = ffecom_f2c_ftnlen_zero_node;				      \
+	}								      \
+    if (TREE_CONSTANT(Exp))						      \
+	{								      \
+	Init = Exp;							      \
+	Exp = NULL_TREE;						      \
+	}								      \
+      else								      \
+	{								      \
+	Init = null_pointer_node;					      \
+	constantp = FALSE;						      \
+	}								      \
+    if ((Lenexp != NULL_TREE) && TREE_CONSTANT(Lenexp))			      \
+	{								      \
+	Leninit = Lenexp;						      \
+	Lenexp = NULL_TREE;						      \
+	}								      \
+      else								      \
+	{								      \
+	Leninit = ffecom_f2c_ftnlen_zero_node;				      \
+	constantp = FALSE;						      \
+	}								      \
+    } while(0)
+
+#define ffeste_f2c_exp_(Field,Exp)					      \
+  do									      \
+    {									      \
+    if (Exp != NULL_TREE)						      \
+	{								      \
+	Exp = ffecom_modify(void_type_node,ffecom_2(COMPONENT_REF,	      \
+	      TREE_TYPE(Field),t,Field),Exp);				      \
+	expand_expr_stmt(Exp);						      \
+	}								      \
+    } while(0)
+
+#define ffeste_f2c_init_(Init)						    \
+  do									      \
+    {									      \
+    TREE_CHAIN(initn) = build_tree_list((field = TREE_CHAIN(field)),Init);    \
+    initn = TREE_CHAIN(initn);						      \
+    } while(0)
+
+#define ffeste_f2c_flagspec_(Flag,Init)					      \
+  do { Init = convert (ffecom_f2c_flag_type_node,			      \
+		       Flag ? integer_one_node : integer_zero_node); }	      \
+    while(0)
+
+#define ffeste_f2c_intspec_(Spec,Exp,Init)				      \
+  do									      \
+    {									      \
+    if (Spec->kw_or_val_present)					      \
+	Exp = ffecom_expr(Spec->u.expr);				      \
+      else								      \
+	Exp = ffecom_integer_zero_node;					      \
+    if (TREE_CONSTANT(Exp))						      \
+	{								      \
+	Init = Exp;							      \
+	Exp = NULL_TREE;						      \
+	}								      \
+      else								      \
+	{								      \
+	Init = ffecom_integer_zero_node;				      \
+	constantp = FALSE;						      \
+	}								      \
+    } while(0)
+
+#define ffeste_f2c_ptrtointspec_(Spec,Exp,Init)				    \
+  do									      \
+    {									      \
+    if (Spec->kw_or_val_present)					      \
+	Exp = ffecom_ptr_to_expr(Spec->u.expr);				 \
+      else								      \
+	Exp = null_pointer_node;					      \
+    if (TREE_CONSTANT(Exp))						      \
+	{								      \
+	Init = Exp;							      \
+	Exp = NULL_TREE;						      \
+	}								      \
+      else								      \
+	{								      \
+	Init = null_pointer_node;					      \
+	constantp = FALSE;						      \
+	}								      \
+    } while(0)
+
+
+/* Begin an iterative DO loop.  Pass the block to start if applicable.
+
+   NOTE: Does _two_ push_momentary () calls, which the caller must
+   undo (by calling ffeste_end_iterdo_).  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffeste_begin_iterdo_ (ffestw block, tree *xtvar, tree *xtincr,
+		      tree *xitersvar, ffebld var,
+		      ffebld start, ffelexToken start_token,
+		      ffebld end, ffelexToken end_token,
+		      ffebld incr, ffelexToken incr_token,
+		      char *msg)
+{
+  tree tvar;
+  tree expr;
+  tree tstart;
+  tree tend;
+  tree tincr;
+  tree tincr_saved;
+  tree niters;
+
+  push_momentary ();		/* Want to save these throughout the loop. */
+
+  tvar = ffecom_expr_rw (var);
+  tincr = ffecom_expr (incr);
+
+  /* Check whether incr is known to be zero, complain and fix.  */
+
+  if (integer_zerop (tincr) || real_zerop (tincr))
+    {
+      ffebad_start (FFEBAD_DO_STEP_ZERO);
+      ffebad_here (0, ffelex_token_where_line (incr_token),
+		   ffelex_token_where_column (incr_token));
+      ffebad_string (msg);
+      ffebad_finish ();
+      tincr = convert (TREE_TYPE (tvar), integer_one_node);
+    }
+
+  tincr_saved = ffecom_save_tree (tincr);
+
+  push_momentary ();		/* Want to discard the rest after the loop. */
+
+  tstart = ffecom_expr (start);
+  tend = ffecom_expr (end);
+
+  {				/* For warnings only, nothing else
+				   happens here.  */
+    tree try;
+
+    if (!ffe_is_onetrip ())
+      {
+	try = ffecom_2 (MINUS_EXPR, TREE_TYPE (tvar),
+			tend,
+			tstart);
+
+	try = ffecom_2 (PLUS_EXPR, TREE_TYPE (tvar),
+			try,
+			tincr);
+
+	if (TREE_CODE (TREE_TYPE (tvar)) != REAL_TYPE)
+	  try = ffecom_2 (TRUNC_DIV_EXPR, integer_type_node, try,
+			  tincr);
+	else
+	  try = convert (integer_type_node,
+			 ffecom_2 (RDIV_EXPR, TREE_TYPE (tvar),
+				   try,
+				   tincr));
+
+	/* Warn if loop never executed, since we've done the evaluation
+	   of the unofficial iteration count already.  */
+
+	try = ffecom_truth_value (ffecom_2 (LE_EXPR, integer_type_node,
+					    try,
+					    convert (TREE_TYPE (tvar),
+						     integer_zero_node)));
+
+	if (integer_onep (try))
+	  {
+	    ffebad_start (FFEBAD_DO_NULL);
+	    ffebad_here (0, ffelex_token_where_line (start_token),
+			 ffelex_token_where_column (start_token));
+	    ffebad_string (msg);
+	    ffebad_finish ();
+	  }
+      }
+
+    /* Warn if end plus incr would overflow.  */
+
+    try = ffecom_2 (PLUS_EXPR, TREE_TYPE (tvar),
+		    tend,
+		    tincr);
+
+    if ((TREE_CODE_CLASS (TREE_CODE (try)) == 'c')
+	&& TREE_CONSTANT_OVERFLOW (try))
+      {
+	ffebad_start (FFEBAD_DO_END_OVERFLOW);
+	ffebad_here (0, ffelex_token_where_line (end_token),
+		     ffelex_token_where_column (end_token));
+	ffebad_string (msg);
+	ffebad_finish ();
+      }
+  }
+
+  /* Do the initial assignment into the DO var.  */
+
+  expr = ffecom_modify (void_type_node, tvar, tstart);
+  expand_expr_stmt (expr);
+
+  expr = ffecom_2 (MINUS_EXPR, TREE_TYPE (tvar),
+		   tend,
+		   TREE_CONSTANT (tstart) ? tstart : tvar);
+
+  if (!ffe_is_onetrip ())
+    {
+      expr = ffecom_2 (PLUS_EXPR, TREE_TYPE (expr),
+		       expr,
+		       convert (TREE_TYPE (expr), tincr_saved));
+    }
+
+  if (TREE_CODE (TREE_TYPE (tvar)) != REAL_TYPE)
+    expr = ffecom_2 (TRUNC_DIV_EXPR, TREE_TYPE (expr),
+		     expr,
+		     tincr_saved);
+  else
+    expr = ffecom_2 (RDIV_EXPR, TREE_TYPE (expr),
+		     expr,
+		     tincr_saved);
+
+#if 1	/* New, F90-approved approach: convert to default INTEGER. */
+  if (TREE_TYPE (tvar) != error_mark_node)
+    expr = convert (ffecom_integer_type_node, expr);
+#else	/* Old approach; convert to INTEGER unless that's a narrowing. */
+  if ((TREE_TYPE (tvar) != error_mark_node)
+      && ((TREE_CODE (TREE_TYPE (tvar)) != INTEGER_TYPE)
+	  || ((TYPE_SIZE (TREE_TYPE (tvar)) != NULL_TREE)
+	      && ((TREE_CODE (TYPE_SIZE (TREE_TYPE (tvar)))
+		   != INTEGER_CST)
+		  || (TREE_INT_CST_LOW (TYPE_SIZE (TREE_TYPE (tvar)))
+		      <= TREE_INT_CST_LOW (TYPE_SIZE (ffecom_integer_type_node)))))))
+    /* Convert unless promoting INTEGER type of any kind downward to
+       default INTEGER; else leave as, say, INTEGER*8 (long long int).  */
+    expr = convert (ffecom_integer_type_node, expr);
+#endif
+
+  niters = ffecom_push_tempvar (TREE_TYPE (expr),
+				FFETARGET_charactersizeNONE, -1, FALSE);
+  expr = ffecom_modify (void_type_node, niters, expr);
+  expand_expr_stmt (expr);
+
+  if (block == NULL)
+    expand_start_loop_continue_elsewhere (0);
+  else
+    ffestw_set_do_hook (block,
+			expand_start_loop_continue_elsewhere (1));
+
+  if (!ffe_is_onetrip ())
+    {
+      expr = ffecom_truth_value
+	(ffecom_2 (GE_EXPR, integer_type_node,
+		   ffecom_2 (PREDECREMENT_EXPR,
+			     TREE_TYPE (niters),
+			     niters,
+			     convert (TREE_TYPE (niters),
+				      ffecom_integer_one_node)),
+		   convert (TREE_TYPE (niters),
+			    ffecom_integer_zero_node)));
+
+      expand_exit_loop_if_false (0, expr);
+    }
+
+  clear_momentary ();		/* Discard the above now that we're done with
+				   DO stmt. */
+
+  if (block == NULL)
+    {
+      *xtvar = tvar;
+      *xtincr = tincr_saved;
+      *xitersvar = niters;
+    }
+  else
+    {
+      ffestw_set_do_tvar (block, tvar);
+      ffestw_set_do_incr_saved (block, tincr_saved);
+      ffestw_set_do_count_var (block, niters);
+    }
+}
+
+#endif
+
+/* End an iterative DO loop.  Pass the same iteration variable and increment
+   value trees that were generated in the paired _begin_ call.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffeste_end_iterdo_ (tree tvar, tree tincr, tree itersvar)
+{
+  tree expr;
+  tree niters = itersvar;
+
+  expand_loop_continue_here ();
+
+  if (ffe_is_onetrip ())
+    {
+      expr = ffecom_truth_value
+	(ffecom_2 (GE_EXPR, integer_type_node,
+		   ffecom_2 (PREDECREMENT_EXPR,
+			     TREE_TYPE (niters),
+			     niters,
+			     convert (TREE_TYPE (niters),
+				      ffecom_integer_one_node)),
+		   convert (TREE_TYPE (niters),
+			    ffecom_integer_zero_node)));
+
+      expand_exit_loop_if_false (0, expr);
+    }
+
+  expr = ffecom_modify (void_type_node, tvar,
+			ffecom_2 (PLUS_EXPR, TREE_TYPE (tvar),
+				  tvar,
+				  tincr));
+  expand_expr_stmt (expr);
+  expand_end_loop ();
+
+  ffecom_pop_tempvar (itersvar);	/* Free #iters var. */
+
+  clear_momentary ();
+  pop_momentary ();		/* Lose the stuff we just built. */
+
+  clear_momentary ();
+  pop_momentary ();		/* Lose the tvar and incr_saved trees. */
+}
+
+#endif
+/* ffeste_io_call_ -- Generate call to run-time I/O routine
+
+   tree callexpr = build(CALL_EXPR,...);
+   ffeste_io_call_(callexpr,TRUE);
+
+   Sets TREE_SIDE_EFFECTS(callexpr) = 1.  If ffeste_io_iostat_ is not
+   NULL_TREE, replaces callexpr with "iostat = callexpr;".  Expands the
+   result.  If ffeste_io_abort_ is not NULL_TREE and the second argument
+   is TRUE, generates "if (iostat != 0) goto ffeste_io_abort_;".  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffeste_io_call_ (tree call, bool do_check)
+{
+  /* Generate the call and optional assignment into iostat var. */
+
+  TREE_SIDE_EFFECTS (call) = 1;
+  if (ffeste_io_iostat_ != NULL_TREE)
+    {
+      call = ffecom_modify (do_check ? NULL_TREE : void_type_node,
+			    ffeste_io_iostat_, call);
+    }
+  expand_expr_stmt (call);
+
+  if (!do_check
+      || (ffeste_io_abort_ == NULL_TREE)
+      || (TREE_CODE (ffeste_io_abort_) == ERROR_MARK))
+    return;
+
+  /* Generate optional test. */
+
+  expand_start_cond (ffecom_truth_value (ffeste_io_iostat_), 0);
+  expand_goto (ffeste_io_abort_);
+  expand_end_cond ();
+}
+
+#endif
+/* ffeste_io_dofio_ -- Generate call to do_fio for formatted I/O item
+
+   ffebld expr;
+   tree call;
+   call = ffeste_io_dofio_(expr);
+
+   Returns a tree for a CALL_EXPR to the do_fio function, which handles
+   a formatted I/O list item, along with the appropriate arguments for
+   the function.  It is up to the caller to set the TREE_SIDE_EFFECTS flag
+   for the CALL_EXPR, expand (emit) the expression, emit any assignment
+   of the result to an IOSTAT= variable, and emit any checking of the
+   result for errors.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_dofio_ (ffebld expr)
+{
+  tree num_elements;
+  tree variable;
+  tree size;
+  tree arglist;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  bool is_complex;
+
+  bt = ffeinfo_basictype (ffebld_info (expr));
+  kt = ffeinfo_kindtype (ffebld_info (expr));
+
+  if ((bt == FFEINFO_basictypeANY)
+      || (kt == FFEINFO_kindtypeANY))
+    return error_mark_node;
+
+  if (bt == FFEINFO_basictypeCOMPLEX)
+    {
+      is_complex = TRUE;
+      bt = FFEINFO_basictypeREAL;
+    }
+  else
+    is_complex = FALSE;
+
+  ffecom_push_calltemps ();
+
+  variable = ffecom_arg_ptr_to_expr (expr, &size);
+
+  if ((variable == error_mark_node)
+      || (size == error_mark_node))
+    {
+      ffecom_pop_calltemps ();
+      return error_mark_node;
+    }
+
+  if (size == NULL_TREE)	/* Already filled in for CHARACTER type. */
+    {				/* "(ftnlen) sizeof(type)" */
+      size = size_binop (CEIL_DIV_EXPR,
+			 TYPE_SIZE (ffecom_tree_type[bt][kt]),
+			 size_int (TYPE_PRECISION (char_type_node)));
+#if 0	/* Assume that while it is possible that char * is wider than
+	   ftnlen, no object in Fortran space can get big enough for its
+	   size to be wider than ftnlen.  I really hope nobody wastes
+	   time debugging a case where it can!  */
+      assert (TYPE_PRECISION (ffecom_f2c_ftnlen_type_node)
+	      >= TYPE_PRECISION (TREE_TYPE (size)));
+#endif
+      size = convert (ffecom_f2c_ftnlen_type_node, size);
+    }
+
+  if ((ffeinfo_rank (ffebld_info (expr)) == 0)
+      || (TREE_CODE (TREE_TYPE (TREE_TYPE (variable))) != ARRAY_TYPE))
+    num_elements = is_complex ? ffecom_f2c_ftnlen_two_node
+      : ffecom_f2c_ftnlen_one_node;
+  else
+    {
+      num_elements = size_binop (CEIL_DIV_EXPR,
+			TYPE_SIZE (TREE_TYPE (TREE_TYPE (variable))), size);
+      num_elements = size_binop (CEIL_DIV_EXPR, num_elements,
+				 size_int (TYPE_PRECISION
+					   (char_type_node)));
+      num_elements = convert (ffecom_f2c_ftnlen_type_node,
+			      num_elements);
+    }
+
+  num_elements
+    = ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node,
+		num_elements);
+
+  variable = convert (string_type_node, variable);
+
+  arglist = build_tree_list (NULL_TREE, num_elements);
+  TREE_CHAIN (arglist) = build_tree_list (NULL_TREE, variable);
+  TREE_CHAIN (TREE_CHAIN (arglist)) = build_tree_list (NULL_TREE, size);
+
+  ffecom_pop_calltemps ();
+
+  return ffecom_call_gfrt (FFECOM_gfrtDOFIO, arglist);
+}
+
+#endif
+/* ffeste_io_dolio_ -- Generate call to do_lio for list-directed I/O item
+
+   ffebld expr;
+   tree call;
+   call = ffeste_io_dolio_(expr);
+
+   Returns a tree for a CALL_EXPR to the do_lio function, which handles
+   a list-directed I/O list item, along with the appropriate arguments for
+   the function.  It is up to the caller to set the TREE_SIDE_EFFECTS flag
+   for the CALL_EXPR, expand (emit) the expression, emit any assignment
+   of the result to an IOSTAT= variable, and emit any checking of the
+   result for errors.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_dolio_ (ffebld expr)
+{
+  tree type_id;
+  tree num_elements;
+  tree variable;
+  tree size;
+  tree arglist;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  int tc;
+
+  bt = ffeinfo_basictype (ffebld_info (expr));
+  kt = ffeinfo_kindtype (ffebld_info (expr));
+
+  if ((bt == FFEINFO_basictypeANY)
+      || (kt == FFEINFO_kindtypeANY))
+    return error_mark_node;
+
+  ffecom_push_calltemps ();
+
+  tc = ffecom_f2c_typecode (bt, kt);
+  assert (tc != -1);
+  type_id = build_int_2 (tc, 0);
+
+  type_id
+    = ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnint_type_node,
+		convert (ffecom_f2c_ftnint_type_node,
+			 type_id));
+
+  variable = ffecom_arg_ptr_to_expr (expr, &size);
+
+  if ((type_id == error_mark_node)
+      || (variable == error_mark_node)
+      || (size == error_mark_node))
+    {
+      ffecom_pop_calltemps ();
+      return error_mark_node;
+    }
+
+  if (size == NULL_TREE)	/* Already filled in for CHARACTER type. */
+    {				/* "(ftnlen) sizeof(type)" */
+      size = size_binop (CEIL_DIV_EXPR,
+			 TYPE_SIZE (ffecom_tree_type[bt][kt]),
+			 size_int (TYPE_PRECISION (char_type_node)));
+#if 0	/* Assume that while it is possible that char * is wider than
+	   ftnlen, no object in Fortran space can get big enough for its
+	   size to be wider than ftnlen.  I really hope nobody wastes
+	   time debugging a case where it can!  */
+      assert (TYPE_PRECISION (ffecom_f2c_ftnlen_type_node)
+	      >= TYPE_PRECISION (TREE_TYPE (size)));
+#endif
+      size = convert (ffecom_f2c_ftnlen_type_node, size);
+    }
+
+  if ((ffeinfo_rank (ffebld_info (expr)) == 0)
+      || (TREE_CODE (TREE_TYPE (TREE_TYPE (variable))) != ARRAY_TYPE))
+    num_elements = ffecom_integer_one_node;
+  else
+    {
+      num_elements = size_binop (CEIL_DIV_EXPR,
+			TYPE_SIZE (TREE_TYPE (TREE_TYPE (variable))), size);
+      num_elements = size_binop (CEIL_DIV_EXPR,
+				 num_elements, size_int (TYPE_PRECISION
+							 (char_type_node)));
+      num_elements = convert (ffecom_f2c_ftnlen_type_node,
+			      num_elements);
+    }
+
+  num_elements
+    = ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node,
+		num_elements);
+
+  variable = convert (string_type_node, variable);
+
+  arglist = build_tree_list (NULL_TREE, type_id);
+  TREE_CHAIN (arglist) = build_tree_list (NULL_TREE, num_elements);
+  TREE_CHAIN (TREE_CHAIN (arglist)) = build_tree_list (NULL_TREE, variable);
+  TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (arglist)))
+    = build_tree_list (NULL_TREE, size);
+
+  ffecom_pop_calltemps ();
+
+  return ffecom_call_gfrt (FFECOM_gfrtDOLIO, arglist);
+}
+
+#endif
+/* ffeste_io_douio_ -- Generate call to do_uio for unformatted I/O item
+
+   ffebld expr;
+   tree call;
+   call = ffeste_io_douio_(expr);
+
+   Returns a tree for a CALL_EXPR to the do_uio function, which handles
+   an unformatted I/O list item, along with the appropriate arguments for
+   the function.  It is up to the caller to set the TREE_SIDE_EFFECTS flag
+   for the CALL_EXPR, expand (emit) the expression, emit any assignment
+   of the result to an IOSTAT= variable, and emit any checking of the
+   result for errors.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_douio_ (ffebld expr)
+{
+  tree num_elements;
+  tree variable;
+  tree size;
+  tree arglist;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  bool is_complex;
+
+  bt = ffeinfo_basictype (ffebld_info (expr));
+  kt = ffeinfo_kindtype (ffebld_info (expr));
+
+  if ((bt == FFEINFO_basictypeANY)
+      || (kt == FFEINFO_kindtypeANY))
+    return error_mark_node;
+
+  if (bt == FFEINFO_basictypeCOMPLEX)
+    {
+      is_complex = TRUE;
+      bt = FFEINFO_basictypeREAL;
+    }
+  else
+    is_complex = FALSE;
+
+  ffecom_push_calltemps ();
+
+  variable = ffecom_arg_ptr_to_expr (expr, &size);
+
+  if ((variable == error_mark_node)
+      || (size == error_mark_node))
+    {
+      ffecom_pop_calltemps ();
+      return error_mark_node;
+    }
+
+  if (size == NULL_TREE)	/* Already filled in for CHARACTER type. */
+    {				/* "(ftnlen) sizeof(type)" */
+      size = size_binop (CEIL_DIV_EXPR,
+			 TYPE_SIZE (ffecom_tree_type[bt][kt]),
+			 size_int (TYPE_PRECISION (char_type_node)));
+#if 0	/* Assume that while it is possible that char * is wider than
+	   ftnlen, no object in Fortran space can get big enough for its
+	   size to be wider than ftnlen.  I really hope nobody wastes
+	   time debugging a case where it can!  */
+      assert (TYPE_PRECISION (ffecom_f2c_ftnlen_type_node)
+	      >= TYPE_PRECISION (TREE_TYPE (size)));
+#endif
+      size = convert (ffecom_f2c_ftnlen_type_node, size);
+    }
+
+  if ((ffeinfo_rank (ffebld_info (expr)) == 0)
+      || (TREE_CODE (TREE_TYPE (TREE_TYPE (variable))) != ARRAY_TYPE))
+    num_elements = is_complex ? ffecom_f2c_ftnlen_two_node
+      : ffecom_f2c_ftnlen_one_node;
+  else
+    {
+      num_elements = size_binop (CEIL_DIV_EXPR,
+			TYPE_SIZE (TREE_TYPE (TREE_TYPE (variable))), size);
+      num_elements = size_binop (CEIL_DIV_EXPR, num_elements,
+				 size_int (TYPE_PRECISION
+					   (char_type_node)));
+      num_elements = convert (ffecom_f2c_ftnlen_type_node,
+			      num_elements);
+    }
+
+  num_elements
+    = ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node,
+		num_elements);
+
+  variable = convert (string_type_node, variable);
+
+  arglist = build_tree_list (NULL_TREE, num_elements);
+  TREE_CHAIN (arglist) = build_tree_list (NULL_TREE, variable);
+  TREE_CHAIN (TREE_CHAIN (arglist)) = build_tree_list (NULL_TREE, size);
+
+  ffecom_pop_calltemps ();
+
+  return ffecom_call_gfrt (FFECOM_gfrtDOUIO, arglist);
+}
+
+#endif
+/* ffeste_io_ialist_ -- Make arglist with ptr to B/E/R control list
+
+   tree arglist;
+   arglist = ffeste_io_ialist_(...);
+
+   Returns a tree suitable as an argument list containing a pointer to
+   a BACKSPACE/ENDFILE/REWIND control list.  First, generates that control
+   list, if necessary, along with any static and run-time initializations
+   that are needed as specified by the arguments to this function.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_ialist_ (bool have_err,
+		   ffestvUnit unit,
+		   ffebld unit_expr,
+		   int unit_dflt)
+{
+  static tree f2c_alist_struct = NULL_TREE;
+  tree t;
+  tree ttype;
+  int yes;
+  tree field;
+  tree inits, initn;
+  bool constantp = TRUE;
+  static tree errfield, unitfield;
+  tree errinit, unitinit;
+  tree unitexp;
+  static int mynumber = 0;
+
+  if (f2c_alist_struct == NULL_TREE)
+    {
+      tree ref;
+
+      push_obstacks_nochange ();
+      end_temporary_allocation ();
+
+      ref = make_node (RECORD_TYPE);
+
+      errfield = ffecom_decl_field (ref, NULL_TREE, "err",
+				    ffecom_f2c_flag_type_node);
+      unitfield = ffecom_decl_field (ref, errfield, "unit",
+				     ffecom_f2c_ftnint_type_node);
+
+      TYPE_FIELDS (ref) = errfield;
+      layout_type (ref);
+
+      resume_temporary_allocation ();
+      pop_obstacks ();
+
+      f2c_alist_struct = ref;
+    }
+
+  ffeste_f2c_flagspec_ (have_err, errinit);
+
+  switch (unit)
+    {
+    case FFESTV_unitNONE:
+    case FFESTV_unitASTERISK:
+      unitinit = build_int_2 (unit_dflt, 0);
+      unitexp = NULL_TREE;
+      break;
+
+    case FFESTV_unitINTEXPR:
+      unitexp = ffecom_expr (unit_expr);
+      if (TREE_CONSTANT (unitexp))
+	{
+	  unitinit = unitexp;
+	  unitexp = NULL_TREE;
+	}
+      else
+	{
+	  unitinit = ffecom_integer_zero_node;
+	  constantp = FALSE;
+	}
+      break;
+
+    default:
+      assert ("bad unit spec" == NULL);
+      unitexp = NULL_TREE;
+      unitinit = ffecom_integer_zero_node;
+      break;
+    }
+
+  inits = build_tree_list ((field = TYPE_FIELDS (f2c_alist_struct)), errinit);
+  initn = inits;
+  ffeste_f2c_init_ (unitinit);
+
+  inits = build (CONSTRUCTOR, f2c_alist_struct, NULL_TREE, inits);
+  TREE_CONSTANT (inits) = constantp ? 1 : 0;
+  TREE_STATIC (inits) = 1;
+
+  yes = suspend_momentary ();
+
+  t = build_decl (VAR_DECL,
+		  ffecom_get_invented_identifier ("__g77_alist_%d", NULL,
+						  mynumber++),
+		  f2c_alist_struct);
+  TREE_STATIC (t) = 1;
+  t = ffecom_start_decl (t, 1);
+  ffecom_finish_decl (t, inits, 0);
+
+  resume_momentary (yes);
+
+  ffeste_f2c_exp_ (unitfield, unitexp);
+
+  ttype = build_pointer_type (TREE_TYPE (t));
+  t = ffecom_1 (ADDR_EXPR, ttype, t);
+
+  t = build_tree_list (NULL_TREE, t);
+
+  return t;
+}
+
+#endif
+/* ffeste_io_cilist_ -- Make arglist with ptr to external I/O control list
+
+   tree arglist;
+   arglist = ffeste_io_cilist_(...);
+
+   Returns a tree suitable as an argument list containing a pointer to
+   an external-file I/O control list.  First, generates that control
+   list, if necessary, along with any static and run-time initializations
+   that are needed as specified by the arguments to this function.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_cilist_ (bool have_err,
+		   ffestvUnit unit,
+		   ffebld unit_expr,
+		   int unit_dflt,
+		   bool have_end,
+		   ffestvFormat format,
+		   ffestpFile *format_spec,
+		   bool rec,
+		   ffebld rec_expr)
+{
+  static tree f2c_cilist_struct = NULL_TREE;
+  tree t;
+  tree ttype;
+  int yes;
+  tree field;
+  tree inits, initn;
+  tree ignore;			/* We ignore the length of format! */
+  bool constantp = TRUE;
+  static tree errfield, unitfield, endfield, formatfield, recfield;
+  tree errinit, unitinit, endinit, formatinit, recinit;
+  tree unitexp, formatexp, recexp;
+  static int mynumber = 0;
+
+  if (f2c_cilist_struct == NULL_TREE)
+    {
+      tree ref;
+
+      push_obstacks_nochange ();
+      end_temporary_allocation ();
+
+      ref = make_node (RECORD_TYPE);
+
+      errfield = ffecom_decl_field (ref, NULL_TREE, "err",
+				    ffecom_f2c_flag_type_node);
+      unitfield = ffecom_decl_field (ref, errfield, "unit",
+				     ffecom_f2c_ftnint_type_node);
+      endfield = ffecom_decl_field (ref, unitfield, "end",
+				    ffecom_f2c_flag_type_node);
+      formatfield = ffecom_decl_field (ref, endfield, "format",
+				       string_type_node);
+      recfield = ffecom_decl_field (ref, formatfield, "rec",
+				    ffecom_f2c_ftnint_type_node);
+
+      TYPE_FIELDS (ref) = errfield;
+      layout_type (ref);
+
+      resume_temporary_allocation ();
+      pop_obstacks ();
+
+      f2c_cilist_struct = ref;
+    }
+
+  ffeste_f2c_flagspec_ (have_err, errinit);
+
+  switch (unit)
+    {
+    case FFESTV_unitNONE:
+    case FFESTV_unitASTERISK:
+      unitinit = build_int_2 (unit_dflt, 0);
+      unitexp = NULL_TREE;
+      break;
+
+    case FFESTV_unitINTEXPR:
+      unitexp = ffecom_expr (unit_expr);
+      if (TREE_CONSTANT (unitexp))
+	{
+	  unitinit = unitexp;
+	  unitexp = NULL_TREE;
+	}
+      else
+	{
+	  unitinit = ffecom_integer_zero_node;
+	  constantp = FALSE;
+	}
+      break;
+
+    default:
+      assert ("bad unit spec" == NULL);
+      unitexp = NULL_TREE;
+      unitinit = ffecom_integer_zero_node;
+      break;
+    }
+
+  switch (format)
+    {
+    case FFESTV_formatNONE:
+      formatinit = null_pointer_node;
+      formatexp = NULL_TREE;
+      break;
+
+    case FFESTV_formatLABEL:
+      formatexp = NULL_TREE;
+      formatinit = ffecom_lookup_label (format_spec->u.label);
+      if ((formatinit == NULL_TREE)
+	  || (TREE_CODE (formatinit) == ERROR_MARK))
+	break;
+      formatinit = ffecom_1 (ADDR_EXPR,
+			     build_pointer_type (void_type_node),
+			     formatinit);
+      TREE_CONSTANT (formatinit) = 1;
+      break;
+
+    case FFESTV_formatCHAREXPR:
+      formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, &ignore);
+      if (TREE_CONSTANT (formatexp))
+	{
+	  formatinit = formatexp;
+	  formatexp = NULL_TREE;
+	}
+      else
+	{
+	  formatinit = null_pointer_node;
+	  constantp = FALSE;
+	}
+      break;
+
+    case FFESTV_formatASTERISK:
+      formatinit = null_pointer_node;
+      formatexp = NULL_TREE;
+      break;
+
+    case FFESTV_formatINTEXPR:
+      formatinit = null_pointer_node;
+      formatexp = ffecom_expr_assign (format_spec->u.expr);
+      if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (formatexp)))
+	  < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node))))
+	error ("ASSIGNed FORMAT specifier is too small");
+      formatexp = convert (string_type_node, formatexp);
+      break;
+
+    case FFESTV_formatNAMELIST:
+      formatinit = ffecom_expr (format_spec->u.expr);
+      formatexp = NULL_TREE;
+      break;
+
+    default:
+      assert ("bad format spec" == NULL);
+      formatexp = NULL_TREE;
+      formatinit = integer_zero_node;
+      break;
+    }
+
+  ffeste_f2c_flagspec_ (have_end, endinit);
+
+  if (rec)
+    recexp = ffecom_expr (rec_expr);
+  else
+    recexp = ffecom_integer_zero_node;
+  if (TREE_CONSTANT (recexp))
+    {
+      recinit = recexp;
+      recexp = NULL_TREE;
+    }
+  else
+    {
+      recinit = ffecom_integer_zero_node;
+      constantp = FALSE;
+    }
+
+  inits = build_tree_list ((field = TYPE_FIELDS (f2c_cilist_struct)), errinit);
+  initn = inits;
+  ffeste_f2c_init_ (unitinit);
+  ffeste_f2c_init_ (endinit);
+  ffeste_f2c_init_ (formatinit);
+  ffeste_f2c_init_ (recinit);
+
+  inits = build (CONSTRUCTOR, f2c_cilist_struct, NULL_TREE, inits);
+  TREE_CONSTANT (inits) = constantp ? 1 : 0;
+  TREE_STATIC (inits) = 1;
+
+  yes = suspend_momentary ();
+
+  t = build_decl (VAR_DECL,
+		  ffecom_get_invented_identifier ("__g77_cilist_%d", NULL,
+						  mynumber++),
+		  f2c_cilist_struct);
+  TREE_STATIC (t) = 1;
+  t = ffecom_start_decl (t, 1);
+  ffecom_finish_decl (t, inits, 0);
+
+  resume_momentary (yes);
+
+  ffeste_f2c_exp_ (unitfield, unitexp);
+  ffeste_f2c_exp_ (formatfield, formatexp);
+  ffeste_f2c_exp_ (recfield, recexp);
+
+  ttype = build_pointer_type (TREE_TYPE (t));
+  t = ffecom_1 (ADDR_EXPR, ttype, t);
+
+  t = build_tree_list (NULL_TREE, t);
+
+  return t;
+}
+
+#endif
+/* ffeste_io_cllist_ -- Make arglist with ptr to CLOSE control list
+
+   tree arglist;
+   arglist = ffeste_io_cllist_(...);
+
+   Returns a tree suitable as an argument list containing a pointer to
+   a CLOSE-statement control list.  First, generates that control
+   list, if necessary, along with any static and run-time initializations
+   that are needed as specified by the arguments to this function.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_cllist_ (bool have_err,
+		   ffebld unit_expr,
+		   ffestpFile *stat_spec)
+{
+  static tree f2c_close_struct = NULL_TREE;
+  tree t;
+  tree ttype;
+  int yes;
+  tree field;
+  tree inits, initn;
+  tree ignore;			/* Ignore length info for certain fields. */
+  bool constantp = TRUE;
+  static tree errfield, unitfield, statfield;
+  tree errinit, unitinit, statinit;
+  tree unitexp, statexp;
+  static int mynumber = 0;
+
+  if (f2c_close_struct == NULL_TREE)
+    {
+      tree ref;
+
+      push_obstacks_nochange ();
+      end_temporary_allocation ();
+
+      ref = make_node (RECORD_TYPE);
+
+      errfield = ffecom_decl_field (ref, NULL_TREE, "err",
+				    ffecom_f2c_flag_type_node);
+      unitfield = ffecom_decl_field (ref, errfield, "unit",
+				     ffecom_f2c_ftnint_type_node);
+      statfield = ffecom_decl_field (ref, unitfield, "stat",
+				     string_type_node);
+
+      TYPE_FIELDS (ref) = errfield;
+      layout_type (ref);
+
+      resume_temporary_allocation ();
+      pop_obstacks ();
+
+      f2c_close_struct = ref;
+    }
+
+  ffeste_f2c_flagspec_ (have_err, errinit);
+
+  unitexp = ffecom_expr (unit_expr);
+  if (TREE_CONSTANT (unitexp))
+    {
+      unitinit = unitexp;
+      unitexp = NULL_TREE;
+    }
+  else
+    {
+      unitinit = ffecom_integer_zero_node;
+      constantp = FALSE;
+    }
+
+  ffeste_f2c_charnolenspec_ (stat_spec, statexp, statinit);
+
+  inits = build_tree_list ((field = TYPE_FIELDS (f2c_close_struct)), errinit);
+  initn = inits;
+  ffeste_f2c_init_ (unitinit);
+  ffeste_f2c_init_ (statinit);
+
+  inits = build (CONSTRUCTOR, f2c_close_struct, NULL_TREE, inits);
+  TREE_CONSTANT (inits) = constantp ? 1 : 0;
+  TREE_STATIC (inits) = 1;
+
+  yes = suspend_momentary ();
+
+  t = build_decl (VAR_DECL,
+		  ffecom_get_invented_identifier ("__g77_cllist_%d", NULL,
+						  mynumber++),
+		  f2c_close_struct);
+  TREE_STATIC (t) = 1;
+  t = ffecom_start_decl (t, 1);
+  ffecom_finish_decl (t, inits, 0);
+
+  resume_momentary (yes);
+
+  ffeste_f2c_exp_ (unitfield, unitexp);
+  ffeste_f2c_exp_ (statfield, statexp);
+
+  ttype = build_pointer_type (TREE_TYPE (t));
+  t = ffecom_1 (ADDR_EXPR, ttype, t);
+
+  t = build_tree_list (NULL_TREE, t);
+
+  return t;
+}
+
+#endif
+/* ffeste_io_icilist_ -- Make arglist with ptr to internal I/O control list
+
+   tree arglist;
+   arglist = ffeste_io_icilist_(...);
+
+   Returns a tree suitable as an argument list containing a pointer to
+   an internal-file I/O control list.  First, generates that control
+   list, if necessary, along with any static and run-time initializations
+   that are needed as specified by the arguments to this function.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_icilist_ (bool have_err,
+		    ffebld unit_expr,
+		    bool have_end,
+		    ffestvFormat format,
+		    ffestpFile *format_spec)
+{
+  static tree f2c_icilist_struct = NULL_TREE;
+  tree t;
+  tree ttype;
+  int yes;
+  tree field;
+  tree inits, initn;
+  tree ignore;			/* We ignore the length of format! */
+  bool constantp = TRUE;
+  static tree errfield, unitfield, endfield, formatfield, unitlenfield,
+    unitnumfield;
+  tree errinit, unitinit, endinit, formatinit, unitleninit, unitnuminit;
+  tree unitexp, formatexp, unitlenexp, unitnumexp;
+  static int mynumber = 0;
+
+  if (f2c_icilist_struct == NULL_TREE)
+    {
+      tree ref;
+
+      push_obstacks_nochange ();
+      end_temporary_allocation ();
+
+      ref = make_node (RECORD_TYPE);
+
+      errfield = ffecom_decl_field (ref, NULL_TREE, "err",
+				    ffecom_f2c_flag_type_node);
+      unitfield = ffecom_decl_field (ref, errfield, "unit",
+				     string_type_node);
+      endfield = ffecom_decl_field (ref, unitfield, "end",
+				    ffecom_f2c_flag_type_node);
+      formatfield = ffecom_decl_field (ref, endfield, "format",
+				       string_type_node);
+      unitlenfield = ffecom_decl_field (ref, formatfield, "unitlen",
+					ffecom_f2c_ftnint_type_node);
+      unitnumfield = ffecom_decl_field (ref, unitlenfield, "unitnum",
+					ffecom_f2c_ftnint_type_node);
+
+      TYPE_FIELDS (ref) = errfield;
+      layout_type (ref);
+
+      resume_temporary_allocation ();
+      pop_obstacks ();
+
+      f2c_icilist_struct = ref;
+    }
+
+  ffeste_f2c_flagspec_ (have_err, errinit);
+
+  unitexp = ffecom_arg_ptr_to_expr (unit_expr, &unitlenexp);
+  if ((ffeinfo_rank (ffebld_info (unit_expr)) == 0)
+      || (TREE_CODE (TREE_TYPE (TREE_TYPE (unitexp))) != ARRAY_TYPE))
+    unitnumexp = ffecom_integer_one_node;
+  else
+    {
+      unitnumexp = size_binop (CEIL_DIV_EXPR,
+		   TYPE_SIZE (TREE_TYPE (TREE_TYPE (unitexp))), unitlenexp);
+      unitnumexp = size_binop (CEIL_DIV_EXPR,
+			       unitnumexp, size_int (TYPE_PRECISION
+						     (char_type_node)));
+    }
+  if (TREE_CONSTANT (unitexp))
+    {
+      unitinit = unitexp;
+      unitexp = NULL_TREE;
+    }
+  else
+    {
+      unitinit = null_pointer_node;
+      constantp = FALSE;
+    }
+  if ((unitlenexp != NULL_TREE) && TREE_CONSTANT (unitlenexp))
+    {
+      unitleninit = unitlenexp;
+      unitlenexp = NULL_TREE;
+    }
+  else
+    {
+      unitleninit = ffecom_integer_zero_node;
+      constantp = FALSE;
+    }
+  if (TREE_CONSTANT (unitnumexp))
+    {
+      unitnuminit = unitnumexp;
+      unitnumexp = NULL_TREE;
+    }
+  else
+    {
+      unitnuminit = ffecom_integer_zero_node;
+      constantp = FALSE;
+    }
+
+  switch (format)
+    {
+    case FFESTV_formatNONE:
+      formatinit = null_pointer_node;
+      formatexp = NULL_TREE;
+      break;
+
+    case FFESTV_formatLABEL:
+      formatexp = NULL_TREE;
+      formatinit = ffecom_lookup_label (format_spec->u.label);
+      if ((formatinit == NULL_TREE)
+	  || (TREE_CODE (formatinit) == ERROR_MARK))
+	break;
+      formatinit = ffecom_1 (ADDR_EXPR,
+			     build_pointer_type (void_type_node),
+			     formatinit);
+      TREE_CONSTANT (formatinit) = 1;
+      break;
+
+    case FFESTV_formatCHAREXPR:
+      formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, &ignore);
+      if (TREE_CONSTANT (formatexp))
+	{
+	  formatinit = formatexp;
+	  formatexp = NULL_TREE;
+	}
+      else
+	{
+	  formatinit = null_pointer_node;
+	  constantp = FALSE;
+	}
+      break;
+
+    case FFESTV_formatASTERISK:
+      formatinit = null_pointer_node;
+      formatexp = NULL_TREE;
+      break;
+
+    case FFESTV_formatINTEXPR:
+      formatinit = null_pointer_node;
+      formatexp = ffecom_expr_assign (format_spec->u.expr);
+      if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (formatexp)))
+	  < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node))))
+	error ("ASSIGNed FORMAT specifier is too small");
+      formatexp = convert (string_type_node, formatexp);
+      break;
+
+    default:
+      assert ("bad format spec" == NULL);
+      formatexp = NULL_TREE;
+      formatinit = ffecom_integer_zero_node;
+      break;
+    }
+
+  ffeste_f2c_flagspec_ (have_end, endinit);
+
+  inits = build_tree_list ((field = TYPE_FIELDS (f2c_icilist_struct)),
+			   errinit);
+  initn = inits;
+  ffeste_f2c_init_ (unitinit);
+  ffeste_f2c_init_ (endinit);
+  ffeste_f2c_init_ (formatinit);
+  ffeste_f2c_init_ (unitleninit);
+  ffeste_f2c_init_ (unitnuminit);
+
+  inits = build (CONSTRUCTOR, f2c_icilist_struct, NULL_TREE, inits);
+  TREE_CONSTANT (inits) = constantp ? 1 : 0;
+  TREE_STATIC (inits) = 1;
+
+  yes = suspend_momentary ();
+
+  t = build_decl (VAR_DECL,
+		  ffecom_get_invented_identifier ("__g77_icilist_%d", NULL,
+						  mynumber++),
+		  f2c_icilist_struct);
+  TREE_STATIC (t) = 1;
+  t = ffecom_start_decl (t, 1);
+  ffecom_finish_decl (t, inits, 0);
+
+  resume_momentary (yes);
+
+  ffeste_f2c_exp_ (unitfield, unitexp);
+  ffeste_f2c_exp_ (formatfield, formatexp);
+  ffeste_f2c_exp_ (unitlenfield, unitlenexp);
+  ffeste_f2c_exp_ (unitnumfield, unitnumexp);
+
+  ttype = build_pointer_type (TREE_TYPE (t));
+  t = ffecom_1 (ADDR_EXPR, ttype, t);
+
+  t = build_tree_list (NULL_TREE, t);
+
+  return t;
+}
+
+#endif
+/* ffeste_io_impdo_ -- Handle implied-DO in I/O list
+
+   ffebld expr;
+   ffeste_io_impdo_(expr);
+
+   Expands code to start up the DO loop.  Then for each item in the
+   DO loop, handles appropriately (possibly including recursively calling
+   itself).  Then expands code to end the DO loop.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffeste_io_impdo_ (ffebld impdo, ffelexToken impdo_token)
+{
+  ffebld var = ffebld_head (ffebld_right (impdo));
+  ffebld start = ffebld_head (ffebld_trail (ffebld_right (impdo)));
+  ffebld end = ffebld_head (ffebld_trail (ffebld_trail
+					  (ffebld_right (impdo))));
+  ffebld incr = ffebld_head (ffebld_trail (ffebld_trail
+				    (ffebld_trail (ffebld_right (impdo)))));
+  ffebld list;			/* Used for list of items in left part of
+				   impdo. */
+  ffebld item;			/* I/O item from head of given list. */
+  tree tvar;
+  tree tincr;
+  tree titervar;
+
+  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 the DO loop.  */
+
+  start = ffeexpr_convert_expr (start, impdo_token, var, impdo_token,
+				FFEEXPR_contextLET);
+  end = ffeexpr_convert_expr (end, impdo_token, var, impdo_token,
+			      FFEEXPR_contextLET);
+  incr = ffeexpr_convert_expr (incr, impdo_token, var, impdo_token,
+			       FFEEXPR_contextLET);
+
+  ffeste_begin_iterdo_ (NULL, &tvar, &tincr, &titervar, var,
+			start, impdo_token,
+			end, impdo_token,
+			incr, impdo_token,
+			"Implied DO loop");
+
+  /* Handle the list of items.  */
+
+  for (list = ffebld_left (impdo); list != NULL; list = ffebld_trail (list))
+    {
+      item = ffebld_head (list);
+      if (item == NULL)
+	continue;
+      while (ffebld_op (item) == FFEBLD_opPAREN)
+	item = ffebld_left (item);
+      if (ffebld_op (item) == FFEBLD_opANY)
+	continue;
+      if (ffebld_op (item) == FFEBLD_opIMPDO)
+	ffeste_io_impdo_ (item, impdo_token);
+      else
+	ffeste_io_call_ ((*ffeste_io_driver_) (item), TRUE);
+      clear_momentary ();
+    }
+
+  /* Generate end of implied-do construct. */
+
+  ffeste_end_iterdo_ (tvar, tincr, titervar);
+}
+
+#endif
+/* ffeste_io_inlist_ -- Make arglist with ptr to INQUIRE control list
+
+   tree arglist;
+   arglist = ffeste_io_inlist_(...);
+
+   Returns a tree suitable as an argument list containing a pointer to
+   an INQUIRE-statement control list.  First, generates that control
+   list, if necessary, along with any static and run-time initializations
+   that are needed as specified by the arguments to this function.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_inlist_ (bool have_err,
+		   ffestpFile *unit_spec,
+		   ffestpFile *file_spec,
+		   ffestpFile *exist_spec,
+		   ffestpFile *open_spec,
+		   ffestpFile *number_spec,
+		   ffestpFile *named_spec,
+		   ffestpFile *name_spec,
+		   ffestpFile *access_spec,
+		   ffestpFile *sequential_spec,
+		   ffestpFile *direct_spec,
+		   ffestpFile *form_spec,
+		   ffestpFile *formatted_spec,
+		   ffestpFile *unformatted_spec,
+		   ffestpFile *recl_spec,
+		   ffestpFile *nextrec_spec,
+		   ffestpFile *blank_spec)
+{
+  static tree f2c_inquire_struct = NULL_TREE;
+  tree t;
+  tree ttype;
+  int yes;
+  tree field;
+  tree inits, initn;
+  bool constantp = TRUE;
+  static tree errfield, unitfield, filefield, filelenfield, existfield,
+    openfield, numberfield, namedfield, namefield, namelenfield, accessfield,
+    accesslenfield, sequentialfield, sequentiallenfield, directfield, directlenfield,
+    formfield, formlenfield, formattedfield, formattedlenfield, unformattedfield,
+    unformattedlenfield, reclfield, nextrecfield, blankfield, blanklenfield;
+  tree errinit, unitinit, fileinit, fileleninit, existinit, openinit, numberinit,
+    namedinit, nameinit, nameleninit, accessinit, accessleninit, sequentialinit,
+    sequentialleninit, directinit, directleninit, forminit, formleninit,
+    formattedinit, formattedleninit, unformattedinit, unformattedleninit,
+    reclinit, nextrecinit, blankinit, blankleninit;
+  tree
+    unitexp, fileexp, filelenexp, existexp, openexp, numberexp, namedexp,
+    nameexp, namelenexp, accessexp, accesslenexp, sequentialexp, sequentiallenexp,
+    directexp, directlenexp, formexp, formlenexp, formattedexp, formattedlenexp,
+    unformattedexp, unformattedlenexp, reclexp, nextrecexp, blankexp, blanklenexp;
+  static int mynumber = 0;
+
+  if (f2c_inquire_struct == NULL_TREE)
+    {
+      tree ref;
+
+      push_obstacks_nochange ();
+      end_temporary_allocation ();
+
+      ref = make_node (RECORD_TYPE);
+
+      errfield = ffecom_decl_field (ref, NULL_TREE, "err",
+				    ffecom_f2c_flag_type_node);
+      unitfield = ffecom_decl_field (ref, errfield, "unit",
+				     ffecom_f2c_ftnint_type_node);
+      filefield = ffecom_decl_field (ref, unitfield, "file",
+				     string_type_node);
+      filelenfield = ffecom_decl_field (ref, filefield, "filelen",
+					ffecom_f2c_ftnlen_type_node);
+      existfield = ffecom_decl_field (ref, filelenfield, "exist",
+				      ffecom_f2c_ptr_to_ftnint_type_node);
+      openfield = ffecom_decl_field (ref, existfield, "open",
+				     ffecom_f2c_ptr_to_ftnint_type_node);
+      numberfield = ffecom_decl_field (ref, openfield, "number",
+				       ffecom_f2c_ptr_to_ftnint_type_node);
+      namedfield = ffecom_decl_field (ref, numberfield, "named",
+				      ffecom_f2c_ptr_to_ftnint_type_node);
+      namefield = ffecom_decl_field (ref, namedfield, "name",
+				     string_type_node);
+      namelenfield = ffecom_decl_field (ref, namefield, "namelen",
+					ffecom_f2c_ftnlen_type_node);
+      accessfield = ffecom_decl_field (ref, namelenfield, "access",
+				       string_type_node);
+      accesslenfield = ffecom_decl_field (ref, accessfield, "accesslen",
+					  ffecom_f2c_ftnlen_type_node);
+      sequentialfield = ffecom_decl_field (ref, accesslenfield, "sequential",
+					   string_type_node);
+      sequentiallenfield = ffecom_decl_field (ref, sequentialfield,
+					      "sequentiallen",
+					      ffecom_f2c_ftnlen_type_node);
+      directfield = ffecom_decl_field (ref, sequentiallenfield, "direct",
+				       string_type_node);
+      directlenfield = ffecom_decl_field (ref, directfield, "directlen",
+					  ffecom_f2c_ftnlen_type_node);
+      formfield = ffecom_decl_field (ref, directlenfield, "form",
+				     string_type_node);
+      formlenfield = ffecom_decl_field (ref, formfield, "formlen",
+					ffecom_f2c_ftnlen_type_node);
+      formattedfield = ffecom_decl_field (ref, formlenfield, "formatted",
+					  string_type_node);
+      formattedlenfield = ffecom_decl_field (ref, formattedfield,
+					     "formattedlen",
+					     ffecom_f2c_ftnlen_type_node);
+      unformattedfield = ffecom_decl_field (ref, formattedlenfield,
+					    "unformatted",
+					    string_type_node);
+      unformattedlenfield = ffecom_decl_field (ref, unformattedfield,
+					       "unformattedlen",
+					       ffecom_f2c_ftnlen_type_node);
+      reclfield = ffecom_decl_field (ref, unformattedlenfield, "recl",
+				     ffecom_f2c_ptr_to_ftnint_type_node);
+      nextrecfield = ffecom_decl_field (ref, reclfield, "nextrec",
+					ffecom_f2c_ptr_to_ftnint_type_node);
+      blankfield = ffecom_decl_field (ref, nextrecfield, "blank",
+				      string_type_node);
+      blanklenfield = ffecom_decl_field (ref, blankfield, "blanklen",
+					 ffecom_f2c_ftnlen_type_node);
+
+      TYPE_FIELDS (ref) = errfield;
+      layout_type (ref);
+
+      resume_temporary_allocation ();
+      pop_obstacks ();
+
+      f2c_inquire_struct = ref;
+    }
+
+  ffeste_f2c_flagspec_ (have_err, errinit);
+  ffeste_f2c_intspec_ (unit_spec, unitexp, unitinit);
+  ffeste_f2c_charspec_ (file_spec, fileexp, fileinit, filelenexp, fileleninit);
+  ffeste_f2c_ptrtointspec_ (exist_spec, existexp, existinit);
+  ffeste_f2c_ptrtointspec_ (open_spec, openexp, openinit);
+  ffeste_f2c_ptrtointspec_ (number_spec, numberexp, numberinit);
+  ffeste_f2c_ptrtointspec_ (named_spec, namedexp, namedinit);
+  ffeste_f2c_charspec_ (name_spec, nameexp, nameinit, namelenexp, nameleninit);
+  ffeste_f2c_charspec_ (access_spec, accessexp, accessinit, accesslenexp,
+			accessleninit);
+  ffeste_f2c_charspec_ (sequential_spec, sequentialexp, sequentialinit,
+			sequentiallenexp, sequentialleninit);
+  ffeste_f2c_charspec_ (direct_spec, directexp, directinit, directlenexp,
+			directleninit);
+  ffeste_f2c_charspec_ (form_spec, formexp, forminit, formlenexp, formleninit);
+  ffeste_f2c_charspec_ (formatted_spec, formattedexp, formattedinit,
+			formattedlenexp, formattedleninit);
+  ffeste_f2c_charspec_ (unformatted_spec, unformattedexp, unformattedinit,
+			unformattedlenexp, unformattedleninit);
+  ffeste_f2c_ptrtointspec_ (recl_spec, reclexp, reclinit);
+  ffeste_f2c_ptrtointspec_ (nextrec_spec, nextrecexp, nextrecinit);
+  ffeste_f2c_charspec_ (blank_spec, blankexp, blankinit, blanklenexp,
+			blankleninit);
+
+  inits = build_tree_list ((field = TYPE_FIELDS (f2c_inquire_struct)),
+			   errinit);
+  initn = inits;
+  ffeste_f2c_init_ (unitinit);
+  ffeste_f2c_init_ (fileinit);
+  ffeste_f2c_init_ (fileleninit);
+  ffeste_f2c_init_ (existinit);
+  ffeste_f2c_init_ (openinit);
+  ffeste_f2c_init_ (numberinit);
+  ffeste_f2c_init_ (namedinit);
+  ffeste_f2c_init_ (nameinit);
+  ffeste_f2c_init_ (nameleninit);
+  ffeste_f2c_init_ (accessinit);
+  ffeste_f2c_init_ (accessleninit);
+  ffeste_f2c_init_ (sequentialinit);
+  ffeste_f2c_init_ (sequentialleninit);
+  ffeste_f2c_init_ (directinit);
+  ffeste_f2c_init_ (directleninit);
+  ffeste_f2c_init_ (forminit);
+  ffeste_f2c_init_ (formleninit);
+  ffeste_f2c_init_ (formattedinit);
+  ffeste_f2c_init_ (formattedleninit);
+  ffeste_f2c_init_ (unformattedinit);
+  ffeste_f2c_init_ (unformattedleninit);
+  ffeste_f2c_init_ (reclinit);
+  ffeste_f2c_init_ (nextrecinit);
+  ffeste_f2c_init_ (blankinit);
+  ffeste_f2c_init_ (blankleninit);
+
+  inits = build (CONSTRUCTOR, f2c_inquire_struct, NULL_TREE, inits);
+  TREE_CONSTANT (inits) = constantp ? 1 : 0;
+  TREE_STATIC (inits) = 1;
+
+  yes = suspend_momentary ();
+
+  t = build_decl (VAR_DECL,
+		  ffecom_get_invented_identifier ("__g77_inlist_%d", NULL,
+						  mynumber++),
+		  f2c_inquire_struct);
+  TREE_STATIC (t) = 1;
+  t = ffecom_start_decl (t, 1);
+  ffecom_finish_decl (t, inits, 0);
+
+  resume_momentary (yes);
+
+  ffeste_f2c_exp_ (unitfield, unitexp);
+  ffeste_f2c_exp_ (filefield, fileexp);
+  ffeste_f2c_exp_ (filelenfield, filelenexp);
+  ffeste_f2c_exp_ (existfield, existexp);
+  ffeste_f2c_exp_ (openfield, openexp);
+  ffeste_f2c_exp_ (numberfield, numberexp);
+  ffeste_f2c_exp_ (namedfield, namedexp);
+  ffeste_f2c_exp_ (namefield, nameexp);
+  ffeste_f2c_exp_ (namelenfield, namelenexp);
+  ffeste_f2c_exp_ (accessfield, accessexp);
+  ffeste_f2c_exp_ (accesslenfield, accesslenexp);
+  ffeste_f2c_exp_ (sequentialfield, sequentialexp);
+  ffeste_f2c_exp_ (sequentiallenfield, sequentiallenexp);
+  ffeste_f2c_exp_ (directfield, directexp);
+  ffeste_f2c_exp_ (directlenfield, directlenexp);
+  ffeste_f2c_exp_ (formfield, formexp);
+  ffeste_f2c_exp_ (formlenfield, formlenexp);
+  ffeste_f2c_exp_ (formattedfield, formattedexp);
+  ffeste_f2c_exp_ (formattedlenfield, formattedlenexp);
+  ffeste_f2c_exp_ (unformattedfield, unformattedexp);
+  ffeste_f2c_exp_ (unformattedlenfield, unformattedlenexp);
+  ffeste_f2c_exp_ (reclfield, reclexp);
+  ffeste_f2c_exp_ (nextrecfield, nextrecexp);
+  ffeste_f2c_exp_ (blankfield, blankexp);
+  ffeste_f2c_exp_ (blanklenfield, blanklenexp);
+
+  ttype = build_pointer_type (TREE_TYPE (t));
+  t = ffecom_1 (ADDR_EXPR, ttype, t);
+
+  t = build_tree_list (NULL_TREE, t);
+
+  return t;
+}
+
+#endif
+/* ffeste_io_olist_ -- Make arglist with ptr to OPEN control list
+
+   tree arglist;
+   arglist = ffeste_io_olist_(...);
+
+   Returns a tree suitable as an argument list containing a pointer to
+   an OPEN-statement control list.  First, generates that control
+   list, if necessary, along with any static and run-time initializations
+   that are needed as specified by the arguments to this function.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_olist_ (bool have_err,
+		  ffebld unit_expr,
+		  ffestpFile *file_spec,
+		  ffestpFile *stat_spec,
+		  ffestpFile *access_spec,
+		  ffestpFile *form_spec,
+		  ffestpFile *recl_spec,
+		  ffestpFile *blank_spec)
+{
+  static tree f2c_open_struct = NULL_TREE;
+  tree t;
+  tree ttype;
+  int yes;
+  tree field;
+  tree inits, initn;
+  tree ignore;			/* Ignore length info for certain fields. */
+  bool constantp = TRUE;
+  static tree errfield, unitfield, filefield, filelenfield, statfield,
+    accessfield, formfield, reclfield, blankfield;
+  tree errinit, unitinit, fileinit, fileleninit, statinit, accessinit,
+    forminit, reclinit, blankinit;
+  tree
+    unitexp, fileexp, filelenexp, statexp, accessexp, formexp, reclexp,
+    blankexp;
+  static int mynumber = 0;
+
+  if (f2c_open_struct == NULL_TREE)
+    {
+      tree ref;
+
+      push_obstacks_nochange ();
+      end_temporary_allocation ();
+
+      ref = make_node (RECORD_TYPE);
+
+      errfield = ffecom_decl_field (ref, NULL_TREE, "err",
+				    ffecom_f2c_flag_type_node);
+      unitfield = ffecom_decl_field (ref, errfield, "unit",
+				     ffecom_f2c_ftnint_type_node);
+      filefield = ffecom_decl_field (ref, unitfield, "file",
+				     string_type_node);
+      filelenfield = ffecom_decl_field (ref, filefield, "filelen",
+					ffecom_f2c_ftnlen_type_node);
+      statfield = ffecom_decl_field (ref, filelenfield, "stat",
+				     string_type_node);
+      accessfield = ffecom_decl_field (ref, statfield, "access",
+				       string_type_node);
+      formfield = ffecom_decl_field (ref, accessfield, "form",
+				     string_type_node);
+      reclfield = ffecom_decl_field (ref, formfield, "recl",
+				     ffecom_f2c_ftnint_type_node);
+      blankfield = ffecom_decl_field (ref, reclfield, "blank",
+				      string_type_node);
+
+      TYPE_FIELDS (ref) = errfield;
+      layout_type (ref);
+
+      resume_temporary_allocation ();
+      pop_obstacks ();
+
+      f2c_open_struct = ref;
+    }
+
+  ffeste_f2c_flagspec_ (have_err, errinit);
+
+  unitexp = ffecom_expr (unit_expr);
+  if (TREE_CONSTANT (unitexp))
+    {
+      unitinit = unitexp;
+      unitexp = NULL_TREE;
+    }
+  else
+    {
+      unitinit = ffecom_integer_zero_node;
+      constantp = FALSE;
+    }
+
+  ffeste_f2c_charspec_ (file_spec, fileexp, fileinit, filelenexp, fileleninit);
+  ffeste_f2c_charnolenspec_ (stat_spec, statexp, statinit);
+  ffeste_f2c_charnolenspec_ (access_spec, accessexp, accessinit);
+  ffeste_f2c_charnolenspec_ (form_spec, formexp, forminit);
+  ffeste_f2c_intspec_ (recl_spec, reclexp, reclinit);
+  ffeste_f2c_charnolenspec_ (blank_spec, blankexp, blankinit);
+
+  inits = build_tree_list ((field = TYPE_FIELDS (f2c_open_struct)), errinit);
+  initn = inits;
+  ffeste_f2c_init_ (unitinit);
+  ffeste_f2c_init_ (fileinit);
+  ffeste_f2c_init_ (fileleninit);
+  ffeste_f2c_init_ (statinit);
+  ffeste_f2c_init_ (accessinit);
+  ffeste_f2c_init_ (forminit);
+  ffeste_f2c_init_ (reclinit);
+  ffeste_f2c_init_ (blankinit);
+
+  inits = build (CONSTRUCTOR, f2c_open_struct, NULL_TREE, inits);
+  TREE_CONSTANT (inits) = constantp ? 1 : 0;
+  TREE_STATIC (inits) = 1;
+
+  yes = suspend_momentary ();
+
+  t = build_decl (VAR_DECL,
+		  ffecom_get_invented_identifier ("__g77_olist_%d", NULL,
+						  mynumber++),
+		  f2c_open_struct);
+  TREE_STATIC (t) = 1;
+  t = ffecom_start_decl (t, 1);
+  ffecom_finish_decl (t, inits, 0);
+
+  resume_momentary (yes);
+
+  ffeste_f2c_exp_ (unitfield, unitexp);
+  ffeste_f2c_exp_ (filefield, fileexp);
+  ffeste_f2c_exp_ (filelenfield, filelenexp);
+  ffeste_f2c_exp_ (statfield, statexp);
+  ffeste_f2c_exp_ (accessfield, accessexp);
+  ffeste_f2c_exp_ (formfield, formexp);
+  ffeste_f2c_exp_ (reclfield, reclexp);
+  ffeste_f2c_exp_ (blankfield, blankexp);
+
+  ttype = build_pointer_type (TREE_TYPE (t));
+  t = ffecom_1 (ADDR_EXPR, ttype, t);
+
+  t = build_tree_list (NULL_TREE, t);
+
+  return t;
+}
+
+#endif
+/* ffeste_subr_file_ -- Display file-statement specifier
+
+   ffeste_subr_file_(&specifier);  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+static void
+ffeste_subr_file_ (char *kw, ffestpFile *spec)
+{
+  if (!spec->kw_or_val_present)
+    return;
+  fputs (kw, dmpout);
+  if (spec->value_present)
+    {
+      fputc ('=', dmpout);
+      if (spec->value_is_label)
+	{
+	  assert (spec->value_is_label == 2);	/* Temporary checking only. */
+	  fprintf (dmpout, "%" ffelabValue_f "u",
+		   ffelab_value (spec->u.label));
+	}
+      else
+	ffebld_dump (spec->u.expr);
+    }
+  fputc (',', dmpout);
+}
+#endif
+
+/* ffeste_subr_beru_ -- Generate code for BACKSPACE/ENDFILE/REWIND
+
+   ffeste_subr_beru_(FFECOM_gfrtFBACK);	 */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt)
+{
+  tree alist;
+  bool iostat;
+  bool errl;
+
+#define specified(something) (info->beru_spec[something].kw_or_val_present)
+
+  ffeste_emit_line_note_ ();
+
+  /* Do the real work. */
+
+  iostat = specified (FFESTP_beruixIOSTAT);
+  errl = specified (FFESTP_beruixERR);
+
+  /* ~~For now, we assume the unit number is specified and is not ASTERISK,
+     because the FFE doesn't support BACKSPACE(*) and rejects a BACKSPACE
+     without any unit specifier.  f2c, however, supports the former
+     construct.	 When it is time to add this feature to the FFE, which
+     probably is fairly easy, ffestc_R919 and company will want to pass an
+     ffestvUnit indicator of FFESTV_unitINTEXPR or _unitASTERISK to
+     ffeste_R919 and company, and they will want to pass that same value to
+     this function, and that argument will replace the constant _unitINTEXPR_
+     in the call below.	 Right now, the default unit number, 6, is ignored. */
+
+  ffecom_push_calltemps ();
+
+  alist = ffeste_io_ialist_ (errl || iostat, FFESTV_unitINTEXPR,
+			     info->beru_spec[FFESTP_beruixUNIT].u.expr, 6);
+
+  if (errl)
+    {				/* ERR= */
+      ffeste_io_err_
+	= ffeste_io_abort_
+	= ffecom_lookup_label
+	(info->beru_spec[FFESTP_beruixERR].u.label);
+      ffeste_io_abort_is_temp_ = FALSE;
+    }
+  else
+    {				/* no ERR= */
+      ffeste_io_err_ = NULL_TREE;
+
+      if ((ffeste_io_abort_is_temp_ = iostat))
+	ffeste_io_abort_ = ffecom_temp_label ();
+      else
+	ffeste_io_abort_ = NULL_TREE;
+    }
+
+  if (iostat)
+    {				/* IOSTAT= */
+      ffeste_io_iostat_is_temp_ = FALSE;
+      ffeste_io_iostat_ = ffecom_expr
+	(info->beru_spec[FFESTP_beruixIOSTAT].u.expr);
+    }
+  else if (ffeste_io_abort_ != NULL_TREE)
+    {				/* no IOSTAT= but ERR= */
+      ffeste_io_iostat_is_temp_ = TRUE;
+      ffeste_io_iostat_
+	= ffecom_push_tempvar (ffecom_integer_type_node,
+			       FFETARGET_charactersizeNONE, -1, FALSE);
+    }
+  else
+    {				/* no IOSTAT=, or ERR= */
+      ffeste_io_iostat_is_temp_ = FALSE;
+      ffeste_io_iostat_ = NULL_TREE;
+    }
+
+  /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
+     label, since we're gonna fall through to there anyway. */
+
+  ffeste_io_call_ (ffecom_call_gfrt (rt, alist),
+		   !ffeste_io_abort_is_temp_);
+
+  /* If we've got a temp label, generate its code here. */
+
+  if (ffeste_io_abort_is_temp_)
+    {
+      DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
+      emit_nop ();
+      expand_label (ffeste_io_abort_);
+
+      assert (ffeste_io_err_ == NULL_TREE);
+    }
+
+  /* If we've got a temp iostat, pop the temp. */
+
+  if (ffeste_io_iostat_is_temp_)
+    ffecom_pop_tempvar (ffeste_io_iostat_);
+
+  ffecom_pop_calltemps ();
+
+#undef specified
+
+  clear_momentary ();
+}
+
+#endif
+/* ffeste_do -- End of statement following DO-term-stmt etc
+
+   ffeste_do(TRUE);
+
+   Also invoked by _labeldef_branch_finish_ (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 ffeste_eof_()) invokes it with ok==FALSE.  */
+
+void
+ffeste_do (ffestw block)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ END_DO\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  if (ffestw_do_tvar (block) == 0)
+    expand_end_loop ();		/* DO WHILE and just DO. */
+  else
+    ffeste_end_iterdo_ (ffestw_do_tvar (block),
+			ffestw_do_incr_saved (block),
+			ffestw_do_count_var (block));
+
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_end_R807 -- End of statement following logical IF
+
+   ffeste_end_R807(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 ffeste_eof_().	*/
+
+void
+ffeste_end_R807 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ END_IF\n", dmpout);	/* Also see ffeste_R806. */
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  expand_end_cond ();
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_labeldef_branch -- Generate "code" for branch label def
+
+   ffeste_labeldef_branch(label);  */
+
+void
+ffeste_labeldef_branch (ffelab label)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "+ label %lu\n", ffelab_value (label));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree glabel;
+
+    glabel = ffecom_lookup_label (label);
+    assert (glabel != NULL_TREE);
+    if (TREE_CODE (glabel) == ERROR_MARK)
+      return;
+    assert (DECL_INITIAL (glabel) == NULL_TREE);
+    DECL_INITIAL (glabel) = error_mark_node;
+    DECL_SOURCE_FILE (glabel) = ffelab_definition_filename (label);
+    DECL_SOURCE_LINE (glabel) = ffelab_definition_filelinenum (label);
+    emit_nop ();
+    expand_label (glabel);
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_labeldef_format -- Generate "code" for FORMAT label def
+
+   ffeste_labeldef_format(label);  */
+
+void
+ffeste_labeldef_format (ffelab label)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "$ label %lu\n", ffelab_value (label));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_label_formatdef_ = label;
+#else
+#error
+#endif
+}
+
+/* ffeste_R737A -- Assignment statement outside of WHERE
+
+   ffeste_R737A(dest_expr,source_expr);	 */
+
+void
+ffeste_R737A (ffebld dest, ffebld source)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ let ", dmpout);
+  ffebld_dump (dest);
+  fputs ("=", dmpout);
+  ffebld_dump (source);
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  ffecom_push_calltemps ();
+
+  ffecom_expand_let_stmt (dest, source);
+
+  ffecom_pop_calltemps ();
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R803 -- Block IF (IF-THEN) statement
+
+   ffeste_R803(construct_name,expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffeste_R803 (ffebld expr)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ IF_block (", dmpout);
+  ffebld_dump (expr);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  ffecom_push_calltemps ();
+
+  expand_start_cond (ffecom_truth_value (ffecom_expr (expr)), 0);
+
+  ffecom_pop_calltemps ();
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R804 -- ELSE IF statement
+
+   ffeste_R804(expr,expr_token,name_token);
+
+   Make sure ffeste_kind_ identifies an IF block.  If not
+   NULL, make sure name_token gives the correct name.  Implement the else
+   of the IF block.  */
+
+void
+ffeste_R804 (ffebld expr)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ ELSE_IF (", dmpout);
+  ffebld_dump (expr);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  ffecom_push_calltemps ();
+
+  expand_start_elseif (ffecom_truth_value (ffecom_expr (expr)));
+
+  ffecom_pop_calltemps ();
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R805 -- ELSE statement
+
+   ffeste_R805(name_token);
+
+   Make sure ffeste_kind_ identifies an IF block.  If not
+   NULL, make sure name_token gives the correct name.  Implement the ELSE
+   of the IF block.  */
+
+void
+ffeste_R805 ()
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ ELSE\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  expand_start_else ();
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R806 -- End an IF-THEN
+
+   ffeste_R806(TRUE);  */
+
+void
+ffeste_R806 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ END_IF_then\n", dmpout);	/* Also see ffeste_shriek_if_. */
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  expand_end_cond ();
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R807 -- Logical IF statement
+
+   ffeste_R807(expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffeste_R807 (ffebld expr)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ IF_logical (", dmpout);
+  ffebld_dump (expr);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  ffecom_push_calltemps ();
+
+  expand_start_cond (ffecom_truth_value (ffecom_expr (expr)), 0);
+
+  ffecom_pop_calltemps ();
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R809 -- SELECT CASE statement
+
+   ffeste_R809(construct_name,expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffeste_R809 (ffestw block, ffebld expr)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ SELECT_CASE (", dmpout);
+  ffebld_dump (expr);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffecom_push_calltemps ();
+
+  {
+    tree texpr;
+
+    ffeste_emit_line_note_ ();
+
+    if ((expr == NULL)
+	|| (ffeinfo_basictype (ffebld_info (expr))
+	    == FFEINFO_basictypeANY))
+      {
+	ffestw_set_select_texpr (block, error_mark_node);
+	clear_momentary ();
+      }
+    else
+      {
+	texpr = ffecom_expr (expr);
+	if (ffeinfo_basictype (ffebld_info (expr))
+	    != FFEINFO_basictypeCHARACTER)
+	  {
+	    expand_start_case (1, texpr, TREE_TYPE (texpr),
+			       "SELECT CASE statement");
+	    ffestw_set_select_texpr (block, texpr);
+	    ffestw_set_select_break (block, FALSE);
+	    push_momentary ();
+	  }
+	else
+	  {
+	    ffebad_start_msg ("SELECT CASE on CHARACTER type (at %0) not supported -- sorry",
+			      FFEBAD_severityFATAL);
+	    ffebad_here (0, ffestw_line (block), ffestw_col (block));
+	    ffebad_finish ();
+	    ffestw_set_select_texpr (block, error_mark_node);
+	  }
+      }
+  }
+
+  ffecom_pop_calltemps ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R810 -- CASE statement
+
+   ffeste_R810(case_value_range_list,name);
+
+   If casenum is 0, it's CASE DEFAULT.	Else it's the case ranges at
+   the start of the first_stmt list in the select object at the top of
+   the stack that match casenum.  */
+
+void
+ffeste_R810 (ffestw block, unsigned long casenum)
+{
+  ffestwSelect s = ffestw_select (block);
+  ffestwCase c;
+
+  ffeste_check_simple_ ();
+
+  if (s->first_stmt == (ffestwCase) &s->first_rel)
+    c = NULL;
+  else
+    c = s->first_stmt;
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  if ((c == NULL) || (casenum != c->casenum))
+    {
+      if (casenum == 0)		/* Intentional CASE DEFAULT. */
+	fputs ("+ CASE_DEFAULT", dmpout);
+    }
+  else
+    {
+      bool comma = FALSE;
+
+      fputs ("+ CASE (", dmpout);
+      do
+	{
+	  if (comma)
+	    fputc (',', dmpout);
+	  else
+	    comma = TRUE;
+	  if (c->low != NULL)
+	    ffebld_constant_dump (c->low);
+	  if (c->low != c->high)
+	    {
+	      fputc (':', dmpout);
+	      if (c->high != NULL)
+		ffebld_constant_dump (c->high);
+	    }
+	  c = c->next_stmt;
+	  /* Unlink prev.  */
+	  c->previous_stmt->previous_stmt->next_stmt = c;
+	  c->previous_stmt = c->previous_stmt->previous_stmt;
+	}
+      while ((c != (ffestwCase) &s->first_rel) && (casenum == c->casenum));
+      fputc (')', dmpout);
+    }
+
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree texprlow;
+    tree texprhigh;
+    tree tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
+    int pushok;
+    tree duplicate;
+
+    ffeste_emit_line_note_ ();
+
+    if (TREE_CODE (ffestw_select_texpr (block)) == ERROR_MARK)
+      {
+	clear_momentary ();
+	return;
+      }
+
+    if (ffestw_select_break (block))
+      expand_exit_something ();
+    else
+      ffestw_set_select_break (block, TRUE);
+
+    if ((c == NULL) || (casenum != c->casenum))
+      {
+	if (casenum == 0)	/* Intentional CASE DEFAULT. */
+	  {
+	    pushok = pushcase (NULL_TREE, 0, tlabel, &duplicate);
+	    assert (pushok == 0);
+	  }
+      }
+    else
+      do
+	{
+	  texprlow = (c->low == NULL) ? NULL_TREE
+	    : ffecom_constantunion (&ffebld_constant_union (c->low), s->type,
+		       s->kindtype, ffecom_tree_type[s->type][s->kindtype]);
+	  if (c->low != c->high)
+	    {
+	      texprhigh = (c->high == NULL) ? NULL_TREE
+		: ffecom_constantunion (&ffebld_constant_union (c->high),
+	      s->type, s->kindtype, ffecom_tree_type[s->type][s->kindtype]);
+	      pushok = pushcase_range (texprlow, texprhigh, convert,
+				       tlabel, &duplicate);
+	    }
+	  else
+	    pushok = pushcase (texprlow, convert, tlabel, &duplicate);
+	  assert (pushok == 0);
+	  c = c->next_stmt;
+	  /* Unlink prev.  */
+	  c->previous_stmt->previous_stmt->next_stmt = c;
+	  c->previous_stmt = c->previous_stmt->previous_stmt;
+	}
+      while ((c != (ffestwCase) &s->first_rel) && (casenum == c->casenum));
+
+    clear_momentary ();
+  }				/* ~~~handle character, character*1 */
+#else
+#error
+#endif
+}
+
+/* ffeste_R811 -- End a SELECT
+
+   ffeste_R811(TRUE);  */
+
+void
+ffeste_R811 (ffestw block)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ END_SELECT\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+
+  if (TREE_CODE (ffestw_select_texpr (block)) == ERROR_MARK)
+    {
+      clear_momentary ();
+      return;
+    }
+
+  expand_end_case (ffestw_select_texpr (block));
+  pop_momentary ();
+  clear_momentary ();		/* ~~~handle character and character*1 */
+#else
+#error
+#endif
+}
+
+/* Iterative DO statement.  */
+
+void
+ffeste_R819A (ffestw block, ffelab label UNUSED, ffebld var,
+	      ffebld start, ffelexToken start_token,
+	      ffebld end, ffelexToken end_token,
+	      ffebld incr, ffelexToken incr_token)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  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 ();
+      /* Don't bother replacing it with 1 yet.  */
+    }
+
+  if (label == NULL)
+    fputs ("+ DO_iterative_nonlabeled (", dmpout);
+  else
+    fprintf (dmpout, "+ DO_iterative_labeled %lu (", ffelab_value (label));
+  ffebld_dump (var);
+  fputc ('=', dmpout);
+  ffebld_dump (start);
+  fputc (',', dmpout);
+  ffebld_dump (end);
+  fputc (',', dmpout);
+  ffebld_dump (incr);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    ffeste_emit_line_note_ ();
+    ffecom_push_calltemps ();
+
+    /* Start the DO loop.  */
+
+    ffeste_begin_iterdo_ (block, NULL, NULL, NULL,
+			  var,
+			  start, start_token,
+			  end, end_token,
+			  incr, incr_token,
+			  "Iterative DO loop");
+
+    ffecom_pop_calltemps ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R819B -- DO WHILE statement
+
+   ffeste_R819B(construct_name,label_token,expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffeste_R819B (ffestw block, ffelab label UNUSED, ffebld expr)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  if (label == NULL)
+    fputs ("+ DO_WHILE_nonlabeled (", dmpout);
+  else
+    fprintf (dmpout, "+ DO_WHILE_labeled %lu (", ffelab_value (label));
+  ffebld_dump (expr);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    ffeste_emit_line_note_ ();
+    ffecom_push_calltemps ();
+
+    ffestw_set_do_hook (block, expand_start_loop (1));
+    ffestw_set_do_tvar (block, 0);	/* Means DO WHILE vs. iter DO. */
+    if (expr != NULL)
+      expand_exit_loop_if_false (0, ffecom_truth_value (ffecom_expr (expr)));
+
+    ffecom_pop_calltemps ();
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R825 -- END DO statement
+
+   ffeste_R825(name_token);
+
+   Make sure ffeste_kind_ identifies a DO block.  If not
+   NULL, make sure name_token gives the correct name.  Do whatever
+   is specific to seeing END DO with a DO-target label definition on it,
+   where the END DO is really treated as a CONTINUE (i.e. generate th
+   same code you would for CONTINUE).  ffeste_do handles the actual
+   generation of end-loop code.	 */
+
+void
+ffeste_R825 ()
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ END_DO_sugar\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  emit_nop ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R834 -- CYCLE statement
+
+   ffeste_R834(name_token);
+
+   Handle a CYCLE within a loop.  */
+
+void
+ffeste_R834 (ffestw block)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "+ CYCLE block #%lu\n", ffestw_blocknum (block));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  expand_continue_loop (ffestw_do_hook (block));
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R835 -- EXIT statement
+
+   ffeste_R835(name_token);
+
+   Handle a EXIT within a loop.	 */
+
+void
+ffeste_R835 (ffestw block)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "+ EXIT block #%lu\n", ffestw_blocknum (block));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  expand_exit_loop (ffestw_do_hook (block));
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R836 -- GOTO statement
+
+   ffeste_R836(label);
+
+   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
+ffeste_R836 (ffelab label)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "+ GOTO %lu\n", ffelab_value (label));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree glabel;
+
+    ffeste_emit_line_note_ ();
+    glabel = ffecom_lookup_label (label);
+    if ((glabel != NULL_TREE)
+	&& (TREE_CODE (glabel) != ERROR_MARK))
+      {
+	TREE_USED (glabel) = 1;
+	expand_goto (glabel);
+	clear_momentary ();
+      }
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R837 -- Computed GOTO statement
+
+   ffeste_R837(labels,count,expr);
+
+   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
+ffeste_R837 (ffelab *labels, int count, ffebld expr)
+{
+  int i;
+
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ CGOTO (", dmpout);
+  for (i = 0; i < count; ++i)
+    {
+      if (i != 0)
+	fputc (',', dmpout);
+      fprintf (dmpout, "%" ffelabValue_f "u", ffelab_value (labels[i]));
+    }
+  fputs ("),", dmpout);
+  ffebld_dump (expr);
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree texpr;
+    tree value;
+    tree tlabel;
+    int pushok;
+    tree duplicate;
+
+    ffeste_emit_line_note_ ();
+    ffecom_push_calltemps ();
+
+    texpr = ffecom_expr (expr);
+    expand_start_case (0, texpr, TREE_TYPE (texpr), "computed GOTO statement");
+    push_momentary ();		/* In case of lots of labels, keep clearing
+				   them out. */
+    for (i = 0; i < count; ++i)
+      {
+	value = build_int_2 (i + 1, 0);
+	tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
+
+	pushok = pushcase (value, convert, tlabel, &duplicate);
+	assert (pushok == 0);
+	tlabel = ffecom_lookup_label (labels[i]);
+	if ((tlabel == NULL_TREE)
+	    || (TREE_CODE (tlabel) == ERROR_MARK))
+	  continue;
+	TREE_USED (tlabel) = 1;
+	expand_goto (tlabel);
+	clear_momentary ();
+      }
+    pop_momentary ();
+    expand_end_case (texpr);
+
+    ffecom_pop_calltemps ();
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R838 -- ASSIGN statement
+
+   ffeste_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
+ffeste_R838 (ffelab label, ffebld target)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "+ ASSIGN %lu TO ", ffelab_value (label));
+  ffebld_dump (target);
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree expr_tree;
+    tree label_tree;
+    tree target_tree;
+
+    ffeste_emit_line_note_ ();
+    ffecom_push_calltemps ();
+
+    label_tree = ffecom_lookup_label (label);
+    if ((label_tree != NULL_TREE)
+	&& (TREE_CODE (label_tree) != ERROR_MARK))
+      {
+	label_tree = ffecom_1 (ADDR_EXPR,
+			       build_pointer_type (void_type_node),
+			       label_tree);
+	TREE_CONSTANT (label_tree) = 1;
+	target_tree = ffecom_expr_assign_w (target);
+	if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (target_tree)))
+	    < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (label_tree))))
+	  error ("ASSIGN to variable that is too small");
+	label_tree = convert (TREE_TYPE (target_tree), label_tree);
+	expr_tree = ffecom_modify (void_type_node,
+				   target_tree,
+				   label_tree);
+	expand_expr_stmt (expr_tree);
+	clear_momentary ();
+      }
+
+    ffecom_pop_calltemps ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R839 -- Assigned GOTO statement
+
+   ffeste_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
+ffeste_R839 (ffebld target)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ AGOTO ", dmpout);
+  ffebld_dump (target);
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree t;
+
+    ffeste_emit_line_note_ ();
+    ffecom_push_calltemps ();
+
+    t = ffecom_expr_assign (target);
+    if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (t)))
+	< GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node))))
+      error ("ASSIGNed GOTO target variable is too small");
+    expand_computed_goto (convert (TREE_TYPE (null_pointer_node), t));
+
+    ffecom_pop_calltemps ();
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R840 -- Arithmetic IF statement
+
+   ffeste_R840(expr,expr_token,neg,zero,pos);
+
+   Make sure the labels are valid; implement.  */
+
+void
+ffeste_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ IF_arithmetic (", dmpout);
+  ffebld_dump (expr);
+  fprintf (dmpout, ") %" ffelabValue_f "u,%" ffelabValue_f "u,%" ffelabValue_f "u\n",
+	   ffelab_value (neg), ffelab_value (zero), ffelab_value (pos));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree gneg = ffecom_lookup_label (neg);
+    tree gzero = ffecom_lookup_label (zero);
+    tree gpos = ffecom_lookup_label (pos);
+    tree texpr;
+
+    if ((gneg == NULL_TREE) || (gzero == NULL_TREE) || (gpos == NULL_TREE))
+      return;
+    if ((TREE_CODE (gneg) == ERROR_MARK)
+	|| (TREE_CODE (gzero) == ERROR_MARK)
+	|| (TREE_CODE (gpos) == ERROR_MARK))
+      return;
+
+    ffecom_push_calltemps ();
+
+    if (neg == zero)
+      if (neg == pos)
+	expand_goto (gzero);
+      else
+	{			/* IF (expr.LE.0) THEN GOTO neg/zero ELSE
+				   GOTO pos. */
+	  texpr = ffecom_expr (expr);
+	  texpr = ffecom_2 (LE_EXPR, integer_type_node,
+			    texpr,
+			    convert (TREE_TYPE (texpr),
+				     integer_zero_node));
+	  expand_start_cond (ffecom_truth_value (texpr), 0);
+	  expand_goto (gzero);
+	  expand_start_else ();
+	  expand_goto (gpos);
+	  expand_end_cond ();
+	}
+    else if (neg == pos)
+      {				/* IF (expr.NE.0) THEN GOTO neg/pos ELSE GOTO
+				   zero. */
+	texpr = ffecom_expr (expr);
+	texpr = ffecom_2 (NE_EXPR, integer_type_node,
+			  texpr,
+			  convert (TREE_TYPE (texpr),
+				   integer_zero_node));
+	expand_start_cond (ffecom_truth_value (texpr), 0);
+	expand_goto (gneg);
+	expand_start_else ();
+	expand_goto (gzero);
+	expand_end_cond ();
+      }
+    else if (zero == pos)
+      {				/* IF (expr.GE.0) THEN GOTO zero/pos ELSE
+				   GOTO neg. */
+	texpr = ffecom_expr (expr);
+	texpr = ffecom_2 (GE_EXPR, integer_type_node,
+			  texpr,
+			  convert (TREE_TYPE (texpr),
+				   integer_zero_node));
+	expand_start_cond (ffecom_truth_value (texpr), 0);
+	expand_goto (gzero);
+	expand_start_else ();
+	expand_goto (gneg);
+	expand_end_cond ();
+      }
+    else
+      {				/* Use a SAVE_EXPR in combo with:
+				   IF (expr.LT.0) THEN GOTO neg
+				   ELSEIF (expr.GT.0) THEN GOTO pos
+				   ELSE GOTO zero. */
+	tree expr_saved = ffecom_save_tree (ffecom_expr (expr));
+
+	texpr = ffecom_2 (LT_EXPR, integer_type_node,
+			  expr_saved,
+			  convert (TREE_TYPE (expr_saved),
+				   integer_zero_node));
+	expand_start_cond (ffecom_truth_value (texpr), 0);
+	expand_goto (gneg);
+	texpr = ffecom_2 (GT_EXPR, integer_type_node,
+			  expr_saved,
+			  convert (TREE_TYPE (expr_saved),
+				   integer_zero_node));
+	expand_start_elseif (ffecom_truth_value (texpr));
+	expand_goto (gpos);
+	expand_start_else ();
+	expand_goto (gzero);
+	expand_end_cond ();
+      }
+    ffeste_emit_line_note_ ();
+
+    ffecom_pop_calltemps ();
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R841 -- CONTINUE statement
+
+   ffeste_R841();  */
+
+void
+ffeste_R841 ()
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ CONTINUE\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_emit_line_note_ ();
+  emit_nop ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R842 -- STOP statement
+
+   ffeste_R842(expr);  */
+
+void
+ffeste_R842 (ffebld expr)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  if (expr == NULL)
+    {
+      fputs ("+ STOP\n", dmpout);
+    }
+  else
+    {
+      fputs ("+ STOP_coded ", dmpout);
+      ffebld_dump (expr);
+      fputc ('\n', dmpout);
+    }
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree callit;
+    ffelexToken msg;
+
+    ffeste_emit_line_note_ ();
+    if ((expr == NULL)
+	|| (ffeinfo_basictype (ffebld_info (expr))
+	    == FFEINFO_basictypeANY))
+      {
+	msg = ffelex_token_new_character ("", ffelex_token_where_line
+			       (ffesta_tokens[0]), ffelex_token_where_column
+					  (ffesta_tokens[0]));
+	expr = ffebld_new_conter (ffebld_constant_new_characterdefault
+				  (msg));
+	ffelex_token_kill (msg);
+	ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER,
+		    FFEINFO_kindtypeCHARACTERDEFAULT, 0, FFEINFO_kindENTITY,
+					    FFEINFO_whereCONSTANT, 0));
+      }
+    else if (ffeinfo_basictype (ffebld_info (expr))
+	     == FFEINFO_basictypeINTEGER)
+      {
+	char num[50];
+
+	assert (ffebld_op (expr) == FFEBLD_opCONTER);
+	assert (ffeinfo_kindtype (ffebld_info (expr))
+		== FFEINFO_kindtypeINTEGERDEFAULT);
+	sprintf (num, "%" ffetargetIntegerDefault_f "d",
+		 ffebld_constant_integer1 (ffebld_conter (expr)));
+	msg = ffelex_token_new_character (num, ffelex_token_where_line
+			       (ffesta_tokens[0]), ffelex_token_where_column
+					  (ffesta_tokens[0]));
+	expr = ffebld_new_conter (ffebld_constant_new_characterdefault
+				  (msg));
+	ffelex_token_kill (msg);
+	ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER,
+		    FFEINFO_kindtypeCHARACTERDEFAULT, 0, FFEINFO_kindENTITY,
+					    FFEINFO_whereCONSTANT, 0));
+      }
+    else
+      {
+	assert (ffeinfo_basictype (ffebld_info (expr))
+		== FFEINFO_basictypeCHARACTER);
+	assert (ffebld_op (expr) == FFEBLD_opCONTER);
+	assert (ffeinfo_kindtype (ffebld_info (expr))
+		== FFEINFO_kindtypeCHARACTERDEFAULT);
+      }
+
+    ffecom_push_calltemps ();
+    callit = ffecom_call_gfrt (FFECOM_gfrtSTOP,
+		    ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)));
+    ffecom_pop_calltemps ();
+    TREE_SIDE_EFFECTS (callit) = 1;
+    expand_expr_stmt (callit);
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R843 -- PAUSE statement
+
+   ffeste_R843(expr,expr_token);
+
+   Make sure statement is valid here; implement.  expr and expr_token are
+   both NULL if there was no expression.  */
+
+void
+ffeste_R843 (ffebld expr)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  if (expr == NULL)
+    {
+      fputs ("+ PAUSE\n", dmpout);
+    }
+  else
+    {
+      fputs ("+ PAUSE_coded ", dmpout);
+      ffebld_dump (expr);
+      fputc ('\n', dmpout);
+    }
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree callit;
+    ffelexToken msg;
+
+    ffeste_emit_line_note_ ();
+    if ((expr == NULL)
+	|| (ffeinfo_basictype (ffebld_info (expr))
+	    == FFEINFO_basictypeANY))
+      {
+	msg = ffelex_token_new_character ("", ffelex_token_where_line
+			       (ffesta_tokens[0]), ffelex_token_where_column
+					  (ffesta_tokens[0]));
+	expr = ffebld_new_conter (ffebld_constant_new_characterdefault
+				  (msg));
+	ffelex_token_kill (msg);
+	ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER,
+		    FFEINFO_kindtypeCHARACTERDEFAULT, 0, FFEINFO_kindENTITY,
+					    FFEINFO_whereCONSTANT, 0));
+      }
+    else if (ffeinfo_basictype (ffebld_info (expr))
+	     == FFEINFO_basictypeINTEGER)
+      {
+	char num[50];
+
+	assert (ffebld_op (expr) == FFEBLD_opCONTER);
+	assert (ffeinfo_kindtype (ffebld_info (expr))
+		== FFEINFO_kindtypeINTEGERDEFAULT);
+	sprintf (num, "%" ffetargetIntegerDefault_f "d",
+		 ffebld_constant_integer1 (ffebld_conter (expr)));
+	msg = ffelex_token_new_character (num, ffelex_token_where_line
+			       (ffesta_tokens[0]), ffelex_token_where_column
+					  (ffesta_tokens[0]));
+	expr = ffebld_new_conter (ffebld_constant_new_characterdefault
+				  (msg));
+	ffelex_token_kill (msg);
+	ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER,
+		    FFEINFO_kindtypeCHARACTERDEFAULT, 0, FFEINFO_kindENTITY,
+					    FFEINFO_whereCONSTANT, 0));
+      }
+    else
+      {
+	assert (ffeinfo_basictype (ffebld_info (expr))
+		== FFEINFO_basictypeCHARACTER);
+	assert (ffebld_op (expr) == FFEBLD_opCONTER);
+	assert (ffeinfo_kindtype (ffebld_info (expr))
+		== FFEINFO_kindtypeCHARACTERDEFAULT);
+      }
+
+    ffecom_push_calltemps ();
+    callit = ffecom_call_gfrt (FFECOM_gfrtPAUSE,
+		    ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)));
+    ffecom_pop_calltemps ();
+    TREE_SIDE_EFFECTS (callit) = 1;
+    expand_expr_stmt (callit);
+    clear_momentary ();
+  }
+#if 0				/* Old approach for phantom g77 run-time
+				   library. */
+  {
+    tree callit;
+
+    ffeste_emit_line_note_ ();
+    if (expr == NULL)
+      callit = ffecom_call_gfrt (FFECOM_gfrtPAUSENIL, NULL_TREE);
+    else if (ffeinfo_basictype (ffebld_info (expr))
+	     == FFEINFO_basictypeINTEGER)
+      {
+	ffecom_push_calltemps ();
+	callit = ffecom_call_gfrt (FFECOM_gfrtPAUSEINT,
+		    ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)));
+	ffecom_pop_calltemps ();
+      }
+    else
+      {
+	if (ffeinfo_basictype (ffebld_info (expr))
+	    != FFEINFO_basictypeCHARACTER)
+	  break;
+	ffecom_push_calltemps ();
+	callit = ffecom_call_gfrt (FFECOM_gfrtPAUSECHAR,
+		    ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)));
+	ffecom_pop_calltemps ();
+      }
+    TREE_SIDE_EFFECTS (callit) = 1;
+    expand_expr_stmt (callit);
+    clear_momentary ();
+  }
+#endif
+#else
+#error
+#endif
+}
+
+/* ffeste_R904 -- OPEN statement
+
+   ffeste_R904();
+
+   Make sure an OPEN is valid in the current context, and implement it.	 */
+
+void
+ffeste_R904 (ffestpOpenStmt *info)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ OPEN (", dmpout);
+  ffeste_subr_file_ ("UNIT", &info->open_spec[FFESTP_openixUNIT]);
+  ffeste_subr_file_ ("ACCESS", &info->open_spec[FFESTP_openixACCESS]);
+  ffeste_subr_file_ ("ACTION", &info->open_spec[FFESTP_openixACTION]);
+  ffeste_subr_file_ ("ASSOCIATEVARIABLE", &info->open_spec[FFESTP_openixASSOCIATEVARIABLE]);
+  ffeste_subr_file_ ("BLANK", &info->open_spec[FFESTP_openixBLANK]);
+  ffeste_subr_file_ ("BLOCKSIZE", &info->open_spec[FFESTP_openixBLOCKSIZE]);
+  ffeste_subr_file_ ("BUFFERCOUNT", &info->open_spec[FFESTP_openixBUFFERCOUNT]);
+  ffeste_subr_file_ ("CARRIAGECONTROL", &info->open_spec[FFESTP_openixCARRIAGECONTROL]);
+  ffeste_subr_file_ ("DEFAULTFILE", &info->open_spec[FFESTP_openixDEFAULTFILE]);
+  ffeste_subr_file_ ("DELIM", &info->open_spec[FFESTP_openixDELIM]);
+  ffeste_subr_file_ ("DISPOSE", &info->open_spec[FFESTP_openixDISPOSE]);
+  ffeste_subr_file_ ("ERR", &info->open_spec[FFESTP_openixERR]);
+  ffeste_subr_file_ ("EXTENDSIZE", &info->open_spec[FFESTP_openixEXTENDSIZE]);
+  ffeste_subr_file_ ("FILE", &info->open_spec[FFESTP_openixFILE]);
+  ffeste_subr_file_ ("FORM", &info->open_spec[FFESTP_openixFORM]);
+  ffeste_subr_file_ ("INITIALSIZE", &info->open_spec[FFESTP_openixINITIALSIZE]);
+  ffeste_subr_file_ ("IOSTAT", &info->open_spec[FFESTP_openixIOSTAT]);
+  ffeste_subr_file_ ("KEY", &info->open_spec[FFESTP_openixKEY]);
+  ffeste_subr_file_ ("MAXREC", &info->open_spec[FFESTP_openixMAXREC]);
+  ffeste_subr_file_ ("NOSPANBLOCKS", &info->open_spec[FFESTP_openixNOSPANBLOCKS]);
+  ffeste_subr_file_ ("ORGANIZATION", &info->open_spec[FFESTP_openixORGANIZATION]);
+  ffeste_subr_file_ ("PAD", &info->open_spec[FFESTP_openixPAD]);
+  ffeste_subr_file_ ("POSITION", &info->open_spec[FFESTP_openixPOSITION]);
+  ffeste_subr_file_ ("READONLY", &info->open_spec[FFESTP_openixREADONLY]);
+  ffeste_subr_file_ ("RECL", &info->open_spec[FFESTP_openixRECL]);
+  ffeste_subr_file_ ("RECORDTYPE", &info->open_spec[FFESTP_openixRECORDTYPE]);
+  ffeste_subr_file_ ("SHARED", &info->open_spec[FFESTP_openixSHARED]);
+  ffeste_subr_file_ ("STATUS", &info->open_spec[FFESTP_openixSTATUS]);
+  ffeste_subr_file_ ("USEROPEN", &info->open_spec[FFESTP_openixUSEROPEN]);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree args;
+    bool iostat;
+    bool errl;
+
+#define specified(something) (info->open_spec[something].kw_or_val_present)
+
+    ffeste_emit_line_note_ ();
+
+    iostat = specified (FFESTP_openixIOSTAT);
+    errl = specified (FFESTP_openixERR);
+
+    ffecom_push_calltemps ();
+
+    args = ffeste_io_olist_ (errl || iostat,
+			     info->open_spec[FFESTP_openixUNIT].u.expr,
+			     &info->open_spec[FFESTP_openixFILE],
+			     &info->open_spec[FFESTP_openixSTATUS],
+			     &info->open_spec[FFESTP_openixACCESS],
+			     &info->open_spec[FFESTP_openixFORM],
+			     &info->open_spec[FFESTP_openixRECL],
+			     &info->open_spec[FFESTP_openixBLANK]);
+
+    if (errl)
+      {
+	ffeste_io_err_
+	  = ffeste_io_abort_
+	  = ffecom_lookup_label
+	  (info->open_spec[FFESTP_openixERR].u.label);
+	ffeste_io_abort_is_temp_ = FALSE;
+      }
+    else
+      {
+	ffeste_io_err_ = NULL_TREE;
+
+	if ((ffeste_io_abort_is_temp_ = iostat))
+	  ffeste_io_abort_ = ffecom_temp_label ();
+	else
+	  ffeste_io_abort_ = NULL_TREE;
+      }
+
+    if (iostat)
+      {				/* IOSTAT= */
+	ffeste_io_iostat_is_temp_ = FALSE;
+	ffeste_io_iostat_ = ffecom_expr
+	  (info->open_spec[FFESTP_openixIOSTAT].u.expr);
+      }
+    else if (ffeste_io_abort_ != NULL_TREE)
+      {				/* no IOSTAT= but ERR= */
+	ffeste_io_iostat_is_temp_ = TRUE;
+	ffeste_io_iostat_
+	  = ffecom_push_tempvar (ffecom_integer_type_node,
+				 FFETARGET_charactersizeNONE, -1, FALSE);
+      }
+    else
+      {				/* no IOSTAT=, or ERR= */
+	ffeste_io_iostat_is_temp_ = FALSE;
+	ffeste_io_iostat_ = NULL_TREE;
+      }
+
+    /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
+       label, since we're gonna fall through to there anyway. */
+
+    ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFOPEN, args),
+		     !ffeste_io_abort_is_temp_);
+
+    /* If we've got a temp label, generate its code here. */
+
+    if (ffeste_io_abort_is_temp_)
+      {
+	DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
+	emit_nop ();
+	expand_label (ffeste_io_abort_);
+
+	assert (ffeste_io_err_ == NULL_TREE);
+      }
+
+    /* If we've got a temp iostat, pop the temp. */
+
+    if (ffeste_io_iostat_is_temp_)
+      ffecom_pop_tempvar (ffeste_io_iostat_);
+
+    ffecom_pop_calltemps ();
+
+#undef specified
+  }
+
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R907 -- CLOSE statement
+
+   ffeste_R907();
+
+   Make sure a CLOSE is valid in the current context, and implement it.	 */
+
+void
+ffeste_R907 (ffestpCloseStmt *info)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ CLOSE (", dmpout);
+  ffeste_subr_file_ ("UNIT", &info->close_spec[FFESTP_closeixUNIT]);
+  ffeste_subr_file_ ("ERR", &info->close_spec[FFESTP_closeixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->close_spec[FFESTP_closeixIOSTAT]);
+  ffeste_subr_file_ ("STATUS", &info->close_spec[FFESTP_closeixSTATUS]);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree args;
+    bool iostat;
+    bool errl;
+
+#define specified(something) (info->close_spec[something].kw_or_val_present)
+
+    ffeste_emit_line_note_ ();
+
+    iostat = specified (FFESTP_closeixIOSTAT);
+    errl = specified (FFESTP_closeixERR);
+
+    ffecom_push_calltemps ();
+
+    args = ffeste_io_cllist_ (errl || iostat,
+			      info->close_spec[FFESTP_closeixUNIT].u.expr,
+			      &info->close_spec[FFESTP_closeixSTATUS]);
+
+    if (errl)
+      {
+	ffeste_io_err_
+	  = ffeste_io_abort_
+	  = ffecom_lookup_label
+	  (info->close_spec[FFESTP_closeixERR].u.label);
+	ffeste_io_abort_is_temp_ = FALSE;
+      }
+    else
+      {
+	ffeste_io_err_ = NULL_TREE;
+
+	if ((ffeste_io_abort_is_temp_ = iostat))
+	  ffeste_io_abort_ = ffecom_temp_label ();
+	else
+	  ffeste_io_abort_ = NULL_TREE;
+      }
+
+    if (iostat)
+      {				/* IOSTAT= */
+	ffeste_io_iostat_is_temp_ = FALSE;
+	ffeste_io_iostat_ = ffecom_expr
+	  (info->close_spec[FFESTP_closeixIOSTAT].u.expr);
+      }
+    else if (ffeste_io_abort_ != NULL_TREE)
+      {				/* no IOSTAT= but ERR= */
+	ffeste_io_iostat_is_temp_ = TRUE;
+	ffeste_io_iostat_
+	  = ffecom_push_tempvar (ffecom_integer_type_node,
+				 FFETARGET_charactersizeNONE, -1, FALSE);
+      }
+    else
+      {				/* no IOSTAT=, or ERR= */
+	ffeste_io_iostat_is_temp_ = FALSE;
+	ffeste_io_iostat_ = NULL_TREE;
+      }
+
+    /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
+       label, since we're gonna fall through to there anyway. */
+
+    ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFCLOS, args),
+		     !ffeste_io_abort_is_temp_);
+
+    /* If we've got a temp label, generate its code here. */
+
+    if (ffeste_io_abort_is_temp_)
+      {
+	DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
+	emit_nop ();
+	expand_label (ffeste_io_abort_);
+
+	assert (ffeste_io_err_ == NULL_TREE);
+      }
+
+    /* If we've got a temp iostat, pop the temp. */
+
+    if (ffeste_io_iostat_is_temp_)
+      ffecom_pop_tempvar (ffeste_io_iostat_);
+
+    ffecom_pop_calltemps ();
+
+#undef specified
+  }
+
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R909_start -- READ(...) statement list begin
+
+   ffeste_R909_start(FALSE);
+
+   Verify that READ is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffeste_R909_start (ffestpReadStmt *info, bool only_format UNUSED,
+		   ffestvUnit unit, ffestvFormat format, bool rec,
+		   bool key UNUSED)
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  switch (format)
+    {
+    case FFESTV_formatNONE:
+      if (rec)
+	fputs ("+ READ_ufdac", dmpout);
+      else if (key)
+	fputs ("+ READ_ufidx", dmpout);
+      else
+	fputs ("+ READ_ufseq", dmpout);
+      break;
+
+    case FFESTV_formatLABEL:
+    case FFESTV_formatCHAREXPR:
+    case FFESTV_formatINTEXPR:
+      if (rec)
+	fputs ("+ READ_fmdac", dmpout);
+      else if (key)
+	fputs ("+ READ_fmidx", dmpout);
+      else if (unit == FFESTV_unitCHAREXPR)
+	fputs ("+ READ_fmint", dmpout);
+      else
+	fputs ("+ READ_fmseq", dmpout);
+      break;
+
+    case FFESTV_formatASTERISK:
+      if (unit == FFESTV_unitCHAREXPR)
+	fputs ("+ READ_lsint", dmpout);
+      else
+	fputs ("+ READ_lsseq", dmpout);
+      break;
+
+    case FFESTV_formatNAMELIST:
+      fputs ("+ READ_nlseq", dmpout);
+      break;
+
+    default:
+      assert ("Unexpected kind of format item in R909 READ" == NULL);
+    }
+
+  if (only_format)
+    {
+      fputc (' ', dmpout);
+      ffeste_subr_file_ ("FORMAT", &info->read_spec[FFESTP_readixFORMAT]);
+      fputc (' ', dmpout);
+
+      return;
+    }
+
+  fputs (" (", dmpout);
+  ffeste_subr_file_ ("UNIT", &info->read_spec[FFESTP_readixUNIT]);
+  ffeste_subr_file_ ("FORMAT", &info->read_spec[FFESTP_readixFORMAT]);
+  ffeste_subr_file_ ("ADVANCE", &info->read_spec[FFESTP_readixADVANCE]);
+  ffeste_subr_file_ ("EOR", &info->read_spec[FFESTP_readixEOR]);
+  ffeste_subr_file_ ("ERR", &info->read_spec[FFESTP_readixERR]);
+  ffeste_subr_file_ ("END", &info->read_spec[FFESTP_readixEND]);
+  ffeste_subr_file_ ("IOSTAT", &info->read_spec[FFESTP_readixIOSTAT]);
+  ffeste_subr_file_ ("KEYEQ", &info->read_spec[FFESTP_readixKEYEQ]);
+  ffeste_subr_file_ ("KEYGE", &info->read_spec[FFESTP_readixKEYGE]);
+  ffeste_subr_file_ ("KEYGT", &info->read_spec[FFESTP_readixKEYGT]);
+  ffeste_subr_file_ ("KEYID", &info->read_spec[FFESTP_readixKEYID]);
+  ffeste_subr_file_ ("NULLS", &info->read_spec[FFESTP_readixNULLS]);
+  ffeste_subr_file_ ("REC", &info->read_spec[FFESTP_readixREC]);
+  ffeste_subr_file_ ("SIZE", &info->read_spec[FFESTP_readixSIZE]);
+  fputs (") ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+
+#define specified(something) (info->read_spec[something].kw_or_val_present)
+
+  ffeste_emit_line_note_ ();
+
+  /* Do the real work. */
+
+  {
+    ffecomGfrt start;
+    ffecomGfrt end;
+    tree cilist;
+    bool iostat;
+    bool errl;
+    bool endl;
+
+    /* First determine the start, per-item, and end run-time functions to
+       call.  The per-item function is picked by choosing an ffeste functio
+       to call to handle a given item; it knows how to generate a call to the
+       appropriate run-time function, and is called an "io driver".  It
+       handles the implied-DO construct, for example. */
+
+    switch (format)
+      {
+      case FFESTV_formatNONE:	/* no FMT= */
+	ffeste_io_driver_ = ffeste_io_douio_;
+	if (rec)
+	  start = FFECOM_gfrtSRDUE, end = FFECOM_gfrtERDUE;
+#if 0
+	else if (key)
+	  start = FFECOM_gfrtSRIUE, end = FFECOM_gfrtERIUE;
+#endif
+	else
+	  start = FFECOM_gfrtSRSUE, end = FFECOM_gfrtERSUE;
+	break;
+
+      case FFESTV_formatLABEL:	/* FMT=10 */
+      case FFESTV_formatCHAREXPR:	/* FMT='(I10)' */
+      case FFESTV_formatINTEXPR:	/* FMT=I [after ASSIGN 10 TO I] */
+	ffeste_io_driver_ = ffeste_io_dofio_;
+	if (rec)
+	  start = FFECOM_gfrtSRDFE, end = FFECOM_gfrtERDFE;
+#if 0
+	else if (key)
+	  start = FFECOM_gfrtSRIFE, end = FFECOM_gfrtERIFE;
+#endif
+	else if (unit == FFESTV_unitCHAREXPR)
+	  start = FFECOM_gfrtSRSFI, end = FFECOM_gfrtERSFI;
+	else
+	  start = FFECOM_gfrtSRSFE, end = FFECOM_gfrtERSFE;
+	break;
+
+      case FFESTV_formatASTERISK:	/* FMT=* */
+	ffeste_io_driver_ = ffeste_io_dolio_;
+	if (unit == FFESTV_unitCHAREXPR)
+	  start = FFECOM_gfrtSRSLI, end = FFECOM_gfrtERSLI;
+	else
+	  start = FFECOM_gfrtSRSLE, end = FFECOM_gfrtERSLE;
+	break;
+
+      case FFESTV_formatNAMELIST:	/* FMT=FOO or NML=FOO [NAMELIST
+					   /FOO/] */
+	ffeste_io_driver_ = NULL;	/* No start or driver function. */
+	start = FFECOM_gfrtSRSNE, end = FFECOM_gfrt;
+	break;
+
+      default:
+	assert ("Weird stuff" == NULL);
+	start = FFECOM_gfrt, end = FFECOM_gfrt;
+	break;
+      }
+    ffeste_io_endgfrt_ = end;
+
+    iostat = specified (FFESTP_readixIOSTAT);
+    errl = specified (FFESTP_readixERR);
+    endl = specified (FFESTP_readixEND);
+
+    ffecom_push_calltemps ();
+
+    if (unit == FFESTV_unitCHAREXPR)
+      {
+	cilist = ffeste_io_icilist_ (errl || iostat,
+				  info->read_spec[FFESTP_readixUNIT].u.expr,
+				     endl || iostat, format,
+				     &info->read_spec[FFESTP_readixFORMAT]);
+      }
+    else
+      {
+	cilist = ffeste_io_cilist_ (errl || iostat, unit,
+				  info->read_spec[FFESTP_readixUNIT].u.expr,
+				    5, endl || iostat, format,
+				    &info->read_spec[FFESTP_readixFORMAT],
+				    rec,
+				  info->read_spec[FFESTP_readixREC].u.expr);
+      }
+
+    if (errl)
+      {				/* ERR= */
+	ffeste_io_err_
+	  = ffecom_lookup_label
+	  (info->read_spec[FFESTP_readixERR].u.label);
+
+	if (endl)
+	  {			/* ERR= END= */
+	    ffeste_io_end_
+	      = ffecom_lookup_label
+	      (info->read_spec[FFESTP_readixEND].u.label);
+	    ffeste_io_abort_is_temp_ = TRUE;
+	    ffeste_io_abort_ = ffecom_temp_label ();
+	  }
+	else
+	  {			/* ERR= but no END= */
+	    ffeste_io_end_ = NULL_TREE;
+	    if ((ffeste_io_abort_is_temp_ = iostat))
+	      ffeste_io_abort_ = ffecom_temp_label ();
+	    else
+	      ffeste_io_abort_ = ffeste_io_err_;
+	  }
+      }
+    else
+      {				/* no ERR= */
+	ffeste_io_err_ = NULL_TREE;
+	if (endl)
+	  {			/* END= but no ERR= */
+	    ffeste_io_end_
+	      = ffecom_lookup_label
+	      (info->read_spec[FFESTP_readixEND].u.label);
+	    if ((ffeste_io_abort_is_temp_ = iostat))
+	      ffeste_io_abort_ = ffecom_temp_label ();
+	    else
+	      ffeste_io_abort_ = ffeste_io_end_;
+	  }
+	else
+	  {			/* no ERR= or END= */
+	    ffeste_io_end_ = NULL_TREE;
+	    if ((ffeste_io_abort_is_temp_ = iostat))
+	      ffeste_io_abort_ = ffecom_temp_label ();
+	    else
+	      ffeste_io_abort_ = NULL_TREE;
+	  }
+      }
+
+    if (iostat)
+      {				/* IOSTAT= */
+	ffeste_io_iostat_is_temp_ = FALSE;
+	ffeste_io_iostat_ = ffecom_expr
+	  (info->read_spec[FFESTP_readixIOSTAT].u.expr);
+      }
+    else if (ffeste_io_abort_ != NULL_TREE)
+      {				/* no IOSTAT= but ERR= or END= or both */
+	ffeste_io_iostat_is_temp_ = TRUE;
+	ffeste_io_iostat_
+	  = ffecom_push_tempvar (ffecom_integer_type_node,
+				 FFETARGET_charactersizeNONE, -1, FALSE);
+      }
+    else
+      {				/* no IOSTAT=, ERR=, or END= */
+	ffeste_io_iostat_is_temp_ = FALSE;
+	ffeste_io_iostat_ = NULL_TREE;
+      }
+
+    /* If there is no end function, then there are no item functions (i.e.
+       it's a NAMELIST), and vice versa by the way.  In this situation, don't
+       generate the "if (iostat != 0) goto label;" if the label is temp abort
+       label, since we're gonna fall through to there anyway.  */
+
+    ffeste_io_call_ (ffecom_call_gfrt (start, cilist),
+		     !ffeste_io_abort_is_temp_ || (end != FFECOM_gfrt));
+  }
+
+#undef specified
+
+  push_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R909_item -- READ statement i/o item
+
+   ffeste_R909_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffeste_R909_item (ffebld expr, ffelexToken expr_token)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (expr);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  if (expr == NULL)
+    return;
+  while (ffebld_op (expr) == FFEBLD_opPAREN)
+    expr = ffebld_left (expr);	/* "READ *,(A)" -- really a bug in the user's
+				   code, but I've been told lots of code does
+				   this (blech)! */
+  if (ffebld_op (expr) == FFEBLD_opANY)
+    return;
+  if (ffebld_op (expr) == FFEBLD_opIMPDO)
+    ffeste_io_impdo_ (expr, expr_token);
+  else
+    ffeste_io_call_ ((*ffeste_io_driver_) (expr), TRUE);
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R909_finish -- READ statement list complete
+
+   ffeste_R909_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_R909_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+
+  /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
+     label, since we're gonna fall through to there anyway. */
+
+  {
+    if (ffeste_io_endgfrt_ != FFECOM_gfrt)
+      ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE),
+		       !ffeste_io_abort_is_temp_);
+
+    clear_momentary ();
+    pop_momentary ();
+
+    /* If we've got a temp label, generate its code here and have it fan out
+       to the END= or ERR= label as appropriate. */
+
+    if (ffeste_io_abort_is_temp_)
+      {
+	DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
+	emit_nop ();
+	expand_label (ffeste_io_abort_);
+
+	/* if (iostat<0) goto end_label; */
+
+	if ((ffeste_io_end_ != NULL_TREE)
+	    && (TREE_CODE (ffeste_io_end_) != ERROR_MARK))
+	  {
+	    expand_start_cond (ffecom_truth_value
+			       (ffecom_2 (LT_EXPR, integer_type_node,
+					  ffeste_io_iostat_,
+					  ffecom_integer_zero_node)),
+			       0);
+	    expand_goto (ffeste_io_end_);
+	    expand_end_cond ();
+	  }
+
+	/* if (iostat>0) goto err_label; */
+
+	if ((ffeste_io_err_ != NULL_TREE)
+	    && (TREE_CODE (ffeste_io_err_) != ERROR_MARK))
+	  {
+	    expand_start_cond (ffecom_truth_value
+			       (ffecom_2 (GT_EXPR, integer_type_node,
+					  ffeste_io_iostat_,
+					  ffecom_integer_zero_node)),
+			       0);
+	    expand_goto (ffeste_io_err_);
+	    expand_end_cond ();
+	  }
+
+      }
+
+    /* If we've got a temp iostat, pop the temp. */
+
+    if (ffeste_io_iostat_is_temp_)
+      ffecom_pop_tempvar (ffeste_io_iostat_);
+
+    ffecom_pop_calltemps ();
+
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R910_start -- WRITE(...) statement list begin
+
+   ffeste_R910_start();
+
+   Verify that WRITE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffeste_R910_start (ffestpWriteStmt *info, ffestvUnit unit,
+		   ffestvFormat format, bool rec)
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  switch (format)
+    {
+    case FFESTV_formatNONE:
+      if (rec)
+	fputs ("+ WRITE_ufdac (", dmpout);
+      else
+	fputs ("+ WRITE_ufseq_or_idx (", dmpout);
+      break;
+
+    case FFESTV_formatLABEL:
+    case FFESTV_formatCHAREXPR:
+    case FFESTV_formatINTEXPR:
+      if (rec)
+	fputs ("+ WRITE_fmdac (", dmpout);
+      else if (unit == FFESTV_unitCHAREXPR)
+	fputs ("+ WRITE_fmint (", dmpout);
+      else
+	fputs ("+ WRITE_fmseq_or_idx (", dmpout);
+      break;
+
+    case FFESTV_formatASTERISK:
+      if (unit == FFESTV_unitCHAREXPR)
+	fputs ("+ WRITE_lsint (", dmpout);
+      else
+	fputs ("+ WRITE_lsseq (", dmpout);
+      break;
+
+    case FFESTV_formatNAMELIST:
+      fputs ("+ WRITE_nlseq (", dmpout);
+      break;
+
+    default:
+      assert ("Unexpected kind of format item in R910 WRITE" == NULL);
+    }
+
+  ffeste_subr_file_ ("UNIT", &info->write_spec[FFESTP_writeixUNIT]);
+  ffeste_subr_file_ ("FORMAT", &info->write_spec[FFESTP_writeixFORMAT]);
+  ffeste_subr_file_ ("ADVANCE", &info->write_spec[FFESTP_writeixADVANCE]);
+  ffeste_subr_file_ ("EOR", &info->write_spec[FFESTP_writeixEOR]);
+  ffeste_subr_file_ ("ERR", &info->write_spec[FFESTP_writeixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->write_spec[FFESTP_writeixIOSTAT]);
+  ffeste_subr_file_ ("REC", &info->write_spec[FFESTP_writeixREC]);
+  fputs (") ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+
+#define specified(something) (info->write_spec[something].kw_or_val_present)
+
+  ffeste_emit_line_note_ ();
+
+  /* Do the real work. */
+
+  {
+    ffecomGfrt start;
+    ffecomGfrt end;
+    tree cilist;
+    bool iostat;
+    bool errl;
+
+    /* First determine the start, per-item, and end run-time functions to
+       call.  The per-item function is picked by choosing an ffeste functio
+       to call to handle a given item; it knows how to generate a call to the
+       appropriate run-time function, and is called an "io driver".  It
+       handles the implied-DO construct, for example. */
+
+    switch (format)
+      {
+      case FFESTV_formatNONE:	/* no FMT= */
+	ffeste_io_driver_ = ffeste_io_douio_;
+	if (rec)
+	  start = FFECOM_gfrtSWDUE, end = FFECOM_gfrtEWDUE;
+	else
+	  start = FFECOM_gfrtSWSUE, end = FFECOM_gfrtEWSUE;
+	break;
+
+      case FFESTV_formatLABEL:	/* FMT=10 */
+      case FFESTV_formatCHAREXPR:	/* FMT='(I10)' */
+      case FFESTV_formatINTEXPR:	/* FMT=I [after ASSIGN 10 TO I] */
+	ffeste_io_driver_ = ffeste_io_dofio_;
+	if (rec)
+	  start = FFECOM_gfrtSWDFE, end = FFECOM_gfrtEWDFE;
+	else if (unit == FFESTV_unitCHAREXPR)
+	  start = FFECOM_gfrtSWSFI, end = FFECOM_gfrtEWSFI;
+	else
+	  start = FFECOM_gfrtSWSFE, end = FFECOM_gfrtEWSFE;
+	break;
+
+      case FFESTV_formatASTERISK:	/* FMT=* */
+	ffeste_io_driver_ = ffeste_io_dolio_;
+	if (unit == FFESTV_unitCHAREXPR)
+	  start = FFECOM_gfrtSWSLI, end = FFECOM_gfrtEWSLI;
+	else
+	  start = FFECOM_gfrtSWSLE, end = FFECOM_gfrtEWSLE;
+	break;
+
+      case FFESTV_formatNAMELIST:	/* FMT=FOO or NML=FOO [NAMELIST
+					   /FOO/] */
+	ffeste_io_driver_ = NULL;	/* No start or driver function. */
+	start = FFECOM_gfrtSWSNE, end = FFECOM_gfrt;
+	break;
+
+      default:
+	assert ("Weird stuff" == NULL);
+	start = FFECOM_gfrt, end = FFECOM_gfrt;
+	break;
+      }
+    ffeste_io_endgfrt_ = end;
+
+    iostat = specified (FFESTP_writeixIOSTAT);
+    errl = specified (FFESTP_writeixERR);
+
+    ffecom_push_calltemps ();
+
+    if (unit == FFESTV_unitCHAREXPR)
+      {
+	cilist = ffeste_io_icilist_ (errl || iostat,
+				info->write_spec[FFESTP_writeixUNIT].u.expr,
+				     FALSE, format,
+				   &info->write_spec[FFESTP_writeixFORMAT]);
+      }
+    else
+      {
+	cilist = ffeste_io_cilist_ (errl || iostat, unit,
+				info->write_spec[FFESTP_writeixUNIT].u.expr,
+				    6, FALSE, format,
+				    &info->write_spec[FFESTP_writeixFORMAT],
+				    rec,
+				info->write_spec[FFESTP_writeixREC].u.expr);
+      }
+
+    ffeste_io_end_ = NULL_TREE;
+
+    if (errl)
+      {				/* ERR= */
+	ffeste_io_err_
+	  = ffeste_io_abort_
+	  = ffecom_lookup_label
+	  (info->write_spec[FFESTP_writeixERR].u.label);
+	ffeste_io_abort_is_temp_ = FALSE;
+      }
+    else
+      {				/* no ERR= */
+	ffeste_io_err_ = NULL_TREE;
+
+	if ((ffeste_io_abort_is_temp_ = iostat))
+	  ffeste_io_abort_ = ffecom_temp_label ();
+	else
+	  ffeste_io_abort_ = NULL_TREE;
+      }
+
+    if (iostat)
+      {				/* IOSTAT= */
+	ffeste_io_iostat_is_temp_ = FALSE;
+	ffeste_io_iostat_ = ffecom_expr
+	  (info->write_spec[FFESTP_writeixIOSTAT].u.expr);
+      }
+    else if (ffeste_io_abort_ != NULL_TREE)
+      {				/* no IOSTAT= but ERR= */
+	ffeste_io_iostat_is_temp_ = TRUE;
+	ffeste_io_iostat_
+	  = ffecom_push_tempvar (ffecom_integer_type_node,
+				 FFETARGET_charactersizeNONE, -1, FALSE);
+      }
+    else
+      {				/* no IOSTAT=, or ERR= */
+	ffeste_io_iostat_is_temp_ = FALSE;
+	ffeste_io_iostat_ = NULL_TREE;
+      }
+
+    /* If there is no end function, then there are no item functions (i.e.
+       it's a NAMELIST), and vice versa by the way.  In this situation, don't
+       generate the "if (iostat != 0) goto label;" if the label is temp abort
+       label, since we're gonna fall through to there anyway.  */
+
+    ffeste_io_call_ (ffecom_call_gfrt (start, cilist),
+		     !ffeste_io_abort_is_temp_ || (end != FFECOM_gfrt));
+  }
+
+#undef specified
+
+  push_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R910_item -- WRITE statement i/o item
+
+   ffeste_R910_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffeste_R910_item (ffebld expr, ffelexToken expr_token)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (expr);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  if (expr == NULL)
+    return;
+  if (ffebld_op (expr) == FFEBLD_opANY)
+    return;
+  if (ffebld_op (expr) == FFEBLD_opIMPDO)
+    ffeste_io_impdo_ (expr, expr_token);
+  else
+    ffeste_io_call_ ((*ffeste_io_driver_) (expr), TRUE);
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R910_finish -- WRITE statement list complete
+
+   ffeste_R910_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_R910_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+
+  /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
+     label, since we're gonna fall through to there anyway. */
+
+  {
+    if (ffeste_io_endgfrt_ != FFECOM_gfrt)
+      ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE),
+		       !ffeste_io_abort_is_temp_);
+
+    clear_momentary ();
+    pop_momentary ();
+
+    /* If we've got a temp label, generate its code here. */
+
+    if (ffeste_io_abort_is_temp_)
+      {
+	DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
+	emit_nop ();
+	expand_label (ffeste_io_abort_);
+
+	assert (ffeste_io_err_ == NULL_TREE);
+      }
+
+    /* If we've got a temp iostat, pop the temp. */
+
+    if (ffeste_io_iostat_is_temp_)
+      ffecom_pop_tempvar (ffeste_io_iostat_);
+
+    ffecom_pop_calltemps ();
+
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R911_start -- PRINT statement list begin
+
+   ffeste_R911_start();
+
+   Verify that PRINT is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffeste_R911_start (ffestpPrintStmt *info, ffestvFormat format)
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  switch (format)
+    {
+    case FFESTV_formatLABEL:
+    case FFESTV_formatCHAREXPR:
+    case FFESTV_formatINTEXPR:
+      fputs ("+ PRINT_fm ", dmpout);
+      break;
+
+    case FFESTV_formatASTERISK:
+      fputs ("+ PRINT_ls ", dmpout);
+      break;
+
+    case FFESTV_formatNAMELIST:
+      fputs ("+ PRINT_nl ", dmpout);
+      break;
+
+    default:
+      assert ("Unexpected kind of format item in R911 PRINT" == NULL);
+    }
+  ffeste_subr_file_ ("FORMAT", &info->print_spec[FFESTP_printixFORMAT]);
+  fputc (' ', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+
+  ffeste_emit_line_note_ ();
+
+  /* Do the real work. */
+
+  {
+    ffecomGfrt start;
+    ffecomGfrt end;
+    tree cilist;
+
+    /* First determine the start, per-item, and end run-time functions to
+       call.  The per-item function is picked by choosing an ffeste functio
+       to call to handle a given item; it knows how to generate a call to the
+       appropriate run-time function, and is called an "io driver".  It
+       handles the implied-DO construct, for example. */
+
+    switch (format)
+      {
+      case FFESTV_formatLABEL:	/* FMT=10 */
+      case FFESTV_formatCHAREXPR:	/* FMT='(I10)' */
+      case FFESTV_formatINTEXPR:	/* FMT=I [after ASSIGN 10 TO I] */
+	ffeste_io_driver_ = ffeste_io_dofio_;
+	start = FFECOM_gfrtSWSFE, end = FFECOM_gfrtEWSFE;
+	break;
+
+      case FFESTV_formatASTERISK:	/* FMT=* */
+	ffeste_io_driver_ = ffeste_io_dolio_;
+	start = FFECOM_gfrtSWSLE, end = FFECOM_gfrtEWSLE;
+	break;
+
+      case FFESTV_formatNAMELIST:	/* FMT=FOO or NML=FOO [NAMELIST
+					   /FOO/] */
+	ffeste_io_driver_ = NULL;	/* No start or driver function. */
+	start = FFECOM_gfrtSWSNE, end = FFECOM_gfrt;
+	break;
+
+      default:
+	assert ("Weird stuff" == NULL);
+	start = FFECOM_gfrt, end = FFECOM_gfrt;
+	break;
+      }
+    ffeste_io_endgfrt_ = end;
+
+    ffecom_push_calltemps ();
+
+    cilist = ffeste_io_cilist_ (FALSE, FFESTV_unitNONE, NULL, 6, FALSE, format,
+		      &info->print_spec[FFESTP_printixFORMAT], FALSE, NULL);
+
+    ffeste_io_end_ = NULL_TREE;
+    ffeste_io_err_ = NULL_TREE;
+    ffeste_io_abort_ = NULL_TREE;
+    ffeste_io_abort_is_temp_ = FALSE;
+    ffeste_io_iostat_is_temp_ = FALSE;
+    ffeste_io_iostat_ = NULL_TREE;
+
+    /* If there is no end function, then there are no item functions (i.e.
+       it's a NAMELIST), and vice versa by the way.  In this situation, don't
+       generate the "if (iostat != 0) goto label;" if the label is temp abort
+       label, since we're gonna fall through to there anyway.  */
+
+    ffeste_io_call_ (ffecom_call_gfrt (start, cilist),
+		     !ffeste_io_abort_is_temp_ || (end != FFECOM_gfrt));
+  }
+
+  push_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R911_item -- PRINT statement i/o item
+
+   ffeste_R911_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffeste_R911_item (ffebld expr, ffelexToken expr_token)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (expr);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  if (expr == NULL)
+    return;
+  if (ffebld_op (expr) == FFEBLD_opANY)
+    return;
+  if (ffebld_op (expr) == FFEBLD_opIMPDO)
+    ffeste_io_impdo_ (expr, expr_token);
+  else
+    ffeste_io_call_ ((*ffeste_io_driver_) (expr), FALSE);
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R911_finish -- PRINT statement list complete
+
+   ffeste_R911_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_R911_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    if (ffeste_io_endgfrt_ != FFECOM_gfrt)
+      ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE),
+		       FALSE);
+
+    ffecom_pop_calltemps ();
+
+    clear_momentary ();
+    pop_momentary ();
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R919 -- BACKSPACE statement
+
+   ffeste_R919();
+
+   Make sure a BACKSPACE is valid in the current context, and implement it.  */
+
+void
+ffeste_R919 (ffestpBeruStmt *info)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ BACKSPACE (", dmpout);
+  ffeste_subr_file_ ("UNIT", &info->beru_spec[FFESTP_beruixUNIT]);
+  ffeste_subr_file_ ("ERR", &info->beru_spec[FFESTP_beruixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_subr_beru_ (info, FFECOM_gfrtFBACK);
+#else
+#error
+#endif
+}
+
+/* ffeste_R920 -- ENDFILE statement
+
+   ffeste_R920();
+
+   Make sure a ENDFILE is valid in the current context, and implement it.  */
+
+void
+ffeste_R920 (ffestpBeruStmt *info)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ ENDFILE (", dmpout);
+  ffeste_subr_file_ ("UNIT", &info->beru_spec[FFESTP_beruixUNIT]);
+  ffeste_subr_file_ ("ERR", &info->beru_spec[FFESTP_beruixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_subr_beru_ (info, FFECOM_gfrtFEND);
+#else
+#error
+#endif
+}
+
+/* ffeste_R921 -- REWIND statement
+
+   ffeste_R921();
+
+   Make sure a REWIND is valid in the current context, and implement it.  */
+
+void
+ffeste_R921 (ffestpBeruStmt *info)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ REWIND (", dmpout);
+  ffeste_subr_file_ ("UNIT", &info->beru_spec[FFESTP_beruixUNIT]);
+  ffeste_subr_file_ ("ERR", &info->beru_spec[FFESTP_beruixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  ffeste_subr_beru_ (info, FFECOM_gfrtFREW);
+#else
+#error
+#endif
+}
+
+/* ffeste_R923A -- INQUIRE statement (non-IOLENGTH version)
+
+   ffeste_R923A(bool by_file);
+
+   Make sure an INQUIRE is valid in the current context, and implement it.  */
+
+void
+ffeste_R923A (ffestpInquireStmt *info, bool by_file UNUSED)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  if (by_file)
+    {
+      fputs ("+ INQUIRE_file (", dmpout);
+      ffeste_subr_file_ ("FILE", &info->inquire_spec[FFESTP_inquireixFILE]);
+    }
+  else
+    {
+      fputs ("+ INQUIRE_unit (", dmpout);
+      ffeste_subr_file_ ("UNIT", &info->inquire_spec[FFESTP_inquireixUNIT]);
+    }
+  ffeste_subr_file_ ("ACCESS", &info->inquire_spec[FFESTP_inquireixACCESS]);
+  ffeste_subr_file_ ("ACTION", &info->inquire_spec[FFESTP_inquireixACTION]);
+  ffeste_subr_file_ ("BLANK", &info->inquire_spec[FFESTP_inquireixBLANK]);
+  ffeste_subr_file_ ("CARRIAGECONTROL", &info->inquire_spec[FFESTP_inquireixCARRIAGECONTROL]);
+  ffeste_subr_file_ ("DEFAULTFILE", &info->inquire_spec[FFESTP_inquireixDEFAULTFILE]);
+  ffeste_subr_file_ ("DELIM", &info->inquire_spec[FFESTP_inquireixDELIM]);
+  ffeste_subr_file_ ("DIRECT", &info->inquire_spec[FFESTP_inquireixDIRECT]);
+  ffeste_subr_file_ ("ERR", &info->inquire_spec[FFESTP_inquireixERR]);
+  ffeste_subr_file_ ("EXIST", &info->inquire_spec[FFESTP_inquireixEXIST]);
+  ffeste_subr_file_ ("FORM", &info->inquire_spec[FFESTP_inquireixFORM]);
+  ffeste_subr_file_ ("FORMATTED", &info->inquire_spec[FFESTP_inquireixFORMATTED]);
+  ffeste_subr_file_ ("IOSTAT", &info->inquire_spec[FFESTP_inquireixIOSTAT]);
+  ffeste_subr_file_ ("KEYED", &info->inquire_spec[FFESTP_inquireixKEYED]);
+  ffeste_subr_file_ ("NAME", &info->inquire_spec[FFESTP_inquireixNAME]);
+  ffeste_subr_file_ ("NAMED", &info->inquire_spec[FFESTP_inquireixNAMED]);
+  ffeste_subr_file_ ("NEXTREC", &info->inquire_spec[FFESTP_inquireixNEXTREC]);
+  ffeste_subr_file_ ("NUMBER", &info->inquire_spec[FFESTP_inquireixNUMBER]);
+  ffeste_subr_file_ ("OPENED", &info->inquire_spec[FFESTP_inquireixOPENED]);
+  ffeste_subr_file_ ("ORGANIZATION", &info->inquire_spec[FFESTP_inquireixORGANIZATION]);
+  ffeste_subr_file_ ("PAD", &info->inquire_spec[FFESTP_inquireixPAD]);
+  ffeste_subr_file_ ("POSITION", &info->inquire_spec[FFESTP_inquireixPOSITION]);
+  ffeste_subr_file_ ("READ", &info->inquire_spec[FFESTP_inquireixREAD]);
+  ffeste_subr_file_ ("READWRITE", &info->inquire_spec[FFESTP_inquireixREADWRITE]);
+  ffeste_subr_file_ ("RECL", &info->inquire_spec[FFESTP_inquireixRECL]);
+  ffeste_subr_file_ ("RECORDTYPE", &info->inquire_spec[FFESTP_inquireixRECORDTYPE]);
+  ffeste_subr_file_ ("SEQUENTIAL", &info->inquire_spec[FFESTP_inquireixSEQUENTIAL]);
+  ffeste_subr_file_ ("UNFORMATTED", &info->inquire_spec[FFESTP_inquireixUNFORMATTED]);
+  ffeste_subr_file_ ("WRITE", &info->inquire_spec[FFESTP_inquireixWRITE]);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree args;
+    bool iostat;
+    bool errl;
+
+#define specified(something) (info->inquire_spec[something].kw_or_val_present)
+
+    ffeste_emit_line_note_ ();
+
+    iostat = specified (FFESTP_inquireixIOSTAT);
+    errl = specified (FFESTP_inquireixERR);
+
+    ffecom_push_calltemps ();
+
+    args = ffeste_io_inlist_ (errl || iostat,
+			      &info->inquire_spec[FFESTP_inquireixUNIT],
+			      &info->inquire_spec[FFESTP_inquireixFILE],
+			      &info->inquire_spec[FFESTP_inquireixEXIST],
+			      &info->inquire_spec[FFESTP_inquireixOPENED],
+			      &info->inquire_spec[FFESTP_inquireixNUMBER],
+			      &info->inquire_spec[FFESTP_inquireixNAMED],
+			      &info->inquire_spec[FFESTP_inquireixNAME],
+			      &info->inquire_spec[FFESTP_inquireixACCESS],
+			    &info->inquire_spec[FFESTP_inquireixSEQUENTIAL],
+			      &info->inquire_spec[FFESTP_inquireixDIRECT],
+			      &info->inquire_spec[FFESTP_inquireixFORM],
+			      &info->inquire_spec[FFESTP_inquireixFORMATTED],
+			   &info->inquire_spec[FFESTP_inquireixUNFORMATTED],
+			      &info->inquire_spec[FFESTP_inquireixRECL],
+			      &info->inquire_spec[FFESTP_inquireixNEXTREC],
+			      &info->inquire_spec[FFESTP_inquireixBLANK]);
+
+    if (errl)
+      {
+	ffeste_io_err_
+	  = ffeste_io_abort_
+	  = ffecom_lookup_label
+	  (info->inquire_spec[FFESTP_inquireixERR].u.label);
+	ffeste_io_abort_is_temp_ = FALSE;
+      }
+    else
+      {
+	ffeste_io_err_ = NULL_TREE;
+
+	if ((ffeste_io_abort_is_temp_ = iostat))
+	  ffeste_io_abort_ = ffecom_temp_label ();
+	else
+	  ffeste_io_abort_ = NULL_TREE;
+      }
+
+    if (iostat)
+      {				/* IOSTAT= */
+	ffeste_io_iostat_is_temp_ = FALSE;
+	ffeste_io_iostat_ = ffecom_expr
+	  (info->inquire_spec[FFESTP_inquireixIOSTAT].u.expr);
+      }
+    else if (ffeste_io_abort_ != NULL_TREE)
+      {				/* no IOSTAT= but ERR= */
+	ffeste_io_iostat_is_temp_ = TRUE;
+	ffeste_io_iostat_
+	  = ffecom_push_tempvar (ffecom_integer_type_node,
+				 FFETARGET_charactersizeNONE, -1, FALSE);
+      }
+    else
+      {				/* no IOSTAT=, or ERR= */
+	ffeste_io_iostat_is_temp_ = FALSE;
+	ffeste_io_iostat_ = NULL_TREE;
+      }
+
+    /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
+       label, since we're gonna fall through to there anyway. */
+
+    ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFINQU, args),
+		     !ffeste_io_abort_is_temp_);
+
+    /* If we've got a temp label, generate its code here. */
+
+    if (ffeste_io_abort_is_temp_)
+      {
+	DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
+	emit_nop ();
+	expand_label (ffeste_io_abort_);
+
+	assert (ffeste_io_err_ == NULL_TREE);
+      }
+
+    /* If we've got a temp iostat, pop the temp. */
+
+    if (ffeste_io_iostat_is_temp_)
+      ffecom_pop_tempvar (ffeste_io_iostat_);
+
+    ffecom_pop_calltemps ();
+
+#undef specified
+  }
+
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R923B_start -- INQUIRE(IOLENGTH=expr) statement list begin
+
+   ffeste_R923B_start();
+
+   Verify that INQUIRE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffeste_R923B_start (ffestpInquireStmt *info UNUSED)
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ INQUIRE (", dmpout);
+  ffeste_subr_file_ ("IOLENGTH", &info->inquire_spec[FFESTP_inquireixIOLENGTH]);
+  fputs (") ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  assert ("INQUIRE(IOLENGTH=<var>) not implemented yet! ~~~" == NULL);
+  ffeste_emit_line_note_ ();
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R923B_item -- INQUIRE statement i/o item
+
+   ffeste_R923B_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffeste_R923B_item (ffebld expr UNUSED)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (expr);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R923B_finish -- INQUIRE statement list complete
+
+   ffeste_R923B_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_R923B_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R1001 -- FORMAT statement
+
+   ffeste_R1001(format_list);  */
+
+void
+ffeste_R1001 (ffests s)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "$ FORMAT %.*s\n", (int) ffests_length (s), ffests_text (s));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree t;
+    tree ttype;
+    tree maxindex;
+    tree var;
+
+    assert (ffeste_label_formatdef_ != NULL);
+
+    ffeste_emit_line_note_ ();
+
+    t = build_string (ffests_length (s), ffests_text (s));
+
+    TREE_TYPE (t)
+      = build_type_variant (build_array_type
+			    (char_type_node,
+			     build_range_type (integer_type_node,
+					       integer_one_node,
+					     build_int_2 (ffests_length (s),
+							  0))),
+			    1, 0);
+    TREE_CONSTANT (t) = 1;
+    TREE_STATIC (t) = 1;
+
+    push_obstacks_nochange ();
+    end_temporary_allocation ();
+
+    var = ffecom_lookup_label (ffeste_label_formatdef_);
+    if ((var != NULL_TREE)
+	&& (TREE_CODE (var) == VAR_DECL))
+      {
+	DECL_INITIAL (var) = t;
+	maxindex = build_int_2 (ffests_length (s) - 1, 0);
+	ttype = TREE_TYPE (var);
+	TYPE_DOMAIN (ttype) = build_range_type (integer_type_node,
+						integer_zero_node,
+						maxindex);
+	if (!TREE_TYPE (maxindex))
+	  TREE_TYPE (maxindex) = TYPE_DOMAIN (ttype);
+	layout_type (ttype);
+	rest_of_decl_compilation (var, NULL, 1, 0);
+	expand_decl (var);
+	expand_decl_init (var);
+      }
+
+    resume_temporary_allocation ();
+    pop_obstacks ();
+
+    ffeste_label_formatdef_ = NULL;
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R1103 -- End a PROGRAM
+
+   ffeste_R1103();  */
+
+void
+ffeste_R1103 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ END_PROGRAM\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_R1112 -- End a BLOCK DATA
+
+   ffeste_R1112(TRUE);	*/
+
+void
+ffeste_R1112 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("* END_BLOCK_DATA\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_R1212 -- CALL statement
+
+   ffeste_R1212(expr,expr_token);
+
+   Make sure statement is valid here; implement.  */
+
+void
+ffeste_R1212 (ffebld expr)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ CALL ", dmpout);
+  ffebld_dump (expr);
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    ffebld args = ffebld_right (expr);
+    ffebld arg;
+    ffebld labels = NULL;	/* First in list of LABTERs. */
+    ffebld prevlabels = NULL;
+    ffebld prevargs = NULL;
+
+    ffeste_emit_line_note_ ();
+
+    /* Here we split the list at ffebld_right(expr) into two lists: one at
+       ffebld_right(expr) consisting of all items that are not LABTERs, the
+       other at labels consisting of all items that are LABTERs.  Then, if
+       the latter list is NULL, we have an ordinary call, else we have a call
+       with alternate returns. */
+
+    for (args = ffebld_right (expr); args != NULL; args = ffebld_trail (args))
+      {
+	if (((arg = ffebld_head (args)) == NULL)
+	    || (ffebld_op (arg) != FFEBLD_opLABTER))
+	  {
+	    if (prevargs == NULL)
+	      {
+		prevargs = args;
+		ffebld_set_right (expr, args);
+	      }
+	    else
+	      {
+		ffebld_set_trail (prevargs, args);
+		prevargs = args;
+	      }
+	  }
+	else
+	  {
+	    if (prevlabels == NULL)
+	      {
+		prevlabels = labels = args;
+	      }
+	    else
+	      {
+		ffebld_set_trail (prevlabels, args);
+		prevlabels = args;
+	      }
+	  }
+      }
+    if (prevlabels == NULL)
+      labels = NULL;
+    else
+      ffebld_set_trail (prevlabels, NULL);
+    if (prevargs == NULL)
+      ffebld_set_right (expr, NULL);
+    else
+      ffebld_set_trail (prevargs, NULL);
+
+    if (labels == NULL)
+      expand_expr_stmt (ffecom_expr (expr));
+    else
+      {
+	tree texpr;
+	tree value;
+	tree tlabel;
+	int caseno;
+	int pushok;
+	tree duplicate;
+
+	texpr = ffecom_expr (expr);
+	expand_start_case (0, texpr, TREE_TYPE (texpr), "CALL statement");
+	push_momentary ();	/* In case of many labels, keep 'em cleared
+				   out. */
+	for (caseno = 1;
+	     labels != NULL;
+	     ++caseno, labels = ffebld_trail (labels))
+	  {
+	    value = build_int_2 (caseno, 0);
+	    tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
+
+	    pushok = pushcase (value, convert, tlabel, &duplicate);
+	    assert (pushok == 0);
+	    tlabel
+	      = ffecom_lookup_label (ffebld_labter (ffebld_head (labels)));
+	    if ((tlabel == NULL_TREE)
+		|| (TREE_CODE (tlabel) == ERROR_MARK))
+	      continue;
+	    TREE_USED (tlabel) = 1;
+	    expand_goto (tlabel);
+	    clear_momentary ();
+	  }
+
+	pop_momentary ();
+	expand_end_case (texpr);
+      }
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R1221 -- End a FUNCTION
+
+   ffeste_R1221(TRUE);	*/
+
+void
+ffeste_R1221 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ END_FUNCTION\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_R1225 -- End a SUBROUTINE
+
+   ffeste_R1225(TRUE);	*/
+
+void
+ffeste_R1225 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "+ END_SUBROUTINE\n");
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_R1226 -- ENTRY statement
+
+   ffeste_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
+ffeste_R1226 (ffesymbol entry)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fprintf (dmpout, "+ ENTRY %s", ffesymbol_text (entry));
+  if (ffesymbol_dummyargs (entry) != NULL)
+    {
+      ffebld argh;
+
+      fputc ('(', dmpout);
+      for (argh = ffesymbol_dummyargs (entry);
+	   argh != NULL;
+	   argh = ffebld_trail (argh))
+	{
+	  assert (ffebld_head (argh) != NULL);
+	  switch (ffebld_op (ffebld_head (argh)))
+	    {
+	    case FFEBLD_opSYMTER:
+	      fputs (ffesymbol_text (ffebld_symter (ffebld_head (argh))),
+		     dmpout);
+	      break;
+
+	    case FFEBLD_opSTAR:
+	      fputc ('*', dmpout);
+	      break;
+
+	    default:
+	      fputc ('?', dmpout);
+	      ffebld_dump (ffebld_head (argh));
+	      fputc ('?', dmpout);
+	      break;
+	    }
+	  if (ffebld_trail (argh) != NULL)
+	    fputc (',', dmpout);
+	}
+      fputc (')', dmpout);
+    }
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree label = ffesymbol_hook (entry).length_tree;
+
+    ffeste_emit_line_note_ ();
+
+    DECL_INITIAL (label) = error_mark_node;
+    emit_nop ();
+    expand_label (label);
+
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_R1227 -- RETURN statement
+
+   ffeste_R1227(expr);
+
+   Make sure statement is valid here; implement.  expr and expr_token are
+   both NULL if there was no expression.  */
+
+void
+ffeste_R1227 (ffestw block UNUSED, ffebld expr)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  if (expr == NULL)
+    {
+      fputs ("+ RETURN\n", dmpout);
+    }
+  else
+    {
+      fputs ("+ RETURN_alternate ", dmpout);
+      ffebld_dump (expr);
+      fputc ('\n', dmpout);
+    }
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+  {
+    tree rtn;
+
+    ffeste_emit_line_note_ ();
+    ffecom_push_calltemps ();
+
+    rtn = ffecom_return_expr (expr);
+
+    if ((rtn == NULL_TREE)
+	|| (rtn == error_mark_node))
+      expand_null_return ();
+    else
+      {
+	tree result = DECL_RESULT (current_function_decl);
+
+	if ((result != error_mark_node)
+	    && (TREE_TYPE (result) != error_mark_node))
+	  expand_return (ffecom_modify (NULL_TREE,
+					result,
+					convert (TREE_TYPE (result),
+						 rtn)));
+	else
+	  expand_null_return ();
+      }
+
+    ffecom_pop_calltemps ();
+    clear_momentary ();
+  }
+#else
+#error
+#endif
+}
+
+/* ffeste_V018_start -- REWRITE(...) statement list begin
+
+   ffeste_V018_start();
+
+   Verify that REWRITE is valid here, and begin accepting items in the
+   list.  */
+
+#if FFESTR_VXT
+void
+ffeste_V018_start (ffestpRewriteStmt *info, ffestvFormat format)
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  switch (format)
+    {
+    case FFESTV_formatNONE:
+      fputs ("+ REWRITE_uf (", dmpout);
+      break;
+
+    case FFESTV_formatLABEL:
+    case FFESTV_formatCHAREXPR:
+    case FFESTV_formatINTEXPR:
+      fputs ("+ REWRITE_fm (", dmpout);
+      break;
+
+    default:
+      assert ("Unexpected kind of format item in V018 REWRITE" == NULL);
+    }
+  ffeste_subr_file_ ("UNIT", &info->rewrite_spec[FFESTP_rewriteixUNIT]);
+  ffeste_subr_file_ ("FMT", &info->rewrite_spec[FFESTP_rewriteixFMT]);
+  ffeste_subr_file_ ("ERR", &info->rewrite_spec[FFESTP_rewriteixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->rewrite_spec[FFESTP_rewriteixIOSTAT]);
+  fputs (") ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V018_item -- REWRITE statement i/o item
+
+   ffeste_V018_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffeste_V018_item (ffebld expr)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (expr);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V018_finish -- REWRITE statement list complete
+
+   ffeste_V018_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_V018_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V019_start -- ACCEPT statement list begin
+
+   ffeste_V019_start();
+
+   Verify that ACCEPT is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffeste_V019_start (ffestpAcceptStmt *info, ffestvFormat format)
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  switch (format)
+    {
+    case FFESTV_formatLABEL:
+    case FFESTV_formatCHAREXPR:
+    case FFESTV_formatINTEXPR:
+      fputs ("+ ACCEPT_fm ", dmpout);
+      break;
+
+    case FFESTV_formatASTERISK:
+      fputs ("+ ACCEPT_ls ", dmpout);
+      break;
+
+    case FFESTV_formatNAMELIST:
+      fputs ("+ ACCEPT_nl ", dmpout);
+      break;
+
+    default:
+      assert ("Unexpected kind of format item in V019 ACCEPT" == NULL);
+    }
+  ffeste_subr_file_ ("FORMAT", &info->accept_spec[FFESTP_acceptixFORMAT]);
+  fputc (' ', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V019_item -- ACCEPT statement i/o item
+
+   ffeste_V019_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffeste_V019_item (ffebld expr)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (expr);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V019_finish -- ACCEPT statement list complete
+
+   ffeste_V019_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_V019_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+#endif
+/* ffeste_V020_start -- TYPE statement list begin
+
+   ffeste_V020_start();
+
+   Verify that TYPE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffeste_V020_start (ffestpTypeStmt *info UNUSED,
+		   ffestvFormat format UNUSED)
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  switch (format)
+    {
+    case FFESTV_formatLABEL:
+    case FFESTV_formatCHAREXPR:
+    case FFESTV_formatINTEXPR:
+      fputs ("+ TYPE_fm ", dmpout);
+      break;
+
+    case FFESTV_formatASTERISK:
+      fputs ("+ TYPE_ls ", dmpout);
+      break;
+
+    case FFESTV_formatNAMELIST:
+      fputs ("* TYPE_nl ", dmpout);
+      break;
+
+    default:
+      assert ("Unexpected kind of format item in V020 TYPE" == NULL);
+    }
+  ffeste_subr_file_ ("FORMAT", &info->type_spec[FFESTP_typeixFORMAT]);
+  fputc (' ', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V020_item -- TYPE statement i/o item
+
+   ffeste_V020_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffeste_V020_item (ffebld expr UNUSED)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (expr);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V020_finish -- TYPE statement list complete
+
+   ffeste_V020_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_V020_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V021 -- DELETE statement
+
+   ffeste_V021();
+
+   Make sure a DELETE is valid in the current context, and implement it.  */
+
+#if FFESTR_VXT
+void
+ffeste_V021 (ffestpDeleteStmt *info)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ DELETE (", dmpout);
+  ffeste_subr_file_ ("UNIT", &info->delete_spec[FFESTP_deleteixUNIT]);
+  ffeste_subr_file_ ("REC", &info->delete_spec[FFESTP_deleteixREC]);
+  ffeste_subr_file_ ("ERR", &info->delete_spec[FFESTP_deleteixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->delete_spec[FFESTP_deleteixIOSTAT]);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V022 -- UNLOCK statement
+
+   ffeste_V022();
+
+   Make sure a UNLOCK is valid in the current context, and implement it.  */
+
+void
+ffeste_V022 (ffestpBeruStmt *info)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ UNLOCK (", dmpout);
+  ffeste_subr_file_ ("UNIT", &info->beru_spec[FFESTP_beruixUNIT]);
+  ffeste_subr_file_ ("ERR", &info->beru_spec[FFESTP_beruixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V023_start -- ENCODE(...) statement list begin
+
+   ffeste_V023_start();
+
+   Verify that ENCODE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffeste_V023_start (ffestpVxtcodeStmt *info)
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ ENCODE (", dmpout);
+  ffeste_subr_file_ ("C", &info->vxtcode_spec[FFESTP_vxtcodeixC]);
+  ffeste_subr_file_ ("F", &info->vxtcode_spec[FFESTP_vxtcodeixF]);
+  ffeste_subr_file_ ("B", &info->vxtcode_spec[FFESTP_vxtcodeixB]);
+  ffeste_subr_file_ ("ERR", &info->vxtcode_spec[FFESTP_vxtcodeixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->vxtcode_spec[FFESTP_vxtcodeixIOSTAT]);
+  fputs (") ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V023_item -- ENCODE statement i/o item
+
+   ffeste_V023_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffeste_V023_item (ffebld expr)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (expr);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V023_finish -- ENCODE statement list complete
+
+   ffeste_V023_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_V023_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V024_start -- DECODE(...) statement list begin
+
+   ffeste_V024_start();
+
+   Verify that DECODE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffeste_V024_start (ffestpVxtcodeStmt *info)
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ DECODE (", dmpout);
+  ffeste_subr_file_ ("C", &info->vxtcode_spec[FFESTP_vxtcodeixC]);
+  ffeste_subr_file_ ("F", &info->vxtcode_spec[FFESTP_vxtcodeixF]);
+  ffeste_subr_file_ ("B", &info->vxtcode_spec[FFESTP_vxtcodeixB]);
+  ffeste_subr_file_ ("ERR", &info->vxtcode_spec[FFESTP_vxtcodeixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->vxtcode_spec[FFESTP_vxtcodeixIOSTAT]);
+  fputs (") ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V024_item -- DECODE statement i/o item
+
+   ffeste_V024_item(expr,expr_token);
+
+   Implement output-list expression.  */
+
+void
+ffeste_V024_item (ffebld expr)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (expr);
+  fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V024_finish -- DECODE statement list complete
+
+   ffeste_V024_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_V024_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V025_start -- DEFINEFILE statement list begin
+
+   ffeste_V025_start();
+
+   Verify that DEFINEFILE is valid here, and begin accepting items in the
+   list.  */
+
+void
+ffeste_V025_start ()
+{
+  ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ DEFINE_FILE ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V025_item -- DEFINE FILE statement item
+
+   ffeste_V025_item(u,ut,m,mt,n,nt,asv,asvt);
+
+   Implement item.  */
+
+void
+ffeste_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv)
+{
+  ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  ffebld_dump (u);
+  fputc ('(', dmpout);
+  ffebld_dump (m);
+  fputc (',', dmpout);
+  ffebld_dump (n);
+  fputs (",U,", dmpout);
+  ffebld_dump (asv);
+  fputs ("),", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V025_finish -- DEFINE FILE statement list complete
+
+   ffeste_V025_finish();
+
+   Just wrap up any local activities.  */
+
+void
+ffeste_V025_finish ()
+{
+  ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V026 -- FIND statement
+
+   ffeste_V026();
+
+   Make sure a FIND is valid in the current context, and implement it.	*/
+
+void
+ffeste_V026 (ffestpFindStmt *info)
+{
+  ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+  fputs ("+ FIND (", dmpout);
+  ffeste_subr_file_ ("UNIT", &info->find_spec[FFESTP_findixUNIT]);
+  ffeste_subr_file_ ("REC", &info->find_spec[FFESTP_findixREC]);
+  ffeste_subr_file_ ("ERR", &info->find_spec[FFESTP_findixERR]);
+  ffeste_subr_file_ ("IOSTAT", &info->find_spec[FFESTP_findixIOSTAT]);
+  fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+#endif