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 ErfcScaled Intrinsic
26struct ForcedErfcScaled10 {
27 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ErfcScaled10));
28 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
29 return [](mlir::MLIRContext *ctx) {
30 auto ty = mlir::Float80Type::get(ctx);
31 return mlir::FunctionType::get(ctx, {ty}, {ty});
32 };
33 }
34};
35
36/// Placeholder for real*16 version of ErfcScaled Intrinsic
37struct ForcedErfcScaled16 {
38 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ErfcScaled16));
39 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
40 return [](mlir::MLIRContext *ctx) {
41 auto ty = mlir::Float128Type::get(ctx);
42 return mlir::FunctionType::get(ctx, {ty}, {ty});
43 };
44 }
45};
46
47/// Placeholder for real*10 version of Exponent Intrinsic
48struct ForcedExponent10_4 {
49 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Exponent10_4));
50 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
51 return [](mlir::MLIRContext *ctx) {
52 auto fltTy = mlir::Float80Type::get(ctx);
53 auto intTy = mlir::IntegerType::get(ctx, 32);
54 return mlir::FunctionType::get(ctx, fltTy, intTy);
55 };
56 }
57};
58
59struct ForcedExponent10_8 {
60 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Exponent10_8));
61 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
62 return [](mlir::MLIRContext *ctx) {
63 auto fltTy = mlir::Float80Type::get(ctx);
64 auto intTy = mlir::IntegerType::get(ctx, 64);
65 return mlir::FunctionType::get(ctx, fltTy, intTy);
66 };
67 }
68};
69
70/// Placeholder for real*16 version of Exponent Intrinsic
71struct ForcedExponent16_4 {
72 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Exponent16_4));
73 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
74 return [](mlir::MLIRContext *ctx) {
75 auto fltTy = mlir::Float128Type::get(ctx);
76 auto intTy = mlir::IntegerType::get(ctx, 32);
77 return mlir::FunctionType::get(ctx, fltTy, intTy);
78 };
79 }
80};
81
82struct ForcedExponent16_8 {
83 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Exponent16_8));
84 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
85 return [](mlir::MLIRContext *ctx) {
86 auto fltTy = mlir::Float128Type::get(ctx);
87 auto intTy = mlir::IntegerType::get(ctx, 64);
88 return mlir::FunctionType::get(ctx, fltTy, intTy);
89 };
90 }
91};
92
93/// Placeholder for real*10 version of Fraction Intrinsic
94struct ForcedFraction10 {
95 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Fraction10));
96 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
97 return [](mlir::MLIRContext *ctx) {
98 auto ty = mlir::Float80Type::get(ctx);
99 return mlir::FunctionType::get(ctx, {ty}, {ty});
100 };
101 }
102};
103
104/// Placeholder for real*16 version of Fraction Intrinsic
105struct ForcedFraction16 {
106 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Fraction16));
107 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
108 return [](mlir::MLIRContext *ctx) {
109 auto ty = mlir::Float128Type::get(ctx);
110 return mlir::FunctionType::get(ctx, {ty}, {ty});
111 };
112 }
113};
114
115/// Placeholder for real*10 version of Mod Intrinsic
116struct ForcedMod10 {
117 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ModReal10));
118 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
119 return [](mlir::MLIRContext *ctx) {
120 auto fltTy = mlir::Float80Type::get(ctx);
121 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
122 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
123 return mlir::FunctionType::get(ctx, {fltTy, fltTy, strTy, intTy},
124 {fltTy});
125 };
126 }
127};
128
129/// Placeholder for real*16 version of Mod Intrinsic
130struct ForcedMod16 {
131 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ModReal16));
132 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
133 return [](mlir::MLIRContext *ctx) {
134 auto fltTy = mlir::Float128Type::get(ctx);
135 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
136 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
137 return mlir::FunctionType::get(ctx, {fltTy, fltTy, strTy, intTy},
138 {fltTy});
139 };
140 }
141};
142
143/// Placeholder for real*10 version of Modulo Intrinsic
144struct ForcedModulo10 {
145 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ModuloReal10));
146 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
147 return [](mlir::MLIRContext *ctx) {
148 auto fltTy = mlir::Float80Type::get(ctx);
149 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
150 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
151 return mlir::FunctionType::get(ctx, {fltTy, fltTy, strTy, intTy},
152 {fltTy});
153 };
154 }
155};
156
157/// Placeholder for real*16 version of Modulo Intrinsic
158struct ForcedModulo16 {
159 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ModuloReal16));
160 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
161 return [](mlir::MLIRContext *ctx) {
162 auto fltTy = mlir::Float128Type::get(ctx);
163 auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
164 auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
165 return mlir::FunctionType::get(ctx, {fltTy, fltTy, strTy, intTy},
166 {fltTy});
167 };
168 }
169};
170
171/// Placeholder for real*10 version of Nearest Intrinsic
172struct ForcedNearest10 {
173 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Nearest10));
174 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
175 return [](mlir::MLIRContext *ctx) {
176 auto fltTy = mlir::Float80Type::get(ctx);
177 auto boolTy = mlir::IntegerType::get(ctx, 1);
178 return mlir::FunctionType::get(ctx, {fltTy, boolTy}, {fltTy});
179 };
180 }
181};
182
183/// Placeholder for real*16 version of Nearest Intrinsic
184struct ForcedNearest16 {
185 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Nearest16));
186 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
187 return [](mlir::MLIRContext *ctx) {
188 auto fltTy = mlir::Float128Type::get(ctx);
189 auto boolTy = mlir::IntegerType::get(ctx, 1);
190 return mlir::FunctionType::get(ctx, {fltTy, boolTy}, {fltTy});
191 };
192 }
193};
194
195/// Placeholder for real*10 version of RRSpacing Intrinsic
196struct ForcedRRSpacing10 {
197 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(RRSpacing10));
198 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
199 return [](mlir::MLIRContext *ctx) {
200 auto ty = mlir::Float80Type::get(ctx);
201 return mlir::FunctionType::get(ctx, {ty}, {ty});
202 };
203 }
204};
205
206/// Placeholder for real*16 version of RRSpacing Intrinsic
207struct ForcedRRSpacing16 {
208 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(RRSpacing16));
209 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
210 return [](mlir::MLIRContext *ctx) {
211 auto ty = mlir::Float128Type::get(ctx);
212 return mlir::FunctionType::get(ctx, {ty}, {ty});
213 };
214 }
215};
216
217/// Placeholder for real*10 version of Scale Intrinsic
218struct ForcedScale10 {
219 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Scale10));
220 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
221 return [](mlir::MLIRContext *ctx) {
222 auto fltTy = mlir::Float80Type::get(ctx);
223 auto intTy = mlir::IntegerType::get(ctx, 64);
224 return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});
225 };
226 }
227};
228
229/// Placeholder for real*16 version of Scale Intrinsic
230struct ForcedScale16 {
231 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Scale16));
232 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
233 return [](mlir::MLIRContext *ctx) {
234 auto fltTy = mlir::Float128Type::get(ctx);
235 auto intTy = mlir::IntegerType::get(ctx, 64);
236 return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});
237 };
238 }
239};
240
241/// Placeholder for real*10 version of RRSpacing Intrinsic
242struct ForcedSetExponent10 {
243 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SetExponent10));
244 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
245 return [](mlir::MLIRContext *ctx) {
246 auto fltTy = mlir::Float80Type::get(ctx);
247 auto intTy = mlir::IntegerType::get(ctx, 64);
248 return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});
249 };
250 }
251};
252
253/// Placeholder for real*10 version of RRSpacing Intrinsic
254struct ForcedSetExponent16 {
255 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SetExponent16));
256 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
257 return [](mlir::MLIRContext *ctx) {
258 auto fltTy = mlir::Float128Type::get(ctx);
259 auto intTy = mlir::IntegerType::get(ctx, 64);
260 return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});
261 };
262 }
263};
264
265/// Placeholder for real*10 version of Spacing Intrinsic
266struct ForcedSpacing10 {
267 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Spacing10));
268 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
269 return [](mlir::MLIRContext *ctx) {
270 auto ty = mlir::Float80Type::get(ctx);
271 return mlir::FunctionType::get(ctx, {ty}, {ty});
272 };
273 }
274};
275
276/// Placeholder for real*16 version of Spacing Intrinsic
277struct ForcedSpacing16 {
278 static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Spacing16));
279 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
280 return [](mlir::MLIRContext *ctx) {
281 auto ty = mlir::Float128Type::get(ctx);
282 return mlir::FunctionType::get(ctx, {ty}, {ty});
283 };
284 }
285};
286
287/// Generate call to Exponent intrinsic runtime routine.
288mlir::Value fir::runtime::genExponent(fir::FirOpBuilder &builder,
289 mlir::Location loc, mlir::Type resultType,
290 mlir::Value x) {
291 mlir::func::FuncOp func;
292 mlir::Type fltTy = x.getType();
293 if (fltTy.isF32()) {
294 if (resultType.isInteger(32))
295 func = fir::runtime::getRuntimeFunc<mkRTKey(Exponent4_4)>(loc, builder);
296 else if (resultType.isInteger(64))
297 func = fir::runtime::getRuntimeFunc<mkRTKey(Exponent4_8)>(loc, builder);
298 } else if (fltTy.isF64()) {
299 if (resultType.isInteger(32))
300 func = fir::runtime::getRuntimeFunc<mkRTKey(Exponent8_4)>(loc, builder);
301 else if (resultType.isInteger(64))
302 func = fir::runtime::getRuntimeFunc<mkRTKey(Exponent8_8)>(loc, builder);
303 } else if (fltTy.isF80()) {
304 if (resultType.isInteger(32))
305 func = fir::runtime::getRuntimeFunc<ForcedExponent10_4>(loc, builder);
306 else if (resultType.isInteger(64))
307 func = fir::runtime::getRuntimeFunc<ForcedExponent10_8>(loc, builder);
308 } else if (fltTy.isF128()) {
309 if (resultType.isInteger(32))
310 func = fir::runtime::getRuntimeFunc<ForcedExponent16_4>(loc, builder);
311 else if (resultType.isInteger(64))
312 func = fir::runtime::getRuntimeFunc<ForcedExponent16_8>(loc, builder);
313 } else
314 fir::intrinsicTypeTODO(builder, fltTy, loc, "EXPONENT");
315
316 auto funcTy = func.getFunctionType();
317 llvm::SmallVector<mlir::Value> args = {
318 builder.createConvert(loc, funcTy.getInput(0), x)};
319
320 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
321}
322
323/// Generate call to Fraction intrinsic runtime routine.
324mlir::Value fir::runtime::genFraction(fir::FirOpBuilder &builder,
325 mlir::Location loc, mlir::Value x) {
326 mlir::func::FuncOp func;
327 mlir::Type fltTy = x.getType();
328 if (fltTy.isF32())
329 func = fir::runtime::getRuntimeFunc<mkRTKey(Fraction4)>(loc, builder);
330 else if (fltTy.isF64())
331 func = fir::runtime::getRuntimeFunc<mkRTKey(Fraction8)>(loc, builder);
332 else if (fltTy.isF80())
333 func = fir::runtime::getRuntimeFunc<ForcedFraction10>(loc, builder);
334 else if (fltTy.isF128())
335 func = fir::runtime::getRuntimeFunc<ForcedFraction16>(loc, builder);
336 else
337 fir::intrinsicTypeTODO(builder, fltTy, loc, "FRACTION");
338
339 auto funcTy = func.getFunctionType();
340 llvm::SmallVector<mlir::Value> args = {
341 builder.createConvert(loc, funcTy.getInput(0), x)};
342
343 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
344}
345
346/// Generate call to Mod intrinsic runtime routine.
347mlir::Value fir::runtime::genMod(fir::FirOpBuilder &builder, mlir::Location loc,
348 mlir::Value a, mlir::Value p) {
349 mlir::func::FuncOp func;
350 mlir::Type fltTy = a.getType();
351
352 if (fltTy != p.getType())
353 fir::emitFatalError(loc, "arguments type mismatch in MOD");
354
355 if (fltTy.isF32())
356 func = fir::runtime::getRuntimeFunc<mkRTKey(ModReal4)>(loc, builder);
357 else if (fltTy.isF64())
358 func = fir::runtime::getRuntimeFunc<mkRTKey(ModReal8)>(loc, builder);
359 else if (fltTy.isF80())
360 func = fir::runtime::getRuntimeFunc<ForcedMod10>(loc, builder);
361 else if (fltTy.isF128())
362 func = fir::runtime::getRuntimeFunc<ForcedMod16>(loc, builder);
363 else
364 fir::intrinsicTypeTODO(builder, fltTy, loc, "MOD");
365
366 auto funcTy = func.getFunctionType();
367 auto sourceFile = fir::factory::locationToFilename(builder, loc);
368 auto sourceLine =
369 fir::factory::locationToLineNo(builder, loc, funcTy.getInput(3));
370 auto args = fir::runtime::createArguments(builder, loc, funcTy, a, p,
371 sourceFile, sourceLine);
372
373 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
374}
375
376/// Generate call to Modulo intrinsic runtime routine.
377mlir::Value fir::runtime::genModulo(fir::FirOpBuilder &builder,
378 mlir::Location loc, mlir::Value a,
379 mlir::Value p) {
380 mlir::func::FuncOp func;
381 mlir::Type fltTy = a.getType();
382
383 if (fltTy != p.getType())
384 fir::emitFatalError(loc, "arguments type mismatch in MOD");
385
386 // MODULO is lowered into math operations in intrinsics lowering,
387 // so genModulo() should only be used for F128 data type now.
388 if (fltTy.isF32())
389 func = fir::runtime::getRuntimeFunc<mkRTKey(ModuloReal4)>(loc, builder);
390 else if (fltTy.isF64())
391 func = fir::runtime::getRuntimeFunc<mkRTKey(ModuloReal8)>(loc, builder);
392 else if (fltTy.isF80())
393 func = fir::runtime::getRuntimeFunc<ForcedModulo10>(loc, builder);
394 else if (fltTy.isF128())
395 func = fir::runtime::getRuntimeFunc<ForcedModulo16>(loc, builder);
396 else
397 fir::intrinsicTypeTODO(builder, fltTy, loc, "MODULO");
398
399 auto funcTy = func.getFunctionType();
400 auto sourceFile = fir::factory::locationToFilename(builder, loc);
401 auto sourceLine =
402 fir::factory::locationToLineNo(builder, loc, funcTy.getInput(3));
403 auto args = fir::runtime::createArguments(builder, loc, funcTy, a, p,
404 sourceFile, sourceLine);
405
406 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
407}
408
409/// Generate call to Nearest intrinsic or a "Next" intrinsic module procedure.
410mlir::Value fir::runtime::genNearest(fir::FirOpBuilder &builder,
411 mlir::Location loc, mlir::Value x,
412 mlir::Value valueUp) {
413 mlir::func::FuncOp func;
414 mlir::Type fltTy = x.getType();
415
416 if (fltTy.isF32())
417 func = fir::runtime::getRuntimeFunc<mkRTKey(Nearest4)>(loc, builder);
418 else if (fltTy.isF64())
419 func = fir::runtime::getRuntimeFunc<mkRTKey(Nearest8)>(loc, builder);
420 else if (fltTy.isF80())
421 func = fir::runtime::getRuntimeFunc<ForcedNearest10>(loc, builder);
422 else if (fltTy.isF128())
423 func = fir::runtime::getRuntimeFunc<ForcedNearest16>(loc, builder);
424 else
425 fir::intrinsicTypeTODO(builder, fltTy, loc, "NEAREST");
426
427 auto funcTy = func.getFunctionType();
428 auto args = fir::runtime::createArguments(builder, loc, funcTy, x, valueUp);
429
430 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
431}
432
433/// Generate call to RRSpacing intrinsic runtime routine.
434mlir::Value fir::runtime::genRRSpacing(fir::FirOpBuilder &builder,
435 mlir::Location loc, mlir::Value x) {
436 mlir::func::FuncOp func;
437 mlir::Type fltTy = x.getType();
438
439 if (fltTy.isF32())
440 func = fir::runtime::getRuntimeFunc<mkRTKey(RRSpacing4)>(loc, builder);
441 else if (fltTy.isF64())
442 func = fir::runtime::getRuntimeFunc<mkRTKey(RRSpacing8)>(loc, builder);
443 else if (fltTy.isF80())
444 func = fir::runtime::getRuntimeFunc<ForcedRRSpacing10>(loc, builder);
445 else if (fltTy.isF128())
446 func = fir::runtime::getRuntimeFunc<ForcedRRSpacing16>(loc, builder);
447 else
448 fir::intrinsicTypeTODO(builder, fltTy, loc, "RRSPACING");
449
450 auto funcTy = func.getFunctionType();
451 llvm::SmallVector<mlir::Value> args = {
452 builder.createConvert(loc, funcTy.getInput(0), x)};
453
454 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
455}
456
457/// Generate call to ErfcScaled intrinsic runtime routine.
458mlir::Value fir::runtime::genErfcScaled(fir::FirOpBuilder &builder,
459 mlir::Location loc, mlir::Value x) {
460 mlir::func::FuncOp func;
461 mlir::Type fltTy = x.getType();
462
463 if (fltTy.isF32())
464 func = fir::runtime::getRuntimeFunc<mkRTKey(ErfcScaled4)>(loc, builder);
465 else if (fltTy.isF64())
466 func = fir::runtime::getRuntimeFunc<mkRTKey(ErfcScaled8)>(loc, builder);
467 else if (fltTy.isF80())
468 func = fir::runtime::getRuntimeFunc<ForcedErfcScaled10>(loc, builder);
469 else if (fltTy.isF128())
470 func = fir::runtime::getRuntimeFunc<ForcedErfcScaled16>(loc, builder);
471 else
472 fir::intrinsicTypeTODO(builder, fltTy, loc, "ERFC_SCALED");
473
474 auto funcTy = func.getFunctionType();
475 llvm::SmallVector<mlir::Value> args = {
476 builder.createConvert(loc, funcTy.getInput(0), x)};
477
478 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
479}
480
481/// Generate call to Scale intrinsic runtime routine.
482mlir::Value fir::runtime::genScale(fir::FirOpBuilder &builder,
483 mlir::Location loc, mlir::Value x,
484 mlir::Value i) {
485 mlir::func::FuncOp func;
486 mlir::Type fltTy = x.getType();
487
488 if (fltTy.isF32())
489 func = fir::runtime::getRuntimeFunc<mkRTKey(Scale4)>(loc, builder);
490 else if (fltTy.isF64())
491 func = fir::runtime::getRuntimeFunc<mkRTKey(Scale8)>(loc, builder);
492 else if (fltTy.isF80())
493 func = fir::runtime::getRuntimeFunc<ForcedScale10>(loc, builder);
494 else if (fltTy.isF128())
495 func = fir::runtime::getRuntimeFunc<ForcedScale16>(loc, builder);
496 else
497 fir::intrinsicTypeTODO(builder, fltTy, loc, "SCALE");
498
499 auto funcTy = func.getFunctionType();
500 auto args = fir::runtime::createArguments(builder, loc, funcTy, x, i);
501
502 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
503}
504
505/// Generate call to Selected_char_kind intrinsic runtime routine.
506mlir::Value fir::runtime::genSelectedCharKind(fir::FirOpBuilder &builder,
507 mlir::Location loc,
508 mlir::Value name,
509 mlir::Value length) {
510 mlir::func::FuncOp func =
511 fir::runtime::getRuntimeFunc<mkRTKey(SelectedCharKind)>(loc, builder);
512 auto fTy = func.getFunctionType();
513 auto sourceFile = fir::factory::locationToFilename(builder, loc);
514 auto sourceLine =
515 fir::factory::locationToLineNo(builder, loc, fTy.getInput(1));
516 if (!fir::isa_ref_type(name.getType()))
517 fir::emitFatalError(loc, "argument address for runtime not found");
518
519 auto args = fir::runtime::createArguments(builder, loc, fTy, sourceFile,
520 sourceLine, name, length);
521
522 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
523}
524
525/// Generate call to Selected_int_kind intrinsic runtime routine.
526mlir::Value fir::runtime::genSelectedIntKind(fir::FirOpBuilder &builder,
527 mlir::Location loc,
528 mlir::Value x) {
529 mlir::func::FuncOp func =
530 fir::runtime::getRuntimeFunc<mkRTKey(SelectedIntKind)>(loc, builder);
531 auto fTy = func.getFunctionType();
532 auto sourceFile = fir::factory::locationToFilename(builder, loc);
533 auto sourceLine =
534 fir::factory::locationToLineNo(builder, loc, fTy.getInput(1));
535 if (!fir::isa_ref_type(x.getType()))
536 fir::emitFatalError(loc, "argument address for runtime not found");
537 mlir::Type eleTy = fir::unwrapRefType(x.getType());
538 mlir::Value xKind = builder.createIntegerConstant(
539 loc, fTy.getInput(3), eleTy.getIntOrFloatBitWidth() / 8);
540 auto args = fir::runtime::createArguments(builder, loc, fTy, sourceFile,
541 sourceLine, x, xKind);
542
543 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
544}
545
546/// Generate call to Selected_logical_kind intrinsic runtime routine.
547mlir::Value fir::runtime::genSelectedLogicalKind(fir::FirOpBuilder &builder,
548 mlir::Location loc,
549 mlir::Value x) {
550 mlir::func::FuncOp func =
551 fir::runtime::getRuntimeFunc<mkRTKey(SelectedLogicalKind)>(loc, builder);
552 auto fTy = func.getFunctionType();
553 auto sourceFile = fir::factory::locationToFilename(builder, loc);
554 auto sourceLine =
555 fir::factory::locationToLineNo(builder, loc, fTy.getInput(1));
556 if (!fir::isa_ref_type(x.getType()))
557 fir::emitFatalError(loc, "argument address for runtime not found");
558 mlir::Type eleTy = fir::unwrapRefType(x.getType());
559 mlir::Value xKind = builder.createIntegerConstant(
560 loc, fTy.getInput(3), eleTy.getIntOrFloatBitWidth() / 8);
561 auto args = fir::runtime::createArguments(builder, loc, fTy, sourceFile,
562 sourceLine, x, xKind);
563
564 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
565}
566
567/// Generate call to Selected_real_kind intrinsic runtime routine.
568mlir::Value fir::runtime::genSelectedRealKind(fir::FirOpBuilder &builder,
569 mlir::Location loc,
570 mlir::Value precision,
571 mlir::Value range,
572 mlir::Value radix) {
573 mlir::func::FuncOp func =
574 fir::runtime::getRuntimeFunc<mkRTKey(SelectedRealKind)>(loc, builder);
575 auto fTy = func.getFunctionType();
576 auto getArgKinds = [&](mlir::Value arg, int argKindIndex) -> mlir::Value {
577 if (fir::isa_ref_type(arg.getType())) {
578 mlir::Type eleTy = fir::unwrapRefType(arg.getType());
579 return builder.createIntegerConstant(loc, fTy.getInput(argKindIndex),
580 eleTy.getIntOrFloatBitWidth() / 8);
581 } else {
582 return builder.createIntegerConstant(loc, fTy.getInput(argKindIndex), 0);
583 }
584 };
585
586 auto sourceFile = fir::factory::locationToFilename(builder, loc);
587 auto sourceLine =
588 fir::factory::locationToLineNo(builder, loc, fTy.getInput(1));
589 mlir::Value pKind = getArgKinds(precision, 3);
590 mlir::Value rKind = getArgKinds(range, 5);
591 mlir::Value dKind = getArgKinds(radix, 7);
592 auto args = fir::runtime::createArguments(builder, loc, fTy, sourceFile,
593 sourceLine, precision, pKind, range,
594 rKind, radix, dKind);
595
596 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
597}
598
599/// Generate call to Set_exponent intrinsic runtime routine.
600mlir::Value fir::runtime::genSetExponent(fir::FirOpBuilder &builder,
601 mlir::Location loc, mlir::Value x,
602 mlir::Value i) {
603 mlir::func::FuncOp func;
604 mlir::Type fltTy = x.getType();
605
606 if (fltTy.isF32())
607 func = fir::runtime::getRuntimeFunc<mkRTKey(SetExponent4)>(loc, builder);
608 else if (fltTy.isF64())
609 func = fir::runtime::getRuntimeFunc<mkRTKey(SetExponent8)>(loc, builder);
610 else if (fltTy.isF80())
611 func = fir::runtime::getRuntimeFunc<ForcedSetExponent10>(loc, builder);
612 else if (fltTy.isF128())
613 func = fir::runtime::getRuntimeFunc<ForcedSetExponent16>(loc, builder);
614 else
615 fir::intrinsicTypeTODO(builder, fltTy, loc, "SET_EXPONENT");
616
617 auto funcTy = func.getFunctionType();
618 auto args = fir::runtime::createArguments(builder, loc, funcTy, x, i);
619
620 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
621}
622
623/// Generate call to Spacing intrinsic runtime routine.
624mlir::Value fir::runtime::genSpacing(fir::FirOpBuilder &builder,
625 mlir::Location loc, mlir::Value x) {
626 mlir::func::FuncOp func;
627 mlir::Type fltTy = x.getType();
628 // TODO: for f16/bf16, there are better alternatives that do not require
629 // casting the argument (resp. result) to (resp. from) f32, but this requires
630 // knowing that the target runtime has been compiled with std::float16_t or
631 // std::bfloat16_t support, which is not an information available here for
632 // now.
633 if (fltTy.isF32())
634 func = fir::runtime::getRuntimeFunc<mkRTKey(Spacing4)>(loc, builder);
635 else if (fltTy.isF64())
636 func = fir::runtime::getRuntimeFunc<mkRTKey(Spacing8)>(loc, builder);
637 else if (fltTy.isF80())
638 func = fir::runtime::getRuntimeFunc<ForcedSpacing10>(loc, builder);
639 else if (fltTy.isF128())
640 func = fir::runtime::getRuntimeFunc<ForcedSpacing16>(loc, builder);
641 else if (fltTy.isF16())
642 func = fir::runtime::getRuntimeFunc<mkRTKey(Spacing2By4)>(loc, builder);
643 else if (fltTy.isBF16())
644 func = fir::runtime::getRuntimeFunc<mkRTKey(Spacing3By4)>(loc, builder);
645 else
646 fir::intrinsicTypeTODO(builder, fltTy, loc, "SPACING");
647
648 auto funcTy = func.getFunctionType();
649 llvm::SmallVector<mlir::Value> args = {
650 builder.createConvert(loc, funcTy.getInput(0), x)};
651
652 mlir::Value res = builder.create<fir::CallOp>(loc, func, args).getResult(0);
653 return builder.createConvert(loc, fltTy, res);
654}
655

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