/* 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
#define stringize(x) expand_macro(x)
#define expand_macro(x) # x
-/* For a the runtime library, a standard prefix is a requirement to
+/* For the runtime library, a standard prefix is a requirement to
avoid cluttering the namespace with things nobody asked for. It's
ugly to look at and a pain to type when you add the prefix by hand,
so we hide it behind a macro. */
typedef enum
{ SUCCESS = 1, FAILURE }
-try;
+gfc_try;
/* 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
/* 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_PROCEDURE, BT_HOLLERITH,
- BT_VOID
+{ 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,
- EXPR_SUBSTRING, EXPR_STRUCTURE, EXPR_ARRAY, EXPR_NULL
+ 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;
/* Statements. */
typedef enum
{
- ST_ARITHMETIC_IF, ST_ALLOCATE, ST_ATTR_DECL, ST_BACKSPACE, ST_BLOCK_DATA,
+ ST_ARITHMETIC_IF, ST_ALLOCATE, ST_ATTR_DECL, 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_DATA, ST_ENDDO, ST_IMPLIED_ENDDO,
+ ST_ELSEWHERE, 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_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_IMPORT,
+ ST_INQUIRE, ST_INTERFACE,
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_WRITE, ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE,
ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT,
- ST_ENUM, ST_ENUMERATOR, ST_END_ENUM,
+ ST_ENUM, ST_ENUMERATOR, ST_END_ENUM, ST_SELECT_TYPE, ST_TYPE_IS, ST_CLASS_IS,
ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_CRITICAL,
ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED, ST_OMP_END_PARALLEL,
ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
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_OMP_TASKWAIT, ST_PROCEDURE, ST_GENERIC,
ST_GET_FCN_CHARACTERISTICS, ST_NONE
}
gfc_statement;
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;
enum gfc_isym_id
{
/* GFC_ISYM_NONE is used for intrinsics which will never be seen by
- the backend (eg. KIND). */
+ the backend (e.g. KIND). */
GFC_ISYM_NONE = 0,
GFC_ISYM_ABORT,
GFC_ISYM_ABS,
GFC_ISYM_EXIT,
GFC_ISYM_EXP,
GFC_ISYM_EXPONENT,
+ GFC_ISYM_EXTENDS_TYPE_OF,
GFC_ISYM_FDATE,
GFC_ISYM_FGET,
GFC_ISYM_FGETC,
GFC_ISYM_KILL,
GFC_ISYM_KIND,
GFC_ISYM_LBOUND,
+ GFC_ISYM_LEADZ,
GFC_ISYM_LEN,
GFC_ISYM_LEN_TRIM,
GFC_ISYM_LGAMMA,
GFC_ISYM_RESHAPE,
GFC_ISYM_RRSPACING,
GFC_ISYM_RSHIFT,
+ GFC_ISYM_SAME_TYPE_AS,
GFC_ISYM_SC_KIND,
GFC_ISYM_SCALE,
GFC_ISYM_SCAN,
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
}
that the list is initialized. */
extern CInteropKind_t c_interop_kinds_table[];
+
+/* Structure and list of supported extension attributes. */
+typedef enum
+{
+ EXT_ATTR_DLLIMPORT = 0,
+ EXT_ATTR_DLLEXPORT,
+ EXT_ATTR_STDCALL,
+ EXT_ATTR_CDECL,
+ EXT_ATTR_FASTCALL,
+ EXT_ATTR_LAST, EXT_ATTR_NUM = EXT_ATTR_LAST
+}
+ext_attr_id_t;
+
+typedef struct
+{
+ const char *name;
+ unsigned id;
+ const char *middle_end_name;
+}
+ext_attr_t;
+
+extern const ext_attr_t ext_attr_list[];
+
/* Symbol attribute structure. */
typedef struct
{
/* 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;
+ implied_index:1, subref_array_pointer:1, proc_pointer:1;
ENUM_BITFIELD (save_state) save:2;
unsigned data:1, /* Symbol is named in a DATA statement. */
- protected:1, /* Symbol has been marked as protected. */
+ is_protected:1, /* Symbol has been marked as protected. */
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. */
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 is_bind_c:1; /* say if is bound to C. */
+ 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. */
/* 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. zer_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;
+
+ /* 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;
#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;
}
gfc_charlen;
-#define gfc_get_charlen() gfc_getmem(sizeof(gfc_charlen))
+#define gfc_get_charlen() XCNEW (gfc_charlen)
-/* Type specification structure. FIXME: derived and cl could be union??? */
+/* Type specification structure. */
typedef struct
{
bt type;
int kind;
- struct gfc_symbol *derived;
- gfc_charlen *cl; /* For character types only. */
+
+ union
+ {
+ struct gfc_symbol *derived; /* For derived types only. */
+ gfc_charlen *cl; /* For character types only. */
+ }
+ u;
+
struct gfc_symbol *interface; /* For PROCEDURE declarations. */
int is_c_interop;
int is_iso_c;
}
gfc_array_spec;
-#define gfc_get_array_spec() gfc_getmem(sizeof(gfc_array_spec))
+#define gfc_get_array_spec() XCNEW (gfc_array_spec)
/* Components of derived types. */
const char *name;
gfc_typespec ts;
- int pointer, allocatable, dimension;
- gfc_access access;
+ symbol_attribute attr;
gfc_array_spec *as;
tree backend_decl;
locus loc;
struct gfc_expr *initializer;
struct gfc_component *next;
+
+ /* Needed for procedure pointer components. */
+ struct gfc_formal_arglist *formal;
+ struct gfc_namespace *formal_ns;
+ struct gfc_typebound_proc *tb;
}
gfc_component;
-#define gfc_get_component() gfc_getmem(sizeof(gfc_component))
+#define gfc_get_component() XCNEW (gfc_component)
/* Formal argument lists are lists of symbols. */
typedef struct gfc_formal_arglist
}
gfc_formal_arglist;
-#define gfc_get_formal_arglist() gfc_getmem(sizeof(gfc_formal_arglist))
+#define gfc_get_formal_arglist() XCNEW (gfc_formal_arglist)
/* The gfc_actual_arglist structure is for actual arguments. */
}
gfc_actual_arglist;
-#define gfc_get_actual_arglist() gfc_getmem(sizeof(gfc_actual_arglist))
+#define gfc_get_actual_arglist() XCNEW (gfc_actual_arglist)
/* Because a symbol can belong to multiple namelists, they must be
}
gfc_namelist;
-#define gfc_get_namelist() gfc_getmem(sizeof(gfc_namelist))
+#define gfc_get_namelist() XCNEW (gfc_namelist)
enum
{
/* 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_omp_clauses;
-#define gfc_get_omp_clauses() gfc_getmem(sizeof(gfc_omp_clauses))
+#define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses)
+
+/* The gfc_st_label structure is a BBT attached to a namespace that
+ records the usage of statement labels within that space. */
-/* 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. */
typedef struct gfc_st_label
{
BBT_HEADER(gfc_st_label);
}
gfc_interface;
-#define gfc_get_interface() gfc_getmem(sizeof(gfc_interface))
-
+#define gfc_get_interface() XCNEW (gfc_interface)
/* User operator nodes. These are like stripped down symbols. */
typedef struct
{
const char *name;
- gfc_interface *operator;
+ gfc_interface *op;
struct gfc_namespace *ns;
gfc_access access;
}
gfc_user_op;
+
+/* A list of specific bindings that are associated with a generic spec. */
+typedef struct gfc_tbp_generic
+{
+ /* The parser sets specific_st, upon resolution we look for the corresponding
+ gfc_typebound_proc and set specific for further use. */
+ struct gfc_symtree* specific_st;
+ struct gfc_typebound_proc* specific;
+
+ struct gfc_tbp_generic* next;
+}
+gfc_tbp_generic;
+
+#define gfc_get_tbp_generic() XCNEW (gfc_tbp_generic)
+
+
+/* Data needed for type-bound procedures. */
+typedef struct gfc_typebound_proc
+{
+ locus where; /* Where the PROCEDURE/GENERIC definition was. */
+
+ union
+ {
+ struct gfc_symtree* specific; /* The interface if DEFERRED. */
+ gfc_tbp_generic* generic;
+ }
+ u;
+
+ gfc_access access;
+ const char* pass_arg; /* Argument-name for PASS. NULL if not specified. */
+
+ /* The overridden type-bound proc (or GENERIC with this name in the
+ parent-type) or NULL if non. */
+ struct gfc_typebound_proc* overridden;
+
+ /* Once resolved, we use the position of pass_arg in the formal arglist of
+ the binding-target procedure to identify it. The first argument has
+ number 1 here, the second 2, and so on. */
+ unsigned pass_arg_num;
+
+ 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. */
+ unsigned ppc:1;
+}
+gfc_typebound_proc;
+
+
/* Symbol nodes. These are important things. They are what the
standard refers to as "entities". The possibly multiple names that
refer to the same entity are accomplished by a binary tree of
gfc_formal_arglist *formal;
struct gfc_namespace *formal_ns;
-
- /* The namespace containing type-associated procedure symbols. */
- /* TODO: Make this union with formal? */
struct gfc_namespace *f2k_derived;
struct gfc_expr *value; /* Parameter/Initializer value */
/* Defined only for Cray pointees; points to their pointer. */
struct gfc_symbol *cp_pointer;
+ int entry_id; /* Used in resolve.c for entries. */
+
+ /* CLASS hashed name for declared and dynamic types in the class. */
+ int hash_value;
+
struct gfc_symbol *common_next; /* Links for COMMON syms */
/* This is in fact a gfc_common_head but it is only used for pointer
order. */
int dummy_order;
- int entry_id;
-
gfc_namelist *namelist, *namelist_tail;
/* Change management fields. Symbols that might be modified by the
the old symbol. */
struct gfc_symbol *old_symbol, *tlink;
- unsigned mark:1, new:1;
+ unsigned mark:1, gfc_new:1;
/* Nonzero if all equivalences associated with this symbol have been
processed. */
unsigned equiv_built:1;
}
gfc_common_head;
-#define gfc_get_common_head() gfc_getmem(sizeof(gfc_common_head))
+#define gfc_get_common_head() XCNEW (gfc_common_head)
/* A list of all the alternate entry points for a procedure. */
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;
#define gfc_get_entry_list() \
(gfc_entry_list *) gfc_getmem(sizeof(gfc_entry_list))
+/* Lists of rename info for the USE statement. */
+
+typedef struct gfc_use_rename
+{
+ char local_name[GFC_MAX_SYMBOL_LEN + 1], use_name[GFC_MAX_SYMBOL_LEN + 1];
+ struct gfc_use_rename *next;
+ int found;
+ gfc_intrinsic_op op;
+ locus where;
+}
+gfc_use_rename;
+
+#define gfc_get_use_rename() XCNEW (gfc_use_rename);
+
+/* A list of all USE statements in a namespace. */
+
+typedef struct gfc_use_list
+{
+ const char *module_name;
+ int only_flag;
+ struct gfc_use_rename *rename;
+ locus where;
+ /* Next USE statement. */
+ struct gfc_use_list *next;
+}
+gfc_use_list;
+
+#define gfc_get_use_list() \
+ (gfc_use_list *) gfc_getmem(sizeof(gfc_use_list))
+
/* Within a namespace, symbols are pointed to by symtree nodes that
are linked together in a balanced binary tree. There can be
several symtrees pointing to the same symbol node via USE
gfc_symbol *sym; /* Symbol associated with this node */
gfc_user_op *uop;
gfc_common_head *common;
+ gfc_typebound_proc *tb;
}
n;
-
}
gfc_symtree;
}
gfc_dt_list;
-#define gfc_get_dt_list() gfc_getmem(sizeof(gfc_dt_list))
+#define gfc_get_dt_list() XCNEW (gfc_dt_list)
/* A list of all derived types. */
extern gfc_dt_list *gfc_derived_types;
-/* A namespace describes the contents of procedure, module or
- interface block. */
+/* A namespace describes the contents of procedure, module, interface block
+ or BLOCK construct. */
/* ??? Anything else use these? */
typedef struct gfc_namespace
gfc_symtree *uop_root;
/* Tree containing all the common blocks. */
gfc_symtree *common_root;
+
+ /* Tree containing type-bound procedures. */
+ gfc_symtree *tb_sym_root;
+ /* Type-bound user operators. */
+ gfc_symtree *tb_uop_root;
+ /* For derived-types, store type-bound intrinsic operators here. */
+ gfc_typebound_proc *tb_op[GFC_INTRINSIC_OPS];
/* Linked list of finalizer procedures. */
struct gfc_finalizer *finalizers;
int set_flag[GFC_LETTERS];
/* Keeps track of the implicit types associated with the letters. */
gfc_typespec default_type[GFC_LETTERS];
+ /* Store the positions of IMPLICIT statements. */
+ locus implicit_loc[GFC_LETTERS];
/* If this is a namespace of a procedure, this points to the procedure. */
struct gfc_symbol *proc_name;
/* Points to the equivalence groups produced by trans_common. */
struct gfc_equiv_list *equiv_lists;
- gfc_interface *operator[GFC_INTRINSIC_OPS];
+ gfc_interface *op[GFC_INTRINSIC_OPS];
/* Points to the parent namespace, i.e. the namespace of a module or
procedure in which the procedure belonging to this namespace is
this namespace. */
struct gfc_data *data;
- gfc_charlen *cl_list;
+ gfc_charlen *cl_list, *old_cl_list;
+
+ gfc_dt_list *derived_types;
int save_all, seen_save, seen_implicit_none;
/* A list of all alternate entry points to this procedure (or NULL). */
gfc_entry_list *entries;
+ /* A list of USE statements in this namespace. */
+ gfc_use_list *use_stmts;
+
/* Set to 1 if namespace is a BLOCK DATA program unit. */
- int is_block_data;
+ unsigned is_block_data:1;
/* Set to 1 if namespace is an interface body with "IMPORT" used. */
- int has_import_set;
+ unsigned has_import_set:1;
+
+ /* Set to 1 if resolved has been called for this namespace. */
+ unsigned resolved:1;
+
+ /* Set to 1 if code has been generated for this namespace. */
+ unsigned translated:1;
+
+ /* Set to 1 if symbols in this namespace should be 'construct entities',
+ i.e. for BLOCK local variables. */
+ unsigned construct_entities:1;
}
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_array_ref;
-#define gfc_get_array_ref() gfc_getmem(sizeof(gfc_array_ref))
+#define gfc_get_array_ref() XCNEW (gfc_array_ref)
/* Component reference nodes. A variable is stored as an expression
}
gfc_ref;
-#define gfc_get_ref() gfc_getmem(sizeof(gfc_ref))
+#define gfc_get_ref() XCNEW (gfc_ref)
/* Structures representing intrinsic symbols and their arguments lists. */
gfc_typespec ts;
int optional;
+ ENUM_BITFIELD (sym_intent) intent:2;
gfc_actual_arglist *actual;
struct gfc_intrinsic_arg *next;
typedef union
{
- try (*f0)(void);
- try (*f1)(struct gfc_expr *);
- try (*f1m)(gfc_actual_arglist *);
- try (*f2)(struct gfc_expr *, struct gfc_expr *);
- try (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
- try (*f3ml)(gfc_actual_arglist *);
- try (*f3red)(gfc_actual_arglist *);
- try (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
+ gfc_try (*f0)(void);
+ gfc_try (*f1)(struct gfc_expr *);
+ gfc_try (*f1m)(gfc_actual_arglist *);
+ gfc_try (*f2)(struct gfc_expr *, struct gfc_expr *);
+ gfc_try (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
+ gfc_try (*f3ml)(gfc_actual_arglist *);
+ gfc_try (*f3red)(gfc_actual_arglist *);
+ gfc_try (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
struct gfc_expr *);
- try (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
+ gfc_try (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
struct gfc_expr *, struct gfc_expr *);
}
gfc_check_f;
gfc_intrinsic_sym;
+typedef struct gfc_class_esym_list
+{
+ gfc_symbol *derived;
+ gfc_symbol *esym;
+ struct gfc_expr *hash_value;
+ 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:
EXPR_FUNCTION Function call, symbol points to function's name
EXPR_CONSTANT A scalar constant: Logical, String, Real, Int or Complex
EXPR_VARIABLE An Lvalue with a root symbol and possible reference list
- which expresses structure, array and substring refs.
+ which expresses structure, array and substring refs.
EXPR_NULL The NULL pointer value (which also has a basic type).
EXPR_SUBSTRING A substring of a constant string
EXPR_STRUCTURE A structure constructor
- EXPR_ARRAY An array constructor. */
+ EXPR_ARRAY An array constructor.
+ EXPR_COMPCALL Function (or subroutine) call of a procedure pointer
+ component or type-bound procedure. */
#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 struct gfc_expr
{
int rank;
mpz_t *shape; /* Can be NULL if shape is unknown at compile time */
- /* Nonnull for functions and structure constructors */
+ /* Nonnull for functions and structure constructors, may also used to hold the
+ base-object for component calls. */
gfc_symtree *symtree;
gfc_ref *ref;
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_intrinsic_op operator;
+ gfc_intrinsic_op op;
gfc_user_op *uop;
struct gfc_expr *op1, *op2;
}
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;
struct
{
+ gfc_actual_arglist* actual;
+ const char* name;
+ /* Base-object, whose component was called. NULL means that it should
+ be taken from symtree/ref. */
+ struct gfc_expr* base_object;
+ gfc_typebound_proc* tbp; /* Should overlap with esym. */
+
+ /* For type-bound operators, we want to call PASS procedures but already
+ have the full arglist; mark this, so that it is not extended by the
+ PASS argument. */
+ unsigned ignore_pass:1;
+
+ /* Do assign-calls rather than calls, that is appropriate dependency
+ checking. */
+ unsigned assign:1;
+ }
+ compcall;
+
+ struct
+ {
int length;
gfc_char_t *string;
}
}
gfc_equiv;
-#define gfc_get_equiv() gfc_getmem(sizeof(gfc_equiv))
+#define gfc_get_equiv() XCNEW (gfc_equiv)
/* Holds a single equivalence member after processing. */
typedef struct gfc_equiv_info
represents the default case. */
gfc_expr *low, *high;
+ /* Only used for SELECT TYPE. */
+ gfc_typespec ts;
+
/* Next case label in the list of cases for a single CASE label. */
struct gfc_case *next;
}
gfc_case;
-#define gfc_get_case() gfc_getmem(sizeof(gfc_case))
+#define gfc_get_case() XCNEW (gfc_case)
typedef struct
}
gfc_iterator;
-#define gfc_get_iterator() gfc_getmem(sizeof(gfc_iterator))
+#define gfc_get_iterator() XCNEW (gfc_iterator)
/* Allocation structure for ALLOCATE, DEALLOCATE and NULLIFY statements. */
}
gfc_alloc;
-#define gfc_get_alloc() gfc_getmem(sizeof(gfc_alloc))
+#define gfc_get_alloc() XCNEW (gfc_alloc)
typedef 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_GOTO, EXEC_CALL, 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_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_BLOCK,
+ EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT, EXEC_CALL_PPC,
+ EXEC_ALLOCATE, EXEC_DEALLOCATE, EXEC_END_PROCEDURE, EXEC_SELECT_TYPE,
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, *expr3;
/* 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
{
gfc_actual_arglist *actual;
gfc_case *case_list;
gfc_iterator *iterator;
- gfc_alloc *alloc_list;
+
+ struct
+ {
+ gfc_typespec ts;
+ gfc_alloc *list;
+ }
+ alloc;
+
gfc_open *open;
gfc_close *close;
gfc_filepos *filepos;
const char *omp_name;
gfc_namelist *omp_namelist;
bool omp_bool;
+ gfc_namespace *ns;
}
ext; /* Points to additional structures required by statement */
int warn_surprising;
int warn_tabs;
int warn_underflow;
+ int warn_intrinsic_shadow;
+ int warn_intrinsics_std;
int warn_character_truncation;
+ int warn_array_temp;
+ int warn_align_commons;
int max_errors;
int flag_all_intrinsics;
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_init_logical;
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 warn_nonstd_intrinsics;
- int fshort_enums;
int convert;
int record_marker;
int max_subrecord_length;
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
{
struct gfc_finalizer* next;
- gfc_symbol* procedure;
- locus where; /* Where the FINAL declaration occured. */
+ locus where; /* Where the FINAL declaration occurred. */
+
+ /* Up to resolution, we want the gfc_symbol, there we lookup the corresponding
+ symtree and later need only that. This way, we can access and call the
+ finalizers from every context as they should be "always accessible". I
+ don't make this a union because we need the information whether proc_sym is
+ still referenced or not for dereferencing it on deleting a gfc_finalizer
+ structure. */
+ gfc_symbol* proc_sym;
+ gfc_symtree* proc_tree;
}
gfc_finalizer;
+#define gfc_get_finalizer() XCNEW (gfc_finalizer)
+
/************************ Function prototypes *************************/
/* decl.c */
bool gfc_in_match_data (void);
+match gfc_match_char_spec (gfc_typespec *);
/* scanner.c */
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);
char *gfc_widechar_to_char (const gfc_char_t *, int);
gfc_char_t *gfc_char_to_widechar (const char *);
-#define gfc_get_wide_string(n) gfc_getmem((n) * sizeof(gfc_char_t))
+#define gfc_get_wide_string(n) XCNEWVEC (gfc_char_t, n)
void gfc_skip_comments (void);
gfc_char_t gfc_next_char_literal (int);
char gfc_peek_ascii_char (void);
void gfc_error_recovery (void);
void gfc_gobble_whitespace (void);
-try gfc_new_file (void);
+gfc_try gfc_new_file (void);
const char * gfc_read_orig_filename (const char *, const char **);
extern gfc_source_form gfc_current_form;
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 *);
int gfc_error_flag_test (void);
notification gfc_notification_std (int);
-try gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
+gfc_try gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
/* A general purpose syntax error. */
#define gfc_syntax_error(ST) \
void gfc_free_error (gfc_error_buf *);
void gfc_get_errors (int *, int *);
+void gfc_errors_to_warnings (int);
/* 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 */
-try gfc_validate_c_kind (gfc_typespec *);
-try gfc_check_any_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);
+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;
/* symbol.c */
void gfc_clear_new_implicit (void);
-try gfc_add_new_implicit_range (int, int);
-try gfc_merge_new_implicit (gfc_typespec *);
+gfc_try gfc_add_new_implicit_range (int, int);
+gfc_try gfc_merge_new_implicit (gfc_typespec *);
void gfc_set_implicit_none (void);
void gfc_check_function_type (gfc_namespace *);
bool gfc_is_intrinsic_typename (const char *);
-gfc_typespec *gfc_get_default_type (gfc_symbol *, gfc_namespace *);
-try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);
-
-void gfc_set_component_attr (gfc_component *, symbol_attribute *);
-void gfc_get_component_attr (symbol_attribute *, gfc_component *);
+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 *);
-try gfc_add_attribute (symbol_attribute *, locus *);
-try gfc_add_allocatable (symbol_attribute *, locus *);
-try gfc_add_dimension (symbol_attribute *, const char *, locus *);
-try gfc_add_external (symbol_attribute *, locus *);
-try gfc_add_intrinsic (symbol_attribute *, locus *);
-try gfc_add_optional (symbol_attribute *, locus *);
-try gfc_add_pointer (symbol_attribute *, locus *);
-try gfc_add_cray_pointer (symbol_attribute *, locus *);
-try gfc_add_cray_pointee (symbol_attribute *, locus *);
-try gfc_mod_pointee_as (gfc_array_spec *);
-try gfc_add_protected (symbol_attribute *, const char *, locus *);
-try gfc_add_result (symbol_attribute *, const char *, locus *);
-try gfc_add_save (symbol_attribute *, const char *, locus *);
-try gfc_add_threadprivate (symbol_attribute *, const char *, locus *);
-try gfc_add_saved_common (symbol_attribute *, locus *);
-try gfc_add_target (symbol_attribute *, locus *);
-try gfc_add_dummy (symbol_attribute *, const char *, locus *);
-try gfc_add_generic (symbol_attribute *, const char *, locus *);
-try gfc_add_common (symbol_attribute *, locus *);
-try gfc_add_in_common (symbol_attribute *, const char *, locus *);
-try gfc_add_in_equivalence (symbol_attribute *, const char *, locus *);
-try gfc_add_data (symbol_attribute *, const char *, locus *);
-try gfc_add_in_namelist (symbol_attribute *, const char *, locus *);
-try gfc_add_sequence (symbol_attribute *, const char *, locus *);
-try gfc_add_elemental (symbol_attribute *, locus *);
-try gfc_add_pure (symbol_attribute *, locus *);
-try gfc_add_recursive (symbol_attribute *, locus *);
-try gfc_add_function (symbol_attribute *, const char *, locus *);
-try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
-try gfc_add_volatile (symbol_attribute *, const char *, locus *);
-try gfc_add_proc (symbol_attribute *attr, const char *name, locus *where);
-
-try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
-try gfc_add_is_bind_c(symbol_attribute *, const char *, locus *, int);
-try gfc_add_value (symbol_attribute *, const char *, locus *);
-try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
-try gfc_add_entry (symbol_attribute *, const char *, locus *);
-try gfc_add_procedure (symbol_attribute *, procedure_type,
+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_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_optional (symbol_attribute *, locus *);
+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 *);
+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_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_dummy (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_generic (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_common (symbol_attribute *, locus *);
+gfc_try gfc_add_in_common (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_in_equivalence (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_data (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_in_namelist (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_sequence (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_elemental (symbol_attribute *, locus *);
+gfc_try gfc_add_pure (symbol_attribute *, locus *);
+gfc_try gfc_add_recursive (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_proc (symbol_attribute *attr, const char *name, locus *where);
+gfc_try gfc_add_abstract (symbol_attribute* attr, locus* where);
+
+gfc_try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
+gfc_try gfc_add_is_bind_c (symbol_attribute *, const char *, locus *, int);
+gfc_try gfc_add_extension (symbol_attribute *, locus *);
+gfc_try gfc_add_value (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
+gfc_try gfc_add_entry (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_procedure (symbol_attribute *, procedure_type,
const char *, locus *);
-try gfc_add_intent (symbol_attribute *, sym_intent, locus *);
-try gfc_add_explicit_interface (gfc_symbol *, ifsrc,
+gfc_try gfc_add_intent (symbol_attribute *, sym_intent, locus *);
+gfc_try gfc_add_explicit_interface (gfc_symbol *, ifsrc,
gfc_formal_arglist *, locus *);
-try gfc_add_type (gfc_symbol *, gfc_typespec *, locus *);
+gfc_try gfc_add_type (gfc_symbol *, gfc_typespec *, locus *);
void gfc_clear_attr (symbol_attribute *);
-try gfc_missing_attr (symbol_attribute *, locus *);
-try gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *);
+gfc_try gfc_missing_attr (symbol_attribute *, locus *);
+gfc_try gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *);
-try gfc_add_component (gfc_symbol *, const char *, gfc_component **);
+gfc_try gfc_add_component (gfc_symbol *, const char *, gfc_component **);
gfc_symbol *gfc_use_derived (gfc_symbol *);
gfc_symtree *gfc_use_derived_tree (gfc_symtree *);
-gfc_component *gfc_find_component (gfc_symbol *, const char *);
+gfc_component *gfc_find_component (gfc_symbol *, const char *, bool, bool);
gfc_st_label *gfc_get_st_label (int);
void gfc_free_st_label (gfc_st_label *);
void gfc_define_st_label (gfc_st_label *, gfc_sl_type, locus *);
-try gfc_reference_st_label (gfc_st_label *, gfc_sl_type);
+gfc_try gfc_reference_st_label (gfc_st_label *, gfc_sl_type);
gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
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 **);
-try verify_c_interop (gfc_typespec *, const char *name, locus *where);
-try verify_c_interop_param (gfc_symbol *);
-try verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *);
-try verify_bind_c_derived_type (gfc_symbol *);
-try verify_com_block_vars_c_interop (gfc_common_head *);
+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 *);
+gfc_try verify_com_block_vars_c_interop (gfc_common_head *);
void generate_isocbinding_symbol (const char *, iso_c_binding_symbol, const char *);
gfc_symbol *get_iso_c_sym (gfc_symbol *, char *, char *, int);
-int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **);
+int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **, bool);
int gfc_get_ha_symbol (const char *, gfc_symbol **);
int gfc_get_ha_sym_tree (const char *, gfc_symtree **);
void gfc_undo_symbols (void);
void gfc_commit_symbols (void);
void gfc_commit_symbol (gfc_symbol *);
+gfc_charlen *gfc_new_charlen (gfc_namespace *, gfc_charlen *);
+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 *);
-void copy_formal_args (gfc_symbol *dest, gfc_symbol *src);
+gfc_try gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
+ gfc_array_spec **);
+gfc_symbol *gfc_find_derived_vtab (gfc_symbol *);
+gfc_typebound_proc* gfc_get_typebound_proc (void);
+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_copy_formal_args_ppc (gfc_component *, gfc_symbol *);
void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.c, too */
+gfc_try gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus);
+
/* intrinsic.c */
extern int gfc_init_expr;
char gfc_type_letter (bt);
gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *);
-try gfc_convert_type (gfc_expr *, gfc_typespec *, int);
-try gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int);
-try gfc_convert_chartype (gfc_expr *, gfc_typespec *);
+gfc_try gfc_convert_type (gfc_expr *, gfc_typespec *, int);
+gfc_try gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int);
+gfc_try gfc_convert_chartype (gfc_expr *, gfc_typespec *);
int gfc_generic_intrinsic (const char *);
int gfc_specific_intrinsic (const char *);
-int gfc_intrinsic_name (const char *, int);
+bool gfc_is_intrinsic (gfc_symbol*, int, locus);
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 *);
match gfc_intrinsic_func_interface (gfc_expr *, int);
match gfc_intrinsic_sub_interface (gfc_code *, int);
+void gfc_warn_intrinsic_shadow (const gfc_symbol*, bool, bool);
+gfc_try gfc_check_intrinsic_standard (const gfc_intrinsic_sym*, const char**,
+ bool, locus);
+
/* match.c -- FIXME */
void gfc_free_iterator (gfc_iterator *, int);
void gfc_free_forall_iterator (gfc_forall_iterator *);
void gfc_free_actual_arglist (gfc_actual_arglist *);
gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
const char *gfc_extract_int (gfc_expr *, int *);
-gfc_expr *gfc_expr_to_initialize (gfc_expr *);
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 *);
int gfc_is_constant_expr (gfc_expr *);
-try gfc_simplify_expr (gfc_expr *, int);
+gfc_try gfc_simplify_expr (gfc_expr *, int);
int gfc_has_vector_index (gfc_expr *);
gfc_expr *gfc_get_expr (void);
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_ref* gfc_copy_ref (gfc_ref*);
-try gfc_specification_expr (gfc_expr *);
+gfc_try gfc_specification_expr (gfc_expr *);
int gfc_numeric_ts (gfc_typespec *);
int gfc_kind_max (gfc_expr *, gfc_expr *);
-try gfc_check_conformance (const char *, gfc_expr *, gfc_expr *);
-try gfc_check_assign (gfc_expr *, gfc_expr *, int);
-try gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
-try gfc_check_assign_symbol (gfc_symbol *, 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_expr *gfc_default_initializer (gfc_typespec *);
gfc_expr *gfc_get_variable_expr (gfc_symtree *);
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 *);
+void gfc_expr_replace_comp (gfc_expr *, gfc_component *);
+
+bool gfc_is_proc_ptr_comp (gfc_expr *, gfc_component **);
/* st.c */
extern gfc_code new_st;
void gfc_free_statements (gfc_code *);
/* resolve.c */
-try gfc_resolve_expr (gfc_expr *);
+gfc_try gfc_resolve_expr (gfc_expr *);
void gfc_resolve (gfc_namespace *);
void gfc_resolve_blocks (gfc_code *, gfc_namespace *);
int gfc_impure_variable (gfc_symbol *);
int gfc_pure (gfc_symbol *);
int gfc_elemental (gfc_symbol *);
-try gfc_resolve_iterator (gfc_iterator *, bool);
-try find_forall_index (gfc_expr *, gfc_symbol *, int);
-try gfc_resolve_index (gfc_expr *, int);
-try gfc_resolve_dim_arg (gfc_expr *);
+gfc_try gfc_resolve_iterator (gfc_iterator *, bool);
+gfc_try find_forall_index (gfc_expr *, gfc_symbol *, int);
+gfc_try gfc_resolve_index (gfc_expr *, int);
+gfc_try gfc_resolve_dim_arg (gfc_expr *);
int gfc_is_formal_arg (void);
void gfc_resolve_substring_charlen (gfc_expr *);
match gfc_iso_c_sub_interface(gfc_code *, gfc_symbol *);
+gfc_expr *gfc_expr_to_initialize (gfc_expr *);
+bool gfc_type_is_extensible (gfc_symbol *sym);
/* array.c */
void gfc_free_array_spec (gfc_array_spec *);
gfc_array_ref *gfc_copy_array_ref (gfc_array_ref *);
-try gfc_set_array_spec (gfc_symbol *, gfc_array_spec *, locus *);
+gfc_try gfc_set_array_spec (gfc_symbol *, gfc_array_spec *, locus *);
gfc_array_spec *gfc_copy_array_spec (gfc_array_spec *);
-try gfc_resolve_array_spec (gfc_array_spec *, int);
+gfc_try gfc_resolve_array_spec (gfc_array_spec *, int);
int gfc_compare_array_spec (gfc_array_spec *, gfc_array_spec *);
void gfc_append_constructor (gfc_expr *, gfc_expr *);
void gfc_free_constructor (gfc_constructor *);
void gfc_simplify_iterator_var (gfc_expr *);
-try gfc_expand_constructor (gfc_expr *);
+gfc_try gfc_expand_constructor (gfc_expr *);
int gfc_constant_ac (gfc_expr *);
int gfc_expanded_ac (gfc_expr *);
-try gfc_resolve_character_array_constructor (gfc_expr *);
-try gfc_resolve_array_constructor (gfc_expr *);
-try gfc_check_constructor_type (gfc_expr *);
-try gfc_check_iter_variable (gfc_expr *);
-try gfc_check_constructor (gfc_expr *, try (*)(gfc_expr *));
+gfc_try gfc_resolve_character_array_constructor (gfc_expr *);
+gfc_try gfc_resolve_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);
-try gfc_array_size (gfc_expr *, mpz_t *);
-try gfc_array_dimen_size (gfc_expr *, int, mpz_t *);
-try gfc_array_ref_shape (gfc_array_ref *, mpz_t *);
+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 *);
-try spec_size (gfc_array_spec *, mpz_t *);
-try spec_dimen_size (gfc_array_spec *, int, mpz_t *);
+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 *);
+
+
/* 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*, const char *, int, int,
+ char *, int);
void gfc_check_interfaces (gfc_namespace *);
void gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *);
+void gfc_ppc_use (gfc_component *, gfc_actual_arglist **, locus *);
gfc_symbol *gfc_search_interface (gfc_interface *, int,
gfc_actual_arglist **);
-try gfc_extend_expr (gfc_expr *);
+gfc_try gfc_extend_expr (gfc_expr *, bool *);
void gfc_free_formal_arglist (gfc_formal_arglist *);
-try gfc_extend_assign (gfc_code *, gfc_namespace *);
-try gfc_add_interface (gfc_symbol *);
+gfc_try gfc_extend_assign (gfc_code *, gfc_namespace *);
+gfc_try gfc_add_interface (gfc_symbol *);
gfc_interface *gfc_current_interface_head (void);
void gfc_set_current_interface_head (gfc_interface *);
+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);
/* io.c */
extern gfc_st_label format_asterisk;
void gfc_free_open (gfc_open *);
-try gfc_resolve_open (gfc_open *);
+gfc_try gfc_resolve_open (gfc_open *);
void gfc_free_close (gfc_close *);
-try gfc_resolve_close (gfc_close *);
+gfc_try gfc_resolve_close (gfc_close *);
void gfc_free_filepos (gfc_filepos *);
-try gfc_resolve_filepos (gfc_filepos *);
+gfc_try gfc_resolve_filepos (gfc_filepos *);
void gfc_free_inquire (gfc_inquire *);
-try gfc_resolve_inquire (gfc_inquire *);
+gfc_try gfc_resolve_inquire (gfc_inquire *);
void gfc_free_dt (gfc_dt *);
-try gfc_resolve_dt (gfc_dt *);
+gfc_try gfc_resolve_dt (gfc_dt *, locus *);
void gfc_free_wait (gfc_wait *);
-try gfc_resolve_wait (gfc_wait *);
+gfc_try gfc_resolve_wait (gfc_wait *);
/* module.c */
void gfc_module_init_2 (void);
void gfc_module_done_2 (void);
void gfc_dump_module (const char *, int);
bool gfc_check_access (gfc_access, gfc_access);
+void gfc_free_use_stmts (gfc_use_list *);
/* primary.c */
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, 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 *);
void gfc_dump_parse_tree (gfc_namespace *, FILE *);
/* parse.c */
-try gfc_parse_file (void);
+gfc_try gfc_parse_file (void);
void gfc_global_used (gfc_gsymbol *, locus *);
/* 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 */