gfortran.h

gcc-fortran,linux使用fortran的编译软件。很好用的。

  ENUM_BITFIELD (sym_intent) intent:2;
  ENUM_BITFIELD (sym_flavor) flavor:4;
  ENUM_BITFIELD (ifsrc) if_source:2;

  ENUM_BITFIELD (procedure_type) proc:3;

  /* Special attributes for Cray pointers, pointees.  */
  unsigned cray_pointer:1, cray_pointee:1;

}
symbol_attribute;


/* The following three structures are used to identify a location in
   the sources.

   gfc_file is used to maintain a tree of the source files and how
   they include each other

   gfc_linebuf holds a single line of source code and information
   which file it resides in

   locus point to the sourceline and the character in the source
   line.
*/

typedef struct gfc_file
{
  struct gfc_file *included_by, *next, *up;
  int inclusion_line, line;
  char *filename;
} gfc_file;

typedef struct gfc_linebuf
{
#ifdef USE_MAPPED_LOCATION
  source_location location;
#else
  int linenum;
#endif
  struct gfc_file *file;
  struct gfc_linebuf *next;

  int truncated;

  char line[1];
} gfc_linebuf;

#define gfc_linebuf_header_size (offsetof (gfc_linebuf, line))

typedef struct
{
  char *nextc;
  gfc_linebuf *lb;
} locus;

/* In order for the "gfc" format checking to work correctly, you must
   have declared a typedef locus first.  */
#if GCC_VERSION >= 4001
#define ATTRIBUTE_GCC_GFC(m, n) __attribute__ ((__format__ (__gcc_gfc__, m, n))) ATTRIBUTE_NONNULL(m)
#else
#define ATTRIBUTE_GCC_GFC(m, n) ATTRIBUTE_NONNULL(m)
#endif


extern int gfc_suppress_error;


/* Character length structures hold the expression that gives the
   length of a character variable.  We avoid putting these into
   gfc_typespec because doing so prevents us from doing structure
   copies and forces us to deallocate any typespecs we create, as well
   as structures that contain typespecs.  They also can have multiple
   character typespecs pointing to them.

   These structures form a singly linked list within the current
   namespace and are deallocated with the namespace.  It is possible to
   end up with gfc_charlen structures that have nothing pointing to them.  */

typedef struct gfc_charlen
{
  struct gfc_expr *length;
  struct gfc_charlen *next;
  tree backend_decl;

  int resolved;
}
gfc_charlen;

#define gfc_get_charlen() gfc_getmem(sizeof(gfc_charlen))

/* Type specification structure.  FIXME: derived and cl could be union???  */
typedef struct
{
  bt type;
  int kind;
  struct gfc_symbol *derived;
  gfc_charlen *cl;	/* For character types only.  */
}
gfc_typespec;

/* Array specification.  */
typedef struct
{
  int rank;	/* A rank of zero means that a variable is a scalar.  */
  array_type type;
  struct gfc_expr *lower[GFC_MAX_DIMENSIONS], *upper[GFC_MAX_DIMENSIONS];

  /* These two fields are used with the Cray Pointer extension.  */
  bool cray_pointee; /* True iff this spec belongs to a cray pointee.  */
  bool cp_was_assumed; /* AS_ASSUMED_SIZE cp arrays are converted to
			AS_EXPLICIT, but we want to remember that we
			did this.  */

}
gfc_array_spec;

#define gfc_get_array_spec() gfc_getmem(sizeof(gfc_array_spec))


/* Components of derived types.  */
typedef struct gfc_component
{
  const char *name;
  gfc_typespec ts;

  int pointer, dimension;
  gfc_array_spec *as;

  tree backend_decl;
  locus loc;
  struct gfc_expr *initializer;
  struct gfc_component *next;
}
gfc_component;

#define gfc_get_component() gfc_getmem(sizeof(gfc_component))

/* Formal argument lists are lists of symbols.  */
typedef struct gfc_formal_arglist
{
  /* Symbol representing the argument at this position in the arglist.  */
  struct gfc_symbol *sym;
  /* Points to the next formal argument.  */
  struct gfc_formal_arglist *next;
}
gfc_formal_arglist;

#define gfc_get_formal_arglist() gfc_getmem(sizeof(gfc_formal_arglist))


/* The gfc_actual_arglist structure is for actual arguments.  */
typedef struct gfc_actual_arglist
{
  const char *name;
  /* Alternate return label when the expr member is null.  */
  struct gfc_st_label *label;

  /* This is set to the type of an eventual omitted optional
     argument. This is used to determine if a hidden string length
     argument has to be added to a function call.  */
  bt missing_arg_type;

  struct gfc_expr *expr;
  struct gfc_actual_arglist *next;
}
gfc_actual_arglist;

#define gfc_get_actual_arglist() gfc_getmem(sizeof(gfc_actual_arglist))


