gcc/f/std.c

/* std.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:
      st.c

   Description:
      Implements the various statements and such like.

   Modifications:
      21-Nov-91	 JCB  2.0
	 Split out actual code generation to ffeste.
*/

/* Include files. */

#include "proj.h"
#include "std.h"
#include "bld.h"
#include "com.h"
#include "lab.h"
#include "lex.h"
#include "malloc.h"
#include "sta.h"
#include "ste.h"
#include "stp.h"
#include "str.h"
#include "sts.h"
#include "stt.h"
#include "stv.h"
#include "stw.h"
#include "symbol.h"
#include "target.h"

/* Externals defined here. */


/* Simple definitions and enumerations. */

#define FFESTD_COPY_EASY_ 1	/* 1 for only one _subr_copy_xyz_ fn. */

#define FFESTD_IS_END_OPTIMIZED_ 1	/* 0=always gen STOP/RETURN before
					   END. */

typedef enum
  {
    FFESTD_stateletSIMPLE_,	/* Expecting simple/start. */
    FFESTD_stateletATTRIB_,	/* Expecting attrib/item/itemstart. */
    FFESTD_stateletITEM_,	/* Expecting item/itemstart/finish. */
    FFESTD_stateletITEMVALS_,	/* Expecting itemvalue/itemendvals. */
    FFESTD_
  } ffestdStatelet_;

#if FFECOM_TWOPASS
typedef enum
  {
    FFESTD_stmtidENDDOLOOP_,
    FFESTD_stmtidENDLOGIF_,
    FFESTD_stmtidEXECLABEL_,
    FFESTD_stmtidFORMATLABEL_,
    FFESTD_stmtidR737A_,	/* let */
    FFESTD_stmtidR803_,		/* IF-block */
    FFESTD_stmtidR804_,		/* ELSE IF */
    FFESTD_stmtidR805_,		/* ELSE */
    FFESTD_stmtidR806_,		/* END IF */
    FFESTD_stmtidR807_,		/* IF-logical */
    FFESTD_stmtidR809_,		/* SELECT CASE */
    FFESTD_stmtidR810_,		/* CASE */
    FFESTD_stmtidR811_,		/* END SELECT */
    FFESTD_stmtidR819A_,	/* DO-iterative */
    FFESTD_stmtidR819B_,	/* DO WHILE */
    FFESTD_stmtidR825_,		/* END DO */
    FFESTD_stmtidR834_,		/* CYCLE */
    FFESTD_stmtidR835_,		/* EXIT */
    FFESTD_stmtidR836_,		/* GOTO */
    FFESTD_stmtidR837_,		/* GOTO-computed */
    FFESTD_stmtidR838_,		/* ASSIGN */
    FFESTD_stmtidR839_,		/* GOTO-assigned */
    FFESTD_stmtidR840_,		/* IF-arithmetic */
    FFESTD_stmtidR841_,		/* CONTINUE */
    FFESTD_stmtidR842_,		/* STOP */
    FFESTD_stmtidR843_,		/* PAUSE */
    FFESTD_stmtidR904_,		/* OPEN */
    FFESTD_stmtidR907_,		/* CLOSE */
    FFESTD_stmtidR909_,		/* READ */
    FFESTD_stmtidR910_,		/* WRITE */
    FFESTD_stmtidR911_,		/* PRINT */
    FFESTD_stmtidR919_,		/* BACKSPACE */
    FFESTD_stmtidR920_,		/* ENDFILE */
    FFESTD_stmtidR921_,		/* REWIND */
    FFESTD_stmtidR923A_,	/* INQUIRE */
    FFESTD_stmtidR923B_,	/* INQUIRE-iolength */
    FFESTD_stmtidR1001_,	/* FORMAT */
    FFESTD_stmtidR1103_,	/* END_PROGRAM */
    FFESTD_stmtidR1112_,	/* END_BLOCK_DATA */
    FFESTD_stmtidR1212_,	/* CALL */
    FFESTD_stmtidR1221_,	/* END_FUNCTION */
    FFESTD_stmtidR1225_,	/* END_SUBROUTINE */
    FFESTD_stmtidR1226_,	/* ENTRY */
    FFESTD_stmtidR1227_,	/* RETURN */
#if FFESTR_VXT
    FFESTD_stmtidV018_,		/* REWRITE */
    FFESTD_stmtidV019_,		/* ACCEPT */
#endif
    FFESTD_stmtidV020_,		/* TYPE */
#if FFESTR_VXT
    FFESTD_stmtidV021_,		/* DELETE */
    FFESTD_stmtidV022_,		/* UNLOCK */
    FFESTD_stmtidV023_,		/* ENCODE */
    FFESTD_stmtidV024_,		/* DECODE */
    FFESTD_stmtidV025start_,	/* DEFINEFILE (start) */
    FFESTD_stmtidV025item_,	/* (DEFINEFILE item) */
    FFESTD_stmtidV025finish_,	/* (DEFINEFILE finish) */
    FFESTD_stmtidV026_,		/* FIND */
#endif
    FFESTD_stmtid_,
  } ffestdStmtId_;

#endif

/* Internal typedefs. */

typedef struct _ffestd_expr_item_ *ffestdExprItem_;
#if FFECOM_TWOPASS
typedef struct _ffestd_stmt_ *ffestdStmt_;
#endif

/* Private include files. */


/* Internal structure definitions. */

struct _ffestd_expr_item_
  {
    ffestdExprItem_ next;
    ffebld expr;
    ffelexToken token;
  };

#if FFECOM_TWOPASS
struct _ffestd_stmt_
  {
    ffestdStmt_ next;
    ffestdStmt_ previous;
    ffestdStmtId_ id;
#if FFECOM_targetCURRENT == FFECOM_targetGCC
    char *filename;
    int filelinenum;
#endif
    union
      {
	struct
	  {
	    ffestw block;
	  }
	enddoloop;
	struct
	  {
	    ffelab label;
	  }
	execlabel;
	struct
	  {
	    ffelab label;
	  }
	formatlabel;
	struct
	  {
	    mallocPool pool;
	    ffebld dest;
	    ffebld source;
	  }
	R737A;
	struct
	  {
	    mallocPool pool;
	    ffebld expr;
	  }
	R803;
	struct
	  {
	    mallocPool pool;
	    ffebld expr;
	  }
	R804;
	struct
	  {
	    mallocPool pool;
	    ffebld expr;
	  }
	R807;
	struct
	  {
	    mallocPool pool;
	    ffestw block;
	    ffebld expr;
	  }
	R809;
	struct
	  {
	    mallocPool pool;
	    ffestw block;
	    unsigned long casenum;
	  }
	R810;
	struct
	  {
	    ffestw block;
	  }
	R811;
	struct
	  {
	    mallocPool pool;
	    ffestw block;
	    ffelab label;
	    ffebld var;
	    ffebld start;
	    ffelexToken start_token;
	    ffebld end;
	    ffelexToken end_token;
	    ffebld incr;
	    ffelexToken incr_token;
	  }
	R819A;
	struct
	  {
	    mallocPool pool;
	    ffestw block;
	    ffelab label;
	    ffebld expr;
	  }
	R819B;
	struct
	  {
	    ffestw block;
	  }
	R834;
	struct
	  {
	    ffestw block;
	  }
	R835;
	struct
	  {
	    ffelab label;
	  }
	R836;
	struct
	  {
	    mallocPool pool;
	    ffelab *labels;
	    int count;
	    ffebld expr;
	  }
	R837;
	struct
	  {
	    mallocPool pool;
	    ffelab label;
	    ffebld target;
	  }
	R838;
	struct
	  {
	    mallocPool pool;
	    ffebld target;
	  }
	R839;
	struct
	  {
	    mallocPool pool;
	    ffebld expr;
	    ffelab neg;
	    ffelab zero;
	    ffelab pos;
	  }
	R840;
	struct
	  {
	    mallocPool pool;
	    ffebld expr;
	  }
	R842;
	struct
	  {
	    mallocPool pool;
	    ffebld expr;
	  }
	R843;
	struct
	  {
	    mallocPool pool;
	    ffestpOpenStmt *params;
	  }
	R904;
	struct
	  {
	    mallocPool pool;
	    ffestpCloseStmt *params;
	  }
	R907;
	struct
	  {
	    mallocPool pool;
	    ffestpReadStmt *params;
	    bool only_format;
	    ffestvUnit unit;
	    ffestvFormat format;
	    bool rec;
	    bool key;
	    ffestdExprItem_ list;
	  }
	R909;
	struct
	  {
	    mallocPool pool;
	    ffestpWriteStmt *params;
	    ffestvUnit unit;
	    ffestvFormat format;
	    bool rec;
	    ffestdExprItem_ list;
	  }
	R910;
	struct
	  {
	    mallocPool pool;
	    ffestpPrintStmt *params;
	    ffestvFormat format;
	    ffestdExprItem_ list;
	  }
	R911;
	struct
	  {
	    mallocPool pool;
	    ffestpBeruStmt *params;
	  }
	R919;
	struct
	  {
	    mallocPool pool;
	    ffestpBeruStmt *params;
	  }
	R920;
	struct
	  {
	    mallocPool pool;
	    ffestpBeruStmt *params;
	  }
	R921;
	struct
	  {
	    mallocPool pool;
	    ffestpInquireStmt *params;
	    bool by_file;
	  }
	R923A;
	struct
	  {
	    mallocPool pool;
	    ffestpInquireStmt *params;
	    ffestdExprItem_ list;
	  }
	R923B;
	struct
	  {
	    ffestsHolder str;
	  }
	R1001;
	struct
	  {
	    mallocPool pool;
	    ffebld expr;
	  }
	R1212;
	struct
	  {
	    ffesymbol entry;
	    int entrynum;
	  }
	R1226;
	struct
	  {
	    mallocPool pool;
	    ffestw block;
	    ffebld expr;
	  }
	R1227;
#if FFESTR_VXT
	struct
	  {
	    mallocPool pool;
	    ffestpRewriteStmt *params;
	    ffestvFormat format;
	    ffestdExprItem_ list;
	  }
	V018;
	struct
	  {
	    mallocPool pool;
	    ffestpAcceptStmt *params;
	    ffestvFormat format;
	    ffestdExprItem_ list;
	  }
	V019;
#endif
	struct
	  {
	    mallocPool pool;
	    ffestpTypeStmt *params;
	    ffestvFormat format;
	    ffestdExprItem_ list;
	  }
	V020;
#if FFESTR_VXT
	struct
	  {
	    mallocPool pool;
	    ffestpDeleteStmt *params;
	  }
	V021;
	struct
	  {
	    mallocPool pool;
	    ffestpBeruStmt *params;
	  }
	V022;
	struct
	  {
	    mallocPool pool;
	    ffestpVxtcodeStmt *params;
	    ffestdExprItem_ list;
	  }
	V023;
	struct
	  {
	    mallocPool pool;
	    ffestpVxtcodeStmt *params;
	    ffestdExprItem_ list;
	  }
	V024;
	struct
	  {
	    ffebld u;
	    ffebld m;
	    ffebld n;
	    ffebld asv;
	  }
	V025item;
	struct
	  {
	    mallocPool pool;
	  } V025finish;
	struct
	  {
	    mallocPool pool;
	    ffestpFindStmt *params;
	  }
	V026;
#endif
      }
    u;
  };

#endif

/* Static objects accessed by functions in this module. */

static ffestdStatelet_ ffestd_statelet_ = FFESTD_stateletSIMPLE_;
static int ffestd_block_level_ = 0;	/* Block level for reachableness. */
static bool ffestd_is_reachable_;	/* Is the current stmt reachable?  */
static ffelab ffestd_label_formatdef_ = NULL;
#if FFECOM_TWOPASS
static ffestdExprItem_ *ffestd_expr_list_;
static struct
  {
    ffestdStmt_ first;
    ffestdStmt_ last;
  }

ffestd_stmt_list_
=
{
  NULL, NULL
};

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
static int ffestd_2pass_entrypoints_ = 0;	/* # ENTRY statements
						   pending. */
#endif

/* Static functions (internal). */

#if FFECOM_TWOPASS
static void ffestd_stmt_append_ (ffestdStmt_ stmt);
static ffestdStmt_ ffestd_stmt_new_ (ffestdStmtId_ id);
static void ffestd_stmt_pass_ (void);
#endif
#if FFESTD_COPY_EASY_ && FFECOM_TWOPASS
static ffestpInquireStmt *ffestd_subr_copy_easy_ (ffestpInquireIx max);
#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
static void ffestd_subr_vxt_ (void);
#endif
#if FFESTR_F90
static void ffestd_subr_f90_ (void);
#endif
static void ffestd_subr_labels_ (bool unexpected);
static void ffestd_R1001dump_ (ffests s, ffesttFormatList list);
static void ffestd_R1001dump_1005_1_ (ffests s, ffesttFormatList f,
				      char *string);
static void ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f,
				      char *string);
static void ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f,
				      char *string);
static void ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f,
				      char *string);
static void ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f,
				      char *string);
static void ffestd_R1001dump_1010_1_ (ffests s, ffesttFormatList f,
				      char *string);
static void ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f,
				      char *string);
static void ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f,
				      char *string);
static void ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f,
				      char *string);
static void ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f,
				      char *string);
static void ffestd_R1001error_ (ffesttFormatList f);
static void ffestd_R1001rtexpr_ (ffests s, ffesttFormatList f, ffebld expr);

/* Internal macros. */

#if FFECOM_targetCURRENT == FFECOM_targetGCC
#define ffestd_subr_line_now_()					       \
  ffeste_set_line (ffelex_token_where_filename (ffesta_tokens[0]), \
		   ffelex_token_where_filelinenum (ffesta_tokens[0]))
#define ffestd_subr_line_restore_(s) \
  ffeste_set_line ((s)->filename, (s)->filelinenum)
#define ffestd_subr_line_save_(s)					   \
  ((s)->filename = ffelex_token_where_filename (ffesta_tokens[0]),	   \
   (s)->filelinenum = ffelex_token_where_filelinenum (ffesta_tokens[0]))
#else
#define ffestd_subr_line_now_()
#if FFECOM_TWOPASS
#define ffestd_subr_line_restore_(s)
#define ffestd_subr_line_save_(s)
#endif	/* FFECOM_TWOPASS */
#endif	/* FFECOM_targetCURRENT != FFECOM_targetGCC */
#define ffestd_check_simple_() \
      assert(ffestd_statelet_ == FFESTD_stateletSIMPLE_)
#define ffestd_check_start_() \
      assert(ffestd_statelet_ == FFESTD_stateletSIMPLE_); \
      ffestd_statelet_ = FFESTD_stateletATTRIB_
#define ffestd_check_attrib_() \
      assert(ffestd_statelet_ == FFESTD_stateletATTRIB_)
#define ffestd_check_item_() \
      assert(ffestd_statelet_ == FFESTD_stateletATTRIB_	 \
	    || ffestd_statelet_ == FFESTD_stateletITEM_); \
      ffestd_statelet_ = FFESTD_stateletITEM_
#define ffestd_check_item_startvals_() \
      assert(ffestd_statelet_ == FFESTD_stateletATTRIB_	 \
	    || ffestd_statelet_ == FFESTD_stateletITEM_); \
      ffestd_statelet_ = FFESTD_stateletITEMVALS_
#define ffestd_check_item_value_() \
      assert(ffestd_statelet_ == FFESTD_stateletITEMVALS_)
#define ffestd_check_item_endvals_() \
      assert(ffestd_statelet_ == FFESTD_stateletITEMVALS_); \
      ffestd_statelet_ = FFESTD_stateletITEM_
#define ffestd_check_finish_() \
      assert(ffestd_statelet_ == FFESTD_stateletATTRIB_	 \
	    || ffestd_statelet_ == FFESTD_stateletITEM_); \
      ffestd_statelet_ = FFESTD_stateletSIMPLE_

#if FFESTD_COPY_EASY_ && FFECOM_TWOPASS
#define ffestd_subr_copy_accept_() (ffestpAcceptStmt *) \
      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_acceptix)
#define ffestd_subr_copy_beru_() (ffestpBeruStmt *) \
      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_beruix)
#define ffestd_subr_copy_close_() (ffestpCloseStmt *) \
      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_closeix)
#define ffestd_subr_copy_delete_() (ffestpDeleteStmt *) \
      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_deleteix)
#define ffestd_subr_copy_find_() (ffestpFindStmt *) \
      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_findix)
#define ffestd_subr_copy_inquire_() (ffestpInquireStmt *) \
      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_inquireix)
#define ffestd_subr_copy_open_() (ffestpOpenStmt *) \
      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_openix)
#define ffestd_subr_copy_print_() (ffestpPrintStmt *) \
      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_printix)
#define ffestd_subr_copy_read_() (ffestpReadStmt *) \
      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_readix)
#define ffestd_subr_copy_rewrite_() (ffestpRewriteStmt *) \
      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_rewriteix)
#define ffestd_subr_copy_type_() (ffestpTypeStmt *) \
      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_typeix)
#define ffestd_subr_copy_vxtcode_() (ffestpVxtcodeStmt *) \
      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_vxtcodeix)
#define ffestd_subr_copy_write_() (ffestpWriteStmt *) \
      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_writeix)
#endif

/* ffestd_stmt_append_ -- Append statement to end of stmt list

   ffestd_stmt_append_(ffestd_stmt_new_(FFESTD_stmtidR737A_));	*/

#if FFECOM_TWOPASS
static void
ffestd_stmt_append_ (ffestdStmt_ stmt)
{
  stmt->next = (ffestdStmt_) &ffestd_stmt_list_.first;
  stmt->previous = ffestd_stmt_list_.last;
  stmt->next->previous = stmt;
  stmt->previous->next = stmt;
}

