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/Runtime/numeric.h"
15 #include "mlir/Dialect/Func/IR/FuncOps.h"
16 
17 using namespace Fortran::runtime;
18 
19 // The real*10 and real*16 placeholders below are used to force the
20 // compilation of the real*10 and real*16 method names on systems that
21 // may not have them in their runtime library. This can occur in the
22 // case of cross compilation, for example.
23 
24 /// Placeholder for real*10 version of Exponent Intrinsic
25 struct ForcedExponent10_4 {
26   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Exponent10_4));
27   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
28     return [](mlir::MLIRContext *ctx) {
29       auto fltTy = mlir::FloatType::getF80(ctx);
30       auto intTy = mlir::IntegerType::get(ctx, 32);
31       return mlir::FunctionType::get(ctx, fltTy, intTy);
32     };
33   }
34 };
35 
36 struct ForcedExponent10_8 {
37   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Exponent10_8));
38   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
39     return [](mlir::MLIRContext *ctx) {
40       auto fltTy = mlir::FloatType::getF80(ctx);
41       auto intTy = mlir::IntegerType::get(ctx, 64);
42       return mlir::FunctionType::get(ctx, fltTy, intTy);
43     };
44   }
45 };
46 
47 /// Placeholder for real*16 version of Exponent Intrinsic
48 struct ForcedExponent16_4 {
49   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Exponent16_4));
50   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
51     return [](mlir::MLIRContext *ctx) {
52       auto fltTy = mlir::FloatType::getF128(ctx);
53       auto intTy = mlir::IntegerType::get(ctx, 32);
54       return mlir::FunctionType::get(ctx, fltTy, intTy);
55     };
56   }
57 };
58 
59 struct ForcedExponent16_8 {
60   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Exponent16_8));
61   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
62     return [](mlir::MLIRContext *ctx) {
63       auto fltTy = mlir::FloatType::getF128(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*10 version of Fraction Intrinsic
71 struct ForcedFraction10 {
72   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Fraction10));
73   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
74     return [](mlir::MLIRContext *ctx) {
75       auto ty = mlir::FloatType::getF80(ctx);
76       return mlir::FunctionType::get(ctx, {ty}, {ty});
77     };
78   }
79 };
80 
81 /// Placeholder for real*16 version of Fraction Intrinsic
82 struct ForcedFraction16 {
83   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Fraction16));
84   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
85     return [](mlir::MLIRContext *ctx) {
86       auto ty = mlir::FloatType::getF128(ctx);
87       return mlir::FunctionType::get(ctx, {ty}, {ty});
88     };
89   }
90 };
91 
92 /// Placeholder for real*10 version of Nearest Intrinsic
93 struct ForcedNearest10 {
94   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Nearest10));
95   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
96     return [](mlir::MLIRContext *ctx) {
97       auto fltTy = mlir::FloatType::getF80(ctx);
98       auto boolTy = mlir::IntegerType::get(ctx, 1);
99       return mlir::FunctionType::get(ctx, {fltTy, boolTy}, {fltTy});
100     };
101   }
102 };
103 
104 /// Placeholder for real*16 version of Nearest Intrinsic
105 struct ForcedNearest16 {
106   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Nearest16));
107   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
108     return [](mlir::MLIRContext *ctx) {
109       auto fltTy = mlir::FloatType::getF128(ctx);
110       auto boolTy = mlir::IntegerType::get(ctx, 1);
111       return mlir::FunctionType::get(ctx, {fltTy, boolTy}, {fltTy});
112     };
113   }
114 };
115 
116 /// Placeholder for real*10 version of RRSpacing Intrinsic
117 struct ForcedRRSpacing10 {
118   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(RRSpacing10));
119   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
120     return [](mlir::MLIRContext *ctx) {
121       auto ty = mlir::FloatType::getF80(ctx);
122       return mlir::FunctionType::get(ctx, {ty}, {ty});
123     };
124   }
125 };
126 
127 /// Placeholder for real*16 version of RRSpacing Intrinsic
128 struct ForcedRRSpacing16 {
129   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(RRSpacing16));
130   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
131     return [](mlir::MLIRContext *ctx) {
132       auto ty = mlir::FloatType::getF128(ctx);
133       return mlir::FunctionType::get(ctx, {ty}, {ty});
134     };
135   }
136 };
137 
138 /// Placeholder for real*10 version of Scale Intrinsic
139 struct ForcedScale10 {
140   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Scale10));
141   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
142     return [](mlir::MLIRContext *ctx) {
143       auto fltTy = mlir::FloatType::getF80(ctx);
144       auto intTy = mlir::IntegerType::get(ctx, 64);
145       return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});
146     };
147   }
148 };
149 
150 /// Placeholder for real*16 version of Scale Intrinsic
151 struct ForcedScale16 {
152   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Scale16));
153   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
154     return [](mlir::MLIRContext *ctx) {
155       auto fltTy = mlir::FloatType::getF128(ctx);
156       auto intTy = mlir::IntegerType::get(ctx, 64);
157       return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});
158     };
159   }
160 };
161 
162 /// Placeholder for real*10 version of RRSpacing Intrinsic
163 struct ForcedSetExponent10 {
164   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SetExponent10));
165   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
166     return [](mlir::MLIRContext *ctx) {
167       auto fltTy = mlir::FloatType::getF80(ctx);
168       auto intTy = mlir::IntegerType::get(ctx, 64);
169       return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});
170     };
171   }
172 };
173 
174 /// Placeholder for real*10 version of RRSpacing Intrinsic
175 struct ForcedSetExponent16 {
176   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SetExponent16));
177   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
178     return [](mlir::MLIRContext *ctx) {
179       auto fltTy = mlir::FloatType::getF128(ctx);
180       auto intTy = mlir::IntegerType::get(ctx, 64);
181       return mlir::FunctionType::get(ctx, {fltTy, intTy}, {fltTy});
182     };
183   }
184 };
185 
186 /// Placeholder for real*10 version of Spacing Intrinsic
187 struct ForcedSpacing10 {
188   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Spacing10));
189   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
190     return [](mlir::MLIRContext *ctx) {
191       auto ty = mlir::FloatType::getF80(ctx);
192       return mlir::FunctionType::get(ctx, {ty}, {ty});
193     };
194   }
195 };
196 
197 /// Placeholder for real*16 version of Spacing Intrinsic
198 struct ForcedSpacing16 {
199   static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Spacing16));
200   static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
201     return [](mlir::MLIRContext *ctx) {
202       auto ty = mlir::FloatType::getF128(ctx);
203       return mlir::FunctionType::get(ctx, {ty}, {ty});
204     };
205   }
206 };
207 
208 /// Generate call to Exponent instrinsic runtime routine.
209 mlir::Value fir::runtime::genExponent(fir::FirOpBuilder &builder,
210                                       mlir::Location loc, mlir::Type resultType,
211                                       mlir::Value x) {
212   mlir::FuncOp func;
213   mlir::Type fltTy = x.getType();
214 
215   if (fltTy.isF32()) {
216     if (resultType.isInteger(32))
217       func = fir::runtime::getRuntimeFunc<mkRTKey(Exponent4_4)>(loc, builder);
218     else if (resultType.isInteger(64))
219       func = fir::runtime::getRuntimeFunc<mkRTKey(Exponent4_8)>(loc, builder);
220   } else if (fltTy.isF64()) {
221     if (resultType.isInteger(32))
222       func = fir::runtime::getRuntimeFunc<mkRTKey(Exponent8_4)>(loc, builder);
223     else if (resultType.isInteger(64))
224       func = fir::runtime::getRuntimeFunc<mkRTKey(Exponent8_8)>(loc, builder);
225   } else if (fltTy.isF80()) {
226     if (resultType.isInteger(32))
227       func = fir::runtime::getRuntimeFunc<ForcedExponent10_4>(loc, builder);
228     else if (resultType.isInteger(64))
229       func = fir::runtime::getRuntimeFunc<ForcedExponent10_8>(loc, builder);
230   } else if (fltTy.isF128()) {
231     if (resultType.isInteger(32))
232       func = fir::runtime::getRuntimeFunc<ForcedExponent16_4>(loc, builder);
233     else if (resultType.isInteger(64))
234       func = fir::runtime::getRuntimeFunc<ForcedExponent16_8>(loc, builder);
235   } else
236     fir::emitFatalError(loc, "unsupported real kind in Exponent lowering");
237 
238   auto funcTy = func.getType();
239   llvm::SmallVector<mlir::Value> args = {
240       builder.createConvert(loc, funcTy.getInput(0), x)};
241 
242   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
243 }
244 
245 /// Generate call to Fraction instrinsic runtime routine.
246 mlir::Value fir::runtime::genFraction(fir::FirOpBuilder &builder,
247                                       mlir::Location loc, mlir::Value x) {
248   mlir::FuncOp func;
249   mlir::Type fltTy = x.getType();
250 
251   if (fltTy.isF32())
252     func = fir::runtime::getRuntimeFunc<mkRTKey(Fraction4)>(loc, builder);
253   else if (fltTy.isF64())
254     func = fir::runtime::getRuntimeFunc<mkRTKey(Fraction8)>(loc, builder);
255   else if (fltTy.isF80())
256     func = fir::runtime::getRuntimeFunc<ForcedFraction10>(loc, builder);
257   else if (fltTy.isF128())
258     func = fir::runtime::getRuntimeFunc<ForcedFraction16>(loc, builder);
259   else
260     fir::emitFatalError(loc, "unsupported real kind in Fraction lowering");
261 
262   auto funcTy = func.getType();
263   llvm::SmallVector<mlir::Value> args = {
264       builder.createConvert(loc, funcTy.getInput(0), x)};
265 
266   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
267 }
268 
269 /// Generate call to Nearest intrinsic runtime routine.
270 mlir::Value fir::runtime::genNearest(fir::FirOpBuilder &builder,
271                                      mlir::Location loc, mlir::Value x,
272                                      mlir::Value s) {
273   mlir::FuncOp func;
274   mlir::Type fltTy = x.getType();
275 
276   if (fltTy.isF32())
277     func = fir::runtime::getRuntimeFunc<mkRTKey(Nearest4)>(loc, builder);
278   else if (fltTy.isF64())
279     func = fir::runtime::getRuntimeFunc<mkRTKey(Nearest8)>(loc, builder);
280   else if (fltTy.isF80())
281     func = fir::runtime::getRuntimeFunc<ForcedNearest10>(loc, builder);
282   else if (fltTy.isF128())
283     func = fir::runtime::getRuntimeFunc<ForcedNearest16>(loc, builder);
284   else
285     fir::emitFatalError(loc, "unsupported REAL kind in Nearest lowering");
286 
287   auto funcTy = func.getType();
288 
289   mlir::Type sTy = s.getType();
290   mlir::Value zero = builder.createRealZeroConstant(loc, sTy);
291   auto cmp = builder.create<mlir::arith::CmpFOp>(
292       loc, mlir::arith::CmpFPredicate::OGT, s, zero);
293 
294   mlir::Type boolTy = mlir::IntegerType::get(builder.getContext(), 1);
295   mlir::Value False = builder.createIntegerConstant(loc, boolTy, 0);
296   mlir::Value True = builder.createIntegerConstant(loc, boolTy, 1);
297 
298   mlir::Value positive =
299       builder.create<mlir::arith::SelectOp>(loc, cmp, True, False);
300   auto args = fir::runtime::createArguments(builder, loc, funcTy, x, positive);
301 
302   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
303 }
304 
305 /// Generate call to RRSpacing intrinsic runtime routine.
306 mlir::Value fir::runtime::genRRSpacing(fir::FirOpBuilder &builder,
307                                        mlir::Location loc, mlir::Value x) {
308   mlir::FuncOp func;
309   mlir::Type fltTy = x.getType();
310 
311   if (fltTy.isF32())
312     func = fir::runtime::getRuntimeFunc<mkRTKey(RRSpacing4)>(loc, builder);
313   else if (fltTy.isF64())
314     func = fir::runtime::getRuntimeFunc<mkRTKey(RRSpacing8)>(loc, builder);
315   else if (fltTy.isF80())
316     func = fir::runtime::getRuntimeFunc<ForcedRRSpacing10>(loc, builder);
317   else if (fltTy.isF128())
318     func = fir::runtime::getRuntimeFunc<ForcedRRSpacing16>(loc, builder);
319   else
320     fir::emitFatalError(loc, "unsupported real kind in RRSpacing lowering");
321 
322   auto funcTy = func.getType();
323   llvm::SmallVector<mlir::Value> args = {
324       builder.createConvert(loc, funcTy.getInput(0), x)};
325 
326   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
327 }
328 
329 /// Generate call to Scale intrinsic runtime routine.
330 mlir::Value fir::runtime::genScale(fir::FirOpBuilder &builder,
331                                    mlir::Location loc, mlir::Value x,
332                                    mlir::Value i) {
333   mlir::FuncOp func;
334   mlir::Type fltTy = x.getType();
335 
336   if (fltTy.isF32())
337     func = fir::runtime::getRuntimeFunc<mkRTKey(Scale4)>(loc, builder);
338   else if (fltTy.isF64())
339     func = fir::runtime::getRuntimeFunc<mkRTKey(Scale8)>(loc, builder);
340   else if (fltTy.isF80())
341     func = fir::runtime::getRuntimeFunc<ForcedScale10>(loc, builder);
342   else if (fltTy.isF128())
343     func = fir::runtime::getRuntimeFunc<ForcedScale16>(loc, builder);
344   else
345     fir::emitFatalError(loc, "unsupported REAL kind in Scale lowering");
346 
347   auto funcTy = func.getType();
348   auto args = fir::runtime::createArguments(builder, loc, funcTy, x, i);
349 
350   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
351 }
352 
353 /// Generate call to Set_exponent instrinsic runtime routine.
354 mlir::Value fir::runtime::genSetExponent(fir::FirOpBuilder &builder,
355                                          mlir::Location loc, mlir::Value x,
356                                          mlir::Value i) {
357   mlir::FuncOp func;
358   mlir::Type fltTy = x.getType();
359 
360   if (fltTy.isF32())
361     func = fir::runtime::getRuntimeFunc<mkRTKey(SetExponent4)>(loc, builder);
362   else if (fltTy.isF64())
363     func = fir::runtime::getRuntimeFunc<mkRTKey(SetExponent8)>(loc, builder);
364   else if (fltTy.isF80())
365     func = fir::runtime::getRuntimeFunc<ForcedSetExponent10>(loc, builder);
366   else if (fltTy.isF128())
367     func = fir::runtime::getRuntimeFunc<ForcedSetExponent16>(loc, builder);
368   else
369     fir::emitFatalError(loc, "unsupported real kind in Fraction lowering");
370 
371   auto funcTy = func.getType();
372   auto args = fir::runtime::createArguments(builder, loc, funcTy, x, i);
373 
374   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
375 }
376 
377 /// Generate call to Spacing intrinsic runtime routine.
378 mlir::Value fir::runtime::genSpacing(fir::FirOpBuilder &builder,
379                                      mlir::Location loc, mlir::Value x) {
380   mlir::FuncOp func;
381   mlir::Type fltTy = x.getType();
382 
383   if (fltTy.isF32())
384     func = fir::runtime::getRuntimeFunc<mkRTKey(Spacing4)>(loc, builder);
385   else if (fltTy.isF64())
386     func = fir::runtime::getRuntimeFunc<mkRTKey(Spacing8)>(loc, builder);
387   else if (fltTy.isF80())
388     func = fir::runtime::getRuntimeFunc<ForcedSpacing10>(loc, builder);
389   else if (fltTy.isF128())
390     func = fir::runtime::getRuntimeFunc<ForcedSpacing16>(loc, builder);
391   else
392     fir::emitFatalError(loc, "unsupported real kind in Spacing lowering");
393 
394   auto funcTy = func.getType();
395   llvm::SmallVector<mlir::Value> args = {
396       builder.createConvert(loc, funcTy.getInput(0), x)};
397 
398   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
399 }
400