/* Because a symbol can belong to multiple namelists, they must be
   linked externally to the symbol itself.  */
typedef struct gfc_namelist
{
  struct gfc_symbol *sym;
  struct gfc_namelist *next;
}
gfc_namelist;

#define gfc_get_namelist() gfc_getmem(sizeof(gfc_namelist))


/* The gfc_st_label structure is a doubly linked list attached to a
   namespace that records the usage of statement labels within that
   space.  */
/* TODO: Make format/statement specifics a union.  */
typedef struct gfc_st_label
{
  int value;

  gfc_sl_type defined, referenced;

  struct gfc_expr *format;

  tree backend_decl;

  locus where;

  struct gfc_st_label *prev, *next;
}
gfc_st_label;


/* gfc_interface()-- Interfaces are lists of symbols strung together.  */
typedef struct gfc_interface
{
  struct gfc_symbol *sym;
  locus where;
  struct gfc_interface *next;
}
gfc_interface;

#define gfc_get_interface() gfc_getmem(sizeof(gfc_interface))


/* User operator nodes.  These are like stripped down symbols.  */
typedef struct
{
  const char *name;

  gfc_interface *operator;
  struct gfc_namespace *ns;
  gfc_access access;
}
gfc_user_op;

/* Symbol nodes.  These are important things.  They are what the
   standard refers to as "entities".  The possibly multiple names that
   refer to the same entity are accomplished by a binary tree of
   symtree structures that is balanced by the red-black method-- more
   than one symtree node can point to any given symbol.  */

typedef struct gfc_symbol
{
  const char *name;	/* Primary name, before renaming */
  const char *module;	/* Module this symbol came from */
  locus declared_at;

  gfc_typespec ts;
  symbol_attribute attr;

  /* The interface member points to the formal argument list if the
     symbol is a function or subroutine name.  If the symbol is a
     generic name, the generic member points to the list of
     interfaces.  */

  gfc_interface *generic;
  gfc_access component_access;

  gfc_formal_arglist *formal;
  struct gfc_namespace *formal_ns;

  struct gfc_expr *value;	/* Parameter/Initializer value */
  gfc_array_spec *as;
  struct gfc_symbol *result;	/* function result symbol */
  gfc_component *components;	/* Derived type components */

  /* Defined only for Cray pointees; points to their pointer.  */
  struct gfc_symbol *cp_pointer;

  struct gfc_symbol *common_next;	/* Links for COMMON syms */

  /* This is in fact a gfc_common_head but it is only used for pointer
     comparisons to check if symbols are in the same common block.  */
  struct gfc_common_head* common_head;

  /* Make sure setup code for dummy arguments is generated in the correct
     order.  */
  int dummy_order;

  gfc_namelist *namelist, *namelist_tail;

  /* Change management fields.  Symbols that might be modified by the
     current statement have the mark member nonzero and are kept in a
     singly linked list through the tlink field.  Of these symbols,
     symbols with old_symbol equal to NULL are symbols created within
     the current statement.  Otherwise, old_symbol points to a copy of
     the old symbol.  */

  struct gfc_symbol *old_symbol, *tlink;
  unsigned mark:1, new:1;
  /* Nonzero if all equivalences associated with this symbol have been
     processed.  */
  unsigned equiv_built:1;
  int refs;
  struct gfc_namespace *ns;	/* namespace containing this symbol */

  tree backend_decl;
}
gfc_symbol;


/* This structure is used to keep track of symbols in common blocks.  */

typedef struct gfc_common_head
{
  locus where;
  int use_assoc, saved;
  char name[GFC_MAX_SYMBOL_LEN + 1];
  struct gfc_symbol *head;
}
gfc_common_head;

#define gfc_get_common_head() gfc_getmem(sizeof(gfc_common_head))


/* A list of all the alternate entry points for a procedure.  */

typedef struct gfc_entry_list
{
  /* The symbol for this entry point.  */
  gfc_symbol *sym;
  /* The zero-based id of this entry point.  */
  int id;
  /* The LABEL_EXPR marking this entry point.  */
  tree label;
  /* The nest item in the list.  */
  struct gfc_entry_list *next;
}
gfc_entry_list;

#define gfc_get_entry_list() \
  (gfc_entry_list *) gfc_getmem(sizeof(gfc_entry_list))

/* Within a namespace, symbols are pointed to by symtree nodes that
   are linked together in a balanced binary tree.  There can be
   several symtrees pointing to the same symbol node via USE
   statements.  */

#define BBT_HEADER(self) int priority; struct self *left, *right

typedef struct gfc_symtree
{
  BBT_HEADER (gfc_symtree);
  const char *name;
  int ambiguous;
  union
  {
    gfc_symbol *sym;		/* Symbol associated with this node */
    gfc_user_op *uop;
    gfc_common_head *common;
  }
  n;

}
gfc_symtree;

