com.c

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

/* com.c -- Implementation File (module.c template V1.0)
   Copyright (C) 1995-1998 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:
      None

   Description:
      Contains compiler-specific functions.

   Modifications:
*/

/* Understanding this module means understanding the interface between
   the g77 front end and the gcc back end (or, perhaps, some other
   back end).  In here are the functions called by the front end proper
   to notify whatever back end is in place about certain things, and
   also the back-end-specific functions.  It's a bear to deal with, so
   lately I've been trying to simplify things, especially with regard
   to the gcc-back-end-specific stuff.

   Building expressions generally seems quite easy, but building decls
   has been challenging and is undergoing revision.  gcc has several
   kinds of decls:

   TYPE_DECL -- a type (int, float, struct, function, etc.)
   CONST_DECL -- a constant of some type other than function
   LABEL_DECL -- a variable or a constant?
   PARM_DECL -- an argument to a function (a variable that is a dummy)
   RESULT_DECL -- the return value of a function (a variable)
   VAR_DECL -- other variable (can hold a ptr-to-function, struct, int, etc.)
   FUNCTION_DECL -- a function (either the actual function or an extern ref)
   FIELD_DECL -- a field in a struct or union (goes into types)

   g77 has a set of functions that somewhat parallels the gcc front end
   when it comes to building decls:

   Internal Function (one we define, not just declare as extern):
   int yes;
   yes = suspend_momentary ();
   if (is_nested) push_f_function_context ();
   start_function (get_identifier ("function_name"), function_type,
		   is_nested, is_public);
   // for each arg, build PARM_DECL and call push_parm_decl (decl) with it;
   store_parm_decls (is_main_program);
   ffecom_start_compstmt ();
   // for stmts and decls inside function, do appropriate things;
   ffecom_end_compstmt ();
   finish_function (is_nested);
   if (is_nested) pop_f_function_context ();
   if (is_nested) resume_momentary (yes);

   Everything Else:
   int yes;
   tree d;
   tree init;
   yes = suspend_momentary ();
   // fill in external, public, static, &c for decl, and
   // set DECL_INITIAL to error_mark_node if going to initialize
   // set is_top_level TRUE only if not at top level and decl
   // must go in top level (i.e. not within current function decl context)
   d = start_decl (decl, is_top_level);
   init = ...;	// if have initializer
   finish_decl (d, init, is_top_level);
   resume_momentary (yes);

*/

/* Include files. */

#include "proj.h"
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#include "flags.j"
#include "rtl.j"
#include "toplev.j"
#include "tree.j"
#include "output.j"  /* Must follow tree.j so TREE_CODE is defined! */
#include "convert.j"
#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */

#define FFECOM_GCC_INCLUDE 1	/* Enable -I. */

/* BEGIN stuff from gcc/cccp.c.  */

/* The following symbols should be autoconfigured:
	HAVE_FCNTL_H
	HAVE_STDLIB_H
	HAVE_SYS_TIME_H
	HAVE_UNISTD_H
	STDC_HEADERS
	TIME_WITH_SYS_TIME
   In the mean time, we'll get by with approximations based
   on existing GCC configuration symbols.  */

#ifdef POSIX
# ifndef HAVE_STDLIB_H
# define HAVE_STDLIB_H 1
# endif
# ifndef HAVE_UNISTD_H
# define HAVE_UNISTD_H 1
# endif
# ifndef STDC_HEADERS
# define STDC_HEADERS 1
# endif
#endif /* defined (POSIX) */

#if defined (POSIX) || (defined (USG) && !defined (VMS))
# ifndef HAVE_FCNTL_H
# define HAVE_FCNTL_H 1
# endif
#endif

#ifndef RLIMIT_STACK
# include <time.h>
#else
# if TIME_WITH_SYS_TIME
#  include <sys/time.h>
#  include <time.h>
# else
#  if HAVE_SYS_TIME_H
#   include <sys/time.h>
#  else
#   include <time.h>
#  endif
# endif
# include <sys/resource.h>
#endif

#if HAVE_FCNTL_H
# include <fcntl.h>
#endif

