std.c

gcc-2.95.3 Linux下最常用的C编译器

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

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;
	    ffestw block;
	    ffebld expr;
	  }
	R803;
	struct
	  {
	    mallocPool pool;
	    ffestw block;
	    ffebld expr;
	  }
	R804;
	struct
	  {
	    ffestw block;
	  }
	R805;
	struct
	  {
	    ffestw block;
	  }
	R806;
	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,
				      const char *string);
static void ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f,
				      const char *string);
static void ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f,
				      const char *string);
static void ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f,
				      const char *string);
static void ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f,
				      const char *string);
static void ffestd_R1001dump_1010_1_ (ffests s, ffesttFormatList f,
				      const char *string);
static void ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f,
				      const char *string);
static void ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f,
				      const char *string);
static void ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f,
				      const char *string);
static void ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f,
				      const 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 *) \