diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt --- a/flang/runtime/CMakeLists.txt +++ b/flang/runtime/CMakeLists.txt @@ -51,6 +51,7 @@ io-stmt.cpp main.cpp memory.cpp + numeric.cpp reduction.cpp stat.cpp stop.cpp diff --git a/flang/runtime/numeric.h b/flang/runtime/numeric.h new file mode 100644 --- /dev/null +++ b/flang/runtime/numeric.h @@ -0,0 +1,329 @@ +//===-- runtime/numeric.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 +// +//===----------------------------------------------------------------------===// + +// Defines API between compiled code and the implementations of various numeric +// intrinsic functions in the runtime library. + +#ifndef FORTRAN_RUNTIME_NUMERIC_H_ +#define FORTRAN_RUNTIME_NUMERIC_H_ + +#include "cpp-type.h" +#include "entry-names.h" + +namespace Fortran::runtime { +extern "C" { + +// AINT +CppTypeFor RTNAME(Aint4_4)( + CppTypeFor); +CppTypeFor RTNAME(Aint4_8)( + CppTypeFor); +CppTypeFor RTNAME(Aint4_10)( + CppTypeFor); +CppTypeFor RTNAME(Aint4_16)( + CppTypeFor); +CppTypeFor RTNAME(Aint8_4)( + CppTypeFor); +CppTypeFor RTNAME(Aint8_8)( + CppTypeFor); +CppTypeFor RTNAME(Aint8_10)( + CppTypeFor); +CppTypeFor RTNAME(Aint8_16)( + CppTypeFor); +CppTypeFor RTNAME(Aint10_4)( + CppTypeFor); +CppTypeFor RTNAME(Aint10_8)( + CppTypeFor); +CppTypeFor RTNAME(Aint10_10)( + CppTypeFor); +CppTypeFor RTNAME(Aint16_4)( + CppTypeFor); +CppTypeFor RTNAME(Aint16_8)( + CppTypeFor); +CppTypeFor RTNAME(Aint16_16)( + CppTypeFor); + +// ANINT +CppTypeFor RTNAME(Anint4_4)( + CppTypeFor); +CppTypeFor RTNAME(Anint4_8)( + CppTypeFor); +CppTypeFor RTNAME(Anint4_10)( + CppTypeFor); +CppTypeFor RTNAME(Anint4_16)( + CppTypeFor); +CppTypeFor RTNAME(Anint8_4)( + CppTypeFor); +CppTypeFor RTNAME(Anint8_8)( + CppTypeFor); +CppTypeFor RTNAME(Anint8_10)( + CppTypeFor); +CppTypeFor RTNAME(Anint8_16)( + CppTypeFor); +CppTypeFor RTNAME(Anint10_4)( + CppTypeFor); +CppTypeFor RTNAME(Anint10_8)( + CppTypeFor); +CppTypeFor RTNAME(Anint10_10)( + CppTypeFor); +CppTypeFor RTNAME(Anint16_4)( + CppTypeFor); +CppTypeFor RTNAME(Anint16_8)( + CppTypeFor); +CppTypeFor RTNAME(Anint16_16)( + CppTypeFor); + +// CEILING +CppTypeFor RTNAME(Ceiling4_1)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling4_2)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling4_4)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling4_8)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling4_16)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling8_1)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling8_2)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling8_4)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling8_8)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling8_16)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling10_1)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling10_2)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling10_4)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling10_8)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling10_16)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling16_1)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling16_2)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling16_4)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling16_8)( + CppTypeFor); +CppTypeFor RTNAME(Ceiling16_16)( + CppTypeFor); + +// EXPONENT is defined to return default INTEGER; support INTEGER(4 & 8) +CppTypeFor RTNAME(Exponent4_4)( + CppTypeFor); +CppTypeFor RTNAME(Exponent4_8)( + CppTypeFor); +CppTypeFor RTNAME(Exponent8_4)( + CppTypeFor); +CppTypeFor RTNAME(Exponent8_8)( + CppTypeFor); +CppTypeFor RTNAME(Exponent10_4)( + CppTypeFor); +CppTypeFor RTNAME(Exponent10_8)( + CppTypeFor); +CppTypeFor RTNAME(Exponent16_4)( + CppTypeFor); +CppTypeFor RTNAME(Exponent16_8)( + CppTypeFor); + +// FLOOR +CppTypeFor RTNAME(Floor4_1)( + CppTypeFor); +CppTypeFor RTNAME(Floor4_2)( + CppTypeFor); +CppTypeFor RTNAME(Floor4_4)( + CppTypeFor); +CppTypeFor RTNAME(Floor4_8)( + CppTypeFor); +CppTypeFor RTNAME(Floor4_16)( + CppTypeFor); +CppTypeFor RTNAME(Floor8_1)( + CppTypeFor); +CppTypeFor RTNAME(Floor8_2)( + CppTypeFor); +CppTypeFor RTNAME(Floor8_4)( + CppTypeFor); +CppTypeFor RTNAME(Floor8_8)( + CppTypeFor); +CppTypeFor RTNAME(Floor8_16)( + CppTypeFor); +CppTypeFor RTNAME(Floor10_1)( + CppTypeFor); +CppTypeFor RTNAME(Floor10_2)( + CppTypeFor); +CppTypeFor RTNAME(Floor10_4)( + CppTypeFor); +CppTypeFor RTNAME(Floor10_8)( + CppTypeFor); +CppTypeFor RTNAME(Floor10_16)( + CppTypeFor); +CppTypeFor RTNAME(Floor16_1)( + CppTypeFor); +CppTypeFor RTNAME(Floor16_2)( + CppTypeFor); +CppTypeFor RTNAME(Floor16_4)( + CppTypeFor); +CppTypeFor RTNAME(Floor16_8)( + CppTypeFor); +CppTypeFor RTNAME(Floor16_16)( + CppTypeFor); + +// FRACTION +CppTypeFor RTNAME(Fraction4)( + CppTypeFor); +CppTypeFor RTNAME(Fraction8)( + CppTypeFor); +CppTypeFor RTNAME(Fraction10)( + CppTypeFor); +CppTypeFor RTNAME(Fraction16)( + CppTypeFor); + +// MOD & MODULO +CppTypeFor RTNAME(ModInteger1)( + CppTypeFor, CppTypeFor); +CppTypeFor RTNAME(ModInteger2)( + CppTypeFor, CppTypeFor); +CppTypeFor RTNAME(ModInteger4)( + CppTypeFor, CppTypeFor); +CppTypeFor RTNAME(ModInteger8)( + CppTypeFor, CppTypeFor); +CppTypeFor RTNAME(ModInteger16)( + CppTypeFor, + CppTypeFor); +CppTypeFor RTNAME(ModReal4)( + CppTypeFor, CppTypeFor); +CppTypeFor RTNAME(ModReal8)( + CppTypeFor, CppTypeFor); +CppTypeFor RTNAME(ModReal10)( + CppTypeFor, CppTypeFor); +CppTypeFor RTNAME(ModReal16)( + CppTypeFor, CppTypeFor); + +CppTypeFor RTNAME(ModuloInteger1)( + CppTypeFor, CppTypeFor); +CppTypeFor RTNAME(ModuloInteger2)( + CppTypeFor, CppTypeFor); +CppTypeFor RTNAME(ModuloInteger4)( + CppTypeFor, CppTypeFor); +CppTypeFor RTNAME(ModuloInteger8)( + CppTypeFor, CppTypeFor); +CppTypeFor RTNAME(ModuloInteger16)( + CppTypeFor, + CppTypeFor); +CppTypeFor RTNAME(ModuloReal4)( + CppTypeFor, CppTypeFor); +CppTypeFor RTNAME(ModuloReal8)( + CppTypeFor, CppTypeFor); +CppTypeFor RTNAME(ModuloReal10)( + CppTypeFor, CppTypeFor); +CppTypeFor RTNAME(ModuloReal16)( + CppTypeFor, CppTypeFor); + +// NINT +CppTypeFor RTNAME(Nint4_1)( + CppTypeFor); +CppTypeFor RTNAME(Nint4_2)( + CppTypeFor); +CppTypeFor RTNAME(Nint4_4)( + CppTypeFor); +CppTypeFor RTNAME(Nint4_8)( + CppTypeFor); +CppTypeFor RTNAME(Nint4_16)( + CppTypeFor); +CppTypeFor RTNAME(Nint8_1)( + CppTypeFor); +CppTypeFor RTNAME(Nint8_2)( + CppTypeFor); +CppTypeFor RTNAME(Nint8_4)( + CppTypeFor); +CppTypeFor RTNAME(Nint8_8)( + CppTypeFor); +CppTypeFor RTNAME(Nint8_16)( + CppTypeFor); +CppTypeFor RTNAME(Nint10_1)( + CppTypeFor); +CppTypeFor RTNAME(Nint10_2)( + CppTypeFor); +CppTypeFor RTNAME(Nint10_4)( + CppTypeFor); +CppTypeFor RTNAME(Nint10_8)( + CppTypeFor); +CppTypeFor RTNAME(Nint10_16)( + CppTypeFor); +CppTypeFor RTNAME(Nint16_1)( + CppTypeFor); +CppTypeFor RTNAME(Nint16_2)( + CppTypeFor); +CppTypeFor RTNAME(Nint16_4)( + CppTypeFor); +CppTypeFor RTNAME(Nint16_8)( + CppTypeFor); +CppTypeFor RTNAME(Nint16_16)( + CppTypeFor); + +// NEAREST +// The second argument to NEAREST is the result of a comparison +// to zero (i.e., S > 0) +CppTypeFor RTNAME(Nearest4)( + CppTypeFor, bool positive); +CppTypeFor RTNAME(Nearest8)( + CppTypeFor, bool positive); +CppTypeFor RTNAME(Nearest10)( + CppTypeFor, bool positive); +CppTypeFor RTNAME(Nearest16)( + CppTypeFor, bool positive); + +// RRSPACING +CppTypeFor RTNAME(RRSpacing4)( + CppTypeFor); +CppTypeFor RTNAME(RRSpacing8)( + CppTypeFor); +CppTypeFor RTNAME(RRSpacing10)( + CppTypeFor); +CppTypeFor RTNAME(RRSpacing16)( + CppTypeFor); + +// 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); +CppTypeFor RTNAME(SetExponent10)( + CppTypeFor, std::int64_t); +CppTypeFor RTNAME(SetExponent16)( + CppTypeFor, std::int64_t); + +// SCALE +CppTypeFor RTNAME(Scale4)( + CppTypeFor, std::int64_t); +CppTypeFor RTNAME(Scale8)( + CppTypeFor, std::int64_t); +CppTypeFor RTNAME(Scale10)( + CppTypeFor, std::int64_t); +CppTypeFor RTNAME(Scale16)( + CppTypeFor, std::int64_t); + +// SPACING +CppTypeFor RTNAME(Spacing4)( + CppTypeFor); +CppTypeFor RTNAME(Spacing8)( + CppTypeFor); +CppTypeFor RTNAME(Spacing10)( + CppTypeFor); +CppTypeFor RTNAME(Spacing16)( + CppTypeFor); +} // extern "C" +} // namespace Fortran::runtime +#endif // FORTRAN_RUNTIME_NUMERIC_H_ diff --git a/flang/runtime/numeric.cpp b/flang/runtime/numeric.cpp new file mode 100644 --- /dev/null +++ b/flang/runtime/numeric.cpp @@ -0,0 +1,773 @@ +//===-- runtime/numeric.cpp -------------------------------------*- 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 +// +//===----------------------------------------------------------------------===// + +#include "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)}; + 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); +} +CppTypeFor RTNAME(Ceiling4_16)( + CppTypeFor x) { + return Ceiling>(x); +} +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); +} +CppTypeFor RTNAME(Ceiling8_16)( + CppTypeFor x) { + return Ceiling>(x); +} +#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); +} +CppTypeFor RTNAME(Ceiling10_16)( + CppTypeFor x) { + return Ceiling>(x); +} +#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); +} +CppTypeFor RTNAME(Ceiling16_16)( + CppTypeFor x) { + return Ceiling>(x); +} +#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); +} +CppTypeFor RTNAME(Floor4_16)( + CppTypeFor x) { + return Floor>(x); +} +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); +} +CppTypeFor RTNAME(Floor8_16)( + CppTypeFor x) { + return Floor>(x); +} +#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); +} +CppTypeFor RTNAME(Floor10_16)( + CppTypeFor x) { + return Floor>(x); +} +#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); +} +CppTypeFor RTNAME(Floor16_16)( + CppTypeFor x) { + return Floor>(x); +} +#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 + +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); +} +CppTypeFor RTNAME(ModInteger16)( + CppTypeFor x, + CppTypeFor p) { + return IntMod(x, p); +} +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); +} +CppTypeFor RTNAME(ModuloInteger16)( + CppTypeFor x, + CppTypeFor p) { + return IntMod(x, p); +} +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); +} +CppTypeFor RTNAME(Nint4_16)( + CppTypeFor x) { + return Anint>(x); +} +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); +} +CppTypeFor RTNAME(Nint8_16)( + CppTypeFor x) { + return Anint>(x); +} +#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); +} +CppTypeFor RTNAME(Nint10_16)( + CppTypeFor x) { + return Anint>(x); +} +#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); +} +CppTypeFor RTNAME(Nint16_16)( + CppTypeFor x) { + return Anint>(x); +} +#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 diff --git a/flang/unittests/RuntimeGTest/CMakeLists.txt b/flang/unittests/RuntimeGTest/CMakeLists.txt --- a/flang/unittests/RuntimeGTest/CMakeLists.txt +++ b/flang/unittests/RuntimeGTest/CMakeLists.txt @@ -1,6 +1,7 @@ add_flang_unittest(FlangRuntimeTests CharacterTest.cpp CrashHandlerFixture.cpp + Numeric.cpp NumericalFormatTest.cpp Reduction.cpp RuntimeCrashTest.cpp diff --git a/flang/unittests/RuntimeGTest/Numeric.cpp b/flang/unittests/RuntimeGTest/Numeric.cpp new file mode 100644 --- /dev/null +++ b/flang/unittests/RuntimeGTest/Numeric.cpp @@ -0,0 +1,168 @@ +//===-- flang/unittests/RuntimeGTest/Numeric.cpp ----------------*- 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 +// +//===----------------------------------------------------------------------===// + +#include "../../runtime/numeric.h" +#include "gtest/gtest.h" +#include +#include + +using namespace Fortran::runtime; +using Fortran::common::TypeCategory; +template using Int = CppTypeFor; +template using Real = CppTypeFor; + +// Simple tests of numeric intrinsic functions using examples from Fortran 2018 + +TEST(Numeric, Aint) { + EXPECT_EQ(RTNAME(Aint4_4)(Real<4>{3.7}), 3.0); + EXPECT_EQ(RTNAME(Aint8_4)(Real<8>{-3.7}), -3.0); + EXPECT_EQ(RTNAME(Aint8_8)(Real<8>{0}), 0.0); + EXPECT_EQ(RTNAME(Aint4_4)(std::numeric_limits>::infinity()), + std::numeric_limits>::infinity()); + EXPECT_TRUE( + std::isnan(RTNAME(Aint8_8)(std::numeric_limits>::quiet_NaN()))); +} + +TEST(Numeric, Anint) { + EXPECT_EQ(RTNAME(Anint4_4)(Real<4>{2.783}), 3.0); + EXPECT_EQ(RTNAME(Anint8_4)(Real<8>{-2.783}), -3.0); + EXPECT_EQ(RTNAME(Anint4_4)(Real<4>{2.5}), 3.0); + EXPECT_EQ(RTNAME(Anint8_4)(Real<8>{-2.5}), -3.0); + EXPECT_EQ(RTNAME(Anint8_8)(Real<8>{0}), 0.0); + EXPECT_EQ(RTNAME(Anint4_4)(std::numeric_limits>::infinity()), + std::numeric_limits>::infinity()); + EXPECT_TRUE( + std::isnan(RTNAME(Aint8_8)(std::numeric_limits>::quiet_NaN()))); +} + +TEST(Numeric, Ceiling) { + EXPECT_EQ(RTNAME(Ceiling4_4)(Real<4>{3.7}), 4); + EXPECT_EQ(RTNAME(Ceiling8_8)(Real<8>{-3.7}), -3); + EXPECT_EQ(RTNAME(Ceiling4_1)(Real<4>{0}), 0); + EXPECT_EQ(RTNAME(Ceiling4_4)(std::numeric_limits>::infinity()), + std::numeric_limits>::min()); + EXPECT_EQ(RTNAME(Ceiling4_4)(std::numeric_limits>::quiet_NaN()), + std::numeric_limits>::min()); +} + +TEST(Numeric, Floor) { + EXPECT_EQ(RTNAME(Floor4_4)(Real<4>{3.7}), 3); + EXPECT_EQ(RTNAME(Floor8_8)(Real<8>{-3.7}), -4); + EXPECT_EQ(RTNAME(Floor4_1)(Real<4>{0}), 0); + EXPECT_EQ(RTNAME(Floor4_4)(std::numeric_limits>::infinity()), + std::numeric_limits>::min()); + EXPECT_EQ(RTNAME(Floor4_4)(std::numeric_limits>::quiet_NaN()), + std::numeric_limits>::min()); +} + +TEST(Numeric, Exponent) { + EXPECT_EQ(RTNAME(Exponent4_4)(Real<4>{0}), 0); + EXPECT_EQ(RTNAME(Exponent4_8)(Real<4>{1.0}), 1); + EXPECT_EQ(RTNAME(Exponent8_4)(Real<8>{4.1}), 3); + EXPECT_EQ(RTNAME(Exponent8_8)(std::numeric_limits>::infinity()), + std::numeric_limits>::max()); + EXPECT_EQ(RTNAME(Exponent8_8)(std::numeric_limits>::quiet_NaN()), + std::numeric_limits>::max()); +} + +TEST(Numeric, Fraction) { + EXPECT_EQ(RTNAME(Fraction4)(Real<4>{0}), 0); + EXPECT_EQ(RTNAME(Fraction8)(Real<8>{3.0}), 0.75); + EXPECT_TRUE( + std::isnan(RTNAME(Fraction4)(std::numeric_limits>::infinity()))); + EXPECT_TRUE( + std::isnan(RTNAME(Fraction8)(std::numeric_limits>::quiet_NaN()))); +} + +TEST(Numeric, Mod) { + EXPECT_EQ(RTNAME(ModInteger1)(Int<1>{8}, Int<1>(5)), 3); + EXPECT_EQ(RTNAME(ModInteger4)(Int<4>{-8}, Int<4>(5)), -3); + EXPECT_EQ(RTNAME(ModInteger2)(Int<2>{8}, Int<2>(-5)), 3); + EXPECT_EQ(RTNAME(ModInteger8)(Int<8>{-8}, Int<8>(-5)), -3); + EXPECT_EQ(RTNAME(ModReal4)(Real<4>{8.0}, Real<4>(5.0)), 3.0); + EXPECT_EQ(RTNAME(ModReal4)(Real<4>{-8.0}, Real<4>(5.0)), -3.0); + EXPECT_EQ(RTNAME(ModReal8)(Real<8>{8.0}, Real<8>(-5.0)), 3.0); + EXPECT_EQ(RTNAME(ModReal8)(Real<8>{-8.0}, Real<8>(-5.0)), -3.0); +} + +TEST(Numeric, Modulo) { + EXPECT_EQ(RTNAME(ModuloInteger1)(Int<1>{8}, Int<1>(5)), 3); + EXPECT_EQ(RTNAME(ModuloInteger4)(Int<4>{-8}, Int<4>(5)), 2); + EXPECT_EQ(RTNAME(ModuloInteger2)(Int<2>{8}, Int<2>(-5)), -2); + EXPECT_EQ(RTNAME(ModuloInteger8)(Int<8>{-8}, Int<8>(-5)), -3); + EXPECT_EQ(RTNAME(ModuloReal4)(Real<4>{8.0}, Real<4>(5.0)), 3.0); + EXPECT_EQ(RTNAME(ModuloReal4)(Real<4>{-8.0}, Real<4>(5.0)), 2.0); + EXPECT_EQ(RTNAME(ModuloReal8)(Real<8>{8.0}, Real<8>(-5.0)), -2.0); + EXPECT_EQ(RTNAME(ModuloReal8)(Real<8>{-8.0}, Real<8>(-5.0)), -3.0); +} + +TEST(Numeric, Nearest) { + EXPECT_EQ(RTNAME(Nearest4)(Real<4>{0}, true), + std::numeric_limits>::denorm_min()); + EXPECT_EQ(RTNAME(Nearest4)(Real<4>{3.0}, true), + Real<4>{3.0} + std::ldexp(Real<4>{1.0}, -22)); + EXPECT_EQ(RTNAME(Nearest8)(Real<8>{1.0}, true), + Real<8>{1.0} + std::ldexp(Real<8>{1.0}, -52)); + EXPECT_EQ(RTNAME(Nearest8)(Real<8>{1.0}, false), + Real<8>{1.0} - std::ldexp(Real<8>{1.0}, -52)); +} + +TEST(Numeric, Nint) { + EXPECT_EQ(RTNAME(Nint4_4)(Real<4>{2.783}), 3); + EXPECT_EQ(RTNAME(Nint8_4)(Real<8>{-2.783}), -3); + EXPECT_EQ(RTNAME(Nint4_4)(Real<4>{2.5}), 3); + EXPECT_EQ(RTNAME(Nint8_4)(Real<8>{-2.5}), -3); + EXPECT_EQ(RTNAME(Nint8_8)(Real<8>{0}), 0); + EXPECT_EQ(RTNAME(Nint4_4)(std::numeric_limits>::infinity()), + std::numeric_limits>::min()); + EXPECT_EQ(RTNAME(Nint4_4)(std::numeric_limits>::quiet_NaN()), + std::numeric_limits>::min()); +} + +TEST(Numeric, RRSpacing) { + EXPECT_EQ(RTNAME(RRSpacing8)(Real<8>{0}), 0); + EXPECT_EQ(RTNAME(RRSpacing4)(Real<4>{-3.0}), 0.75 * (1 << 24)); + EXPECT_EQ(RTNAME(RRSpacing8)(Real<8>{-3.0}), 0.75 * (std::int64_t{1} << 53)); + EXPECT_TRUE( + std::isnan(RTNAME(RRSpacing4)(std::numeric_limits>::infinity()))); + EXPECT_TRUE(std::isnan( + RTNAME(RRSpacing8)(std::numeric_limits>::quiet_NaN()))); +} + +TEST(Numeric, Scale) { + EXPECT_EQ(RTNAME(Scale4)(Real<4>{0}, 0), 0); + EXPECT_EQ(RTNAME(Scale4)(Real<4>{1.0}, 0), 1.0); + EXPECT_EQ(RTNAME(Scale4)(Real<4>{1.0}, 1), 2.0); + EXPECT_EQ(RTNAME(Scale4)(Real<4>{1.0}, -1), 0.5); + EXPECT_TRUE( + std::isinf(RTNAME(Scale4)(std::numeric_limits>::infinity(), 1))); + EXPECT_TRUE( + std::isnan(RTNAME(Scale8)(std::numeric_limits>::quiet_NaN(), 1))); +} + +TEST(Numeric, SetExponent) { + EXPECT_EQ(RTNAME(SetExponent4)(Real<4>{0}, 0), 0); + EXPECT_EQ(RTNAME(SetExponent8)(Real<8>{0}, 666), 0); + EXPECT_EQ(RTNAME(SetExponent8)(Real<8>{3.0}, 0), 1.5); + EXPECT_EQ(RTNAME(SetExponent4)(Real<4>{1.0}, 0), 1.0); + EXPECT_EQ(RTNAME(SetExponent4)(Real<4>{1.0}, 1), 2.0); + EXPECT_EQ(RTNAME(SetExponent4)(Real<4>{1.0}, -1), 0.5); + EXPECT_TRUE(std::isnan( + RTNAME(SetExponent4)(std::numeric_limits>::infinity(), 1))); + EXPECT_TRUE(std::isnan( + RTNAME(SetExponent8)(std::numeric_limits>::quiet_NaN(), 1))); +} + +TEST(Numeric, Spacing) { + EXPECT_EQ(RTNAME(Spacing8)(Real<8>{0}), std::numeric_limits>::min()); + EXPECT_EQ(RTNAME(Spacing4)(Real<4>{3.0}), std::ldexp(Real<4>{1.0}, -22)); + EXPECT_TRUE( + std::isnan(RTNAME(Spacing4)(std::numeric_limits>::infinity()))); + EXPECT_TRUE( + std::isnan(RTNAME(Spacing8)(std::numeric_limits>::quiet_NaN()))); +}