/* This defines "errno" properly for VMS, and gives us EACCES. */
#include <errno.h>

#if HAVE_STDLIB_H
# include <stdlib.h>
#else
char *getenv ();
#endif

#if HAVE_UNISTD_H
# include <unistd.h>
#endif

/* VMS-specific definitions */
#ifdef VMS
#include <descrip.h>
#define O_RDONLY	0	/* Open arg for Read/Only  */
#define O_WRONLY	1	/* Open arg for Write/Only */
#define read(fd,buf,size)	VMS_read (fd,buf,size)
#define write(fd,buf,size)	VMS_write (fd,buf,size)
#define open(fname,mode,prot)	VMS_open (fname,mode,prot)
#define fopen(fname,mode)	VMS_fopen (fname,mode)
#define freopen(fname,mode,ofile) VMS_freopen (fname,mode,ofile)
#define strncat(dst,src,cnt) VMS_strncat (dst,src,cnt)
#define fstat(fd,stbuf)		VMS_fstat (fd,stbuf)
static int VMS_fstat (), VMS_stat ();
static char * VMS_strncat ();
static int VMS_read ();
static int VMS_write ();
static int VMS_open ();
static FILE * VMS_fopen ();
static FILE * VMS_freopen ();
static void hack_vms_include_specification ();
typedef struct { unsigned :16, :16, :16; } vms_ino_t;
#define ino_t vms_ino_t
#define INCLUDE_LEN_FUDGE 10	/* leave room for VMS syntax conversion */
#ifdef __GNUC__
#define BSTRING			/* VMS/GCC supplies the bstring routines */
#endif /* __GNUC__ */
#endif /* VMS */

#ifndef O_RDONLY
#define O_RDONLY 0
#endif

/* END stuff from gcc/cccp.c.  */

#define FFECOM_DETERMINE_TYPES 1 /* for com.h */
#include "com.h"
#include "bad.h"
#include "bld.h"
#include "equiv.h"
#include "expr.h"
#include "implic.h"
#include "info.h"
#include "malloc.h"
#include "src.h"
#include "st.h"
#include "storag.h"
#include "symbol.h"
#include "target.h"
#include "top.h"
#include "type.h"

/* Externals defined here.  */

#if FFECOM_targetCURRENT == FFECOM_targetGCC

/* tree.h declares a bunch of stuff that it expects the front end to
   define.  Here are the definitions, which in the C front end are
   found in the file c-decl.c.  */

tree integer_zero_node;
tree integer_one_node;
tree null_pointer_node;
tree error_mark_node;
tree void_type_node;
tree integer_type_node;
tree unsigned_type_node;
tree char_type_node;
tree current_function_decl;

/* ~~gcc/tree.h *should* declare this, because toplev.c and dwarfout.c
   reference it.  */

char *language_string = "GNU F77";

/* Stream for reading from the input file.  */
FILE *finput;

/* These definitions parallel those in c-decl.c so that code from that
   module can be used pretty much as is.  Much of these defs aren't
   otherwise used, i.e. by g77 code per se, except some of them are used
   to build some of them that are.  The ones that are global (i.e. not
   "static") are those that ste.c and such might use (directly
   or by using com macros that reference them in their definitions).  */

static tree short_integer_type_node;
tree long_integer_type_node;
static tree long_long_integer_type_node;

static tree short_unsigned_type_node;
static tree long_unsigned_type_node;
static tree long_long_unsigned_type_node;

static tree unsigned_char_type_node;
static tree signed_char_type_node;

static tree float_type_node;
static tree double_type_node;
static tree complex_float_type_node;
tree complex_double_type_node;
static tree long_double_type_node;
static tree complex_integer_type_node;
static tree complex_long_double_type_node;

tree string_type_node;

static tree double_ftype_double;
static tree float_ftype_float;
static tree ldouble_ftype_ldouble;

/* The rest of these are inventions for g77, though there might be
   similar things in the C front end.  As they are found, these
   inventions should be renamed to be canonical.  Note that only
   the ones currently required to be global are so.  */

static tree ffecom_tree_fun_type_void;
static tree ffecom_tree_ptr_to_fun_type_void;