#endif
/* ffestd_stmt_new_ -- Make new statement with given id

   ffestdStmt_ stmt;
   stmt = ffestd_stmt_new_(FFESTD_stmtidR737A_);  */

#if FFECOM_TWOPASS
static ffestdStmt_
ffestd_stmt_new_ (ffestdStmtId_ id)
{
  ffestdStmt_ stmt;

  stmt = malloc_new_kp (ffe_pool_any_unit (), "ffestdStmt_", sizeof (*stmt));
  stmt->id = id;
  return stmt;
}

#endif
/* ffestd_stmt_pass_ -- Pass all statements on list to ffeste

   ffestd_stmt_pass_();	 */

#if FFECOM_TWOPASS
static void
ffestd_stmt_pass_ ()
{
  ffestdStmt_ stmt;
  ffestdExprItem_ expr;		/* For traversing lists. */
  bool okay = (TREE_CODE (current_function_decl) != ERROR_MARK);

#if FFECOM_targetCURRENT == FFECOM_targetGCC
  if ((ffestd_2pass_entrypoints_ != 0) && okay)
    {
      tree which = ffecom_which_entrypoint_decl ();
      tree value;
      tree label;
      int pushok;
      int ents = ffestd_2pass_entrypoints_;
      tree duplicate;

      expand_start_case (0, which, TREE_TYPE (which), "entrypoint dispatch");
      push_momentary ();

      stmt = ffestd_stmt_list_.first;
      do
	{
	  while (stmt->id != FFESTD_stmtidR1226_)
	    stmt = stmt->next;

	  if (stmt->u.R1226.entry != NULL)
	    {
	      value = build_int_2 (stmt->u.R1226.entrynum, 0);
	      /* Yes, we really want to build a null LABEL_DECL here and not
		 put it on any list.  That's what pushcase wants, so that's
		 what it gets!  */
	      label = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);

	      pushok = pushcase (value, convert, label, &duplicate);
	      assert (pushok == 0);

	      label = ffecom_temp_label ();
	      TREE_USED (label) = 1;
	      expand_goto (label);
	      clear_momentary ();

	      ffesymbol_hook (stmt->u.R1226.entry).length_tree = label;
	    }
	  stmt = stmt->next;
	}
      while (--ents != 0);

      pop_momentary ();
      expand_end_case (which);
      clear_momentary ();
    }
#endif

  for (stmt = ffestd_stmt_list_.first;
       stmt != (ffestdStmt_) &ffestd_stmt_list_.first;
       stmt = stmt->next)
    {
      switch (stmt->id)
	{
	case FFESTD_stmtidENDDOLOOP_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_do (stmt->u.enddoloop.block);
	  ffestw_kill (stmt->u.enddoloop.block);
	  break;

	case FFESTD_stmtidENDLOGIF_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_end_R807 ();
	  break;

	case FFESTD_stmtidEXECLABEL_:
	  if (okay)
	    ffeste_labeldef_branch (stmt->u.execlabel.label);
	  break;

	case FFESTD_stmtidFORMATLABEL_:
	  if (okay)
	    ffeste_labeldef_format (stmt->u.formatlabel.label);
	  break;

	case FFESTD_stmtidR737A_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R737A (stmt->u.R737A.dest, stmt->u.R737A.source);
	  malloc_pool_kill (stmt->u.R737A.pool);
	  break;

	case FFESTD_stmtidR803_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R803 (stmt->u.R803.expr);
	  malloc_pool_kill (stmt->u.R803.pool);
	  break;

	case FFESTD_stmtidR804_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R804 (stmt->u.R804.expr);
	  malloc_pool_kill (stmt->u.R804.pool);
	  break;

	case FFESTD_stmtidR805_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R805 ();
	  break;

	case FFESTD_stmtidR806_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R806 ();
	  break;

	case FFESTD_stmtidR807_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R807 (stmt->u.R807.expr);
	  malloc_pool_kill (stmt->u.R807.pool);
	  break;

	case FFESTD_stmtidR809_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R809 (stmt->u.R809.block, stmt->u.R809.expr);
	  malloc_pool_kill (stmt->u.R809.pool);
	  break;

	case FFESTD_stmtidR810_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R810 (stmt->u.R810.block, stmt->u.R810.casenum);
	  malloc_pool_kill (stmt->u.R810.pool);
	  break;

	case FFESTD_stmtidR811_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R811 (stmt->u.R811.block);
	  malloc_pool_kill (ffestw_select (stmt->u.R811.block)->pool);
	  ffestw_kill (stmt->u.R811.block);
	  break;

	case FFESTD_stmtidR819A_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R819A (stmt->u.R819A.block, stmt->u.R819A.label,
			  stmt->u.R819A.var,
			  stmt->u.R819A.start, stmt->u.R819A.start_token,
			  stmt->u.R819A.end, stmt->u.R819A.end_token,
			  stmt->u.R819A.incr, stmt->u.R819A.incr_token);
	  ffelex_token_kill (stmt->u.R819A.start_token);
	  ffelex_token_kill (stmt->u.R819A.end_token);
	  if (stmt->u.R819A.incr_token != NULL)
	    ffelex_token_kill (stmt->u.R819A.incr_token);
	  malloc_pool_kill (stmt->u.R819A.pool);
	  break;

	case FFESTD_stmtidR819B_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R819B (stmt->u.R819B.block, stmt->u.R819B.label,
			  stmt->u.R819B.expr);
	  malloc_pool_kill (stmt->u.R819B.pool);
	  break;

	case FFESTD_stmtidR825_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R825 ();
	  break;

	case FFESTD_stmtidR834_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R834 (stmt->u.R834.block);
	  break;

	case FFESTD_stmtidR835_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R835 (stmt->u.R835.block);
	  break;

	case FFESTD_stmtidR836_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R836 (stmt->u.R836.label);
	  break;

	case FFESTD_stmtidR837_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R837 (stmt->u.R837.labels, stmt->u.R837.count,
			 stmt->u.R837.expr);
	  malloc_pool_kill (stmt->u.R837.pool);
	  break;

	case FFESTD_stmtidR838_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R838 (stmt->u.R838.label, stmt->u.R838.target);
	  malloc_pool_kill (stmt->u.R838.pool);
	  break;

	case FFESTD_stmtidR839_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R839 (stmt->u.R839.target);
	  malloc_pool_kill (stmt->u.R839.pool);
	  break;

	case FFESTD_stmtidR840_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R840 (stmt->u.R840.expr, stmt->u.R840.neg, stmt->u.R840.zero,
			 stmt->u.R840.pos);
	  malloc_pool_kill (stmt->u.R840.pool);
	  break;

	case FFESTD_stmtidR841_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R841 ();
	  break;

	case FFESTD_stmtidR842_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R842 (stmt->u.R842.expr);
	  if (stmt->u.R842.pool != NULL)
	    malloc_pool_kill (stmt->u.R842.pool);
	  break;

	case FFESTD_stmtidR843_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R843 (stmt->u.R843.expr);
	  malloc_pool_kill (stmt->u.R843.pool);
	  break;

	case FFESTD_stmtidR904_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R904 (stmt->u.R904.params);
	  malloc_pool_kill (stmt->u.R904.pool);
	  break;

	case FFESTD_stmtidR907_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R907 (stmt->u.R907.params);
	  malloc_pool_kill (stmt->u.R907.pool);
	  break;

	case FFESTD_stmtidR909_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R909_start (stmt->u.R909.params, stmt->u.R909.only_format,
			       stmt->u.R909.unit, stmt->u.R909.format,
			       stmt->u.R909.rec, stmt->u.R909.key);
	  for (expr = stmt->u.R909.list; expr != NULL; expr = expr->next)
	    {
	      if (okay)
		ffeste_R909_item (expr->expr, expr->token);
	      ffelex_token_kill (expr->token);
	    }
	  if (okay)
	    ffeste_R909_finish ();
	  malloc_pool_kill (stmt->u.R909.pool);
	  break;

	case FFESTD_stmtidR910_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R910_start (stmt->u.R910.params, stmt->u.R910.unit,
			       stmt->u.R910.format, stmt->u.R910.rec);
	  for (expr = stmt->u.R910.list; expr != NULL; expr = expr->next)
	    {
	      if (okay)
		ffeste_R910_item (expr->expr, expr->token);
	      ffelex_token_kill (expr->token);
	    }
	  if (okay)
	    ffeste_R910_finish ();
	  malloc_pool_kill (stmt->u.R910.pool);
	  break;

	case FFESTD_stmtidR911_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R911_start (stmt->u.R911.params, stmt->u.R911.format);
	  for (expr = stmt->u.R911.list; expr != NULL; expr = expr->next)
	    {
	      if (okay)
		ffeste_R911_item (expr->expr, expr->token);
	      ffelex_token_kill (expr->token);
	    }
	  if (okay)
	    ffeste_R911_finish ();
	  malloc_pool_kill (stmt->u.R911.pool);
	  break;

	case FFESTD_stmtidR919_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R919 (stmt->u.R919.params);
	  malloc_pool_kill (stmt->u.R919.pool);
	  break;

	case FFESTD_stmtidR920_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R920 (stmt->u.R920.params);
	  malloc_pool_kill (stmt->u.R920.pool);
	  break;

	case FFESTD_stmtidR921_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R921 (stmt->u.R921.params);
	  malloc_pool_kill (stmt->u.R921.pool);
	  break;

	case FFESTD_stmtidR923A_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R923A (stmt->u.R923A.params, stmt->u.R923A.by_file);
	  malloc_pool_kill (stmt->u.R923A.pool);
	  break;

	case FFESTD_stmtidR923B_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R923B_start (stmt->u.R923B.params);
	  for (expr = stmt->u.R923B.list; expr != NULL; expr = expr->next)
	    {
	      if (okay)
		ffeste_R923B_item (expr->expr);
	    }
	  if (okay)
	    ffeste_R923B_finish ();
	  malloc_pool_kill (stmt->u.R923B.pool);
	  break;

	case FFESTD_stmtidR1001_:
	  if (okay)
	    ffeste_R1001 (&stmt->u.R1001.str);
	  ffests_kill (&stmt->u.R1001.str);
	  break;

	case FFESTD_stmtidR1103_:
	  if (okay)
	    ffeste_R1103 ();
	  break;

	case FFESTD_stmtidR1112_:
	  if (okay)
	    ffeste_R1112 ();
	  break;

	case FFESTD_stmtidR1212_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R1212 (stmt->u.R1212.expr);
	  malloc_pool_kill (stmt->u.R1212.pool);
	  break;

	case FFESTD_stmtidR1221_:
	  if (okay)
	    ffeste_R1221 ();
	  break;

	case FFESTD_stmtidR1225_:
	  if (okay)
	    ffeste_R1225 ();
	  break;

	case FFESTD_stmtidR1226_:
	  ffestd_subr_line_restore_ (stmt);
	  if (stmt->u.R1226.entry != NULL)
	    {
	      if (okay)
		ffeste_R1226 (stmt->u.R1226.entry);
	    }
	  break;

	case FFESTD_stmtidR1227_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_R1227 (stmt->u.R1227.block, stmt->u.R1227.expr);
	  malloc_pool_kill (stmt->u.R1227.pool);
	  break;

#if FFESTR_VXT
	case FFESTD_stmtidV018_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_V018_start (stmt->u.V018.params, stmt->u.V018.format);
	  for (expr = stmt->u.V018.list; expr != NULL; expr = expr->next)
	    {
	      if (okay)
		ffeste_V018_item (expr->expr);
	    }
	  if (okay)
	    ffeste_V018_finish ();
	  malloc_pool_kill (stmt->u.V018.pool);
	  break;

	case FFESTD_stmtidV019_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_V019_start (stmt->u.V019.params, stmt->u.V019.format);
	  for (expr = stmt->u.V019.list; expr != NULL; expr = expr->next)
	    {
	      if (okay)
		ffeste_V019_item (expr->expr);
	    }
	  if (okay)
	    ffeste_V019_finish ();
	  malloc_pool_kill (stmt->u.V019.pool);
	  break;
#endif

	case FFESTD_stmtidV020_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_V020_start (stmt->u.V020.params, stmt->u.V020.format);
	  for (expr = stmt->u.V020.list; expr != NULL; expr = expr->next)
	    {
	      if (okay)
		ffeste_V020_item (expr->expr);
	    }
	  if (okay)
	    ffeste_V020_finish ();
	  malloc_pool_kill (stmt->u.V020.pool);
	  break;

#if FFESTR_VXT
	case FFESTD_stmtidV021_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_V021 (stmt->u.V021.params);
	  malloc_pool_kill (stmt->u.V021.pool);
	  break;

	case FFESTD_stmtidV023_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_V023_start (stmt->u.V023.params);
	  for (expr = stmt->u.V023.list; expr != NULL; expr = expr->next)
	    {
	      if (okay)
		ffeste_V023_item (expr->expr);
	    }
	  if (okay)
	    ffeste_V023_finish ();
	  malloc_pool_kill (stmt->u.V023.pool);
	  break;

	case FFESTD_stmtidV024_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_V024_start (stmt->u.V024.params);
	  for (expr = stmt->u.V024.list; expr != NULL; expr = expr->next)
	    {
	      if (okay)
		ffeste_V024_item (expr->expr);
	    }
	  if (okay)
	    ffeste_V024_finish ();
	  malloc_pool_kill (stmt->u.V024.pool);
	  break;

	case FFESTD_stmtidV025start_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_V025_start ();
	  break;

	case FFESTD_stmtidV025item_:
	  if (okay)
	    ffeste_V025_item (stmt->u.V025item.u, stmt->u.V025item.m,
			      stmt->u.V025item.n, stmt->u.V025item.asv);
	  break;

	case FFESTD_stmtidV025finish_:
	  if (okay)
	    ffeste_V025_finish ();
	  malloc_pool_kill (stmt->u.V025finish.pool);
	  break;

	case FFESTD_stmtidV026_:
	  ffestd_subr_line_restore_ (stmt);
	  if (okay)
	    ffeste_V026 (stmt->u.V026.params);
	  malloc_pool_kill (stmt->u.V026.pool);
	  break;
#endif

	default:
	  assert ("bad stmt->id" == NULL);
	  break;
	}
    }
}

#endif
/* ffestd_subr_copy_easy_ -- Copy I/O statement data structure

   ffestd_subr_copy_easy_();

   Copies all data except tokens in the I/O data structure into a new
   structure that lasts as long as the output pool for the current
   statement.  Assumes that they are
   overlaid with each other (union) in stp.h and the typing
   and structure references assume (though not necessarily dangerous if
   FALSE) that INQUIRE has the most file elements.  */

#if FFESTD_COPY_EASY_ && FFECOM_TWOPASS
static ffestpInquireStmt *
ffestd_subr_copy_easy_ (ffestpInquireIx max)
{
  ffestpInquireStmt *stmt;
  ffestpInquireIx ix;

  stmt = (ffestpInquireStmt *) malloc_new_kp (ffesta_output_pool,
				  "FFESTD easy", sizeof (ffestpFile) * max);

  for (ix = 0; ix < max; ++ix)
    {
      if ((stmt->inquire_spec[ix].kw_or_val_present
	   = ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
	  && (stmt->inquire_spec[ix].value_present
	      = ffestp_file.inquire.inquire_spec[ix].value_present))
	{
	  if ((stmt->inquire_spec[ix].value_is_label
	       = ffestp_file.inquire.inquire_spec[ix].value_is_label))
	    stmt->inquire_spec[ix].u.label
	      = ffestp_file.inquire.inquire_spec[ix].u.label;
	  else
	    stmt->inquire_spec[ix].u.expr
	      = ffestp_file.inquire.inquire_spec[ix].u.expr;
	}
    }

  return stmt;
}

#endif
/* ffestd_subr_labels_ -- Handle any undefined labels

   ffestd_subr_labels_(FALSE);

   For every undefined label, generate an error message and either define
   label as a FORMAT() statement (for FORMAT labels) or as a STOP statement
   (for all other labels).  */

static void
ffestd_subr_labels_ (bool unexpected)
{
  ffelab l;
  ffelabHandle h;
  ffelabNumber undef;
  ffesttFormatList f;

  undef = ffelab_number () - ffestv_num_label_defines_;

  for (h = ffelab_handle_first (); h != NULL; h = ffelab_handle_next (h))
    {
      l = ffelab_handle_target (h);
      if (ffewhere_line_is_unknown (ffelab_definition_line (l)))
	{			/* Undefined label. */
	  assert (!unexpected);
	  assert (undef > 0);
	  undef--;
	  ffebad_start (FFEBAD_UNDEF_LABEL);
	  if (ffelab_type (l) == FFELAB_typeLOOPEND)
	    ffebad_here (0, ffelab_doref_line (l), ffelab_doref_column (l));
	  else if (ffelab_type (l) != FFELAB_typeANY)
	    ffebad_here (0, ffelab_firstref_line (l), ffelab_firstref_column (l));
	  else if (!ffewhere_line_is_unknown (ffelab_firstref_line (l)))
	    ffebad_here (0, ffelab_firstref_line (l), ffelab_firstref_column (l));
	  else if (!ffewhere_line_is_unknown (ffelab_doref_line (l)))
	    ffebad_here (0, ffelab_doref_line (l), ffelab_doref_column (l));
	  else
	    ffebad_here (0, ffelab_definition_line (l), ffelab_definition_column (l));
	  ffebad_finish ();

	  switch (ffelab_type (l))
	    {
	    case FFELAB_typeFORMAT:
	      ffelab_set_definition_line (l,
			      ffewhere_line_use (ffelab_firstref_line (l)));
	      ffelab_set_definition_column (l,
			  ffewhere_column_use (ffelab_firstref_column (l)));
	      ffestv_num_label_defines_++;
	      f = ffestt_formatlist_create (NULL, NULL);
	      ffestd_labeldef_format (l);
	      ffestd_R1001 (f);
	      ffestt_formatlist_kill (f);
	      break;

	    case FFELAB_typeASSIGNABLE:
	      ffelab_set_definition_line (l,
			      ffewhere_line_use (ffelab_firstref_line (l)));
	      ffelab_set_definition_column (l,
			  ffewhere_column_use (ffelab_firstref_column (l)));
	      ffestv_num_label_defines_++;
	      ffelab_set_type (l, FFELAB_typeNOTLOOP);
	      ffelab_set_blocknum (l, ffestw_blocknum (ffestw_stack_top ()));
	      ffestd_labeldef_notloop (l);
	      ffestd_R842 (NULL);
	      break;

	    case FFELAB_typeNOTLOOP:
	      ffelab_set_definition_line (l,
			      ffewhere_line_use (ffelab_firstref_line (l)));
	      ffelab_set_definition_column (l,
			  ffewhere_column_use (ffelab_firstref_column (l)));
	      ffestv_num_label_defines_++;
	      ffelab_set_blocknum (l, ffestw_blocknum (ffestw_stack_top ()));
	      ffestd_labeldef_notloop (l);
	      ffestd_R842 (NULL);
	      break;

	    default:
	      assert ("bad label type" == NULL);
	      /* Fall through. */
	    case FFELAB_typeUNKNOWN:
	    case FFELAB_typeANY:
	      break;
	    }
	}
    }
  ffelab_handle_done (h);
  assert (undef == 0);
}

/* ffestd_subr_f90_ -- Report error about lack of full F90 support

   ffestd_subr_f90_();	*/

#if FFESTR_F90
static void
ffestd_subr_f90_ ()
{
  ffebad_start (FFEBAD_F90);
  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
	       ffelex_token_where_column (ffesta_tokens[0]));
  ffebad_finish ();
}

