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/StandardOps/IR/Ops.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 = builder.create<mlir::SelectOp>(loc, cmp, True, False);
299   auto args = fir::runtime::createArguments(builder, loc, funcTy, x, positive);
300 
301   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
302 }
303 
304 /// Generate call to RRSpacing intrinsic runtime routine.
305 mlir::Value fir::runtime::genRRSpacing(fir::FirOpBuilder &builder,
306                                        mlir::Location loc, mlir::Value x) {
307   mlir::FuncOp func;
308   mlir::Type fltTy = x.getType();
309 
310   if (fltTy.isF32())
311     func = fir::runtime::getRuntimeFunc<mkRTKey(RRSpacing4)>(loc, builder);
312   else if (fltTy.isF64())
313     func = fir::runtime::getRuntimeFunc<mkRTKey(RRSpacing8)>(loc, builder);
314   else if (fltTy.isF80())
315     func = fir::runtime::getRuntimeFunc<ForcedRRSpacing10>(loc, builder);
316   else if (fltTy.isF128())
317     func = fir::runtime::getRuntimeFunc<ForcedRRSpacing16>(loc, builder);
318   else
319     fir::emitFatalError(loc, "unsupported real kind in RRSpacing lowering");
320 
321   auto funcTy = func.getType();
322   llvm::SmallVector<mlir::Value> args = {
323       builder.createConvert(loc, funcTy.getInput(0), x)};
324 
325   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
326 }
327 
328 /// Generate call to Scale intrinsic runtime routine.
329 mlir::Value fir::runtime::genScale(fir::FirOpBuilder &builder,
330                                    mlir::Location loc, mlir::Value x,
331                                    mlir::Value i) {
332   mlir::FuncOp func;
333   mlir::Type fltTy = x.getType();
334 
335   if (fltTy.isF32())
336     func = fir::runtime::getRuntimeFunc<mkRTKey(Scale4)>(loc, builder);
337   else if (fltTy.isF64())
338     func = fir::runtime::getRuntimeFunc<mkRTKey(Scale8)>(loc, builder);
339   else if (fltTy.isF80())
340     func = fir::runtime::getRuntimeFunc<ForcedScale10>(loc, builder);
341   else if (fltTy.isF128())
342     func = fir::runtime::getRuntimeFunc<ForcedScale16>(loc, builder);
343   else
344     fir::emitFatalError(loc, "unsupported REAL kind in Scale lowering");
345 
346   auto funcTy = func.getType();
347   auto args = fir::runtime::createArguments(builder, loc, funcTy, x, i);
348 
349   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
350 }
351 
352 /// Generate call to Set_exponent instrinsic runtime routine.
353 mlir::Value fir::runtime::genSetExponent(fir::FirOpBuilder &builder,
354                                          mlir::Location loc, mlir::Value x,
355                                          mlir::Value i) {
356   mlir::FuncOp func;
357   mlir::Type fltTy = x.getType();
358 
359   if (fltTy.isF32())
360     func = fir::runtime::getRuntimeFunc<mkRTKey(SetExponent4)>(loc, builder);
361   else if (fltTy.isF64())
362     func = fir::runtime::getRuntimeFunc<mkRTKey(SetExponent8)>(loc, builder);
363   else if (fltTy.isF80())
364     func = fir::runtime::getRuntimeFunc<ForcedSetExponent10>(loc, builder);
365   else if (fltTy.isF128())
366     func = fir::runtime::getRuntimeFunc<ForcedSetExponent16>(loc, builder);
367   else
368     fir::emitFatalError(loc, "unsupported real kind in Fraction lowering");
369 
370   auto funcTy = func.getType();
371   auto args = fir::runtime::createArguments(builder, loc, funcTy, x, i);
372 
373   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
374 }
375 
376 /// Generate call to Spacing intrinsic runtime routine.
377 mlir::Value fir::runtime::genSpacing(fir::FirOpBuilder &builder,
378                                      mlir::Location loc, mlir::Value x) {
379   mlir::FuncOp func;
380   mlir::Type fltTy = x.getType();
381 
382   if (fltTy.isF32())
383     func = fir::runtime::getRuntimeFunc<mkRTKey(Spacing4)>(loc, builder);
384   else if (fltTy.isF64())
385     func = fir::runtime::getRuntimeFunc<mkRTKey(Spacing8)>(loc, builder);
386   else if (fltTy.isF80())
387     func = fir::runtime::getRuntimeFunc<ForcedSpacing10>(loc, builder);
388   else if (fltTy.isF128())
389     func = fir::runtime::getRuntimeFunc<ForcedSpacing16>(loc, builder);
390   else
391     fir::emitFatalError(loc, "unsupported real kind in Spacing lowering");
392 
393   auto funcTy = func.getType();
394   llvm::SmallVector<mlir::Value> args = {
395       builder.createConvert(loc, funcTy.getInput(0), x)};
396 
397   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
398 }
399