tree ffecom_integer_type_node;	/* Abbrev for _tree_type[blah][blah]. */
tree ffecom_integer_zero_node;	/* Like *_*_* with g77's integer type. */
tree ffecom_integer_one_node;	/* " */
tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype];

/* _fun_type things are the f2c-specific versions.  For -fno-f2c,
   just use build_function_type and build_pointer_type on the
   appropriate _tree_type array element.  */

static tree ffecom_tree_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
static tree ffecom_tree_ptr_to_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
static tree ffecom_tree_subr_type;
static tree ffecom_tree_ptr_to_subr_type;
static tree ffecom_tree_blockdata_type;

static tree ffecom_tree_xargc_;

ffecomSymbol ffecom_symbol_null_
=
{
  NULL_TREE,
  NULL_TREE,
  NULL_TREE,
  NULL_TREE,
  false
};
ffeinfoKindtype ffecom_pointer_kind_ = FFEINFO_basictypeNONE;
ffeinfoKindtype ffecom_label_kind_ = FFEINFO_basictypeNONE;

int ffecom_f2c_typecode_[FFEINFO_basictype][FFEINFO_kindtype];
tree ffecom_f2c_integer_type_node;
tree ffecom_f2c_ptr_to_integer_type_node;
tree ffecom_f2c_address_type_node;
tree ffecom_f2c_real_type_node;
tree ffecom_f2c_ptr_to_real_type_node;
tree ffecom_f2c_doublereal_type_node;
tree ffecom_f2c_complex_type_node;
tree ffecom_f2c_doublecomplex_type_node;
tree ffecom_f2c_longint_type_node;
tree ffecom_f2c_logical_type_node;
tree ffecom_f2c_flag_type_node;
tree ffecom_f2c_ftnlen_type_node;
tree ffecom_f2c_ftnlen_zero_node;
tree ffecom_f2c_ftnlen_one_node;
tree ffecom_f2c_ftnlen_two_node;
tree ffecom_f2c_ptr_to_ftnlen_type_node;
tree ffecom_f2c_ftnint_type_node;
tree ffecom_f2c_ptr_to_ftnint_type_node;
#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */

/* Simple definitions and enumerations. */

#ifndef FFECOM_sizeMAXSTACKITEM
#define FFECOM_sizeMAXSTACKITEM 32*1024	/* Keep user-declared things
					   larger than this # bytes
					   off stack if possible. */
#endif

/* For systems that have large enough stacks, they should define
   this to 0, and here, for ease of use later on, we just undefine
   it if it is 0.  */

#if FFECOM_sizeMAXSTACKITEM == 0
#undef FFECOM_sizeMAXSTACKITEM
#endif

typedef enum
  {
    FFECOM_rttypeVOID_,
    FFECOM_rttypeVOIDSTAR_,	/* C's `void *' type. */
    FFECOM_rttypeFTNINT_,	/* f2c's `ftnint' type. */
    FFECOM_rttypeINTEGER_,	/* f2c's `integer' type. */
    FFECOM_rttypeLONGINT_,	/* f2c's `longint' type. */
    FFECOM_rttypeLOGICAL_,	/* f2c's `logical' type. */
    FFECOM_rttypeREAL_F2C_,	/* f2c's `real' returned as `double'. */
    FFECOM_rttypeREAL_GNU_,	/* `real' returned as such. */
    FFECOM_rttypeCOMPLEX_F2C_,	/* f2c's `complex' returned via 1st arg. */
    FFECOM_rttypeCOMPLEX_GNU_,	/* f2c's `complex' returned directly. */
    FFECOM_rttypeDOUBLE_,	/* C's `double' type. */
    FFECOM_rttypeDOUBLEREAL_,	/* f2c's `doublereal' type. */
    FFECOM_rttypeDBLCMPLX_F2C_,	/* f2c's `doublecomplex' returned via 1st arg. */
    FFECOM_rttypeDBLCMPLX_GNU_,	/* f2c's `doublecomplex' returned directly. */
    FFECOM_rttypeCHARACTER_,	/* f2c `char *'/`ftnlen' pair. */
    FFECOM_rttype_
  } ffecomRttype_;

