1 //===-- runtime/numeric.cpp -----------------------------------------------===//
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-exception
6 //
7 //===----------------------------------------------------------------------===//
8 
9 #include "flang/Runtime/numeric.h"
10 #include "terminator.h"
11 #include "flang/Runtime/float128.h"
12 #include <cfloat>
13 #include <climits>
14 #include <cmath>
15 #include <limits>
16 
17 namespace Fortran::runtime {
18 
19 template <typename RES>
getIntArgValue(const char * source,int line,void * arg,int kind,std::int64_t defaultValue,int resKind)20 inline RES getIntArgValue(const char *source, int line, void *arg, int kind,
21     std::int64_t defaultValue, int resKind) {
22   RES res;
23   if (!arg) {
24     res = static_cast<RES>(defaultValue);
25   } else if (kind == 1) {
26     res = static_cast<RES>(
27         *static_cast<CppTypeFor<TypeCategory::Integer, 1> *>(arg));
28   } else if (kind == 2) {
29     res = static_cast<RES>(
30         *static_cast<CppTypeFor<TypeCategory::Integer, 2> *>(arg));
31   } else if (kind == 4) {
32     res = static_cast<RES>(
33         *static_cast<CppTypeFor<TypeCategory::Integer, 4> *>(arg));
34   } else if (kind == 8) {
35     res = static_cast<RES>(
36         *static_cast<CppTypeFor<TypeCategory::Integer, 8> *>(arg));
37 #ifdef __SIZEOF_INT128__
38   } else if (kind == 16) {
39     if (resKind != 16) {
40       Terminator{source, line}.Crash("Unexpected integer kind in runtime");
41     }
42     res = static_cast<RES>(
43         *static_cast<CppTypeFor<TypeCategory::Integer, 16> *>(arg));
44 #endif
45   } else {
46     Terminator{source, line}.Crash("Unexpected integer kind in runtime");
47   }
48   return res;
49 }
50 
51 // NINT (16.9.141)
Nint(ARG x)52 template <typename RESULT, typename ARG> inline RESULT Nint(ARG x) {
53   if (x >= 0) {
54     return std::trunc(x + ARG{0.5});
55   } else {
56     return std::trunc(x - ARG{0.5});
57   }
58 }
59 
60 // CEILING & FLOOR (16.9.43, .79)
Ceiling(ARG x)61 template <typename RESULT, typename ARG> inline RESULT Ceiling(ARG x) {
62   return std::ceil(x);
63 }
Floor(ARG x)64 template <typename RESULT, typename ARG> inline RESULT Floor(ARG x) {
65   return std::floor(x);
66 }
67 
68 // EXPONENT (16.9.75)
Exponent(ARG x)69 template <typename RESULT, typename ARG> inline RESULT Exponent(ARG x) {
70   if (std::isinf(x) || std::isnan(x)) {
71     return std::numeric_limits<RESULT>::max(); // +/-Inf, NaN -> HUGE(0)
72   } else if (x == 0) {
73     return 0; // 0 -> 0
74   } else {
75     return std::ilogb(x) + 1;
76   }
77 }
78 
79 // FRACTION (16.9.80)
Fraction(T x)80 template <typename T> inline T Fraction(T x) {
81   if (std::isnan(x)) {
82     return x; // NaN -> same NaN
83   } else if (std::isinf(x)) {
84     return std::numeric_limits<T>::quiet_NaN(); // +/-Inf -> NaN
85   } else if (x == 0) {
86     return 0; // 0 -> 0
87   } else {
88     int ignoredExp;
89     return std::frexp(x, &ignoredExp);
90   }
91 }
92 
93 // MOD & MODULO (16.9.135, .136)
94 template <bool IS_MODULO, typename T>
IntMod(T x,T p,const char * sourceFile,int sourceLine)95 inline T IntMod(T x, T p, const char *sourceFile, int sourceLine) {
96   if (p == 0) {
97     Terminator{sourceFile, sourceLine}.Crash(
98         IS_MODULO ? "MODULO with P==0" : "MOD with P==0");
99   }
100   auto mod{x - (x / p) * p};
101   if (IS_MODULO && (x > 0) != (p > 0)) {
102     mod += p;
103   }
104   return mod;
105 }
106 template <bool IS_MODULO, typename T>
RealMod(T a,T p,const char * sourceFile,int sourceLine)107 inline T RealMod(T a, T p, const char *sourceFile, int sourceLine) {
108   if (p == 0) {
109     Terminator{sourceFile, sourceLine}.Crash(
110         IS_MODULO ? "MODULO with P==0" : "MOD with P==0");
111   }
112   T quotient{a / p};
113   if (std::isinf(quotient) && std::isfinite(a) && std::isfinite(p)) {
114     // a/p overflowed -- so it must be an integer, and the result
115     // must be a zero of the same sign as one of the operands.
116     return std::copysign(T{}, IS_MODULO ? p : a);
117   }
118   T toInt{IS_MODULO ? std::floor(quotient) : std::trunc(quotient)};
119   return a - toInt * p;
120 }
121 
122 // RRSPACING (16.9.164)
RRSpacing(T x)123 template <int PREC, typename T> inline T RRSpacing(T x) {
124   if (std::isnan(x)) {
125     return x; // NaN -> same NaN
126   } else if (std::isinf(x)) {
127     return std::numeric_limits<T>::quiet_NaN(); // +/-Inf -> NaN
128   } else if (x == 0) {
129     return 0; // 0 -> 0
130   } else {
131     return std::ldexp(std::abs(x), PREC - (std::ilogb(x) + 1));
132   }
133 }
134 
135 // SCALE (16.9.166)
Scale(T x,std::int64_t p)136 template <typename T> inline T Scale(T x, std::int64_t p) {
137   auto ip{static_cast<int>(p)};
138   if (ip != p) {
139     ip = p < 0 ? std::numeric_limits<int>::min()
140                : std::numeric_limits<int>::max();
141   }
142   return std::ldexp(x, p); // x*2**p
143 }
144 
145 // SELECTED_INT_KIND (16.9.169)
146 template <typename T>
SelectedIntKind(T x)147 inline CppTypeFor<TypeCategory::Integer, 4> SelectedIntKind(T x) {
148   if (x <= 2) {
149     return 1;
150   } else if (x <= 4) {
151     return 2;
152   } else if (x <= 9) {
153     return 4;
154   } else if (x <= 18) {
155     return 8;
156 #ifdef __SIZEOF_INT128__
157   } else if (x <= 38) {
158     return 16;
159 #endif
160   }
161   return -1;
162 }
163 
164 // SELECTED_REAL_KIND (16.9.170)
165 template <typename P, typename R, typename D>
SelectedRealKind(P p,R r,D d)166 inline CppTypeFor<TypeCategory::Integer, 4> SelectedRealKind(P p, R r, D d) {
167   if (d != 2) {
168     return -5;
169   }
170 
171   int error{0};
172   int kind{0};
173   if (p <= 3) {
174     kind = 2;
175   } else if (p <= 6) {
176     kind = 4;
177   } else if (p <= 15) {
178     kind = 8;
179 #if LDBL_MANT_DIG == 64
180   } else if (p <= 18) {
181     kind = 10;
182   } else if (p <= 33) {
183     kind = 16;
184 #elif LDBL_MANT_DIG == 113
185   } else if (p <= 33) {
186     kind = 16;
187 #endif
188   } else {
189     error -= 1;
190   }
191 
192   if (r <= 4) {
193     kind = kind < 2 ? 2 : kind;
194   } else if (r <= 37) {
195     kind = kind < 3 ? (p == 3 ? 4 : 3) : kind;
196   } else if (r <= 307) {
197     kind = kind < 8 ? 8 : kind;
198 #if LDBL_MANT_DIG == 64
199   } else if (r <= 4931) {
200     kind = kind < 10 ? 10 : kind;
201 #elif LDBL_MANT_DIG == 113
202   } else if (r <= 4931) {
203     kind = kind < 16 ? 16 : kind;
204 #endif
205   } else {
206     error -= 2;
207   }
208 
209   return error ? error : kind;
210 }
211 
212 // SET_EXPONENT (16.9.171)
SetExponent(T x,std::int64_t p)213 template <typename T> inline T SetExponent(T x, std::int64_t p) {
214   if (std::isnan(x)) {
215     return x; // NaN -> same NaN
216   } else if (std::isinf(x)) {
217     return std::numeric_limits<T>::quiet_NaN(); // +/-Inf -> NaN
218   } else if (x == 0) {
219     return x; // return negative zero if x is negative zero
220   } else {
221     int expo{std::ilogb(x) + 1};
222     auto ip{static_cast<int>(p - expo)};
223     if (ip != p - expo) {
224       ip = p < 0 ? std::numeric_limits<int>::min()
225                  : std::numeric_limits<int>::max();
226     }
227     return std::ldexp(x, ip); // x*2**(p-e)
228   }
229 }
230 
231 // SPACING (16.9.180)
Spacing(T x)232 template <int PREC, typename T> inline T Spacing(T x) {
233   if (std::isnan(x)) {
234     return x; // NaN -> same NaN
235   } else if (std::isinf(x)) {
236     return std::numeric_limits<T>::quiet_NaN(); // +/-Inf -> NaN
237   } else if (x == 0) {
238     // The standard-mandated behavior seems broken, since TINY() can't be
239     // subnormal.
240     return std::numeric_limits<T>::min(); // 0 -> TINY(x)
241   } else {
242     return std::ldexp(
243         static_cast<T>(1.0), std::ilogb(x) + 1 - PREC); // 2**(e-p)
244   }
245 }
246 
247 // NEAREST (16.9.139)
Nearest(T x,bool positive)248 template <int PREC, typename T> inline T Nearest(T x, bool positive) {
249   auto spacing{Spacing<PREC>(x)};
250   if (x == 0) {
251     auto least{std::numeric_limits<T>::denorm_min()};
252     return positive ? least : -least;
253   } else {
254     return positive ? x + spacing : x - spacing;
255   }
256 }
257 
258 extern "C" {
259 
RTNAME(Ceiling4_1)260 CppTypeFor<TypeCategory::Integer, 1> RTNAME(Ceiling4_1)(
261     CppTypeFor<TypeCategory::Real, 4> x) {
262   return Ceiling<CppTypeFor<TypeCategory::Integer, 1>>(x);
263 }
RTNAME(Ceiling4_2)264 CppTypeFor<TypeCategory::Integer, 2> RTNAME(Ceiling4_2)(
265     CppTypeFor<TypeCategory::Real, 4> x) {
266   return Ceiling<CppTypeFor<TypeCategory::Integer, 2>>(x);
267 }
RTNAME(Ceiling4_4)268 CppTypeFor<TypeCategory::Integer, 4> RTNAME(Ceiling4_4)(
269     CppTypeFor<TypeCategory::Real, 4> x) {
270   return Ceiling<CppTypeFor<TypeCategory::Integer, 4>>(x);
271 }
RTNAME(Ceiling4_8)272 CppTypeFor<TypeCategory::Integer, 8> RTNAME(Ceiling4_8)(
273     CppTypeFor<TypeCategory::Real, 4> x) {
274   return Ceiling<CppTypeFor<TypeCategory::Integer, 8>>(x);
275 }
276 #ifdef __SIZEOF_INT128__
RTNAME(Ceiling4_16)277 CppTypeFor<TypeCategory::Integer, 16> RTNAME(Ceiling4_16)(
278     CppTypeFor<TypeCategory::Real, 4> x) {
279   return Ceiling<CppTypeFor<TypeCategory::Integer, 16>>(x);
280 }
281 #endif
RTNAME(Ceiling8_1)282 CppTypeFor<TypeCategory::Integer, 1> RTNAME(Ceiling8_1)(
283     CppTypeFor<TypeCategory::Real, 8> x) {
284   return Ceiling<CppTypeFor<TypeCategory::Integer, 1>>(x);
285 }
RTNAME(Ceiling8_2)286 CppTypeFor<TypeCategory::Integer, 2> RTNAME(Ceiling8_2)(
287     CppTypeFor<TypeCategory::Real, 8> x) {
288   return Ceiling<CppTypeFor<TypeCategory::Integer, 2>>(x);
289 }
RTNAME(Ceiling8_4)290 CppTypeFor<TypeCategory::Integer, 4> RTNAME(Ceiling8_4)(
291     CppTypeFor<TypeCategory::Real, 8> x) {
292   return Ceiling<CppTypeFor<TypeCategory::Integer, 4>>(x);
293 }
RTNAME(Ceiling8_8)294 CppTypeFor<TypeCategory::Integer, 8> RTNAME(Ceiling8_8)(
295     CppTypeFor<TypeCategory::Real, 8> x) {
296   return Ceiling<CppTypeFor<TypeCategory::Integer, 8>>(x);
297 }
298 #ifdef __SIZEOF_INT128__
RTNAME(Ceiling8_16)299 CppTypeFor<TypeCategory::Integer, 16> RTNAME(Ceiling8_16)(
300     CppTypeFor<TypeCategory::Real, 8> x) {
301   return Ceiling<CppTypeFor<TypeCategory::Integer, 16>>(x);
302 }
303 #endif
304 #if LDBL_MANT_DIG == 64
RTNAME(Ceiling10_1)305 CppTypeFor<TypeCategory::Integer, 1> RTNAME(Ceiling10_1)(
306     CppTypeFor<TypeCategory::Real, 10> x) {
307   return Ceiling<CppTypeFor<TypeCategory::Integer, 1>>(x);
308 }
RTNAME(Ceiling10_2)309 CppTypeFor<TypeCategory::Integer, 2> RTNAME(Ceiling10_2)(
310     CppTypeFor<TypeCategory::Real, 10> x) {
311   return Ceiling<CppTypeFor<TypeCategory::Integer, 2>>(x);
312 }
RTNAME(Ceiling10_4)313 CppTypeFor<TypeCategory::Integer, 4> RTNAME(Ceiling10_4)(
314     CppTypeFor<TypeCategory::Real, 10> x) {
315   return Ceiling<CppTypeFor<TypeCategory::Integer, 4>>(x);
316 }
RTNAME(Ceiling10_8)317 CppTypeFor<TypeCategory::Integer, 8> RTNAME(Ceiling10_8)(
318     CppTypeFor<TypeCategory::Real, 10> x) {
319   return Ceiling<CppTypeFor<TypeCategory::Integer, 8>>(x);
320 }
321 #ifdef __SIZEOF_INT128__
RTNAME(Ceiling10_16)322 CppTypeFor<TypeCategory::Integer, 16> RTNAME(Ceiling10_16)(
323     CppTypeFor<TypeCategory::Real, 10> x) {
324   return Ceiling<CppTypeFor<TypeCategory::Integer, 16>>(x);
325 }
326 #endif
327 #elif LDBL_MANT_DIG == 113
RTNAME(Ceiling16_1)328 CppTypeFor<TypeCategory::Integer, 1> RTNAME(Ceiling16_1)(
329     CppTypeFor<TypeCategory::Real, 16> x) {
330   return Ceiling<CppTypeFor<TypeCategory::Integer, 1>>(x);
331 }
RTNAME(Ceiling16_2)332 CppTypeFor<TypeCategory::Integer, 2> RTNAME(Ceiling16_2)(
333     CppTypeFor<TypeCategory::Real, 16> x) {
334   return Ceiling<CppTypeFor<TypeCategory::Integer, 2>>(x);
335 }
RTNAME(Ceiling16_4)336 CppTypeFor<TypeCategory::Integer, 4> RTNAME(Ceiling16_4)(
337     CppTypeFor<TypeCategory::Real, 16> x) {
338   return Ceiling<CppTypeFor<TypeCategory::Integer, 4>>(x);
339 }
RTNAME(Ceiling16_8)340 CppTypeFor<TypeCategory::Integer, 8> RTNAME(Ceiling16_8)(
341     CppTypeFor<TypeCategory::Real, 16> x) {
342   return Ceiling<CppTypeFor<TypeCategory::Integer, 8>>(x);
343 }
344 #ifdef __SIZEOF_INT128__
RTNAME(Ceiling16_16)345 CppTypeFor<TypeCategory::Integer, 16> RTNAME(Ceiling16_16)(
346     CppTypeFor<TypeCategory::Real, 16> x) {
347   return Ceiling<CppTypeFor<TypeCategory::Integer, 16>>(x);
348 }
349 #endif
350 #endif
351 
RTNAME(Exponent4_4)352 CppTypeFor<TypeCategory::Integer, 4> RTNAME(Exponent4_4)(
353     CppTypeFor<TypeCategory::Real, 4> x) {
354   return Exponent<CppTypeFor<TypeCategory::Integer, 4>>(x);
355 }
RTNAME(Exponent4_8)356 CppTypeFor<TypeCategory::Integer, 8> RTNAME(Exponent4_8)(
357     CppTypeFor<TypeCategory::Real, 4> x) {
358   return Exponent<CppTypeFor<TypeCategory::Integer, 8>>(x);
359 }
RTNAME(Exponent8_4)360 CppTypeFor<TypeCategory::Integer, 4> RTNAME(Exponent8_4)(
361     CppTypeFor<TypeCategory::Real, 8> x) {
362   return Exponent<CppTypeFor<TypeCategory::Integer, 4>>(x);
363 }
RTNAME(Exponent8_8)364 CppTypeFor<TypeCategory::Integer, 8> RTNAME(Exponent8_8)(
365     CppTypeFor<TypeCategory::Real, 8> x) {
366   return Exponent<CppTypeFor<TypeCategory::Integer, 8>>(x);
367 }
368 #if LDBL_MANT_DIG == 64
RTNAME(Exponent10_4)369 CppTypeFor<TypeCategory::Integer, 4> RTNAME(Exponent10_4)(
370     CppTypeFor<TypeCategory::Real, 10> x) {
371   return Exponent<CppTypeFor<TypeCategory::Integer, 4>>(x);
372 }
RTNAME(Exponent10_8)373 CppTypeFor<TypeCategory::Integer, 8> RTNAME(Exponent10_8)(
374     CppTypeFor<TypeCategory::Real, 10> x) {
375   return Exponent<CppTypeFor<TypeCategory::Integer, 8>>(x);
376 }
377 #elif LDBL_MANT_DIG == 113
RTNAME(Exponent16_4)378 CppTypeFor<TypeCategory::Integer, 4> RTNAME(Exponent16_4)(
379     CppTypeFor<TypeCategory::Real, 16> x) {
380   return Exponent<CppTypeFor<TypeCategory::Integer, 4>>(x);
381 }
RTNAME(Exponent16_8)382 CppTypeFor<TypeCategory::Integer, 8> RTNAME(Exponent16_8)(
383     CppTypeFor<TypeCategory::Real, 16> x) {
384   return Exponent<CppTypeFor<TypeCategory::Integer, 8>>(x);
385 }
386 #endif
387 
RTNAME(Floor4_1)388 CppTypeFor<TypeCategory::Integer, 1> RTNAME(Floor4_1)(
389     CppTypeFor<TypeCategory::Real, 4> x) {
390   return Floor<CppTypeFor<TypeCategory::Integer, 1>>(x);
391 }
RTNAME(Floor4_2)392 CppTypeFor<TypeCategory::Integer, 2> RTNAME(Floor4_2)(
393     CppTypeFor<TypeCategory::Real, 4> x) {
394   return Floor<CppTypeFor<TypeCategory::Integer, 2>>(x);
395 }
RTNAME(Floor4_4)396 CppTypeFor<TypeCategory::Integer, 4> RTNAME(Floor4_4)(
397     CppTypeFor<TypeCategory::Real, 4> x) {
398   return Floor<CppTypeFor<TypeCategory::Integer, 4>>(x);
399 }
RTNAME(Floor4_8)400 CppTypeFor<TypeCategory::Integer, 8> RTNAME(Floor4_8)(
401     CppTypeFor<TypeCategory::Real, 4> x) {
402   return Floor<CppTypeFor<TypeCategory::Integer, 8>>(x);
403 }
404 #ifdef __SIZEOF_INT128__
RTNAME(Floor4_16)405 CppTypeFor<TypeCategory::Integer, 16> RTNAME(Floor4_16)(
406     CppTypeFor<TypeCategory::Real, 4> x) {
407   return Floor<CppTypeFor<TypeCategory::Integer, 16>>(x);
408 }
409 #endif
RTNAME(Floor8_1)410 CppTypeFor<TypeCategory::Integer, 1> RTNAME(Floor8_1)(
411     CppTypeFor<TypeCategory::Real, 8> x) {
412   return Floor<CppTypeFor<TypeCategory::Integer, 1>>(x);
413 }
RTNAME(Floor8_2)414 CppTypeFor<TypeCategory::Integer, 2> RTNAME(Floor8_2)(
415     CppTypeFor<TypeCategory::Real, 8> x) {
416   return Floor<CppTypeFor<TypeCategory::Integer, 2>>(x);
417 }
RTNAME(Floor8_4)418 CppTypeFor<TypeCategory::Integer, 4> RTNAME(Floor8_4)(
419     CppTypeFor<TypeCategory::Real, 8> x) {
420   return Floor<CppTypeFor<TypeCategory::Integer, 4>>(x);
421 }
RTNAME(Floor8_8)422 CppTypeFor<TypeCategory::Integer, 8> RTNAME(Floor8_8)(
423     CppTypeFor<TypeCategory::Real, 8> x) {
424   return Floor<CppTypeFor<TypeCategory::Integer, 8>>(x);
425 }
426 #ifdef __SIZEOF_INT128__
RTNAME(Floor8_16)427 CppTypeFor<TypeCategory::Integer, 16> RTNAME(Floor8_16)(
428     CppTypeFor<TypeCategory::Real, 8> x) {
429   return Floor<CppTypeFor<TypeCategory::Integer, 16>>(x);
430 }
431 #endif
432 #if LDBL_MANT_DIG == 64
RTNAME(Floor10_1)433 CppTypeFor<TypeCategory::Integer, 1> RTNAME(Floor10_1)(
434     CppTypeFor<TypeCategory::Real, 10> x) {
435   return Floor<CppTypeFor<TypeCategory::Integer, 1>>(x);
436 }
RTNAME(Floor10_2)437 CppTypeFor<TypeCategory::Integer, 2> RTNAME(Floor10_2)(
438     CppTypeFor<TypeCategory::Real, 10> x) {
439   return Floor<CppTypeFor<TypeCategory::Integer, 2>>(x);
440 }
RTNAME(Floor10_4)441 CppTypeFor<TypeCategory::Integer, 4> RTNAME(Floor10_4)(
442     CppTypeFor<TypeCategory::Real, 10> x) {
443   return Floor<CppTypeFor<TypeCategory::Integer, 4>>(x);
444 }
RTNAME(Floor10_8)445 CppTypeFor<TypeCategory::Integer, 8> RTNAME(Floor10_8)(
446     CppTypeFor<TypeCategory::Real, 10> x) {
447   return Floor<CppTypeFor<TypeCategory::Integer, 8>>(x);
448 }
449 #ifdef __SIZEOF_INT128__
RTNAME(Floor10_16)450 CppTypeFor<TypeCategory::Integer, 16> RTNAME(Floor10_16)(
451     CppTypeFor<TypeCategory::Real, 10> x) {
452   return Floor<CppTypeFor<TypeCategory::Integer, 16>>(x);
453 }
454 #endif
455 #elif LDBL_MANT_DIG == 113
RTNAME(Floor16_1)456 CppTypeFor<TypeCategory::Integer, 1> RTNAME(Floor16_1)(
457     CppTypeFor<TypeCategory::Real, 16> x) {
458   return Floor<CppTypeFor<TypeCategory::Integer, 1>>(x);
459 }
RTNAME(Floor16_2)460 CppTypeFor<TypeCategory::Integer, 2> RTNAME(Floor16_2)(
461     CppTypeFor<TypeCategory::Real, 16> x) {
462   return Floor<CppTypeFor<TypeCategory::Integer, 2>>(x);
463 }
RTNAME(Floor16_4)464 CppTypeFor<TypeCategory::Integer, 4> RTNAME(Floor16_4)(
465     CppTypeFor<TypeCategory::Real, 16> x) {
466   return Floor<CppTypeFor<TypeCategory::Integer, 4>>(x);
467 }
RTNAME(Floor16_8)468 CppTypeFor<TypeCategory::Integer, 8> RTNAME(Floor16_8)(
469     CppTypeFor<TypeCategory::Real, 16> x) {
470   return Floor<CppTypeFor<TypeCategory::Integer, 8>>(x);
471 }
472 #ifdef __SIZEOF_INT128__
RTNAME(Floor16_16)473 CppTypeFor<TypeCategory::Integer, 16> RTNAME(Floor16_16)(
474     CppTypeFor<TypeCategory::Real, 16> x) {
475   return Floor<CppTypeFor<TypeCategory::Integer, 16>>(x);
476 }
477 #endif
478 #endif
479 
RTNAME(Fraction4)480 CppTypeFor<TypeCategory::Real, 4> RTNAME(Fraction4)(
481     CppTypeFor<TypeCategory::Real, 4> x) {
482   return Fraction(x);
483 }
RTNAME(Fraction8)484 CppTypeFor<TypeCategory::Real, 8> RTNAME(Fraction8)(
485     CppTypeFor<TypeCategory::Real, 8> x) {
486   return Fraction(x);
487 }
488 #if LDBL_MANT_DIG == 64
RTNAME(Fraction10)489 CppTypeFor<TypeCategory::Real, 10> RTNAME(Fraction10)(
490     CppTypeFor<TypeCategory::Real, 10> x) {
491   return Fraction(x);
492 }
493 #elif LDBL_MANT_DIG == 113
RTNAME(Fraction16)494 CppTypeFor<TypeCategory::Real, 16> RTNAME(Fraction16)(
495     CppTypeFor<TypeCategory::Real, 16> x) {
496   return Fraction(x);
497 }
498 #endif
499 
RTNAME(IsFinite4)500 bool RTNAME(IsFinite4)(CppTypeFor<TypeCategory::Real, 4> x) {
501   return std::isfinite(x);
502 }
RTNAME(IsFinite8)503 bool RTNAME(IsFinite8)(CppTypeFor<TypeCategory::Real, 8> x) {
504   return std::isfinite(x);
505 }
506 #if LDBL_MANT_DIG == 64
RTNAME(IsFinite10)507 bool RTNAME(IsFinite10)(CppTypeFor<TypeCategory::Real, 10> x) {
508   return std::isfinite(x);
509 }
510 #elif LDBL_MANT_DIG == 113
RTNAME(IsFinite16)511 bool RTNAME(IsFinite16)(CppTypeFor<TypeCategory::Real, 16> x) {
512   return std::isfinite(x);
513 }
514 #endif
515 
RTNAME(IsNaN4)516 bool RTNAME(IsNaN4)(CppTypeFor<TypeCategory::Real, 4> x) {
517   return std::isnan(x);
518 }
RTNAME(IsNaN8)519 bool RTNAME(IsNaN8)(CppTypeFor<TypeCategory::Real, 8> x) {
520   return std::isnan(x);
521 }
522 #if LDBL_MANT_DIG == 64
RTNAME(IsNaN10)523 bool RTNAME(IsNaN10)(CppTypeFor<TypeCategory::Real, 10> x) {
524   return std::isnan(x);
525 }
526 #elif LDBL_MANT_DIG == 113
RTNAME(IsNaN16)527 bool RTNAME(IsNaN16)(CppTypeFor<TypeCategory::Real, 16> x) {
528   return std::isnan(x);
529 }
530 #endif
531 
RTNAME(ModInteger1)532 CppTypeFor<TypeCategory::Integer, 1> RTNAME(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 }
RTNAME(ModInteger2)538 CppTypeFor<TypeCategory::Integer, 2> RTNAME(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 }
RTNAME(ModInteger4)544 CppTypeFor<TypeCategory::Integer, 4> RTNAME(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 }
RTNAME(ModInteger8)550 CppTypeFor<TypeCategory::Integer, 8> RTNAME(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__
RTNAME(ModInteger16)557 CppTypeFor<TypeCategory::Integer, 16> RTNAME(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 #endif
RTNAME(ModReal4)564 CppTypeFor<TypeCategory::Real, 4> RTNAME(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 }
RTNAME(ModReal8)569 CppTypeFor<TypeCategory::Real, 8> RTNAME(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 LDBL_MANT_DIG == 64
RTNAME(ModReal10)575 CppTypeFor<TypeCategory::Real, 10> RTNAME(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 #elif LDBL_MANT_DIG == 113
RTNAME(ModReal16)581 CppTypeFor<TypeCategory::Real, 16> RTNAME(ModReal16)(
582     CppTypeFor<TypeCategory::Real, 16> x, CppTypeFor<TypeCategory::Real, 16> p,
583     const char *sourceFile, int sourceLine) {
584   return RealMod<false>(x, p, sourceFile, sourceLine);
585 }
586 #endif
587 
RTNAME(ModuloInteger1)588 CppTypeFor<TypeCategory::Integer, 1> RTNAME(ModuloInteger1)(
589     CppTypeFor<TypeCategory::Integer, 1> x,
590     CppTypeFor<TypeCategory::Integer, 1> p, const char *sourceFile,
591     int sourceLine) {
592   return IntMod<true>(x, p, sourceFile, sourceLine);
593 }
RTNAME(ModuloInteger2)594 CppTypeFor<TypeCategory::Integer, 2> RTNAME(ModuloInteger2)(
595     CppTypeFor<TypeCategory::Integer, 2> x,
596     CppTypeFor<TypeCategory::Integer, 2> p, const char *sourceFile,
597     int sourceLine) {
598   return IntMod<true>(x, p, sourceFile, sourceLine);
599 }
RTNAME(ModuloInteger4)600 CppTypeFor<TypeCategory::Integer, 4> RTNAME(ModuloInteger4)(
601     CppTypeFor<TypeCategory::Integer, 4> x,
602     CppTypeFor<TypeCategory::Integer, 4> p, const char *sourceFile,
603     int sourceLine) {
604   return IntMod<true>(x, p, sourceFile, sourceLine);
605 }
RTNAME(ModuloInteger8)606 CppTypeFor<TypeCategory::Integer, 8> RTNAME(ModuloInteger8)(
607     CppTypeFor<TypeCategory::Integer, 8> x,
608     CppTypeFor<TypeCategory::Integer, 8> p, const char *sourceFile,
609     int sourceLine) {
610   return IntMod<true>(x, p, sourceFile, sourceLine);
611 }
612 #ifdef __SIZEOF_INT128__
RTNAME(ModuloInteger16)613 CppTypeFor<TypeCategory::Integer, 16> RTNAME(ModuloInteger16)(
614     CppTypeFor<TypeCategory::Integer, 16> x,
615     CppTypeFor<TypeCategory::Integer, 16> p, const char *sourceFile,
616     int sourceLine) {
617   return IntMod<true>(x, p, sourceFile, sourceLine);
618 }
619 #endif
RTNAME(ModuloReal4)620 CppTypeFor<TypeCategory::Real, 4> RTNAME(ModuloReal4)(
621     CppTypeFor<TypeCategory::Real, 4> x, CppTypeFor<TypeCategory::Real, 4> p,
622     const char *sourceFile, int sourceLine) {
623   return RealMod<true>(x, p, sourceFile, sourceLine);
624 }
RTNAME(ModuloReal8)625 CppTypeFor<TypeCategory::Real, 8> RTNAME(ModuloReal8)(
626     CppTypeFor<TypeCategory::Real, 8> x, CppTypeFor<TypeCategory::Real, 8> p,
627     const char *sourceFile, int sourceLine) {
628   return RealMod<true>(x, p, sourceFile, sourceLine);
629 }
630 #if LDBL_MANT_DIG == 64
RTNAME(ModuloReal10)631 CppTypeFor<TypeCategory::Real, 10> RTNAME(ModuloReal10)(
632     CppTypeFor<TypeCategory::Real, 10> x, CppTypeFor<TypeCategory::Real, 10> p,
633     const char *sourceFile, int sourceLine) {
634   return RealMod<true>(x, p, sourceFile, sourceLine);
635 }
636 #elif LDBL_MANT_DIG == 113
RTNAME(ModuloReal16)637 CppTypeFor<TypeCategory::Real, 16> RTNAME(ModuloReal16)(
638     CppTypeFor<TypeCategory::Real, 16> x, CppTypeFor<TypeCategory::Real, 16> p,
639     const char *sourceFile, int sourceLine) {
640   return RealMod<true>(x, p, sourceFile, sourceLine);
641 }
642 #endif
643 
RTNAME(Nearest4)644 CppTypeFor<TypeCategory::Real, 4> RTNAME(Nearest4)(
645     CppTypeFor<TypeCategory::Real, 4> x, bool positive) {
646   return Nearest<24>(x, positive);
647 }
RTNAME(Nearest8)648 CppTypeFor<TypeCategory::Real, 8> RTNAME(Nearest8)(
649     CppTypeFor<TypeCategory::Real, 8> x, bool positive) {
650   return Nearest<53>(x, positive);
651 }
652 #if LDBL_MANT_DIG == 64
RTNAME(Nearest10)653 CppTypeFor<TypeCategory::Real, 10> RTNAME(Nearest10)(
654     CppTypeFor<TypeCategory::Real, 10> x, bool positive) {
655   return Nearest<64>(x, positive);
656 }
657 #elif LDBL_MANT_DIG == 113
RTNAME(Nearest16)658 CppTypeFor<TypeCategory::Real, 16> RTNAME(Nearest16)(
659     CppTypeFor<TypeCategory::Real, 16> x, bool positive) {
660   return Nearest<113>(x, positive);
661 }
662 #endif
663 
RTNAME(Nint4_1)664 CppTypeFor<TypeCategory::Integer, 1> RTNAME(Nint4_1)(
665     CppTypeFor<TypeCategory::Real, 4> x) {
666   return Nint<CppTypeFor<TypeCategory::Integer, 1>>(x);
667 }
RTNAME(Nint4_2)668 CppTypeFor<TypeCategory::Integer, 2> RTNAME(Nint4_2)(
669     CppTypeFor<TypeCategory::Real, 4> x) {
670   return Nint<CppTypeFor<TypeCategory::Integer, 2>>(x);
671 }
RTNAME(Nint4_4)672 CppTypeFor<TypeCategory::Integer, 4> RTNAME(Nint4_4)(
673     CppTypeFor<TypeCategory::Real, 4> x) {
674   return Nint<CppTypeFor<TypeCategory::Integer, 4>>(x);
675 }
RTNAME(Nint4_8)676 CppTypeFor<TypeCategory::Integer, 8> RTNAME(Nint4_8)(
677     CppTypeFor<TypeCategory::Real, 4> x) {
678   return Nint<CppTypeFor<TypeCategory::Integer, 8>>(x);
679 }
680 #ifdef __SIZEOF_INT128__
RTNAME(Nint4_16)681 CppTypeFor<TypeCategory::Integer, 16> RTNAME(Nint4_16)(
682     CppTypeFor<TypeCategory::Real, 4> x) {
683   return Nint<CppTypeFor<TypeCategory::Integer, 16>>(x);
684 }
685 #endif
RTNAME(Nint8_1)686 CppTypeFor<TypeCategory::Integer, 1> RTNAME(Nint8_1)(
687     CppTypeFor<TypeCategory::Real, 8> x) {
688   return Nint<CppTypeFor<TypeCategory::Integer, 1>>(x);
689 }
RTNAME(Nint8_2)690 CppTypeFor<TypeCategory::Integer, 2> RTNAME(Nint8_2)(
691     CppTypeFor<TypeCategory::Real, 8> x) {
692   return Nint<CppTypeFor<TypeCategory::Integer, 2>>(x);
693 }
RTNAME(Nint8_4)694 CppTypeFor<TypeCategory::Integer, 4> RTNAME(Nint8_4)(
695     CppTypeFor<TypeCategory::Real, 8> x) {
696   return Nint<CppTypeFor<TypeCategory::Integer, 4>>(x);
697 }
RTNAME(Nint8_8)698 CppTypeFor<TypeCategory::Integer, 8> RTNAME(Nint8_8)(
699     CppTypeFor<TypeCategory::Real, 8> x) {
700   return Nint<CppTypeFor<TypeCategory::Integer, 8>>(x);
701 }
702 #ifdef __SIZEOF_INT128__
RTNAME(Nint8_16)703 CppTypeFor<TypeCategory::Integer, 16> RTNAME(Nint8_16)(
704     CppTypeFor<TypeCategory::Real, 8> x) {
705   return Nint<CppTypeFor<TypeCategory::Integer, 16>>(x);
706 }
707 #endif
708 #if LDBL_MANT_DIG == 64
RTNAME(Nint10_1)709 CppTypeFor<TypeCategory::Integer, 1> RTNAME(Nint10_1)(
710     CppTypeFor<TypeCategory::Real, 10> x) {
711   return Nint<CppTypeFor<TypeCategory::Integer, 1>>(x);
712 }
RTNAME(Nint10_2)713 CppTypeFor<TypeCategory::Integer, 2> RTNAME(Nint10_2)(
714     CppTypeFor<TypeCategory::Real, 10> x) {
715   return Nint<CppTypeFor<TypeCategory::Integer, 2>>(x);
716 }
RTNAME(Nint10_4)717 CppTypeFor<TypeCategory::Integer, 4> RTNAME(Nint10_4)(
718     CppTypeFor<TypeCategory::Real, 10> x) {
719   return Nint<CppTypeFor<TypeCategory::Integer, 4>>(x);
720 }
RTNAME(Nint10_8)721 CppTypeFor<TypeCategory::Integer, 8> RTNAME(Nint10_8)(
722     CppTypeFor<TypeCategory::Real, 10> x) {
723   return Nint<CppTypeFor<TypeCategory::Integer, 8>>(x);
724 }
725 #ifdef __SIZEOF_INT128__
RTNAME(Nint10_16)726 CppTypeFor<TypeCategory::Integer, 16> RTNAME(Nint10_16)(
727     CppTypeFor<TypeCategory::Real, 10> x) {
728   return Nint<CppTypeFor<TypeCategory::Integer, 16>>(x);
729 }
730 #endif
731 #elif LDBL_MANT_DIG == 113
RTNAME(Nint16_1)732 CppTypeFor<TypeCategory::Integer, 1> RTNAME(Nint16_1)(
733     CppTypeFor<TypeCategory::Real, 16> x) {
734   return Nint<CppTypeFor<TypeCategory::Integer, 1>>(x);
735 }
RTNAME(Nint16_2)736 CppTypeFor<TypeCategory::Integer, 2> RTNAME(Nint16_2)(
737     CppTypeFor<TypeCategory::Real, 16> x) {
738   return Nint<CppTypeFor<TypeCategory::Integer, 2>>(x);
739 }
RTNAME(Nint16_4)740 CppTypeFor<TypeCategory::Integer, 4> RTNAME(Nint16_4)(
741     CppTypeFor<TypeCategory::Real, 16> x) {
742   return Nint<CppTypeFor<TypeCategory::Integer, 4>>(x);
743 }
RTNAME(Nint16_8)744 CppTypeFor<TypeCategory::Integer, 8> RTNAME(Nint16_8)(
745     CppTypeFor<TypeCategory::Real, 16> x) {
746   return Nint<CppTypeFor<TypeCategory::Integer, 8>>(x);
747 }
748 #ifdef __SIZEOF_INT128__
RTNAME(Nint16_16)749 CppTypeFor<TypeCategory::Integer, 16> RTNAME(Nint16_16)(
750     CppTypeFor<TypeCategory::Real, 16> x) {
751   return Nint<CppTypeFor<TypeCategory::Integer, 16>>(x);
752 }
753 #endif
754 #endif
755 
RTNAME(RRSpacing4)756 CppTypeFor<TypeCategory::Real, 4> RTNAME(RRSpacing4)(
757     CppTypeFor<TypeCategory::Real, 4> x) {
758   return RRSpacing<24>(x);
759 }
RTNAME(RRSpacing8)760 CppTypeFor<TypeCategory::Real, 8> RTNAME(RRSpacing8)(
761     CppTypeFor<TypeCategory::Real, 8> x) {
762   return RRSpacing<53>(x);
763 }
764 #if LDBL_MANT_DIG == 64
RTNAME(RRSpacing10)765 CppTypeFor<TypeCategory::Real, 10> RTNAME(RRSpacing10)(
766     CppTypeFor<TypeCategory::Real, 10> x) {
767   return RRSpacing<64>(x);
768 }
769 #elif LDBL_MANT_DIG == 113
RTNAME(RRSpacing16)770 CppTypeFor<TypeCategory::Real, 16> RTNAME(RRSpacing16)(
771     CppTypeFor<TypeCategory::Real, 16> x) {
772   return RRSpacing<113>(x);
773 }
774 #endif
775 
RTNAME(SetExponent4)776 CppTypeFor<TypeCategory::Real, 4> RTNAME(SetExponent4)(
777     CppTypeFor<TypeCategory::Real, 4> x, std::int64_t p) {
778   return SetExponent(x, p);
779 }
RTNAME(SetExponent8)780 CppTypeFor<TypeCategory::Real, 8> RTNAME(SetExponent8)(
781     CppTypeFor<TypeCategory::Real, 8> x, std::int64_t p) {
782   return SetExponent(x, p);
783 }
784 #if LDBL_MANT_DIG == 64
RTNAME(SetExponent10)785 CppTypeFor<TypeCategory::Real, 10> RTNAME(SetExponent10)(
786     CppTypeFor<TypeCategory::Real, 10> x, std::int64_t p) {
787   return SetExponent(x, p);
788 }
789 #elif LDBL_MANT_DIG == 113
RTNAME(SetExponent16)790 CppTypeFor<TypeCategory::Real, 16> RTNAME(SetExponent16)(
791     CppTypeFor<TypeCategory::Real, 16> x, std::int64_t p) {
792   return SetExponent(x, p);
793 }
794 #endif
795 
RTNAME(Scale4)796 CppTypeFor<TypeCategory::Real, 4> RTNAME(Scale4)(
797     CppTypeFor<TypeCategory::Real, 4> x, std::int64_t p) {
798   return Scale(x, p);
799 }
RTNAME(Scale8)800 CppTypeFor<TypeCategory::Real, 8> RTNAME(Scale8)(
801     CppTypeFor<TypeCategory::Real, 8> x, std::int64_t p) {
802   return Scale(x, p);
803 }
804 #if LDBL_MANT_DIG == 64
RTNAME(Scale10)805 CppTypeFor<TypeCategory::Real, 10> RTNAME(Scale10)(
806     CppTypeFor<TypeCategory::Real, 10> x, std::int64_t p) {
807   return Scale(x, p);
808 }
809 #elif LDBL_MANT_DIG == 113
RTNAME(Scale16)810 CppTypeFor<TypeCategory::Real, 16> RTNAME(Scale16)(
811     CppTypeFor<TypeCategory::Real, 16> x, std::int64_t p) {
812   return Scale(x, p);
813 }
814 #endif
815 
816 // SELECTED_INT_KIND
RTNAME(SelectedIntKind)817 CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedIntKind)(
818     const char *source, int line, void *x, int xKind) {
819 #ifdef __SIZEOF_INT128__
820   CppTypeFor<TypeCategory::Integer, 16> r =
821       getIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
822           source, line, x, xKind, /*defaultValue*/ 0, /*resKind*/ 16);
823 #else
824   std::int64_t r = getIntArgValue<std::int64_t>(
825       source, line, x, xKind, /*defaultValue*/ 0, /*resKind*/ 8);
826 #endif
827   return SelectedIntKind(r);
828 }
829 
830 // SELECTED_REAL_KIND
RTNAME(SelectedRealKind)831 CppTypeFor<TypeCategory::Integer, 4> RTNAME(SelectedRealKind)(
832     const char *source, int line, void *precision, int pKind, void *range,
833     int rKind, void *radix, int dKind) {
834 #ifdef __SIZEOF_INT128__
835   CppTypeFor<TypeCategory::Integer, 16> p =
836       getIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
837           source, line, precision, pKind, /*defaultValue*/ 0, /*resKind*/ 16);
838   CppTypeFor<TypeCategory::Integer, 16> r =
839       getIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
840           source, line, range, rKind, /*defaultValue*/ 0, /*resKind*/ 16);
841   CppTypeFor<TypeCategory::Integer, 16> d =
842       getIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
843           source, line, radix, dKind, /*defaultValue*/ 2, /*resKind*/ 16);
844 #else
845   std::int64_t p = getIntArgValue<std::int64_t>(
846       source, line, precision, pKind, /*defaultValue*/ 0, /*resKind*/ 8);
847   std::int64_t r = getIntArgValue<std::int64_t>(
848       source, line, range, rKind, /*defaultValue*/ 0, /*resKind*/ 8);
849   std::int64_t d = getIntArgValue<std::int64_t>(
850       source, line, radix, dKind, /*defaultValue*/ 2, /*resKind*/ 8);
851 #endif
852   return SelectedRealKind(p, r, d);
853 }
854 
RTNAME(Spacing4)855 CppTypeFor<TypeCategory::Real, 4> RTNAME(Spacing4)(
856     CppTypeFor<TypeCategory::Real, 4> x) {
857   return Spacing<24>(x);
858 }
RTNAME(Spacing8)859 CppTypeFor<TypeCategory::Real, 8> RTNAME(Spacing8)(
860     CppTypeFor<TypeCategory::Real, 8> x) {
861   return Spacing<53>(x);
862 }
863 #if LDBL_MANT_DIG == 64
RTNAME(Spacing10)864 CppTypeFor<TypeCategory::Real, 10> RTNAME(Spacing10)(
865     CppTypeFor<TypeCategory::Real, 10> x) {
866   return Spacing<64>(x);
867 }
868 #elif LDBL_MANT_DIG == 113
RTNAME(Spacing16)869 CppTypeFor<TypeCategory::Real, 16> RTNAME(Spacing16)(
870     CppTypeFor<TypeCategory::Real, 16> x) {
871   return Spacing<113>(x);
872 }
873 #endif
874 } // extern "C"
875 } // namespace Fortran::runtime
876