/* Common declarations for all of libgfortran.
- Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+ Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
+ 2011
Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>, and
Andy Vaught <andy@xena.eas.asu.edu>
#include <float.h>
#include <stdarg.h>
+/* If we're support quad-precision floating-point type, include the
+ header to our support library. */
+#ifdef HAVE_FLOAT128
+# include "quadmath_weak.h"
+#endif
+
#ifdef __MINGW32__
extern float __strtof (const char *, char **);
#define gfc_strtof __strtof
#define offsetof(TYPE, MEMBER) ((size_t) &((TYPE *) 0)->MEMBER)
#endif
-/* The isfinite macro is only available with C99, but some non-C99
- systems still provide fpclassify, and there is a `finite' function
- in BSD.
-
- Also, isfinite is broken on Cygwin.
+/* The C99 classification macros isfinite, isinf, isnan, isnormal
+ and signbit are broken or inconsistent on quite a few targets.
+ So, we use GCC's builtins instead.
- When isfinite is not available, try to use one of the
- alternatives, or bail out. */
-
-#if defined(HAVE_BROKEN_ISFINITE) || defined(__CYGWIN__)
-#undef isfinite
-#endif
+ Another advantage for GCC's builtins for these type-generic macros
+ is that it handles floating-point types that the system headers
+ may not support (like __float128). */
-#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 /* !defined(fpclassify) */
-#endif /* !defined(isfinite) */
-
-#if !defined(isnan)
-#if !defined(fpclassify)
-#define isnan(x) ((x) != (x))
-#else
-#define isnan(x) (fpclassify(x) == FP_NAN)
-#endif /* !defined(fpclassify) */
-#endif /* !defined(isfinite) */
+#define isnan(x) __builtin_isnan(x)
+#undef isfinite
+#define isfinite(x) __builtin_isfinite(x)
+#undef isinf
+#define isinf(x) __builtin_isinf(x)
+#undef isnormal
+#define isnormal(x) __builtin_isnormal(x)
+#undef signbit
+#define signbit(x) __builtin_signbit(x)
/* TODO: find the C99 version of these an move into above ifdef. */
#define REALPART(z) (__real__(z))
# define GFC_REAL_10_INFINITY __builtin_infl ()
# endif
# ifdef HAVE_GFC_REAL_16
-# define GFC_REAL_16_INFINITY __builtin_infl ()
+# ifdef GFC_REAL_16_IS_LONG_DOUBLE
+# define GFC_REAL_16_INFINITY __builtin_infl ()
+# else
+# define GFC_REAL_16_INFINITY __builtin_infq ()
+# endif
# endif
#endif
#ifdef __FLT_HAS_QUIET_NAN__
# define GFC_REAL_10_QUIET_NAN __builtin_nanl ("")
# endif
# ifdef HAVE_GFC_REAL_16
-# define GFC_REAL_16_QUIET_NAN __builtin_nanl ("")
+# ifdef GFC_REAL_16_IS_LONG_DOUBLE
+# define GFC_REAL_16_QUIET_NAN __builtin_nanl ("")
+# else
+# define GFC_REAL_16_QUIET_NAN nanq ("")
+# endif
# endif
#endif
#define GFC_DTYPE_TYPE_SIZE(desc) ((desc)->dtype & GFC_DTYPE_TYPE_SIZE_MASK)
-#define GFC_DTYPE_INTEGER_1 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_INTEGER_1 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_INTEGER_2 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_INTEGER_2 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_INTEGER_4 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_INTEGER_4 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_INTEGER_8 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_INTEGER_8 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT))
#ifdef HAVE_GFC_INTEGER_16
-#define GFC_DTYPE_INTEGER_16 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_INTEGER_16 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT))
#endif
-#define GFC_DTYPE_LOGICAL_1 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_LOGICAL_1 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_LOGICAL_1) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_LOGICAL_2 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_LOGICAL_2 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_LOGICAL_2) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_LOGICAL_4 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_LOGICAL_4 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_LOGICAL_4) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_LOGICAL_8 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_LOGICAL_8 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_LOGICAL_8) << GFC_DTYPE_SIZE_SHIFT))
#ifdef HAVE_GFC_LOGICAL_16
-#define GFC_DTYPE_LOGICAL_16 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_LOGICAL_16 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_LOGICAL_16) << GFC_DTYPE_SIZE_SHIFT))
#endif
-#define GFC_DTYPE_REAL_4 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_REAL_4 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_REAL_4) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_REAL_8 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_REAL_8 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_REAL_8) << GFC_DTYPE_SIZE_SHIFT))
#ifdef HAVE_GFC_REAL_10
-#define GFC_DTYPE_REAL_10 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_REAL_10 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_REAL_10) << GFC_DTYPE_SIZE_SHIFT))
#endif
#ifdef HAVE_GFC_REAL_16
-#define GFC_DTYPE_REAL_16 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_REAL_16 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_REAL_16) << GFC_DTYPE_SIZE_SHIFT))
#endif
-#define GFC_DTYPE_COMPLEX_4 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_COMPLEX_4 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_COMPLEX_4) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_COMPLEX_8 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_COMPLEX_8 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_COMPLEX_8) << GFC_DTYPE_SIZE_SHIFT))
#ifdef HAVE_GFC_COMPLEX_10
-#define GFC_DTYPE_COMPLEX_10 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_COMPLEX_10 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_COMPLEX_10) << GFC_DTYPE_SIZE_SHIFT))
#endif
#ifdef HAVE_GFC_COMPLEX_16
-#define GFC_DTYPE_COMPLEX_16 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_COMPLEX_16 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_COMPLEX_16) << GFC_DTYPE_SIZE_SHIFT))
#endif
-#define GFC_DTYPE_DERIVED_1 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_DERIVED_1 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_DERIVED_2 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_DERIVED_2 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_DERIVED_4 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_DERIVED_4 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_DERIVED_8 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_DERIVED_8 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT))
#ifdef HAVE_GFC_INTEGER_16
-#define GFC_DTYPE_DERIVED_16 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
+#define GFC_DTYPE_DERIVED_16 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT))
#endif
__attribute__ ((noreturn));
internal_proto(internal_error);
-extern const char *get_oserror (void);
-internal_proto(get_oserror);
-
extern const char *translate_error (int);
internal_proto(translate_error);
extern void generate_error (st_parameter_common *, int, const char *);
iexport_proto(generate_error);
+extern void generate_warning (st_parameter_common *, const char *);
+internal_proto(generate_warning);
+
extern try notify_std (st_parameter_common *, int, const char *);
internal_proto(notify_std);
extern notification notification_std(int);
internal_proto(notification_std);
+extern char *gf_strerror (int, char *, size_t);
+internal_proto(gf_strerror);
+
/* fpu.c */
extern void set_fpu (void);
/* stop.c */
-extern void stop_numeric (GFC_INTEGER_4) __attribute__ ((noreturn));
-iexport_proto(stop_numeric);
+extern void stop_string (const char *, GFC_INTEGER_4)
+ __attribute__ ((noreturn));
+export_proto(stop_string);
/* reshape_packed.c */
gfc_charlen_type, const gfc_char4_t *);
iexport_proto(compare_string_char4);
+extern int memcmp_char4 (const void *, const void *, size_t);
+internal_proto(memcmp_char4);
+
+
/* random.c */
extern void random_seed_i4 (GFC_INTEGER_4 * size, gfc_array_i4 * put,