time I looked, so by comparison this is perfectly reasonable. */
#include "system.h"
+#include "intl.h"
#include "coretypes.h"
#include "input.h"
#define PREFIX(x) "_gfortran_" x
#define PREFIX_LEN 10
+#define BLANK_COMMON_NAME "__BLNK__"
+
/* Macro to initialize an mstring structure. */
#define minit(s, t) { s, NULL, t }
#define GFC_STD_F95_OBS (1<<1) /* Obsoleted in F95. */
#define GFC_STD_F77 (1<<0) /* Up to and including F77. */
+/* 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)
+
+
/*************************** Enums *****************************/
/* The author remains confused to this day about the convention of
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_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT,
- ST_NONE
+ ST_ENUM, ST_ENUMERATOR, ST_END_ENUM, ST_NONE
}
gfc_statement;
GFC_ISYM_ALL,
GFC_ISYM_ALLOCATED,
GFC_ISYM_ANINT,
+ GFC_ISYM_AND,
GFC_ISYM_ANY,
GFC_ISYM_ASIN,
GFC_ISYM_ASINH,
GFC_ISYM_CHDIR,
GFC_ISYM_CMPLX,
GFC_ISYM_COMMAND_ARGUMENT_COUNT,
+ GFC_ISYM_COMPLEX,
GFC_ISYM_CONJG,
GFC_ISYM_COS,
GFC_ISYM_COSH,
GFC_ISYM_COUNT,
GFC_ISYM_CSHIFT,
+ GFC_ISYM_CTIME,
GFC_ISYM_DBLE,
GFC_ISYM_DIM,
GFC_ISYM_DOT_PRODUCT,
GFC_ISYM_ETIME,
GFC_ISYM_EXP,
GFC_ISYM_EXPONENT,
+ GFC_ISYM_FDATE,
+ GFC_ISYM_FGET,
+ GFC_ISYM_FGETC,
GFC_ISYM_FLOOR,
GFC_ISYM_FNUM,
+ GFC_ISYM_FPUT,
+ GFC_ISYM_FPUTC,
GFC_ISYM_FRACTION,
GFC_ISYM_FSTAT,
+ GFC_ISYM_FTELL,
GFC_ISYM_GETCWD,
GFC_ISYM_GETGID,
GFC_ISYM_GETPID,
GFC_ISYM_LLE,
GFC_ISYM_LLT,
GFC_ISYM_LOG,
+ GFC_ISYM_LOC,
GFC_ISYM_LOG10,
GFC_ISYM_LOGICAL,
+ GFC_ISYM_MALLOC,
GFC_ISYM_MATMUL,
GFC_ISYM_MAX,
GFC_ISYM_MAXLOC,
GFC_ISYM_NEAREST,
GFC_ISYM_NINT,
GFC_ISYM_NOT,
+ GFC_ISYM_OR,
GFC_ISYM_PACK,
GFC_ISYM_PRESENT,
GFC_ISYM_PRODUCT,
GFC_ISYM_SCALE,
GFC_ISYM_SCAN,
GFC_ISYM_SECOND,
+ GFC_ISYM_SECNDS,
GFC_ISYM_SET_EXPONENT,
GFC_ISYM_SHAPE,
GFC_ISYM_SI_KIND,
GFC_ISYM_SIGN,
+ GFC_ISYM_SIGNAL,
GFC_ISYM_SIN,
GFC_ISYM_SINH,
GFC_ISYM_SIZE,
GFC_ISYM_TRANSFER,
GFC_ISYM_TRANSPOSE,
GFC_ISYM_TRIM,
+ GFC_ISYM_TTYNAM,
GFC_ISYM_UBOUND,
GFC_ISYM_UMASK,
GFC_ISYM_UNLINK,
GFC_ISYM_UNPACK,
GFC_ISYM_VERIFY,
+ GFC_ISYM_XOR,
GFC_ISYM_CONVERSION
};
typedef enum gfc_generic_isym_id gfc_generic_isym_id;
unsigned data:1, /* Symbol is named in a DATA statement. */
use_assoc:1; /* Symbol has been use-associated. */
- unsigned in_namelist:1, in_common:1;
+ unsigned in_namelist:1, in_common:1, in_equivalence:1;
unsigned function:1, subroutine:1, generic:1;
unsigned implicit_type:1; /* Type defined via implicit rules. */
unsigned untyped:1; /* No implicit type could be found. */
unsigned sequence:1, elemental:1, pure:1, recursive:1;
unsigned unmaskable:1, masked:1, contained:1;
+ /* This is set if the subroutine doesn't return. Currently, this
+ is only possible for intrinsic subroutines. */
+ unsigned noreturn:1;
+
/* Set if this procedure is an alternate entry point. These procedures
don't have any code associated, and the backend will turn them into
thunks to the master function. */
ENUM_BITFIELD (ifsrc) if_source:2;
ENUM_BITFIELD (procedure_type) proc:3;
+
+ /* Special attributes for Cray pointers, pointees. */
+ unsigned cray_pointer:1, cray_pointee:1;
}
symbol_attribute;
int rank; /* A rank of zero means that a variable is a scalar. */
array_type type;
struct gfc_expr *lower[GFC_MAX_DIMENSIONS], *upper[GFC_MAX_DIMENSIONS];
+
+ /* These two fields are used with the Cray Pointer extension. */
+ bool cray_pointee; /* True iff this spec belongs to a cray pointee. */
+ bool cp_was_assumed; /* AS_ASSUMED_SIZE cp arrays are converted to
+ AS_EXPLICIT, but we want to remember that we
+ did this. */
+
}
gfc_array_spec;
struct gfc_symbol *result; /* function result symbol */
gfc_component *components; /* Derived type components */
+ /* Defined only for Cray pointees; points to their pointer. */
+ struct gfc_symbol *cp_pointer;
+
struct gfc_symbol *common_next; /* Links for COMMON syms */
+
+ /* This is in fact a gfc_common_head but it is only used for pointer
+ comparisons to check if symbols are in the same common block. */
+ struct gfc_common_head* common_head;
+
/* Make sure setup code for dummy arguments is generated in the correct
order. */
int dummy_order;
/* This structure is used to keep track of symbols in common blocks. */
-typedef struct
+typedef struct gfc_common_head
{
locus where;
int use_assoc, saved;
char name[GFC_MAX_SYMBOL_LEN + 1];
- gfc_symbol *head;
+ struct gfc_symbol *head;
}
gfc_common_head;
const char *name, *lib_name;
gfc_intrinsic_arg *formal;
gfc_typespec ts;
- int elemental, pure, generic, specific, actual_ok, standard;
+ int elemental, pure, generic, specific, actual_ok, standard, noreturn;
gfc_simplify_f simplify;
gfc_check_f check;
{
struct gfc_equiv *next, *eq;
gfc_expr *expr;
+ const char *module;
int used;
}
gfc_equiv;
typedef struct
{
gfc_expr *unit, *file, *status, *access, *form, *recl,
- *blank, *position, *action, *delim, *pad, *iostat;
+ *blank, *position, *action, *delim, *pad, *iostat, *iomsg;
gfc_st_label *err;
}
gfc_open;
typedef struct
{
- gfc_expr *unit, *status, *iostat;
+ gfc_expr *unit, *status, *iostat, *iomsg;
gfc_st_label *err;
}
gfc_close;
typedef struct
{
- gfc_expr *unit, *iostat;
+ gfc_expr *unit, *iostat, *iomsg;
gfc_st_label *err;
}
gfc_filepos;
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;
+ *write, *readwrite, *delim, *pad, *iolength, *iomsg;
gfc_st_label *err;
typedef struct
{
- gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size;
+ gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg;
gfc_symbol *namelist;
/* A format_label of `format_asterisk' indicates the "*" format */
int flag_pack_derived;
int flag_repack_arrays;
int flag_f2c;
+ int flag_automatic;
int flag_backslash;
+ int flag_cray_pointer;
int flag_d_lines;
int q_kind;
+ int fpe;
+
int warn_std;
int allow_std;
int warn_nonstd_intrinsics;
+ int fshort_enums;
}
gfc_option_t;
int gfc_terminal_width(void);
void gfc_clear_ts (gfc_typespec *);
FILE *gfc_open_file (const char *);
-const char *gfc_article (const char *);
const char *gfc_basic_typename (bt);
const char *gfc_typename (gfc_typespec *);
/* 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);
/* trans-types.c */
int gfc_validate_kind (bt, int, bool);
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 *as);
try gfc_add_result (symbol_attribute *, const char *, locus *);
try gfc_add_save (symbol_attribute *, const char *, locus *);
try gfc_add_saved_common (symbol_attribute *, 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 *);
void gfc_type_convert_binary (gfc_expr *);
int gfc_is_constant_expr (gfc_expr *);
try gfc_simplify_expr (gfc_expr *, int);
+int gfc_has_vector_index (gfc_expr *);
gfc_expr *gfc_get_expr (void);
void gfc_free_expr (gfc_expr *);
try gfc_resolve_iterator (gfc_iterator *, bool);
try gfc_resolve_index (gfc_expr *, int);
try gfc_resolve_dim_arg (gfc_expr *);
+int gfc_is_formal_arg (void);
/* array.c */
void gfc_free_array_spec (gfc_array_spec *);
projects / gcc.git / blobdiff