#endif
/* ffestd_subr_vxt_ -- Report error about lack of full VXT support

   ffestd_subr_vxt_();	*/

#if FFECOM_targetCURRENT == FFECOM_targetGCC
static void
ffestd_subr_vxt_ ()
{
  ffebad_start (FFEBAD_VXT_UNSUPPORTED);
  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
	       ffelex_token_where_column (ffesta_tokens[0]));
  ffebad_finish ();
}

#endif
/* ffestd_begin_uses -- Start a bunch of USE statements

   ffestd_begin_uses();

   Invoked before handling the first USE statement in a block of one or
   more USE statements.	 _end_uses_(bool ok) is invoked before handling
   the first statement after the block (there are no BEGIN USE and END USE
   statements, but the semantics of USE statements effectively requires
   handling them as a single block rather than one statement at a time).  */

void
ffestd_begin_uses ()
{
#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("; begin_uses\n", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_do -- End of statement following DO-term-stmt etc

   ffestd_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 ffestd_eof_()) invokes it with ok==FALSE.  */

void
ffestd_do (bool ok UNUSED)
{
#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_do (ffestw_stack_top ());
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidENDDOLOOP_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.enddoloop.block = ffestw_stack_top ();
  }
#endif

  --ffestd_block_level_;
  assert (ffestd_block_level_ >= 0);
}

/* ffestd_end_uses -- End a bunch of USE statements

   ffestd_end_uses(TRUE);

   ok==TRUE means simply not popping due to ffestd_eof_()
   being called, because there is no formal END USES statement in Fortran.  */

#if FFESTR_F90
void
ffestd_end_uses (bool ok)
{
#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("; end_uses\n", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_end_R740 -- End a WHERE(-THEN)

   ffestd_end_R740(TRUE);  */

void
ffestd_end_R740 (bool ok)
{
  return;			/* F90. */
}

#endif
/* ffestd_end_R807 -- End of statement following logical IF

   ffestd_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 ffestd_eof_().	*/

void
ffestd_end_R807 (bool ok UNUSED)
{
#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_end_R807 ();
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidENDLOGIF_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
  }
#endif

  --ffestd_block_level_;
  assert (ffestd_block_level_ >= 0);
}

/* ffestd_exec_begin -- Executable statements can start coming in now

   ffestd_exec_begin();	 */

void
ffestd_exec_begin ()
{
  ffecom_exec_transition ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("{ begin_exec\n", dmpout);
#endif

#if FFECOM_targetCURRENT == FFECOM_targetGCC
  if (ffestd_2pass_entrypoints_ != 0)
    {				/* Process pending ENTRY statements now that
				   info filled in. */
      ffestdStmt_ stmt;
      int ents = ffestd_2pass_entrypoints_;

      stmt = ffestd_stmt_list_.first;
      do
	{
	  while (stmt->id != FFESTD_stmtidR1226_)
	    stmt = stmt->next;

	  if (!ffecom_2pass_advise_entrypoint (stmt->u.R1226.entry))
	    {
	      stmt->u.R1226.entry = NULL;
	      --ffestd_2pass_entrypoints_;
	    }
	  stmt = stmt->next;
	}
      while (--ents != 0);
    }
#endif
}

/* ffestd_exec_end -- Executable statements can no longer come in now

   ffestd_exec_end();  */

void
ffestd_exec_end ()
{
#if FFECOM_targetCURRENT == FFECOM_targetGCC
  int old_lineno = lineno;
  char *old_input_filename = input_filename;
#endif

  ffecom_end_transition ();

#if FFECOM_TWOPASS
  ffestd_stmt_pass_ ();
#endif

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("} end_exec\n", dmpout);
  fputs ("> end_unit\n", dmpout);
#endif

#if FFECOM_targetCURRENT == FFECOM_targetGCC
  ffecom_finish_progunit ();

  if (ffestd_2pass_entrypoints_ != 0)
    {
      int ents = ffestd_2pass_entrypoints_;
      ffestdStmt_ stmt = ffestd_stmt_list_.first;

      do
	{
	  while (stmt->id != FFESTD_stmtidR1226_)
	    stmt = stmt->next;

	  if (stmt->u.R1226.entry != NULL)
	    {
	      ffestd_subr_line_restore_ (stmt);
	      ffecom_2pass_do_entrypoint (stmt->u.R1226.entry);
	    }
	  stmt = stmt->next;
	}
      while (--ents != 0);
    }

  ffestd_stmt_list_.first = NULL;
  ffestd_stmt_list_.last = NULL;
  ffestd_2pass_entrypoints_ = 0;

  lineno = old_lineno;
  input_filename = old_input_filename;
#endif
}

/* ffestd_init_3 -- Initialize for any program unit

   ffestd_init_3();  */

void
ffestd_init_3 ()
{
#if FFECOM_TWOPASS
  ffestd_stmt_list_.first = (ffestdStmt_) &ffestd_stmt_list_.first;
  ffestd_stmt_list_.last = (ffestdStmt_) &ffestd_stmt_list_.first;
#endif
}

/* Generate "code" for "any" label def.  */

void
ffestd_labeldef_any (ffelab label UNUSED)
{
#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fprintf (dmpout, "; any_label_def %lu\n", ffelab_value (label));
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_labeldef_branch -- Generate "code" for branch label def

   ffestd_labeldef_branch(label);  */

void
ffestd_labeldef_branch (ffelab label)
{
#if FFECOM_ONEPASS
  ffeste_labeldef_branch (label);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidEXECLABEL_);
    ffestd_stmt_append_ (stmt);
    stmt->u.execlabel.label = label;
  }
#endif

  ffestd_is_reachable_ = TRUE;
}

/* ffestd_labeldef_format -- Generate "code" for FORMAT label def

   ffestd_labeldef_format(label);  */

void
ffestd_labeldef_format (ffelab label)
{
  ffestd_label_formatdef_ = label;

#if FFECOM_ONEPASS
  ffeste_labeldef_format (label);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidFORMATLABEL_);
    ffestd_stmt_append_ (stmt);
    stmt->u.formatlabel.label = label;
  }
#endif
}

/* ffestd_labeldef_useless -- Generate "code" for useless label def

   ffestd_labeldef_useless(label);  */

