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-exception
6//
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#endif
47 } 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**p
95}
96
97// SELECTED_INT_KIND (16.9.169) and SELECTED_UNSIGNED_KIND extension
98template <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_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)
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_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)
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
232extern "C" {
233RT_EXT_API_GROUP_BEGIN
234
235CppTypeFor<TypeCategory::Integer, 1> RTDEF(Ceiling4_1)(
236 CppTypeFor<TypeCategory::Real, 4> x) {
237 return Ceiling<CppTypeFor<TypeCategory::Integer, 1>>(x);
238}
239CppTypeFor<TypeCategory::Integer, 2> RTDEF(Ceiling4_2)(
240 CppTypeFor<TypeCategory::Real, 4> x) {
241 return Ceiling<CppTypeFor<TypeCategory::Integer, 2>>(x);
242}
243CppTypeFor<TypeCategory::Integer, 4> RTDEF(Ceiling4_4)(
244 CppTypeFor<TypeCategory::Real, 4> x) {
245 return Ceiling<CppTypeFor<TypeCategory::Integer, 4>>(x);
246}
247CppTypeFor<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
252CppTypeFor<TypeCategory::Integer, 16> RTDEF(Ceiling4_16)(
253 CppTypeFor<TypeCategory::Real, 4> x) {
254 return Ceiling<CppTypeFor<TypeCategory::Integer, 16>>(x);
255}
256#endif
257CppTypeFor<TypeCategory::Integer, 1> RTDEF(Ceiling8_1)(
258 CppTypeFor<TypeCategory::Real, 8> x) {
259 return Ceiling<CppTypeFor<TypeCategory::Integer, 1>>(x);
260}
261CppTypeFor<TypeCategory::Integer, 2> RTDEF(Ceiling8_2)(
262 CppTypeFor<TypeCategory::Real, 8> x) {
263 return Ceiling<CppTypeFor<TypeCategory::Integer, 2>>(x);
264}
265CppTypeFor<TypeCategory::Integer, 4> RTDEF(Ceiling8_4)(
266 CppTypeFor<TypeCategory::Real, 8> x) {
267 return Ceiling<CppTypeFor<TypeCategory::Integer, 4>>(x);
268}
269CppTypeFor<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
274CppTypeFor<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
280CppTypeFor<TypeCategory::Integer, 1> RTDEF(Ceiling10_1)(
281 CppTypeFor<TypeCategory::Real, 10> x) {
282 return Ceiling<CppTypeFor<TypeCategory::Integer, 1>>(x);
283}
284CppTypeFor<TypeCategory::Integer, 2> RTDEF(Ceiling10_2)(
285 CppTypeFor<TypeCategory::Real, 10> x) {
286 return Ceiling<CppTypeFor<TypeCategory::Integer, 2>>(x);
287}
288CppTypeFor<TypeCategory::Integer, 4> RTDEF(Ceiling10_4)(
289 CppTypeFor<TypeCategory::Real, 10> x) {
290 return Ceiling<CppTypeFor<TypeCategory::Integer, 4>>(x);
291}
292CppTypeFor<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
297CppTypeFor<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
303CppTypeFor<TypeCategory::Integer, 1> RTDEF(Ceiling16_1)(
304 CppTypeFor<TypeCategory::Real, 16> x) {
305 return Ceiling<CppTypeFor<TypeCategory::Integer, 1>>(x);
306}
307CppTypeFor<TypeCategory::Integer, 2> RTDEF(Ceiling16_2)(
308 CppTypeFor<TypeCategory::Real, 16> x) {
309 return Ceiling<CppTypeFor<TypeCategory::Integer, 2>>(x);
310}
311CppTypeFor<TypeCategory::Integer, 4> RTDEF(Ceiling16_4)(
312 CppTypeFor<TypeCategory::Real, 16> x) {
313 return Ceiling<CppTypeFor<TypeCategory::Integer, 4>>(x);
314}
315CppTypeFor<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
320CppTypeFor<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
327CppTypeFor<TypeCategory::Real, 4> RTDEF(ErfcScaled4)(
328 CppTypeFor<TypeCategory::Real, 4> x) {
329 return ErfcScaled(x);
330}
331CppTypeFor<TypeCategory::Real, 8> RTDEF(ErfcScaled8)(
332 CppTypeFor<TypeCategory::Real, 8> x) {
333 return ErfcScaled(x);
334}
335#if HAS_FLOAT80
336CppTypeFor<TypeCategory::Real, 10> RTDEF(ErfcScaled10)(
337 CppTypeFor<TypeCategory::Real, 10> x) {
338 return ErfcScaled(x);
339}
340#endif
341#if HAS_LDBL128
342CppTypeFor<TypeCategory::Real, 16> RTDEF(ErfcScaled16)(
343 CppTypeFor<TypeCategory::Real, 16> x) {
344 return ErfcScaled(x);
345}
346#endif
347
348CppTypeFor<TypeCategory::Integer, 4> RTDEF(Exponent4_4)(
349 CppTypeFor<TypeCategory::Real, 4> x) {
350 return Exponent<CppTypeFor<TypeCategory::Integer, 4>>(x);
351}
352CppTypeFor<TypeCategory::Integer, 8> RTDEF(Exponent4_8)(
353 CppTypeFor<TypeCategory::Real, 4> x) {
354 return Exponent<CppTypeFor<TypeCategory::Integer, 8>>(x);
355}
356CppTypeFor<TypeCategory::Integer, 4> RTDEF(Exponent8_4)(
357 CppTypeFor<TypeCategory::Real, 8> x) {
358 return Exponent<CppTypeFor<TypeCategory::Integer, 4>>(x);
359}
360CppTypeFor<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
365CppTypeFor<TypeCategory::Integer, 4> RTDEF(Exponent10_4)(
366 CppTypeFor<TypeCategory::Real, 10> x) {
367 return Exponent<CppTypeFor<TypeCategory::Integer, 4>>(x);
368}
369CppTypeFor<TypeCategory::Integer, 8> RTDEF(Exponent10_8)(
370 CppTypeFor<TypeCategory::Real, 10> x) {
371 return Exponent<CppTypeFor<TypeCategory::Integer, 8>>(x);
372}
373#endif
374
375CppTypeFor<TypeCategory::Integer, 1> RTDEF(Floor4_1)(
376 CppTypeFor<TypeCategory::Real, 4> x) {
377 return Floor<CppTypeFor<TypeCategory::Integer, 1>>(x);
378}
379CppTypeFor<TypeCategory::Integer, 2> RTDEF(Floor4_2)(
380 CppTypeFor<TypeCategory::Real, 4> x) {
381 return Floor<CppTypeFor<TypeCategory::Integer, 2>>(x);
382}
383CppTypeFor<TypeCategory::Integer, 4> RTDEF(Floor4_4)(
384 CppTypeFor<TypeCategory::Real, 4> x) {
385 return Floor<CppTypeFor<TypeCategory::Integer, 4>>(x);
386}
387CppTypeFor<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
392CppTypeFor<TypeCategory::Integer, 16> RTDEF(Floor4_16)(
393 CppTypeFor<TypeCategory::Real, 4> x) {
394 return Floor<CppTypeFor<TypeCategory::Integer, 16>>(x);
395}
396#endif
397CppTypeFor<TypeCategory::Integer, 1> RTDEF(Floor8_1)(
398 CppTypeFor<TypeCategory::Real, 8> x) {
399 return Floor<CppTypeFor<TypeCategory::Integer, 1>>(x);
400}
401CppTypeFor<TypeCategory::Integer, 2> RTDEF(Floor8_2)(
402 CppTypeFor<TypeCategory::Real, 8> x) {
403 return Floor<CppTypeFor<TypeCategory::Integer, 2>>(x);
404}
405CppTypeFor<TypeCategory::Integer, 4> RTDEF(Floor8_4)(
406 CppTypeFor<TypeCategory::Real, 8> x) {
407 return Floor<CppTypeFor<TypeCategory::Integer, 4>>(x);
408}
409CppTypeFor<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
414CppTypeFor<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
420CppTypeFor<TypeCategory::Integer, 1> RTDEF(Floor10_1)(
421 CppTypeFor<TypeCategory::Real, 10> x) {
422 return Floor<CppTypeFor<TypeCategory::Integer, 1>>(x);
423}
424CppTypeFor<TypeCategory::Integer, 2> RTDEF(Floor10_2)(
425 CppTypeFor<TypeCategory::Real, 10> x) {
426 return Floor<CppTypeFor<TypeCategory::Integer, 2>>(x);
427}
428CppTypeFor<TypeCategory::Integer, 4> RTDEF(Floor10_4)(
429 CppTypeFor<TypeCategory::Real, 10> x) {
430 return Floor<CppTypeFor<TypeCategory::Integer, 4>>(x);
431}
432CppTypeFor<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
437CppTypeFor<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
443CppTypeFor<TypeCategory::Integer, 1> RTDEF(Floor16_1)(
444 CppTypeFor<TypeCategory::Real, 16> x) {
445 return Floor<CppTypeFor<TypeCategory::Integer, 1>>(x);
446}
447CppTypeFor<TypeCategory::Integer, 2> RTDEF(Floor16_2)(
448 CppTypeFor<TypeCategory::Real, 16> x) {
449 return Floor<CppTypeFor<TypeCategory::Integer, 2>>(x);
450}
451CppTypeFor<TypeCategory::Integer, 4> RTDEF(Floor16_4)(
452 CppTypeFor<TypeCategory::Real, 16> x) {
453 return Floor<CppTypeFor<TypeCategory::Integer, 4>>(x);
454}
455CppTypeFor<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
460CppTypeFor<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
467CppTypeFor<TypeCategory::Real, 4> RTDEF(Fraction4)(
468 CppTypeFor<TypeCategory::Real, 4> x) {
469 return Fraction(x);
470}
471CppTypeFor<TypeCategory::Real, 8> RTDEF(Fraction8)(
472 CppTypeFor<TypeCategory::Real, 8> x) {
473 return Fraction(x);
474}
475#if HAS_FLOAT80
476CppTypeFor<TypeCategory::Real, 10> RTDEF(Fraction10)(
477 CppTypeFor<TypeCategory::Real, 10> x) {
478 return Fraction(x);
479}
480#endif
481
482bool RTDEF(IsFinite4)(CppTypeFor<TypeCategory::Real, 4> x) {
483 return std::isfinite(x);
484}
485bool RTDEF(IsFinite8)(CppTypeFor<TypeCategory::Real, 8> x) {
486 return std::isfinite(x);
487}
488#if HAS_FLOAT80
489bool RTDEF(IsFinite10)(CppTypeFor<TypeCategory::Real, 10> x) {
490 return std::isfinite(x);
491}
492#elif HAS_LDBL128
493bool RTDEF(IsFinite16)(CppTypeFor<TypeCategory::Real, 16> x) {
494 return std::isfinite(x);
495}
496#endif
497
498bool RTDEF(IsNaN4)(CppTypeFor<TypeCategory::Real, 4> x) {
499 return std::isnan(x);
500}
501bool RTDEF(IsNaN8)(CppTypeFor<TypeCategory::Real, 8> x) {
502 return std::isnan(x);
503}
504#if HAS_FLOAT80
505bool RTDEF(IsNaN10)(CppTypeFor<TypeCategory::Real, 10> x) {
506 return std::isnan(x);
507}
508#elif HAS_LDBL128
509bool RTDEF(IsNaN16)(CppTypeFor<TypeCategory::Real, 16> x) {
510 return std::isnan(x);
511}
512#endif
513
514CppTypeFor<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}
520CppTypeFor<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}
526CppTypeFor<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}
532CppTypeFor<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__
539CppTypeFor<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
546CppTypeFor<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}
551CppTypeFor<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
557CppTypeFor<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
564CppTypeFor<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}
570CppTypeFor<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}
576CppTypeFor<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}
582CppTypeFor<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__
589CppTypeFor<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
596CppTypeFor<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}
601CppTypeFor<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
607CppTypeFor<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
614CppTypeFor<TypeCategory::Real, 4> RTDEF(Nearest4)(
615 CppTypeFor<TypeCategory::Real, 4> x, bool positive) {
616 return Nearest<24>(x, positive);
617}
618CppTypeFor<TypeCategory::Real, 8> RTDEF(Nearest8)(
619 CppTypeFor<TypeCategory::Real, 8> x, bool positive) {
620 return Nearest<53>(x, positive);
621}
622#if HAS_FLOAT80
623CppTypeFor<TypeCategory::Real, 10> RTDEF(Nearest10)(
624 CppTypeFor<TypeCategory::Real, 10> x, bool positive) {
625 return Nearest<64>(x, positive);
626}
627#endif
628
629CppTypeFor<TypeCategory::Integer, 1> RTDEF(Nint4_1)(
630 CppTypeFor<TypeCategory::Real, 4> x) {
631 return Nint<CppTypeFor<TypeCategory::Integer, 1>>(x);
632}
633CppTypeFor<TypeCategory::Integer, 2> RTDEF(Nint4_2)(
634 CppTypeFor<TypeCategory::Real, 4> x) {
635 return Nint<CppTypeFor<TypeCategory::Integer, 2>>(x);
636}
637CppTypeFor<TypeCategory::Integer, 4> RTDEF(Nint4_4)(
638 CppTypeFor<TypeCategory::Real, 4> x) {
639 return Nint<CppTypeFor<TypeCategory::Integer, 4>>(x);
640}
641CppTypeFor<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
646CppTypeFor<TypeCategory::Integer, 16> RTDEF(Nint4_16)(
647 CppTypeFor<TypeCategory::Real, 4> x) {
648 return Nint<CppTypeFor<TypeCategory::Integer, 16>>(x);
649}
650#endif
651CppTypeFor<TypeCategory::Integer, 1> RTDEF(Nint8_1)(
652 CppTypeFor<TypeCategory::Real, 8> x) {
653 return Nint<CppTypeFor<TypeCategory::Integer, 1>>(x);
654}
655CppTypeFor<TypeCategory::Integer, 2> RTDEF(Nint8_2)(
656 CppTypeFor<TypeCategory::Real, 8> x) {
657 return Nint<CppTypeFor<TypeCategory::Integer, 2>>(x);
658}
659CppTypeFor<TypeCategory::Integer, 4> RTDEF(Nint8_4)(
660 CppTypeFor<TypeCategory::Real, 8> x) {
661 return Nint<CppTypeFor<TypeCategory::Integer, 4>>(x);
662}
663CppTypeFor<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
668CppTypeFor<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
674CppTypeFor<TypeCategory::Integer, 1> RTDEF(Nint10_1)(
675 CppTypeFor<TypeCategory::Real, 10> x) {
676 return Nint<CppTypeFor<TypeCategory::Integer, 1>>(x);
677}
678CppTypeFor<TypeCategory::Integer, 2> RTDEF(Nint10_2)(
679 CppTypeFor<TypeCategory::Real, 10> x) {
680 return Nint<CppTypeFor<TypeCategory::Integer, 2>>(x);
681}
682CppTypeFor<TypeCategory::Integer, 4> RTDEF(Nint10_4)(
683 CppTypeFor<TypeCategory::Real, 10> x) {
684 return Nint<CppTypeFor<TypeCategory::Integer, 4>>(x);
685}
686CppTypeFor<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
691CppTypeFor<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
697CppTypeFor<TypeCategory::Integer, 1> RTDEF(Nint16_1)(
698 CppTypeFor<TypeCategory::Real, 16> x) {
699 return Nint<CppTypeFor<TypeCategory::Integer, 1>>(x);
700}
701CppTypeFor<TypeCategory::Integer, 2> RTDEF(Nint16_2)(
702 CppTypeFor<TypeCategory::Real, 16> x) {
703 return Nint<CppTypeFor<TypeCategory::Integer, 2>>(x);
704}
705CppTypeFor<TypeCategory::Integer, 4> RTDEF(Nint16_4)(
706 CppTypeFor<TypeCategory::Real, 16> x) {
707 return Nint<CppTypeFor<TypeCategory::Integer, 4>>(x);
708}
709CppTypeFor<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
714CppTypeFor<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
721CppTypeFor<TypeCategory::Real, 4> RTDEF(RRSpacing4)(
722 CppTypeFor<TypeCategory::Real, 4> x) {
723 return RRSpacing<24>(x);
724}
725CppTypeFor<TypeCategory::Real, 8> RTDEF(RRSpacing8)(
726 CppTypeFor<TypeCategory::Real, 8> x) {
727 return RRSpacing<53>(x);
728}
729#if HAS_FLOAT80
730CppTypeFor<TypeCategory::Real, 10> RTDEF(RRSpacing10)(
731 CppTypeFor<TypeCategory::Real, 10> x) {
732 return RRSpacing<64>(x);
733}
734#endif
735
736CppTypeFor<TypeCategory::Real, 4> RTDEF(SetExponent4)(
737 CppTypeFor<TypeCategory::Real, 4> x, std::int64_t p) {
738 return SetExponent(x, p);
739}
740CppTypeFor<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
745CppTypeFor<TypeCategory::Real, 10> RTDEF(SetExponent10)(
746 CppTypeFor<TypeCategory::Real, 10> x, std::int64_t p) {
747 return SetExponent(x, p);
748}
749#endif
750
751CppTypeFor<TypeCategory::Real, 4> RTDEF(Scale4)(
752 CppTypeFor<TypeCategory::Real, 4> x, std::int64_t p) {
753 return Scale(x, p);
754}
755CppTypeFor<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
760CppTypeFor<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
767CppTypeFor<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
785CppTypeFor<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
791CppTypeFor<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
805CppTypeFor<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
819CppTypeFor<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
827CppTypeFor<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
852CppTypeFor<TypeCategory::Real, 2> RTDEF(Spacing2)(
853 CppTypeFor<TypeCategory::Real, 2> x) {
854 return Spacing<11>(x);
855}
856#endif
857CppTypeFor<TypeCategory::Real, 4> RTDEF(Spacing2By4)(
858 CppTypeFor<TypeCategory::Real, 4> x) {
859 return Spacing<11>(x);
860}
861#if HAS_BF16
862CppTypeFor<TypeCategory::Real, 3> RTDEF(Spacing3)(
863 CppTypeFor<TypeCategory::Real, 3> x) {
864 return Spacing<8>(x);
865}
866#endif
867CppTypeFor<TypeCategory::Real, 4> RTDEF(Spacing3By4)(
868 CppTypeFor<TypeCategory::Real, 4> x) {
869 return Spacing<8>(x);
870}
871CppTypeFor<TypeCategory::Real, 4> RTDEF(Spacing4)(
872 CppTypeFor<TypeCategory::Real, 4> x) {
873 return Spacing<24>(x);
874}
875CppTypeFor<TypeCategory::Real, 8> RTDEF(Spacing8)(
876 CppTypeFor<TypeCategory::Real, 8> x) {
877 return Spacing<53>(x);
878}
879#if HAS_FLOAT80
880CppTypeFor<TypeCategory::Real, 10> RTDEF(Spacing10)(
881 CppTypeFor<TypeCategory::Real, 10> x) {
882 return Spacing<64>(x);
883}
884#endif
885
886CppTypeFor<TypeCategory::Real, 4> RTDEF(FPow4i)(
887 CppTypeFor<TypeCategory::Real, 4> b,
888 CppTypeFor<TypeCategory::Integer, 4> e) {
889 return FPowI(b, e);
890}
891CppTypeFor<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
897CppTypeFor<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
904CppTypeFor<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
911CppTypeFor<TypeCategory::Real, 4> RTDEF(FPow4k)(
912 CppTypeFor<TypeCategory::Real, 4> b,
913 CppTypeFor<TypeCategory::Integer, 8> e) {
914 return FPowI(b, e);
915}
916CppTypeFor<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
922CppTypeFor<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
929CppTypeFor<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
936RT_EXT_API_GROUP_END
937} // extern "C"
938} // namespace Fortran::runtime
939

source code of flang-rt/lib/runtime/numeric.cpp