/* 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
Free Software Foundation, Inc.
Contributed by Andy Vaught
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;
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_IDATE,
GFC_ISYM_IEOR,
GFC_ISYM_IERRNO,
+ GFC_ISYM_IMAGE_INDEX,
GFC_ISYM_INDEX,
GFC_ISYM_INT,
GFC_ISYM_INT2,
GFC_ISYM_KILL,
GFC_ISYM_KIND,
GFC_ISYM_LBOUND,
+ GFC_ISYM_LCOBOUND,
GFC_ISYM_LEADZ,
GFC_ISYM_LEN,
GFC_ISYM_LEN_TRIM,
GFC_ISYM_NINT,
GFC_ISYM_NOT,
GFC_ISYM_NULL,
+ GFC_ISYM_NUMIMAGES,
GFC_ISYM_OR,
GFC_ISYM_PACK,
GFC_ISYM_PERROR,
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,
}
init_local_integer;
+typedef enum
+{
+ GFC_FCOARRAY_NONE = 0,
+ GFC_FCOARRAY_SINGLE
+}
+gfc_fcoarray;
+
/************************* Structures *****************************/
/* Used for keeping things in balanced binary trees. */
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;
+
+ /* 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;
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
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;
/* 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;
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 */
/* 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;
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;
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;
-
/* 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;
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,
int warn_ampersand;
int warn_conversion;
int warn_implicit_interface;
+ int warn_implicit_procedure;
int warn_line_truncation;
int warn_surprising;
int warn_tabs;
char flag_init_character_value;
int flag_align_commons;
int flag_whole_file;
+ int flag_protect_parens;
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;
/* options.c */
unsigned int gfc_init_options (unsigned int, const char **);
-int gfc_handle_option (size_t, const char *, int);
+int gfc_handle_option (size_t, const char *, int, int);
bool gfc_post_options (const char **);
/* f95-lang.c */
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_dimension (symbol_attribute *, const char *, locus *);
gfc_try gfc_add_external (symbol_attribute *, locus *);
gfc_try gfc_add_intrinsic (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);
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 *);
gfc_try gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus);
-/* 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
const char *gfc_extract_int (gfc_expr *, int *);
bool is_subref_array (gfc_expr *);
-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_expr *gfc_default_initializer (gfc_typespec *);
gfc_expr *gfc_get_variable_expr (gfc_symtree *);
+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*),
int);
bool gfc_is_proc_ptr_comp (gfc_expr *, gfc_component **);
+bool gfc_is_coindexed (gfc_expr *);
+bool gfc_has_ultimate_allocatable (gfc_expr *);
+bool gfc_has_ultimate_pointer (gfc_expr *);
+
+
/* st.c */
extern gfc_code new_st;
/* 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 *);
int gfc_constant_ac (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 *);
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 *);
/* 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 *);
+gfc_expr *gfc_class_null_initializer (gfc_typespec *);
+gfc_try gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
+ gfc_array_spec **, bool);
+gfc_symbol *gfc_find_derived_vtab (gfc_symbol *, bool);
+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*);
+
#endif /* GCC_GFORTRAN_H */
OSDN Git Service
