/* Expression node types. */
typedef enum
{ EXPR_OP = 1, EXPR_FUNCTION, EXPR_CONSTANT, EXPR_VARIABLE,
- EXPR_SUBSTRING, EXPR_STRUCTURE, EXPR_ARRAY, EXPR_NULL, EXPR_COMPCALL
+ EXPR_SUBSTRING, EXPR_STRUCTURE, EXPR_ARRAY, EXPR_NULL, EXPR_COMPCALL, EXPR_PPC
}
expr_t;
gfc_access;
/* Flags to keep track of where an interface came from.
- 4 elements = 2 bits. */
+ 3 elements = 2 bits. */
typedef enum ifsrc
-{ IFSRC_UNKNOWN = 0, IFSRC_DECL, IFSRC_IFBODY, IFSRC_USAGE
+{ IFSRC_UNKNOWN = 0, /* Interface unknown, only return type may be known. */
+ IFSRC_DECL, /* FUNCTION or SUBROUTINE declaration. */
+ IFSRC_IFBODY /* INTERFACE statement or PROCEDURE statement
+ with explicit interface. */
}
ifsrc;
{
/* Variable attributes. */
unsigned allocatable:1, dimension:1, external:1, intrinsic:1,
- optional:1, pointer:1, target:1, value:1, volatile_: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;
unsigned cray_pointer:1, cray_pointee:1;
/* The symbol is a derived type with allocatable components, pointer
- components or private components, possibly nested. zero_comp
- is true if the derived type has no component at all. */
- unsigned alloc_comp:1, pointer_comp:1, private_comp:1, zero_comp:1;
+ components or private components, procedure pointer components,
+ 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;
/* The namespace where the VOLATILE attribute has been set. */
struct gfc_namespace *volatile_ns;
struct gfc_charlen *next;
bool length_from_typespec; /* Length from explicit array ctor typespec? */
tree backend_decl;
+ tree passed_length; /* Length argument explicitelly passed. */
int resolved;
}
locus loc;
struct gfc_expr *initializer;
struct gfc_component *next;
+
+ struct gfc_formal_arglist *formal;
}
gfc_component;
/* Because a symbol can belong to multiple namelists, they must be
linked externally to the symbol itself. */
+
+enum gfc_omp_sched_kind
+{
+ OMP_SCHED_NONE,
+ OMP_SCHED_STATIC,
+ OMP_SCHED_DYNAMIC,
+ OMP_SCHED_GUIDED,
+ OMP_SCHED_RUNTIME,
+ OMP_SCHED_AUTO
+};
+
+enum gfc_omp_default_sharing
+{
+ OMP_DEFAULT_UNKNOWN,
+ OMP_DEFAULT_NONE,
+ OMP_DEFAULT_PRIVATE,
+ OMP_DEFAULT_SHARED,
+ OMP_DEFAULT_FIRSTPRIVATE
+};
+
typedef struct gfc_omp_clauses
{
struct gfc_expr *if_expr;
struct gfc_expr *num_threads;
gfc_namelist *lists[OMP_LIST_NUM];
- enum
- {
- OMP_SCHED_NONE,
- OMP_SCHED_STATIC,
- OMP_SCHED_DYNAMIC,
- OMP_SCHED_GUIDED,
- OMP_SCHED_RUNTIME,
- OMP_SCHED_AUTO
- } sched_kind;
+ enum gfc_omp_sched_kind sched_kind;
struct gfc_expr *chunk_size;
- enum
- {
- OMP_DEFAULT_UNKNOWN,
- OMP_DEFAULT_NONE,
- OMP_DEFAULT_PRIVATE,
- OMP_DEFAULT_SHARED,
- OMP_DEFAULT_FIRSTPRIVATE
- } default_sharing;
+ enum gfc_omp_default_sharing default_sharing;
int collapse;
bool nowait, ordered, untied;
}
}
gfc_typebound_proc;
-#define gfc_get_typebound_proc() XCNEW (gfc_typebound_proc)
-
/* Symbol nodes. These are important things. They are what the
standard refers to as "entities". The possibly multiple names that
gfc_symbol *sym; /* Symbol associated with this node */
gfc_user_op *uop;
gfc_common_head *common;
+ gfc_typebound_proc *tb;
}
n;
-
- /* Data for type-bound procedures; NULL if no type-bound procedure. */
- gfc_typebound_proc* typebound;
}
gfc_symtree;
gfc_symtree *uop_root;
/* Tree containing all the common blocks. */
gfc_symtree *common_root;
+
+ /* Tree containing type-bound procedures. */
+ gfc_symtree *tb_sym_root;
/* Linked list of finalizer procedures. */
struct gfc_finalizer *finalizers;
this to detect collisions already when parsing.
TODO: Extend to verify procedure calls. */
+enum gfc_symbol_type
+{
+ GSYM_UNKNOWN=1, GSYM_PROGRAM, GSYM_FUNCTION, GSYM_SUBROUTINE,
+ GSYM_MODULE, GSYM_COMMON, GSYM_BLOCK_DATA
+};
+
typedef struct gfc_gsymbol
{
BBT_HEADER(gfc_gsymbol);
const char *sym_name;
const char *mod_name;
const char *binding_label;
- enum { GSYM_UNKNOWN=1, GSYM_PROGRAM, GSYM_FUNCTION, GSYM_SUBROUTINE,
- GSYM_MODULE, GSYM_COMMON, GSYM_BLOCK_DATA } type;
+ enum gfc_symbol_type type;
int defined, used;
locus where;
/* Array reference. */
+
+enum gfc_array_ref_dimen_type
+{
+ DIMEN_ELEMENT = 1, DIMEN_RANGE, DIMEN_VECTOR, DIMEN_UNKNOWN
+};
+
typedef struct gfc_array_ref
{
ar_type type;
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];
+ enum gfc_array_ref_dimen_type dimen_type[GFC_MAX_DIMENSIONS];
struct gfc_expr *offset;
}
gfc_typespec ts;
int optional;
+ ENUM_BITFIELD (sym_intent) intent:2;
gfc_actual_arglist *actual;
struct gfc_intrinsic_arg *next;
#include <gmp.h>
#include <mpfr.h>
+#ifdef HAVE_mpc
+#include <mpc.h>
+#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 struct gfc_expr
{
mpfr_t real;
+#ifdef HAVE_mpc
+ mpc_t
+#else
struct
{
mpfr_t r, i;
}
+#endif
complex;
struct
{
gfc_expr *unit, *file, *status, *access, *form, *recl,
*blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert,
- *decimal, *encoding, *round, *sign, *asynchronous, *id;
+ *decimal, *encoding, *round, *sign, *asynchronous, *id, *newunit;
gfc_st_label *err;
}
gfc_open;
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_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT,
- EXEC_ALLOCATE, EXEC_DEALLOCATE,
+ EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT, EXEC_CALL_PPC,
+ EXEC_ALLOCATE, EXEC_DEALLOCATE, EXEC_END_PROCEDURE,
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,
struct gfc_code *block, *next;
locus loc;
- gfc_st_label *here, *label, *label2, *label3;
+ gfc_st_label *here, *label1, *label2, *label3;
gfc_symtree *symtree;
- gfc_expr *expr, *expr2;
+ gfc_expr *expr1, *expr2;
/* A name isn't sufficient to identify a subroutine, we need the actual
symbol for the interface definition.
const char *sub_name; */
int warn_std;
int allow_std;
- int fshort_enums;
int convert;
int record_marker;
int max_subrecord_length;
int gfc_handle_option (size_t, const char *, int);
bool gfc_post_options (const char **);
+/* f95-lang.c */
+void gfc_maybe_initialize_eh (void);
+
/* iresolve.c */
const char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1;
bool gfc_find_sym_in_expr (gfc_symbol *, gfc_expr *);
/* arith.c */
void gfc_arith_init_1 (void);
void gfc_arith_done_1 (void);
-gfc_expr *gfc_enum_initializer (gfc_expr *, locus);
arith gfc_check_integer_range (mpz_t p, int kind);
bool gfc_check_character_range (gfc_char_t, int);
/* trans-types.c */
gfc_try gfc_check_any_c_kind (gfc_typespec *);
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);
extern int gfc_index_integer_kind;
extern int gfc_default_integer_kind;
extern int gfc_max_integer_kind;
void gfc_check_function_type (gfc_namespace *);
bool gfc_is_intrinsic_typename (const char *);
-gfc_typespec *gfc_get_default_type (gfc_symbol *, gfc_namespace *);
+gfc_typespec *gfc_get_default_type (const char *, gfc_namespace *);
gfc_try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);
void gfc_set_sym_referenced (gfc_symbol *);
gfc_try gfc_add_pointer (symbol_attribute *, locus *);
gfc_try gfc_add_cray_pointer (symbol_attribute *, locus *);
gfc_try gfc_add_cray_pointee (symbol_attribute *, locus *);
-gfc_try gfc_mod_pointee_as (gfc_array_spec *);
+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_gsymbol *gfc_get_gsymbol (const char *);
gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *);
+gfc_typebound_proc* gfc_get_typebound_proc (void);
gfc_symbol* gfc_get_derived_super_type (gfc_symbol*);
gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, gfc_try*, const char*, bool);
+gfc_symtree* gfc_get_tbp_symtree (gfc_symtree**, const char*);
-void copy_formal_args (gfc_symbol *dest, gfc_symbol *src);
+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 */
int gfc_numeric_ts (gfc_typespec *);
int gfc_kind_max (gfc_expr *, gfc_expr *);
-gfc_try gfc_check_conformance (const char *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_conformance (gfc_expr *, gfc_expr *, const char *, ...) ATTRIBUTE_PRINTF_3;
gfc_try gfc_check_assign (gfc_expr *, gfc_expr *, int);
gfc_try gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
gfc_try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
gfc_try gfc_expr_check_typed (gfc_expr*, gfc_namespace*, bool);
void gfc_expr_replace_symbols (gfc_expr *, gfc_symbol *);
+bool is_proc_ptr_comp (gfc_expr *, gfc_component **);
+
/* st.c */
extern gfc_code new_st;
void gfc_free_interface (gfc_interface *);
int gfc_compare_derived_types (gfc_symbol *, gfc_symbol *);
int gfc_compare_types (gfc_typespec *, gfc_typespec *);
-int gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, int);
+int gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, int, int, char *, int);
void gfc_check_interfaces (gfc_namespace *);
void gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *);
gfc_symbol *gfc_search_interface (gfc_interface *, int,
symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
symbol_attribute gfc_expr_attr (gfc_expr *);
match gfc_match_rvalue (gfc_expr **);
-match gfc_match_varspec (gfc_expr*, int, bool);
+match gfc_match_varspec (gfc_expr*, int, bool, bool);
int gfc_check_digit (char, int);
/* trans.c */
OSDN Git Service
