/* gfortran header file
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+ 2009, 2010
Free Software Foundation, Inc.
Contributed by Andy Vaught
GCC is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
-Software Foundation; either version 2, or (at your option) any later
+Software Foundation; either version 3, or (at your option) any later
version.
GCC is distributed in the hope that it will be useful, but WITHOUT ANY
for more details.
You should have received a copy of the GNU General Public License
-along with GCC; see the file COPYING. If not, write to the Free
-Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA. */
+along with GCC; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
#ifndef GCC_GFORTRAN_H
#define GCC_GFORTRAN_H
multiple header files. Besides, Microsoft's winnt.h was 250k last
time I looked, so by comparison this is perfectly reasonable. */
+/* Declarations common to the front-end and library are put in
+ libgfortran/libgfortran_frontend.h */
+#include "libgfortran.h"
+
+
#include "system.h"
#include "intl.h"
#include "coretypes.h"
#define GFC_MAX_SYMBOL_LEN 63 /* Must be at least 63 for F2003. */
#define GFC_MAX_BINDING_LABEL_LEN 126 /* (2 * GFC_MAX_SYMBOL_LEN) */
#define GFC_MAX_LINE 132 /* Characters beyond this are not seen. */
-#define GFC_MAX_DIMENSIONS 7 /* Maximum dimensions in an array. */
#define GFC_LETTERS 26 /* Number of letters in the alphabet. */
#define MAX_SUBRECORD_LENGTH 2147483639 /* 2**31-9 */
#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. */
mstring;
-/* Flags to specify which standard/extension contains a feature. */
-#define GFC_STD_LEGACY (1<<6) /* Backward compatibility. */
-#define GFC_STD_GNU (1<<5) /* GNU Fortran extension. */
-#define GFC_STD_F2003 (1<<4) /* New in F2003. */
-/* Note that no additional features were deleted or made obsolescent
- in F2003. */
-#define GFC_STD_F95 (1<<3) /* New in F95. */
-#define GFC_STD_F95_DEL (1<<2) /* Deleted in F95. */
-#define GFC_STD_F95_OBS (1<<1) /* Obsolescent in F95. */
-#define GFC_STD_F77 (1<<0) /* Included in F77, but not
- deleted or obsolescent in
- later standards. */
-
-/* Bitmasks for the various FPE that can be enabled. */
-#define GFC_FPE_INVALID (1<<0)
-#define GFC_FPE_DENORMAL (1<<1)
-#define GFC_FPE_ZERO (1<<2)
-#define GFC_FPE_OVERFLOW (1<<3)
-#define GFC_FPE_UNDERFLOW (1<<4)
-#define GFC_FPE_PRECISION (1<<5)
-
-/* Keep this in sync with libgfortran/io/io.h ! */
-typedef enum
- { CONVERT_NATIVE=0, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE }
-options_convert;
+/*************************** Enums *****************************/
+/* Used when matching and resolving data I/O transfer statements. */
-/*************************** Enums *****************************/
+typedef enum
+{ M_READ, M_WRITE, M_PRINT, M_INQUIRE }
+io_kind;
/* The author remains confused to this day about the convention of
returning '0' for 'SUCCESS'... or was it the other way around? The
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
{ FORM_FREE, FORM_FIXED, FORM_UNKNOWN }
gfc_source_form;
-/* Basic types. BT_VOID is used by ISO C BInding so funcs like c_f_pointer
+/* 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;
gfc_intrinsic_op;
-/* Strings for all intrinsic operators. */
-extern mstring intrinsic_operators[];
-
-
/* This macro is the number of intrinsic operators that exist.
Assumptions are made about the numbering of the interface_op enums. */
#define GFC_INTRINSIC_OPS GFC_INTRINSIC_END
/* 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_END_FILE, ST_FLUSH, ST_END_FORALL, ST_END_FUNCTION, ST_ENDIF,
+ 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_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_WRITE,
- ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE,
+ 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_END_WORKSHARE, ST_OMP_DO, ST_OMP_FLUSH, ST_OMP_MASTER, ST_OMP_ORDERED,
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_NONE
+ ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_OMP_TASK, ST_OMP_END_TASK,
+ ST_OMP_TASKWAIT, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
+ ST_GET_FCN_CHARACTERISTICS, ST_NONE
}
gfc_statement;
typedef enum
{
INTERFACE_NAMELESS = 1, INTERFACE_GENERIC,
- INTERFACE_INTRINSIC_OP, INTERFACE_USER_OP
+ INTERFACE_INTRINSIC_OP, INTERFACE_USER_OP, INTERFACE_ABSTRACT
}
interface_type;
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_EPSILON,
GFC_ISYM_ERF,
GFC_ISYM_ERFC,
+ GFC_ISYM_ERFC_SCALED,
GFC_ISYM_ETIME,
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_FSEEK,
GFC_ISYM_FSTAT,
GFC_ISYM_FTELL,
+ GFC_ISYM_TGAMMA,
GFC_ISYM_GERROR,
GFC_ISYM_GETARG,
GFC_ISYM_GET_COMMAND,
GFC_ISYM_GMTIME,
GFC_ISYM_HOSTNM,
GFC_ISYM_HUGE,
+ GFC_ISYM_HYPOT,
GFC_ISYM_IACHAR,
GFC_ISYM_IAND,
GFC_ISYM_IARGC,
GFC_ISYM_IDATE,
GFC_ISYM_IEOR,
GFC_ISYM_IERRNO,
+ GFC_ISYM_IMAGE_INDEX,
GFC_ISYM_INDEX,
GFC_ISYM_INT,
GFC_ISYM_INT2,
GFC_ISYM_IOR,
GFC_ISYM_IRAND,
GFC_ISYM_ISATTY,
+ GFC_ISYM_IS_IOSTAT_END,
+ GFC_ISYM_IS_IOSTAT_EOR,
+ GFC_ISYM_ISNAN,
GFC_ISYM_ISHFT,
GFC_ISYM_ISHFTC,
GFC_ISYM_ITIME,
GFC_ISYM_KILL,
GFC_ISYM_KIND,
GFC_ISYM_LBOUND,
+ GFC_ISYM_LCOBOUND,
+ GFC_ISYM_LEADZ,
GFC_ISYM_LEN,
GFC_ISYM_LEN_TRIM,
+ GFC_ISYM_LGAMMA,
GFC_ISYM_LGE,
GFC_ISYM_LGT,
GFC_ISYM_LINK,
GFC_ISYM_NINT,
GFC_ISYM_NOT,
GFC_ISYM_NULL,
+ GFC_ISYM_NUMIMAGES,
GFC_ISYM_OR,
GFC_ISYM_PACK,
GFC_ISYM_PERROR,
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_SECNDS,
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_TRAILZ,
GFC_ISYM_TRANSFER,
GFC_ISYM_TRANSPOSE,
GFC_ISYM_TRIM,
GFC_ISYM_TTYNAM,
GFC_ISYM_UBOUND,
+ GFC_ISYM_UCOBOUND,
GFC_ISYM_UMASK,
GFC_ISYM_UNLINK,
GFC_ISYM_UNPACK,
};
typedef enum gfc_isym_id gfc_isym_id;
-/* Runtime errors. The EOR and EOF errors are required to be negative.
- These codes must be kept synchronized with their equivalents in
- libgfortran/libgfortran.h . */
typedef enum
{
- IOERROR_FIRST = -3, /* Marker for the first error. */
- IOERROR_EOR = -2,
- IOERROR_END = -1,
- IOERROR_OK = 0, /* Indicates success, must be zero. */
- IOERROR_OS = 5000, /* Operating system error, more info in errno. */
- IOERROR_OPTION_CONFLICT,
- IOERROR_BAD_OPTION,
- IOERROR_MISSING_OPTION,
- IOERROR_ALREADY_OPEN,
- IOERROR_BAD_UNIT,
- IOERROR_FORMAT,
- IOERROR_BAD_ACTION,
- IOERROR_ENDFILE,
- IOERROR_BAD_US,
- IOERROR_READ_VALUE,
- IOERROR_READ_OVERFLOW,
- IOERROR_INTERNAL,
- IOERROR_INTERNAL_UNIT,
- IOERROR_ALLOCATION,
- IOERROR_DIRECT_EOR,
- IOERROR_SHORT_RECORD,
- IOERROR_CORRUPT_FILE,
- IOERROR_LAST /* Not a real error, the last error # + 1. */
-}
-ioerror_codes;
+ 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
+}
+init_local_real;
+typedef enum
+{
+ GFC_INIT_LOGICAL_OFF = 0,
+ GFC_INIT_LOGICAL_FALSE,
+ GFC_INIT_LOGICAL_TRUE
+}
+init_local_logical;
+
+typedef enum
+{
+ GFC_INIT_CHARACTER_OFF = 0,
+ GFC_INIT_CHARACTER_ON
+}
+init_local_character;
+
+typedef enum
+{
+ GFC_INIT_INTEGER_OFF = 0,
+ GFC_INIT_INTEGER_ON
+}
+init_local_integer;
+
+typedef enum
+{
+ GFC_FCOARRAY_NONE = 0,
+ GFC_FCOARRAY_SINGLE
+}
+gfc_fcoarray;
/************************* Structures *****************************/
/* Used for keeping things in balanced binary trees. */
#define BBT_HEADER(self) int priority; struct self *left, *right
-#define NAMED_INTCST(a,b,c) a,
+#define NAMED_INTCST(a,b,c,d) a,
typedef enum
{
ISOFORTRANENV_INVALID = -1,
iso_fortran_env_symbol;
#undef NAMED_INTCST
-#define NAMED_INTCST(a,b,c) a,
+#define NAMED_INTCST(a,b,c,d) a,
#define NAMED_REALCST(a,b,c) a,
#define NAMED_CMPXCST(a,b,c) a,
#define NAMED_LOGCST(a,b,c) a,
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,
+ 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;
+ 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 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_only:1, /* Symbol has been use-associated, with ONLY. */
+ use_rename:1, /* Symbol has been use-associated and renamed. */
+ imported:1; /* Symbol has been associated by IMPORT. */
unsigned in_namelist:1, in_common:1, in_equivalence:1;
- unsigned function:1, subroutine:1, generic:1, generic_copy: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 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, 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
/* Function/subroutine attributes */
unsigned sequence:1, elemental:1, pure:1, recursive:1;
- unsigned unmaskable:1, masked:1, contained:1, mod_proc:1;
+ unsigned unmaskable:1, masked:1, contained:1, mod_proc:1, abstract:1;
/* This is set if the subroutine doesn't return. Currently, this
is only possible for intrinsic subroutines. */
modification of type or type parameters is permitted. */
unsigned referenced:1;
- /* Set if the symbol has ambiguous interfaces. */
- unsigned ambiguous_interfaces:1;
-
- /* Set if the is the symbol for the main program. This is the least
- cumbersome way to communicate this function property without
- strcmp'ing with __MAIN everywhere. */
+ /* Set if this is the symbol for the main program. */
unsigned is_main_program:1;
/* Mutually exclusive multibit attributes. */
/* Special attributes for Cray pointers, pointees. */
unsigned cray_pointer:1, cray_pointee:1;
- /* The symbol is a derived type with allocatable components, possibly
- nested. */
- unsigned alloc_comp:1;
+ /* The symbol is a derived type with allocatable components, pointer
+ 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, coarray_comp:1;
- /* The namespace where the VOLATILE attribute has been set. */
- struct gfc_namespace *volatile_ns;
+ /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */
+ unsigned ext_attr:EXT_ATTR_NUM;
+
+ /* The namespace where the attribute has been set. */
+ struct gfc_namespace *volatile_ns, *asynchronous_ns;
}
symbol_attribute;
+/* We need to store source lines as sequences of multibyte source
+ characters. We define here a type wide enough to hold any multibyte
+ source character, just like libcpp does. A 32-bit type is enough. */
+
+#if HOST_BITS_PER_INT >= 32
+typedef unsigned int gfc_char_t;
+#elif HOST_BITS_PER_LONG >= 32
+typedef unsigned long gfc_char_t;
+#elif defined(HAVE_LONG_LONG) && (HOST_BITS_PER_LONGLONG >= 32)
+typedef unsigned long long gfc_char_t;
+#else
+# error "Cannot find an integer type with at least 32 bits"
+#endif
+
+
/* The following three structures are used to identify a location in
the sources.
typedef struct gfc_file
{
- struct gfc_file *included_by, *next, *up;
+ struct gfc_file *next, *up;
int inclusion_line, line;
char *filename;
} gfc_file;
typedef struct gfc_linebuf
{
-#ifdef USE_MAPPED_LOCATION
source_location location;
-#else
- int linenum;
-#endif
struct gfc_file *file;
struct gfc_linebuf *next;
int truncated;
+ bool dbg_emitted;
- char line[1];
+ gfc_char_t line[1];
} gfc_linebuf;
#define gfc_linebuf_header_size (offsetof (gfc_linebuf, line))
+#define gfc_linebuf_linenum(LBUF) (LOCATION_LINE ((LBUF)->location))
+
typedef struct
{
- char *nextc;
+ gfc_char_t *nextc;
gfc_linebuf *lb;
} locus;
#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_expr *length;
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;
bt f90_type;
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. */
}
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
- } 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
- } default_sharing;
- bool nowait, ordered;
+ 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 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);
}
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_typespec ts;
symbol_attribute attr;
- /* The interface member points to the formal argument list if the
+ /* The formal member points to the formal argument list if the
symbol is a function or subroutine name. If the symbol is a
generic name, the generic member points to the list of
interfaces. */
gfc_formal_arglist *formal;
struct gfc_namespace *formal_ns;
+ struct gfc_namespace *f2k_derived;
struct gfc_expr *value; /* Parameter/Initializer value */
gfc_array_spec *as;
/* 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
/* 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;
+
/* If set_flag[letter] is set, an implicit type has been set for letter. */
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.
+ Holds -1 during resolution. */
+ signed resolved:2;
+
+ /* 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_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;
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;
const char *name, *lib_name;
gfc_intrinsic_arg *formal;
gfc_typespec ts;
- int elemental, pure, generic, specific, actual_ok, standard, noreturn;
+ unsigned elemental:1, inquiry:1, transformational:1, pure:1,
+ generic:1, specific:1, actual_ok:1, noreturn:1, conversion:1;
+
+ int standard;
gfc_simplify_f simplify;
gfc_check_f check;
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>
+#include <mpc.h>
#define GFC_RND_MODE GMP_RNDN
+#define GFC_MPC_RND_MODE MPC_RNDNN
+
+typedef splay_tree gfc_constructor_base;
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;
-
- /* Used to quickly find a given constructor by its offset. */
- splay_tree con_by_offset;
+ 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;
/* If an expression comes from a Hollerith constant or compile-time
evaluation of a transfer statement, it may have a prescribed target-
{
int logical;
+ io_kind iokind;
+
mpz_t integer;
mpfr_t real;
- struct
- {
- mpfr_t r, i;
- }
- complex;
+ mpc_t complex;
struct
{
- gfc_intrinsic_op operator;
+ gfc_intrinsic_op op;
gfc_user_op *uop;
struct gfc_expr *op1, *op2;
}
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;
- char *string;
+ gfc_char_t *string;
}
character;
- struct gfc_constructor *constructor;
+ gfc_constructor_base constructor;
}
value;
extern gfc_real_info gfc_real_kinds[];
+typedef struct
+{
+ int kind, bit_size;
+ const char *name;
+}
+gfc_character_info;
+
+extern gfc_character_info gfc_character_kinds[];
+
/* Equivalence structures. Equivalent lvalues are linked along the
*eq pointer, equivalence sets are strung along the *next node. */
}
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;
+ *blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert,
+ *decimal, *encoding, *round, *sign, *asynchronous, *id, *newunit;
gfc_st_label *err;
}
gfc_open;
gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named,
*name, *access, *sequential, *direct, *form, *formatted,
*unformatted, *recl, *nextrec, *blank, *position, *action, *read,
- *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos;
+ *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos,
+ *asynchronous, *decimal, *encoding, *pending, *round, *sign, *size, *id;
gfc_st_label *err;
typedef struct
{
- gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg;
+ gfc_expr *unit, *iostat, *iomsg, *id;
+ gfc_st_label *err, *end, *eor;
+}
+gfc_wait;
+
+
+typedef struct
+{
+ gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg,
+ *id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round,
+ *sign, *extra_comma;
gfc_symbol *namelist;
/* A format_label of `format_asterisk' indicates the "*" format */
/* 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_OPEN, EXEC_CLOSE,
+ EXEC_NOP = 1, EXEC_END_BLOCK, EXEC_ASSIGN, EXEC_LABEL_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,
EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE,
EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT,
- EXEC_OMP_END_SINGLE
+ EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TASKWAIT
}
gfc_exec_op;
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;
gfc_inquire *inquire;
+ gfc_wait *wait;
gfc_dt *dt;
gfc_forall_iterator *forall_iterator;
struct gfc_code *whichloop;
const char *omp_name;
gfc_namelist *omp_namelist;
bool omp_bool;
+ gfc_namespace *ns;
}
ext; /* Points to additional structures required by statement */
typedef struct gfc_data_value
{
- unsigned int repeat;
+ mpz_t repeat;
gfc_expr *expr;
struct gfc_data_value *next;
}
}
gfc_data;
-#define gfc_get_data_variable() gfc_getmem(sizeof(gfc_data_variable))
-#define gfc_get_data_value() gfc_getmem(sizeof(gfc_data_value))
-#define gfc_get_data() gfc_getmem(sizeof(gfc_data))
-
/* Structure for holding compile options */
typedef struct
int max_continue_fixed;
int max_continue_free;
int max_identifier_length;
- int verbose;
+ int dump_parse_tree;
int warn_aliasing;
int warn_ampersand;
int warn_conversion;
int warn_implicit_interface;
+ int warn_implicit_procedure;
int warn_line_truncation;
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_cray_pointer;
int flag_d_lines;
int flag_openmp;
+ int flag_sign_zero;
+ int flag_module_private;
+ int flag_recursive;
+ int flag_init_local_zero;
+ int flag_init_integer;
+ int flag_init_integer_value;
+ int flag_init_real;
+ int flag_init_logical;
+ int flag_init_character;
+ 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;
- int warn_nonstd_intrinsics;
- int fshort_enums;
int convert;
int record_marker;
int max_subrecord_length;
/* 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;
iterator_stack;
extern iterator_stack *iter_stack;
-/************************ Function prototypes *************************/
-/* data.c */
-void gfc_formalize_init_value (gfc_symbol *);
-void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *);
-try gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t);
-void gfc_assign_data_value_range (gfc_expr *, gfc_expr *, mpz_t, mpz_t);
-void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *);
+/* 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;
+ 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);
-void gfc_set_in_match_data (bool);
+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);
int gfc_at_eol (void);
void gfc_advance_line (void);
int gfc_check_include (void);
+int gfc_define_undef_line (void);
+
+int gfc_wide_is_printable (gfc_char_t);
+int gfc_wide_is_digit (gfc_char_t);
+int gfc_wide_fits_in_byte (gfc_char_t);
+gfc_char_t gfc_wide_tolower (gfc_char_t);
+gfc_char_t gfc_wide_toupper (gfc_char_t);
+size_t gfc_wide_strlen (const gfc_char_t *);
+int gfc_wide_strncasecmp (const gfc_char_t *, const char *, size_t);
+gfc_char_t *gfc_wide_memset (gfc_char_t *, gfc_char_t, size_t);
+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) XCNEWVEC (gfc_char_t, n)
void gfc_skip_comments (void);
-int gfc_next_char_literal (int);
-int gfc_next_char (void);
-int gfc_peek_char (void);
+gfc_char_t gfc_next_char_literal (int);
+gfc_char_t gfc_next_char (void);
+char gfc_next_ascii_char (void);
+gfc_char_t gfc_peek_char (void);
+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;
extern const char *gfc_source_file;
extern locus gfc_current_locus;
+void gfc_start_source_files (void);
+void gfc_end_source_files (void);
+
/* misc.c */
void *gfc_getmem (size_t) ATTRIBUTE_MALLOC;
void gfc_free (void *);
FILE *gfc_open_file (const char *);
const char *gfc_basic_typename (bt);
const char *gfc_typename (gfc_typespec *);
-
-#define gfc_op2string(OP) (OP == INTRINSIC_ASSIGN ? \
- "=" : gfc_code2string (intrinsic_operators, OP))
-
+const char *gfc_op2string (gfc_intrinsic_op);
const char *gfc_code2string (const mstring *, int);
int gfc_string2code (const mstring *, const char *);
const char *gfc_intent_string (sym_intent);
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 *);
/* error.c */
void gfc_error_init_1 (void);
void gfc_buffer_error (int);
+const char *gfc_print_wide_char (gfc_char_t);
+
void gfc_warning (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
void gfc_warning_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
void gfc_clear_warning (void);
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_pop_error (gfc_error_buf *);
void gfc_free_error (gfc_error_buf *);
-void gfc_status (const char *, ...) ATTRIBUTE_PRINTF_1;
-void gfc_status_char (char);
-
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_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_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_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_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_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 *);
gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
+void gfc_delete_symtree (gfc_symtree **, const char *);
+gfc_symtree *gfc_get_unique_symtree (gfc_namespace *);
gfc_user_op *gfc_get_uop (const char *);
gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
void gfc_free_symbol (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 *);
-void generate_isocbinding_symbol (const char *, iso_c_binding_symbol, char *);
+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 *);
+gfc_try gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
+ gfc_array_spec **, bool);
+gfc_symbol *gfc_find_derived_vtab (gfc_symbol *, bool);
+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);
+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 *);
+void gfc_type_convert_binary (gfc_expr *, int);
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);
+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_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 *);
+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);
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 **);
+
+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;
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 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 */
+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 *);
-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 *);
-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 *);
-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 *);
-void 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_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_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_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 *);
+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_delete_bbt (void *, void *, compare_fn);
/* dump-parse-tree.c */
-void gfc_show_actual_arglist (gfc_actual_arglist *);
-void gfc_show_array_ref (gfc_array_ref *);
-void gfc_show_array_spec (gfc_array_spec *);
-void gfc_show_attr (symbol_attribute *);
-void gfc_show_code (int, gfc_code *);
-void gfc_show_components (gfc_symbol *);
-void gfc_show_constructor (gfc_constructor *);
-void gfc_show_equiv (gfc_equiv *);
-void gfc_show_expr (gfc_expr *);
-void gfc_show_namelist (gfc_namelist *);
-void gfc_show_namespace (gfc_namespace *);
-void gfc_show_ref (gfc_ref *);
-void gfc_show_symbol (gfc_symbol *);
-void gfc_show_typespec (gfc_typespec *);
+void gfc_dump_parse_tree (gfc_namespace *, FILE *);
/* parse.c */
-try gfc_parse_file (void);
-void global_used (gfc_gsymbol *, locus *);
+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 */
OSDN Git Service
