/* gfortran header file
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+ 2009, 2010, 2011
Free Software Foundation, Inc.
Contributed by Andy Vaught
#include "libgfortran.h"
-#include "system.h"
#include "intl.h"
#include "coretypes.h"
#include "input.h"
#include "splay-tree.h"
-/* The following ifdefs are recommended by the autoconf documentation
- for any code using alloca. */
-
-/* AIX requires this to be the first thing in the file. */
-#ifdef __GNUC__
-#else /* not __GNUC__ */
-#ifdef HAVE_ALLOCA_H
-#include <alloca.h>
-#else /* do not HAVE_ALLOCA_H */
-#ifdef _AIX
-#pragma alloca
-#else
-#ifndef alloca /* predefined by HP cc +Olibcalls */
-char *alloca ();
-#endif /* not predefined */
-#endif /* not _AIX */
-#endif /* do not HAVE_ALLOCA_H */
-#endif /* not __GNUC__ */
/* Major control parameters. */
#define free(x) Use_gfc_free_instead_of_free()
#define gfc_is_whitespace(c) ((c==' ') || (c=='\t'))
-#ifndef NULL
-#define NULL ((void *) 0)
-#endif
-
/* Stringization. */
#define stringize(x) expand_macro(x)
#define expand_macro(x) # x
{ SUCCESS = 1, FAILURE }
gfc_try;
+/* These are flags for identifying whether we are reading a character literal
+ between quotes or normal source code. */
+
+typedef enum
+{ NONSTRING = 0, INSTRING_WARN, INSTRING_NOWARN }
+gfc_instring;
+
/* This is returned by gfc_notification_std to know if, given the flags
that were given (-std=, -pedantic) we should issue an error, a warning
or nothing. */
{ MATCH_NO = 1, MATCH_YES, MATCH_ERROR }
match;
+/* Used for different Fortran source forms in places like scanner.c. */
typedef enum
{ FORM_FREE, FORM_FIXED, FORM_UNKNOWN }
gfc_source_form;
-/* Basic types. BT_VOID is used by ISO C Binding so funcs like c_f_pointer
- can take any arg with the pointer attribute as a param. */
-typedef enum
-{ BT_UNKNOWN = 1, BT_INTEGER, BT_REAL, BT_COMPLEX, BT_LOGICAL, BT_CHARACTER,
- BT_DERIVED, BT_CLASS, BT_PROCEDURE, BT_HOLLERITH, BT_VOID
-}
-bt;
-
/* Expression node types. */
typedef enum
{ EXPR_OP = 1, EXPR_FUNCTION, EXPR_CONSTANT, EXPR_VARIABLE,
/* Array types. */
typedef enum
{ AS_EXPLICIT = 1, AS_ASSUMED_SHAPE, AS_DEFERRED,
- AS_ASSUMED_SIZE, AS_UNKNOWN
+ AS_ASSUMED_SIZE, AS_IMPLIED_SHAPE, AS_UNKNOWN
}
array_type;
}
gfc_intrinsic_op;
-
/* This macro is the number of intrinsic operators that exist.
Assumptions are made about the numbering of the interface_op enums. */
#define GFC_INTRINSIC_OPS GFC_INTRINSIC_END
/* Statements. */
typedef enum
{
- ST_ARITHMETIC_IF, ST_ALLOCATE, ST_ATTR_DECL, ST_BACKSPACE,
- ST_BLOCK, ST_BLOCK_DATA,
+ ST_ARITHMETIC_IF, ST_ALLOCATE, ST_ATTR_DECL, ST_ASSOCIATE,
+ ST_BACKSPACE, ST_BLOCK, ST_BLOCK_DATA,
ST_CALL, ST_CASE, ST_CLOSE, ST_COMMON, ST_CONTINUE, ST_CONTAINS, ST_CYCLE,
ST_DATA, ST_DATA_DECL, ST_DEALLOCATE, ST_DO, ST_ELSE, ST_ELSEIF,
- ST_ELSEWHERE, ST_END_BLOCK, ST_END_BLOCK_DATA, ST_ENDDO, ST_IMPLIED_ENDDO,
+ ST_ELSEWHERE, ST_END_ASSOCIATE, ST_END_BLOCK, ST_END_BLOCK_DATA,
+ ST_ENDDO, ST_IMPLIED_ENDDO,
ST_END_FILE, ST_FINAL, ST_FLUSH, ST_END_FORALL, ST_END_FUNCTION, ST_ENDIF,
ST_END_INTERFACE, ST_END_MODULE, ST_END_PROGRAM, ST_END_SELECT,
ST_END_SUBROUTINE, ST_END_WHERE, ST_END_TYPE, ST_ENTRY, ST_EQUIVALENCE,
- ST_EXIT, ST_FORALL, ST_FORALL_BLOCK, ST_FORMAT, ST_FUNCTION, ST_GOTO,
- ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_IMPORT,
- ST_INQUIRE, ST_INTERFACE,
+ ST_ERROR_STOP, ST_EXIT, ST_FORALL, ST_FORALL_BLOCK, ST_FORMAT, ST_FUNCTION,
+ ST_GOTO, ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_IMPORT,
+ ST_INQUIRE, ST_INTERFACE, ST_SYNC_ALL, ST_SYNC_MEMORY, ST_SYNC_IMAGES,
ST_PARAMETER, ST_MODULE, ST_MODULE_PROC, ST_NAMELIST, ST_NULLIFY, ST_OPEN,
ST_PAUSE, ST_PRIVATE, ST_PROGRAM, ST_PUBLIC, ST_READ, ST_RETURN, ST_REWIND,
ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WAIT,
ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS,
ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE,
ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_OMP_TASK, ST_OMP_END_TASK,
- ST_OMP_TASKWAIT, ST_PROCEDURE, ST_GENERIC,
+ ST_OMP_TASKWAIT, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
ST_GET_FCN_CHARACTERISTICS, ST_NONE
}
gfc_statement;
-
/* Types of interfaces that we can have. Assignment interfaces are
considered to be intrinsic operators. */
typedef enum
GFC_ISYM_ATAN,
GFC_ISYM_ATAN2,
GFC_ISYM_ATANH,
+ GFC_ISYM_BGE,
+ GFC_ISYM_BGT,
GFC_ISYM_BIT_SIZE,
+ GFC_ISYM_BLE,
+ GFC_ISYM_BLT,
GFC_ISYM_BTEST,
GFC_ISYM_CEILING,
GFC_ISYM_CHAR,
GFC_ISYM_CHMOD,
GFC_ISYM_CMPLX,
GFC_ISYM_COMMAND_ARGUMENT_COUNT,
+ GFC_ISYM_COMPILER_OPTIONS,
+ GFC_ISYM_COMPILER_VERSION,
GFC_ISYM_COMPLEX,
GFC_ISYM_CONJG,
GFC_ISYM_CONVERSION,
GFC_ISYM_CPU_TIME,
GFC_ISYM_CSHIFT,
GFC_ISYM_CTIME,
+ GFC_ISYM_C_SIZEOF,
GFC_ISYM_DATE_AND_TIME,
GFC_ISYM_DBLE,
GFC_ISYM_DIGITS,
GFC_ISYM_DIM,
GFC_ISYM_DOT_PRODUCT,
GFC_ISYM_DPROD,
+ GFC_ISYM_DSHIFTL,
+ GFC_ISYM_DSHIFTR,
GFC_ISYM_DTIME,
GFC_ISYM_EOSHIFT,
GFC_ISYM_EPSILON,
GFC_ISYM_ERFC,
GFC_ISYM_ERFC_SCALED,
GFC_ISYM_ETIME,
+ GFC_ISYM_EXECUTE_COMMAND_LINE,
GFC_ISYM_EXIT,
GFC_ISYM_EXP,
GFC_ISYM_EXPONENT,
GFC_ISYM_FSEEK,
GFC_ISYM_FSTAT,
GFC_ISYM_FTELL,
- GFC_ISYM_GAMMA,
+ GFC_ISYM_TGAMMA,
GFC_ISYM_GERROR,
GFC_ISYM_GETARG,
GFC_ISYM_GET_COMMAND,
GFC_ISYM_HUGE,
GFC_ISYM_HYPOT,
GFC_ISYM_IACHAR,
+ GFC_ISYM_IALL,
GFC_ISYM_IAND,
+ GFC_ISYM_IANY,
GFC_ISYM_IARGC,
GFC_ISYM_IBCLR,
GFC_ISYM_IBITS,
GFC_ISYM_IDATE,
GFC_ISYM_IEOR,
GFC_ISYM_IERRNO,
+ GFC_ISYM_IMAGE_INDEX,
GFC_ISYM_INDEX,
GFC_ISYM_INT,
GFC_ISYM_INT2,
GFC_ISYM_INT8,
GFC_ISYM_IOR,
+ GFC_ISYM_IPARITY,
GFC_ISYM_IRAND,
GFC_ISYM_ISATTY,
GFC_ISYM_IS_IOSTAT_END,
GFC_ISYM_J0,
GFC_ISYM_J1,
GFC_ISYM_JN,
+ GFC_ISYM_JN2,
GFC_ISYM_KILL,
GFC_ISYM_KIND,
GFC_ISYM_LBOUND,
+ GFC_ISYM_LCOBOUND,
GFC_ISYM_LEADZ,
GFC_ISYM_LEN,
GFC_ISYM_LEN_TRIM,
GFC_ISYM_LSTAT,
GFC_ISYM_LTIME,
GFC_ISYM_MALLOC,
+ GFC_ISYM_MASKL,
+ GFC_ISYM_MASKR,
GFC_ISYM_MATMUL,
GFC_ISYM_MAX,
GFC_ISYM_MAXEXPONENT,
GFC_ISYM_MCLOCK,
GFC_ISYM_MCLOCK8,
GFC_ISYM_MERGE,
+ GFC_ISYM_MERGE_BITS,
GFC_ISYM_MIN,
GFC_ISYM_MINEXPONENT,
GFC_ISYM_MINLOC,
GFC_ISYM_NEAREST,
GFC_ISYM_NEW_LINE,
GFC_ISYM_NINT,
+ GFC_ISYM_NORM2,
GFC_ISYM_NOT,
GFC_ISYM_NULL,
+ GFC_ISYM_NUMIMAGES,
GFC_ISYM_OR,
GFC_ISYM_PACK,
+ GFC_ISYM_PARITY,
GFC_ISYM_PERROR,
+ GFC_ISYM_POPCNT,
+ GFC_ISYM_POPPAR,
GFC_ISYM_PRECISION,
GFC_ISYM_PRESENT,
GFC_ISYM_PRODUCT,
GFC_ISYM_SECOND,
GFC_ISYM_SET_EXPONENT,
GFC_ISYM_SHAPE,
+ GFC_ISYM_SHIFTA,
+ GFC_ISYM_SHIFTL,
+ GFC_ISYM_SHIFTR,
GFC_ISYM_SIGN,
GFC_ISYM_SIGNAL,
GFC_ISYM_SI_KIND,
GFC_ISYM_SRAND,
GFC_ISYM_SR_KIND,
GFC_ISYM_STAT,
+ GFC_ISYM_STORAGE_SIZE,
GFC_ISYM_SUM,
GFC_ISYM_SYMLINK,
GFC_ISYM_SYMLNK,
GFC_ISYM_SYSTEM_CLOCK,
GFC_ISYM_TAN,
GFC_ISYM_TANH,
+ GFC_ISYM_THIS_IMAGE,
GFC_ISYM_TIME,
GFC_ISYM_TIME8,
GFC_ISYM_TINY,
GFC_ISYM_TRIM,
GFC_ISYM_TTYNAM,
GFC_ISYM_UBOUND,
+ GFC_ISYM_UCOBOUND,
GFC_ISYM_UMASK,
GFC_ISYM_UNLINK,
GFC_ISYM_UNPACK,
GFC_ISYM_XOR,
GFC_ISYM_Y0,
GFC_ISYM_Y1,
- GFC_ISYM_YN
+ GFC_ISYM_YN,
+ GFC_ISYM_YN2
};
typedef enum gfc_isym_id gfc_isym_id;
}
init_local_integer;
+typedef enum
+{
+ GFC_FCOARRAY_NONE = 0,
+ GFC_FCOARRAY_SINGLE
+}
+gfc_fcoarray;
+
+typedef enum
+{
+ GFC_REVERSE_NOT_SET,
+ GFC_REVERSE_SET,
+ GFC_CAN_REVERSE,
+ GFC_CANNOT_REVERSE
+}
+gfc_reverse;
+
/************************* Structures *****************************/
/* Used for keeping things in balanced binary trees. */
#define BBT_HEADER(self) int priority; struct self *left, *right
#define NAMED_INTCST(a,b,c,d) a,
+#define NAMED_KINDARRAY(a,b,c,d) a,
+#define NAMED_FUNCTION(a,b,c,d) a,
typedef enum
{
ISOFORTRANENV_INVALID = -1,
}
iso_fortran_env_symbol;
#undef NAMED_INTCST
+#undef NAMED_KINDARRAY
+#undef NAMED_FUNCTION
#define NAMED_INTCST(a,b,c,d) a,
#define NAMED_REALCST(a,b,c) a,
#define NAMED_CHARCST(a,b,c) a,
#define DERIVED_TYPE(a,b,c) a,
#define PROCEDURE(a,b) a,
+#define NAMED_FUNCTION(a,b,c,d) a,
typedef enum
{
ISOCBINDING_INVALID = -1,
#undef NAMED_CHARCST
#undef DERIVED_TYPE
#undef PROCEDURE
+#undef NAMED_FUNCTION
typedef enum
{
typedef struct
{
/* Variable attributes. */
- unsigned allocatable:1, dimension:1, external:1, intrinsic:1,
+ unsigned allocatable:1, dimension:1, codimension:1, external:1, intrinsic:1,
optional:1, pointer:1, target:1, value:1, volatile_:1, temporary:1,
dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1,
- implied_index:1, subref_array_pointer:1, proc_pointer:1;
+ implied_index:1, subref_array_pointer:1, proc_pointer:1, asynchronous:1,
+ contiguous:1;
+
+ /* For CLASS containers, the pointer attribute is sometimes set internally
+ even though it was not directly specified. In this case, keep the
+ "real" (original) value here. */
+ unsigned class_pointer:1;
ENUM_BITFIELD (save_state) save:2;
use_assoc:1, /* Symbol has been use-associated. */
use_only:1, /* Symbol has been use-associated, with ONLY. */
use_rename:1, /* Symbol has been use-associated and renamed. */
- imported:1; /* Symbol has been associated by IMPORT. */
+ imported:1, /* Symbol has been associated by IMPORT. */
+ host_assoc:1; /* Symbol has been host associated. */
unsigned in_namelist:1, in_common:1, in_equivalence:1;
unsigned function:1, subroutine:1, procedure:1;
unsigned untyped:1; /* No implicit type could be found. */
unsigned is_bind_c:1; /* say if is bound to C. */
- unsigned extension:1; /* extends a derived type. */
+ unsigned extension:8; /* extension level of a derived type. */
unsigned is_class:1; /* is a CLASS container. */
+ unsigned class_ok:1; /* is a CLASS object with correct attributes. */
+ unsigned vtab:1; /* is a derived type vtab, pointed to by CLASS objects. */
+ unsigned vtype:1; /* is a derived type of a vtab. */
/* These flags are both in the typespec and attribute. The attribute
list is what gets read from/written to a module file. The typespec
unsigned sequence:1, elemental:1, pure:1, recursive:1;
unsigned unmaskable:1, masked:1, contained:1, mod_proc:1, abstract:1;
+ /* This is set if a contained procedure could be declared pure. This is
+ used for certain optimizations that require the result or arguments
+ cannot alias. Note that this is zero for PURE procedures. */
+ unsigned implicit_pure:1;
+
/* This is set if the subroutine doesn't return. Currently, this
is only possible for intrinsic subroutines. */
unsigned noreturn:1;
modification of type or type parameters is permitted. */
unsigned referenced:1;
- /* Set if the symbol has ambiguous interfaces. */
- unsigned ambiguous_interfaces:1;
-
/* Set if this is the symbol for the main program. */
unsigned is_main_program:1;
possibly nested. zero_comp is true if the derived type has no
component at all. */
unsigned alloc_comp:1, pointer_comp:1, proc_pointer_comp:1,
- private_comp:1, zero_comp:1;
+ private_comp:1, zero_comp:1, coarray_comp:1;
+
+ /* This is a temporary selector for SELECT TYPE. */
+ unsigned select_type_temporary:1;
/* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */
unsigned ext_attr:EXT_ATTR_NUM;
- /* The namespace where the VOLATILE attribute has been set. */
- struct gfc_namespace *volatile_ns;
+ /* The namespace where the attribute has been set. */
+ struct gfc_namespace *volatile_ns, *asynchronous_ns;
}
symbol_attribute;
struct gfc_charlen *next;
bool length_from_typespec; /* Length from explicit array ctor typespec? */
tree backend_decl;
- tree passed_length; /* Length argument explicitelly passed. */
+ tree passed_length; /* Length argument explicitly passed. */
int resolved;
}
{
struct gfc_symbol *derived; /* For derived types only. */
gfc_charlen *cl; /* For character types only. */
+ int pad; /* For hollerith types only. */
}
u;
struct gfc_symbol *interface; /* For PROCEDURE declarations. */
int is_c_interop;
int is_iso_c;
- bt f90_type;
+ bt f90_type;
+ bool deferred;
}
gfc_typespec;
typedef struct
{
int rank; /* A rank of zero means that a variable is a scalar. */
- array_type type;
+ int corank;
+ array_type type, cotype;
struct gfc_expr *lower[GFC_MAX_DIMENSIONS], *upper[GFC_MAX_DIMENSIONS];
/* These two fields are used with the Cray Pointer extension. */
int entry_id; /* Used in resolve.c for entries. */
- /* CLASS vindex for declared and dynamic types in the class. */
- int vindex;
+ /* CLASS hashed name for declared and dynamic types in the class. */
+ int hash_value;
struct gfc_symbol *common_next; /* Links for COMMON syms */
char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
/* Store a reference to the common_block, if this symbol is in one. */
struct gfc_common_head *common_block;
+
+ /* Link to corresponding association-list if this is an associate name. */
+ struct gfc_association_list *assoc;
}
gfc_symbol;
struct gfc_code *code;
/* Points to the equivalences set up in this namespace. */
- struct gfc_equiv *equiv;
+ struct gfc_equiv *equiv, *old_equiv;
/* Points to the equivalence groups produced by trans_common. */
struct gfc_equiv_list *equiv_lists;
/* Set to 1 if namespace is an interface body with "IMPORT" used. */
unsigned has_import_set:1;
- /* Set to 1 if resolved has been called for this namespace. */
- unsigned resolved:1;
+ /* Set to 1 if resolved has been called for this namespace.
+ Holds -1 during resolution. */
+ signed resolved:2;
/* Set to 1 if code has been generated for this namespace. */
unsigned translated:1;
enum gfc_array_ref_dimen_type
{
- DIMEN_ELEMENT = 1, DIMEN_RANGE, DIMEN_VECTOR, DIMEN_UNKNOWN
+ DIMEN_ELEMENT = 1, DIMEN_RANGE, DIMEN_VECTOR, DIMEN_STAR, DIMEN_UNKNOWN
};
typedef struct gfc_array_ref
{
ar_type type;
int dimen; /* # of components in the reference */
+ int codimen;
+ bool in_allocate; /* For coarray checks. */
locus where;
gfc_array_spec *as;
char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_typespec ts;
- int optional;
+ unsigned optional:1, value:1;
ENUM_BITFIELD (sym_intent) intent:2;
gfc_actual_arglist *actual;
gfc_intrinsic_arg *formal;
gfc_typespec ts;
unsigned elemental:1, inquiry:1, transformational:1, pure:1,
- generic:1, specific:1, actual_ok:1, noreturn:1, conversion:1;
+ generic:1, specific:1, actual_ok:1, noreturn:1, conversion:1,
+ from_module:1;
int standard;
gfc_intrinsic_sym;
-typedef struct gfc_class_esym_list
-{
- gfc_symbol *derived;
- gfc_symbol *esym;
- gfc_symbol *class_object;
- struct gfc_class_esym_list *next;
-}
-gfc_class_esym_list;
-
-#define gfc_get_class_esym_list() XCNEW (gfc_class_esym_list)
-
/* Expression nodes. The expression node types deserve explanations,
since the last couple can be easily misconstrued:
#include <gmp.h>
#include <mpfr.h>
-#ifdef HAVE_mpc
#include <mpc.h>
-# if MPC_VERSION >= MPC_VERSION_NUM(0,6,1)
-# define HAVE_mpc_pow
-# endif
-# if MPC_VERSION >= MPC_VERSION_NUM(0,7,1)
-# define HAVE_mpc_arc
-# define HAVE_mpc_pow_z
-# endif
-#else
-#define mpc_realref(X) ((X).r)
-#define mpc_imagref(X) ((X).i)
-#endif
#define GFC_RND_MODE GMP_RNDN
#define GFC_MPC_RND_MODE MPC_RNDNN
+typedef splay_tree gfc_constructor_base;
+
typedef struct gfc_expr
{
expr_t expr_type;
locus where;
- /* True if the expression is a call to a function that returns an array,
- and if we have decided not to allocate temporary data for that array.
- is_boz is true if the integer is regarded as BOZ bitpatten and is_snan
+ /* is_boz is true if the integer is regarded as BOZ bitpatten and is_snan
denotes a signalling not-a-number. */
- unsigned int inline_noncopying_intrinsic : 1, is_boz : 1, is_snan : 1;
+ unsigned int is_boz : 1, is_snan : 1;
/* Sometimes, when an error has been emitted, it is necessary to prevent
it from recurring. */
unsigned int error : 1;
- /* Mark and expression where a user operator has been substituted by
+ /* Mark an expression where a user operator has been substituted by
a function call in interface.c(gfc_extend_expr). */
unsigned int user_operator : 1;
- /* Used to quickly find a given constructor by its offset. */
- splay_tree con_by_offset;
-
+ /* Mark an expression as being a MOLD argument of ALLOCATE. */
+ unsigned int mold : 1;
+
/* If an expression comes from a Hollerith constant or compile-time
evaluation of a transfer statement, it may have a prescribed target-
memory representation, and these cannot always be backformed from
mpfr_t real;
-#ifdef HAVE_mpc
- mpc_t
-#else
- struct
- {
- mpfr_t r, i;
- }
-#endif
- complex;
+ mpc_t complex;
struct
{
const char *name; /* Points to the ultimate name of the function */
gfc_intrinsic_sym *isym;
gfc_symbol *esym;
- gfc_class_esym_list *class_esym;
}
function;
}
character;
- struct gfc_constructor *constructor;
+ gfc_constructor_base constructor;
}
value;
unsigned int c_float : 1;
unsigned int c_double : 1;
unsigned int c_long_double : 1;
+ unsigned int c_float128 : 1;
}
gfc_real_info;
{
gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg,
*id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round,
- *sign, *extra_comma;
+ *sign, *extra_comma, *dt_io_kind;
gfc_symbol *namelist;
/* A format_label of `format_asterisk' indicates the "*" format */
gfc_forall_iterator;
+/* Linked list to store associations in an ASSOCIATE statement. */
+
+typedef struct gfc_association_list
+{
+ struct gfc_association_list *next;
+
+ /* Whether this is association to a variable that can be changed; otherwise,
+ it's association to an expression and the name may not be used as
+ lvalue. */
+ unsigned variable:1;
+
+ /* True if this struct is currently only linked to from a gfc_symbol rather
+ than as part of a real list in gfc_code->ext.block.assoc. This may
+ happen for SELECT TYPE temporaries and must be considered
+ for memory handling. */
+ unsigned dangling:1;
+
+ char name[GFC_MAX_SYMBOL_LEN + 1];
+ gfc_symtree *st; /* Symtree corresponding to name. */
+ locus where;
+
+ gfc_expr *target;
+}
+gfc_association_list;
+#define gfc_get_association_list() XCNEW (gfc_association_list)
+
+
/* Executable statements that fill gfc_code structures. */
typedef enum
{
EXEC_NOP = 1, EXEC_END_BLOCK, EXEC_ASSIGN, EXEC_LABEL_ASSIGN,
- EXEC_POINTER_ASSIGN,
+ EXEC_POINTER_ASSIGN, EXEC_CRITICAL, EXEC_ERROR_STOP,
EXEC_GOTO, EXEC_CALL, EXEC_COMPCALL, EXEC_ASSIGN_CALL, EXEC_RETURN,
EXEC_ENTRY, EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE, EXEC_INIT_ASSIGN,
EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT, EXEC_BLOCK,
EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT, EXEC_CALL_PPC,
EXEC_ALLOCATE, EXEC_DEALLOCATE, EXEC_END_PROCEDURE, EXEC_SELECT_TYPE,
+ EXEC_SYNC_ALL, EXEC_SYNC_MEMORY, EXEC_SYNC_IMAGES,
EXEC_OPEN, EXEC_CLOSE, EXEC_WAIT,
EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
union
{
gfc_actual_arglist *actual;
- gfc_case *case_list;
gfc_iterator *iterator;
struct
}
alloc;
+ struct
+ {
+ gfc_namespace *ns;
+ gfc_association_list *assoc;
+ gfc_case *case_list;
+ }
+ block;
+
gfc_open *open;
gfc_close *close;
gfc_filepos *filepos;
gfc_wait *wait;
gfc_dt *dt;
gfc_forall_iterator *forall_iterator;
- struct gfc_code *whichloop;
+ struct gfc_code *which_construct;
int stop_code;
gfc_entry_list *entry;
gfc_omp_clauses *omp_clauses;
const char *omp_name;
gfc_namelist *omp_namelist;
bool omp_bool;
- gfc_namespace *ns;
}
ext; /* Points to additional structures required by statement */
- /* Backend_decl is used for cycle and break labels in do loops, and
- probably for other constructs as well, once we translate them. */
- tree backend_decl;
+ /* Cycle and break labels in constructs. */
+ tree cycle_label;
+ tree exit_label;
}
gfc_code;
int max_continue_fixed;
int max_continue_free;
int max_identifier_length;
- int dump_parse_tree;
+ int dump_fortran_original;
+ int dump_fortran_optimized;
int warn_aliasing;
int warn_ampersand;
- int warn_conversion;
+ int gfc_warn_conversion;
+ int warn_conversion_extra;
int warn_implicit_interface;
+ int warn_implicit_procedure;
int warn_line_truncation;
int warn_surprising;
int warn_tabs;
int warn_character_truncation;
int warn_array_temp;
int warn_align_commons;
+ int warn_unused_dummy_argument;
int max_errors;
int flag_all_intrinsics;
int blas_matmul_limit;
int flag_cray_pointer;
int flag_d_lines;
- int flag_openmp;
+ int gfc_flag_openmp;
int flag_sign_zero;
int flag_module_private;
int flag_recursive;
char flag_init_character_value;
int flag_align_commons;
int flag_whole_file;
+ int flag_protect_parens;
+ int flag_realloc_lhs;
int fpe;
int rtcheck;
+ gfc_fcoarray coarray;
int warn_std;
int allow_std;
/* Constructor nodes for array and structure constructors. */
typedef struct gfc_constructor
{
+ gfc_constructor_base base;
+ mpz_t offset; /* Offset within a constructor, used as
+ key within base. */
+
gfc_expr *expr;
gfc_iterator *iterator;
locus where;
- struct gfc_constructor *next;
- struct
+
+ union
{
- mpz_t offset; /* Record the offset of array element which appears in
- data statement like "data a(5)/4/". */
- gfc_component *component; /* Record the component being initialized. */
+ gfc_component *component; /* Record the component being initialized. */
}
n;
- mpz_t repeat; /* Record the repeat number of initial values in data
- statement like "data a/5*10/". */
}
gfc_constructor;
extern iterator_stack *iter_stack;
+/* Used for (possibly nested) SELECT TYPE statements. */
+typedef struct gfc_select_type_stack
+{
+ gfc_symbol *selector; /* Current selector variable. */
+ gfc_symtree *tmp; /* Current temporary variable. */
+ struct gfc_select_type_stack *prev; /* Previous element on stack. */
+}
+gfc_select_type_stack;
+extern gfc_select_type_stack *select_type_stack;
+#define gfc_get_select_type_stack() XCNEW (gfc_select_type_stack)
+
+
/* Node in the linked list used for storing finalizer procedures. */
typedef struct gfc_finalizer
#define gfc_get_wide_string(n) XCNEWVEC (gfc_char_t, n)
void gfc_skip_comments (void);
-gfc_char_t gfc_next_char_literal (int);
+gfc_char_t gfc_next_char_literal (gfc_instring);
gfc_char_t gfc_next_char (void);
char gfc_next_ascii_char (void);
gfc_char_t gfc_peek_char (void);
int get_c_kind (const char *, CInteropKind_t *);
/* options.c */
-unsigned int gfc_init_options (unsigned int, const char **);
-int gfc_handle_option (size_t, const char *, int);
+unsigned int gfc_option_lang_mask (void);
+void gfc_init_options_struct (struct gcc_options *);
+void gfc_init_options (unsigned int,
+ struct cl_decoded_option *);
+bool gfc_handle_option (size_t, const char *, int, int, location_t,
+ const struct cl_option_handlers *);
bool gfc_post_options (const char **);
+char *gfc_get_option_string (void);
/* f95-lang.c */
void gfc_maybe_initialize_eh (void);
int gfc_validate_kind (bt, int, bool);
int gfc_get_int_kind_from_width_isofortranenv (int size);
int gfc_get_real_kind_from_width_isofortranenv (int size);
+tree gfc_get_derived_type (gfc_symbol * derived);
extern int gfc_index_integer_kind;
extern int gfc_default_integer_kind;
extern int gfc_max_integer_kind;
gfc_try gfc_add_attribute (symbol_attribute *, locus *);
gfc_try gfc_add_ext_attribute (symbol_attribute *, ext_attr_id_t, locus *);
gfc_try gfc_add_allocatable (symbol_attribute *, locus *);
+gfc_try gfc_add_codimension (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_contiguous (symbol_attribute *, const char *, locus *);
gfc_try gfc_add_dimension (symbol_attribute *, const char *, locus *);
gfc_try gfc_add_external (symbol_attribute *, locus *);
gfc_try gfc_add_intrinsic (symbol_attribute *, locus *);
match gfc_mod_pointee_as (gfc_array_spec *);
gfc_try gfc_add_protected (symbol_attribute *, const char *, locus *);
gfc_try gfc_add_result (symbol_attribute *, const char *, locus *);
-gfc_try gfc_add_save (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_save (symbol_attribute *, save_state, const char *, locus *);
gfc_try gfc_add_threadprivate (symbol_attribute *, const char *, locus *);
gfc_try gfc_add_saved_common (symbol_attribute *, locus *);
gfc_try gfc_add_target (symbol_attribute *, locus *);
gfc_try gfc_add_function (symbol_attribute *, const char *, locus *);
gfc_try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
gfc_try gfc_add_volatile (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_asynchronous (symbol_attribute *, const char *, locus *);
gfc_try gfc_add_proc (symbol_attribute *attr, const char *name, locus *where);
gfc_try gfc_add_abstract (symbol_attribute* attr, locus* where);
void gfc_define_st_label (gfc_st_label *, gfc_sl_type, locus *);
gfc_try gfc_reference_st_label (gfc_st_label *, gfc_sl_type);
-gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
-
gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
gfc_user_op *gfc_get_uop (const char *);
gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
void gfc_free_symbol (gfc_symbol *);
+void gfc_release_symbol (gfc_symbol *);
gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *);
+gfc_symtree* gfc_find_symtree_in_proc (const char *, gfc_namespace *);
int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);
int gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **);
int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **);
int gfc_get_ha_symbol (const char *, gfc_symbol **);
int gfc_get_ha_sym_tree (const char *, gfc_symtree **);
-int gfc_symbols_could_alias (gfc_symbol *, gfc_symbol *);
-
void gfc_undo_symbols (void);
void gfc_commit_symbols (void);
void gfc_commit_symbol (gfc_symbol *);
void gfc_traverse_user_op (gfc_namespace *, void (*)(gfc_user_op *));
void gfc_save_all (gfc_namespace *);
-void gfc_symbol_state (void);
+void gfc_enforce_clean_symbol_state (void);
void gfc_free_dt_list (void);
gfc_gsymbol *gfc_get_gsymbol (const char *);
gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *);
-gfc_typebound_proc* gfc_get_typebound_proc (void);
+gfc_typebound_proc* gfc_get_typebound_proc (gfc_typebound_proc*);
gfc_symbol* gfc_get_derived_super_type (gfc_symbol*);
gfc_symbol* gfc_get_ultimate_derived_super_type (gfc_symbol*);
bool gfc_type_is_extension_of (gfc_symbol *, gfc_symbol *);
bool gfc_type_compatible (gfc_typespec *, gfc_typespec *);
-gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, gfc_try*,
- const char*, bool, locus*);
-gfc_symtree* gfc_find_typebound_user_op (gfc_symbol*, gfc_try*,
- const char*, bool, locus*);
-gfc_typebound_proc* gfc_find_typebound_intrinsic_op (gfc_symbol*, gfc_try*,
- gfc_intrinsic_op, bool,
- locus*);
-gfc_symtree* gfc_get_tbp_symtree (gfc_symtree**, const char*);
void gfc_copy_formal_args (gfc_symbol *, gfc_symbol *);
void gfc_copy_formal_args_intr (gfc_symbol *, gfc_intrinsic_sym *);
void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.c, too */
gfc_try gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus);
+gfc_namespace* gfc_find_proc_namespace (gfc_namespace*);
+
+bool gfc_is_associate_pointer (gfc_symbol*);
-/* intrinsic.c */
-extern int gfc_init_expr;
+/* intrinsic.c -- true if working in an init-expr, false otherwise. */
+extern bool gfc_init_expr_flag;
/* Given a symbol that we have decided is intrinsic, mark it as such
by placing it into a special module that is otherwise impossible to
int gfc_intrinsic_actual_ok (const char *, const bool);
gfc_intrinsic_sym *gfc_find_function (const char *);
gfc_intrinsic_sym *gfc_find_subroutine (const char *);
+gfc_intrinsic_sym *gfc_intrinsic_function_by_id (gfc_isym_id);
match gfc_intrinsic_func_interface (gfc_expr *, int);
match gfc_intrinsic_sub_interface (gfc_code *, int);
void gfc_free_alloc_list (gfc_alloc *);
void gfc_free_namelist (gfc_namelist *);
void gfc_free_equiv (gfc_equiv *);
+void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *);
void gfc_free_data (gfc_data *);
void gfc_free_case_list (gfc_case *);
-/* Used for SELECT TYPE statements. */
-extern gfc_symbol *type_selector;
-extern gfc_symtree *select_type_tmp;
-
/* matchexp.c -- FIXME too? */
gfc_expr *gfc_get_parentheses (gfc_expr *);
gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
const char *gfc_extract_int (gfc_expr *, int *);
bool is_subref_array (gfc_expr *);
+bool gfc_is_simply_contiguous (gfc_expr *, bool);
-void gfc_add_component_ref (gfc_expr *, const char *);
gfc_expr *gfc_build_conversion (gfc_expr *);
void gfc_free_ref_list (gfc_ref *);
-void gfc_type_convert_binary (gfc_expr *);
+void gfc_type_convert_binary (gfc_expr *, int);
int gfc_is_constant_expr (gfc_expr *);
gfc_try gfc_simplify_expr (gfc_expr *, int);
int gfc_has_vector_index (gfc_expr *);
gfc_expr *gfc_get_expr (void);
+gfc_expr *gfc_get_array_expr (bt type, int kind, locus *);
+gfc_expr *gfc_get_null_expr (locus *);
+gfc_expr *gfc_get_operator_expr (locus *, gfc_intrinsic_op,gfc_expr *, gfc_expr *);
+gfc_expr *gfc_get_structure_constructor_expr (bt, int, locus *);
+gfc_expr *gfc_get_constant_expr (bt, int, locus *);
+gfc_expr *gfc_get_character_expr (int, locus *, const char *, int len);
+gfc_expr *gfc_get_int_expr (int, locus *, int);
+gfc_expr *gfc_get_logical_expr (int, locus *, bool);
+gfc_expr *gfc_get_iokind_expr (locus *, io_kind);
+
void gfc_free_expr (gfc_expr *);
void gfc_replace_expr (gfc_expr *, gfc_expr *);
-gfc_expr *gfc_int_expr (int);
-gfc_expr *gfc_logical_expr (int, locus *);
mpz_t *gfc_copy_shape (mpz_t *, int);
mpz_t *gfc_copy_shape_excluding (mpz_t *, int, gfc_expr *);
gfc_expr *gfc_copy_expr (gfc_expr *);
gfc_try gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
gfc_try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
+bool gfc_has_default_initializer (gfc_symbol *);
gfc_expr *gfc_default_initializer (gfc_typespec *);
gfc_expr *gfc_get_variable_expr (gfc_symtree *);
+gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
+
+gfc_array_spec *gfc_get_full_arrayspec_from_expr (gfc_expr *expr);
bool gfc_traverse_expr (gfc_expr *, gfc_symbol *,
bool (*)(gfc_expr *, gfc_symbol *, int*),
bool gfc_is_proc_ptr_comp (gfc_expr *, gfc_component **);
+bool gfc_is_coindexed (gfc_expr *);
+bool gfc_get_corank (gfc_expr *);
+bool gfc_has_ultimate_allocatable (gfc_expr *);
+bool gfc_has_ultimate_pointer (gfc_expr *);
+
+gfc_expr* gfc_build_intrinsic_call (const char*, locus, unsigned, ...);
+gfc_try gfc_check_vardef_context (gfc_expr*, bool, const char*);
+
+
/* st.c */
extern gfc_code new_st;
gfc_code *gfc_append_code (gfc_code *, gfc_code *);
void gfc_free_statement (gfc_code *);
void gfc_free_statements (gfc_code *);
+void gfc_free_association_list (gfc_association_list *);
/* resolve.c */
gfc_try gfc_resolve_expr (gfc_expr *);
void gfc_resolve_blocks (gfc_code *, gfc_namespace *);
int gfc_impure_variable (gfc_symbol *);
int gfc_pure (gfc_symbol *);
+int gfc_implicit_pure (gfc_symbol *);
int gfc_elemental (gfc_symbol *);
gfc_try gfc_resolve_iterator (gfc_iterator *, bool);
gfc_try find_forall_index (gfc_expr *, gfc_symbol *, int);
/* array.c */
+gfc_iterator *gfc_copy_iterator (gfc_iterator *);
+
void gfc_free_array_spec (gfc_array_spec *);
gfc_array_ref *gfc_copy_array_ref (gfc_array_ref *);
int gfc_compare_array_spec (gfc_array_spec *, gfc_array_spec *);
-gfc_expr *gfc_start_constructor (bt, int, locus *);
-void gfc_append_constructor (gfc_expr *, gfc_expr *);
-void gfc_free_constructor (gfc_constructor *);
void gfc_simplify_iterator_var (gfc_expr *);
-gfc_try gfc_expand_constructor (gfc_expr *);
+gfc_try gfc_expand_constructor (gfc_expr *, bool);
int gfc_constant_ac (gfc_expr *);
int gfc_expanded_ac (gfc_expr *);
gfc_try gfc_resolve_character_array_constructor (gfc_expr *);
gfc_try gfc_check_constructor_type (gfc_expr *);
gfc_try gfc_check_iter_variable (gfc_expr *);
gfc_try gfc_check_constructor (gfc_expr *, gfc_try (*)(gfc_expr *));
-gfc_constructor *gfc_copy_constructor (gfc_constructor *);
-gfc_expr *gfc_get_array_element (gfc_expr *, int);
gfc_try gfc_array_size (gfc_expr *, mpz_t *);
gfc_try gfc_array_dimen_size (gfc_expr *, int, mpz_t *);
gfc_try gfc_array_ref_shape (gfc_array_ref *, mpz_t *);
gfc_array_ref *gfc_find_array_ref (gfc_expr *);
-void gfc_insert_constructor (gfc_expr *, gfc_constructor *);
-gfc_constructor *gfc_get_constructor (void);
tree gfc_conv_array_initializer (tree type, gfc_expr *);
gfc_try spec_size (gfc_array_spec *, mpz_t *);
gfc_try spec_dimen_size (gfc_array_spec *, int, mpz_t *);
int gfc_is_compile_time_shape (gfc_array_spec *);
-gfc_try gfc_ref_dimen_size (gfc_array_ref *, int dimen, mpz_t *);
+gfc_try gfc_ref_dimen_size (gfc_array_ref *, int dimen, mpz_t *, mpz_t *);
/* interface.c -- FIXME: some of these should be in symbol.c */
gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*);
bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*);
bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus);
+int gfc_has_vector_subscript (gfc_expr*);
/* io.c */
extern gfc_st_label format_asterisk;
match gfc_match_rvalue (gfc_expr **);
match gfc_match_varspec (gfc_expr*, int, bool, bool);
int gfc_check_digit (char, int);
+bool gfc_is_function_return_value (gfc_symbol *, gfc_namespace *);
/* trans.c */
void gfc_generate_code (gfc_namespace *);
/* parse.c */
gfc_try gfc_parse_file (void);
void gfc_global_used (gfc_gsymbol *, locus *);
+gfc_namespace* gfc_build_block_ns (gfc_namespace *);
/* dependency.c */
int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
-int gfc_is_data_pointer (gfc_expr *);
/* check.c */
gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
+/* class.c */
+void gfc_add_component_ref (gfc_expr *, const char *);
+#define gfc_add_data_component(e) gfc_add_component_ref(e,"_data")
+#define gfc_add_vptr_component(e) gfc_add_component_ref(e,"_vptr")
+#define gfc_add_hash_component(e) gfc_add_component_ref(e,"_hash")
+#define gfc_add_size_component(e) gfc_add_component_ref(e,"_size")
+#define gfc_add_def_init_component(e) gfc_add_component_ref(e,"_def_init")
+gfc_expr *gfc_class_null_initializer (gfc_typespec *);
+unsigned int gfc_hash_value (gfc_symbol *);
+gfc_try gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
+ gfc_array_spec **, bool);
+gfc_symbol *gfc_find_derived_vtab (gfc_symbol *);
+gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, gfc_try*,
+ const char*, bool, locus*);
+gfc_symtree* gfc_find_typebound_user_op (gfc_symbol*, gfc_try*,
+ const char*, bool, locus*);
+gfc_typebound_proc* gfc_find_typebound_intrinsic_op (gfc_symbol*, gfc_try*,
+ gfc_intrinsic_op, bool,
+ locus*);
+gfc_symtree* gfc_get_tbp_symtree (gfc_symtree**, const char*);
+
+#define CLASS_DATA(sym) sym->ts.u.derived->components
+
+/* frontend-passes.c */
+
+void gfc_run_passes (gfc_namespace *);
+
+typedef int (*walk_code_fn_t) (gfc_code **, int *, void *);
+typedef int (*walk_expr_fn_t) (gfc_expr **, int *, void *);
+
+int gfc_expr_walker (gfc_expr **, walk_expr_fn_t, void *);
+int gfc_code_walker (gfc_code **, walk_code_fn_t, walk_expr_fn_t, void *);
+
#endif /* GCC_GFORTRAN_H */