freebsd/contrib/gcc/f/ste.c

/* ste.c -- Implementation File (module.c template V1.0)
   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
   Contributed by James Craig Burley (burley@gnu.org).

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. */

#include "proj.h"

#if FFECOM_targetCURRENT == FFECOM_targetGCC
#include "rtl.j"
#include "toplev.j"
#endif

#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.  */

  tstart = ffecom_save_tree (tstart);

  expr = ffecom_2 (MINUS_EXPR, TREE_TYPE (tvar),
		   tend,
		   tstart);

  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);

  expr = ffecom_modify (void_type_node, tvar, tstart);
  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;
  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, NULL);
      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;
  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, NULL);
      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