978 lines · cpp
1//===-- lib/runtime/numeric.cpp ---------------------------------*- C++ -*-===//2//3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4// See https://llvm.org/LICENSE.txt for license information.5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6//7//===----------------------------------------------------------------------===//8 9#include "flang/Runtime/numeric.h"10#include "flang-rt/runtime/numeric-templates.h"11#include "flang-rt/runtime/terminator.h"12#include "flang-rt/runtime/tools.h"13#include "flang/Common/float128.h"14#include <cfloat>15#include <climits>16#include <cmath>17#include <limits>18 19namespace Fortran::runtime {20 21template <typename RES>22inline RT_API_ATTRS RES GetIntArgValue(const char *source, int line,23 const void *arg, int kind, std::int64_t defaultValue, int resKind) {24 RES res;25 if (!arg) {26 res = static_cast<RES>(defaultValue);27 } else if (kind == 1) {28 res = static_cast<RES>(29 *static_cast<const CppTypeFor<TypeCategory::Integer, 1> *>(arg));30 } else if (kind == 2) {31 res = static_cast<RES>(32 *static_cast<const CppTypeFor<TypeCategory::Integer, 2> *>(arg));33 } else if (kind == 4) {34 res = static_cast<RES>(35 *static_cast<const CppTypeFor<TypeCategory::Integer, 4> *>(arg));36 } else if (kind == 8) {37 res = static_cast<RES>(38 *static_cast<const CppTypeFor<TypeCategory::Integer, 8> *>(arg));39#ifdef __SIZEOF_INT128__40 } else if (kind == 16) {41 if (resKind != 16) {42 Terminator{source, line}.Crash("Unexpected integer kind in runtime");43 }44 res = static_cast<RES>(45 *static_cast<const CppTypeFor<TypeCategory::Integer, 16> *>(arg));46#endif47 } else {48 Terminator{source, line}.Crash("Unexpected integer kind in runtime");49 }50 return res;51}52 53// NINT (16.9.141)54template <typename RESULT, typename ARG>55inline RT_API_ATTRS RESULT Nint(ARG x) {56 if (x >= 0) {57 return std::trunc(x + ARG{0.5});58 } else {59 return std::trunc(x - ARG{0.5});60 }61}62 63// CEILING & FLOOR (16.9.43, .79)64template <typename RESULT, typename ARG>65inline RT_API_ATTRS RESULT Ceiling(ARG x) {66 return std::ceil(x);67}68template <typename RESULT, typename ARG>69inline RT_API_ATTRS RESULT Floor(ARG x) {70 return std::floor(x);71}72 73// MOD & MODULO (16.9.135, .136)74template <bool IS_MODULO, typename T>75inline RT_API_ATTRS T IntMod(T x, T p, const char *sourceFile, int sourceLine) {76 if (p == 0) {77 Terminator{sourceFile, sourceLine}.Crash(78 IS_MODULO ? "MODULO with P==0" : "MOD with P==0");79 }80 auto mod{x - (x / p) * p};81 if (IS_MODULO && (x > 0) != (p > 0)) {82 mod += p;83 }84 return mod;85}86 87// SCALE (16.9.166)88template <typename T> inline RT_API_ATTRS T Scale(T x, std::int64_t p) {89 auto ip{static_cast<int>(p)};90 if (ip != p) {91 ip = p < 0 ? std::numeric_limits<int>::min()92 : std::numeric_limits<int>::max();93 }94 return std::ldexp(x, ip); // x*2**p95}96 97// SELECTED_INT_KIND (16.9.169) and SELECTED_UNSIGNED_KIND extension98template <typename X, typename M>99inline RT_API_ATTRS CppTypeFor<TypeCategory::Integer, 4> SelectedIntKind(100 X x, M mask) {101#if !defined __SIZEOF_INT128__ || defined FLANG_RUNTIME_NO_INTEGER_16102 mask &= ~(1 << 16);103#endif104 if (x <= 2 && (mask & (1 << 1))) {105 return 1;106 } else if (x <= 4 && (mask & (1 << 2))) {107 return 2;108 } else if (x <= 9 && (mask & (1 << 4))) {109 return 4;110 } else if (x <= 18 && (mask & (1 << 8))) {111 return 8;112 } else if (x <= 38 && (mask & (1 << 16))) {113 return 16;114 }115 return -1;116}117 118// SELECTED_LOGICAL_KIND (F'2023 16.9.182)119template <typename T>120inline RT_API_ATTRS CppTypeFor<TypeCategory::Integer, 4> SelectedLogicalKind(121 T x) {122 if (x <= 8) {123 return 1;124 } else if (x <= 16) {125 return 2;126 } else if (x <= 32) {127 return 4;128 } else if (x <= 64) {129 return 8;130 }131 return -1;132}133 134// SELECTED_REAL_KIND (16.9.170)135template <typename P, typename R, typename D, typename M>136inline RT_API_ATTRS CppTypeFor<TypeCategory::Integer, 4> SelectedRealKind(137 P p, R r, D d, M mask) {138 if (d != 2) {139 return -5;140 }141#ifdef FLANG_RUNTIME_NO_REAL_2142 mask &= ~(1 << 2);143#endif144#ifdef FLANG_RUNTIME_NO_REAL_3145 mask &= ~(1 << 3);146#endif147#if !HAS_FLOAT80 || defined FLANG_RUNTIME_NO_REAL_10148 mask &= ~(1 << 10);149#endif150#if LDBL_MANT_DIG < 64 || defined FLANG_RUNTIME_NO_REAL_16151 mask &= ~(1 << 16);152#endif153 154 int error{0};155 int kind{0};156 if (p <= 3 && (mask & (1 << 2))) {157 kind = 2;158 } else if (p <= 6 && (mask & (1 << 4))) {159 kind = 4;160 } else if (p <= 15 && (mask & (1 << 8))) {161 kind = 8;162 } else if (p <= 18 && (mask & (1 << 10))) {163 kind = 10;164 } else if (p <= 33 && (mask & (1 << 16))) {165 kind = 16;166 } else {167 error -= 1;168 }169 170 if (r <= 4 && (mask & (1 << 2))) {171 kind = kind < 2 ? 2 : kind;172 } else if (r <= 37 && p != 3 && (mask & (1 << 3))) {173 kind = kind < 3 ? 3 : kind;174 } else if (r <= 37 && (mask & (1 << 4))) {175 kind = kind < 4 ? 4 : kind;176 } else if (r <= 307 && (mask & (1 << 8))) {177 kind = kind < 8 ? 8 : kind;178 } else if (r <= 4931 && (mask & (1 << 10))) {179 kind = kind < 10 ? 10 : kind;180 } else if (r <= 4931 && (mask & (1 << 16))) {181 kind = kind < 16 ? 16 : kind;182 } else {183 error -= 2;184 }185 186 return error ? error : kind;187}188 189// NEAREST (16.9.139)190template <int PREC, typename T>191inline RT_API_ATTRS T Nearest(T x, bool positive) {192 if (positive) {193 return std::nextafter(x, std::numeric_limits<T>::infinity());194 } else {195 return std::nextafter(x, -std::numeric_limits<T>::infinity());196 }197}198 199// Exponentiation operator for (Real ** Integer) cases (10.1.5.2.1).200template <typename BTy, typename ETy>201RT_API_ATTRS BTy FPowI(BTy base, ETy exp) {202 if (exp == ETy{0})203 return BTy{1};204 bool isNegativePower{exp < ETy{0}};205 bool isMinPower{exp == std::numeric_limits<ETy>::min()};206 if (isMinPower) {207 exp = std::numeric_limits<ETy>::max();208 } else if (isNegativePower) {209 exp = -exp;210 }211 BTy result{1};212 BTy origBase{base};213 while (true) {214 if (exp & ETy{1}) {215 result *= base;216 }217 exp >>= 1;218 if (exp == ETy{0}) {219 break;220 }221 base *= base;222 }223 if (isMinPower) {224 result *= origBase;225 }226 if (isNegativePower) {227 result = BTy{1} / result;228 }229 return result;230}231 232// Exponentiation operator for (Unsigned ** Unsigned) cases233template <typename Ty> RT_API_ATTRS Ty UPow(Ty base, Ty exp) {234 if (exp == Ty{0})235 return Ty{1};236 Ty result{1};237 while (true) {238 if (exp & Ty{1}) {239 result *= base;240 }241 exp >>= 1;242 if (exp == Ty{0}) {243 break;244 }245 base *= base;246 }247 return result;248}249 250extern "C" {251RT_EXT_API_GROUP_BEGIN252 253CppTypeFor<TypeCategory::Integer, 1> RTDEF(Ceiling4_1)(254 CppTypeFor<TypeCategory::Real, 4> x) {255 return Ceiling<CppTypeFor<TypeCategory::Integer, 1>>(x);256}257CppTypeFor<TypeCategory::Integer, 2> RTDEF(Ceiling4_2)(258 CppTypeFor<TypeCategory::Real, 4> x) {259 return Ceiling<CppTypeFor<TypeCategory::Integer, 2>>(x);260}261CppTypeFor<TypeCategory::Integer, 4> RTDEF(Ceiling4_4)(262 CppTypeFor<TypeCategory::Real, 4> x) {263 return Ceiling<CppTypeFor<TypeCategory::Integer, 4>>(x);264}265CppTypeFor<TypeCategory::Integer, 8> RTDEF(Ceiling4_8)(266 CppTypeFor<TypeCategory::Real, 4> x) {267 return Ceiling<CppTypeFor<TypeCategory::Integer, 8>>(x);268}269#if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T270CppTypeFor<TypeCategory::Integer, 16> RTDEF(Ceiling4_16)(271 CppTypeFor<TypeCategory::Real, 4> x) {272 return Ceiling<CppTypeFor<TypeCategory::Integer, 16>>(x);273}274#endif275CppTypeFor<TypeCategory::Integer, 1> RTDEF(Ceiling8_1)(276 CppTypeFor<TypeCategory::Real, 8> x) {277 return Ceiling<CppTypeFor<TypeCategory::Integer, 1>>(x);278}279CppTypeFor<TypeCategory::Integer, 2> RTDEF(Ceiling8_2)(280 CppTypeFor<TypeCategory::Real, 8> x) {281 return Ceiling<CppTypeFor<TypeCategory::Integer, 2>>(x);282}283CppTypeFor<TypeCategory::Integer, 4> RTDEF(Ceiling8_4)(284 CppTypeFor<TypeCategory::Real, 8> x) {285 return Ceiling<CppTypeFor<TypeCategory::Integer, 4>>(x);286}287CppTypeFor<TypeCategory::Integer, 8> RTDEF(Ceiling8_8)(288 CppTypeFor<TypeCategory::Real, 8> x) {289 return Ceiling<CppTypeFor<TypeCategory::Integer, 8>>(x);290}291#if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T292CppTypeFor<TypeCategory::Integer, 16> RTDEF(Ceiling8_16)(293 CppTypeFor<TypeCategory::Real, 8> x) {294 return Ceiling<CppTypeFor<TypeCategory::Integer, 16>>(x);295}296#endif297#if HAS_FLOAT80298CppTypeFor<TypeCategory::Integer, 1> RTDEF(Ceiling10_1)(299 CppTypeFor<TypeCategory::Real, 10> x) {300 return Ceiling<CppTypeFor<TypeCategory::Integer, 1>>(x);301}302CppTypeFor<TypeCategory::Integer, 2> RTDEF(Ceiling10_2)(303 CppTypeFor<TypeCategory::Real, 10> x) {304 return Ceiling<CppTypeFor<TypeCategory::Integer, 2>>(x);305}306CppTypeFor<TypeCategory::Integer, 4> RTDEF(Ceiling10_4)(307 CppTypeFor<TypeCategory::Real, 10> x) {308 return Ceiling<CppTypeFor<TypeCategory::Integer, 4>>(x);309}310CppTypeFor<TypeCategory::Integer, 8> RTDEF(Ceiling10_8)(311 CppTypeFor<TypeCategory::Real, 10> x) {312 return Ceiling<CppTypeFor<TypeCategory::Integer, 8>>(x);313}314#if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T315CppTypeFor<TypeCategory::Integer, 16> RTDEF(Ceiling10_16)(316 CppTypeFor<TypeCategory::Real, 10> x) {317 return Ceiling<CppTypeFor<TypeCategory::Integer, 16>>(x);318}319#endif320#elif HAS_LDBL128321CppTypeFor<TypeCategory::Integer, 1> RTDEF(Ceiling16_1)(322 CppTypeFor<TypeCategory::Real, 16> x) {323 return Ceiling<CppTypeFor<TypeCategory::Integer, 1>>(x);324}325CppTypeFor<TypeCategory::Integer, 2> RTDEF(Ceiling16_2)(326 CppTypeFor<TypeCategory::Real, 16> x) {327 return Ceiling<CppTypeFor<TypeCategory::Integer, 2>>(x);328}329CppTypeFor<TypeCategory::Integer, 4> RTDEF(Ceiling16_4)(330 CppTypeFor<TypeCategory::Real, 16> x) {331 return Ceiling<CppTypeFor<TypeCategory::Integer, 4>>(x);332}333CppTypeFor<TypeCategory::Integer, 8> RTDEF(Ceiling16_8)(334 CppTypeFor<TypeCategory::Real, 16> x) {335 return Ceiling<CppTypeFor<TypeCategory::Integer, 8>>(x);336}337#if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T338CppTypeFor<TypeCategory::Integer, 16> RTDEF(Ceiling16_16)(339 CppTypeFor<TypeCategory::Real, 16> x) {340 return Ceiling<CppTypeFor<TypeCategory::Integer, 16>>(x);341}342#endif343#endif344 345CppTypeFor<TypeCategory::Real, 4> RTDEF(ErfcScaled4)(346 CppTypeFor<TypeCategory::Real, 4> x) {347 return ErfcScaled(x);348}349CppTypeFor<TypeCategory::Real, 8> RTDEF(ErfcScaled8)(350 CppTypeFor<TypeCategory::Real, 8> x) {351 return ErfcScaled(x);352}353#if HAS_FLOAT80354CppTypeFor<TypeCategory::Real, 10> RTDEF(ErfcScaled10)(355 CppTypeFor<TypeCategory::Real, 10> x) {356 return ErfcScaled(x);357}358#endif359#if HAS_LDBL128360CppTypeFor<TypeCategory::Real, 16> RTDEF(ErfcScaled16)(361 CppTypeFor<TypeCategory::Real, 16> x) {362 return ErfcScaled(x);363}364#endif365 366CppTypeFor<TypeCategory::Integer, 4> RTDEF(Exponent4_4)(367 CppTypeFor<TypeCategory::Real, 4> x) {368 return Exponent<CppTypeFor<TypeCategory::Integer, 4>>(x);369}370CppTypeFor<TypeCategory::Integer, 8> RTDEF(Exponent4_8)(371 CppTypeFor<TypeCategory::Real, 4> x) {372 return Exponent<CppTypeFor<TypeCategory::Integer, 8>>(x);373}374CppTypeFor<TypeCategory::Integer, 4> RTDEF(Exponent8_4)(375 CppTypeFor<TypeCategory::Real, 8> x) {376 return Exponent<CppTypeFor<TypeCategory::Integer, 4>>(x);377}378CppTypeFor<TypeCategory::Integer, 8> RTDEF(Exponent8_8)(379 CppTypeFor<TypeCategory::Real, 8> x) {380 return Exponent<CppTypeFor<TypeCategory::Integer, 8>>(x);381}382#if HAS_FLOAT80383CppTypeFor<TypeCategory::Integer, 4> RTDEF(Exponent10_4)(384 CppTypeFor<TypeCategory::Real, 10> x) {385 return Exponent<CppTypeFor<TypeCategory::Integer, 4>>(x);386}387CppTypeFor<TypeCategory::Integer, 8> RTDEF(Exponent10_8)(388 CppTypeFor<TypeCategory::Real, 10> x) {389 return Exponent<CppTypeFor<TypeCategory::Integer, 8>>(x);390}391#endif392 393CppTypeFor<TypeCategory::Integer, 1> RTDEF(Floor4_1)(394 CppTypeFor<TypeCategory::Real, 4> x) {395 return Floor<CppTypeFor<TypeCategory::Integer, 1>>(x);396}397CppTypeFor<TypeCategory::Integer, 2> RTDEF(Floor4_2)(398 CppTypeFor<TypeCategory::Real, 4> x) {399 return Floor<CppTypeFor<TypeCategory::Integer, 2>>(x);400}401CppTypeFor<TypeCategory::Integer, 4> RTDEF(Floor4_4)(402 CppTypeFor<TypeCategory::Real, 4> x) {403 return Floor<CppTypeFor<TypeCategory::Integer, 4>>(x);404}405CppTypeFor<TypeCategory::Integer, 8> RTDEF(Floor4_8)(406 CppTypeFor<TypeCategory::Real, 4> x) {407 return Floor<CppTypeFor<TypeCategory::Integer, 8>>(x);408}409#if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T410CppTypeFor<TypeCategory::Integer, 16> RTDEF(Floor4_16)(411 CppTypeFor<TypeCategory::Real, 4> x) {412 return Floor<CppTypeFor<TypeCategory::Integer, 16>>(x);413}414#endif415CppTypeFor<TypeCategory::Integer, 1> RTDEF(Floor8_1)(416 CppTypeFor<TypeCategory::Real, 8> x) {417 return Floor<CppTypeFor<TypeCategory::Integer, 1>>(x);418}419CppTypeFor<TypeCategory::Integer, 2> RTDEF(Floor8_2)(420 CppTypeFor<TypeCategory::Real, 8> x) {421 return Floor<CppTypeFor<TypeCategory::Integer, 2>>(x);422}423CppTypeFor<TypeCategory::Integer, 4> RTDEF(Floor8_4)(424 CppTypeFor<TypeCategory::Real, 8> x) {425 return Floor<CppTypeFor<TypeCategory::Integer, 4>>(x);426}427CppTypeFor<TypeCategory::Integer, 8> RTDEF(Floor8_8)(428 CppTypeFor<TypeCategory::Real, 8> x) {429 return Floor<CppTypeFor<TypeCategory::Integer, 8>>(x);430}431#if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T432CppTypeFor<TypeCategory::Integer, 16> RTDEF(Floor8_16)(433 CppTypeFor<TypeCategory::Real, 8> x) {434 return Floor<CppTypeFor<TypeCategory::Integer, 16>>(x);435}436#endif437#if HAS_FLOAT80438CppTypeFor<TypeCategory::Integer, 1> RTDEF(Floor10_1)(439 CppTypeFor<TypeCategory::Real, 10> x) {440 return Floor<CppTypeFor<TypeCategory::Integer, 1>>(x);441}442CppTypeFor<TypeCategory::Integer, 2> RTDEF(Floor10_2)(443 CppTypeFor<TypeCategory::Real, 10> x) {444 return Floor<CppTypeFor<TypeCategory::Integer, 2>>(x);445}446CppTypeFor<TypeCategory::Integer, 4> RTDEF(Floor10_4)(447 CppTypeFor<TypeCategory::Real, 10> x) {448 return Floor<CppTypeFor<TypeCategory::Integer, 4>>(x);449}450CppTypeFor<TypeCategory::Integer, 8> RTDEF(Floor10_8)(451 CppTypeFor<TypeCategory::Real, 10> x) {452 return Floor<CppTypeFor<TypeCategory::Integer, 8>>(x);453}454#if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T455CppTypeFor<TypeCategory::Integer, 16> RTDEF(Floor10_16)(456 CppTypeFor<TypeCategory::Real, 10> x) {457 return Floor<CppTypeFor<TypeCategory::Integer, 16>>(x);458}459#endif460#elif HAS_LDBL128461CppTypeFor<TypeCategory::Integer, 1> RTDEF(Floor16_1)(462 CppTypeFor<TypeCategory::Real, 16> x) {463 return Floor<CppTypeFor<TypeCategory::Integer, 1>>(x);464}465CppTypeFor<TypeCategory::Integer, 2> RTDEF(Floor16_2)(466 CppTypeFor<TypeCategory::Real, 16> x) {467 return Floor<CppTypeFor<TypeCategory::Integer, 2>>(x);468}469CppTypeFor<TypeCategory::Integer, 4> RTDEF(Floor16_4)(470 CppTypeFor<TypeCategory::Real, 16> x) {471 return Floor<CppTypeFor<TypeCategory::Integer, 4>>(x);472}473CppTypeFor<TypeCategory::Integer, 8> RTDEF(Floor16_8)(474 CppTypeFor<TypeCategory::Real, 16> x) {475 return Floor<CppTypeFor<TypeCategory::Integer, 8>>(x);476}477#if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T478CppTypeFor<TypeCategory::Integer, 16> RTDEF(Floor16_16)(479 CppTypeFor<TypeCategory::Real, 16> x) {480 return Floor<CppTypeFor<TypeCategory::Integer, 16>>(x);481}482#endif483#endif484 485CppTypeFor<TypeCategory::Real, 4> RTDEF(Fraction4)(486 CppTypeFor<TypeCategory::Real, 4> x) {487 return Fraction(x);488}489CppTypeFor<TypeCategory::Real, 8> RTDEF(Fraction8)(490 CppTypeFor<TypeCategory::Real, 8> x) {491 return Fraction(x);492}493#if HAS_FLOAT80494CppTypeFor<TypeCategory::Real, 10> RTDEF(Fraction10)(495 CppTypeFor<TypeCategory::Real, 10> x) {496 return Fraction(x);497}498#endif499 500bool RTDEF(IsFinite4)(CppTypeFor<TypeCategory::Real, 4> x) {501 return std::isfinite(x);502}503bool RTDEF(IsFinite8)(CppTypeFor<TypeCategory::Real, 8> x) {504 return std::isfinite(x);505}506#if HAS_FLOAT80507bool RTDEF(IsFinite10)(CppTypeFor<TypeCategory::Real, 10> x) {508 return std::isfinite(x);509}510#elif HAS_LDBL128511bool RTDEF(IsFinite16)(CppTypeFor<TypeCategory::Real, 16> x) {512 return std::isfinite(x);513}514#endif515 516bool RTDEF(IsNaN4)(CppTypeFor<TypeCategory::Real, 4> x) {517 return std::isnan(x);518}519bool RTDEF(IsNaN8)(CppTypeFor<TypeCategory::Real, 8> x) {520 return std::isnan(x);521}522#if HAS_FLOAT80523bool RTDEF(IsNaN10)(CppTypeFor<TypeCategory::Real, 10> x) {524 return std::isnan(x);525}526#elif HAS_LDBL128527bool RTDEF(IsNaN16)(CppTypeFor<TypeCategory::Real, 16> x) {528 return std::isnan(x);529}530#endif531 532CppTypeFor<TypeCategory::Integer, 1> RTDEF(ModInteger1)(533 CppTypeFor<TypeCategory::Integer, 1> x,534 CppTypeFor<TypeCategory::Integer, 1> p, const char *sourceFile,535 int sourceLine) {536 return IntMod<false>(x, p, sourceFile, sourceLine);537}538CppTypeFor<TypeCategory::Integer, 2> RTDEF(ModInteger2)(539 CppTypeFor<TypeCategory::Integer, 2> x,540 CppTypeFor<TypeCategory::Integer, 2> p, const char *sourceFile,541 int sourceLine) {542 return IntMod<false>(x, p, sourceFile, sourceLine);543}544CppTypeFor<TypeCategory::Integer, 4> RTDEF(ModInteger4)(545 CppTypeFor<TypeCategory::Integer, 4> x,546 CppTypeFor<TypeCategory::Integer, 4> p, const char *sourceFile,547 int sourceLine) {548 return IntMod<false>(x, p, sourceFile, sourceLine);549}550CppTypeFor<TypeCategory::Integer, 8> RTDEF(ModInteger8)(551 CppTypeFor<TypeCategory::Integer, 8> x,552 CppTypeFor<TypeCategory::Integer, 8> p, const char *sourceFile,553 int sourceLine) {554 return IntMod<false>(x, p, sourceFile, sourceLine);555}556#ifdef __SIZEOF_INT128__557CppTypeFor<TypeCategory::Integer, 16> RTDEF(ModInteger16)(558 CppTypeFor<TypeCategory::Integer, 16> x,559 CppTypeFor<TypeCategory::Integer, 16> p, const char *sourceFile,560 int sourceLine) {561 return IntMod<false>(x, p, sourceFile, sourceLine);562}563#endif564CppTypeFor<TypeCategory::Real, 4> RTDEF(ModReal4)(565 CppTypeFor<TypeCategory::Real, 4> x, CppTypeFor<TypeCategory::Real, 4> p,566 const char *sourceFile, int sourceLine) {567 return RealMod<false>(x, p, sourceFile, sourceLine);568}569CppTypeFor<TypeCategory::Real, 8> RTDEF(ModReal8)(570 CppTypeFor<TypeCategory::Real, 8> x, CppTypeFor<TypeCategory::Real, 8> p,571 const char *sourceFile, int sourceLine) {572 return RealMod<false>(x, p, sourceFile, sourceLine);573}574#if HAS_FLOAT80575CppTypeFor<TypeCategory::Real, 10> RTDEF(ModReal10)(576 CppTypeFor<TypeCategory::Real, 10> x, CppTypeFor<TypeCategory::Real, 10> p,577 const char *sourceFile, int sourceLine) {578 return RealMod<false>(x, p, sourceFile, sourceLine);579}580#endif581 582CppTypeFor<TypeCategory::Integer, 1> RTDEF(ModuloInteger1)(583 CppTypeFor<TypeCategory::Integer, 1> x,584 CppTypeFor<TypeCategory::Integer, 1> p, const char *sourceFile,585 int sourceLine) {586 return IntMod<true>(x, p, sourceFile, sourceLine);587}588CppTypeFor<TypeCategory::Integer, 2> RTDEF(ModuloInteger2)(589 CppTypeFor<TypeCategory::Integer, 2> x,590 CppTypeFor<TypeCategory::Integer, 2> p, const char *sourceFile,591 int sourceLine) {592 return IntMod<true>(x, p, sourceFile, sourceLine);593}594CppTypeFor<TypeCategory::Integer, 4> RTDEF(ModuloInteger4)(595 CppTypeFor<TypeCategory::Integer, 4> x,596 CppTypeFor<TypeCategory::Integer, 4> p, const char *sourceFile,597 int sourceLine) {598 return IntMod<true>(x, p, sourceFile, sourceLine);599}600CppTypeFor<TypeCategory::Integer, 8> RTDEF(ModuloInteger8)(601 CppTypeFor<TypeCategory::Integer, 8> x,602 CppTypeFor<TypeCategory::Integer, 8> p, const char *sourceFile,603 int sourceLine) {604 return IntMod<true>(x, p, sourceFile, sourceLine);605}606#ifdef __SIZEOF_INT128__607CppTypeFor<TypeCategory::Integer, 16> RTDEF(ModuloInteger16)(608 CppTypeFor<TypeCategory::Integer, 16> x,609 CppTypeFor<TypeCategory::Integer, 16> p, const char *sourceFile,610 int sourceLine) {611 return IntMod<true>(x, p, sourceFile, sourceLine);612}613#endif614CppTypeFor<TypeCategory::Real, 4> RTDEF(ModuloReal4)(615 CppTypeFor<TypeCategory::Real, 4> x, CppTypeFor<TypeCategory::Real, 4> p,616 const char *sourceFile, int sourceLine) {617 return RealMod<true>(x, p, sourceFile, sourceLine);618}619CppTypeFor<TypeCategory::Real, 8> RTDEF(ModuloReal8)(620 CppTypeFor<TypeCategory::Real, 8> x, CppTypeFor<TypeCategory::Real, 8> p,621 const char *sourceFile, int sourceLine) {622 return RealMod<true>(x, p, sourceFile, sourceLine);623}624#if HAS_FLOAT80625CppTypeFor<TypeCategory::Real, 10> RTDEF(ModuloReal10)(626 CppTypeFor<TypeCategory::Real, 10> x, CppTypeFor<TypeCategory::Real, 10> p,627 const char *sourceFile, int sourceLine) {628 return RealMod<true>(x, p, sourceFile, sourceLine);629}630#endif631 632CppTypeFor<TypeCategory::Real, 4> RTDEF(Nearest4)(633 CppTypeFor<TypeCategory::Real, 4> x, bool positive) {634 return Nearest<24>(x, positive);635}636CppTypeFor<TypeCategory::Real, 8> RTDEF(Nearest8)(637 CppTypeFor<TypeCategory::Real, 8> x, bool positive) {638 return Nearest<53>(x, positive);639}640#if HAS_FLOAT80641CppTypeFor<TypeCategory::Real, 10> RTDEF(Nearest10)(642 CppTypeFor<TypeCategory::Real, 10> x, bool positive) {643 return Nearest<64>(x, positive);644}645#endif646 647CppTypeFor<TypeCategory::Integer, 1> RTDEF(Nint4_1)(648 CppTypeFor<TypeCategory::Real, 4> x) {649 return Nint<CppTypeFor<TypeCategory::Integer, 1>>(x);650}651CppTypeFor<TypeCategory::Integer, 2> RTDEF(Nint4_2)(652 CppTypeFor<TypeCategory::Real, 4> x) {653 return Nint<CppTypeFor<TypeCategory::Integer, 2>>(x);654}655CppTypeFor<TypeCategory::Integer, 4> RTDEF(Nint4_4)(656 CppTypeFor<TypeCategory::Real, 4> x) {657 return Nint<CppTypeFor<TypeCategory::Integer, 4>>(x);658}659CppTypeFor<TypeCategory::Integer, 8> RTDEF(Nint4_8)(660 CppTypeFor<TypeCategory::Real, 4> x) {661 return Nint<CppTypeFor<TypeCategory::Integer, 8>>(x);662}663#if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T664CppTypeFor<TypeCategory::Integer, 16> RTDEF(Nint4_16)(665 CppTypeFor<TypeCategory::Real, 4> x) {666 return Nint<CppTypeFor<TypeCategory::Integer, 16>>(x);667}668#endif669CppTypeFor<TypeCategory::Integer, 1> RTDEF(Nint8_1)(670 CppTypeFor<TypeCategory::Real, 8> x) {671 return Nint<CppTypeFor<TypeCategory::Integer, 1>>(x);672}673CppTypeFor<TypeCategory::Integer, 2> RTDEF(Nint8_2)(674 CppTypeFor<TypeCategory::Real, 8> x) {675 return Nint<CppTypeFor<TypeCategory::Integer, 2>>(x);676}677CppTypeFor<TypeCategory::Integer, 4> RTDEF(Nint8_4)(678 CppTypeFor<TypeCategory::Real, 8> x) {679 return Nint<CppTypeFor<TypeCategory::Integer, 4>>(x);680}681CppTypeFor<TypeCategory::Integer, 8> RTDEF(Nint8_8)(682 CppTypeFor<TypeCategory::Real, 8> x) {683 return Nint<CppTypeFor<TypeCategory::Integer, 8>>(x);684}685#if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T686CppTypeFor<TypeCategory::Integer, 16> RTDEF(Nint8_16)(687 CppTypeFor<TypeCategory::Real, 8> x) {688 return Nint<CppTypeFor<TypeCategory::Integer, 16>>(x);689}690#endif691#if HAS_FLOAT80692CppTypeFor<TypeCategory::Integer, 1> RTDEF(Nint10_1)(693 CppTypeFor<TypeCategory::Real, 10> x) {694 return Nint<CppTypeFor<TypeCategory::Integer, 1>>(x);695}696CppTypeFor<TypeCategory::Integer, 2> RTDEF(Nint10_2)(697 CppTypeFor<TypeCategory::Real, 10> x) {698 return Nint<CppTypeFor<TypeCategory::Integer, 2>>(x);699}700CppTypeFor<TypeCategory::Integer, 4> RTDEF(Nint10_4)(701 CppTypeFor<TypeCategory::Real, 10> x) {702 return Nint<CppTypeFor<TypeCategory::Integer, 4>>(x);703}704CppTypeFor<TypeCategory::Integer, 8> RTDEF(Nint10_8)(705 CppTypeFor<TypeCategory::Real, 10> x) {706 return Nint<CppTypeFor<TypeCategory::Integer, 8>>(x);707}708#if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T709CppTypeFor<TypeCategory::Integer, 16> RTDEF(Nint10_16)(710 CppTypeFor<TypeCategory::Real, 10> x) {711 return Nint<CppTypeFor<TypeCategory::Integer, 16>>(x);712}713#endif714#elif HAS_LDBL128715CppTypeFor<TypeCategory::Integer, 1> RTDEF(Nint16_1)(716 CppTypeFor<TypeCategory::Real, 16> x) {717 return Nint<CppTypeFor<TypeCategory::Integer, 1>>(x);718}719CppTypeFor<TypeCategory::Integer, 2> RTDEF(Nint16_2)(720 CppTypeFor<TypeCategory::Real, 16> x) {721 return Nint<CppTypeFor<TypeCategory::Integer, 2>>(x);722}723CppTypeFor<TypeCategory::Integer, 4> RTDEF(Nint16_4)(724 CppTypeFor<TypeCategory::Real, 16> x) {725 return Nint<CppTypeFor<TypeCategory::Integer, 4>>(x);726}727CppTypeFor<TypeCategory::Integer, 8> RTDEF(Nint16_8)(728 CppTypeFor<TypeCategory::Real, 16> x) {729 return Nint<CppTypeFor<TypeCategory::Integer, 8>>(x);730}731#if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T732CppTypeFor<TypeCategory::Integer, 16> RTDEF(Nint16_16)(733 CppTypeFor<TypeCategory::Real, 16> x) {734 return Nint<CppTypeFor<TypeCategory::Integer, 16>>(x);735}736#endif737#endif738 739CppTypeFor<TypeCategory::Real, 4> RTDEF(RRSpacing4)(740 CppTypeFor<TypeCategory::Real, 4> x) {741 return RRSpacing<24>(x);742}743CppTypeFor<TypeCategory::Real, 8> RTDEF(RRSpacing8)(744 CppTypeFor<TypeCategory::Real, 8> x) {745 return RRSpacing<53>(x);746}747#if HAS_FLOAT80748CppTypeFor<TypeCategory::Real, 10> RTDEF(RRSpacing10)(749 CppTypeFor<TypeCategory::Real, 10> x) {750 return RRSpacing<64>(x);751}752#endif753 754CppTypeFor<TypeCategory::Real, 4> RTDEF(SetExponent4)(755 CppTypeFor<TypeCategory::Real, 4> x, std::int64_t p) {756 return SetExponent(x, p);757}758CppTypeFor<TypeCategory::Real, 8> RTDEF(SetExponent8)(759 CppTypeFor<TypeCategory::Real, 8> x, std::int64_t p) {760 return SetExponent(x, p);761}762#if HAS_FLOAT80763CppTypeFor<TypeCategory::Real, 10> RTDEF(SetExponent10)(764 CppTypeFor<TypeCategory::Real, 10> x, std::int64_t p) {765 return SetExponent(x, p);766}767#endif768 769CppTypeFor<TypeCategory::Real, 4> RTDEF(Scale4)(770 CppTypeFor<TypeCategory::Real, 4> x, std::int64_t p) {771 return Scale(x, p);772}773CppTypeFor<TypeCategory::Real, 8> RTDEF(Scale8)(774 CppTypeFor<TypeCategory::Real, 8> x, std::int64_t p) {775 return Scale(x, p);776}777#if HAS_FLOAT80778CppTypeFor<TypeCategory::Real, 10> RTDEF(Scale10)(779 CppTypeFor<TypeCategory::Real, 10> x, std::int64_t p) {780 return Scale(x, p);781}782#endif783 784// SELECTED_CHAR_KIND785CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedCharKind)(786 const char *source, int line, const char *x, std::size_t length) {787 static const char *keywords[]{788 "ASCII", "DEFAULT", "UCS-2", "ISO_10646", "UCS-4", nullptr};789 switch (IdentifyValue(x, length, keywords)) {790 case 0: // ASCII791 case 1: // DEFAULT792 return 1;793 case 2: // UCS-2794 return 2;795 case 3: // ISO_10646796 case 4: // UCS-4797 return 4;798 default:799 return -1;800 }801}802// SELECTED_INT_KIND and SELECTED_UNSIGNED_KIND extension803CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedIntKind)(804 const char *source, int line, void *x, int xKind) {805 return RTNAME(SelectedIntKindMasked)(source, line, x, xKind,806 (1 << 1) | (1 << 2) | (1 << 4) | (1 << 8) | (1 << 16));807}808 809CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedIntKindMasked)(810 const char *source, int line, void *x, int xKind, int mask) {811#ifdef __SIZEOF_INT128__812 CppTypeFor<TypeCategory::Integer, 16> r =813 GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(814 source, line, x, xKind, /*defaultValue*/ 0, /*resKind*/ 16);815#else816 std::int64_t r = GetIntArgValue<std::int64_t>(817 source, line, x, xKind, /*defaultValue*/ 0, /*resKind*/ 8);818#endif819 return SelectedIntKind(r, mask);820}821 822// SELECTED_LOGICAL_KIND823CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedLogicalKind)(824 const char *source, int line, void *x, int xKind) {825#ifdef __SIZEOF_INT128__826 CppTypeFor<TypeCategory::Integer, 16> r =827 GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(828 source, line, x, xKind, /*defaultValue*/ 0, /*resKind*/ 16);829#else830 std::int64_t r = GetIntArgValue<std::int64_t>(831 source, line, x, xKind, /*defaultValue*/ 0, /*resKind*/ 8);832#endif833 return SelectedLogicalKind(r);834}835 836// SELECTED_REAL_KIND837CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedRealKind)(const char *source,838 int line, void *precision, int pKind, void *range, int rKind, void *radix,839 int dKind) {840 return RTNAME(SelectedRealKindMasked)(source, line, precision, pKind, range,841 rKind, radix, dKind,842 (1 << 2) | (1 << 3) | (1 << 4) | (1 << 8) | (1 << 10) | (1 << 16));843}844 845CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedRealKindMasked)(846 const char *source, int line, void *precision, int pKind, void *range,847 int rKind, void *radix, int dKind, int mask) {848#ifdef __SIZEOF_INT128__849 CppTypeFor<TypeCategory::Integer, 16> p =850 GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(851 source, line, precision, pKind, /*defaultValue*/ 0, /*resKind*/ 16);852 CppTypeFor<TypeCategory::Integer, 16> r =853 GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(854 source, line, range, rKind, /*defaultValue*/ 0, /*resKind*/ 16);855 CppTypeFor<TypeCategory::Integer, 16> d =856 GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(857 source, line, radix, dKind, /*defaultValue*/ 2, /*resKind*/ 16);858#else859 std::int64_t p = GetIntArgValue<std::int64_t>(860 source, line, precision, pKind, /*defaultValue*/ 0, /*resKind*/ 8);861 std::int64_t r = GetIntArgValue<std::int64_t>(862 source, line, range, rKind, /*defaultValue*/ 0, /*resKind*/ 8);863 std::int64_t d = GetIntArgValue<std::int64_t>(864 source, line, radix, dKind, /*defaultValue*/ 2, /*resKind*/ 8);865#endif866 return SelectedRealKind(p, r, d, mask);867}868 869#if HAS_FP16870CppTypeFor<TypeCategory::Real, 2> RTDEF(Spacing2)(871 CppTypeFor<TypeCategory::Real, 2> x) {872 return Spacing<11>(x);873}874#endif875CppTypeFor<TypeCategory::Real, 4> RTDEF(Spacing2By4)(876 CppTypeFor<TypeCategory::Real, 4> x) {877 return Spacing<11>(x);878}879#if HAS_BF16880CppTypeFor<TypeCategory::Real, 3> RTDEF(Spacing3)(881 CppTypeFor<TypeCategory::Real, 3> x) {882 return Spacing<8>(x);883}884#endif885CppTypeFor<TypeCategory::Real, 4> RTDEF(Spacing3By4)(886 CppTypeFor<TypeCategory::Real, 4> x) {887 return Spacing<8>(x);888}889CppTypeFor<TypeCategory::Real, 4> RTDEF(Spacing4)(890 CppTypeFor<TypeCategory::Real, 4> x) {891 return Spacing<24>(x);892}893CppTypeFor<TypeCategory::Real, 8> RTDEF(Spacing8)(894 CppTypeFor<TypeCategory::Real, 8> x) {895 return Spacing<53>(x);896}897#if HAS_FLOAT80898CppTypeFor<TypeCategory::Real, 10> RTDEF(Spacing10)(899 CppTypeFor<TypeCategory::Real, 10> x) {900 return Spacing<64>(x);901}902#endif903 904CppTypeFor<TypeCategory::Real, 4> RTDEF(FPow4i)(905 CppTypeFor<TypeCategory::Real, 4> b,906 CppTypeFor<TypeCategory::Integer, 4> e) {907 return FPowI(b, e);908}909CppTypeFor<TypeCategory::Real, 8> RTDEF(FPow8i)(910 CppTypeFor<TypeCategory::Real, 8> b,911 CppTypeFor<TypeCategory::Integer, 4> e) {912 return FPowI(b, e);913}914#if HAS_FLOAT80915CppTypeFor<TypeCategory::Real, 10> RTDEF(FPow10i)(916 CppTypeFor<TypeCategory::Real, 10> b,917 CppTypeFor<TypeCategory::Integer, 4> e) {918 return FPowI(b, e);919}920#endif921#if HAS_LDBL128 || HAS_FLOAT128922CppTypeFor<TypeCategory::Real, 16> RTDEF(FPow16i)(923 CppTypeFor<TypeCategory::Real, 16> b,924 CppTypeFor<TypeCategory::Integer, 4> e) {925 return FPowI(b, e);926}927#endif928 929CppTypeFor<TypeCategory::Real, 4> RTDEF(FPow4k)(930 CppTypeFor<TypeCategory::Real, 4> b,931 CppTypeFor<TypeCategory::Integer, 8> e) {932 return FPowI(b, e);933}934CppTypeFor<TypeCategory::Real, 8> RTDEF(FPow8k)(935 CppTypeFor<TypeCategory::Real, 8> b,936 CppTypeFor<TypeCategory::Integer, 8> e) {937 return FPowI(b, e);938}939#if HAS_FLOAT80940CppTypeFor<TypeCategory::Real, 10> RTDEF(FPow10k)(941 CppTypeFor<TypeCategory::Real, 10> b,942 CppTypeFor<TypeCategory::Integer, 8> e) {943 return FPowI(b, e);944}945#endif946#if HAS_LDBL128 || HAS_FLOAT128947CppTypeFor<TypeCategory::Real, 16> RTDEF(FPow16k)(948 CppTypeFor<TypeCategory::Real, 16> b,949 CppTypeFor<TypeCategory::Integer, 8> e) {950 return FPowI(b, e);951}952#endif953 954CppTypeFor<TypeCategory::Unsigned, 1> RTDEF(UPow1)(955 CppTypeFor<TypeCategory::Unsigned, 1> b,956 CppTypeFor<TypeCategory::Unsigned, 1> e) {957 return UPow(b, e);958}959CppTypeFor<TypeCategory::Unsigned, 2> RTDEF(UPow2)(960 CppTypeFor<TypeCategory::Unsigned, 2> b,961 CppTypeFor<TypeCategory::Unsigned, 2> e) {962 return UPow(b, e);963}964CppTypeFor<TypeCategory::Unsigned, 4> RTDEF(UPow4)(965 CppTypeFor<TypeCategory::Unsigned, 4> b,966 CppTypeFor<TypeCategory::Unsigned, 4> e) {967 return UPow(b, e);968}969CppTypeFor<TypeCategory::Unsigned, 8> RTDEF(UPow8)(970 CppTypeFor<TypeCategory::Unsigned, 8> b,971 CppTypeFor<TypeCategory::Unsigned, 8> e) {972 return UPow(b, e);973}974 975RT_EXT_API_GROUP_END976} // extern "C"977} // namespace Fortran::runtime978