/* A linked list of derived types in the namespace.  */
typedef struct gfc_dt_list
{
  struct gfc_symbol *derived;
  struct gfc_dt_list *next;
}
gfc_dt_list;

#define gfc_get_dt_list() gfc_getmem(sizeof(gfc_dt_list))


/* A namespace describes the contents of procedure, module or
   interface block.  */
/* ??? Anything else use these?  */

typedef struct gfc_namespace
{
  /* Tree containing all the symbols in this namespace.  */
  gfc_symtree *sym_root;
  /* Tree containing all the user-defined operators in the namespace.  */
  gfc_symtree *uop_root;
  /* Tree containing all the common blocks.  */
  gfc_symtree *common_root;

  /* If set_flag[letter] is set, an implicit type has been set for letter.  */
  int set_flag[GFC_LETTERS];
  /* Keeps track of the implicit types associated with the letters.  */
  gfc_typespec default_type[GFC_LETTERS];

  /* If this is a namespace of a procedure, this points to the procedure.  */
  struct gfc_symbol *proc_name;
  /* If this is the namespace of a unit which contains executable
     code, this points to it.  */
  struct gfc_code *code;

  /* Points to the equivalences set up in this namespace.  */
  struct gfc_equiv *equiv;
  gfc_interface *operator[GFC_INTRINSIC_OPS];

  /* Points to the parent namespace, i.e. the namespace of a module or
     procedure in which the procedure belonging to this namespace is
     contained. The parent namespace points to this namespace either
     directly via CONTAINED, or indirectly via the chain built by
     SIBLING.  */
  struct gfc_namespace *parent;
  /* CONTAINED points to the first contained namespace. Sibling
     namespaces are chained via SIBLING.  */
  struct gfc_namespace  *contained, *sibling;

  gfc_common_head blank_common;
  gfc_access default_access, operator_access[GFC_INTRINSIC_OPS];

  gfc_st_label *st_labels;
  /* This list holds information about all the data initializers in
     this namespace.  */
  struct gfc_data *data;

  gfc_charlen *cl_list;

  int save_all, seen_save, seen_implicit_none;

  /* Normally we don't need to refcount namespaces.  However when we read
     a module containing a function with multiple entry points, this
     will appear as several functions with the same formal namespace.  */
  int refs;

  /* A list of all alternate entry points to this procedure (or NULL).  */
  gfc_entry_list *entries;

  /* A list of all derived types in this procedure (or NULL).  */
  gfc_dt_list *derived_types;

  /* Set to 1 if namespace is a BLOCK DATA program unit.  */
  int is_block_data;
}
gfc_namespace;

extern gfc_namespace *gfc_current_ns;

/* Global symbols are symbols of global scope. Currently we only use
   this to detect collisions already when parsing.
   TODO: Extend to verify procedure calls.  */

typedef struct gfc_gsymbol
{
  BBT_HEADER(gfc_gsymbol);

  const char *name;
  enum { GSYM_UNKNOWN=1, GSYM_PROGRAM, GSYM_FUNCTION, GSYM_SUBROUTINE,
        GSYM_MODULE, GSYM_COMMON, GSYM_BLOCK_DATA } type;

  int defined, used;
  locus where;
}
gfc_gsymbol;

extern gfc_gsymbol *gfc_gsym_root;

/* Information on interfaces being built.  */
typedef struct
{
  interface_type type;
  gfc_symbol *sym;
  gfc_namespace *ns;
  gfc_user_op *uop;
  gfc_intrinsic_op op;
}
gfc_interface_info;

extern gfc_interface_info current_interface;


/* Array reference.  */
typedef struct gfc_array_ref
{
  ar_type type;
  int dimen;			/* # of components in the reference */
  locus where;
  gfc_array_spec *as;

  locus c_where[GFC_MAX_DIMENSIONS];	/* All expressions can be NULL */
  struct gfc_expr *start[GFC_MAX_DIMENSIONS], *end[GFC_MAX_DIMENSIONS],
    *stride[GFC_MAX_DIMENSIONS];

  enum
  { DIMEN_ELEMENT = 1, DIMEN_RANGE, DIMEN_VECTOR, DIMEN_UNKNOWN }
  dimen_type[GFC_MAX_DIMENSIONS];

  struct gfc_expr *offset;
}
gfc_array_ref;

#define gfc_get_array_ref() gfc_getmem(sizeof(gfc_array_ref))


/* Component reference nodes.  A variable is stored as an expression
   node that points to the base symbol.  After that, a singly linked
   list of component reference nodes gives the variable's complete
   resolution.  The array_ref component may be present and comes
   before the component component.  */

typedef enum
  { REF_ARRAY, REF_COMPONENT, REF_SUBSTRING }
ref_type;

typedef struct gfc_ref
{