void
ffestd_labeldef_useless (ffelab label UNUSED)
{
#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fprintf (dmpout, "; useless_label_def %lu\n", ffelab_value (label));
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R423A -- PRIVATE statement (in R422 derived-type statement)

   ffestd_R423A();  */

#if FFESTR_F90
void
ffestd_R423A ()
{
  ffestd_check_simple_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* PRIVATE_derived_type\n", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R423B -- SEQUENCE statement (in R422 derived-type-stmt)

   ffestd_R423B();  */

void
ffestd_R423B ()
{
  ffestd_check_simple_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* SEQUENCE_derived_type\n", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R424 -- derived-TYPE-def statement

   ffestd_R424(access_token,access_kw,name_token);

   Handle a derived-type definition.  */

void
ffestd_R424 (ffelexToken access, ffestrOther access_kw, ffelexToken name)
{
  ffestd_check_simple_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  char *a;

  if (access == NULL)
    fprintf (dmpout, "* TYPE %s\n", ffelex_token_text (name));
  else
    {
      switch (access_kw)
	{
	case FFESTR_otherPUBLIC:
	  a = "PUBLIC";
	  break;

	case FFESTR_otherPRIVATE:
	  a = "PRIVATE";
	  break;

	default:
	  assert (FALSE);
	}
      fprintf (dmpout, "* TYPE,%s: %s\n", a, ffelex_token_text (name));
    }
#endif
}

/* ffestd_R425 -- End a TYPE

   ffestd_R425(TRUE);  */

void
ffestd_R425 (bool ok)
{
#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fprintf (dmpout, "* END_TYPE %s\n", ffelex_token_text (ffestw_name (ffestw_stack_top ())));
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R519_start -- INTENT statement list begin

   ffestd_R519_start();

   Verify that INTENT is valid here, and begin accepting items in the list.  */

void
ffestd_R519_start (ffestrOther intent_kw)
{
  ffestd_check_start_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  char *a;

  switch (intent_kw)
    {
    case FFESTR_otherIN:
      a = "IN";
      break;

    case FFESTR_otherOUT:
      a = "OUT";
      break;

    case FFESTR_otherINOUT:
      a = "INOUT";
      break;

    default:
      assert (FALSE);
    }
  fprintf (dmpout, "* INTENT (%s) ", a);
#endif
}

/* ffestd_R519_item -- INTENT statement for name

   ffestd_R519_item(name_token);

   Make sure name_token identifies a valid object to be INTENTed.  */

void
ffestd_R519_item (ffelexToken name)
{
  ffestd_check_item_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fprintf (dmpout, "%s,", ffelex_token_text (name));
#endif
}

/* ffestd_R519_finish -- INTENT statement list complete

   ffestd_R519_finish();

   Just wrap up any local activities.  */

void
ffestd_R519_finish ()
{
  ffestd_check_finish_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fputc ('\n', dmpout);
#endif
}

/* ffestd_R520_start -- OPTIONAL statement list begin

   ffestd_R520_start();

   Verify that OPTIONAL is valid here, and begin accepting items in the list.  */

void
ffestd_R520_start ()
{
  ffestd_check_start_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  fputs ("* OPTIONAL ", dmpout);
#endif
}

/* ffestd_R520_item -- OPTIONAL statement for name

   ffestd_R520_item(name_token);

   Make sure name_token identifies a valid object to be OPTIONALed.  */

void
ffestd_R520_item (ffelexToken name)
{
  ffestd_check_item_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fprintf (dmpout, "%s,", ffelex_token_text (name));
#endif
}

/* ffestd_R520_finish -- OPTIONAL statement list complete

   ffestd_R520_finish();

   Just wrap up any local activities.  */

void
ffestd_R520_finish ()
{
  ffestd_check_finish_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fputc ('\n', dmpout);
#endif
}

/* ffestd_R521A -- PUBLIC statement

   ffestd_R521A();

   Verify that PUBLIC is valid here.  */

void
ffestd_R521A ()
{
  ffestd_check_simple_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  fputs ("* PUBLIC\n", dmpout);
#endif
}

/* ffestd_R521Astart -- PUBLIC statement list begin

   ffestd_R521Astart();

   Verify that PUBLIC is valid here, and begin accepting items in the list.  */

void
ffestd_R521Astart ()
{
  ffestd_check_start_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  fputs ("* PUBLIC ", dmpout);
#endif
}

/* ffestd_R521Aitem -- PUBLIC statement for name

   ffestd_R521Aitem(name_token);

   Make sure name_token identifies a valid object to be PUBLICed.  */

void
ffestd_R521Aitem (ffelexToken name)
{
  ffestd_check_item_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fprintf (dmpout, "%s,", ffelex_token_text (name));
#endif
}

/* ffestd_R521Afinish -- PUBLIC statement list complete

   ffestd_R521Afinish();

   Just wrap up any local activities.  */

void
ffestd_R521Afinish ()
{
  ffestd_check_finish_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fputc ('\n', dmpout);
#endif
}

/* ffestd_R521B -- PRIVATE statement

   ffestd_R521B();

   Verify that PRIVATE is valid here (outside a derived-type statement).  */

void
ffestd_R521B ()
{
  ffestd_check_simple_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  fputs ("* PRIVATE_outside_of_R422_derived_type_def\n", dmpout);
#endif
}

/* ffestd_R521Bstart -- PRIVATE statement list begin

   ffestd_R521Bstart();

   Verify that PRIVATE is valid here, and begin accepting items in the list.  */

void
ffestd_R521Bstart ()
{
  ffestd_check_start_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  fputs ("* PRIVATE ", dmpout);
#endif
}

/* ffestd_R521Bitem -- PRIVATE statement for name

   ffestd_R521Bitem(name_token);

   Make sure name_token identifies a valid object to be PRIVATEed.  */

void
ffestd_R521Bitem (ffelexToken name)
{
  ffestd_check_item_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fprintf (dmpout, "%s,", ffelex_token_text (name));
#endif
}

/* ffestd_R521Bfinish -- PRIVATE statement list complete

   ffestd_R521Bfinish();

   Just wrap up any local activities.  */

void
ffestd_R521Bfinish ()
{
  ffestd_check_finish_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fputc ('\n', dmpout);
#endif
}

#endif
/* ffestd_R522 -- SAVE statement with no list

   ffestd_R522();

   Verify that SAVE is valid here, and flag everything as SAVEd.  */

void
ffestd_R522 ()
{
  ffestd_check_simple_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* SAVE_all\n", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R522start -- SAVE statement list begin

   ffestd_R522start();

   Verify that SAVE is valid here, and begin accepting items in the list.  */

void
ffestd_R522start ()
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* SAVE ", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R522item_object -- SAVE statement for object-name

   ffestd_R522item_object(name_token);

   Make sure name_token identifies a valid object to be SAVEd.	*/

void
ffestd_R522item_object (ffelexToken name UNUSED)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fprintf (dmpout, "%s,", ffelex_token_text (name));
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R522item_cblock -- SAVE statement for common-block-name

   ffestd_R522item_cblock(name_token);

   Make sure name_token identifies a valid common block to be SAVEd.  */

void
ffestd_R522item_cblock (ffelexToken name UNUSED)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fprintf (dmpout, "/%s/,", ffelex_token_text (name));
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R522finish -- SAVE statement list complete

   ffestd_R522finish();

   Just wrap up any local activities.  */

void
ffestd_R522finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputc ('\n', dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R524_start -- DIMENSION statement list begin

   ffestd_R524_start(bool virtual);

   Verify that DIMENSION is valid here, and begin accepting items in the list.	*/

void
ffestd_R524_start (bool virtual UNUSED)
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  if (virtual)
    fputs ("* VIRTUAL ", dmpout);	/* V028. */
  else
    fputs ("* DIMENSION ", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R524_item -- DIMENSION statement for object-name

   ffestd_R524_item(name_token,dim_list);

   Make sure name_token identifies a valid object to be DIMENSIONd.  */

void
ffestd_R524_item (ffelexToken name UNUSED, ffesttDimList dims UNUSED)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs (ffelex_token_text (name), dmpout);
  fputc ('(', dmpout);
  ffestt_dimlist_dump (dims);
  fputs ("),", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R524_finish -- DIMENSION statement list complete

   ffestd_R524_finish();

   Just wrap up any local activities.  */

void
ffestd_R524_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputc ('\n', dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R525_start -- ALLOCATABLE statement list begin

   ffestd_R525_start();

   Verify that ALLOCATABLE is valid here, and begin accepting items in the
   list.  */

#if FFESTR_F90
void
ffestd_R525_start ()
{
  ffestd_check_start_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  fputs ("* ALLOCATABLE ", dmpout);
#endif
}

/* ffestd_R525_item -- ALLOCATABLE statement for object-name

   ffestd_R525_item(name_token,dim_list);

   Make sure name_token identifies a valid object to be ALLOCATABLEd.  */

void
ffestd_R525_item (ffelexToken name, ffesttDimList dims)
{
  ffestd_check_item_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fputs (ffelex_token_text (name), dmpout);
  if (dims != NULL)
    {
      fputc ('(', dmpout);
      ffestt_dimlist_dump (dims);
      fputc (')', dmpout);
    }
  fputc (',', dmpout);
#endif
}

/* ffestd_R525_finish -- ALLOCATABLE statement list complete

   ffestd_R525_finish();

   Just wrap up any local activities.  */

void
ffestd_R525_finish ()
{
  ffestd_check_finish_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fputc ('\n', dmpout);
#endif
}

/* ffestd_R526_start -- POINTER statement list begin

   ffestd_R526_start();

   Verify that POINTER is valid here, and begin accepting items in the
   list.  */

void
ffestd_R526_start ()
{
  ffestd_check_start_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  fputs ("* POINTER ", dmpout);
#endif
}

/* ffestd_R526_item -- POINTER statement for object-name

   ffestd_R526_item(name_token,dim_list);

   Make sure name_token identifies a valid object to be POINTERd.  */

void
ffestd_R526_item (ffelexToken name, ffesttDimList dims)
{
  ffestd_check_item_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fputs (ffelex_token_text (name), dmpout);
  if (dims != NULL)
    {
      fputc ('(', dmpout);
      ffestt_dimlist_dump (dims);
      fputc (')', dmpout);
    }
  fputc (',', dmpout);
#endif
}

/* ffestd_R526_finish -- POINTER statement list complete

   ffestd_R526_finish();

   Just wrap up any local activities.  */

void
ffestd_R526_finish ()
{
  ffestd_check_finish_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fputc ('\n', dmpout);
#endif
}

/* ffestd_R527_start -- TARGET statement list begin

   ffestd_R527_start();

   Verify that TARGET is valid here, and begin accepting items in the
   list.  */

void
ffestd_R527_start ()
{
  ffestd_check_start_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  fputs ("* TARGET ", dmpout);
#endif
}

/* ffestd_R527_item -- TARGET statement for object-name

   ffestd_R527_item(name_token,dim_list);

   Make sure name_token identifies a valid object to be TARGETd.  */

void
ffestd_R527_item (ffelexToken name, ffesttDimList dims)
{
  ffestd_check_item_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fputs (ffelex_token_text (name), dmpout);
  if (dims != NULL)
    {
      fputc ('(', dmpout);
      ffestt_dimlist_dump (dims);
      fputc (')', dmpout);
    }
  fputc (',', dmpout);
#endif
}

/* ffestd_R527_finish -- TARGET statement list complete

   ffestd_R527_finish();

   Just wrap up any local activities.  */

void
ffestd_R527_finish ()
{
  ffestd_check_finish_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fputc ('\n', dmpout);
#endif
}

#endif
/* ffestd_R537_start -- PARAMETER statement list begin

   ffestd_R537_start();

   Verify that PARAMETER is valid here, and begin accepting items in the list.	*/

void
ffestd_R537_start ()
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* PARAMETER (", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R537_item -- PARAMETER statement assignment

   ffestd_R537_item(dest,dest_token,source,source_token);

   Make sure the source is a valid source for the destination; make the
   assignment.	*/

void
ffestd_R537_item (ffebld dest UNUSED, ffebld source UNUSED)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  ffebld_dump (dest);
  fputc ('=', dmpout);
  ffebld_dump (source);
  fputc (',', dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R537_finish -- PARAMETER statement list complete

   ffestd_R537_finish();

   Just wrap up any local activities.  */

void
ffestd_R537_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs (")\n", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R539 -- IMPLICIT NONE statement

   ffestd_R539();

   Verify that the IMPLICIT NONE statement is ok here and implement.  */

void
ffestd_R539 ()
{
  ffestd_check_simple_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* IMPLICIT_NONE\n", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R539start -- IMPLICIT statement

   ffestd_R539start();

   Verify that the IMPLICIT statement is ok here and implement.	 */

void
ffestd_R539start ()
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* IMPLICIT ", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R539item -- IMPLICIT statement specification (R540)

   ffestd_R539item(...);

   Verify that the type and letter list are all ok and implement.  */

void
ffestd_R539item (ffestpType type UNUSED, ffebld kind UNUSED,
		 ffelexToken kindt UNUSED, ffebld len UNUSED,
		 ffelexToken lent UNUSED, ffesttImpList letters UNUSED)
{
#if FFECOM_targetCURRENT == FFECOM_targetFFE
  char *a;
#endif

  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  switch (type)
    {
    case FFESTP_typeINTEGER:
      a = "INTEGER";
      break;

    case FFESTP_typeBYTE:
      a = "BYTE";
      break;

    case FFESTP_typeWORD:
      a = "WORD";
      break;

    case FFESTP_typeREAL:
      a = "REAL";
      break;

    case FFESTP_typeCOMPLEX:
      a = "COMPLEX";
      break;

    case FFESTP_typeLOGICAL:
      a = "LOGICAL";
      break;

    case FFESTP_typeCHARACTER:
      a = "CHARACTER";
      break;

    case FFESTP_typeDBLPRCSN:
      a = "DOUBLE PRECISION";
      break;

    case FFESTP_typeDBLCMPLX:
      a = "DOUBLE COMPLEX";
      break;

#if FFESTR_F90
    case FFESTP_typeTYPE:
      a = "TYPE";
      break;
#endif

    default:
      assert (FALSE);
      a = "?";
      break;
    }
  fprintf (dmpout, "%s(", a);
  if (kindt != NULL)
    {
      fputs ("kind=", dmpout);
      if (kind == NULL)
	fputs (ffelex_token_text (kindt), dmpout);
      else
	ffebld_dump (kind);
      if (lent != NULL)
	fputc (',', dmpout);
    }
  if (lent != NULL)
    {
      fputs ("len=", dmpout);
      if (len == NULL)
	fputs (ffelex_token_text (lent), dmpout);
      else
	ffebld_dump (len);
    }
  fputs (")(", dmpout);
  ffestt_implist_dump (letters);
  fputs ("),", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R539finish -- IMPLICIT statement

   ffestd_R539finish();

   Finish up any local activities.  */

void
ffestd_R539finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputc ('\n', dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R542_start -- NAMELIST statement list begin

   ffestd_R542_start();

   Verify that NAMELIST is valid here, and begin accepting items in the list.  */

void
ffestd_R542_start ()
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* NAMELIST ", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R542_item_nlist -- NAMELIST statement for group-name

   ffestd_R542_item_nlist(groupname_token);

   Make sure name_token identifies a valid object to be NAMELISTd.  */

void
ffestd_R542_item_nlist (ffelexToken name UNUSED)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fprintf (dmpout, "/%s/", ffelex_token_text (name));
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R542_item_nitem -- NAMELIST statement for variable-name

   ffestd_R542_item_nitem(name_token);

   Make sure name_token identifies a valid object to be NAMELISTd.  */

void
ffestd_R542_item_nitem (ffelexToken name UNUSED)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fprintf (dmpout, "%s,", ffelex_token_text (name));
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R542_finish -- NAMELIST statement list complete

   ffestd_R542_finish();

   Just wrap up any local activities.  */

void
ffestd_R542_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputc ('\n', dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R544_start -- EQUIVALENCE statement list begin

   ffestd_R544_start();

   Verify that EQUIVALENCE is valid here, and begin accepting items in the
   list.  */

#if 0
void
ffestd_R544_start ()
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* EQUIVALENCE (", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

#endif
/* ffestd_R544_item -- EQUIVALENCE statement assignment

   ffestd_R544_item(exprlist);

   Make sure the equivalence is valid, then implement it.  */

#if 0
void
ffestd_R544_item (ffesttExprList exprlist)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  ffestt_exprlist_dump (exprlist);
  fputs ("),", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

#endif
/* ffestd_R544_finish -- EQUIVALENCE statement list complete

   ffestd_R544_finish();

   Just wrap up any local activities.  */

#if 0
void
ffestd_R544_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs (")\n", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

#endif
/* ffestd_R547_start -- COMMON statement list begin

   ffestd_R547_start();

   Verify that COMMON is valid here, and begin accepting items in the list.  */

void
ffestd_R547_start ()
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* COMMON ", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R547_item_object -- COMMON statement for object-name

   ffestd_R547_item_object(name_token,dim_list);

   Make sure name_token identifies a valid object to be COMMONd.  */

void
ffestd_R547_item_object (ffelexToken name UNUSED,
			 ffesttDimList dims UNUSED)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs (ffelex_token_text (name), dmpout);
  if (dims != NULL)
    {
      fputc ('(', dmpout);
      ffestt_dimlist_dump (dims);
      fputc (')', dmpout);
    }
  fputc (',', dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R547_item_cblock -- COMMON statement for common-block-name

   ffestd_R547_item_cblock(name_token);

   Make sure name_token identifies a valid common block to be COMMONd.	*/

void
ffestd_R547_item_cblock (ffelexToken name UNUSED)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  if (name == NULL)
    fputs ("//,", dmpout);
  else
    fprintf (dmpout, "/%s/,", ffelex_token_text (name));
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R547_finish -- COMMON statement list complete

   ffestd_R547_finish();

   Just wrap up any local activities.  */

void
ffestd_R547_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputc ('\n', dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R620 -- ALLOCATE statement

   ffestd_R620(exprlist,stat,stat_token);

   Make sure the expression list is valid, then implement it.  */

#if FFESTR_F90
void
ffestd_R620 (ffesttExprList exprlist, ffebld stat)
{
  ffestd_check_simple_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  fputs ("+ ALLOCATE (", dmpout);
  ffestt_exprlist_dump (exprlist);
  if (stat != NULL)
    {
      fputs (",stat=", dmpout);
      ffebld_dump (stat);
    }
  fputs (")\n", dmpout);
#endif
}

/* ffestd_R624 -- NULLIFY statement

   ffestd_R624(pointer_name_list);

   Make sure pointer_name_list identifies valid pointers for a NULLIFY.	 */

void
ffestd_R624 (ffesttExprList pointers)
{
  ffestd_check_simple_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  fputs ("+ NULLIFY (", dmpout);
  assert (pointers != NULL);
  ffestt_exprlist_dump (pointers);
  fputs (")\n", dmpout);
#endif
}

/* ffestd_R625 -- DEALLOCATE statement

   ffestd_R625(exprlist,stat,stat_token);

   Make sure the equivalence is valid, then implement it.  */

void
ffestd_R625 (ffesttExprList exprlist, ffebld stat)
{
  ffestd_check_simple_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  fputs ("+ DEALLOCATE (", dmpout);
  ffestt_exprlist_dump (exprlist);
  if (stat != NULL)
    {
      fputs (",stat=", dmpout);
      ffebld_dump (stat);
    }
  fputs (")\n", dmpout);
#endif
}

#endif
/* ffestd_R737A -- Assignment statement outside of WHERE

   ffestd_R737A(dest_expr,source_expr);	 */

void
ffestd_R737A (ffebld dest, ffebld source)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R737A (dest, source);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR737A_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R737A.pool = ffesta_output_pool;
    stmt->u.R737A.dest = dest;
    stmt->u.R737A.source = source;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif
}

/* ffestd_R737B -- Assignment statement inside of WHERE

   ffestd_R737B(dest_expr,source_expr);	 */

#if FFESTR_F90
void
ffestd_R737B (ffebld dest, ffebld source)
{
  ffestd_check_simple_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fputs ("+ let_inside_where ", dmpout);
  ffebld_dump (dest);
  fputs ("=", dmpout);
  ffebld_dump (source);
  fputc ('\n', dmpout);
#endif
}

/* ffestd_R738 -- Pointer assignment statement

   ffestd_R738(dest_expr,source_expr,source_token);

   Make sure the assignment is valid.  */

void
ffestd_R738 (ffebld dest, ffebld source)
{
  ffestd_check_simple_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  fputs ("+ let_pointer ", dmpout);
  ffebld_dump (dest);
  fputs ("=>", dmpout);
  ffebld_dump (source);
  fputc ('\n', dmpout);
#endif
}

/* ffestd_R740 -- WHERE statement

   ffestd_R740(expr,expr_token);

   Make sure statement is valid here; implement.  */

void
ffestd_R740 (ffebld expr)
{
  ffestd_check_simple_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  fputs ("+ WHERE (", dmpout);
  ffebld_dump (expr);
  fputs (")\n", dmpout);

  ++ffestd_block_level_;
  assert (ffestd_block_level_ > 0);
#endif
}

/* ffestd_R742 -- WHERE-construct statement

   ffestd_R742(expr,expr_token);

   Make sure statement is valid here; implement.  */

void
ffestd_R742 (ffebld expr)
{
  ffestd_check_simple_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  fputs ("+ WHERE_construct (", dmpout);
  ffebld_dump (expr);
  fputs (")\n", dmpout);

  ++ffestd_block_level_;
  assert (ffestd_block_level_ > 0);
#endif
}

/* ffestd_R744 -- ELSE WHERE statement

   ffestd_R744();

   Make sure ffestd_kind_ identifies a WHERE block.
   Implement the ELSE of the current WHERE block.  */

void
ffestd_R744 ()
{
  ffestd_check_simple_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fputs ("+ ELSE_WHERE\n", dmpout);
#endif
}

/* ffestd_R745 -- Implicit END WHERE statement

   ffestd_R745(TRUE);

   Implement the end of the current WHERE "block".  ok==TRUE iff statement
   following WHERE (substatement) is valid; else, statement is invalid
   or stack forcibly popped due to ffestd_eof_().  */

void
ffestd_R745 (bool ok)
{
  return;			/* F90. */

#ifdef FFESTD_F90
  fputs ("+ END_WHERE\n", dmpout);	/* Also see ffestd_R745. */

  --ffestd_block_level_;
  assert (ffestd_block_level_ >= 0);
#endif
}

#endif
/* ffestd_R803 -- Block IF (IF-THEN) statement

   ffestd_R803(construct_name,expr,expr_token);

   Make sure statement is valid here; implement.  */

void
ffestd_R803 (ffelexToken construct_name UNUSED, ffebld expr)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R803 (expr);		/* Don't bother with name. */
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR803_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R803.pool = ffesta_output_pool;
    stmt->u.R803.expr = expr;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif

  ++ffestd_block_level_;
  assert (ffestd_block_level_ > 0);
}

/* ffestd_R804 -- ELSE IF statement

   ffestd_R804(expr,expr_token,name_token);

   Make sure ffestd_kind_ identifies an IF block.  If not
   NULL, make sure name_token gives the correct name.  Implement the else
   of the IF block.  */

void
ffestd_R804 (ffebld expr, ffelexToken name UNUSED)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R804 (expr);		/* Don't bother with name. */
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR804_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R804.pool = ffesta_output_pool;
    stmt->u.R804.expr = expr;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif
}

/* ffestd_R805 -- ELSE statement

   ffestd_R805(name_token);

   Make sure ffestd_kind_ identifies an IF block.  If not
   NULL, make sure name_token gives the correct name.  Implement the ELSE
   of the IF block.  */

void
ffestd_R805 (ffelexToken name UNUSED)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R805 ();		/* Don't bother with name. */
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR805_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
  }
#endif
}

/* ffestd_R806 -- End an IF-THEN

   ffestd_R806(TRUE);  */

void
ffestd_R806 (bool ok UNUSED)
{
#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R806 ();
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR806_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
  }
#endif

  --ffestd_block_level_;
  assert (ffestd_block_level_ >= 0);
}

/* ffestd_R807 -- Logical IF statement

   ffestd_R807(expr,expr_token);

   Make sure statement is valid here; implement.  */

void
ffestd_R807 (ffebld expr)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R807 (expr);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR807_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R807.pool = ffesta_output_pool;
    stmt->u.R807.expr = expr;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif

  ++ffestd_block_level_;
  assert (ffestd_block_level_ > 0);
}

/* ffestd_R809 -- SELECT CASE statement

   ffestd_R809(construct_name,expr,expr_token);

   Make sure statement is valid here; implement.  */

void
ffestd_R809 (ffelexToken construct_name UNUSED, ffebld expr)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R809 (ffestw_stack_top (), expr);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR809_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R809.pool = ffesta_output_pool;
    stmt->u.R809.block = ffestw_use (ffestw_stack_top ());
    stmt->u.R809.expr = expr;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
    malloc_pool_use (ffestw_select (ffestw_stack_top ())->pool);
  }
#endif

  ++ffestd_block_level_;
  assert (ffestd_block_level_ > 0);
}

/* ffestd_R810 -- CASE statement

   ffestd_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
ffestd_R810 (unsigned long casenum)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R810 (ffestw_stack_top (), casenum);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR810_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R810.pool = ffesta_output_pool;
    stmt->u.R810.block = ffestw_stack_top ();
    stmt->u.R810.casenum = casenum;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif
}

/* ffestd_R811 -- End a SELECT

   ffestd_R811(TRUE);  */

void
ffestd_R811 (bool ok UNUSED)
{
#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R811 (ffestw_stack_top ());
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR811_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R811.block = ffestw_stack_top ();
  }
#endif

  --ffestd_block_level_;
  assert (ffestd_block_level_ >= 0);
}

/* ffestd_R819A -- Iterative DO statement

   ffestd_R819A(construct_name,label_token,expr,expr_token);

   Make sure statement is valid here; implement.  */

void
ffestd_R819A (ffelexToken construct_name UNUSED, ffelab label,
	      ffebld var, ffebld start, ffelexToken start_token,
	      ffebld end, ffelexToken end_token,
	      ffebld incr, ffelexToken incr_token)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R819A (ffestw_stack_top (), label, var, start, end, incr,
		incr_token);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR819A_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R819A.pool = ffesta_output_pool;
    stmt->u.R819A.block = ffestw_use (ffestw_stack_top ());
    stmt->u.R819A.label = label;
    stmt->u.R819A.var = var;
    stmt->u.R819A.start = start;
    stmt->u.R819A.start_token = ffelex_token_use (start_token);
    stmt->u.R819A.end = end;
    stmt->u.R819A.end_token = ffelex_token_use (end_token);
    stmt->u.R819A.incr = incr;
    stmt->u.R819A.incr_token = (incr_token == NULL) ? NULL
      : ffelex_token_use (incr_token);
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif

  ++ffestd_block_level_;
  assert (ffestd_block_level_ > 0);
}

/* ffestd_R819B -- DO WHILE statement

   ffestd_R819B(construct_name,label_token,expr,expr_token);

   Make sure statement is valid here; implement.  */

void
ffestd_R819B (ffelexToken construct_name UNUSED, ffelab label,
	      ffebld expr)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R819B (ffestw_stack_top (), label, expr);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR819B_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R819B.pool = ffesta_output_pool;
    stmt->u.R819B.block = ffestw_use (ffestw_stack_top ());
    stmt->u.R819B.label = label;
    stmt->u.R819B.expr = expr;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif

  ++ffestd_block_level_;
  assert (ffestd_block_level_ > 0);
}

/* ffestd_R825 -- END DO statement

   ffestd_R825(name_token);

   Make sure ffestd_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).  ffestd_do handles the actual
   generation of end-loop code.	 */

void
ffestd_R825 (ffelexToken name UNUSED)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R825 ();
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR825_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
  }
#endif
}

/* ffestd_R834 -- CYCLE statement

   ffestd_R834(name_token);

   Handle a CYCLE within a loop.  */

void
ffestd_R834 (ffestw block)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R834 (block);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR834_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R834.block = block;
  }
#endif
}

/* ffestd_R835 -- EXIT statement

   ffestd_R835(name_token);

   Handle a EXIT within a loop.	 */

void
ffestd_R835 (ffestw block)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R835 (block);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR835_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R835.block = block;
  }
#endif
}

/* ffestd_R836 -- GOTO statement

   ffestd_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
ffestd_R836 (ffelab label)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R836 (label);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR836_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R836.label = label;
  }
#endif

  if (ffestd_block_level_ == 0)
    ffestd_is_reachable_ = FALSE;
}

/* ffestd_R837 -- Computed GOTO statement

   ffestd_R837(labels,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
ffestd_R837 (ffelab *labels, int count, ffebld expr)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R837 (labels, count, expr);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR837_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R837.pool = ffesta_output_pool;
    stmt->u.R837.labels = labels;
    stmt->u.R837.count = count;
    stmt->u.R837.expr = expr;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif
}

/* ffestd_R838 -- ASSIGN statement

   ffestd_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
ffestd_R838 (ffelab label, ffebld target)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R838 (label, target);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR838_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R838.pool = ffesta_output_pool;
    stmt->u.R838.label = label;
    stmt->u.R838.target = target;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif
}

/* ffestd_R839 -- Assigned GOTO statement

   ffestd_R839(target,labels);

   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
ffestd_R839 (ffebld target, ffelab *labels UNUSED, int count UNUSED)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R839 (target);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR839_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R839.pool = ffesta_output_pool;
    stmt->u.R839.target = target;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif

  if (ffestd_block_level_ == 0)
    ffestd_is_reachable_ = FALSE;
}

/* ffestd_R840 -- Arithmetic IF statement

   ffestd_R840(expr,expr_token,neg,zero,pos);

   Make sure the labels are valid; implement.  */

void
ffestd_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R840 (expr, neg, zero, pos);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR840_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R840.pool = ffesta_output_pool;
    stmt->u.R840.expr = expr;
    stmt->u.R840.neg = neg;
    stmt->u.R840.zero = zero;
    stmt->u.R840.pos = pos;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif

  if (ffestd_block_level_ == 0)
    ffestd_is_reachable_ = FALSE;
}

/* ffestd_R841 -- CONTINUE statement

   ffestd_R841();  */

void
ffestd_R841 (bool in_where UNUSED)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R841 ();
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR841_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
  }
#endif
}

/* ffestd_R842 -- STOP statement

   ffestd_R842(expr);  */

void
ffestd_R842 (ffebld expr)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R842 (expr);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR842_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    if (ffesta_outpooldisp () == FFESTA_pooldispPRESERVE)
      {
	/* This is a "spurious" (automatically-generated) STOP
	   that follows a previous STOP or other statement.
	   Make sure we don't have an expression in the pool,
	   and then mark that the pool has already been killed.  */
	assert (expr == NULL);
	stmt->u.R842.pool = NULL;
	stmt->u.R842.expr = NULL;
      }
    else
      {
	stmt->u.R842.pool = ffesta_output_pool;
	stmt->u.R842.expr = expr;
	ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
      }
  }
