Index: flang/include/flang/Common/long-double.h =================================================================== --- flang/include/flang/Common/long-double.h +++ /dev/null @@ -1,23 +0,0 @@ -/*===-- include/flang/Common/config.h -------------------------------*- C -*-=== - * - * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. - * See https://llvm.org/LICENSE.txt for license information. - * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception - * - * ===-----------------------------------------------------------------------=== - */ - -/* This header can be used by both C and C++. */ - -#ifndef FORTRAN_COMMON_LONG_DOUBLE_H -#define FORTRAN_COMMON_LONG_DOUBLE_H - -#ifdef _MSC_VER /* no long double */ -#undef LONG_DOUBLE -#elif __x86_64__ /* x87 extended precision */ -#define LONG_DOUBLE 80 -#else -#define LONG_DOUBLE 128 -#endif - -#endif /* FORTRAN_COMMON_LONG_DOUBLE_H */ Index: flang/include/flang/Runtime/cpp-type.h =================================================================== --- flang/include/flang/Runtime/cpp-type.h +++ flang/include/flang/Runtime/cpp-type.h @@ -13,8 +13,11 @@ #include "flang/Common/Fortran.h" #include "flang/Common/uint128.h" +#include "flang/Runtime/float128.h" +#include #include #include +#include namespace Fortran::runtime { @@ -24,6 +27,11 @@ template using CppTypeFor = typename CppTypeForHelper::type; +template constexpr bool HasCppTypeFor{false}; +template +constexpr bool HasCppTypeFor{ + !std::is_void_v::type>}; + template struct CppTypeForHelper { using type = common::HostSignedIntType<8 * KIND>; }; @@ -35,12 +43,21 @@ template <> struct CppTypeForHelper { using type = double; }; +#if LDBL_MANT_DIG == 64 template <> struct CppTypeForHelper { using type = long double; }; +#endif +#if LDBL_MANT_DIG == 113 +using CppFloat128Type = long double; +#elif HAS_FLOAT128 +using CppFloat128Type = __float128; +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 template <> struct CppTypeForHelper { - using type = long double; + using type = CppFloat128Type; }; +#endif template struct CppTypeForHelper { using type = std::complex>; Index: flang/include/flang/Runtime/float128.h =================================================================== --- /dev/null +++ flang/include/flang/Runtime/float128.h @@ -0,0 +1,32 @@ +/*===-- flang/Runtime/float128.h ----------------------------------*- C -*-=== + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*/ + +/* This header is usable in both C and C++ code. + * Isolates build compiler checks to determine the presence of an IEEE-754 + * quad-precision type named __float128 type that isn't __ibm128 + * (double/double). We don't care whether the type has underlying hardware + * support or is emulated. + * + * 128-bit arithmetic may be available via "long double"; this can + * be determined by LDBL_MANT_DIG == 113. A machine may have both 128-bit + * long double and __float128; prefer long double by testing for it first. + */ + +#ifndef FORTRAN_RUNTIME_FLOAT128_H_ +#define FORTRAN_RUNTIME_FLOAT128_H_ + +#undef HAS_FLOAT128 +#if __x86_64__ +#if __GNUC__ >= 7 || __clang_major >= 7 +#define HAS_FLOAT128 1 +#endif +#elif defined __PPC__ && __GNUC__ >= 8 +#define HAS_FLOAT128 1 +#endif + +#endif /* FORTRAN_RUNTIME_FLOAT128_H_ */ Index: flang/include/flang/Runtime/numeric.h =================================================================== --- flang/include/flang/Runtime/numeric.h +++ flang/include/flang/Runtime/numeric.h @@ -23,60 +23,84 @@ CppTypeFor); CppTypeFor RTNAME(Aint4_8)( CppTypeFor); +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Aint4_10)( CppTypeFor); +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(Aint4_16)( CppTypeFor); +#endif CppTypeFor RTNAME(Aint8_4)( CppTypeFor); CppTypeFor RTNAME(Aint8_8)( CppTypeFor); +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Aint8_10)( CppTypeFor); +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(Aint8_16)( CppTypeFor); +#endif +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Aint10_4)( CppTypeFor); CppTypeFor RTNAME(Aint10_8)( CppTypeFor); CppTypeFor RTNAME(Aint10_10)( CppTypeFor); +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(Aint16_4)( CppTypeFor); CppTypeFor RTNAME(Aint16_8)( CppTypeFor); CppTypeFor RTNAME(Aint16_16)( CppTypeFor); +#endif // ANINT CppTypeFor RTNAME(Anint4_4)( CppTypeFor); CppTypeFor RTNAME(Anint4_8)( CppTypeFor); +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Anint4_10)( CppTypeFor); +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(Anint4_16)( CppTypeFor); +#endif CppTypeFor RTNAME(Anint8_4)( CppTypeFor); CppTypeFor RTNAME(Anint8_8)( CppTypeFor); +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Anint8_10)( CppTypeFor); +#endif +#if LDBL_MANT_DIG == 113 CppTypeFor RTNAME(Anint8_16)( CppTypeFor); +#endif +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Anint10_4)( CppTypeFor); CppTypeFor RTNAME(Anint10_8)( CppTypeFor); CppTypeFor RTNAME(Anint10_10)( CppTypeFor); +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(Anint16_4)( CppTypeFor); CppTypeFor RTNAME(Anint16_8)( CppTypeFor); CppTypeFor RTNAME(Anint16_16)( CppTypeFor); +#endif // CEILING CppTypeFor RTNAME(Ceiling4_1)( @@ -103,6 +127,7 @@ CppTypeFor RTNAME(Ceiling8_16)( CppTypeFor); #endif +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Ceiling10_1)( CppTypeFor); CppTypeFor RTNAME(Ceiling10_2)( @@ -115,6 +140,8 @@ CppTypeFor RTNAME(Ceiling10_16)( CppTypeFor); #endif +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(Ceiling16_1)( CppTypeFor); CppTypeFor RTNAME(Ceiling16_2)( @@ -127,6 +154,7 @@ CppTypeFor RTNAME(Ceiling16_16)( CppTypeFor); #endif +#endif // EXPONENT is defined to return default INTEGER; support INTEGER(4 & 8) CppTypeFor RTNAME(Exponent4_4)( @@ -137,14 +165,18 @@ CppTypeFor); CppTypeFor RTNAME(Exponent8_8)( CppTypeFor); +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Exponent10_4)( CppTypeFor); CppTypeFor RTNAME(Exponent10_8)( CppTypeFor); +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT CppTypeFor RTNAME(Exponent16_4)( CppTypeFor); CppTypeFor RTNAME(Exponent16_8)( CppTypeFor); +#endif // FLOOR CppTypeFor RTNAME(Floor4_1)( @@ -171,6 +203,7 @@ CppTypeFor RTNAME(Floor8_16)( CppTypeFor); #endif +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Floor10_1)( CppTypeFor); CppTypeFor RTNAME(Floor10_2)( @@ -183,6 +216,8 @@ CppTypeFor RTNAME(Floor10_16)( CppTypeFor); #endif +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(Floor16_1)( CppTypeFor); CppTypeFor RTNAME(Floor16_2)( @@ -195,22 +230,31 @@ CppTypeFor RTNAME(Floor16_16)( CppTypeFor); #endif +#endif // FRACTION CppTypeFor RTNAME(Fraction4)( CppTypeFor); CppTypeFor RTNAME(Fraction8)( CppTypeFor); +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Fraction10)( CppTypeFor); +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(Fraction16)( CppTypeFor); +#endif // ISNAN / IEEE_IS_NAN bool RTNAME(IsNaN4)(CppTypeFor); bool RTNAME(IsNaN8)(CppTypeFor); +#if LDBL_MANT_DIG == 64 bool RTNAME(IsNaN10)(CppTypeFor); +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 bool RTNAME(IsNaN16)(CppTypeFor); +#endif // MOD & MODULO CppTypeFor RTNAME(ModInteger1)( @@ -237,12 +281,16 @@ CppTypeFor RTNAME(ModReal8)( CppTypeFor, CppTypeFor, const char *sourceFile = nullptr, int sourceLine = 0); +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(ModReal10)( CppTypeFor, CppTypeFor, const char *sourceFile = nullptr, int sourceLine = 0); +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(ModReal16)( CppTypeFor, CppTypeFor, const char *sourceFile = nullptr, int sourceLine = 0); +#endif CppTypeFor RTNAME(ModuloInteger1)( CppTypeFor, CppTypeFor, @@ -268,12 +316,16 @@ CppTypeFor RTNAME(ModuloReal8)( CppTypeFor, CppTypeFor, const char *sourceFile = nullptr, int sourceLine = 0); +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(ModuloReal10)( CppTypeFor, CppTypeFor, const char *sourceFile = nullptr, int sourceLine = 0); +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(ModuloReal16)( CppTypeFor, CppTypeFor, const char *sourceFile = nullptr, int sourceLine = 0); +#endif // NINT CppTypeFor RTNAME(Nint4_1)( @@ -300,6 +352,7 @@ CppTypeFor RTNAME(Nint8_16)( CppTypeFor); #endif +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Nint10_1)( CppTypeFor); CppTypeFor RTNAME(Nint10_2)( @@ -312,6 +365,8 @@ CppTypeFor RTNAME(Nint10_16)( CppTypeFor); #endif +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(Nint16_1)( CppTypeFor); CppTypeFor RTNAME(Nint16_2)( @@ -320,10 +375,11 @@ CppTypeFor); CppTypeFor RTNAME(Nint16_8)( CppTypeFor); -#ifdef __SIZEOF_INT128__ +#if defined __SIZEOF_INT128__ CppTypeFor RTNAME(Nint16_16)( CppTypeFor); #endif +#endif // NEAREST // The second argument to NEAREST is the result of a comparison @@ -332,50 +388,71 @@ CppTypeFor, bool positive); CppTypeFor RTNAME(Nearest8)( CppTypeFor, bool positive); +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Nearest10)( CppTypeFor, bool positive); +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(Nearest16)( CppTypeFor, bool positive); +#endif // RRSPACING CppTypeFor RTNAME(RRSpacing4)( CppTypeFor); CppTypeFor RTNAME(RRSpacing8)( CppTypeFor); +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(RRSpacing10)( CppTypeFor); +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(RRSpacing16)( CppTypeFor); +#endif // SET_EXPONENT's I= argument can be any INTEGER kind; upcast it to 64-bit CppTypeFor RTNAME(SetExponent4)( CppTypeFor, std::int64_t); CppTypeFor RTNAME(SetExponent8)( CppTypeFor, std::int64_t); +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(SetExponent10)( CppTypeFor, std::int64_t); +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(SetExponent16)( CppTypeFor, std::int64_t); +#endif // SCALE CppTypeFor RTNAME(Scale4)( CppTypeFor, std::int64_t); CppTypeFor RTNAME(Scale8)( CppTypeFor, std::int64_t); +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Scale10)( CppTypeFor, std::int64_t); +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(Scale16)( CppTypeFor, std::int64_t); +#endif // SPACING CppTypeFor RTNAME(Spacing4)( CppTypeFor); CppTypeFor RTNAME(Spacing8)( CppTypeFor); +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Spacing10)( CppTypeFor); +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(Spacing16)( CppTypeFor); +#endif + } // extern "C" } // namespace Fortran::runtime #endif // FORTRAN_RUNTIME_NUMERIC_H_ Index: flang/include/flang/Runtime/reduction.h =================================================================== --- flang/include/flang/Runtime/reduction.h +++ flang/include/flang/Runtime/reduction.h @@ -12,7 +12,10 @@ #define FORTRAN_RUNTIME_REDUCTION_H_ #include "flang/Common/uint128.h" +#include "flang/Runtime/cpp-type.h" #include "flang/Runtime/entry-names.h" +#include "flang/Runtime/float128.h" +#include #include #include #include @@ -65,10 +68,14 @@ int dim = 0, const Descriptor *mask = nullptr); double RTNAME(SumReal8)(const Descriptor &, const char *source, int line, int dim = 0, const Descriptor *mask = nullptr); +#if LDBL_MANT_DIG == 64 long double RTNAME(SumReal10)(const Descriptor &, const char *source, int line, int dim = 0, const Descriptor *mask = nullptr); -long double RTNAME(SumReal16)(const Descriptor &, const char *source, int line, - int dim = 0, const Descriptor *mask = nullptr); +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 +CppFloat128Type RTNAME(SumReal16)(const Descriptor &, const char *source, + int line, int dim = 0, const Descriptor *mask = nullptr); +#endif void RTNAME(CppSumComplex2)(std::complex &, const Descriptor &, const char *source, int line, int dim = 0, @@ -117,10 +124,14 @@ int dim = 0, const Descriptor *mask = nullptr); double RTNAME(ProductReal8)(const Descriptor &, const char *source, int line, int dim = 0, const Descriptor *mask = nullptr); +#if LDBL_MANT_DIG == 64 long double RTNAME(ProductReal10)(const Descriptor &, const char *source, int line, int dim = 0, const Descriptor *mask = nullptr); -long double RTNAME(ProductReal16)(const Descriptor &, const char *source, +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 +CppFloat128Type RTNAME(ProductReal16)(const Descriptor &, const char *source, int line, int dim = 0, const Descriptor *mask = nullptr); +#endif void RTNAME(CppProductComplex2)(std::complex &, const Descriptor &, const char *source, int line, int dim = 0, @@ -234,10 +245,14 @@ int dim = 0, const Descriptor *mask = nullptr); double RTNAME(MaxvalReal8)(const Descriptor &, const char *source, int line, int dim = 0, const Descriptor *mask = nullptr); +#if LDBL_MANT_DIG == 64 long double RTNAME(MaxvalReal10)(const Descriptor &, const char *source, int line, int dim = 0, const Descriptor *mask = nullptr); -long double RTNAME(MaxvalReal16)(const Descriptor &, const char *source, +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 +CppFloat128Type RTNAME(MaxvalReal16)(const Descriptor &, const char *source, int line, int dim = 0, const Descriptor *mask = nullptr); +#endif void RTNAME(MaxvalCharacter)(Descriptor &, const Descriptor &, const char *source, int line, const Descriptor *mask = nullptr); @@ -261,10 +276,14 @@ int dim = 0, const Descriptor *mask = nullptr); double RTNAME(MinvalReal8)(const Descriptor &, const char *source, int line, int dim = 0, const Descriptor *mask = nullptr); +#if LDBL_MANT_DIG == 64 long double RTNAME(MinvalReal10)(const Descriptor &, const char *source, int line, int dim = 0, const Descriptor *mask = nullptr); -long double RTNAME(MinvalReal16)(const Descriptor &, const char *source, +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 +CppFloat128Type RTNAME(MinvalReal16)(const Descriptor &, const char *source, int line, int dim = 0, const Descriptor *mask = nullptr); +#endif void RTNAME(MinvalCharacter)(Descriptor &, const Descriptor &, const char *source, int line, const Descriptor *mask = nullptr); @@ -282,10 +301,13 @@ int dim = 0, const Descriptor *mask = nullptr); double RTNAME(Norm2_8)(const Descriptor &, const char *source, int line, int dim = 0, const Descriptor *mask = nullptr); +#if LDBL_MANT_DIG == 64 long double RTNAME(Norm2_10)(const Descriptor &, const char *source, int line, int dim = 0, const Descriptor *mask = nullptr); +#elif LDBL_MANT_DIG == 113 long double RTNAME(Norm2_16)(const Descriptor &, const char *source, int line, int dim = 0, const Descriptor *mask = nullptr); +#endif void RTNAME(Norm2Dim)(Descriptor &, const Descriptor &, int dim, const char *source, int line, const Descriptor *mask = nullptr); @@ -326,10 +348,14 @@ const char *source = nullptr, int line = 0); double RTNAME(DotProductReal8)(const Descriptor &, const Descriptor &, const char *source = nullptr, int line = 0); +#if LDBL_MANT_DIG == 64 long double RTNAME(DotProductReal10)(const Descriptor &, const Descriptor &, const char *source = nullptr, int line = 0); -long double RTNAME(DotProductReal16)(const Descriptor &, const Descriptor &, +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 +CppFloat128Type RTNAME(DotProductReal16)(const Descriptor &, const Descriptor &, const char *source = nullptr, int line = 0); +#endif void RTNAME(CppDotProductComplex2)(std::complex &, const Descriptor &, const Descriptor &, const char *source = nullptr, int line = 0); void RTNAME(CppDotProductComplex3)(std::complex &, const Descriptor &, @@ -338,12 +364,16 @@ const Descriptor &, const char *source = nullptr, int line = 0); void RTNAME(CppDotProductComplex8)(std::complex &, const Descriptor &, const Descriptor &, const char *source = nullptr, int line = 0); +#if LDBL_MANT_DIG == 64 void RTNAME(CppDotProductComplex10)(std::complex &, const Descriptor &, const Descriptor &, const char *source = nullptr, int line = 0); -void RTNAME(CppDotProductComplex16)(std::complex &, +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 +void RTNAME(CppDotProductComplex16)(std::complex &, const Descriptor &, const Descriptor &, const char *source = nullptr, int line = 0); +#endif bool RTNAME(DotProductLogical)(const Descriptor &, const Descriptor &, const char *source = nullptr, int line = 0); Index: flang/lib/Decimal/binary-to-decimal.cpp =================================================================== --- flang/lib/Decimal/binary-to-decimal.cpp +++ flang/lib/Decimal/binary-to-decimal.cpp @@ -9,6 +9,7 @@ #include "big-radix-floating-point.h" #include "flang/Decimal/decimal.h" #include +#include #include namespace Fortran::decimal { @@ -349,14 +350,14 @@ rounding, Fortran::decimal::BinaryFloatingPointNumber<53>(x)); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 ConversionToDecimalResult ConvertLongDoubleToDecimal(char *buffer, std::size_t size, enum DecimalConversionFlags flags, int digits, enum FortranRounding rounding, long double x) { return Fortran::decimal::ConvertToDecimal(buffer, size, flags, digits, rounding, Fortran::decimal::BinaryFloatingPointNumber<64>(x)); } -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 ConversionToDecimalResult ConvertLongDoubleToDecimal(char *buffer, std::size_t size, enum DecimalConversionFlags flags, int digits, enum FortranRounding rounding, long double x) { Index: flang/lib/Evaluate/intrinsics-library.cpp =================================================================== --- flang/lib/Evaluate/intrinsics-library.cpp +++ flang/lib/Evaluate/intrinsics-library.cpp @@ -16,6 +16,7 @@ #include "host.h" #include "flang/Common/static-multimap-view.h" #include "flang/Evaluate/expression.h" +#include #include #include #include @@ -324,8 +325,7 @@ static_assert(map.Verify(), "map must be sorted"); }; -#if !defined(__PPC__) || defined(__LONG_DOUBLE_IEEE128__) -// TODO: use HostTypeExists instead? +#if LDBL_MANT_DIG == 80 || LDBL_MANT_DIG == 113 template <> struct HostRuntimeLibrary { using F = FuncPointer; @@ -341,7 +341,7 @@ static constexpr HostRuntimeMap map{table}; static_assert(map.Verify(), "map must be sorted"); }; -#endif // !defined(__PPC__) || defined(__LONG_DOUBLE_IEEE128__) +#endif // LDBL_MANT_DIG == 80 || LDBL_MANT_DIG == 113 #endif /// Define pgmath description Index: flang/runtime/complex-reduction.c =================================================================== --- flang/runtime/complex-reduction.c +++ flang/runtime/complex-reduction.c @@ -8,7 +8,7 @@ */ #include "complex-reduction.h" -#include "flang/Common/long-double.h" +#include struct CppComplexFloat { float r, i; @@ -90,10 +90,10 @@ REDUCTION_ARGS, REDUCTION_ARG_NAMES) ADAPT_REDUCTION(SumComplex8, double_Complex_t, CppComplexDouble, CMPLX, REDUCTION_ARGS, REDUCTION_ARG_NAMES) -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 ADAPT_REDUCTION(SumComplex10, long_double_Complex_t, CppComplexLongDouble, CMPLXL, REDUCTION_ARGS, REDUCTION_ARG_NAMES) -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 ADAPT_REDUCTION(SumComplex16, long_double_Complex_t, CppComplexLongDouble, CMPLXL, REDUCTION_ARGS, REDUCTION_ARG_NAMES) #endif @@ -103,10 +103,10 @@ REDUCTION_ARGS, REDUCTION_ARG_NAMES) ADAPT_REDUCTION(ProductComplex8, double_Complex_t, CppComplexDouble, CMPLX, REDUCTION_ARGS, REDUCTION_ARG_NAMES) -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 ADAPT_REDUCTION(ProductComplex10, long_double_Complex_t, CppComplexLongDouble, CMPLXL, REDUCTION_ARGS, REDUCTION_ARG_NAMES) -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 ADAPT_REDUCTION(ProductComplex16, long_double_Complex_t, CppComplexLongDouble, CMPLXL, REDUCTION_ARGS, REDUCTION_ARG_NAMES) #endif @@ -116,10 +116,10 @@ DOT_PRODUCT_ARGS, DOT_PRODUCT_ARG_NAMES) ADAPT_REDUCTION(DotProductComplex8, double_Complex_t, CppComplexDouble, CMPLX, DOT_PRODUCT_ARGS, DOT_PRODUCT_ARG_NAMES) -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 ADAPT_REDUCTION(DotProductComplex10, long_double_Complex_t, CppComplexLongDouble, CMPLXL, DOT_PRODUCT_ARGS, DOT_PRODUCT_ARG_NAMES) -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 ADAPT_REDUCTION(DotProductComplex16, long_double_Complex_t, CppComplexLongDouble, CMPLXL, DOT_PRODUCT_ARGS, DOT_PRODUCT_ARG_NAMES) #endif Index: flang/runtime/dot-product.cpp =================================================================== --- flang/runtime/dot-product.cpp +++ flang/runtime/dot-product.cpp @@ -6,11 +6,13 @@ // //===----------------------------------------------------------------------===// +#include "float.h" #include "terminator.h" #include "tools.h" #include "flang/Runtime/cpp-type.h" #include "flang/Runtime/descriptor.h" #include "flang/Runtime/reduction.h" +#include #include namespace Fortran::runtime { @@ -178,13 +180,14 @@ const Descriptor &x, const Descriptor &y, const char *source, int line) { return DotProduct{}(x, y, source, line); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 long double RTNAME(DotProductReal10)( const Descriptor &x, const Descriptor &y, const char *source, int line) { return DotProduct{}(x, y, source, line); } -#elif LONG_DOUBLE == 128 -long double RTNAME(DotProductReal16)( +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 +CppTypeFor RTNAME(DotProductReal16)( const Descriptor &x, const Descriptor &y, const char *source, int line) { return DotProduct{}(x, y, source, line); } @@ -200,13 +203,13 @@ const Descriptor &x, const Descriptor &y, const char *source, int line) { result = DotProduct{}(x, y, source, line); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 void RTNAME(CppDotProductComplex10)(std::complex &result, const Descriptor &x, const Descriptor &y, const char *source, int line) { result = DotProduct{}(x, y, source, line); } -#elif LONG_DOUBLE == 128 -void RTNAME(CppDotProductComplex16)(std::complex &result, +#elif LDBL_MANT_DIG == 113 +void RTNAME(CppDotProductComplex16)(std::complex &result, const Descriptor &x, const Descriptor &y, const char *source, int line) { result = DotProduct{}(x, y, source, line); } Index: flang/runtime/extrema.cpp =================================================================== --- flang/runtime/extrema.cpp +++ flang/runtime/extrema.cpp @@ -11,10 +11,11 @@ // NORM2 using common infrastructure. #include "reduction-templates.h" -#include "flang/Common/long-double.h" #include "flang/Runtime/character.h" +#include "flang/Runtime/float128.h" #include "flang/Runtime/reduction.h" #include +#include #include #include #include @@ -511,13 +512,14 @@ return TotalNumericMaxOrMin( x, source, line, dim, mask, "MAXVAL"); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(MaxvalReal10)(const Descriptor &x, const char *source, int line, int dim, const Descriptor *mask) { return TotalNumericMaxOrMin( x, source, line, dim, mask, "MAXVAL"); } -#elif LONG_DOUBLE == 128 +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(MaxvalReal16)(const Descriptor &x, const char *source, int line, int dim, const Descriptor *mask) { return TotalNumericMaxOrMin( @@ -570,13 +572,14 @@ return TotalNumericMaxOrMin( x, source, line, dim, mask, "MINVAL"); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(MinvalReal10)(const Descriptor &x, const char *source, int line, int dim, const Descriptor *mask) { return TotalNumericMaxOrMin( x, source, line, dim, mask, "MINVAL"); } -#elif LONG_DOUBLE == 128 +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(MinvalReal16)(const Descriptor &x, const char *source, int line, int dim, const Descriptor *mask) { return TotalNumericMaxOrMin( @@ -612,8 +615,19 @@ template class Norm2Accumulator { public: using Type = CppTypeFor; - // Use at least double precision for accumulators - using AccumType = CppTypeFor; + // Use at least double precision for accumulators. + // Don't use __float128, it doesn't work with abs() or sqrt() yet. + static constexpr int largestLDKind { +#if LDBL_MANT_DIG == 113 + 16 +#elif LDBL_MANT_DIG == 64 + 10 +#else + 8 +#endif + }; + using AccumType = CppTypeFor; explicit Norm2Accumulator(const Descriptor &array) : array_{array} {} void Reinitialize() { max_ = sum_ = 0; } template void GetResult(A *p, int /*zeroBasedDim*/ = -1) const { @@ -621,7 +635,7 @@ *p = static_cast(max_ * std::sqrt(1 + sum_)); } bool Accumulate(Type x) { - auto absX{AccumType{std::abs(x)}}; + auto absX{std::abs(static_cast(x))}; if (!max_) { max_ = x; } else if (absX > max_) { @@ -666,13 +680,14 @@ return GetTotalReduction( x, source, line, dim, mask, Norm2Accumulator<8>{x}, "NORM2"); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Norm2_10)(const Descriptor &x, const char *source, int line, int dim, const Descriptor *mask) { return GetTotalReduction( x, source, line, dim, mask, Norm2Accumulator<10>{x}, "NORM2"); } -#elif LONG_DOUBLE == 128 +#endif +#if LDBL_MANT_DIG == 113 CppTypeFor RTNAME(Norm2_16)(const Descriptor &x, const char *source, int line, int dim, const Descriptor *mask) { return GetTotalReduction( Index: flang/runtime/findloc.cpp =================================================================== --- flang/runtime/findloc.cpp +++ flang/runtime/findloc.cpp @@ -10,7 +10,6 @@ // integer kinds. #include "reduction-templates.h" -#include "flang/Common/long-double.h" #include "flang/Runtime/character.h" #include "flang/Runtime/reduction.h" #include Index: flang/runtime/numeric.cpp =================================================================== --- flang/runtime/numeric.cpp +++ flang/runtime/numeric.cpp @@ -6,9 +6,10 @@ // //===----------------------------------------------------------------------===// -#include "terminator.h" #include "flang/Runtime/numeric.h" -#include "flang/Common/long-double.h" +#include "terminator.h" +#include "flang/Runtime/float128.h" +#include #include #include #include @@ -175,7 +176,7 @@ CppTypeFor x) { return Aint>(x); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Aint4_10)( CppTypeFor x) { return Aint>(x); @@ -196,7 +197,7 @@ CppTypeFor x) { return Aint>(x); } -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 CppTypeFor RTNAME(Aint4_16)( CppTypeFor x) { return Aint>(x); @@ -235,7 +236,7 @@ CppTypeFor x) { return Anint>(x); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Anint4_10)( CppTypeFor x) { return Anint>(x); @@ -256,7 +257,7 @@ CppTypeFor x) { return Anint>(x); } -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 CppTypeFor RTNAME(Anint4_16)( CppTypeFor x) { return Anint>(x); @@ -323,7 +324,7 @@ return Ceiling>(x); } #endif -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Ceiling10_1)( CppTypeFor x) { return Ceiling>(x); @@ -346,7 +347,7 @@ return Ceiling>(x); } #endif -#else +#elif LDBL_MANT_DIG == 113 CppTypeFor RTNAME(Ceiling16_1)( CppTypeFor x) { return Ceiling>(x); @@ -387,7 +388,7 @@ CppTypeFor x) { return Exponent>(x); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Exponent10_4)( CppTypeFor x) { return Exponent>(x); @@ -396,7 +397,7 @@ CppTypeFor x) { return Exponent>(x); } -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 CppTypeFor RTNAME(Exponent16_4)( CppTypeFor x) { return Exponent>(x); @@ -451,7 +452,7 @@ return Floor>(x); } #endif -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Floor10_1)( CppTypeFor x) { return Floor>(x); @@ -474,7 +475,7 @@ return Floor>(x); } #endif -#else +#elif LDBL_MANT_DIG == 113 CppTypeFor RTNAME(Floor16_1)( CppTypeFor x) { return Floor>(x); @@ -507,12 +508,12 @@ CppTypeFor x) { return Fraction(x); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Fraction10)( CppTypeFor x) { return Fraction(x); } -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 CppTypeFor RTNAME(Fraction16)( CppTypeFor x) { return Fraction(x); @@ -525,11 +526,11 @@ bool RTNAME(IsFinite8)(CppTypeFor x) { return std::isfinite(x); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 bool RTNAME(IsFinite10)(CppTypeFor x) { return std::isfinite(x); } -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 bool RTNAME(IsFinite16)(CppTypeFor x) { return std::isfinite(x); } @@ -541,11 +542,11 @@ bool RTNAME(IsNaN8)(CppTypeFor x) { return std::isnan(x); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 bool RTNAME(IsNaN10)(CppTypeFor x) { return std::isnan(x); } -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 bool RTNAME(IsNaN16)(CppTypeFor x) { return std::isnan(x); } @@ -593,13 +594,13 @@ const char *sourceFile, int sourceLine) { return RealMod(x, p, sourceFile, sourceLine); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(ModReal10)( CppTypeFor x, CppTypeFor p, const char *sourceFile, int sourceLine) { return RealMod(x, p, sourceFile, sourceLine); } -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 CppTypeFor RTNAME(ModReal16)( CppTypeFor x, CppTypeFor p, const char *sourceFile, int sourceLine) { @@ -649,13 +650,13 @@ const char *sourceFile, int sourceLine) { return RealMod(x, p, sourceFile, sourceLine); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(ModuloReal10)( CppTypeFor x, CppTypeFor p, const char *sourceFile, int sourceLine) { return RealMod(x, p, sourceFile, sourceLine); } -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 CppTypeFor RTNAME(ModuloReal16)( CppTypeFor x, CppTypeFor p, const char *sourceFile, int sourceLine) { @@ -671,12 +672,12 @@ CppTypeFor x, bool positive) { return Nearest<53>(x, positive); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Nearest10)( CppTypeFor x, bool positive) { return Nearest<64>(x, positive); } -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 CppTypeFor RTNAME(Nearest16)( CppTypeFor x, bool positive) { return Nearest<113>(x, positive); @@ -727,7 +728,7 @@ return Anint>(x); } #endif -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Nint10_1)( CppTypeFor x) { return Anint>(x); @@ -750,7 +751,7 @@ return Anint>(x); } #endif -#else +#elif LDBL_MANT_DIG == 113 CppTypeFor RTNAME(Nint16_1)( CppTypeFor x) { return Anint>(x); @@ -783,12 +784,12 @@ CppTypeFor x) { return RRSpacing<53>(x); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(RRSpacing10)( CppTypeFor x) { return RRSpacing<64>(x); } -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 CppTypeFor RTNAME(RRSpacing16)( CppTypeFor x) { return RRSpacing<113>(x); @@ -803,12 +804,12 @@ CppTypeFor x, std::int64_t p) { return SetExponent(x, p); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(SetExponent10)( CppTypeFor x, std::int64_t p) { return SetExponent(x, p); } -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 CppTypeFor RTNAME(SetExponent16)( CppTypeFor x, std::int64_t p) { return SetExponent(x, p); @@ -823,12 +824,12 @@ CppTypeFor x, std::int64_t p) { return Scale(x, p); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Scale10)( CppTypeFor x, std::int64_t p) { return Scale(x, p); } -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 CppTypeFor RTNAME(Scale16)( CppTypeFor x, std::int64_t p) { return Scale(x, p); @@ -843,12 +844,12 @@ CppTypeFor x) { return Spacing<53>(x); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(Spacing10)( CppTypeFor x) { return Spacing<64>(x); } -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 CppTypeFor RTNAME(Spacing16)( CppTypeFor x) { return Spacing<113>(x); Index: flang/runtime/product.cpp =================================================================== --- flang/runtime/product.cpp +++ flang/runtime/product.cpp @@ -9,8 +9,9 @@ // Implements PRODUCT for all required operand types and shapes. #include "reduction-templates.h" -#include "flang/Common/long-double.h" +#include "flang/Runtime/float128.h" #include "flang/Runtime/reduction.h" +#include #include #include @@ -105,14 +106,14 @@ NonComplexProductAccumulator>{x}, "PRODUCT"); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(ProductReal10)(const Descriptor &x, const char *source, int line, int dim, const Descriptor *mask) { return GetTotalReduction(x, source, line, dim, mask, NonComplexProductAccumulator>{x}, "PRODUCT"); } -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 CppTypeFor RTNAME(ProductReal16)(const Descriptor &x, const char *source, int line, int dim, const Descriptor *mask) { return GetTotalReduction(x, source, line, dim, mask, @@ -135,7 +136,7 @@ mask, ComplexProductAccumulator>{x}, "PRODUCT"); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 void RTNAME(CppProductComplex10)(CppTypeFor &result, const Descriptor &x, const char *source, int line, int dim, const Descriptor *mask) { @@ -143,7 +144,7 @@ mask, ComplexProductAccumulator>{x}, "PRODUCT"); } -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 void RTNAME(CppProductComplex16)(CppTypeFor &result, const Descriptor &x, const char *source, int line, int dim, const Descriptor *mask) { Index: flang/runtime/random.cpp =================================================================== --- flang/runtime/random.cpp +++ flang/runtime/random.cpp @@ -15,6 +15,7 @@ #include "flang/Common/uint128.h" #include "flang/Runtime/cpp-type.h" #include "flang/Runtime/descriptor.h" +#include "flang/Runtime/float128.h" #include #include #include @@ -113,23 +114,26 @@ // TODO: REAL (2 & 3) case 4: Generate, 24>(harvest); - break; + return; case 8: Generate, 53>(harvest); - break; -#if LONG_DOUBLE == 80 + return; case 10: - Generate, 64>(harvest); + if constexpr (HasCppTypeFor) { + Generate, 64>(harvest); + return; + } break; -#elif LONG_DOUBLE == 128 case 16: - Generate, 113>(harvest); - break; + if constexpr (HasCppTypeFor) { +#if LDBL_MANT_DIG == 113 + Generate, 113>(harvest); + return; #endif - default: - terminator.Crash( - "not yet implemented: RANDOM_NUMBER(): REAL kind %d", kind); + } + break; } + terminator.Crash("not yet implemented: RANDOM_NUMBER(): REAL kind %d", kind); } void RTNAME(RandomSeedSize)( Index: flang/runtime/sum.cpp =================================================================== --- flang/runtime/sum.cpp +++ flang/runtime/sum.cpp @@ -13,8 +13,9 @@ // (basically the same as manual "double-double"). #include "reduction-templates.h" -#include "flang/Common/long-double.h" +#include "flang/Runtime/float128.h" #include "flang/Runtime/reduction.h" +#include #include #include @@ -129,13 +130,14 @@ return GetTotalReduction( x, source, line, dim, mask, RealSumAccumulator{x}, "SUM"); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 CppTypeFor RTNAME(SumReal10)(const Descriptor &x, const char *source, int line, int dim, const Descriptor *mask) { return GetTotalReduction( x, source, line, dim, mask, RealSumAccumulator{x}, "SUM"); } -#elif LONG_DOUBLE == 128 +#endif +#if LDBL_MANT_DIG == 113 || HAS_FLOAT128 CppTypeFor RTNAME(SumReal16)(const Descriptor &x, const char *source, int line, int dim, const Descriptor *mask) { return GetTotalReduction( @@ -155,14 +157,14 @@ result = GetTotalReduction( x, source, line, dim, mask, ComplexSumAccumulator{x}, "SUM"); } -#if LONG_DOUBLE == 80 +#if LDBL_MANT_DIG == 64 void RTNAME(CppSumComplex10)(CppTypeFor &result, const Descriptor &x, const char *source, int line, int dim, const Descriptor *mask) { result = GetTotalReduction( x, source, line, dim, mask, ComplexSumAccumulator{x}, "SUM"); } -#elif LONG_DOUBLE == 128 +#elif LDBL_MANT_DIG == 113 void RTNAME(CppSumComplex16)(CppTypeFor &result, const Descriptor &x, const char *source, int line, int dim, const Descriptor *mask) { Index: flang/runtime/tools.h =================================================================== --- flang/runtime/tools.h +++ flang/runtime/tools.h @@ -10,7 +10,6 @@ #define FORTRAN_RUNTIME_TOOLS_H_ #include "terminator.h" -#include "flang/Common/long-double.h" #include "flang/Runtime/cpp-type.h" #include "flang/Runtime/descriptor.h" #include "flang/Runtime/memory.h" @@ -148,16 +147,18 @@ return FUNC{}(std::forward(x)...); case 8: return FUNC{}(std::forward(x)...); -#if LONG_DOUBLE == 80 case 10: - return FUNC{}(std::forward(x)...); -#elif LONG_DOUBLE == 128 + if constexpr (HasCppTypeFor) { + return FUNC{}(std::forward(x)...); + } + break; case 16: - return FUNC{}(std::forward(x)...); -#endif - default: - terminator.Crash("not yet implemented: REAL(KIND=%d)", kind); + if constexpr (HasCppTypeFor) { + return FUNC{}(std::forward(x)...); + } + break; } + terminator.Crash("not yet implemented: REAL(KIND=%d)", kind); case TypeCategory::Complex: switch (kind) { #if 0 // TODO: COMPLEX(2 & 3) @@ -170,16 +171,18 @@ return FUNC{}(std::forward(x)...); case 8: return FUNC{}(std::forward(x)...); -#if LONG_DOUBLE == 80 case 10: - return FUNC{}(std::forward(x)...); -#elif LONG_DOUBLE == 128 + if constexpr (HasCppTypeFor) { + return FUNC{}(std::forward(x)...); + } + break; case 16: - return FUNC{}(std::forward(x)...); -#endif - default: - terminator.Crash("not yet implemented: COMPLEX(KIND=%d)", kind); + if constexpr (HasCppTypeFor) { + return FUNC{}(std::forward(x)...); + } + break; } + terminator.Crash("not yet implemented: COMPLEX(KIND=%d)", kind); case TypeCategory::Character: switch (kind) { case 1: @@ -246,16 +249,18 @@ return FUNC<4>{}(std::forward(x)...); case 8: return FUNC<8>{}(std::forward(x)...); -#if LONG_DOUBLE == 80 case 10: - return FUNC<10>{}(std::forward(x)...); -#elif LONG_DOUBLE == 128 + if constexpr (HasCppTypeFor) { + return FUNC<10>{}(std::forward(x)...); + } + break; case 16: - return FUNC<16>{}(std::forward(x)...); -#endif - default: - terminator.Crash("not yet implemented: REAL/COMPLEX(KIND=%d)", kind); + if constexpr (HasCppTypeFor) { + return FUNC<16>{}(std::forward(x)...); + } + break; } + terminator.Crash("not yet implemented: REAL/COMPLEX(KIND=%d)", kind); } template