1//===-- Numeric.cpp -- runtime API for numeric intrinsics -----------------===//
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/Optimizer/Builder/Runtime/Numeric.h"
10#include "flang/Optimizer/Builder/BoxValue.h"
11#include "flang/Optimizer/Builder/Character.h"
12#include "flang/Optimizer/Builder/FIRBuilder.h"
13#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
14#include "flang/Optimizer/Support/Utils.h"
15#include "flang/Runtime/numeric.h"
16#include "mlir/Dialect/Func/IR/FuncOps.h"
17
18using namespace Fortran::runtime;
19
20// The real*10 and real*16 placeholders below are used to force the
21// compilation of the real*10 and real*16 method names on systems that
22// may not have them in their runtime library. This can occur in the
23// case of cross compilation, for example.
24
25/// Placeholder for real*10 version of Exponent Intrinsic
26struct ForcedExponent10_4 {
27 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Exponent10_4));
28 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
29 return [](mlir::MLIRContext *ctx) {
30 auto fltTy = mlir::FloatType::getF80(ctx);
31 auto intTy = mlir::IntegerType::get(ctx, 32);
32 return mlir::FunctionType::get(ctx, fltTy, intTy);
33 };
34 }
35};
36
37struct ForcedExponent10_8 {
38 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Exponent10_8));
39 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
40 return [](mlir::MLIRContext *ctx) {
41 auto fltTy = mlir::FloatType::getF80(ctx);
42 auto intTy = mlir::IntegerType::get(ctx, 64);
43 return mlir::FunctionType::get(ctx, fltTy, intTy);
44 };
45 }
46};
47
48/// Placeholder for real*16 version of Exponent Intrinsic
49struct ForcedExponent16_4 {
50 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Exponent16_4));
51 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
52 return [](mlir::MLIRContext *ctx) {
53 auto fltTy = mlir::FloatType::getF128(ctx);
54 auto intTy = mlir::IntegerType::get(ctx, 32);
55 return mlir::FunctionType::get(ctx, fltTy, intTy);
56 };
57 }
58};
59
60struct ForcedExponent16_8 {
61 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Exponent16_8));
62 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
63 return [](mlir::MLIRContext *ctx) {
64 auto fltTy = mlir::FloatType::getF128(ctx);
65 auto intTy = mlir::IntegerType::get(ctx, 64);
66 return mlir::FunctionType::get(ctx, fltTy, intTy);
67 };
68 }
69};
70
71/// Placeholder for real*10 version of Fraction Intrinsic
72struct ForcedFraction10 {
73 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Fraction10));
74 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
75 return [](mlir::MLIRContext *ctx) {
76 auto ty = mlir::FloatType::getF80(ctx);
77 return mlir::FunctionType::get(ctx, {ty}, {ty});
78 };
79 }
80};
81
82/// Placeholder for real*16 version of Fraction Intrinsic
83struct ForcedFraction16 {
84 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Fraction16));
85 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
86 return [](mlir::MLIRContext *ctx) {
87 auto ty = mlir::FloatType::getF128(ctx);
88 return mlir::FunctionType::get(ctx, {ty}, {ty});
89 };
90 }
91};
92
93/// Placeholder for real*10 version of Mod Intrinsic
94struct ForcedMod10 {
95 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ModReal10));
96 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
97 return [](mlir::MLIRContext *ctx) {
98 auto fltTy = mlir::FloatType::getF80(ctx);
99 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
100 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
101 return mlir::FunctionType::get(ctx, {fltTy, fltTy, strTy, intTy},
102 {fltTy});
103 };
104 }
105};
106
107/// Placeholder for real*16 version of Mod Intrinsic
108struct ForcedMod16 {
109 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ModReal16));
110 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
111 return [](mlir::MLIRContext *ctx) {
112 auto fltTy = mlir::FloatType::getF128(ctx);
113 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
114 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
115 return mlir::FunctionType::get(ctx, {fltTy, fltTy, strTy, intTy},
116 {fltTy});
117 };
118 }
119};
120
121/// Placeholder for real*10 version of Modulo Intrinsic
122struct ForcedModulo10 {
123 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ModuloReal10));
124 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
125 return [](mlir::MLIRContext *ctx) {
126 auto fltTy = mlir::FloatType::getF80(ctx);
127 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
128 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
129 return mlir::FunctionType::get(ctx, {fltTy, fltTy, strTy, intTy},
130 {fltTy});
131 };
132 }
133};
134
135/// Placeholder for real*16 version of Modulo Intrinsic
136struct ForcedModulo16 {
137 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ModuloReal16));
138 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
139 return [](mlir::MLIRContext *ctx) {
140 auto fltTy = mlir::FloatType::getF128(ctx);
141 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
142 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
143 return mlir::FunctionType::get(ctx, {fltTy, fltTy, strTy, intTy},
144 {fltTy});
145 };
146 }
147};
148
149/// Placeholder for real*10 version of Nearest Intrinsic
150struct ForcedNearest10 {
151 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Nearest10));
152 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
153 return [](mlir::MLIRContext *ctx) {
154 auto fltTy = mlir::FloatType::getF80(ctx);
155 auto boolTy = mlir::IntegerType::get(ctx, 1);
156 return mlir::FunctionType::get(ctx, {fltTy, boolTy}, {fltTy});
157 };
158 }
159};
160
161/// Placeholder for real*16 version of Nearest Intrinsic
162struct ForcedNearest16 {
163 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Nearest16));
164 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
165 return [](mlir::MLIRContext *ctx) {
166 auto fltTy = mlir::FloatType::getF128(ctx);
167 auto boolTy = mlir::IntegerType::get(ctx, 1);
168 return mlir::FunctionType::get(ctx, {fltTy, boolTy}, {fltTy});
169 };
170 }
171};
172
173/// Placeholder for real*10 version of RRSpacing Intrinsic
174struct ForcedRRSpacing10 {
175 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(RRSpacing10));
176 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
177 return [](mlir::MLIRContext *ctx) {
178 auto ty = mlir::FloatType::getF80(ctx);
179 return mlir::FunctionType::get(ctx, {ty}, {ty});
180 };
181 }
182};
183
184/// Placeholder for real*16 version of RRSpacing Intrinsic
185struct ForcedRRSpacing16 {
186 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(RRSpacing16));
187 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
188 return [](mlir::MLIRContext *ctx) {
189 auto ty = mlir::FloatType::getF128(ctx);
190 return mlir::FunctionType::get(ctx, {ty}, {ty});
191 };
192 }
193};
194
195/// Placeholder for real*10 version of Scale Intrinsic
196struct ForcedScale10 {
197 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Scale10));
198 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
199 return [](mlir::MLIRContext *ctx) {
200 auto fltTy = mlir::FloatType::getF80(ctx);
201 auto intTy = mlir::IntegerType::get(ctx, 64);
202 return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});
203 };
204 }
205};
206
207/// Placeholder for real*16 version of Scale Intrinsic
208struct ForcedScale16 {
209 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Scale16));
210 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
211 return [](mlir::MLIRContext *ctx) {
212 auto fltTy = mlir::FloatType::getF128(ctx);
213 auto intTy = mlir::IntegerType::get(ctx, 64);
214 return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});
215 };
216 }
217};
218
219/// Placeholder for real*10 version of RRSpacing Intrinsic
220struct ForcedSetExponent10 {
221 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SetExponent10));
222 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
223 return [](mlir::MLIRContext *ctx) {
224 auto fltTy = mlir::FloatType::getF80(ctx);
225 auto intTy = mlir::IntegerType::get(ctx, 64);
226 return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});
227 };
228 }
229};
230
231/// Placeholder for real*10 version of RRSpacing Intrinsic
232struct ForcedSetExponent16 {
233 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SetExponent16));
234 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
235 return [](mlir::MLIRContext *ctx) {
236 auto fltTy = mlir::FloatType::getF128(ctx);
237 auto intTy = mlir::IntegerType::get(ctx, 64);
238 return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});
239 };
240 }
241};
242
243/// Placeholder for real*10 version of Spacing Intrinsic
244struct ForcedSpacing10 {
245 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Spacing10));
246 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
247 return [](mlir::MLIRContext *ctx) {
248 auto ty = mlir::FloatType::getF80(ctx);
249 return mlir::FunctionType::get(ctx, {ty}, {ty});
250 };
251 }
252};
253
254/// Placeholder for real*16 version of Spacing Intrinsic
255struct ForcedSpacing16 {
256 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Spacing16));
257 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
258 return [](mlir::MLIRContext *ctx) {
259 auto ty = mlir::FloatType::getF128(ctx);
260 return mlir::FunctionType::get(ctx, {ty}, {ty});
261 };
262 }
263};
264
265/// Generate call to Exponent instrinsic runtime routine.
266mlir::Value fir::runtime::genExponent(fir::FirOpBuilder &builder,
267 mlir::Location loc, mlir::Type resultType,
268 mlir::Value x) {
269 mlir::func::FuncOp func;
270 mlir::Type fltTy = x.getType();
271 if (fltTy.isF32()) {
272 if (resultType.isInteger(32))
273 func = fir::runtime::getRuntimeFunc<mkRTKey(Exponent4_4)>(loc, builder);
274 else if (resultType.isInteger(64))
275 func = fir::runtime::getRuntimeFunc<mkRTKey(Exponent4_8)>(loc, builder);
276 } else if (fltTy.isF64()) {
277 if (resultType.isInteger(32))
278 func = fir::runtime::getRuntimeFunc<mkRTKey(Exponent8_4)>(loc, builder);
279 else if (resultType.isInteger(64))
280 func = fir::runtime::getRuntimeFunc<mkRTKey(Exponent8_8)>(loc, builder);
281 } else if (fltTy.isF80()) {
282 if (resultType.isInteger(32))
283 func = fir::runtime::getRuntimeFunc<ForcedExponent10_4>(loc, builder);
284 else if (resultType.isInteger(64))
285 func = fir::runtime::getRuntimeFunc<ForcedExponent10_8>(loc, builder);
286 } else if (fltTy.isF128()) {
287 if (resultType.isInteger(32))
288 func = fir::runtime::getRuntimeFunc<ForcedExponent16_4>(loc, builder);
289 else if (resultType.isInteger(64))
290 func = fir::runtime::getRuntimeFunc<ForcedExponent16_8>(loc, builder);
291 } else
292 fir::intrinsicTypeTODO(builder, fltTy, loc, "EXPONENT");
293
294 auto funcTy = func.getFunctionType();
295 llvm::SmallVector<mlir::Value> args = {
296 builder.createConvert(loc, funcTy.getInput(0), x)};
297
298 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
299}
300
301/// Generate call to Fraction instrinsic runtime routine.
302mlir::Value fir::runtime::genFraction(fir::FirOpBuilder &builder,
303 mlir::Location loc, mlir::Value x) {
304 mlir::func::FuncOp func;
305 mlir::Type fltTy = x.getType();
306 if (fltTy.isF32())
307 func = fir::runtime::getRuntimeFunc<mkRTKey(Fraction4)>(loc, builder);
308 else if (fltTy.isF64())
309 func = fir::runtime::getRuntimeFunc<mkRTKey(Fraction8)>(loc, builder);
310 else if (fltTy.isF80())
311 func = fir::runtime::getRuntimeFunc<ForcedFraction10>(loc, builder);
312 else if (fltTy.isF128())
313 func = fir::runtime::getRuntimeFunc<ForcedFraction16>(loc, builder);
314 else
315 fir::intrinsicTypeTODO(builder, fltTy, loc, "FRACTION");
316
317 auto funcTy = func.getFunctionType();
318 llvm::SmallVector<mlir::Value> args = {
319 builder.createConvert(loc, funcTy.getInput(0), x)};
320
321 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
322}
323
324/// Generate call to Mod intrinsic runtime routine.
325mlir::Value fir::runtime::genMod(fir::FirOpBuilder &builder, mlir::Location loc,
326 mlir::Value a, mlir::Value p) {
327 mlir::func::FuncOp func;
328 mlir::Type fltTy = a.getType();
329
330 if (fltTy != p.getType())
331 fir::emitFatalError(loc, "arguments type mismatch in MOD");
332
333 if (fltTy.isF32())
334 func = fir::runtime::getRuntimeFunc<mkRTKey(ModReal4)>(loc, builder);
335 else if (fltTy.isF64())
336 func = fir::runtime::getRuntimeFunc<mkRTKey(ModReal8)>(loc, builder);
337 else if (fltTy.isF80())
338 func = fir::runtime::getRuntimeFunc<ForcedMod10>(loc, builder);
339 else if (fltTy.isF128())
340 func = fir::runtime::getRuntimeFunc<ForcedMod16>(loc, builder);
341 else
342 fir::intrinsicTypeTODO(builder, fltTy, loc, "MOD");
343
344 auto funcTy = func.getFunctionType();
345 auto sourceFile = fir::factory::locationToFilename(builder, loc);
346 auto sourceLine =
347 fir::factory::locationToLineNo(builder, loc, funcTy.getInput(3));
348 auto args = fir::runtime::createArguments(builder, loc, funcTy, a, p,
349 sourceFile, sourceLine);
350
351 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
352}
353
354/// Generate call to Modulo intrinsic runtime routine.
355mlir::Value fir::runtime::genModulo(fir::FirOpBuilder &builder,
356 mlir::Location loc, mlir::Value a,
357 mlir::Value p) {
358 mlir::func::FuncOp func;
359 mlir::Type fltTy = a.getType();
360
361 if (fltTy != p.getType())
362 fir::emitFatalError(loc, "arguments type mismatch in MOD");
363
364 // MODULO is lowered into math operations in intrinsics lowering,
365 // so genModulo() should only be used for F128 data type now.
366 if (fltTy.isF32())
367 func = fir::runtime::getRuntimeFunc<mkRTKey(ModuloReal4)>(loc, builder);
368 else if (fltTy.isF64())
369 func = fir::runtime::getRuntimeFunc<mkRTKey(ModuloReal8)>(loc, builder);
370 else if (fltTy.isF80())
371 func = fir::runtime::getRuntimeFunc<ForcedModulo10>(loc, builder);
372 else if (fltTy.isF128())
373 func = fir::runtime::getRuntimeFunc<ForcedModulo16>(loc, builder);
374 else
375 fir::intrinsicTypeTODO(builder, fltTy, loc, "MODULO");
376
377 auto funcTy = func.getFunctionType();
378 auto sourceFile = fir::factory::locationToFilename(builder, loc);
379 auto sourceLine =
380 fir::factory::locationToLineNo(builder, loc, funcTy.getInput(3));
381 auto args = fir::runtime::createArguments(builder, loc, funcTy, a, p,
382 sourceFile, sourceLine);
383
384 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
385}
386
387/// Generate call to Nearest intrinsic runtime routine.
388mlir::Value fir::runtime::genNearest(fir::FirOpBuilder &builder,
389 mlir::Location loc, mlir::Value x,
390 mlir::Value s) {
391 mlir::func::FuncOp func;
392 mlir::Type fltTy = x.getType();
393
394 if (fltTy.isF32())
395 func = fir::runtime::getRuntimeFunc<mkRTKey(Nearest4)>(loc, builder);
396 else if (fltTy.isF64())
397 func = fir::runtime::getRuntimeFunc<mkRTKey(Nearest8)>(loc, builder);
398 else if (fltTy.isF80())
399 func = fir::runtime::getRuntimeFunc<ForcedNearest10>(loc, builder);
400 else if (fltTy.isF128())
401 func = fir::runtime::getRuntimeFunc<ForcedNearest16>(loc, builder);
402 else
403 fir::intrinsicTypeTODO(builder, fltTy, loc, "NEAREST");
404
405 auto funcTy = func.getFunctionType();
406
407 mlir::Type sTy = s.getType();
408 mlir::Value zero = builder.createRealZeroConstant(loc, sTy);
409 auto cmp = builder.create<mlir::arith::CmpFOp>(
410 loc, mlir::arith::CmpFPredicate::OGT, s, zero);
411
412 mlir::Type boolTy = mlir::IntegerType::get(builder.getContext(), 1);
413 mlir::Value False = builder.createIntegerConstant(loc, boolTy, 0);
414 mlir::Value True = builder.createIntegerConstant(loc, boolTy, 1);
415
416 mlir::Value positive =
417 builder.create<mlir::arith::SelectOp>(loc, cmp, True, False);
418 auto args = fir::runtime::createArguments(builder, loc, funcTy, x, positive);
419
420 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
421}
422
423/// Generate call to RRSpacing intrinsic runtime routine.
424mlir::Value fir::runtime::genRRSpacing(fir::FirOpBuilder &builder,
425 mlir::Location loc, mlir::Value x) {
426 mlir::func::FuncOp func;
427 mlir::Type fltTy = x.getType();
428
429 if (fltTy.isF32())
430 func = fir::runtime::getRuntimeFunc<mkRTKey(RRSpacing4)>(loc, builder);
431 else if (fltTy.isF64())
432 func = fir::runtime::getRuntimeFunc<mkRTKey(RRSpacing8)>(loc, builder);
433 else if (fltTy.isF80())
434 func = fir::runtime::getRuntimeFunc<ForcedRRSpacing10>(loc, builder);
435 else if (fltTy.isF128())
436 func = fir::runtime::getRuntimeFunc<ForcedRRSpacing16>(loc, builder);
437 else
438 fir::intrinsicTypeTODO(builder, fltTy, loc, "RRSPACING");
439
440 auto funcTy = func.getFunctionType();
441 llvm::SmallVector<mlir::Value> args = {
442 builder.createConvert(loc, funcTy.getInput(0), x)};
443
444 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
445}
446
447/// Generate call to Scale intrinsic runtime routine.
448mlir::Value fir::runtime::genScale(fir::FirOpBuilder &builder,
449 mlir::Location loc, mlir::Value x,
450 mlir::Value i) {
451 mlir::func::FuncOp func;
452 mlir::Type fltTy = x.getType();
453
454 if (fltTy.isF32())
455 func = fir::runtime::getRuntimeFunc<mkRTKey(Scale4)>(loc, builder);
456 else if (fltTy.isF64())
457 func = fir::runtime::getRuntimeFunc<mkRTKey(Scale8)>(loc, builder);
458 else if (fltTy.isF80())
459 func = fir::runtime::getRuntimeFunc<ForcedScale10>(loc, builder);
460 else if (fltTy.isF128())
461 func = fir::runtime::getRuntimeFunc<ForcedScale16>(loc, builder);
462 else
463 fir::intrinsicTypeTODO(builder, fltTy, loc, "SCALE");
464
465 auto funcTy = func.getFunctionType();
466 auto args = fir::runtime::createArguments(builder, loc, funcTy, x, i);
467
468 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
469}
470
471/// Generate call to Selected_int_kind intrinsic runtime routine.
472mlir::Value fir::runtime::genSelectedIntKind(fir::FirOpBuilder &builder,
473 mlir::Location loc,
474 mlir::Value x) {
475 mlir::func::FuncOp func =
476 fir::runtime::getRuntimeFunc<mkRTKey(SelectedIntKind)>(loc, builder);
477 auto fTy = func.getFunctionType();
478 auto sourceFile = fir::factory::locationToFilename(builder, loc);
479 auto sourceLine =
480 fir::factory::locationToLineNo(builder, loc, fTy.getInput(1));
481 if (!fir::isa_ref_type(x.getType()))
482 fir::emitFatalError(loc, "argument address for runtime not found");
483 mlir::Type eleTy = fir::unwrapRefType(x.getType());
484 mlir::Value xKind = builder.createIntegerConstant(
485 loc, fTy.getInput(3), eleTy.getIntOrFloatBitWidth() / 8);
486 auto args = fir::runtime::createArguments(builder, loc, fTy, sourceFile,
487 sourceLine, x, xKind);
488
489 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
490}
491
492/// Generate call to Selected_real_kind intrinsic runtime routine.
493mlir::Value fir::runtime::genSelectedRealKind(fir::FirOpBuilder &builder,
494 mlir::Location loc,
495 mlir::Value precision,
496 mlir::Value range,
497 mlir::Value radix) {
498 mlir::func::FuncOp func =
499 fir::runtime::getRuntimeFunc<mkRTKey(SelectedRealKind)>(loc, builder);
500 auto fTy = func.getFunctionType();
501 auto getArgKinds = [&](mlir::Value arg, int argKindIndex) -> mlir::Value {
502 if (fir::isa_ref_type(arg.getType())) {
503 mlir::Type eleTy = fir::unwrapRefType(arg.getType());
504 return builder.createIntegerConstant(loc, fTy.getInput(argKindIndex),
505 eleTy.getIntOrFloatBitWidth() / 8);
506 } else {
507 return builder.createIntegerConstant(loc, fTy.getInput(argKindIndex), 0);
508 }
509 };
510
511 auto sourceFile = fir::factory::locationToFilename(builder, loc);
512 auto sourceLine =
513 fir::factory::locationToLineNo(builder, loc, fTy.getInput(1));
514 mlir::Value pKind = getArgKinds(precision, 3);
515 mlir::Value rKind = getArgKinds(range, 5);
516 mlir::Value dKind = getArgKinds(radix, 7);
517 auto args = fir::runtime::createArguments(builder, loc, fTy, sourceFile,
518 sourceLine, precision, pKind, range,
519 rKind, radix, dKind);
520
521 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
522}
523
524/// Generate call to Set_exponent instrinsic runtime routine.
525mlir::Value fir::runtime::genSetExponent(fir::FirOpBuilder &builder,
526 mlir::Location loc, mlir::Value x,
527 mlir::Value i) {
528 mlir::func::FuncOp func;
529 mlir::Type fltTy = x.getType();
530
531 if (fltTy.isF32())
532 func = fir::runtime::getRuntimeFunc<mkRTKey(SetExponent4)>(loc, builder);
533 else if (fltTy.isF64())
534 func = fir::runtime::getRuntimeFunc<mkRTKey(SetExponent8)>(loc, builder);
535 else if (fltTy.isF80())
536 func = fir::runtime::getRuntimeFunc<ForcedSetExponent10>(loc, builder);
537 else if (fltTy.isF128())
538 func = fir::runtime::getRuntimeFunc<ForcedSetExponent16>(loc, builder);
539 else
540 fir::intrinsicTypeTODO(builder, fltTy, loc, "SET_EXPONENT");
541
542 auto funcTy = func.getFunctionType();
543 auto args = fir::runtime::createArguments(builder, loc, funcTy, x, i);
544
545 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
546}
547
548/// Generate call to Spacing intrinsic runtime routine.
549mlir::Value fir::runtime::genSpacing(fir::FirOpBuilder &builder,
550 mlir::Location loc, mlir::Value x) {
551 mlir::func::FuncOp func;
552 mlir::Type fltTy = x.getType();
553
554 if (fltTy.isF32())
555 func = fir::runtime::getRuntimeFunc<mkRTKey(Spacing4)>(loc, builder);
556 else if (fltTy.isF64())
557 func = fir::runtime::getRuntimeFunc<mkRTKey(Spacing8)>(loc, builder);
558 else if (fltTy.isF80())
559 func = fir::runtime::getRuntimeFunc<ForcedSpacing10>(loc, builder);
560 else if (fltTy.isF128())
561 func = fir::runtime::getRuntimeFunc<ForcedSpacing16>(loc, builder);
562 else
563 fir::intrinsicTypeTODO(builder, fltTy, loc, "SPACING");
564
565 auto funcTy = func.getFunctionType();
566 llvm::SmallVector<mlir::Value> args = {
567 builder.createConvert(loc, funcTy.getInput(0), x)};
568
569 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
570}
571

source code of flang/lib/Optimizer/Builder/Runtime/Numeric.cpp