#endif

  if (ffestd_block_level_ == 0)
    ffestd_is_reachable_ = FALSE;
}

/* ffestd_R843 -- PAUSE statement

   ffestd_R843(expr,expr_token);

   Make sure statement is valid here; implement.  expr and expr_token are
   both NULL if there was no expression.  */

void
ffestd_R843 (ffebld expr)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R843 (expr);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR843_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R843.pool = ffesta_output_pool;
    stmt->u.R843.expr = expr;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif
}

/* ffestd_R904 -- OPEN statement

   ffestd_R904();

   Make sure an OPEN is valid in the current context, and implement it.	 */

void
ffestd_R904 ()
{
  ffestd_check_simple_ ();

#if FFECOM_targetCURRENT == FFECOM_targetGCC
#define specified(something) \
      (ffestp_file.open.open_spec[something].kw_or_val_present)

  /* Warn if there are any thing we don't handle via f2c libraries. */

  if (specified (FFESTP_openixACTION)
      || specified (FFESTP_openixASSOCIATEVARIABLE)
      || specified (FFESTP_openixBLOCKSIZE)
      || specified (FFESTP_openixBUFFERCOUNT)
      || specified (FFESTP_openixCARRIAGECONTROL)
      || specified (FFESTP_openixDEFAULTFILE)
      || specified (FFESTP_openixDELIM)
      || specified (FFESTP_openixDISPOSE)
      || specified (FFESTP_openixEXTENDSIZE)
      || specified (FFESTP_openixINITIALSIZE)
      || specified (FFESTP_openixKEY)
      || specified (FFESTP_openixMAXREC)
      || specified (FFESTP_openixNOSPANBLOCKS)
      || specified (FFESTP_openixORGANIZATION)
      || specified (FFESTP_openixPAD)
      || specified (FFESTP_openixPOSITION)
      || specified (FFESTP_openixREADONLY)
      || specified (FFESTP_openixRECORDTYPE)
      || specified (FFESTP_openixSHARED)
      || specified (FFESTP_openixUSEROPEN))
    {
      ffebad_start (FFEBAD_OPEN_UNSUPPORTED);
      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
		   ffelex_token_where_column (ffesta_tokens[0]));
      ffebad_finish ();
    }

#undef specified
#endif

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R904 (&ffestp_file.open);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR904_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R904.pool = ffesta_output_pool;
    stmt->u.R904.params = ffestd_subr_copy_open_ ();
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif
}

/* ffestd_R907 -- CLOSE statement

   ffestd_R907();

   Make sure a CLOSE is valid in the current context, and implement it.	 */

void
ffestd_R907 ()
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R907 (&ffestp_file.close);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR907_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R907.pool = ffesta_output_pool;
    stmt->u.R907.params = ffestd_subr_copy_close_ ();
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif
}

/* ffestd_R909_start -- READ(...) statement list begin

   ffestd_R909_start(FALSE);

   Verify that READ is valid here, and begin accepting items in the
   list.  */

void
ffestd_R909_start (bool only_format, ffestvUnit unit,
		   ffestvFormat format, bool rec, bool key)
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetGCC
#define specified(something) \
      (ffestp_file.read.read_spec[something].kw_or_val_present)

  /* Warn if there are any thing we don't handle via f2c libraries. */
  if (specified (FFESTP_readixADVANCE)
      || specified (FFESTP_readixEOR)
      || specified (FFESTP_readixKEYEQ)
      || specified (FFESTP_readixKEYGE)
      || specified (FFESTP_readixKEYGT)
      || specified (FFESTP_readixKEYID)
      || specified (FFESTP_readixNULLS)
      || specified (FFESTP_readixSIZE))
    {
      ffebad_start (FFEBAD_READ_UNSUPPORTED);
      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
		   ffelex_token_where_column (ffesta_tokens[0]));
      ffebad_finish ();
    }

#undef specified
#endif

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R909_start (&ffestp_file.read, only_format, unit, format, rec, key);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR909_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R909.pool = ffesta_output_pool;
    stmt->u.R909.params = ffestd_subr_copy_read_ ();
    stmt->u.R909.only_format = only_format;
    stmt->u.R909.unit = unit;
    stmt->u.R909.format = format;
    stmt->u.R909.rec = rec;
    stmt->u.R909.key = key;
    stmt->u.R909.list = NULL;
    ffestd_expr_list_ = &stmt->u.R909.list;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif
}

/* ffestd_R909_item -- READ statement i/o item

   ffestd_R909_item(expr,expr_token);

   Implement output-list expression.  */

void
ffestd_R909_item (ffebld expr, ffelexToken expr_token)
{
  ffestd_check_item_ ();

#if FFECOM_ONEPASS
  ffeste_R909_item (expr);
#else
  {
    ffestdExprItem_ item
    = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
				       sizeof (*item));

    item->next = NULL;
    item->expr = expr;
    item->token = ffelex_token_use (expr_token);
    *ffestd_expr_list_ = item;
    ffestd_expr_list_ = &item->next;
  }
#endif
}

/* ffestd_R909_finish -- READ statement list complete

   ffestd_R909_finish();

   Just wrap up any local activities.  */

void
ffestd_R909_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_ONEPASS
  ffeste_R909_finish ();
#else
  /* Nothing to do, it's implicit. */
#endif
}

/* ffestd_R910_start -- WRITE(...) statement list begin

   ffestd_R910_start();

   Verify that WRITE is valid here, and begin accepting items in the
   list.  */

void
ffestd_R910_start (ffestvUnit unit, ffestvFormat format, bool rec)
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetGCC
#define specified(something) \
      (ffestp_file.write.write_spec[something].kw_or_val_present)

  /* Warn if there are any thing we don't handle via f2c libraries. */
  if (specified (FFESTP_writeixADVANCE)
      || specified (FFESTP_writeixEOR))
    {
      ffebad_start (FFEBAD_WRITE_UNSUPPORTED);
      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
		   ffelex_token_where_column (ffesta_tokens[0]));
      ffebad_finish ();
    }

#undef specified
#endif

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R910_start (&ffestp_file.write, unit, format, rec);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR910_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R910.pool = ffesta_output_pool;
    stmt->u.R910.params = ffestd_subr_copy_write_ ();
    stmt->u.R910.unit = unit;
    stmt->u.R910.format = format;
    stmt->u.R910.rec = rec;
    stmt->u.R910.list = NULL;
    ffestd_expr_list_ = &stmt->u.R910.list;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif
}

/* ffestd_R910_item -- WRITE statement i/o item

   ffestd_R910_item(expr,expr_token);

   Implement output-list expression.  */

void
ffestd_R910_item (ffebld expr, ffelexToken expr_token)
{
  ffestd_check_item_ ();

#if FFECOM_ONEPASS
  ffeste_R910_item (expr);
#else
  {
    ffestdExprItem_ item
    = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
				       sizeof (*item));

    item->next = NULL;
    item->expr = expr;
    item->token = ffelex_token_use (expr_token);
    *ffestd_expr_list_ = item;
    ffestd_expr_list_ = &item->next;
  }
#endif
}

/* ffestd_R910_finish -- WRITE statement list complete

   ffestd_R910_finish();

   Just wrap up any local activities.  */

void
ffestd_R910_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_ONEPASS
  ffeste_R910_finish ();
#else
  /* Nothing to do, it's implicit. */
#endif
}

/* ffestd_R911_start -- PRINT statement list begin

   ffestd_R911_start();

   Verify that PRINT is valid here, and begin accepting items in the
   list.  */

void
ffestd_R911_start (ffestvFormat format)
{
  ffestd_check_start_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R911_start (&ffestp_file.print, format);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR911_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R911.pool = ffesta_output_pool;
    stmt->u.R911.params = ffestd_subr_copy_print_ ();
    stmt->u.R911.format = format;
    stmt->u.R911.list = NULL;
    ffestd_expr_list_ = &stmt->u.R911.list;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif
}

/* ffestd_R911_item -- PRINT statement i/o item

   ffestd_R911_item(expr,expr_token);

   Implement output-list expression.  */

void
ffestd_R911_item (ffebld expr, ffelexToken expr_token)
{
  ffestd_check_item_ ();

#if FFECOM_ONEPASS
  ffeste_R911_item (expr);
#else
  {
    ffestdExprItem_ item
    = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
				       sizeof (*item));

    item->next = NULL;
    item->expr = expr;
    item->token = ffelex_token_use (expr_token);
    *ffestd_expr_list_ = item;
    ffestd_expr_list_ = &item->next;
  }
#endif
}

/* ffestd_R911_finish -- PRINT statement list complete

   ffestd_R911_finish();

   Just wrap up any local activities.  */

void
ffestd_R911_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_ONEPASS
  ffeste_R911_finish ();
#else
  /* Nothing to do, it's implicit. */
#endif
}

/* ffestd_R919 -- BACKSPACE statement

   ffestd_R919();

   Make sure a BACKSPACE is valid in the current context, and implement it.  */

void
ffestd_R919 ()
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R919 (&ffestp_file.beru);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR919_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R919.pool = ffesta_output_pool;
    stmt->u.R919.params = ffestd_subr_copy_beru_ ();
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif
}

/* ffestd_R920 -- ENDFILE statement

   ffestd_R920();

   Make sure a ENDFILE is valid in the current context, and implement it.  */

void
ffestd_R920 ()
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R920 (&ffestp_file.beru);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR920_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R920.pool = ffesta_output_pool;
    stmt->u.R920.params = ffestd_subr_copy_beru_ ();
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif
}

/* ffestd_R921 -- REWIND statement

   ffestd_R921();

   Make sure a REWIND is valid in the current context, and implement it.  */

void
ffestd_R921 ()
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R921 (&ffestp_file.beru);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR921_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R921.pool = ffesta_output_pool;
    stmt->u.R921.params = ffestd_subr_copy_beru_ ();
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif
}

/* ffestd_R923A -- INQUIRE statement (non-IOLENGTH version)

   ffestd_R923A(bool by_file);

   Make sure an INQUIRE is valid in the current context, and implement it.  */

void
ffestd_R923A (bool by_file)
{
  ffestd_check_simple_ ();

#if FFECOM_targetCURRENT == FFECOM_targetGCC
#define specified(something) \
      (ffestp_file.inquire.inquire_spec[something].kw_or_val_present)

  /* Warn if there are any thing we don't handle via f2c libraries. */
  if (specified (FFESTP_inquireixACTION)
      || specified (FFESTP_inquireixCARRIAGECONTROL)
      || specified (FFESTP_inquireixDEFAULTFILE)
      || specified (FFESTP_inquireixDELIM)
      || specified (FFESTP_inquireixKEYED)
      || specified (FFESTP_inquireixORGANIZATION)
      || specified (FFESTP_inquireixPAD)
      || specified (FFESTP_inquireixPOSITION)
      || specified (FFESTP_inquireixREAD)
      || specified (FFESTP_inquireixREADWRITE)
      || specified (FFESTP_inquireixRECORDTYPE)
      || specified (FFESTP_inquireixWRITE))
    {
      ffebad_start (FFEBAD_INQUIRE_UNSUPPORTED);
      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
		   ffelex_token_where_column (ffesta_tokens[0]));
      ffebad_finish ();
    }

#undef specified
#endif

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R923A (&ffestp_file.inquire, by_file);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR923A_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R923A.pool = ffesta_output_pool;
    stmt->u.R923A.params = ffestd_subr_copy_inquire_ ();
    stmt->u.R923A.by_file = by_file;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif
}

/* ffestd_R923B_start -- INQUIRE(IOLENGTH=expr) statement list begin

   ffestd_R923B_start();

   Verify that INQUIRE is valid here, and begin accepting items in the
   list.  */

void
ffestd_R923B_start ()
{
  ffestd_check_start_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R923B_start (&ffestp_file.inquire);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR923B_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R923B.pool = ffesta_output_pool;
    stmt->u.R923B.params = ffestd_subr_copy_inquire_ ();
    stmt->u.R923B.list = NULL;
    ffestd_expr_list_ = &stmt->u.R923B.list;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif
}

/* ffestd_R923B_item -- INQUIRE statement i/o item

   ffestd_R923B_item(expr,expr_token);

   Implement output-list expression.  */

void
ffestd_R923B_item (ffebld expr)
{
  ffestd_check_item_ ();

#if FFECOM_ONEPASS
  ffeste_R923B_item (expr);
#else
  {
    ffestdExprItem_ item
    = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
				       sizeof (*item));

    item->next = NULL;
    item->expr = expr;
    *ffestd_expr_list_ = item;
    ffestd_expr_list_ = &item->next;
  }
#endif
}

/* ffestd_R923B_finish -- INQUIRE statement list complete

   ffestd_R923B_finish();

   Just wrap up any local activities.  */

void
ffestd_R923B_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_ONEPASS
  ffeste_R923B_finish ();
#else
  /* Nothing to do, it's implicit. */
#endif
}

/* ffestd_R1001 -- FORMAT statement

   ffestd_R1001(format_list);  */

void
ffestd_R1001 (ffesttFormatList f)
{
  ffestsHolder str;
  ffests s = &str;

  ffestd_check_simple_ ();

  if (ffestd_label_formatdef_ == NULL)
    return;			/* Nothing to hook it up to (no label def). */

  ffests_new (s, malloc_pool_image (), 80);
  ffests_putc (s, '(');
  ffestd_R1001dump_ (s, f);	/* Build the string in s. */
  ffests_putc (s, ')');

#if FFECOM_ONEPASS
  ffeste_R1001 (s);
  ffests_kill (s);		/* Kill the string in s. */
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR1001_);
    ffestd_stmt_append_ (stmt);
    stmt->u.R1001.str = str;
  }
#endif

  ffestd_label_formatdef_ = NULL;
}

