xref: /llvm-project/flang/runtime/numeric.cpp (revision fc97d2e68b03bc2979395e84b645e5b3ba35aecd) 
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 "numeric-templates.h"
11 #include "terminator.h"
12 #include "tools.h"
13 #include "flang/Common/float128.h"
14 #include <cfloat>
15 #include <climits>
16 #include <cmath>
17 #include <limits>
18 
19 namespace Fortran::runtime {
20 
21 template <typename RES>
22 inline 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 #endif
47   } else {
48     Terminator{source, line}.Crash("Unexpected integer kind in runtime");
49   }
50   return res;
51 }
52 
53 // NINT (16.9.141)
54 template <typename RESULT, typename ARG>
55 inline 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)
64 template <typename RESULT, typename ARG>
65 inline RT_API_ATTRS RESULT Ceiling(ARG x) {
66   return std::ceil(x);
67 }
68 template <typename RESULT, typename ARG>
69 inline RT_API_ATTRS RESULT Floor(ARG x) {
70   return std::floor(x);
71 }
72 
73 // MOD & MODULO (16.9.135, .136)
74 template <bool IS_MODULO, typename T>
75 inline 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)
88 template <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**p
95 }
96 
97 // SELECTED_INT_KIND (16.9.169) and SELECTED_UNSIGNED_KIND extension
98 template <typename X, typename M>
99 inline RT_API_ATTRS CppTypeFor<TypeCategory::Integer, 4> SelectedIntKind(
100     X x, M mask) {
101 #if !defined __SIZEOF_INT128__ || defined FLANG_RUNTIME_NO_INTEGER_16
102   mask &= ~(1 << 16);
103 #endif
104   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)
119 template <typename T>
120 inline 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)
135 template <typename P, typename R, typename D, typename M>
136 inline 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_2
142   mask &= ~(1 << 2);
143 #endif
144 #ifdef FLANG_RUNTIME_NO_REAL_3
145   mask &= ~(1 << 3);
146 #endif
147 #if !HAS_FLOAT80 || defined FLANG_RUNTIME_NO_REAL_10
148   mask &= ~(1 << 10);
149 #endif
150 #if LDBL_MANT_DIG < 64 || defined FLANG_RUNTIME_NO_REAL_16
151   mask &= ~(1 << 16);
152 #endif
153 
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)
190 template <int PREC, typename T>
191 inline 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).
200 template <typename BTy, typename ETy>
201 RT_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 extern "C" {
233 RT_EXT_API_GROUP_BEGIN
234 
235 CppTypeFor<TypeCategory::Integer, 1> RTDEF(Ceiling4_1)(
236     CppTypeFor<TypeCategory::Real, 4> x) {
237   return Ceiling<CppTypeFor<TypeCategory::Integer, 1>>(x);
238 }
239 CppTypeFor<TypeCategory::Integer, 2> RTDEF(Ceiling4_2)(
240     CppTypeFor<TypeCategory::Real, 4> x) {
241   return Ceiling<CppTypeFor<TypeCategory::Integer, 2>>(x);
242 }
243 CppTypeFor<TypeCategory::Integer, 4> RTDEF(Ceiling4_4)(
244     CppTypeFor<TypeCategory::Real, 4> x) {
245   return Ceiling<CppTypeFor<TypeCategory::Integer, 4>>(x);
246 }
247 CppTypeFor<TypeCategory::Integer, 8> RTDEF(Ceiling4_8)(
248     CppTypeFor<TypeCategory::Real, 4> x) {
249   return Ceiling<CppTypeFor<TypeCategory::Integer, 8>>(x);
250 }
251 #if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T
252 CppTypeFor<TypeCategory::Integer, 16> RTDEF(Ceiling4_16)(
253     CppTypeFor<TypeCategory::Real, 4> x) {
254   return Ceiling<CppTypeFor<TypeCategory::Integer, 16>>(x);
255 }
256 #endif
257 CppTypeFor<TypeCategory::Integer, 1> RTDEF(Ceiling8_1)(
258     CppTypeFor<TypeCategory::Real, 8> x) {
259   return Ceiling<CppTypeFor<TypeCategory::Integer, 1>>(x);
260 }
261 CppTypeFor<TypeCategory::Integer, 2> RTDEF(Ceiling8_2)(
262     CppTypeFor<TypeCategory::Real, 8> x) {
263   return Ceiling<CppTypeFor<TypeCategory::Integer, 2>>(x);
264 }
265 CppTypeFor<TypeCategory::Integer, 4> RTDEF(Ceiling8_4)(
266     CppTypeFor<TypeCategory::Real, 8> x) {
267   return Ceiling<CppTypeFor<TypeCategory::Integer, 4>>(x);
268 }
269 CppTypeFor<TypeCategory::Integer, 8> RTDEF(Ceiling8_8)(
270     CppTypeFor<TypeCategory::Real, 8> x) {
271   return Ceiling<CppTypeFor<TypeCategory::Integer, 8>>(x);
272 }
273 #if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T
274 CppTypeFor<TypeCategory::Integer, 16> RTDEF(Ceiling8_16)(
275     CppTypeFor<TypeCategory::Real, 8> x) {
276   return Ceiling<CppTypeFor<TypeCategory::Integer, 16>>(x);
277 }
278 #endif
279 #if HAS_FLOAT80
280 CppTypeFor<TypeCategory::Integer, 1> RTDEF(Ceiling10_1)(
281     CppTypeFor<TypeCategory::Real, 10> x) {
282   return Ceiling<CppTypeFor<TypeCategory::Integer, 1>>(x);
283 }
284 CppTypeFor<TypeCategory::Integer, 2> RTDEF(Ceiling10_2)(
285     CppTypeFor<TypeCategory::Real, 10> x) {
286   return Ceiling<CppTypeFor<TypeCategory::Integer, 2>>(x);
287 }
288 CppTypeFor<TypeCategory::Integer, 4> RTDEF(Ceiling10_4)(
289     CppTypeFor<TypeCategory::Real, 10> x) {
290   return Ceiling<CppTypeFor<TypeCategory::Integer, 4>>(x);
291 }
292 CppTypeFor<TypeCategory::Integer, 8> RTDEF(Ceiling10_8)(
293     CppTypeFor<TypeCategory::Real, 10> x) {
294   return Ceiling<CppTypeFor<TypeCategory::Integer, 8>>(x);
295 }
296 #if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T
297 CppTypeFor<TypeCategory::Integer, 16> RTDEF(Ceiling10_16)(
298     CppTypeFor<TypeCategory::Real, 10> x) {
299   return Ceiling<CppTypeFor<TypeCategory::Integer, 16>>(x);
300 }
301 #endif
302 #elif HAS_LDBL128
303 CppTypeFor<TypeCategory::Integer, 1> RTDEF(Ceiling16_1)(
304     CppTypeFor<TypeCategory::Real, 16> x) {
305   return Ceiling<CppTypeFor<TypeCategory::Integer, 1>>(x);
306 }
307 CppTypeFor<TypeCategory::Integer, 2> RTDEF(Ceiling16_2)(
308     CppTypeFor<TypeCategory::Real, 16> x) {
309   return Ceiling<CppTypeFor<TypeCategory::Integer, 2>>(x);
310 }
311 CppTypeFor<TypeCategory::Integer, 4> RTDEF(Ceiling16_4)(
312     CppTypeFor<TypeCategory::Real, 16> x) {
313   return Ceiling<CppTypeFor<TypeCategory::Integer, 4>>(x);
314 }
315 CppTypeFor<TypeCategory::Integer, 8> RTDEF(Ceiling16_8)(
316     CppTypeFor<TypeCategory::Real, 16> x) {
317   return Ceiling<CppTypeFor<TypeCategory::Integer, 8>>(x);
318 }
319 #if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T
320 CppTypeFor<TypeCategory::Integer, 16> RTDEF(Ceiling16_16)(
321     CppTypeFor<TypeCategory::Real, 16> x) {
322   return Ceiling<CppTypeFor<TypeCategory::Integer, 16>>(x);
323 }
324 #endif
325 #endif
326 
327 CppTypeFor<TypeCategory::Real, 4> RTDEF(ErfcScaled4)(
328     CppTypeFor<TypeCategory::Real, 4> x) {
329   return ErfcScaled(x);
330 }
331 CppTypeFor<TypeCategory::Real, 8> RTDEF(ErfcScaled8)(
332     CppTypeFor<TypeCategory::Real, 8> x) {
333   return ErfcScaled(x);
334 }
335 #if HAS_FLOAT80
336 CppTypeFor<TypeCategory::Real, 10> RTDEF(ErfcScaled10)(
337     CppTypeFor<TypeCategory::Real, 10> x) {
338   return ErfcScaled(x);
339 }
340 #endif
341 #if HAS_LDBL128
342 CppTypeFor<TypeCategory::Real, 16> RTDEF(ErfcScaled16)(
343     CppTypeFor<TypeCategory::Real, 16> x) {
344   return ErfcScaled(x);
345 }
346 #endif
347 
348 CppTypeFor<TypeCategory::Integer, 4> RTDEF(Exponent4_4)(
349     CppTypeFor<TypeCategory::Real, 4> x) {
350   return Exponent<CppTypeFor<TypeCategory::Integer, 4>>(x);
351 }
352 CppTypeFor<TypeCategory::Integer, 8> RTDEF(Exponent4_8)(
353     CppTypeFor<TypeCategory::Real, 4> x) {
354   return Exponent<CppTypeFor<TypeCategory::Integer, 8>>(x);
355 }
356 CppTypeFor<TypeCategory::Integer, 4> RTDEF(Exponent8_4)(
357     CppTypeFor<TypeCategory::Real, 8> x) {
358   return Exponent<CppTypeFor<TypeCategory::Integer, 4>>(x);
359 }
360 CppTypeFor<TypeCategory::Integer, 8> RTDEF(Exponent8_8)(
361     CppTypeFor<TypeCategory::Real, 8> x) {
362   return Exponent<CppTypeFor<TypeCategory::Integer, 8>>(x);
363 }
364 #if HAS_FLOAT80
365 CppTypeFor<TypeCategory::Integer, 4> RTDEF(Exponent10_4)(
366     CppTypeFor<TypeCategory::Real, 10> x) {
367   return Exponent<CppTypeFor<TypeCategory::Integer, 4>>(x);
368 }
369 CppTypeFor<TypeCategory::Integer, 8> RTDEF(Exponent10_8)(
370     CppTypeFor<TypeCategory::Real, 10> x) {
371   return Exponent<CppTypeFor<TypeCategory::Integer, 8>>(x);
372 }
373 #endif
374 
375 CppTypeFor<TypeCategory::Integer, 1> RTDEF(Floor4_1)(
376     CppTypeFor<TypeCategory::Real, 4> x) {
377   return Floor<CppTypeFor<TypeCategory::Integer, 1>>(x);
378 }
379 CppTypeFor<TypeCategory::Integer, 2> RTDEF(Floor4_2)(
380     CppTypeFor<TypeCategory::Real, 4> x) {
381   return Floor<CppTypeFor<TypeCategory::Integer, 2>>(x);
382 }
383 CppTypeFor<TypeCategory::Integer, 4> RTDEF(Floor4_4)(
384     CppTypeFor<TypeCategory::Real, 4> x) {
385   return Floor<CppTypeFor<TypeCategory::Integer, 4>>(x);
386 }
387 CppTypeFor<TypeCategory::Integer, 8> RTDEF(Floor4_8)(
388     CppTypeFor<TypeCategory::Real, 4> x) {
389   return Floor<CppTypeFor<TypeCategory::Integer, 8>>(x);
390 }
391 #if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T
392 CppTypeFor<TypeCategory::Integer, 16> RTDEF(Floor4_16)(
393     CppTypeFor<TypeCategory::Real, 4> x) {
394   return Floor<CppTypeFor<TypeCategory::Integer, 16>>(x);
395 }
396 #endif
397 CppTypeFor<TypeCategory::Integer, 1> RTDEF(Floor8_1)(
398     CppTypeFor<TypeCategory::Real, 8> x) {
399   return Floor<CppTypeFor<TypeCategory::Integer, 1>>(x);
400 }
401 CppTypeFor<TypeCategory::Integer, 2> RTDEF(Floor8_2)(
402     CppTypeFor<TypeCategory::Real, 8> x) {
403   return Floor<CppTypeFor<TypeCategory::Integer, 2>>(x);
404 }
405 CppTypeFor<TypeCategory::Integer, 4> RTDEF(Floor8_4)(
406     CppTypeFor<TypeCategory::Real, 8> x) {
407   return Floor<CppTypeFor<TypeCategory::Integer, 4>>(x);
408 }
409 CppTypeFor<TypeCategory::Integer, 8> RTDEF(Floor8_8)(
410     CppTypeFor<TypeCategory::Real, 8> x) {
411   return Floor<CppTypeFor<TypeCategory::Integer, 8>>(x);
412 }
413 #if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T
414 CppTypeFor<TypeCategory::Integer, 16> RTDEF(Floor8_16)(
415     CppTypeFor<TypeCategory::Real, 8> x) {
416   return Floor<CppTypeFor<TypeCategory::Integer, 16>>(x);
417 }
418 #endif
419 #if HAS_FLOAT80
420 CppTypeFor<TypeCategory::Integer, 1> RTDEF(Floor10_1)(
421     CppTypeFor<TypeCategory::Real, 10> x) {
422   return Floor<CppTypeFor<TypeCategory::Integer, 1>>(x);
423 }
424 CppTypeFor<TypeCategory::Integer, 2> RTDEF(Floor10_2)(
425     CppTypeFor<TypeCategory::Real, 10> x) {
426   return Floor<CppTypeFor<TypeCategory::Integer, 2>>(x);
427 }
428 CppTypeFor<TypeCategory::Integer, 4> RTDEF(Floor10_4)(
429     CppTypeFor<TypeCategory::Real, 10> x) {
430   return Floor<CppTypeFor<TypeCategory::Integer, 4>>(x);
431 }
432 CppTypeFor<TypeCategory::Integer, 8> RTDEF(Floor10_8)(
433     CppTypeFor<TypeCategory::Real, 10> x) {
434   return Floor<CppTypeFor<TypeCategory::Integer, 8>>(x);
435 }
436 #if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T
437 CppTypeFor<TypeCategory::Integer, 16> RTDEF(Floor10_16)(
438     CppTypeFor<TypeCategory::Real, 10> x) {
439   return Floor<CppTypeFor<TypeCategory::Integer, 16>>(x);
440 }
441 #endif
442 #elif HAS_LDBL128
443 CppTypeFor<TypeCategory::Integer, 1> RTDEF(Floor16_1)(
444     CppTypeFor<TypeCategory::Real, 16> x) {
445   return Floor<CppTypeFor<TypeCategory::Integer, 1>>(x);
446 }
447 CppTypeFor<TypeCategory::Integer, 2> RTDEF(Floor16_2)(
448     CppTypeFor<TypeCategory::Real, 16> x) {
449   return Floor<CppTypeFor<TypeCategory::Integer, 2>>(x);
450 }
451 CppTypeFor<TypeCategory::Integer, 4> RTDEF(Floor16_4)(
452     CppTypeFor<TypeCategory::Real, 16> x) {
453   return Floor<CppTypeFor<TypeCategory::Integer, 4>>(x);
454 }
455 CppTypeFor<TypeCategory::Integer, 8> RTDEF(Floor16_8)(
456     CppTypeFor<TypeCategory::Real, 16> x) {
457   return Floor<CppTypeFor<TypeCategory::Integer, 8>>(x);
458 }
459 #if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T
460 CppTypeFor<TypeCategory::Integer, 16> RTDEF(Floor16_16)(
461     CppTypeFor<TypeCategory::Real, 16> x) {
462   return Floor<CppTypeFor<TypeCategory::Integer, 16>>(x);
463 }
464 #endif
465 #endif
466 
467 CppTypeFor<TypeCategory::Real, 4> RTDEF(Fraction4)(
468     CppTypeFor<TypeCategory::Real, 4> x) {
469   return Fraction(x);
470 }
471 CppTypeFor<TypeCategory::Real, 8> RTDEF(Fraction8)(
472     CppTypeFor<TypeCategory::Real, 8> x) {
473   return Fraction(x);
474 }
475 #if HAS_FLOAT80
476 CppTypeFor<TypeCategory::Real, 10> RTDEF(Fraction10)(
477     CppTypeFor<TypeCategory::Real, 10> x) {
478   return Fraction(x);
479 }
480 #endif
481 
482 bool RTDEF(IsFinite4)(CppTypeFor<TypeCategory::Real, 4> x) {
483   return std::isfinite(x);
484 }
485 bool RTDEF(IsFinite8)(CppTypeFor<TypeCategory::Real, 8> x) {
486   return std::isfinite(x);
487 }
488 #if HAS_FLOAT80
489 bool RTDEF(IsFinite10)(CppTypeFor<TypeCategory::Real, 10> x) {
490   return std::isfinite(x);
491 }
492 #elif HAS_LDBL128
493 bool RTDEF(IsFinite16)(CppTypeFor<TypeCategory::Real, 16> x) {
494   return std::isfinite(x);
495 }
496 #endif
497 
498 bool RTDEF(IsNaN4)(CppTypeFor<TypeCategory::Real, 4> x) {
499   return std::isnan(x);
500 }
501 bool RTDEF(IsNaN8)(CppTypeFor<TypeCategory::Real, 8> x) {
502   return std::isnan(x);
503 }
504 #if HAS_FLOAT80
505 bool RTDEF(IsNaN10)(CppTypeFor<TypeCategory::Real, 10> x) {
506   return std::isnan(x);
507 }
508 #elif HAS_LDBL128
509 bool RTDEF(IsNaN16)(CppTypeFor<TypeCategory::Real, 16> x) {
510   return std::isnan(x);
511 }
512 #endif
513 
514 CppTypeFor<TypeCategory::Integer, 1> RTDEF(ModInteger1)(
515     CppTypeFor<TypeCategory::Integer, 1> x,
516     CppTypeFor<TypeCategory::Integer, 1> p, const char *sourceFile,
517     int sourceLine) {
518   return IntMod<false>(x, p, sourceFile, sourceLine);
519 }
520 CppTypeFor<TypeCategory::Integer, 2> RTDEF(ModInteger2)(
521     CppTypeFor<TypeCategory::Integer, 2> x,
522     CppTypeFor<TypeCategory::Integer, 2> p, const char *sourceFile,
523     int sourceLine) {
524   return IntMod<false>(x, p, sourceFile, sourceLine);
525 }
526 CppTypeFor<TypeCategory::Integer, 4> RTDEF(ModInteger4)(
527     CppTypeFor<TypeCategory::Integer, 4> x,
528     CppTypeFor<TypeCategory::Integer, 4> p, const char *sourceFile,
529     int sourceLine) {
530   return IntMod<false>(x, p, sourceFile, sourceLine);
531 }
532 CppTypeFor<TypeCategory::Integer, 8> RTDEF(ModInteger8)(
533     CppTypeFor<TypeCategory::Integer, 8> x,
534     CppTypeFor<TypeCategory::Integer, 8> p, const char *sourceFile,
535     int sourceLine) {
536   return IntMod<false>(x, p, sourceFile, sourceLine);
537 }
538 #ifdef __SIZEOF_INT128__
539 CppTypeFor<TypeCategory::Integer, 16> RTDEF(ModInteger16)(
540     CppTypeFor<TypeCategory::Integer, 16> x,
541     CppTypeFor<TypeCategory::Integer, 16> p, const char *sourceFile,
542     int sourceLine) {
543   return IntMod<false>(x, p, sourceFile, sourceLine);
544 }
545 #endif
546 CppTypeFor<TypeCategory::Real, 4> RTDEF(ModReal4)(
547     CppTypeFor<TypeCategory::Real, 4> x, CppTypeFor<TypeCategory::Real, 4> p,
548     const char *sourceFile, int sourceLine) {
549   return RealMod<false>(x, p, sourceFile, sourceLine);
550 }
551 CppTypeFor<TypeCategory::Real, 8> RTDEF(ModReal8)(
552     CppTypeFor<TypeCategory::Real, 8> x, CppTypeFor<TypeCategory::Real, 8> p,
553     const char *sourceFile, int sourceLine) {
554   return RealMod<false>(x, p, sourceFile, sourceLine);
555 }
556 #if HAS_FLOAT80
557 CppTypeFor<TypeCategory::Real, 10> RTDEF(ModReal10)(
558     CppTypeFor<TypeCategory::Real, 10> x, CppTypeFor<TypeCategory::Real, 10> p,
559     const char *sourceFile, int sourceLine) {
560   return RealMod<false>(x, p, sourceFile, sourceLine);
561 }
562 #endif
563 
564 CppTypeFor<TypeCategory::Integer, 1> RTDEF(ModuloInteger1)(
565     CppTypeFor<TypeCategory::Integer, 1> x,
566     CppTypeFor<TypeCategory::Integer, 1> p, const char *sourceFile,
567     int sourceLine) {
568   return IntMod<true>(x, p, sourceFile, sourceLine);
569 }
570 CppTypeFor<TypeCategory::Integer, 2> RTDEF(ModuloInteger2)(
571     CppTypeFor<TypeCategory::Integer, 2> x,
572     CppTypeFor<TypeCategory::Integer, 2> p, const char *sourceFile,
573     int sourceLine) {
574   return IntMod<true>(x, p, sourceFile, sourceLine);
575 }
576 CppTypeFor<TypeCategory::Integer, 4> RTDEF(ModuloInteger4)(
577     CppTypeFor<TypeCategory::Integer, 4> x,
578     CppTypeFor<TypeCategory::Integer, 4> p, const char *sourceFile,
579     int sourceLine) {
580   return IntMod<true>(x, p, sourceFile, sourceLine);
581 }
582 CppTypeFor<TypeCategory::Integer, 8> RTDEF(ModuloInteger8)(
583     CppTypeFor<TypeCategory::Integer, 8> x,
584     CppTypeFor<TypeCategory::Integer, 8> p, const char *sourceFile,
585     int sourceLine) {
586   return IntMod<true>(x, p, sourceFile, sourceLine);
587 }
588 #ifdef __SIZEOF_INT128__
589 CppTypeFor<TypeCategory::Integer, 16> RTDEF(ModuloInteger16)(
590     CppTypeFor<TypeCategory::Integer, 16> x,
591     CppTypeFor<TypeCategory::Integer, 16> p, const char *sourceFile,
592     int sourceLine) {
593   return IntMod<true>(x, p, sourceFile, sourceLine);
594 }
595 #endif
596 CppTypeFor<TypeCategory::Real, 4> RTDEF(ModuloReal4)(
597     CppTypeFor<TypeCategory::Real, 4> x, CppTypeFor<TypeCategory::Real, 4> p,
598     const char *sourceFile, int sourceLine) {
599   return RealMod<true>(x, p, sourceFile, sourceLine);
600 }
601 CppTypeFor<TypeCategory::Real, 8> RTDEF(ModuloReal8)(
602     CppTypeFor<TypeCategory::Real, 8> x, CppTypeFor<TypeCategory::Real, 8> p,
603     const char *sourceFile, int sourceLine) {
604   return RealMod<true>(x, p, sourceFile, sourceLine);
605 }
606 #if HAS_FLOAT80
607 CppTypeFor<TypeCategory::Real, 10> RTDEF(ModuloReal10)(
608     CppTypeFor<TypeCategory::Real, 10> x, CppTypeFor<TypeCategory::Real, 10> p,
609     const char *sourceFile, int sourceLine) {
610   return RealMod<true>(x, p, sourceFile, sourceLine);
611 }
612 #endif
613 
614 CppTypeFor<TypeCategory::Real, 4> RTDEF(Nearest4)(
615     CppTypeFor<TypeCategory::Real, 4> x, bool positive) {
616   return Nearest<24>(x, positive);
617 }
618 CppTypeFor<TypeCategory::Real, 8> RTDEF(Nearest8)(
619     CppTypeFor<TypeCategory::Real, 8> x, bool positive) {
620   return Nearest<53>(x, positive);
621 }
622 #if HAS_FLOAT80
623 CppTypeFor<TypeCategory::Real, 10> RTDEF(Nearest10)(
624     CppTypeFor<TypeCategory::Real, 10> x, bool positive) {
625   return Nearest<64>(x, positive);
626 }
627 #endif
628 
629 CppTypeFor<TypeCategory::Integer, 1> RTDEF(Nint4_1)(
630     CppTypeFor<TypeCategory::Real, 4> x) {
631   return Nint<CppTypeFor<TypeCategory::Integer, 1>>(x);
632 }
633 CppTypeFor<TypeCategory::Integer, 2> RTDEF(Nint4_2)(
634     CppTypeFor<TypeCategory::Real, 4> x) {
635   return Nint<CppTypeFor<TypeCategory::Integer, 2>>(x);
636 }
637 CppTypeFor<TypeCategory::Integer, 4> RTDEF(Nint4_4)(
638     CppTypeFor<TypeCategory::Real, 4> x) {
639   return Nint<CppTypeFor<TypeCategory::Integer, 4>>(x);
640 }
641 CppTypeFor<TypeCategory::Integer, 8> RTDEF(Nint4_8)(
642     CppTypeFor<TypeCategory::Real, 4> x) {
643   return Nint<CppTypeFor<TypeCategory::Integer, 8>>(x);
644 }
645 #if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T
646 CppTypeFor<TypeCategory::Integer, 16> RTDEF(Nint4_16)(
647     CppTypeFor<TypeCategory::Real, 4> x) {
648   return Nint<CppTypeFor<TypeCategory::Integer, 16>>(x);
649 }
650 #endif
651 CppTypeFor<TypeCategory::Integer, 1> RTDEF(Nint8_1)(
652     CppTypeFor<TypeCategory::Real, 8> x) {
653   return Nint<CppTypeFor<TypeCategory::Integer, 1>>(x);
654 }
655 CppTypeFor<TypeCategory::Integer, 2> RTDEF(Nint8_2)(
656     CppTypeFor<TypeCategory::Real, 8> x) {
657   return Nint<CppTypeFor<TypeCategory::Integer, 2>>(x);
658 }
659 CppTypeFor<TypeCategory::Integer, 4> RTDEF(Nint8_4)(
660     CppTypeFor<TypeCategory::Real, 8> x) {
661   return Nint<CppTypeFor<TypeCategory::Integer, 4>>(x);
662 }
663 CppTypeFor<TypeCategory::Integer, 8> RTDEF(Nint8_8)(
664     CppTypeFor<TypeCategory::Real, 8> x) {
665   return Nint<CppTypeFor<TypeCategory::Integer, 8>>(x);
666 }
667 #if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T
668 CppTypeFor<TypeCategory::Integer, 16> RTDEF(Nint8_16)(
669     CppTypeFor<TypeCategory::Real, 8> x) {
670   return Nint<CppTypeFor<TypeCategory::Integer, 16>>(x);
671 }
672 #endif
673 #if HAS_FLOAT80
674 CppTypeFor<TypeCategory::Integer, 1> RTDEF(Nint10_1)(
675     CppTypeFor<TypeCategory::Real, 10> x) {
676   return Nint<CppTypeFor<TypeCategory::Integer, 1>>(x);
677 }
678 CppTypeFor<TypeCategory::Integer, 2> RTDEF(Nint10_2)(
679     CppTypeFor<TypeCategory::Real, 10> x) {
680   return Nint<CppTypeFor<TypeCategory::Integer, 2>>(x);
681 }
682 CppTypeFor<TypeCategory::Integer, 4> RTDEF(Nint10_4)(
683     CppTypeFor<TypeCategory::Real, 10> x) {
684   return Nint<CppTypeFor<TypeCategory::Integer, 4>>(x);
685 }
686 CppTypeFor<TypeCategory::Integer, 8> RTDEF(Nint10_8)(
687     CppTypeFor<TypeCategory::Real, 10> x) {
688   return Nint<CppTypeFor<TypeCategory::Integer, 8>>(x);
689 }
690 #if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T
691 CppTypeFor<TypeCategory::Integer, 16> RTDEF(Nint10_16)(
692     CppTypeFor<TypeCategory::Real, 10> x) {
693   return Nint<CppTypeFor<TypeCategory::Integer, 16>>(x);
694 }
695 #endif
696 #elif HAS_LDBL128
697 CppTypeFor<TypeCategory::Integer, 1> RTDEF(Nint16_1)(
698     CppTypeFor<TypeCategory::Real, 16> x) {
699   return Nint<CppTypeFor<TypeCategory::Integer, 1>>(x);
700 }
701 CppTypeFor<TypeCategory::Integer, 2> RTDEF(Nint16_2)(
702     CppTypeFor<TypeCategory::Real, 16> x) {
703   return Nint<CppTypeFor<TypeCategory::Integer, 2>>(x);
704 }
705 CppTypeFor<TypeCategory::Integer, 4> RTDEF(Nint16_4)(
706     CppTypeFor<TypeCategory::Real, 16> x) {
707   return Nint<CppTypeFor<TypeCategory::Integer, 4>>(x);
708 }
709 CppTypeFor<TypeCategory::Integer, 8> RTDEF(Nint16_8)(
710     CppTypeFor<TypeCategory::Real, 16> x) {
711   return Nint<CppTypeFor<TypeCategory::Integer, 8>>(x);
712 }
713 #if defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T
714 CppTypeFor<TypeCategory::Integer, 16> RTDEF(Nint16_16)(
715     CppTypeFor<TypeCategory::Real, 16> x) {
716   return Nint<CppTypeFor<TypeCategory::Integer, 16>>(x);
717 }
718 #endif
719 #endif
720 
721 CppTypeFor<TypeCategory::Real, 4> RTDEF(RRSpacing4)(
722     CppTypeFor<TypeCategory::Real, 4> x) {
723   return RRSpacing<24>(x);
724 }
725 CppTypeFor<TypeCategory::Real, 8> RTDEF(RRSpacing8)(
726     CppTypeFor<TypeCategory::Real, 8> x) {
727   return RRSpacing<53>(x);
728 }
729 #if HAS_FLOAT80
730 CppTypeFor<TypeCategory::Real, 10> RTDEF(RRSpacing10)(
731     CppTypeFor<TypeCategory::Real, 10> x) {
732   return RRSpacing<64>(x);
733 }
734 #endif
735 
736 CppTypeFor<TypeCategory::Real, 4> RTDEF(SetExponent4)(
737     CppTypeFor<TypeCategory::Real, 4> x, std::int64_t p) {
738   return SetExponent(x, p);
739 }
740 CppTypeFor<TypeCategory::Real, 8> RTDEF(SetExponent8)(
741     CppTypeFor<TypeCategory::Real, 8> x, std::int64_t p) {
742   return SetExponent(x, p);
743 }
744 #if HAS_FLOAT80
745 CppTypeFor<TypeCategory::Real, 10> RTDEF(SetExponent10)(
746     CppTypeFor<TypeCategory::Real, 10> x, std::int64_t p) {
747   return SetExponent(x, p);
748 }
749 #endif
750 
751 CppTypeFor<TypeCategory::Real, 4> RTDEF(Scale4)(
752     CppTypeFor<TypeCategory::Real, 4> x, std::int64_t p) {
753   return Scale(x, p);
754 }
755 CppTypeFor<TypeCategory::Real, 8> RTDEF(Scale8)(
756     CppTypeFor<TypeCategory::Real, 8> x, std::int64_t p) {
757   return Scale(x, p);
758 }
759 #if HAS_FLOAT80
760 CppTypeFor<TypeCategory::Real, 10> RTDEF(Scale10)(
761     CppTypeFor<TypeCategory::Real, 10> x, std::int64_t p) {
762   return Scale(x, p);
763 }
764 #endif
765 
766 // SELECTED_CHAR_KIND
767 CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedCharKind)(
768     const char *source, int line, const char *x, std::size_t length) {
769   static const char *keywords[]{
770       "ASCII", "DEFAULT", "UCS-2", "ISO_10646", "UCS-4", nullptr};
771   switch (IdentifyValue(x, length, keywords)) {
772   case 0: // ASCII
773   case 1: // DEFAULT
774     return 1;
775   case 2: // UCS-2
776     return 2;
777   case 3: // ISO_10646
778   case 4: // UCS-4
779     return 4;
780   default:
781     return -1;
782   }
783 }
784 // SELECTED_INT_KIND and SELECTED_UNSIGNED_KIND extension
785 CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedIntKind)(
786     const char *source, int line, void *x, int xKind) {
787   return RTNAME(SelectedIntKindMasked)(source, line, x, xKind,
788       (1 << 1) | (1 << 2) | (1 << 4) | (1 << 8) | (1 << 16));
789 }
790 
791 CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedIntKindMasked)(
792     const char *source, int line, void *x, int xKind, int mask) {
793 #ifdef __SIZEOF_INT128__
794   CppTypeFor<TypeCategory::Integer, 16> r =
795       GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
796           source, line, x, xKind, /*defaultValue*/ 0, /*resKind*/ 16);
797 #else
798   std::int64_t r = GetIntArgValue<std::int64_t>(
799       source, line, x, xKind, /*defaultValue*/ 0, /*resKind*/ 8);
800 #endif
801   return SelectedIntKind(r, mask);
802 }
803 
804 // SELECTED_LOGICAL_KIND
805 CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedLogicalKind)(
806     const char *source, int line, void *x, int xKind) {
807 #ifdef __SIZEOF_INT128__
808   CppTypeFor<TypeCategory::Integer, 16> r =
809       GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
810           source, line, x, xKind, /*defaultValue*/ 0, /*resKind*/ 16);
811 #else
812   std::int64_t r = GetIntArgValue<std::int64_t>(
813       source, line, x, xKind, /*defaultValue*/ 0, /*resKind*/ 8);
814 #endif
815   return SelectedLogicalKind(r);
816 }
817 
818 // SELECTED_REAL_KIND
819 CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedRealKind)(const char *source,
820     int line, void *precision, int pKind, void *range, int rKind, void *radix,
821     int dKind) {
822   return RTNAME(SelectedRealKindMasked)(source, line, precision, pKind, range,
823       rKind, radix, dKind,
824       (1 << 2) | (1 << 3) | (1 << 4) | (1 << 8) | (1 << 10) | (1 << 16));
825 }
826 
827 CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedRealKindMasked)(
828     const char *source, int line, void *precision, int pKind, void *range,
829     int rKind, void *radix, int dKind, int mask) {
830 #ifdef __SIZEOF_INT128__
831   CppTypeFor<TypeCategory::Integer, 16> p =
832       GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
833           source, line, precision, pKind, /*defaultValue*/ 0, /*resKind*/ 16);
834   CppTypeFor<TypeCategory::Integer, 16> r =
835       GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
836           source, line, range, rKind, /*defaultValue*/ 0, /*resKind*/ 16);
837   CppTypeFor<TypeCategory::Integer, 16> d =
838       GetIntArgValue<CppTypeFor<TypeCategory::Integer, 16>>(
839           source, line, radix, dKind, /*defaultValue*/ 2, /*resKind*/ 16);
840 #else
841   std::int64_t p = GetIntArgValue<std::int64_t>(
842       source, line, precision, pKind, /*defaultValue*/ 0, /*resKind*/ 8);
843   std::int64_t r = GetIntArgValue<std::int64_t>(
844       source, line, range, rKind, /*defaultValue*/ 0, /*resKind*/ 8);
845   std::int64_t d = GetIntArgValue<std::int64_t>(
846       source, line, radix, dKind, /*defaultValue*/ 2, /*resKind*/ 8);
847 #endif
848   return SelectedRealKind(p, r, d, mask);
849 }
850 
851 #if HAS_FP16
852 CppTypeFor<TypeCategory::Real, 2> RTDEF(Spacing2)(
853     CppTypeFor<TypeCategory::Real, 2> x) {
854   return Spacing<11>(x);
855 }
856 #endif
857 CppTypeFor<TypeCategory::Real, 4> RTDEF(Spacing2By4)(
858     CppTypeFor<TypeCategory::Real, 4> x) {
859   return Spacing<11>(x);
860 }
861 #if HAS_BF16
862 CppTypeFor<TypeCategory::Real, 3> RTDEF(Spacing3)(
863     CppTypeFor<TypeCategory::Real, 3> x) {
864   return Spacing<8>(x);
865 }
866 #endif
867 CppTypeFor<TypeCategory::Real, 4> RTDEF(Spacing3By4)(
868     CppTypeFor<TypeCategory::Real, 4> x) {
869   return Spacing<8>(x);
870 }
871 CppTypeFor<TypeCategory::Real, 4> RTDEF(Spacing4)(
872     CppTypeFor<TypeCategory::Real, 4> x) {
873   return Spacing<24>(x);
874 }
875 CppTypeFor<TypeCategory::Real, 8> RTDEF(Spacing8)(
876     CppTypeFor<TypeCategory::Real, 8> x) {
877   return Spacing<53>(x);
878 }
879 #if HAS_FLOAT80
880 CppTypeFor<TypeCategory::Real, 10> RTDEF(Spacing10)(
881     CppTypeFor<TypeCategory::Real, 10> x) {
882   return Spacing<64>(x);
883 }
884 #endif
885 
886 CppTypeFor<TypeCategory::Real, 4> RTDEF(FPow4i)(
887     CppTypeFor<TypeCategory::Real, 4> b,
888     CppTypeFor<TypeCategory::Integer, 4> e) {
889   return FPowI(b, e);
890 }
891 CppTypeFor<TypeCategory::Real, 8> RTDEF(FPow8i)(
892     CppTypeFor<TypeCategory::Real, 8> b,
893     CppTypeFor<TypeCategory::Integer, 4> e) {
894   return FPowI(b, e);
895 }
896 #if HAS_FLOAT80
897 CppTypeFor<TypeCategory::Real, 10> RTDEF(FPow10i)(
898     CppTypeFor<TypeCategory::Real, 10> b,
899     CppTypeFor<TypeCategory::Integer, 4> e) {
900   return FPowI(b, e);
901 }
902 #endif
903 #if HAS_LDBL128 || HAS_FLOAT128
904 CppTypeFor<TypeCategory::Real, 16> RTDEF(FPow16i)(
905     CppTypeFor<TypeCategory::Real, 16> b,
906     CppTypeFor<TypeCategory::Integer, 4> e) {
907   return FPowI(b, e);
908 }
909 #endif
910 
911 CppTypeFor<TypeCategory::Real, 4> RTDEF(FPow4k)(
912     CppTypeFor<TypeCategory::Real, 4> b,
913     CppTypeFor<TypeCategory::Integer, 8> e) {
914   return FPowI(b, e);
915 }
916 CppTypeFor<TypeCategory::Real, 8> RTDEF(FPow8k)(
917     CppTypeFor<TypeCategory::Real, 8> b,
918     CppTypeFor<TypeCategory::Integer, 8> e) {
919   return FPowI(b, e);
920 }
921 #if HAS_FLOAT80
922 CppTypeFor<TypeCategory::Real, 10> RTDEF(FPow10k)(
923     CppTypeFor<TypeCategory::Real, 10> b,
924     CppTypeFor<TypeCategory::Integer, 8> e) {
925   return FPowI(b, e);
926 }
927 #endif
928 #if HAS_LDBL128 || HAS_FLOAT128
929 CppTypeFor<TypeCategory::Real, 16> RTDEF(FPow16k)(
930     CppTypeFor<TypeCategory::Real, 16> b,
931     CppTypeFor<TypeCategory::Integer, 8> e) {
932   return FPowI(b, e);
933 }
934 #endif
935 
936 RT_EXT_API_GROUP_END
937 } // extern "C"
938 } // namespace Fortran::runtime
939