1//===-- IntrinsicCall.cpp -------------------------------------------------===//
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// Helper routines for constructing the FIR dialect of MLIR. As FIR is a
10// dialect of MLIR, it makes extensive use of MLIR interfaces and MLIR's coding
11// style (https://mlir.llvm.org/getting_started/DeveloperGuide/) is used in this
12// module.
13//
14//===----------------------------------------------------------------------===//
15
16#include "flang/Optimizer/Builder/IntrinsicCall.h"
17#include "flang/Common/static-multimap-view.h"
18#include "flang/Optimizer/Builder/BoxValue.h"
19#include "flang/Optimizer/Builder/CUFCommon.h"
20#include "flang/Optimizer/Builder/Character.h"
21#include "flang/Optimizer/Builder/Complex.h"
22#include "flang/Optimizer/Builder/FIRBuilder.h"
23#include "flang/Optimizer/Builder/MutableBox.h"
24#include "flang/Optimizer/Builder/PPCIntrinsicCall.h"
25#include "flang/Optimizer/Builder/Runtime/Allocatable.h"
26#include "flang/Optimizer/Builder/Runtime/CUDA/Descriptor.h"
27#include "flang/Optimizer/Builder/Runtime/Character.h"
28#include "flang/Optimizer/Builder/Runtime/Command.h"
29#include "flang/Optimizer/Builder/Runtime/Derived.h"
30#include "flang/Optimizer/Builder/Runtime/Exceptions.h"
31#include "flang/Optimizer/Builder/Runtime/Execute.h"
32#include "flang/Optimizer/Builder/Runtime/Inquiry.h"
33#include "flang/Optimizer/Builder/Runtime/Intrinsics.h"
34#include "flang/Optimizer/Builder/Runtime/Numeric.h"
35#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
36#include "flang/Optimizer/Builder/Runtime/Reduction.h"
37#include "flang/Optimizer/Builder/Runtime/Stop.h"
38#include "flang/Optimizer/Builder/Runtime/Transformational.h"
39#include "flang/Optimizer/Builder/Todo.h"
40#include "flang/Optimizer/Dialect/FIROps.h"
41#include "flang/Optimizer/Dialect/FIROpsSupport.h"
42#include "flang/Optimizer/Dialect/Support/FIRContext.h"
43#include "flang/Optimizer/HLFIR/HLFIROps.h"
44#include "flang/Optimizer/Support/FatalError.h"
45#include "flang/Optimizer/Support/Utils.h"
46#include "flang/Runtime/entry-names.h"
47#include "flang/Runtime/iostat-consts.h"
48#include "mlir/Dialect/Complex/IR/Complex.h"
49#include "mlir/Dialect/LLVMIR/LLVMDialect.h"
50#include "mlir/Dialect/LLVMIR/LLVMTypes.h"
51#include "mlir/Dialect/Math/IR/Math.h"
52#include "mlir/Dialect/Vector/IR/VectorOps.h"
53#include "llvm/Support/CommandLine.h"
54#include "llvm/Support/Debug.h"
55#include "llvm/Support/MathExtras.h"
56#include "llvm/Support/raw_ostream.h"
57#include <cfenv> // temporary -- only used in genIeeeGetOrSetModesOrStatus
58#include <optional>
59
60#define DEBUG_TYPE "flang-lower-intrinsic"
61
62/// This file implements lowering of Fortran intrinsic procedures and Fortran
63/// intrinsic module procedures. A call may be inlined with a mix of FIR and
64/// MLIR operations, or as a call to a runtime function or LLVM intrinsic.
65
66/// Lowering of intrinsic procedure calls is based on a map that associates
67/// Fortran intrinsic generic names to FIR generator functions.
68/// All generator functions are member functions of the IntrinsicLibrary class
69/// and have the same interface.
70/// If no generator is given for an intrinsic name, a math runtime library
71/// is searched for an implementation and, if a runtime function is found,
72/// a call is generated for it. LLVM intrinsics are handled as a math
73/// runtime library here.
74
75namespace fir {
76
77fir::ExtendedValue getAbsentIntrinsicArgument() { return fir::UnboxedValue{}; }
78
79/// Test if an ExtendedValue is absent. This is used to test if an intrinsic
80/// argument are absent at compile time.
81static bool isStaticallyAbsent(const fir::ExtendedValue &exv) {
82 return !fir::getBase(string: exv);
83}
84static bool isStaticallyAbsent(llvm::ArrayRef<fir::ExtendedValue> args,
85 size_t argIndex) {
86 return args.size() <= argIndex || isStaticallyAbsent(args[argIndex]);
87}
88static bool isStaticallyAbsent(llvm::ArrayRef<mlir::Value> args,
89 size_t argIndex) {
90 return args.size() <= argIndex || !args[argIndex];
91}
92
93/// Test if an ExtendedValue is present. This is used to test if an intrinsic
94/// argument is present at compile time. This does not imply that the related
95/// value may not be an absent dummy optional, disassociated pointer, or a
96/// deallocated allocatable. See `handleDynamicOptional` to deal with these
97/// cases when it makes sense.
98static bool isStaticallyPresent(const fir::ExtendedValue &exv) {
99 return !isStaticallyAbsent(exv);
100}
101
102using I = IntrinsicLibrary;
103
104/// Flag to indicate that an intrinsic argument has to be handled as
105/// being dynamically optional (e.g. special handling when actual
106/// argument is an optional variable in the current scope).
107static constexpr bool handleDynamicOptional = true;
108
109/// TODO: Move all CUDA Fortran intrinsic handlers into its own file similar to
110/// PPC.
111static const char __ldca_i4x4[] = "__ldca_i4x4_";
112static const char __ldca_i8x2[] = "__ldca_i8x2_";
113static const char __ldca_r2x2[] = "__ldca_r2x2_";
114static const char __ldca_r4x4[] = "__ldca_r4x4_";
115static const char __ldca_r8x2[] = "__ldca_r8x2_";
116static const char __ldcg_i4x4[] = "__ldcg_i4x4_";
117static const char __ldcg_i8x2[] = "__ldcg_i8x2_";
118static const char __ldcg_r2x2[] = "__ldcg_r2x2_";
119static const char __ldcg_r4x4[] = "__ldcg_r4x4_";
120static const char __ldcg_r8x2[] = "__ldcg_r8x2_";
121static const char __ldcs_i4x4[] = "__ldcs_i4x4_";
122static const char __ldcs_i8x2[] = "__ldcs_i8x2_";
123static const char __ldcs_r2x2[] = "__ldcs_r2x2_";
124static const char __ldcs_r4x4[] = "__ldcs_r4x4_";
125static const char __ldcs_r8x2[] = "__ldcs_r8x2_";
126static const char __ldcv_i4x4[] = "__ldcv_i4x4_";
127static const char __ldcv_i8x2[] = "__ldcv_i8x2_";
128static const char __ldcv_r2x2[] = "__ldcv_r2x2_";
129static const char __ldcv_r4x4[] = "__ldcv_r4x4_";
130static const char __ldcv_r8x2[] = "__ldcv_r8x2_";
131static const char __ldlu_i4x4[] = "__ldlu_i4x4_";
132static const char __ldlu_i8x2[] = "__ldlu_i8x2_";
133static const char __ldlu_r2x2[] = "__ldlu_r2x2_";
134static const char __ldlu_r4x4[] = "__ldlu_r4x4_";
135static const char __ldlu_r8x2[] = "__ldlu_r8x2_";
136
137/// Table that drives the fir generation depending on the intrinsic or intrinsic
138/// module procedure one to one mapping with Fortran arguments. If no mapping is
139/// defined here for a generic intrinsic, genRuntimeCall will be called
140/// to look for a match in the runtime a emit a call. Note that the argument
141/// lowering rules for an intrinsic need to be provided only if at least one
142/// argument must not be lowered by value. In which case, the lowering rules
143/// should be provided for all the intrinsic arguments for completeness.
144static constexpr IntrinsicHandler handlers[]{
145 {"__ldca_i4x4",
146 &I::genCUDALDXXFunc<__ldca_i4x4, 4>,
147 {{{"a", asAddr}}},
148 /*isElemental=*/false},
149 {"__ldca_i8x2",
150 &I::genCUDALDXXFunc<__ldca_i8x2, 2>,
151 {{{"a", asAddr}}},
152 /*isElemental=*/false},
153 {"__ldca_r2x2",
154 &I::genCUDALDXXFunc<__ldca_r2x2, 2>,
155 {{{"a", asAddr}}},
156 /*isElemental=*/false},
157 {"__ldca_r4x4",
158 &I::genCUDALDXXFunc<__ldca_r4x4, 4>,
159 {{{"a", asAddr}}},
160 /*isElemental=*/false},
161 {"__ldca_r8x2",
162 &I::genCUDALDXXFunc<__ldca_r8x2, 2>,
163 {{{"a", asAddr}}},
164 /*isElemental=*/false},
165 {"__ldcg_i4x4",
166 &I::genCUDALDXXFunc<__ldcg_i4x4, 4>,
167 {{{"a", asAddr}}},
168 /*isElemental=*/false},
169 {"__ldcg_i8x2",
170 &I::genCUDALDXXFunc<__ldcg_i8x2, 2>,
171 {{{"a", asAddr}}},
172 /*isElemental=*/false},
173 {"__ldcg_r2x2",
174 &I::genCUDALDXXFunc<__ldcg_r2x2, 2>,
175 {{{"a", asAddr}}},
176 /*isElemental=*/false},
177 {"__ldcg_r4x4",
178 &I::genCUDALDXXFunc<__ldcg_r4x4, 4>,
179 {{{"a", asAddr}}},
180 /*isElemental=*/false},
181 {"__ldcg_r8x2",
182 &I::genCUDALDXXFunc<__ldcg_r8x2, 2>,
183 {{{"a", asAddr}}},
184 /*isElemental=*/false},
185 {"__ldcs_i4x4",
186 &I::genCUDALDXXFunc<__ldcs_i4x4, 4>,
187 {{{"a", asAddr}}},
188 /*isElemental=*/false},
189 {"__ldcs_i8x2",
190 &I::genCUDALDXXFunc<__ldcs_i8x2, 2>,
191 {{{"a", asAddr}}},
192 /*isElemental=*/false},
193 {"__ldcs_r2x2",
194 &I::genCUDALDXXFunc<__ldcs_r2x2, 2>,
195 {{{"a", asAddr}}},
196 /*isElemental=*/false},
197 {"__ldcs_r4x4",
198 &I::genCUDALDXXFunc<__ldcs_r4x4, 4>,
199 {{{"a", asAddr}}},
200 /*isElemental=*/false},
201 {"__ldcs_r8x2",
202 &I::genCUDALDXXFunc<__ldcs_r8x2, 2>,
203 {{{"a", asAddr}}},
204 /*isElemental=*/false},
205 {"__ldcv_i4x4",
206 &I::genCUDALDXXFunc<__ldcv_i4x4, 4>,
207 {{{"a", asAddr}}},
208 /*isElemental=*/false},
209 {"__ldcv_i8x2",
210 &I::genCUDALDXXFunc<__ldcv_i8x2, 2>,
211 {{{"a", asAddr}}},
212 /*isElemental=*/false},
213 {"__ldcv_r2x2",
214 &I::genCUDALDXXFunc<__ldcv_r2x2, 2>,
215 {{{"a", asAddr}}},
216 /*isElemental=*/false},
217 {"__ldcv_r4x4",
218 &I::genCUDALDXXFunc<__ldcv_r4x4, 4>,
219 {{{"a", asAddr}}},
220 /*isElemental=*/false},
221 {"__ldcv_r8x2",
222 &I::genCUDALDXXFunc<__ldcv_r8x2, 2>,
223 {{{"a", asAddr}}},
224 /*isElemental=*/false},
225 {"__ldlu_i4x4",
226 &I::genCUDALDXXFunc<__ldlu_i4x4, 4>,
227 {{{"a", asAddr}}},
228 /*isElemental=*/false},
229 {"__ldlu_i8x2",
230 &I::genCUDALDXXFunc<__ldlu_i8x2, 2>,
231 {{{"a", asAddr}}},
232 /*isElemental=*/false},
233 {"__ldlu_r2x2",
234 &I::genCUDALDXXFunc<__ldlu_r2x2, 2>,
235 {{{"a", asAddr}}},
236 /*isElemental=*/false},
237 {"__ldlu_r4x4",
238 &I::genCUDALDXXFunc<__ldlu_r4x4, 4>,
239 {{{"a", asAddr}}},
240 /*isElemental=*/false},
241 {"__ldlu_r8x2",
242 &I::genCUDALDXXFunc<__ldlu_r8x2, 2>,
243 {{{"a", asAddr}}},
244 /*isElemental=*/false},
245 {"abort", &I::genAbort},
246 {"abs", &I::genAbs},
247 {"achar", &I::genChar},
248 {"acosd", &I::genAcosd},
249 {"adjustl",
250 &I::genAdjustRtCall<fir::runtime::genAdjustL>,
251 {{{"string", asAddr}}},
252 /*isElemental=*/true},
253 {"adjustr",
254 &I::genAdjustRtCall<fir::runtime::genAdjustR>,
255 {{{"string", asAddr}}},
256 /*isElemental=*/true},
257 {"aimag", &I::genAimag},
258 {"aint", &I::genAint},
259 {"all",
260 &I::genAll,
261 {{{"mask", asAddr}, {"dim", asValue}}},
262 /*isElemental=*/false},
263 {"all_sync",
264 &I::genVoteSync<mlir::NVVM::VoteSyncKind::all>,
265 {{{"mask", asValue}, {"pred", asValue}}},
266 /*isElemental=*/false},
267 {"allocated",
268 &I::genAllocated,
269 {{{"array", asInquired}, {"scalar", asInquired}}},
270 /*isElemental=*/false},
271 {"anint", &I::genAnint},
272 {"any",
273 &I::genAny,
274 {{{"mask", asAddr}, {"dim", asValue}}},
275 /*isElemental=*/false},
276 {"any_sync",
277 &I::genVoteSync<mlir::NVVM::VoteSyncKind::any>,
278 {{{"mask", asValue}, {"pred", asValue}}},
279 /*isElemental=*/false},
280 {"asind", &I::genAsind},
281 {"associated",
282 &I::genAssociated,
283 {{{"pointer", asInquired}, {"target", asInquired}}},
284 /*isElemental=*/false},
285 {"atan2d", &I::genAtand},
286 {"atan2pi", &I::genAtanpi},
287 {"atand", &I::genAtand},
288 {"atanpi", &I::genAtanpi},
289 {"atomicaddd", &I::genAtomicAdd, {{{"a", asAddr}, {"v", asValue}}}, false},
290 {"atomicaddf", &I::genAtomicAdd, {{{"a", asAddr}, {"v", asValue}}}, false},
291 {"atomicaddi", &I::genAtomicAdd, {{{"a", asAddr}, {"v", asValue}}}, false},
292 {"atomicaddl", &I::genAtomicAdd, {{{"a", asAddr}, {"v", asValue}}}, false},
293 {"atomicandi", &I::genAtomicAnd, {{{"a", asAddr}, {"v", asValue}}}, false},
294 {"atomiccasd",
295 &I::genAtomicCas,
296 {{{"a", asAddr}, {"v1", asValue}, {"v2", asValue}}},
297 false},
298 {"atomiccasf",
299 &I::genAtomicCas,
300 {{{"a", asAddr}, {"v1", asValue}, {"v2", asValue}}},
301 false},
302 {"atomiccasi",
303 &I::genAtomicCas,
304 {{{"a", asAddr}, {"v1", asValue}, {"v2", asValue}}},
305 false},
306 {"atomiccasul",
307 &I::genAtomicCas,
308 {{{"a", asAddr}, {"v1", asValue}, {"v2", asValue}}},
309 false},
310 {"atomicdeci", &I::genAtomicDec, {{{"a", asAddr}, {"v", asValue}}}, false},
311 {"atomicexchd",
312 &I::genAtomicExch,
313 {{{"a", asAddr}, {"v", asValue}}},
314 false},
315 {"atomicexchf",
316 &I::genAtomicExch,
317 {{{"a", asAddr}, {"v", asValue}}},
318 false},
319 {"atomicexchi",
320 &I::genAtomicExch,
321 {{{"a", asAddr}, {"v", asValue}}},
322 false},
323 {"atomicexchul",
324 &I::genAtomicExch,
325 {{{"a", asAddr}, {"v", asValue}}},
326 false},
327 {"atomicinci", &I::genAtomicInc, {{{"a", asAddr}, {"v", asValue}}}, false},
328 {"atomicmaxd", &I::genAtomicMax, {{{"a", asAddr}, {"v", asValue}}}, false},
329 {"atomicmaxf", &I::genAtomicMax, {{{"a", asAddr}, {"v", asValue}}}, false},
330 {"atomicmaxi", &I::genAtomicMax, {{{"a", asAddr}, {"v", asValue}}}, false},
331 {"atomicmaxl", &I::genAtomicMax, {{{"a", asAddr}, {"v", asValue}}}, false},
332 {"atomicmind", &I::genAtomicMin, {{{"a", asAddr}, {"v", asValue}}}, false},
333 {"atomicminf", &I::genAtomicMin, {{{"a", asAddr}, {"v", asValue}}}, false},
334 {"atomicmini", &I::genAtomicMin, {{{"a", asAddr}, {"v", asValue}}}, false},
335 {"atomicminl", &I::genAtomicMin, {{{"a", asAddr}, {"v", asValue}}}, false},
336 {"atomicori", &I::genAtomicOr, {{{"a", asAddr}, {"v", asValue}}}, false},
337 {"atomicsubd", &I::genAtomicSub, {{{"a", asAddr}, {"v", asValue}}}, false},
338 {"atomicsubf", &I::genAtomicSub, {{{"a", asAddr}, {"v", asValue}}}, false},
339 {"atomicsubi", &I::genAtomicSub, {{{"a", asAddr}, {"v", asValue}}}, false},
340 {"atomicsubl", &I::genAtomicSub, {{{"a", asAddr}, {"v", asValue}}}, false},
341 {"atomicxori", &I::genAtomicXor, {{{"a", asAddr}, {"v", asValue}}}, false},
342 {"ballot_sync",
343 &I::genVoteSync<mlir::NVVM::VoteSyncKind::ballot>,
344 {{{"mask", asValue}, {"pred", asValue}}},
345 /*isElemental=*/false},
346 {"bessel_jn",
347 &I::genBesselJn,
348 {{{"n1", asValue}, {"n2", asValue}, {"x", asValue}}},
349 /*isElemental=*/false},
350 {"bessel_yn",
351 &I::genBesselYn,
352 {{{"n1", asValue}, {"n2", asValue}, {"x", asValue}}},
353 /*isElemental=*/false},
354 {"bge", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::uge>},
355 {"bgt", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ugt>},
356 {"ble", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ule>},
357 {"blt", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ult>},
358 {"btest", &I::genBtest},
359 {"c_associated_c_funptr",
360 &I::genCAssociatedCFunPtr,
361 {{{"c_ptr_1", asAddr}, {"c_ptr_2", asAddr, handleDynamicOptional}}},
362 /*isElemental=*/false},
363 {"c_associated_c_ptr",
364 &I::genCAssociatedCPtr,
365 {{{"c_ptr_1", asAddr}, {"c_ptr_2", asAddr, handleDynamicOptional}}},
366 /*isElemental=*/false},
367 {"c_devloc", &I::genCDevLoc, {{{"x", asBox}}}, /*isElemental=*/false},
368 {"c_f_pointer",
369 &I::genCFPointer,
370 {{{"cptr", asValue},
371 {"fptr", asInquired},
372 {"shape", asAddr, handleDynamicOptional}}},
373 /*isElemental=*/false},
374 {"c_f_procpointer",
375 &I::genCFProcPointer,
376 {{{"cptr", asValue}, {"fptr", asInquired}}},
377 /*isElemental=*/false},
378 {"c_funloc", &I::genCFunLoc, {{{"x", asBox}}}, /*isElemental=*/false},
379 {"c_loc", &I::genCLoc, {{{"x", asBox}}}, /*isElemental=*/false},
380 {"c_ptr_eq", &I::genCPtrCompare<mlir::arith::CmpIPredicate::eq>},
381 {"c_ptr_ne", &I::genCPtrCompare<mlir::arith::CmpIPredicate::ne>},
382 {"ceiling", &I::genCeiling},
383 {"char", &I::genChar},
384 {"chdir",
385 &I::genChdir,
386 {{{"name", asAddr}, {"status", asAddr, handleDynamicOptional}}},
387 /*isElemental=*/false},
388 {"clock64", &I::genClock64, {}, /*isElemental=*/false},
389 {"cmplx",
390 &I::genCmplx,
391 {{{"x", asValue}, {"y", asValue, handleDynamicOptional}}}},
392 {"command_argument_count", &I::genCommandArgumentCount},
393 {"conjg", &I::genConjg},
394 {"cosd", &I::genCosd},
395 {"count",
396 &I::genCount,
397 {{{"mask", asAddr}, {"dim", asValue}, {"kind", asValue}}},
398 /*isElemental=*/false},
399 {"cpu_time",
400 &I::genCpuTime,
401 {{{"time", asAddr}}},
402 /*isElemental=*/false},
403 {"cshift",
404 &I::genCshift,
405 {{{"array", asAddr}, {"shift", asAddr}, {"dim", asValue}}},
406 /*isElemental=*/false},
407 {"date_and_time",
408 &I::genDateAndTime,
409 {{{"date", asAddr, handleDynamicOptional},
410 {"time", asAddr, handleDynamicOptional},
411 {"zone", asAddr, handleDynamicOptional},
412 {"values", asBox, handleDynamicOptional}}},
413 /*isElemental=*/false},
414 {"dble", &I::genConversion},
415 {"dim", &I::genDim},
416 {"dot_product",
417 &I::genDotProduct,
418 {{{"vector_a", asBox}, {"vector_b", asBox}}},
419 /*isElemental=*/false},
420 {"dprod", &I::genDprod},
421 {"dshiftl", &I::genDshiftl},
422 {"dshiftr", &I::genDshiftr},
423 {"eoshift",
424 &I::genEoshift,
425 {{{"array", asBox},
426 {"shift", asAddr},
427 {"boundary", asBox, handleDynamicOptional},
428 {"dim", asValue}}},
429 /*isElemental=*/false},
430 {"erfc_scaled", &I::genErfcScaled},
431 {"etime",
432 &I::genEtime,
433 {{{"values", asBox}, {"time", asBox}}},
434 /*isElemental=*/false},
435 {"execute_command_line",
436 &I::genExecuteCommandLine,
437 {{{"command", asBox},
438 {"wait", asAddr, handleDynamicOptional},
439 {"exitstat", asBox, handleDynamicOptional},
440 {"cmdstat", asBox, handleDynamicOptional},
441 {"cmdmsg", asBox, handleDynamicOptional}}},
442 /*isElemental=*/false},
443 {"exit",
444 &I::genExit,
445 {{{"status", asValue, handleDynamicOptional}}},
446 /*isElemental=*/false},
447 {"exponent", &I::genExponent},
448 {"extends_type_of",
449 &I::genExtendsTypeOf,
450 {{{"a", asBox}, {"mold", asBox}}},
451 /*isElemental=*/false},
452 {"findloc",
453 &I::genFindloc,
454 {{{"array", asBox},
455 {"value", asAddr},
456 {"dim", asValue},
457 {"mask", asBox, handleDynamicOptional},
458 {"kind", asValue},
459 {"back", asValue, handleDynamicOptional}}},
460 /*isElemental=*/false},
461 {"floor", &I::genFloor},
462 {"fraction", &I::genFraction},
463 {"free", &I::genFree},
464 {"fseek",
465 &I::genFseek,
466 {{{"unit", asValue},
467 {"offset", asValue},
468 {"whence", asValue},
469 {"status", asAddr, handleDynamicOptional}}},
470 /*isElemental=*/false},
471 {"ftell",
472 &I::genFtell,
473 {{{"unit", asValue}, {"offset", asAddr}}},
474 /*isElemental=*/false},
475 {"get_command",
476 &I::genGetCommand,
477 {{{"command", asBox, handleDynamicOptional},
478 {"length", asBox, handleDynamicOptional},
479 {"status", asAddr, handleDynamicOptional},
480 {"errmsg", asBox, handleDynamicOptional}}},
481 /*isElemental=*/false},
482 {"get_command_argument",
483 &I::genGetCommandArgument,
484 {{{"number", asValue},
485 {"value", asBox, handleDynamicOptional},
486 {"length", asBox, handleDynamicOptional},
487 {"status", asAddr, handleDynamicOptional},
488 {"errmsg", asBox, handleDynamicOptional}}},
489 /*isElemental=*/false},
490 {"get_environment_variable",
491 &I::genGetEnvironmentVariable,
492 {{{"name", asBox},
493 {"value", asBox, handleDynamicOptional},
494 {"length", asBox, handleDynamicOptional},
495 {"status", asAddr, handleDynamicOptional},
496 {"trim_name", asAddr, handleDynamicOptional},
497 {"errmsg", asBox, handleDynamicOptional}}},
498 /*isElemental=*/false},
499 {"getcwd",
500 &I::genGetCwd,
501 {{{"c", asBox}, {"status", asAddr, handleDynamicOptional}}},
502 /*isElemental=*/false},
503 {"getgid", &I::genGetGID},
504 {"getpid", &I::genGetPID},
505 {"getuid", &I::genGetUID},
506 {"hostnm",
507 &I::genHostnm,
508 {{{"c", asBox}, {"status", asAddr, handleDynamicOptional}}},
509 /*isElemental=*/false},
510 {"iachar", &I::genIchar},
511 {"iall",
512 &I::genIall,
513 {{{"array", asBox},
514 {"dim", asValue},
515 {"mask", asBox, handleDynamicOptional}}},
516 /*isElemental=*/false},
517 {"iand", &I::genIand},
518 {"iany",
519 &I::genIany,
520 {{{"array", asBox},
521 {"dim", asValue},
522 {"mask", asBox, handleDynamicOptional}}},
523 /*isElemental=*/false},
524 {"ibclr", &I::genIbclr},
525 {"ibits", &I::genIbits},
526 {"ibset", &I::genIbset},
527 {"ichar", &I::genIchar},
528 {"ieee_class", &I::genIeeeClass},
529 {"ieee_class_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},
530 {"ieee_class_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},
531 {"ieee_copy_sign", &I::genIeeeCopySign},
532 {"ieee_get_flag",
533 &I::genIeeeGetFlag,
534 {{{"flag", asValue}, {"flag_value", asAddr}}}},
535 {"ieee_get_halting_mode",
536 &I::genIeeeGetHaltingMode,
537 {{{"flag", asValue}, {"halting", asAddr}}}},
538 {"ieee_get_modes",
539 &I::genIeeeGetOrSetModesOrStatus</*isGet=*/true, /*isModes=*/true>},
540 {"ieee_get_rounding_mode",
541 &I::genIeeeGetRoundingMode,
542 {{{"round_value", asAddr, handleDynamicOptional},
543 {"radix", asValue, handleDynamicOptional}}},
544 /*isElemental=*/false},
545 {"ieee_get_status",
546 &I::genIeeeGetOrSetModesOrStatus</*isGet=*/true, /*isModes=*/false>},
547 {"ieee_get_underflow_mode",
548 &I::genIeeeGetUnderflowMode,
549 {{{"gradual", asAddr}}},
550 /*isElemental=*/false},
551 {"ieee_int", &I::genIeeeInt},
552 {"ieee_is_finite", &I::genIeeeIsFinite},
553 {"ieee_is_nan", &I::genIeeeIsNan},
554 {"ieee_is_negative", &I::genIeeeIsNegative},
555 {"ieee_is_normal", &I::genIeeeIsNormal},
556 {"ieee_logb", &I::genIeeeLogb},
557 {"ieee_max",
558 &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/false, /*isMag=*/false>},
559 {"ieee_max_mag",
560 &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/false, /*isMag=*/true>},
561 {"ieee_max_num",
562 &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/true, /*isMag=*/false>},
563 {"ieee_max_num_mag",
564 &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/true, /*isMag=*/true>},
565 {"ieee_min",
566 &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/false, /*isMag=*/false>},
567 {"ieee_min_mag",
568 &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/false, /*isMag=*/true>},
569 {"ieee_min_num",
570 &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/true, /*isMag=*/false>},
571 {"ieee_min_num_mag",
572 &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/true, /*isMag=*/true>},
573 {"ieee_next_after", &I::genNearest<I::NearestProc::NextAfter>},
574 {"ieee_next_down", &I::genNearest<I::NearestProc::NextDown>},
575 {"ieee_next_up", &I::genNearest<I::NearestProc::NextUp>},
576 {"ieee_quiet_eq", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OEQ>},
577 {"ieee_quiet_ge", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OGE>},
578 {"ieee_quiet_gt", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OGT>},
579 {"ieee_quiet_le", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OLE>},
580 {"ieee_quiet_lt", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OLT>},
581 {"ieee_quiet_ne", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::UNE>},
582 {"ieee_real", &I::genIeeeReal},
583 {"ieee_rem", &I::genIeeeRem},
584 {"ieee_rint", &I::genIeeeRint},
585 {"ieee_round_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},
586 {"ieee_round_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},
587 {"ieee_set_flag", &I::genIeeeSetFlagOrHaltingMode</*isFlag=*/true>},
588 {"ieee_set_halting_mode",
589 &I::genIeeeSetFlagOrHaltingMode</*isFlag=*/false>},
590 {"ieee_set_modes",
591 &I::genIeeeGetOrSetModesOrStatus</*isGet=*/false, /*isModes=*/true>},
592 {"ieee_set_rounding_mode",
593 &I::genIeeeSetRoundingMode,
594 {{{"round_value", asValue, handleDynamicOptional},
595 {"radix", asValue, handleDynamicOptional}}},
596 /*isElemental=*/false},
597 {"ieee_set_status",
598 &I::genIeeeGetOrSetModesOrStatus</*isGet=*/false, /*isModes=*/false>},
599 {"ieee_set_underflow_mode", &I::genIeeeSetUnderflowMode},
600 {"ieee_signaling_eq",
601 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OEQ>},
602 {"ieee_signaling_ge",
603 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OGE>},
604 {"ieee_signaling_gt",
605 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OGT>},
606 {"ieee_signaling_le",
607 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OLE>},
608 {"ieee_signaling_lt",
609 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OLT>},
610 {"ieee_signaling_ne",
611 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::UNE>},
612 {"ieee_signbit", &I::genIeeeSignbit},
613 {"ieee_support_flag",
614 &I::genIeeeSupportFlag,
615 {{{"flag", asValue}, {"x", asInquired, handleDynamicOptional}}},
616 /*isElemental=*/false},
617 {"ieee_support_halting",
618 &I::genIeeeSupportHalting,
619 {{{"flag", asValue}}},
620 /*isElemental=*/false},
621 {"ieee_support_rounding",
622 &I::genIeeeSupportRounding,
623 {{{"round_value", asValue}, {"x", asInquired, handleDynamicOptional}}},
624 /*isElemental=*/false},
625 {"ieee_support_standard",
626 &I::genIeeeSupportStandard,
627 {{{"flag", asValue}, {"x", asInquired, handleDynamicOptional}}},
628 /*isElemental=*/false},
629 {"ieee_unordered", &I::genIeeeUnordered},
630 {"ieee_value", &I::genIeeeValue},
631 {"ieor", &I::genIeor},
632 {"index",
633 &I::genIndex,
634 {{{"string", asAddr},
635 {"substring", asAddr},
636 {"back", asValue, handleDynamicOptional},
637 {"kind", asValue}}}},
638 {"ior", &I::genIor},
639 {"iparity",
640 &I::genIparity,
641 {{{"array", asBox},
642 {"dim", asValue},
643 {"mask", asBox, handleDynamicOptional}}},
644 /*isElemental=*/false},
645 {"is_contiguous",
646 &I::genIsContiguous,
647 {{{"array", asBox}}},
648 /*isElemental=*/false},
649 {"is_iostat_end", &I::genIsIostatValue<Fortran::runtime::io::IostatEnd>},
650 {"is_iostat_eor", &I::genIsIostatValue<Fortran::runtime::io::IostatEor>},
651 {"ishft", &I::genIshft},
652 {"ishftc", &I::genIshftc},
653 {"isnan", &I::genIeeeIsNan},
654 {"lbound",
655 &I::genLbound,
656 {{{"array", asInquired}, {"dim", asValue}, {"kind", asValue}}},
657 /*isElemental=*/false},
658 {"leadz", &I::genLeadz},
659 {"len",
660 &I::genLen,
661 {{{"string", asInquired}, {"kind", asValue}}},
662 /*isElemental=*/false},
663 {"len_trim", &I::genLenTrim},
664 {"lge", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sge>},
665 {"lgt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sgt>},
666 {"lle", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sle>},
667 {"llt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::slt>},
668 {"lnblnk", &I::genLenTrim},
669 {"loc", &I::genLoc, {{{"x", asBox}}}, /*isElemental=*/false},
670 {"malloc", &I::genMalloc},
671 {"maskl", &I::genMask<mlir::arith::ShLIOp>},
672 {"maskr", &I::genMask<mlir::arith::ShRUIOp>},
673 {"match_all_syncjd",
674 &I::genMatchAllSync,
675 {{{"mask", asValue}, {"value", asValue}, {"pred", asAddr}}},
676 /*isElemental=*/false},
677 {"match_all_syncjf",
678 &I::genMatchAllSync,
679 {{{"mask", asValue}, {"value", asValue}, {"pred", asAddr}}},
680 /*isElemental=*/false},
681 {"match_all_syncjj",
682 &I::genMatchAllSync,
683 {{{"mask", asValue}, {"value", asValue}, {"pred", asAddr}}},
684 /*isElemental=*/false},
685 {"match_all_syncjx",
686 &I::genMatchAllSync,
687 {{{"mask", asValue}, {"value", asValue}, {"pred", asAddr}}},
688 /*isElemental=*/false},
689 {"match_any_syncjd",
690 &I::genMatchAnySync,
691 {{{"mask", asValue}, {"value", asValue}}},
692 /*isElemental=*/false},
693 {"match_any_syncjf",
694 &I::genMatchAnySync,
695 {{{"mask", asValue}, {"value", asValue}}},
696 /*isElemental=*/false},
697 {"match_any_syncjj",
698 &I::genMatchAnySync,
699 {{{"mask", asValue}, {"value", asValue}}},
700 /*isElemental=*/false},
701 {"match_any_syncjx",
702 &I::genMatchAnySync,
703 {{{"mask", asValue}, {"value", asValue}}},
704 /*isElemental=*/false},
705 {"matmul",
706 &I::genMatmul,
707 {{{"matrix_a", asAddr}, {"matrix_b", asAddr}}},
708 /*isElemental=*/false},
709 {"matmul_transpose",
710 &I::genMatmulTranspose,
711 {{{"matrix_a", asAddr}, {"matrix_b", asAddr}}},
712 /*isElemental=*/false},
713 {"max", &I::genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>},
714 {"maxloc",
715 &I::genMaxloc,
716 {{{"array", asBox},
717 {"dim", asValue},
718 {"mask", asBox, handleDynamicOptional},
719 {"kind", asValue},
720 {"back", asValue, handleDynamicOptional}}},
721 /*isElemental=*/false},
722 {"maxval",
723 &I::genMaxval,
724 {{{"array", asBox},
725 {"dim", asValue},
726 {"mask", asBox, handleDynamicOptional}}},
727 /*isElemental=*/false},
728 {"merge", &I::genMerge},
729 {"merge_bits", &I::genMergeBits},
730 {"min", &I::genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>},
731 {"minloc",
732 &I::genMinloc,
733 {{{"array", asBox},
734 {"dim", asValue},
735 {"mask", asBox, handleDynamicOptional},
736 {"kind", asValue},
737 {"back", asValue, handleDynamicOptional}}},
738 /*isElemental=*/false},
739 {"minval",
740 &I::genMinval,
741 {{{"array", asBox},
742 {"dim", asValue},
743 {"mask", asBox, handleDynamicOptional}}},
744 /*isElemental=*/false},
745 {"mod", &I::genMod},
746 {"modulo", &I::genModulo},
747 {"move_alloc",
748 &I::genMoveAlloc,
749 {{{"from", asInquired},
750 {"to", asInquired},
751 {"status", asAddr, handleDynamicOptional},
752 {"errMsg", asBox, handleDynamicOptional}}},
753 /*isElemental=*/false},
754 {"mvbits",
755 &I::genMvbits,
756 {{{"from", asValue},
757 {"frompos", asValue},
758 {"len", asValue},
759 {"to", asAddr},
760 {"topos", asValue}}}},
761 {"nearest", &I::genNearest<I::NearestProc::Nearest>},
762 {"nint", &I::genNint},
763 {"norm2",
764 &I::genNorm2,
765 {{{"array", asBox}, {"dim", asValue}}},
766 /*isElemental=*/false},
767 {"not", &I::genNot},
768 {"null", &I::genNull, {{{"mold", asInquired}}}, /*isElemental=*/false},
769 {"pack",
770 &I::genPack,
771 {{{"array", asBox},
772 {"mask", asBox},
773 {"vector", asBox, handleDynamicOptional}}},
774 /*isElemental=*/false},
775 {"parity",
776 &I::genParity,
777 {{{"mask", asBox}, {"dim", asValue}}},
778 /*isElemental=*/false},
779 {"perror",
780 &I::genPerror,
781 {{{"string", asBox}}},
782 /*isElemental*/ false},
783 {"popcnt", &I::genPopcnt},
784 {"poppar", &I::genPoppar},
785 {"present",
786 &I::genPresent,
787 {{{"a", asInquired}}},
788 /*isElemental=*/false},
789 {"product",
790 &I::genProduct,
791 {{{"array", asBox},
792 {"dim", asValue},
793 {"mask", asBox, handleDynamicOptional}}},
794 /*isElemental=*/false},
795 {"putenv",
796 &I::genPutenv,
797 {{{"str", asAddr}, {"status", asAddr, handleDynamicOptional}}},
798 /*isElemental=*/false},
799 {"random_init",
800 &I::genRandomInit,
801 {{{"repeatable", asValue}, {"image_distinct", asValue}}},
802 /*isElemental=*/false},
803 {"random_number",
804 &I::genRandomNumber,
805 {{{"harvest", asBox}}},
806 /*isElemental=*/false},
807 {"random_seed",
808 &I::genRandomSeed,
809 {{{"size", asBox, handleDynamicOptional},
810 {"put", asBox, handleDynamicOptional},
811 {"get", asBox, handleDynamicOptional}}},
812 /*isElemental=*/false},
813 {"reduce",
814 &I::genReduce,
815 {{{"array", asBox},
816 {"operation", asAddr},
817 {"dim", asValue},
818 {"mask", asBox, handleDynamicOptional},
819 {"identity", asAddr, handleDynamicOptional},
820 {"ordered", asValue, handleDynamicOptional}}},
821 /*isElemental=*/false},
822 {"rename",
823 &I::genRename,
824 {{{"path1", asBox},
825 {"path2", asBox},
826 {"status", asBox, handleDynamicOptional}}},
827 /*isElemental=*/false},
828 {"repeat",
829 &I::genRepeat,
830 {{{"string", asAddr}, {"ncopies", asValue}}},
831 /*isElemental=*/false},
832 {"reshape",
833 &I::genReshape,
834 {{{"source", asBox},
835 {"shape", asBox},
836 {"pad", asBox, handleDynamicOptional},
837 {"order", asBox, handleDynamicOptional}}},
838 /*isElemental=*/false},
839 {"rrspacing", &I::genRRSpacing},
840 {"same_type_as",
841 &I::genSameTypeAs,
842 {{{"a", asBox}, {"b", asBox}}},
843 /*isElemental=*/false},
844 {"scale",
845 &I::genScale,
846 {{{"x", asValue}, {"i", asValue}}},
847 /*isElemental=*/true},
848 {"scan",
849 &I::genScan,
850 {{{"string", asAddr},
851 {"set", asAddr},
852 {"back", asValue, handleDynamicOptional},
853 {"kind", asValue}}},
854 /*isElemental=*/true},
855 {"second",
856 &I::genSecond,
857 {{{"time", asAddr}}},
858 /*isElemental=*/false},
859 {"selected_char_kind",
860 &I::genSelectedCharKind,
861 {{{"name", asAddr}}},
862 /*isElemental=*/false},
863 {"selected_int_kind",
864 &I::genSelectedIntKind,
865 {{{"scalar", asAddr}}},
866 /*isElemental=*/false},
867 {"selected_logical_kind",
868 &I::genSelectedLogicalKind,
869 {{{"bits", asAddr}}},
870 /*isElemental=*/false},
871 {"selected_real_kind",
872 &I::genSelectedRealKind,
873 {{{"precision", asAddr, handleDynamicOptional},
874 {"range", asAddr, handleDynamicOptional},
875 {"radix", asAddr, handleDynamicOptional}}},
876 /*isElemental=*/false},
877 {"selected_unsigned_kind",
878 &I::genSelectedIntKind, // same results as selected_int_kind
879 {{{"scalar", asAddr}}},
880 /*isElemental=*/false},
881 {"set_exponent", &I::genSetExponent},
882 {"shape",
883 &I::genShape,
884 {{{"source", asBox}, {"kind", asValue}}},
885 /*isElemental=*/false},
886 {"shifta", &I::genShiftA},
887 {"shiftl", &I::genShift<mlir::arith::ShLIOp>},
888 {"shiftr", &I::genShift<mlir::arith::ShRUIOp>},
889 {"sign", &I::genSign},
890 {"signal",
891 &I::genSignalSubroutine,
892 {{{"number", asValue}, {"handler", asAddr}, {"status", asAddr}}},
893 /*isElemental=*/false},
894 {"sind", &I::genSind},
895 {"size",
896 &I::genSize,
897 {{{"array", asBox},
898 {"dim", asAddr, handleDynamicOptional},
899 {"kind", asValue}}},
900 /*isElemental=*/false},
901 {"sizeof",
902 &I::genSizeOf,
903 {{{"a", asBox}}},
904 /*isElemental=*/false},
905 {"sleep", &I::genSleep, {{{"seconds", asValue}}}, /*isElemental=*/false},
906 {"spacing", &I::genSpacing},
907 {"spread",
908 &I::genSpread,
909 {{{"source", asBox}, {"dim", asValue}, {"ncopies", asValue}}},
910 /*isElemental=*/false},
911 {"storage_size",
912 &I::genStorageSize,
913 {{{"a", asInquired}, {"kind", asValue}}},
914 /*isElemental=*/false},
915 {"sum",
916 &I::genSum,
917 {{{"array", asBox},
918 {"dim", asValue},
919 {"mask", asBox, handleDynamicOptional}}},
920 /*isElemental=*/false},
921 {"syncthreads", &I::genSyncThreads, {}, /*isElemental=*/false},
922 {"syncthreads_and", &I::genSyncThreadsAnd, {}, /*isElemental=*/false},
923 {"syncthreads_count", &I::genSyncThreadsCount, {}, /*isElemental=*/false},
924 {"syncthreads_or", &I::genSyncThreadsOr, {}, /*isElemental=*/false},
925 {"syncwarp", &I::genSyncWarp, {}, /*isElemental=*/false},
926 {"system",
927 &I::genSystem,
928 {{{"command", asBox}, {"exitstat", asBox, handleDynamicOptional}}},
929 /*isElemental=*/false},
930 {"system_clock",
931 &I::genSystemClock,
932 {{{"count", asAddr}, {"count_rate", asAddr}, {"count_max", asAddr}}},
933 /*isElemental=*/false},
934 {"tand", &I::genTand},
935 {"this_grid", &I::genThisGrid, {}, /*isElemental=*/false},
936 {"this_thread_block", &I::genThisThreadBlock, {}, /*isElemental=*/false},
937 {"this_warp", &I::genThisWarp, {}, /*isElemental=*/false},
938 {"threadfence", &I::genThreadFence, {}, /*isElemental=*/false},
939 {"threadfence_block", &I::genThreadFenceBlock, {}, /*isElemental=*/false},
940 {"threadfence_system", &I::genThreadFenceSystem, {}, /*isElemental=*/false},
941 {"time", &I::genTime, {}, /*isElemental=*/false},
942 {"trailz", &I::genTrailz},
943 {"transfer",
944 &I::genTransfer,
945 {{{"source", asAddr}, {"mold", asAddr}, {"size", asValue}}},
946 /*isElemental=*/false},
947 {"transpose",
948 &I::genTranspose,
949 {{{"matrix", asAddr}}},
950 /*isElemental=*/false},
951 {"trim", &I::genTrim, {{{"string", asAddr}}}, /*isElemental=*/false},
952 {"ubound",
953 &I::genUbound,
954 {{{"array", asBox}, {"dim", asValue}, {"kind", asValue}}},
955 /*isElemental=*/false},
956 {"umaskl", &I::genMask<mlir::arith::ShLIOp>},
957 {"umaskr", &I::genMask<mlir::arith::ShRUIOp>},
958 {"unlink",
959 &I::genUnlink,
960 {{{"path", asAddr}, {"status", asAddr, handleDynamicOptional}}},
961 /*isElemental=*/false},
962 {"unpack",
963 &I::genUnpack,
964 {{{"vector", asBox}, {"mask", asBox}, {"field", asBox}}},
965 /*isElemental=*/false},
966 {"verify",
967 &I::genVerify,
968 {{{"string", asAddr},
969 {"set", asAddr},
970 {"back", asValue, handleDynamicOptional},
971 {"kind", asValue}}},
972 /*isElemental=*/true},
973};
974
975template <std::size_t N>
976static constexpr bool isSorted(const IntrinsicHandler (&array)[N]) {
977 // Replace by std::sorted when C++20 is default (will be constexpr).
978 const IntrinsicHandler *lastSeen{nullptr};
979 bool isSorted{true};
980 for (const auto &x : array) {
981 if (lastSeen)
982 isSorted &= std::string_view{lastSeen->name} < std::string_view{x.name};
983 lastSeen = &x;
984 }
985 return isSorted;
986}
987static_assert(isSorted(handlers) && "map must be sorted");
988
989static const IntrinsicHandler *findIntrinsicHandler(llvm::StringRef name) {
990 auto compare = [](const IntrinsicHandler &handler, llvm::StringRef name) {
991 return name.compare(handler.name) > 0;
992 };
993 auto result = llvm::lower_bound(handlers, name, compare);
994 return result != std::end(handlers) && result->name == name ? result
995 : nullptr;
996}
997
998/// To make fir output more readable for debug, one can outline all intrinsic
999/// implementation in wrappers (overrides the IntrinsicHandler::outline flag).
1000static llvm::cl::opt<bool> outlineAllIntrinsics(
1001 "outline-intrinsics",
1002 llvm::cl::desc(
1003 "Lower all intrinsic procedure implementation in their own functions"),
1004 llvm::cl::init(Val: false));
1005
1006//===----------------------------------------------------------------------===//
1007// Math runtime description and matching utility
1008//===----------------------------------------------------------------------===//
1009
1010/// Command line option to modify math runtime behavior used to implement
1011/// intrinsics. This option applies both to early and late math-lowering modes.
1012enum MathRuntimeVersion { fastVersion, relaxedVersion, preciseVersion };
1013llvm::cl::opt<MathRuntimeVersion> mathRuntimeVersion(
1014 "math-runtime", llvm::cl::desc("Select math operations' runtime behavior:"),
1015 llvm::cl::values(
1016 clEnumValN(fastVersion, "fast", "use fast runtime behavior"),
1017 clEnumValN(relaxedVersion, "relaxed", "use relaxed runtime behavior"),
1018 clEnumValN(preciseVersion, "precise", "use precise runtime behavior")),
1019 llvm::cl::init(Val: fastVersion));
1020
1021static llvm::cl::opt<bool>
1022 forceMlirComplex("force-mlir-complex",
1023 llvm::cl::desc("Force using MLIR complex operations "
1024 "instead of libm complex operations"),
1025 llvm::cl::init(Val: false));
1026
1027/// Return a string containing the given Fortran intrinsic name
1028/// with the type of its arguments specified in funcType
1029/// surrounded by the given prefix/suffix.
1030static std::string
1031prettyPrintIntrinsicName(fir::FirOpBuilder &builder, mlir::Location loc,
1032 llvm::StringRef prefix, llvm::StringRef name,
1033 llvm::StringRef suffix, mlir::FunctionType funcType) {
1034 std::string output = prefix.str();
1035 llvm::raw_string_ostream sstream(output);
1036 if (name == "pow") {
1037 assert(funcType.getNumInputs() == 2 && "power operator has two arguments");
1038 std::string displayName{" ** "};
1039 sstream << mlirTypeToIntrinsicFortran(builder, funcType.getInput(i: 0), loc,
1040 displayName)
1041 << displayName
1042 << mlirTypeToIntrinsicFortran(builder, funcType.getInput(i: 1), loc,
1043 displayName);
1044 } else {
1045 sstream << name.upper() << "(";
1046 if (funcType.getNumInputs() > 0)
1047 sstream << mlirTypeToIntrinsicFortran(builder, funcType.getInput(i: 0), loc,
1048 name);
1049 for (mlir::Type argType : funcType.getInputs().drop_front()) {
1050 sstream << ", "
1051 << mlirTypeToIntrinsicFortran(builder, argType, loc, name);
1052 }
1053 sstream << ")";
1054 }
1055 sstream << suffix;
1056 return output;
1057}
1058
1059// Generate a call to the Fortran runtime library providing
1060// support for 128-bit float math.
1061// On 'HAS_LDBL128' targets the implementation
1062// is provided by flang_rt, otherwise, it is done via the
1063// libflang_rt.quadmath library. In the latter case the compiler
1064// has to be built with FLANG_RUNTIME_F128_MATH_LIB to guarantee
1065// proper linking actions in the driver.
1066static mlir::Value genLibF128Call(fir::FirOpBuilder &builder,
1067 mlir::Location loc,
1068 const MathOperation &mathOp,
1069 mlir::FunctionType libFuncType,
1070 llvm::ArrayRef<mlir::Value> args) {
1071 // TODO: if we knew that the C 'long double' does not have 113-bit mantissa
1072 // on the target, we could have asserted that FLANG_RUNTIME_F128_MATH_LIB
1073 // must be specified. For now just always generate the call even
1074 // if it will be unresolved.
1075 return genLibCall(builder, loc, mathOp, libFuncType, args);
1076}
1077
1078mlir::Value genLibCall(fir::FirOpBuilder &builder, mlir::Location loc,
1079 const MathOperation &mathOp,
1080 mlir::FunctionType libFuncType,
1081 llvm::ArrayRef<mlir::Value> args) {
1082 llvm::StringRef libFuncName = mathOp.runtimeFunc;
1083
1084 // On AIX, __clog is used in libm.
1085 if (fir::getTargetTriple(builder.getModule()).isOSAIX() &&
1086 libFuncName == "clog") {
1087 libFuncName = "__clog";
1088 }
1089
1090 LLVM_DEBUG(llvm::dbgs() << "Generating '" << libFuncName
1091 << "' call with type ";
1092 libFuncType.dump(); llvm::dbgs() << "\n");
1093 mlir::func::FuncOp funcOp = builder.getNamedFunction(libFuncName);
1094
1095 if (!funcOp) {
1096 funcOp = builder.createFunction(loc, libFuncName, libFuncType);
1097 // C-interoperability rules apply to these library functions.
1098 funcOp->setAttr(fir::getSymbolAttrName(),
1099 mlir::StringAttr::get(builder.getContext(), libFuncName));
1100 // Set fir.runtime attribute to distinguish the function that
1101 // was just created from user functions with the same name.
1102 funcOp->setAttr(fir::FIROpsDialect::getFirRuntimeAttrName(),
1103 builder.getUnitAttr());
1104 auto libCall = builder.create<fir::CallOp>(loc, funcOp, args);
1105 // TODO: ensure 'strictfp' setting on the call for "precise/strict"
1106 // FP mode. Set appropriate Fast-Math Flags otherwise.
1107 // TODO: we should also mark as many libm function as possible
1108 // with 'pure' attribute (of course, not in strict FP mode).
1109 LLVM_DEBUG(libCall.dump(); llvm::dbgs() << "\n");
1110 return libCall.getResult(0);
1111 }
1112
1113 // The function with the same name already exists.
1114 fir::CallOp libCall;
1115 mlir::Type soughtFuncType = funcOp.getFunctionType();
1116
1117 if (soughtFuncType == libFuncType) {
1118 libCall = builder.create<fir::CallOp>(loc, funcOp, args);
1119 } else {
1120 // A function with the same name might have been declared
1121 // before (e.g. with an explicit interface and a binding label).
1122 // It is in general incorrect to use the same definition for the library
1123 // call, but we have no other options. Type cast the function to match
1124 // the requested signature and generate an indirect call to avoid
1125 // later failures caused by the signature mismatch.
1126 LLVM_DEBUG(mlir::emitWarning(
1127 loc, llvm::Twine("function signature mismatch for '") +
1128 llvm::Twine(libFuncName) +
1129 llvm::Twine("' may lead to undefined behavior.")));
1130 mlir::SymbolRefAttr funcSymbolAttr = builder.getSymbolRefAttr(libFuncName);
1131 mlir::Value funcPointer =
1132 builder.create<fir::AddrOfOp>(loc, soughtFuncType, funcSymbolAttr);
1133 funcPointer = builder.createConvert(loc, libFuncType, funcPointer);
1134
1135 llvm::SmallVector<mlir::Value, 3> operands{funcPointer};
1136 operands.append(in_start: args.begin(), in_end: args.end());
1137 libCall = builder.create<fir::CallOp>(loc, mlir::SymbolRefAttr{},
1138 libFuncType.getResults(), operands);
1139 }
1140
1141 LLVM_DEBUG(libCall.dump(); llvm::dbgs() << "\n");
1142 return libCall.getResult(0);
1143}
1144
1145mlir::Value genLibSplitComplexArgsCall(fir::FirOpBuilder &builder,
1146 mlir::Location loc,
1147 const MathOperation &mathOp,
1148 mlir::FunctionType libFuncType,
1149 llvm::ArrayRef<mlir::Value> args) {
1150 assert(args.size() == 2 && "Incorrect #args to genLibSplitComplexArgsCall");
1151
1152 auto getSplitComplexArgsType = [&builder, &args]() -> mlir::FunctionType {
1153 mlir::Type ctype = args[0].getType();
1154 auto ftype = mlir::cast<mlir::ComplexType>(Val&: ctype).getElementType();
1155 return builder.getFunctionType({ftype, ftype, ftype, ftype}, {ctype});
1156 };
1157
1158 llvm::SmallVector<mlir::Value, 4> splitArgs;
1159 mlir::Value cplx1 = args[0];
1160 auto real1 = fir::factory::Complex{builder, loc}.extractComplexPart(
1161 cplx1, /*isImagPart=*/false);
1162 splitArgs.push_back(Elt: real1);
1163 auto imag1 = fir::factory::Complex{builder, loc}.extractComplexPart(
1164 cplx1, /*isImagPart=*/true);
1165 splitArgs.push_back(Elt: imag1);
1166 mlir::Value cplx2 = args[1];
1167 auto real2 = fir::factory::Complex{builder, loc}.extractComplexPart(
1168 cplx2, /*isImagPart=*/false);
1169 splitArgs.push_back(Elt: real2);
1170 auto imag2 = fir::factory::Complex{builder, loc}.extractComplexPart(
1171 cplx2, /*isImagPart=*/true);
1172 splitArgs.push_back(Elt: imag2);
1173
1174 return genLibCall(builder, loc, mathOp, getSplitComplexArgsType(), splitArgs);
1175}
1176
1177template <typename T>
1178mlir::Value genMathOp(fir::FirOpBuilder &builder, mlir::Location loc,
1179 const MathOperation &mathOp,
1180 mlir::FunctionType mathLibFuncType,
1181 llvm::ArrayRef<mlir::Value> args) {
1182 // TODO: we have to annotate the math operations with flags
1183 // that will allow to define FP accuracy/exception
1184 // behavior per operation, so that after early multi-module
1185 // MLIR inlining we can distiguish operation that were
1186 // compiled with different settings.
1187 // Suggestion:
1188 // * For "relaxed" FP mode set all Fast-Math Flags
1189 // (see "[RFC] FastMath flags support in MLIR (arith dialect)"
1190 // topic at discourse.llvm.org).
1191 // * For "fast" FP mode set all Fast-Math Flags except 'afn'.
1192 // * For "precise/strict" FP mode generate fir.calls to libm
1193 // entries and annotate them with an attribute that will
1194 // end up transformed into 'strictfp' LLVM attribute (TBD).
1195 // Elsewhere, "precise/strict" FP mode should also set
1196 // 'strictfp' for all user functions and calls so that
1197 // LLVM backend does the right job.
1198 // * Operations that cannot be reasonably optimized in MLIR
1199 // can be also lowered to libm calls for "fast" and "relaxed"
1200 // modes.
1201 mlir::Value result;
1202 llvm::StringRef mathLibFuncName = mathOp.runtimeFunc;
1203 if (mathRuntimeVersion == preciseVersion &&
1204 // Some operations do not have to be lowered as conservative
1205 // calls, since they do not affect strict FP behavior.
1206 // For example, purely integer operations like exponentiation
1207 // with integer operands fall into this class.
1208 !mathLibFuncName.empty()) {
1209 result = genLibCall(builder, loc, mathOp, mathLibFuncType, args);
1210 } else {
1211 LLVM_DEBUG(llvm::dbgs() << "Generating '" << mathLibFuncName
1212 << "' operation with type ";
1213 mathLibFuncType.dump(); llvm::dbgs() << "\n");
1214 result = builder.create<T>(loc, args);
1215 }
1216 LLVM_DEBUG(result.dump(); llvm::dbgs() << "\n");
1217 return result;
1218}
1219
1220template <typename T>
1221mlir::Value genComplexMathOp(fir::FirOpBuilder &builder, mlir::Location loc,
1222 const MathOperation &mathOp,
1223 mlir::FunctionType mathLibFuncType,
1224 llvm::ArrayRef<mlir::Value> args) {
1225 mlir::Value result;
1226 bool canUseApprox = mlir::arith::bitEnumContainsAny(
1227 builder.getFastMathFlags(), mlir::arith::FastMathFlags::afn);
1228
1229 // If we have libm functions, we can attempt to generate the more precise
1230 // version of the complex math operation.
1231 llvm::StringRef mathLibFuncName = mathOp.runtimeFunc;
1232 if (!mathLibFuncName.empty()) {
1233 // If we enabled MLIR complex or can use approximate operations, we should
1234 // NOT use libm.
1235 if (!forceMlirComplex && !canUseApprox) {
1236 result = genLibCall(builder, loc, mathOp, mathLibFuncType, args);
1237 LLVM_DEBUG(result.dump(); llvm::dbgs() << "\n");
1238 return result;
1239 }
1240 }
1241
1242 LLVM_DEBUG(llvm::dbgs() << "Generating '" << mathLibFuncName
1243 << "' operation with type ";
1244 mathLibFuncType.dump(); llvm::dbgs() << "\n");
1245 // Builder expects an extra return type to be provided if different to
1246 // the argument types for an operation
1247 if constexpr (T::template hasTrait<
1248 mlir::OpTrait::SameOperandsAndResultType>()) {
1249 result = builder.create<T>(loc, args);
1250 result = builder.createConvert(loc, mathLibFuncType.getResult(i: 0), result);
1251 } else {
1252 auto complexTy = mlir::cast<mlir::ComplexType>(Val: mathLibFuncType.getInput(i: 0));
1253 auto realTy = complexTy.getElementType();
1254 result = builder.create<T>(loc, realTy, args);
1255 result = builder.createConvert(loc, mathLibFuncType.getResult(i: 0), result);
1256 }
1257
1258 LLVM_DEBUG(result.dump(); llvm::dbgs() << "\n");
1259 return result;
1260}
1261
1262/// Mapping between mathematical intrinsic operations and MLIR operations
1263/// of some appropriate dialect (math, complex, etc.) or libm calls.
1264/// TODO: support remaining Fortran math intrinsics.
1265/// See https://gcc.gnu.org/onlinedocs/gcc-12.1.0/gfortran/\
1266/// Intrinsic-Procedures.html for a reference.
1267constexpr auto FuncTypeReal16Real16 = genFuncType<Ty::Real<16>, Ty::Real<16>>;
1268constexpr auto FuncTypeReal16Real16Real16 =
1269 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Real<16>>;
1270constexpr auto FuncTypeReal16Real16Real16Real16 =
1271 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Real<16>, Ty::Real<16>>;
1272constexpr auto FuncTypeReal16Integer4Real16 =
1273 genFuncType<Ty::Real<16>, Ty::Integer<4>, Ty::Real<16>>;
1274constexpr auto FuncTypeInteger4Real16 =
1275 genFuncType<Ty::Integer<4>, Ty::Real<16>>;
1276constexpr auto FuncTypeInteger8Real16 =
1277 genFuncType<Ty::Integer<8>, Ty::Real<16>>;
1278constexpr auto FuncTypeReal16Complex16 =
1279 genFuncType<Ty::Real<16>, Ty::Complex<16>>;
1280constexpr auto FuncTypeComplex16Complex16 =
1281 genFuncType<Ty::Complex<16>, Ty::Complex<16>>;
1282constexpr auto FuncTypeComplex16Complex16Complex16 =
1283 genFuncType<Ty::Complex<16>, Ty::Complex<16>, Ty::Complex<16>>;
1284constexpr auto FuncTypeComplex16Complex16Integer4 =
1285 genFuncType<Ty::Complex<16>, Ty::Complex<16>, Ty::Integer<4>>;
1286constexpr auto FuncTypeComplex16Complex16Integer8 =
1287 genFuncType<Ty::Complex<16>, Ty::Complex<16>, Ty::Integer<8>>;
1288
1289static constexpr MathOperation mathOperations[] = {
1290 {"abs", "fabsf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1291 genMathOp<mlir::math::AbsFOp>},
1292 {"abs", "fabs", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1293 genMathOp<mlir::math::AbsFOp>},
1294 {"abs", "llvm.fabs.f128", genFuncType<Ty::Real<16>, Ty::Real<16>>,
1295 genMathOp<mlir::math::AbsFOp>},
1296 {"abs", "cabsf", genFuncType<Ty::Real<4>, Ty::Complex<4>>,
1297 genComplexMathOp<mlir::complex::AbsOp>},
1298 {"abs", "cabs", genFuncType<Ty::Real<8>, Ty::Complex<8>>,
1299 genComplexMathOp<mlir::complex::AbsOp>},
1300 {"abs", RTNAME_STRING(CAbsF128), FuncTypeReal16Complex16, genLibF128Call},
1301 {"acos", "acosf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1302 genMathOp<mlir::math::AcosOp>},
1303 {"acos", "acos", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1304 genMathOp<mlir::math::AcosOp>},
1305 {"acos", RTNAME_STRING(AcosF128), FuncTypeReal16Real16, genLibF128Call},
1306 {"acos", "cacosf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall},
1307 {"acos", "cacos", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall},
1308 {"acos", RTNAME_STRING(CAcosF128), FuncTypeComplex16Complex16,
1309 genLibF128Call},
1310 {"acosh", "acoshf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1311 genMathOp<mlir::math::AcoshOp>},
1312 {"acosh", "acosh", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1313 genMathOp<mlir::math::AcoshOp>},
1314 {"acosh", RTNAME_STRING(AcoshF128), FuncTypeReal16Real16, genLibF128Call},
1315 {"acosh", "cacoshf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1316 genLibCall},
1317 {"acosh", "cacosh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1318 genLibCall},
1319 {"acosh", RTNAME_STRING(CAcoshF128), FuncTypeComplex16Complex16,
1320 genLibF128Call},
1321 // llvm.trunc behaves the same way as libm's trunc.
1322 {"aint", "llvm.trunc.f32", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1323 genLibCall},
1324 {"aint", "llvm.trunc.f64", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1325 genLibCall},
1326 {"aint", "llvm.trunc.f80", genFuncType<Ty::Real<10>, Ty::Real<10>>,
1327 genLibCall},
1328 {"aint", RTNAME_STRING(TruncF128), FuncTypeReal16Real16, genLibF128Call},
1329 // llvm.round behaves the same way as libm's round.
1330 {"anint", "llvm.round.f32", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1331 genMathOp<mlir::LLVM::RoundOp>},
1332 {"anint", "llvm.round.f64", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1333 genMathOp<mlir::LLVM::RoundOp>},
1334 {"anint", "llvm.round.f80", genFuncType<Ty::Real<10>, Ty::Real<10>>,
1335 genMathOp<mlir::LLVM::RoundOp>},
1336 {"anint", RTNAME_STRING(RoundF128), FuncTypeReal16Real16, genLibF128Call},
1337 {"asin", "asinf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1338 genMathOp<mlir::math::AsinOp>},
1339 {"asin", "asin", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1340 genMathOp<mlir::math::AsinOp>},
1341 {"asin", RTNAME_STRING(AsinF128), FuncTypeReal16Real16, genLibF128Call},
1342 {"asin", "casinf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall},
1343 {"asin", "casin", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall},
1344 {"asin", RTNAME_STRING(CAsinF128), FuncTypeComplex16Complex16,
1345 genLibF128Call},
1346 {"asinh", "asinhf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1347 genMathOp<mlir::math::AsinhOp>},
1348 {"asinh", "asinh", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1349 genMathOp<mlir::math::AsinhOp>},
1350 {"asinh", RTNAME_STRING(AsinhF128), FuncTypeReal16Real16, genLibF128Call},
1351 {"asinh", "casinhf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1352 genLibCall},
1353 {"asinh", "casinh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1354 genLibCall},
1355 {"asinh", RTNAME_STRING(CAsinhF128), FuncTypeComplex16Complex16,
1356 genLibF128Call},
1357 {"atan", "atanf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1358 genMathOp<mlir::math::AtanOp>},
1359 {"atan", "atan", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1360 genMathOp<mlir::math::AtanOp>},
1361 {"atan", RTNAME_STRING(AtanF128), FuncTypeReal16Real16, genLibF128Call},
1362 {"atan", "catanf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall},
1363 {"atan", "catan", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall},
1364 {"atan", RTNAME_STRING(CAtanF128), FuncTypeComplex16Complex16,
1365 genLibF128Call},
1366 {"atan", "atan2f", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>,
1367 genMathOp<mlir::math::Atan2Op>},
1368 {"atan", "atan2", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>,
1369 genMathOp<mlir::math::Atan2Op>},
1370 {"atan", RTNAME_STRING(Atan2F128), FuncTypeReal16Real16Real16,
1371 genLibF128Call},
1372 {"atan2", "atan2f", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>,
1373 genMathOp<mlir::math::Atan2Op>},
1374 {"atan2", "atan2", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>,
1375 genMathOp<mlir::math::Atan2Op>},
1376 {"atan2", RTNAME_STRING(Atan2F128), FuncTypeReal16Real16Real16,
1377 genLibF128Call},
1378 {"atanh", "atanhf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1379 genMathOp<mlir::math::AtanhOp>},
1380 {"atanh", "atanh", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1381 genMathOp<mlir::math::AtanhOp>},
1382 {"atanh", RTNAME_STRING(AtanhF128), FuncTypeReal16Real16, genLibF128Call},
1383 {"atanh", "catanhf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1384 genLibCall},
1385 {"atanh", "catanh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1386 genLibCall},
1387 {"atanh", RTNAME_STRING(CAtanhF128), FuncTypeComplex16Complex16,
1388 genLibF128Call},
1389 {"bessel_j0", "j0f", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
1390 {"bessel_j0", "j0", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
1391 {"bessel_j0", RTNAME_STRING(J0F128), FuncTypeReal16Real16, genLibF128Call},
1392 {"bessel_j1", "j1f", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
1393 {"bessel_j1", "j1", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
1394 {"bessel_j1", RTNAME_STRING(J1F128), FuncTypeReal16Real16, genLibF128Call},
1395 {"bessel_jn", "jnf", genFuncType<Ty::Real<4>, Ty::Integer<4>, Ty::Real<4>>,
1396 genLibCall},
1397 {"bessel_jn", "jn", genFuncType<Ty::Real<8>, Ty::Integer<4>, Ty::Real<8>>,
1398 genLibCall},
1399 {"bessel_jn", RTNAME_STRING(JnF128), FuncTypeReal16Integer4Real16,
1400 genLibF128Call},
1401 {"bessel_y0", "y0f", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
1402 {"bessel_y0", "y0", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
1403 {"bessel_y0", RTNAME_STRING(Y0F128), FuncTypeReal16Real16, genLibF128Call},
1404 {"bessel_y1", "y1f", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
1405 {"bessel_y1", "y1", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
1406 {"bessel_y1", RTNAME_STRING(Y1F128), FuncTypeReal16Real16, genLibF128Call},
1407 {"bessel_yn", "ynf", genFuncType<Ty::Real<4>, Ty::Integer<4>, Ty::Real<4>>,
1408 genLibCall},
1409 {"bessel_yn", "yn", genFuncType<Ty::Real<8>, Ty::Integer<4>, Ty::Real<8>>,
1410 genLibCall},
1411 {"bessel_yn", RTNAME_STRING(YnF128), FuncTypeReal16Integer4Real16,
1412 genLibF128Call},
1413 // math::CeilOp returns a real, while Fortran CEILING returns integer.
1414 {"ceil", "ceilf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1415 genMathOp<mlir::math::CeilOp>},
1416 {"ceil", "ceil", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1417 genMathOp<mlir::math::CeilOp>},
1418 {"ceil", RTNAME_STRING(CeilF128), FuncTypeReal16Real16, genLibF128Call},
1419 {"cos", "cosf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1420 genMathOp<mlir::math::CosOp>},
1421 {"cos", "cos", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1422 genMathOp<mlir::math::CosOp>},
1423 {"cos", RTNAME_STRING(CosF128), FuncTypeReal16Real16, genLibF128Call},
1424 {"cos", "ccosf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1425 genComplexMathOp<mlir::complex::CosOp>},
1426 {"cos", "ccos", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1427 genComplexMathOp<mlir::complex::CosOp>},
1428 {"cos", RTNAME_STRING(CCosF128), FuncTypeComplex16Complex16,
1429 genLibF128Call},
1430 {"cosh", "coshf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1431 genMathOp<mlir::math::CoshOp>},
1432 {"cosh", "cosh", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1433 genMathOp<mlir::math::CoshOp>},
1434 {"cosh", RTNAME_STRING(CoshF128), FuncTypeReal16Real16, genLibF128Call},
1435 {"cosh", "ccoshf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall},
1436 {"cosh", "ccosh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall},
1437 {"cosh", RTNAME_STRING(CCoshF128), FuncTypeComplex16Complex16,
1438 genLibF128Call},
1439 {"divc",
1440 {},
1441 genFuncType<Ty::Complex<2>, Ty::Complex<2>, Ty::Complex<2>>,
1442 genComplexMathOp<mlir::complex::DivOp>},
1443 {"divc",
1444 {},
1445 genFuncType<Ty::Complex<3>, Ty::Complex<3>, Ty::Complex<3>>,
1446 genComplexMathOp<mlir::complex::DivOp>},
1447 {"divc", "__divsc3",
1448 genFuncType<Ty::Complex<4>, Ty::Complex<4>, Ty::Complex<4>>,
1449 genLibSplitComplexArgsCall},
1450 {"divc", "__divdc3",
1451 genFuncType<Ty::Complex<8>, Ty::Complex<8>, Ty::Complex<8>>,
1452 genLibSplitComplexArgsCall},
1453 {"divc", "__divxc3",
1454 genFuncType<Ty::Complex<10>, Ty::Complex<10>, Ty::Complex<10>>,
1455 genLibSplitComplexArgsCall},
1456 {"divc", "__divtc3",
1457 genFuncType<Ty::Complex<16>, Ty::Complex<16>, Ty::Complex<16>>,
1458 genLibSplitComplexArgsCall},
1459 {"erf", "erff", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1460 genMathOp<mlir::math::ErfOp>},
1461 {"erf", "erf", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1462 genMathOp<mlir::math::ErfOp>},
1463 {"erf", RTNAME_STRING(ErfF128), FuncTypeReal16Real16, genLibF128Call},
1464 {"erfc", "erfcf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1465 genMathOp<mlir::math::ErfcOp>},
1466 {"erfc", "erfc", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1467 genMathOp<mlir::math::ErfcOp>},
1468 {"erfc", RTNAME_STRING(ErfcF128), FuncTypeReal16Real16, genLibF128Call},
1469 {"exp", "expf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1470 genMathOp<mlir::math::ExpOp>},
1471 {"exp", "exp", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1472 genMathOp<mlir::math::ExpOp>},
1473 {"exp", RTNAME_STRING(ExpF128), FuncTypeReal16Real16, genLibF128Call},
1474 {"exp", "cexpf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1475 genComplexMathOp<mlir::complex::ExpOp>},
1476 {"exp", "cexp", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1477 genComplexMathOp<mlir::complex::ExpOp>},
1478 {"exp", RTNAME_STRING(CExpF128), FuncTypeComplex16Complex16,
1479 genLibF128Call},
1480 {"feclearexcept", "feclearexcept",
1481 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},
1482 {"fedisableexcept", "fedisableexcept",
1483 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},
1484 {"feenableexcept", "feenableexcept",
1485 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},
1486 {"fegetenv", "fegetenv", genFuncType<Ty::Integer<4>, Ty::Address<4>>,
1487 genLibCall},
1488 {"fegetexcept", "fegetexcept", genFuncType<Ty::Integer<4>>, genLibCall},
1489 {"fegetmode", "fegetmode", genFuncType<Ty::Integer<4>, Ty::Address<4>>,
1490 genLibCall},
1491 {"feraiseexcept", "feraiseexcept",
1492 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},
1493 {"fesetenv", "fesetenv", genFuncType<Ty::Integer<4>, Ty::Address<4>>,
1494 genLibCall},
1495 {"fesetmode", "fesetmode", genFuncType<Ty::Integer<4>, Ty::Address<4>>,
1496 genLibCall},
1497 {"fetestexcept", "fetestexcept",
1498 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},
1499 {"feupdateenv", "feupdateenv", genFuncType<Ty::Integer<4>, Ty::Address<4>>,
1500 genLibCall},
1501 // math::FloorOp returns a real, while Fortran FLOOR returns integer.
1502 {"floor", "floorf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1503 genMathOp<mlir::math::FloorOp>},
1504 {"floor", "floor", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1505 genMathOp<mlir::math::FloorOp>},
1506 {"floor", RTNAME_STRING(FloorF128), FuncTypeReal16Real16, genLibF128Call},
1507 {"fma", "llvm.fma.f32",
1508 genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>,
1509 genMathOp<mlir::math::FmaOp>},
1510 {"fma", "llvm.fma.f64",
1511 genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>,
1512 genMathOp<mlir::math::FmaOp>},
1513 {"fma", RTNAME_STRING(FmaF128), FuncTypeReal16Real16Real16Real16,
1514 genLibF128Call},
1515 {"gamma", "tgammaf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
1516 {"gamma", "tgamma", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
1517 {"gamma", RTNAME_STRING(TgammaF128), FuncTypeReal16Real16, genLibF128Call},
1518 {"hypot", "hypotf", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>,
1519 genLibCall},
1520 {"hypot", "hypot", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>,
1521 genLibCall},
1522 {"hypot", RTNAME_STRING(HypotF128), FuncTypeReal16Real16Real16,
1523 genLibF128Call},
1524 {"log", "logf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1525 genMathOp<mlir::math::LogOp>},
1526 {"log", "log", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1527 genMathOp<mlir::math::LogOp>},
1528 {"log", RTNAME_STRING(LogF128), FuncTypeReal16Real16, genLibF128Call},
1529 {"log", "clogf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1530 genComplexMathOp<mlir::complex::LogOp>},
1531 {"log", "clog", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1532 genComplexMathOp<mlir::complex::LogOp>},
1533 {"log", RTNAME_STRING(CLogF128), FuncTypeComplex16Complex16,
1534 genLibF128Call},
1535 {"log10", "log10f", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1536 genMathOp<mlir::math::Log10Op>},
1537 {"log10", "log10", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1538 genMathOp<mlir::math::Log10Op>},
1539 {"log10", RTNAME_STRING(Log10F128), FuncTypeReal16Real16, genLibF128Call},
1540 {"log_gamma", "lgammaf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
1541 {"log_gamma", "lgamma", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
1542 {"log_gamma", RTNAME_STRING(LgammaF128), FuncTypeReal16Real16,
1543 genLibF128Call},
1544 {"nearbyint", "llvm.nearbyint.f32", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1545 genLibCall},
1546 {"nearbyint", "llvm.nearbyint.f64", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1547 genLibCall},
1548 {"nearbyint", "llvm.nearbyint.f80", genFuncType<Ty::Real<10>, Ty::Real<10>>,
1549 genLibCall},
1550 {"nearbyint", RTNAME_STRING(NearbyintF128), FuncTypeReal16Real16,
1551 genLibF128Call},
1552 // llvm.lround behaves the same way as libm's lround.
1553 {"nint", "llvm.lround.i64.f64", genFuncType<Ty::Integer<8>, Ty::Real<8>>,
1554 genLibCall},
1555 {"nint", "llvm.lround.i64.f32", genFuncType<Ty::Integer<8>, Ty::Real<4>>,
1556 genLibCall},
1557 {"nint", RTNAME_STRING(LlroundF128), FuncTypeInteger8Real16,
1558 genLibF128Call},
1559 {"nint", "llvm.lround.i32.f64", genFuncType<Ty::Integer<4>, Ty::Real<8>>,
1560 genLibCall},
1561 {"nint", "llvm.lround.i32.f32", genFuncType<Ty::Integer<4>, Ty::Real<4>>,
1562 genLibCall},
1563 {"nint", RTNAME_STRING(LroundF128), FuncTypeInteger4Real16, genLibF128Call},
1564 {"pow",
1565 {},
1566 genFuncType<Ty::Integer<1>, Ty::Integer<1>, Ty::Integer<1>>,
1567 genMathOp<mlir::math::IPowIOp>},
1568 {"pow",
1569 {},
1570 genFuncType<Ty::Integer<2>, Ty::Integer<2>, Ty::Integer<2>>,
1571 genMathOp<mlir::math::IPowIOp>},
1572 {"pow",
1573 {},
1574 genFuncType<Ty::Integer<4>, Ty::Integer<4>, Ty::Integer<4>>,
1575 genMathOp<mlir::math::IPowIOp>},
1576 {"pow",
1577 {},
1578 genFuncType<Ty::Integer<8>, Ty::Integer<8>, Ty::Integer<8>>,
1579 genMathOp<mlir::math::IPowIOp>},
1580 {"pow", "powf", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>,
1581 genMathOp<mlir::math::PowFOp>},
1582 {"pow", "pow", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>,
1583 genMathOp<mlir::math::PowFOp>},
1584 {"pow", RTNAME_STRING(PowF128), FuncTypeReal16Real16Real16, genLibF128Call},
1585 {"pow", "cpowf",
1586 genFuncType<Ty::Complex<4>, Ty::Complex<4>, Ty::Complex<4>>,
1587 genComplexMathOp<mlir::complex::PowOp>},
1588 {"pow", "cpow", genFuncType<Ty::Complex<8>, Ty::Complex<8>, Ty::Complex<8>>,
1589 genComplexMathOp<mlir::complex::PowOp>},
1590 {"pow", RTNAME_STRING(CPowF128), FuncTypeComplex16Complex16Complex16,
1591 genLibF128Call},
1592 {"pow", RTNAME_STRING(FPow4i),
1593 genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Integer<4>>,
1594 genMathOp<mlir::math::FPowIOp>},
1595 {"pow", RTNAME_STRING(FPow8i),
1596 genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Integer<4>>,
1597 genMathOp<mlir::math::FPowIOp>},
1598 {"pow", RTNAME_STRING(FPow16i),
1599 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Integer<4>>,
1600 genMathOp<mlir::math::FPowIOp>},
1601 {"pow", RTNAME_STRING(FPow4k),
1602 genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Integer<8>>,
1603 genMathOp<mlir::math::FPowIOp>},
1604 {"pow", RTNAME_STRING(FPow8k),
1605 genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Integer<8>>,
1606 genMathOp<mlir::math::FPowIOp>},
1607 {"pow", RTNAME_STRING(FPow16k),
1608 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Integer<8>>,
1609 genMathOp<mlir::math::FPowIOp>},
1610 {"pow", RTNAME_STRING(cpowi),
1611 genFuncType<Ty::Complex<4>, Ty::Complex<4>, Ty::Integer<4>>, genLibCall},
1612 {"pow", RTNAME_STRING(zpowi),
1613 genFuncType<Ty::Complex<8>, Ty::Complex<8>, Ty::Integer<4>>, genLibCall},
1614 {"pow", RTNAME_STRING(cqpowi), FuncTypeComplex16Complex16Integer4,
1615 genLibF128Call},
1616 {"pow", RTNAME_STRING(cpowk),
1617 genFuncType<Ty::Complex<4>, Ty::Complex<4>, Ty::Integer<8>>, genLibCall},
1618 {"pow", RTNAME_STRING(zpowk),
1619 genFuncType<Ty::Complex<8>, Ty::Complex<8>, Ty::Integer<8>>, genLibCall},
1620 {"pow", RTNAME_STRING(cqpowk), FuncTypeComplex16Complex16Integer8,
1621 genLibF128Call},
1622 {"remainder", "remainderf",
1623 genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>, genLibCall},
1624 {"remainder", "remainder",
1625 genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>, genLibCall},
1626 {"remainder", "remainderl",
1627 genFuncType<Ty::Real<10>, Ty::Real<10>, Ty::Real<10>>, genLibCall},
1628 {"remainder", RTNAME_STRING(RemainderF128), FuncTypeReal16Real16Real16,
1629 genLibF128Call},
1630 {"sign", "copysignf", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>,
1631 genMathOp<mlir::math::CopySignOp>},
1632 {"sign", "copysign", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>,
1633 genMathOp<mlir::math::CopySignOp>},
1634 {"sign", "copysignl", genFuncType<Ty::Real<10>, Ty::Real<10>, Ty::Real<10>>,
1635 genMathOp<mlir::math::CopySignOp>},
1636 {"sign", "llvm.copysign.f128",
1637 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Real<16>>,
1638 genMathOp<mlir::math::CopySignOp>},
1639 {"sin", "sinf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1640 genMathOp<mlir::math::SinOp>},
1641 {"sin", "sin", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1642 genMathOp<mlir::math::SinOp>},
1643 {"sin", RTNAME_STRING(SinF128), FuncTypeReal16Real16, genLibF128Call},
1644 {"sin", "csinf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1645 genComplexMathOp<mlir::complex::SinOp>},
1646 {"sin", "csin", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1647 genComplexMathOp<mlir::complex::SinOp>},
1648 {"sin", RTNAME_STRING(CSinF128), FuncTypeComplex16Complex16,
1649 genLibF128Call},
1650 {"sinh", "sinhf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
1651 {"sinh", "sinh", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
1652 {"sinh", RTNAME_STRING(SinhF128), FuncTypeReal16Real16, genLibF128Call},
1653 {"sinh", "csinhf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall},
1654 {"sinh", "csinh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall},
1655 {"sinh", RTNAME_STRING(CSinhF128), FuncTypeComplex16Complex16,
1656 genLibF128Call},
1657 {"sqrt", "sqrtf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1658 genMathOp<mlir::math::SqrtOp>},
1659 {"sqrt", "sqrt", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1660 genMathOp<mlir::math::SqrtOp>},
1661 {"sqrt", RTNAME_STRING(SqrtF128), FuncTypeReal16Real16, genLibF128Call},
1662 {"sqrt", "csqrtf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1663 genComplexMathOp<mlir::complex::SqrtOp>},
1664 {"sqrt", "csqrt", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1665 genComplexMathOp<mlir::complex::SqrtOp>},
1666 {"sqrt", RTNAME_STRING(CSqrtF128), FuncTypeComplex16Complex16,
1667 genLibF128Call},
1668 {"tan", "tanf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1669 genMathOp<mlir::math::TanOp>},
1670 {"tan", "tan", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1671 genMathOp<mlir::math::TanOp>},
1672 {"tan", RTNAME_STRING(TanF128), FuncTypeReal16Real16, genLibF128Call},
1673 {"tan", "ctanf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1674 genComplexMathOp<mlir::complex::TanOp>},
1675 {"tan", "ctan", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1676 genComplexMathOp<mlir::complex::TanOp>},
1677 {"tan", RTNAME_STRING(CTanF128), FuncTypeComplex16Complex16,
1678 genLibF128Call},
1679 {"tanh", "tanhf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1680 genMathOp<mlir::math::TanhOp>},
1681 {"tanh", "tanh", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1682 genMathOp<mlir::math::TanhOp>},
1683 {"tanh", RTNAME_STRING(TanhF128), FuncTypeReal16Real16, genLibF128Call},
1684 {"tanh", "ctanhf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1685 genComplexMathOp<mlir::complex::TanhOp>},
1686 {"tanh", "ctanh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1687 genComplexMathOp<mlir::complex::TanhOp>},
1688 {"tanh", RTNAME_STRING(CTanhF128), FuncTypeComplex16Complex16,
1689 genLibF128Call},
1690};
1691
1692// This helper class computes a "distance" between two function types.
1693// The distance measures how many narrowing conversions of actual arguments
1694// and result of "from" must be made in order to use "to" instead of "from".
1695// For instance, the distance between ACOS(REAL(10)) and ACOS(REAL(8)) is
1696// greater than the one between ACOS(REAL(10)) and ACOS(REAL(16)). This means
1697// if no implementation of ACOS(REAL(10)) is available, it is better to use
1698// ACOS(REAL(16)) with casts rather than ACOS(REAL(8)).
1699// Note that this is not a symmetric distance and the order of "from" and "to"
1700// arguments matters, d(foo, bar) may not be the same as d(bar, foo) because it
1701// may be safe to replace foo by bar, but not the opposite.
1702class FunctionDistance {
1703public:
1704 FunctionDistance() : infinite{true} {}
1705
1706 FunctionDistance(mlir::FunctionType from, mlir::FunctionType to) {
1707 unsigned nInputs = from.getNumInputs();
1708 unsigned nResults = from.getNumResults();
1709 if (nResults != to.getNumResults() || nInputs != to.getNumInputs()) {
1710 infinite = true;
1711 } else {
1712 for (decltype(nInputs) i = 0; i < nInputs && !infinite; ++i)
1713 addArgumentDistance(from: from.getInput(i), to: to.getInput(i));
1714 for (decltype(nResults) i = 0; i < nResults && !infinite; ++i)
1715 addResultDistance(from: to.getResult(i), to: from.getResult(i));
1716 }
1717 }
1718
1719 /// Beware both d1.isSmallerThan(d2) *and* d2.isSmallerThan(d1) may be
1720 /// false if both d1 and d2 are infinite. This implies that
1721 /// d1.isSmallerThan(d2) is not equivalent to !d2.isSmallerThan(d1)
1722 bool isSmallerThan(const FunctionDistance &d) const {
1723 return !infinite &&
1724 (d.infinite || std::lexicographical_compare(
1725 first1: conversions.begin(), last1: conversions.end(),
1726 first2: d.conversions.begin(), last2: d.conversions.end()));
1727 }
1728
1729 bool isLosingPrecision() const {
1730 return conversions[narrowingArg] != 0 || conversions[extendingResult] != 0;
1731 }
1732
1733 bool isInfinite() const { return infinite; }
1734
1735private:
1736 enum class Conversion { Forbidden, None, Narrow, Extend };
1737
1738 void addArgumentDistance(mlir::Type from, mlir::Type to) {
1739 switch (conversionBetweenTypes(from, to)) {
1740 case Conversion::Forbidden:
1741 infinite = true;
1742 break;
1743 case Conversion::None:
1744 break;
1745 case Conversion::Narrow:
1746 conversions[narrowingArg]++;
1747 break;
1748 case Conversion::Extend:
1749 conversions[nonNarrowingArg]++;
1750 break;
1751 }
1752 }
1753
1754 void addResultDistance(mlir::Type from, mlir::Type to) {
1755 switch (conversionBetweenTypes(from, to)) {
1756 case Conversion::Forbidden:
1757 infinite = true;
1758 break;
1759 case Conversion::None:
1760 break;
1761 case Conversion::Narrow:
1762 conversions[nonExtendingResult]++;
1763 break;
1764 case Conversion::Extend:
1765 conversions[extendingResult]++;
1766 break;
1767 }
1768 }
1769
1770 // Floating point can be mlir Float or Complex Type.
1771 static unsigned getFloatingPointWidth(mlir::Type t) {
1772 if (auto f{mlir::dyn_cast<mlir::FloatType>(Val&: t)})
1773 return f.getWidth();
1774 if (auto cplx{mlir::dyn_cast<mlir::ComplexType>(Val&: t)})
1775 return mlir::cast<mlir::FloatType>(Val: cplx.getElementType()).getWidth();
1776 llvm_unreachable("not a floating-point type");
1777 }
1778
1779 static Conversion conversionBetweenTypes(mlir::Type from, mlir::Type to) {
1780 if (from == to)
1781 return Conversion::None;
1782
1783 if (auto fromIntTy{mlir::dyn_cast<mlir::IntegerType>(Val&: from)}) {
1784 if (auto toIntTy{mlir::dyn_cast<mlir::IntegerType>(Val&: to)}) {
1785 return fromIntTy.getWidth() > toIntTy.getWidth() ? Conversion::Narrow
1786 : Conversion::Extend;
1787 }
1788 }
1789
1790 if (fir::isa_real(from) && fir::isa_real(to)) {
1791 return getFloatingPointWidth(t: from) > getFloatingPointWidth(t: to)
1792 ? Conversion::Narrow
1793 : Conversion::Extend;
1794 }
1795
1796 if (fir::isa_complex(from) && fir::isa_complex(to)) {
1797 return getFloatingPointWidth(t: from) > getFloatingPointWidth(t: to)
1798 ? Conversion::Narrow
1799 : Conversion::Extend;
1800 }
1801 // Notes:
1802 // - No conversion between character types, specialization of runtime
1803 // functions should be made instead.
1804 // - It is not clear there is a use case for automatic conversions
1805 // around Logical and it may damage hidden information in the physical
1806 // storage so do not do it.
1807 return Conversion::Forbidden;
1808 }
1809
1810 // Below are indexes to access data in conversions.
1811 // The order in data does matter for lexicographical_compare
1812 enum {
1813 narrowingArg = 0, // usually bad
1814 extendingResult, // usually bad
1815 nonExtendingResult, // usually ok
1816 nonNarrowingArg, // usually ok
1817 dataSize
1818 };
1819
1820 std::array<int, dataSize> conversions = {};
1821 bool infinite = false; // When forbidden conversion or wrong argument number
1822};
1823
1824using RtMap = Fortran::common::StaticMultimapView<MathOperation>;
1825static constexpr RtMap mathOps(mathOperations);
1826static_assert(mathOps.Verify() && "map must be sorted");
1827
1828/// Look for a MathOperation entry specifying how to lower a mathematical
1829/// operation defined by \p name with its result' and operands' types
1830/// specified in the form of a FunctionType \p funcType.
1831/// If exact match for the given types is found, then the function
1832/// returns a pointer to the corresponding MathOperation.
1833/// Otherwise, the function returns nullptr.
1834/// If there is a MathOperation that can be used with additional
1835/// type casts for the operands or/and result (non-exact match),
1836/// then it is returned via \p bestNearMatch argument, and
1837/// \p bestMatchDistance specifies the FunctionDistance between
1838/// the requested operation and the non-exact match.
1839static const MathOperation *
1840searchMathOperation(fir::FirOpBuilder &builder,
1841 const IntrinsicHandlerEntry::RuntimeGeneratorRange &range,
1842 mlir::FunctionType funcType,
1843 const MathOperation **bestNearMatch,
1844 FunctionDistance &bestMatchDistance) {
1845 for (auto iter = range.first; iter != range.second && iter; ++iter) {
1846 const auto &impl = *iter;
1847 auto implType = impl.typeGenerator(builder.getContext(), builder);
1848 if (funcType == implType) {
1849 return &impl; // exact match
1850 }
1851
1852 FunctionDistance distance(funcType, implType);
1853 if (distance.isSmallerThan(d: bestMatchDistance)) {
1854 *bestNearMatch = &impl;
1855 bestMatchDistance = std::move(distance);
1856 }
1857 }
1858 return nullptr;
1859}
1860
1861/// Implementation of the operation defined by \p name with type
1862/// \p funcType is not precise, and the actual available implementation
1863/// is \p distance away from the requested. If using the available
1864/// implementation results in a precision loss, emit an error message
1865/// with the given code location \p loc.
1866static void checkPrecisionLoss(llvm::StringRef name,
1867 mlir::FunctionType funcType,
1868 const FunctionDistance &distance,
1869 fir::FirOpBuilder &builder, mlir::Location loc) {
1870 if (!distance.isLosingPrecision())
1871 return;
1872
1873 // Using this runtime version requires narrowing the arguments
1874 // or extending the result. It is not numerically safe. There
1875 // is currently no quad math library that was described in
1876 // lowering and could be used here. Emit an error and continue
1877 // generating the code with the narrowing cast so that the user
1878 // can get a complete list of the problematic intrinsic calls.
1879 std::string message = prettyPrintIntrinsicName(
1880 builder, loc, "not yet implemented: no math runtime available for '",
1881 name, "'", funcType);
1882 mlir::emitError(loc, message);
1883}
1884
1885/// Helpers to get function type from arguments and result type.
1886static mlir::FunctionType getFunctionType(std::optional<mlir::Type> resultType,
1887 llvm::ArrayRef<mlir::Value> arguments,
1888 fir::FirOpBuilder &builder) {
1889 llvm::SmallVector<mlir::Type> argTypes;
1890 for (mlir::Value arg : arguments)
1891 argTypes.push_back(Elt: arg.getType());
1892 llvm::SmallVector<mlir::Type> resTypes;
1893 if (resultType)
1894 resTypes.push_back(Elt: *resultType);
1895 return mlir::FunctionType::get(context: builder.getModule().getContext(), inputs: argTypes,
1896 results: resTypes);
1897}
1898
1899/// fir::ExtendedValue to mlir::Value translation layer
1900
1901fir::ExtendedValue toExtendedValue(mlir::Value val, fir::FirOpBuilder &builder,
1902 mlir::Location loc) {
1903 assert(val && "optional unhandled here");
1904 mlir::Type type = val.getType();
1905 mlir::Value base = val;
1906 mlir::IndexType indexType = builder.getIndexType();
1907 llvm::SmallVector<mlir::Value> extents;
1908
1909 fir::factory::CharacterExprHelper charHelper{builder, loc};
1910 // FIXME: we may want to allow non character scalar here.
1911 if (charHelper.isCharacterScalar(type))
1912 return charHelper.toExtendedValue(val);
1913
1914 if (auto refType = mlir::dyn_cast<fir::ReferenceType>(type))
1915 type = refType.getEleTy();
1916
1917 if (auto arrayType = mlir::dyn_cast<fir::SequenceType>(type)) {
1918 type = arrayType.getEleTy();
1919 for (fir::SequenceType::Extent extent : arrayType.getShape()) {
1920 if (extent == fir::SequenceType::getUnknownExtent())
1921 break;
1922 extents.emplace_back(
1923 builder.createIntegerConstant(loc, indexType, extent));
1924 }
1925 // Last extent might be missing in case of assumed-size. If more extents
1926 // could not be deduced from type, that's an error (a fir.box should
1927 // have been used in the interface).
1928 if (extents.size() + 1 < arrayType.getShape().size())
1929 mlir::emitError(loc, message: "cannot retrieve array extents from type");
1930 } else if (mlir::isa<fir::BoxType>(type) ||
1931 mlir::isa<fir::RecordType>(type)) {
1932 fir::emitFatalError(loc, "not yet implemented: descriptor or derived type");
1933 }
1934
1935 if (!extents.empty())
1936 return fir::ArrayBoxValue{base, extents};
1937 return base;
1938}
1939
1940mlir::Value toValue(const fir::ExtendedValue &val, fir::FirOpBuilder &builder,
1941 mlir::Location loc) {
1942 if (const fir::CharBoxValue *charBox = val.getCharBox()) {
1943 mlir::Value buffer = charBox->getBuffer();
1944 auto buffTy = buffer.getType();
1945 if (mlir::isa<mlir::FunctionType>(buffTy))
1946 fir::emitFatalError(
1947 loc, "A character's buffer type cannot be a function type.");
1948 if (mlir::isa<fir::BoxCharType>(buffTy))
1949 return buffer;
1950 return fir::factory::CharacterExprHelper{builder, loc}.createEmboxChar(
1951 buffer, charBox->getLen());
1952 }
1953
1954 // FIXME: need to access other ExtendedValue variants and handle them
1955 // properly.
1956 return fir::getBase(val);
1957}
1958
1959//===----------------------------------------------------------------------===//
1960// IntrinsicLibrary
1961//===----------------------------------------------------------------------===//
1962
1963static bool isIntrinsicModuleProcedure(llvm::StringRef name) {
1964 return name.starts_with(Prefix: "c_") || name.starts_with(Prefix: "compiler_") ||
1965 name.starts_with(Prefix: "ieee_") || name.starts_with(Prefix: "__ppc_");
1966}
1967
1968static bool isCoarrayIntrinsic(llvm::StringRef name) {
1969 return name.starts_with(Prefix: "atomic_") || name.starts_with(Prefix: "co_") ||
1970 name.contains(Other: "image") || name.ends_with(Suffix: "cobound") ||
1971 name == "team_number";
1972}
1973
1974/// Return the generic name of an intrinsic module procedure specific name.
1975/// Remove any "__builtin_" prefix, and any specific suffix of the form
1976/// {_[ail]?[0-9]+}*, such as _1 or _a4.
1977llvm::StringRef genericName(llvm::StringRef specificName) {
1978 const std::string builtin = "__builtin_";
1979 llvm::StringRef name = specificName.starts_with(Prefix: builtin)
1980 ? specificName.drop_front(N: builtin.size())
1981 : specificName;
1982 size_t size = name.size();
1983 if (isIntrinsicModuleProcedure(name))
1984 while (isdigit(name[size - 1]))
1985 while (name[--size] != '_')
1986 ;
1987 return name.drop_back(N: name.size() - size);
1988}
1989
1990std::optional<IntrinsicHandlerEntry::RuntimeGeneratorRange>
1991lookupRuntimeGenerator(llvm::StringRef name, bool isPPCTarget) {
1992 if (auto range = mathOps.equal_range(name); range.first != range.second)
1993 return std::make_optional<IntrinsicHandlerEntry::RuntimeGeneratorRange>(
1994 range);
1995 // Search ppcMathOps only if targetting PowerPC arch
1996 if (isPPCTarget)
1997 if (auto range = checkPPCMathOperationsRange(name);
1998 range.first != range.second)
1999 return std::make_optional<IntrinsicHandlerEntry::RuntimeGeneratorRange>(
2000 range);
2001 return std::nullopt;
2002}
2003
2004std::optional<IntrinsicHandlerEntry>
2005lookupIntrinsicHandler(fir::FirOpBuilder &builder,
2006 llvm::StringRef intrinsicName,
2007 std::optional<mlir::Type> resultType) {
2008 llvm::StringRef name = genericName(specificName: intrinsicName);
2009 if (const IntrinsicHandler *handler = findIntrinsicHandler(name))
2010 return std::make_optional<IntrinsicHandlerEntry>(handler);
2011 bool isPPCTarget = fir::getTargetTriple(builder.getModule()).isPPC();
2012 // If targeting PowerPC, check PPC intrinsic handlers.
2013 if (isPPCTarget)
2014 if (const IntrinsicHandler *ppcHandler = findPPCIntrinsicHandler(name))
2015 return std::make_optional<IntrinsicHandlerEntry>(ppcHandler);
2016 // Subroutines should have a handler.
2017 if (!resultType)
2018 return std::nullopt;
2019 // Try the runtime if no special handler was defined for the
2020 // intrinsic being called. Maths runtime only has numerical elemental.
2021 if (auto runtimeGeneratorRange = lookupRuntimeGenerator(name, isPPCTarget))
2022 return std::make_optional<IntrinsicHandlerEntry>(*runtimeGeneratorRange);
2023 return std::nullopt;
2024}
2025
2026/// Generate a TODO error message for an as yet unimplemented intrinsic.
2027void crashOnMissingIntrinsic(mlir::Location loc,
2028 llvm::StringRef intrinsicName) {
2029 llvm::StringRef name = genericName(specificName: intrinsicName);
2030 if (isIntrinsicModuleProcedure(name))
2031 TODO(loc, "intrinsic module procedure: " + llvm::Twine(name));
2032 else if (isCoarrayIntrinsic(name))
2033 TODO(loc, "coarray: intrinsic " + llvm::Twine(name));
2034 else
2035 TODO(loc, "intrinsic: " + llvm::Twine(name.upper()));
2036}
2037
2038template <typename GeneratorType>
2039fir::ExtendedValue IntrinsicLibrary::genElementalCall(
2040 GeneratorType generator, llvm::StringRef name, mlir::Type resultType,
2041 llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
2042 llvm::SmallVector<mlir::Value> scalarArgs;
2043 for (const fir::ExtendedValue &arg : args)
2044 if (arg.getUnboxed() || arg.getCharBox())
2045 scalarArgs.emplace_back(fir::getBase(arg));
2046 else
2047 fir::emitFatalError(loc, "nonscalar intrinsic argument");
2048 if (outline)
2049 return outlineInWrapper(generator, name, resultType, scalarArgs);
2050 return invokeGenerator(generator, resultType, scalarArgs);
2051}
2052
2053template <>
2054fir::ExtendedValue
2055IntrinsicLibrary::genElementalCall<IntrinsicLibrary::ExtendedGenerator>(
2056 ExtendedGenerator generator, llvm::StringRef name, mlir::Type resultType,
2057 llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
2058 for (const fir::ExtendedValue &arg : args) {
2059 auto *box = arg.getBoxOf<fir::BoxValue>();
2060 if (!arg.getUnboxed() && !arg.getCharBox() &&
2061 !(box && fir::isScalarBoxedRecordType(fir::getBase(*box).getType())))
2062 fir::emitFatalError(loc, "nonscalar intrinsic argument");
2063 }
2064 if (outline)
2065 return outlineInExtendedWrapper(generator, name, resultType, args);
2066 return std::invoke(generator, *this, resultType, args);
2067}
2068
2069template <>
2070fir::ExtendedValue
2071IntrinsicLibrary::genElementalCall<IntrinsicLibrary::SubroutineGenerator>(
2072 SubroutineGenerator generator, llvm::StringRef name, mlir::Type resultType,
2073 llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
2074 for (const fir::ExtendedValue &arg : args)
2075 if (!arg.getUnboxed() && !arg.getCharBox())
2076 // fir::emitFatalError(loc, "nonscalar intrinsic argument");
2077 crashOnMissingIntrinsic(loc, name);
2078 if (outline)
2079 return outlineInExtendedWrapper(generator, name, resultType, args);
2080 std::invoke(generator, *this, args);
2081 return mlir::Value();
2082}
2083
2084template <>
2085fir::ExtendedValue
2086IntrinsicLibrary::genElementalCall<IntrinsicLibrary::DualGenerator>(
2087 DualGenerator generator, llvm::StringRef name, mlir::Type resultType,
2088 llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
2089 assert(resultType.getImpl() && "expect elemental intrinsic to be functions");
2090
2091 for (const fir::ExtendedValue &arg : args)
2092 if (!arg.getUnboxed() && !arg.getCharBox())
2093 // fir::emitFatalError(loc, "nonscalar intrinsic argument");
2094 crashOnMissingIntrinsic(loc, name);
2095 if (outline)
2096 return outlineInExtendedWrapper(generator, name, resultType, args);
2097
2098 return std::invoke(generator, *this, std::optional<mlir::Type>{resultType},
2099 args);
2100}
2101
2102static fir::ExtendedValue
2103invokeHandler(IntrinsicLibrary::ElementalGenerator generator,
2104 const IntrinsicHandler &handler,
2105 std::optional<mlir::Type> resultType,
2106 llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
2107 IntrinsicLibrary &lib) {
2108 assert(resultType && "expect elemental intrinsic to be functions");
2109 return lib.genElementalCall(generator, handler.name, *resultType, args,
2110 outline);
2111}
2112
2113static fir::ExtendedValue
2114invokeHandler(IntrinsicLibrary::ExtendedGenerator generator,
2115 const IntrinsicHandler &handler,
2116 std::optional<mlir::Type> resultType,
2117 llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
2118 IntrinsicLibrary &lib) {
2119 assert(resultType && "expect intrinsic function");
2120 if (handler.isElemental)
2121 return lib.genElementalCall(generator, handler.name, *resultType, args,
2122 outline);
2123 if (outline)
2124 return lib.outlineInExtendedWrapper(generator, handler.name, *resultType,
2125 args);
2126 return std::invoke(generator, lib, *resultType, args);
2127}
2128
2129static fir::ExtendedValue
2130invokeHandler(IntrinsicLibrary::SubroutineGenerator generator,
2131 const IntrinsicHandler &handler,
2132 std::optional<mlir::Type> resultType,
2133 llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
2134 IntrinsicLibrary &lib) {
2135 if (handler.isElemental)
2136 return lib.genElementalCall(generator, handler.name, mlir::Type{}, args,
2137 outline);
2138 if (outline)
2139 return lib.outlineInExtendedWrapper(generator, handler.name, resultType,
2140 args);
2141 std::invoke(generator, lib, args);
2142 return mlir::Value{};
2143}
2144
2145static fir::ExtendedValue
2146invokeHandler(IntrinsicLibrary::DualGenerator generator,
2147 const IntrinsicHandler &handler,
2148 std::optional<mlir::Type> resultType,
2149 llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
2150 IntrinsicLibrary &lib) {
2151 if (handler.isElemental)
2152 return lib.genElementalCall(generator, handler.name, mlir::Type{}, args,
2153 outline);
2154 if (outline)
2155 return lib.outlineInExtendedWrapper(generator, handler.name, resultType,
2156 args);
2157
2158 return std::invoke(generator, lib, resultType, args);
2159}
2160
2161static std::pair<fir::ExtendedValue, bool> genIntrinsicCallHelper(
2162 const IntrinsicHandler *handler, std::optional<mlir::Type> resultType,
2163 llvm::ArrayRef<fir::ExtendedValue> args, IntrinsicLibrary &lib) {
2164 assert(handler && "must be set");
2165 bool outline = handler->outline || outlineAllIntrinsics;
2166 return {Fortran::common::visit(
2167 [&](auto &generator) -> fir::ExtendedValue {
2168 return invokeHandler(generator, *handler, resultType, args,
2169 outline, lib);
2170 },
2171 handler->generator),
2172 lib.resultMustBeFreed};
2173}
2174
2175static IntrinsicLibrary::RuntimeCallGenerator getRuntimeCallGeneratorHelper(
2176 const IntrinsicHandlerEntry::RuntimeGeneratorRange &, mlir::FunctionType,
2177 fir::FirOpBuilder &, mlir::Location);
2178
2179static std::pair<fir::ExtendedValue, bool> genIntrinsicCallHelper(
2180 const IntrinsicHandlerEntry::RuntimeGeneratorRange &range,
2181 std::optional<mlir::Type> resultType,
2182 llvm::ArrayRef<fir::ExtendedValue> args, IntrinsicLibrary &lib) {
2183 assert(resultType.has_value() && "RuntimeGenerator are for functions only");
2184 assert(range.first != nullptr && "range should not be empty");
2185 fir::FirOpBuilder &builder = lib.builder;
2186 mlir::Location loc = lib.loc;
2187 llvm::StringRef name = range.first->key;
2188 // FIXME: using toValue to get the type won't work with array arguments.
2189 llvm::SmallVector<mlir::Value> mlirArgs;
2190 for (const fir::ExtendedValue &extendedVal : args) {
2191 mlir::Value val = toValue(extendedVal, builder, loc);
2192 if (!val)
2193 // If an absent optional gets there, most likely its handler has just
2194 // not yet been defined.
2195 crashOnMissingIntrinsic(loc, name);
2196 mlirArgs.emplace_back(val);
2197 }
2198 mlir::FunctionType soughtFuncType =
2199 getFunctionType(*resultType, mlirArgs, builder);
2200
2201 IntrinsicLibrary::RuntimeCallGenerator runtimeCallGenerator =
2202 getRuntimeCallGeneratorHelper(range, soughtFuncType, builder, loc);
2203 return {lib.genElementalCall(runtimeCallGenerator, name, *resultType, args,
2204 /*outline=*/outlineAllIntrinsics),
2205 lib.resultMustBeFreed};
2206}
2207
2208std::pair<fir::ExtendedValue, bool>
2209genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc,
2210 const IntrinsicHandlerEntry &intrinsic,
2211 std::optional<mlir::Type> resultType,
2212 llvm::ArrayRef<fir::ExtendedValue> args,
2213 Fortran::lower::AbstractConverter *converter) {
2214 IntrinsicLibrary library{builder, loc, converter};
2215 return std::visit(
2216 [&](auto handler) -> auto {
2217 return genIntrinsicCallHelper(handler, resultType, args, library);
2218 },
2219 intrinsic.entry);
2220}
2221
2222std::pair<fir::ExtendedValue, bool>
2223IntrinsicLibrary::genIntrinsicCall(llvm::StringRef specificName,
2224 std::optional<mlir::Type> resultType,
2225 llvm::ArrayRef<fir::ExtendedValue> args) {
2226 std::optional<IntrinsicHandlerEntry> intrinsic =
2227 lookupIntrinsicHandler(builder, specificName, resultType);
2228 if (!intrinsic.has_value())
2229 crashOnMissingIntrinsic(loc, specificName);
2230 return std::visit(
2231 [&](auto handler) -> auto {
2232 return genIntrinsicCallHelper(handler, resultType, args, *this);
2233 },
2234 intrinsic->entry);
2235}
2236
2237mlir::Value
2238IntrinsicLibrary::invokeGenerator(ElementalGenerator generator,
2239 mlir::Type resultType,
2240 llvm::ArrayRef<mlir::Value> args) {
2241 return std::invoke(generator, *this, resultType, args);
2242}
2243
2244mlir::Value
2245IntrinsicLibrary::invokeGenerator(RuntimeCallGenerator generator,
2246 mlir::Type resultType,
2247 llvm::ArrayRef<mlir::Value> args) {
2248 return generator(builder, loc, args);
2249}
2250
2251mlir::Value
2252IntrinsicLibrary::invokeGenerator(ExtendedGenerator generator,
2253 mlir::Type resultType,
2254 llvm::ArrayRef<mlir::Value> args) {
2255 llvm::SmallVector<fir::ExtendedValue> extendedArgs;
2256 for (mlir::Value arg : args)
2257 extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
2258 auto extendedResult = std::invoke(generator, *this, resultType, extendedArgs);
2259 return toValue(extendedResult, builder, loc);
2260}
2261
2262mlir::Value
2263IntrinsicLibrary::invokeGenerator(SubroutineGenerator generator,
2264 llvm::ArrayRef<mlir::Value> args) {
2265 llvm::SmallVector<fir::ExtendedValue> extendedArgs;
2266 for (mlir::Value arg : args)
2267 extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
2268 std::invoke(generator, *this, extendedArgs);
2269 return {};
2270}
2271
2272mlir::Value
2273IntrinsicLibrary::invokeGenerator(DualGenerator generator,
2274 llvm::ArrayRef<mlir::Value> args) {
2275 llvm::SmallVector<fir::ExtendedValue> extendedArgs;
2276 for (mlir::Value arg : args)
2277 extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
2278 std::invoke(generator, *this, std::optional<mlir::Type>{}, extendedArgs);
2279 return {};
2280}
2281
2282mlir::Value
2283IntrinsicLibrary::invokeGenerator(DualGenerator generator,
2284 mlir::Type resultType,
2285 llvm::ArrayRef<mlir::Value> args) {
2286 llvm::SmallVector<fir::ExtendedValue> extendedArgs;
2287 for (mlir::Value arg : args)
2288 extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
2289
2290 if (resultType.getImpl() == nullptr) {
2291 // TODO:
2292 assert(false && "result type is null");
2293 }
2294
2295 auto extendedResult = std::invoke(
2296 generator, *this, std::optional<mlir::Type>{resultType}, extendedArgs);
2297 return toValue(extendedResult, builder, loc);
2298}
2299
2300//===----------------------------------------------------------------------===//
2301// Intrinsic Procedure Mangling
2302//===----------------------------------------------------------------------===//
2303
2304/// Helper to encode type into string for intrinsic procedure names.
2305/// Note: mlir has Type::dump(ostream) methods but it may add "!" that is not
2306/// suitable for function names.
2307static std::string typeToString(mlir::Type t) {
2308 if (auto refT{mlir::dyn_cast<fir::ReferenceType>(t)})
2309 return "ref_" + typeToString(refT.getEleTy());
2310 if (auto i{mlir::dyn_cast<mlir::IntegerType>(Val&: t)}) {
2311 return "i" + std::to_string(val: i.getWidth());
2312 }
2313 if (auto cplx{mlir::dyn_cast<mlir::ComplexType>(Val&: t)}) {
2314 auto eleTy = mlir::cast<mlir::FloatType>(Val: cplx.getElementType());
2315 return "z" + std::to_string(val: eleTy.getWidth());
2316 }
2317 if (auto f{mlir::dyn_cast<mlir::FloatType>(Val&: t)}) {
2318 return "f" + std::to_string(val: f.getWidth());
2319 }
2320 if (auto logical{mlir::dyn_cast<fir::LogicalType>(t)}) {
2321 return "l" + std::to_string(logical.getFKind());
2322 }
2323 if (auto character{mlir::dyn_cast<fir::CharacterType>(t)}) {
2324 return "c" + std::to_string(character.getFKind());
2325 }
2326 if (auto boxCharacter{mlir::dyn_cast<fir::BoxCharType>(t)}) {
2327 return "bc" + std::to_string(boxCharacter.getEleTy().getFKind());
2328 }
2329 llvm_unreachable("no mangling for type");
2330}
2331
2332/// Returns a name suitable to define mlir functions for Fortran intrinsic
2333/// Procedure. These names are guaranteed to not conflict with user defined
2334/// procedures. This is needed to implement Fortran generic intrinsics as
2335/// several mlir functions specialized for the argument types.
2336/// The result is guaranteed to be distinct for different mlir::FunctionType
2337/// arguments. The mangling pattern is:
2338/// fir.<generic name>.<result type>.<arg type>...
2339/// e.g ACOS(COMPLEX(4)) is mangled as fir.acos.z4.z4
2340/// For subroutines no result type is return but in order to still provide
2341/// a unique mangled name, we use "void" as the return type. As in:
2342/// fir.<generic name>.void.<arg type>...
2343/// e.g. FREE(INTEGER(4)) is mangled as fir.free.void.i4
2344static std::string mangleIntrinsicProcedure(llvm::StringRef intrinsic,
2345 mlir::FunctionType funTy) {
2346 std::string name = "fir.";
2347 name.append(str: intrinsic.str()).append(s: ".");
2348 if (funTy.getNumResults() == 1)
2349 name.append(str: typeToString(t: funTy.getResult(i: 0)));
2350 else if (funTy.getNumResults() == 0)
2351 name.append(s: "void");
2352 else
2353 llvm_unreachable("more than one result value for function");
2354 unsigned e = funTy.getNumInputs();
2355 for (decltype(e) i = 0; i < e; ++i)
2356 name.append(s: ".").append(str: typeToString(t: funTy.getInput(i)));
2357 return name;
2358}
2359
2360template <typename GeneratorType>
2361mlir::func::FuncOp IntrinsicLibrary::getWrapper(GeneratorType generator,
2362 llvm::StringRef name,
2363 mlir::FunctionType funcType,
2364 bool loadRefArguments) {
2365 std::string wrapperName = mangleIntrinsicProcedure(name, funcType);
2366 mlir::func::FuncOp function = builder.getNamedFunction(wrapperName);
2367 if (!function) {
2368 // First time this wrapper is needed, build it.
2369 function = builder.createFunction(loc, wrapperName, funcType);
2370 function->setAttr("fir.intrinsic", builder.getUnitAttr());
2371 fir::factory::setInternalLinkage(function);
2372 function.addEntryBlock();
2373
2374 // Create local context to emit code into the newly created function
2375 // This new function is not linked to a source file location, only
2376 // its calls will be.
2377 auto localBuilder = std::make_unique<fir::FirOpBuilder>(
2378 function, builder.getKindMap(), builder.getMLIRSymbolTable());
2379 localBuilder->setFastMathFlags(builder.getFastMathFlags());
2380 localBuilder->setInsertionPointToStart(&function.front());
2381 // Location of code inside wrapper of the wrapper is independent from
2382 // the location of the intrinsic call.
2383 mlir::Location localLoc = localBuilder->getUnknownLoc();
2384 llvm::SmallVector<mlir::Value> localArguments;
2385 for (mlir::BlockArgument bArg : function.front().getArguments()) {
2386 auto refType = mlir::dyn_cast<fir::ReferenceType>(bArg.getType());
2387 if (loadRefArguments && refType) {
2388 auto loaded = localBuilder->create<fir::LoadOp>(localLoc, bArg);
2389 localArguments.push_back(loaded);
2390 } else {
2391 localArguments.push_back(bArg);
2392 }
2393 }
2394
2395 IntrinsicLibrary localLib{*localBuilder, localLoc};
2396
2397 if constexpr (std::is_same_v<GeneratorType, SubroutineGenerator>) {
2398 localLib.invokeGenerator(generator, localArguments);
2399 localBuilder->create<mlir::func::ReturnOp>(localLoc);
2400 } else {
2401 assert(funcType.getNumResults() == 1 &&
2402 "expect one result for intrinsic function wrapper type");
2403 mlir::Type resultType = funcType.getResult(0);
2404 auto result =
2405 localLib.invokeGenerator(generator, resultType, localArguments);
2406 localBuilder->create<mlir::func::ReturnOp>(localLoc, result);
2407 }
2408 } else {
2409 // Wrapper was already built, ensure it has the sought type
2410 assert(function.getFunctionType() == funcType &&
2411 "conflict between intrinsic wrapper types");
2412 }
2413 return function;
2414}
2415
2416/// Helpers to detect absent optional (not yet supported in outlining).
2417bool static hasAbsentOptional(llvm::ArrayRef<mlir::Value> args) {
2418 for (const mlir::Value &arg : args)
2419 if (!arg)
2420 return true;
2421 return false;
2422}
2423bool static hasAbsentOptional(llvm::ArrayRef<fir::ExtendedValue> args) {
2424 for (const fir::ExtendedValue &arg : args)
2425 if (!fir::getBase(arg))
2426 return true;
2427 return false;
2428}
2429
2430template <typename GeneratorType>
2431mlir::Value
2432IntrinsicLibrary::outlineInWrapper(GeneratorType generator,
2433 llvm::StringRef name, mlir::Type resultType,
2434 llvm::ArrayRef<mlir::Value> args) {
2435 if (hasAbsentOptional(args)) {
2436 // TODO: absent optional in outlining is an issue: we cannot just ignore
2437 // them. Needs a better interface here. The issue is that we cannot easily
2438 // tell that a value is optional or not here if it is presents. And if it is
2439 // absent, we cannot tell what it type should be.
2440 TODO(loc, "cannot outline call to intrinsic " + llvm::Twine(name) +
2441 " with absent optional argument");
2442 }
2443
2444 mlir::FunctionType funcType = getFunctionType(resultType, args, builder);
2445 std::string funcName{name};
2446 llvm::raw_string_ostream nameOS{funcName};
2447 if (std::string fmfString{builder.getFastMathFlagsString()};
2448 !fmfString.empty()) {
2449 nameOS << '.' << fmfString;
2450 }
2451 mlir::func::FuncOp wrapper = getWrapper(generator, funcName, funcType);
2452 return builder.create<fir::CallOp>(loc, wrapper, args).getResult(0);
2453}
2454
2455template <typename GeneratorType>
2456fir::ExtendedValue IntrinsicLibrary::outlineInExtendedWrapper(
2457 GeneratorType generator, llvm::StringRef name,
2458 std::optional<mlir::Type> resultType,
2459 llvm::ArrayRef<fir::ExtendedValue> args) {
2460 if (hasAbsentOptional(args))
2461 TODO(loc, "cannot outline call to intrinsic " + llvm::Twine(name) +
2462 " with absent optional argument");
2463 llvm::SmallVector<mlir::Value> mlirArgs;
2464 for (const auto &extendedVal : args)
2465 mlirArgs.emplace_back(toValue(extendedVal, builder, loc));
2466 mlir::FunctionType funcType = getFunctionType(resultType, mlirArgs, builder);
2467 mlir::func::FuncOp wrapper = getWrapper(generator, name, funcType);
2468 auto call = builder.create<fir::CallOp>(loc, wrapper, mlirArgs);
2469 if (resultType)
2470 return toExtendedValue(call.getResult(0), builder, loc);
2471 // Subroutine calls
2472 return mlir::Value{};
2473}
2474
2475static IntrinsicLibrary::RuntimeCallGenerator getRuntimeCallGeneratorHelper(
2476 const IntrinsicHandlerEntry::RuntimeGeneratorRange &range,
2477 mlir::FunctionType soughtFuncType, fir::FirOpBuilder &builder,
2478 mlir::Location loc) {
2479 assert(range.first != nullptr && "range should not be empty");
2480 llvm::StringRef name = range.first->key;
2481 // Look for a dedicated math operation generator, which
2482 // normally produces a single MLIR operation implementing
2483 // the math operation.
2484 const MathOperation *bestNearMatch = nullptr;
2485 FunctionDistance bestMatchDistance;
2486 const MathOperation *mathOp = searchMathOperation(
2487 builder, range, soughtFuncType, &bestNearMatch, bestMatchDistance);
2488 if (!mathOp && bestNearMatch) {
2489 // Use the best near match, optionally issuing an error,
2490 // if types conversions cause precision loss.
2491 checkPrecisionLoss(name, soughtFuncType, bestMatchDistance, builder, loc);
2492 mathOp = bestNearMatch;
2493 }
2494
2495 if (!mathOp) {
2496 std::string nameAndType;
2497 llvm::raw_string_ostream sstream(nameAndType);
2498 sstream << name << "\nrequested type: " << soughtFuncType;
2499 crashOnMissingIntrinsic(loc, intrinsicName: nameAndType);
2500 }
2501
2502 mlir::FunctionType actualFuncType =
2503 mathOp->typeGenerator(builder.getContext(), builder);
2504
2505 assert(actualFuncType.getNumResults() == soughtFuncType.getNumResults() &&
2506 actualFuncType.getNumInputs() == soughtFuncType.getNumInputs() &&
2507 actualFuncType.getNumResults() == 1 && "Bad intrinsic match");
2508
2509 return [actualFuncType, mathOp,
2510 soughtFuncType](fir::FirOpBuilder &builder, mlir::Location loc,
2511 llvm::ArrayRef<mlir::Value> args) {
2512 llvm::SmallVector<mlir::Value> convertedArguments;
2513 for (auto [fst, snd] : llvm::zip(actualFuncType.getInputs(), args))
2514 convertedArguments.push_back(builder.createConvert(loc, fst, snd));
2515 mlir::Value result = mathOp->funcGenerator(
2516 builder, loc, *mathOp, actualFuncType, convertedArguments);
2517 mlir::Type soughtType = soughtFuncType.getResult(i: 0);
2518 return builder.createConvert(loc, soughtType, result);
2519 };
2520}
2521
2522IntrinsicLibrary::RuntimeCallGenerator
2523IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name,
2524 mlir::FunctionType soughtFuncType) {
2525 bool isPPCTarget = fir::getTargetTriple(builder.getModule()).isPPC();
2526 std::optional<IntrinsicHandlerEntry::RuntimeGeneratorRange> range =
2527 lookupRuntimeGenerator(name, isPPCTarget);
2528 if (!range.has_value())
2529 crashOnMissingIntrinsic(loc, name);
2530 return getRuntimeCallGeneratorHelper(*range, soughtFuncType, builder, loc);
2531}
2532
2533mlir::SymbolRefAttr IntrinsicLibrary::getUnrestrictedIntrinsicSymbolRefAttr(
2534 llvm::StringRef name, mlir::FunctionType signature) {
2535 // Unrestricted intrinsics signature follows implicit rules: argument
2536 // are passed by references. But the runtime versions expect values.
2537 // So instead of duplicating the runtime, just have the wrappers loading
2538 // this before calling the code generators.
2539 bool loadRefArguments = true;
2540 mlir::func::FuncOp funcOp;
2541 if (const IntrinsicHandler *handler = findIntrinsicHandler(name))
2542 funcOp = Fortran::common::visit(
2543 [&](auto generator) {
2544 return getWrapper(generator, name, signature, loadRefArguments);
2545 },
2546 handler->generator);
2547
2548 if (!funcOp) {
2549 llvm::SmallVector<mlir::Type> argTypes;
2550 for (mlir::Type type : signature.getInputs()) {
2551 if (auto refType = mlir::dyn_cast<fir::ReferenceType>(type))
2552 argTypes.push_back(refType.getEleTy());
2553 else
2554 argTypes.push_back(type);
2555 }
2556 mlir::FunctionType soughtFuncType =
2557 builder.getFunctionType(argTypes, signature.getResults());
2558 IntrinsicLibrary::RuntimeCallGenerator rtCallGenerator =
2559 getRuntimeCallGenerator(name, soughtFuncType);
2560 funcOp = getWrapper(rtCallGenerator, name, signature, loadRefArguments);
2561 }
2562
2563 return mlir::SymbolRefAttr::get(funcOp);
2564}
2565
2566fir::ExtendedValue
2567IntrinsicLibrary::readAndAddCleanUp(fir::MutableBoxValue resultMutableBox,
2568 mlir::Type resultType,
2569 llvm::StringRef intrinsicName) {
2570 fir::ExtendedValue res =
2571 fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
2572 return res.match(
2573 [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
2574 setResultMustBeFreed();
2575 return box;
2576 },
2577 [&](const fir::BoxValue &box) -> fir::ExtendedValue {
2578 setResultMustBeFreed();
2579 return box;
2580 },
2581 [&](const fir::CharArrayBoxValue &box) -> fir::ExtendedValue {
2582 setResultMustBeFreed();
2583 return box;
2584 },
2585 [&](const mlir::Value &tempAddr) -> fir::ExtendedValue {
2586 auto load = builder.create<fir::LoadOp>(loc, resultType, tempAddr);
2587 // Temp can be freed right away since it was loaded.
2588 builder.create<fir::FreeMemOp>(loc, tempAddr);
2589 return load;
2590 },
2591 [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {
2592 setResultMustBeFreed();
2593 return box;
2594 },
2595 [&](const auto &) -> fir::ExtendedValue {
2596 fir::emitFatalError(loc, "unexpected result for " + intrinsicName);
2597 });
2598}
2599
2600//===----------------------------------------------------------------------===//
2601// Code generators for the intrinsic
2602//===----------------------------------------------------------------------===//
2603
2604mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name,
2605 mlir::Type resultType,
2606 llvm::ArrayRef<mlir::Value> args) {
2607 mlir::FunctionType soughtFuncType =
2608 getFunctionType(resultType, args, builder);
2609 return getRuntimeCallGenerator(name, soughtFuncType)(builder, loc, args);
2610}
2611
2612mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType,
2613 llvm::ArrayRef<mlir::Value> args) {
2614 // There can be an optional kind in second argument.
2615 assert(args.size() >= 1);
2616 return builder.convertWithSemantics(loc, resultType, args[0]);
2617}
2618
2619// ABORT
2620void IntrinsicLibrary::genAbort(llvm::ArrayRef<fir::ExtendedValue> args) {
2621 assert(args.size() == 0);
2622 fir::runtime::genAbort(builder, loc);
2623}
2624
2625// ABS
2626mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType,
2627 llvm::ArrayRef<mlir::Value> args) {
2628 assert(args.size() == 1);
2629 mlir::Value arg = args[0];
2630 mlir::Type type = arg.getType();
2631 if (fir::isa_real(type) || fir::isa_complex(type)) {
2632 // Runtime call to fp abs. An alternative would be to use mlir
2633 // math::AbsFOp but it does not support all fir floating point types.
2634 return genRuntimeCall("abs", resultType, args);
2635 }
2636 if (auto intType = mlir::dyn_cast<mlir::IntegerType>(type)) {
2637 // At the time of this implementation there is no abs op in mlir.
2638 // So, implement abs here without branching.
2639 mlir::Value shift =
2640 builder.createIntegerConstant(loc, intType, intType.getWidth() - 1);
2641 auto mask = builder.create<mlir::arith::ShRSIOp>(loc, arg, shift);
2642 auto xored = builder.create<mlir::arith::XOrIOp>(loc, arg, mask);
2643 return builder.create<mlir::arith::SubIOp>(loc, xored, mask);
2644 }
2645 llvm_unreachable("unexpected type in ABS argument");
2646}
2647
2648// ACOSD
2649mlir::Value IntrinsicLibrary::genAcosd(mlir::Type resultType,
2650 llvm::ArrayRef<mlir::Value> args) {
2651 // maps ACOSD to ACOS * 180 / pi
2652 assert(args.size() == 1);
2653 mlir::MLIRContext *context = builder.getContext();
2654 mlir::FunctionType ftype =
2655 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});
2656 mlir::Value result =
2657 getRuntimeCallGenerator("acos", ftype)(builder, loc, {args[0]});
2658 llvm::APFloat pi = llvm::APFloat(llvm::numbers::pi);
2659 mlir::Value dfactor = builder.createRealConstant(
2660 loc, mlir::Float64Type::get(context), llvm::APFloat(180.0) / pi);
2661 mlir::Value factor = builder.createConvert(loc, args[0].getType(), dfactor);
2662 return builder.create<mlir::arith::MulFOp>(loc, result, factor);
2663}
2664
2665// ADJUSTL & ADJUSTR
2666template <void (*CallRuntime)(fir::FirOpBuilder &, mlir::Location loc,
2667 mlir::Value, mlir::Value)>
2668fir::ExtendedValue
2669IntrinsicLibrary::genAdjustRtCall(mlir::Type resultType,
2670 llvm::ArrayRef<fir::ExtendedValue> args) {
2671 assert(args.size() == 1);
2672 mlir::Value string = builder.createBox(loc, args[0]);
2673 // Create a mutable fir.box to be passed to the runtime for the result.
2674 fir::MutableBoxValue resultMutableBox =
2675 fir::factory::createTempMutableBox(builder, loc, resultType);
2676 mlir::Value resultIrBox =
2677 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2678
2679 // Call the runtime -- the runtime will allocate the result.
2680 CallRuntime(builder, loc, resultIrBox, string);
2681 // Read result from mutable fir.box and add it to the list of temps to be
2682 // finalized by the StatementContext.
2683 return readAndAddCleanUp(resultMutableBox, resultType, "ADJUSTL or ADJUSTR");
2684}
2685
2686// AIMAG
2687mlir::Value IntrinsicLibrary::genAimag(mlir::Type resultType,
2688 llvm::ArrayRef<mlir::Value> args) {
2689 assert(args.size() == 1);
2690 return fir::factory::Complex{builder, loc}.extractComplexPart(
2691 args[0], /*isImagPart=*/true);
2692}
2693
2694// AINT
2695mlir::Value IntrinsicLibrary::genAint(mlir::Type resultType,
2696 llvm::ArrayRef<mlir::Value> args) {
2697 assert(args.size() >= 1 && args.size() <= 2);
2698 // Skip optional kind argument to search the runtime; it is already reflected
2699 // in result type.
2700 return genRuntimeCall("aint", resultType, {args[0]});
2701}
2702
2703// ALL
2704fir::ExtendedValue
2705IntrinsicLibrary::genAll(mlir::Type resultType,
2706 llvm::ArrayRef<fir::ExtendedValue> args) {
2707
2708 assert(args.size() == 2);
2709 // Handle required mask argument
2710 mlir::Value mask = builder.createBox(loc, args[0]);
2711
2712 fir::BoxValue maskArry = builder.createBox(loc, args[0]);
2713 int rank = maskArry.rank();
2714 assert(rank >= 1);
2715
2716 // Handle optional dim argument
2717 bool absentDim = isStaticallyAbsent(args[1]);
2718 mlir::Value dim =
2719 absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
2720 : fir::getBase(args[1]);
2721
2722 if (rank == 1 || absentDim)
2723 return builder.createConvert(loc, resultType,
2724 fir::runtime::genAll(builder, loc, mask, dim));
2725
2726 // else use the result descriptor AllDim() intrinsic
2727
2728 // Create mutable fir.box to be passed to the runtime for the result.
2729
2730 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
2731 fir::MutableBoxValue resultMutableBox =
2732 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2733 mlir::Value resultIrBox =
2734 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2735 // Call runtime. The runtime is allocating the result.
2736 fir::runtime::genAllDescriptor(builder, loc, resultIrBox, mask, dim);
2737 return readAndAddCleanUp(resultMutableBox, resultType, "ALL");
2738}
2739
2740// ALLOCATED
2741fir::ExtendedValue
2742IntrinsicLibrary::genAllocated(mlir::Type resultType,
2743 llvm::ArrayRef<fir::ExtendedValue> args) {
2744 assert(args.size() == 1);
2745 return args[0].match(
2746 [&](const fir::MutableBoxValue &x) -> fir::ExtendedValue {
2747 return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, x);
2748 },
2749 [&](const auto &) -> fir::ExtendedValue {
2750 fir::emitFatalError(loc,
2751 "allocated arg not lowered to MutableBoxValue");
2752 });
2753}
2754
2755// ANINT
2756mlir::Value IntrinsicLibrary::genAnint(mlir::Type resultType,
2757 llvm::ArrayRef<mlir::Value> args) {
2758 assert(args.size() >= 1 && args.size() <= 2);
2759 // Skip optional kind argument to search the runtime; it is already reflected
2760 // in result type.
2761 return genRuntimeCall("anint", resultType, {args[0]});
2762}
2763
2764// ANY
2765fir::ExtendedValue
2766IntrinsicLibrary::genAny(mlir::Type resultType,
2767 llvm::ArrayRef<fir::ExtendedValue> args) {
2768
2769 assert(args.size() == 2);
2770 // Handle required mask argument
2771 mlir::Value mask = builder.createBox(loc, args[0]);
2772
2773 fir::BoxValue maskArry = builder.createBox(loc, args[0]);
2774 int rank = maskArry.rank();
2775 assert(rank >= 1);
2776
2777 // Handle optional dim argument
2778 bool absentDim = isStaticallyAbsent(args[1]);
2779 mlir::Value dim =
2780 absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
2781 : fir::getBase(args[1]);
2782
2783 if (rank == 1 || absentDim)
2784 return builder.createConvert(loc, resultType,
2785 fir::runtime::genAny(builder, loc, mask, dim));
2786
2787 // else use the result descriptor AnyDim() intrinsic
2788
2789 // Create mutable fir.box to be passed to the runtime for the result.
2790
2791 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
2792 fir::MutableBoxValue resultMutableBox =
2793 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2794 mlir::Value resultIrBox =
2795 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2796 // Call runtime. The runtime is allocating the result.
2797 fir::runtime::genAnyDescriptor(builder, loc, resultIrBox, mask, dim);
2798 return readAndAddCleanUp(resultMutableBox, resultType, "ANY");
2799}
2800
2801// ASIND
2802mlir::Value IntrinsicLibrary::genAsind(mlir::Type resultType,
2803 llvm::ArrayRef<mlir::Value> args) {
2804 // maps ASIND to ASIN * 180 / pi
2805 assert(args.size() == 1);
2806 mlir::MLIRContext *context = builder.getContext();
2807 mlir::FunctionType ftype =
2808 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});
2809 mlir::Value result =
2810 getRuntimeCallGenerator("asin", ftype)(builder, loc, {args[0]});
2811 llvm::APFloat pi = llvm::APFloat(llvm::numbers::pi);
2812 mlir::Value dfactor = builder.createRealConstant(
2813 loc, mlir::Float64Type::get(context), llvm::APFloat(180.0) / pi);
2814 mlir::Value factor = builder.createConvert(loc, args[0].getType(), dfactor);
2815 return builder.create<mlir::arith::MulFOp>(loc, result, factor);
2816}
2817
2818// ATAND, ATAN2D
2819mlir::Value IntrinsicLibrary::genAtand(mlir::Type resultType,
2820 llvm::ArrayRef<mlir::Value> args) {
2821 // assert for: atand(X), atand(Y,X), atan2d(Y,X)
2822 assert(args.size() >= 1 && args.size() <= 2);
2823
2824 mlir::MLIRContext *context = builder.getContext();
2825 mlir::Value atan;
2826
2827 // atand = atan * 180/pi
2828 if (args.size() == 2) {
2829 atan = builder.create<mlir::math::Atan2Op>(loc, fir::getBase(args[0]),
2830 fir::getBase(args[1]));
2831 } else {
2832 mlir::FunctionType ftype =
2833 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});
2834 atan = getRuntimeCallGenerator("atan", ftype)(builder, loc, args);
2835 }
2836 llvm::APFloat pi = llvm::APFloat(llvm::numbers::pi);
2837 mlir::Value dfactor = builder.createRealConstant(
2838 loc, mlir::Float64Type::get(context), llvm::APFloat(180.0) / pi);
2839 mlir::Value factor = builder.createConvert(loc, resultType, dfactor);
2840 return builder.create<mlir::arith::MulFOp>(loc, atan, factor);
2841}
2842
2843// ATANPI, ATAN2PI
2844mlir::Value IntrinsicLibrary::genAtanpi(mlir::Type resultType,
2845 llvm::ArrayRef<mlir::Value> args) {
2846 // assert for: atanpi(X), atanpi(Y,X), atan2pi(Y,X)
2847 assert(args.size() >= 1 && args.size() <= 2);
2848
2849 mlir::Value atan;
2850 mlir::MLIRContext *context = builder.getContext();
2851
2852 // atanpi = atan / pi
2853 if (args.size() == 2) {
2854 atan = builder.create<mlir::math::Atan2Op>(loc, fir::getBase(args[0]),
2855 fir::getBase(args[1]));
2856 } else {
2857 mlir::FunctionType ftype =
2858 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});
2859 atan = getRuntimeCallGenerator("atan", ftype)(builder, loc, args);
2860 }
2861 llvm::APFloat inv_pi = llvm::APFloat(llvm::numbers::inv_pi);
2862 mlir::Value dfactor =
2863 builder.createRealConstant(loc, mlir::Float64Type::get(context), inv_pi);
2864 mlir::Value factor = builder.createConvert(loc, resultType, dfactor);
2865 return builder.create<mlir::arith::MulFOp>(loc, atan, factor);
2866}
2867
2868static mlir::Value genAtomBinOp(fir::FirOpBuilder &builder, mlir::Location &loc,
2869 mlir::LLVM::AtomicBinOp binOp, mlir::Value arg0,
2870 mlir::Value arg1) {
2871 auto llvmPointerType = mlir::LLVM::LLVMPointerType::get(context: builder.getContext());
2872 arg0 = builder.createConvert(loc, llvmPointerType, arg0);
2873 return builder.create<mlir::LLVM::AtomicRMWOp>(
2874 loc, binOp, arg0, arg1, mlir::LLVM::AtomicOrdering::seq_cst);
2875}
2876
2877mlir::Value IntrinsicLibrary::genAtomicAdd(mlir::Type resultType,
2878 llvm::ArrayRef<mlir::Value> args) {
2879 assert(args.size() == 2);
2880
2881 mlir::LLVM::AtomicBinOp binOp =
2882 mlir::isa<mlir::IntegerType>(args[1].getType())
2883 ? mlir::LLVM::AtomicBinOp::add
2884 : mlir::LLVM::AtomicBinOp::fadd;
2885 return genAtomBinOp(builder, loc, binOp, args[0], args[1]);
2886}
2887
2888mlir::Value IntrinsicLibrary::genAtomicSub(mlir::Type resultType,
2889 llvm::ArrayRef<mlir::Value> args) {
2890 assert(args.size() == 2);
2891
2892 mlir::LLVM::AtomicBinOp binOp =
2893 mlir::isa<mlir::IntegerType>(args[1].getType())
2894 ? mlir::LLVM::AtomicBinOp::sub
2895 : mlir::LLVM::AtomicBinOp::fsub;
2896 return genAtomBinOp(builder, loc, binOp, args[0], args[1]);
2897}
2898
2899mlir::Value IntrinsicLibrary::genAtomicAnd(mlir::Type resultType,
2900 llvm::ArrayRef<mlir::Value> args) {
2901 assert(args.size() == 2);
2902 assert(mlir::isa<mlir::IntegerType>(args[1].getType()));
2903
2904 mlir::LLVM::AtomicBinOp binOp = mlir::LLVM::AtomicBinOp::_and;
2905 return genAtomBinOp(builder, loc, binOp, args[0], args[1]);
2906}
2907
2908mlir::Value IntrinsicLibrary::genAtomicOr(mlir::Type resultType,
2909 llvm::ArrayRef<mlir::Value> args) {
2910 assert(args.size() == 2);
2911 assert(mlir::isa<mlir::IntegerType>(args[1].getType()));
2912
2913 mlir::LLVM::AtomicBinOp binOp = mlir::LLVM::AtomicBinOp::_or;
2914 return genAtomBinOp(builder, loc, binOp, args[0], args[1]);
2915}
2916
2917// ATOMICCAS
2918fir::ExtendedValue
2919IntrinsicLibrary::genAtomicCas(mlir::Type resultType,
2920 llvm::ArrayRef<fir::ExtendedValue> args) {
2921 assert(args.size() == 3);
2922 auto successOrdering = mlir::LLVM::AtomicOrdering::acq_rel;
2923 auto failureOrdering = mlir::LLVM::AtomicOrdering::monotonic;
2924 auto llvmPtrTy = mlir::LLVM::LLVMPointerType::get(resultType.getContext());
2925
2926 mlir::Value arg0 = fir::getBase(args[0]);
2927 mlir::Value arg1 = fir::getBase(args[1]);
2928 mlir::Value arg2 = fir::getBase(args[2]);
2929
2930 auto bitCastFloat = [&](mlir::Value arg) -> mlir::Value {
2931 if (mlir::isa<mlir::Float32Type>(arg.getType()))
2932 return builder.create<mlir::LLVM::BitcastOp>(loc, builder.getI32Type(),
2933 arg);
2934 if (mlir::isa<mlir::Float64Type>(arg.getType()))
2935 return builder.create<mlir::LLVM::BitcastOp>(loc, builder.getI64Type(),
2936 arg);
2937 return arg;
2938 };
2939
2940 arg1 = bitCastFloat(arg1);
2941 arg2 = bitCastFloat(arg2);
2942
2943 if (arg1.getType() != arg2.getType()) {
2944 // arg1 and arg2 need to have the same type in AtomicCmpXchgOp.
2945 arg2 = builder.createConvert(loc, arg1.getType(), arg2);
2946 }
2947
2948 auto address =
2949 builder.create<mlir::UnrealizedConversionCastOp>(loc, llvmPtrTy, arg0)
2950 .getResult(0);
2951 auto cmpxchg = builder.create<mlir::LLVM::AtomicCmpXchgOp>(
2952 loc, address, arg1, arg2, successOrdering, failureOrdering);
2953 return builder.create<mlir::LLVM::ExtractValueOp>(loc, cmpxchg, 1);
2954}
2955
2956mlir::Value IntrinsicLibrary::genAtomicDec(mlir::Type resultType,
2957 llvm::ArrayRef<mlir::Value> args) {
2958 assert(args.size() == 2);
2959 assert(mlir::isa<mlir::IntegerType>(args[1].getType()));
2960
2961 mlir::LLVM::AtomicBinOp binOp = mlir::LLVM::AtomicBinOp::udec_wrap;
2962 return genAtomBinOp(builder, loc, binOp, args[0], args[1]);
2963}
2964
2965// ATOMICEXCH
2966fir::ExtendedValue
2967IntrinsicLibrary::genAtomicExch(mlir::Type resultType,
2968 llvm::ArrayRef<fir::ExtendedValue> args) {
2969 assert(args.size() == 2);
2970 mlir::Value arg0 = fir::getBase(args[0]);
2971 mlir::Value arg1 = fir::getBase(args[1]);
2972 assert(arg1.getType().isIntOrFloat());
2973
2974 mlir::LLVM::AtomicBinOp binOp = mlir::LLVM::AtomicBinOp::xchg;
2975 return genAtomBinOp(builder, loc, binOp, arg0, arg1);
2976}
2977
2978mlir::Value IntrinsicLibrary::genAtomicInc(mlir::Type resultType,
2979 llvm::ArrayRef<mlir::Value> args) {
2980 assert(args.size() == 2);
2981 assert(mlir::isa<mlir::IntegerType>(args[1].getType()));
2982
2983 mlir::LLVM::AtomicBinOp binOp = mlir::LLVM::AtomicBinOp::uinc_wrap;
2984 return genAtomBinOp(builder, loc, binOp, args[0], args[1]);
2985}
2986
2987mlir::Value IntrinsicLibrary::genAtomicMax(mlir::Type resultType,
2988 llvm::ArrayRef<mlir::Value> args) {
2989 assert(args.size() == 2);
2990
2991 mlir::LLVM::AtomicBinOp binOp =
2992 mlir::isa<mlir::IntegerType>(args[1].getType())
2993 ? mlir::LLVM::AtomicBinOp::max
2994 : mlir::LLVM::AtomicBinOp::fmax;
2995 return genAtomBinOp(builder, loc, binOp, args[0], args[1]);
2996}
2997
2998mlir::Value IntrinsicLibrary::genAtomicMin(mlir::Type resultType,
2999 llvm::ArrayRef<mlir::Value> args) {
3000 assert(args.size() == 2);
3001
3002 mlir::LLVM::AtomicBinOp binOp =
3003 mlir::isa<mlir::IntegerType>(args[1].getType())
3004 ? mlir::LLVM::AtomicBinOp::min
3005 : mlir::LLVM::AtomicBinOp::fmin;
3006 return genAtomBinOp(builder, loc, binOp, args[0], args[1]);
3007}
3008
3009// ATOMICXOR
3010fir::ExtendedValue
3011IntrinsicLibrary::genAtomicXor(mlir::Type resultType,
3012 llvm::ArrayRef<fir::ExtendedValue> args) {
3013 assert(args.size() == 2);
3014 mlir::Value arg0 = fir::getBase(args[0]);
3015 mlir::Value arg1 = fir::getBase(args[1]);
3016 return genAtomBinOp(builder, loc, mlir::LLVM::AtomicBinOp::_xor, arg0, arg1);
3017}
3018
3019// ASSOCIATED
3020fir::ExtendedValue
3021IntrinsicLibrary::genAssociated(mlir::Type resultType,
3022 llvm::ArrayRef<fir::ExtendedValue> args) {
3023 assert(args.size() == 2);
3024 mlir::Type ptrTy = fir::getBase(args[0]).getType();
3025 if (ptrTy && (fir::isBoxProcAddressType(ptrTy) ||
3026 mlir::isa<fir::BoxProcType>(ptrTy))) {
3027 mlir::Value pointerBoxProc =
3028 fir::isBoxProcAddressType(ptrTy)
3029 ? builder.create<fir::LoadOp>(loc, fir::getBase(args[0]))
3030 : fir::getBase(args[0]);
3031 mlir::Value pointerTarget =
3032 builder.create<fir::BoxAddrOp>(loc, pointerBoxProc);
3033 if (isStaticallyAbsent(args[1]))
3034 return builder.genIsNotNullAddr(loc, pointerTarget);
3035 mlir::Value target = fir::getBase(args[1]);
3036 if (fir::isBoxProcAddressType(target.getType()))
3037 target = builder.create<fir::LoadOp>(loc, target);
3038 if (mlir::isa<fir::BoxProcType>(target.getType()))
3039 target = builder.create<fir::BoxAddrOp>(loc, target);
3040 mlir::Type intPtrTy = builder.getIntPtrType();
3041 mlir::Value pointerInt =
3042 builder.createConvert(loc, intPtrTy, pointerTarget);
3043 mlir::Value targetInt = builder.createConvert(loc, intPtrTy, target);
3044 mlir::Value sameTarget = builder.create<mlir::arith::CmpIOp>(
3045 loc, mlir::arith::CmpIPredicate::eq, pointerInt, targetInt);
3046 mlir::Value zero = builder.createIntegerConstant(loc, intPtrTy, 0);
3047 mlir::Value notNull = builder.create<mlir::arith::CmpIOp>(
3048 loc, mlir::arith::CmpIPredicate::ne, zero, pointerInt);
3049 // The not notNull test covers the following two cases:
3050 // - TARGET is a procedure that is OPTIONAL and absent at runtime.
3051 // - TARGET is a procedure pointer that is NULL.
3052 // In both cases, ASSOCIATED should be false if POINTER is NULL.
3053 return builder.create<mlir::arith::AndIOp>(loc, sameTarget, notNull);
3054 }
3055 auto *pointer =
3056 args[0].match([&](const fir::MutableBoxValue &x) { return &x; },
3057 [&](const auto &) -> const fir::MutableBoxValue * {
3058 fir::emitFatalError(loc, "pointer not a MutableBoxValue");
3059 });
3060 const fir::ExtendedValue &target = args[1];
3061 if (isStaticallyAbsent(target))
3062 return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, *pointer);
3063 mlir::Value targetBox = builder.createBox(loc, target);
3064 mlir::Value pointerBoxRef =
3065 fir::factory::getMutableIRBox(builder, loc, *pointer);
3066 auto pointerBox = builder.create<fir::LoadOp>(loc, pointerBoxRef);
3067 return fir::runtime::genAssociated(builder, loc, pointerBox, targetBox);
3068}
3069
3070// BESSEL_JN
3071fir::ExtendedValue
3072IntrinsicLibrary::genBesselJn(mlir::Type resultType,
3073 llvm::ArrayRef<fir::ExtendedValue> args) {
3074 assert(args.size() == 2 || args.size() == 3);
3075
3076 mlir::Value x = fir::getBase(args.back());
3077
3078 if (args.size() == 2) {
3079 mlir::Value n = fir::getBase(args[0]);
3080
3081 return genRuntimeCall("bessel_jn", resultType, {n, x});
3082 } else {
3083 mlir::Value n1 = fir::getBase(args[0]);
3084 mlir::Value n2 = fir::getBase(args[1]);
3085
3086 mlir::Type intTy = n1.getType();
3087 mlir::Type floatTy = x.getType();
3088 mlir::Value zero = builder.createRealZeroConstant(loc, floatTy);
3089 mlir::Value one = builder.createIntegerConstant(loc, intTy, 1);
3090
3091 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 1);
3092 fir::MutableBoxValue resultMutableBox =
3093 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
3094 mlir::Value resultBox =
3095 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3096
3097 mlir::Value cmpXEq0 = builder.create<mlir::arith::CmpFOp>(
3098 loc, mlir::arith::CmpFPredicate::UEQ, x, zero);
3099 mlir::Value cmpN1LtN2 = builder.create<mlir::arith::CmpIOp>(
3100 loc, mlir::arith::CmpIPredicate::slt, n1, n2);
3101 mlir::Value cmpN1EqN2 = builder.create<mlir::arith::CmpIOp>(
3102 loc, mlir::arith::CmpIPredicate::eq, n1, n2);
3103
3104 auto genXEq0 = [&]() {
3105 fir::runtime::genBesselJnX0(builder, loc, floatTy, resultBox, n1, n2);
3106 };
3107
3108 auto genN1LtN2 = [&]() {
3109 // The runtime generates the values in the range using a backward
3110 // recursion from n2 to n1. (see https://dlmf.nist.gov/10.74.iv and
3111 // https://dlmf.nist.gov/10.6.E1). When n1 < n2, this requires
3112 // the values of BESSEL_JN(n2) and BESSEL_JN(n2 - 1) since they
3113 // are the anchors of the recursion.
3114 mlir::Value n2_1 = builder.create<mlir::arith::SubIOp>(loc, n2, one);
3115 mlir::Value bn2 = genRuntimeCall("bessel_jn", resultType, {n2, x});
3116 mlir::Value bn2_1 = genRuntimeCall("bessel_jn", resultType, {n2_1, x});
3117 fir::runtime::genBesselJn(builder, loc, resultBox, n1, n2, x, bn2, bn2_1);
3118 };
3119
3120 auto genN1EqN2 = [&]() {
3121 // When n1 == n2, only BESSEL_JN(n2) is needed.
3122 mlir::Value bn2 = genRuntimeCall("bessel_jn", resultType, {n2, x});
3123 fir::runtime::genBesselJn(builder, loc, resultBox, n1, n2, x, bn2, zero);
3124 };
3125
3126 auto genN1GtN2 = [&]() {
3127 // The standard requires n1 <= n2. However, we still need to allocate
3128 // a zero-length array and return it when n1 > n2, so we do need to call
3129 // the runtime function.
3130 fir::runtime::genBesselJn(builder, loc, resultBox, n1, n2, x, zero, zero);
3131 };
3132
3133 auto genN1GeN2 = [&] {
3134 builder.genIfThenElse(loc, cmpN1EqN2)
3135 .genThen(genN1EqN2)
3136 .genElse(genN1GtN2)
3137 .end();
3138 };
3139
3140 auto genXNeq0 = [&]() {
3141 builder.genIfThenElse(loc, cmpN1LtN2)
3142 .genThen(genN1LtN2)
3143 .genElse(genN1GeN2)
3144 .end();
3145 };
3146
3147 builder.genIfThenElse(loc, cmpXEq0)
3148 .genThen(genXEq0)
3149 .genElse(genXNeq0)
3150 .end();
3151 return readAndAddCleanUp(resultMutableBox, resultType, "BESSEL_JN");
3152 }
3153}
3154
3155// BESSEL_YN
3156fir::ExtendedValue
3157IntrinsicLibrary::genBesselYn(mlir::Type resultType,
3158 llvm::ArrayRef<fir::ExtendedValue> args) {
3159 assert(args.size() == 2 || args.size() == 3);
3160
3161 mlir::Value x = fir::getBase(args.back());
3162
3163 if (args.size() == 2) {
3164 mlir::Value n = fir::getBase(args[0]);
3165
3166 return genRuntimeCall("bessel_yn", resultType, {n, x});
3167 } else {
3168 mlir::Value n1 = fir::getBase(args[0]);
3169 mlir::Value n2 = fir::getBase(args[1]);
3170
3171 mlir::Type floatTy = x.getType();
3172 mlir::Type intTy = n1.getType();
3173 mlir::Value zero = builder.createRealZeroConstant(loc, floatTy);
3174 mlir::Value one = builder.createIntegerConstant(loc, intTy, 1);
3175
3176 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 1);
3177 fir::MutableBoxValue resultMutableBox =
3178 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
3179 mlir::Value resultBox =
3180 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3181
3182 mlir::Value cmpXEq0 = builder.create<mlir::arith::CmpFOp>(
3183 loc, mlir::arith::CmpFPredicate::UEQ, x, zero);
3184 mlir::Value cmpN1LtN2 = builder.create<mlir::arith::CmpIOp>(
3185 loc, mlir::arith::CmpIPredicate::slt, n1, n2);
3186 mlir::Value cmpN1EqN2 = builder.create<mlir::arith::CmpIOp>(
3187 loc, mlir::arith::CmpIPredicate::eq, n1, n2);
3188
3189 auto genXEq0 = [&]() {
3190 fir::runtime::genBesselYnX0(builder, loc, floatTy, resultBox, n1, n2);
3191 };
3192
3193 auto genN1LtN2 = [&]() {
3194 // The runtime generates the values in the range using a forward
3195 // recursion from n1 to n2. (see https://dlmf.nist.gov/10.74.iv and
3196 // https://dlmf.nist.gov/10.6.E1). When n1 < n2, this requires
3197 // the values of BESSEL_YN(n1) and BESSEL_YN(n1 + 1) since they
3198 // are the anchors of the recursion.
3199 mlir::Value n1_1 = builder.create<mlir::arith::AddIOp>(loc, n1, one);
3200 mlir::Value bn1 = genRuntimeCall("bessel_yn", resultType, {n1, x});
3201 mlir::Value bn1_1 = genRuntimeCall("bessel_yn", resultType, {n1_1, x});
3202 fir::runtime::genBesselYn(builder, loc, resultBox, n1, n2, x, bn1, bn1_1);
3203 };
3204
3205 auto genN1EqN2 = [&]() {
3206 // When n1 == n2, only BESSEL_YN(n1) is needed.
3207 mlir::Value bn1 = genRuntimeCall("bessel_yn", resultType, {n1, x});
3208 fir::runtime::genBesselYn(builder, loc, resultBox, n1, n2, x, bn1, zero);
3209 };
3210
3211 auto genN1GtN2 = [&]() {
3212 // The standard requires n1 <= n2. However, we still need to allocate
3213 // a zero-length array and return it when n1 > n2, so we do need to call
3214 // the runtime function.
3215 fir::runtime::genBesselYn(builder, loc, resultBox, n1, n2, x, zero, zero);
3216 };
3217
3218 auto genN1GeN2 = [&] {
3219 builder.genIfThenElse(loc, cmpN1EqN2)
3220 .genThen(genN1EqN2)
3221 .genElse(genN1GtN2)
3222 .end();
3223 };
3224
3225 auto genXNeq0 = [&]() {
3226 builder.genIfThenElse(loc, cmpN1LtN2)
3227 .genThen(genN1LtN2)
3228 .genElse(genN1GeN2)
3229 .end();
3230 };
3231
3232 builder.genIfThenElse(loc, cmpXEq0)
3233 .genThen(genXEq0)
3234 .genElse(genXNeq0)
3235 .end();
3236 return readAndAddCleanUp(resultMutableBox, resultType, "BESSEL_YN");
3237 }
3238}
3239
3240// BGE, BGT, BLE, BLT
3241template <mlir::arith::CmpIPredicate pred>
3242mlir::Value
3243IntrinsicLibrary::genBitwiseCompare(mlir::Type resultType,
3244 llvm::ArrayRef<mlir::Value> args) {
3245 assert(args.size() == 2);
3246
3247 mlir::Value arg0 = args[0];
3248 mlir::Value arg1 = args[1];
3249 mlir::Type arg0Ty = arg0.getType();
3250 mlir::Type arg1Ty = arg1.getType();
3251 int bits0 = arg0Ty.getIntOrFloatBitWidth();
3252 int bits1 = arg1Ty.getIntOrFloatBitWidth();
3253
3254 // Arguments do not have to be of the same integer type. However, if neither
3255 // of the arguments is a BOZ literal, then the shorter of the two needs
3256 // to be converted to the longer by zero-extending (not sign-extending)
3257 // to the left [Fortran 2008, 13.3.2].
3258 //
3259 // In the case of BOZ literals, the standard describes zero-extension or
3260 // truncation depending on the kind of the result [Fortran 2008, 13.3.3].
3261 // However, that seems to be relevant for the case where the type of the
3262 // result must match the type of the BOZ literal. That is not the case for
3263 // these intrinsics, so, again, zero-extend to the larger type.
3264 int widest = bits0 > bits1 ? bits0 : bits1;
3265 mlir::Type signlessType =
3266 mlir::IntegerType::get(builder.getContext(), widest,
3267 mlir::IntegerType::SignednessSemantics::Signless);
3268 if (arg0Ty.isUnsignedInteger())
3269 arg0 = builder.createConvert(loc, signlessType, arg0);
3270 else if (bits0 < widest)
3271 arg0 = builder.create<mlir::arith::ExtUIOp>(loc, signlessType, arg0);
3272 if (arg1Ty.isUnsignedInteger())
3273 arg1 = builder.createConvert(loc, signlessType, arg1);
3274 else if (bits1 < widest)
3275 arg1 = builder.create<mlir::arith::ExtUIOp>(loc, signlessType, arg1);
3276 return builder.create<mlir::arith::CmpIOp>(loc, pred, arg0, arg1);
3277}
3278
3279// BTEST
3280mlir::Value IntrinsicLibrary::genBtest(mlir::Type resultType,
3281 llvm::ArrayRef<mlir::Value> args) {
3282 // A conformant BTEST(I,POS) call satisfies:
3283 // POS >= 0
3284 // POS < BIT_SIZE(I)
3285 // Return: (I >> POS) & 1
3286 assert(args.size() == 2);
3287 mlir::Value word = args[0];
3288 mlir::Type signlessType = mlir::IntegerType::get(
3289 builder.getContext(), word.getType().getIntOrFloatBitWidth(),
3290 mlir::IntegerType::SignednessSemantics::Signless);
3291 if (word.getType().isUnsignedInteger())
3292 word = builder.createConvert(loc, signlessType, word);
3293 mlir::Value shiftCount = builder.createConvert(loc, signlessType, args[1]);
3294 mlir::Value shifted =
3295 builder.create<mlir::arith::ShRUIOp>(loc, word, shiftCount);
3296 mlir::Value one = builder.createIntegerConstant(loc, signlessType, 1);
3297 mlir::Value bit = builder.create<mlir::arith::AndIOp>(loc, shifted, one);
3298 return builder.createConvert(loc, resultType, bit);
3299}
3300
3301static mlir::Value getAddrFromBox(fir::FirOpBuilder &builder,
3302 mlir::Location loc, fir::ExtendedValue arg,
3303 bool isFunc) {
3304 mlir::Value argValue = fir::getBase(arg);
3305 mlir::Value addr{nullptr};
3306 if (isFunc) {
3307 auto funcTy = mlir::cast<fir::BoxProcType>(argValue.getType()).getEleTy();
3308 addr = builder.create<fir::BoxAddrOp>(loc, funcTy, argValue);
3309 } else {
3310 const auto *box = arg.getBoxOf<fir::BoxValue>();
3311 addr = builder.create<fir::BoxAddrOp>(loc, box->getMemTy(),
3312 fir::getBase(*box));
3313 }
3314 return addr;
3315}
3316
3317static fir::ExtendedValue
3318genCLocOrCFunLoc(fir::FirOpBuilder &builder, mlir::Location loc,
3319 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args,
3320 bool isFunc = false, bool isDevLoc = false) {
3321 assert(args.size() == 1);
3322 mlir::Value res = builder.create<fir::AllocaOp>(loc, resultType);
3323 mlir::Value resAddr;
3324 if (isDevLoc)
3325 resAddr = fir::factory::genCDevPtrAddr(builder, loc, res, resultType);
3326 else
3327 resAddr = fir::factory::genCPtrOrCFunptrAddr(builder, loc, res, resultType);
3328 assert(fir::isa_box_type(fir::getBase(args[0]).getType()) &&
3329 "argument must have been lowered to box type");
3330 mlir::Value argAddr = getAddrFromBox(builder, loc, args[0], isFunc);
3331 mlir::Value argAddrVal = builder.createConvert(
3332 loc, fir::unwrapRefType(resAddr.getType()), argAddr);
3333 builder.create<fir::StoreOp>(loc, argAddrVal, resAddr);
3334 return res;
3335}
3336
3337/// C_ASSOCIATED
3338static fir::ExtendedValue
3339genCAssociated(fir::FirOpBuilder &builder, mlir::Location loc,
3340 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {
3341 assert(args.size() == 2);
3342 mlir::Value cPtr1 = fir::getBase(args[0]);
3343 mlir::Value cPtrVal1 =
3344 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr1);
3345 mlir::Value zero = builder.createIntegerConstant(loc, cPtrVal1.getType(), 0);
3346 mlir::Value res = builder.create<mlir::arith::CmpIOp>(
3347 loc, mlir::arith::CmpIPredicate::ne, cPtrVal1, zero);
3348
3349 if (isStaticallyPresent(args[1])) {
3350 mlir::Type i1Ty = builder.getI1Type();
3351 mlir::Value cPtr2 = fir::getBase(args[1]);
3352 mlir::Value isDynamicallyAbsent = builder.genIsNullAddr(loc, cPtr2);
3353 res =
3354 builder
3355 .genIfOp(loc, {i1Ty}, isDynamicallyAbsent, /*withElseRegion=*/true)
3356 .genThen([&]() { builder.create<fir::ResultOp>(loc, res); })
3357 .genElse([&]() {
3358 mlir::Value cPtrVal2 =
3359 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr2);
3360 mlir::Value cmpVal = builder.create<mlir::arith::CmpIOp>(
3361 loc, mlir::arith::CmpIPredicate::eq, cPtrVal1, cPtrVal2);
3362 mlir::Value newRes =
3363 builder.create<mlir::arith::AndIOp>(loc, res, cmpVal);
3364 builder.create<fir::ResultOp>(loc, newRes);
3365 })
3366 .getResults()[0];
3367 }
3368 return builder.createConvert(loc, resultType, res);
3369}
3370
3371/// C_ASSOCIATED (C_FUNPTR [, C_FUNPTR])
3372fir::ExtendedValue IntrinsicLibrary::genCAssociatedCFunPtr(
3373 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {
3374 return genCAssociated(builder, loc, resultType, args);
3375}
3376
3377/// C_ASSOCIATED (C_PTR [, C_PTR])
3378fir::ExtendedValue
3379IntrinsicLibrary::genCAssociatedCPtr(mlir::Type resultType,
3380 llvm::ArrayRef<fir::ExtendedValue> args) {
3381 return genCAssociated(builder, loc, resultType, args);
3382}
3383
3384// C_DEVLOC
3385fir::ExtendedValue
3386IntrinsicLibrary::genCDevLoc(mlir::Type resultType,
3387 llvm::ArrayRef<fir::ExtendedValue> args) {
3388 return genCLocOrCFunLoc(builder, loc, resultType, args, /*isFunc=*/false,
3389 /*isDevLoc=*/true);
3390}
3391
3392// C_F_POINTER
3393void IntrinsicLibrary::genCFPointer(llvm::ArrayRef<fir::ExtendedValue> args) {
3394 assert(args.size() == 3);
3395 // Handle CPTR argument
3396 // Get the value of the C address or the result of a reference to C_LOC.
3397 mlir::Value cPtr = fir::getBase(args[0]);
3398 mlir::Value cPtrAddrVal =
3399 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr);
3400
3401 // Handle FPTR argument
3402 const auto *fPtr = args[1].getBoxOf<fir::MutableBoxValue>();
3403 assert(fPtr && "FPTR must be a pointer");
3404
3405 auto getCPtrExtVal = [&](fir::MutableBoxValue box) -> fir::ExtendedValue {
3406 mlir::Value addr =
3407 builder.createConvert(loc, fPtr->getMemTy(), cPtrAddrVal);
3408 mlir::SmallVector<mlir::Value> extents;
3409 if (box.hasRank()) {
3410 assert(isStaticallyPresent(args[2]) &&
3411 "FPTR argument must be an array if SHAPE argument exists");
3412 mlir::Value shape = fir::getBase(args[2]);
3413 int arrayRank = box.rank();
3414 mlir::Type shapeElementType =
3415 fir::unwrapSequenceType(fir::unwrapPassByRefType(shape.getType()));
3416 mlir::Type idxType = builder.getIndexType();
3417 for (int i = 0; i < arrayRank; ++i) {
3418 mlir::Value index = builder.createIntegerConstant(loc, idxType, i);
3419 mlir::Value var = builder.create<fir::CoordinateOp>(
3420 loc, builder.getRefType(shapeElementType), shape, index);
3421 mlir::Value load = builder.create<fir::LoadOp>(loc, var);
3422 extents.push_back(builder.createConvert(loc, idxType, load));
3423 }
3424 }
3425 if (box.isCharacter()) {
3426 mlir::Value len = box.nonDeferredLenParams()[0];
3427 if (box.hasRank())
3428 return fir::CharArrayBoxValue{addr, len, extents};
3429 return fir::CharBoxValue{addr, len};
3430 }
3431 if (box.isDerivedWithLenParameters())
3432 TODO(loc, "get length parameters of derived type");
3433 if (box.hasRank())
3434 return fir::ArrayBoxValue{addr, extents};
3435 return addr;
3436 };
3437
3438 fir::factory::associateMutableBox(builder, loc, *fPtr, getCPtrExtVal(*fPtr),
3439 /*lbounds=*/mlir::ValueRange{});
3440
3441 // If the pointer is a registered CUDA fortran variable, the descriptor needs
3442 // to be synced.
3443 if (auto declare = mlir::dyn_cast_or_null<hlfir::DeclareOp>(
3444 fPtr->getAddr().getDefiningOp()))
3445 if (declare.getMemref().getDefiningOp() &&
3446 mlir::isa<fir::AddrOfOp>(declare.getMemref().getDefiningOp()))
3447 if (cuf::isRegisteredDeviceAttr(declare.getDataAttr()) &&
3448 !cuf::isCUDADeviceContext(builder.getRegion()))
3449 fir::runtime::cuda::genSyncGlobalDescriptor(builder, loc,
3450 declare.getMemref());
3451}
3452
3453// C_F_PROCPOINTER
3454void IntrinsicLibrary::genCFProcPointer(
3455 llvm::ArrayRef<fir::ExtendedValue> args) {
3456 assert(args.size() == 2);
3457 mlir::Value cptr =
3458 fir::factory::genCPtrOrCFunptrValue(builder, loc, fir::getBase(args[0]));
3459 mlir::Value fptr = fir::getBase(args[1]);
3460 auto boxProcType =
3461 mlir::cast<fir::BoxProcType>(fir::unwrapRefType(fptr.getType()));
3462 mlir::Value cptrCast =
3463 builder.createConvert(loc, boxProcType.getEleTy(), cptr);
3464 mlir::Value cptrBox =
3465 builder.create<fir::EmboxProcOp>(loc, boxProcType, cptrCast);
3466 builder.create<fir::StoreOp>(loc, cptrBox, fptr);
3467}
3468
3469// C_FUNLOC
3470fir::ExtendedValue
3471IntrinsicLibrary::genCFunLoc(mlir::Type resultType,
3472 llvm::ArrayRef<fir::ExtendedValue> args) {
3473 return genCLocOrCFunLoc(builder, loc, resultType, args, /*isFunc=*/true);
3474}
3475
3476// C_LOC
3477fir::ExtendedValue
3478IntrinsicLibrary::genCLoc(mlir::Type resultType,
3479 llvm::ArrayRef<fir::ExtendedValue> args) {
3480 return genCLocOrCFunLoc(builder, loc, resultType, args);
3481}
3482
3483// C_PTR_EQ and C_PTR_NE
3484template <mlir::arith::CmpIPredicate pred>
3485fir::ExtendedValue
3486IntrinsicLibrary::genCPtrCompare(mlir::Type resultType,
3487 llvm::ArrayRef<fir::ExtendedValue> args) {
3488 assert(args.size() == 2);
3489 mlir::Value cPtr1 = fir::getBase(args[0]);
3490 mlir::Value cPtrVal1 =
3491 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr1);
3492 mlir::Value cPtr2 = fir::getBase(args[1]);
3493 mlir::Value cPtrVal2 =
3494 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr2);
3495 mlir::Value cmp =
3496 builder.create<mlir::arith::CmpIOp>(loc, pred, cPtrVal1, cPtrVal2);
3497 return builder.createConvert(loc, resultType, cmp);
3498}
3499
3500// CEILING
3501mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType,
3502 llvm::ArrayRef<mlir::Value> args) {
3503 // Optional KIND argument.
3504 assert(args.size() >= 1);
3505 mlir::Value arg = args[0];
3506 // Use ceil that is not an actual Fortran intrinsic but that is
3507 // an llvm intrinsic that does the same, but return a floating
3508 // point.
3509 mlir::Value ceil = genRuntimeCall("ceil", arg.getType(), {arg});
3510 return builder.createConvert(loc, resultType, ceil);
3511}
3512
3513// CHAR
3514fir::ExtendedValue
3515IntrinsicLibrary::genChar(mlir::Type type,
3516 llvm::ArrayRef<fir::ExtendedValue> args) {
3517 // Optional KIND argument.
3518 assert(args.size() >= 1);
3519 const mlir::Value *arg = args[0].getUnboxed();
3520 // expect argument to be a scalar integer
3521 if (!arg)
3522 mlir::emitError(loc, "CHAR intrinsic argument not unboxed");
3523 fir::factory::CharacterExprHelper helper{builder, loc};
3524 fir::CharacterType::KindTy kind = helper.getCharacterType(type).getFKind();
3525 mlir::Value cast = helper.createSingletonFromCode(*arg, kind);
3526 mlir::Value len =
3527 builder.createIntegerConstant(loc, builder.getCharacterLengthType(), 1);
3528 return fir::CharBoxValue{cast, len};
3529}
3530
3531// CHDIR
3532fir::ExtendedValue
3533IntrinsicLibrary::genChdir(std::optional<mlir::Type> resultType,
3534 llvm::ArrayRef<fir::ExtendedValue> args) {
3535 assert((args.size() == 1 && resultType.has_value()) ||
3536 (args.size() >= 1 && !resultType.has_value()));
3537 mlir::Value name = fir::getBase(args[0]);
3538 mlir::Value status = fir::runtime::genChdir(builder, loc, name);
3539
3540 if (resultType.has_value()) {
3541 return status;
3542 } else {
3543 // Subroutine form, store status and return none.
3544 if (!isStaticallyAbsent(args[1])) {
3545 mlir::Value statusAddr = fir::getBase(args[1]);
3546 statusAddr.dump();
3547 mlir::Value statusIsPresentAtRuntime =
3548 builder.genIsNotNullAddr(loc, statusAddr);
3549 builder.genIfThen(loc, statusIsPresentAtRuntime)
3550 .genThen([&]() {
3551 builder.createStoreWithConvert(loc, status, statusAddr);
3552 })
3553 .end();
3554 }
3555 }
3556
3557 return {};
3558}
3559
3560// CLOCK64
3561mlir::Value IntrinsicLibrary::genClock64(mlir::Type resultType,
3562 llvm::ArrayRef<mlir::Value> args) {
3563 constexpr llvm::StringLiteral funcName = "llvm.nvvm.read.ptx.sreg.clock64";
3564 mlir::MLIRContext *context = builder.getContext();
3565 mlir::FunctionType ftype = mlir::FunctionType::get(context, {}, {resultType});
3566 auto funcOp = builder.createFunction(loc, funcName, ftype);
3567 return builder.create<fir::CallOp>(loc, funcOp, args).getResult(0);
3568}
3569
3570// CMPLX
3571mlir::Value IntrinsicLibrary::genCmplx(mlir::Type resultType,
3572 llvm::ArrayRef<mlir::Value> args) {
3573 assert(args.size() >= 1);
3574 fir::factory::Complex complexHelper(builder, loc);
3575 mlir::Type partType = complexHelper.getComplexPartType(resultType);
3576 mlir::Value real = builder.createConvert(loc, partType, args[0]);
3577 mlir::Value imag = isStaticallyAbsent(args, 1)
3578 ? builder.createRealZeroConstant(loc, partType)
3579 : builder.createConvert(loc, partType, args[1]);
3580 return fir::factory::Complex{builder, loc}.createComplex(resultType, real,
3581 imag);
3582}
3583
3584// COMMAND_ARGUMENT_COUNT
3585fir::ExtendedValue IntrinsicLibrary::genCommandArgumentCount(
3586 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {
3587 assert(args.size() == 0);
3588 assert(resultType == builder.getDefaultIntegerType() &&
3589 "result type is not default integer kind type");
3590 return builder.createConvert(
3591 loc, resultType, fir::runtime::genCommandArgumentCount(builder, loc));
3592 ;
3593}
3594
3595// CONJG
3596mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType,
3597 llvm::ArrayRef<mlir::Value> args) {
3598 assert(args.size() == 1);
3599 if (resultType != args[0].getType())
3600 llvm_unreachable("argument type mismatch");
3601
3602 mlir::Value cplx = args[0];
3603 auto imag = fir::factory::Complex{builder, loc}.extractComplexPart(
3604 cplx, /*isImagPart=*/true);
3605 auto negImag = builder.create<mlir::arith::NegFOp>(loc, imag);
3606 return fir::factory::Complex{builder, loc}.insertComplexPart(
3607 cplx, negImag, /*isImagPart=*/true);
3608}
3609
3610// COSD
3611mlir::Value IntrinsicLibrary::genCosd(mlir::Type resultType,
3612 llvm::ArrayRef<mlir::Value> args) {
3613 assert(args.size() == 1);
3614 mlir::MLIRContext *context = builder.getContext();
3615 mlir::FunctionType ftype =
3616 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});
3617 llvm::APFloat pi = llvm::APFloat(llvm::numbers::pi);
3618 mlir::Value dfactor = builder.createRealConstant(
3619 loc, mlir::Float64Type::get(context), pi / llvm::APFloat(180.0));
3620 mlir::Value factor = builder.createConvert(loc, args[0].getType(), dfactor);
3621 mlir::Value arg = builder.create<mlir::arith::MulFOp>(loc, args[0], factor);
3622 return getRuntimeCallGenerator("cos", ftype)(builder, loc, {arg});
3623}
3624
3625// COUNT
3626fir::ExtendedValue
3627IntrinsicLibrary::genCount(mlir::Type resultType,
3628 llvm::ArrayRef<fir::ExtendedValue> args) {
3629 assert(args.size() == 3);
3630
3631 // Handle mask argument
3632 fir::BoxValue mask = builder.createBox(loc, args[0]);
3633 unsigned maskRank = mask.rank();
3634
3635 assert(maskRank > 0);
3636
3637 // Handle optional dim argument
3638 bool absentDim = isStaticallyAbsent(args[1]);
3639 mlir::Value dim =
3640 absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 0)
3641 : fir::getBase(args[1]);
3642
3643 if (absentDim || maskRank == 1) {
3644 // Result is scalar if no dim argument or mask is rank 1.
3645 // So, call specialized Count runtime routine.
3646 return builder.createConvert(
3647 loc, resultType,
3648 fir::runtime::genCount(builder, loc, fir::getBase(mask), dim));
3649 }
3650
3651 // Call general CountDim runtime routine.
3652
3653 // Handle optional kind argument
3654 bool absentKind = isStaticallyAbsent(args[2]);
3655 mlir::Value kind = absentKind ? builder.createIntegerConstant(
3656 loc, builder.getIndexType(),
3657 builder.getKindMap().defaultIntegerKind())
3658 : fir::getBase(args[2]);
3659
3660 // Create mutable fir.box to be passed to the runtime for the result.
3661 mlir::Type type = builder.getVarLenSeqTy(resultType, maskRank - 1);
3662 fir::MutableBoxValue resultMutableBox =
3663 fir::factory::createTempMutableBox(builder, loc, type);
3664
3665 mlir::Value resultIrBox =
3666 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3667
3668 fir::runtime::genCountDim(builder, loc, resultIrBox, fir::getBase(mask), dim,
3669 kind);
3670 // Handle cleanup of allocatable result descriptor and return
3671 return readAndAddCleanUp(resultMutableBox, resultType, "COUNT");
3672}
3673
3674// CPU_TIME
3675void IntrinsicLibrary::genCpuTime(llvm::ArrayRef<fir::ExtendedValue> args) {
3676 assert(args.size() == 1);
3677 const mlir::Value *arg = args[0].getUnboxed();
3678 assert(arg && "nonscalar cpu_time argument");
3679 mlir::Value res1 = fir::runtime::genCpuTime(builder, loc);
3680 mlir::Value res2 =
3681 builder.createConvert(loc, fir::dyn_cast_ptrEleTy(arg->getType()), res1);
3682 builder.create<fir::StoreOp>(loc, res2, *arg);
3683}
3684
3685// CSHIFT
3686fir::ExtendedValue
3687IntrinsicLibrary::genCshift(mlir::Type resultType,
3688 llvm::ArrayRef<fir::ExtendedValue> args) {
3689 assert(args.size() == 3);
3690
3691 // Handle required ARRAY argument
3692 fir::BoxValue arrayBox = builder.createBox(loc, args[0]);
3693 mlir::Value array = fir::getBase(arrayBox);
3694 unsigned arrayRank = arrayBox.rank();
3695
3696 // Create mutable fir.box to be passed to the runtime for the result.
3697 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, arrayRank);
3698 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(
3699 builder, loc, resultArrayType, {},
3700 fir::isPolymorphicType(array.getType()) ? array : mlir::Value{});
3701 mlir::Value resultIrBox =
3702 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3703
3704 if (arrayRank == 1) {
3705 // Vector case
3706 // Handle required SHIFT argument as a scalar
3707 const mlir::Value *shiftAddr = args[1].getUnboxed();
3708 assert(shiftAddr && "nonscalar CSHIFT argument");
3709 auto shift = builder.create<fir::LoadOp>(loc, *shiftAddr);
3710
3711 fir::runtime::genCshiftVector(builder, loc, resultIrBox, array, shift);
3712 } else {
3713 // Non-vector case
3714 // Handle required SHIFT argument as an array
3715 mlir::Value shift = builder.createBox(loc, args[1]);
3716
3717 // Handle optional DIM argument
3718 mlir::Value dim =
3719 isStaticallyAbsent(args[2])
3720 ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
3721 : fir::getBase(args[2]);
3722 fir::runtime::genCshift(builder, loc, resultIrBox, array, shift, dim);
3723 }
3724 return readAndAddCleanUp(resultMutableBox, resultType, "CSHIFT");
3725}
3726
3727// __LDCA, __LDCS, __LDLU, __LDCV
3728template <const char *fctName, int extent>
3729fir::ExtendedValue
3730IntrinsicLibrary::genCUDALDXXFunc(mlir::Type resultType,
3731 llvm::ArrayRef<fir::ExtendedValue> args) {
3732 assert(args.size() == 1);
3733 mlir::Type resTy = fir::SequenceType::get(extent, resultType);
3734 mlir::Value arg = fir::getBase(args[0]);
3735 mlir::Value res = builder.create<fir::AllocaOp>(loc, resTy);
3736 if (mlir::isa<fir::BaseBoxType>(arg.getType()))
3737 arg = builder.create<fir::BoxAddrOp>(loc, arg);
3738 mlir::Type refResTy = fir::ReferenceType::get(resTy);
3739 mlir::FunctionType ftype =
3740 mlir::FunctionType::get(arg.getContext(), {refResTy, refResTy}, {});
3741 auto funcOp = builder.createFunction(loc, fctName, ftype);
3742 llvm::SmallVector<mlir::Value> funcArgs;
3743 funcArgs.push_back(res);
3744 funcArgs.push_back(arg);
3745 builder.create<fir::CallOp>(loc, funcOp, funcArgs);
3746 mlir::Value ext =
3747 builder.createIntegerConstant(loc, builder.getIndexType(), extent);
3748 return fir::ArrayBoxValue(res, {ext});
3749}
3750
3751// DATE_AND_TIME
3752void IntrinsicLibrary::genDateAndTime(llvm::ArrayRef<fir::ExtendedValue> args) {
3753 assert(args.size() == 4 && "date_and_time has 4 args");
3754 llvm::SmallVector<std::optional<fir::CharBoxValue>> charArgs(3);
3755 for (unsigned i = 0; i < 3; ++i)
3756 if (const fir::CharBoxValue *charBox = args[i].getCharBox())
3757 charArgs[i] = *charBox;
3758
3759 mlir::Value values = fir::getBase(args[3]);
3760 if (!values)
3761 values = builder.create<fir::AbsentOp>(
3762 loc, fir::BoxType::get(builder.getNoneType()));
3763
3764 fir::runtime::genDateAndTime(builder, loc, charArgs[0], charArgs[1],
3765 charArgs[2], values);
3766}
3767
3768// DIM
3769mlir::Value IntrinsicLibrary::genDim(mlir::Type resultType,
3770 llvm::ArrayRef<mlir::Value> args) {
3771 assert(args.size() == 2);
3772 if (mlir::isa<mlir::IntegerType>(resultType)) {
3773 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3774 auto diff = builder.create<mlir::arith::SubIOp>(loc, args[0], args[1]);
3775 auto cmp = builder.create<mlir::arith::CmpIOp>(
3776 loc, mlir::arith::CmpIPredicate::sgt, diff, zero);
3777 return builder.create<mlir::arith::SelectOp>(loc, cmp, diff, zero);
3778 }
3779 assert(fir::isa_real(resultType) && "Only expects real and integer in DIM");
3780 mlir::Value zero = builder.createRealZeroConstant(loc, resultType);
3781 auto diff = builder.create<mlir::arith::SubFOp>(loc, args[0], args[1]);
3782 auto cmp = builder.create<mlir::arith::CmpFOp>(
3783 loc, mlir::arith::CmpFPredicate::OGT, diff, zero);
3784 return builder.create<mlir::arith::SelectOp>(loc, cmp, diff, zero);
3785}
3786
3787// DOT_PRODUCT
3788fir::ExtendedValue
3789IntrinsicLibrary::genDotProduct(mlir::Type resultType,
3790 llvm::ArrayRef<fir::ExtendedValue> args) {
3791 assert(args.size() == 2);
3792
3793 // Handle required vector arguments
3794 mlir::Value vectorA = fir::getBase(args[0]);
3795 mlir::Value vectorB = fir::getBase(args[1]);
3796 // Result type is used for picking appropriate runtime function.
3797 mlir::Type eleTy = resultType;
3798
3799 if (fir::isa_complex(eleTy)) {
3800 mlir::Value result = builder.createTemporary(loc, eleTy);
3801 fir::runtime::genDotProduct(builder, loc, vectorA, vectorB, result);
3802 return builder.create<fir::LoadOp>(loc, result);
3803 }
3804
3805 // This operation is only used to pass the result type
3806 // information to the DotProduct generator.
3807 auto resultBox = builder.create<fir::AbsentOp>(loc, fir::BoxType::get(eleTy));
3808 return fir::runtime::genDotProduct(builder, loc, vectorA, vectorB, resultBox);
3809}
3810
3811// DPROD
3812mlir::Value IntrinsicLibrary::genDprod(mlir::Type resultType,
3813 llvm::ArrayRef<mlir::Value> args) {
3814 assert(args.size() == 2);
3815 assert(fir::isa_real(resultType) &&
3816 "Result must be double precision in DPROD");
3817 mlir::Value a = builder.createConvert(loc, resultType, args[0]);
3818 mlir::Value b = builder.createConvert(loc, resultType, args[1]);
3819 return builder.create<mlir::arith::MulFOp>(loc, a, b);
3820}
3821
3822// DSHIFTL
3823mlir::Value IntrinsicLibrary::genDshiftl(mlir::Type resultType,
3824 llvm::ArrayRef<mlir::Value> args) {
3825 assert(args.size() == 3);
3826
3827 mlir::Value i = args[0];
3828 mlir::Value j = args[1];
3829 int bits = resultType.getIntOrFloatBitWidth();
3830 mlir::Type signlessType =
3831 mlir::IntegerType::get(builder.getContext(), bits,
3832 mlir::IntegerType::SignednessSemantics::Signless);
3833 if (resultType.isUnsignedInteger()) {
3834 i = builder.createConvert(loc, signlessType, i);
3835 j = builder.createConvert(loc, signlessType, j);
3836 }
3837 mlir::Value shift = builder.createConvert(loc, signlessType, args[2]);
3838 mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits);
3839
3840 // Per the standard, the value of DSHIFTL(I, J, SHIFT) is equal to
3841 // IOR (SHIFTL(I, SHIFT), SHIFTR(J, BIT_SIZE(J) - SHIFT))
3842 mlir::Value diff = builder.create<mlir::arith::SubIOp>(loc, bitSize, shift);
3843
3844 mlir::Value lArgs[2]{i, shift};
3845 mlir::Value lft = genShift<mlir::arith::ShLIOp>(signlessType, lArgs);
3846
3847 mlir::Value rArgs[2]{j, diff};
3848 mlir::Value rgt = genShift<mlir::arith::ShRUIOp>(signlessType, rArgs);
3849 mlir::Value result = builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
3850 if (resultType.isUnsignedInteger())
3851 return builder.createConvert(loc, resultType, result);
3852 return result;
3853}
3854
3855// DSHIFTR
3856mlir::Value IntrinsicLibrary::genDshiftr(mlir::Type resultType,
3857 llvm::ArrayRef<mlir::Value> args) {
3858 assert(args.size() == 3);
3859
3860 mlir::Value i = args[0];
3861 mlir::Value j = args[1];
3862 int bits = resultType.getIntOrFloatBitWidth();
3863 mlir::Type signlessType =
3864 mlir::IntegerType::get(builder.getContext(), bits,
3865 mlir::IntegerType::SignednessSemantics::Signless);
3866 if (resultType.isUnsignedInteger()) {
3867 i = builder.createConvert(loc, signlessType, i);
3868 j = builder.createConvert(loc, signlessType, j);
3869 }
3870 mlir::Value shift = builder.createConvert(loc, signlessType, args[2]);
3871 mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits);
3872
3873 // Per the standard, the value of DSHIFTR(I, J, SHIFT) is equal to
3874 // IOR (SHIFTL(I, BIT_SIZE(I) - SHIFT), SHIFTR(J, SHIFT))
3875 mlir::Value diff = builder.create<mlir::arith::SubIOp>(loc, bitSize, shift);
3876
3877 mlir::Value lArgs[2]{i, diff};
3878 mlir::Value lft = genShift<mlir::arith::ShLIOp>(signlessType, lArgs);
3879
3880 mlir::Value rArgs[2]{j, shift};
3881 mlir::Value rgt = genShift<mlir::arith::ShRUIOp>(signlessType, rArgs);
3882 mlir::Value result = builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
3883 if (resultType.isUnsignedInteger())
3884 return builder.createConvert(loc, resultType, result);
3885 return result;
3886}
3887
3888// EOSHIFT
3889fir::ExtendedValue
3890IntrinsicLibrary::genEoshift(mlir::Type resultType,
3891 llvm::ArrayRef<fir::ExtendedValue> args) {
3892 assert(args.size() == 4);
3893
3894 // Handle required ARRAY argument
3895 fir::BoxValue arrayBox = builder.createBox(loc, args[0]);
3896 mlir::Value array = fir::getBase(arrayBox);
3897 unsigned arrayRank = arrayBox.rank();
3898
3899 // Create mutable fir.box to be passed to the runtime for the result.
3900 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, arrayRank);
3901 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(
3902 builder, loc, resultArrayType, {},
3903 fir::isPolymorphicType(array.getType()) ? array : mlir::Value{});
3904 mlir::Value resultIrBox =
3905 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3906
3907 // Handle optional BOUNDARY argument
3908 mlir::Value boundary =
3909 isStaticallyAbsent(args[2])
3910 ? builder.create<fir::AbsentOp>(
3911 loc, fir::BoxType::get(builder.getNoneType()))
3912 : builder.createBox(loc, args[2]);
3913
3914 if (arrayRank == 1) {
3915 // Vector case
3916 // Handle required SHIFT argument as a scalar
3917 const mlir::Value *shiftAddr = args[1].getUnboxed();
3918 assert(shiftAddr && "nonscalar EOSHIFT SHIFT argument");
3919 auto shift = builder.create<fir::LoadOp>(loc, *shiftAddr);
3920 fir::runtime::genEoshiftVector(builder, loc, resultIrBox, array, shift,
3921 boundary);
3922 } else {
3923 // Non-vector case
3924 // Handle required SHIFT argument as an array
3925 mlir::Value shift = builder.createBox(loc, args[1]);
3926
3927 // Handle optional DIM argument
3928 mlir::Value dim =
3929 isStaticallyAbsent(args[3])
3930 ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
3931 : fir::getBase(args[3]);
3932 fir::runtime::genEoshift(builder, loc, resultIrBox, array, shift, boundary,
3933 dim);
3934 }
3935 return readAndAddCleanUp(resultMutableBox, resultType, "EOSHIFT");
3936}
3937
3938// EXECUTE_COMMAND_LINE
3939void IntrinsicLibrary::genExecuteCommandLine(
3940 llvm::ArrayRef<fir::ExtendedValue> args) {
3941 assert(args.size() == 5);
3942
3943 mlir::Value command = fir::getBase(args[0]);
3944 // Optional arguments: wait, exitstat, cmdstat, cmdmsg.
3945 const fir::ExtendedValue &wait = args[1];
3946 const fir::ExtendedValue &exitstat = args[2];
3947 const fir::ExtendedValue &cmdstat = args[3];
3948 const fir::ExtendedValue &cmdmsg = args[4];
3949
3950 if (!command)
3951 fir::emitFatalError(loc, "expected COMMAND parameter");
3952
3953 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
3954
3955 mlir::Value waitBool;
3956 if (isStaticallyAbsent(wait)) {
3957 waitBool = builder.createBool(loc, true);
3958 } else {
3959 mlir::Type i1Ty = builder.getI1Type();
3960 mlir::Value waitAddr = fir::getBase(wait);
3961 mlir::Value waitIsPresentAtRuntime =
3962 builder.genIsNotNullAddr(loc, waitAddr);
3963 waitBool = builder
3964 .genIfOp(loc, {i1Ty}, waitIsPresentAtRuntime,
3965 /*withElseRegion=*/true)
3966 .genThen([&]() {
3967 auto waitLoad = builder.create<fir::LoadOp>(loc, waitAddr);
3968 mlir::Value cast =
3969 builder.createConvert(loc, i1Ty, waitLoad);
3970 builder.create<fir::ResultOp>(loc, cast);
3971 })
3972 .genElse([&]() {
3973 mlir::Value trueVal = builder.createBool(loc, true);
3974 builder.create<fir::ResultOp>(loc, trueVal);
3975 })
3976 .getResults()[0];
3977 }
3978
3979 mlir::Value exitstatBox =
3980 isStaticallyPresent(exitstat)
3981 ? fir::getBase(exitstat)
3982 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3983 mlir::Value cmdstatBox =
3984 isStaticallyPresent(cmdstat)
3985 ? fir::getBase(cmdstat)
3986 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3987 mlir::Value cmdmsgBox =
3988 isStaticallyPresent(cmdmsg)
3989 ? fir::getBase(cmdmsg)
3990 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3991 fir::runtime::genExecuteCommandLine(builder, loc, command, waitBool,
3992 exitstatBox, cmdstatBox, cmdmsgBox);
3993}
3994
3995// ETIME
3996fir::ExtendedValue
3997IntrinsicLibrary::genEtime(std::optional<mlir::Type> resultType,
3998 llvm::ArrayRef<fir::ExtendedValue> args) {
3999 assert((args.size() == 2 && !resultType.has_value()) ||
4000 (args.size() == 1 && resultType.has_value()));
4001
4002 mlir::Value values = fir::getBase(args[0]);
4003 if (resultType.has_value()) {
4004 // function form
4005 if (!values)
4006 fir::emitFatalError(loc, "expected VALUES parameter");
4007
4008 auto timeAddr = builder.createTemporary(loc, *resultType);
4009 auto timeBox = builder.createBox(loc, timeAddr);
4010 fir::runtime::genEtime(builder, loc, values, timeBox);
4011 return builder.create<fir::LoadOp>(loc, timeAddr);
4012 } else {
4013 // subroutine form
4014 mlir::Value time = fir::getBase(args[1]);
4015 if (!values)
4016 fir::emitFatalError(loc, "expected VALUES parameter");
4017 if (!time)
4018 fir::emitFatalError(loc, "expected TIME parameter");
4019
4020 fir::runtime::genEtime(builder, loc, values, time);
4021 return {};
4022 }
4023 return {};
4024}
4025
4026// EXIT
4027void IntrinsicLibrary::genExit(llvm::ArrayRef<fir::ExtendedValue> args) {
4028 assert(args.size() == 1);
4029
4030 mlir::Value status =
4031 isStaticallyAbsent(args[0])
4032 ? builder.createIntegerConstant(loc, builder.getDefaultIntegerType(),
4033 EXIT_SUCCESS)
4034 : fir::getBase(args[0]);
4035
4036 assert(status.getType() == builder.getDefaultIntegerType() &&
4037 "STATUS parameter must be an INTEGER of default kind");
4038
4039 fir::runtime::genExit(builder, loc, status);
4040}
4041
4042// EXPONENT
4043mlir::Value IntrinsicLibrary::genExponent(mlir::Type resultType,
4044 llvm::ArrayRef<mlir::Value> args) {
4045 assert(args.size() == 1);
4046
4047 return builder.createConvert(
4048 loc, resultType,
4049 fir::runtime::genExponent(builder, loc, resultType,
4050 fir::getBase(args[0])));
4051}
4052
4053// EXTENDS_TYPE_OF
4054fir::ExtendedValue
4055IntrinsicLibrary::genExtendsTypeOf(mlir::Type resultType,
4056 llvm::ArrayRef<fir::ExtendedValue> args) {
4057 assert(args.size() == 2);
4058
4059 return builder.createConvert(
4060 loc, resultType,
4061 fir::runtime::genExtendsTypeOf(builder, loc, fir::getBase(args[0]),
4062 fir::getBase(args[1])));
4063}
4064
4065// FINDLOC
4066fir::ExtendedValue
4067IntrinsicLibrary::genFindloc(mlir::Type resultType,
4068 llvm::ArrayRef<fir::ExtendedValue> args) {
4069 assert(args.size() == 6);
4070
4071 // Handle required array argument
4072 mlir::Value array = builder.createBox(loc, args[0]);
4073 unsigned rank = fir::BoxValue(array).rank();
4074 assert(rank >= 1);
4075
4076 // Handle required value argument
4077 mlir::Value val = builder.createBox(loc, args[1]);
4078
4079 // Check if dim argument is present
4080 bool absentDim = isStaticallyAbsent(args[2]);
4081
4082 // Handle optional mask argument
4083 auto mask = isStaticallyAbsent(args[3])
4084 ? builder.create<fir::AbsentOp>(
4085 loc, fir::BoxType::get(builder.getI1Type()))
4086 : builder.createBox(loc, args[3]);
4087
4088 // Handle optional kind argument
4089 auto kind = isStaticallyAbsent(args[4])
4090 ? builder.createIntegerConstant(
4091 loc, builder.getIndexType(),
4092 builder.getKindMap().defaultIntegerKind())
4093 : fir::getBase(args[4]);
4094
4095 // Handle optional back argument
4096 auto back = isStaticallyAbsent(args[5]) ? builder.createBool(loc, false)
4097 : fir::getBase(args[5]);
4098
4099 if (!absentDim && rank == 1) {
4100 // If dim argument is present and the array is rank 1, then the result is
4101 // a scalar (since the the result is rank-1 or 0).
4102 // Therefore, we use a scalar result descriptor with FindlocDim().
4103 // Create mutable fir.box to be passed to the runtime for the result.
4104 fir::MutableBoxValue resultMutableBox =
4105 fir::factory::createTempMutableBox(builder, loc, resultType);
4106 mlir::Value resultIrBox =
4107 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4108 mlir::Value dim = fir::getBase(args[2]);
4109
4110 fir::runtime::genFindlocDim(builder, loc, resultIrBox, array, val, dim,
4111 mask, kind, back);
4112 // Handle cleanup of allocatable result descriptor and return
4113 return readAndAddCleanUp(resultMutableBox, resultType, "FINDLOC");
4114 }
4115
4116 // The result will be an array. Create mutable fir.box to be passed to the
4117 // runtime for the result.
4118 mlir::Type resultArrayType =
4119 builder.getVarLenSeqTy(resultType, absentDim ? 1 : rank - 1);
4120 fir::MutableBoxValue resultMutableBox =
4121 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
4122 mlir::Value resultIrBox =
4123 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4124
4125 if (absentDim) {
4126 fir::runtime::genFindloc(builder, loc, resultIrBox, array, val, mask, kind,
4127 back);
4128 } else {
4129 mlir::Value dim = fir::getBase(args[2]);
4130 fir::runtime::genFindlocDim(builder, loc, resultIrBox, array, val, dim,
4131 mask, kind, back);
4132 }
4133 return readAndAddCleanUp(resultMutableBox, resultType, "FINDLOC");
4134}
4135
4136// FLOOR
4137mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType,
4138 llvm::ArrayRef<mlir::Value> args) {
4139 // Optional KIND argument.
4140 assert(args.size() >= 1);
4141 mlir::Value arg = args[0];
4142 // Use LLVM floor that returns real.
4143 mlir::Value floor = genRuntimeCall("floor", arg.getType(), {arg});
4144 return builder.createConvert(loc, resultType, floor);
4145}
4146
4147// FRACTION
4148mlir::Value IntrinsicLibrary::genFraction(mlir::Type resultType,
4149 llvm::ArrayRef<mlir::Value> args) {
4150 assert(args.size() == 1);
4151
4152 return builder.createConvert(
4153 loc, resultType,
4154 fir::runtime::genFraction(builder, loc, fir::getBase(args[0])));
4155}
4156
4157void IntrinsicLibrary::genFree(llvm::ArrayRef<fir::ExtendedValue> args) {
4158 assert(args.size() == 1);
4159
4160 fir::runtime::genFree(builder, loc, fir::getBase(args[0]));
4161}
4162
4163// FSEEK
4164fir::ExtendedValue
4165IntrinsicLibrary::genFseek(std::optional<mlir::Type> resultType,
4166 llvm::ArrayRef<fir::ExtendedValue> args) {
4167 assert((args.size() == 4 && !resultType.has_value()) ||
4168 (args.size() == 3 && resultType.has_value()));
4169 mlir::Value unit = fir::getBase(args[0]);
4170 mlir::Value offset = fir::getBase(args[1]);
4171 mlir::Value whence = fir::getBase(args[2]);
4172 if (!unit)
4173 fir::emitFatalError(loc, "expected UNIT argument");
4174 if (!offset)
4175 fir::emitFatalError(loc, "expected OFFSET argument");
4176 if (!whence)
4177 fir::emitFatalError(loc, "expected WHENCE argument");
4178 mlir::Value statusValue =
4179 fir::runtime::genFseek(builder, loc, unit, offset, whence);
4180 if (resultType.has_value()) { // function
4181 return builder.createConvert(loc, *resultType, statusValue);
4182 } else { // subroutine
4183 const fir::ExtendedValue &statusVar = args[3];
4184 if (!isStaticallyAbsent(statusVar)) {
4185 mlir::Value statusAddr = fir::getBase(statusVar);
4186 mlir::Value statusIsPresentAtRuntime =
4187 builder.genIsNotNullAddr(loc, statusAddr);
4188 builder.genIfThen(loc, statusIsPresentAtRuntime)
4189 .genThen([&]() {
4190 builder.createStoreWithConvert(loc, statusValue, statusAddr);
4191 })
4192 .end();
4193 }
4194 return {};
4195 }
4196}
4197
4198// FTELL
4199fir::ExtendedValue
4200IntrinsicLibrary::genFtell(std::optional<mlir::Type> resultType,
4201 llvm::ArrayRef<fir::ExtendedValue> args) {
4202 assert((args.size() == 2 && !resultType.has_value()) ||
4203 (args.size() == 1 && resultType.has_value()));
4204 mlir::Value unit = fir::getBase(args[0]);
4205 if (!unit)
4206 fir::emitFatalError(loc, "expected UNIT argument");
4207 mlir::Value offsetValue = fir::runtime::genFtell(builder, loc, unit);
4208 if (resultType.has_value()) { // function
4209 return offsetValue;
4210 } else { // subroutine
4211 const fir::ExtendedValue &offsetVar = args[1];
4212 if (!isStaticallyAbsent(offsetVar)) {
4213 mlir::Value offsetAddr = fir::getBase(offsetVar);
4214 mlir::Value offsetIsPresentAtRuntime =
4215 builder.genIsNotNullAddr(loc, offsetAddr);
4216 builder.genIfThen(loc, offsetIsPresentAtRuntime)
4217 .genThen([&]() {
4218 builder.createStoreWithConvert(loc, offsetValue, offsetAddr);
4219 })
4220 .end();
4221 }
4222 return {};
4223 }
4224}
4225
4226// GETCWD
4227fir::ExtendedValue
4228IntrinsicLibrary::genGetCwd(std::optional<mlir::Type> resultType,
4229 llvm::ArrayRef<fir::ExtendedValue> args) {
4230 assert((args.size() == 1 && resultType.has_value()) ||
4231 (args.size() >= 1 && !resultType.has_value()));
4232
4233 mlir::Value cwd = fir::getBase(args[0]);
4234 mlir::Value statusValue = fir::runtime::genGetCwd(builder, loc, cwd);
4235
4236 if (resultType.has_value()) {
4237 // Function form, return status.
4238 return statusValue;
4239 } else {
4240 // Subroutine form, store status and return none.
4241 const fir::ExtendedValue &status = args[1];
4242 if (!isStaticallyAbsent(status)) {
4243 mlir::Value statusAddr = fir::getBase(status);
4244 mlir::Value statusIsPresentAtRuntime =
4245 builder.genIsNotNullAddr(loc, statusAddr);
4246 builder.genIfThen(loc, statusIsPresentAtRuntime)
4247 .genThen([&]() {
4248 builder.createStoreWithConvert(loc, statusValue, statusAddr);
4249 })
4250 .end();
4251 }
4252 }
4253
4254 return {};
4255}
4256
4257// GET_COMMAND
4258void IntrinsicLibrary::genGetCommand(llvm::ArrayRef<fir::ExtendedValue> args) {
4259 assert(args.size() == 4);
4260 const fir::ExtendedValue &command = args[0];
4261 const fir::ExtendedValue &length = args[1];
4262 const fir::ExtendedValue &status = args[2];
4263 const fir::ExtendedValue &errmsg = args[3];
4264
4265 // If none of the optional parameters are present, do nothing.
4266 if (!isStaticallyPresent(command) && !isStaticallyPresent(length) &&
4267 !isStaticallyPresent(status) && !isStaticallyPresent(errmsg))
4268 return;
4269
4270 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
4271 mlir::Value commandBox =
4272 isStaticallyPresent(command)
4273 ? fir::getBase(command)
4274 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
4275 mlir::Value lenBox =
4276 isStaticallyPresent(length)
4277 ? fir::getBase(length)
4278 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
4279 mlir::Value errBox =
4280 isStaticallyPresent(errmsg)
4281 ? fir::getBase(errmsg)
4282 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
4283 mlir::Value stat =
4284 fir::runtime::genGetCommand(builder, loc, commandBox, lenBox, errBox);
4285 if (isStaticallyPresent(status)) {
4286 mlir::Value statAddr = fir::getBase(status);
4287 mlir::Value statIsPresentAtRuntime =
4288 builder.genIsNotNullAddr(loc, statAddr);
4289 builder.genIfThen(loc, statIsPresentAtRuntime)
4290 .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); })
4291 .end();
4292 }
4293}
4294
4295// GETGID
4296mlir::Value IntrinsicLibrary::genGetGID(mlir::Type resultType,
4297 llvm::ArrayRef<mlir::Value> args) {
4298 assert(args.size() == 0 && "getgid takes no input");
4299 return builder.createConvert(loc, resultType,
4300 fir::runtime::genGetGID(builder, loc));
4301}
4302
4303// GETPID
4304mlir::Value IntrinsicLibrary::genGetPID(mlir::Type resultType,
4305 llvm::ArrayRef<mlir::Value> args) {
4306 assert(args.size() == 0 && "getpid takes no input");
4307 return builder.createConvert(loc, resultType,
4308 fir::runtime::genGetPID(builder, loc));
4309}
4310
4311// GETUID
4312mlir::Value IntrinsicLibrary::genGetUID(mlir::Type resultType,
4313 llvm::ArrayRef<mlir::Value> args) {
4314 assert(args.size() == 0 && "getgid takes no input");
4315 return builder.createConvert(loc, resultType,
4316 fir::runtime::genGetUID(builder, loc));
4317}
4318
4319// GET_COMMAND_ARGUMENT
4320void IntrinsicLibrary::genGetCommandArgument(
4321 llvm::ArrayRef<fir::ExtendedValue> args) {
4322 assert(args.size() == 5);
4323 mlir::Value number = fir::getBase(args[0]);
4324 const fir::ExtendedValue &value = args[1];
4325 const fir::ExtendedValue &length = args[2];
4326 const fir::ExtendedValue &status = args[3];
4327 const fir::ExtendedValue &errmsg = args[4];
4328
4329 if (!number)
4330 fir::emitFatalError(loc, "expected NUMBER parameter");
4331
4332 // If none of the optional parameters are present, do nothing.
4333 if (!isStaticallyPresent(value) && !isStaticallyPresent(length) &&
4334 !isStaticallyPresent(status) && !isStaticallyPresent(errmsg))
4335 return;
4336
4337 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
4338 mlir::Value valBox =
4339 isStaticallyPresent(value)
4340 ? fir::getBase(value)
4341 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
4342 mlir::Value lenBox =
4343 isStaticallyPresent(length)
4344 ? fir::getBase(length)
4345 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
4346 mlir::Value errBox =
4347 isStaticallyPresent(errmsg)
4348 ? fir::getBase(errmsg)
4349 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
4350 mlir::Value stat = fir::runtime::genGetCommandArgument(
4351 builder, loc, number, valBox, lenBox, errBox);
4352 if (isStaticallyPresent(status)) {
4353 mlir::Value statAddr = fir::getBase(status);
4354 mlir::Value statIsPresentAtRuntime =
4355 builder.genIsNotNullAddr(loc, statAddr);
4356 builder.genIfThen(loc, statIsPresentAtRuntime)
4357 .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); })
4358 .end();
4359 }
4360}
4361
4362// GET_ENVIRONMENT_VARIABLE
4363void IntrinsicLibrary::genGetEnvironmentVariable(
4364 llvm::ArrayRef<fir::ExtendedValue> args) {
4365 assert(args.size() == 6);
4366 mlir::Value name = fir::getBase(args[0]);
4367 const fir::ExtendedValue &value = args[1];
4368 const fir::ExtendedValue &length = args[2];
4369 const fir::ExtendedValue &status = args[3];
4370 const fir::ExtendedValue &trimName = args[4];
4371 const fir::ExtendedValue &errmsg = args[5];
4372
4373 if (!name)
4374 fir::emitFatalError(loc, "expected NAME parameter");
4375
4376 // If none of the optional parameters are present, do nothing.
4377 if (!isStaticallyPresent(value) && !isStaticallyPresent(length) &&
4378 !isStaticallyPresent(status) && !isStaticallyPresent(errmsg))
4379 return;
4380
4381 // Handle optional TRIM_NAME argument
4382 mlir::Value trim;
4383 if (isStaticallyAbsent(trimName)) {
4384 trim = builder.createBool(loc, true);
4385 } else {
4386 mlir::Type i1Ty = builder.getI1Type();
4387 mlir::Value trimNameAddr = fir::getBase(trimName);
4388 mlir::Value trimNameIsPresentAtRuntime =
4389 builder.genIsNotNullAddr(loc, trimNameAddr);
4390 trim = builder
4391 .genIfOp(loc, {i1Ty}, trimNameIsPresentAtRuntime,
4392 /*withElseRegion=*/true)
4393 .genThen([&]() {
4394 auto trimLoad = builder.create<fir::LoadOp>(loc, trimNameAddr);
4395 mlir::Value cast = builder.createConvert(loc, i1Ty, trimLoad);
4396 builder.create<fir::ResultOp>(loc, cast);
4397 })
4398 .genElse([&]() {
4399 mlir::Value trueVal = builder.createBool(loc, true);
4400 builder.create<fir::ResultOp>(loc, trueVal);
4401 })
4402 .getResults()[0];
4403 }
4404
4405 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
4406 mlir::Value valBox =
4407 isStaticallyPresent(value)
4408 ? fir::getBase(value)
4409 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
4410 mlir::Value lenBox =
4411 isStaticallyPresent(length)
4412 ? fir::getBase(length)
4413 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
4414 mlir::Value errBox =
4415 isStaticallyPresent(errmsg)
4416 ? fir::getBase(errmsg)
4417 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
4418 mlir::Value stat = fir::runtime::genGetEnvVariable(builder, loc, name, valBox,
4419 lenBox, trim, errBox);
4420 if (isStaticallyPresent(status)) {
4421 mlir::Value statAddr = fir::getBase(status);
4422 mlir::Value statIsPresentAtRuntime =
4423 builder.genIsNotNullAddr(loc, statAddr);
4424 builder.genIfThen(loc, statIsPresentAtRuntime)
4425 .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); })
4426 .end();
4427 }
4428}
4429
4430// HOSTNM
4431fir::ExtendedValue
4432IntrinsicLibrary::genHostnm(std::optional<mlir::Type> resultType,
4433 llvm::ArrayRef<fir::ExtendedValue> args) {
4434 assert((args.size() == 1 && resultType.has_value()) ||
4435 (args.size() >= 1 && !resultType.has_value()));
4436
4437 mlir::Value res = fir::getBase(args[0]);
4438 mlir::Value statusValue = fir::runtime::genHostnm(builder, loc, res);
4439
4440 if (resultType.has_value()) {
4441 // Function form, return status.
4442 return builder.createConvert(loc, *resultType, statusValue);
4443 }
4444
4445 // Subroutine form, store status and return none.
4446 const fir::ExtendedValue &status = args[1];
4447 if (!isStaticallyAbsent(status)) {
4448 mlir::Value statusAddr = fir::getBase(status);
4449 mlir::Value statusIsPresentAtRuntime =
4450 builder.genIsNotNullAddr(loc, statusAddr);
4451 builder.genIfThen(loc, statusIsPresentAtRuntime)
4452 .genThen([&]() {
4453 builder.createStoreWithConvert(loc, statusValue, statusAddr);
4454 })
4455 .end();
4456 }
4457
4458 return {};
4459}
4460
4461/// Process calls to Maxval, Minval, Product, Sum intrinsic functions that
4462/// take a DIM argument.
4463template <typename FD>
4464static fir::MutableBoxValue
4465genFuncDim(FD funcDim, mlir::Type resultType, fir::FirOpBuilder &builder,
4466 mlir::Location loc, mlir::Value array, fir::ExtendedValue dimArg,
4467 mlir::Value mask, int rank) {
4468
4469 // Create mutable fir.box to be passed to the runtime for the result.
4470 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
4471 fir::MutableBoxValue resultMutableBox =
4472 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
4473 mlir::Value resultIrBox =
4474 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
4475
4476 mlir::Value dim =
4477 isStaticallyAbsent(dimArg)
4478 ? builder.createIntegerConstant(loc, builder.getIndexType(), 0)
4479 : fir::getBase(dimArg);
4480 funcDim(builder, loc, resultIrBox, array, dim, mask);
4481
4482 return resultMutableBox;
4483}
4484
4485/// Process calls to Product, Sum, IAll, IAny, IParity intrinsic functions
4486template <typename FN, typename FD>
4487fir::ExtendedValue
4488IntrinsicLibrary::genReduction(FN func, FD funcDim, llvm::StringRef errMsg,
4489 mlir::Type resultType,
4490 llvm::ArrayRef<fir::ExtendedValue> args) {
4491
4492 assert(args.size() == 3);
4493
4494 // Handle required array argument
4495 fir::BoxValue arryTmp = builder.createBox(loc, args[0]);
4496 mlir::Value array = fir::getBase(arryTmp);
4497 int rank = arryTmp.rank();
4498 assert(rank >= 1);
4499
4500 // Handle optional mask argument
4501 auto mask = isStaticallyAbsent(args[2])
4502 ? builder.create<fir::AbsentOp>(
4503 loc, fir::BoxType::get(builder.getI1Type()))
4504 : builder.createBox(loc, args[2]);
4505
4506 bool absentDim = isStaticallyAbsent(args[1]);
4507
4508 // We call the type specific versions because the result is scalar
4509 // in the case below.
4510 if (absentDim || rank == 1) {
4511 mlir::Type ty = array.getType();
4512 mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
4513 auto eleTy = mlir::cast<fir::SequenceType>(arrTy).getElementType();
4514 if (fir::isa_complex(eleTy)) {
4515 mlir::Value result = builder.createTemporary(loc, eleTy);
4516 func(builder, loc, array, mask, result);
4517 return builder.create<fir::LoadOp>(loc, result);
4518 }
4519 auto resultBox = builder.create<fir::AbsentOp>(
4520 loc, fir::BoxType::get(builder.getI1Type()));
4521 return func(builder, loc, array, mask, resultBox);
4522 }
4523 // Handle Product/Sum cases that have an array result.
4524 auto resultMutableBox =
4525 genFuncDim(funcDim, resultType, builder, loc, array, args[1], mask, rank);
4526 return readAndAddCleanUp(resultMutableBox, resultType, errMsg);
4527}
4528
4529// IALL
4530fir::ExtendedValue
4531IntrinsicLibrary::genIall(mlir::Type resultType,
4532 llvm::ArrayRef<fir::ExtendedValue> args) {
4533 return genReduction(fir::runtime::genIAll, fir::runtime::genIAllDim, "IALL",
4534 resultType, args);
4535}
4536
4537// IAND
4538mlir::Value IntrinsicLibrary::genIand(mlir::Type resultType,
4539 llvm::ArrayRef<mlir::Value> args) {
4540 assert(args.size() == 2);
4541 return builder.createUnsigned<mlir::arith::AndIOp>(loc, resultType, args[0],
4542 args[1]);
4543}
4544
4545// IANY
4546fir::ExtendedValue
4547IntrinsicLibrary::genIany(mlir::Type resultType,
4548 llvm::ArrayRef<fir::ExtendedValue> args) {
4549 return genReduction(fir::runtime::genIAny, fir::runtime::genIAnyDim, "IANY",
4550 resultType, args);
4551}
4552
4553// IBCLR
4554mlir::Value IntrinsicLibrary::genIbclr(mlir::Type resultType,
4555 llvm::ArrayRef<mlir::Value> args) {
4556 // A conformant IBCLR(I,POS) call satisfies:
4557 // POS >= 0
4558 // POS < BIT_SIZE(I)
4559 // Return: I & (!(1 << POS))
4560 assert(args.size() == 2);
4561 mlir::Type signlessType = mlir::IntegerType::get(
4562 builder.getContext(), resultType.getIntOrFloatBitWidth(),
4563 mlir::IntegerType::SignednessSemantics::Signless);
4564 mlir::Value one = builder.createIntegerConstant(loc, signlessType, 1);
4565 mlir::Value ones = builder.createAllOnesInteger(loc, signlessType);
4566 mlir::Value pos = builder.createConvert(loc, signlessType, args[1]);
4567 mlir::Value bit = builder.create<mlir::arith::ShLIOp>(loc, one, pos);
4568 mlir::Value mask = builder.create<mlir::arith::XOrIOp>(loc, ones, bit);
4569 return builder.createUnsigned<mlir::arith::AndIOp>(loc, resultType, args[0],
4570 mask);
4571}
4572
4573// IBITS
4574mlir::Value IntrinsicLibrary::genIbits(mlir::Type resultType,
4575 llvm::ArrayRef<mlir::Value> args) {
4576 // A conformant IBITS(I,POS,LEN) call satisfies:
4577 // POS >= 0
4578 // LEN >= 0
4579 // POS + LEN <= BIT_SIZE(I)
4580 // Return: LEN == 0 ? 0 : (I >> POS) & (-1 >> (BIT_SIZE(I) - LEN))
4581 // For a conformant call, implementing (I >> POS) with a signed or an
4582 // unsigned shift produces the same result. For a nonconformant call,
4583 // the two choices may produce different results.
4584 assert(args.size() == 3);
4585 mlir::Type signlessType = mlir::IntegerType::get(
4586 builder.getContext(), resultType.getIntOrFloatBitWidth(),
4587 mlir::IntegerType::SignednessSemantics::Signless);
4588 mlir::Value word = args[0];
4589 if (word.getType().isUnsignedInteger())
4590 word = builder.createConvert(loc, signlessType, word);
4591 mlir::Value pos = builder.createConvert(loc, signlessType, args[1]);
4592 mlir::Value len = builder.createConvert(loc, signlessType, args[2]);
4593 mlir::Value bitSize = builder.createIntegerConstant(
4594 loc, signlessType, mlir::cast<mlir::IntegerType>(resultType).getWidth());
4595 mlir::Value shiftCount =
4596 builder.create<mlir::arith::SubIOp>(loc, bitSize, len);
4597 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
4598 mlir::Value ones = builder.createAllOnesInteger(loc, signlessType);
4599 mlir::Value mask =
4600 builder.create<mlir::arith::ShRUIOp>(loc, ones, shiftCount);
4601 mlir::Value res1 = builder.createUnsigned<mlir::arith::ShRSIOp>(
4602 loc, signlessType, word, pos);
4603 mlir::Value res2 = builder.create<mlir::arith::AndIOp>(loc, res1, mask);
4604 mlir::Value lenIsZero = builder.create<mlir::arith::CmpIOp>(
4605 loc, mlir::arith::CmpIPredicate::eq, len, zero);
4606 mlir::Value result =
4607 builder.create<mlir::arith::SelectOp>(loc, lenIsZero, zero, res2);
4608 if (resultType.isUnsignedInteger())
4609 return builder.createConvert(loc, resultType, result);
4610 return result;
4611}
4612
4613// IBSET
4614mlir::Value IntrinsicLibrary::genIbset(mlir::Type resultType,
4615 llvm::ArrayRef<mlir::Value> args) {
4616 // A conformant IBSET(I,POS) call satisfies:
4617 // POS >= 0
4618 // POS < BIT_SIZE(I)
4619 // Return: I | (1 << POS)
4620 assert(args.size() == 2);
4621 mlir::Type signlessType = mlir::IntegerType::get(
4622 builder.getContext(), resultType.getIntOrFloatBitWidth(),
4623 mlir::IntegerType::SignednessSemantics::Signless);
4624 mlir::Value one = builder.createIntegerConstant(loc, signlessType, 1);
4625 mlir::Value pos = builder.createConvert(loc, signlessType, args[1]);
4626 mlir::Value mask = builder.create<mlir::arith::ShLIOp>(loc, one, pos);
4627 return builder.createUnsigned<mlir::arith::OrIOp>(loc, resultType, args[0],
4628 mask);
4629}
4630
4631// ICHAR
4632fir::ExtendedValue
4633IntrinsicLibrary::genIchar(mlir::Type resultType,
4634 llvm::ArrayRef<fir::ExtendedValue> args) {
4635 // There can be an optional kind in second argument.
4636 assert(args.size() == 2);
4637 const fir::CharBoxValue *charBox = args[0].getCharBox();
4638 if (!charBox)
4639 llvm::report_fatal_error("expected character scalar");
4640
4641 fir::factory::CharacterExprHelper helper{builder, loc};
4642 mlir::Value buffer = charBox->getBuffer();
4643 mlir::Type bufferTy = buffer.getType();
4644 mlir::Value charVal;
4645 if (auto charTy = mlir::dyn_cast<fir::CharacterType>(bufferTy)) {
4646 assert(charTy.singleton());
4647 charVal = buffer;
4648 } else {
4649 // Character is in memory, cast to fir.ref<char> and load.
4650 mlir::Type ty = fir::dyn_cast_ptrEleTy(bufferTy);
4651 if (!ty)
4652 llvm::report_fatal_error("expected memory type");
4653 // The length of in the character type may be unknown. Casting
4654 // to a singleton ref is required before loading.
4655 fir::CharacterType eleType = helper.getCharacterType(ty);
4656 fir::CharacterType charType =
4657 fir::CharacterType::get(builder.getContext(), eleType.getFKind(), 1);
4658 mlir::Type toTy = builder.getRefType(charType);
4659 mlir::Value cast = builder.createConvert(loc, toTy, buffer);
4660 charVal = builder.create<fir::LoadOp>(loc, cast);
4661 }
4662 LLVM_DEBUG(llvm::dbgs() << "ichar(" << charVal << ")\n");
4663 auto code = helper.extractCodeFromSingleton(charVal);
4664 if (code.getType() == resultType)
4665 return code;
4666 return builder.create<mlir::arith::ExtUIOp>(loc, resultType, code);
4667}
4668
4669// llvm floating point class intrinsic test values
4670// 0 Signaling NaN
4671// 1 Quiet NaN
4672// 2 Negative infinity
4673// 3 Negative normal
4674// 4 Negative subnormal
4675// 5 Negative zero
4676// 6 Positive zero
4677// 7 Positive subnormal
4678// 8 Positive normal
4679// 9 Positive infinity
4680static constexpr int finiteTest = 0b0111111000;
4681static constexpr int infiniteTest = 0b1000000100;
4682static constexpr int nanTest = 0b0000000011;
4683static constexpr int negativeTest = 0b0000111100;
4684static constexpr int normalTest = 0b0101101000;
4685static constexpr int positiveTest = 0b1111000000;
4686static constexpr int snanTest = 0b0000000001;
4687static constexpr int subnormalTest = 0b0010010000;
4688static constexpr int zeroTest = 0b0001100000;
4689
4690mlir::Value IntrinsicLibrary::genIsFPClass(mlir::Type resultType,
4691 llvm::ArrayRef<mlir::Value> args,
4692 int fpclass) {
4693 assert(args.size() == 1);
4694 mlir::Type i1Ty = builder.getI1Type();
4695 mlir::Value isfpclass =
4696 builder.create<mlir::LLVM::IsFPClass>(loc, i1Ty, args[0], fpclass);
4697 return builder.createConvert(loc, resultType, isfpclass);
4698}
4699
4700// Generate a quiet NaN of a given floating point type.
4701mlir::Value IntrinsicLibrary::genQNan(mlir::Type resultType) {
4702 return genIeeeValue(resultType, builder.createIntegerConstant(
4703 loc, builder.getIntegerType(8),
4704 _FORTRAN_RUNTIME_IEEE_QUIET_NAN));
4705}
4706
4707// Generate code to raise \p excepts if \p cond is absent, or present and true.
4708void IntrinsicLibrary::genRaiseExcept(int excepts, mlir::Value cond) {
4709 fir::IfOp ifOp;
4710 if (cond) {
4711 ifOp = builder.create<fir::IfOp>(loc, cond, /*withElseRegion=*/false);
4712 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
4713 }
4714 mlir::Type i32Ty = builder.getIntegerType(32);
4715 fir::runtime::genFeraiseexcept(
4716 builder, loc,
4717 fir::runtime::genMapExcept(
4718 builder, loc, builder.createIntegerConstant(loc, i32Ty, excepts)));
4719 if (cond)
4720 builder.setInsertionPointAfter(ifOp);
4721}
4722
4723// Return a reference to the contents of a derived type with one field.
4724// Also return the field type.
4725static std::pair<mlir::Value, mlir::Type>
4726getFieldRef(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value rec,
4727 unsigned index = 0) {
4728 auto recType =
4729 mlir::dyn_cast<fir::RecordType>(fir::unwrapPassByRefType(rec.getType()));
4730 assert(index < recType.getTypeList().size() && "not enough components");
4731 auto [fieldName, fieldTy] = recType.getTypeList()[index];
4732 mlir::Value field = builder.create<fir::FieldIndexOp>(
4733 loc, fir::FieldType::get(recType.getContext()), fieldName, recType,
4734 fir::getTypeParams(rec));
4735 return {builder.create<fir::CoordinateOp>(loc, builder.getRefType(fieldTy),
4736 rec, field),
4737 fieldTy};
4738}
4739
4740// IEEE_CLASS_TYPE OPERATOR(==), OPERATOR(/=)
4741// IEEE_ROUND_TYPE OPERATOR(==), OPERATOR(/=)
4742template <mlir::arith::CmpIPredicate pred>
4743mlir::Value
4744IntrinsicLibrary::genIeeeTypeCompare(mlir::Type resultType,
4745 llvm::ArrayRef<mlir::Value> args) {
4746 assert(args.size() == 2);
4747 auto [leftRef, fieldTy] = getFieldRef(builder, loc, args[0]);
4748 auto [rightRef, ignore] = getFieldRef(builder, loc, args[1]);
4749 mlir::Value left = builder.create<fir::LoadOp>(loc, fieldTy, leftRef);
4750 mlir::Value right = builder.create<fir::LoadOp>(loc, fieldTy, rightRef);
4751 return builder.create<mlir::arith::CmpIOp>(loc, pred, left, right);
4752}
4753
4754// IEEE_CLASS
4755mlir::Value IntrinsicLibrary::genIeeeClass(mlir::Type resultType,
4756 llvm::ArrayRef<mlir::Value> args) {
4757 // Classify REAL argument X as one of 11 IEEE_CLASS_TYPE values via
4758 // a table lookup on an index built from 5 values derived from X.
4759 // In indexing order, the values are:
4760 //
4761 // [s] sign bit
4762 // [e] exponent != 0
4763 // [m] exponent == 1..1 (max exponent)
4764 // [l] low-order significand != 0
4765 // [h] high-order significand (kind=10: 2 bits; other kinds: 1 bit)
4766 //
4767 // kind=10 values have an explicit high-order integer significand bit,
4768 // whereas this bit is implicit for other kinds. This requires using a 6-bit
4769 // index into a 64-slot table for kind=10 argument classification queries
4770 // vs. a 5-bit index into a 32-slot table for other argument kind queries.
4771 // The instruction sequence is the same for the two cases.
4772 //
4773 // Placing the [l] and [h] significand bits in "swapped" order rather than
4774 // "natural" order enables more efficient generated code.
4775
4776 assert(args.size() == 1);
4777 mlir::Value realVal = args[0];
4778 mlir::FloatType realType = mlir::dyn_cast<mlir::FloatType>(realVal.getType());
4779 const unsigned intWidth = realType.getWidth();
4780 mlir::Type intType = builder.getIntegerType(intWidth);
4781 mlir::Value intVal =
4782 builder.create<mlir::arith::BitcastOp>(loc, intType, realVal);
4783 llvm::StringRef tableName = RTNAME_STRING(IeeeClassTable);
4784 uint64_t highSignificandSize = (realType.getWidth() == 80) + 1;
4785
4786 // Get masks and shift counts.
4787 mlir::Value signShift, highSignificandShift, exponentMask, lowSignificandMask;
4788 auto createIntegerConstant = [&](uint64_t k) {
4789 return builder.createIntegerConstant(loc, intType, k);
4790 };
4791 auto createIntegerConstantAPI = [&](const llvm::APInt &apInt) {
4792 return builder.create<mlir::arith::ConstantOp>(
4793 loc, intType, builder.getIntegerAttr(intType, apInt));
4794 };
4795 auto getMasksAndShifts = [&](uint64_t totalSize, uint64_t exponentSize,
4796 uint64_t significandSize,
4797 bool hasExplicitBit = false) {
4798 assert(1 + exponentSize + significandSize == totalSize &&
4799 "invalid floating point fields");
4800 uint64_t lowSignificandSize = significandSize - hasExplicitBit - 1;
4801 signShift = createIntegerConstant(totalSize - 1 - hasExplicitBit - 4);
4802 highSignificandShift = createIntegerConstant(lowSignificandSize);
4803 llvm::APInt exponentMaskAPI =
4804 llvm::APInt::getBitsSet(intWidth, /*lo=*/significandSize,
4805 /*hi=*/significandSize + exponentSize);
4806 exponentMask = createIntegerConstantAPI(exponentMaskAPI);
4807 llvm::APInt lowSignificandMaskAPI =
4808 llvm::APInt::getLowBitsSet(intWidth, lowSignificandSize);
4809 lowSignificandMask = createIntegerConstantAPI(lowSignificandMaskAPI);
4810 };
4811 switch (realType.getWidth()) {
4812 case 16:
4813 if (realType.isF16()) {
4814 // kind=2: 1 sign bit, 5 exponent bits, 10 significand bits
4815 getMasksAndShifts(16, 5, 10);
4816 } else {
4817 // kind=3: 1 sign bit, 8 exponent bits, 7 significand bits
4818 getMasksAndShifts(16, 8, 7);
4819 }
4820 break;
4821 case 32: // kind=4: 1 sign bit, 8 exponent bits, 23 significand bits
4822 getMasksAndShifts(32, 8, 23);
4823 break;
4824 case 64: // kind=8: 1 sign bit, 11 exponent bits, 52 significand bits
4825 getMasksAndShifts(64, 11, 52);
4826 break;
4827 case 80: // kind=10: 1 sign bit, 15 exponent bits, 1+63 significand bits
4828 getMasksAndShifts(80, 15, 64, /*hasExplicitBit=*/true);
4829 tableName = RTNAME_STRING(IeeeClassTable_10);
4830 break;
4831 case 128: // kind=16: 1 sign bit, 15 exponent bits, 112 significand bits
4832 getMasksAndShifts(128, 15, 112);
4833 break;
4834 default:
4835 llvm_unreachable("unknown real type");
4836 }
4837
4838 // [s] sign bit
4839 int pos = 3 + highSignificandSize;
4840 mlir::Value index = builder.create<mlir::arith::AndIOp>(
4841 loc, builder.create<mlir::arith::ShRUIOp>(loc, intVal, signShift),
4842 createIntegerConstant(1ULL << pos));
4843
4844 // [e] exponent != 0
4845 mlir::Value exponent =
4846 builder.create<mlir::arith::AndIOp>(loc, intVal, exponentMask);
4847 mlir::Value zero = createIntegerConstant(0);
4848 index = builder.create<mlir::arith::OrIOp>(
4849 loc, index,
4850 builder.create<mlir::arith::SelectOp>(
4851 loc,
4852 builder.create<mlir::arith::CmpIOp>(
4853 loc, mlir::arith::CmpIPredicate::ne, exponent, zero),
4854 createIntegerConstant(1ULL << --pos), zero));
4855
4856 // [m] exponent == 1..1 (max exponent)
4857 index = builder.create<mlir::arith::OrIOp>(
4858 loc, index,
4859 builder.create<mlir::arith::SelectOp>(
4860 loc,
4861 builder.create<mlir::arith::CmpIOp>(
4862 loc, mlir::arith::CmpIPredicate::eq, exponent, exponentMask),
4863 createIntegerConstant(1ULL << --pos), zero));
4864
4865 // [l] low-order significand != 0
4866 index = builder.create<mlir::arith::OrIOp>(
4867 loc, index,
4868 builder.create<mlir::arith::SelectOp>(
4869 loc,
4870 builder.create<mlir::arith::CmpIOp>(
4871 loc, mlir::arith::CmpIPredicate::ne,
4872 builder.create<mlir::arith::AndIOp>(loc, intVal,
4873 lowSignificandMask),
4874 zero),
4875 createIntegerConstant(1ULL << --pos), zero));
4876
4877 // [h] high-order significand (1 or 2 bits)
4878 index = builder.create<mlir::arith::OrIOp>(
4879 loc, index,
4880 builder.create<mlir::arith::AndIOp>(
4881 loc,
4882 builder.create<mlir::arith::ShRUIOp>(loc, intVal,
4883 highSignificandShift),
4884 createIntegerConstant((1 << highSignificandSize) - 1)));
4885
4886 int tableSize = 1 << (4 + highSignificandSize);
4887 mlir::Type int8Ty = builder.getIntegerType(8);
4888 mlir::Type tableTy = fir::SequenceType::get(tableSize, int8Ty);
4889 if (!builder.getNamedGlobal(tableName)) {
4890 llvm::SmallVector<mlir::Attribute, 64> values;
4891 auto insert = [&](std::int8_t which) {
4892 values.push_back(builder.getIntegerAttr(int8Ty, which));
4893 };
4894 // If indexing value [e] is 0, value [m] can't be 1. (If the exponent is 0,
4895 // it can't be the max exponent). Use IEEE_OTHER_VALUE for impossible
4896 // combinations.
4897 constexpr std::int8_t impossible = _FORTRAN_RUNTIME_IEEE_OTHER_VALUE;
4898 if (tableSize == 32) {
4899 // s e m l h kinds 2,3,4,8,16
4900 // ===================================================================
4901 /* 0 0 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO);
4902 /* 0 0 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
4903 /* 0 0 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
4904 /* 0 0 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
4905 /* 0 0 1 0 0 */ insert(impossible);
4906 /* 0 0 1 0 1 */ insert(impossible);
4907 /* 0 0 1 1 0 */ insert(impossible);
4908 /* 0 0 1 1 1 */ insert(impossible);
4909 /* 0 1 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
4910 /* 0 1 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
4911 /* 0 1 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
4912 /* 0 1 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
4913 /* 0 1 1 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_INF);
4914 /* 0 1 1 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
4915 /* 0 1 1 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);
4916 /* 0 1 1 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
4917 /* 1 0 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO);
4918 /* 1 0 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
4919 /* 1 0 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
4920 /* 1 0 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
4921 /* 1 0 1 0 0 */ insert(impossible);
4922 /* 1 0 1 0 1 */ insert(impossible);
4923 /* 1 0 1 1 0 */ insert(impossible);
4924 /* 1 0 1 1 1 */ insert(impossible);
4925 /* 1 1 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
4926 /* 1 1 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
4927 /* 1 1 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
4928 /* 1 1 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
4929 /* 1 1 1 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_INF);
4930 /* 1 1 1 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
4931 /* 1 1 1 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);
4932 /* 1 1 1 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
4933 } else {
4934 // Unlike values of other kinds, kind=10 values can be "invalid", and
4935 // can appear in code. Use IEEE_OTHER_VALUE for invalid bit patterns.
4936 // Runtime IO may print an invalid value as a NaN.
4937 constexpr std::int8_t invalid = _FORTRAN_RUNTIME_IEEE_OTHER_VALUE;
4938 // s e m l h kind 10
4939 // ===================================================================
4940 /* 0 0 0 0 00 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO);
4941 /* 0 0 0 0 01 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
4942 /* 0 0 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
4943 /* 0 0 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
4944 /* 0 0 0 1 00 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
4945 /* 0 0 0 1 01 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
4946 /* 0 0 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
4947 /* 0 0 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
4948 /* 0 0 1 0 00 */ insert(impossible);
4949 /* 0 0 1 0 01 */ insert(impossible);
4950 /* 0 0 1 0 10 */ insert(impossible);
4951 /* 0 0 1 0 11 */ insert(impossible);
4952 /* 0 0 1 1 00 */ insert(impossible);
4953 /* 0 0 1 1 01 */ insert(impossible);
4954 /* 0 0 1 1 10 */ insert(impossible);
4955 /* 0 0 1 1 11 */ insert(impossible);
4956 /* 0 1 0 0 00 */ insert(invalid);
4957 /* 0 1 0 0 01 */ insert(invalid);
4958 /* 0 1 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
4959 /* 0 1 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
4960 /* 0 1 0 1 00 */ insert(invalid);
4961 /* 0 1 0 1 01 */ insert(invalid);
4962 /* 0 1 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
4963 /* 0 1 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
4964 /* 0 1 1 0 00 */ insert(invalid);
4965 /* 0 1 1 0 01 */ insert(invalid);
4966 /* 0 1 1 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_INF);
4967 /* 0 1 1 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
4968 /* 0 1 1 1 00 */ insert(invalid);
4969 /* 0 1 1 1 01 */ insert(invalid);
4970 /* 0 1 1 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);
4971 /* 0 1 1 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
4972 /* 1 0 0 0 00 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO);
4973 /* 1 0 0 0 01 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
4974 /* 1 0 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
4975 /* 1 0 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
4976 /* 1 0 0 1 00 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
4977 /* 1 0 0 1 01 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
4978 /* 1 0 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
4979 /* 1 0 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
4980 /* 1 0 1 0 00 */ insert(impossible);
4981 /* 1 0 1 0 01 */ insert(impossible);
4982 /* 1 0 1 0 10 */ insert(impossible);
4983 /* 1 0 1 0 11 */ insert(impossible);
4984 /* 1 0 1 1 00 */ insert(impossible);
4985 /* 1 0 1 1 01 */ insert(impossible);
4986 /* 1 0 1 1 10 */ insert(impossible);
4987 /* 1 0 1 1 11 */ insert(impossible);
4988 /* 1 1 0 0 00 */ insert(invalid);
4989 /* 1 1 0 0 01 */ insert(invalid);
4990 /* 1 1 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
4991 /* 1 1 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
4992 /* 1 1 0 1 00 */ insert(invalid);
4993 /* 1 1 0 1 01 */ insert(invalid);
4994 /* 1 1 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
4995 /* 1 1 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
4996 /* 1 1 1 0 00 */ insert(invalid);
4997 /* 1 1 1 0 01 */ insert(invalid);
4998 /* 1 1 1 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_INF);
4999 /* 1 1 1 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
5000 /* 1 1 1 1 00 */ insert(invalid);
5001 /* 1 1 1 1 01 */ insert(invalid);
5002 /* 1 1 1 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);
5003 /* 1 1 1 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
5004 }
5005 builder.createGlobalConstant(
5006 loc, tableTy, tableName, builder.createLinkOnceLinkage(),
5007 mlir::DenseElementsAttr::get(
5008 mlir::RankedTensorType::get(tableSize, int8Ty), values));
5009 }
5010
5011 return builder.create<fir::CoordinateOp>(
5012 loc, builder.getRefType(resultType),
5013 builder.create<fir::AddrOfOp>(loc, builder.getRefType(tableTy),
5014 builder.getSymbolRefAttr(tableName)),
5015 index);
5016}
5017
5018// IEEE_COPY_SIGN
5019mlir::Value
5020IntrinsicLibrary::genIeeeCopySign(mlir::Type resultType,
5021 llvm::ArrayRef<mlir::Value> args) {
5022 // Copy the sign of REAL arg Y to REAL arg X.
5023 assert(args.size() == 2);
5024 mlir::Value xRealVal = args[0];
5025 mlir::Value yRealVal = args[1];
5026 mlir::FloatType xRealType =
5027 mlir::dyn_cast<mlir::FloatType>(xRealVal.getType());
5028 mlir::FloatType yRealType =
5029 mlir::dyn_cast<mlir::FloatType>(yRealVal.getType());
5030
5031 if (yRealType == mlir::BFloat16Type::get(builder.getContext())) {
5032 // Workaround: CopySignOp and BitcastOp don't work for kind 3 arg Y.
5033 // This conversion should always preserve the sign bit.
5034 yRealVal = builder.createConvert(
5035 loc, mlir::Float32Type::get(builder.getContext()), yRealVal);
5036 yRealType = mlir::Float32Type::get(builder.getContext());
5037 }
5038
5039 // Args have the same type.
5040 if (xRealType == yRealType)
5041 return builder.create<mlir::math::CopySignOp>(loc, xRealVal, yRealVal);
5042
5043 // Args have different types.
5044 mlir::Type xIntType = builder.getIntegerType(xRealType.getWidth());
5045 mlir::Type yIntType = builder.getIntegerType(yRealType.getWidth());
5046 mlir::Value xIntVal =
5047 builder.create<mlir::arith::BitcastOp>(loc, xIntType, xRealVal);
5048 mlir::Value yIntVal =
5049 builder.create<mlir::arith::BitcastOp>(loc, yIntType, yRealVal);
5050 mlir::Value xZero = builder.createIntegerConstant(loc, xIntType, 0);
5051 mlir::Value yZero = builder.createIntegerConstant(loc, yIntType, 0);
5052 mlir::Value xOne = builder.createIntegerConstant(loc, xIntType, 1);
5053 mlir::Value ySign = builder.create<mlir::arith::ShRUIOp>(
5054 loc, yIntVal,
5055 builder.createIntegerConstant(loc, yIntType, yRealType.getWidth() - 1));
5056 mlir::Value xAbs = builder.create<mlir::arith::ShRUIOp>(
5057 loc, builder.create<mlir::arith::ShLIOp>(loc, xIntVal, xOne), xOne);
5058 mlir::Value xSign = builder.create<mlir::arith::SelectOp>(
5059 loc,
5060 builder.create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::eq,
5061 ySign, yZero),
5062 xZero,
5063 builder.create<mlir::arith::ShLIOp>(
5064 loc, xOne,
5065 builder.createIntegerConstant(loc, xIntType,
5066 xRealType.getWidth() - 1)));
5067 return builder.create<mlir::arith::BitcastOp>(
5068 loc, xRealType, builder.create<mlir::arith::OrIOp>(loc, xAbs, xSign));
5069}
5070
5071// IEEE_GET_FLAG
5072void IntrinsicLibrary::genIeeeGetFlag(llvm::ArrayRef<fir::ExtendedValue> args) {
5073 assert(args.size() == 2);
5074 // Set FLAG_VALUE=.TRUE. if the exception specified by FLAG is signaling.
5075 mlir::Value flag = fir::getBase(args[0]);
5076 mlir::Value flagValue = fir::getBase(args[1]);
5077 mlir::Type resultTy =
5078 mlir::dyn_cast<fir::ReferenceType>(flagValue.getType()).getEleTy();
5079 mlir::Type i32Ty = builder.getIntegerType(32);
5080 mlir::Value zero = builder.createIntegerConstant(loc, i32Ty, 0);
5081 auto [fieldRef, ignore] = getFieldRef(builder, loc, flag);
5082 mlir::Value field = builder.create<fir::LoadOp>(loc, fieldRef);
5083 mlir::Value excepts = fir::runtime::genFetestexcept(
5084 builder, loc,
5085 fir::runtime::genMapExcept(
5086 builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, field)));
5087 mlir::Value logicalResult = builder.create<fir::ConvertOp>(
5088 loc, resultTy,
5089 builder.create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::ne,
5090 excepts, zero));
5091 builder.create<fir::StoreOp>(loc, logicalResult, flagValue);
5092}
5093
5094// IEEE_GET_HALTING_MODE
5095void IntrinsicLibrary::genIeeeGetHaltingMode(
5096 llvm::ArrayRef<fir::ExtendedValue> args) {
5097 // Set HALTING=.TRUE. if the exception specified by FLAG will cause halting.
5098 assert(args.size() == 2);
5099 mlir::Value flag = fir::getBase(args[0]);
5100 mlir::Value halting = fir::getBase(args[1]);
5101 mlir::Type resultTy =
5102 mlir::dyn_cast<fir::ReferenceType>(halting.getType()).getEleTy();
5103 mlir::Type i32Ty = builder.getIntegerType(32);
5104 mlir::Value zero = builder.createIntegerConstant(loc, i32Ty, 0);
5105 auto [fieldRef, ignore] = getFieldRef(builder, loc, flag);
5106 mlir::Value field = builder.create<fir::LoadOp>(loc, fieldRef);
5107 mlir::Value haltSet = fir::runtime::genFegetexcept(builder, loc);
5108 mlir::Value intResult = builder.create<mlir::arith::AndIOp>(
5109 loc, haltSet,
5110 fir::runtime::genMapExcept(
5111 builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, field)));
5112 mlir::Value logicalResult = builder.create<fir::ConvertOp>(
5113 loc, resultTy,
5114 builder.create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::ne,
5115 intResult, zero));
5116 builder.create<fir::StoreOp>(loc, logicalResult, halting);
5117}
5118
5119// IEEE_GET_MODES, IEEE_SET_MODES
5120// IEEE_GET_STATUS, IEEE_SET_STATUS
5121template <bool isGet, bool isModes>
5122void IntrinsicLibrary::genIeeeGetOrSetModesOrStatus(
5123 llvm::ArrayRef<fir::ExtendedValue> args) {
5124 assert(args.size() == 1);
5125#ifndef __GLIBC_USE_IEC_60559_BFP_EXT // only use of "#include <cfenv>"
5126 // No definitions of fegetmode, fesetmode
5127 llvm::StringRef func = isModes
5128 ? (isGet ? "ieee_get_modes" : "ieee_set_modes")
5129 : (isGet ? "ieee_get_status" : "ieee_set_status");
5130 TODO(loc, "intrinsic module procedure: " + func);
5131#else
5132 mlir::Type i32Ty = builder.getIntegerType(32);
5133 mlir::Type i64Ty = builder.getIntegerType(64);
5134 mlir::Type ptrTy = builder.getRefType(i32Ty);
5135 mlir::Value addr;
5136 if (fir::getTargetTriple(builder.getModule()).isSPARC()) {
5137 // Floating point environment data is larger than the __data field
5138 // allotment. Allocate data space from the heap.
5139 auto [fieldRef, fieldTy] =
5140 getFieldRef(builder, loc, fir::getBase(args[0]), 1);
5141 addr = builder.create<fir::BoxAddrOp>(
5142 loc, builder.create<fir::LoadOp>(loc, fieldRef));
5143 mlir::Type heapTy = addr.getType();
5144 mlir::Value allocated = builder.create<mlir::arith::CmpIOp>(
5145 loc, mlir::arith::CmpIPredicate::ne,
5146 builder.createConvert(loc, i64Ty, addr),
5147 builder.createIntegerConstant(loc, i64Ty, 0));
5148 auto ifOp = builder.create<fir::IfOp>(loc, heapTy, allocated,
5149 /*withElseRegion=*/true);
5150 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
5151 builder.create<fir::ResultOp>(loc, addr);
5152 builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
5153 mlir::Value byteSize =
5154 isModes ? fir::runtime::genGetModesTypeSize(builder, loc)
5155 : fir::runtime::genGetStatusTypeSize(builder, loc);
5156 byteSize = builder.createConvert(loc, builder.getIndexType(), byteSize);
5157 addr = builder.create<fir::AllocMemOp>(loc, extractSequenceType(heapTy),
5158 /*typeparams=*/mlir::ValueRange(),
5159 byteSize);
5160 mlir::Value shape = builder.create<fir::ShapeOp>(loc, byteSize);
5161 builder.create<fir::StoreOp>(
5162 loc, builder.create<fir::EmboxOp>(loc, fieldTy, addr, shape), fieldRef);
5163 builder.create<fir::ResultOp>(loc, addr);
5164 builder.setInsertionPointAfter(ifOp);
5165 addr = builder.create<fir::ConvertOp>(loc, ptrTy, ifOp.getResult(0));
5166 } else {
5167 // Place floating point environment data in __data storage.
5168 addr = builder.create<fir::ConvertOp>(loc, ptrTy, getBase(args[0]));
5169 }
5170 llvm::StringRef func = isModes ? (isGet ? "fegetmode" : "fesetmode")
5171 : (isGet ? "fegetenv" : "fesetenv");
5172 genRuntimeCall(func, i32Ty, addr);
5173#endif
5174}
5175
5176// Check that an explicit ieee_[get|set]_rounding_mode call radix value is 2.
5177static void checkRadix(fir::FirOpBuilder &builder, mlir::Location loc,
5178 mlir::Value radix, std::string procName) {
5179 mlir::Value notTwo = builder.create<mlir::arith::CmpIOp>(
5180 loc, mlir::arith::CmpIPredicate::ne, radix,
5181 builder.createIntegerConstant(loc, radix.getType(), 2));
5182 auto ifOp = builder.create<fir::IfOp>(loc, notTwo,
5183 /*withElseRegion=*/false);
5184 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
5185 fir::runtime::genReportFatalUserError(builder, loc,
5186 procName + " radix argument must be 2");
5187 builder.setInsertionPointAfter(ifOp);
5188}
5189
5190// IEEE_GET_ROUNDING_MODE
5191void IntrinsicLibrary::genIeeeGetRoundingMode(
5192 llvm::ArrayRef<fir::ExtendedValue> args) {
5193 // Set arg ROUNDING_VALUE to the current floating point rounding mode.
5194 // Values are chosen to match the llvm.get.rounding encoding.
5195 // Generate an error if the value of optional arg RADIX is not 2.
5196 assert(args.size() == 1 || args.size() == 2);
5197 if (args.size() == 2)
5198 checkRadix(builder, loc, fir::getBase(args[1]), "ieee_get_rounding_mode");
5199 auto [fieldRef, fieldTy] = getFieldRef(builder, loc, fir::getBase(args[0]));
5200 mlir::func::FuncOp getRound = fir::factory::getLlvmGetRounding(builder);
5201 mlir::Value mode = builder.create<fir::CallOp>(loc, getRound).getResult(0);
5202 mode = builder.createConvert(loc, fieldTy, mode);
5203 builder.create<fir::StoreOp>(loc, mode, fieldRef);
5204}
5205
5206// IEEE_GET_UNDERFLOW_MODE
5207void IntrinsicLibrary::genIeeeGetUnderflowMode(
5208 llvm::ArrayRef<fir::ExtendedValue> args) {
5209 assert(args.size() == 1);
5210 mlir::Value flag = fir::runtime::genGetUnderflowMode(builder, loc);
5211 builder.createStoreWithConvert(loc, flag, fir::getBase(args[0]));
5212}
5213
5214// IEEE_INT
5215mlir::Value IntrinsicLibrary::genIeeeInt(mlir::Type resultType,
5216 llvm::ArrayRef<mlir::Value> args) {
5217 // Convert real argument A to an integer, with rounding according to argument
5218 // ROUND. Signal IEEE_INVALID if A is a NaN, an infinity, or out of range,
5219 // and return either the largest or smallest integer result value (*).
5220 // For valid results (when IEEE_INVALID is not signaled), signal IEEE_INEXACT
5221 // if A is not an exact integral value (*). The (*) choices are processor
5222 // dependent implementation choices not mandated by the standard.
5223 // The primary result is generated with a call to IEEE_RINT.
5224 assert(args.size() == 3);
5225 mlir::FloatType realType = mlir::cast<mlir::FloatType>(args[0].getType());
5226 mlir::Value realResult = genIeeeRint(realType, {args[0], args[1]});
5227 int intWidth = mlir::cast<mlir::IntegerType>(resultType).getWidth();
5228 mlir::Value intLBound = builder.create<mlir::arith::ConstantOp>(
5229 loc, resultType,
5230 builder.getIntegerAttr(resultType,
5231 llvm::APInt::getBitsSet(intWidth,
5232 /*lo=*/intWidth - 1,
5233 /*hi=*/intWidth)));
5234 mlir::Value intUBound = builder.create<mlir::arith::ConstantOp>(
5235 loc, resultType,
5236 builder.getIntegerAttr(resultType,
5237 llvm::APInt::getBitsSet(intWidth, /*lo=*/0,
5238 /*hi=*/intWidth - 1)));
5239 mlir::Value realLBound =
5240 builder.create<fir::ConvertOp>(loc, realType, intLBound);
5241 mlir::Value realUBound = builder.create<mlir::arith::NegFOp>(loc, realLBound);
5242 mlir::Value aGreaterThanLBound = builder.create<mlir::arith::CmpFOp>(
5243 loc, mlir::arith::CmpFPredicate::OGE, realResult, realLBound);
5244 mlir::Value aLessThanUBound = builder.create<mlir::arith::CmpFOp>(
5245 loc, mlir::arith::CmpFPredicate::OLT, realResult, realUBound);
5246 mlir::Value resultIsValid = builder.create<mlir::arith::AndIOp>(
5247 loc, aGreaterThanLBound, aLessThanUBound);
5248
5249 // Result is valid. It may be exact or inexact.
5250 mlir::Value result;
5251 fir::IfOp ifOp = builder.create<fir::IfOp>(loc, resultType, resultIsValid,
5252 /*withElseRegion=*/true);
5253 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
5254 mlir::Value inexact = builder.create<mlir::arith::CmpFOp>(
5255 loc, mlir::arith::CmpFPredicate::ONE, args[0], realResult);
5256 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INEXACT, inexact);
5257 result = builder.create<fir::ConvertOp>(loc, resultType, realResult);
5258 builder.create<fir::ResultOp>(loc, result);
5259
5260 // Result is invalid.
5261 builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
5262 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID);
5263 result = builder.create<mlir::arith::SelectOp>(loc, aGreaterThanLBound,
5264 intUBound, intLBound);
5265 builder.create<fir::ResultOp>(loc, result);
5266 builder.setInsertionPointAfter(ifOp);
5267 return ifOp.getResult(0);
5268}
5269
5270// IEEE_IS_FINITE
5271mlir::Value
5272IntrinsicLibrary::genIeeeIsFinite(mlir::Type resultType,
5273 llvm::ArrayRef<mlir::Value> args) {
5274 // Check if arg X is a (negative or positive) (normal, denormal, or zero).
5275 assert(args.size() == 1);
5276 return genIsFPClass(resultType, args, finiteTest);
5277}
5278
5279// IEEE_IS_NAN
5280mlir::Value IntrinsicLibrary::genIeeeIsNan(mlir::Type resultType,
5281 llvm::ArrayRef<mlir::Value> args) {
5282 // Check if arg X is a (signaling or quiet) NaN.
5283 assert(args.size() == 1);
5284 return genIsFPClass(resultType, args, nanTest);
5285}
5286
5287// IEEE_IS_NEGATIVE
5288mlir::Value
5289IntrinsicLibrary::genIeeeIsNegative(mlir::Type resultType,
5290 llvm::ArrayRef<mlir::Value> args) {
5291 // Check if arg X is a negative (infinity, normal, denormal or zero).
5292 assert(args.size() == 1);
5293 return genIsFPClass(resultType, args, negativeTest);
5294}
5295
5296// IEEE_IS_NORMAL
5297mlir::Value
5298IntrinsicLibrary::genIeeeIsNormal(mlir::Type resultType,
5299 llvm::ArrayRef<mlir::Value> args) {
5300 // Check if arg X is a (negative or positive) (normal or zero).
5301 assert(args.size() == 1);
5302 return genIsFPClass(resultType, args, normalTest);
5303}
5304
5305// IEEE_LOGB
5306mlir::Value IntrinsicLibrary::genIeeeLogb(mlir::Type resultType,
5307 llvm::ArrayRef<mlir::Value> args) {
5308 // Exponent of X, with special case treatment for some input values.
5309 // Return: X == 0
5310 // ? -infinity (and raise FE_DIVBYZERO)
5311 // : ieee_is_finite(X)
5312 // ? exponent(X) - 1 // unbiased exponent of X
5313 // : ieee_copy_sign(X, 1.0) // +infinity or NaN
5314 assert(args.size() == 1);
5315 mlir::Value realVal = args[0];
5316 mlir::FloatType realType = mlir::dyn_cast<mlir::FloatType>(realVal.getType());
5317 int bitWidth = realType.getWidth();
5318 mlir::Type intType = builder.getIntegerType(realType.getWidth());
5319 mlir::Value intVal =
5320 builder.create<mlir::arith::BitcastOp>(loc, intType, realVal);
5321 mlir::Type i1Ty = builder.getI1Type();
5322
5323 int exponentBias, significandSize, nonSignificandSize;
5324 switch (bitWidth) {
5325 case 16:
5326 if (realType.isF16()) {
5327 // kind=2: 1 sign bit, 5 exponent bits, 10 significand bits
5328 exponentBias = (1 << (5 - 1)) - 1; // 15
5329 significandSize = 10;
5330 nonSignificandSize = 6;
5331 break;
5332 }
5333 assert(realType.isBF16() && "unknown 16-bit real type");
5334 // kind=3: 1 sign bit, 8 exponent bits, 7 significand bits
5335 exponentBias = (1 << (8 - 1)) - 1; // 127
5336 significandSize = 7;
5337 nonSignificandSize = 9;
5338 break;
5339 case 32:
5340 // kind=4: 1 sign bit, 8 exponent bits, 23 significand bits
5341 exponentBias = (1 << (8 - 1)) - 1; // 127
5342 significandSize = 23;
5343 nonSignificandSize = 9;
5344 break;
5345 case 64:
5346 // kind=8: 1 sign bit, 11 exponent bits, 52 significand bits
5347 exponentBias = (1 << (11 - 1)) - 1; // 1023
5348 significandSize = 52;
5349 nonSignificandSize = 12;
5350 break;
5351 case 80:
5352 // kind=10: 1 sign bit, 15 exponent bits, 1+63 significand bits
5353 exponentBias = (1 << (15 - 1)) - 1; // 16383
5354 significandSize = 64;
5355 nonSignificandSize = 16 + 1;
5356 break;
5357 case 128:
5358 // kind=16: 1 sign bit, 15 exponent bits, 112 significand bits
5359 exponentBias = (1 << (15 - 1)) - 1; // 16383
5360 significandSize = 112;
5361 nonSignificandSize = 16;
5362 break;
5363 default:
5364 llvm_unreachable("unknown real type");
5365 }
5366
5367 mlir::Value isZero = builder.create<mlir::arith::CmpFOp>(
5368 loc, mlir::arith::CmpFPredicate::OEQ, realVal,
5369 builder.createRealZeroConstant(loc, resultType));
5370 auto outerIfOp = builder.create<fir::IfOp>(loc, resultType, isZero,
5371 /*withElseRegion=*/true);
5372 // X is zero -- result is -infinity
5373 builder.setInsertionPointToStart(&outerIfOp.getThenRegion().front());
5374 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO);
5375 mlir::Value ones = builder.createAllOnesInteger(loc, intType);
5376 mlir::Value result = builder.create<mlir::arith::ShLIOp>(
5377 loc, ones,
5378 builder.createIntegerConstant(loc, intType,
5379 // kind=10 high-order bit is explicit
5380 significandSize - (bitWidth == 80)));
5381 result = builder.create<mlir::arith::BitcastOp>(loc, resultType, result);
5382 builder.create<fir::ResultOp>(loc, result);
5383
5384 builder.setInsertionPointToStart(&outerIfOp.getElseRegion().front());
5385 mlir::Value one = builder.createIntegerConstant(loc, intType, 1);
5386 mlir::Value shiftLeftOne =
5387 builder.create<mlir::arith::ShLIOp>(loc, intVal, one);
5388 mlir::Value isFinite = genIsFPClass(i1Ty, args, finiteTest);
5389 auto innerIfOp = builder.create<fir::IfOp>(loc, resultType, isFinite,
5390 /*withElseRegion=*/true);
5391 // X is non-zero finite -- result is unbiased exponent of X
5392 builder.setInsertionPointToStart(&innerIfOp.getThenRegion().front());
5393 mlir::Value isNormal = genIsFPClass(i1Ty, args, normalTest);
5394 auto normalIfOp = builder.create<fir::IfOp>(loc, resultType, isNormal,
5395 /*withElseRegion=*/true);
5396 // X is normal
5397 builder.setInsertionPointToStart(&normalIfOp.getThenRegion().front());
5398 mlir::Value biasedExponent = builder.create<mlir::arith::ShRUIOp>(
5399 loc, shiftLeftOne,
5400 builder.createIntegerConstant(loc, intType, significandSize + 1));
5401 result = builder.create<mlir::arith::SubIOp>(
5402 loc, biasedExponent,
5403 builder.createIntegerConstant(loc, intType, exponentBias));
5404 result = builder.create<fir::ConvertOp>(loc, resultType, result);
5405 builder.create<fir::ResultOp>(loc, result);
5406
5407 // X is denormal -- result is (-exponentBias - ctlz(significand))
5408 builder.setInsertionPointToStart(&normalIfOp.getElseRegion().front());
5409 mlir::Value significand = builder.create<mlir::arith::ShLIOp>(
5410 loc, intVal,
5411 builder.createIntegerConstant(loc, intType, nonSignificandSize));
5412 mlir::Value ctlz =
5413 builder.create<mlir::math::CountLeadingZerosOp>(loc, significand);
5414 mlir::Type i32Ty = builder.getI32Type();
5415 result = builder.create<mlir::arith::SubIOp>(
5416 loc, builder.createIntegerConstant(loc, i32Ty, -exponentBias),
5417 builder.create<fir::ConvertOp>(loc, i32Ty, ctlz));
5418 result = builder.create<fir::ConvertOp>(loc, resultType, result);
5419 builder.create<fir::ResultOp>(loc, result);
5420
5421 builder.setInsertionPointToEnd(&innerIfOp.getThenRegion().front());
5422 builder.create<fir::ResultOp>(loc, normalIfOp.getResult(0));
5423
5424 // X is infinity or NaN -- result is +infinity or NaN
5425 builder.setInsertionPointToStart(&innerIfOp.getElseRegion().front());
5426 result = builder.create<mlir::arith::ShRUIOp>(loc, shiftLeftOne, one);
5427 result = builder.create<mlir::arith::BitcastOp>(loc, resultType, result);
5428 builder.create<fir::ResultOp>(loc, result);
5429
5430 // Unwind the if nest.
5431 builder.setInsertionPointToEnd(&outerIfOp.getElseRegion().front());
5432 builder.create<fir::ResultOp>(loc, innerIfOp.getResult(0));
5433 builder.setInsertionPointAfter(outerIfOp);
5434 return outerIfOp.getResult(0);
5435}
5436
5437// IEEE_MAX, IEEE_MAX_MAG, IEEE_MAX_NUM, IEEE_MAX_NUM_MAG
5438// IEEE_MIN, IEEE_MIN_MAG, IEEE_MIN_NUM, IEEE_MIN_NUM_MAG
5439template <bool isMax, bool isNum, bool isMag>
5440mlir::Value IntrinsicLibrary::genIeeeMaxMin(mlir::Type resultType,
5441 llvm::ArrayRef<mlir::Value> args) {
5442 // Maximum/minimum of X and Y with special case treatment of NaN operands.
5443 // The f18 definitions of these procedures (where applicable) are incomplete.
5444 // And f18 results involving NaNs are different from and incompatible with
5445 // f23 results. This code implements the f23 procedures.
5446 // For IEEE_MAX_MAG and IEEE_MAX_NUM_MAG:
5447 // if (ABS(X) > ABS(Y))
5448 // return X
5449 // else if (ABS(Y) > ABS(X))
5450 // return Y
5451 // else if (ABS(X) == ABS(Y))
5452 // return IEEE_SIGNBIT(Y) ? X : Y
5453 // // X or Y or both are NaNs
5454 // if (X is an sNaN or Y is an sNaN) raise FE_INVALID
5455 // if (IEEE_MAX_NUM_MAG and X is not a NaN) return X
5456 // if (IEEE_MAX_NUM_MAG and Y is not a NaN) return Y
5457 // return a qNaN
5458 // For IEEE_MAX, IEEE_MAX_NUM: compare X vs. Y rather than ABS(X) vs. ABS(Y)
5459 // IEEE_MIN, IEEE_MIN_MAG, IEEE_MIN_NUM, IEEE_MIN_NUM_MAG: invert comparisons
5460 assert(args.size() == 2);
5461 mlir::Value x = args[0];
5462 mlir::Value y = args[1];
5463 mlir::Value x1, y1; // X or ABS(X), Y or ABS(Y)
5464 if constexpr (isMag) {
5465 mlir::Value zero = builder.createRealZeroConstant(loc, resultType);
5466 x1 = builder.create<mlir::math::CopySignOp>(loc, x, zero);
5467 y1 = builder.create<mlir::math::CopySignOp>(loc, y, zero);
5468 } else {
5469 x1 = x;
5470 y1 = y;
5471 }
5472 mlir::Type i1Ty = builder.getI1Type();
5473 mlir::arith::CmpFPredicate pred;
5474 mlir::Value cmp, result, resultIsX, resultIsY;
5475
5476 // X1 < Y1 -- MAX result is Y; MIN result is X.
5477 pred = mlir::arith::CmpFPredicate::OLT;
5478 cmp = builder.create<mlir::arith::CmpFOp>(loc, pred, x1, y1);
5479 auto ifOp1 = builder.create<fir::IfOp>(loc, resultType, cmp, true);
5480 builder.setInsertionPointToStart(&ifOp1.getThenRegion().front());
5481 result = isMax ? y : x;
5482 builder.create<fir::ResultOp>(loc, result);
5483
5484 // X1 > Y1 -- MAX result is X; MIN result is Y.
5485 builder.setInsertionPointToStart(&ifOp1.getElseRegion().front());
5486 pred = mlir::arith::CmpFPredicate::OGT;
5487 cmp = builder.create<mlir::arith::CmpFOp>(loc, pred, x1, y1);
5488 auto ifOp2 = builder.create<fir::IfOp>(loc, resultType, cmp, true);
5489 builder.setInsertionPointToStart(&ifOp2.getThenRegion().front());
5490 result = isMax ? x : y;
5491 builder.create<fir::ResultOp>(loc, result);
5492
5493 // X1 == Y1 -- MAX favors a positive result; MIN favors a negative result.
5494 builder.setInsertionPointToStart(&ifOp2.getElseRegion().front());
5495 pred = mlir::arith::CmpFPredicate::OEQ;
5496 cmp = builder.create<mlir::arith::CmpFOp>(loc, pred, x1, y1);
5497 auto ifOp3 = builder.create<fir::IfOp>(loc, resultType, cmp, true);
5498 builder.setInsertionPointToStart(&ifOp3.getThenRegion().front());
5499 resultIsX = isMax ? genIsFPClass(i1Ty, x, positiveTest)
5500 : genIsFPClass(i1Ty, x, negativeTest);
5501 result = builder.create<mlir::arith::SelectOp>(loc, resultIsX, x, y);
5502 builder.create<fir::ResultOp>(loc, result);
5503
5504 // X or Y or both are NaNs -- result may be X, Y, or a qNaN
5505 builder.setInsertionPointToStart(&ifOp3.getElseRegion().front());
5506 if constexpr (isNum) {
5507 pred = mlir::arith::CmpFPredicate::ORD; // check for a non-NaN
5508 resultIsX = builder.create<mlir::arith::CmpFOp>(loc, pred, x, x);
5509 resultIsY = builder.create<mlir::arith::CmpFOp>(loc, pred, y, y);
5510 } else {
5511 resultIsX = resultIsY = builder.createBool(loc, false);
5512 }
5513 result = builder.create<mlir::arith::SelectOp>(
5514 loc, resultIsX, x,
5515 builder.create<mlir::arith::SelectOp>(loc, resultIsY, y,
5516 genQNan(resultType)));
5517 mlir::Value hasSNaNOp = builder.create<mlir::arith::OrIOp>(
5518 loc, genIsFPClass(builder.getI1Type(), args[0], snanTest),
5519 genIsFPClass(builder.getI1Type(), args[1], snanTest));
5520 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID, hasSNaNOp);
5521 builder.create<fir::ResultOp>(loc, result);
5522
5523 // Unwind the if nest.
5524 builder.setInsertionPointAfter(ifOp3);
5525 builder.create<fir::ResultOp>(loc, ifOp3.getResult(0));
5526 builder.setInsertionPointAfter(ifOp2);
5527 builder.create<fir::ResultOp>(loc, ifOp2.getResult(0));
5528 builder.setInsertionPointAfter(ifOp1);
5529 return ifOp1.getResult(0);
5530}
5531
5532// IEEE_QUIET_EQ, IEEE_QUIET_GE, IEEE_QUIET_GT,
5533// IEEE_QUIET_LE, IEEE_QUIET_LT, IEEE_QUIET_NE
5534template <mlir::arith::CmpFPredicate pred>
5535mlir::Value
5536IntrinsicLibrary::genIeeeQuietCompare(mlir::Type resultType,
5537 llvm::ArrayRef<mlir::Value> args) {
5538 // Compare X and Y with special case treatment of NaN operands.
5539 assert(args.size() == 2);
5540 mlir::Value hasSNaNOp = builder.create<mlir::arith::OrIOp>(
5541 loc, genIsFPClass(builder.getI1Type(), args[0], snanTest),
5542 genIsFPClass(builder.getI1Type(), args[1], snanTest));
5543 mlir::Value res =
5544 builder.create<mlir::arith::CmpFOp>(loc, pred, args[0], args[1]);
5545 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID, hasSNaNOp);
5546 return builder.create<fir::ConvertOp>(loc, resultType, res);
5547}
5548
5549// IEEE_REAL
5550mlir::Value IntrinsicLibrary::genIeeeReal(mlir::Type resultType,
5551 llvm::ArrayRef<mlir::Value> args) {
5552 // Convert integer or real argument A to a real of a specified kind.
5553 // Round according to the current rounding mode.
5554 // Signal IEEE_INVALID if A is an sNaN, and return a qNaN.
5555 // Signal IEEE_UNDERFLOW for an inexact subnormal or zero result.
5556 // Signal IEEE_OVERFLOW if A is finite and the result is infinite.
5557 // Signal IEEE_INEXACT for an inexact result.
5558 //
5559 // if (type(a) == resultType) {
5560 // // Conversion to the same type is a nop except for sNaN processing.
5561 // result = a
5562 // } else {
5563 // result = r = real(a, kind(result))
5564 // // Conversion to a larger type is exact.
5565 // if (c_sizeof(a) >= c_sizeof(r)) {
5566 // b = (a is integer) ? int(r, kind(a)) : real(r, kind(a))
5567 // if (a == b || isNaN(a)) {
5568 // // a is {-0, +0, -inf, +inf, NaN} or exact; result is r
5569 // } else {
5570 // // odd(r) is true if the low bit of significand(r) is 1
5571 // // rounding mode ieee_other is an alias for mode ieee_nearest
5572 // if (a < b) {
5573 // if (mode == ieee_nearest && odd(r)) result = ieee_next_down(r)
5574 // if (mode == ieee_other && odd(r)) result = ieee_next_down(r)
5575 // if (mode == ieee_to_zero && a > 0) result = ieee_next_down(r)
5576 // if (mode == ieee_away && a < 0) result = ieee_next_down(r)
5577 // if (mode == ieee_down) result = ieee_next_down(r)
5578 // } else { // a > b
5579 // if (mode == ieee_nearest && odd(r)) result = ieee_next_up(r)
5580 // if (mode == ieee_other && odd(r)) result = ieee_next_up(r)
5581 // if (mode == ieee_to_zero && a < 0) result = ieee_next_up(r)
5582 // if (mode == ieee_away && a > 0) result = ieee_next_up(r)
5583 // if (mode == ieee_up) result = ieee_next_up(r)
5584 // }
5585 // }
5586 // }
5587 // }
5588
5589 assert(args.size() == 2);
5590 mlir::Type i1Ty = builder.getI1Type();
5591 mlir::Type f32Ty = mlir::Float32Type::get(builder.getContext());
5592 mlir::Value a = args[0];
5593 mlir::Type aType = a.getType();
5594
5595 // If the argument is an sNaN, raise an invalid exception and return a qNaN.
5596 // Otherwise return the argument.
5597 auto processSnan = [&](mlir::Value x) {
5598 fir::IfOp ifOp = builder.create<fir::IfOp>(loc, resultType,
5599 genIsFPClass(i1Ty, x, snanTest),
5600 /*withElseRegion=*/true);
5601 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
5602 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID);
5603 builder.create<fir::ResultOp>(loc, genQNan(resultType));
5604 builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
5605 builder.create<fir::ResultOp>(loc, x);
5606 builder.setInsertionPointAfter(ifOp);
5607 return ifOp.getResult(0);
5608 };
5609
5610 // Conversion is a nop, except that A may be an sNaN.
5611 if (resultType == aType)
5612 return processSnan(a);
5613
5614 // Can't directly convert between kind=2 and kind=3.
5615 mlir::Value r, r1;
5616 if ((aType.isBF16() && resultType.isF16()) ||
5617 (aType.isF16() && resultType.isBF16())) {
5618 a = builder.createConvert(loc, f32Ty, a);
5619 aType = f32Ty;
5620 }
5621 r = builder.create<fir::ConvertOp>(loc, resultType, a);
5622
5623 mlir::IntegerType aIntType = mlir::dyn_cast<mlir::IntegerType>(aType);
5624 mlir::FloatType aFloatType = mlir::dyn_cast<mlir::FloatType>(aType);
5625 mlir::FloatType resultFloatType = mlir::dyn_cast<mlir::FloatType>(resultType);
5626
5627 // Conversion from a smaller type to a larger type is exact.
5628 if ((aIntType ? aIntType.getWidth() : aFloatType.getWidth()) <
5629 resultFloatType.getWidth())
5630 return aIntType ? r : processSnan(r);
5631
5632 // A possibly inexact conversion result may need to be rounded up or down.
5633 mlir::Value b = builder.create<fir::ConvertOp>(loc, aType, r);
5634 mlir::Value aEqB;
5635 if (aIntType)
5636 aEqB = builder.create<mlir::arith::CmpIOp>(
5637 loc, mlir::arith::CmpIPredicate::eq, a, b);
5638 else
5639 aEqB = builder.create<mlir::arith::CmpFOp>(
5640 loc, mlir::arith::CmpFPredicate::UEQ, a, b);
5641
5642 // [a == b] a is a NaN or r is exact (a may be -0, +0, -inf, +inf) -- return r
5643 fir::IfOp ifOp1 = builder.create<fir::IfOp>(loc, resultType, aEqB,
5644 /*withElseRegion=*/true);
5645 builder.setInsertionPointToStart(&ifOp1.getThenRegion().front());
5646 builder.create<fir::ResultOp>(loc, aIntType ? r : processSnan(r));
5647
5648 // Code common to (a < b) and (a > b) branches.
5649 builder.setInsertionPointToStart(&ifOp1.getElseRegion().front());
5650 mlir::func::FuncOp getRound = fir::factory::getLlvmGetRounding(builder);
5651 mlir::Value mode = builder.create<fir::CallOp>(loc, getRound).getResult(0);
5652 mlir::Value aIsNegative, aIsPositive;
5653 if (aIntType) {
5654 mlir::Value zero = builder.createIntegerConstant(loc, aIntType, 0);
5655 aIsNegative = builder.create<mlir::arith::CmpIOp>(
5656 loc, mlir::arith::CmpIPredicate::slt, a, zero);
5657 aIsPositive = builder.create<mlir::arith::CmpIOp>(
5658 loc, mlir::arith::CmpIPredicate::sgt, a, zero);
5659 } else {
5660 mlir::Value zero = builder.createRealZeroConstant(loc, aFloatType);
5661 aIsNegative = builder.create<mlir::arith::CmpFOp>(
5662 loc, mlir::arith::CmpFPredicate::OLT, a, zero);
5663 aIsPositive = builder.create<mlir::arith::CmpFOp>(
5664 loc, mlir::arith::CmpFPredicate::OGT, a, zero);
5665 }
5666 mlir::Type resultIntType = builder.getIntegerType(resultFloatType.getWidth());
5667 mlir::Value resultCast =
5668 builder.create<mlir::arith::BitcastOp>(loc, resultIntType, r);
5669 mlir::Value one = builder.createIntegerConstant(loc, resultIntType, 1);
5670 mlir::Value rIsOdd = builder.create<fir::ConvertOp>(
5671 loc, i1Ty, builder.create<mlir::arith::AndIOp>(loc, resultCast, one));
5672 // Check for a rounding mode match.
5673 auto match = [&](int m) {
5674 return builder.create<mlir::arith::CmpIOp>(
5675 loc, mlir::arith::CmpIPredicate::eq, mode,
5676 builder.createIntegerConstant(loc, mode.getType(), m));
5677 };
5678 mlir::Value roundToNearestBit = builder.create<mlir::arith::OrIOp>(
5679 loc,
5680 // IEEE_OTHER is an alias for IEEE_NEAREST.
5681 match(_FORTRAN_RUNTIME_IEEE_NEAREST), match(_FORTRAN_RUNTIME_IEEE_OTHER));
5682 mlir::Value roundToNearest =
5683 builder.create<mlir::arith::AndIOp>(loc, roundToNearestBit, rIsOdd);
5684 mlir::Value roundToZeroBit = match(_FORTRAN_RUNTIME_IEEE_TO_ZERO);
5685 mlir::Value roundAwayBit = match(_FORTRAN_RUNTIME_IEEE_AWAY);
5686 mlir::Value roundToZero, roundAway, mustAdjust;
5687 fir::IfOp adjustIfOp;
5688 mlir::Value aLtB;
5689 if (aIntType)
5690 aLtB = builder.create<mlir::arith::CmpIOp>(
5691 loc, mlir::arith::CmpIPredicate::slt, a, b);
5692 else
5693 aLtB = builder.create<mlir::arith::CmpFOp>(
5694 loc, mlir::arith::CmpFPredicate::OLT, a, b);
5695 mlir::Value upResult =
5696 builder.create<mlir::arith::AddIOp>(loc, resultCast, one);
5697 mlir::Value downResult =
5698 builder.create<mlir::arith::SubIOp>(loc, resultCast, one);
5699
5700 // (a < b): r is inexact -- return r or ieee_next_down(r)
5701 fir::IfOp ifOp2 = builder.create<fir::IfOp>(loc, resultType, aLtB,
5702 /*withElseRegion=*/true);
5703 builder.setInsertionPointToStart(&ifOp2.getThenRegion().front());
5704 roundToZero =
5705 builder.create<mlir::arith::AndIOp>(loc, roundToZeroBit, aIsPositive);
5706 roundAway =
5707 builder.create<mlir::arith::AndIOp>(loc, roundAwayBit, aIsNegative);
5708 mlir::Value roundDown = match(_FORTRAN_RUNTIME_IEEE_DOWN);
5709 mustAdjust =
5710 builder.create<mlir::arith::OrIOp>(loc, roundToNearest, roundToZero);
5711 mustAdjust = builder.create<mlir::arith::OrIOp>(loc, mustAdjust, roundAway);
5712 mustAdjust = builder.create<mlir::arith::OrIOp>(loc, mustAdjust, roundDown);
5713 adjustIfOp = builder.create<fir::IfOp>(loc, resultType, mustAdjust,
5714 /*withElseRegion=*/true);
5715 builder.setInsertionPointToStart(&adjustIfOp.getThenRegion().front());
5716 if (resultType.isF80())
5717 r1 = fir::runtime::genNearest(builder, loc, r,
5718 builder.createBool(loc, false));
5719 else
5720 r1 = builder.create<mlir::arith::BitcastOp>(
5721 loc, resultType,
5722 builder.create<mlir::arith::SelectOp>(loc, aIsNegative, upResult,
5723 downResult));
5724 builder.create<fir::ResultOp>(loc, r1);
5725 builder.setInsertionPointToStart(&adjustIfOp.getElseRegion().front());
5726 builder.create<fir::ResultOp>(loc, r);
5727 builder.setInsertionPointAfter(adjustIfOp);
5728 builder.create<fir::ResultOp>(loc, adjustIfOp.getResult(0));
5729
5730 // (a > b): r is inexact -- return r or ieee_next_up(r)
5731 builder.setInsertionPointToStart(&ifOp2.getElseRegion().front());
5732 roundToZero =
5733 builder.create<mlir::arith::AndIOp>(loc, roundToZeroBit, aIsNegative);
5734 roundAway =
5735 builder.create<mlir::arith::AndIOp>(loc, roundAwayBit, aIsPositive);
5736 mlir::Value roundUp = match(_FORTRAN_RUNTIME_IEEE_UP);
5737 mustAdjust =
5738 builder.create<mlir::arith::OrIOp>(loc, roundToNearest, roundToZero);
5739 mustAdjust = builder.create<mlir::arith::OrIOp>(loc, mustAdjust, roundAway);
5740 mustAdjust = builder.create<mlir::arith::OrIOp>(loc, mustAdjust, roundUp);
5741 adjustIfOp = builder.create<fir::IfOp>(loc, resultType, mustAdjust,
5742 /*withElseRegion=*/true);
5743 builder.setInsertionPointToStart(&adjustIfOp.getThenRegion().front());
5744 if (resultType.isF80())
5745 r1 = fir::runtime::genNearest(builder, loc, r,
5746 builder.createBool(loc, true));
5747 else
5748 r1 = builder.create<mlir::arith::BitcastOp>(
5749 loc, resultType,
5750 builder.create<mlir::arith::SelectOp>(loc, aIsPositive, upResult,
5751 downResult));
5752 builder.create<fir::ResultOp>(loc, r1);
5753 builder.setInsertionPointToStart(&adjustIfOp.getElseRegion().front());
5754 builder.create<fir::ResultOp>(loc, r);
5755 builder.setInsertionPointAfter(adjustIfOp);
5756 builder.create<fir::ResultOp>(loc, adjustIfOp.getResult(0));
5757
5758 // Generate exceptions for (a < b) and (a > b) branches.
5759 builder.setInsertionPointAfter(ifOp2);
5760 r = ifOp2.getResult(0);
5761 fir::IfOp exceptIfOp1 = builder.create<fir::IfOp>(
5762 loc, genIsFPClass(i1Ty, r, infiniteTest), /*withElseRegion=*/true);
5763 builder.setInsertionPointToStart(&exceptIfOp1.getThenRegion().front());
5764 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_OVERFLOW |
5765 _FORTRAN_RUNTIME_IEEE_INEXACT);
5766 builder.setInsertionPointToStart(&exceptIfOp1.getElseRegion().front());
5767 fir::IfOp exceptIfOp2 = builder.create<fir::IfOp>(
5768 loc, genIsFPClass(i1Ty, r, subnormalTest | zeroTest),
5769 /*withElseRegion=*/true);
5770 builder.setInsertionPointToStart(&exceptIfOp2.getThenRegion().front());
5771 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_UNDERFLOW |
5772 _FORTRAN_RUNTIME_IEEE_INEXACT);
5773 builder.setInsertionPointToStart(&exceptIfOp2.getElseRegion().front());
5774 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INEXACT);
5775 builder.setInsertionPointAfter(exceptIfOp1);
5776 builder.create<fir::ResultOp>(loc, ifOp2.getResult(0));
5777 builder.setInsertionPointAfter(ifOp1);
5778 return ifOp1.getResult(0);
5779}
5780
5781// IEEE_REM
5782mlir::Value IntrinsicLibrary::genIeeeRem(mlir::Type resultType,
5783 llvm::ArrayRef<mlir::Value> args) {
5784 // Return the remainder of X divided by Y.
5785 // Signal IEEE_UNDERFLOW if X is subnormal and Y is infinite.
5786 // Signal IEEE_INVALID if X is infinite or Y is zero and neither is a NaN.
5787 assert(args.size() == 2);
5788 mlir::Value x = args[0];
5789 mlir::Value y = args[1];
5790 if (mlir::dyn_cast<mlir::FloatType>(resultType).getWidth() < 32) {
5791 mlir::Type f32Ty = mlir::Float32Type::get(builder.getContext());
5792 x = builder.create<fir::ConvertOp>(loc, f32Ty, x);
5793 y = builder.create<fir::ConvertOp>(loc, f32Ty, y);
5794 } else {
5795 x = builder.create<fir::ConvertOp>(loc, resultType, x);
5796 y = builder.create<fir::ConvertOp>(loc, resultType, y);
5797 }
5798 // remainder calls do not signal IEEE_UNDERFLOW.
5799 mlir::Value underflow = builder.create<mlir::arith::AndIOp>(
5800 loc, genIsFPClass(builder.getI1Type(), x, subnormalTest),
5801 genIsFPClass(builder.getI1Type(), y, infiniteTest));
5802 mlir::Value result = genRuntimeCall("remainder", x.getType(), {x, y});
5803 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_UNDERFLOW, underflow);
5804 return builder.create<fir::ConvertOp>(loc, resultType, result);
5805}
5806
5807// IEEE_RINT
5808mlir::Value IntrinsicLibrary::genIeeeRint(mlir::Type resultType,
5809 llvm::ArrayRef<mlir::Value> args) {
5810 // Return the value of real argument A rounded to an integer value according
5811 // to argument ROUND if present, otherwise according to the current rounding
5812 // mode. If ROUND is not present, signal IEEE_INEXACT if A is not an exact
5813 // integral value.
5814 assert(args.size() == 2);
5815 mlir::Value a = args[0];
5816 mlir::func::FuncOp getRound = fir::factory::getLlvmGetRounding(builder);
5817 mlir::func::FuncOp setRound = fir::factory::getLlvmSetRounding(builder);
5818 mlir::Value mode;
5819 if (isStaticallyPresent(args[1])) {
5820 mode = builder.create<fir::CallOp>(loc, getRound).getResult(0);
5821 genIeeeSetRoundingMode({args[1]});
5822 }
5823 if (mlir::cast<mlir::FloatType>(resultType).getWidth() == 16)
5824 a = builder.create<fir::ConvertOp>(
5825 loc, mlir::Float32Type::get(builder.getContext()), a);
5826 mlir::Value result = builder.create<fir::ConvertOp>(
5827 loc, resultType, genRuntimeCall("nearbyint", a.getType(), a));
5828 if (isStaticallyPresent(args[1])) {
5829 builder.create<fir::CallOp>(loc, setRound, mode);
5830 } else {
5831 mlir::Value inexact = builder.create<mlir::arith::CmpFOp>(
5832 loc, mlir::arith::CmpFPredicate::ONE, args[0], result);
5833 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INEXACT, inexact);
5834 }
5835 return result;
5836}
5837
5838// IEEE_SET_FLAG, IEEE_SET_HALTING_MODE
5839template <bool isFlag>
5840void IntrinsicLibrary::genIeeeSetFlagOrHaltingMode(
5841 llvm::ArrayRef<fir::ExtendedValue> args) {
5842 // IEEE_SET_FLAG: Set an exception FLAG to a FLAG_VALUE.
5843 // IEEE_SET_HALTING: Set an exception halting mode FLAG to a HALTING value.
5844 assert(args.size() == 2);
5845 mlir::Type i1Ty = builder.getI1Type();
5846 mlir::Type i32Ty = builder.getIntegerType(32);
5847 auto [fieldRef, ignore] = getFieldRef(builder, loc, getBase(args[0]));
5848 mlir::Value field = builder.create<fir::LoadOp>(loc, fieldRef);
5849 mlir::Value except = fir::runtime::genMapExcept(
5850 builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, field));
5851 auto ifOp = builder.create<fir::IfOp>(
5852 loc, builder.create<fir::ConvertOp>(loc, i1Ty, getBase(args[1])),
5853 /*withElseRegion=*/true);
5854 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
5855 (isFlag ? fir::runtime::genFeraiseexcept : fir::runtime::genFeenableexcept)(
5856 builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, except));
5857 builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
5858 (isFlag ? fir::runtime::genFeclearexcept : fir::runtime::genFedisableexcept)(
5859 builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, except));
5860 builder.setInsertionPointAfter(ifOp);
5861}
5862
5863// IEEE_SET_ROUNDING_MODE
5864void IntrinsicLibrary::genIeeeSetRoundingMode(
5865 llvm::ArrayRef<fir::ExtendedValue> args) {
5866 // Set the current floating point rounding mode to the value of arg
5867 // ROUNDING_VALUE. Values are llvm.get.rounding encoding values.
5868 // Modes ieee_to_zero, ieee_nearest, ieee_up, and ieee_down are supported.
5869 // Modes ieee_away and ieee_other are not supported, and are treated as
5870 // ieee_nearest. Generate an error if the optional RADIX arg is not 2.
5871 assert(args.size() == 1 || args.size() == 2);
5872 if (args.size() == 2)
5873 checkRadix(builder, loc, fir::getBase(args[1]), "ieee_set_rounding_mode");
5874 auto [fieldRef, fieldTy] = getFieldRef(builder, loc, fir::getBase(args[0]));
5875 mlir::func::FuncOp setRound = fir::factory::getLlvmSetRounding(builder);
5876 mlir::Value mode = builder.create<fir::LoadOp>(loc, fieldRef);
5877 static_assert(
5878 _FORTRAN_RUNTIME_IEEE_TO_ZERO >= 0 &&
5879 _FORTRAN_RUNTIME_IEEE_TO_ZERO <= 3 &&
5880 _FORTRAN_RUNTIME_IEEE_NEAREST >= 0 &&
5881 _FORTRAN_RUNTIME_IEEE_NEAREST <= 3 && _FORTRAN_RUNTIME_IEEE_UP >= 0 &&
5882 _FORTRAN_RUNTIME_IEEE_UP <= 3 && _FORTRAN_RUNTIME_IEEE_DOWN >= 0 &&
5883 _FORTRAN_RUNTIME_IEEE_DOWN <= 3 && "unexpected rounding mode mapping");
5884 mlir::Value mask = builder.create<mlir::arith::ShLIOp>(
5885 loc, builder.createAllOnesInteger(loc, fieldTy),
5886 builder.createIntegerConstant(loc, fieldTy, 2));
5887 mlir::Value modeIsSupported = builder.create<mlir::arith::CmpIOp>(
5888 loc, mlir::arith::CmpIPredicate::eq,
5889 builder.create<mlir::arith::AndIOp>(loc, mode, mask),
5890 builder.createIntegerConstant(loc, fieldTy, 0));
5891 mlir::Value nearest = builder.createIntegerConstant(
5892 loc, fieldTy, _FORTRAN_RUNTIME_IEEE_NEAREST);
5893 mode = builder.create<mlir::arith::SelectOp>(loc, modeIsSupported, mode,
5894 nearest);
5895 mode = builder.create<fir::ConvertOp>(
5896 loc, setRound.getFunctionType().getInput(0), mode);
5897 builder.create<fir::CallOp>(loc, setRound, mode);
5898}
5899
5900// IEEE_SET_UNDERFLOW_MODE
5901void IntrinsicLibrary::genIeeeSetUnderflowMode(
5902 llvm::ArrayRef<fir::ExtendedValue> args) {
5903 assert(args.size() == 1);
5904 mlir::Value gradual = builder.create<fir::ConvertOp>(loc, builder.getI1Type(),
5905 getBase(args[0]));
5906 fir::runtime::genSetUnderflowMode(builder, loc, {gradual});
5907}
5908
5909// IEEE_SIGNALING_EQ, IEEE_SIGNALING_GE, IEEE_SIGNALING_GT,
5910// IEEE_SIGNALING_LE, IEEE_SIGNALING_LT, IEEE_SIGNALING_NE
5911template <mlir::arith::CmpFPredicate pred>
5912mlir::Value
5913IntrinsicLibrary::genIeeeSignalingCompare(mlir::Type resultType,
5914 llvm::ArrayRef<mlir::Value> args) {
5915 // Compare X and Y with special case treatment of NaN operands.
5916 assert(args.size() == 2);
5917 mlir::Value hasNaNOp = genIeeeUnordered(mlir::Type{}, args);
5918 mlir::Value res =
5919 builder.create<mlir::arith::CmpFOp>(loc, pred, args[0], args[1]);
5920 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID, hasNaNOp);
5921 return builder.create<fir::ConvertOp>(loc, resultType, res);
5922}
5923
5924// IEEE_SIGNBIT
5925mlir::Value IntrinsicLibrary::genIeeeSignbit(mlir::Type resultType,
5926 llvm::ArrayRef<mlir::Value> args) {
5927 // Check if the sign bit of arg X is set.
5928 assert(args.size() == 1);
5929 mlir::Value realVal = args[0];
5930 mlir::FloatType realType = mlir::dyn_cast<mlir::FloatType>(realVal.getType());
5931 int bitWidth = realType.getWidth();
5932 if (realType == mlir::BFloat16Type::get(builder.getContext())) {
5933 // Workaround: can't bitcast or convert real(3) to integer(2) or real(2).
5934 realVal = builder.createConvert(
5935 loc, mlir::Float32Type::get(builder.getContext()), realVal);
5936 bitWidth = 32;
5937 }
5938 mlir::Type intType = builder.getIntegerType(bitWidth);
5939 mlir::Value intVal =
5940 builder.create<mlir::arith::BitcastOp>(loc, intType, realVal);
5941 mlir::Value shift = builder.createIntegerConstant(loc, intType, bitWidth - 1);
5942 mlir::Value sign = builder.create<mlir::arith::ShRUIOp>(loc, intVal, shift);
5943 return builder.createConvert(loc, resultType, sign);
5944}
5945
5946// IEEE_SUPPORT_FLAG
5947fir::ExtendedValue
5948IntrinsicLibrary::genIeeeSupportFlag(mlir::Type resultType,
5949 llvm::ArrayRef<fir::ExtendedValue> args) {
5950 // Check if a floating point exception flag is supported.
5951 assert(args.size() == 1 || args.size() == 2);
5952 mlir::Type i1Ty = builder.getI1Type();
5953 mlir::Type i32Ty = builder.getIntegerType(32);
5954 auto [fieldRef, fieldTy] = getFieldRef(builder, loc, getBase(args[0]));
5955 mlir::Value flag = builder.create<fir::LoadOp>(loc, fieldRef);
5956 mlir::Value standardFlagMask = builder.createIntegerConstant(
5957 loc, fieldTy,
5958 _FORTRAN_RUNTIME_IEEE_INVALID | _FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO |
5959 _FORTRAN_RUNTIME_IEEE_OVERFLOW | _FORTRAN_RUNTIME_IEEE_UNDERFLOW |
5960 _FORTRAN_RUNTIME_IEEE_INEXACT);
5961 mlir::Value isStandardFlag = builder.create<mlir::arith::CmpIOp>(
5962 loc, mlir::arith::CmpIPredicate::ne,
5963 builder.create<mlir::arith::AndIOp>(loc, flag, standardFlagMask),
5964 builder.createIntegerConstant(loc, fieldTy, 0));
5965 fir::IfOp ifOp = builder.create<fir::IfOp>(loc, i1Ty, isStandardFlag,
5966 /*withElseRegion=*/true);
5967 // Standard flags are supported.
5968 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
5969 builder.create<fir::ResultOp>(loc, builder.createBool(loc, true));
5970
5971 // TargetCharacteristics information for the nonstandard ieee_denorm flag
5972 // is not available here. So use a runtime check restricted to possibly
5973 // supported kinds.
5974 builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
5975 bool mayBeSupported = false;
5976 if (mlir::Value arg1 = getBase(args[1])) {
5977 mlir::Type arg1Ty = arg1.getType();
5978 if (auto eleTy = fir::dyn_cast_ptrOrBoxEleTy(arg1.getType()))
5979 arg1Ty = eleTy;
5980 if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(arg1Ty))
5981 arg1Ty = seqTy.getEleTy();
5982 switch (mlir::dyn_cast<mlir::FloatType>(arg1Ty).getWidth()) {
5983 case 16:
5984 mayBeSupported = arg1Ty.isBF16(); // kind=3
5985 break;
5986 case 32: // kind=4
5987 case 64: // kind=8
5988 mayBeSupported = true;
5989 break;
5990 }
5991 }
5992 if (mayBeSupported) {
5993 mlir::Value isDenorm = builder.create<mlir::arith::CmpIOp>(
5994 loc, mlir::arith::CmpIPredicate::eq, flag,
5995 builder.createIntegerConstant(loc, fieldTy,
5996 _FORTRAN_RUNTIME_IEEE_DENORM));
5997 mlir::Value result = builder.create<mlir::arith::AndIOp>(
5998 loc, isDenorm,
5999 fir::runtime::genSupportHalting(
6000 builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, flag)));
6001 builder.create<fir::ResultOp>(loc, result);
6002 } else {
6003 builder.create<fir::ResultOp>(loc, builder.createBool(loc, false));
6004 }
6005 builder.setInsertionPointAfter(ifOp);
6006 return builder.createConvert(loc, resultType, ifOp.getResult(0));
6007}
6008
6009// IEEE_SUPPORT_HALTING
6010fir::ExtendedValue IntrinsicLibrary::genIeeeSupportHalting(
6011 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {
6012 // Check if halting is supported for a floating point exception flag.
6013 // Standard flags are all supported. The nonstandard DENORM extension is
6014 // not supported, at least for now.
6015 assert(args.size() == 1);
6016 mlir::Type i32Ty = builder.getIntegerType(32);
6017 auto [fieldRef, ignore] = getFieldRef(builder, loc, getBase(args[0]));
6018 mlir::Value field = builder.create<fir::LoadOp>(loc, fieldRef);
6019 return builder.createConvert(
6020 loc, resultType,
6021 fir::runtime::genSupportHalting(
6022 builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, field)));
6023}
6024
6025// IEEE_SUPPORT_ROUNDING
6026fir::ExtendedValue IntrinsicLibrary::genIeeeSupportRounding(
6027 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {
6028 // Check if floating point rounding mode ROUND_VALUE is supported.
6029 // Rounding is supported either for all type kinds or none.
6030 // An optional X kind argument is therefore ignored.
6031 // Values are chosen to match the llvm.get.rounding encoding:
6032 // 0 - toward zero [supported]
6033 // 1 - to nearest, ties to even [supported] - default
6034 // 2 - toward positive infinity [supported]
6035 // 3 - toward negative infinity [supported]
6036 // 4 - to nearest, ties away from zero [not supported]
6037 assert(args.size() == 1 || args.size() == 2);
6038 auto [fieldRef, fieldTy] = getFieldRef(builder, loc, getBase(args[0]));
6039 mlir::Value mode = builder.create<fir::LoadOp>(loc, fieldRef);
6040 mlir::Value lbOk = builder.create<mlir::arith::CmpIOp>(
6041 loc, mlir::arith::CmpIPredicate::sge, mode,
6042 builder.createIntegerConstant(loc, fieldTy,
6043 _FORTRAN_RUNTIME_IEEE_TO_ZERO));
6044 mlir::Value ubOk = builder.create<mlir::arith::CmpIOp>(
6045 loc, mlir::arith::CmpIPredicate::sle, mode,
6046 builder.createIntegerConstant(loc, fieldTy, _FORTRAN_RUNTIME_IEEE_DOWN));
6047 return builder.createConvert(
6048 loc, resultType, builder.create<mlir::arith::AndIOp>(loc, lbOk, ubOk));
6049}
6050
6051// IEEE_SUPPORT_STANDARD
6052fir::ExtendedValue IntrinsicLibrary::genIeeeSupportStandard(
6053 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {
6054 // Check if IEEE standard support is available, which reduces to checking
6055 // if halting control is supported, as that is the only support component
6056 // that may not be available.
6057 assert(args.size() <= 1);
6058 mlir::Value overflow = builder.createIntegerConstant(
6059 loc, builder.getIntegerType(32), _FORTRAN_RUNTIME_IEEE_OVERFLOW);
6060 return builder.createConvert(
6061 loc, resultType, fir::runtime::genSupportHalting(builder, loc, overflow));
6062}
6063
6064// IEEE_UNORDERED
6065mlir::Value
6066IntrinsicLibrary::genIeeeUnordered(mlir::Type resultType,
6067 llvm::ArrayRef<mlir::Value> args) {
6068 // Check if REAL args X or Y or both are (signaling or quiet) NaNs.
6069 // If there is no result type return an i1 result.
6070 assert(args.size() == 2);
6071 if (args[0].getType() == args[1].getType()) {
6072 mlir::Value res = builder.create<mlir::arith::CmpFOp>(
6073 loc, mlir::arith::CmpFPredicate::UNO, args[0], args[1]);
6074 return resultType ? builder.createConvert(loc, resultType, res) : res;
6075 }
6076 assert(resultType && "expecting a (mixed arg type) unordered result type");
6077 mlir::Type i1Ty = builder.getI1Type();
6078 mlir::Value xIsNan = genIsFPClass(i1Ty, args[0], nanTest);
6079 mlir::Value yIsNan = genIsFPClass(i1Ty, args[1], nanTest);
6080 mlir::Value res = builder.create<mlir::arith::OrIOp>(loc, xIsNan, yIsNan);
6081 return builder.createConvert(loc, resultType, res);
6082}
6083
6084// IEEE_VALUE
6085mlir::Value IntrinsicLibrary::genIeeeValue(mlir::Type resultType,
6086 llvm::ArrayRef<mlir::Value> args) {
6087 // Return a KIND(X) REAL number of IEEE_CLASS_TYPE CLASS.
6088 // A user call has two arguments:
6089 // - arg[0] is X (ignored, since the resultType is provided)
6090 // - arg[1] is CLASS, an IEEE_CLASS_TYPE CLASS argument containing an index
6091 // A compiler generated call has one argument:
6092 // - arg[0] is an index constant
6093 assert(args.size() == 1 || args.size() == 2);
6094 mlir::FloatType realType = mlir::dyn_cast<mlir::FloatType>(resultType);
6095 int bitWidth = realType.getWidth();
6096 mlir::Type intType = builder.getIntegerType(bitWidth);
6097 mlir::Type valueTy = bitWidth <= 64 ? intType : builder.getIntegerType(64);
6098 constexpr int tableSize = _FORTRAN_RUNTIME_IEEE_OTHER_VALUE + 1;
6099 mlir::Type tableTy = fir::SequenceType::get(tableSize, valueTy);
6100 std::string tableName = RTNAME_STRING(IeeeValueTable_) +
6101 std::to_string(realType.isBF16() ? 3 : bitWidth >> 3);
6102 if (!builder.getNamedGlobal(tableName)) {
6103 llvm::SmallVector<mlir::Attribute, tableSize> values;
6104 auto insert = [&](std::int64_t v) {
6105 values.push_back(builder.getIntegerAttr(valueTy, v));
6106 };
6107 insert(0); // placeholder
6108 switch (bitWidth) {
6109 case 16:
6110 if (realType.isF16()) {
6111 // kind=2: 1 sign bit, 5 exponent bits, 10 significand bits
6112 /* IEEE_SIGNALING_NAN */ insert(0x7d00);
6113 /* IEEE_QUIET_NAN */ insert(0x7e00);
6114 /* IEEE_NEGATIVE_INF */ insert(0xfc00);
6115 /* IEEE_NEGATIVE_NORMAL */ insert(0xbc00);
6116 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8200);
6117 /* IEEE_NEGATIVE_ZERO */ insert(0x8000);
6118 /* IEEE_POSITIVE_ZERO */ insert(0x0000);
6119 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0200);
6120 /* IEEE_POSITIVE_NORMAL */ insert(0x3c00); // 1.0
6121 /* IEEE_POSITIVE_INF */ insert(0x7c00);
6122 break;
6123 }
6124 assert(realType.isBF16() && "unknown 16-bit real type");
6125 // kind=3: 1 sign bit, 8 exponent bits, 7 significand bits
6126 /* IEEE_SIGNALING_NAN */ insert(0x7fa0);
6127 /* IEEE_QUIET_NAN */ insert(0x7fc0);
6128 /* IEEE_NEGATIVE_INF */ insert(0xff80);
6129 /* IEEE_NEGATIVE_NORMAL */ insert(0xbf80);
6130 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8040);
6131 /* IEEE_NEGATIVE_ZERO */ insert(0x8000);
6132 /* IEEE_POSITIVE_ZERO */ insert(0x0000);
6133 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0040);
6134 /* IEEE_POSITIVE_NORMAL */ insert(0x3f80); // 1.0
6135 /* IEEE_POSITIVE_INF */ insert(0x7f80);
6136 break;
6137 case 32:
6138 // kind=4: 1 sign bit, 8 exponent bits, 23 significand bits
6139 /* IEEE_SIGNALING_NAN */ insert(0x7fa00000);
6140 /* IEEE_QUIET_NAN */ insert(0x7fc00000);
6141 /* IEEE_NEGATIVE_INF */ insert(0xff800000);
6142 /* IEEE_NEGATIVE_NORMAL */ insert(0xbf800000);
6143 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x80400000);
6144 /* IEEE_NEGATIVE_ZERO */ insert(0x80000000);
6145 /* IEEE_POSITIVE_ZERO */ insert(0x00000000);
6146 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x00400000);
6147 /* IEEE_POSITIVE_NORMAL */ insert(0x3f800000); // 1.0
6148 /* IEEE_POSITIVE_INF */ insert(0x7f800000);
6149 break;
6150 case 64:
6151 // kind=8: 1 sign bit, 11 exponent bits, 52 significand bits
6152 /* IEEE_SIGNALING_NAN */ insert(0x7ff4000000000000);
6153 /* IEEE_QUIET_NAN */ insert(0x7ff8000000000000);
6154 /* IEEE_NEGATIVE_INF */ insert(0xfff0000000000000);
6155 /* IEEE_NEGATIVE_NORMAL */ insert(0xbff0000000000000);
6156 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8008000000000000);
6157 /* IEEE_NEGATIVE_ZERO */ insert(0x8000000000000000);
6158 /* IEEE_POSITIVE_ZERO */ insert(0x0000000000000000);
6159 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0008000000000000);
6160 /* IEEE_POSITIVE_NORMAL */ insert(0x3ff0000000000000); // 1.0
6161 /* IEEE_POSITIVE_INF */ insert(0x7ff0000000000000);
6162 break;
6163 case 80:
6164 // kind=10: 1 sign bit, 15 exponent bits, 1+63 significand bits
6165 // 64 high order bits; 16 low order bits are 0.
6166 /* IEEE_SIGNALING_NAN */ insert(0x7fffa00000000000);
6167 /* IEEE_QUIET_NAN */ insert(0x7fffc00000000000);
6168 /* IEEE_NEGATIVE_INF */ insert(0xffff800000000000);
6169 /* IEEE_NEGATIVE_NORMAL */ insert(0xbfff800000000000);
6170 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8000400000000000);
6171 /* IEEE_NEGATIVE_ZERO */ insert(0x8000000000000000);
6172 /* IEEE_POSITIVE_ZERO */ insert(0x0000000000000000);
6173 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0000400000000000);
6174 /* IEEE_POSITIVE_NORMAL */ insert(0x3fff800000000000); // 1.0
6175 /* IEEE_POSITIVE_INF */ insert(0x7fff800000000000);
6176 break;
6177 case 128:
6178 // kind=16: 1 sign bit, 15 exponent bits, 112 significand bits
6179 // 64 high order bits; 64 low order bits are 0.
6180 /* IEEE_SIGNALING_NAN */ insert(0x7fff400000000000);
6181 /* IEEE_QUIET_NAN */ insert(0x7fff800000000000);
6182 /* IEEE_NEGATIVE_INF */ insert(0xffff000000000000);
6183 /* IEEE_NEGATIVE_NORMAL */ insert(0xbfff000000000000);
6184 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8000200000000000);
6185 /* IEEE_NEGATIVE_ZERO */ insert(0x8000000000000000);
6186 /* IEEE_POSITIVE_ZERO */ insert(0x0000000000000000);
6187 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0000200000000000);
6188 /* IEEE_POSITIVE_NORMAL */ insert(0x3fff000000000000); // 1.0
6189 /* IEEE_POSITIVE_INF */ insert(0x7fff000000000000);
6190 break;
6191 default:
6192 llvm_unreachable("unknown real type");
6193 }
6194 insert(0); // IEEE_OTHER_VALUE
6195 assert(values.size() == tableSize && "ieee value mismatch");
6196 builder.createGlobalConstant(
6197 loc, tableTy, tableName, builder.createLinkOnceLinkage(),
6198 mlir::DenseElementsAttr::get(
6199 mlir::RankedTensorType::get(tableSize, valueTy), values));
6200 }
6201
6202 mlir::Value which;
6203 if (args.size() == 2) { // user call
6204 auto [index, ignore] = getFieldRef(builder, loc, args[1]);
6205 which = builder.create<fir::LoadOp>(loc, index);
6206 } else { // compiler generated call
6207 which = args[0];
6208 }
6209 mlir::Value bits = builder.create<fir::LoadOp>(
6210 loc,
6211 builder.create<fir::CoordinateOp>(
6212 loc, builder.getRefType(valueTy),
6213 builder.create<fir::AddrOfOp>(loc, builder.getRefType(tableTy),
6214 builder.getSymbolRefAttr(tableName)),
6215 which));
6216 if (bitWidth > 64)
6217 bits = builder.create<mlir::arith::ShLIOp>(
6218 loc, builder.createConvert(loc, intType, bits),
6219 builder.createIntegerConstant(loc, intType, bitWidth - 64));
6220 return builder.create<mlir::arith::BitcastOp>(loc, realType, bits);
6221}
6222
6223// IEOR
6224mlir::Value IntrinsicLibrary::genIeor(mlir::Type resultType,
6225 llvm::ArrayRef<mlir::Value> args) {
6226 assert(args.size() == 2);
6227 return builder.createUnsigned<mlir::arith::XOrIOp>(loc, resultType, args[0],
6228 args[1]);
6229}
6230
6231// INDEX
6232fir::ExtendedValue
6233IntrinsicLibrary::genIndex(mlir::Type resultType,
6234 llvm::ArrayRef<fir::ExtendedValue> args) {
6235 assert(args.size() >= 2 && args.size() <= 4);
6236
6237 mlir::Value stringBase = fir::getBase(args[0]);
6238 fir::KindTy kind =
6239 fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
6240 stringBase.getType());
6241 mlir::Value stringLen = fir::getLen(args[0]);
6242 mlir::Value substringBase = fir::getBase(args[1]);
6243 mlir::Value substringLen = fir::getLen(args[1]);
6244 mlir::Value back =
6245 isStaticallyAbsent(args, 2)
6246 ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
6247 : fir::getBase(args[2]);
6248 if (isStaticallyAbsent(args, 3))
6249 return builder.createConvert(
6250 loc, resultType,
6251 fir::runtime::genIndex(builder, loc, kind, stringBase, stringLen,
6252 substringBase, substringLen, back));
6253
6254 // Call the descriptor-based Index implementation
6255 mlir::Value string = builder.createBox(loc, args[0]);
6256 mlir::Value substring = builder.createBox(loc, args[1]);
6257 auto makeRefThenEmbox = [&](mlir::Value b) {
6258 fir::LogicalType logTy = fir::LogicalType::get(
6259 builder.getContext(), builder.getKindMap().defaultLogicalKind());
6260 mlir::Value temp = builder.createTemporary(loc, logTy);
6261 mlir::Value castb = builder.createConvert(loc, logTy, b);
6262 builder.create<fir::StoreOp>(loc, castb, temp);
6263 return builder.createBox(loc, temp);
6264 };
6265 mlir::Value backOpt = isStaticallyAbsent(args, 2)
6266 ? builder.create<fir::AbsentOp>(
6267 loc, fir::BoxType::get(builder.getI1Type()))
6268 : makeRefThenEmbox(fir::getBase(args[2]));
6269 mlir::Value kindVal = isStaticallyAbsent(args, 3)
6270 ? builder.createIntegerConstant(
6271 loc, builder.getIndexType(),
6272 builder.getKindMap().defaultIntegerKind())
6273 : fir::getBase(args[3]);
6274 // Create mutable fir.box to be passed to the runtime for the result.
6275 fir::MutableBoxValue mutBox =
6276 fir::factory::createTempMutableBox(builder, loc, resultType);
6277 mlir::Value resBox = fir::factory::getMutableIRBox(builder, loc, mutBox);
6278 // Call runtime. The runtime is allocating the result.
6279 fir::runtime::genIndexDescriptor(builder, loc, resBox, string, substring,
6280 backOpt, kindVal);
6281 // Read back the result from the mutable box.
6282 return readAndAddCleanUp(mutBox, resultType, "INDEX");
6283}
6284
6285// IOR
6286mlir::Value IntrinsicLibrary::genIor(mlir::Type resultType,
6287 llvm::ArrayRef<mlir::Value> args) {
6288 assert(args.size() == 2);
6289 return builder.createUnsigned<mlir::arith::OrIOp>(loc, resultType, args[0],
6290 args[1]);
6291}
6292
6293// IPARITY
6294fir::ExtendedValue
6295IntrinsicLibrary::genIparity(mlir::Type resultType,
6296 llvm::ArrayRef<fir::ExtendedValue> args) {
6297 return genReduction(fir::runtime::genIParity, fir::runtime::genIParityDim,
6298 "IPARITY", resultType, args);
6299}
6300
6301// IS_CONTIGUOUS
6302fir::ExtendedValue
6303IntrinsicLibrary::genIsContiguous(mlir::Type resultType,
6304 llvm::ArrayRef<fir::ExtendedValue> args) {
6305 assert(args.size() == 1);
6306 return builder.createConvert(
6307 loc, resultType,
6308 fir::runtime::genIsContiguous(builder, loc, fir::getBase(args[0])));
6309}
6310
6311// IS_IOSTAT_END, IS_IOSTAT_EOR
6312template <Fortran::runtime::io::Iostat value>
6313mlir::Value
6314IntrinsicLibrary::genIsIostatValue(mlir::Type resultType,
6315 llvm::ArrayRef<mlir::Value> args) {
6316 assert(args.size() == 1);
6317 return builder.create<mlir::arith::CmpIOp>(
6318 loc, mlir::arith::CmpIPredicate::eq, args[0],
6319 builder.createIntegerConstant(loc, args[0].getType(), value));
6320}
6321
6322// ISHFT
6323mlir::Value IntrinsicLibrary::genIshft(mlir::Type resultType,
6324 llvm::ArrayRef<mlir::Value> args) {
6325 // A conformant ISHFT(I,SHIFT) call satisfies:
6326 // abs(SHIFT) <= BIT_SIZE(I)
6327 // Return: abs(SHIFT) >= BIT_SIZE(I)
6328 // ? 0
6329 // : SHIFT < 0
6330 // ? I >> abs(SHIFT)
6331 // : I << abs(SHIFT)
6332 assert(args.size() == 2);
6333 int intWidth = resultType.getIntOrFloatBitWidth();
6334 mlir::Type signlessType =
6335 mlir::IntegerType::get(builder.getContext(), intWidth,
6336 mlir::IntegerType::SignednessSemantics::Signless);
6337 mlir::Value bitSize =
6338 builder.createIntegerConstant(loc, signlessType, intWidth);
6339 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
6340 mlir::Value shift = builder.createConvert(loc, signlessType, args[1]);
6341 mlir::Value absShift = genAbs(signlessType, {shift});
6342 mlir::Value word = args[0];
6343 if (word.getType().isUnsignedInteger())
6344 word = builder.createConvert(loc, signlessType, word);
6345 auto left = builder.create<mlir::arith::ShLIOp>(loc, word, absShift);
6346 auto right = builder.create<mlir::arith::ShRUIOp>(loc, word, absShift);
6347 auto shiftIsLarge = builder.create<mlir::arith::CmpIOp>(
6348 loc, mlir::arith::CmpIPredicate::sge, absShift, bitSize);
6349 auto shiftIsNegative = builder.create<mlir::arith::CmpIOp>(
6350 loc, mlir::arith::CmpIPredicate::slt, shift, zero);
6351 auto sel =
6352 builder.create<mlir::arith::SelectOp>(loc, shiftIsNegative, right, left);
6353 mlir::Value result =
6354 builder.create<mlir::arith::SelectOp>(loc, shiftIsLarge, zero, sel);
6355 if (resultType.isUnsignedInteger())
6356 return builder.createConvert(loc, resultType, result);
6357 return result;
6358}
6359
6360// ISHFTC
6361mlir::Value IntrinsicLibrary::genIshftc(mlir::Type resultType,
6362 llvm::ArrayRef<mlir::Value> args) {
6363 // A conformant ISHFTC(I,SHIFT,SIZE) call satisfies:
6364 // SIZE > 0
6365 // SIZE <= BIT_SIZE(I)
6366 // abs(SHIFT) <= SIZE
6367 // if SHIFT > 0
6368 // leftSize = abs(SHIFT)
6369 // rightSize = SIZE - abs(SHIFT)
6370 // else [if SHIFT < 0]
6371 // leftSize = SIZE - abs(SHIFT)
6372 // rightSize = abs(SHIFT)
6373 // unchanged = SIZE == BIT_SIZE(I) ? 0 : (I >> SIZE) << SIZE
6374 // leftMaskShift = BIT_SIZE(I) - leftSize
6375 // rightMaskShift = BIT_SIZE(I) - rightSize
6376 // left = (I >> rightSize) & (-1 >> leftMaskShift)
6377 // right = (I & (-1 >> rightMaskShift)) << leftSize
6378 // Return: SHIFT == 0 || SIZE == abs(SHIFT) ? I : (unchanged | left | right)
6379 assert(args.size() == 3);
6380 int intWidth = resultType.getIntOrFloatBitWidth();
6381 mlir::Type signlessType =
6382 mlir::IntegerType::get(builder.getContext(), intWidth,
6383 mlir::IntegerType::SignednessSemantics::Signless);
6384 mlir::Value bitSize =
6385 builder.createIntegerConstant(loc, signlessType, intWidth);
6386 mlir::Value word = args[0];
6387 if (word.getType().isUnsignedInteger())
6388 word = builder.createConvert(loc, signlessType, word);
6389 mlir::Value shift = builder.createConvert(loc, signlessType, args[1]);
6390 mlir::Value size =
6391 args[2] ? builder.createConvert(loc, signlessType, args[2]) : bitSize;
6392 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
6393 mlir::Value ones = builder.createAllOnesInteger(loc, signlessType);
6394 mlir::Value absShift = genAbs(signlessType, {shift});
6395 auto elseSize = builder.create<mlir::arith::SubIOp>(loc, size, absShift);
6396 auto shiftIsZero = builder.create<mlir::arith::CmpIOp>(
6397 loc, mlir::arith::CmpIPredicate::eq, shift, zero);
6398 auto shiftEqualsSize = builder.create<mlir::arith::CmpIOp>(
6399 loc, mlir::arith::CmpIPredicate::eq, absShift, size);
6400 auto shiftIsNop =
6401 builder.create<mlir::arith::OrIOp>(loc, shiftIsZero, shiftEqualsSize);
6402 auto shiftIsPositive = builder.create<mlir::arith::CmpIOp>(
6403 loc, mlir::arith::CmpIPredicate::sgt, shift, zero);
6404 auto leftSize = builder.create<mlir::arith::SelectOp>(loc, shiftIsPositive,
6405 absShift, elseSize);
6406 auto rightSize = builder.create<mlir::arith::SelectOp>(loc, shiftIsPositive,
6407 elseSize, absShift);
6408 auto hasUnchanged = builder.create<mlir::arith::CmpIOp>(
6409 loc, mlir::arith::CmpIPredicate::ne, size, bitSize);
6410 auto unchangedTmp1 = builder.create<mlir::arith::ShRUIOp>(loc, word, size);
6411 auto unchangedTmp2 =
6412 builder.create<mlir::arith::ShLIOp>(loc, unchangedTmp1, size);
6413 auto unchanged = builder.create<mlir::arith::SelectOp>(loc, hasUnchanged,
6414 unchangedTmp2, zero);
6415 auto leftMaskShift =
6416 builder.create<mlir::arith::SubIOp>(loc, bitSize, leftSize);
6417 auto leftMask =
6418 builder.create<mlir::arith::ShRUIOp>(loc, ones, leftMaskShift);
6419 auto leftTmp = builder.create<mlir::arith::ShRUIOp>(loc, word, rightSize);
6420 auto left = builder.create<mlir::arith::AndIOp>(loc, leftTmp, leftMask);
6421 auto rightMaskShift =
6422 builder.create<mlir::arith::SubIOp>(loc, bitSize, rightSize);
6423 auto rightMask =
6424 builder.create<mlir::arith::ShRUIOp>(loc, ones, rightMaskShift);
6425 auto rightTmp = builder.create<mlir::arith::AndIOp>(loc, word, rightMask);
6426 auto right = builder.create<mlir::arith::ShLIOp>(loc, rightTmp, leftSize);
6427 auto resTmp = builder.create<mlir::arith::OrIOp>(loc, unchanged, left);
6428 auto res = builder.create<mlir::arith::OrIOp>(loc, resTmp, right);
6429 mlir::Value result =
6430 builder.create<mlir::arith::SelectOp>(loc, shiftIsNop, word, res);
6431 if (resultType.isUnsignedInteger())
6432 return builder.createConvert(loc, resultType, result);
6433 return result;
6434}
6435
6436// LEADZ
6437mlir::Value IntrinsicLibrary::genLeadz(mlir::Type resultType,
6438 llvm::ArrayRef<mlir::Value> args) {
6439 assert(args.size() == 1);
6440
6441 mlir::Value result =
6442 builder.create<mlir::math::CountLeadingZerosOp>(loc, args);
6443
6444 return builder.createConvert(loc, resultType, result);
6445}
6446
6447// LEN
6448// Note that this is only used for an unrestricted intrinsic LEN call.
6449// Other uses of LEN are rewritten as descriptor inquiries by the front-end.
6450fir::ExtendedValue
6451IntrinsicLibrary::genLen(mlir::Type resultType,
6452 llvm::ArrayRef<fir::ExtendedValue> args) {
6453 // Optional KIND argument reflected in result type and otherwise ignored.
6454 assert(args.size() == 1 || args.size() == 2);
6455 mlir::Value len = fir::factory::readCharLen(builder, loc, args[0]);
6456 return builder.createConvert(loc, resultType, len);
6457}
6458
6459// LEN_TRIM
6460fir::ExtendedValue
6461IntrinsicLibrary::genLenTrim(mlir::Type resultType,
6462 llvm::ArrayRef<fir::ExtendedValue> args) {
6463 // Optional KIND argument reflected in result type and otherwise ignored.
6464 assert(args.size() == 1 || args.size() == 2);
6465 const fir::CharBoxValue *charBox = args[0].getCharBox();
6466 if (!charBox)
6467 TODO(loc, "intrinsic: len_trim for character array");
6468 auto len =
6469 fir::factory::CharacterExprHelper(builder, loc).createLenTrim(*charBox);
6470 return builder.createConvert(loc, resultType, len);
6471}
6472
6473// LGE, LGT, LLE, LLT
6474template <mlir::arith::CmpIPredicate pred>
6475fir::ExtendedValue
6476IntrinsicLibrary::genCharacterCompare(mlir::Type resultType,
6477 llvm::ArrayRef<fir::ExtendedValue> args) {
6478 assert(args.size() == 2);
6479 return fir::runtime::genCharCompare(
6480 builder, loc, pred, fir::getBase(args[0]), fir::getLen(args[0]),
6481 fir::getBase(args[1]), fir::getLen(args[1]));
6482}
6483
6484static bool isOptional(mlir::Value value) {
6485 auto varIface = mlir::dyn_cast_or_null<fir::FortranVariableOpInterface>(
6486 value.getDefiningOp());
6487 return varIface && varIface.isOptional();
6488}
6489
6490// LOC
6491fir::ExtendedValue
6492IntrinsicLibrary::genLoc(mlir::Type resultType,
6493 llvm::ArrayRef<fir::ExtendedValue> args) {
6494 assert(args.size() == 1);
6495 mlir::Value box = fir::getBase(args[0]);
6496 assert(fir::isa_box_type(box.getType()) &&
6497 "argument must have been lowered to box type");
6498 bool isFunc = mlir::isa<fir::BoxProcType>(box.getType());
6499 if (!isOptional(box)) {
6500 mlir::Value argAddr = getAddrFromBox(builder, loc, args[0], isFunc);
6501 return builder.createConvert(loc, resultType, argAddr);
6502 }
6503 // Optional assumed shape case. Although this is not specified in this GNU
6504 // intrinsic extension, LOC accepts absent optional and returns zero in that
6505 // case.
6506 // Note that the other OPTIONAL cases do not fall here since `box` was
6507 // created when preparing the argument cases, but the box can be safely be
6508 // used for all those cases and the address will be null if absent.
6509 mlir::Value isPresent =
6510 builder.create<fir::IsPresentOp>(loc, builder.getI1Type(), box);
6511 return builder
6512 .genIfOp(loc, {resultType}, isPresent,
6513 /*withElseRegion=*/true)
6514 .genThen([&]() {
6515 mlir::Value argAddr = getAddrFromBox(builder, loc, args[0], isFunc);
6516 mlir::Value cast = builder.createConvert(loc, resultType, argAddr);
6517 builder.create<fir::ResultOp>(loc, cast);
6518 })
6519 .genElse([&]() {
6520 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
6521 builder.create<fir::ResultOp>(loc, zero);
6522 })
6523 .getResults()[0];
6524}
6525
6526mlir::Value IntrinsicLibrary::genMalloc(mlir::Type resultType,
6527 llvm::ArrayRef<mlir::Value> args) {
6528 assert(args.size() == 1);
6529 return builder.createConvert(loc, resultType,
6530 fir::runtime::genMalloc(builder, loc, args[0]));
6531}
6532
6533// MASKL, MASKR, UMASKL, UMASKR
6534template <typename Shift>
6535mlir::Value IntrinsicLibrary::genMask(mlir::Type resultType,
6536 llvm::ArrayRef<mlir::Value> args) {
6537 assert(args.size() == 2);
6538
6539 int bits = resultType.getIntOrFloatBitWidth();
6540 mlir::Type signlessType =
6541 mlir::IntegerType::get(builder.getContext(), bits,
6542 mlir::IntegerType::SignednessSemantics::Signless);
6543 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
6544 mlir::Value ones = builder.createAllOnesInteger(loc, signlessType);
6545 mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits);
6546 mlir::Value bitsToSet = builder.createConvert(loc, signlessType, args[0]);
6547
6548 // The standard does not specify what to return if the number of bits to be
6549 // set, I < 0 or I >= BIT_SIZE(KIND). The shift instruction used below will
6550 // produce a poison value which may return a possibly platform-specific and/or
6551 // non-deterministic result. Other compilers don't produce a consistent result
6552 // in this case either, so we choose the most efficient implementation.
6553 mlir::Value shift =
6554 builder.create<mlir::arith::SubIOp>(loc, bitSize, bitsToSet);
6555 mlir::Value shifted = builder.create<Shift>(loc, ones, shift);
6556 mlir::Value isZero = builder.create<mlir::arith::CmpIOp>(
6557 loc, mlir::arith::CmpIPredicate::eq, bitsToSet, zero);
6558 mlir::Value result =
6559 builder.create<mlir::arith::SelectOp>(loc, isZero, zero, shifted);
6560 if (resultType.isUnsignedInteger())
6561 return builder.createConvert(loc, resultType, result);
6562 return result;
6563}
6564
6565// MATCH_ALL_SYNC
6566mlir::Value
6567IntrinsicLibrary::genMatchAllSync(mlir::Type resultType,
6568 llvm::ArrayRef<mlir::Value> args) {
6569 assert(args.size() == 3);
6570 bool is32 = args[1].getType().isInteger(32) || args[1].getType().isF32();
6571
6572 mlir::Type i1Ty = builder.getI1Type();
6573 mlir::MLIRContext *context = builder.getContext();
6574
6575 mlir::Value arg1 = args[1];
6576 if (arg1.getType().isF32() || arg1.getType().isF64())
6577 arg1 = builder.create<fir::ConvertOp>(
6578 loc, is32 ? builder.getI32Type() : builder.getI64Type(), arg1);
6579
6580 mlir::Type retTy =
6581 mlir::LLVM::LLVMStructType::getLiteral(context, {resultType, i1Ty});
6582 auto match =
6583 builder
6584 .create<mlir::NVVM::MatchSyncOp>(loc, retTy, args[0], arg1,
6585 mlir::NVVM::MatchSyncKind::all)
6586 .getResult();
6587 auto value = builder.create<mlir::LLVM::ExtractValueOp>(loc, match, 0);
6588 auto pred = builder.create<mlir::LLVM::ExtractValueOp>(loc, match, 1);
6589 auto conv = builder.create<mlir::LLVM::ZExtOp>(loc, resultType, pred);
6590 builder.create<fir::StoreOp>(loc, conv, args[2]);
6591 return value;
6592}
6593
6594// ALL_SYNC, ANY_SYNC, BALLOT_SYNC
6595template <mlir::NVVM::VoteSyncKind kind>
6596mlir::Value IntrinsicLibrary::genVoteSync(mlir::Type resultType,
6597 llvm::ArrayRef<mlir::Value> args) {
6598 assert(args.size() == 2);
6599 mlir::Value arg1 =
6600 builder.create<fir::ConvertOp>(loc, builder.getI1Type(), args[1]);
6601 mlir::Type resTy = kind == mlir::NVVM::VoteSyncKind::ballot
6602 ? builder.getI32Type()
6603 : builder.getI1Type();
6604 auto voteRes =
6605 builder.create<mlir::NVVM::VoteSyncOp>(loc, resTy, args[0], arg1, kind)
6606 .getResult();
6607 return builder.create<fir::ConvertOp>(loc, resultType, voteRes);
6608}
6609
6610// MATCH_ANY_SYNC
6611mlir::Value
6612IntrinsicLibrary::genMatchAnySync(mlir::Type resultType,
6613 llvm::ArrayRef<mlir::Value> args) {
6614 assert(args.size() == 2);
6615 bool is32 = args[1].getType().isInteger(32) || args[1].getType().isF32();
6616
6617 mlir::Value arg1 = args[1];
6618 if (arg1.getType().isF32() || arg1.getType().isF64())
6619 arg1 = builder.create<fir::ConvertOp>(
6620 loc, is32 ? builder.getI32Type() : builder.getI64Type(), arg1);
6621
6622 return builder
6623 .create<mlir::NVVM::MatchSyncOp>(loc, resultType, args[0], arg1,
6624 mlir::NVVM::MatchSyncKind::any)
6625 .getResult();
6626}
6627
6628// MATMUL
6629fir::ExtendedValue
6630IntrinsicLibrary::genMatmul(mlir::Type resultType,
6631 llvm::ArrayRef<fir::ExtendedValue> args) {
6632 assert(args.size() == 2);
6633
6634 // Handle required matmul arguments
6635 fir::BoxValue matrixTmpA = builder.createBox(loc, args[0]);
6636 mlir::Value matrixA = fir::getBase(matrixTmpA);
6637 fir::BoxValue matrixTmpB = builder.createBox(loc, args[1]);
6638 mlir::Value matrixB = fir::getBase(matrixTmpB);
6639 unsigned resultRank =
6640 (matrixTmpA.rank() == 1 || matrixTmpB.rank() == 1) ? 1 : 2;
6641
6642 // Create mutable fir.box to be passed to the runtime for the result.
6643 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, resultRank);
6644 fir::MutableBoxValue resultMutableBox =
6645 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
6646 mlir::Value resultIrBox =
6647 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
6648 // Call runtime. The runtime is allocating the result.
6649 fir::runtime::genMatmul(builder, loc, resultIrBox, matrixA, matrixB);
6650 // Read result from mutable fir.box and add it to the list of temps to be
6651 // finalized by the StatementContext.
6652 return readAndAddCleanUp(resultMutableBox, resultType, "MATMUL");
6653}
6654
6655// MATMUL_TRANSPOSE
6656fir::ExtendedValue
6657IntrinsicLibrary::genMatmulTranspose(mlir::Type resultType,
6658 llvm::ArrayRef<fir::ExtendedValue> args) {
6659 assert(args.size() == 2);
6660
6661 // Handle required matmul_transpose arguments
6662 fir::BoxValue matrixTmpA = builder.createBox(loc, args[0]);
6663 mlir::Value matrixA = fir::getBase(matrixTmpA);
6664 fir::BoxValue matrixTmpB = builder.createBox(loc, args[1]);
6665 mlir::Value matrixB = fir::getBase(matrixTmpB);
6666 unsigned resultRank =
6667 (matrixTmpA.rank() == 1 || matrixTmpB.rank() == 1) ? 1 : 2;
6668
6669 // Create mutable fir.box to be passed to the runtime for the result.
6670 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, resultRank);
6671 fir::MutableBoxValue resultMutableBox =
6672 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
6673 mlir::Value resultIrBox =
6674 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
6675 // Call runtime. The runtime is allocating the result.
6676 fir::runtime::genMatmulTranspose(builder, loc, resultIrBox, matrixA, matrixB);
6677 // Read result from mutable fir.box and add it to the list of temps to be
6678 // finalized by the StatementContext.
6679 return readAndAddCleanUp(resultMutableBox, resultType, "MATMUL_TRANSPOSE");
6680}
6681
6682// MERGE
6683fir::ExtendedValue
6684IntrinsicLibrary::genMerge(mlir::Type,
6685 llvm::ArrayRef<fir::ExtendedValue> args) {
6686 assert(args.size() == 3);
6687 mlir::Value tsource = fir::getBase(args[0]);
6688 mlir::Value fsource = fir::getBase(args[1]);
6689 mlir::Value rawMask = fir::getBase(args[2]);
6690 mlir::Type type0 = fir::unwrapRefType(tsource.getType());
6691 bool isCharRslt = fir::isa_char(type0); // result is same as first argument
6692 mlir::Value mask = builder.createConvert(loc, builder.getI1Type(), rawMask);
6693
6694 // The result is polymorphic if and only if both TSOURCE and FSOURCE are
6695 // polymorphic. TSOURCE and FSOURCE are required to have the same type
6696 // (for both declared and dynamic types) so a simple convert op can be
6697 // used.
6698 mlir::Value tsourceCast = tsource;
6699 mlir::Value fsourceCast = fsource;
6700 auto convertToStaticType = [&](mlir::Value polymorphic,
6701 mlir::Value other) -> mlir::Value {
6702 mlir::Type otherType = other.getType();
6703 if (mlir::isa<fir::BaseBoxType>(otherType))
6704 return builder.create<fir::ReboxOp>(loc, otherType, polymorphic,
6705 /*shape*/ mlir::Value{},
6706 /*slice=*/mlir::Value{});
6707 return builder.create<fir::BoxAddrOp>(loc, otherType, polymorphic);
6708 };
6709 if (fir::isPolymorphicType(tsource.getType()) &&
6710 !fir::isPolymorphicType(fsource.getType())) {
6711 tsourceCast = convertToStaticType(tsource, fsource);
6712 } else if (!fir::isPolymorphicType(tsource.getType()) &&
6713 fir::isPolymorphicType(fsource.getType())) {
6714 fsourceCast = convertToStaticType(fsource, tsource);
6715 } else {
6716 // FSOURCE and TSOURCE are not polymorphic.
6717 // FSOURCE has the same type as TSOURCE, but they may not have the same MLIR
6718 // types (one can have dynamic length while the other has constant lengths,
6719 // or one may be a fir.logical<> while the other is an i1). Insert a cast to
6720 // fulfill mlir::SelectOp constraint that the MLIR types must be the same.
6721 fsourceCast = builder.createConvert(loc, tsource.getType(), fsource);
6722 }
6723 auto rslt = builder.create<mlir::arith::SelectOp>(loc, mask, tsourceCast,
6724 fsourceCast);
6725 if (isCharRslt) {
6726 // Need a CharBoxValue for character results
6727 const fir::CharBoxValue *charBox = args[0].getCharBox();
6728 fir::CharBoxValue charRslt(rslt, charBox->getLen());
6729 return charRslt;
6730 }
6731 return rslt;
6732}
6733
6734// MERGE_BITS
6735mlir::Value IntrinsicLibrary::genMergeBits(mlir::Type resultType,
6736 llvm::ArrayRef<mlir::Value> args) {
6737 assert(args.size() == 3);
6738
6739 mlir::Type signlessType = mlir::IntegerType::get(
6740 builder.getContext(), resultType.getIntOrFloatBitWidth(),
6741 mlir::IntegerType::SignednessSemantics::Signless);
6742 // MERGE_BITS(I, J, MASK) = IOR(IAND(I, MASK), IAND(J, NOT(MASK)))
6743 mlir::Value ones = builder.createAllOnesInteger(loc, signlessType);
6744 mlir::Value notMask = builder.createUnsigned<mlir::arith::XOrIOp>(
6745 loc, resultType, args[2], ones);
6746 mlir::Value lft = builder.createUnsigned<mlir::arith::AndIOp>(
6747 loc, resultType, args[0], args[2]);
6748 mlir::Value rgt = builder.createUnsigned<mlir::arith::AndIOp>(
6749 loc, resultType, args[1], notMask);
6750 return builder.createUnsigned<mlir::arith::OrIOp>(loc, resultType, lft, rgt);
6751}
6752
6753// MOD
6754mlir::Value IntrinsicLibrary::genMod(mlir::Type resultType,
6755 llvm::ArrayRef<mlir::Value> args) {
6756 assert(args.size() == 2);
6757 if (resultType.isUnsignedInteger()) {
6758 mlir::Type signlessType = mlir::IntegerType::get(
6759 builder.getContext(), resultType.getIntOrFloatBitWidth(),
6760 mlir::IntegerType::SignednessSemantics::Signless);
6761 return builder.createUnsigned<mlir::arith::RemUIOp>(loc, signlessType,
6762 args[0], args[1]);
6763 }
6764 if (mlir::isa<mlir::IntegerType>(resultType))
6765 return builder.create<mlir::arith::RemSIOp>(loc, args[0], args[1]);
6766
6767 // Use runtime.
6768 return builder.createConvert(
6769 loc, resultType, fir::runtime::genMod(builder, loc, args[0], args[1]));
6770}
6771
6772// MODULO
6773mlir::Value IntrinsicLibrary::genModulo(mlir::Type resultType,
6774 llvm::ArrayRef<mlir::Value> args) {
6775 // TODO: we'd better generate a runtime call here, when runtime error
6776 // checking is needed (to detect 0 divisor) or when precise math is requested.
6777 assert(args.size() == 2);
6778 // No floored modulo op in LLVM/MLIR yet. TODO: add one to MLIR.
6779 // In the meantime, use a simple inlined implementation based on truncated
6780 // modulo (MOD(A, P) implemented by RemIOp, RemFOp). This avoids making manual
6781 // division and multiplication from MODULO formula.
6782 // - If A/P > 0 or MOD(A,P)=0, then INT(A/P) = FLOOR(A/P), and MODULO = MOD.
6783 // - Otherwise, when A/P < 0 and MOD(A,P) !=0, then MODULO(A, P) =
6784 // A-FLOOR(A/P)*P = A-(INT(A/P)-1)*P = A-INT(A/P)*P+P = MOD(A,P)+P
6785 // Note that A/P < 0 if and only if A and P signs are different.
6786 if (resultType.isUnsignedInteger()) {
6787 mlir::Type signlessType = mlir::IntegerType::get(
6788 builder.getContext(), resultType.getIntOrFloatBitWidth(),
6789 mlir::IntegerType::SignednessSemantics::Signless);
6790 return builder.createUnsigned<mlir::arith::RemUIOp>(loc, signlessType,
6791 args[0], args[1]);
6792 }
6793 if (mlir::isa<mlir::IntegerType>(resultType)) {
6794 auto remainder =
6795 builder.create<mlir::arith::RemSIOp>(loc, args[0], args[1]);
6796 auto argXor = builder.create<mlir::arith::XOrIOp>(loc, args[0], args[1]);
6797 mlir::Value zero = builder.createIntegerConstant(loc, argXor.getType(), 0);
6798 auto argSignDifferent = builder.create<mlir::arith::CmpIOp>(
6799 loc, mlir::arith::CmpIPredicate::slt, argXor, zero);
6800 auto remainderIsNotZero = builder.create<mlir::arith::CmpIOp>(
6801 loc, mlir::arith::CmpIPredicate::ne, remainder, zero);
6802 auto mustAddP = builder.create<mlir::arith::AndIOp>(loc, remainderIsNotZero,
6803 argSignDifferent);
6804 auto remPlusP =
6805 builder.create<mlir::arith::AddIOp>(loc, remainder, args[1]);
6806 return builder.create<mlir::arith::SelectOp>(loc, mustAddP, remPlusP,
6807 remainder);
6808 }
6809
6810 auto fastMathFlags = builder.getFastMathFlags();
6811 // F128 arith::RemFOp may be lowered to a runtime call that may be unsupported
6812 // on the target, so generate a call to Fortran Runtime's ModuloReal16.
6813 if (resultType == mlir::Float128Type::get(builder.getContext()) ||
6814 (fastMathFlags & mlir::arith::FastMathFlags::ninf) ==
6815 mlir::arith::FastMathFlags::none)
6816 return builder.createConvert(
6817 loc, resultType,
6818 fir::runtime::genModulo(builder, loc, args[0], args[1]));
6819
6820 auto remainder = builder.create<mlir::arith::RemFOp>(loc, args[0], args[1]);
6821 mlir::Value zero = builder.createRealZeroConstant(loc, remainder.getType());
6822 auto remainderIsNotZero = builder.create<mlir::arith::CmpFOp>(
6823 loc, mlir::arith::CmpFPredicate::UNE, remainder, zero);
6824 auto aLessThanZero = builder.create<mlir::arith::CmpFOp>(
6825 loc, mlir::arith::CmpFPredicate::OLT, args[0], zero);
6826 auto pLessThanZero = builder.create<mlir::arith::CmpFOp>(
6827 loc, mlir::arith::CmpFPredicate::OLT, args[1], zero);
6828 auto argSignDifferent =
6829 builder.create<mlir::arith::XOrIOp>(loc, aLessThanZero, pLessThanZero);
6830 auto mustAddP = builder.create<mlir::arith::AndIOp>(loc, remainderIsNotZero,
6831 argSignDifferent);
6832 auto remPlusP = builder.create<mlir::arith::AddFOp>(loc, remainder, args[1]);
6833 return builder.create<mlir::arith::SelectOp>(loc, mustAddP, remPlusP,
6834 remainder);
6835}
6836
6837void IntrinsicLibrary::genMoveAlloc(llvm::ArrayRef<fir::ExtendedValue> args) {
6838 assert(args.size() == 4);
6839
6840 const fir::ExtendedValue &from = args[0];
6841 const fir::ExtendedValue &to = args[1];
6842 const fir::ExtendedValue &status = args[2];
6843 const fir::ExtendedValue &errMsg = args[3];
6844
6845 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
6846 mlir::Value errBox =
6847 isStaticallyPresent(errMsg)
6848 ? fir::getBase(errMsg)
6849 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
6850
6851 const fir::MutableBoxValue *fromBox = from.getBoxOf<fir::MutableBoxValue>();
6852 const fir::MutableBoxValue *toBox = to.getBoxOf<fir::MutableBoxValue>();
6853
6854 assert(fromBox && toBox && "move_alloc parameters must be mutable arrays");
6855
6856 mlir::Value fromAddr = fir::factory::getMutableIRBox(builder, loc, *fromBox);
6857 mlir::Value toAddr = fir::factory::getMutableIRBox(builder, loc, *toBox);
6858
6859 mlir::Value hasStat = builder.createBool(loc, isStaticallyPresent(status));
6860
6861 mlir::Value stat = fir::runtime::genMoveAlloc(builder, loc, toAddr, fromAddr,
6862 hasStat, errBox);
6863
6864 fir::factory::syncMutableBoxFromIRBox(builder, loc, *fromBox);
6865 fir::factory::syncMutableBoxFromIRBox(builder, loc, *toBox);
6866
6867 if (isStaticallyPresent(status)) {
6868 mlir::Value statAddr = fir::getBase(status);
6869 mlir::Value statIsPresentAtRuntime =
6870 builder.genIsNotNullAddr(loc, statAddr);
6871 builder.genIfThen(loc, statIsPresentAtRuntime)
6872 .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); })
6873 .end();
6874 }
6875}
6876
6877// MVBITS
6878void IntrinsicLibrary::genMvbits(llvm::ArrayRef<fir::ExtendedValue> args) {
6879 // A conformant MVBITS(FROM,FROMPOS,LEN,TO,TOPOS) call satisfies:
6880 // FROMPOS >= 0
6881 // LEN >= 0
6882 // TOPOS >= 0
6883 // FROMPOS + LEN <= BIT_SIZE(FROM)
6884 // TOPOS + LEN <= BIT_SIZE(TO)
6885 // MASK = -1 >> (BIT_SIZE(FROM) - LEN)
6886 // TO = LEN == 0 ? TO : ((!(MASK << TOPOS)) & TO) |
6887 // (((FROM >> FROMPOS) & MASK) << TOPOS)
6888 assert(args.size() == 5);
6889 auto unbox = [&](fir::ExtendedValue exv) {
6890 const mlir::Value *arg = exv.getUnboxed();
6891 assert(arg && "nonscalar mvbits argument");
6892 return *arg;
6893 };
6894 mlir::Value from = unbox(args[0]);
6895 mlir::Type fromType = from.getType();
6896 mlir::Type signlessType = mlir::IntegerType::get(
6897 builder.getContext(), fromType.getIntOrFloatBitWidth(),
6898 mlir::IntegerType::SignednessSemantics::Signless);
6899 mlir::Value frompos =
6900 builder.createConvert(loc, signlessType, unbox(args[1]));
6901 mlir::Value len = builder.createConvert(loc, signlessType, unbox(args[2]));
6902 mlir::Value toAddr = unbox(args[3]);
6903 mlir::Type toType{fir::dyn_cast_ptrEleTy(toAddr.getType())};
6904 assert(toType.getIntOrFloatBitWidth() == fromType.getIntOrFloatBitWidth() &&
6905 "mismatched mvbits types");
6906 auto to = builder.create<fir::LoadOp>(loc, signlessType, toAddr);
6907 mlir::Value topos = builder.createConvert(loc, signlessType, unbox(args[4]));
6908 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
6909 mlir::Value ones = builder.createAllOnesInteger(loc, signlessType);
6910 mlir::Value bitSize = builder.createIntegerConstant(
6911 loc, signlessType,
6912 mlir::cast<mlir::IntegerType>(signlessType).getWidth());
6913 auto shiftCount = builder.create<mlir::arith::SubIOp>(loc, bitSize, len);
6914 auto mask = builder.create<mlir::arith::ShRUIOp>(loc, ones, shiftCount);
6915 auto unchangedTmp1 = builder.create<mlir::arith::ShLIOp>(loc, mask, topos);
6916 auto unchangedTmp2 =
6917 builder.create<mlir::arith::XOrIOp>(loc, unchangedTmp1, ones);
6918 auto unchanged = builder.create<mlir::arith::AndIOp>(loc, unchangedTmp2, to);
6919 if (fromType.isUnsignedInteger())
6920 from = builder.createConvert(loc, signlessType, from);
6921 auto frombitsTmp1 = builder.create<mlir::arith::ShRUIOp>(loc, from, frompos);
6922 auto frombitsTmp2 =
6923 builder.create<mlir::arith::AndIOp>(loc, frombitsTmp1, mask);
6924 auto frombits = builder.create<mlir::arith::ShLIOp>(loc, frombitsTmp2, topos);
6925 auto resTmp = builder.create<mlir::arith::OrIOp>(loc, unchanged, frombits);
6926 auto lenIsZero = builder.create<mlir::arith::CmpIOp>(
6927 loc, mlir::arith::CmpIPredicate::eq, len, zero);
6928 mlir::Value res =
6929 builder.create<mlir::arith::SelectOp>(loc, lenIsZero, to, resTmp);
6930 if (toType.isUnsignedInteger())
6931 res = builder.createConvert(loc, toType, res);
6932 builder.create<fir::StoreOp>(loc, res, toAddr);
6933}
6934
6935// NEAREST, IEEE_NEXT_AFTER, IEEE_NEXT_DOWN, IEEE_NEXT_UP
6936template <I::NearestProc proc>
6937mlir::Value IntrinsicLibrary::genNearest(mlir::Type resultType,
6938 llvm::ArrayRef<mlir::Value> args) {
6939 // NEAREST
6940 // Return the number adjacent to arg X in the direction of the infinity
6941 // with the sign of arg S. Terminate with an error if arg S is zero.
6942 // Generate exceptions as for IEEE_NEXT_AFTER.
6943 // IEEE_NEXT_AFTER
6944 // Return isNan(Y) ? NaN : X==Y ? X : num adjacent to X in the dir of Y.
6945 // Signal IEEE_OVERFLOW, IEEE_INEXACT for finite X and infinite result.
6946 // Signal IEEE_UNDERFLOW, IEEE_INEXACT for subnormal result.
6947 // IEEE_NEXT_DOWN
6948 // Return the number adjacent to X and less than X.
6949 // Signal IEEE_INVALID when X is a signaling NaN.
6950 // IEEE_NEXT_UP
6951 // Return the number adjacent to X and greater than X.
6952 // Signal IEEE_INVALID when X is a signaling NaN.
6953 //
6954 // valueUp -- true if a finite result must be larger than X.
6955 // magnitudeUp -- true if a finite abs(result) must be larger than abs(X).
6956 //
6957 // if (isNextAfter && isNan(Y)) X = NaN // result = NaN
6958 // if (isNan(X) || (isNextAfter && X == Y) || (isInfinite(X) && magnitudeUp))
6959 // result = X
6960 // else if (isZero(X))
6961 // result = valueUp ? minPositiveSubnormal : minNegativeSubnormal
6962 // else
6963 // result = magUp ? (X + minPositiveSubnormal) : (X - minPositiveSubnormal)
6964
6965 assert(args.size() == 1 || args.size() == 2);
6966 mlir::Value x = args[0];
6967 mlir::FloatType xType = mlir::dyn_cast<mlir::FloatType>(x.getType());
6968 const unsigned xBitWidth = xType.getWidth();
6969 mlir::Type i1Ty = builder.getI1Type();
6970 if constexpr (proc == NearestProc::NextAfter) {
6971 // If isNan(Y), set X to a qNaN that will propagate to the resultIsX result.
6972 mlir::Value qNan = genQNan(xType);
6973 mlir::Value isFPClass = genIsFPClass(i1Ty, args[1], nanTest);
6974 x = builder.create<mlir::arith::SelectOp>(loc, isFPClass, qNan, x);
6975 }
6976 mlir::Value resultIsX = genIsFPClass(i1Ty, x, nanTest);
6977 mlir::Type intType = builder.getIntegerType(xBitWidth);
6978 mlir::Value one = builder.createIntegerConstant(loc, intType, 1);
6979
6980 // Set valueUp to true if a finite result must be larger than arg X.
6981 mlir::Value valueUp;
6982 if constexpr (proc == NearestProc::Nearest) {
6983 // Arg S must not be zero.
6984 fir::IfOp ifOp =
6985 builder.create<fir::IfOp>(loc, genIsFPClass(i1Ty, args[1], zeroTest),
6986 /*withElseRegion=*/false);
6987 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
6988 fir::runtime::genReportFatalUserError(
6989 builder, loc, "intrinsic nearest S argument is zero");
6990 builder.setInsertionPointAfter(ifOp);
6991 mlir::Value sSign = IntrinsicLibrary::genIeeeSignbit(intType, {args[1]});
6992 valueUp = builder.create<mlir::arith::CmpIOp>(
6993 loc, mlir::arith::CmpIPredicate::ne, sSign, one);
6994 } else if constexpr (proc == NearestProc::NextAfter) {
6995 // Convert X and Y to a common type to allow comparison. Direct conversions
6996 // between kinds 2, 3, 10, and 16 are not all supported. These conversions
6997 // are implemented by converting kind=2,3 values to kind=4, possibly
6998 // followed with a conversion of that value to a larger type.
6999 mlir::Value x1 = x;
7000 mlir::Value y = args[1];
7001 mlir::FloatType yType = mlir::dyn_cast<mlir::FloatType>(args[1].getType());
7002 const unsigned yBitWidth = yType.getWidth();
7003 if (xType != yType) {
7004 mlir::Type f32Ty = mlir::Float32Type::get(builder.getContext());
7005 if (xBitWidth < 32)
7006 x1 = builder.createConvert(loc, f32Ty, x1);
7007 if (yBitWidth > 32 && yBitWidth > xBitWidth)
7008 x1 = builder.createConvert(loc, yType, x1);
7009 if (yBitWidth < 32)
7010 y = builder.createConvert(loc, f32Ty, y);
7011 if (xBitWidth > 32 && xBitWidth > yBitWidth)
7012 y = builder.createConvert(loc, xType, y);
7013 }
7014 resultIsX = builder.create<mlir::arith::OrIOp>(
7015 loc, resultIsX,
7016 builder.create<mlir::arith::CmpFOp>(
7017 loc, mlir::arith::CmpFPredicate::OEQ, x1, y));
7018 valueUp = builder.create<mlir::arith::CmpFOp>(
7019 loc, mlir::arith::CmpFPredicate::OLT, x1, y);
7020 } else if constexpr (proc == NearestProc::NextDown) {
7021 valueUp = builder.createBool(loc, false);
7022 } else if constexpr (proc == NearestProc::NextUp) {
7023 valueUp = builder.createBool(loc, true);
7024 }
7025 mlir::Value magnitudeUp = builder.create<mlir::arith::CmpIOp>(
7026 loc, mlir::arith::CmpIPredicate::ne, valueUp,
7027 IntrinsicLibrary::genIeeeSignbit(i1Ty, {args[0]}));
7028 resultIsX = builder.create<mlir::arith::OrIOp>(
7029 loc, resultIsX,
7030 builder.create<mlir::arith::AndIOp>(
7031 loc, genIsFPClass(i1Ty, x, infiniteTest), magnitudeUp));
7032
7033 // Result is X. (For ieee_next_after with isNan(Y), X has been set to a NaN.)
7034 fir::IfOp outerIfOp = builder.create<fir::IfOp>(loc, resultType, resultIsX,
7035 /*withElseRegion=*/true);
7036 builder.setInsertionPointToStart(&outerIfOp.getThenRegion().front());
7037 if constexpr (proc == NearestProc::NextDown || proc == NearestProc::NextUp)
7038 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID,
7039 genIsFPClass(i1Ty, x, snanTest));
7040 builder.create<fir::ResultOp>(loc, x);
7041
7042 // Result is minPositiveSubnormal or minNegativeSubnormal. (X is zero.)
7043 builder.setInsertionPointToStart(&outerIfOp.getElseRegion().front());
7044 mlir::Value resultIsMinSubnormal = builder.create<mlir::arith::CmpFOp>(
7045 loc, mlir::arith::CmpFPredicate::OEQ, x,
7046 builder.createRealZeroConstant(loc, xType));
7047 fir::IfOp innerIfOp =
7048 builder.create<fir::IfOp>(loc, resultType, resultIsMinSubnormal,
7049 /*withElseRegion=*/true);
7050 builder.setInsertionPointToStart(&innerIfOp.getThenRegion().front());
7051 mlir::Value minPositiveSubnormal =
7052 builder.create<mlir::arith::BitcastOp>(loc, resultType, one);
7053 mlir::Value minNegativeSubnormal = builder.create<mlir::arith::BitcastOp>(
7054 loc, resultType,
7055 builder.create<mlir::arith::ConstantOp>(
7056 loc, intType,
7057 builder.getIntegerAttr(
7058 intType, llvm::APInt::getBitsSetWithWrap(
7059 xBitWidth, /*lo=*/xBitWidth - 1, /*hi=*/1))));
7060 mlir::Value result = builder.create<mlir::arith::SelectOp>(
7061 loc, valueUp, minPositiveSubnormal, minNegativeSubnormal);
7062 if constexpr (proc == NearestProc::Nearest || proc == NearestProc::NextAfter)
7063 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_UNDERFLOW |
7064 _FORTRAN_RUNTIME_IEEE_INEXACT);
7065 builder.create<fir::ResultOp>(loc, result);
7066
7067 // Result is (X + minPositiveSubnormal) or (X - minPositiveSubnormal).
7068 builder.setInsertionPointToStart(&innerIfOp.getElseRegion().front());
7069 if (xBitWidth == 80) {
7070 // Kind 10. Call std::nextafter, which generates exceptions as required
7071 // for ieee_next_after and nearest. Override this exception processing
7072 // for ieee_next_down and ieee_next_up.
7073 constexpr bool overrideExceptionGeneration =
7074 proc == NearestProc::NextDown || proc == NearestProc::NextUp;
7075 [[maybe_unused]] mlir::Type i32Ty;
7076 [[maybe_unused]] mlir::Value allExcepts, excepts, mask;
7077 if constexpr (overrideExceptionGeneration) {
7078 i32Ty = builder.getIntegerType(32);
7079 allExcepts = fir::runtime::genMapExcept(
7080 builder, loc,
7081 builder.createIntegerConstant(loc, i32Ty, _FORTRAN_RUNTIME_IEEE_ALL));
7082 excepts = genRuntimeCall("fetestexcept", i32Ty, allExcepts);
7083 mask = genRuntimeCall("fedisableexcept", i32Ty, allExcepts);
7084 }
7085 result = fir::runtime::genNearest(builder, loc, x, valueUp);
7086 if constexpr (overrideExceptionGeneration) {
7087 genRuntimeCall("feclearexcept", i32Ty, allExcepts);
7088 genRuntimeCall("feraiseexcept", i32Ty, excepts);
7089 genRuntimeCall("feenableexcept", i32Ty, mask);
7090 }
7091 builder.create<fir::ResultOp>(loc, result);
7092 } else {
7093 // Kind 2, 3, 4, 8, 16. Increment or decrement X cast to integer.
7094 mlir::Value intX = builder.create<mlir::arith::BitcastOp>(loc, intType, x);
7095 mlir::Value add = builder.create<mlir::arith::AddIOp>(loc, intX, one);
7096 mlir::Value sub = builder.create<mlir::arith::SubIOp>(loc, intX, one);
7097 result = builder.create<mlir::arith::BitcastOp>(
7098 loc, resultType,
7099 builder.create<mlir::arith::SelectOp>(loc, magnitudeUp, add, sub));
7100 if constexpr (proc == NearestProc::Nearest ||
7101 proc == NearestProc::NextAfter) {
7102 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_OVERFLOW |
7103 _FORTRAN_RUNTIME_IEEE_INEXACT,
7104 genIsFPClass(i1Ty, result, infiniteTest));
7105 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_UNDERFLOW |
7106 _FORTRAN_RUNTIME_IEEE_INEXACT,
7107 genIsFPClass(i1Ty, result, subnormalTest));
7108 }
7109 builder.create<fir::ResultOp>(loc, result);
7110 }
7111
7112 builder.setInsertionPointAfter(innerIfOp);
7113 builder.create<fir::ResultOp>(loc, innerIfOp.getResult(0));
7114 builder.setInsertionPointAfter(outerIfOp);
7115 return outerIfOp.getResult(0);
7116}
7117
7118// NINT
7119mlir::Value IntrinsicLibrary::genNint(mlir::Type resultType,
7120 llvm::ArrayRef<mlir::Value> args) {
7121 assert(args.size() >= 1);
7122 // Skip optional kind argument to search the runtime; it is already reflected
7123 // in result type.
7124 return genRuntimeCall("nint", resultType, {args[0]});
7125}
7126
7127// NORM2
7128fir::ExtendedValue
7129IntrinsicLibrary::genNorm2(mlir::Type resultType,
7130 llvm::ArrayRef<fir::ExtendedValue> args) {
7131 assert(args.size() == 2);
7132
7133 // Handle required array argument
7134 mlir::Value array = builder.createBox(loc, args[0]);
7135 unsigned rank = fir::BoxValue(array).rank();
7136 assert(rank >= 1);
7137
7138 // Check if the dim argument is present
7139 bool absentDim = isStaticallyAbsent(args[1]);
7140
7141 // If dim argument is absent or the array is rank 1, then the result is
7142 // a scalar (since the the result is rank-1 or 0). Otherwise, the result is
7143 // an array.
7144 if (absentDim || rank == 1) {
7145 return fir::runtime::genNorm2(builder, loc, array);
7146 } else {
7147 // Create mutable fir.box to be passed to the runtime for the result.
7148 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
7149 fir::MutableBoxValue resultMutableBox =
7150 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
7151 mlir::Value resultIrBox =
7152 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
7153
7154 mlir::Value dim = fir::getBase(args[1]);
7155 fir::runtime::genNorm2Dim(builder, loc, resultIrBox, array, dim);
7156 // Handle cleanup of allocatable result descriptor and return
7157 return readAndAddCleanUp(resultMutableBox, resultType, "NORM2");
7158 }
7159}
7160
7161// NOT
7162mlir::Value IntrinsicLibrary::genNot(mlir::Type resultType,
7163 llvm::ArrayRef<mlir::Value> args) {
7164 assert(args.size() == 1);
7165 mlir::Type signlessType = mlir::IntegerType::get(
7166 builder.getContext(), resultType.getIntOrFloatBitWidth(),
7167 mlir::IntegerType::SignednessSemantics::Signless);
7168 mlir::Value allOnes = builder.createAllOnesInteger(loc, signlessType);
7169 return builder.createUnsigned<mlir::arith::XOrIOp>(loc, resultType, args[0],
7170 allOnes);
7171}
7172
7173// NULL
7174fir::ExtendedValue
7175IntrinsicLibrary::genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue> args) {
7176 // NULL() without MOLD must be handled in the contexts where it can appear
7177 // (see table 16.5 of Fortran 2018 standard).
7178 assert(args.size() == 1 && isStaticallyPresent(args[0]) &&
7179 "MOLD argument required to lower NULL outside of any context");
7180 mlir::Type ptrTy = fir::getBase(args[0]).getType();
7181 if (ptrTy && fir::isBoxProcAddressType(ptrTy)) {
7182 auto boxProcType = mlir::cast<fir::BoxProcType>(fir::unwrapRefType(ptrTy));
7183 mlir::Value boxStorage = builder.createTemporary(loc, boxProcType);
7184 mlir::Value nullBoxProc =
7185 fir::factory::createNullBoxProc(builder, loc, boxProcType);
7186 builder.createStoreWithConvert(loc, nullBoxProc, boxStorage);
7187 return boxStorage;
7188 }
7189 const auto *mold = args[0].getBoxOf<fir::MutableBoxValue>();
7190 assert(mold && "MOLD must be a pointer or allocatable");
7191 fir::BaseBoxType boxType = mold->getBoxTy();
7192 mlir::Value boxStorage = builder.createTemporary(loc, boxType);
7193 mlir::Value box = fir::factory::createUnallocatedBox(
7194 builder, loc, boxType, mold->nonDeferredLenParams());
7195 builder.create<fir::StoreOp>(loc, box, boxStorage);
7196 return fir::MutableBoxValue(boxStorage, mold->nonDeferredLenParams(), {});
7197}
7198
7199// PACK
7200fir::ExtendedValue
7201IntrinsicLibrary::genPack(mlir::Type resultType,
7202 llvm::ArrayRef<fir::ExtendedValue> args) {
7203 [[maybe_unused]] auto numArgs = args.size();
7204 assert(numArgs == 2 || numArgs == 3);
7205
7206 // Handle required array argument
7207 mlir::Value array = builder.createBox(loc, args[0]);
7208
7209 // Handle required mask argument
7210 mlir::Value mask = builder.createBox(loc, args[1]);
7211
7212 // Handle optional vector argument
7213 mlir::Value vector = isStaticallyAbsent(args, 2)
7214 ? builder.create<fir::AbsentOp>(
7215 loc, fir::BoxType::get(builder.getI1Type()))
7216 : builder.createBox(loc, args[2]);
7217
7218 // Create mutable fir.box to be passed to the runtime for the result.
7219 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 1);
7220 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(
7221 builder, loc, resultArrayType, {},
7222 fir::isPolymorphicType(array.getType()) ? array : mlir::Value{});
7223 mlir::Value resultIrBox =
7224 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
7225
7226 fir::runtime::genPack(builder, loc, resultIrBox, array, mask, vector);
7227
7228 return readAndAddCleanUp(resultMutableBox, resultType, "PACK");
7229}
7230
7231// PARITY
7232fir::ExtendedValue
7233IntrinsicLibrary::genParity(mlir::Type resultType,
7234 llvm::ArrayRef<fir::ExtendedValue> args) {
7235
7236 assert(args.size() == 2);
7237 // Handle required mask argument
7238 mlir::Value mask = builder.createBox(loc, args[0]);
7239
7240 fir::BoxValue maskArry = builder.createBox(loc, args[0]);
7241 int rank = maskArry.rank();
7242 assert(rank >= 1);
7243
7244 // Handle optional dim argument
7245 bool absentDim = isStaticallyAbsent(args[1]);
7246 mlir::Value dim =
7247 absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
7248 : fir::getBase(args[1]);
7249
7250 if (rank == 1 || absentDim)
7251 return builder.createConvert(
7252 loc, resultType, fir::runtime::genParity(builder, loc, mask, dim));
7253
7254 // else use the result descriptor ParityDim() intrinsic
7255
7256 // Create mutable fir.box to be passed to the runtime for the result.
7257
7258 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
7259 fir::MutableBoxValue resultMutableBox =
7260 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
7261 mlir::Value resultIrBox =
7262 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
7263
7264 // Call runtime. The runtime is allocating the result.
7265 fir::runtime::genParityDescriptor(builder, loc, resultIrBox, mask, dim);
7266 return readAndAddCleanUp(resultMutableBox, resultType, "PARITY");
7267}
7268
7269// PERROR
7270void IntrinsicLibrary::genPerror(llvm::ArrayRef<fir::ExtendedValue> args) {
7271 assert(args.size() == 1);
7272
7273 fir::ExtendedValue str = args[0];
7274 const auto *box = str.getBoxOf<fir::BoxValue>();
7275 mlir::Value addr =
7276 builder.create<fir::BoxAddrOp>(loc, box->getMemTy(), fir::getBase(*box));
7277 fir::runtime::genPerror(builder, loc, addr);
7278}
7279
7280// POPCNT
7281mlir::Value IntrinsicLibrary::genPopcnt(mlir::Type resultType,
7282 llvm::ArrayRef<mlir::Value> args) {
7283 assert(args.size() == 1);
7284
7285 mlir::Value count = builder.create<mlir::math::CtPopOp>(loc, args);
7286
7287 return builder.createConvert(loc, resultType, count);
7288}
7289
7290// POPPAR
7291mlir::Value IntrinsicLibrary::genPoppar(mlir::Type resultType,
7292 llvm::ArrayRef<mlir::Value> args) {
7293 assert(args.size() == 1);
7294
7295 mlir::Value count = genPopcnt(resultType, args);
7296 mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
7297
7298 return builder.create<mlir::arith::AndIOp>(loc, count, one);
7299}
7300
7301// PRESENT
7302fir::ExtendedValue
7303IntrinsicLibrary::genPresent(mlir::Type,
7304 llvm::ArrayRef<fir::ExtendedValue> args) {
7305 assert(args.size() == 1);
7306 return builder.create<fir::IsPresentOp>(loc, builder.getI1Type(),
7307 fir::getBase(args[0]));
7308}
7309
7310// PRODUCT
7311fir::ExtendedValue
7312IntrinsicLibrary::genProduct(mlir::Type resultType,
7313 llvm::ArrayRef<fir::ExtendedValue> args) {
7314 return genReduction(fir::runtime::genProduct, fir::runtime::genProductDim,
7315 "PRODUCT", resultType, args);
7316}
7317
7318// PUTENV
7319fir::ExtendedValue
7320IntrinsicLibrary::genPutenv(std::optional<mlir::Type> resultType,
7321 llvm::ArrayRef<fir::ExtendedValue> args) {
7322 assert((resultType.has_value() && args.size() == 1) ||
7323 (!resultType.has_value() && args.size() >= 1 && args.size() <= 2));
7324
7325 mlir::Value str = fir::getBase(args[0]);
7326 mlir::Value strLength = fir::getLen(args[0]);
7327 mlir::Value statusValue =
7328 fir::runtime::genPutEnv(builder, loc, str, strLength);
7329
7330 if (resultType.has_value()) {
7331 // Function form, return status.
7332 return builder.createConvert(loc, *resultType, statusValue);
7333 }
7334
7335 // Subroutine form, store status and return none.
7336 const fir::ExtendedValue &status = args[1];
7337 if (!isStaticallyAbsent(status)) {
7338 mlir::Value statusAddr = fir::getBase(status);
7339 mlir::Value statusIsPresentAtRuntime =
7340 builder.genIsNotNullAddr(loc, statusAddr);
7341 builder.genIfThen(loc, statusIsPresentAtRuntime)
7342 .genThen([&]() {
7343 builder.createStoreWithConvert(loc, statusValue, statusAddr);
7344 })
7345 .end();
7346 }
7347
7348 return {};
7349}
7350
7351// RANDOM_INIT
7352void IntrinsicLibrary::genRandomInit(llvm::ArrayRef<fir::ExtendedValue> args) {
7353 assert(args.size() == 2);
7354 fir::runtime::genRandomInit(builder, loc, fir::getBase(args[0]),
7355 fir::getBase(args[1]));
7356}
7357
7358// RANDOM_NUMBER
7359void IntrinsicLibrary::genRandomNumber(
7360 llvm::ArrayRef<fir::ExtendedValue> args) {
7361 assert(args.size() == 1);
7362 fir::runtime::genRandomNumber(builder, loc, fir::getBase(args[0]));
7363}
7364
7365// RANDOM_SEED
7366void IntrinsicLibrary::genRandomSeed(llvm::ArrayRef<fir::ExtendedValue> args) {
7367 assert(args.size() == 3);
7368 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
7369 auto getDesc = [&](int i) {
7370 return isStaticallyPresent(args[i])
7371 ? fir::getBase(args[i])
7372 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
7373 };
7374 mlir::Value size = getDesc(0);
7375 mlir::Value put = getDesc(1);
7376 mlir::Value get = getDesc(2);
7377 fir::runtime::genRandomSeed(builder, loc, size, put, get);
7378}
7379
7380// REDUCE
7381fir::ExtendedValue
7382IntrinsicLibrary::genReduce(mlir::Type resultType,
7383 llvm::ArrayRef<fir::ExtendedValue> args) {
7384 assert(args.size() == 6);
7385
7386 fir::BoxValue arrayTmp = builder.createBox(loc, args[0]);
7387 mlir::Value array = fir::getBase(arrayTmp);
7388 mlir::Value operation = fir::getBase(args[1]);
7389 int rank = arrayTmp.rank();
7390 assert(rank >= 1);
7391
7392 // Arguements to the reduction operation are passed by reference or value?
7393 bool argByRef = true;
7394 if (!operation.getDefiningOp())
7395 TODO(loc, "Distinguigh dummy procedure arguments");
7396 if (auto embox =
7397 mlir::dyn_cast_or_null<fir::EmboxProcOp>(operation.getDefiningOp())) {
7398 auto fctTy = mlir::dyn_cast<mlir::FunctionType>(embox.getFunc().getType());
7399 argByRef = mlir::isa<fir::ReferenceType>(fctTy.getInput(0));
7400 } else if (auto load = mlir::dyn_cast_or_null<fir::LoadOp>(
7401 operation.getDefiningOp())) {
7402 auto boxProcTy = mlir::dyn_cast_or_null<fir::BoxProcType>(load.getType());
7403 assert(boxProcTy && "expect BoxProcType");
7404 auto fctTy = mlir::dyn_cast<mlir::FunctionType>(boxProcTy.getEleTy());
7405 argByRef = mlir::isa<fir::ReferenceType>(fctTy.getInput(0));
7406 }
7407
7408 mlir::Type ty = array.getType();
7409 mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
7410 mlir::Type eleTy = mlir::cast<fir::SequenceType>(arrTy).getElementType();
7411
7412 // Handle optional arguments
7413 bool absentDim = isStaticallyAbsent(args[2]);
7414
7415 auto mask = isStaticallyAbsent(args[3])
7416 ? builder.create<fir::AbsentOp>(
7417 loc, fir::BoxType::get(builder.getI1Type()))
7418 : builder.createBox(loc, args[3]);
7419
7420 mlir::Value identity =
7421 isStaticallyAbsent(args[4])
7422 ? builder.create<fir::AbsentOp>(loc, fir::ReferenceType::get(eleTy))
7423 : fir::getBase(args[4]);
7424
7425 mlir::Value ordered = isStaticallyAbsent(args[5])
7426 ? builder.createBool(loc, false)
7427 : fir::getBase(args[5]);
7428
7429 // We call the type specific versions because the result is scalar
7430 // in the case below.
7431 if (absentDim || rank == 1) {
7432 if (fir::isa_complex(eleTy) || fir::isa_derived(eleTy)) {
7433 mlir::Value result = builder.createTemporary(loc, eleTy);
7434 fir::runtime::genReduce(builder, loc, array, operation, mask, identity,
7435 ordered, result, argByRef);
7436 if (fir::isa_derived(eleTy))
7437 return result;
7438 return builder.create<fir::LoadOp>(loc, result);
7439 }
7440 if (fir::isa_char(eleTy)) {
7441 auto charTy = mlir::dyn_cast_or_null<fir::CharacterType>(resultType);
7442 assert(charTy && "expect CharacterType");
7443 fir::factory::CharacterExprHelper charHelper(builder, loc);
7444 mlir::Value len;
7445 if (charTy.hasDynamicLen())
7446 len = charHelper.readLengthFromBox(fir::getBase(arrayTmp), charTy);
7447 else
7448 len = builder.createIntegerConstant(loc, builder.getI32Type(),
7449 charTy.getLen());
7450 fir::CharBoxValue temp = charHelper.createCharacterTemp(eleTy, len);
7451 fir::runtime::genReduce(builder, loc, array, operation, mask, identity,
7452 ordered, temp.getBuffer(), argByRef);
7453 return temp;
7454 }
7455 return fir::runtime::genReduce(builder, loc, array, operation, mask,
7456 identity, ordered, argByRef);
7457 }
7458 // Handle cases that have an array result.
7459 // Create mutable fir.box to be passed to the runtime for the result.
7460 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
7461 fir::MutableBoxValue resultMutableBox =
7462 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
7463 mlir::Value resultIrBox =
7464 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
7465 mlir::Value dim = fir::getBase(args[2]);
7466 fir::runtime::genReduceDim(builder, loc, array, operation, dim, mask,
7467 identity, ordered, resultIrBox, argByRef);
7468 return readAndAddCleanUp(resultMutableBox, resultType, "REDUCE");
7469}
7470
7471// RENAME
7472fir::ExtendedValue
7473IntrinsicLibrary::genRename(std::optional<mlir::Type> resultType,
7474 mlir::ArrayRef<fir::ExtendedValue> args) {
7475 assert((args.size() == 3 && !resultType.has_value()) ||
7476 (args.size() == 2 && resultType.has_value()));
7477
7478 mlir::Value path1 = fir::getBase(args[0]);
7479 mlir::Value path2 = fir::getBase(args[1]);
7480 if (!path1 || !path2)
7481 fir::emitFatalError(loc, "Expected at least two dummy arguments");
7482
7483 if (resultType.has_value()) {
7484 // code-gen for the function form of RENAME
7485 auto statusAddr = builder.createTemporary(loc, *resultType);
7486 auto statusBox = builder.createBox(loc, statusAddr);
7487 fir::runtime::genRename(builder, loc, path1, path2, statusBox);
7488 return builder.create<fir::LoadOp>(loc, statusAddr);
7489 } else {
7490 // code-gen for the procedure form of RENAME
7491 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
7492 auto status = args[2];
7493 mlir::Value statusBox =
7494 isStaticallyPresent(status)
7495 ? fir::getBase(status)
7496 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
7497 fir::runtime::genRename(builder, loc, path1, path2, statusBox);
7498 return {};
7499 }
7500}
7501
7502// REPEAT
7503fir::ExtendedValue
7504IntrinsicLibrary::genRepeat(mlir::Type resultType,
7505 llvm::ArrayRef<fir::ExtendedValue> args) {
7506 assert(args.size() == 2);
7507 mlir::Value string = builder.createBox(loc, args[0]);
7508 mlir::Value ncopies = fir::getBase(args[1]);
7509 // Create mutable fir.box to be passed to the runtime for the result.
7510 fir::MutableBoxValue resultMutableBox =
7511 fir::factory::createTempMutableBox(builder, loc, resultType);
7512 mlir::Value resultIrBox =
7513 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
7514 // Call runtime. The runtime is allocating the result.
7515 fir::runtime::genRepeat(builder, loc, resultIrBox, string, ncopies);
7516 // Read result from mutable fir.box and add it to the list of temps to be
7517 // finalized by the StatementContext.
7518 return readAndAddCleanUp(resultMutableBox, resultType, "REPEAT");
7519}
7520
7521// RESHAPE
7522fir::ExtendedValue
7523IntrinsicLibrary::genReshape(mlir::Type resultType,
7524 llvm::ArrayRef<fir::ExtendedValue> args) {
7525 assert(args.size() == 4);
7526
7527 // Handle source argument
7528 mlir::Value source = builder.createBox(loc, args[0]);
7529
7530 // Handle shape argument
7531 mlir::Value shape = builder.createBox(loc, args[1]);
7532 assert(fir::BoxValue(shape).rank() == 1);
7533 mlir::Type shapeTy = shape.getType();
7534 mlir::Type shapeArrTy = fir::dyn_cast_ptrOrBoxEleTy(shapeTy);
7535 auto resultRank = mlir::cast<fir::SequenceType>(shapeArrTy).getShape()[0];
7536
7537 if (resultRank == fir::SequenceType::getUnknownExtent())
7538 TODO(loc, "intrinsic: reshape requires computing rank of result");
7539
7540 // Handle optional pad argument
7541 mlir::Value pad = isStaticallyAbsent(args[2])
7542 ? builder.create<fir::AbsentOp>(
7543 loc, fir::BoxType::get(builder.getI1Type()))
7544 : builder.createBox(loc, args[2]);
7545
7546 // Handle optional order argument
7547 mlir::Value order = isStaticallyAbsent(args[3])
7548 ? builder.create<fir::AbsentOp>(
7549 loc, fir::BoxType::get(builder.getI1Type()))
7550 : builder.createBox(loc, args[3]);
7551
7552 // Create mutable fir.box to be passed to the runtime for the result.
7553 mlir::Type type = builder.getVarLenSeqTy(resultType, resultRank);
7554 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(
7555 builder, loc, type, {},
7556 fir::isPolymorphicType(source.getType()) ? source : mlir::Value{});
7557
7558 mlir::Value resultIrBox =
7559 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
7560
7561 fir::runtime::genReshape(builder, loc, resultIrBox, source, shape, pad,
7562 order);
7563
7564 return readAndAddCleanUp(resultMutableBox, resultType, "RESHAPE");
7565}
7566
7567// RRSPACING
7568mlir::Value IntrinsicLibrary::genRRSpacing(mlir::Type resultType,
7569 llvm::ArrayRef<mlir::Value> args) {
7570 assert(args.size() == 1);
7571
7572 return builder.createConvert(
7573 loc, resultType,
7574 fir::runtime::genRRSpacing(builder, loc, fir::getBase(args[0])));
7575}
7576
7577// ERFC_SCALED
7578mlir::Value IntrinsicLibrary::genErfcScaled(mlir::Type resultType,
7579 llvm::ArrayRef<mlir::Value> args) {
7580 assert(args.size() == 1);
7581
7582 return builder.createConvert(
7583 loc, resultType,
7584 fir::runtime::genErfcScaled(builder, loc, fir::getBase(args[0])));
7585}
7586
7587// SAME_TYPE_AS
7588fir::ExtendedValue
7589IntrinsicLibrary::genSameTypeAs(mlir::Type resultType,
7590 llvm::ArrayRef<fir::ExtendedValue> args) {
7591 assert(args.size() == 2);
7592
7593 return builder.createConvert(
7594 loc, resultType,
7595 fir::runtime::genSameTypeAs(builder, loc, fir::getBase(args[0]),
7596 fir::getBase(args[1])));
7597}
7598
7599// SCALE
7600mlir::Value IntrinsicLibrary::genScale(mlir::Type resultType,
7601 llvm::ArrayRef<mlir::Value> args) {
7602 assert(args.size() == 2);
7603 mlir::FloatType floatTy = mlir::dyn_cast<mlir::FloatType>(resultType);
7604 if (!floatTy.isF16() && !floatTy.isBF16()) // kind=4,8,10,16
7605 return builder.createConvert(
7606 loc, resultType,
7607 fir::runtime::genScale(builder, loc, args[0], args[1]));
7608
7609 // Convert kind=2,3 arg X to kind=4. Convert kind=4 result back to kind=2,3.
7610 mlir::Type i1Ty = builder.getI1Type();
7611 mlir::Type f32Ty = mlir::Float32Type::get(builder.getContext());
7612 mlir::Value result = builder.createConvert(
7613 loc, resultType,
7614 fir::runtime::genScale(
7615 builder, loc, builder.createConvert(loc, f32Ty, args[0]), args[1]));
7616
7617 // kind=4 runtime::genScale call may not signal kind=2,3 exceptions.
7618 // If X is finite and result is infinite, signal IEEE_OVERFLOW
7619 // If X is finite and scale(result, -I) != X, signal IEEE_UNDERFLOW
7620 fir::IfOp outerIfOp =
7621 builder.create<fir::IfOp>(loc, genIsFPClass(i1Ty, args[0], finiteTest),
7622 /*withElseRegion=*/false);
7623 builder.setInsertionPointToStart(&outerIfOp.getThenRegion().front());
7624 fir::IfOp innerIfOp =
7625 builder.create<fir::IfOp>(loc, genIsFPClass(i1Ty, result, infiniteTest),
7626 /*withElseRegion=*/true);
7627 builder.setInsertionPointToStart(&innerIfOp.getThenRegion().front());
7628 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_OVERFLOW |
7629 _FORTRAN_RUNTIME_IEEE_INEXACT);
7630 builder.setInsertionPointToStart(&innerIfOp.getElseRegion().front());
7631 mlir::Value minusI = builder.create<mlir::arith::MulIOp>(
7632 loc, args[1], builder.createAllOnesInteger(loc, args[1].getType()));
7633 mlir::Value reverseResult = builder.createConvert(
7634 loc, resultType,
7635 fir::runtime::genScale(
7636 builder, loc, builder.createConvert(loc, f32Ty, result), minusI));
7637 genRaiseExcept(
7638 _FORTRAN_RUNTIME_IEEE_UNDERFLOW | _FORTRAN_RUNTIME_IEEE_INEXACT,
7639 builder.create<mlir::arith::CmpFOp>(loc, mlir::arith::CmpFPredicate::ONE,
7640 args[0], reverseResult));
7641 builder.setInsertionPointAfter(outerIfOp);
7642 return result;
7643}
7644
7645// SCAN
7646fir::ExtendedValue
7647IntrinsicLibrary::genScan(mlir::Type resultType,
7648 llvm::ArrayRef<fir::ExtendedValue> args) {
7649
7650 assert(args.size() == 4);
7651
7652 if (isStaticallyAbsent(args[3])) {
7653 // Kind not specified, so call scan/verify runtime routine that is
7654 // specialized on the kind of characters in string.
7655
7656 // Handle required string base arg
7657 mlir::Value stringBase = fir::getBase(args[0]);
7658
7659 // Handle required set string base arg
7660 mlir::Value setBase = fir::getBase(args[1]);
7661
7662 // Handle kind argument; it is the kind of character in this case
7663 fir::KindTy kind =
7664 fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
7665 stringBase.getType());
7666
7667 // Get string length argument
7668 mlir::Value stringLen = fir::getLen(args[0]);
7669
7670 // Get set string length argument
7671 mlir::Value setLen = fir::getLen(args[1]);
7672
7673 // Handle optional back argument
7674 mlir::Value back =
7675 isStaticallyAbsent(args[2])
7676 ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
7677 : fir::getBase(args[2]);
7678
7679 return builder.createConvert(loc, resultType,
7680 fir::runtime::genScan(builder, loc, kind,
7681 stringBase, stringLen,
7682 setBase, setLen, back));
7683 }
7684 // else use the runtime descriptor version of scan/verify
7685
7686 // Handle optional argument, back
7687 auto makeRefThenEmbox = [&](mlir::Value b) {
7688 fir::LogicalType logTy = fir::LogicalType::get(
7689 builder.getContext(), builder.getKindMap().defaultLogicalKind());
7690 mlir::Value temp = builder.createTemporary(loc, logTy);
7691 mlir::Value castb = builder.createConvert(loc, logTy, b);
7692 builder.create<fir::StoreOp>(loc, castb, temp);
7693 return builder.createBox(loc, temp);
7694 };
7695 mlir::Value back = fir::isUnboxedValue(args[2])
7696 ? makeRefThenEmbox(*args[2].getUnboxed())
7697 : builder.create<fir::AbsentOp>(
7698 loc, fir::BoxType::get(builder.getI1Type()));
7699
7700 // Handle required string argument
7701 mlir::Value string = builder.createBox(loc, args[0]);
7702
7703 // Handle required set argument
7704 mlir::Value set = builder.createBox(loc, args[1]);
7705
7706 // Handle kind argument
7707 mlir::Value kind = fir::getBase(args[3]);
7708
7709 // Create result descriptor
7710 fir::MutableBoxValue resultMutableBox =
7711 fir::factory::createTempMutableBox(builder, loc, resultType);
7712 mlir::Value resultIrBox =
7713 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
7714
7715 fir::runtime::genScanDescriptor(builder, loc, resultIrBox, string, set, back,
7716 kind);
7717
7718 // Handle cleanup of allocatable result descriptor and return
7719 return readAndAddCleanUp(resultMutableBox, resultType, "SCAN");
7720}
7721
7722// SECOND
7723fir::ExtendedValue
7724IntrinsicLibrary::genSecond(std::optional<mlir::Type> resultType,
7725 mlir::ArrayRef<fir::ExtendedValue> args) {
7726 assert((args.size() == 1 && !resultType) || (args.empty() && resultType));
7727
7728 fir::ExtendedValue result;
7729
7730 if (resultType)
7731 result = builder.createTemporary(loc, *resultType);
7732 else
7733 result = args[0];
7734
7735 llvm::SmallVector<fir::ExtendedValue, 1> subroutineArgs(1, result);
7736 genCpuTime(subroutineArgs);
7737
7738 if (resultType)
7739 return builder.create<fir::LoadOp>(loc, fir::getBase(result));
7740 return {};
7741}
7742
7743// SELECTED_CHAR_KIND
7744fir::ExtendedValue
7745IntrinsicLibrary::genSelectedCharKind(mlir::Type resultType,
7746 llvm::ArrayRef<fir::ExtendedValue> args) {
7747 assert(args.size() == 1);
7748
7749 return builder.createConvert(
7750 loc, resultType,
7751 fir::runtime::genSelectedCharKind(builder, loc, fir::getBase(args[0]),
7752 fir::getLen(args[0])));
7753}
7754
7755// SELECTED_INT_KIND
7756mlir::Value
7757IntrinsicLibrary::genSelectedIntKind(mlir::Type resultType,
7758 llvm::ArrayRef<mlir::Value> args) {
7759 assert(args.size() == 1);
7760
7761 return builder.createConvert(
7762 loc, resultType,
7763 fir::runtime::genSelectedIntKind(builder, loc, fir::getBase(args[0])));
7764}
7765
7766// SELECTED_LOGICAL_KIND
7767mlir::Value
7768IntrinsicLibrary::genSelectedLogicalKind(mlir::Type resultType,
7769 llvm::ArrayRef<mlir::Value> args) {
7770 assert(args.size() == 1);
7771
7772 return builder.createConvert(loc, resultType,
7773 fir::runtime::genSelectedLogicalKind(
7774 builder, loc, fir::getBase(args[0])));
7775}
7776
7777// SELECTED_REAL_KIND
7778mlir::Value
7779IntrinsicLibrary::genSelectedRealKind(mlir::Type resultType,
7780 llvm::ArrayRef<mlir::Value> args) {
7781 assert(args.size() == 3);
7782
7783 // Handle optional precision(P) argument
7784 mlir::Value precision =
7785 isStaticallyAbsent(args[0])
7786 ? builder.create<fir::AbsentOp>(
7787 loc, fir::ReferenceType::get(builder.getI1Type()))
7788 : fir::getBase(args[0]);
7789
7790 // Handle optional range(R) argument
7791 mlir::Value range =
7792 isStaticallyAbsent(args[1])
7793 ? builder.create<fir::AbsentOp>(
7794 loc, fir::ReferenceType::get(builder.getI1Type()))
7795 : fir::getBase(args[1]);
7796
7797 // Handle optional radix(RADIX) argument
7798 mlir::Value radix =
7799 isStaticallyAbsent(args[2])
7800 ? builder.create<fir::AbsentOp>(
7801 loc, fir::ReferenceType::get(builder.getI1Type()))
7802 : fir::getBase(args[2]);
7803
7804 return builder.createConvert(
7805 loc, resultType,
7806 fir::runtime::genSelectedRealKind(builder, loc, precision, range, radix));
7807}
7808
7809// SET_EXPONENT
7810mlir::Value IntrinsicLibrary::genSetExponent(mlir::Type resultType,
7811 llvm::ArrayRef<mlir::Value> args) {
7812 assert(args.size() == 2);
7813
7814 return builder.createConvert(
7815 loc, resultType,
7816 fir::runtime::genSetExponent(builder, loc, fir::getBase(args[0]),
7817 fir::getBase(args[1])));
7818}
7819
7820/// Create a fir.box to be passed to the LBOUND/UBOUND runtime.
7821/// This ensure that local lower bounds of assumed shape are propagated and that
7822/// a fir.box with equivalent LBOUNDs.
7823static mlir::Value
7824createBoxForRuntimeBoundInquiry(mlir::Location loc, fir::FirOpBuilder &builder,
7825 const fir::ExtendedValue &array) {
7826 // Assumed-rank descriptor must always carry accurate lower bound information
7827 // in lowering since they cannot be tracked on the side in a vector at compile
7828 // time.
7829 if (array.hasAssumedRank())
7830 return builder.createBox(loc, array);
7831
7832 return array.match(
7833 [&](const fir::BoxValue &boxValue) -> mlir::Value {
7834 // This entity is mapped to a fir.box that may not contain the local
7835 // lower bound information if it is a dummy. Rebox it with the local
7836 // shape information.
7837 mlir::Value localShape = builder.createShape(loc, array);
7838 mlir::Value oldBox = boxValue.getAddr();
7839 return builder.create<fir::ReboxOp>(loc, oldBox.getType(), oldBox,
7840 localShape,
7841 /*slice=*/mlir::Value{});
7842 },
7843 [&](const auto &) -> mlir::Value {
7844 // This is a pointer/allocatable, or an entity not yet tracked with a
7845 // fir.box. For pointer/allocatable, createBox will forward the
7846 // descriptor that contains the correct lower bound information. For
7847 // other entities, a new fir.box will be made with the local lower
7848 // bounds.
7849 return builder.createBox(loc, array);
7850 });
7851}
7852
7853/// Generate runtime call to inquire about all the bounds/extents of an
7854/// array (or an assumed-rank).
7855template <typename Func>
7856static fir::ExtendedValue
7857genBoundInquiry(fir::FirOpBuilder &builder, mlir::Location loc,
7858 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args,
7859 int kindPos, Func genRtCall, bool needAccurateLowerBound) {
7860 const fir::ExtendedValue &array = args[0];
7861 const bool hasAssumedRank = array.hasAssumedRank();
7862 mlir::Type resultElementType = fir::unwrapSequenceType(resultType);
7863 // For assumed-rank arrays, allocate an array with the maximum rank, that is
7864 // big enough to hold the result but still "small" (15 elements). Static size
7865 // alloca make stack analysis/manipulation easier.
7866 int rank = hasAssumedRank ? Fortran::common::maxRank : array.rank();
7867 mlir::Type allocSeqType = fir::SequenceType::get(rank, resultElementType);
7868 mlir::Value resultStorage = builder.createTemporary(loc, allocSeqType);
7869 mlir::Value arrayBox =
7870 needAccurateLowerBound
7871 ? createBoxForRuntimeBoundInquiry(loc, builder, array)
7872 : builder.createBox(loc, array);
7873 mlir::Value kind = isStaticallyAbsent(args, kindPos)
7874 ? builder.createIntegerConstant(
7875 loc, builder.getI32Type(),
7876 builder.getKindMap().defaultIntegerKind())
7877 : fir::getBase(args[kindPos]);
7878 genRtCall(builder, loc, resultStorage, arrayBox, kind);
7879 if (hasAssumedRank) {
7880 // Cast to fir.ref<array<?xik>> since the result extent is not a compile
7881 // time constant.
7882 mlir::Type baseType =
7883 fir::ReferenceType::get(builder.getVarLenSeqTy(resultElementType));
7884 mlir::Value resultBase =
7885 builder.createConvert(loc, baseType, resultStorage);
7886 mlir::Value rankValue =
7887 builder.create<fir::BoxRankOp>(loc, builder.getIndexType(), arrayBox);
7888 return fir::ArrayBoxValue{resultBase, {rankValue}};
7889 }
7890 // Result extent is a compile time constant in the other cases.
7891 mlir::Value rankValue =
7892 builder.createIntegerConstant(loc, builder.getIndexType(), rank);
7893 return fir::ArrayBoxValue{resultStorage, {rankValue}};
7894}
7895
7896// SHAPE
7897fir::ExtendedValue
7898IntrinsicLibrary::genShape(mlir::Type resultType,
7899 llvm::ArrayRef<fir::ExtendedValue> args) {
7900 assert(args.size() >= 1);
7901 const fir::ExtendedValue &array = args[0];
7902 if (array.hasAssumedRank())
7903 return genBoundInquiry(builder, loc, resultType, args,
7904 /*kindPos=*/1, fir::runtime::genShape,
7905 /*needAccurateLowerBound=*/false);
7906 int rank = array.rank();
7907 mlir::Type indexType = builder.getIndexType();
7908 mlir::Type extentType = fir::unwrapSequenceType(resultType);
7909 mlir::Type seqType = fir::SequenceType::get(
7910 {static_cast<fir::SequenceType::Extent>(rank)}, extentType);
7911 mlir::Value shapeArray = builder.createTemporary(loc, seqType);
7912 mlir::Type shapeAddrType = builder.getRefType(extentType);
7913 for (int dim = 0; dim < rank; ++dim) {
7914 mlir::Value extent = fir::factory::readExtent(builder, loc, array, dim);
7915 extent = builder.createConvert(loc, extentType, extent);
7916 auto index = builder.createIntegerConstant(loc, indexType, dim);
7917 auto shapeAddr = builder.create<fir::CoordinateOp>(loc, shapeAddrType,
7918 shapeArray, index);
7919 builder.create<fir::StoreOp>(loc, extent, shapeAddr);
7920 }
7921 mlir::Value shapeArrayExtent =
7922 builder.createIntegerConstant(loc, indexType, rank);
7923 llvm::SmallVector<mlir::Value> extents{shapeArrayExtent};
7924 return fir::ArrayBoxValue{shapeArray, extents};
7925}
7926
7927// SHIFTL, SHIFTR
7928template <typename Shift>
7929mlir::Value IntrinsicLibrary::genShift(mlir::Type resultType,
7930 llvm::ArrayRef<mlir::Value> args) {
7931 assert(args.size() == 2);
7932
7933 // If SHIFT < 0 or SHIFT >= BIT_SIZE(I), return 0. This is not required by
7934 // the standard. However, several other compilers behave this way, so try and
7935 // maintain compatibility with them to an extent.
7936
7937 unsigned bits = resultType.getIntOrFloatBitWidth();
7938 mlir::Type signlessType =
7939 mlir::IntegerType::get(builder.getContext(), bits,
7940 mlir::IntegerType::SignednessSemantics::Signless);
7941 mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits);
7942 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
7943 mlir::Value shift = builder.createConvert(loc, signlessType, args[1]);
7944
7945 mlir::Value tooSmall = builder.create<mlir::arith::CmpIOp>(
7946 loc, mlir::arith::CmpIPredicate::slt, shift, zero);
7947 mlir::Value tooLarge = builder.create<mlir::arith::CmpIOp>(
7948 loc, mlir::arith::CmpIPredicate::sge, shift, bitSize);
7949 mlir::Value outOfBounds =
7950 builder.create<mlir::arith::OrIOp>(loc, tooSmall, tooLarge);
7951 mlir::Value word = args[0];
7952 if (word.getType().isUnsignedInteger())
7953 word = builder.createConvert(loc, signlessType, word);
7954 mlir::Value shifted = builder.create<Shift>(loc, word, shift);
7955 mlir::Value result =
7956 builder.create<mlir::arith::SelectOp>(loc, outOfBounds, zero, shifted);
7957 if (resultType.isUnsignedInteger())
7958 return builder.createConvert(loc, resultType, result);
7959 return result;
7960}
7961
7962// SHIFTA
7963mlir::Value IntrinsicLibrary::genShiftA(mlir::Type resultType,
7964 llvm::ArrayRef<mlir::Value> args) {
7965 unsigned bits = resultType.getIntOrFloatBitWidth();
7966 mlir::Type signlessType =
7967 mlir::IntegerType::get(builder.getContext(), bits,
7968 mlir::IntegerType::SignednessSemantics::Signless);
7969 mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits);
7970 mlir::Value shift = builder.createConvert(loc, signlessType, args[1]);
7971 mlir::Value shiftGeBitSize = builder.create<mlir::arith::CmpIOp>(
7972 loc, mlir::arith::CmpIPredicate::uge, shift, bitSize);
7973
7974 // Lowering of mlir::arith::ShRSIOp is using `ashr`. `ashr` is undefined when
7975 // the shift amount is equal to the element size.
7976 // So if SHIFT is equal to the bit width then it is handled as a special case.
7977 // When negative or larger than the bit width, handle it like other
7978 // Fortran compiler do (treat it as bit width, minus 1).
7979 mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
7980 mlir::Value minusOne = builder.createMinusOneInteger(loc, signlessType);
7981 mlir::Value word = args[0];
7982 if (word.getType().isUnsignedInteger())
7983 word = builder.createConvert(loc, signlessType, word);
7984 mlir::Value valueIsNeg = builder.create<mlir::arith::CmpIOp>(
7985 loc, mlir::arith::CmpIPredicate::slt, word, zero);
7986 mlir::Value specialRes =
7987 builder.create<mlir::arith::SelectOp>(loc, valueIsNeg, minusOne, zero);
7988 mlir::Value shifted = builder.create<mlir::arith::ShRSIOp>(loc, word, shift);
7989 mlir::Value result = builder.create<mlir::arith::SelectOp>(
7990 loc, shiftGeBitSize, specialRes, shifted);
7991 if (resultType.isUnsignedInteger())
7992 return builder.createConvert(loc, resultType, result);
7993 return result;
7994}
7995
7996// SIGNAL
7997void IntrinsicLibrary::genSignalSubroutine(
7998 llvm::ArrayRef<fir::ExtendedValue> args) {
7999 assert(args.size() == 2 || args.size() == 3);
8000 mlir::Value number = fir::getBase(args[0]);
8001 mlir::Value handler = fir::getBase(args[1]);
8002 mlir::Value status;
8003 if (args.size() == 3)
8004 status = fir::getBase(args[2]);
8005 fir::runtime::genSignal(builder, loc, number, handler, status);
8006}
8007
8008// SIGN
8009mlir::Value IntrinsicLibrary::genSign(mlir::Type resultType,
8010 llvm::ArrayRef<mlir::Value> args) {
8011 assert(args.size() == 2);
8012 if (mlir::isa<mlir::IntegerType>(resultType)) {
8013 mlir::Value abs = genAbs(resultType, {args[0]});
8014 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
8015 auto neg = builder.create<mlir::arith::SubIOp>(loc, zero, abs);
8016 auto cmp = builder.create<mlir::arith::CmpIOp>(
8017 loc, mlir::arith::CmpIPredicate::slt, args[1], zero);
8018 return builder.create<mlir::arith::SelectOp>(loc, cmp, neg, abs);
8019 }
8020 return genRuntimeCall("sign", resultType, args);
8021}
8022
8023// SIND
8024mlir::Value IntrinsicLibrary::genSind(mlir::Type resultType,
8025 llvm::ArrayRef<mlir::Value> args) {
8026 assert(args.size() == 1);
8027 mlir::MLIRContext *context = builder.getContext();
8028 mlir::FunctionType ftype =
8029 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});
8030 llvm::APFloat pi = llvm::APFloat(llvm::numbers::pi);
8031 mlir::Value dfactor = builder.createRealConstant(
8032 loc, mlir::Float64Type::get(context), pi / llvm::APFloat(180.0));
8033 mlir::Value factor = builder.createConvert(loc, args[0].getType(), dfactor);
8034 mlir::Value arg = builder.create<mlir::arith::MulFOp>(loc, args[0], factor);
8035 return getRuntimeCallGenerator("sin", ftype)(builder, loc, {arg});
8036}
8037
8038// SIZE
8039fir::ExtendedValue
8040IntrinsicLibrary::genSize(mlir::Type resultType,
8041 llvm::ArrayRef<fir::ExtendedValue> args) {
8042 // Note that the value of the KIND argument is already reflected in the
8043 // resultType
8044 assert(args.size() == 3);
8045
8046 // Get the ARRAY argument
8047 mlir::Value array = builder.createBox(loc, args[0]);
8048
8049 // The front-end rewrites SIZE without the DIM argument to
8050 // an array of SIZE with DIM in most cases, but it may not be
8051 // possible in some cases like when in SIZE(function_call()).
8052 if (isStaticallyAbsent(args, 1))
8053 return builder.createConvert(loc, resultType,
8054 fir::runtime::genSize(builder, loc, array));
8055
8056 // Get the DIM argument.
8057 mlir::Value dim = fir::getBase(args[1]);
8058 if (!args[0].hasAssumedRank())
8059 if (std::optional<std::int64_t> cstDim = fir::getIntIfConstant(dim)) {
8060 // If both DIM and the rank are compile time constants, skip the runtime
8061 // call.
8062 return builder.createConvert(
8063 loc, resultType,
8064 fir::factory::readExtent(builder, loc, fir::BoxValue{array},
8065 cstDim.value() - 1));
8066 }
8067 if (!fir::isa_ref_type(dim.getType()))
8068 return builder.createConvert(
8069 loc, resultType, fir::runtime::genSizeDim(builder, loc, array, dim));
8070
8071 mlir::Value isDynamicallyAbsent = builder.genIsNullAddr(loc, dim);
8072 return builder
8073 .genIfOp(loc, {resultType}, isDynamicallyAbsent,
8074 /*withElseRegion=*/true)
8075 .genThen([&]() {
8076 mlir::Value size = builder.createConvert(
8077 loc, resultType, fir::runtime::genSize(builder, loc, array));
8078 builder.create<fir::ResultOp>(loc, size);
8079 })
8080 .genElse([&]() {
8081 mlir::Value dimValue = builder.create<fir::LoadOp>(loc, dim);
8082 mlir::Value size = builder.createConvert(
8083 loc, resultType,
8084 fir::runtime::genSizeDim(builder, loc, array, dimValue));
8085 builder.create<fir::ResultOp>(loc, size);
8086 })
8087 .getResults()[0];
8088}
8089
8090// SIZEOF
8091fir::ExtendedValue
8092IntrinsicLibrary::genSizeOf(mlir::Type resultType,
8093 llvm::ArrayRef<fir::ExtendedValue> args) {
8094 assert(args.size() == 1);
8095 mlir::Value box = fir::getBase(args[0]);
8096 mlir::Value eleSize = builder.create<fir::BoxEleSizeOp>(loc, resultType, box);
8097 if (!fir::isArray(args[0]))
8098 return eleSize;
8099 mlir::Value arraySize = builder.createConvert(
8100 loc, resultType, fir::runtime::genSize(builder, loc, box));
8101 return builder.create<mlir::arith::MulIOp>(loc, eleSize, arraySize);
8102}
8103
8104// TAND
8105mlir::Value IntrinsicLibrary::genTand(mlir::Type resultType,
8106 llvm::ArrayRef<mlir::Value> args) {
8107 assert(args.size() == 1);
8108 mlir::MLIRContext *context = builder.getContext();
8109 mlir::FunctionType ftype =
8110 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});
8111 llvm::APFloat pi = llvm::APFloat(llvm::numbers::pi);
8112 mlir::Value dfactor = builder.createRealConstant(
8113 loc, mlir::Float64Type::get(context), pi / llvm::APFloat(180.0));
8114 mlir::Value factor = builder.createConvert(loc, args[0].getType(), dfactor);
8115 mlir::Value arg = builder.create<mlir::arith::MulFOp>(loc, args[0], factor);
8116 return getRuntimeCallGenerator("tan", ftype)(builder, loc, {arg});
8117}
8118
8119// THIS_GRID
8120mlir::Value IntrinsicLibrary::genThisGrid(mlir::Type resultType,
8121 llvm::ArrayRef<mlir::Value> args) {
8122 assert(args.size() == 0);
8123 auto recTy = mlir::cast<fir::RecordType>(resultType);
8124 assert(recTy && "RecordType expepected");
8125 mlir::Value res = builder.create<fir::AllocaOp>(loc, resultType);
8126 mlir::Type i32Ty = builder.getI32Type();
8127
8128 mlir::Value threadIdX = builder.create<mlir::NVVM::ThreadIdXOp>(loc, i32Ty);
8129 mlir::Value threadIdY = builder.create<mlir::NVVM::ThreadIdYOp>(loc, i32Ty);
8130 mlir::Value threadIdZ = builder.create<mlir::NVVM::ThreadIdZOp>(loc, i32Ty);
8131
8132 mlir::Value blockIdX = builder.create<mlir::NVVM::BlockIdXOp>(loc, i32Ty);
8133 mlir::Value blockIdY = builder.create<mlir::NVVM::BlockIdYOp>(loc, i32Ty);
8134 mlir::Value blockIdZ = builder.create<mlir::NVVM::BlockIdZOp>(loc, i32Ty);
8135
8136 mlir::Value blockDimX = builder.create<mlir::NVVM::BlockDimXOp>(loc, i32Ty);
8137 mlir::Value blockDimY = builder.create<mlir::NVVM::BlockDimYOp>(loc, i32Ty);
8138 mlir::Value blockDimZ = builder.create<mlir::NVVM::BlockDimZOp>(loc, i32Ty);
8139 mlir::Value gridDimX = builder.create<mlir::NVVM::GridDimXOp>(loc, i32Ty);
8140 mlir::Value gridDimY = builder.create<mlir::NVVM::GridDimYOp>(loc, i32Ty);
8141 mlir::Value gridDimZ = builder.create<mlir::NVVM::GridDimZOp>(loc, i32Ty);
8142
8143 // this_grid.size = ((blockDim.z * gridDim.z) * (blockDim.y * gridDim.y)) *
8144 // (blockDim.x * gridDim.x);
8145 mlir::Value resZ =
8146 builder.create<mlir::arith::MulIOp>(loc, blockDimZ, gridDimZ);
8147 mlir::Value resY =
8148 builder.create<mlir::arith::MulIOp>(loc, blockDimY, gridDimY);
8149 mlir::Value resX =
8150 builder.create<mlir::arith::MulIOp>(loc, blockDimX, gridDimX);
8151 mlir::Value resZY = builder.create<mlir::arith::MulIOp>(loc, resZ, resY);
8152 mlir::Value size = builder.create<mlir::arith::MulIOp>(loc, resZY, resX);
8153
8154 // tmp = ((blockIdx.z * gridDim.y * gridDim.x) + (blockIdx.y * gridDim.x)) +
8155 // blockIdx.x;
8156 // this_group.rank = tmp * ((blockDim.x * blockDim.y) * blockDim.z) +
8157 // ((threadIdx.z * blockDim.y) * blockDim.x) +
8158 // (threadIdx.y * blockDim.x) + threadIdx.x + 1;
8159 mlir::Value r1 = builder.create<mlir::arith::MulIOp>(loc, blockIdZ, gridDimY);
8160 mlir::Value r2 = builder.create<mlir::arith::MulIOp>(loc, r1, gridDimX);
8161 mlir::Value r3 = builder.create<mlir::arith::MulIOp>(loc, blockIdY, gridDimX);
8162 mlir::Value r2r3 = builder.create<mlir::arith::AddIOp>(loc, r2, r3);
8163 mlir::Value tmp = builder.create<mlir::arith::AddIOp>(loc, r2r3, blockIdX);
8164
8165 mlir::Value bXbY =
8166 builder.create<mlir::arith::MulIOp>(loc, blockDimX, blockDimY);
8167 mlir::Value bXbYbZ =
8168 builder.create<mlir::arith::MulIOp>(loc, bXbY, blockDimZ);
8169 mlir::Value tZbY =
8170 builder.create<mlir::arith::MulIOp>(loc, threadIdZ, blockDimY);
8171 mlir::Value tZbYbX =
8172 builder.create<mlir::arith::MulIOp>(loc, tZbY, blockDimX);
8173 mlir::Value tYbX =
8174 builder.create<mlir::arith::MulIOp>(loc, threadIdY, blockDimX);
8175 mlir::Value rank = builder.create<mlir::arith::MulIOp>(loc, tmp, bXbYbZ);
8176 rank = builder.create<mlir::arith::AddIOp>(loc, rank, tZbYbX);
8177 rank = builder.create<mlir::arith::AddIOp>(loc, rank, tYbX);
8178 rank = builder.create<mlir::arith::AddIOp>(loc, rank, threadIdX);
8179 mlir::Value one = builder.createIntegerConstant(loc, i32Ty, 1);
8180 rank = builder.create<mlir::arith::AddIOp>(loc, rank, one);
8181
8182 auto sizeFieldName = recTy.getTypeList()[1].first;
8183 mlir::Type sizeFieldTy = recTy.getTypeList()[1].second;
8184 mlir::Type fieldIndexType = fir::FieldType::get(resultType.getContext());
8185 mlir::Value sizeFieldIndex = builder.create<fir::FieldIndexOp>(
8186 loc, fieldIndexType, sizeFieldName, recTy,
8187 /*typeParams=*/mlir::ValueRange{});
8188 mlir::Value sizeCoord = builder.create<fir::CoordinateOp>(
8189 loc, builder.getRefType(sizeFieldTy), res, sizeFieldIndex);
8190 builder.create<fir::StoreOp>(loc, size, sizeCoord);
8191
8192 auto rankFieldName = recTy.getTypeList()[2].first;
8193 mlir::Type rankFieldTy = recTy.getTypeList()[2].second;
8194 mlir::Value rankFieldIndex = builder.create<fir::FieldIndexOp>(
8195 loc, fieldIndexType, rankFieldName, recTy,
8196 /*typeParams=*/mlir::ValueRange{});
8197 mlir::Value rankCoord = builder.create<fir::CoordinateOp>(
8198 loc, builder.getRefType(rankFieldTy), res, rankFieldIndex);
8199 builder.create<fir::StoreOp>(loc, rank, rankCoord);
8200 return res;
8201}
8202
8203// THIS_THREAD_BLOCK
8204mlir::Value
8205IntrinsicLibrary::genThisThreadBlock(mlir::Type resultType,
8206 llvm::ArrayRef<mlir::Value> args) {
8207 assert(args.size() == 0);
8208 auto recTy = mlir::cast<fir::RecordType>(resultType);
8209 assert(recTy && "RecordType expepected");
8210 mlir::Value res = builder.create<fir::AllocaOp>(loc, resultType);
8211 mlir::Type i32Ty = builder.getI32Type();
8212
8213 // this_thread_block%size = blockDim.z * blockDim.y * blockDim.x;
8214 mlir::Value blockDimX = builder.create<mlir::NVVM::BlockDimXOp>(loc, i32Ty);
8215 mlir::Value blockDimY = builder.create<mlir::NVVM::BlockDimYOp>(loc, i32Ty);
8216 mlir::Value blockDimZ = builder.create<mlir::NVVM::BlockDimZOp>(loc, i32Ty);
8217 mlir::Value size =
8218 builder.create<mlir::arith::MulIOp>(loc, blockDimZ, blockDimY);
8219 size = builder.create<mlir::arith::MulIOp>(loc, size, blockDimX);
8220
8221 // this_thread_block%rank = ((threadIdx.z * blockDim.y) * blockDim.x) +
8222 // (threadIdx.y * blockDim.x) + threadIdx.x + 1;
8223 mlir::Value threadIdX = builder.create<mlir::NVVM::ThreadIdXOp>(loc, i32Ty);
8224 mlir::Value threadIdY = builder.create<mlir::NVVM::ThreadIdYOp>(loc, i32Ty);
8225 mlir::Value threadIdZ = builder.create<mlir::NVVM::ThreadIdZOp>(loc, i32Ty);
8226 mlir::Value r1 =
8227 builder.create<mlir::arith::MulIOp>(loc, threadIdZ, blockDimY);
8228 mlir::Value r2 = builder.create<mlir::arith::MulIOp>(loc, r1, blockDimX);
8229 mlir::Value r3 =
8230 builder.create<mlir::arith::MulIOp>(loc, threadIdY, blockDimX);
8231 mlir::Value r2r3 = builder.create<mlir::arith::AddIOp>(loc, r2, r3);
8232 mlir::Value rank = builder.create<mlir::arith::AddIOp>(loc, r2r3, threadIdX);
8233 mlir::Value one = builder.createIntegerConstant(loc, i32Ty, 1);
8234 rank = builder.create<mlir::arith::AddIOp>(loc, rank, one);
8235
8236 auto sizeFieldName = recTy.getTypeList()[1].first;
8237 mlir::Type sizeFieldTy = recTy.getTypeList()[1].second;
8238 mlir::Type fieldIndexType = fir::FieldType::get(resultType.getContext());
8239 mlir::Value sizeFieldIndex = builder.create<fir::FieldIndexOp>(
8240 loc, fieldIndexType, sizeFieldName, recTy,
8241 /*typeParams=*/mlir::ValueRange{});
8242 mlir::Value sizeCoord = builder.create<fir::CoordinateOp>(
8243 loc, builder.getRefType(sizeFieldTy), res, sizeFieldIndex);
8244 builder.create<fir::StoreOp>(loc, size, sizeCoord);
8245
8246 auto rankFieldName = recTy.getTypeList()[2].first;
8247 mlir::Type rankFieldTy = recTy.getTypeList()[2].second;
8248 mlir::Value rankFieldIndex = builder.create<fir::FieldIndexOp>(
8249 loc, fieldIndexType, rankFieldName, recTy,
8250 /*typeParams=*/mlir::ValueRange{});
8251 mlir::Value rankCoord = builder.create<fir::CoordinateOp>(
8252 loc, builder.getRefType(rankFieldTy), res, rankFieldIndex);
8253 builder.create<fir::StoreOp>(loc, rank, rankCoord);
8254 return res;
8255}
8256
8257// THIS_WARP
8258mlir::Value IntrinsicLibrary::genThisWarp(mlir::Type resultType,
8259 llvm::ArrayRef<mlir::Value> args) {
8260 assert(args.size() == 0);
8261 auto recTy = mlir::cast<fir::RecordType>(resultType);
8262 assert(recTy && "RecordType expepected");
8263 mlir::Value res = builder.create<fir::AllocaOp>(loc, resultType);
8264 mlir::Type i32Ty = builder.getI32Type();
8265
8266 // coalesced_group%size = 32
8267 mlir::Value size = builder.createIntegerConstant(loc, i32Ty, 32);
8268 auto sizeFieldName = recTy.getTypeList()[1].first;
8269 mlir::Type sizeFieldTy = recTy.getTypeList()[1].second;
8270 mlir::Type fieldIndexType = fir::FieldType::get(resultType.getContext());
8271 mlir::Value sizeFieldIndex = builder.create<fir::FieldIndexOp>(
8272 loc, fieldIndexType, sizeFieldName, recTy,
8273 /*typeParams=*/mlir::ValueRange{});
8274 mlir::Value sizeCoord = builder.create<fir::CoordinateOp>(
8275 loc, builder.getRefType(sizeFieldTy), res, sizeFieldIndex);
8276 builder.create<fir::StoreOp>(loc, size, sizeCoord);
8277
8278 // coalesced_group%rank = threadIdx.x & 31 + 1
8279 mlir::Value threadIdX = builder.create<mlir::NVVM::ThreadIdXOp>(loc, i32Ty);
8280 mlir::Value mask = builder.createIntegerConstant(loc, i32Ty, 31);
8281 mlir::Value one = builder.createIntegerConstant(loc, i32Ty, 1);
8282 mlir::Value masked =
8283 builder.create<mlir::arith::AndIOp>(loc, threadIdX, mask);
8284 mlir::Value rank = builder.create<mlir::arith::AddIOp>(loc, masked, one);
8285 auto rankFieldName = recTy.getTypeList()[2].first;
8286 mlir::Type rankFieldTy = recTy.getTypeList()[2].second;
8287 mlir::Value rankFieldIndex = builder.create<fir::FieldIndexOp>(
8288 loc, fieldIndexType, rankFieldName, recTy,
8289 /*typeParams=*/mlir::ValueRange{});
8290 mlir::Value rankCoord = builder.create<fir::CoordinateOp>(
8291 loc, builder.getRefType(rankFieldTy), res, rankFieldIndex);
8292 builder.create<fir::StoreOp>(loc, rank, rankCoord);
8293 return res;
8294}
8295
8296// TRAILZ
8297mlir::Value IntrinsicLibrary::genTrailz(mlir::Type resultType,
8298 llvm::ArrayRef<mlir::Value> args) {
8299 assert(args.size() == 1);
8300
8301 mlir::Value result =
8302 builder.create<mlir::math::CountTrailingZerosOp>(loc, args);
8303
8304 return builder.createConvert(loc, resultType, result);
8305}
8306
8307static bool hasDefaultLowerBound(const fir::ExtendedValue &exv) {
8308 return exv.match(
8309 [](const fir::ArrayBoxValue &arr) { return arr.getLBounds().empty(); },
8310 [](const fir::CharArrayBoxValue &arr) {
8311 return arr.getLBounds().empty();
8312 },
8313 [](const fir::BoxValue &arr) { return arr.getLBounds().empty(); },
8314 [](const auto &) { return false; });
8315}
8316
8317/// Compute the lower bound in dimension \p dim (zero based) of \p array
8318/// taking care of returning one when the related extent is zero.
8319static mlir::Value computeLBOUND(fir::FirOpBuilder &builder, mlir::Location loc,
8320 const fir::ExtendedValue &array, unsigned dim,
8321 mlir::Value zero, mlir::Value one) {
8322 assert(dim < array.rank() && "invalid dimension");
8323 if (hasDefaultLowerBound(array))
8324 return one;
8325 mlir::Value lb = fir::factory::readLowerBound(builder, loc, array, dim, one);
8326 mlir::Value extent = fir::factory::readExtent(builder, loc, array, dim);
8327 zero = builder.createConvert(loc, extent.getType(), zero);
8328 // Note: for assumed size, the extent is -1, and the lower bound should
8329 // be returned. It is important to test extent == 0 and not extent > 0.
8330 auto dimIsEmpty = builder.create<mlir::arith::CmpIOp>(
8331 loc, mlir::arith::CmpIPredicate::eq, extent, zero);
8332 one = builder.createConvert(loc, lb.getType(), one);
8333 return builder.create<mlir::arith::SelectOp>(loc, dimIsEmpty, one, lb);
8334}
8335
8336// LBOUND
8337fir::ExtendedValue
8338IntrinsicLibrary::genLbound(mlir::Type resultType,
8339 llvm::ArrayRef<fir::ExtendedValue> args) {
8340 assert(args.size() == 2 || args.size() == 3);
8341 const fir::ExtendedValue &array = args[0];
8342 // Semantics builds signatures for LBOUND calls as either
8343 // LBOUND(array, dim, [kind]) or LBOUND(array, [kind]).
8344 const bool dimIsAbsent = args.size() == 2 || isStaticallyAbsent(args, 1);
8345 if (array.hasAssumedRank() && dimIsAbsent) {
8346 int kindPos = args.size() == 2 ? 1 : 2;
8347 return genBoundInquiry(builder, loc, resultType, args, kindPos,
8348 fir::runtime::genLbound,
8349 /*needAccurateLowerBound=*/true);
8350 }
8351
8352 mlir::Type indexType = builder.getIndexType();
8353
8354 if (dimIsAbsent) {
8355 // DIM is absent and the rank of array is a compile time constant.
8356 mlir::Type lbType = fir::unwrapSequenceType(resultType);
8357 unsigned rank = array.rank();
8358 mlir::Type lbArrayType = fir::SequenceType::get(
8359 {static_cast<fir::SequenceType::Extent>(array.rank())}, lbType);
8360 mlir::Value lbArray = builder.createTemporary(loc, lbArrayType);
8361 mlir::Type lbAddrType = builder.getRefType(lbType);
8362 mlir::Value one = builder.createIntegerConstant(loc, lbType, 1);
8363 mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0);
8364 for (unsigned dim = 0; dim < rank; ++dim) {
8365 mlir::Value lb = computeLBOUND(builder, loc, array, dim, zero, one);
8366 lb = builder.createConvert(loc, lbType, lb);
8367 auto index = builder.createIntegerConstant(loc, indexType, dim);
8368 auto lbAddr =
8369 builder.create<fir::CoordinateOp>(loc, lbAddrType, lbArray, index);
8370 builder.create<fir::StoreOp>(loc, lb, lbAddr);
8371 }
8372 mlir::Value lbArrayExtent =
8373 builder.createIntegerConstant(loc, indexType, rank);
8374 llvm::SmallVector<mlir::Value> extents{lbArrayExtent};
8375 return fir::ArrayBoxValue{lbArray, extents};
8376 }
8377 // DIM is present.
8378 mlir::Value dim = fir::getBase(args[1]);
8379
8380 // If it is a compile time constant and the rank is known, skip the runtime
8381 // call.
8382 if (!array.hasAssumedRank())
8383 if (std::optional<std::int64_t> cstDim = fir::getIntIfConstant(dim)) {
8384 mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
8385 mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0);
8386 mlir::Value lb =
8387 computeLBOUND(builder, loc, array, *cstDim - 1, zero, one);
8388 return builder.createConvert(loc, resultType, lb);
8389 }
8390
8391 fir::ExtendedValue box = createBoxForRuntimeBoundInquiry(loc, builder, array);
8392 return builder.createConvert(
8393 loc, resultType,
8394 fir::runtime::genLboundDim(builder, loc, fir::getBase(box), dim));
8395}
8396
8397// UBOUND
8398fir::ExtendedValue
8399IntrinsicLibrary::genUbound(mlir::Type resultType,
8400 llvm::ArrayRef<fir::ExtendedValue> args) {
8401 assert(args.size() == 3 || args.size() == 2);
8402 const bool dimIsAbsent = args.size() == 2 || isStaticallyAbsent(args, 1);
8403 if (!dimIsAbsent) {
8404 // Handle calls to UBOUND with the DIM argument, which return a scalar
8405 mlir::Value extent = fir::getBase(genSize(resultType, args));
8406 mlir::Value lbound = fir::getBase(genLbound(resultType, args));
8407
8408 mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
8409 mlir::Value ubound = builder.create<mlir::arith::SubIOp>(loc, lbound, one);
8410 return builder.create<mlir::arith::AddIOp>(loc, ubound, extent);
8411 }
8412 // Handle calls to UBOUND without the DIM argument, which return an array
8413 int kindPos = args.size() == 2 ? 1 : 2;
8414 return genBoundInquiry(builder, loc, resultType, args, kindPos,
8415 fir::runtime::genUbound,
8416 /*needAccurateLowerBound=*/true);
8417}
8418
8419// SPACING
8420mlir::Value IntrinsicLibrary::genSpacing(mlir::Type resultType,
8421 llvm::ArrayRef<mlir::Value> args) {
8422 assert(args.size() == 1);
8423
8424 return builder.createConvert(
8425 loc, resultType,
8426 fir::runtime::genSpacing(builder, loc, fir::getBase(args[0])));
8427}
8428
8429// SPREAD
8430fir::ExtendedValue
8431IntrinsicLibrary::genSpread(mlir::Type resultType,
8432 llvm::ArrayRef<fir::ExtendedValue> args) {
8433
8434 assert(args.size() == 3);
8435
8436 // Handle source argument
8437 mlir::Value source = builder.createBox(loc, args[0]);
8438 fir::BoxValue sourceTmp = source;
8439 unsigned sourceRank = sourceTmp.rank();
8440
8441 // Handle Dim argument
8442 mlir::Value dim = fir::getBase(args[1]);
8443
8444 // Handle ncopies argument
8445 mlir::Value ncopies = fir::getBase(args[2]);
8446
8447 // Generate result descriptor
8448 mlir::Type resultArrayType =
8449 builder.getVarLenSeqTy(resultType, sourceRank + 1);
8450 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(
8451 builder, loc, resultArrayType, {},
8452 fir::isPolymorphicType(source.getType()) ? source : mlir::Value{});
8453 mlir::Value resultIrBox =
8454 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
8455
8456 fir::runtime::genSpread(builder, loc, resultIrBox, source, dim, ncopies);
8457
8458 return readAndAddCleanUp(resultMutableBox, resultType, "SPREAD");
8459}
8460
8461// STORAGE_SIZE
8462fir::ExtendedValue
8463IntrinsicLibrary::genStorageSize(mlir::Type resultType,
8464 llvm::ArrayRef<fir::ExtendedValue> args) {
8465 assert(args.size() == 2 || args.size() == 1);
8466 mlir::Value box = fir::getBase(args[0]);
8467 mlir::Type boxTy = box.getType();
8468 mlir::Type kindTy = builder.getDefaultIntegerType();
8469 bool needRuntimeCheck = false;
8470 std::string errorMsg;
8471
8472 if (fir::isUnlimitedPolymorphicType(boxTy) &&
8473 (fir::isAllocatableType(boxTy) || fir::isPointerType(boxTy))) {
8474 needRuntimeCheck = true;
8475 errorMsg =
8476 fir::isPointerType(boxTy)
8477 ? "unlimited polymorphic disassociated POINTER in STORAGE_SIZE"
8478 : "unlimited polymorphic unallocated ALLOCATABLE in STORAGE_SIZE";
8479 }
8480 const fir::MutableBoxValue *mutBox = args[0].getBoxOf<fir::MutableBoxValue>();
8481 if (needRuntimeCheck && mutBox) {
8482 mlir::Value isNotAllocOrAssoc =
8483 fir::factory::genIsNotAllocatedOrAssociatedTest(builder, loc, *mutBox);
8484 builder.genIfThen(loc, isNotAllocOrAssoc)
8485 .genThen([&]() {
8486 fir::runtime::genReportFatalUserError(builder, loc, errorMsg);
8487 })
8488 .end();
8489 }
8490
8491 // Handle optional kind argument
8492 bool absentKind = isStaticallyAbsent(args, 1);
8493 if (!absentKind) {
8494 mlir::Operation *defKind = fir::getBase(args[1]).getDefiningOp();
8495 assert(mlir::isa<mlir::arith::ConstantOp>(*defKind) &&
8496 "kind not a constant");
8497 auto constOp = mlir::dyn_cast<mlir::arith::ConstantOp>(*defKind);
8498 kindTy = builder.getIntegerType(
8499 builder.getKindMap().getIntegerBitsize(fir::toInt(constOp)));
8500 }
8501
8502 box = builder.createBox(loc, args[0],
8503 /*isPolymorphic=*/args[0].isPolymorphic());
8504 mlir::Value eleSize = builder.create<fir::BoxEleSizeOp>(loc, kindTy, box);
8505 mlir::Value c8 = builder.createIntegerConstant(loc, kindTy, 8);
8506 return builder.create<mlir::arith::MulIOp>(loc, eleSize, c8);
8507}
8508
8509// SUM
8510fir::ExtendedValue
8511IntrinsicLibrary::genSum(mlir::Type resultType,
8512 llvm::ArrayRef<fir::ExtendedValue> args) {
8513 return genReduction(fir::runtime::genSum, fir::runtime::genSumDim, "SUM",
8514 resultType, args);
8515}
8516
8517// SYNCTHREADS
8518void IntrinsicLibrary::genSyncThreads(llvm::ArrayRef<fir::ExtendedValue> args) {
8519 builder.create<mlir::NVVM::Barrier0Op>(loc);
8520}
8521
8522// SYNCTHREADS_AND
8523mlir::Value
8524IntrinsicLibrary::genSyncThreadsAnd(mlir::Type resultType,
8525 llvm::ArrayRef<mlir::Value> args) {
8526 constexpr llvm::StringLiteral funcName = "llvm.nvvm.barrier0.and";
8527 mlir::MLIRContext *context = builder.getContext();
8528 mlir::FunctionType ftype =
8529 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});
8530 auto funcOp = builder.createFunction(loc, funcName, ftype);
8531 return builder.create<fir::CallOp>(loc, funcOp, args).getResult(0);
8532}
8533
8534// SYNCTHREADS_COUNT
8535mlir::Value
8536IntrinsicLibrary::genSyncThreadsCount(mlir::Type resultType,
8537 llvm::ArrayRef<mlir::Value> args) {
8538 constexpr llvm::StringLiteral funcName = "llvm.nvvm.barrier0.popc";
8539 mlir::MLIRContext *context = builder.getContext();
8540 mlir::FunctionType ftype =
8541 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});
8542 auto funcOp = builder.createFunction(loc, funcName, ftype);
8543 return builder.create<fir::CallOp>(loc, funcOp, args).getResult(0);
8544}
8545
8546// SYNCTHREADS_OR
8547mlir::Value
8548IntrinsicLibrary::genSyncThreadsOr(mlir::Type resultType,
8549 llvm::ArrayRef<mlir::Value> args) {
8550 constexpr llvm::StringLiteral funcName = "llvm.nvvm.barrier0.or";
8551 mlir::MLIRContext *context = builder.getContext();
8552 mlir::FunctionType ftype =
8553 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});
8554 auto funcOp = builder.createFunction(loc, funcName, ftype);
8555 return builder.create<fir::CallOp>(loc, funcOp, args).getResult(0);
8556}
8557
8558// SYNCWARP
8559void IntrinsicLibrary::genSyncWarp(llvm::ArrayRef<fir::ExtendedValue> args) {
8560 assert(args.size() == 1);
8561 constexpr llvm::StringLiteral funcName = "llvm.nvvm.bar.warp.sync";
8562 mlir::Value mask = fir::getBase(args[0]);
8563 mlir::FunctionType funcType =
8564 mlir::FunctionType::get(builder.getContext(), {mask.getType()}, {});
8565 auto funcOp = builder.createFunction(loc, funcName, funcType);
8566 llvm::SmallVector<mlir::Value> argsList{mask};
8567 builder.create<fir::CallOp>(loc, funcOp, argsList);
8568}
8569
8570// SYSTEM
8571fir::ExtendedValue
8572IntrinsicLibrary::genSystem(std::optional<mlir::Type> resultType,
8573 llvm::ArrayRef<fir::ExtendedValue> args) {
8574 assert((!resultType && (args.size() == 2)) ||
8575 (resultType && (args.size() == 1)));
8576 mlir::Value command = fir::getBase(args[0]);
8577 assert(command && "expected COMMAND parameter");
8578
8579 fir::ExtendedValue exitstat;
8580 if (resultType) {
8581 mlir::Value tmp = builder.createTemporary(loc, *resultType);
8582 exitstat = builder.createBox(loc, tmp);
8583 } else {
8584 exitstat = args[1];
8585 }
8586
8587 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
8588
8589 mlir::Value waitBool = builder.createBool(loc, true);
8590 mlir::Value exitstatBox =
8591 isStaticallyPresent(exitstat)
8592 ? fir::getBase(exitstat)
8593 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
8594
8595 // Create a dummmy cmdstat to prevent EXECUTE_COMMAND_LINE terminate itself
8596 // when cmdstat is assigned with a non-zero value but not present
8597 mlir::Value tempValue =
8598 builder.createIntegerConstant(loc, builder.getI16Type(), 0);
8599 mlir::Value temp = builder.createTemporary(loc, builder.getI16Type());
8600 builder.create<fir::StoreOp>(loc, tempValue, temp);
8601 mlir::Value cmdstatBox = builder.createBox(loc, temp);
8602
8603 mlir::Value cmdmsgBox =
8604 builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
8605
8606 fir::runtime::genExecuteCommandLine(builder, loc, command, waitBool,
8607 exitstatBox, cmdstatBox, cmdmsgBox);
8608
8609 if (resultType) {
8610 mlir::Value exitstatAddr = builder.create<fir::BoxAddrOp>(loc, exitstatBox);
8611 return builder.create<fir::LoadOp>(loc, fir::getBase(exitstatAddr));
8612 }
8613 return {};
8614}
8615
8616// SYSTEM_CLOCK
8617void IntrinsicLibrary::genSystemClock(llvm::ArrayRef<fir::ExtendedValue> args) {
8618 assert(args.size() == 3);
8619 fir::runtime::genSystemClock(builder, loc, fir::getBase(args[0]),
8620 fir::getBase(args[1]), fir::getBase(args[2]));
8621}
8622
8623// SLEEP
8624void IntrinsicLibrary::genSleep(llvm::ArrayRef<fir::ExtendedValue> args) {
8625 assert(args.size() == 1 && "SLEEP has one compulsory argument");
8626 fir::runtime::genSleep(builder, loc, fir::getBase(args[0]));
8627}
8628
8629// TRANSFER
8630fir::ExtendedValue
8631IntrinsicLibrary::genTransfer(mlir::Type resultType,
8632 llvm::ArrayRef<fir::ExtendedValue> args) {
8633
8634 assert(args.size() >= 2); // args.size() == 2 when size argument is omitted.
8635
8636 // Handle source argument
8637 mlir::Value source = builder.createBox(loc, args[0]);
8638
8639 // Handle mold argument
8640 mlir::Value mold = builder.createBox(loc, args[1]);
8641 fir::BoxValue moldTmp = mold;
8642 unsigned moldRank = moldTmp.rank();
8643
8644 bool absentSize = (args.size() == 2);
8645
8646 // Create mutable fir.box to be passed to the runtime for the result.
8647 mlir::Type type = (moldRank == 0 && absentSize)
8648 ? resultType
8649 : builder.getVarLenSeqTy(resultType, 1);
8650 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(
8651 builder, loc, type, {},
8652 fir::isPolymorphicType(mold.getType()) ? mold : mlir::Value{});
8653
8654 if (moldRank == 0 && absentSize) {
8655 // This result is a scalar in this case.
8656 mlir::Value resultIrBox =
8657 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
8658
8659 fir::runtime::genTransfer(builder, loc, resultIrBox, source, mold);
8660 } else {
8661 // The result is a rank one array in this case.
8662 mlir::Value resultIrBox =
8663 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
8664
8665 if (absentSize) {
8666 fir::runtime::genTransfer(builder, loc, resultIrBox, source, mold);
8667 } else {
8668 mlir::Value sizeArg = fir::getBase(args[2]);
8669 fir::runtime::genTransferSize(builder, loc, resultIrBox, source, mold,
8670 sizeArg);
8671 }
8672 }
8673 return readAndAddCleanUp(resultMutableBox, resultType, "TRANSFER");
8674}
8675
8676// TRANSPOSE
8677fir::ExtendedValue
8678IntrinsicLibrary::genTranspose(mlir::Type resultType,
8679 llvm::ArrayRef<fir::ExtendedValue> args) {
8680
8681 assert(args.size() == 1);
8682
8683 // Handle source argument
8684 mlir::Value source = builder.createBox(loc, args[0]);
8685
8686 // Create mutable fir.box to be passed to the runtime for the result.
8687 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 2);
8688 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(
8689 builder, loc, resultArrayType, {},
8690 fir::isPolymorphicType(source.getType()) ? source : mlir::Value{});
8691 mlir::Value resultIrBox =
8692 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
8693 // Call runtime. The runtime is allocating the result.
8694 fir::runtime::genTranspose(builder, loc, resultIrBox, source);
8695 // Read result from mutable fir.box and add it to the list of temps to be
8696 // finalized by the StatementContext.
8697 return readAndAddCleanUp(resultMutableBox, resultType, "TRANSPOSE");
8698}
8699
8700// THREADFENCE
8701void IntrinsicLibrary::genThreadFence(llvm::ArrayRef<fir::ExtendedValue> args) {
8702 constexpr llvm::StringLiteral funcName = "llvm.nvvm.membar.gl";
8703 mlir::FunctionType funcType =
8704 mlir::FunctionType::get(builder.getContext(), {}, {});
8705 auto funcOp = builder.createFunction(loc, funcName, funcType);
8706 llvm::SmallVector<mlir::Value> noArgs;
8707 builder.create<fir::CallOp>(loc, funcOp, noArgs);
8708}
8709
8710// THREADFENCE_BLOCK
8711void IntrinsicLibrary::genThreadFenceBlock(
8712 llvm::ArrayRef<fir::ExtendedValue> args) {
8713 constexpr llvm::StringLiteral funcName = "llvm.nvvm.membar.cta";
8714 mlir::FunctionType funcType =
8715 mlir::FunctionType::get(builder.getContext(), {}, {});
8716 auto funcOp = builder.createFunction(loc, funcName, funcType);
8717 llvm::SmallVector<mlir::Value> noArgs;
8718 builder.create<fir::CallOp>(loc, funcOp, noArgs);
8719}
8720
8721// THREADFENCE_SYSTEM
8722void IntrinsicLibrary::genThreadFenceSystem(
8723 llvm::ArrayRef<fir::ExtendedValue> args) {
8724 constexpr llvm::StringLiteral funcName = "llvm.nvvm.membar.sys";
8725 mlir::FunctionType funcType =
8726 mlir::FunctionType::get(builder.getContext(), {}, {});
8727 auto funcOp = builder.createFunction(loc, funcName, funcType);
8728 llvm::SmallVector<mlir::Value> noArgs;
8729 builder.create<fir::CallOp>(loc, funcOp, noArgs);
8730}
8731
8732// TIME
8733mlir::Value IntrinsicLibrary::genTime(mlir::Type resultType,
8734 llvm::ArrayRef<mlir::Value> args) {
8735 assert(args.size() == 0);
8736 return builder.createConvert(loc, resultType,
8737 fir::runtime::genTime(builder, loc));
8738}
8739
8740// TRIM
8741fir::ExtendedValue
8742IntrinsicLibrary::genTrim(mlir::Type resultType,
8743 llvm::ArrayRef<fir::ExtendedValue> args) {
8744 assert(args.size() == 1);
8745 mlir::Value string = builder.createBox(loc, args[0]);
8746 // Create mutable fir.box to be passed to the runtime for the result.
8747 fir::MutableBoxValue resultMutableBox =
8748 fir::factory::createTempMutableBox(builder, loc, resultType);
8749 mlir::Value resultIrBox =
8750 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
8751 // Call runtime. The runtime is allocating the result.
8752 fir::runtime::genTrim(builder, loc, resultIrBox, string);
8753 // Read result from mutable fir.box and add it to the list of temps to be
8754 // finalized by the StatementContext.
8755 return readAndAddCleanUp(resultMutableBox, resultType, "TRIM");
8756}
8757
8758// Compare two FIR values and return boolean result as i1.
8759template <Extremum extremum, ExtremumBehavior behavior>
8760static mlir::Value createExtremumCompare(mlir::Location loc,
8761 fir::FirOpBuilder &builder,
8762 mlir::Value left, mlir::Value right) {
8763 mlir::Type type = left.getType();
8764 mlir::arith::CmpIPredicate integerPredicate =
8765 type.isUnsignedInteger() ? extremum == Extremum::Max
8766 ? mlir::arith::CmpIPredicate::ugt
8767 : mlir::arith::CmpIPredicate::ult
8768 : extremum == Extremum::Max ? mlir::arith::CmpIPredicate::sgt
8769 : mlir::arith::CmpIPredicate::slt;
8770 static constexpr mlir::arith::CmpFPredicate orderedCmp =
8771 extremum == Extremum::Max ? mlir::arith::CmpFPredicate::OGT
8772 : mlir::arith::CmpFPredicate::OLT;
8773 mlir::Value result;
8774 if (fir::isa_real(type)) {
8775 // Note: the signaling/quit aspect of the result required by IEEE
8776 // cannot currently be obtained with LLVM without ad-hoc runtime.
8777 if constexpr (behavior == ExtremumBehavior::IeeeMinMaximumNumber) {
8778 // Return the number if one of the inputs is NaN and the other is
8779 // a number.
8780 auto leftIsResult =
8781 builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
8782 auto rightIsNan = builder.create<mlir::arith::CmpFOp>(
8783 loc, mlir::arith::CmpFPredicate::UNE, right, right);
8784 result =
8785 builder.create<mlir::arith::OrIOp>(loc, leftIsResult, rightIsNan);
8786 } else if constexpr (behavior == ExtremumBehavior::IeeeMinMaximum) {
8787 // Always return NaNs if one the input is NaNs
8788 auto leftIsResult =
8789 builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
8790 auto leftIsNan = builder.create<mlir::arith::CmpFOp>(
8791 loc, mlir::arith::CmpFPredicate::UNE, left, left);
8792 result = builder.create<mlir::arith::OrIOp>(loc, leftIsResult, leftIsNan);
8793 } else if constexpr (behavior == ExtremumBehavior::MinMaxss) {
8794 // If the left is a NaN, return the right whatever it is.
8795 result =
8796 builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
8797 } else if constexpr (behavior == ExtremumBehavior::PgfortranLlvm) {
8798 // If one of the operand is a NaN, return left whatever it is.
8799 static constexpr auto unorderedCmp =
8800 extremum == Extremum::Max ? mlir::arith::CmpFPredicate::UGT
8801 : mlir::arith::CmpFPredicate::ULT;
8802 result =
8803 builder.create<mlir::arith::CmpFOp>(loc, unorderedCmp, left, right);
8804 } else {
8805 // TODO: ieeeMinNum/ieeeMaxNum
8806 static_assert(behavior == ExtremumBehavior::IeeeMinMaxNum,
8807 "ieeeMinNum/ieeeMaxNum behavior not implemented");
8808 }
8809 } else if (fir::isa_integer(type)) {
8810 if (type.isUnsignedInteger()) {
8811 mlir::Type signlessType = mlir::IntegerType::get(
8812 context: builder.getContext(), width: type.getIntOrFloatBitWidth(),
8813 signedness: mlir::IntegerType::SignednessSemantics::Signless);
8814 left = builder.createConvert(loc, signlessType, left);
8815 right = builder.createConvert(loc, signlessType, right);
8816 }
8817 result =
8818 builder.create<mlir::arith::CmpIOp>(loc, integerPredicate, left, right);
8819 } else if (fir::isa_char(type) || fir::isa_char(fir::unwrapRefType(type))) {
8820 // TODO: ! character min and max is tricky because the result
8821 // length is the length of the longest argument!
8822 // So we may need a temp.
8823 TODO(loc, "intrinsic: min and max for CHARACTER");
8824 }
8825 assert(result && "result must be defined");
8826 return result;
8827}
8828
8829// UNLINK
8830fir::ExtendedValue
8831IntrinsicLibrary::genUnlink(std::optional<mlir::Type> resultType,
8832 llvm::ArrayRef<fir::ExtendedValue> args) {
8833 assert((resultType.has_value() && args.size() == 1) ||
8834 (!resultType.has_value() && args.size() >= 1 && args.size() <= 2));
8835
8836 mlir::Value path = fir::getBase(args[0]);
8837 mlir::Value pathLength = fir::getLen(args[0]);
8838 mlir::Value statusValue =
8839 fir::runtime::genUnlink(builder, loc, path, pathLength);
8840
8841 if (resultType.has_value()) {
8842 // Function form, return status.
8843 return builder.createConvert(loc, *resultType, statusValue);
8844 }
8845
8846 // Subroutine form, store status and return none.
8847 const fir::ExtendedValue &status = args[1];
8848 if (!isStaticallyAbsent(status)) {
8849 mlir::Value statusAddr = fir::getBase(status);
8850 mlir::Value statusIsPresentAtRuntime =
8851 builder.genIsNotNullAddr(loc, statusAddr);
8852 builder.genIfThen(loc, statusIsPresentAtRuntime)
8853 .genThen([&]() {
8854 builder.createStoreWithConvert(loc, statusValue, statusAddr);
8855 })
8856 .end();
8857 }
8858
8859 return {};
8860}
8861
8862// UNPACK
8863fir::ExtendedValue
8864IntrinsicLibrary::genUnpack(mlir::Type resultType,
8865 llvm::ArrayRef<fir::ExtendedValue> args) {
8866 assert(args.size() == 3);
8867
8868 // Handle required vector argument
8869 mlir::Value vector = builder.createBox(loc, args[0]);
8870
8871 // Handle required mask argument
8872 fir::BoxValue maskBox = builder.createBox(loc, args[1]);
8873 mlir::Value mask = fir::getBase(maskBox);
8874 unsigned maskRank = maskBox.rank();
8875
8876 // Handle required field argument
8877 mlir::Value field = builder.createBox(loc, args[2]);
8878
8879 // Create mutable fir.box to be passed to the runtime for the result.
8880 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, maskRank);
8881 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(
8882 builder, loc, resultArrayType, {},
8883 fir::isPolymorphicType(vector.getType()) ? vector : mlir::Value{});
8884 mlir::Value resultIrBox =
8885 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
8886
8887 fir::runtime::genUnpack(builder, loc, resultIrBox, vector, mask, field);
8888
8889 return readAndAddCleanUp(resultMutableBox, resultType, "UNPACK");
8890}
8891
8892// VERIFY
8893fir::ExtendedValue
8894IntrinsicLibrary::genVerify(mlir::Type resultType,
8895 llvm::ArrayRef<fir::ExtendedValue> args) {
8896
8897 assert(args.size() == 4);
8898
8899 if (isStaticallyAbsent(args[3])) {
8900 // Kind not specified, so call scan/verify runtime routine that is
8901 // specialized on the kind of characters in string.
8902
8903 // Handle required string base arg
8904 mlir::Value stringBase = fir::getBase(args[0]);
8905
8906 // Handle required set string base arg
8907 mlir::Value setBase = fir::getBase(args[1]);
8908
8909 // Handle kind argument; it is the kind of character in this case
8910 fir::KindTy kind =
8911 fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
8912 stringBase.getType());
8913
8914 // Get string length argument
8915 mlir::Value stringLen = fir::getLen(args[0]);
8916
8917 // Get set string length argument
8918 mlir::Value setLen = fir::getLen(args[1]);
8919
8920 // Handle optional back argument
8921 mlir::Value back =
8922 isStaticallyAbsent(args[2])
8923 ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
8924 : fir::getBase(args[2]);
8925
8926 return builder.createConvert(
8927 loc, resultType,
8928 fir::runtime::genVerify(builder, loc, kind, stringBase, stringLen,
8929 setBase, setLen, back));
8930 }
8931 // else use the runtime descriptor version of scan/verify
8932
8933 // Handle optional argument, back
8934 auto makeRefThenEmbox = [&](mlir::Value b) {
8935 fir::LogicalType logTy = fir::LogicalType::get(
8936 builder.getContext(), builder.getKindMap().defaultLogicalKind());
8937 mlir::Value temp = builder.createTemporary(loc, logTy);
8938 mlir::Value castb = builder.createConvert(loc, logTy, b);
8939 builder.create<fir::StoreOp>(loc, castb, temp);
8940 return builder.createBox(loc, temp);
8941 };
8942 mlir::Value back = fir::isUnboxedValue(args[2])
8943 ? makeRefThenEmbox(*args[2].getUnboxed())
8944 : builder.create<fir::AbsentOp>(
8945 loc, fir::BoxType::get(builder.getI1Type()));
8946
8947 // Handle required string argument
8948 mlir::Value string = builder.createBox(loc, args[0]);
8949
8950 // Handle required set argument
8951 mlir::Value set = builder.createBox(loc, args[1]);
8952
8953 // Handle kind argument
8954 mlir::Value kind = fir::getBase(args[3]);
8955
8956 // Create result descriptor
8957 fir::MutableBoxValue resultMutableBox =
8958 fir::factory::createTempMutableBox(builder, loc, resultType);
8959 mlir::Value resultIrBox =
8960 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
8961
8962 fir::runtime::genVerifyDescriptor(builder, loc, resultIrBox, string, set,
8963 back, kind);
8964
8965 // Handle cleanup of allocatable result descriptor and return
8966 return readAndAddCleanUp(resultMutableBox, resultType, "VERIFY");
8967}
8968
8969/// Process calls to Minloc, Maxloc intrinsic functions
8970template <typename FN, typename FD>
8971fir::ExtendedValue
8972IntrinsicLibrary::genExtremumloc(FN func, FD funcDim, llvm::StringRef errMsg,
8973 mlir::Type resultType,
8974 llvm::ArrayRef<fir::ExtendedValue> args) {
8975
8976 assert(args.size() == 5);
8977
8978 // Handle required array argument
8979 mlir::Value array = builder.createBox(loc, args[0]);
8980 unsigned rank = fir::BoxValue(array).rank();
8981 assert(rank >= 1);
8982
8983 // Handle optional mask argument
8984 auto mask = isStaticallyAbsent(args[2])
8985 ? builder.create<fir::AbsentOp>(
8986 loc, fir::BoxType::get(builder.getI1Type()))
8987 : builder.createBox(loc, args[2]);
8988
8989 // Handle optional kind argument
8990 auto kind = isStaticallyAbsent(args[3])
8991 ? builder.createIntegerConstant(
8992 loc, builder.getIndexType(),
8993 builder.getKindMap().defaultIntegerKind())
8994 : fir::getBase(args[3]);
8995
8996 // Handle optional back argument
8997 auto back = isStaticallyAbsent(args[4]) ? builder.createBool(loc, false)
8998 : fir::getBase(args[4]);
8999
9000 bool absentDim = isStaticallyAbsent(args[1]);
9001
9002 if (!absentDim && rank == 1) {
9003 // If dim argument is present and the array is rank 1, then the result is
9004 // a scalar (since the the result is rank-1 or 0).
9005 // Therefore, we use a scalar result descriptor with Min/MaxlocDim().
9006 mlir::Value dim = fir::getBase(args[1]);
9007 // Create mutable fir.box to be passed to the runtime for the result.
9008 fir::MutableBoxValue resultMutableBox =
9009 fir::factory::createTempMutableBox(builder, loc, resultType);
9010 mlir::Value resultIrBox =
9011 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
9012
9013 funcDim(builder, loc, resultIrBox, array, dim, mask, kind, back);
9014
9015 // Handle cleanup of allocatable result descriptor and return
9016 return readAndAddCleanUp(resultMutableBox, resultType, errMsg);
9017 }
9018
9019 // Note: The Min/Maxloc/val cases below have an array result.
9020
9021 // Create mutable fir.box to be passed to the runtime for the result.
9022 mlir::Type resultArrayType =
9023 builder.getVarLenSeqTy(resultType, absentDim ? 1 : rank - 1);
9024 fir::MutableBoxValue resultMutableBox =
9025 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
9026 mlir::Value resultIrBox =
9027 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
9028
9029 if (absentDim) {
9030 // Handle min/maxloc/val case where there is no dim argument
9031 // (calls Min/Maxloc()/MinMaxval() runtime routine)
9032 func(builder, loc, resultIrBox, array, mask, kind, back);
9033 } else {
9034 // else handle min/maxloc case with dim argument (calls
9035 // Min/Max/loc/val/Dim() runtime routine).
9036 mlir::Value dim = fir::getBase(args[1]);
9037 funcDim(builder, loc, resultIrBox, array, dim, mask, kind, back);
9038 }
9039 return readAndAddCleanUp(resultMutableBox, resultType, errMsg);
9040}
9041
9042// MAXLOC
9043fir::ExtendedValue
9044IntrinsicLibrary::genMaxloc(mlir::Type resultType,
9045 llvm::ArrayRef<fir::ExtendedValue> args) {
9046 return genExtremumloc(fir::runtime::genMaxloc, fir::runtime::genMaxlocDim,
9047 "MAXLOC", resultType, args);
9048}
9049
9050/// Process calls to Maxval and Minval
9051template <typename FN, typename FD, typename FC>
9052fir::ExtendedValue
9053IntrinsicLibrary::genExtremumVal(FN func, FD funcDim, FC funcChar,
9054 llvm::StringRef errMsg, mlir::Type resultType,
9055 llvm::ArrayRef<fir::ExtendedValue> args) {
9056
9057 assert(args.size() == 3);
9058
9059 // Handle required array argument
9060 fir::BoxValue arryTmp = builder.createBox(loc, args[0]);
9061 mlir::Value array = fir::getBase(arryTmp);
9062 int rank = arryTmp.rank();
9063 assert(rank >= 1);
9064 bool hasCharacterResult = arryTmp.isCharacter();
9065
9066 // Handle optional mask argument
9067 auto mask = isStaticallyAbsent(args[2])
9068 ? builder.create<fir::AbsentOp>(
9069 loc, fir::BoxType::get(builder.getI1Type()))
9070 : builder.createBox(loc, args[2]);
9071
9072 bool absentDim = isStaticallyAbsent(args[1]);
9073
9074 // For Maxval/MinVal, we call the type specific versions of
9075 // Maxval/Minval because the result is scalar in the case below.
9076 if (!hasCharacterResult && (absentDim || rank == 1))
9077 return func(builder, loc, array, mask);
9078
9079 if (hasCharacterResult && (absentDim || rank == 1)) {
9080 // Create mutable fir.box to be passed to the runtime for the result.
9081 fir::MutableBoxValue resultMutableBox =
9082 fir::factory::createTempMutableBox(builder, loc, resultType);
9083 mlir::Value resultIrBox =
9084 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
9085
9086 funcChar(builder, loc, resultIrBox, array, mask);
9087
9088 // Handle cleanup of allocatable result descriptor and return
9089 return readAndAddCleanUp(resultMutableBox, resultType, errMsg);
9090 }
9091
9092 // Handle Min/Maxval cases that have an array result.
9093 auto resultMutableBox =
9094 genFuncDim(funcDim, resultType, builder, loc, array, args[1], mask, rank);
9095 return readAndAddCleanUp(resultMutableBox, resultType, errMsg);
9096}
9097
9098// MAXVAL
9099fir::ExtendedValue
9100IntrinsicLibrary::genMaxval(mlir::Type resultType,
9101 llvm::ArrayRef<fir::ExtendedValue> args) {
9102 return genExtremumVal(fir::runtime::genMaxval, fir::runtime::genMaxvalDim,
9103 fir::runtime::genMaxvalChar, "MAXVAL", resultType,
9104 args);
9105}
9106
9107// MINLOC
9108fir::ExtendedValue
9109IntrinsicLibrary::genMinloc(mlir::Type resultType,
9110 llvm::ArrayRef<fir::ExtendedValue> args) {
9111 return genExtremumloc(fir::runtime::genMinloc, fir::runtime::genMinlocDim,
9112 "MINLOC", resultType, args);
9113}
9114
9115// MINVAL
9116fir::ExtendedValue
9117IntrinsicLibrary::genMinval(mlir::Type resultType,
9118 llvm::ArrayRef<fir::ExtendedValue> args) {
9119 return genExtremumVal(fir::runtime::genMinval, fir::runtime::genMinvalDim,
9120 fir::runtime::genMinvalChar, "MINVAL", resultType,
9121 args);
9122}
9123
9124// MIN and MAX
9125template <Extremum extremum, ExtremumBehavior behavior>
9126mlir::Value IntrinsicLibrary::genExtremum(mlir::Type,
9127 llvm::ArrayRef<mlir::Value> args) {
9128 assert(args.size() >= 1);
9129 mlir::Value result = args[0];
9130 for (auto arg : args.drop_front()) {
9131 mlir::Value mask =
9132 createExtremumCompare<extremum, behavior>(loc, builder, result, arg);
9133 result = builder.create<mlir::arith::SelectOp>(loc, mask, result, arg);
9134 }
9135 return result;
9136}
9137
9138//===----------------------------------------------------------------------===//
9139// Argument lowering rules interface for intrinsic or intrinsic module
9140// procedure.
9141//===----------------------------------------------------------------------===//
9142
9143const IntrinsicArgumentLoweringRules *
9144getIntrinsicArgumentLowering(llvm::StringRef specificName) {
9145 llvm::StringRef name = genericName(specificName);
9146 if (const IntrinsicHandler *handler = findIntrinsicHandler(name))
9147 if (!handler->argLoweringRules.hasDefaultRules())
9148 return &handler->argLoweringRules;
9149 if (const IntrinsicHandler *ppcHandler = findPPCIntrinsicHandler(name))
9150 if (!ppcHandler->argLoweringRules.hasDefaultRules())
9151 return &ppcHandler->argLoweringRules;
9152 return nullptr;
9153}
9154
9155const IntrinsicArgumentLoweringRules *
9156IntrinsicHandlerEntry::getArgumentLoweringRules() const {
9157 if (const IntrinsicHandler *const *handler =
9158 std::get_if<const IntrinsicHandler *>(&entry)) {
9159 assert(*handler);
9160 if (!(*handler)->argLoweringRules.hasDefaultRules())
9161 return &(*handler)->argLoweringRules;
9162 }
9163 return nullptr;
9164}
9165
9166/// Return how argument \p argName should be lowered given the rules for the
9167/// intrinsic function.
9168fir::ArgLoweringRule
9169lowerIntrinsicArgumentAs(const IntrinsicArgumentLoweringRules &rules,
9170 unsigned position) {
9171 assert(position < sizeof(rules.args) / (sizeof(decltype(*rules.args))) &&
9172 "invalid argument");
9173 return {rules.args[position].lowerAs,
9174 rules.args[position].handleDynamicOptional};
9175}
9176
9177//===----------------------------------------------------------------------===//
9178// Public intrinsic call helpers
9179//===----------------------------------------------------------------------===//
9180
9181std::pair<fir::ExtendedValue, bool>
9182genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc,
9183 llvm::StringRef name, std::optional<mlir::Type> resultType,
9184 llvm::ArrayRef<fir::ExtendedValue> args,
9185 Fortran::lower::AbstractConverter *converter) {
9186 return IntrinsicLibrary{builder, loc, converter}.genIntrinsicCall(
9187 name, resultType, args);
9188}
9189
9190mlir::Value genMax(fir::FirOpBuilder &builder, mlir::Location loc,
9191 llvm::ArrayRef<mlir::Value> args) {
9192 assert(args.size() > 0 && "max requires at least one argument");
9193 return IntrinsicLibrary{builder, loc}
9194 .genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>(args[0].getType(),
9195 args);
9196}
9197
9198mlir::Value genMin(fir::FirOpBuilder &builder, mlir::Location loc,
9199 llvm::ArrayRef<mlir::Value> args) {
9200 assert(args.size() > 0 && "min requires at least one argument");
9201 return IntrinsicLibrary{builder, loc}
9202 .genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>(args[0].getType(),
9203 args);
9204}
9205
9206mlir::Value genDivC(fir::FirOpBuilder &builder, mlir::Location loc,
9207 mlir::Type type, mlir::Value x, mlir::Value y) {
9208 return IntrinsicLibrary{builder, loc}.genRuntimeCall("divc", type, {x, y});
9209}
9210
9211mlir::Value genPow(fir::FirOpBuilder &builder, mlir::Location loc,
9212 mlir::Type type, mlir::Value x, mlir::Value y) {
9213 // TODO: since there is no libm version of pow with integer exponent,
9214 // we have to provide an alternative implementation for
9215 // "precise/strict" FP mode.
9216 // One option is to generate internal function with inlined
9217 // implementation and mark it 'strictfp'.
9218 // Another option is to implement it in Fortran runtime library
9219 // (just like matmul).
9220 return IntrinsicLibrary{builder, loc}.genRuntimeCall("pow", type, {x, y});
9221}
9222
9223mlir::SymbolRefAttr
9224getUnrestrictedIntrinsicSymbolRefAttr(fir::FirOpBuilder &builder,
9225 mlir::Location loc, llvm::StringRef name,
9226 mlir::FunctionType signature) {
9227 return IntrinsicLibrary{builder, loc}.getUnrestrictedIntrinsicSymbolRefAttr(
9228 name, signature);
9229}
9230} // namespace fir
9231

source code of flang/lib/Optimizer/Builder/IntrinsicCall.cpp