//===-- runtime/numeric.cpp -----------------------------------------------===// // // 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 // //===----------------------------------------------------------------------===// #include "flang/Runtime/numeric.h" #include "flang/Common/long-double.h" #include #include #include namespace Fortran::runtime { // AINT template inline RESULT Aint(ARG x) { return std::trunc(x); } // ANINT & NINT template inline RESULT Anint(ARG x) { if (x >= 0) { return std::trunc(x + ARG{0.5}); } else { return std::trunc(x - ARG{0.5}); } } // CEILING & FLOOR (16.9.43, .79) template inline RESULT Ceiling(ARG x) { return std::ceil(x); } template inline RESULT Floor(ARG x) { return std::floor(x); } // EXPONENT (16.9.75) template inline RESULT Exponent(ARG x) { if (std::isinf(x) || std::isnan(x)) { return std::numeric_limits::max(); // +/-Inf, NaN -> HUGE(0) } else if (x == 0) { return 0; // 0 -> 0 } else { return std::ilogb(x) + 1; } } // FRACTION (16.9.80) template inline T Fraction(T x) { if (std::isnan(x)) { return x; // NaN -> same NaN } else if (std::isinf(x)) { return std::numeric_limits::quiet_NaN(); // +/-Inf -> NaN } else if (x == 0) { return 0; // 0 -> 0 } else { int ignoredExp; return std::frexp(x, &ignoredExp); } } // MOD & MODULO (16.9.135, .136) template inline T IntMod(T x, T p) { auto mod{x - (x / p) * p}; if (IS_MODULO && (x > 0) != (p > 0)) { mod += p; } return mod; } template inline T RealMod(T x, T p) { if constexpr (IS_MODULO) { return x - std::floor(x / p) * p; } else { return x - std::trunc(x / p) * p; } } // RRSPACING (16.9.164) template inline T RRSpacing(T x) { if (std::isnan(x)) { return x; // NaN -> same NaN } else if (std::isinf(x)) { return std::numeric_limits::quiet_NaN(); // +/-Inf -> NaN } else if (x == 0) { return 0; // 0 -> 0 } else { return std::ldexp(std::abs(x), PREC - (std::ilogb(x) + 1)); } } // SCALE (16.9.166) template inline T Scale(T x, std::int64_t p) { auto ip{static_cast(p)}; if (ip != p) { ip = p < 0 ? std::numeric_limits::min() : std::numeric_limits::max(); } return std::ldexp(x, p); // x*2**p } // SET_EXPONENT (16.9.171) template inline T SetExponent(T x, std::int64_t p) { if (std::isnan(x)) { return x; // NaN -> same NaN } else if (std::isinf(x)) { return std::numeric_limits::quiet_NaN(); // +/-Inf -> NaN } else if (x == 0) { return 0; // 0 -> 0 } else { int expo{std::ilogb(x) + 1}; auto ip{static_cast(p - expo)}; if (ip != p - expo) { ip = p < 0 ? std::numeric_limits::min() : std::numeric_limits::max(); } return std::ldexp(x, ip); // x*2**(p-e) } } // SPACING (16.9.180) template inline T Spacing(T x) { if (std::isnan(x)) { return x; // NaN -> same NaN } else if (std::isinf(x)) { return std::numeric_limits::quiet_NaN(); // +/-Inf -> NaN } else if (x == 0) { // The standard-mandated behavior seems broken, since TINY() can't be // subnormal. return std::numeric_limits::min(); // 0 -> TINY(x) } else { return std::ldexp( static_cast(1.0), std::ilogb(x) + 1 - PREC); // 2**(e-p) } } // NEAREST (16.9.139) template inline T Nearest(T x, bool positive) { auto spacing{Spacing(x)}; if (x == 0) { auto least{std::numeric_limits::denorm_min()}; return positive ? least : -least; } else { return positive ? x + spacing : x - spacing; } } extern "C" { CppTypeFor RTNAME(Aint4_4)( CppTypeFor x) { return Aint>(x); } CppTypeFor RTNAME(Aint4_8)( CppTypeFor x) { return Aint>(x); } CppTypeFor RTNAME(Aint8_4)( CppTypeFor x) { return Aint>(x); } CppTypeFor RTNAME(Aint8_8)( CppTypeFor x) { return Aint>(x); } #if LONG_DOUBLE == 80 CppTypeFor RTNAME(Aint4_10)( CppTypeFor x) { return Aint>(x); } CppTypeFor RTNAME(Aint8_10)( CppTypeFor x) { return Aint>(x); } CppTypeFor RTNAME(Aint10_4)( CppTypeFor x) { return Aint>(x); } CppTypeFor RTNAME(Aint10_8)( CppTypeFor x) { return Aint>(x); } CppTypeFor RTNAME(Aint10_10)( CppTypeFor x) { return Aint>(x); } #elif LONG_DOUBLE == 128 CppTypeFor RTNAME(Aint4_16)( CppTypeFor x) { return Aint>(x); } CppTypeFor RTNAME(Aint8_16)( CppTypeFor x) { return Aint>(x); } CppTypeFor RTNAME(Aint16_4)( CppTypeFor x) { return Aint>(x); } CppTypeFor RTNAME(Aint16_8)( CppTypeFor x) { return Aint>(x); } CppTypeFor RTNAME(Aint16_16)( CppTypeFor x) { return Aint>(x); } #endif CppTypeFor RTNAME(Anint4_4)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Anint4_8)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Anint8_4)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Anint8_8)( CppTypeFor x) { return Anint>(x); } #if LONG_DOUBLE == 80 CppTypeFor RTNAME(Anint4_10)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Anint8_10)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Anint10_4)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Anint10_8)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Anint10_10)( CppTypeFor x) { return Anint>(x); } #elif LONG_DOUBLE == 128 CppTypeFor RTNAME(Anint4_16)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Anint8_16)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Anint16_4)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Anint16_8)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Anint16_16)( CppTypeFor x) { return Anint>(x); } #endif CppTypeFor RTNAME(Ceiling4_1)( CppTypeFor x) { return Ceiling>(x); } CppTypeFor RTNAME(Ceiling4_2)( CppTypeFor x) { return Ceiling>(x); } CppTypeFor RTNAME(Ceiling4_4)( CppTypeFor x) { return Ceiling>(x); } CppTypeFor RTNAME(Ceiling4_8)( CppTypeFor x) { return Ceiling>(x); } #ifdef __SIZEOF_INT128__ CppTypeFor RTNAME(Ceiling4_16)( CppTypeFor x) { return Ceiling>(x); } #endif CppTypeFor RTNAME(Ceiling8_1)( CppTypeFor x) { return Ceiling>(x); } CppTypeFor RTNAME(Ceiling8_2)( CppTypeFor x) { return Ceiling>(x); } CppTypeFor RTNAME(Ceiling8_4)( CppTypeFor x) { return Ceiling>(x); } CppTypeFor RTNAME(Ceiling8_8)( CppTypeFor x) { return Ceiling>(x); } #ifdef __SIZEOF_INT128__ CppTypeFor RTNAME(Ceiling8_16)( CppTypeFor x) { return Ceiling>(x); } #endif #if LONG_DOUBLE == 80 CppTypeFor RTNAME(Ceiling10_1)( CppTypeFor x) { return Ceiling>(x); } CppTypeFor RTNAME(Ceiling10_2)( CppTypeFor x) { return Ceiling>(x); } CppTypeFor RTNAME(Ceiling10_4)( CppTypeFor x) { return Ceiling>(x); } CppTypeFor RTNAME(Ceiling10_8)( CppTypeFor x) { return Ceiling>(x); } #ifdef __SIZEOF_INT128__ CppTypeFor RTNAME(Ceiling10_16)( CppTypeFor x) { return Ceiling>(x); } #endif #else CppTypeFor RTNAME(Ceiling16_1)( CppTypeFor x) { return Ceiling>(x); } CppTypeFor RTNAME(Ceiling16_2)( CppTypeFor x) { return Ceiling>(x); } CppTypeFor RTNAME(Ceiling16_4)( CppTypeFor x) { return Ceiling>(x); } CppTypeFor RTNAME(Ceiling16_8)( CppTypeFor x) { return Ceiling>(x); } #ifdef __SIZEOF_INT128__ CppTypeFor RTNAME(Ceiling16_16)( CppTypeFor x) { return Ceiling>(x); } #endif #endif CppTypeFor RTNAME(Exponent4_4)( CppTypeFor x) { return Exponent>(x); } CppTypeFor RTNAME(Exponent4_8)( CppTypeFor x) { return Exponent>(x); } CppTypeFor RTNAME(Exponent8_4)( CppTypeFor x) { return Exponent>(x); } CppTypeFor RTNAME(Exponent8_8)( CppTypeFor x) { return Exponent>(x); } #if LONG_DOUBLE == 80 CppTypeFor RTNAME(Exponent10_4)( CppTypeFor x) { return Exponent>(x); } CppTypeFor RTNAME(Exponent10_8)( CppTypeFor x) { return Exponent>(x); } #elif LONG_DOUBLE == 128 CppTypeFor RTNAME(Exponent16_4)( CppTypeFor x) { return Exponent>(x); } CppTypeFor RTNAME(Exponent16_8)( CppTypeFor x) { return Exponent>(x); } #endif CppTypeFor RTNAME(Floor4_1)( CppTypeFor x) { return Floor>(x); } CppTypeFor RTNAME(Floor4_2)( CppTypeFor x) { return Floor>(x); } CppTypeFor RTNAME(Floor4_4)( CppTypeFor x) { return Floor>(x); } CppTypeFor RTNAME(Floor4_8)( CppTypeFor x) { return Floor>(x); } #ifdef __SIZEOF_INT128__ CppTypeFor RTNAME(Floor4_16)( CppTypeFor x) { return Floor>(x); } #endif CppTypeFor RTNAME(Floor8_1)( CppTypeFor x) { return Floor>(x); } CppTypeFor RTNAME(Floor8_2)( CppTypeFor x) { return Floor>(x); } CppTypeFor RTNAME(Floor8_4)( CppTypeFor x) { return Floor>(x); } CppTypeFor RTNAME(Floor8_8)( CppTypeFor x) { return Floor>(x); } #ifdef __SIZEOF_INT128__ CppTypeFor RTNAME(Floor8_16)( CppTypeFor x) { return Floor>(x); } #endif #if LONG_DOUBLE == 80 CppTypeFor RTNAME(Floor10_1)( CppTypeFor x) { return Floor>(x); } CppTypeFor RTNAME(Floor10_2)( CppTypeFor x) { return Floor>(x); } CppTypeFor RTNAME(Floor10_4)( CppTypeFor x) { return Floor>(x); } CppTypeFor RTNAME(Floor10_8)( CppTypeFor x) { return Floor>(x); } #ifdef __SIZEOF_INT128__ CppTypeFor RTNAME(Floor10_16)( CppTypeFor x) { return Floor>(x); } #endif #else CppTypeFor RTNAME(Floor16_1)( CppTypeFor x) { return Floor>(x); } CppTypeFor RTNAME(Floor16_2)( CppTypeFor x) { return Floor>(x); } CppTypeFor RTNAME(Floor16_4)( CppTypeFor x) { return Floor>(x); } CppTypeFor RTNAME(Floor16_8)( CppTypeFor x) { return Floor>(x); } #ifdef __SIZEOF_INT128__ CppTypeFor RTNAME(Floor16_16)( CppTypeFor x) { return Floor>(x); } #endif #endif CppTypeFor RTNAME(Fraction4)( CppTypeFor x) { return Fraction(x); } CppTypeFor RTNAME(Fraction8)( CppTypeFor x) { return Fraction(x); } #if LONG_DOUBLE == 80 CppTypeFor RTNAME(Fraction10)( CppTypeFor x) { return Fraction(x); } #elif LONG_DOUBLE == 128 CppTypeFor RTNAME(Fraction16)( CppTypeFor x) { return Fraction(x); } #endif bool RTNAME(IsFinite4)(CppTypeFor x) { return std::isfinite(x); } bool RTNAME(IsFinite8)(CppTypeFor x) { return std::isfinite(x); } #if LONG_DOUBLE == 80 bool RTNAME(IsFinite10)(CppTypeFor x) { return std::isfinite(x); } #elif LONG_DOUBLE == 128 bool RTNAME(IsFinite16)(CppTypeFor x) { return std::isfinite(x); } #endif bool RTNAME(IsNaN4)(CppTypeFor x) { return std::isnan(x); } bool RTNAME(IsNaN8)(CppTypeFor x) { return std::isnan(x); } #if LONG_DOUBLE == 80 bool RTNAME(IsNaN10)(CppTypeFor x) { return std::isnan(x); } #elif LONG_DOUBLE == 128 bool RTNAME(IsNaN16)(CppTypeFor x) { return std::isnan(x); } #endif CppTypeFor RTNAME(ModInteger1)( CppTypeFor x, CppTypeFor p) { return IntMod(x, p); } CppTypeFor RTNAME(ModInteger2)( CppTypeFor x, CppTypeFor p) { return IntMod(x, p); } CppTypeFor RTNAME(ModInteger4)( CppTypeFor x, CppTypeFor p) { return IntMod(x, p); } CppTypeFor RTNAME(ModInteger8)( CppTypeFor x, CppTypeFor p) { return IntMod(x, p); } #ifdef __SIZEOF_INT128__ CppTypeFor RTNAME(ModInteger16)( CppTypeFor x, CppTypeFor p) { return IntMod(x, p); } #endif CppTypeFor RTNAME(ModReal4)( CppTypeFor x, CppTypeFor p) { return RealMod(x, p); } CppTypeFor RTNAME(ModReal8)( CppTypeFor x, CppTypeFor p) { return RealMod(x, p); } #if LONG_DOUBLE == 80 CppTypeFor RTNAME(ModReal10)( CppTypeFor x, CppTypeFor p) { return RealMod(x, p); } #elif LONG_DOUBLE == 128 CppTypeFor RTNAME(ModReal16)( CppTypeFor x, CppTypeFor p) { return RealMod(x, p); } #endif CppTypeFor RTNAME(ModuloInteger1)( CppTypeFor x, CppTypeFor p) { return IntMod(x, p); } CppTypeFor RTNAME(ModuloInteger2)( CppTypeFor x, CppTypeFor p) { return IntMod(x, p); } CppTypeFor RTNAME(ModuloInteger4)( CppTypeFor x, CppTypeFor p) { return IntMod(x, p); } CppTypeFor RTNAME(ModuloInteger8)( CppTypeFor x, CppTypeFor p) { return IntMod(x, p); } #ifdef __SIZEOF_INT128__ CppTypeFor RTNAME(ModuloInteger16)( CppTypeFor x, CppTypeFor p) { return IntMod(x, p); } #endif CppTypeFor RTNAME(ModuloReal4)( CppTypeFor x, CppTypeFor p) { return RealMod(x, p); } CppTypeFor RTNAME(ModuloReal8)( CppTypeFor x, CppTypeFor p) { return RealMod(x, p); } #if LONG_DOUBLE == 80 CppTypeFor RTNAME(ModuloReal10)( CppTypeFor x, CppTypeFor p) { return RealMod(x, p); } #elif LONG_DOUBLE == 128 CppTypeFor RTNAME(ModuloReal16)( CppTypeFor x, CppTypeFor p) { return RealMod(x, p); } #endif CppTypeFor RTNAME(Nearest4)( CppTypeFor x, bool positive) { return Nearest<24>(x, positive); } CppTypeFor RTNAME(Nearest8)( CppTypeFor x, bool positive) { return Nearest<53>(x, positive); } #if LONG_DOUBLE == 80 CppTypeFor RTNAME(Nearest10)( CppTypeFor x, bool positive) { return Nearest<64>(x, positive); } #elif LONG_DOUBLE == 128 CppTypeFor RTNAME(Nearest16)( CppTypeFor x, bool positive) { return Nearest<113>(x, positive); } #endif CppTypeFor RTNAME(Nint4_1)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Nint4_2)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Nint4_4)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Nint4_8)( CppTypeFor x) { return Anint>(x); } #ifdef __SIZEOF_INT128__ CppTypeFor RTNAME(Nint4_16)( CppTypeFor x) { return Anint>(x); } #endif CppTypeFor RTNAME(Nint8_1)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Nint8_2)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Nint8_4)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Nint8_8)( CppTypeFor x) { return Anint>(x); } #ifdef __SIZEOF_INT128__ CppTypeFor RTNAME(Nint8_16)( CppTypeFor x) { return Anint>(x); } #endif #if LONG_DOUBLE == 80 CppTypeFor RTNAME(Nint10_1)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Nint10_2)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Nint10_4)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Nint10_8)( CppTypeFor x) { return Anint>(x); } #ifdef __SIZEOF_INT128__ CppTypeFor RTNAME(Nint10_16)( CppTypeFor x) { return Anint>(x); } #endif #else CppTypeFor RTNAME(Nint16_1)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Nint16_2)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Nint16_4)( CppTypeFor x) { return Anint>(x); } CppTypeFor RTNAME(Nint16_8)( CppTypeFor x) { return Anint>(x); } #ifdef __SIZEOF_INT128__ CppTypeFor RTNAME(Nint16_16)( CppTypeFor x) { return Anint>(x); } #endif #endif CppTypeFor RTNAME(RRSpacing4)( CppTypeFor x) { return RRSpacing<24>(x); } CppTypeFor RTNAME(RRSpacing8)( CppTypeFor x) { return RRSpacing<53>(x); } #if LONG_DOUBLE == 80 CppTypeFor RTNAME(RRSpacing10)( CppTypeFor x) { return RRSpacing<64>(x); } #elif LONG_DOUBLE == 128 CppTypeFor RTNAME(RRSpacing16)( CppTypeFor x) { return RRSpacing<113>(x); } #endif CppTypeFor RTNAME(SetExponent4)( CppTypeFor x, std::int64_t p) { return SetExponent(x, p); } CppTypeFor RTNAME(SetExponent8)( CppTypeFor x, std::int64_t p) { return SetExponent(x, p); } #if LONG_DOUBLE == 80 CppTypeFor RTNAME(SetExponent10)( CppTypeFor x, std::int64_t p) { return SetExponent(x, p); } #elif LONG_DOUBLE == 128 CppTypeFor RTNAME(SetExponent16)( CppTypeFor x, std::int64_t p) { return SetExponent(x, p); } #endif CppTypeFor RTNAME(Scale4)( CppTypeFor x, std::int64_t p) { return Scale(x, p); } CppTypeFor RTNAME(Scale8)( CppTypeFor x, std::int64_t p) { return Scale(x, p); } #if LONG_DOUBLE == 80 CppTypeFor RTNAME(Scale10)( CppTypeFor x, std::int64_t p) { return Scale(x, p); } #elif LONG_DOUBLE == 128 CppTypeFor RTNAME(Scale16)( CppTypeFor x, std::int64_t p) { return Scale(x, p); } #endif CppTypeFor RTNAME(Spacing4)( CppTypeFor x) { return Spacing<24>(x); } CppTypeFor RTNAME(Spacing8)( CppTypeFor x) { return Spacing<53>(x); } #if LONG_DOUBLE == 80 CppTypeFor RTNAME(Spacing10)( CppTypeFor x) { return Spacing<64>(x); } #elif LONG_DOUBLE == 128 CppTypeFor RTNAME(Spacing16)( CppTypeFor x) { return Spacing<113>(x); } #endif } // extern "C" } // namespace Fortran::runtime