/* ffestd_R1001dump_ -- Dump list of formats

   ffesttFormatList list;
   ffestd_R1001dump_(list,0);

   The formats in the list are dumped.	*/

static void
ffestd_R1001dump_ (ffests s, ffesttFormatList list)
{
  ffesttFormatList next;

  for (next = list->next; next != list; next = next->next)
    {
      if (next != list->next)
	ffests_putc (s, ',');
      switch (next->type)
	{
	case FFESTP_formattypeI:
	  ffestd_R1001dump_1005_3_ (s, next, "I");
	  break;

	case FFESTP_formattypeB:
#if FFECOM_targetCURRENT == FFECOM_targetFFE
	  ffestd_R1001dump_1005_3_ (s, next, "B");
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
	  ffestd_R1001error_ (next);
#else
#error
#endif
	  break;

	case FFESTP_formattypeO:
	  ffestd_R1001dump_1005_3_ (s, next, "O");
	  break;

	case FFESTP_formattypeZ:
	  ffestd_R1001dump_1005_3_ (s, next, "Z");
	  break;

	case FFESTP_formattypeF:
	  ffestd_R1001dump_1005_4_ (s, next, "F");
	  break;

	case FFESTP_formattypeE:
	  ffestd_R1001dump_1005_5_ (s, next, "E");
	  break;

	case FFESTP_formattypeEN:
#if FFECOM_targetCURRENT == FFECOM_targetFFE
	  ffestd_R1001dump_1005_5_ (s, next, "EN");
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
	  ffestd_R1001error_ (next);
#else
#error
#endif
	  break;

	case FFESTP_formattypeG:
	  ffestd_R1001dump_1005_5_ (s, next, "G");
	  break;

	case FFESTP_formattypeL:
	  ffestd_R1001dump_1005_2_ (s, next, "L");
	  break;

	case FFESTP_formattypeA:
	  ffestd_R1001dump_1005_1_ (s, next, "A");
	  break;

	case FFESTP_formattypeD:
	  ffestd_R1001dump_1005_4_ (s, next, "D");
	  break;

	case FFESTP_formattypeQ:
#if FFECOM_targetCURRENT == FFECOM_targetFFE
	  ffestd_R1001dump_1010_1_ (s, next, "Q");
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
	  ffestd_R1001error_ (next);
#else
#error
#endif
	  break;

	case FFESTP_formattypeDOLLAR:
	  ffestd_R1001dump_1010_1_ (s, next, "$");
	  break;

	case FFESTP_formattypeP:
	  ffestd_R1001dump_1010_4_ (s, next, "P");
	  break;

	case FFESTP_formattypeT:
	  ffestd_R1001dump_1010_5_ (s, next, "T");
	  break;

	case FFESTP_formattypeTL:
	  ffestd_R1001dump_1010_5_ (s, next, "TL");
	  break;

	case FFESTP_formattypeTR:
	  ffestd_R1001dump_1010_5_ (s, next, "TR");
	  break;

	case FFESTP_formattypeX:
	  ffestd_R1001dump_1010_3_ (s, next, "X");
	  break;

	case FFESTP_formattypeS:
	  ffestd_R1001dump_1010_1_ (s, next, "S");
	  break;

	case FFESTP_formattypeSP:
	  ffestd_R1001dump_1010_1_ (s, next, "SP");
	  break;

	case FFESTP_formattypeSS:
	  ffestd_R1001dump_1010_1_ (s, next, "SS");
	  break;

	case FFESTP_formattypeBN:
	  ffestd_R1001dump_1010_1_ (s, next, "BN");
	  break;

	case FFESTP_formattypeBZ:
	  ffestd_R1001dump_1010_1_ (s, next, "BZ");
	  break;

	case FFESTP_formattypeSLASH:
	  ffestd_R1001dump_1010_2_ (s, next, "/");
	  break;

	case FFESTP_formattypeCOLON:
	  ffestd_R1001dump_1010_1_ (s, next, ":");
	  break;

	case FFESTP_formattypeR1016:
	  switch (ffelex_token_type (next->t))
	    {
	    case FFELEX_typeCHARACTER:
	      {
		char *p = ffelex_token_text (next->t);
		ffeTokenLength i = ffelex_token_length (next->t);

		ffests_putc (s, '\002');
		while (i-- != 0)
		  {
		    if (*p == '\002')
		      ffests_putc (s, '\002');
		    ffests_putc (s, *p);
		    ++p;
		  }
		ffests_putc (s, '\002');
	      }
	      break;

	    case FFELEX_typeHOLLERITH:
	      {
		char *p = ffelex_token_text (next->t);
		ffeTokenLength i = ffelex_token_length (next->t);

		ffests_printf_1U (s,
				  "%" ffeTokenLength_f "uH",
				  i);
		while (i-- != 0)
		  {
		    ffests_putc (s, *p);
		    ++p;
		  }
	      }
	      break;

	    default:
	      assert (FALSE);
	    }
	  break;

	case FFESTP_formattypeFORMAT:
	  if (next->u.R1003D.R1004.present)
	    {
	      if (next->u.R1003D.R1004.rtexpr)
		ffestd_R1001rtexpr_ (s, next, next->u.R1003D.R1004.u.expr);
	      else
		ffests_printf_1U (s, "%lu",
				  next->u.R1003D.R1004.u.unsigned_val);
	    }

	  ffests_putc (s, '(');
	  ffestd_R1001dump_ (s, next->u.R1003D.format);
	  ffests_putc (s, ')');
	  break;

	default:
	  assert (FALSE);
	}
    }
}

/* ffestd_R1001dump_1005_1_ -- Dump a particular format

   ffesttFormatList f;
   ffestd_R1001dump_1005_1_(f,"I");

   The format is dumped with form [r]X[w].  */

static void
ffestd_R1001dump_1005_1_ (ffests s, ffesttFormatList f, char *string)
{
  assert (!f->u.R1005.R1007_or_R1008.present);
  assert (!f->u.R1005.R1009.present);

  if (f->u.R1005.R1004.present)
    {
      if (f->u.R1005.R1004.rtexpr)
	ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
      else
	ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
    }

  ffests_puts (s, string);

  if (f->u.R1005.R1006.present)
    {
      if (f->u.R1005.R1006.rtexpr)
	ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
      else
	ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
    }
}

/* ffestd_R1001dump_1005_2_ -- Dump a particular format

   ffesttFormatList f;
   ffestd_R1001dump_1005_2_(f,"I");

   The format is dumped with form [r]Xw.  */

static void
ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f, char *string)
{
  assert (!f->u.R1005.R1007_or_R1008.present);
  assert (!f->u.R1005.R1009.present);
  assert (f->u.R1005.R1006.present);

  if (f->u.R1005.R1004.present)
    {
      if (f->u.R1005.R1004.rtexpr)
	ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
      else
	ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
    }

  ffests_puts (s, string);

  if (f->u.R1005.R1006.rtexpr)
    ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
  else
    ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
}

/* ffestd_R1001dump_1005_3_ -- Dump a particular format

   ffesttFormatList f;
   ffestd_R1001dump_1005_3_(f,"I");

   The format is dumped with form [r]Xw[.m].  */

static void
ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f, char *string)
{
  assert (!f->u.R1005.R1009.present);
  assert (f->u.R1005.R1006.present);

  if (f->u.R1005.R1004.present)
    {
      if (f->u.R1005.R1004.rtexpr)
	ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
      else
	ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
    }

  ffests_puts (s, string);

  if (f->u.R1005.R1006.rtexpr)
    ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
  else
    ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);

  if (f->u.R1005.R1007_or_R1008.present)
    {
      ffests_putc (s, '.');
      if (f->u.R1005.R1007_or_R1008.rtexpr)
	ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1007_or_R1008.u.expr);
      else
	ffests_printf_1U (s, "%lu",
			  f->u.R1005.R1007_or_R1008.u.unsigned_val);
    }
}

/* ffestd_R1001dump_1005_4_ -- Dump a particular format

   ffesttFormatList f;
   ffestd_R1001dump_1005_4_(f,"I");

   The format is dumped with form [r]Xw.d.  */

static void
ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f, char *string)
{
  assert (!f->u.R1005.R1009.present);
  assert (f->u.R1005.R1007_or_R1008.present);
  assert (f->u.R1005.R1006.present);

  if (f->u.R1005.R1004.present)
    {
      if (f->u.R1005.R1004.rtexpr)
	ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
      else
	ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
    }

  ffests_puts (s, string);

  if (f->u.R1005.R1006.rtexpr)
    ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
  else
    ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);

  ffests_putc (s, '.');
  if (f->u.R1005.R1007_or_R1008.rtexpr)
    ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1007_or_R1008.u.expr);
  else
    ffests_printf_1U (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
}

/* ffestd_R1001dump_1005_5_ -- Dump a particular format

   ffesttFormatList f;
   ffestd_R1001dump_1005_5_(f,"I");

   The format is dumped with form [r]Xw.d[Ee].	*/

static void
ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f, char *string)
{
  assert (f->u.R1005.R1007_or_R1008.present);
  assert (f->u.R1005.R1006.present);

  if (f->u.R1005.R1004.present)
    {
      if (f->u.R1005.R1004.rtexpr)
	ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
      else
	ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
    }

  ffests_puts (s, string);

  if (f->u.R1005.R1006.rtexpr)
    ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
  else
    ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);

  ffests_putc (s, '.');
  if (f->u.R1005.R1007_or_R1008.rtexpr)
    ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1007_or_R1008.u.expr);
  else
    ffests_printf_1U (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);

  if (f->u.R1005.R1009.present)
    {
      ffests_putc (s, 'E');
      if (f->u.R1005.R1009.rtexpr)
	ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1009.u.expr);
      else
	ffests_printf_1U (s, "%lu", f->u.R1005.R1009.u.unsigned_val);
    }
}

/* ffestd_R1001dump_1010_1_ -- Dump a particular format

   ffesttFormatList f;
   ffestd_R1001dump_1010_1_(f,"I");

   The format is dumped with form X.  */

static void
ffestd_R1001dump_1010_1_ (ffests s, ffesttFormatList f, char *string)
{
  assert (!f->u.R1010.val.present);

  ffests_puts (s, string);
}

/* ffestd_R1001dump_1010_2_ -- Dump a particular format

   ffesttFormatList f;
   ffestd_R1001dump_1010_2_(f,"I");

   The format is dumped with form [r]X.	 */

static void
ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f, char *string)
{
  if (f->u.R1010.val.present)
    {
      if (f->u.R1010.val.rtexpr)
	ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
      else
	ffests_printf_1U (s, "%lu", f->u.R1010.val.u.unsigned_val);
    }

  ffests_puts (s, string);
}

/* ffestd_R1001dump_1010_3_ -- Dump a particular format

   ffesttFormatList f;
   ffestd_R1001dump_1010_3_(f,"I");

   The format is dumped with form nX.  */

static void
ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f, char *string)
{
  assert (f->u.R1010.val.present);

  if (f->u.R1010.val.rtexpr)
    ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
  else
    ffests_printf_1U (s, "%lu", f->u.R1010.val.u.unsigned_val);

  ffests_puts (s, string);
}

/* ffestd_R1001dump_1010_4_ -- Dump a particular format

   ffesttFormatList f;
   ffestd_R1001dump_1010_4_(f,"I");

   The format is dumped with form kX.  Note that k is signed.  */

static void
ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f, char *string)
{
  assert (f->u.R1010.val.present);

  if (f->u.R1010.val.rtexpr)
    ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
  else
    ffests_printf_1D (s, "%ld", f->u.R1010.val.u.signed_val);

  ffests_puts (s, string);
}

/* ffestd_R1001dump_1010_5_ -- Dump a particular format

   ffesttFormatList f;
   ffestd_R1001dump_1010_5_(f,"I");

   The format is dumped with form Xn.  */

static void
ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f, char *string)
{
  assert (f->u.R1010.val.present);

  ffests_puts (s, string);

  if (f->u.R1010.val.rtexpr)
    ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
  else
    ffests_printf_1U (s, "%lu", f->u.R1010.val.u.unsigned_val);
}

/* ffestd_R1001error_ -- Complain about FORMAT specification not supported

   ffesttFormatList f;
   ffestd_R1001error_(f);

   An error message is produced.  */

static void
ffestd_R1001error_ (ffesttFormatList f)
{
  ffebad_start (FFEBAD_FORMAT_UNSUPPORTED);
  ffebad_here (0, ffelex_token_where_line (f->t), ffelex_token_where_column (f->t));
  ffebad_finish ();
}

static void
ffestd_R1001rtexpr_ (ffests s, ffesttFormatList f, ffebld expr)
{
  if ((expr == NULL)
      || (ffebld_op (expr) != FFEBLD_opCONTER)
      || (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeINTEGER)
      || (ffeinfo_kindtype (ffebld_info (expr)) == FFEINFO_kindtypeINTEGER4))
    {
      ffebad_start (FFEBAD_FORMAT_VARIABLE);
      ffebad_here (0, ffelex_token_where_line (f->t), ffelex_token_where_column (f->t));
      ffebad_finish ();
    }
  else
    {
      int val;

      switch (ffeinfo_kindtype (ffebld_info (expr)))
	{
#if FFETARGET_okINTEGER1
	case FFEINFO_kindtypeINTEGER1:
	  val = ffebld_constant_integer1 (ffebld_conter (expr));
	  break;
#endif

#if FFETARGET_okINTEGER2
	case FFEINFO_kindtypeINTEGER2:
	  val = ffebld_constant_integer2 (ffebld_conter (expr));
	  break;
#endif

#if FFETARGET_okINTEGER3
	case FFEINFO_kindtypeINTEGER3:
	  val = ffebld_constant_integer3 (ffebld_conter (expr));
	  break;
#endif

	default:
	  assert ("bad INTEGER constant kind type" == NULL);
	  /* Fall through. */
	case FFEINFO_kindtypeANY:
	  return;
	}
      ffests_printf_1D (s, "%ld", val);
    }
}

/* ffestd_R1102 -- PROGRAM statement

   ffestd_R1102(name_token);

   Make sure ffestd_kind_ identifies an empty block.  Make sure name_token
   gives a valid name.	Implement the beginning of a main program.  */

void
ffestd_R1102 (ffesymbol s, ffelexToken name UNUSED)
{
  ffestd_check_simple_ ();

  assert (ffestd_block_level_ == 0);
  ffestd_is_reachable_ = TRUE;

  ffecom_notify_primary_entry (s);
  ffe_set_is_mainprog (TRUE);	/* Is a main program. */
  ffe_set_is_saveall (TRUE);	/* Main program always has implicit SAVE. */

  ffestw_set_sym (ffestw_stack_top (), s);

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  if (name == NULL)
    fputs ("< PROGRAM_unnamed\n", dmpout);
  else
    fprintf (dmpout, "< PROGRAM %s\n", ffelex_token_text (name));
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R1103 -- End a PROGRAM

   ffestd_R1103();  */

void
ffestd_R1103 (bool ok UNUSED)
{
  assert (ffestd_block_level_ == 0);

  if (FFESTD_IS_END_OPTIMIZED_ && ffestd_is_reachable_)
    ffestd_R842 (NULL);		/* Generate STOP. */

  if (ffestw_state (ffestw_stack_top ()) != FFESTV_statePROGRAM5)
    ffestd_subr_labels_ (FALSE);/* Handle any undefined labels. */

#if FFECOM_ONEPASS
  ffeste_R1103 ();
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR1103_);
    ffestd_stmt_append_ (stmt);
  }
#endif
}

/* ffestd_R1105 -- MODULE statement

   ffestd_R1105(name_token);

   Make sure ffestd_kind_ identifies an empty block.  Make sure name_token
   gives a valid name.	Implement the beginning of a module.  */

#if FFESTR_F90
void
ffestd_R1105 (ffelexToken name)
{
  assert (ffestd_block_level_ == 0);

  ffestd_check_simple_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  fprintf (dmpout, "* MODULE %s\n", ffelex_token_text (name));
#endif
}

/* ffestd_R1106 -- End a MODULE

   ffestd_R1106(TRUE);	*/

void
ffestd_R1106 (bool ok)
{
  assert (ffestd_block_level_ == 0);

  /* Generate any wrap-up code here (unlikely in MODULE!). */

  if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateMODULE5)
    ffestd_subr_labels_ (TRUE);	/* Handle any undefined labels (unlikely). */

  return;			/* F90. */

#ifdef FFESTD_F90
  fprintf (dmpout, "< END_MODULE %s\n",
	   ffelex_token_text (ffestw_name (ffestw_stack_top ())));
#endif
}

/* ffestd_R1107_start -- USE statement list begin

   ffestd_R1107_start();

   Verify that USE is valid here, and begin accepting items in the list.  */

void
ffestd_R1107_start (ffelexToken name, bool only)
{
  ffestd_check_start_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  fprintf (dmpout, "* USE %s,", ffelex_token_text (name));	/* NB
								   _shriek_begin_uses_. */
  if (only)
    fputs ("only: ", dmpout);
#endif
}

/* ffestd_R1107_item -- USE statement for name

   ffestd_R1107_item(local_token,use_token);

   Make sure name_token identifies a valid object to be USEed.	local_token
   may be NULL if _start_ was called with only==TRUE.  */

void
ffestd_R1107_item (ffelexToken local, ffelexToken use)
{
  ffestd_check_item_ ();
  assert (use != NULL);

  return;			/* F90. */

#ifdef FFESTD_F90
  if (local != NULL)
    fprintf (dmpout, "%s=>", ffelex_token_text (local));
  fprintf (dmpout, "%s,", ffelex_token_text (use));
#endif
}

/* ffestd_R1107_finish -- USE statement list complete

   ffestd_R1107_finish();

   Just wrap up any local activities.  */

