#ifndef LIBGFOR_H
#define LIBGFOR_H
#include <math.h>
#include <stddef.h>
#include <float.h>
#ifndef M_PI
#define M_PI 3.14159265358979323846264338327
#endif
#if HAVE_COMPLEX_H
# include <complex.h>
#else
#define complex __complex__
#endif
#include "config.h"
#include "c99_protos.h"
#if HAVE_IEEEFP_H
#include <ieeefp.h>
#endif
#include "gstdint.h"
#if HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
typedef off_t gfc_offset;
#ifndef NULL
#define NULL (void *) 0
#endif
#ifndef __GNUC__
#define __attribute__(x)
#endif
#define PREFIX(x) _gfortran_ ## x
#define IPREFIX(x) _gfortrani_ ## x
#define sym_rename(old, new) sym_rename1(old, __USER_LABEL_PREFIX__, new)
#define sym_rename1(old, ulp, new) sym_rename2(old, ulp, new)
#define sym_rename2(old, ulp, new) extern __typeof(old) old __asm__(#ulp #new)
#if defined(HAVE_ATTRIBUTE_VISIBILITY)
# define internal_proto(x) \
sym_rename(x, IPREFIX (x)) __attribute__((__visibility__("hidden")))
#else
# define internal_proto(x) sym_rename(x, IPREFIX(x))
#endif
#if defined(HAVE_ATTRIBUTE_VISIBILITY) && defined(HAVE_ATTRIBUTE_ALIAS)
# define export_proto(x) sym_rename(x, PREFIX(x))
# define export_proto_np(x) extern char swallow_semicolon
# define iexport_proto(x) internal_proto(x)
# define iexport(x) iexport1(x, __USER_LABEL_PREFIX__, IPREFIX(x))
# define iexport1(x,p,y) iexport2(x,p,y)
# define iexport2(x,p,y) \
extern __typeof(x) PREFIX(x) __attribute__((__alias__(#p #y)))
#elif 0 && defined(HAVE_ATTRIBUTE_DLLEXPORT)
# define export_proto_np(x) extern __typeof(x) x __attribute__((dllexport))
# define export_proto(x) sym_rename(x, PREFIX(x)) __attribute__((dllexport))
# define iexport_proto(x) export_proto(x)
# define iexport(x) extern char swallow_semicolon
#else
# define export_proto(x) sym_rename(x, PREFIX(x))
# define export_proto_np(x) extern char swallow_semicolon
# define iexport_proto(x) export_proto(x)
# define iexport(x) extern char swallow_semicolon
#endif
#define iexport_data_proto(x) export_proto(x)
#define iexport_data(x) extern char swallow_semicolon
#ifndef offsetof
#define offsetof(TYPE, MEMBER) ((size_t) &((TYPE *) 0)->MEMBER)
#endif
#if defined(HAVE_BROKEN_ISFINITE) || defined(__CYGWIN__)
#undef isfinite
#endif
#if defined(HAVE_BROKEN_ISNAN)
#undef isnan
#endif
#if defined(HAVE_BROKEN_FPCLASSIFY)
#undef fpclassify
#endif
#if !defined(isfinite)
#if !defined(fpclassify)
#define isfinite(x) ((x) - (x) == 0)
#else
#define isfinite(x) (fpclassify(x) != FP_NAN && fpclassify(x) != FP_INFINITE)
#endif
#endif
#if !defined(isnan)
#if !defined(fpclassify)
#define isnan(x) ((x) != (x))
#else
#define isnan(x) (fpclassify(x) == FP_NAN)
#endif
#endif
#define REALPART(z) (__real__(z))
#define IMAGPART(z) (__imag__(z))
#define COMPLEX_ASSIGN(z_, r_, i_) {__real__(z_) = (r_); __imag__(z_) = (i_);}
#include "kinds.h"
#ifdef HAVE_GFC_INTEGER_8
typedef GFC_INTEGER_8 GFC_IO_INT;
#else
#ifdef HAVE_GFC_INTEGER_4
typedef GFC_INTEGER_4 GFC_IO_INT;
#else
#error "GFC_INTEGER_4 should be available for the library to compile".
#endif
#endif
typedef ssize_t index_type;
typedef GFC_INTEGER_4 gfc_charlen_type;
extern int l8_to_l4_offset;
internal_proto(l8_to_l4_offset);
#define GFOR_POINTER_L8_TO_L4(p8) \
(l8_to_l4_offset + (GFC_LOGICAL_4 *)(p8))
#define GFC_INTEGER_1_HUGE \
(GFC_INTEGER_1)((((GFC_UINTEGER_1)1) << 7) - 1)
#define GFC_INTEGER_2_HUGE \
(GFC_INTEGER_2)((((GFC_UINTEGER_2)1) << 15) - 1)
#define GFC_INTEGER_4_HUGE \
(GFC_INTEGER_4)((((GFC_UINTEGER_4)1) << 31) - 1)
#define GFC_INTEGER_8_HUGE \
(GFC_INTEGER_8)((((GFC_UINTEGER_8)1) << 63) - 1)
#ifdef HAVE_GFC_INTEGER_16
#define GFC_INTEGER_16_HUGE \
(GFC_INTEGER_16)((((GFC_UINTEGER_16)1) << 127) - 1)
#endif
#define GFC_REAL_4_HUGE FLT_MAX
#define GFC_REAL_8_HUGE DBL_MAX
#ifdef HAVE_GFC_REAL_10
#define GFC_REAL_10_HUGE LDBL_MAX
#endif
#ifdef HAVE_GFC_REAL_16
#define GFC_REAL_16_HUGE LDBL_MAX
#endif
#define GFC_REAL_4_DIGITS FLT_MANT_DIG
#define GFC_REAL_8_DIGITS DBL_MANT_DIG
#ifdef HAVE_GFC_REAL_10
#define GFC_REAL_10_DIGITS LDBL_MANT_DIG
#endif
#ifdef HAVE_GFC_REAL_16
#define GFC_REAL_16_DIGITS LDBL_MANT_DIG
#endif
#define GFC_REAL_4_RADIX FLT_RADIX
#define GFC_REAL_8_RADIX FLT_RADIX
#ifdef HAVE_GFC_REAL_10
#define GFC_REAL_10_RADIX FLT_RADIX
#endif
#ifdef HAVE_GFC_REAL_16
#define GFC_REAL_16_RADIX FLT_RADIX
#endif
#ifndef GFC_MAX_DIMENSIONS
#define GFC_MAX_DIMENSIONS 7
#endif
typedef struct descriptor_dimension
{
index_type stride;
index_type lbound;
index_type ubound;
}
descriptor_dimension;
#define GFC_ARRAY_DESCRIPTOR(r, type) \
struct {\
type *data;\
size_t offset;\
index_type dtype;\
descriptor_dimension dim[r];\
}
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) gfc_array_void;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, char) gfc_array_char;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_1) gfc_array_i1;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_2) gfc_array_i2;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_array_i4;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_8) gfc_array_i8;
#ifdef HAVE_GFC_INTEGER_16
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_16) gfc_array_i16;
#endif
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_4) gfc_array_r4;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_8) gfc_array_r8;
#ifdef HAVE_GFC_REAL_10
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_10) gfc_array_r10;
#endif
#ifdef HAVE_GFC_REAL_16
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_16) gfc_array_r16;
#endif
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_4) gfc_array_c4;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_8) gfc_array_c8;
#ifdef HAVE_GFC_COMPLEX_10
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_10) gfc_array_c10;
#endif
#ifdef HAVE_GFC_COMPLEX_16
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_16) gfc_array_c16;
#endif
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_4) gfc_array_l4;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_8) gfc_array_l8;
#ifdef HAVE_GFC_LOGICAL_16
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16;
#endif
#define GFC_DTYPE_RANK_MASK 0x07
#define GFC_DTYPE_TYPE_SHIFT 3
#define GFC_DTYPE_TYPE_MASK 0x38
#define GFC_DTYPE_SIZE_SHIFT 6
enum
{
GFC_DTYPE_UNKNOWN = 0,
GFC_DTYPE_INTEGER,
GFC_DTYPE_LOGICAL,
GFC_DTYPE_REAL,
GFC_DTYPE_COMPLEX,
GFC_DTYPE_DERIVED,
GFC_DTYPE_CHARACTER
};
#define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype & GFC_DTYPE_RANK_MASK)
#define GFC_DESCRIPTOR_TYPE(desc) (((desc)->dtype & GFC_DTYPE_TYPE_MASK) \
>> GFC_DTYPE_TYPE_SHIFT)
#define GFC_DESCRIPTOR_SIZE(desc) ((desc)->dtype >> GFC_DTYPE_SIZE_SHIFT)
#define GFC_DESCRIPTOR_DATA(desc) ((desc)->data)
#define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype)
#define stringize(x) expand_macro(x)
#define expand_macro(x) # x
typedef struct
{
int stdin_unit, stdout_unit, stderr_unit, optional_plus;
int allocate_init_flag, allocate_init_value;
int locus;
int separator_len;
const char *separator;
int mem_check;
int use_stderr, all_unbuffered, default_recl;
int fpu_round, fpu_precision, fpe;
int sighup, sigint;
}
options_t;
extern options_t options;
internal_proto(options);
typedef struct
{
int warn_std;
int allow_std;
int pedantic;
int convert;
size_t record_marker;
int max_subrecord_length;
}
compile_options_t;
extern compile_options_t compile_options;
internal_proto(compile_options);
extern void init_compile_options (void);
internal_proto(init_compile_options);
#define GFC_MAX_SUBRECORD_LENGTH 2147483639
typedef struct
{
const char *name;
int value;
}
st_option;
typedef enum
{
ERROR_FIRST = -3,
ERROR_EOR = -2,
ERROR_END = -1,
ERROR_OK = 0,
ERROR_OS,
ERROR_OPTION_CONFLICT,
ERROR_BAD_OPTION,
ERROR_MISSING_OPTION,
ERROR_ALREADY_OPEN,
ERROR_BAD_UNIT,
ERROR_FORMAT,
ERROR_BAD_ACTION,
ERROR_ENDFILE,
ERROR_BAD_US,
ERROR_READ_VALUE,
ERROR_READ_OVERFLOW,
ERROR_INTERNAL,
ERROR_INTERNAL_UNIT,
ERROR_ALLOCATION,
ERROR_DIRECT_EOR,
ERROR_SHORT_RECORD,
ERROR_CORRUPT_FILE,
ERROR_LAST
}
error_codes;
#define GFC_STD_LEGACY (1<<6)
#define GFC_STD_GNU (1<<5)
#define GFC_STD_F2003 (1<<4)
#define GFC_STD_F95 (1<<3)
#define GFC_STD_F95_DEL (1<<2)
#define GFC_STD_F95_OBS (1<<1)
#define GFC_STD_F77 (1<<0)
#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)
typedef enum
{ SILENT, WARNING, ERROR }
notification;
typedef enum
{ SUCCESS = 1, FAILURE }
try;
extern unsigned line;
iexport_data_proto(line);
extern char *filename;
iexport_data_proto(filename);
#define gfc_alloca(x) __builtin_alloca(x)
extern void stupid_function_name_for_static_linking (void);
internal_proto(stupid_function_name_for_static_linking);
struct st_parameter_common;
extern void library_start (struct st_parameter_common *);
internal_proto(library_start);
#define library_end()
extern void set_args (int, char **);
export_proto(set_args);
extern void get_args (int *, char ***);
internal_proto(get_args);
#define GFC_ITOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 2)
#define GFC_XTOA_BUF_SIZE (sizeof (GFC_UINTEGER_LARGEST) * 2 + 1)
#define GFC_OTOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 1)
#define GFC_BTOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 8 + 1)
extern const char *gfc_itoa (GFC_INTEGER_LARGEST, char *, size_t);
internal_proto(gfc_itoa);
extern const char *xtoa (GFC_UINTEGER_LARGEST, char *, size_t);
internal_proto(xtoa);
extern void os_error (const char *) __attribute__ ((noreturn));
internal_proto(os_error);
extern void show_locus (struct st_parameter_common *);
internal_proto(show_locus);
extern void runtime_error (const char *) __attribute__ ((noreturn));
iexport_proto(runtime_error);
extern void internal_error (struct st_parameter_common *, const char *)
__attribute__ ((noreturn));
internal_proto(internal_error);
extern const char *get_oserror (void);
internal_proto(get_oserror);
extern void sys_exit (int) __attribute__ ((noreturn));
internal_proto(sys_exit);
extern int st_printf (const char *, ...)
__attribute__ ((format (printf, 1, 2)));
internal_proto(st_printf);
extern void st_sprintf (char *, const char *, ...)
__attribute__ ((format (printf, 2, 3)));
internal_proto(st_sprintf);
extern const char *translate_error (int);
internal_proto(translate_error);
extern void generate_error (struct st_parameter_common *, int, const char *);
internal_proto(generate_error);
extern try notify_std (struct st_parameter_common *, int, const char *);
internal_proto(notify_std);
extern void set_fpu (void);
internal_proto(set_fpu);
extern void *get_mem (size_t) __attribute__ ((malloc));
internal_proto(get_mem);
extern void free_mem (void *);
internal_proto(free_mem);
extern void *internal_malloc_size (size_t);
internal_proto(internal_malloc_size);
extern void internal_free (void *);
iexport_proto(internal_free);
extern int check_buffered (int);
internal_proto(check_buffered);
extern void init_variables (void);
internal_proto(init_variables);
extern void show_variables (void);
internal_proto(show_variables);
extern int find_option (struct st_parameter_common *, const char *, int,
const st_option *, const char *);
internal_proto(find_option);
extern int fstrlen (const char *, int);
internal_proto(fstrlen);
extern void fstrcpy (char *, int, const char *, int);
internal_proto(fstrcpy);
extern void cf_strcpy (char *, int, const char *);
internal_proto(cf_strcpy);
extern void init_units (void);
internal_proto(init_units);
extern void close_units (void);
internal_proto(close_units);
extern int unit_to_fd (int);
internal_proto(unit_to_fd);
extern void stop_numeric (GFC_INTEGER_4);
iexport_proto(stop_numeric);
extern void reshape_packed (char *, index_type, const char *, index_type,
const char *, index_type);
internal_proto(reshape_packed);
GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *);
internal_proto(internal_pack_4);
GFC_INTEGER_8 *internal_pack_8 (gfc_array_i8 *);
internal_proto(internal_pack_8);
#if defined HAVE_GFC_INTEGER_16
GFC_INTEGER_16 *internal_pack_16 (gfc_array_i16 *);
internal_proto(internal_pack_16);
#endif
GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *);
internal_proto(internal_pack_c4);
GFC_COMPLEX_8 *internal_pack_c8 (gfc_array_c8 *);
internal_proto(internal_pack_c8);
#if defined HAVE_GFC_COMPLEX_10
GFC_COMPLEX_10 *internal_pack_c10 (gfc_array_c10 *);
internal_proto(internal_pack_c10);
#endif
extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *);
internal_proto(internal_unpack_4);
extern void internal_unpack_8 (gfc_array_i8 *, const GFC_INTEGER_8 *);
internal_proto(internal_unpack_8);
#if defined HAVE_GFC_INTEGER_16
extern void internal_unpack_16 (gfc_array_i16 *, const GFC_INTEGER_16 *);
internal_proto(internal_unpack_16);
#endif
extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *);
internal_proto(internal_unpack_c4);
extern void internal_unpack_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *);
internal_proto(internal_unpack_c8);
#if defined HAVE_GFC_COMPLEX_10
extern void internal_unpack_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *);
internal_proto(internal_unpack_c10);
#endif
#if defined HAVE_GFC_COMPLEX_16
extern void internal_unpack_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *);
internal_proto(internal_unpack_c16);
#endif
extern GFC_INTEGER_4 compare_string (GFC_INTEGER_4, const char *,
GFC_INTEGER_4, const char *);
iexport_proto(compare_string);
extern void random_seed (GFC_INTEGER_4 * size, gfc_array_i4 * put,
gfc_array_i4 * get);
iexport_proto(random_seed);
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) array_t;
extern index_type size0 (const array_t * array);
iexport_proto(size0);
#endif