xref: /llvm-project/flang/lib/Optimizer/Builder/Runtime/Numeric.cpp (revision f023da12d12635f5fba436e825cbfc999e28e623) 
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 
18 using 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
26 struct 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
37 struct 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
48 struct 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 
59 struct 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
71 struct 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 
82 struct 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
94 struct 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
105 struct 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
116 struct 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
130 struct 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
144 struct 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
158 struct 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
172 struct 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
184 struct 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
196 struct 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
207 struct 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
218 struct 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
230 struct 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
242 struct 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
254 struct 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
266 struct 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
277 struct 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.
288 mlir::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.
324 mlir::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.
347 mlir::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.
377 mlir::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.
410 mlir::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.
434 mlir::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.
458 mlir::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.
482 mlir::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.
506 mlir::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.
526 mlir::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.
547 mlir::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.
568 mlir::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.
600 mlir::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.
624 mlir::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