void
ffestd_R1107_finish ()
{
  ffestd_check_finish_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fputc ('\n', dmpout);
#endif
}

#endif
/* ffestd_R1111 -- BLOCK DATA statement

   ffestd_R1111(name_token);

   Make sure ffestd_kind_ identifies no current program unit.  If not
   NULL, make sure name_token gives a valid name.  Implement the beginning
   of a block data program unit.  */

void
ffestd_R1111 (ffesymbol s, ffelexToken name UNUSED)
{
  assert (ffestd_block_level_ == 0);
  ffestd_is_reachable_ = TRUE;

  ffestd_check_simple_ ();

  ffecom_notify_primary_entry (s);
  ffestw_set_sym (ffestw_stack_top (), s);

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  if (name == NULL)
    fputs ("< BLOCK_DATA_unnamed\n", dmpout);
  else
    fprintf (dmpout, "< BLOCK_DATA %s\n", ffelex_token_text (name));
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R1112 -- End a BLOCK DATA

   ffestd_R1112(TRUE);	*/

void
ffestd_R1112 (bool ok UNUSED)
{
  assert (ffestd_block_level_ == 0);

  /* Generate any return-like code here (not likely for BLOCK DATA!). */

  if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateBLOCKDATA5)
    ffestd_subr_labels_ (TRUE);	/* Handle any undefined labels. */

#if FFECOM_ONEPASS
  ffeste_R1112 ();
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR1112_);
    ffestd_stmt_append_ (stmt);
  }
#endif
}

/* ffestd_R1202 -- INTERFACE statement

   ffestd_R1202(operator,defined_name);

   Make sure ffestd_kind_ identifies an INTERFACE block.
   Implement the end of the current interface.

   06-Jun-90  JCB  1.1
      Allow no operator or name to mean INTERFACE by itself; missed this
      valid form when originally doing syntactic analysis code.	 */

#if FFESTR_F90
void
ffestd_R1202 (ffestpDefinedOperator operator, ffelexToken name)
{
  ffestd_check_simple_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  switch (operator)
    {
    case FFESTP_definedoperatorNone:
      if (name == NULL)
	fputs ("* INTERFACE_unnamed\n", dmpout);
      else
	fprintf (dmpout, "* INTERFACE %s\n", ffelex_token_text (name));
      break;

    case FFESTP_definedoperatorOPERATOR:
      fprintf (dmpout, "* INTERFACE_OPERATOR (.%s.)\n", ffelex_token_text (name));
      break;

    case FFESTP_definedoperatorASSIGNMENT:
      fputs ("* INTERFACE_ASSIGNMENT (=)\n", dmpout);
      break;

    case FFESTP_definedoperatorPOWER:
      fputs ("* INTERFACE_OPERATOR (**)\n", dmpout);
      break;

    case FFESTP_definedoperatorMULT:
      fputs ("* INTERFACE_OPERATOR (*)\n", dmpout);
      break;

    case FFESTP_definedoperatorADD:
      fputs ("* INTERFACE_OPERATOR (+)\n", dmpout);
      break;

    case FFESTP_definedoperatorCONCAT:
      fputs ("* INTERFACE_OPERATOR (//)\n", dmpout);
      break;

    case FFESTP_definedoperatorDIVIDE:
      fputs ("* INTERFACE_OPERATOR (/)\n", dmpout);
      break;

    case FFESTP_definedoperatorSUBTRACT:
      fputs ("* INTERFACE_OPERATOR (-)\n", dmpout);
      break;

    case FFESTP_definedoperatorNOT:
      fputs ("* INTERFACE_OPERATOR (.not.)\n", dmpout);
      break;

    case FFESTP_definedoperatorAND:
      fputs ("* INTERFACE_OPERATOR (.and.)\n", dmpout);
      break;

    case FFESTP_definedoperatorOR:
      fputs ("* INTERFACE_OPERATOR (.or.)\n", dmpout);
      break;

    case FFESTP_definedoperatorEQV:
      fputs ("* INTERFACE_OPERATOR (.eqv.)\n", dmpout);
      break;

    case FFESTP_definedoperatorNEQV:
      fputs ("* INTERFACE_OPERATOR (.neqv.)\n", dmpout);
      break;

    case FFESTP_definedoperatorEQ:
      fputs ("* INTERFACE_OPERATOR (==)\n", dmpout);
      break;

    case FFESTP_definedoperatorNE:
      fputs ("* INTERFACE_OPERATOR (/=)\n", dmpout);
      break;

    case FFESTP_definedoperatorLT:
      fputs ("* INTERFACE_OPERATOR (<)\n", dmpout);
      break;

    case FFESTP_definedoperatorLE:
      fputs ("* INTERFACE_OPERATOR (<=)\n", dmpout);
      break;

    case FFESTP_definedoperatorGT:
      fputs ("* INTERFACE_OPERATOR (>)\n", dmpout);
      break;

    case FFESTP_definedoperatorGE:
      fputs ("* INTERFACE_OPERATOR (>=)\n", dmpout);
      break;

    default:
      assert (FALSE);
      break;
    }
#endif
}

/* ffestd_R1203 -- End an INTERFACE

   ffestd_R1203(TRUE);	*/

void
ffestd_R1203 (bool ok)
{
  return;			/* F90. */

#ifdef FFESTD_F90
  fputs ("* END_INTERFACE\n", dmpout);
#endif
}

/* ffestd_R1205_start -- MODULE PROCEDURE statement list begin

   ffestd_R1205_start();

   Verify that MODULE PROCEDURE is valid here, and begin accepting items in
   the list.  */

void
ffestd_R1205_start ()
{
  ffestd_check_start_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fputs ("* MODULE_PROCEDURE ", dmpout);
#endif
}

/* ffestd_R1205_item -- MODULE PROCEDURE statement for name

   ffestd_R1205_item(name_token);

   Make sure name_token identifies a valid object to be MODULE PROCEDUREed.  */

void
ffestd_R1205_item (ffelexToken name)
{
  ffestd_check_item_ ();
  assert (name != NULL);

  return;			/* F90. */

#ifdef FFESTD_F90
  fprintf (dmpout, "%s,", ffelex_token_text (name));
#endif
}

/* ffestd_R1205_finish -- MODULE PROCEDURE statement list complete

   ffestd_R1205_finish();

   Just wrap up any local activities.  */

void
ffestd_R1205_finish ()
{
  ffestd_check_finish_ ();

  return;			/* F90. */

#ifdef FFESTD_F90
  fputc ('\n', dmpout);
#endif
}

#endif
/* ffestd_R1207_start -- EXTERNAL statement list begin

   ffestd_R1207_start();

   Verify that EXTERNAL is valid here, and begin accepting items in the list.  */

void
ffestd_R1207_start ()
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* EXTERNAL (", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R1207_item -- EXTERNAL statement for name

   ffestd_R1207_item(name_token);

   Make sure name_token identifies a valid object to be EXTERNALd.  */

void
ffestd_R1207_item (ffelexToken name)
{
  ffestd_check_item_ ();
  assert (name != NULL);

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fprintf (dmpout, "%s,", ffelex_token_text (name));
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R1207_finish -- EXTERNAL statement list complete

   ffestd_R1207_finish();

   Just wrap up any local activities.  */

void
ffestd_R1207_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs (")\n", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R1208_start -- INTRINSIC statement list begin

   ffestd_R1208_start();

   Verify that INTRINSIC is valid here, and begin accepting items in the list.	*/

void
ffestd_R1208_start ()
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* INTRINSIC (", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R1208_item -- INTRINSIC statement for name

   ffestd_R1208_item(name_token);

   Make sure name_token identifies a valid object to be INTRINSICd.  */

void
ffestd_R1208_item (ffelexToken name)
{
  ffestd_check_item_ ();
  assert (name != NULL);

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fprintf (dmpout, "%s,", ffelex_token_text (name));
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R1208_finish -- INTRINSIC statement list complete

   ffestd_R1208_finish();

   Just wrap up any local activities.  */

void
ffestd_R1208_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs (")\n", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R1212 -- CALL statement

   ffestd_R1212(expr,expr_token);

   Make sure statement is valid here; implement.  */

void
ffestd_R1212 (ffebld expr)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R1212 (expr);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR1212_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R1212.pool = ffesta_output_pool;
    stmt->u.R1212.expr = expr;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif
}

/* ffestd_R1213 -- Defined assignment statement

   ffestd_R1213(dest_expr,source_expr,source_token);

   Make sure the assignment is valid.  */

#if FFESTR_F90
void
ffestd_R1213 (ffebld dest, ffebld source)
{
  ffestd_check_simple_ ();

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  fputs ("+ let_defined ", dmpout);
  ffebld_dump (dest);
  fputs ("=", dmpout);
  ffebld_dump (source);
  fputc ('\n', dmpout);
#endif
}

#endif
/* ffestd_R1219 -- FUNCTION statement

   ffestd_R1219(funcname,arglist,ending_token,kind,kindt,len,lent,
	 recursive);

   Make sure statement is valid here, register arguments for the
   function name, and so on.

   06-Jun-90  JCB  2.0
      Added the kind, len, and recursive arguments.  */

void
ffestd_R1219 (ffesymbol s, ffelexToken funcname UNUSED,
	      ffesttTokenList args UNUSED, ffestpType type UNUSED,
	      ffebld kind UNUSED, ffelexToken kindt UNUSED,
	      ffebld len UNUSED, ffelexToken lent UNUSED,
	      bool recursive UNUSED, ffelexToken result UNUSED,
	      bool separate_result UNUSED)
{
#if FFECOM_targetCURRENT == FFECOM_targetFFE
  char *a;
#endif

  assert (ffestd_block_level_ == 0);
  ffestd_is_reachable_ = TRUE;

  ffestd_check_simple_ ();

  ffecom_notify_primary_entry (s);
  ffestw_set_sym (ffestw_stack_top (), s);

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  switch (type)
    {
    case FFESTP_typeINTEGER:
      a = "INTEGER";
      break;

    case FFESTP_typeBYTE:
      a = "BYTE";
      break;

    case FFESTP_typeWORD:
      a = "WORD";
      break;

    case FFESTP_typeREAL:
      a = "REAL";
      break;

    case FFESTP_typeCOMPLEX:
      a = "COMPLEX";
      break;

    case FFESTP_typeLOGICAL:
      a = "LOGICAL";
      break;

    case FFESTP_typeCHARACTER:
      a = "CHARACTER";
      break;

    case FFESTP_typeDBLPRCSN:
      a = "DOUBLE PRECISION";
      break;

    case FFESTP_typeDBLCMPLX:
      a = "DOUBLE COMPLEX";
      break;

#if FFESTR_F90
    case FFESTP_typeTYPE:
      a = "TYPE";
      break;
#endif

    case FFESTP_typeNone:
      a = "";
      break;

    default:
      assert (FALSE);
      a = "?";
      break;
    }
  fprintf (dmpout, "< FUNCTION %s ", ffelex_token_text (funcname));
  if (recursive)
    fputs ("RECURSIVE ", dmpout);
  fprintf (dmpout, "%s(", a);
  if (kindt != NULL)
    {
      fputs ("kind=", dmpout);
      if (kind == NULL)
	fputs (ffelex_token_text (kindt), dmpout);
      else
	ffebld_dump (kind);
      if (lent != NULL)
	fputc (',', dmpout);
    }
  if (lent != NULL)
    {
      fputs ("len=", dmpout);
      if (len == NULL)
	fputs (ffelex_token_text (lent), dmpout);
      else
	ffebld_dump (len);
    }
  fprintf (dmpout, ")");
  if (args != NULL)
    {
      fputs (" (", dmpout);
      ffestt_tokenlist_dump (args);
      fputc (')', dmpout);
    }
  if (result != NULL)
    fprintf (dmpout, " result(%s)", ffelex_token_text (result));
  fputc ('\n', dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R1221 -- End a FUNCTION

   ffestd_R1221(TRUE);	*/

void
ffestd_R1221 (bool ok UNUSED)
{
  assert (ffestd_block_level_ == 0);

  if (FFESTD_IS_END_OPTIMIZED_ && ffestd_is_reachable_)
    ffestd_R1227 (NULL);	/* Generate RETURN. */

  if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateFUNCTION5)
    ffestd_subr_labels_ (FALSE);/* Handle any undefined labels. */

#if FFECOM_ONEPASS
  ffeste_R1221 ();
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR1221_);
    ffestd_stmt_append_ (stmt);
  }
#endif
}

/* ffestd_R1223 -- SUBROUTINE statement

   ffestd_R1223(subrname,arglist,ending_token,recursive_token);

   Make sure statement is valid here, register arguments for the
   subroutine name, and so on.

   06-Jun-90  JCB  2.0
      Added the recursive argument.  */

void
ffestd_R1223 (ffesymbol s, ffelexToken subrname UNUSED,
	      ffesttTokenList args UNUSED, ffelexToken final UNUSED,
	      bool recursive UNUSED)
{
  assert (ffestd_block_level_ == 0);
  ffestd_is_reachable_ = TRUE;

  ffestd_check_simple_ ();

  ffecom_notify_primary_entry (s);
  ffestw_set_sym (ffestw_stack_top (), s);

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fprintf (dmpout, "< SUBROUTINE %s ", ffelex_token_text (subrname));
  if (recursive)
    fputs ("recursive ", dmpout);
  if (args != NULL)
    {
      fputc ('(', dmpout);
      ffestt_tokenlist_dump (args);
      fputc (')', dmpout);
    }
  fputc ('\n', dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R1225 -- End a SUBROUTINE

   ffestd_R1225(TRUE);	*/

void
ffestd_R1225 (bool ok UNUSED)
{
  assert (ffestd_block_level_ == 0);

  if (FFESTD_IS_END_OPTIMIZED_ && ffestd_is_reachable_)
    ffestd_R1227 (NULL);	/* Generate RETURN. */

  if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateSUBROUTINE5)
    ffestd_subr_labels_ (FALSE);/* Handle any undefined labels. */

#if FFECOM_ONEPASS
  ffeste_R1225 ();
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR1225_);
    ffestd_stmt_append_ (stmt);
  }
#endif
}

/* ffestd_R1226 -- ENTRY statement

   ffestd_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
ffestd_R1226 (ffesymbol entry)
{
  ffestd_check_simple_ ();

#if (FFECOM_targetCURRENT == FFECOM_targetFFE) || FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R1226 (entry);
#else
  if (!ffesta_seen_first_exec || ffecom_2pass_advise_entrypoint (entry))
    {
      ffestdStmt_ stmt;

      stmt = ffestd_stmt_new_ (FFESTD_stmtidR1226_);
      ffestd_stmt_append_ (stmt);
      ffestd_subr_line_save_ (stmt);
      stmt->u.R1226.entry = entry;
      stmt->u.R1226.entrynum = ++ffestd_2pass_entrypoints_;
    }
#endif

  ffestd_is_reachable_ = TRUE;
}

/* ffestd_R1227 -- RETURN statement

   ffestd_R1227(expr);

   Make sure statement is valid here; implement.  expr and expr_token are
   both NULL if there was no expression.  */

void
ffestd_R1227 (ffebld expr)
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R1227 (ffestw_stack_top (), expr);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR1227_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.R1227.pool = ffesta_output_pool;
    stmt->u.R1227.block = ffestw_stack_top ();
    stmt->u.R1227.expr = expr;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif

  if (ffestd_block_level_ == 0)
    ffestd_is_reachable_ = FALSE;
}

/* ffestd_R1228 -- CONTAINS statement

   ffestd_R1228();  */

#if FFESTR_F90
void
ffestd_R1228 ()
{
  assert (ffestd_block_level_ == 0);

  ffestd_check_simple_ ();

  /* Generate RETURN/STOP code here */

  ffestd_subr_labels_ (ffestw_state (ffestw_stack_top ())
		       == FFESTV_stateMODULE5);	/* Handle any undefined
						   labels. */

  ffestd_subr_f90_ ();
  return;

#ifdef FFESTD_F90
  fputs ("- CONTAINS\n", dmpout);
#endif
}

#endif
/* ffestd_R1229_start -- STMTFUNCTION statement begin

   ffestd_R1229_start(func_name,func_arg_list,close_paren);

   This function does not really need to do anything, since _finish_
   gets all the info needed, and ffestc_R1229_start has already
   done all the stuff that makes a two-phase operation (start and
   finish) for handling statement functions necessary.

   03-Jan-91  JCB  2.0
      Do nothing, now that _finish_ does everything.  */

void
ffestd_R1229_start (ffelexToken name UNUSED, ffesttTokenList args UNUSED)
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_R1229_finish -- STMTFUNCTION statement list complete

   ffestd_R1229_finish(s);

   The statement function's symbol is passed.  Its list of dummy args is
   accessed via ffesymbol_dummyargs and its expansion expression (expr)
   is accessed via ffesymbol_sfexpr.

   If sfexpr is NULL, an error occurred parsing the expansion expression, so
   just cancel the effects of ffestd_R1229_start and pretend nothing
   happened.  Otherwise, install the expression as the expansion for the
   statement function, then clean up.

   03-Jan-91  JCB  2.0
      Takes sfunc sym instead of just the expansion expression as an
      argument, so this function can do all the work, and _start_ is just
      a nicety than can do nothing in a back end.  */

void
ffestd_R1229_finish (ffesymbol s)
{
#if FFECOM_targetCURRENT == FFECOM_targetFFE
  ffebld args = ffesymbol_dummyargs (s);
#endif
  ffebld expr = ffesymbol_sfexpr (s);

  ffestd_check_finish_ ();

  if (expr == NULL)
    return;			/* Nothing to do, definition didn't work. */

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fprintf (dmpout, "* stmtfunction %s(", ffesymbol_text (s));
  for (; args != NULL; args = ffebld_trail (args))
    fprintf (dmpout, "%s,", ffesymbol_text (ffebld_symter (ffebld_head (args))));
  fputs (")=", dmpout);
  ffebld_dump (expr);
  fputc ('\n', dmpout);
#if 0				/* Normally no need to preserve the
				   expression. */
  ffesymbol_set_sfexpr (s, NULL);	/* Except expr.c sees NULL
					   as recursive reference!
					   So until we can use something
					   convenient, like a "permanent"
					   expression, don't worry about
					   wasting some memory in the
					   stand-alone FFE. */
#else
  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
#endif
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
  /* With gcc, cannot do anything here, because the backend hasn't even
     (necessarily) been notified that we're compiling a program unit! */

#if 0				/* Must preserve the expression for gcc. */
  ffesymbol_set_sfexpr (s, NULL);
#else
  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
#endif
#else
#error
#endif
}

/* ffestd_S3P4 -- INCLUDE line

   ffestd_S3P4(filename,filename_token);

   Make sure INCLUDE not preceded by any semicolons or a label def; implement.	*/

void
ffestd_S3P4 (ffebld filename)
{
  FILE *fi;
  ffetargetCharacterDefault buildname;
  ffewhereFile wf;

  ffestd_check_simple_ ();

  assert (filename != NULL);
  if (ffebld_op (filename) != FFEBLD_opANY)
    {
      assert (ffebld_op (filename) == FFEBLD_opCONTER);
      assert (ffeinfo_basictype (ffebld_info (filename))
	      == FFEINFO_basictypeCHARACTER);
      assert (ffeinfo_kindtype (ffebld_info (filename))
	      == FFEINFO_kindtypeCHARACTERDEFAULT);
      buildname = ffebld_constant_characterdefault (ffebld_conter (filename));
      wf = ffewhere_file_new (ffetarget_text_characterdefault (buildname),
			      ffetarget_length_characterdefault (buildname));
      fi = ffecom_open_include (ffewhere_file_name (wf),
				ffelex_token_where_line (ffesta_tokens[0]),
				ffelex_token_where_column (ffesta_tokens[0]));
      if (fi == NULL)
	ffewhere_file_kill (wf);
      else
	ffelex_set_include (wf, (ffelex_token_type (ffesta_tokens[0])
				 == FFELEX_typeNAME), fi);
    }
}

/* ffestd_V003_start -- STRUCTURE statement list begin

   ffestd_V003_start(structure_name);

   Verify that STRUCTURE is valid here, and begin accepting items in the list.	*/

#if FFESTR_VXT
void
ffestd_V003_start (ffelexToken structure_name)
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  if (structure_name == NULL)
    fputs ("* STRUCTURE_unnamed ", dmpout);
  else
    fprintf (dmpout, "* STRUCTURE %s ", ffelex_token_text (structure_name));
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
  ffestd_subr_vxt_ ();
#else
#error
#endif
}

/* ffestd_V003_item -- STRUCTURE statement for object-name

   ffestd_V003_item(name_token,dim_list);

   Make sure name_token identifies a valid object to be STRUCTUREd.  */

void
ffestd_V003_item (ffelexToken name, ffesttDimList dims)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs (ffelex_token_text (name), dmpout);
  if (dims != NULL)
    {
      fputc ('(', dmpout);
      ffestt_dimlist_dump (dims);
      fputc (')', dmpout);
    }
  fputc (',', dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_V003_finish -- STRUCTURE statement list complete

   ffestd_V003_finish();

   Just wrap up any local activities.  */

void
ffestd_V003_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputc ('\n', dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_V004 -- End a STRUCTURE

   ffestd_V004(TRUE);  */

void
ffestd_V004 (bool ok)
{
#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* END_STRUCTURE\n", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_V009 -- UNION statement

   ffestd_V009();  */

void
ffestd_V009 ()
{
  ffestd_check_simple_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* UNION\n", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_V010 -- End a UNION

   ffestd_V010(TRUE);  */

void
ffestd_V010 (bool ok)
{
#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* END_UNION\n", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_V012 -- MAP statement

   ffestd_V012();  */

void
ffestd_V012 ()
{
  ffestd_check_simple_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* MAP\n", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_V013 -- End a MAP

   ffestd_V013(TRUE);  */

void
ffestd_V013 (bool ok)
{
#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* END_MAP\n", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

#endif
/* ffestd_V014_start -- VOLATILE statement list begin

   ffestd_V014_start();

   Verify that VOLATILE is valid here, and begin accepting items in the list.  */

void
ffestd_V014_start ()
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* VOLATILE (", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
  ffestd_subr_vxt_ ();
#else
#error
#endif
}

/* ffestd_V014_item_object -- VOLATILE statement for object-name

   ffestd_V014_item_object(name_token);

   Make sure name_token identifies a valid object to be VOLATILEd.  */

void
ffestd_V014_item_object (ffelexToken name UNUSED)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fprintf (dmpout, "%s,", ffelex_token_text (name));
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_V014_item_cblock -- VOLATILE statement for common-block-name

   ffestd_V014_item_cblock(name_token);

   Make sure name_token identifies a valid common block to be VOLATILEd.  */

void
ffestd_V014_item_cblock (ffelexToken name UNUSED)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fprintf (dmpout, "/%s/,", ffelex_token_text (name));
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_V014_finish -- VOLATILE statement list complete

   ffestd_V014_finish();

   Just wrap up any local activities.  */

void
ffestd_V014_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs (")\n", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_V016_start -- RECORD statement list begin

   ffestd_V016_start();

   Verify that RECORD is valid here, and begin accepting items in the list.  */

#if FFESTR_VXT
void
ffestd_V016_start ()
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* RECORD ", dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
  ffestd_subr_vxt_ ();
#else
#error
#endif
}

/* ffestd_V016_item_structure -- RECORD statement for common-block-name

   ffestd_V016_item_structure(name_token);

   Make sure name_token identifies a valid structure to be RECORDed.  */

void
ffestd_V016_item_structure (ffelexToken name)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fprintf (dmpout, "/%s/,", ffelex_token_text (name));
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_V016_item_object -- RECORD statement for object-name

   ffestd_V016_item_object(name_token,dim_list);

   Make sure name_token identifies a valid object to be RECORDd.  */

void
ffestd_V016_item_object (ffelexToken name, ffesttDimList dims)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs (ffelex_token_text (name), dmpout);
  if (dims != NULL)
    {
      fputc ('(', dmpout);
      ffestt_dimlist_dump (dims);
      fputc (')', dmpout);
    }
  fputc (',', dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_V016_finish -- RECORD statement list complete

   ffestd_V016_finish();

   Just wrap up any local activities.  */

void
ffestd_V016_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputc ('\n', dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_V018_start -- REWRITE(...) statement list begin

   ffestd_V018_start();

   Verify that REWRITE is valid here, and begin accepting items in the
   list.  */

void
ffestd_V018_start (ffestvFormat format)
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_V018_start (&ffestp_file.rewrite, format);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidV018_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.V018.pool = ffesta_output_pool;
    stmt->u.V018.params = ffestd_subr_copy_rewrite_ ();
    stmt->u.V018.format = format;
    stmt->u.V018.list = NULL;
    ffestd_expr_list_ = &stmt->u.V018.list;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
  ffestd_subr_vxt_ ();
#endif
}

/* ffestd_V018_item -- REWRITE statement i/o item

   ffestd_V018_item(expr,expr_token);

   Implement output-list expression.  */

void
ffestd_V018_item (ffebld expr)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffeste_V018_item (expr);
#else
  {
    ffestdExprItem_ item
    = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
				       sizeof (*item));

    item->next = NULL;
    item->expr = expr;
    *ffestd_expr_list_ = item;
    ffestd_expr_list_ = &item->next;
  }
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#endif
}

/* ffestd_V018_finish -- REWRITE statement list complete

   ffestd_V018_finish();

   Just wrap up any local activities.  */

void
ffestd_V018_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffeste_V018_finish ();
#else
  /* Nothing to do, it's implicit. */
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#endif
}

/* ffestd_V019_start -- ACCEPT statement list begin

   ffestd_V019_start();

   Verify that ACCEPT is valid here, and begin accepting items in the
   list.  */

void
ffestd_V019_start (ffestvFormat format)
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_V019_start (&ffestp_file.accept, format);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidV019_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.V019.pool = ffesta_output_pool;
    stmt->u.V019.params = ffestd_subr_copy_accept_ ();
    stmt->u.V019.format = format;
    stmt->u.V019.list = NULL;
    ffestd_expr_list_ = &stmt->u.V019.list;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
  ffestd_subr_vxt_ ();
#endif
}

/* ffestd_V019_item -- ACCEPT statement i/o item

   ffestd_V019_item(expr,expr_token);

   Implement output-list expression.  */

void
ffestd_V019_item (ffebld expr)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffeste_V019_item (expr);
#else
  {
    ffestdExprItem_ item
    = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
				       sizeof (*item));

    item->next = NULL;
    item->expr = expr;
    *ffestd_expr_list_ = item;
    ffestd_expr_list_ = &item->next;
  }
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#endif
}

/* ffestd_V019_finish -- ACCEPT statement list complete

   ffestd_V019_finish();

   Just wrap up any local activities.  */

void
ffestd_V019_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffeste_V019_finish ();
#else
  /* Nothing to do, it's implicit. */
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#endif
}

#endif
/* ffestd_V020_start -- TYPE statement list begin

   ffestd_V020_start();

   Verify that TYPE is valid here, and begin accepting items in the
   list.  */

void
ffestd_V020_start (ffestvFormat format UNUSED)
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_V020_start (&ffestp_file.type, format);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidV020_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.V020.pool = ffesta_output_pool;
    stmt->u.V020.params = ffestd_subr_copy_type_ ();
    stmt->u.V020.format = format;
    stmt->u.V020.list = NULL;
    ffestd_expr_list_ = &stmt->u.V020.list;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
  ffestd_subr_vxt_ ();
#endif
}

/* ffestd_V020_item -- TYPE statement i/o item

   ffestd_V020_item(expr,expr_token);

   Implement output-list expression.  */

void
ffestd_V020_item (ffebld expr UNUSED)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffeste_V020_item (expr);
#else
  {
    ffestdExprItem_ item
    = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
				       sizeof (*item));

    item->next = NULL;
    item->expr = expr;
    *ffestd_expr_list_ = item;
    ffestd_expr_list_ = &item->next;
  }
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#endif
}

