/* 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;
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;
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;
}
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 *);
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 */