/* gfortran header file
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
Free Software Foundation, Inc.
Contributed by Andy Vaught
/* 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;
/* Arithmetic results. */
typedef enum
{ ARITH_OK = 1, ARITH_OVERFLOW, ARITH_UNDERFLOW, ARITH_NAN,
- ARITH_DIV0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC
+ ARITH_DIV0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC, ARITH_PROHIBIT
}
arith;
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;
GFC_ISYM_KILL,
GFC_ISYM_KIND,
GFC_ISYM_LBOUND,
+ GFC_ISYM_LEADZ,
GFC_ISYM_LEN,
GFC_ISYM_LEN_TRIM,
GFC_ISYM_LGAMMA,
GFC_ISYM_TIME,
GFC_ISYM_TIME8,
GFC_ISYM_TINY,
+ GFC_ISYM_TRAILZ,
GFC_ISYM_TRANSFER,
GFC_ISYM_TRANSPOSE,
GFC_ISYM_TRIM,
GFC_INIT_REAL_OFF = 0,
GFC_INIT_REAL_ZERO,
GFC_INIT_REAL_NAN,
+ GFC_INIT_REAL_SNAN,
GFC_INIT_REAL_INF,
GFC_INIT_REAL_NEG_INF
}
{
/* 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 function:1, subroutine:1, procedure:1;
unsigned generic:1, generic_copy:1;
unsigned implicit_type:1; /* Type defined via implicit rules. */
- unsigned untyped:1; /* No implicit type could be found. */
+ 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 is_bind_c:1; /* say if is bound to C. */
+ unsigned extension:1; /* extends a derived type. */
/* 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 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;
#endif
-extern int gfc_suppress_error;
+/* Suppress error messages or re-enable them. */
+
+void gfc_push_suppress_errors (void);
+void gfc_pop_suppress_errors (void);
/* Character length structures hold the expression that gives the
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;
}
#define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses)
-/* 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. */
+/* The gfc_st_label structure is a BBT attached to a namespace that
+ records the usage of statement labels within that space. */
+
typedef struct gfc_st_label
{
BBT_HEADER(gfc_st_label);
union
{
- struct gfc_symtree* specific;
+ struct gfc_symtree* specific; /* The interface if DEFERRED. */
gfc_tbp_generic* generic;
}
u;
unsigned nopass:1; /* Whether we have NOPASS (PASS otherwise). */
unsigned non_overridable:1;
+ unsigned deferred:1;
unsigned is_generic:1;
unsigned function:1, subroutine:1;
+ unsigned error:1; /* Ignore it, when an error occurred during resolution. */
}
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
int id;
/* The LABEL_EXPR marking this entry point. */
tree label;
- /* The nest item in the list. */
+ /* The next item in the list. */
struct gfc_entry_list *next;
}
gfc_entry_list;
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 namespace. */
struct gfc_data *data;
- gfc_charlen *cl_list;
+ gfc_charlen *cl_list, *old_cl_list;
int save_all, seen_save, seen_implicit_none;
/* Set to 1 if namespace is an interface body with "IMPORT" used. */
int has_import_set;
+
+ /* Set to 1 if resolved has been called for this namespace. */
+ int resolved;
}
gfc_namespace;
extern gfc_namespace *gfc_current_ns;
+extern gfc_namespace *gfc_global_ns_list;
/* Global symbols are symbols of global scope. Currently we only use
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;
+ gfc_namespace *ns;
}
gfc_gsymbol;
/* 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
{
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. */
- unsigned int inline_noncopying_intrinsic : 1, is_boz : 1;
+ 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
+ denotes a signalling not-a-number. */
+ unsigned int inline_noncopying_intrinsic : 1, 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
+ 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;
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;
/* Executable statements that fill gfc_code structures. */
typedef enum
{
- EXEC_NOP = 1, EXEC_ASSIGN, EXEC_LABEL_ASSIGN, EXEC_POINTER_ASSIGN,
+ EXEC_NOP = 1, EXEC_END_BLOCK, EXEC_ASSIGN, EXEC_LABEL_ASSIGN,
+ EXEC_POINTER_ASSIGN,
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; */
gfc_symbol *resolved_sym;
+ gfc_intrinsic_sym *resolved_isym;
union
{
int flag_second_underscore;
int flag_implicit_none;
int flag_max_stack_var_size;
+ int flag_max_array_constructor;
int flag_range_check;
int flag_pack_derived;
int flag_repack_arrays;
int flag_automatic;
int flag_backslash;
int flag_backtrace;
- int flag_check_array_temporaries;
int flag_allow_leading_underscore;
int flag_dump_core;
int flag_external_blas;
int flag_init_character;
char flag_init_character_value;
int flag_align_commons;
+ int flag_whole_file;
int fpe;
+ int rtcheck;
int warn_std;
int allow_std;
- int fshort_enums;
int convert;
int record_marker;
int max_subrecord_length;
void gfc_scanner_done_1 (void);
void gfc_scanner_init_1 (void);
-void gfc_add_include_path (const char *, bool);
+void gfc_add_include_path (const char *, bool, bool);
void gfc_add_intrinsic_modules_path (const char *);
void gfc_release_include_path (void);
FILE *gfc_open_included_file (const char *, bool, bool);
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_validate_c_kind (gfc_typespec *);
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_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 **);
-gfc_try verify_c_interop (gfc_typespec *, const char *name, locus *where);
+gfc_try verify_c_interop (gfc_typespec *);
gfc_try verify_c_interop_param (gfc_symbol *);
gfc_try verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *);
gfc_try verify_bind_c_derived_type (gfc_symbol *);
void gfc_undo_symbols (void);
void gfc_commit_symbols (void);
void gfc_commit_symbol (gfc_symbol *);
+void gfc_free_charlen (gfc_charlen *, gfc_charlen *);
void gfc_free_namespace (gfc_namespace *);
void gfc_symbol_init_2 (void);
void gfc_save_all (gfc_namespace *);
void gfc_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_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 *);
bool (*)(gfc_expr *, gfc_symbol *, int*),
int);
void gfc_expr_set_symbols_referenced (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;
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 *);
+
+
/* interface.c -- FIXME: some of these should be in symbol.c */
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,
gfc_interface *gfc_current_interface_head (void);
void gfc_set_current_interface_head (gfc_interface *);
gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*);
-int gfc_compare_actual_formal (gfc_actual_arglist**, gfc_formal_arglist*,
- int, int, locus*);
+bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*);
/* io.c */
extern gfc_st_label format_asterisk;
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 */
/* 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*);
#endif /* GCC_GFORTRAN_H */