/* Internal typedefs. */

#if FFECOM_targetCURRENT == FFECOM_targetGCC
typedef struct _ffecom_concat_list_ ffecomConcatList_;
#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */

/* Private include files. */


/* Internal structure definitions. */

#if FFECOM_targetCURRENT == FFECOM_targetGCC
struct _ffecom_concat_list_
  {
    ffebld *exprs;
    int count;
    int max;
    ffetargetCharacterSize minlen;
    ffetargetCharacterSize maxlen;
  };
#endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */

/* Static functions (internal). */

#if FFECOM_targetCURRENT == FFECOM_targetGCC
static tree ffecom_arglist_expr_ (const char *argstring, ffebld args);
static tree ffecom_widest_expr_type_ (ffebld list);
static bool ffecom_overlap_ (tree dest_decl, tree dest_offset,
			     tree dest_size, tree source_tree,
			     ffebld source, bool scalar_arg);
static bool ffecom_args_overlapping_ (tree dest_tree, ffebld dest,
				      tree args, tree callee_commons,
				      bool scalar_args);
static tree ffecom_build_f2c_string_ (int i, const char *s);
static tree ffecom_call_ (tree fn, ffeinfoKindtype kt,
			  bool is_f2c_complex, tree type,
			  tree args, tree dest_tree,
			  ffebld dest, bool *dest_used,
			  tree callee_commons, bool scalar_args, tree hook);
static tree ffecom_call_binop_ (tree fn, ffeinfoKindtype kt,
				bool is_f2c_complex, tree type,
				ffebld left, ffebld right,
				tree dest_tree, ffebld dest,
				bool *dest_used, tree callee_commons,
				bool scalar_args, tree hook);
static void ffecom_char_args_x_ (tree *xitem, tree *length,
				 ffebld expr, bool with_null);
static tree ffecom_check_size_overflow_ (ffesymbol s, tree type, bool dummy);
static tree ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s);
static ffecomConcatList_
  ffecom_concat_list_gather_ (ffecomConcatList_ catlist,
			      ffebld expr,
			      ffetargetCharacterSize max);
static void ffecom_concat_list_kill_ (ffecomConcatList_ catlist);
static ffecomConcatList_ ffecom_concat_list_new_ (ffebld expr,
						ffetargetCharacterSize max);
static void ffecom_debug_kludge_ (tree aggr, const char *aggr_type,
				  ffesymbol member, tree member_type,
				  ffetargetOffset offset);
static void ffecom_do_entry_ (ffesymbol fn, int entrynum);
static tree ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
			  bool *dest_used, bool assignp, bool widenp);
static tree ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
				    ffebld dest, bool *dest_used);
static tree ffecom_expr_power_integer_ (ffebld expr);
static void ffecom_expr_transform_ (ffebld expr);
static void ffecom_f2c_make_type_ (tree *type, int tcode, const char *name);
static void ffecom_f2c_set_lio_code_ (ffeinfoBasictype bt, int size,
				      int code);
static ffeglobal ffecom_finish_global_ (ffeglobal global);
static ffesymbol ffecom_finish_symbol_transform_ (ffesymbol s);
static tree ffecom_get_appended_identifier_ (char us, const char *text);
static tree ffecom_get_external_identifier_ (ffesymbol s);
static tree ffecom_get_identifier_ (const char *text);
static tree ffecom_gen_sfuncdef_ (ffesymbol s,
				  ffeinfoBasictype bt,
				  ffeinfoKindtype kt);
static const char *ffecom_gfrt_args_ (ffecomGfrt ix);
static tree ffecom_gfrt_tree_ (ffecomGfrt ix);
static tree ffecom_init_zero_ (tree decl);
static tree ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg,
				     tree *maybe_tree);
static tree ffecom_intrinsic_len_ (ffebld expr);
static void ffecom_let_char_ (tree dest_tree,
			      tree dest_length,
			      ffetargetCharacterSize dest_size,
			      ffebld source);
static void ffecom_make_gfrt_ (ffecomGfrt ix);