/* ffestd_V020_finish -- TYPE statement list complete

   ffestd_V020_finish();

   Just wrap up any local activities.  */

void
ffestd_V020_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffeste_V020_finish ();
#else
  /* Nothing to do, it's implicit. */
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#endif
}

/* ffestd_V021 -- DELETE statement

   ffestd_V021();

   Make sure a DELETE is valid in the current context, and implement it.  */

#if FFESTR_VXT
void
ffestd_V021 ()
{
  ffestd_check_simple_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_V021 (&ffestp_file.delete);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidV021_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.V021.pool = ffesta_output_pool;
    stmt->u.V021.params = ffestd_subr_copy_delete_ ();
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
  ffestd_subr_vxt_ ();
#endif
}

/* ffestd_V022 -- UNLOCK statement

   ffestd_V022();

   Make sure a UNLOCK is valid in the current context, and implement it.  */

void
ffestd_V022 ()
{
  ffestd_check_simple_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_V022 (&ffestp_file.beru);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidV022_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.V022.pool = ffesta_output_pool;
    stmt->u.V022.params = ffestd_subr_copy_beru_ ();
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
  ffestd_subr_vxt_ ();
#endif
}

/* ffestd_V023_start -- ENCODE(...) statement list begin

   ffestd_V023_start();

   Verify that ENCODE is valid here, and begin accepting items in the
   list.  */

void
ffestd_V023_start ()
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_V023_start (&ffestp_file.vxtcode);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidV023_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.V023.pool = ffesta_output_pool;
    stmt->u.V023.params = ffestd_subr_copy_vxtcode_ ();
    stmt->u.V023.list = NULL;
    ffestd_expr_list_ = &stmt->u.V023.list;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
  ffestd_subr_vxt_ ();
#endif
}

/* ffestd_V023_item -- ENCODE statement i/o item

   ffestd_V023_item(expr,expr_token);

   Implement output-list expression.  */

void
ffestd_V023_item (ffebld expr)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffeste_V023_item (expr);
#else
  {
    ffestdExprItem_ item
    = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
				       sizeof (*item));

    item->next = NULL;
    item->expr = expr;
    *ffestd_expr_list_ = item;
    ffestd_expr_list_ = &item->next;
  }
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#endif
}

/* ffestd_V023_finish -- ENCODE statement list complete

   ffestd_V023_finish();

   Just wrap up any local activities.  */

void
ffestd_V023_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffeste_V023_finish ();
#else
  /* Nothing to do, it's implicit. */
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#endif
}

/* ffestd_V024_start -- DECODE(...) statement list begin

   ffestd_V024_start();

   Verify that DECODE is valid here, and begin accepting items in the
   list.  */

void
ffestd_V024_start ()
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_V024_start (&ffestp_file.vxtcode);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidV024_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.V024.pool = ffesta_output_pool;
    stmt->u.V024.params = ffestd_subr_copy_vxtcode_ ();
    stmt->u.V024.list = NULL;
    ffestd_expr_list_ = &stmt->u.V024.list;
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
  ffestd_subr_vxt_ ();
#endif
}

/* ffestd_V024_item -- DECODE statement i/o item

   ffestd_V024_item(expr,expr_token);

   Implement output-list expression.  */

void
ffestd_V024_item (ffebld expr)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffeste_V024_item (expr);
#else
  {
    ffestdExprItem_ item
    = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
				       sizeof (*item));

    item->next = NULL;
    item->expr = expr;
    *ffestd_expr_list_ = item;
    ffestd_expr_list_ = &item->next;
  }
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#endif
}

/* ffestd_V024_finish -- DECODE statement list complete

   ffestd_V024_finish();

   Just wrap up any local activities.  */

void
ffestd_V024_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffeste_V024_finish ();
#else
  /* Nothing to do, it's implicit. */
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#endif
}

/* ffestd_V025_start -- DEFINEFILE statement list begin

   ffestd_V025_start();

   Verify that DEFINEFILE is valid here, and begin accepting items in the
   list.  */

void
ffestd_V025_start ()
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_V025_start ();
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidV025start_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
  ffestd_subr_vxt_ ();
#endif
}

/* ffestd_V025_item -- DEFINE FILE statement item

   ffestd_V025_item(u,ut,m,mt,n,nt,asv,asvt);

   Implement item.  Treat each item kind of like a separate statement,
   since there's really no need to treat them as an aggregate.	*/

void
ffestd_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffeste_V025_item (u, m, n, asv);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidV025item_);
    ffestd_stmt_append_ (stmt);
    stmt->u.V025item.u = u;
    stmt->u.V025item.m = m;
    stmt->u.V025item.n = n;
    stmt->u.V025item.asv = asv;
  }
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#endif
}

/* ffestd_V025_finish -- DEFINE FILE statement list complete

   ffestd_V025_finish();

   Just wrap up any local activities.  */

void
ffestd_V025_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffeste_V025_finish ();
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidV025finish_);
    stmt->u.V025finish.pool = ffesta_output_pool;
    ffestd_stmt_append_ (stmt);
  }
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#endif
}

/* ffestd_V026 -- FIND statement

   ffestd_V026();

   Make sure a FIND is valid in the current context, and implement it.	*/

void
ffestd_V026 ()
{
  ffestd_check_simple_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_V026 (&ffestp_file.find);
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidV026_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
    stmt->u.V026.pool = ffesta_output_pool;
    stmt->u.V026.params = ffestd_subr_copy_find_ ();
    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
  }
#endif

#endif
#if FFECOM_targetCURRENT == FFECOM_targetGCC
  ffestd_subr_vxt_ ();
#endif
}

#endif
/* ffestd_V027_start -- VXT PARAMETER statement list begin

   ffestd_V027_start();

   Verify that PARAMETER is valid here, and begin accepting items in the list.	*/

void
ffestd_V027_start ()
{
  ffestd_check_start_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs ("* PARAMETER_vxt ", dmpout);
#else
#if FFECOM_targetCURRENT == FFECOM_targetGCC
  ffestd_subr_vxt_ ();
#endif
#endif
}

/* ffestd_V027_item -- VXT PARAMETER statement assignment

   ffestd_V027_item(dest,dest_token,source,source_token);

   Make sure the source is a valid source for the destination; make the
   assignment.	*/

void
ffestd_V027_item (ffelexToken dest_token UNUSED, ffebld source UNUSED)
{
  ffestd_check_item_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputs (ffelex_token_text (dest_token), dmpout);
  fputc ('=', dmpout);
  ffebld_dump (source);
  fputc (',', dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* ffestd_V027_finish -- VXT PARAMETER statement list complete

   ffestd_V027_finish();

   Just wrap up any local activities.  */

void
ffestd_V027_finish ()
{
  ffestd_check_finish_ ();

#if FFECOM_targetCURRENT == FFECOM_targetFFE
  fputc ('\n', dmpout);
#elif FFECOM_targetCURRENT == FFECOM_targetGCC
#else
#error
#endif
}

/* Any executable statement.  */

void
ffestd_any ()
{
  ffestd_check_simple_ ();

#if FFECOM_ONEPASS
  ffestd_subr_line_now_ ();
  ffeste_R841 ();
#else
  {
    ffestdStmt_ stmt;

    stmt = ffestd_stmt_new_ (FFESTD_stmtidR841_);
    ffestd_stmt_append_ (stmt);
    ffestd_subr_line_save_ (stmt);
  }
#endif
}