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/Character.h"
20#include "flang/Optimizer/Builder/Complex.h"
21#include "flang/Optimizer/Builder/FIRBuilder.h"
22#include "flang/Optimizer/Builder/MutableBox.h"
23#include "flang/Optimizer/Builder/PPCIntrinsicCall.h"
24#include "flang/Optimizer/Builder/Runtime/Allocatable.h"
25#include "flang/Optimizer/Builder/Runtime/Character.h"
26#include "flang/Optimizer/Builder/Runtime/Command.h"
27#include "flang/Optimizer/Builder/Runtime/Derived.h"
28#include "flang/Optimizer/Builder/Runtime/Exceptions.h"
29#include "flang/Optimizer/Builder/Runtime/Execute.h"
30#include "flang/Optimizer/Builder/Runtime/Inquiry.h"
31#include "flang/Optimizer/Builder/Runtime/Intrinsics.h"
32#include "flang/Optimizer/Builder/Runtime/Numeric.h"
33#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
34#include "flang/Optimizer/Builder/Runtime/Reduction.h"
35#include "flang/Optimizer/Builder/Runtime/Stop.h"
36#include "flang/Optimizer/Builder/Runtime/Transformational.h"
37#include "flang/Optimizer/Builder/Todo.h"
38#include "flang/Optimizer/Dialect/FIROpsSupport.h"
39#include "flang/Optimizer/Dialect/Support/FIRContext.h"
40#include "flang/Optimizer/Support/FatalError.h"
41#include "flang/Optimizer/Support/Utils.h"
42#include "flang/Runtime/entry-names.h"
43#include "flang/Runtime/iostat.h"
44#include "mlir/Dialect/Complex/IR/Complex.h"
45#include "mlir/Dialect/LLVMIR/LLVMDialect.h"
46#include "mlir/Dialect/Math/IR/Math.h"
47#include "mlir/Dialect/Vector/IR/VectorOps.h"
48#include "llvm/Support/CommandLine.h"
49#include "llvm/Support/Debug.h"
50#include "llvm/Support/MathExtras.h"
51#include "llvm/Support/raw_ostream.h"
52#include <optional>
53
54#define DEBUG_TYPE "flang-lower-intrinsic"
55
56/// This file implements lowering of Fortran intrinsic procedures and Fortran
57/// intrinsic module procedures. A call may be inlined with a mix of FIR and
58/// MLIR operations, or as a call to a runtime function or LLVM intrinsic.
59
60/// Lowering of intrinsic procedure calls is based on a map that associates
61/// Fortran intrinsic generic names to FIR generator functions.
62/// All generator functions are member functions of the IntrinsicLibrary class
63/// and have the same interface.
64/// If no generator is given for an intrinsic name, a math runtime library
65/// is searched for an implementation and, if a runtime function is found,
66/// a call is generated for it. LLVM intrinsics are handled as a math
67/// runtime library here.
68
69namespace fir {
70
71fir::ExtendedValue getAbsentIntrinsicArgument() { return fir::UnboxedValue{}; }
72
73/// Test if an ExtendedValue is absent. This is used to test if an intrinsic
74/// argument are absent at compile time.
75static bool isStaticallyAbsent(const fir::ExtendedValue &exv) {
76 return !fir::getBase(exv);
77}
78static bool isStaticallyAbsent(llvm::ArrayRef<fir::ExtendedValue> args,
79 size_t argIndex) {
80 return args.size() <= argIndex || isStaticallyAbsent(args[argIndex]);
81}
82static bool isStaticallyAbsent(llvm::ArrayRef<mlir::Value> args,
83 size_t argIndex) {
84 return args.size() <= argIndex || !args[argIndex];
85}
86
87/// Test if an ExtendedValue is present. This is used to test if an intrinsic
88/// argument is present at compile time. This does not imply that the related
89/// value may not be an absent dummy optional, disassociated pointer, or a
90/// deallocated allocatable. See `handleDynamicOptional` to deal with these
91/// cases when it makes sense.
92static bool isStaticallyPresent(const fir::ExtendedValue &exv) {
93 return !isStaticallyAbsent(exv);
94}
95
96using I = IntrinsicLibrary;
97
98/// Flag to indicate that an intrinsic argument has to be handled as
99/// being dynamically optional (e.g. special handling when actual
100/// argument is an optional variable in the current scope).
101static constexpr bool handleDynamicOptional = true;
102
103/// Table that drives the fir generation depending on the intrinsic or intrinsic
104/// module procedure one to one mapping with Fortran arguments. If no mapping is
105/// defined here for a generic intrinsic, genRuntimeCall will be called
106/// to look for a match in the runtime a emit a call. Note that the argument
107/// lowering rules for an intrinsic need to be provided only if at least one
108/// argument must not be lowered by value. In which case, the lowering rules
109/// should be provided for all the intrinsic arguments for completeness.
110static constexpr IntrinsicHandler handlers[]{
111 {"abort", &I::genAbort},
112 {"abs", &I::genAbs},
113 {"achar", &I::genChar},
114 {"acosd", &I::genAcosd},
115 {"adjustl",
116 &I::genAdjustRtCall<fir::runtime::genAdjustL>,
117 {{{"string", asAddr}}},
118 /*isElemental=*/true},
119 {"adjustr",
120 &I::genAdjustRtCall<fir::runtime::genAdjustR>,
121 {{{"string", asAddr}}},
122 /*isElemental=*/true},
123 {"aimag", &I::genAimag},
124 {"aint", &I::genAint},
125 {"all",
126 &I::genAll,
127 {{{"mask", asAddr}, {"dim", asValue}}},
128 /*isElemental=*/false},
129 {"allocated",
130 &I::genAllocated,
131 {{{"array", asInquired}, {"scalar", asInquired}}},
132 /*isElemental=*/false},
133 {"anint", &I::genAnint},
134 {"any",
135 &I::genAny,
136 {{{"mask", asAddr}, {"dim", asValue}}},
137 /*isElemental=*/false},
138 {"asind", &I::genAsind},
139 {"associated",
140 &I::genAssociated,
141 {{{"pointer", asInquired}, {"target", asInquired}}},
142 /*isElemental=*/false},
143 {"atan2d", &I::genAtand},
144 {"atan2pi", &I::genAtanpi},
145 {"atand", &I::genAtand},
146 {"atanpi", &I::genAtanpi},
147 {"bessel_jn",
148 &I::genBesselJn,
149 {{{"n1", asValue}, {"n2", asValue}, {"x", asValue}}},
150 /*isElemental=*/false},
151 {"bessel_yn",
152 &I::genBesselYn,
153 {{{"n1", asValue}, {"n2", asValue}, {"x", asValue}}},
154 /*isElemental=*/false},
155 {"bge", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::uge>},
156 {"bgt", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ugt>},
157 {"ble", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ule>},
158 {"blt", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ult>},
159 {"btest", &I::genBtest},
160 {"c_associated_c_funptr",
161 &I::genCAssociatedCFunPtr,
162 {{{"c_ptr_1", asAddr}, {"c_ptr_2", asAddr, handleDynamicOptional}}},
163 /*isElemental=*/false},
164 {"c_associated_c_ptr",
165 &I::genCAssociatedCPtr,
166 {{{"c_ptr_1", asAddr}, {"c_ptr_2", asAddr, handleDynamicOptional}}},
167 /*isElemental=*/false},
168 {"c_f_pointer",
169 &I::genCFPointer,
170 {{{"cptr", asValue},
171 {"fptr", asInquired},
172 {"shape", asAddr, handleDynamicOptional}}},
173 /*isElemental=*/false},
174 {"c_f_procpointer",
175 &I::genCFProcPointer,
176 {{{"cptr", asValue}, {"fptr", asInquired}}},
177 /*isElemental=*/false},
178 {"c_funloc", &I::genCFunLoc, {{{"x", asBox}}}, /*isElemental=*/false},
179 {"c_loc", &I::genCLoc, {{{"x", asBox}}}, /*isElemental=*/false},
180 {"c_ptr_eq", &I::genCPtrCompare<mlir::arith::CmpIPredicate::eq>},
181 {"c_ptr_ne", &I::genCPtrCompare<mlir::arith::CmpIPredicate::ne>},
182 {"ceiling", &I::genCeiling},
183 {"char", &I::genChar},
184 {"cmplx",
185 &I::genCmplx,
186 {{{"x", asValue}, {"y", asValue, handleDynamicOptional}}}},
187 {"command_argument_count", &I::genCommandArgumentCount},
188 {"conjg", &I::genConjg},
189 {"cosd", &I::genCosd},
190 {"count",
191 &I::genCount,
192 {{{"mask", asAddr}, {"dim", asValue}, {"kind", asValue}}},
193 /*isElemental=*/false},
194 {"cpu_time",
195 &I::genCpuTime,
196 {{{"time", asAddr}}},
197 /*isElemental=*/false},
198 {"cshift",
199 &I::genCshift,
200 {{{"array", asAddr}, {"shift", asAddr}, {"dim", asValue}}},
201 /*isElemental=*/false},
202 {"date_and_time",
203 &I::genDateAndTime,
204 {{{"date", asAddr, handleDynamicOptional},
205 {"time", asAddr, handleDynamicOptional},
206 {"zone", asAddr, handleDynamicOptional},
207 {"values", asBox, handleDynamicOptional}}},
208 /*isElemental=*/false},
209 {"dble", &I::genConversion},
210 {"dim", &I::genDim},
211 {"dot_product",
212 &I::genDotProduct,
213 {{{"vector_a", asBox}, {"vector_b", asBox}}},
214 /*isElemental=*/false},
215 {"dprod", &I::genDprod},
216 {"dshiftl", &I::genDshiftl},
217 {"dshiftr", &I::genDshiftr},
218 {"eoshift",
219 &I::genEoshift,
220 {{{"array", asBox},
221 {"shift", asAddr},
222 {"boundary", asBox, handleDynamicOptional},
223 {"dim", asValue}}},
224 /*isElemental=*/false},
225 {"execute_command_line",
226 &I::genExecuteCommandLine,
227 {{{"command", asBox},
228 {"wait", asAddr, handleDynamicOptional},
229 {"exitstat", asBox, handleDynamicOptional},
230 {"cmdstat", asBox, handleDynamicOptional},
231 {"cmdmsg", asBox, handleDynamicOptional}}},
232 /*isElemental=*/false},
233 {"exit",
234 &I::genExit,
235 {{{"status", asValue, handleDynamicOptional}}},
236 /*isElemental=*/false},
237 {"exponent", &I::genExponent},
238 {"extends_type_of",
239 &I::genExtendsTypeOf,
240 {{{"a", asBox}, {"mold", asBox}}},
241 /*isElemental=*/false},
242 {"findloc",
243 &I::genFindloc,
244 {{{"array", asBox},
245 {"value", asAddr},
246 {"dim", asValue},
247 {"mask", asBox, handleDynamicOptional},
248 {"kind", asValue},
249 {"back", asValue, handleDynamicOptional}}},
250 /*isElemental=*/false},
251 {"floor", &I::genFloor},
252 {"fraction", &I::genFraction},
253 {"get_command",
254 &I::genGetCommand,
255 {{{"command", asBox, handleDynamicOptional},
256 {"length", asBox, handleDynamicOptional},
257 {"status", asAddr, handleDynamicOptional},
258 {"errmsg", asBox, handleDynamicOptional}}},
259 /*isElemental=*/false},
260 {"get_command_argument",
261 &I::genGetCommandArgument,
262 {{{"number", asValue},
263 {"value", asBox, handleDynamicOptional},
264 {"length", asBox, handleDynamicOptional},
265 {"status", asAddr, handleDynamicOptional},
266 {"errmsg", asBox, handleDynamicOptional}}},
267 /*isElemental=*/false},
268 {"get_environment_variable",
269 &I::genGetEnvironmentVariable,
270 {{{"name", asBox},
271 {"value", asBox, handleDynamicOptional},
272 {"length", asBox, handleDynamicOptional},
273 {"status", asAddr, handleDynamicOptional},
274 {"trim_name", asAddr, handleDynamicOptional},
275 {"errmsg", asBox, handleDynamicOptional}}},
276 /*isElemental=*/false},
277 {"getpid", &I::genGetPID},
278 {"iachar", &I::genIchar},
279 {"iall",
280 &I::genIall,
281 {{{"array", asBox},
282 {"dim", asValue},
283 {"mask", asBox, handleDynamicOptional}}},
284 /*isElemental=*/false},
285 {"iand", &I::genIand},
286 {"iany",
287 &I::genIany,
288 {{{"array", asBox},
289 {"dim", asValue},
290 {"mask", asBox, handleDynamicOptional}}},
291 /*isElemental=*/false},
292 {"ibclr", &I::genIbclr},
293 {"ibits", &I::genIbits},
294 {"ibset", &I::genIbset},
295 {"ichar", &I::genIchar},
296 {"ieee_class", &I::genIeeeClass},
297 {"ieee_class_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},
298 {"ieee_class_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},
299 {"ieee_copy_sign", &I::genIeeeCopySign},
300 {"ieee_get_flag",
301 &I::genIeeeGetFlag,
302 {{{"flag", asValue}, {"flag_value", asAddr}}}},
303 {"ieee_get_halting_mode",
304 &I::genIeeeGetHaltingMode,
305 {{{"flag", asValue}, {"halting", asAddr}}}},
306 {"ieee_get_modes", &I::genIeeeGetOrSetModes</*isGet=*/true>},
307 {"ieee_get_rounding_mode",
308 &I::genIeeeGetRoundingMode,
309 {{{"round_value", asAddr, handleDynamicOptional},
310 {"radix", asValue, handleDynamicOptional}}},
311 /*isElemental=*/false},
312 {"ieee_get_status", &I::genIeeeGetOrSetStatus</*isGet=*/true>},
313 {"ieee_is_finite", &I::genIeeeIsFinite},
314 {"ieee_is_nan", &I::genIeeeIsNan},
315 {"ieee_is_negative", &I::genIeeeIsNegative},
316 {"ieee_is_normal", &I::genIeeeIsNormal},
317 {"ieee_logb", &I::genIeeeLogb},
318 {"ieee_max",
319 &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/false, /*isMag=*/false>},
320 {"ieee_max_mag",
321 &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/false, /*isMag=*/true>},
322 {"ieee_max_num",
323 &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/true, /*isMag=*/false>},
324 {"ieee_max_num_mag",
325 &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/true, /*isMag=*/true>},
326 {"ieee_min",
327 &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/false, /*isMag=*/false>},
328 {"ieee_min_mag",
329 &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/false, /*isMag=*/true>},
330 {"ieee_min_num",
331 &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/true, /*isMag=*/false>},
332 {"ieee_min_num_mag",
333 &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/true, /*isMag=*/true>},
334 {"ieee_quiet_eq", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OEQ>},
335 {"ieee_quiet_ge", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OGE>},
336 {"ieee_quiet_gt", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OGT>},
337 {"ieee_quiet_le", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OLE>},
338 {"ieee_quiet_lt", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OLT>},
339 {"ieee_quiet_ne", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::UNE>},
340 {"ieee_round_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},
341 {"ieee_round_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},
342 {"ieee_set_flag", &I::genIeeeSetFlagOrHaltingMode</*isFlag=*/true>},
343 {"ieee_set_halting_mode",
344 &I::genIeeeSetFlagOrHaltingMode</*isFlag=*/false>},
345 {"ieee_set_modes", &I::genIeeeGetOrSetModes</*isGet=*/false>},
346 {"ieee_set_rounding_mode",
347 &I::genIeeeSetRoundingMode,
348 {{{"round_value", asValue, handleDynamicOptional},
349 {"radix", asValue, handleDynamicOptional}}},
350 /*isElemental=*/false},
351 {"ieee_set_status", &I::genIeeeGetOrSetStatus</*isGet=*/false>},
352 {"ieee_signaling_eq",
353 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OEQ>},
354 {"ieee_signaling_ge",
355 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OGE>},
356 {"ieee_signaling_gt",
357 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OGT>},
358 {"ieee_signaling_le",
359 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OLE>},
360 {"ieee_signaling_lt",
361 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OLT>},
362 {"ieee_signaling_ne",
363 &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::UNE>},
364 {"ieee_signbit", &I::genIeeeSignbit},
365 {"ieee_support_flag", &I::genIeeeSupportFlagOrHalting},
366 {"ieee_support_halting", &I::genIeeeSupportFlagOrHalting},
367 {"ieee_support_rounding", &I::genIeeeSupportRounding},
368 {"ieee_unordered", &I::genIeeeUnordered},
369 {"ieee_value", &I::genIeeeValue},
370 {"ieor", &I::genIeor},
371 {"index",
372 &I::genIndex,
373 {{{"string", asAddr},
374 {"substring", asAddr},
375 {"back", asValue, handleDynamicOptional},
376 {"kind", asValue}}}},
377 {"ior", &I::genIor},
378 {"iparity",
379 &I::genIparity,
380 {{{"array", asBox},
381 {"dim", asValue},
382 {"mask", asBox, handleDynamicOptional}}},
383 /*isElemental=*/false},
384 {"is_contiguous",
385 &I::genIsContiguous,
386 {{{"array", asBox}}},
387 /*isElemental=*/false},
388 {"is_iostat_end", &I::genIsIostatValue<Fortran::runtime::io::IostatEnd>},
389 {"is_iostat_eor", &I::genIsIostatValue<Fortran::runtime::io::IostatEor>},
390 {"ishft", &I::genIshft},
391 {"ishftc", &I::genIshftc},
392 {"isnan", &I::genIeeeIsNan},
393 {"lbound",
394 &I::genLbound,
395 {{{"array", asInquired}, {"dim", asValue}, {"kind", asValue}}},
396 /*isElemental=*/false},
397 {"leadz", &I::genLeadz},
398 {"len",
399 &I::genLen,
400 {{{"string", asInquired}, {"kind", asValue}}},
401 /*isElemental=*/false},
402 {"len_trim", &I::genLenTrim},
403 {"lge", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sge>},
404 {"lgt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sgt>},
405 {"lle", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sle>},
406 {"llt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::slt>},
407 {"loc", &I::genLoc, {{{"x", asBox}}}, /*isElemental=*/false},
408 {"maskl", &I::genMask<mlir::arith::ShLIOp>},
409 {"maskr", &I::genMask<mlir::arith::ShRUIOp>},
410 {"matmul",
411 &I::genMatmul,
412 {{{"matrix_a", asAddr}, {"matrix_b", asAddr}}},
413 /*isElemental=*/false},
414 {"matmul_transpose",
415 &I::genMatmulTranspose,
416 {{{"matrix_a", asAddr}, {"matrix_b", asAddr}}},
417 /*isElemental=*/false},
418 {"max", &I::genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>},
419 {"maxloc",
420 &I::genMaxloc,
421 {{{"array", asBox},
422 {"dim", asValue},
423 {"mask", asBox, handleDynamicOptional},
424 {"kind", asValue},
425 {"back", asValue, handleDynamicOptional}}},
426 /*isElemental=*/false},
427 {"maxval",
428 &I::genMaxval,
429 {{{"array", asBox},
430 {"dim", asValue},
431 {"mask", asBox, handleDynamicOptional}}},
432 /*isElemental=*/false},
433 {"merge", &I::genMerge},
434 {"merge_bits", &I::genMergeBits},
435 {"min", &I::genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>},
436 {"minloc",
437 &I::genMinloc,
438 {{{"array", asBox},
439 {"dim", asValue},
440 {"mask", asBox, handleDynamicOptional},
441 {"kind", asValue},
442 {"back", asValue, handleDynamicOptional}}},
443 /*isElemental=*/false},
444 {"minval",
445 &I::genMinval,
446 {{{"array", asBox},
447 {"dim", asValue},
448 {"mask", asBox, handleDynamicOptional}}},
449 /*isElemental=*/false},
450 {"mod", &I::genMod},
451 {"modulo", &I::genModulo},
452 {"move_alloc",
453 &I::genMoveAlloc,
454 {{{"from", asInquired},
455 {"to", asInquired},
456 {"status", asAddr, handleDynamicOptional},
457 {"errMsg", asBox, handleDynamicOptional}}},
458 /*isElemental=*/false},
459 {"mvbits",
460 &I::genMvbits,
461 {{{"from", asValue},
462 {"frompos", asValue},
463 {"len", asValue},
464 {"to", asAddr},
465 {"topos", asValue}}}},
466 {"nearest", &I::genNearest},
467 {"nint", &I::genNint},
468 {"norm2",
469 &I::genNorm2,
470 {{{"array", asBox}, {"dim", asValue}}},
471 /*isElemental=*/false},
472 {"not", &I::genNot},
473 {"null", &I::genNull, {{{"mold", asInquired}}}, /*isElemental=*/false},
474 {"pack",
475 &I::genPack,
476 {{{"array", asBox},
477 {"mask", asBox},
478 {"vector", asBox, handleDynamicOptional}}},
479 /*isElemental=*/false},
480 {"parity",
481 &I::genParity,
482 {{{"mask", asBox}, {"dim", asValue}}},
483 /*isElemental=*/false},
484 {"popcnt", &I::genPopcnt},
485 {"poppar", &I::genPoppar},
486 {"present",
487 &I::genPresent,
488 {{{"a", asInquired}}},
489 /*isElemental=*/false},
490 {"product",
491 &I::genProduct,
492 {{{"array", asBox},
493 {"dim", asValue},
494 {"mask", asBox, handleDynamicOptional}}},
495 /*isElemental=*/false},
496 {"random_init",
497 &I::genRandomInit,
498 {{{"repeatable", asValue}, {"image_distinct", asValue}}},
499 /*isElemental=*/false},
500 {"random_number",
501 &I::genRandomNumber,
502 {{{"harvest", asBox}}},
503 /*isElemental=*/false},
504 {"random_seed",
505 &I::genRandomSeed,
506 {{{"size", asBox, handleDynamicOptional},
507 {"put", asBox, handleDynamicOptional},
508 {"get", asBox, handleDynamicOptional}}},
509 /*isElemental=*/false},
510 {"reduce",
511 &I::genReduce,
512 {{{"array", asBox},
513 {"operation", asAddr},
514 {"dim", asValue},
515 {"mask", asBox, handleDynamicOptional},
516 {"identity", asValue},
517 {"ordered", asValue}}},
518 /*isElemental=*/false},
519 {"repeat",
520 &I::genRepeat,
521 {{{"string", asAddr}, {"ncopies", asValue}}},
522 /*isElemental=*/false},
523 {"reshape",
524 &I::genReshape,
525 {{{"source", asBox},
526 {"shape", asBox},
527 {"pad", asBox, handleDynamicOptional},
528 {"order", asBox, handleDynamicOptional}}},
529 /*isElemental=*/false},
530 {"rrspacing", &I::genRRSpacing},
531 {"same_type_as",
532 &I::genSameTypeAs,
533 {{{"a", asBox}, {"b", asBox}}},
534 /*isElemental=*/false},
535 {"scale",
536 &I::genScale,
537 {{{"x", asValue}, {"i", asValue}}},
538 /*isElemental=*/true},
539 {"scan",
540 &I::genScan,
541 {{{"string", asAddr},
542 {"set", asAddr},
543 {"back", asValue, handleDynamicOptional},
544 {"kind", asValue}}},
545 /*isElemental=*/true},
546 {"selected_int_kind",
547 &I::genSelectedIntKind,
548 {{{"scalar", asAddr}}},
549 /*isElemental=*/false},
550 {"selected_real_kind",
551 &I::genSelectedRealKind,
552 {{{"precision", asAddr, handleDynamicOptional},
553 {"range", asAddr, handleDynamicOptional},
554 {"radix", asAddr, handleDynamicOptional}}},
555 /*isElemental=*/false},
556 {"set_exponent", &I::genSetExponent},
557 {"shape",
558 &I::genShape,
559 {{{"source", asBox}, {"kind", asValue}}},
560 /*isElemental=*/false},
561 {"shifta", &I::genShiftA},
562 {"shiftl", &I::genShift<mlir::arith::ShLIOp>},
563 {"shiftr", &I::genShift<mlir::arith::ShRUIOp>},
564 {"sign", &I::genSign},
565 {"signal",
566 &I::genSignalSubroutine,
567 {{{"number", asValue}, {"handler", asAddr}, {"status", asAddr}}},
568 /*isElemental=*/false},
569 {"sind", &I::genSind},
570 {"size",
571 &I::genSize,
572 {{{"array", asBox},
573 {"dim", asAddr, handleDynamicOptional},
574 {"kind", asValue}}},
575 /*isElemental=*/false},
576 {"sizeof",
577 &I::genSizeOf,
578 {{{"a", asBox}}},
579 /*isElemental=*/false},
580 {"sleep", &I::genSleep, {{{"seconds", asValue}}}, /*isElemental=*/false},
581 {"spacing", &I::genSpacing},
582 {"spread",
583 &I::genSpread,
584 {{{"source", asBox}, {"dim", asValue}, {"ncopies", asValue}}},
585 /*isElemental=*/false},
586 {"storage_size",
587 &I::genStorageSize,
588 {{{"a", asInquired}, {"kind", asValue}}},
589 /*isElemental=*/false},
590 {"sum",
591 &I::genSum,
592 {{{"array", asBox},
593 {"dim", asValue},
594 {"mask", asBox, handleDynamicOptional}}},
595 /*isElemental=*/false},
596 {"system",
597 &I::genSystem,
598 {{{"command", asBox}, {"exitstat", asBox, handleDynamicOptional}}},
599 /*isElemental=*/false},
600 {"system_clock",
601 &I::genSystemClock,
602 {{{"count", asAddr}, {"count_rate", asAddr}, {"count_max", asAddr}}},
603 /*isElemental=*/false},
604 {"tand", &I::genTand},
605 {"trailz", &I::genTrailz},
606 {"transfer",
607 &I::genTransfer,
608 {{{"source", asAddr}, {"mold", asAddr}, {"size", asValue}}},
609 /*isElemental=*/false},
610 {"transpose",
611 &I::genTranspose,
612 {{{"matrix", asAddr}}},
613 /*isElemental=*/false},
614 {"trim", &I::genTrim, {{{"string", asAddr}}}, /*isElemental=*/false},
615 {"ubound",
616 &I::genUbound,
617 {{{"array", asBox}, {"dim", asValue}, {"kind", asValue}}},
618 /*isElemental=*/false},
619 {"unpack",
620 &I::genUnpack,
621 {{{"vector", asBox}, {"mask", asBox}, {"field", asBox}}},
622 /*isElemental=*/false},
623 {"verify",
624 &I::genVerify,
625 {{{"string", asAddr},
626 {"set", asAddr},
627 {"back", asValue, handleDynamicOptional},
628 {"kind", asValue}}},
629 /*isElemental=*/true},
630};
631
632static const IntrinsicHandler *findIntrinsicHandler(llvm::StringRef name) {
633 auto compare = [](const IntrinsicHandler &handler, llvm::StringRef name) {
634 return name.compare(handler.name) > 0;
635 };
636 auto result = llvm::lower_bound(handlers, name, compare);
637 return result != std::end(handlers) && result->name == name ? result
638 : nullptr;
639}
640
641/// To make fir output more readable for debug, one can outline all intrinsic
642/// implementation in wrappers (overrides the IntrinsicHandler::outline flag).
643static llvm::cl::opt<bool> outlineAllIntrinsics(
644 "outline-intrinsics",
645 llvm::cl::desc(
646 "Lower all intrinsic procedure implementation in their own functions"),
647 llvm::cl::init(Val: false));
648
649//===----------------------------------------------------------------------===//
650// Math runtime description and matching utility
651//===----------------------------------------------------------------------===//
652
653/// Command line option to modify math runtime behavior used to implement
654/// intrinsics. This option applies both to early and late math-lowering modes.
655enum MathRuntimeVersion { fastVersion, relaxedVersion, preciseVersion };
656llvm::cl::opt<MathRuntimeVersion> mathRuntimeVersion(
657 "math-runtime", llvm::cl::desc("Select math operations' runtime behavior:"),
658 llvm::cl::values(
659 clEnumValN(fastVersion, "fast", "use fast runtime behavior"),
660 clEnumValN(relaxedVersion, "relaxed", "use relaxed runtime behavior"),
661 clEnumValN(preciseVersion, "precise", "use precise runtime behavior")),
662 llvm::cl::init(Val: fastVersion));
663
664static llvm::cl::opt<bool>
665 forceMlirComplex("force-mlir-complex",
666 llvm::cl::desc("Force using MLIR complex operations "
667 "instead of libm complex operations"),
668 llvm::cl::init(Val: false));
669
670/// Return a string containing the given Fortran intrinsic name
671/// with the type of its arguments specified in funcType
672/// surrounded by the given prefix/suffix.
673static std::string
674prettyPrintIntrinsicName(fir::FirOpBuilder &builder, mlir::Location loc,
675 llvm::StringRef prefix, llvm::StringRef name,
676 llvm::StringRef suffix, mlir::FunctionType funcType) {
677 std::string output = prefix.str();
678 llvm::raw_string_ostream sstream(output);
679 if (name == "pow") {
680 assert(funcType.getNumInputs() == 2 && "power operator has two arguments");
681 std::string displayName{" ** "};
682 sstream << numericMlirTypeToFortran(builder, funcType.getInput(0), loc,
683 displayName)
684 << displayName
685 << numericMlirTypeToFortran(builder, funcType.getInput(1), loc,
686 displayName);
687 } else {
688 sstream << name.upper() << "(";
689 if (funcType.getNumInputs() > 0)
690 sstream << numericMlirTypeToFortran(builder, funcType.getInput(0), loc,
691 name);
692 for (mlir::Type argType : funcType.getInputs().drop_front()) {
693 sstream << ", " << numericMlirTypeToFortran(builder, argType, loc, name);
694 }
695 sstream << ")";
696 }
697 sstream << suffix;
698 return output;
699}
700
701// Generate a call to the Fortran runtime library providing
702// support for 128-bit float math.
703// On 'LDBL_MANT_DIG == 113' targets the implementation
704// is provided by FortranRuntime, otherwise, it is done via
705// FortranFloat128Math library. In the latter case the compiler
706// has to be built with FLANG_RUNTIME_F128_MATH_LIB to guarantee
707// proper linking actions in the driver.
708static mlir::Value genLibF128Call(fir::FirOpBuilder &builder,
709 mlir::Location loc,
710 const MathOperation &mathOp,
711 mlir::FunctionType libFuncType,
712 llvm::ArrayRef<mlir::Value> args) {
713 // TODO: if we knew that the C 'long double' does not have 113-bit mantissa
714 // on the target, we could have asserted that FLANG_RUNTIME_F128_MATH_LIB
715 // must be specified. For now just always generate the call even
716 // if it will be unresolved.
717 return genLibCall(builder, loc, mathOp, libFuncType, args);
718}
719
720mlir::Value genLibCall(fir::FirOpBuilder &builder, mlir::Location loc,
721 const MathOperation &mathOp,
722 mlir::FunctionType libFuncType,
723 llvm::ArrayRef<mlir::Value> args) {
724 llvm::StringRef libFuncName = mathOp.runtimeFunc;
725 LLVM_DEBUG(llvm::dbgs() << "Generating '" << libFuncName
726 << "' call with type ";
727 libFuncType.dump(); llvm::dbgs() << "\n");
728 mlir::func::FuncOp funcOp = builder.getNamedFunction(libFuncName);
729
730 if (!funcOp) {
731 funcOp = builder.createFunction(loc, libFuncName, libFuncType);
732 // C-interoperability rules apply to these library functions.
733 funcOp->setAttr(fir::getSymbolAttrName(),
734 mlir::StringAttr::get(builder.getContext(), libFuncName));
735 // Set fir.runtime attribute to distinguish the function that
736 // was just created from user functions with the same name.
737 funcOp->setAttr(fir::FIROpsDialect::getFirRuntimeAttrName(),
738 builder.getUnitAttr());
739 auto libCall = builder.create<fir::CallOp>(loc, funcOp, args);
740 // TODO: ensure 'strictfp' setting on the call for "precise/strict"
741 // FP mode. Set appropriate Fast-Math Flags otherwise.
742 // TODO: we should also mark as many libm function as possible
743 // with 'pure' attribute (of course, not in strict FP mode).
744 LLVM_DEBUG(libCall.dump(); llvm::dbgs() << "\n");
745 return libCall.getResult(0);
746 }
747
748 // The function with the same name already exists.
749 fir::CallOp libCall;
750 mlir::Type soughtFuncType = funcOp.getFunctionType();
751
752 if (soughtFuncType == libFuncType) {
753 libCall = builder.create<fir::CallOp>(loc, funcOp, args);
754 } else {
755 // A function with the same name might have been declared
756 // before (e.g. with an explicit interface and a binding label).
757 // It is in general incorrect to use the same definition for the library
758 // call, but we have no other options. Type cast the function to match
759 // the requested signature and generate an indirect call to avoid
760 // later failures caused by the signature mismatch.
761 LLVM_DEBUG(mlir::emitWarning(
762 loc, llvm::Twine("function signature mismatch for '") +
763 llvm::Twine(libFuncName) +
764 llvm::Twine("' may lead to undefined behavior.")));
765 mlir::SymbolRefAttr funcSymbolAttr = builder.getSymbolRefAttr(libFuncName);
766 mlir::Value funcPointer =
767 builder.create<fir::AddrOfOp>(loc, soughtFuncType, funcSymbolAttr);
768 funcPointer = builder.createConvert(loc, libFuncType, funcPointer);
769
770 llvm::SmallVector<mlir::Value, 3> operands{funcPointer};
771 operands.append(in_start: args.begin(), in_end: args.end());
772 libCall = builder.create<fir::CallOp>(loc, libFuncType.getResults(),
773 nullptr, operands);
774 }
775
776 LLVM_DEBUG(libCall.dump(); llvm::dbgs() << "\n");
777 return libCall.getResult(0);
778}
779
780mlir::Value genLibSplitComplexArgsCall(fir::FirOpBuilder &builder,
781 mlir::Location loc,
782 const MathOperation &mathOp,
783 mlir::FunctionType libFuncType,
784 llvm::ArrayRef<mlir::Value> args) {
785 assert(args.size() == 2 && "Incorrect #args to genLibSplitComplexArgsCall");
786
787 auto getSplitComplexArgsType = [&builder, &args]() -> mlir::FunctionType {
788 mlir::Type ctype = args[0].getType();
789 auto fKind = ctype.cast<fir::ComplexType>().getFKind();
790 mlir::Type ftype;
791
792 if (fKind == 2)
793 ftype = builder.getF16Type();
794 else if (fKind == 3)
795 ftype = builder.getBF16Type();
796 else if (fKind == 4)
797 ftype = builder.getF32Type();
798 else if (fKind == 8)
799 ftype = builder.getF64Type();
800 else if (fKind == 10)
801 ftype = builder.getF80Type();
802 else if (fKind == 16)
803 ftype = builder.getF128Type();
804 else
805 assert(0 && "Unsupported Complex Type");
806
807 return builder.getFunctionType({ftype, ftype, ftype, ftype}, {ctype});
808 };
809
810 llvm::SmallVector<mlir::Value, 4> splitArgs;
811 mlir::Value cplx1 = args[0];
812 auto real1 = fir::factory::Complex{builder, loc}.extractComplexPart(
813 cplx1, /*isImagPart=*/false);
814 splitArgs.push_back(Elt: real1);
815 auto imag1 = fir::factory::Complex{builder, loc}.extractComplexPart(
816 cplx1, /*isImagPart=*/true);
817 splitArgs.push_back(Elt: imag1);
818 mlir::Value cplx2 = args[1];
819 auto real2 = fir::factory::Complex{builder, loc}.extractComplexPart(
820 cplx2, /*isImagPart=*/false);
821 splitArgs.push_back(Elt: real2);
822 auto imag2 = fir::factory::Complex{builder, loc}.extractComplexPart(
823 cplx2, /*isImagPart=*/true);
824 splitArgs.push_back(Elt: imag2);
825
826 return genLibCall(builder, loc, mathOp, getSplitComplexArgsType(), splitArgs);
827}
828
829template <typename T>
830mlir::Value genMathOp(fir::FirOpBuilder &builder, mlir::Location loc,
831 const MathOperation &mathOp,
832 mlir::FunctionType mathLibFuncType,
833 llvm::ArrayRef<mlir::Value> args) {
834 // TODO: we have to annotate the math operations with flags
835 // that will allow to define FP accuracy/exception
836 // behavior per operation, so that after early multi-module
837 // MLIR inlining we can distiguish operation that were
838 // compiled with different settings.
839 // Suggestion:
840 // * For "relaxed" FP mode set all Fast-Math Flags
841 // (see "[RFC] FastMath flags support in MLIR (arith dialect)"
842 // topic at discourse.llvm.org).
843 // * For "fast" FP mode set all Fast-Math Flags except 'afn'.
844 // * For "precise/strict" FP mode generate fir.calls to libm
845 // entries and annotate them with an attribute that will
846 // end up transformed into 'strictfp' LLVM attribute (TBD).
847 // Elsewhere, "precise/strict" FP mode should also set
848 // 'strictfp' for all user functions and calls so that
849 // LLVM backend does the right job.
850 // * Operations that cannot be reasonably optimized in MLIR
851 // can be also lowered to libm calls for "fast" and "relaxed"
852 // modes.
853 mlir::Value result;
854 llvm::StringRef mathLibFuncName = mathOp.runtimeFunc;
855 if (mathRuntimeVersion == preciseVersion &&
856 // Some operations do not have to be lowered as conservative
857 // calls, since they do not affect strict FP behavior.
858 // For example, purely integer operations like exponentiation
859 // with integer operands fall into this class.
860 !mathLibFuncName.empty()) {
861 result = genLibCall(builder, loc, mathOp, mathLibFuncType, args);
862 } else {
863 LLVM_DEBUG(llvm::dbgs() << "Generating '" << mathLibFuncName
864 << "' operation with type ";
865 mathLibFuncType.dump(); llvm::dbgs() << "\n");
866 result = builder.create<T>(loc, args);
867 }
868 LLVM_DEBUG(result.dump(); llvm::dbgs() << "\n");
869 return result;
870}
871
872template <typename T>
873mlir::Value genComplexMathOp(fir::FirOpBuilder &builder, mlir::Location loc,
874 const MathOperation &mathOp,
875 mlir::FunctionType mathLibFuncType,
876 llvm::ArrayRef<mlir::Value> args) {
877 mlir::Value result;
878 bool canUseApprox = mlir::arith::bitEnumContainsAny(
879 builder.getFastMathFlags(), mlir::arith::FastMathFlags::afn);
880
881 // If we have libm functions, we can attempt to generate the more precise
882 // version of the complex math operation.
883 llvm::StringRef mathLibFuncName = mathOp.runtimeFunc;
884 if (!mathLibFuncName.empty()) {
885 // If we enabled MLIR complex or can use approximate operations, we should
886 // NOT use libm.
887 if (!forceMlirComplex && !canUseApprox) {
888 result = genLibCall(builder, loc, mathOp, mathLibFuncType, args);
889 LLVM_DEBUG(result.dump(); llvm::dbgs() << "\n");
890 return result;
891 }
892 }
893
894 LLVM_DEBUG(llvm::dbgs() << "Generating '" << mathLibFuncName
895 << "' operation with type ";
896 mathLibFuncType.dump(); llvm::dbgs() << "\n");
897 auto type = mathLibFuncType.getInput(0).cast<fir::ComplexType>();
898 auto kind = type.getElementType().cast<fir::RealType>().getFKind();
899 auto realTy = builder.getRealType(kind);
900 auto mComplexTy = mlir::ComplexType::get(realTy);
901
902 llvm::SmallVector<mlir::Value, 2> cargs;
903 for (const mlir::Value &arg : args) {
904 // Convert the fir.complex to a mlir::complex
905 cargs.push_back(Elt: builder.createConvert(loc, mComplexTy, arg));
906 }
907
908 // Builder expects an extra return type to be provided if different to
909 // the argument types for an operation
910 if constexpr (T::template hasTrait<
911 mlir::OpTrait::SameOperandsAndResultType>()) {
912 result = builder.create<T>(loc, cargs);
913 result = builder.createConvert(loc, mathLibFuncType.getResult(0), result);
914 } else {
915 result = builder.create<T>(loc, realTy, cargs);
916 result = builder.createConvert(loc, mathLibFuncType.getResult(0), result);
917 }
918
919 LLVM_DEBUG(result.dump(); llvm::dbgs() << "\n");
920 return result;
921}
922
923/// Mapping between mathematical intrinsic operations and MLIR operations
924/// of some appropriate dialect (math, complex, etc.) or libm calls.
925/// TODO: support remaining Fortran math intrinsics.
926/// See https://gcc.gnu.org/onlinedocs/gcc-12.1.0/gfortran/\
927/// Intrinsic-Procedures.html for a reference.
928constexpr auto FuncTypeReal16Real16 = genFuncType<Ty::Real<16>, Ty::Real<16>>;
929constexpr auto FuncTypeReal16Real16Real16 =
930 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Real<16>>;
931constexpr auto FuncTypeReal16Real16Real16Real16 =
932 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Real<16>, Ty::Real<16>>;
933constexpr auto FuncTypeReal16Integer4Real16 =
934 genFuncType<Ty::Real<16>, Ty::Integer<4>, Ty::Real<16>>;
935constexpr auto FuncTypeInteger4Real16 =
936 genFuncType<Ty::Integer<4>, Ty::Real<16>>;
937constexpr auto FuncTypeInteger8Real16 =
938 genFuncType<Ty::Integer<8>, Ty::Real<16>>;
939constexpr auto FuncTypeReal16Complex16 =
940 genFuncType<Ty::Real<16>, Ty::Complex<16>>;
941constexpr auto FuncTypeComplex16Complex16 =
942 genFuncType<Ty::Complex<16>, Ty::Complex<16>>;
943constexpr auto FuncTypeComplex16Complex16Complex16 =
944 genFuncType<Ty::Complex<16>, Ty::Complex<16>, Ty::Complex<16>>;
945constexpr auto FuncTypeComplex16Complex16Integer4 =
946 genFuncType<Ty::Complex<16>, Ty::Complex<16>, Ty::Integer<4>>;
947constexpr auto FuncTypeComplex16Complex16Integer8 =
948 genFuncType<Ty::Complex<16>, Ty::Complex<16>, Ty::Integer<8>>;
949
950static constexpr MathOperation mathOperations[] = {
951 {"abs", "fabsf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
952 genMathOp<mlir::math::AbsFOp>},
953 {"abs", "fabs", genFuncType<Ty::Real<8>, Ty::Real<8>>,
954 genMathOp<mlir::math::AbsFOp>},
955 {"abs", "llvm.fabs.f128", genFuncType<Ty::Real<16>, Ty::Real<16>>,
956 genMathOp<mlir::math::AbsFOp>},
957 {"abs", "cabsf", genFuncType<Ty::Real<4>, Ty::Complex<4>>,
958 genComplexMathOp<mlir::complex::AbsOp>},
959 {"abs", "cabs", genFuncType<Ty::Real<8>, Ty::Complex<8>>,
960 genComplexMathOp<mlir::complex::AbsOp>},
961 {"abs", RTNAME_STRING(CAbsF128), FuncTypeReal16Complex16, genLibF128Call},
962 {"acos", "acosf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
963 {"acos", "acos", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
964 {"acos", RTNAME_STRING(AcosF128), FuncTypeReal16Real16, genLibF128Call},
965 {"acos", "cacosf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall},
966 {"acos", "cacos", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall},
967 {"acos", RTNAME_STRING(CAcosF128), FuncTypeComplex16Complex16,
968 genLibF128Call},
969 {"acosh", "acoshf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
970 {"acosh", "acosh", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
971 {"acosh", RTNAME_STRING(AcoshF128), FuncTypeReal16Real16, genLibF128Call},
972 {"acosh", "cacoshf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
973 genLibCall},
974 {"acosh", "cacosh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
975 genLibCall},
976 {"acosh", RTNAME_STRING(CAcoshF128), FuncTypeComplex16Complex16,
977 genLibF128Call},
978 // llvm.trunc behaves the same way as libm's trunc.
979 {"aint", "llvm.trunc.f32", genFuncType<Ty::Real<4>, Ty::Real<4>>,
980 genLibCall},
981 {"aint", "llvm.trunc.f64", genFuncType<Ty::Real<8>, Ty::Real<8>>,
982 genLibCall},
983 {"aint", "llvm.trunc.f80", genFuncType<Ty::Real<10>, Ty::Real<10>>,
984 genLibCall},
985 {"aint", RTNAME_STRING(TruncF128), FuncTypeReal16Real16, genLibF128Call},
986 // llvm.round behaves the same way as libm's round.
987 {"anint", "llvm.round.f32", genFuncType<Ty::Real<4>, Ty::Real<4>>,
988 genMathOp<mlir::LLVM::RoundOp>},
989 {"anint", "llvm.round.f64", genFuncType<Ty::Real<8>, Ty::Real<8>>,
990 genMathOp<mlir::LLVM::RoundOp>},
991 {"anint", "llvm.round.f80", genFuncType<Ty::Real<10>, Ty::Real<10>>,
992 genMathOp<mlir::LLVM::RoundOp>},
993 {"anint", RTNAME_STRING(RoundF128), FuncTypeReal16Real16, genLibF128Call},
994 {"asin", "asinf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
995 {"asin", "asin", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
996 {"asin", RTNAME_STRING(AsinF128), FuncTypeReal16Real16, genLibF128Call},
997 {"asin", "casinf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall},
998 {"asin", "casin", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall},
999 {"asin", RTNAME_STRING(CAsinF128), FuncTypeComplex16Complex16,
1000 genLibF128Call},
1001 {"asinh", "asinhf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
1002 {"asinh", "asinh", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
1003 {"asinh", RTNAME_STRING(AsinhF128), FuncTypeReal16Real16, genLibF128Call},
1004 {"asinh", "casinhf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1005 genLibCall},
1006 {"asinh", "casinh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1007 genLibCall},
1008 {"asinh", RTNAME_STRING(CAsinhF128), FuncTypeComplex16Complex16,
1009 genLibF128Call},
1010 {"atan", "atanf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1011 genMathOp<mlir::math::AtanOp>},
1012 {"atan", "atan", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1013 genMathOp<mlir::math::AtanOp>},
1014 {"atan", RTNAME_STRING(AtanF128), FuncTypeReal16Real16, genLibF128Call},
1015 {"atan", "catanf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall},
1016 {"atan", "catan", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall},
1017 {"atan", RTNAME_STRING(CAtanF128), FuncTypeComplex16Complex16,
1018 genLibF128Call},
1019 {"atan2", "atan2f", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>,
1020 genMathOp<mlir::math::Atan2Op>},
1021 {"atan2", "atan2", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>,
1022 genMathOp<mlir::math::Atan2Op>},
1023 {"atan2", RTNAME_STRING(Atan2F128), FuncTypeReal16Real16Real16,
1024 genLibF128Call},
1025 {"atanh", "atanhf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
1026 {"atanh", "atanh", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
1027 {"atanh", RTNAME_STRING(AtanhF128), FuncTypeReal16Real16, genLibF128Call},
1028 {"atanh", "catanhf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1029 genLibCall},
1030 {"atanh", "catanh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1031 genLibCall},
1032 {"atanh", RTNAME_STRING(CAtanhF128), FuncTypeComplex16Complex16,
1033 genLibF128Call},
1034 {"bessel_j0", "j0f", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
1035 {"bessel_j0", "j0", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
1036 {"bessel_j0", RTNAME_STRING(J0F128), FuncTypeReal16Real16, genLibF128Call},
1037 {"bessel_j1", "j1f", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
1038 {"bessel_j1", "j1", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
1039 {"bessel_j1", RTNAME_STRING(J1F128), FuncTypeReal16Real16, genLibF128Call},
1040 {"bessel_jn", "jnf", genFuncType<Ty::Real<4>, Ty::Integer<4>, Ty::Real<4>>,
1041 genLibCall},
1042 {"bessel_jn", "jn", genFuncType<Ty::Real<8>, Ty::Integer<4>, Ty::Real<8>>,
1043 genLibCall},
1044 {"bessel_jn", RTNAME_STRING(JnF128), FuncTypeReal16Integer4Real16,
1045 genLibF128Call},
1046 {"bessel_y0", "y0f", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
1047 {"bessel_y0", "y0", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
1048 {"bessel_y0", RTNAME_STRING(Y0F128), FuncTypeReal16Real16, genLibF128Call},
1049 {"bessel_y1", "y1f", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
1050 {"bessel_y1", "y1", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
1051 {"bessel_y1", RTNAME_STRING(Y1F128), FuncTypeReal16Real16, genLibF128Call},
1052 {"bessel_yn", "ynf", genFuncType<Ty::Real<4>, Ty::Integer<4>, Ty::Real<4>>,
1053 genLibCall},
1054 {"bessel_yn", "yn", genFuncType<Ty::Real<8>, Ty::Integer<4>, Ty::Real<8>>,
1055 genLibCall},
1056 {"bessel_yn", RTNAME_STRING(YnF128), FuncTypeReal16Integer4Real16,
1057 genLibF128Call},
1058 // math::CeilOp returns a real, while Fortran CEILING returns integer.
1059 {"ceil", "ceilf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1060 genMathOp<mlir::math::CeilOp>},
1061 {"ceil", "ceil", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1062 genMathOp<mlir::math::CeilOp>},
1063 {"ceil", RTNAME_STRING(CeilF128), FuncTypeReal16Real16, genLibF128Call},
1064 {"cos", "cosf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1065 genMathOp<mlir::math::CosOp>},
1066 {"cos", "cos", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1067 genMathOp<mlir::math::CosOp>},
1068 {"cos", RTNAME_STRING(CosF128), FuncTypeReal16Real16, genLibF128Call},
1069 {"cos", "ccosf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1070 genComplexMathOp<mlir::complex::CosOp>},
1071 {"cos", "ccos", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1072 genComplexMathOp<mlir::complex::CosOp>},
1073 {"cos", RTNAME_STRING(CCosF128), FuncTypeComplex16Complex16,
1074 genLibF128Call},
1075 {"cosh", "coshf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
1076 {"cosh", "cosh", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
1077 {"cosh", RTNAME_STRING(CoshF128), FuncTypeReal16Real16, genLibF128Call},
1078 {"cosh", "ccoshf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall},
1079 {"cosh", "ccosh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall},
1080 {"cosh", RTNAME_STRING(CCoshF128), FuncTypeComplex16Complex16,
1081 genLibF128Call},
1082 {"divc",
1083 {},
1084 genFuncType<Ty::Complex<2>, Ty::Complex<2>, Ty::Complex<2>>,
1085 genComplexMathOp<mlir::complex::DivOp>},
1086 {"divc",
1087 {},
1088 genFuncType<Ty::Complex<3>, Ty::Complex<3>, Ty::Complex<3>>,
1089 genComplexMathOp<mlir::complex::DivOp>},
1090 {"divc", "__divsc3",
1091 genFuncType<Ty::Complex<4>, Ty::Complex<4>, Ty::Complex<4>>,
1092 genLibSplitComplexArgsCall},
1093 {"divc", "__divdc3",
1094 genFuncType<Ty::Complex<8>, Ty::Complex<8>, Ty::Complex<8>>,
1095 genLibSplitComplexArgsCall},
1096 {"divc", "__divxc3",
1097 genFuncType<Ty::Complex<10>, Ty::Complex<10>, Ty::Complex<10>>,
1098 genLibSplitComplexArgsCall},
1099 {"divc", "__divtc3",
1100 genFuncType<Ty::Complex<16>, Ty::Complex<16>, Ty::Complex<16>>,
1101 genLibSplitComplexArgsCall},
1102 {"erf", "erff", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1103 genMathOp<mlir::math::ErfOp>},
1104 {"erf", "erf", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1105 genMathOp<mlir::math::ErfOp>},
1106 {"erf", RTNAME_STRING(ErfF128), FuncTypeReal16Real16, genLibF128Call},
1107 {"erfc", "erfcf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
1108 {"erfc", "erfc", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
1109 {"erfc", RTNAME_STRING(ErfcF128), FuncTypeReal16Real16, genLibF128Call},
1110 {"exp", "expf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1111 genMathOp<mlir::math::ExpOp>},
1112 {"exp", "exp", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1113 genMathOp<mlir::math::ExpOp>},
1114 {"exp", RTNAME_STRING(ExpF128), FuncTypeReal16Real16, genLibF128Call},
1115 {"exp", "cexpf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1116 genComplexMathOp<mlir::complex::ExpOp>},
1117 {"exp", "cexp", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1118 genComplexMathOp<mlir::complex::ExpOp>},
1119 {"exp", RTNAME_STRING(CExpF128), FuncTypeComplex16Complex16,
1120 genLibF128Call},
1121 {"feclearexcept", "feclearexcept",
1122 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},
1123 {"fedisableexcept", "fedisableexcept",
1124 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},
1125 {"feenableexcept", "feenableexcept",
1126 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},
1127 {"fegetenv", "fegetenv", genFuncType<Ty::Integer<4>, Ty::Address<4>>,
1128 genLibCall},
1129 {"fegetexcept", "fegetexcept", genFuncType<Ty::Integer<4>>, genLibCall},
1130 {"fegetmode", "fegetmode", genFuncType<Ty::Integer<4>, Ty::Address<4>>,
1131 genLibCall},
1132 {"feraiseexcept", "feraiseexcept",
1133 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},
1134 {"fesetenv", "fesetenv", genFuncType<Ty::Integer<4>, Ty::Address<4>>,
1135 genLibCall},
1136 {"fesetmode", "fesetmode", genFuncType<Ty::Integer<4>, Ty::Address<4>>,
1137 genLibCall},
1138 {"fetestexcept", "fetestexcept",
1139 genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},
1140 {"feupdateenv", "feupdateenv", genFuncType<Ty::Integer<4>, Ty::Address<4>>,
1141 genLibCall},
1142 // math::FloorOp returns a real, while Fortran FLOOR returns integer.
1143 {"floor", "floorf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1144 genMathOp<mlir::math::FloorOp>},
1145 {"floor", "floor", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1146 genMathOp<mlir::math::FloorOp>},
1147 {"floor", RTNAME_STRING(FloorF128), FuncTypeReal16Real16, genLibF128Call},
1148 {"fma", "llvm.fma.f32",
1149 genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>,
1150 genMathOp<mlir::math::FmaOp>},
1151 {"fma", "llvm.fma.f64",
1152 genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>,
1153 genMathOp<mlir::math::FmaOp>},
1154 {"fma", RTNAME_STRING(FmaF128), FuncTypeReal16Real16Real16Real16,
1155 genLibF128Call},
1156 {"gamma", "tgammaf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
1157 {"gamma", "tgamma", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
1158 {"gamma", RTNAME_STRING(TgammaF128), FuncTypeReal16Real16, genLibF128Call},
1159 {"hypot", "hypotf", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>,
1160 genLibCall},
1161 {"hypot", "hypot", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>,
1162 genLibCall},
1163 {"hypot", RTNAME_STRING(HypotF128), FuncTypeReal16Real16Real16,
1164 genLibF128Call},
1165 {"log", "logf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1166 genMathOp<mlir::math::LogOp>},
1167 {"log", "log", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1168 genMathOp<mlir::math::LogOp>},
1169 {"log", RTNAME_STRING(LogF128), FuncTypeReal16Real16, genLibF128Call},
1170 {"log", "clogf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1171 genComplexMathOp<mlir::complex::LogOp>},
1172 {"log", "clog", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1173 genComplexMathOp<mlir::complex::LogOp>},
1174 {"log", RTNAME_STRING(CLogF128), FuncTypeComplex16Complex16,
1175 genLibF128Call},
1176 {"log10", "log10f", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1177 genMathOp<mlir::math::Log10Op>},
1178 {"log10", "log10", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1179 genMathOp<mlir::math::Log10Op>},
1180 {"log10", RTNAME_STRING(Log10F128), FuncTypeReal16Real16, genLibF128Call},
1181 {"log_gamma", "lgammaf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
1182 {"log_gamma", "lgamma", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
1183 {"log_gamma", RTNAME_STRING(LgammaF128), FuncTypeReal16Real16,
1184 genLibF128Call},
1185 // llvm.lround behaves the same way as libm's lround.
1186 {"nint", "llvm.lround.i64.f64", genFuncType<Ty::Integer<8>, Ty::Real<8>>,
1187 genLibCall},
1188 {"nint", "llvm.lround.i64.f32", genFuncType<Ty::Integer<8>, Ty::Real<4>>,
1189 genLibCall},
1190 {"nint", RTNAME_STRING(LlroundF128), FuncTypeInteger8Real16,
1191 genLibF128Call},
1192 {"nint", "llvm.lround.i32.f64", genFuncType<Ty::Integer<4>, Ty::Real<8>>,
1193 genLibCall},
1194 {"nint", "llvm.lround.i32.f32", genFuncType<Ty::Integer<4>, Ty::Real<4>>,
1195 genLibCall},
1196 {"nint", RTNAME_STRING(LroundF128), FuncTypeInteger4Real16, genLibF128Call},
1197 {"pow",
1198 {},
1199 genFuncType<Ty::Integer<1>, Ty::Integer<1>, Ty::Integer<1>>,
1200 genMathOp<mlir::math::IPowIOp>},
1201 {"pow",
1202 {},
1203 genFuncType<Ty::Integer<2>, Ty::Integer<2>, Ty::Integer<2>>,
1204 genMathOp<mlir::math::IPowIOp>},
1205 {"pow",
1206 {},
1207 genFuncType<Ty::Integer<4>, Ty::Integer<4>, Ty::Integer<4>>,
1208 genMathOp<mlir::math::IPowIOp>},
1209 {"pow",
1210 {},
1211 genFuncType<Ty::Integer<8>, Ty::Integer<8>, Ty::Integer<8>>,
1212 genMathOp<mlir::math::IPowIOp>},
1213 {"pow", "powf", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>,
1214 genMathOp<mlir::math::PowFOp>},
1215 {"pow", "pow", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>,
1216 genMathOp<mlir::math::PowFOp>},
1217 {"pow", RTNAME_STRING(PowF128), FuncTypeReal16Real16Real16, genLibF128Call},
1218 {"pow", "cpowf",
1219 genFuncType<Ty::Complex<4>, Ty::Complex<4>, Ty::Complex<4>>,
1220 genComplexMathOp<mlir::complex::PowOp>},
1221 {"pow", "cpow", genFuncType<Ty::Complex<8>, Ty::Complex<8>, Ty::Complex<8>>,
1222 genComplexMathOp<mlir::complex::PowOp>},
1223 {"pow", RTNAME_STRING(CPowF128), FuncTypeComplex16Complex16Complex16,
1224 genLibF128Call},
1225 {"pow", RTNAME_STRING(FPow4i),
1226 genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Integer<4>>,
1227 genMathOp<mlir::math::FPowIOp>},
1228 {"pow", RTNAME_STRING(FPow8i),
1229 genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Integer<4>>,
1230 genMathOp<mlir::math::FPowIOp>},
1231 {"pow", RTNAME_STRING(FPow16i),
1232 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Integer<4>>,
1233 genMathOp<mlir::math::FPowIOp>},
1234 {"pow", RTNAME_STRING(FPow4k),
1235 genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Integer<8>>,
1236 genMathOp<mlir::math::FPowIOp>},
1237 {"pow", RTNAME_STRING(FPow8k),
1238 genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Integer<8>>,
1239 genMathOp<mlir::math::FPowIOp>},
1240 {"pow", RTNAME_STRING(FPow16k),
1241 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Integer<8>>,
1242 genMathOp<mlir::math::FPowIOp>},
1243 {"pow", RTNAME_STRING(cpowi),
1244 genFuncType<Ty::Complex<4>, Ty::Complex<4>, Ty::Integer<4>>, genLibCall},
1245 {"pow", RTNAME_STRING(zpowi),
1246 genFuncType<Ty::Complex<8>, Ty::Complex<8>, Ty::Integer<4>>, genLibCall},
1247 {"pow", RTNAME_STRING(cqpowi), FuncTypeComplex16Complex16Integer4,
1248 genLibF128Call},
1249 {"pow", RTNAME_STRING(cpowk),
1250 genFuncType<Ty::Complex<4>, Ty::Complex<4>, Ty::Integer<8>>, genLibCall},
1251 {"pow", RTNAME_STRING(zpowk),
1252 genFuncType<Ty::Complex<8>, Ty::Complex<8>, Ty::Integer<8>>, genLibCall},
1253 {"pow", RTNAME_STRING(cqpowk), FuncTypeComplex16Complex16Integer8,
1254 genLibF128Call},
1255 {"sign", "copysignf", genFuncType<Ty::Real<4>, Ty::Real<4>, Ty::Real<4>>,
1256 genMathOp<mlir::math::CopySignOp>},
1257 {"sign", "copysign", genFuncType<Ty::Real<8>, Ty::Real<8>, Ty::Real<8>>,
1258 genMathOp<mlir::math::CopySignOp>},
1259 {"sign", "copysignl", genFuncType<Ty::Real<10>, Ty::Real<10>, Ty::Real<10>>,
1260 genMathOp<mlir::math::CopySignOp>},
1261 {"sign", "llvm.copysign.f128",
1262 genFuncType<Ty::Real<16>, Ty::Real<16>, Ty::Real<16>>,
1263 genMathOp<mlir::math::CopySignOp>},
1264 {"sin", "sinf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1265 genMathOp<mlir::math::SinOp>},
1266 {"sin", "sin", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1267 genMathOp<mlir::math::SinOp>},
1268 {"sin", RTNAME_STRING(SinF128), FuncTypeReal16Real16, genLibF128Call},
1269 {"sin", "csinf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1270 genComplexMathOp<mlir::complex::SinOp>},
1271 {"sin", "csin", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1272 genComplexMathOp<mlir::complex::SinOp>},
1273 {"sin", RTNAME_STRING(CSinF128), FuncTypeComplex16Complex16,
1274 genLibF128Call},
1275 {"sinh", "sinhf", genFuncType<Ty::Real<4>, Ty::Real<4>>, genLibCall},
1276 {"sinh", "sinh", genFuncType<Ty::Real<8>, Ty::Real<8>>, genLibCall},
1277 {"sinh", RTNAME_STRING(SinhF128), FuncTypeReal16Real16, genLibF128Call},
1278 {"sinh", "csinhf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>, genLibCall},
1279 {"sinh", "csinh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>, genLibCall},
1280 {"sinh", RTNAME_STRING(CSinhF128), FuncTypeComplex16Complex16,
1281 genLibF128Call},
1282 {"sqrt", "sqrtf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1283 genMathOp<mlir::math::SqrtOp>},
1284 {"sqrt", "sqrt", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1285 genMathOp<mlir::math::SqrtOp>},
1286 {"sqrt", RTNAME_STRING(SqrtF128), FuncTypeReal16Real16, genLibF128Call},
1287 {"sqrt", "csqrtf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1288 genComplexMathOp<mlir::complex::SqrtOp>},
1289 {"sqrt", "csqrt", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1290 genComplexMathOp<mlir::complex::SqrtOp>},
1291 {"sqrt", RTNAME_STRING(CSqrtF128), FuncTypeComplex16Complex16,
1292 genLibF128Call},
1293 {"tan", "tanf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1294 genMathOp<mlir::math::TanOp>},
1295 {"tan", "tan", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1296 genMathOp<mlir::math::TanOp>},
1297 {"tan", RTNAME_STRING(TanF128), FuncTypeReal16Real16, genLibF128Call},
1298 {"tan", "ctanf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1299 genComplexMathOp<mlir::complex::TanOp>},
1300 {"tan", "ctan", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1301 genComplexMathOp<mlir::complex::TanOp>},
1302 {"tan", RTNAME_STRING(CTanF128), FuncTypeComplex16Complex16,
1303 genLibF128Call},
1304 {"tanh", "tanhf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
1305 genMathOp<mlir::math::TanhOp>},
1306 {"tanh", "tanh", genFuncType<Ty::Real<8>, Ty::Real<8>>,
1307 genMathOp<mlir::math::TanhOp>},
1308 {"tanh", RTNAME_STRING(TanhF128), FuncTypeReal16Real16, genLibF128Call},
1309 {"tanh", "ctanhf", genFuncType<Ty::Complex<4>, Ty::Complex<4>>,
1310 genComplexMathOp<mlir::complex::TanhOp>},
1311 {"tanh", "ctanh", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
1312 genComplexMathOp<mlir::complex::TanhOp>},
1313 {"tanh", RTNAME_STRING(CTanhF128), FuncTypeComplex16Complex16,
1314 genLibF128Call},
1315};
1316
1317// This helper class computes a "distance" between two function types.
1318// The distance measures how many narrowing conversions of actual arguments
1319// and result of "from" must be made in order to use "to" instead of "from".
1320// For instance, the distance between ACOS(REAL(10)) and ACOS(REAL(8)) is
1321// greater than the one between ACOS(REAL(10)) and ACOS(REAL(16)). This means
1322// if no implementation of ACOS(REAL(10)) is available, it is better to use
1323// ACOS(REAL(16)) with casts rather than ACOS(REAL(8)).
1324// Note that this is not a symmetric distance and the order of "from" and "to"
1325// arguments matters, d(foo, bar) may not be the same as d(bar, foo) because it
1326// may be safe to replace foo by bar, but not the opposite.
1327class FunctionDistance {
1328public:
1329 FunctionDistance() : infinite{true} {}
1330
1331 FunctionDistance(mlir::FunctionType from, mlir::FunctionType to) {
1332 unsigned nInputs = from.getNumInputs();
1333 unsigned nResults = from.getNumResults();
1334 if (nResults != to.getNumResults() || nInputs != to.getNumInputs()) {
1335 infinite = true;
1336 } else {
1337 for (decltype(nInputs) i = 0; i < nInputs && !infinite; ++i)
1338 addArgumentDistance(from: from.getInput(i), to: to.getInput(i));
1339 for (decltype(nResults) i = 0; i < nResults && !infinite; ++i)
1340 addResultDistance(from: to.getResult(i), to: from.getResult(i));
1341 }
1342 }
1343
1344 /// Beware both d1.isSmallerThan(d2) *and* d2.isSmallerThan(d1) may be
1345 /// false if both d1 and d2 are infinite. This implies that
1346 /// d1.isSmallerThan(d2) is not equivalent to !d2.isSmallerThan(d1)
1347 bool isSmallerThan(const FunctionDistance &d) const {
1348 return !infinite &&
1349 (d.infinite || std::lexicographical_compare(
1350 first1: conversions.begin(), last1: conversions.end(),
1351 first2: d.conversions.begin(), last2: d.conversions.end()));
1352 }
1353
1354 bool isLosingPrecision() const {
1355 return conversions[narrowingArg] != 0 || conversions[extendingResult] != 0;
1356 }
1357
1358 bool isInfinite() const { return infinite; }
1359
1360private:
1361 enum class Conversion { Forbidden, None, Narrow, Extend };
1362
1363 void addArgumentDistance(mlir::Type from, mlir::Type to) {
1364 switch (conversionBetweenTypes(from, to)) {
1365 case Conversion::Forbidden:
1366 infinite = true;
1367 break;
1368 case Conversion::None:
1369 break;
1370 case Conversion::Narrow:
1371 conversions[narrowingArg]++;
1372 break;
1373 case Conversion::Extend:
1374 conversions[nonNarrowingArg]++;
1375 break;
1376 }
1377 }
1378
1379 void addResultDistance(mlir::Type from, mlir::Type to) {
1380 switch (conversionBetweenTypes(from, to)) {
1381 case Conversion::Forbidden:
1382 infinite = true;
1383 break;
1384 case Conversion::None:
1385 break;
1386 case Conversion::Narrow:
1387 conversions[nonExtendingResult]++;
1388 break;
1389 case Conversion::Extend:
1390 conversions[extendingResult]++;
1391 break;
1392 }
1393 }
1394
1395 // Floating point can be mlir::FloatType or fir::real
1396 static unsigned getFloatingPointWidth(mlir::Type t) {
1397 if (auto f{t.dyn_cast<mlir::FloatType>()})
1398 return f.getWidth();
1399 // FIXME: Get width another way for fir.real/complex
1400 // - use fir/KindMapping.h and llvm::Type
1401 // - or use evaluate/type.h
1402 if (auto r{t.dyn_cast<fir::RealType>()})
1403 return r.getFKind() * 4;
1404 if (auto cplx{t.dyn_cast<fir::ComplexType>()})
1405 return cplx.getFKind() * 4;
1406 llvm_unreachable("not a floating-point type");
1407 }
1408
1409 static Conversion conversionBetweenTypes(mlir::Type from, mlir::Type to) {
1410 if (from == to)
1411 return Conversion::None;
1412
1413 if (auto fromIntTy{from.dyn_cast<mlir::IntegerType>()}) {
1414 if (auto toIntTy{to.dyn_cast<mlir::IntegerType>()}) {
1415 return fromIntTy.getWidth() > toIntTy.getWidth() ? Conversion::Narrow
1416 : Conversion::Extend;
1417 }
1418 }
1419
1420 if (fir::isa_real(from) && fir::isa_real(to)) {
1421 return getFloatingPointWidth(t: from) > getFloatingPointWidth(t: to)
1422 ? Conversion::Narrow
1423 : Conversion::Extend;
1424 }
1425
1426 if (auto fromCplxTy{from.dyn_cast<fir::ComplexType>()}) {
1427 if (auto toCplxTy{to.dyn_cast<fir::ComplexType>()}) {
1428 return getFloatingPointWidth(t: fromCplxTy) >
1429 getFloatingPointWidth(t: toCplxTy)
1430 ? Conversion::Narrow
1431 : Conversion::Extend;
1432 }
1433 }
1434 // Notes:
1435 // - No conversion between character types, specialization of runtime
1436 // functions should be made instead.
1437 // - It is not clear there is a use case for automatic conversions
1438 // around Logical and it may damage hidden information in the physical
1439 // storage so do not do it.
1440 return Conversion::Forbidden;
1441 }
1442
1443 // Below are indexes to access data in conversions.
1444 // The order in data does matter for lexicographical_compare
1445 enum {
1446 narrowingArg = 0, // usually bad
1447 extendingResult, // usually bad
1448 nonExtendingResult, // usually ok
1449 nonNarrowingArg, // usually ok
1450 dataSize
1451 };
1452
1453 std::array<int, dataSize> conversions = {};
1454 bool infinite = false; // When forbidden conversion or wrong argument number
1455};
1456
1457using RtMap = Fortran::common::StaticMultimapView<MathOperation>;
1458static constexpr RtMap mathOps(mathOperations);
1459static_assert(mathOps.Verify() && "map must be sorted");
1460
1461/// Look for a MathOperation entry specifying how to lower a mathematical
1462/// operation defined by \p name with its result' and operands' types
1463/// specified in the form of a FunctionType \p funcType.
1464/// If exact match for the given types is found, then the function
1465/// returns a pointer to the corresponding MathOperation.
1466/// Otherwise, the function returns nullptr.
1467/// If there is a MathOperation that can be used with additional
1468/// type casts for the operands or/and result (non-exact match),
1469/// then it is returned via \p bestNearMatch argument, and
1470/// \p bestMatchDistance specifies the FunctionDistance between
1471/// the requested operation and the non-exact match.
1472static const MathOperation *
1473searchMathOperation(fir::FirOpBuilder &builder, llvm::StringRef name,
1474 mlir::FunctionType funcType,
1475 const MathOperation **bestNearMatch,
1476 FunctionDistance &bestMatchDistance) {
1477 auto range = mathOps.equal_range(name);
1478 auto mod = builder.getModule();
1479
1480 // Search ppcMathOps only if targetting PowerPC arch
1481 if (fir::getTargetTriple(mod).isPPC() && range.first == range.second) {
1482 range = checkPPCMathOperationsRange(name);
1483 }
1484 for (auto iter = range.first; iter != range.second && iter; ++iter) {
1485 const auto &impl = *iter;
1486 auto implType = impl.typeGenerator(builder.getContext(), builder);
1487 if (funcType == implType) {
1488 return &impl; // exact match
1489 }
1490
1491 FunctionDistance distance(funcType, implType);
1492 if (distance.isSmallerThan(d: bestMatchDistance)) {
1493 *bestNearMatch = &impl;
1494 bestMatchDistance = std::move(distance);
1495 }
1496 }
1497 return nullptr;
1498}
1499
1500/// Implementation of the operation defined by \p name with type
1501/// \p funcType is not precise, and the actual available implementation
1502/// is \p distance away from the requested. If using the available
1503/// implementation results in a precision loss, emit an error message
1504/// with the given code location \p loc.
1505static void checkPrecisionLoss(llvm::StringRef name,
1506 mlir::FunctionType funcType,
1507 const FunctionDistance &distance,
1508 fir::FirOpBuilder &builder, mlir::Location loc) {
1509 if (!distance.isLosingPrecision())
1510 return;
1511
1512 // Using this runtime version requires narrowing the arguments
1513 // or extending the result. It is not numerically safe. There
1514 // is currently no quad math library that was described in
1515 // lowering and could be used here. Emit an error and continue
1516 // generating the code with the narrowing cast so that the user
1517 // can get a complete list of the problematic intrinsic calls.
1518 std::string message = prettyPrintIntrinsicName(
1519 builder, loc, "not yet implemented: no math runtime available for '",
1520 name, "'", funcType);
1521 mlir::emitError(loc, message);
1522}
1523
1524/// Helpers to get function type from arguments and result type.
1525static mlir::FunctionType getFunctionType(std::optional<mlir::Type> resultType,
1526 llvm::ArrayRef<mlir::Value> arguments,
1527 fir::FirOpBuilder &builder) {
1528 llvm::SmallVector<mlir::Type> argTypes;
1529 for (mlir::Value arg : arguments)
1530 argTypes.push_back(Elt: arg.getType());
1531 llvm::SmallVector<mlir::Type> resTypes;
1532 if (resultType)
1533 resTypes.push_back(Elt: *resultType);
1534 return mlir::FunctionType::get(builder.getModule().getContext(), argTypes,
1535 resTypes);
1536}
1537
1538/// fir::ExtendedValue to mlir::Value translation layer
1539
1540fir::ExtendedValue toExtendedValue(mlir::Value val, fir::FirOpBuilder &builder,
1541 mlir::Location loc) {
1542 assert(val && "optional unhandled here");
1543 mlir::Type type = val.getType();
1544 mlir::Value base = val;
1545 mlir::IndexType indexType = builder.getIndexType();
1546 llvm::SmallVector<mlir::Value> extents;
1547
1548 fir::factory::CharacterExprHelper charHelper{builder, loc};
1549 // FIXME: we may want to allow non character scalar here.
1550 if (charHelper.isCharacterScalar(type))
1551 return charHelper.toExtendedValue(val);
1552
1553 if (auto refType = type.dyn_cast<fir::ReferenceType>())
1554 type = refType.getEleTy();
1555
1556 if (auto arrayType = type.dyn_cast<fir::SequenceType>()) {
1557 type = arrayType.getEleTy();
1558 for (fir::SequenceType::Extent extent : arrayType.getShape()) {
1559 if (extent == fir::SequenceType::getUnknownExtent())
1560 break;
1561 extents.emplace_back(
1562 builder.createIntegerConstant(loc, indexType, extent));
1563 }
1564 // Last extent might be missing in case of assumed-size. If more extents
1565 // could not be deduced from type, that's an error (a fir.box should
1566 // have been used in the interface).
1567 if (extents.size() + 1 < arrayType.getShape().size())
1568 mlir::emitError(loc, message: "cannot retrieve array extents from type");
1569 } else if (type.isa<fir::BoxType>() || type.isa<fir::RecordType>()) {
1570 fir::emitFatalError(loc, "not yet implemented: descriptor or derived type");
1571 }
1572
1573 if (!extents.empty())
1574 return fir::ArrayBoxValue{base, extents};
1575 return base;
1576}
1577
1578mlir::Value toValue(const fir::ExtendedValue &val, fir::FirOpBuilder &builder,
1579 mlir::Location loc) {
1580 if (const fir::CharBoxValue *charBox = val.getCharBox()) {
1581 mlir::Value buffer = charBox->getBuffer();
1582 auto buffTy = buffer.getType();
1583 if (buffTy.isa<mlir::FunctionType>())
1584 fir::emitFatalError(
1585 loc, "A character's buffer type cannot be a function type.");
1586 if (buffTy.isa<fir::BoxCharType>())
1587 return buffer;
1588 return fir::factory::CharacterExprHelper{builder, loc}.createEmboxChar(
1589 buffer, charBox->getLen());
1590 }
1591
1592 // FIXME: need to access other ExtendedValue variants and handle them
1593 // properly.
1594 return fir::getBase(val);
1595}
1596
1597//===----------------------------------------------------------------------===//
1598// IntrinsicLibrary
1599//===----------------------------------------------------------------------===//
1600
1601static bool isIntrinsicModuleProcedure(llvm::StringRef name) {
1602 return name.starts_with(Prefix: "c_") || name.starts_with(Prefix: "compiler_") ||
1603 name.starts_with(Prefix: "ieee_") || name.starts_with(Prefix: "__ppc_");
1604}
1605
1606static bool isCoarrayIntrinsic(llvm::StringRef name) {
1607 return name.starts_with(Prefix: "atomic_") || name.starts_with(Prefix: "co_") ||
1608 name.contains(Other: "image") || name.ends_with(Suffix: "cobound") ||
1609 name.equals(RHS: "team_number");
1610}
1611
1612/// Return the generic name of an intrinsic module procedure specific name.
1613/// Remove any "__builtin_" prefix, and any specific suffix of the form
1614/// {_[ail]?[0-9]+}*, such as _1 or _a4.
1615llvm::StringRef genericName(llvm::StringRef specificName) {
1616 const std::string builtin = "__builtin_";
1617 llvm::StringRef name = specificName.starts_with(Prefix: builtin)
1618 ? specificName.drop_front(N: builtin.size())
1619 : specificName;
1620 size_t size = name.size();
1621 if (isIntrinsicModuleProcedure(name))
1622 while (isdigit(name[size - 1]))
1623 while (name[--size] != '_')
1624 ;
1625 return name.drop_back(N: name.size() - size);
1626}
1627
1628/// Generate a TODO error message for an as yet unimplemented intrinsic.
1629void crashOnMissingIntrinsic(mlir::Location loc, llvm::StringRef name) {
1630 if (isIntrinsicModuleProcedure(name))
1631 TODO(loc, "intrinsic module procedure: " + llvm::Twine(name));
1632 else if (isCoarrayIntrinsic(name))
1633 TODO(loc, "coarray: intrinsic " + llvm::Twine(name));
1634 else
1635 TODO(loc, "intrinsic: " + llvm::Twine(name.upper()));
1636}
1637
1638template <typename GeneratorType>
1639fir::ExtendedValue IntrinsicLibrary::genElementalCall(
1640 GeneratorType generator, llvm::StringRef name, mlir::Type resultType,
1641 llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
1642 llvm::SmallVector<mlir::Value> scalarArgs;
1643 for (const fir::ExtendedValue &arg : args)
1644 if (arg.getUnboxed() || arg.getCharBox())
1645 scalarArgs.emplace_back(fir::getBase(arg));
1646 else
1647 fir::emitFatalError(loc, "nonscalar intrinsic argument");
1648 if (outline)
1649 return outlineInWrapper(generator, name, resultType, scalarArgs);
1650 return invokeGenerator(generator, resultType, scalarArgs);
1651}
1652
1653template <>
1654fir::ExtendedValue
1655IntrinsicLibrary::genElementalCall<IntrinsicLibrary::ExtendedGenerator>(
1656 ExtendedGenerator generator, llvm::StringRef name, mlir::Type resultType,
1657 llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
1658 for (const fir::ExtendedValue &arg : args) {
1659 auto *box = arg.getBoxOf<fir::BoxValue>();
1660 if (!arg.getUnboxed() && !arg.getCharBox() &&
1661 !(box && fir::isScalarBoxedRecordType(fir::getBase(*box).getType())))
1662 fir::emitFatalError(loc, "nonscalar intrinsic argument");
1663 }
1664 if (outline)
1665 return outlineInExtendedWrapper(generator, name, resultType, args);
1666 return std::invoke(generator, *this, resultType, args);
1667}
1668
1669template <>
1670fir::ExtendedValue
1671IntrinsicLibrary::genElementalCall<IntrinsicLibrary::SubroutineGenerator>(
1672 SubroutineGenerator generator, llvm::StringRef name, mlir::Type resultType,
1673 llvm::ArrayRef<fir::ExtendedValue> args, bool outline) {
1674 for (const fir::ExtendedValue &arg : args)
1675 if (!arg.getUnboxed() && !arg.getCharBox())
1676 // fir::emitFatalError(loc, "nonscalar intrinsic argument");
1677 crashOnMissingIntrinsic(loc, name);
1678 if (outline)
1679 return outlineInExtendedWrapper(generator, name, resultType, args);
1680 std::invoke(generator, *this, args);
1681 return mlir::Value();
1682}
1683
1684static fir::ExtendedValue
1685invokeHandler(IntrinsicLibrary::ElementalGenerator generator,
1686 const IntrinsicHandler &handler,
1687 std::optional<mlir::Type> resultType,
1688 llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
1689 IntrinsicLibrary &lib) {
1690 assert(resultType && "expect elemental intrinsic to be functions");
1691 return lib.genElementalCall(generator, handler.name, *resultType, args,
1692 outline);
1693}
1694
1695static fir::ExtendedValue
1696invokeHandler(IntrinsicLibrary::ExtendedGenerator generator,
1697 const IntrinsicHandler &handler,
1698 std::optional<mlir::Type> resultType,
1699 llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
1700 IntrinsicLibrary &lib) {
1701 assert(resultType && "expect intrinsic function");
1702 if (handler.isElemental)
1703 return lib.genElementalCall(generator, handler.name, *resultType, args,
1704 outline);
1705 if (outline)
1706 return lib.outlineInExtendedWrapper(generator, handler.name, *resultType,
1707 args);
1708 return std::invoke(generator, lib, *resultType, args);
1709}
1710
1711static fir::ExtendedValue
1712invokeHandler(IntrinsicLibrary::SubroutineGenerator generator,
1713 const IntrinsicHandler &handler,
1714 std::optional<mlir::Type> resultType,
1715 llvm::ArrayRef<fir::ExtendedValue> args, bool outline,
1716 IntrinsicLibrary &lib) {
1717 if (handler.isElemental)
1718 return lib.genElementalCall(generator, handler.name, mlir::Type{}, args,
1719 outline);
1720 if (outline)
1721 return lib.outlineInExtendedWrapper(generator, handler.name, resultType,
1722 args);
1723 std::invoke(generator, lib, args);
1724 return mlir::Value{};
1725}
1726
1727std::pair<fir::ExtendedValue, bool>
1728IntrinsicLibrary::genIntrinsicCall(llvm::StringRef specificName,
1729 std::optional<mlir::Type> resultType,
1730 llvm::ArrayRef<fir::ExtendedValue> args) {
1731 llvm::StringRef name = genericName(specificName);
1732 if (const IntrinsicHandler *handler = findIntrinsicHandler(name)) {
1733 bool outline = handler->outline || outlineAllIntrinsics;
1734 return {std::visit(
1735 [&](auto &generator) -> fir::ExtendedValue {
1736 return invokeHandler(generator, *handler, resultType, args,
1737 outline, *this);
1738 },
1739 handler->generator),
1740 this->resultMustBeFreed};
1741 }
1742
1743 // If targeting PowerPC, check PPC intrinsic handlers.
1744 auto mod = builder.getModule();
1745 if (fir::getTargetTriple(mod).isPPC()) {
1746 if (const IntrinsicHandler *ppcHandler = findPPCIntrinsicHandler(name)) {
1747 bool outline = ppcHandler->outline || outlineAllIntrinsics;
1748 return {std::visit(
1749 [&](auto &generator) -> fir::ExtendedValue {
1750 return invokeHandler(generator, *ppcHandler, resultType,
1751 args, outline, *this);
1752 },
1753 ppcHandler->generator),
1754 this->resultMustBeFreed};
1755 }
1756 }
1757
1758 // Try the runtime if no special handler was defined for the
1759 // intrinsic being called. Maths runtime only has numerical elemental.
1760 // No optional arguments are expected at this point, the code will
1761 // crash if it gets absent optional.
1762
1763 if (!resultType)
1764 // Subroutine should have a handler, they are likely missing for now.
1765 crashOnMissingIntrinsic(loc, name);
1766
1767 // FIXME: using toValue to get the type won't work with array arguments.
1768 llvm::SmallVector<mlir::Value> mlirArgs;
1769 for (const fir::ExtendedValue &extendedVal : args) {
1770 mlir::Value val = toValue(extendedVal, builder, loc);
1771 if (!val)
1772 // If an absent optional gets there, most likely its handler has just
1773 // not yet been defined.
1774 crashOnMissingIntrinsic(loc, name);
1775 mlirArgs.emplace_back(val);
1776 }
1777 mlir::FunctionType soughtFuncType =
1778 getFunctionType(*resultType, mlirArgs, builder);
1779
1780 IntrinsicLibrary::RuntimeCallGenerator runtimeCallGenerator =
1781 getRuntimeCallGenerator(name, soughtFuncType);
1782 return {genElementalCall(runtimeCallGenerator, name, *resultType, args,
1783 /*outline=*/outlineAllIntrinsics),
1784 resultMustBeFreed};
1785}
1786
1787mlir::Value
1788IntrinsicLibrary::invokeGenerator(ElementalGenerator generator,
1789 mlir::Type resultType,
1790 llvm::ArrayRef<mlir::Value> args) {
1791 return std::invoke(generator, *this, resultType, args);
1792}
1793
1794mlir::Value
1795IntrinsicLibrary::invokeGenerator(RuntimeCallGenerator generator,
1796 mlir::Type resultType,
1797 llvm::ArrayRef<mlir::Value> args) {
1798 return generator(builder, loc, args);
1799}
1800
1801mlir::Value
1802IntrinsicLibrary::invokeGenerator(ExtendedGenerator generator,
1803 mlir::Type resultType,
1804 llvm::ArrayRef<mlir::Value> args) {
1805 llvm::SmallVector<fir::ExtendedValue> extendedArgs;
1806 for (mlir::Value arg : args)
1807 extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
1808 auto extendedResult = std::invoke(generator, *this, resultType, extendedArgs);
1809 return toValue(extendedResult, builder, loc);
1810}
1811
1812mlir::Value
1813IntrinsicLibrary::invokeGenerator(SubroutineGenerator generator,
1814 llvm::ArrayRef<mlir::Value> args) {
1815 llvm::SmallVector<fir::ExtendedValue> extendedArgs;
1816 for (mlir::Value arg : args)
1817 extendedArgs.emplace_back(toExtendedValue(arg, builder, loc));
1818 std::invoke(generator, *this, extendedArgs);
1819 return {};
1820}
1821
1822//===----------------------------------------------------------------------===//
1823// Intrinsic Procedure Mangling
1824//===----------------------------------------------------------------------===//
1825
1826/// Helper to encode type into string for intrinsic procedure names.
1827/// Note: mlir has Type::dump(ostream) methods but it may add "!" that is not
1828/// suitable for function names.
1829static std::string typeToString(mlir::Type t) {
1830 if (auto refT{t.dyn_cast<fir::ReferenceType>()})
1831 return "ref_" + typeToString(refT.getEleTy());
1832 if (auto i{t.dyn_cast<mlir::IntegerType>()}) {
1833 return "i" + std::to_string(i.getWidth());
1834 }
1835 if (auto cplx{t.dyn_cast<fir::ComplexType>()}) {
1836 return "z" + std::to_string(cplx.getFKind());
1837 }
1838 if (auto real{t.dyn_cast<fir::RealType>()}) {
1839 return "r" + std::to_string(real.getFKind());
1840 }
1841 if (auto f{t.dyn_cast<mlir::FloatType>()}) {
1842 return "f" + std::to_string(val: f.getWidth());
1843 }
1844 if (auto logical{t.dyn_cast<fir::LogicalType>()}) {
1845 return "l" + std::to_string(logical.getFKind());
1846 }
1847 if (auto character{t.dyn_cast<fir::CharacterType>()}) {
1848 return "c" + std::to_string(character.getFKind());
1849 }
1850 if (auto boxCharacter{t.dyn_cast<fir::BoxCharType>()}) {
1851 return "bc" + std::to_string(boxCharacter.getEleTy().getFKind());
1852 }
1853 llvm_unreachable("no mangling for type");
1854}
1855
1856/// Returns a name suitable to define mlir functions for Fortran intrinsic
1857/// Procedure. These names are guaranteed to not conflict with user defined
1858/// procedures. This is needed to implement Fortran generic intrinsics as
1859/// several mlir functions specialized for the argument types.
1860/// The result is guaranteed to be distinct for different mlir::FunctionType
1861/// arguments. The mangling pattern is:
1862/// fir.<generic name>.<result type>.<arg type>...
1863/// e.g ACOS(COMPLEX(4)) is mangled as fir.acos.z4.z4
1864/// For subroutines no result type is return but in order to still provide
1865/// a unique mangled name, we use "void" as the return type. As in:
1866/// fir.<generic name>.void.<arg type>...
1867/// e.g. FREE(INTEGER(4)) is mangled as fir.free.void.i4
1868static std::string mangleIntrinsicProcedure(llvm::StringRef intrinsic,
1869 mlir::FunctionType funTy) {
1870 std::string name = "fir.";
1871 name.append(str: intrinsic.str()).append(s: ".");
1872 if (funTy.getNumResults() == 1)
1873 name.append(typeToString(funTy.getResult(0)));
1874 else if (funTy.getNumResults() == 0)
1875 name.append(s: "void");
1876 else
1877 llvm_unreachable("more than one result value for function");
1878 unsigned e = funTy.getNumInputs();
1879 for (decltype(e) i = 0; i < e; ++i)
1880 name.append(s: ".").append(typeToString(funTy.getInput(i)));
1881 return name;
1882}
1883
1884template <typename GeneratorType>
1885mlir::func::FuncOp IntrinsicLibrary::getWrapper(GeneratorType generator,
1886 llvm::StringRef name,
1887 mlir::FunctionType funcType,
1888 bool loadRefArguments) {
1889 std::string wrapperName = mangleIntrinsicProcedure(name, funcType);
1890 mlir::func::FuncOp function = builder.getNamedFunction(wrapperName);
1891 if (!function) {
1892 // First time this wrapper is needed, build it.
1893 function = builder.createFunction(loc, wrapperName, funcType);
1894 function->setAttr("fir.intrinsic", builder.getUnitAttr());
1895 fir::factory::setInternalLinkage(function);
1896 function.addEntryBlock();
1897
1898 // Create local context to emit code into the newly created function
1899 // This new function is not linked to a source file location, only
1900 // its calls will be.
1901 auto localBuilder = std::make_unique<fir::FirOpBuilder>(
1902 function, builder.getKindMap(), builder.getMLIRSymbolTable());
1903 localBuilder->setFastMathFlags(builder.getFastMathFlags());
1904 localBuilder->setInsertionPointToStart(&function.front());
1905 // Location of code inside wrapper of the wrapper is independent from
1906 // the location of the intrinsic call.
1907 mlir::Location localLoc = localBuilder->getUnknownLoc();
1908 llvm::SmallVector<mlir::Value> localArguments;
1909 for (mlir::BlockArgument bArg : function.front().getArguments()) {
1910 auto refType = bArg.getType().dyn_cast<fir::ReferenceType>();
1911 if (loadRefArguments && refType) {
1912 auto loaded = localBuilder->create<fir::LoadOp>(localLoc, bArg);
1913 localArguments.push_back(loaded);
1914 } else {
1915 localArguments.push_back(bArg);
1916 }
1917 }
1918
1919 IntrinsicLibrary localLib{*localBuilder, localLoc};
1920
1921 if constexpr (std::is_same_v<GeneratorType, SubroutineGenerator>) {
1922 localLib.invokeGenerator(generator, localArguments);
1923 localBuilder->create<mlir::func::ReturnOp>(localLoc);
1924 } else {
1925 assert(funcType.getNumResults() == 1 &&
1926 "expect one result for intrinsic function wrapper type");
1927 mlir::Type resultType = funcType.getResult(0);
1928 auto result =
1929 localLib.invokeGenerator(generator, resultType, localArguments);
1930 localBuilder->create<mlir::func::ReturnOp>(localLoc, result);
1931 }
1932 } else {
1933 // Wrapper was already built, ensure it has the sought type
1934 assert(function.getFunctionType() == funcType &&
1935 "conflict between intrinsic wrapper types");
1936 }
1937 return function;
1938}
1939
1940/// Helpers to detect absent optional (not yet supported in outlining).
1941bool static hasAbsentOptional(llvm::ArrayRef<mlir::Value> args) {
1942 for (const mlir::Value &arg : args)
1943 if (!arg)
1944 return true;
1945 return false;
1946}
1947bool static hasAbsentOptional(llvm::ArrayRef<fir::ExtendedValue> args) {
1948 for (const fir::ExtendedValue &arg : args)
1949 if (!fir::getBase(arg))
1950 return true;
1951 return false;
1952}
1953
1954template <typename GeneratorType>
1955mlir::Value
1956IntrinsicLibrary::outlineInWrapper(GeneratorType generator,
1957 llvm::StringRef name, mlir::Type resultType,
1958 llvm::ArrayRef<mlir::Value> args) {
1959 if (hasAbsentOptional(args)) {
1960 // TODO: absent optional in outlining is an issue: we cannot just ignore
1961 // them. Needs a better interface here. The issue is that we cannot easily
1962 // tell that a value is optional or not here if it is presents. And if it is
1963 // absent, we cannot tell what it type should be.
1964 TODO(loc, "cannot outline call to intrinsic " + llvm::Twine(name) +
1965 " with absent optional argument");
1966 }
1967
1968 mlir::FunctionType funcType = getFunctionType(resultType, args, builder);
1969 std::string funcName{name};
1970 llvm::raw_string_ostream nameOS{funcName};
1971 if (std::string fmfString{builder.getFastMathFlagsString()};
1972 !fmfString.empty()) {
1973 nameOS << '.' << fmfString;
1974 }
1975 mlir::func::FuncOp wrapper = getWrapper(generator, funcName, funcType);
1976 return builder.create<fir::CallOp>(loc, wrapper, args).getResult(0);
1977}
1978
1979template <typename GeneratorType>
1980fir::ExtendedValue IntrinsicLibrary::outlineInExtendedWrapper(
1981 GeneratorType generator, llvm::StringRef name,
1982 std::optional<mlir::Type> resultType,
1983 llvm::ArrayRef<fir::ExtendedValue> args) {
1984 if (hasAbsentOptional(args))
1985 TODO(loc, "cannot outline call to intrinsic " + llvm::Twine(name) +
1986 " with absent optional argument");
1987 llvm::SmallVector<mlir::Value> mlirArgs;
1988 for (const auto &extendedVal : args)
1989 mlirArgs.emplace_back(toValue(extendedVal, builder, loc));
1990 mlir::FunctionType funcType = getFunctionType(resultType, mlirArgs, builder);
1991 mlir::func::FuncOp wrapper = getWrapper(generator, name, funcType);
1992 auto call = builder.create<fir::CallOp>(loc, wrapper, mlirArgs);
1993 if (resultType)
1994 return toExtendedValue(call.getResult(0), builder, loc);
1995 // Subroutine calls
1996 return mlir::Value{};
1997}
1998
1999IntrinsicLibrary::RuntimeCallGenerator
2000IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name,
2001 mlir::FunctionType soughtFuncType) {
2002 mlir::FunctionType actualFuncType;
2003 const MathOperation *mathOp = nullptr;
2004
2005 // Look for a dedicated math operation generator, which
2006 // normally produces a single MLIR operation implementing
2007 // the math operation.
2008 const MathOperation *bestNearMatch = nullptr;
2009 FunctionDistance bestMatchDistance;
2010 mathOp = searchMathOperation(builder, name, soughtFuncType, &bestNearMatch,
2011 bestMatchDistance);
2012 if (!mathOp && bestNearMatch) {
2013 // Use the best near match, optionally issuing an error,
2014 // if types conversions cause precision loss.
2015 checkPrecisionLoss(name, soughtFuncType, bestMatchDistance, builder, loc);
2016 mathOp = bestNearMatch;
2017 }
2018
2019 if (!mathOp) {
2020 std::string nameAndType;
2021 llvm::raw_string_ostream sstream(nameAndType);
2022 sstream << name << "\nrequested type: " << soughtFuncType;
2023 crashOnMissingIntrinsic(loc, nameAndType);
2024 }
2025
2026 actualFuncType = mathOp->typeGenerator(builder.getContext(), builder);
2027
2028 assert(actualFuncType.getNumResults() == soughtFuncType.getNumResults() &&
2029 actualFuncType.getNumInputs() == soughtFuncType.getNumInputs() &&
2030 actualFuncType.getNumResults() == 1 && "Bad intrinsic match");
2031
2032 return [actualFuncType, mathOp,
2033 soughtFuncType](fir::FirOpBuilder &builder, mlir::Location loc,
2034 llvm::ArrayRef<mlir::Value> args) {
2035 llvm::SmallVector<mlir::Value> convertedArguments;
2036 for (auto [fst, snd] : llvm::zip(actualFuncType.getInputs(), args))
2037 convertedArguments.push_back(builder.createConvert(loc, fst, snd));
2038 mlir::Value result = mathOp->funcGenerator(
2039 builder, loc, *mathOp, actualFuncType, convertedArguments);
2040 mlir::Type soughtType = soughtFuncType.getResult(0);
2041 return builder.createConvert(loc, soughtType, result);
2042 };
2043}
2044
2045mlir::SymbolRefAttr IntrinsicLibrary::getUnrestrictedIntrinsicSymbolRefAttr(
2046 llvm::StringRef name, mlir::FunctionType signature) {
2047 // Unrestricted intrinsics signature follows implicit rules: argument
2048 // are passed by references. But the runtime versions expect values.
2049 // So instead of duplicating the runtime, just have the wrappers loading
2050 // this before calling the code generators.
2051 bool loadRefArguments = true;
2052 mlir::func::FuncOp funcOp;
2053 if (const IntrinsicHandler *handler = findIntrinsicHandler(name))
2054 funcOp = std::visit(
2055 [&](auto generator) {
2056 return getWrapper(generator, name, signature, loadRefArguments);
2057 },
2058 handler->generator);
2059
2060 if (!funcOp) {
2061 llvm::SmallVector<mlir::Type> argTypes;
2062 for (mlir::Type type : signature.getInputs()) {
2063 if (auto refType = type.dyn_cast<fir::ReferenceType>())
2064 argTypes.push_back(refType.getEleTy());
2065 else
2066 argTypes.push_back(type);
2067 }
2068 mlir::FunctionType soughtFuncType =
2069 builder.getFunctionType(argTypes, signature.getResults());
2070 IntrinsicLibrary::RuntimeCallGenerator rtCallGenerator =
2071 getRuntimeCallGenerator(name, soughtFuncType);
2072 funcOp = getWrapper(rtCallGenerator, name, signature, loadRefArguments);
2073 }
2074
2075 return mlir::SymbolRefAttr::get(funcOp);
2076}
2077
2078fir::ExtendedValue
2079IntrinsicLibrary::readAndAddCleanUp(fir::MutableBoxValue resultMutableBox,
2080 mlir::Type resultType,
2081 llvm::StringRef intrinsicName) {
2082 fir::ExtendedValue res =
2083 fir::factory::genMutableBoxRead(builder, loc, resultMutableBox);
2084 return res.match(
2085 [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
2086 setResultMustBeFreed();
2087 return box;
2088 },
2089 [&](const fir::BoxValue &box) -> fir::ExtendedValue {
2090 setResultMustBeFreed();
2091 return box;
2092 },
2093 [&](const fir::CharArrayBoxValue &box) -> fir::ExtendedValue {
2094 setResultMustBeFreed();
2095 return box;
2096 },
2097 [&](const mlir::Value &tempAddr) -> fir::ExtendedValue {
2098 auto load = builder.create<fir::LoadOp>(loc, resultType, tempAddr);
2099 // Temp can be freed right away since it was loaded.
2100 builder.create<fir::FreeMemOp>(loc, tempAddr);
2101 return load;
2102 },
2103 [&](const fir::CharBoxValue &box) -> fir::ExtendedValue {
2104 setResultMustBeFreed();
2105 return box;
2106 },
2107 [&](const auto &) -> fir::ExtendedValue {
2108 fir::emitFatalError(loc, "unexpected result for " + intrinsicName);
2109 });
2110}
2111
2112//===----------------------------------------------------------------------===//
2113// Code generators for the intrinsic
2114//===----------------------------------------------------------------------===//
2115
2116mlir::Value IntrinsicLibrary::genRuntimeCall(llvm::StringRef name,
2117 mlir::Type resultType,
2118 llvm::ArrayRef<mlir::Value> args) {
2119 mlir::FunctionType soughtFuncType =
2120 getFunctionType(resultType, args, builder);
2121 return getRuntimeCallGenerator(name, soughtFuncType)(builder, loc, args);
2122}
2123
2124mlir::Value IntrinsicLibrary::genConversion(mlir::Type resultType,
2125 llvm::ArrayRef<mlir::Value> args) {
2126 // There can be an optional kind in second argument.
2127 assert(args.size() >= 1);
2128 return builder.convertWithSemantics(loc, resultType, args[0]);
2129}
2130
2131// ABORT
2132void IntrinsicLibrary::genAbort(llvm::ArrayRef<fir::ExtendedValue> args) {
2133 assert(args.size() == 0);
2134 fir::runtime::genAbort(builder, loc);
2135}
2136
2137// ABS
2138mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType,
2139 llvm::ArrayRef<mlir::Value> args) {
2140 assert(args.size() == 1);
2141 mlir::Value arg = args[0];
2142 mlir::Type type = arg.getType();
2143 if (fir::isa_real(type) || fir::isa_complex(type)) {
2144 // Runtime call to fp abs. An alternative would be to use mlir
2145 // math::AbsFOp but it does not support all fir floating point types.
2146 return genRuntimeCall("abs", resultType, args);
2147 }
2148 if (auto intType = type.dyn_cast<mlir::IntegerType>()) {
2149 // At the time of this implementation there is no abs op in mlir.
2150 // So, implement abs here without branching.
2151 mlir::Value shift =
2152 builder.createIntegerConstant(loc, intType, intType.getWidth() - 1);
2153 auto mask = builder.create<mlir::arith::ShRSIOp>(loc, arg, shift);
2154 auto xored = builder.create<mlir::arith::XOrIOp>(loc, arg, mask);
2155 return builder.create<mlir::arith::SubIOp>(loc, xored, mask);
2156 }
2157 llvm_unreachable("unexpected type in ABS argument");
2158}
2159
2160// ACOSD
2161mlir::Value IntrinsicLibrary::genAcosd(mlir::Type resultType,
2162 llvm::ArrayRef<mlir::Value> args) {
2163 assert(args.size() == 1);
2164 mlir::MLIRContext *context = builder.getContext();
2165 mlir::FunctionType ftype =
2166 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});
2167 llvm::APFloat pi = llvm::APFloat(llvm::numbers::pi);
2168 mlir::Value dfactor = builder.createRealConstant(
2169 loc, mlir::FloatType::getF64(context), pi / llvm::APFloat(180.0));
2170 mlir::Value factor = builder.createConvert(loc, args[0].getType(), dfactor);
2171 mlir::Value arg = builder.create<mlir::arith::MulFOp>(loc, args[0], factor);
2172 return getRuntimeCallGenerator("acos", ftype)(builder, loc, {arg});
2173}
2174
2175// ADJUSTL & ADJUSTR
2176template <void (*CallRuntime)(fir::FirOpBuilder &, mlir::Location loc,
2177 mlir::Value, mlir::Value)>
2178fir::ExtendedValue
2179IntrinsicLibrary::genAdjustRtCall(mlir::Type resultType,
2180 llvm::ArrayRef<fir::ExtendedValue> args) {
2181 assert(args.size() == 1);
2182 mlir::Value string = builder.createBox(loc, args[0]);
2183 // Create a mutable fir.box to be passed to the runtime for the result.
2184 fir::MutableBoxValue resultMutableBox =
2185 fir::factory::createTempMutableBox(builder, loc, resultType);
2186 mlir::Value resultIrBox =
2187 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2188
2189 // Call the runtime -- the runtime will allocate the result.
2190 CallRuntime(builder, loc, resultIrBox, string);
2191 // Read result from mutable fir.box and add it to the list of temps to be
2192 // finalized by the StatementContext.
2193 return readAndAddCleanUp(resultMutableBox, resultType, "ADJUSTL or ADJUSTR");
2194}
2195
2196// AIMAG
2197mlir::Value IntrinsicLibrary::genAimag(mlir::Type resultType,
2198 llvm::ArrayRef<mlir::Value> args) {
2199 assert(args.size() == 1);
2200 return fir::factory::Complex{builder, loc}.extractComplexPart(
2201 args[0], /*isImagPart=*/true);
2202}
2203
2204// AINT
2205mlir::Value IntrinsicLibrary::genAint(mlir::Type resultType,
2206 llvm::ArrayRef<mlir::Value> args) {
2207 assert(args.size() >= 1 && args.size() <= 2);
2208 // Skip optional kind argument to search the runtime; it is already reflected
2209 // in result type.
2210 return genRuntimeCall("aint", resultType, {args[0]});
2211}
2212
2213// ALL
2214fir::ExtendedValue
2215IntrinsicLibrary::genAll(mlir::Type resultType,
2216 llvm::ArrayRef<fir::ExtendedValue> args) {
2217
2218 assert(args.size() == 2);
2219 // Handle required mask argument
2220 mlir::Value mask = builder.createBox(loc, args[0]);
2221
2222 fir::BoxValue maskArry = builder.createBox(loc, args[0]);
2223 int rank = maskArry.rank();
2224 assert(rank >= 1);
2225
2226 // Handle optional dim argument
2227 bool absentDim = isStaticallyAbsent(args[1]);
2228 mlir::Value dim =
2229 absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
2230 : fir::getBase(args[1]);
2231
2232 if (rank == 1 || absentDim)
2233 return builder.createConvert(loc, resultType,
2234 fir::runtime::genAll(builder, loc, mask, dim));
2235
2236 // else use the result descriptor AllDim() intrinsic
2237
2238 // Create mutable fir.box to be passed to the runtime for the result.
2239
2240 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
2241 fir::MutableBoxValue resultMutableBox =
2242 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2243 mlir::Value resultIrBox =
2244 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2245 // Call runtime. The runtime is allocating the result.
2246 fir::runtime::genAllDescriptor(builder, loc, resultIrBox, mask, dim);
2247 return readAndAddCleanUp(resultMutableBox, resultType, "ALL");
2248}
2249
2250// ALLOCATED
2251fir::ExtendedValue
2252IntrinsicLibrary::genAllocated(mlir::Type resultType,
2253 llvm::ArrayRef<fir::ExtendedValue> args) {
2254 assert(args.size() == 1);
2255 return args[0].match(
2256 [&](const fir::MutableBoxValue &x) -> fir::ExtendedValue {
2257 return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, x);
2258 },
2259 [&](const auto &) -> fir::ExtendedValue {
2260 fir::emitFatalError(loc,
2261 "allocated arg not lowered to MutableBoxValue");
2262 });
2263}
2264
2265// ANINT
2266mlir::Value IntrinsicLibrary::genAnint(mlir::Type resultType,
2267 llvm::ArrayRef<mlir::Value> args) {
2268 assert(args.size() >= 1 && args.size() <= 2);
2269 // Skip optional kind argument to search the runtime; it is already reflected
2270 // in result type.
2271 return genRuntimeCall("anint", resultType, {args[0]});
2272}
2273
2274// ANY
2275fir::ExtendedValue
2276IntrinsicLibrary::genAny(mlir::Type resultType,
2277 llvm::ArrayRef<fir::ExtendedValue> args) {
2278
2279 assert(args.size() == 2);
2280 // Handle required mask argument
2281 mlir::Value mask = builder.createBox(loc, args[0]);
2282
2283 fir::BoxValue maskArry = builder.createBox(loc, args[0]);
2284 int rank = maskArry.rank();
2285 assert(rank >= 1);
2286
2287 // Handle optional dim argument
2288 bool absentDim = isStaticallyAbsent(args[1]);
2289 mlir::Value dim =
2290 absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
2291 : fir::getBase(args[1]);
2292
2293 if (rank == 1 || absentDim)
2294 return builder.createConvert(loc, resultType,
2295 fir::runtime::genAny(builder, loc, mask, dim));
2296
2297 // else use the result descriptor AnyDim() intrinsic
2298
2299 // Create mutable fir.box to be passed to the runtime for the result.
2300
2301 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
2302 fir::MutableBoxValue resultMutableBox =
2303 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2304 mlir::Value resultIrBox =
2305 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2306 // Call runtime. The runtime is allocating the result.
2307 fir::runtime::genAnyDescriptor(builder, loc, resultIrBox, mask, dim);
2308 return readAndAddCleanUp(resultMutableBox, resultType, "ANY");
2309}
2310
2311// ASIND
2312mlir::Value IntrinsicLibrary::genAsind(mlir::Type resultType,
2313 llvm::ArrayRef<mlir::Value> args) {
2314 assert(args.size() == 1);
2315 mlir::MLIRContext *context = builder.getContext();
2316 mlir::FunctionType ftype =
2317 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});
2318 llvm::APFloat pi = llvm::APFloat(llvm::numbers::pi);
2319 mlir::Value dfactor = builder.createRealConstant(
2320 loc, mlir::FloatType::getF64(context), pi / llvm::APFloat(180.0));
2321 mlir::Value factor = builder.createConvert(loc, args[0].getType(), dfactor);
2322 mlir::Value arg = builder.create<mlir::arith::MulFOp>(loc, args[0], factor);
2323 return getRuntimeCallGenerator("asin", ftype)(builder, loc, {arg});
2324}
2325
2326// ATAND, ATAN2D
2327mlir::Value IntrinsicLibrary::genAtand(mlir::Type resultType,
2328 llvm::ArrayRef<mlir::Value> args) {
2329 // assert for: atand(X), atand(Y,X), atan2d(Y,X)
2330 assert(args.size() >= 1 && args.size() <= 2);
2331
2332 mlir::MLIRContext *context = builder.getContext();
2333 mlir::Value atan;
2334
2335 // atand = atan * 180/pi
2336 if (args.size() == 2) {
2337 atan = builder.create<mlir::math::Atan2Op>(loc, fir::getBase(args[0]),
2338 fir::getBase(args[1]));
2339 } else {
2340 mlir::FunctionType ftype =
2341 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});
2342 atan = getRuntimeCallGenerator("atan", ftype)(builder, loc, args);
2343 }
2344 llvm::APFloat pi = llvm::APFloat(llvm::numbers::pi);
2345 mlir::Value dfactor = builder.createRealConstant(
2346 loc, mlir::FloatType::getF64(context), llvm::APFloat(180.0) / pi);
2347 mlir::Value factor = builder.createConvert(loc, resultType, dfactor);
2348 return builder.create<mlir::arith::MulFOp>(loc, atan, factor);
2349}
2350
2351// ATANPI, ATAN2PI
2352mlir::Value IntrinsicLibrary::genAtanpi(mlir::Type resultType,
2353 llvm::ArrayRef<mlir::Value> args) {
2354 // assert for: atanpi(X), atanpi(Y,X), atan2pi(Y,X)
2355 assert(args.size() >= 1 && args.size() <= 2);
2356
2357 mlir::Value atan;
2358 mlir::MLIRContext *context = builder.getContext();
2359
2360 // atanpi = atan / pi
2361 if (args.size() == 2) {
2362 atan = builder.create<mlir::math::Atan2Op>(loc, fir::getBase(args[0]),
2363 fir::getBase(args[1]));
2364 } else {
2365 mlir::FunctionType ftype =
2366 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});
2367 atan = getRuntimeCallGenerator("atan", ftype)(builder, loc, args);
2368 }
2369 llvm::APFloat inv_pi = llvm::APFloat(llvm::numbers::inv_pi);
2370 mlir::Value dfactor =
2371 builder.createRealConstant(loc, mlir::FloatType::getF64(context), inv_pi);
2372 mlir::Value factor = builder.createConvert(loc, resultType, dfactor);
2373 return builder.create<mlir::arith::MulFOp>(loc, atan, factor);
2374}
2375
2376// ASSOCIATED
2377fir::ExtendedValue
2378IntrinsicLibrary::genAssociated(mlir::Type resultType,
2379 llvm::ArrayRef<fir::ExtendedValue> args) {
2380 assert(args.size() == 2);
2381 mlir::Type ptrTy = fir::getBase(args[0]).getType();
2382 if (ptrTy &&
2383 (fir::isBoxProcAddressType(ptrTy) || ptrTy.isa<fir::BoxProcType>())) {
2384 mlir::Value pointerBoxProc =
2385 fir::isBoxProcAddressType(ptrTy)
2386 ? builder.create<fir::LoadOp>(loc, fir::getBase(args[0]))
2387 : fir::getBase(args[0]);
2388 mlir::Value pointerTarget =
2389 builder.create<fir::BoxAddrOp>(loc, pointerBoxProc);
2390 if (isStaticallyAbsent(args[1]))
2391 return builder.genIsNotNullAddr(loc, pointerTarget);
2392 mlir::Value target = fir::getBase(args[1]);
2393 if (fir::isBoxProcAddressType(target.getType()))
2394 target = builder.create<fir::LoadOp>(loc, target);
2395 if (target.getType().isa<fir::BoxProcType>())
2396 target = builder.create<fir::BoxAddrOp>(loc, target);
2397 mlir::Type intPtrTy = builder.getIntPtrType();
2398 mlir::Value pointerInt =
2399 builder.createConvert(loc, intPtrTy, pointerTarget);
2400 mlir::Value targetInt = builder.createConvert(loc, intPtrTy, target);
2401 mlir::Value sameTarget = builder.create<mlir::arith::CmpIOp>(
2402 loc, mlir::arith::CmpIPredicate::eq, pointerInt, targetInt);
2403 mlir::Value zero = builder.createIntegerConstant(loc, intPtrTy, 0);
2404 mlir::Value notNull = builder.create<mlir::arith::CmpIOp>(
2405 loc, mlir::arith::CmpIPredicate::ne, zero, pointerInt);
2406 // The not notNull test covers the following two cases:
2407 // - TARGET is a procedure that is OPTIONAL and absent at runtime.
2408 // - TARGET is a procedure pointer that is NULL.
2409 // In both cases, ASSOCIATED should be false if POINTER is NULL.
2410 return builder.create<mlir::arith::AndIOp>(loc, sameTarget, notNull);
2411 }
2412 auto *pointer =
2413 args[0].match([&](const fir::MutableBoxValue &x) { return &x; },
2414 [&](const auto &) -> const fir::MutableBoxValue * {
2415 fir::emitFatalError(loc, "pointer not a MutableBoxValue");
2416 });
2417 const fir::ExtendedValue &target = args[1];
2418 if (isStaticallyAbsent(target))
2419 return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, *pointer);
2420 mlir::Value targetBox = builder.createBox(loc, target);
2421 mlir::Value pointerBoxRef =
2422 fir::factory::getMutableIRBox(builder, loc, *pointer);
2423 auto pointerBox = builder.create<fir::LoadOp>(loc, pointerBoxRef);
2424 return fir::runtime::genAssociated(builder, loc, pointerBox, targetBox);
2425}
2426
2427// BESSEL_JN
2428fir::ExtendedValue
2429IntrinsicLibrary::genBesselJn(mlir::Type resultType,
2430 llvm::ArrayRef<fir::ExtendedValue> args) {
2431 assert(args.size() == 2 || args.size() == 3);
2432
2433 mlir::Value x = fir::getBase(args.back());
2434
2435 if (args.size() == 2) {
2436 mlir::Value n = fir::getBase(args[0]);
2437
2438 return genRuntimeCall("bessel_jn", resultType, {n, x});
2439 } else {
2440 mlir::Value n1 = fir::getBase(args[0]);
2441 mlir::Value n2 = fir::getBase(args[1]);
2442
2443 mlir::Type intTy = n1.getType();
2444 mlir::Type floatTy = x.getType();
2445 mlir::Value zero = builder.createRealZeroConstant(loc, floatTy);
2446 mlir::Value one = builder.createIntegerConstant(loc, intTy, 1);
2447
2448 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 1);
2449 fir::MutableBoxValue resultMutableBox =
2450 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2451 mlir::Value resultBox =
2452 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2453
2454 mlir::Value cmpXEq0 = builder.create<mlir::arith::CmpFOp>(
2455 loc, mlir::arith::CmpFPredicate::UEQ, x, zero);
2456 mlir::Value cmpN1LtN2 = builder.create<mlir::arith::CmpIOp>(
2457 loc, mlir::arith::CmpIPredicate::slt, n1, n2);
2458 mlir::Value cmpN1EqN2 = builder.create<mlir::arith::CmpIOp>(
2459 loc, mlir::arith::CmpIPredicate::eq, n1, n2);
2460
2461 auto genXEq0 = [&]() {
2462 fir::runtime::genBesselJnX0(builder, loc, floatTy, resultBox, n1, n2);
2463 };
2464
2465 auto genN1LtN2 = [&]() {
2466 // The runtime generates the values in the range using a backward
2467 // recursion from n2 to n1. (see https://dlmf.nist.gov/10.74.iv and
2468 // https://dlmf.nist.gov/10.6.E1). When n1 < n2, this requires
2469 // the values of BESSEL_JN(n2) and BESSEL_JN(n2 - 1) since they
2470 // are the anchors of the recursion.
2471 mlir::Value n2_1 = builder.create<mlir::arith::SubIOp>(loc, n2, one);
2472 mlir::Value bn2 = genRuntimeCall("bessel_jn", resultType, {n2, x});
2473 mlir::Value bn2_1 = genRuntimeCall("bessel_jn", resultType, {n2_1, x});
2474 fir::runtime::genBesselJn(builder, loc, resultBox, n1, n2, x, bn2, bn2_1);
2475 };
2476
2477 auto genN1EqN2 = [&]() {
2478 // When n1 == n2, only BESSEL_JN(n2) is needed.
2479 mlir::Value bn2 = genRuntimeCall("bessel_jn", resultType, {n2, x});
2480 fir::runtime::genBesselJn(builder, loc, resultBox, n1, n2, x, bn2, zero);
2481 };
2482
2483 auto genN1GtN2 = [&]() {
2484 // The standard requires n1 <= n2. However, we still need to allocate
2485 // a zero-length array and return it when n1 > n2, so we do need to call
2486 // the runtime function.
2487 fir::runtime::genBesselJn(builder, loc, resultBox, n1, n2, x, zero, zero);
2488 };
2489
2490 auto genN1GeN2 = [&] {
2491 builder.genIfThenElse(loc, cmpN1EqN2)
2492 .genThen(genN1EqN2)
2493 .genElse(genN1GtN2)
2494 .end();
2495 };
2496
2497 auto genXNeq0 = [&]() {
2498 builder.genIfThenElse(loc, cmpN1LtN2)
2499 .genThen(genN1LtN2)
2500 .genElse(genN1GeN2)
2501 .end();
2502 };
2503
2504 builder.genIfThenElse(loc, cmpXEq0)
2505 .genThen(genXEq0)
2506 .genElse(genXNeq0)
2507 .end();
2508 return readAndAddCleanUp(resultMutableBox, resultType, "BESSEL_JN");
2509 }
2510}
2511
2512// BESSEL_YN
2513fir::ExtendedValue
2514IntrinsicLibrary::genBesselYn(mlir::Type resultType,
2515 llvm::ArrayRef<fir::ExtendedValue> args) {
2516 assert(args.size() == 2 || args.size() == 3);
2517
2518 mlir::Value x = fir::getBase(args.back());
2519
2520 if (args.size() == 2) {
2521 mlir::Value n = fir::getBase(args[0]);
2522
2523 return genRuntimeCall("bessel_yn", resultType, {n, x});
2524 } else {
2525 mlir::Value n1 = fir::getBase(args[0]);
2526 mlir::Value n2 = fir::getBase(args[1]);
2527
2528 mlir::Type floatTy = x.getType();
2529 mlir::Type intTy = n1.getType();
2530 mlir::Value zero = builder.createRealZeroConstant(loc, floatTy);
2531 mlir::Value one = builder.createIntegerConstant(loc, intTy, 1);
2532
2533 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 1);
2534 fir::MutableBoxValue resultMutableBox =
2535 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
2536 mlir::Value resultBox =
2537 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2538
2539 mlir::Value cmpXEq0 = builder.create<mlir::arith::CmpFOp>(
2540 loc, mlir::arith::CmpFPredicate::UEQ, x, zero);
2541 mlir::Value cmpN1LtN2 = builder.create<mlir::arith::CmpIOp>(
2542 loc, mlir::arith::CmpIPredicate::slt, n1, n2);
2543 mlir::Value cmpN1EqN2 = builder.create<mlir::arith::CmpIOp>(
2544 loc, mlir::arith::CmpIPredicate::eq, n1, n2);
2545
2546 auto genXEq0 = [&]() {
2547 fir::runtime::genBesselYnX0(builder, loc, floatTy, resultBox, n1, n2);
2548 };
2549
2550 auto genN1LtN2 = [&]() {
2551 // The runtime generates the values in the range using a forward
2552 // recursion from n1 to n2. (see https://dlmf.nist.gov/10.74.iv and
2553 // https://dlmf.nist.gov/10.6.E1). When n1 < n2, this requires
2554 // the values of BESSEL_YN(n1) and BESSEL_YN(n1 + 1) since they
2555 // are the anchors of the recursion.
2556 mlir::Value n1_1 = builder.create<mlir::arith::AddIOp>(loc, n1, one);
2557 mlir::Value bn1 = genRuntimeCall("bessel_yn", resultType, {n1, x});
2558 mlir::Value bn1_1 = genRuntimeCall("bessel_yn", resultType, {n1_1, x});
2559 fir::runtime::genBesselYn(builder, loc, resultBox, n1, n2, x, bn1, bn1_1);
2560 };
2561
2562 auto genN1EqN2 = [&]() {
2563 // When n1 == n2, only BESSEL_YN(n1) is needed.
2564 mlir::Value bn1 = genRuntimeCall("bessel_yn", resultType, {n1, x});
2565 fir::runtime::genBesselYn(builder, loc, resultBox, n1, n2, x, bn1, zero);
2566 };
2567
2568 auto genN1GtN2 = [&]() {
2569 // The standard requires n1 <= n2. However, we still need to allocate
2570 // a zero-length array and return it when n1 > n2, so we do need to call
2571 // the runtime function.
2572 fir::runtime::genBesselYn(builder, loc, resultBox, n1, n2, x, zero, zero);
2573 };
2574
2575 auto genN1GeN2 = [&] {
2576 builder.genIfThenElse(loc, cmpN1EqN2)
2577 .genThen(genN1EqN2)
2578 .genElse(genN1GtN2)
2579 .end();
2580 };
2581
2582 auto genXNeq0 = [&]() {
2583 builder.genIfThenElse(loc, cmpN1LtN2)
2584 .genThen(genN1LtN2)
2585 .genElse(genN1GeN2)
2586 .end();
2587 };
2588
2589 builder.genIfThenElse(loc, cmpXEq0)
2590 .genThen(genXEq0)
2591 .genElse(genXNeq0)
2592 .end();
2593 return readAndAddCleanUp(resultMutableBox, resultType, "BESSEL_YN");
2594 }
2595}
2596
2597// BGE, BGT, BLE, BLT
2598template <mlir::arith::CmpIPredicate pred>
2599mlir::Value
2600IntrinsicLibrary::genBitwiseCompare(mlir::Type resultType,
2601 llvm::ArrayRef<mlir::Value> args) {
2602 assert(args.size() == 2);
2603
2604 mlir::Value arg0 = args[0];
2605 mlir::Value arg1 = args[1];
2606 mlir::Type arg0Ty = arg0.getType();
2607 mlir::Type arg1Ty = arg1.getType();
2608 unsigned bits0 = arg0Ty.getIntOrFloatBitWidth();
2609 unsigned bits1 = arg1Ty.getIntOrFloatBitWidth();
2610
2611 // Arguments do not have to be of the same integer type. However, if neither
2612 // of the arguments is a BOZ literal, then the shorter of the two needs
2613 // to be converted to the longer by zero-extending (not sign-extending)
2614 // to the left [Fortran 2008, 13.3.2].
2615 //
2616 // In the case of BOZ literals, the standard describes zero-extension or
2617 // truncation depending on the kind of the result [Fortran 2008, 13.3.3].
2618 // However, that seems to be relevant for the case where the type of the
2619 // result must match the type of the BOZ literal. That is not the case for
2620 // these intrinsics, so, again, zero-extend to the larger type.
2621 //
2622 if (bits0 > bits1)
2623 arg1 = builder.create<mlir::arith::ExtUIOp>(loc, arg0Ty, arg1);
2624 else if (bits0 < bits1)
2625 arg0 = builder.create<mlir::arith::ExtUIOp>(loc, arg1Ty, arg0);
2626
2627 return builder.create<mlir::arith::CmpIOp>(loc, pred, arg0, arg1);
2628}
2629
2630// BTEST
2631mlir::Value IntrinsicLibrary::genBtest(mlir::Type resultType,
2632 llvm::ArrayRef<mlir::Value> args) {
2633 // A conformant BTEST(I,POS) call satisfies:
2634 // POS >= 0
2635 // POS < BIT_SIZE(I)
2636 // Return: (I >> POS) & 1
2637 assert(args.size() == 2);
2638 mlir::Type argType = args[0].getType();
2639 mlir::Value pos = builder.createConvert(loc, argType, args[1]);
2640 auto shift = builder.create<mlir::arith::ShRUIOp>(loc, args[0], pos);
2641 mlir::Value one = builder.createIntegerConstant(loc, argType, 1);
2642 auto res = builder.create<mlir::arith::AndIOp>(loc, shift, one);
2643 return builder.createConvert(loc, resultType, res);
2644}
2645
2646static mlir::Value getAddrFromBox(fir::FirOpBuilder &builder,
2647 mlir::Location loc, fir::ExtendedValue arg,
2648 bool isFunc) {
2649 mlir::Value argValue = fir::getBase(arg);
2650 mlir::Value addr{nullptr};
2651 if (isFunc) {
2652 auto funcTy = argValue.getType().cast<fir::BoxProcType>().getEleTy();
2653 addr = builder.create<fir::BoxAddrOp>(loc, funcTy, argValue);
2654 } else {
2655 const auto *box = arg.getBoxOf<fir::BoxValue>();
2656 addr = builder.create<fir::BoxAddrOp>(loc, box->getMemTy(),
2657 fir::getBase(*box));
2658 }
2659 return addr;
2660}
2661
2662static fir::ExtendedValue
2663genCLocOrCFunLoc(fir::FirOpBuilder &builder, mlir::Location loc,
2664 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args,
2665 bool isFunc = false) {
2666 assert(args.size() == 1);
2667 mlir::Value res = builder.create<fir::AllocaOp>(loc, resultType);
2668 mlir::Value resAddr =
2669 fir::factory::genCPtrOrCFunptrAddr(builder, loc, res, resultType);
2670 assert(fir::isa_box_type(fir::getBase(args[0]).getType()) &&
2671 "argument must have been lowered to box type");
2672 mlir::Value argAddr = getAddrFromBox(builder, loc, args[0], isFunc);
2673 mlir::Value argAddrVal = builder.createConvert(
2674 loc, fir::unwrapRefType(resAddr.getType()), argAddr);
2675 builder.create<fir::StoreOp>(loc, argAddrVal, resAddr);
2676 return res;
2677}
2678
2679/// C_ASSOCIATED
2680static fir::ExtendedValue
2681genCAssociated(fir::FirOpBuilder &builder, mlir::Location loc,
2682 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {
2683 assert(args.size() == 2);
2684 mlir::Value cPtr1 = fir::getBase(args[0]);
2685 mlir::Value cPtrVal1 =
2686 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr1);
2687 mlir::Value zero = builder.createIntegerConstant(loc, cPtrVal1.getType(), 0);
2688 mlir::Value res = builder.create<mlir::arith::CmpIOp>(
2689 loc, mlir::arith::CmpIPredicate::ne, cPtrVal1, zero);
2690
2691 if (isStaticallyPresent(args[1])) {
2692 mlir::Type i1Ty = builder.getI1Type();
2693 mlir::Value cPtr2 = fir::getBase(args[1]);
2694 mlir::Value isDynamicallyAbsent = builder.genIsNullAddr(loc, cPtr2);
2695 res =
2696 builder
2697 .genIfOp(loc, {i1Ty}, isDynamicallyAbsent, /*withElseRegion=*/true)
2698 .genThen([&]() { builder.create<fir::ResultOp>(loc, res); })
2699 .genElse([&]() {
2700 mlir::Value cPtrVal2 =
2701 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr2);
2702 mlir::Value cmpVal = builder.create<mlir::arith::CmpIOp>(
2703 loc, mlir::arith::CmpIPredicate::eq, cPtrVal1, cPtrVal2);
2704 mlir::Value newRes =
2705 builder.create<mlir::arith::AndIOp>(loc, res, cmpVal);
2706 builder.create<fir::ResultOp>(loc, newRes);
2707 })
2708 .getResults()[0];
2709 }
2710 return builder.createConvert(loc, resultType, res);
2711}
2712
2713/// C_ASSOCIATED (C_FUNPTR [, C_FUNPTR])
2714fir::ExtendedValue IntrinsicLibrary::genCAssociatedCFunPtr(
2715 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {
2716 return genCAssociated(builder, loc, resultType, args);
2717}
2718
2719/// C_ASSOCIATED (C_PTR [, C_PTR])
2720fir::ExtendedValue
2721IntrinsicLibrary::genCAssociatedCPtr(mlir::Type resultType,
2722 llvm::ArrayRef<fir::ExtendedValue> args) {
2723 return genCAssociated(builder, loc, resultType, args);
2724}
2725
2726// C_F_POINTER
2727void IntrinsicLibrary::genCFPointer(llvm::ArrayRef<fir::ExtendedValue> args) {
2728 assert(args.size() == 3);
2729 // Handle CPTR argument
2730 // Get the value of the C address or the result of a reference to C_LOC.
2731 mlir::Value cPtr = fir::getBase(args[0]);
2732 mlir::Value cPtrAddrVal =
2733 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr);
2734
2735 // Handle FPTR argument
2736 const auto *fPtr = args[1].getBoxOf<fir::MutableBoxValue>();
2737 assert(fPtr && "FPTR must be a pointer");
2738
2739 auto getCPtrExtVal = [&](fir::MutableBoxValue box) -> fir::ExtendedValue {
2740 mlir::Value addr =
2741 builder.createConvert(loc, fPtr->getMemTy(), cPtrAddrVal);
2742 mlir::SmallVector<mlir::Value> extents;
2743 if (box.hasRank()) {
2744 assert(isStaticallyPresent(args[2]) &&
2745 "FPTR argument must be an array if SHAPE argument exists");
2746 mlir::Value shape = fir::getBase(args[2]);
2747 int arrayRank = box.rank();
2748 mlir::Type shapeElementType =
2749 fir::unwrapSequenceType(fir::unwrapPassByRefType(shape.getType()));
2750 mlir::Type idxType = builder.getIndexType();
2751 for (int i = 0; i < arrayRank; ++i) {
2752 mlir::Value index = builder.createIntegerConstant(loc, idxType, i);
2753 mlir::Value var = builder.create<fir::CoordinateOp>(
2754 loc, builder.getRefType(shapeElementType), shape, index);
2755 mlir::Value load = builder.create<fir::LoadOp>(loc, var);
2756 extents.push_back(builder.createConvert(loc, idxType, load));
2757 }
2758 }
2759 if (box.isCharacter()) {
2760 mlir::Value len = box.nonDeferredLenParams()[0];
2761 if (box.hasRank())
2762 return fir::CharArrayBoxValue{addr, len, extents};
2763 return fir::CharBoxValue{addr, len};
2764 }
2765 if (box.isDerivedWithLenParameters())
2766 TODO(loc, "get length parameters of derived type");
2767 if (box.hasRank())
2768 return fir::ArrayBoxValue{addr, extents};
2769 return addr;
2770 };
2771
2772 fir::factory::associateMutableBox(builder, loc, *fPtr, getCPtrExtVal(*fPtr),
2773 /*lbounds=*/mlir::ValueRange{});
2774}
2775
2776// C_F_PROCPOINTER
2777void IntrinsicLibrary::genCFProcPointer(
2778 llvm::ArrayRef<fir::ExtendedValue> args) {
2779 assert(args.size() == 2);
2780 mlir::Value cptr =
2781 fir::factory::genCPtrOrCFunptrValue(builder, loc, fir::getBase(args[0]));
2782 mlir::Value fptr = fir::getBase(args[1]);
2783 auto boxProcType =
2784 mlir::cast<fir::BoxProcType>(fir::unwrapRefType(fptr.getType()));
2785 mlir::Value cptrCast =
2786 builder.createConvert(loc, boxProcType.getEleTy(), cptr);
2787 mlir::Value cptrBox =
2788 builder.create<fir::EmboxProcOp>(loc, boxProcType, cptrCast);
2789 builder.create<fir::StoreOp>(loc, cptrBox, fptr);
2790}
2791
2792// C_FUNLOC
2793fir::ExtendedValue
2794IntrinsicLibrary::genCFunLoc(mlir::Type resultType,
2795 llvm::ArrayRef<fir::ExtendedValue> args) {
2796 return genCLocOrCFunLoc(builder, loc, resultType, args, /*isFunc=*/true);
2797}
2798
2799// C_LOC
2800fir::ExtendedValue
2801IntrinsicLibrary::genCLoc(mlir::Type resultType,
2802 llvm::ArrayRef<fir::ExtendedValue> args) {
2803 return genCLocOrCFunLoc(builder, loc, resultType, args);
2804}
2805
2806// C_PTR_EQ and C_PTR_NE
2807template <mlir::arith::CmpIPredicate pred>
2808fir::ExtendedValue
2809IntrinsicLibrary::genCPtrCompare(mlir::Type resultType,
2810 llvm::ArrayRef<fir::ExtendedValue> args) {
2811 assert(args.size() == 2);
2812 mlir::Value cPtr1 = fir::getBase(args[0]);
2813 mlir::Value cPtrVal1 =
2814 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr1);
2815 mlir::Value cPtr2 = fir::getBase(args[1]);
2816 mlir::Value cPtrVal2 =
2817 fir::factory::genCPtrOrCFunptrValue(builder, loc, cPtr2);
2818 mlir::Value cmp =
2819 builder.create<mlir::arith::CmpIOp>(loc, pred, cPtrVal1, cPtrVal2);
2820 return builder.createConvert(loc, resultType, cmp);
2821}
2822
2823// CEILING
2824mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType,
2825 llvm::ArrayRef<mlir::Value> args) {
2826 // Optional KIND argument.
2827 assert(args.size() >= 1);
2828 mlir::Value arg = args[0];
2829 // Use ceil that is not an actual Fortran intrinsic but that is
2830 // an llvm intrinsic that does the same, but return a floating
2831 // point.
2832 mlir::Value ceil = genRuntimeCall("ceil", arg.getType(), {arg});
2833 return builder.createConvert(loc, resultType, ceil);
2834}
2835
2836// CHAR
2837fir::ExtendedValue
2838IntrinsicLibrary::genChar(mlir::Type type,
2839 llvm::ArrayRef<fir::ExtendedValue> args) {
2840 // Optional KIND argument.
2841 assert(args.size() >= 1);
2842 const mlir::Value *arg = args[0].getUnboxed();
2843 // expect argument to be a scalar integer
2844 if (!arg)
2845 mlir::emitError(loc, "CHAR intrinsic argument not unboxed");
2846 fir::factory::CharacterExprHelper helper{builder, loc};
2847 fir::CharacterType::KindTy kind = helper.getCharacterType(type).getFKind();
2848 mlir::Value cast = helper.createSingletonFromCode(*arg, kind);
2849 mlir::Value len =
2850 builder.createIntegerConstant(loc, builder.getCharacterLengthType(), 1);
2851 return fir::CharBoxValue{cast, len};
2852}
2853
2854// CMPLX
2855mlir::Value IntrinsicLibrary::genCmplx(mlir::Type resultType,
2856 llvm::ArrayRef<mlir::Value> args) {
2857 assert(args.size() >= 1);
2858 fir::factory::Complex complexHelper(builder, loc);
2859 mlir::Type partType = complexHelper.getComplexPartType(resultType);
2860 mlir::Value real = builder.createConvert(loc, partType, args[0]);
2861 mlir::Value imag = isStaticallyAbsent(args, 1)
2862 ? builder.createRealZeroConstant(loc, partType)
2863 : builder.createConvert(loc, partType, args[1]);
2864 return fir::factory::Complex{builder, loc}.createComplex(resultType, real,
2865 imag);
2866}
2867
2868// COMMAND_ARGUMENT_COUNT
2869fir::ExtendedValue IntrinsicLibrary::genCommandArgumentCount(
2870 mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args) {
2871 assert(args.size() == 0);
2872 assert(resultType == builder.getDefaultIntegerType() &&
2873 "result type is not default integer kind type");
2874 return builder.createConvert(
2875 loc, resultType, fir::runtime::genCommandArgumentCount(builder, loc));
2876 ;
2877}
2878
2879// CONJG
2880mlir::Value IntrinsicLibrary::genConjg(mlir::Type resultType,
2881 llvm::ArrayRef<mlir::Value> args) {
2882 assert(args.size() == 1);
2883 if (resultType != args[0].getType())
2884 llvm_unreachable("argument type mismatch");
2885
2886 mlir::Value cplx = args[0];
2887 auto imag = fir::factory::Complex{builder, loc}.extractComplexPart(
2888 cplx, /*isImagPart=*/true);
2889 auto negImag = builder.create<mlir::arith::NegFOp>(loc, imag);
2890 return fir::factory::Complex{builder, loc}.insertComplexPart(
2891 cplx, negImag, /*isImagPart=*/true);
2892}
2893
2894// COSD
2895mlir::Value IntrinsicLibrary::genCosd(mlir::Type resultType,
2896 llvm::ArrayRef<mlir::Value> args) {
2897 assert(args.size() == 1);
2898 mlir::MLIRContext *context = builder.getContext();
2899 mlir::FunctionType ftype =
2900 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});
2901 llvm::APFloat pi = llvm::APFloat(llvm::numbers::pi);
2902 mlir::Value dfactor = builder.createRealConstant(
2903 loc, mlir::FloatType::getF64(context), pi / llvm::APFloat(180.0));
2904 mlir::Value factor = builder.createConvert(loc, args[0].getType(), dfactor);
2905 mlir::Value arg = builder.create<mlir::arith::MulFOp>(loc, args[0], factor);
2906 return getRuntimeCallGenerator("cos", ftype)(builder, loc, {arg});
2907}
2908
2909// COUNT
2910fir::ExtendedValue
2911IntrinsicLibrary::genCount(mlir::Type resultType,
2912 llvm::ArrayRef<fir::ExtendedValue> args) {
2913 assert(args.size() == 3);
2914
2915 // Handle mask argument
2916 fir::BoxValue mask = builder.createBox(loc, args[0]);
2917 unsigned maskRank = mask.rank();
2918
2919 assert(maskRank > 0);
2920
2921 // Handle optional dim argument
2922 bool absentDim = isStaticallyAbsent(args[1]);
2923 mlir::Value dim =
2924 absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 0)
2925 : fir::getBase(args[1]);
2926
2927 if (absentDim || maskRank == 1) {
2928 // Result is scalar if no dim argument or mask is rank 1.
2929 // So, call specialized Count runtime routine.
2930 return builder.createConvert(
2931 loc, resultType,
2932 fir::runtime::genCount(builder, loc, fir::getBase(mask), dim));
2933 }
2934
2935 // Call general CountDim runtime routine.
2936
2937 // Handle optional kind argument
2938 bool absentKind = isStaticallyAbsent(args[2]);
2939 mlir::Value kind = absentKind ? builder.createIntegerConstant(
2940 loc, builder.getIndexType(),
2941 builder.getKindMap().defaultIntegerKind())
2942 : fir::getBase(args[2]);
2943
2944 // Create mutable fir.box to be passed to the runtime for the result.
2945 mlir::Type type = builder.getVarLenSeqTy(resultType, maskRank - 1);
2946 fir::MutableBoxValue resultMutableBox =
2947 fir::factory::createTempMutableBox(builder, loc, type);
2948
2949 mlir::Value resultIrBox =
2950 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2951
2952 fir::runtime::genCountDim(builder, loc, resultIrBox, fir::getBase(mask), dim,
2953 kind);
2954 // Handle cleanup of allocatable result descriptor and return
2955 return readAndAddCleanUp(resultMutableBox, resultType, "COUNT");
2956}
2957
2958// CPU_TIME
2959void IntrinsicLibrary::genCpuTime(llvm::ArrayRef<fir::ExtendedValue> args) {
2960 assert(args.size() == 1);
2961 const mlir::Value *arg = args[0].getUnboxed();
2962 assert(arg && "nonscalar cpu_time argument");
2963 mlir::Value res1 = fir::runtime::genCpuTime(builder, loc);
2964 mlir::Value res2 =
2965 builder.createConvert(loc, fir::dyn_cast_ptrEleTy(arg->getType()), res1);
2966 builder.create<fir::StoreOp>(loc, res2, *arg);
2967}
2968
2969// CSHIFT
2970fir::ExtendedValue
2971IntrinsicLibrary::genCshift(mlir::Type resultType,
2972 llvm::ArrayRef<fir::ExtendedValue> args) {
2973 assert(args.size() == 3);
2974
2975 // Handle required ARRAY argument
2976 fir::BoxValue arrayBox = builder.createBox(loc, args[0]);
2977 mlir::Value array = fir::getBase(arrayBox);
2978 unsigned arrayRank = arrayBox.rank();
2979
2980 // Create mutable fir.box to be passed to the runtime for the result.
2981 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, arrayRank);
2982 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(
2983 builder, loc, resultArrayType, {},
2984 fir::isPolymorphicType(array.getType()) ? array : mlir::Value{});
2985 mlir::Value resultIrBox =
2986 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2987
2988 if (arrayRank == 1) {
2989 // Vector case
2990 // Handle required SHIFT argument as a scalar
2991 const mlir::Value *shiftAddr = args[1].getUnboxed();
2992 assert(shiftAddr && "nonscalar CSHIFT argument");
2993 auto shift = builder.create<fir::LoadOp>(loc, *shiftAddr);
2994
2995 fir::runtime::genCshiftVector(builder, loc, resultIrBox, array, shift);
2996 } else {
2997 // Non-vector case
2998 // Handle required SHIFT argument as an array
2999 mlir::Value shift = builder.createBox(loc, args[1]);
3000
3001 // Handle optional DIM argument
3002 mlir::Value dim =
3003 isStaticallyAbsent(args[2])
3004 ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
3005 : fir::getBase(args[2]);
3006 fir::runtime::genCshift(builder, loc, resultIrBox, array, shift, dim);
3007 }
3008 return readAndAddCleanUp(resultMutableBox, resultType, "CSHIFT");
3009}
3010
3011// DATE_AND_TIME
3012void IntrinsicLibrary::genDateAndTime(llvm::ArrayRef<fir::ExtendedValue> args) {
3013 assert(args.size() == 4 && "date_and_time has 4 args");
3014 llvm::SmallVector<std::optional<fir::CharBoxValue>> charArgs(3);
3015 for (unsigned i = 0; i < 3; ++i)
3016 if (const fir::CharBoxValue *charBox = args[i].getCharBox())
3017 charArgs[i] = *charBox;
3018
3019 mlir::Value values = fir::getBase(args[3]);
3020 if (!values)
3021 values = builder.create<fir::AbsentOp>(
3022 loc, fir::BoxType::get(builder.getNoneType()));
3023
3024 fir::runtime::genDateAndTime(builder, loc, charArgs[0], charArgs[1],
3025 charArgs[2], values);
3026}
3027
3028// DIM
3029mlir::Value IntrinsicLibrary::genDim(mlir::Type resultType,
3030 llvm::ArrayRef<mlir::Value> args) {
3031 assert(args.size() == 2);
3032 if (resultType.isa<mlir::IntegerType>()) {
3033 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3034 auto diff = builder.create<mlir::arith::SubIOp>(loc, args[0], args[1]);
3035 auto cmp = builder.create<mlir::arith::CmpIOp>(
3036 loc, mlir::arith::CmpIPredicate::sgt, diff, zero);
3037 return builder.create<mlir::arith::SelectOp>(loc, cmp, diff, zero);
3038 }
3039 assert(fir::isa_real(resultType) && "Only expects real and integer in DIM");
3040 mlir::Value zero = builder.createRealZeroConstant(loc, resultType);
3041 auto diff = builder.create<mlir::arith::SubFOp>(loc, args[0], args[1]);
3042 auto cmp = builder.create<mlir::arith::CmpFOp>(
3043 loc, mlir::arith::CmpFPredicate::OGT, diff, zero);
3044 return builder.create<mlir::arith::SelectOp>(loc, cmp, diff, zero);
3045}
3046
3047// DOT_PRODUCT
3048fir::ExtendedValue
3049IntrinsicLibrary::genDotProduct(mlir::Type resultType,
3050 llvm::ArrayRef<fir::ExtendedValue> args) {
3051 assert(args.size() == 2);
3052
3053 // Handle required vector arguments
3054 mlir::Value vectorA = fir::getBase(args[0]);
3055 mlir::Value vectorB = fir::getBase(args[1]);
3056 // Result type is used for picking appropriate runtime function.
3057 mlir::Type eleTy = resultType;
3058
3059 if (fir::isa_complex(eleTy)) {
3060 mlir::Value result = builder.createTemporary(loc, eleTy);
3061 fir::runtime::genDotProduct(builder, loc, vectorA, vectorB, result);
3062 return builder.create<fir::LoadOp>(loc, result);
3063 }
3064
3065 // This operation is only used to pass the result type
3066 // information to the DotProduct generator.
3067 auto resultBox = builder.create<fir::AbsentOp>(loc, fir::BoxType::get(eleTy));
3068 return fir::runtime::genDotProduct(builder, loc, vectorA, vectorB, resultBox);
3069}
3070
3071// DPROD
3072mlir::Value IntrinsicLibrary::genDprod(mlir::Type resultType,
3073 llvm::ArrayRef<mlir::Value> args) {
3074 assert(args.size() == 2);
3075 assert(fir::isa_real(resultType) &&
3076 "Result must be double precision in DPROD");
3077 mlir::Value a = builder.createConvert(loc, resultType, args[0]);
3078 mlir::Value b = builder.createConvert(loc, resultType, args[1]);
3079 return builder.create<mlir::arith::MulFOp>(loc, a, b);
3080}
3081
3082// DSHIFTL
3083mlir::Value IntrinsicLibrary::genDshiftl(mlir::Type resultType,
3084 llvm::ArrayRef<mlir::Value> args) {
3085 assert(args.size() == 3);
3086
3087 mlir::Value i = args[0];
3088 mlir::Value j = args[1];
3089 mlir::Value shift = builder.createConvert(loc, resultType, args[2]);
3090 mlir::Value bitSize = builder.createIntegerConstant(
3091 loc, resultType, resultType.getIntOrFloatBitWidth());
3092
3093 // Per the standard, the value of DSHIFTL(I, J, SHIFT) is equal to
3094 // IOR (SHIFTL(I, SHIFT), SHIFTR(J, BIT_SIZE(J) - SHIFT))
3095 mlir::Value diff = builder.create<mlir::arith::SubIOp>(loc, bitSize, shift);
3096
3097 mlir::Value lArgs[2]{i, shift};
3098 mlir::Value lft = genShift<mlir::arith::ShLIOp>(resultType, lArgs);
3099
3100 mlir::Value rArgs[2]{j, diff};
3101 mlir::Value rgt = genShift<mlir::arith::ShRUIOp>(resultType, rArgs);
3102
3103 return builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
3104}
3105
3106// DSHIFTR
3107mlir::Value IntrinsicLibrary::genDshiftr(mlir::Type resultType,
3108 llvm::ArrayRef<mlir::Value> args) {
3109 assert(args.size() == 3);
3110
3111 mlir::Value i = args[0];
3112 mlir::Value j = args[1];
3113 mlir::Value shift = builder.createConvert(loc, resultType, args[2]);
3114 mlir::Value bitSize = builder.createIntegerConstant(
3115 loc, resultType, resultType.getIntOrFloatBitWidth());
3116
3117 // Per the standard, the value of DSHIFTR(I, J, SHIFT) is equal to
3118 // IOR (SHIFTL(I, BIT_SIZE(I) - SHIFT), SHIFTR(J, SHIFT))
3119 mlir::Value diff = builder.create<mlir::arith::SubIOp>(loc, bitSize, shift);
3120
3121 mlir::Value lArgs[2]{i, diff};
3122 mlir::Value lft = genShift<mlir::arith::ShLIOp>(resultType, lArgs);
3123
3124 mlir::Value rArgs[2]{j, shift};
3125 mlir::Value rgt = genShift<mlir::arith::ShRUIOp>(resultType, rArgs);
3126
3127 return builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
3128}
3129
3130// EOSHIFT
3131fir::ExtendedValue
3132IntrinsicLibrary::genEoshift(mlir::Type resultType,
3133 llvm::ArrayRef<fir::ExtendedValue> args) {
3134 assert(args.size() == 4);
3135
3136 // Handle required ARRAY argument
3137 fir::BoxValue arrayBox = builder.createBox(loc, args[0]);
3138 mlir::Value array = fir::getBase(arrayBox);
3139 unsigned arrayRank = arrayBox.rank();
3140
3141 // Create mutable fir.box to be passed to the runtime for the result.
3142 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, arrayRank);
3143 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(
3144 builder, loc, resultArrayType, {},
3145 fir::isPolymorphicType(array.getType()) ? array : mlir::Value{});
3146 mlir::Value resultIrBox =
3147 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3148
3149 // Handle optional BOUNDARY argument
3150 mlir::Value boundary =
3151 isStaticallyAbsent(args[2])
3152 ? builder.create<fir::AbsentOp>(
3153 loc, fir::BoxType::get(builder.getNoneType()))
3154 : builder.createBox(loc, args[2]);
3155
3156 if (arrayRank == 1) {
3157 // Vector case
3158 // Handle required SHIFT argument as a scalar
3159 const mlir::Value *shiftAddr = args[1].getUnboxed();
3160 assert(shiftAddr && "nonscalar EOSHIFT SHIFT argument");
3161 auto shift = builder.create<fir::LoadOp>(loc, *shiftAddr);
3162 fir::runtime::genEoshiftVector(builder, loc, resultIrBox, array, shift,
3163 boundary);
3164 } else {
3165 // Non-vector case
3166 // Handle required SHIFT argument as an array
3167 mlir::Value shift = builder.createBox(loc, args[1]);
3168
3169 // Handle optional DIM argument
3170 mlir::Value dim =
3171 isStaticallyAbsent(args[3])
3172 ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
3173 : fir::getBase(args[3]);
3174 fir::runtime::genEoshift(builder, loc, resultIrBox, array, shift, boundary,
3175 dim);
3176 }
3177 return readAndAddCleanUp(resultMutableBox, resultType, "EOSHIFT");
3178}
3179
3180// EXECUTE_COMMAND_LINE
3181void IntrinsicLibrary::genExecuteCommandLine(
3182 llvm::ArrayRef<fir::ExtendedValue> args) {
3183 assert(args.size() == 5);
3184
3185 mlir::Value command = fir::getBase(args[0]);
3186 // Optional arguments: wait, exitstat, cmdstat, cmdmsg.
3187 const fir::ExtendedValue &wait = args[1];
3188 const fir::ExtendedValue &exitstat = args[2];
3189 const fir::ExtendedValue &cmdstat = args[3];
3190 const fir::ExtendedValue &cmdmsg = args[4];
3191
3192 if (!command)
3193 fir::emitFatalError(loc, "expected COMMAND parameter");
3194
3195 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
3196
3197 mlir::Value waitBool;
3198 if (isStaticallyAbsent(wait)) {
3199 waitBool = builder.createBool(loc, true);
3200 } else {
3201 mlir::Type i1Ty = builder.getI1Type();
3202 mlir::Value waitAddr = fir::getBase(wait);
3203 mlir::Value waitIsPresentAtRuntime =
3204 builder.genIsNotNullAddr(loc, waitAddr);
3205 waitBool = builder
3206 .genIfOp(loc, {i1Ty}, waitIsPresentAtRuntime,
3207 /*withElseRegion=*/true)
3208 .genThen([&]() {
3209 auto waitLoad = builder.create<fir::LoadOp>(loc, waitAddr);
3210 mlir::Value cast =
3211 builder.createConvert(loc, i1Ty, waitLoad);
3212 builder.create<fir::ResultOp>(loc, cast);
3213 })
3214 .genElse([&]() {
3215 mlir::Value trueVal = builder.createBool(loc, true);
3216 builder.create<fir::ResultOp>(loc, trueVal);
3217 })
3218 .getResults()[0];
3219 }
3220
3221 mlir::Value exitstatBox =
3222 isStaticallyPresent(exitstat)
3223 ? fir::getBase(exitstat)
3224 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3225 mlir::Value cmdstatBox =
3226 isStaticallyPresent(cmdstat)
3227 ? fir::getBase(cmdstat)
3228 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3229 mlir::Value cmdmsgBox =
3230 isStaticallyPresent(cmdmsg)
3231 ? fir::getBase(cmdmsg)
3232 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3233 fir::runtime::genExecuteCommandLine(builder, loc, command, waitBool,
3234 exitstatBox, cmdstatBox, cmdmsgBox);
3235}
3236
3237// EXIT
3238void IntrinsicLibrary::genExit(llvm::ArrayRef<fir::ExtendedValue> args) {
3239 assert(args.size() == 1);
3240
3241 mlir::Value status =
3242 isStaticallyAbsent(args[0])
3243 ? builder.createIntegerConstant(loc, builder.getDefaultIntegerType(),
3244 EXIT_SUCCESS)
3245 : fir::getBase(args[0]);
3246
3247 assert(status.getType() == builder.getDefaultIntegerType() &&
3248 "STATUS parameter must be an INTEGER of default kind");
3249
3250 fir::runtime::genExit(builder, loc, status);
3251}
3252
3253// EXPONENT
3254mlir::Value IntrinsicLibrary::genExponent(mlir::Type resultType,
3255 llvm::ArrayRef<mlir::Value> args) {
3256 assert(args.size() == 1);
3257
3258 return builder.createConvert(
3259 loc, resultType,
3260 fir::runtime::genExponent(builder, loc, resultType,
3261 fir::getBase(args[0])));
3262}
3263
3264// EXTENDS_TYPE_OF
3265fir::ExtendedValue
3266IntrinsicLibrary::genExtendsTypeOf(mlir::Type resultType,
3267 llvm::ArrayRef<fir::ExtendedValue> args) {
3268 assert(args.size() == 2);
3269
3270 return builder.createConvert(
3271 loc, resultType,
3272 fir::runtime::genExtendsTypeOf(builder, loc, fir::getBase(args[0]),
3273 fir::getBase(args[1])));
3274}
3275
3276// FINDLOC
3277fir::ExtendedValue
3278IntrinsicLibrary::genFindloc(mlir::Type resultType,
3279 llvm::ArrayRef<fir::ExtendedValue> args) {
3280 assert(args.size() == 6);
3281
3282 // Handle required array argument
3283 mlir::Value array = builder.createBox(loc, args[0]);
3284 unsigned rank = fir::BoxValue(array).rank();
3285 assert(rank >= 1);
3286
3287 // Handle required value argument
3288 mlir::Value val = builder.createBox(loc, args[1]);
3289
3290 // Check if dim argument is present
3291 bool absentDim = isStaticallyAbsent(args[2]);
3292
3293 // Handle optional mask argument
3294 auto mask = isStaticallyAbsent(args[3])
3295 ? builder.create<fir::AbsentOp>(
3296 loc, fir::BoxType::get(builder.getI1Type()))
3297 : builder.createBox(loc, args[3]);
3298
3299 // Handle optional kind argument
3300 auto kind = isStaticallyAbsent(args[4])
3301 ? builder.createIntegerConstant(
3302 loc, builder.getIndexType(),
3303 builder.getKindMap().defaultIntegerKind())
3304 : fir::getBase(args[4]);
3305
3306 // Handle optional back argument
3307 auto back = isStaticallyAbsent(args[5]) ? builder.createBool(loc, false)
3308 : fir::getBase(args[5]);
3309
3310 if (!absentDim && rank == 1) {
3311 // If dim argument is present and the array is rank 1, then the result is
3312 // a scalar (since the the result is rank-1 or 0).
3313 // Therefore, we use a scalar result descriptor with FindlocDim().
3314 // Create mutable fir.box to be passed to the runtime for the result.
3315 fir::MutableBoxValue resultMutableBox =
3316 fir::factory::createTempMutableBox(builder, loc, resultType);
3317 mlir::Value resultIrBox =
3318 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3319 mlir::Value dim = fir::getBase(args[2]);
3320
3321 fir::runtime::genFindlocDim(builder, loc, resultIrBox, array, val, dim,
3322 mask, kind, back);
3323 // Handle cleanup of allocatable result descriptor and return
3324 return readAndAddCleanUp(resultMutableBox, resultType, "FINDLOC");
3325 }
3326
3327 // The result will be an array. Create mutable fir.box to be passed to the
3328 // runtime for the result.
3329 mlir::Type resultArrayType =
3330 builder.getVarLenSeqTy(resultType, absentDim ? 1 : rank - 1);
3331 fir::MutableBoxValue resultMutableBox =
3332 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
3333 mlir::Value resultIrBox =
3334 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3335
3336 if (absentDim) {
3337 fir::runtime::genFindloc(builder, loc, resultIrBox, array, val, mask, kind,
3338 back);
3339 } else {
3340 mlir::Value dim = fir::getBase(args[2]);
3341 fir::runtime::genFindlocDim(builder, loc, resultIrBox, array, val, dim,
3342 mask, kind, back);
3343 }
3344 return readAndAddCleanUp(resultMutableBox, resultType, "FINDLOC");
3345}
3346
3347// FLOOR
3348mlir::Value IntrinsicLibrary::genFloor(mlir::Type resultType,
3349 llvm::ArrayRef<mlir::Value> args) {
3350 // Optional KIND argument.
3351 assert(args.size() >= 1);
3352 mlir::Value arg = args[0];
3353 // Use LLVM floor that returns real.
3354 mlir::Value floor = genRuntimeCall("floor", arg.getType(), {arg});
3355 return builder.createConvert(loc, resultType, floor);
3356}
3357
3358// FRACTION
3359mlir::Value IntrinsicLibrary::genFraction(mlir::Type resultType,
3360 llvm::ArrayRef<mlir::Value> args) {
3361 assert(args.size() == 1);
3362
3363 return builder.createConvert(
3364 loc, resultType,
3365 fir::runtime::genFraction(builder, loc, fir::getBase(args[0])));
3366}
3367
3368// GET_COMMAND
3369void IntrinsicLibrary::genGetCommand(llvm::ArrayRef<fir::ExtendedValue> args) {
3370 assert(args.size() == 4);
3371 const fir::ExtendedValue &command = args[0];
3372 const fir::ExtendedValue &length = args[1];
3373 const fir::ExtendedValue &status = args[2];
3374 const fir::ExtendedValue &errmsg = args[3];
3375
3376 // If none of the optional parameters are present, do nothing.
3377 if (!isStaticallyPresent(command) && !isStaticallyPresent(length) &&
3378 !isStaticallyPresent(status) && !isStaticallyPresent(errmsg))
3379 return;
3380
3381 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
3382 mlir::Value commandBox =
3383 isStaticallyPresent(command)
3384 ? fir::getBase(command)
3385 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3386 mlir::Value lenBox =
3387 isStaticallyPresent(length)
3388 ? fir::getBase(length)
3389 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3390 mlir::Value errBox =
3391 isStaticallyPresent(errmsg)
3392 ? fir::getBase(errmsg)
3393 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3394 mlir::Value stat =
3395 fir::runtime::genGetCommand(builder, loc, commandBox, lenBox, errBox);
3396 if (isStaticallyPresent(status)) {
3397 mlir::Value statAddr = fir::getBase(status);
3398 mlir::Value statIsPresentAtRuntime =
3399 builder.genIsNotNullAddr(loc, statAddr);
3400 builder.genIfThen(loc, statIsPresentAtRuntime)
3401 .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); })
3402 .end();
3403 }
3404}
3405
3406// GETPID
3407mlir::Value IntrinsicLibrary::genGetPID(mlir::Type resultType,
3408 llvm::ArrayRef<mlir::Value> args) {
3409 assert(args.size() == 0 && "getpid takes no input");
3410 return builder.createConvert(loc, resultType,
3411 fir::runtime::genGetPID(builder, loc));
3412}
3413
3414// GET_COMMAND_ARGUMENT
3415void IntrinsicLibrary::genGetCommandArgument(
3416 llvm::ArrayRef<fir::ExtendedValue> args) {
3417 assert(args.size() == 5);
3418 mlir::Value number = fir::getBase(args[0]);
3419 const fir::ExtendedValue &value = args[1];
3420 const fir::ExtendedValue &length = args[2];
3421 const fir::ExtendedValue &status = args[3];
3422 const fir::ExtendedValue &errmsg = args[4];
3423
3424 if (!number)
3425 fir::emitFatalError(loc, "expected NUMBER parameter");
3426
3427 // If none of the optional parameters are present, do nothing.
3428 if (!isStaticallyPresent(value) && !isStaticallyPresent(length) &&
3429 !isStaticallyPresent(status) && !isStaticallyPresent(errmsg))
3430 return;
3431
3432 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
3433 mlir::Value valBox =
3434 isStaticallyPresent(value)
3435 ? fir::getBase(value)
3436 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3437 mlir::Value lenBox =
3438 isStaticallyPresent(length)
3439 ? fir::getBase(length)
3440 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3441 mlir::Value errBox =
3442 isStaticallyPresent(errmsg)
3443 ? fir::getBase(errmsg)
3444 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3445 mlir::Value stat = fir::runtime::genGetCommandArgument(
3446 builder, loc, number, valBox, lenBox, errBox);
3447 if (isStaticallyPresent(status)) {
3448 mlir::Value statAddr = fir::getBase(status);
3449 mlir::Value statIsPresentAtRuntime =
3450 builder.genIsNotNullAddr(loc, statAddr);
3451 builder.genIfThen(loc, statIsPresentAtRuntime)
3452 .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); })
3453 .end();
3454 }
3455}
3456
3457// GET_ENVIRONMENT_VARIABLE
3458void IntrinsicLibrary::genGetEnvironmentVariable(
3459 llvm::ArrayRef<fir::ExtendedValue> args) {
3460 assert(args.size() == 6);
3461 mlir::Value name = fir::getBase(args[0]);
3462 const fir::ExtendedValue &value = args[1];
3463 const fir::ExtendedValue &length = args[2];
3464 const fir::ExtendedValue &status = args[3];
3465 const fir::ExtendedValue &trimName = args[4];
3466 const fir::ExtendedValue &errmsg = args[5];
3467
3468 if (!name)
3469 fir::emitFatalError(loc, "expected NAME parameter");
3470
3471 // If none of the optional parameters are present, do nothing.
3472 if (!isStaticallyPresent(value) && !isStaticallyPresent(length) &&
3473 !isStaticallyPresent(status) && !isStaticallyPresent(errmsg))
3474 return;
3475
3476 // Handle optional TRIM_NAME argument
3477 mlir::Value trim;
3478 if (isStaticallyAbsent(trimName)) {
3479 trim = builder.createBool(loc, true);
3480 } else {
3481 mlir::Type i1Ty = builder.getI1Type();
3482 mlir::Value trimNameAddr = fir::getBase(trimName);
3483 mlir::Value trimNameIsPresentAtRuntime =
3484 builder.genIsNotNullAddr(loc, trimNameAddr);
3485 trim = builder
3486 .genIfOp(loc, {i1Ty}, trimNameIsPresentAtRuntime,
3487 /*withElseRegion=*/true)
3488 .genThen([&]() {
3489 auto trimLoad = builder.create<fir::LoadOp>(loc, trimNameAddr);
3490 mlir::Value cast = builder.createConvert(loc, i1Ty, trimLoad);
3491 builder.create<fir::ResultOp>(loc, cast);
3492 })
3493 .genElse([&]() {
3494 mlir::Value trueVal = builder.createBool(loc, true);
3495 builder.create<fir::ResultOp>(loc, trueVal);
3496 })
3497 .getResults()[0];
3498 }
3499
3500 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
3501 mlir::Value valBox =
3502 isStaticallyPresent(value)
3503 ? fir::getBase(value)
3504 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3505 mlir::Value lenBox =
3506 isStaticallyPresent(length)
3507 ? fir::getBase(length)
3508 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3509 mlir::Value errBox =
3510 isStaticallyPresent(errmsg)
3511 ? fir::getBase(errmsg)
3512 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3513 mlir::Value stat = fir::runtime::genGetEnvVariable(builder, loc, name, valBox,
3514 lenBox, trim, errBox);
3515 if (isStaticallyPresent(status)) {
3516 mlir::Value statAddr = fir::getBase(status);
3517 mlir::Value statIsPresentAtRuntime =
3518 builder.genIsNotNullAddr(loc, statAddr);
3519 builder.genIfThen(loc, statIsPresentAtRuntime)
3520 .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); })
3521 .end();
3522 }
3523}
3524
3525/// Process calls to Maxval, Minval, Product, Sum intrinsic functions that
3526/// take a DIM argument.
3527template <typename FD>
3528static fir::MutableBoxValue
3529genFuncDim(FD funcDim, mlir::Type resultType, fir::FirOpBuilder &builder,
3530 mlir::Location loc, mlir::Value array, fir::ExtendedValue dimArg,
3531 mlir::Value mask, int rank) {
3532
3533 // Create mutable fir.box to be passed to the runtime for the result.
3534 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
3535 fir::MutableBoxValue resultMutableBox =
3536 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
3537 mlir::Value resultIrBox =
3538 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
3539
3540 mlir::Value dim =
3541 isStaticallyAbsent(dimArg)
3542 ? builder.createIntegerConstant(loc, builder.getIndexType(), 0)
3543 : fir::getBase(dimArg);
3544 funcDim(builder, loc, resultIrBox, array, dim, mask);
3545
3546 return resultMutableBox;
3547}
3548
3549/// Process calls to Product, Sum, IAll, IAny, IParity intrinsic functions
3550template <typename FN, typename FD>
3551fir::ExtendedValue
3552IntrinsicLibrary::genReduction(FN func, FD funcDim, llvm::StringRef errMsg,
3553 mlir::Type resultType,
3554 llvm::ArrayRef<fir::ExtendedValue> args) {
3555
3556 assert(args.size() == 3);
3557
3558 // Handle required array argument
3559 fir::BoxValue arryTmp = builder.createBox(loc, args[0]);
3560 mlir::Value array = fir::getBase(arryTmp);
3561 int rank = arryTmp.rank();
3562 assert(rank >= 1);
3563
3564 // Handle optional mask argument
3565 auto mask = isStaticallyAbsent(args[2])
3566 ? builder.create<fir::AbsentOp>(
3567 loc, fir::BoxType::get(builder.getI1Type()))
3568 : builder.createBox(loc, args[2]);
3569
3570 bool absentDim = isStaticallyAbsent(args[1]);
3571
3572 // We call the type specific versions because the result is scalar
3573 // in the case below.
3574 if (absentDim || rank == 1) {
3575 mlir::Type ty = array.getType();
3576 mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy(ty);
3577 auto eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
3578 if (fir::isa_complex(eleTy)) {
3579 mlir::Value result = builder.createTemporary(loc, eleTy);
3580 func(builder, loc, array, mask, result);
3581 return builder.create<fir::LoadOp>(loc, result);
3582 }
3583 auto resultBox = builder.create<fir::AbsentOp>(
3584 loc, fir::BoxType::get(builder.getI1Type()));
3585 return func(builder, loc, array, mask, resultBox);
3586 }
3587 // Handle Product/Sum cases that have an array result.
3588 auto resultMutableBox =
3589 genFuncDim(funcDim, resultType, builder, loc, array, args[1], mask, rank);
3590 return readAndAddCleanUp(resultMutableBox, resultType, errMsg);
3591}
3592
3593// IALL
3594fir::ExtendedValue
3595IntrinsicLibrary::genIall(mlir::Type resultType,
3596 llvm::ArrayRef<fir::ExtendedValue> args) {
3597 return genReduction(fir::runtime::genIAll, fir::runtime::genIAllDim, "IALL",
3598 resultType, args);
3599}
3600
3601// IAND
3602mlir::Value IntrinsicLibrary::genIand(mlir::Type resultType,
3603 llvm::ArrayRef<mlir::Value> args) {
3604 assert(args.size() == 2);
3605 auto arg0 = builder.createConvert(loc, resultType, args[0]);
3606 auto arg1 = builder.createConvert(loc, resultType, args[1]);
3607 return builder.create<mlir::arith::AndIOp>(loc, arg0, arg1);
3608}
3609
3610// IANY
3611fir::ExtendedValue
3612IntrinsicLibrary::genIany(mlir::Type resultType,
3613 llvm::ArrayRef<fir::ExtendedValue> args) {
3614 return genReduction(fir::runtime::genIAny, fir::runtime::genIAnyDim, "IANY",
3615 resultType, args);
3616}
3617
3618// IBCLR
3619mlir::Value IntrinsicLibrary::genIbclr(mlir::Type resultType,
3620 llvm::ArrayRef<mlir::Value> args) {
3621 // A conformant IBCLR(I,POS) call satisfies:
3622 // POS >= 0
3623 // POS < BIT_SIZE(I)
3624 // Return: I & (!(1 << POS))
3625 assert(args.size() == 2);
3626 mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
3627 mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
3628 mlir::Value ones = builder.createAllOnesInteger(loc, resultType);
3629 auto mask = builder.create<mlir::arith::ShLIOp>(loc, one, pos);
3630 auto res = builder.create<mlir::arith::XOrIOp>(loc, ones, mask);
3631 return builder.create<mlir::arith::AndIOp>(loc, args[0], res);
3632}
3633
3634// IBITS
3635mlir::Value IntrinsicLibrary::genIbits(mlir::Type resultType,
3636 llvm::ArrayRef<mlir::Value> args) {
3637 // A conformant IBITS(I,POS,LEN) call satisfies:
3638 // POS >= 0
3639 // LEN >= 0
3640 // POS + LEN <= BIT_SIZE(I)
3641 // Return: LEN == 0 ? 0 : (I >> POS) & (-1 >> (BIT_SIZE(I) - LEN))
3642 // For a conformant call, implementing (I >> POS) with a signed or an
3643 // unsigned shift produces the same result. For a nonconformant call,
3644 // the two choices may produce different results.
3645 assert(args.size() == 3);
3646 mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
3647 mlir::Value len = builder.createConvert(loc, resultType, args[2]);
3648 mlir::Value bitSize = builder.createIntegerConstant(
3649 loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
3650 auto shiftCount = builder.create<mlir::arith::SubIOp>(loc, bitSize, len);
3651 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
3652 mlir::Value ones = builder.createAllOnesInteger(loc, resultType);
3653 auto mask = builder.create<mlir::arith::ShRUIOp>(loc, ones, shiftCount);
3654 auto res1 = builder.create<mlir::arith::ShRSIOp>(loc, args[0], pos);
3655 auto res2 = builder.create<mlir::arith::AndIOp>(loc, res1, mask);
3656 auto lenIsZero = builder.create<mlir::arith::CmpIOp>(
3657 loc, mlir::arith::CmpIPredicate::eq, len, zero);
3658 return builder.create<mlir::arith::SelectOp>(loc, lenIsZero, zero, res2);
3659}
3660
3661// IBSET
3662mlir::Value IntrinsicLibrary::genIbset(mlir::Type resultType,
3663 llvm::ArrayRef<mlir::Value> args) {
3664 // A conformant IBSET(I,POS) call satisfies:
3665 // POS >= 0
3666 // POS < BIT_SIZE(I)
3667 // Return: I | (1 << POS)
3668 assert(args.size() == 2);
3669 mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
3670 mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
3671 auto mask = builder.create<mlir::arith::ShLIOp>(loc, one, pos);
3672 return builder.create<mlir::arith::OrIOp>(loc, args[0], mask);
3673}
3674
3675// ICHAR
3676fir::ExtendedValue
3677IntrinsicLibrary::genIchar(mlir::Type resultType,
3678 llvm::ArrayRef<fir::ExtendedValue> args) {
3679 // There can be an optional kind in second argument.
3680 assert(args.size() == 2);
3681 const fir::CharBoxValue *charBox = args[0].getCharBox();
3682 if (!charBox)
3683 llvm::report_fatal_error("expected character scalar");
3684
3685 fir::factory::CharacterExprHelper helper{builder, loc};
3686 mlir::Value buffer = charBox->getBuffer();
3687 mlir::Type bufferTy = buffer.getType();
3688 mlir::Value charVal;
3689 if (auto charTy = bufferTy.dyn_cast<fir::CharacterType>()) {
3690 assert(charTy.singleton());
3691 charVal = buffer;
3692 } else {
3693 // Character is in memory, cast to fir.ref<char> and load.
3694 mlir::Type ty = fir::dyn_cast_ptrEleTy(bufferTy);
3695 if (!ty)
3696 llvm::report_fatal_error("expected memory type");
3697 // The length of in the character type may be unknown. Casting
3698 // to a singleton ref is required before loading.
3699 fir::CharacterType eleType = helper.getCharacterType(ty);
3700 fir::CharacterType charType =
3701 fir::CharacterType::get(builder.getContext(), eleType.getFKind(), 1);
3702 mlir::Type toTy = builder.getRefType(charType);
3703 mlir::Value cast = builder.createConvert(loc, toTy, buffer);
3704 charVal = builder.create<fir::LoadOp>(loc, cast);
3705 }
3706 LLVM_DEBUG(llvm::dbgs() << "ichar(" << charVal << ")\n");
3707 auto code = helper.extractCodeFromSingleton(charVal);
3708 if (code.getType() == resultType)
3709 return code;
3710 return builder.create<mlir::arith::ExtUIOp>(loc, resultType, code);
3711}
3712
3713// llvm floating point class intrinsic test values
3714// 0 Signaling NaN
3715// 1 Quiet NaN
3716// 2 Negative infinity
3717// 3 Negative normal
3718// 4 Negative subnormal
3719// 5 Negative zero
3720// 6 Positive zero
3721// 7 Positive subnormal
3722// 8 Positive normal
3723// 9 Positive infinity
3724static constexpr int finiteTest = 0b0111111000;
3725static constexpr int nanTest = 0b0000000011;
3726static constexpr int negativeTest = 0b0000111100;
3727static constexpr int normalTest = 0b0101101000;
3728static constexpr int positiveTest = 0b1111000000;
3729static constexpr int snanTest = 0b0000000001;
3730
3731mlir::Value IntrinsicLibrary::genIsFPClass(mlir::Type resultType,
3732 llvm::ArrayRef<mlir::Value> args,
3733 int fpclass) {
3734 assert(args.size() == 1);
3735 mlir::Type i1Ty = builder.getI1Type();
3736 mlir::Value isfpclass =
3737 builder.create<mlir::LLVM::IsFPClass>(loc, i1Ty, args[0], fpclass);
3738 return builder.createConvert(loc, resultType, isfpclass);
3739}
3740
3741/// Generate code to raise \p except if \p cond is absent, or present and true.
3742void IntrinsicLibrary::genRaiseExcept(int except, mlir::Value cond) {
3743 fir::IfOp ifOp;
3744 if (cond) {
3745 ifOp = builder.create<fir::IfOp>(loc, cond, /*withElseRegion=*/false);
3746 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
3747 }
3748 mlir::Type i32Ty = builder.getIntegerType(32);
3749 genRuntimeCall(
3750 "feraiseexcept", i32Ty,
3751 fir::runtime::genMapException(
3752 builder, loc, builder.createIntegerConstant(loc, i32Ty, except)));
3753 if (cond)
3754 builder.setInsertionPointAfter(ifOp);
3755}
3756
3757// Return a reference to the contents of a derived type with one field.
3758// Also return the field type.
3759static std::pair<mlir::Value, mlir::Type>
3760getFieldRef(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value rec) {
3761 auto recType =
3762 fir::unwrapPassByRefType(rec.getType()).dyn_cast<fir::RecordType>();
3763 assert(recType.getTypeList().size() == 1 && "expected exactly one component");
3764 auto [fieldName, fieldTy] = recType.getTypeList().front();
3765 mlir::Value field = builder.create<fir::FieldIndexOp>(
3766 loc, fir::FieldType::get(recType.getContext()), fieldName, recType,
3767 fir::getTypeParams(rec));
3768 return {builder.create<fir::CoordinateOp>(loc, builder.getRefType(fieldTy),
3769 rec, field),
3770 fieldTy};
3771}
3772
3773// IEEE_CLASS_TYPE OPERATOR(==), OPERATOR(/=)
3774// IEEE_ROUND_TYPE OPERATOR(==), OPERATOR(/=)
3775template <mlir::arith::CmpIPredicate pred>
3776mlir::Value
3777IntrinsicLibrary::genIeeeTypeCompare(mlir::Type resultType,
3778 llvm::ArrayRef<mlir::Value> args) {
3779 assert(args.size() == 2);
3780 auto [leftRef, fieldTy] = getFieldRef(builder, loc, args[0]);
3781 auto [rightRef, ignore] = getFieldRef(builder, loc, args[1]);
3782 mlir::Value left = builder.create<fir::LoadOp>(loc, fieldTy, leftRef);
3783 mlir::Value right = builder.create<fir::LoadOp>(loc, fieldTy, rightRef);
3784 return builder.create<mlir::arith::CmpIOp>(loc, pred, left, right);
3785}
3786
3787// IEEE_CLASS
3788mlir::Value IntrinsicLibrary::genIeeeClass(mlir::Type resultType,
3789 llvm::ArrayRef<mlir::Value> args) {
3790 // Classify REAL argument X as one of 11 IEEE_CLASS_TYPE values via
3791 // a table lookup on an index built from 5 values derived from X.
3792 // In indexing order, the values are:
3793 //
3794 // [s] sign bit
3795 // [e] exponent != 0
3796 // [m] exponent == 1..1 (max exponent)
3797 // [l] low-order significand != 0
3798 // [h] high-order significand (kind=10: 2 bits; other kinds: 1 bit)
3799 //
3800 // kind=10 values have an explicit high-order integer significand bit,
3801 // whereas this bit is implicit for other kinds. This requires using a 6-bit
3802 // index into a 64-slot table for kind=10 argument classification queries
3803 // vs. a 5-bit index into a 32-slot table for other argument kind queries.
3804 // The instruction sequence is the same for the two cases.
3805 //
3806 // Placing the [l] and [h] significand bits in "swapped" order rather than
3807 // "natural" order enables more efficient generated code.
3808
3809 assert(args.size() == 1);
3810 mlir::Value realVal = args[0];
3811 mlir::FloatType realType = realVal.getType().dyn_cast<mlir::FloatType>();
3812 const unsigned intWidth = realType.getWidth();
3813 mlir::Type intType = builder.getIntegerType(intWidth);
3814 mlir::Value intVal =
3815 builder.create<mlir::arith::BitcastOp>(loc, intType, realVal);
3816 llvm::StringRef tableName = RTNAME_STRING(IeeeClassTable);
3817 uint64_t highSignificandSize = (realType.getWidth() == 80) + 1;
3818
3819 // Get masks and shift counts.
3820 mlir::Value signShift, highSignificandShift, exponentMask, lowSignificandMask;
3821 auto createIntegerConstant = [&](uint64_t k) {
3822 return builder.createIntegerConstant(loc, intType, k);
3823 };
3824 auto createIntegerConstantAPI = [&](const llvm::APInt &apInt) {
3825 return builder.create<mlir::arith::ConstantOp>(
3826 loc, intType, builder.getIntegerAttr(intType, apInt));
3827 };
3828 auto getMasksAndShifts = [&](uint64_t totalSize, uint64_t exponentSize,
3829 uint64_t significandSize,
3830 bool hasExplicitBit = false) {
3831 assert(1 + exponentSize + significandSize == totalSize &&
3832 "invalid floating point fields");
3833 uint64_t lowSignificandSize = significandSize - hasExplicitBit - 1;
3834 signShift = createIntegerConstant(totalSize - 1 - hasExplicitBit - 4);
3835 highSignificandShift = createIntegerConstant(lowSignificandSize);
3836 llvm::APInt exponentMaskAPI =
3837 llvm::APInt::getBitsSet(intWidth, /*lo=*/significandSize,
3838 /*hi=*/significandSize + exponentSize);
3839 exponentMask = createIntegerConstantAPI(exponentMaskAPI);
3840 llvm::APInt lowSignificandMaskAPI =
3841 llvm::APInt::getLowBitsSet(intWidth, lowSignificandSize);
3842 lowSignificandMask = createIntegerConstantAPI(lowSignificandMaskAPI);
3843 };
3844 switch (realType.getWidth()) {
3845 case 16:
3846 if (realType.isF16()) {
3847 // kind=2: 1 sign bit, 5 exponent bits, 10 significand bits
3848 getMasksAndShifts(16, 5, 10);
3849 } else {
3850 // kind=3: 1 sign bit, 8 exponent bits, 7 significand bits
3851 getMasksAndShifts(16, 8, 7);
3852 }
3853 break;
3854 case 32: // kind=4: 1 sign bit, 8 exponent bits, 23 significand bits
3855 getMasksAndShifts(32, 8, 23);
3856 break;
3857 case 64: // kind=8: 1 sign bit, 11 exponent bits, 52 significand bits
3858 getMasksAndShifts(64, 11, 52);
3859 break;
3860 case 80: // kind=10: 1 sign bit, 15 exponent bits, 1+63 significand bits
3861 getMasksAndShifts(80, 15, 64, /*hasExplicitBit=*/true);
3862 tableName = RTNAME_STRING(IeeeClassTable_10);
3863 break;
3864 case 128: // kind=16: 1 sign bit, 15 exponent bits, 112 significand bits
3865 getMasksAndShifts(128, 15, 112);
3866 break;
3867 default:
3868 llvm_unreachable("unknown real type");
3869 }
3870
3871 // [s] sign bit
3872 int pos = 3 + highSignificandSize;
3873 mlir::Value index = builder.create<mlir::arith::AndIOp>(
3874 loc, builder.create<mlir::arith::ShRUIOp>(loc, intVal, signShift),
3875 createIntegerConstant(1ULL << pos));
3876
3877 // [e] exponent != 0
3878 mlir::Value exponent =
3879 builder.create<mlir::arith::AndIOp>(loc, intVal, exponentMask);
3880 mlir::Value zero = createIntegerConstant(0);
3881 index = builder.create<mlir::arith::OrIOp>(
3882 loc, index,
3883 builder.create<mlir::arith::SelectOp>(
3884 loc,
3885 builder.create<mlir::arith::CmpIOp>(
3886 loc, mlir::arith::CmpIPredicate::ne, exponent, zero),
3887 createIntegerConstant(1ULL << --pos), zero));
3888
3889 // [m] exponent == 1..1 (max exponent)
3890 index = builder.create<mlir::arith::OrIOp>(
3891 loc, index,
3892 builder.create<mlir::arith::SelectOp>(
3893 loc,
3894 builder.create<mlir::arith::CmpIOp>(
3895 loc, mlir::arith::CmpIPredicate::eq, exponent, exponentMask),
3896 createIntegerConstant(1ULL << --pos), zero));
3897
3898 // [l] low-order significand != 0
3899 index = builder.create<mlir::arith::OrIOp>(
3900 loc, index,
3901 builder.create<mlir::arith::SelectOp>(
3902 loc,
3903 builder.create<mlir::arith::CmpIOp>(
3904 loc, mlir::arith::CmpIPredicate::ne,
3905 builder.create<mlir::arith::AndIOp>(loc, intVal,
3906 lowSignificandMask),
3907 zero),
3908 createIntegerConstant(1ULL << --pos), zero));
3909
3910 // [h] high-order significand (1 or 2 bits)
3911 index = builder.create<mlir::arith::OrIOp>(
3912 loc, index,
3913 builder.create<mlir::arith::AndIOp>(
3914 loc,
3915 builder.create<mlir::arith::ShRUIOp>(loc, intVal,
3916 highSignificandShift),
3917 createIntegerConstant((1 << highSignificandSize) - 1)));
3918
3919 int tableSize = 1 << (4 + highSignificandSize);
3920 mlir::Type int8Ty = builder.getIntegerType(8);
3921 mlir::Type tableTy = fir::SequenceType::get(tableSize, int8Ty);
3922 if (!builder.getNamedGlobal(tableName)) {
3923 llvm::SmallVector<mlir::Attribute, 64> values;
3924 auto insert = [&](std::int8_t which) {
3925 values.push_back(builder.getIntegerAttr(int8Ty, which));
3926 };
3927 // If indexing value [e] is 0, value [m] can't be 1. (If the exponent is 0,
3928 // it can't be the max exponent). Use IEEE_OTHER_VALUE for impossible
3929 // combinations.
3930 constexpr std::int8_t impossible = _FORTRAN_RUNTIME_IEEE_OTHER_VALUE;
3931 if (tableSize == 32) {
3932 // s e m l h kinds 2,3,4,8,16
3933 // ===================================================================
3934 /* 0 0 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO);
3935 /* 0 0 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
3936 /* 0 0 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
3937 /* 0 0 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
3938 /* 0 0 1 0 0 */ insert(impossible);
3939 /* 0 0 1 0 1 */ insert(impossible);
3940 /* 0 0 1 1 0 */ insert(impossible);
3941 /* 0 0 1 1 1 */ insert(impossible);
3942 /* 0 1 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
3943 /* 0 1 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
3944 /* 0 1 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
3945 /* 0 1 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
3946 /* 0 1 1 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_INF);
3947 /* 0 1 1 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
3948 /* 0 1 1 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);
3949 /* 0 1 1 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
3950 /* 1 0 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO);
3951 /* 1 0 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
3952 /* 1 0 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
3953 /* 1 0 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
3954 /* 1 0 1 0 0 */ insert(impossible);
3955 /* 1 0 1 0 1 */ insert(impossible);
3956 /* 1 0 1 1 0 */ insert(impossible);
3957 /* 1 0 1 1 1 */ insert(impossible);
3958 /* 1 1 0 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
3959 /* 1 1 0 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
3960 /* 1 1 0 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
3961 /* 1 1 0 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
3962 /* 1 1 1 0 0 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_INF);
3963 /* 1 1 1 0 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
3964 /* 1 1 1 1 0 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);
3965 /* 1 1 1 1 1 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
3966 } else {
3967 // Unlike values of other kinds, kind=10 values can be "invalid", and
3968 // can appear in code. Use IEEE_OTHER_VALUE for invalid bit patterns.
3969 // Runtime IO may print an invalid value as a NaN.
3970 constexpr std::int8_t invalid = _FORTRAN_RUNTIME_IEEE_OTHER_VALUE;
3971 // s e m l h kind 10
3972 // ===================================================================
3973 /* 0 0 0 0 00 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO);
3974 /* 0 0 0 0 01 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
3975 /* 0 0 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
3976 /* 0 0 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
3977 /* 0 0 0 1 00 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
3978 /* 0 0 0 1 01 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
3979 /* 0 0 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
3980 /* 0 0 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
3981 /* 0 0 1 0 00 */ insert(impossible);
3982 /* 0 0 1 0 01 */ insert(impossible);
3983 /* 0 0 1 0 10 */ insert(impossible);
3984 /* 0 0 1 0 11 */ insert(impossible);
3985 /* 0 0 1 1 00 */ insert(impossible);
3986 /* 0 0 1 1 01 */ insert(impossible);
3987 /* 0 0 1 1 10 */ insert(impossible);
3988 /* 0 0 1 1 11 */ insert(impossible);
3989 /* 0 1 0 0 00 */ insert(invalid);
3990 /* 0 1 0 0 01 */ insert(invalid);
3991 /* 0 1 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
3992 /* 0 1 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
3993 /* 0 1 0 1 00 */ insert(invalid);
3994 /* 0 1 0 1 01 */ insert(invalid);
3995 /* 0 1 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
3996 /* 0 1 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
3997 /* 0 1 1 0 00 */ insert(invalid);
3998 /* 0 1 1 0 01 */ insert(invalid);
3999 /* 0 1 1 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_INF);
4000 /* 0 1 1 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
4001 /* 0 1 1 1 00 */ insert(invalid);
4002 /* 0 1 1 1 01 */ insert(invalid);
4003 /* 0 1 1 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);
4004 /* 0 1 1 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
4005 /* 1 0 0 0 00 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO);
4006 /* 1 0 0 0 01 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
4007 /* 1 0 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
4008 /* 1 0 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
4009 /* 1 0 0 1 00 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
4010 /* 1 0 0 1 01 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
4011 /* 1 0 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
4012 /* 1 0 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
4013 /* 1 0 1 0 00 */ insert(impossible);
4014 /* 1 0 1 0 01 */ insert(impossible);
4015 /* 1 0 1 0 10 */ insert(impossible);
4016 /* 1 0 1 0 11 */ insert(impossible);
4017 /* 1 0 1 1 00 */ insert(impossible);
4018 /* 1 0 1 1 01 */ insert(impossible);
4019 /* 1 0 1 1 10 */ insert(impossible);
4020 /* 1 0 1 1 11 */ insert(impossible);
4021 /* 1 1 0 0 00 */ insert(invalid);
4022 /* 1 1 0 0 01 */ insert(invalid);
4023 /* 1 1 0 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
4024 /* 1 1 0 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
4025 /* 1 1 0 1 00 */ insert(invalid);
4026 /* 1 1 0 1 01 */ insert(invalid);
4027 /* 1 1 0 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
4028 /* 1 1 0 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
4029 /* 1 1 1 0 00 */ insert(invalid);
4030 /* 1 1 1 0 01 */ insert(invalid);
4031 /* 1 1 1 0 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_INF);
4032 /* 1 1 1 0 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
4033 /* 1 1 1 1 00 */ insert(invalid);
4034 /* 1 1 1 1 01 */ insert(invalid);
4035 /* 1 1 1 1 10 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);
4036 /* 1 1 1 1 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
4037 }
4038 builder.createGlobalConstant(
4039 loc, tableTy, tableName, builder.createLinkOnceLinkage(),
4040 mlir::DenseElementsAttr::get(
4041 mlir::RankedTensorType::get(tableSize, int8Ty), values));
4042 }
4043
4044 return builder.create<fir::CoordinateOp>(
4045 loc, builder.getRefType(resultType),
4046 builder.create<fir::AddrOfOp>(loc, builder.getRefType(tableTy),
4047 builder.getSymbolRefAttr(tableName)),
4048 index);
4049}
4050
4051// IEEE_COPY_SIGN
4052mlir::Value
4053IntrinsicLibrary::genIeeeCopySign(mlir::Type resultType,
4054 llvm::ArrayRef<mlir::Value> args) {
4055 // Copy the sign of REAL arg Y to REAL arg X.
4056 assert(args.size() == 2);
4057 mlir::Value xRealVal = args[0];
4058 mlir::Value yRealVal = args[1];
4059 mlir::FloatType xRealType = xRealVal.getType().dyn_cast<mlir::FloatType>();
4060 mlir::FloatType yRealType = yRealVal.getType().dyn_cast<mlir::FloatType>();
4061
4062 if (yRealType == mlir::FloatType::getBF16(builder.getContext())) {
4063 // Workaround: CopySignOp and BitcastOp don't work for kind 3 arg Y.
4064 // This conversion should always preserve the sign bit.
4065 yRealVal = builder.createConvert(
4066 loc, mlir::FloatType::getF32(builder.getContext()), yRealVal);
4067 yRealType = mlir::FloatType::getF32(builder.getContext());
4068 }
4069
4070 // Args have the same type.
4071 if (xRealType == yRealType)
4072 return builder.create<mlir::math::CopySignOp>(loc, xRealVal, yRealVal);
4073
4074 // Args have different types.
4075 mlir::Type xIntType = builder.getIntegerType(xRealType.getWidth());
4076 mlir::Type yIntType = builder.getIntegerType(yRealType.getWidth());
4077 mlir::Value xIntVal =
4078 builder.create<mlir::arith::BitcastOp>(loc, xIntType, xRealVal);
4079 mlir::Value yIntVal =
4080 builder.create<mlir::arith::BitcastOp>(loc, yIntType, yRealVal);
4081 mlir::Value xZero = builder.createIntegerConstant(loc, xIntType, 0);
4082 mlir::Value yZero = builder.createIntegerConstant(loc, yIntType, 0);
4083 mlir::Value xOne = builder.createIntegerConstant(loc, xIntType, 1);
4084 mlir::Value ySign = builder.create<mlir::arith::ShRUIOp>(
4085 loc, yIntVal,
4086 builder.createIntegerConstant(loc, yIntType, yRealType.getWidth() - 1));
4087 mlir::Value xAbs = builder.create<mlir::arith::ShRUIOp>(
4088 loc, builder.create<mlir::arith::ShLIOp>(loc, xIntVal, xOne), xOne);
4089 mlir::Value xSign = builder.create<mlir::arith::SelectOp>(
4090 loc,
4091 builder.create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::eq,
4092 ySign, yZero),
4093 xZero,
4094 builder.create<mlir::arith::ShLIOp>(
4095 loc, xOne,
4096 builder.createIntegerConstant(loc, xIntType,
4097 xRealType.getWidth() - 1)));
4098 return builder.create<mlir::arith::BitcastOp>(
4099 loc, xRealType, builder.create<mlir::arith::OrIOp>(loc, xAbs, xSign));
4100}
4101
4102// IEEE_GET_FLAG
4103void IntrinsicLibrary::genIeeeGetFlag(llvm::ArrayRef<fir::ExtendedValue> args) {
4104 assert(args.size() == 2);
4105 // Set FLAG_VALUE=.TRUE. if the exception specified by FLAG is signaling.
4106 mlir::Value flag = fir::getBase(args[0]);
4107 mlir::Value flagValue = fir::getBase(args[1]);
4108 mlir::Type resultTy =
4109 flagValue.getType().dyn_cast<fir::ReferenceType>().getEleTy();
4110 mlir::Type i32Ty = builder.getIntegerType(32);
4111 mlir::Value zero = builder.createIntegerConstant(loc, i32Ty, 0);
4112 auto [fieldRef, ignore] = getFieldRef(builder, loc, flag);
4113 mlir::Value field = builder.create<fir::LoadOp>(loc, fieldRef);
4114 mlir::Value exceptSet = IntrinsicLibrary::genRuntimeCall(
4115 "fetestexcept", i32Ty,
4116 fir::runtime::genMapException(
4117 builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, field)));
4118 mlir::Value logicalResult = builder.create<fir::ConvertOp>(
4119 loc, resultTy,
4120 builder.create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::ne,
4121 exceptSet, zero));
4122 builder.create<fir::StoreOp>(loc, logicalResult, flagValue);
4123}
4124
4125// IEEE_GET_HALTING_MODE
4126void IntrinsicLibrary::genIeeeGetHaltingMode(
4127 llvm::ArrayRef<fir::ExtendedValue> args) {
4128 // Set HALTING=.TRUE. if the exception specified by FLAG will cause halting.
4129 assert(args.size() == 2);
4130 mlir::Value flag = fir::getBase(args[0]);
4131 mlir::Value halting = fir::getBase(args[1]);
4132 mlir::Type resultTy =
4133 halting.getType().dyn_cast<fir::ReferenceType>().getEleTy();
4134 mlir::Type i32Ty = builder.getIntegerType(32);
4135 mlir::Value zero = builder.createIntegerConstant(loc, i32Ty, 0);
4136 auto [fieldRef, ignore] = getFieldRef(builder, loc, flag);
4137 mlir::Value field = builder.create<fir::LoadOp>(loc, fieldRef);
4138 mlir::Value haltSet =
4139 IntrinsicLibrary::genRuntimeCall("fegetexcept", i32Ty, {});
4140 mlir::Value intResult = builder.create<mlir::arith::AndIOp>(
4141 loc, haltSet,
4142 fir::runtime::genMapException(
4143 builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, field)));
4144 mlir::Value logicalResult = builder.create<fir::ConvertOp>(
4145 loc, resultTy,
4146 builder.create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::ne,
4147 intResult, zero));
4148 builder.create<fir::StoreOp>(loc, logicalResult, halting);
4149}
4150
4151// IEEE_GET_MODES, IEEE_SET_MODES
4152template <bool isGet>
4153void IntrinsicLibrary::genIeeeGetOrSetModes(
4154 llvm::ArrayRef<fir::ExtendedValue> args) {
4155 assert(args.size() == 1);
4156 mlir::Type ptrTy = builder.getRefType(builder.getIntegerType(32));
4157 mlir::Type i32Ty = builder.getIntegerType(32);
4158 mlir::Value addr =
4159 builder.create<fir::ConvertOp>(loc, ptrTy, getBase(args[0]));
4160 genRuntimeCall(isGet ? "fegetmode" : "fesetmode", i32Ty, addr);
4161}
4162
4163// Check that an explicit ieee_[get|set]_rounding_mode call radix value is 2.
4164static void checkRadix(fir::FirOpBuilder &builder, mlir::Location loc,
4165 mlir::Value radix, std::string procName) {
4166 mlir::Value notTwo = builder.create<mlir::arith::CmpIOp>(
4167 loc, mlir::arith::CmpIPredicate::ne, radix,
4168 builder.createIntegerConstant(loc, radix.getType(), 2));
4169 auto ifOp = builder.create<fir::IfOp>(loc, notTwo,
4170 /*withElseRegion=*/false);
4171 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
4172 fir::runtime::genReportFatalUserError(builder, loc,
4173 procName + " radix argument must be 2");
4174 builder.setInsertionPointAfter(ifOp);
4175}
4176
4177// IEEE_GET_ROUNDING_MODE
4178void IntrinsicLibrary::genIeeeGetRoundingMode(
4179 llvm::ArrayRef<fir::ExtendedValue> args) {
4180 // Set arg ROUNDING_VALUE to the current floating point rounding mode.
4181 // Values are chosen to match the llvm.get.rounding encoding.
4182 // Generate an error if the value of optional arg RADIX is not 2.
4183 assert(args.size() == 1 || args.size() == 2);
4184 if (args.size() == 2)
4185 checkRadix(builder, loc, fir::getBase(args[1]), "ieee_get_rounding_mode");
4186 auto [fieldRef, fieldTy] = getFieldRef(builder, loc, fir::getBase(args[0]));
4187 mlir::func::FuncOp getRound = fir::factory::getLlvmGetRounding(builder);
4188 mlir::Value mode = builder.create<fir::CallOp>(loc, getRound).getResult(0);
4189 mode = builder.createConvert(loc, fieldTy, mode);
4190 builder.create<fir::StoreOp>(loc, mode, fieldRef);
4191}
4192
4193// IEEE_GET_STATUS, IEEE_SET_STATUS
4194template <bool isGet>
4195void IntrinsicLibrary::genIeeeGetOrSetStatus(
4196 llvm::ArrayRef<fir::ExtendedValue> args) {
4197 assert(args.size() == 1);
4198 mlir::Type ptrTy = builder.getRefType(builder.getIntegerType(32));
4199 mlir::Type i32Ty = builder.getIntegerType(32);
4200 mlir::Value addr =
4201 builder.create<fir::ConvertOp>(loc, ptrTy, getBase(args[0]));
4202 genRuntimeCall(isGet ? "fegetenv" : "fesetenv", i32Ty, addr);
4203}
4204
4205// IEEE_IS_FINITE
4206mlir::Value
4207IntrinsicLibrary::genIeeeIsFinite(mlir::Type resultType,
4208 llvm::ArrayRef<mlir::Value> args) {
4209 // Check if arg X is a (negative or positive) (normal, denormal, or zero).
4210 assert(args.size() == 1);
4211 return genIsFPClass(resultType, args, finiteTest);
4212}
4213
4214// IEEE_IS_NAN
4215mlir::Value IntrinsicLibrary::genIeeeIsNan(mlir::Type resultType,
4216 llvm::ArrayRef<mlir::Value> args) {
4217 // Check if arg X is a (signaling or quiet) NaN.
4218 assert(args.size() == 1);
4219 return genIsFPClass(resultType, args, nanTest);
4220}
4221
4222// IEEE_IS_NEGATIVE
4223mlir::Value
4224IntrinsicLibrary::genIeeeIsNegative(mlir::Type resultType,
4225 llvm::ArrayRef<mlir::Value> args) {
4226 // Check if arg X is a negative (infinity, normal, denormal or zero).
4227 assert(args.size() == 1);
4228 return genIsFPClass(resultType, args, negativeTest);
4229}
4230
4231// IEEE_IS_NORMAL
4232mlir::Value
4233IntrinsicLibrary::genIeeeIsNormal(mlir::Type resultType,
4234 llvm::ArrayRef<mlir::Value> args) {
4235 // Check if arg X is a (negative or positive) (normal or zero).
4236 assert(args.size() == 1);
4237 return genIsFPClass(resultType, args, normalTest);
4238}
4239
4240// IEEE_LOGB
4241mlir::Value IntrinsicLibrary::genIeeeLogb(mlir::Type resultType,
4242 llvm::ArrayRef<mlir::Value> args) {
4243 // Exponent of X, with special case treatment for some input values.
4244 // Return: X == 0
4245 // ? -infinity (and raise FE_DIVBYZERO)
4246 // : ieee_is_finite(X)
4247 // ? exponent(X) - 1 // unbiased exponent of X
4248 // : ieee_copy_sign(X, 1.0) // +infinity or NaN
4249 assert(args.size() == 1);
4250 mlir::Value realVal = args[0];
4251 mlir::FloatType realType = realVal.getType().dyn_cast<mlir::FloatType>();
4252 int bitWidth = realType.getWidth();
4253 mlir::Type intType = builder.getIntegerType(realType.getWidth());
4254 mlir::Value intVal =
4255 builder.create<mlir::arith::BitcastOp>(loc, intType, realVal);
4256 mlir::Type i1Ty = builder.getI1Type();
4257
4258 int exponentBias, significandSize, nonSignificandSize;
4259 switch (bitWidth) {
4260 case 16:
4261 if (realType.isF16()) {
4262 // kind=2: 1 sign bit, 5 exponent bits, 10 significand bits
4263 exponentBias = (1 << (5 - 1)) - 1; // 15
4264 significandSize = 10;
4265 nonSignificandSize = 6;
4266 break;
4267 }
4268 assert(realType.isBF16() && "unknown 16-bit real type");
4269 // kind=3: 1 sign bit, 8 exponent bits, 7 significand bits
4270 exponentBias = (1 << (8 - 1)) - 1; // 127
4271 significandSize = 7;
4272 nonSignificandSize = 9;
4273 break;
4274 case 32:
4275 // kind=4: 1 sign bit, 8 exponent bits, 23 significand bits
4276 exponentBias = (1 << (8 - 1)) - 1; // 127
4277 significandSize = 23;
4278 nonSignificandSize = 9;
4279 break;
4280 case 64:
4281 // kind=8: 1 sign bit, 11 exponent bits, 52 significand bits
4282 exponentBias = (1 << (11 - 1)) - 1; // 1023
4283 significandSize = 52;
4284 nonSignificandSize = 12;
4285 break;
4286 case 80:
4287 // kind=10: 1 sign bit, 15 exponent bits, 1+63 significand bits
4288 exponentBias = (1 << (15 - 1)) - 1; // 16383
4289 significandSize = 64;
4290 nonSignificandSize = 16 + 1;
4291 break;
4292 case 128:
4293 // kind=16: 1 sign bit, 15 exponent bits, 112 significand bits
4294 exponentBias = (1 << (15 - 1)) - 1; // 16383
4295 significandSize = 112;
4296 nonSignificandSize = 16;
4297 break;
4298 default:
4299 llvm_unreachable("unknown real type");
4300 }
4301
4302 mlir::Value isZero = builder.create<mlir::arith::CmpFOp>(
4303 loc, mlir::arith::CmpFPredicate::OEQ, realVal,
4304 builder.createRealZeroConstant(loc, resultType));
4305 auto outerIfOp = builder.create<fir::IfOp>(loc, resultType, isZero,
4306 /*withElseRegion=*/true);
4307 // X is zero -- result is -infinity
4308 builder.setInsertionPointToStart(&outerIfOp.getThenRegion().front());
4309 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO);
4310 mlir::Value ones = builder.createAllOnesInteger(loc, intType);
4311 mlir::Value result = builder.create<mlir::arith::ShLIOp>(
4312 loc, ones,
4313 builder.createIntegerConstant(loc, intType,
4314 // kind=10 high-order bit is explicit
4315 significandSize - (bitWidth == 80)));
4316 result = builder.create<mlir::arith::BitcastOp>(loc, resultType, result);
4317 builder.create<fir::ResultOp>(loc, result);
4318
4319 builder.setInsertionPointToStart(&outerIfOp.getElseRegion().front());
4320 mlir::Value one = builder.createIntegerConstant(loc, intType, 1);
4321 mlir::Value shiftLeftOne =
4322 builder.create<mlir::arith::ShLIOp>(loc, intVal, one);
4323 mlir::Value isFinite = genIsFPClass(i1Ty, args, finiteTest);
4324 auto innerIfOp = builder.create<fir::IfOp>(loc, resultType, isFinite,
4325 /*withElseRegion=*/true);
4326 // X is non-zero finite -- result is unbiased exponent of X
4327 builder.setInsertionPointToStart(&innerIfOp.getThenRegion().front());
4328 mlir::Value isNormal = genIsFPClass(i1Ty, args, normalTest);
4329 auto normalIfOp = builder.create<fir::IfOp>(loc, resultType, isNormal,
4330 /*withElseRegion=*/true);
4331 // X is normal
4332 builder.setInsertionPointToStart(&normalIfOp.getThenRegion().front());
4333 mlir::Value biasedExponent = builder.create<mlir::arith::ShRUIOp>(
4334 loc, shiftLeftOne,
4335 builder.createIntegerConstant(loc, intType, significandSize + 1));
4336 result = builder.create<mlir::arith::SubIOp>(
4337 loc, biasedExponent,
4338 builder.createIntegerConstant(loc, intType, exponentBias));
4339 result = builder.create<fir::ConvertOp>(loc, resultType, result);
4340 builder.create<fir::ResultOp>(loc, result);
4341
4342 // X is denormal -- result is (-exponentBias - ctlz(significand))
4343 builder.setInsertionPointToStart(&normalIfOp.getElseRegion().front());
4344 mlir::Value significand = builder.create<mlir::arith::ShLIOp>(
4345 loc, intVal,
4346 builder.createIntegerConstant(loc, intType, nonSignificandSize));
4347 mlir::Value ctlz =
4348 builder.create<mlir::math::CountLeadingZerosOp>(loc, significand);
4349 mlir::Type i32Ty = builder.getI32Type();
4350 result = builder.create<mlir::arith::SubIOp>(
4351 loc, builder.createIntegerConstant(loc, i32Ty, -exponentBias),
4352 builder.create<fir::ConvertOp>(loc, i32Ty, ctlz));
4353 result = builder.create<fir::ConvertOp>(loc, resultType, result);
4354 builder.create<fir::ResultOp>(loc, result);
4355
4356 builder.setInsertionPointToEnd(&innerIfOp.getThenRegion().front());
4357 builder.create<fir::ResultOp>(loc, normalIfOp.getResult(0));
4358
4359 // X is infinity or NaN -- result is +infinity or NaN
4360 builder.setInsertionPointToStart(&innerIfOp.getElseRegion().front());
4361 result = builder.create<mlir::arith::ShRUIOp>(loc, shiftLeftOne, one);
4362 result = builder.create<mlir::arith::BitcastOp>(loc, resultType, result);
4363 builder.create<fir::ResultOp>(loc, result);
4364
4365 // Unwind the if nest.
4366 builder.setInsertionPointToEnd(&outerIfOp.getElseRegion().front());
4367 builder.create<fir::ResultOp>(loc, innerIfOp.getResult(0));
4368 builder.setInsertionPointAfter(outerIfOp);
4369 return outerIfOp.getResult(0);
4370}
4371
4372// IEEE_MAX, IEEE_MAX_MAG, IEEE_MAX_NUM, IEEE_MAX_NUM_MAG
4373// IEEE_MIN, IEEE_MIN_MAG, IEEE_MIN_NUM, IEEE_MIN_NUM_MAG
4374template <bool isMax, bool isNum, bool isMag>
4375mlir::Value IntrinsicLibrary::genIeeeMaxMin(mlir::Type resultType,
4376 llvm::ArrayRef<mlir::Value> args) {
4377 // Maximum/minimum of X and Y with special case treatment of NaN operands.
4378 // The f18 definitions of these procedures (where applicable) are incomplete.
4379 // And f18 results involving NaNs are different from and incompatible with
4380 // f23 results. This code implements the f23 procedures.
4381 // For IEEE_MAX_MAG and IEEE_MAX_NUM_MAG:
4382 // if (ABS(X) > ABS(Y))
4383 // return X
4384 // else if (ABS(Y) > ABS(X))
4385 // return Y
4386 // else if (ABS(X) == ABS(Y))
4387 // return IEEE_SIGNBIT(Y) ? X : Y
4388 // // X or Y or both are NaNs
4389 // if (X is an sNaN or Y is an sNaN) raise FE_INVALID
4390 // if (IEEE_MAX_NUM_MAG and X is not a NaN) return X
4391 // if (IEEE_MAX_NUM_MAG and Y is not a NaN) return Y
4392 // return a qNaN
4393 // For IEEE_MAX, IEEE_MAX_NUM: compare X vs. Y rather than ABS(X) vs. ABS(Y)
4394 // IEEE_MIN, IEEE_MIN_MAG, IEEE_MIN_NUM, IEEE_MIN_NUM_MAG: invert comparisons
4395 assert(args.size() == 2);
4396 mlir::Value x = args[0];
4397 mlir::Value y = args[1];
4398 mlir::Value x1, y1; // X or ABS(X), Y or ABS(Y)
4399 if constexpr (isMag) {
4400 mlir::Value zero = builder.createRealZeroConstant(loc, resultType);
4401 x1 = builder.create<mlir::math::CopySignOp>(loc, x, zero);
4402 y1 = builder.create<mlir::math::CopySignOp>(loc, y, zero);
4403 } else {
4404 x1 = x;
4405 y1 = y;
4406 }
4407 mlir::Type i1Ty = builder.getI1Type();
4408 mlir::Type i8Ty = builder.getIntegerType(8);
4409 mlir::arith::CmpFPredicate pred;
4410 mlir::Value cmp, result, resultIsX, resultIsY;
4411
4412 // X1 < Y1 -- MAX result is Y; MIN result is X.
4413 pred = mlir::arith::CmpFPredicate::OLT;
4414 cmp = builder.create<mlir::arith::CmpFOp>(loc, pred, x1, y1);
4415 auto ifOp1 = builder.create<fir::IfOp>(loc, resultType, cmp, true);
4416 builder.setInsertionPointToStart(&ifOp1.getThenRegion().front());
4417 result = isMax ? y : x;
4418 builder.create<fir::ResultOp>(loc, result);
4419
4420 // X1 > Y1 -- MAX result is X; MIN result is Y.
4421 builder.setInsertionPointToStart(&ifOp1.getElseRegion().front());
4422 pred = mlir::arith::CmpFPredicate::OGT;
4423 cmp = builder.create<mlir::arith::CmpFOp>(loc, pred, x1, y1);
4424 auto ifOp2 = builder.create<fir::IfOp>(loc, resultType, cmp, true);
4425 builder.setInsertionPointToStart(&ifOp2.getThenRegion().front());
4426 result = isMax ? x : y;
4427 builder.create<fir::ResultOp>(loc, result);
4428
4429 // X1 == Y1 -- MAX favors a positive result; MIN favors a negative result.
4430 builder.setInsertionPointToStart(&ifOp2.getElseRegion().front());
4431 pred = mlir::arith::CmpFPredicate::OEQ;
4432 cmp = builder.create<mlir::arith::CmpFOp>(loc, pred, x1, y1);
4433 auto ifOp3 = builder.create<fir::IfOp>(loc, resultType, cmp, true);
4434 builder.setInsertionPointToStart(&ifOp3.getThenRegion().front());
4435 resultIsX = isMax ? genIsFPClass(i1Ty, x, positiveTest)
4436 : genIsFPClass(i1Ty, x, negativeTest);
4437 result = builder.create<mlir::arith::SelectOp>(loc, resultIsX, x, y);
4438 builder.create<fir::ResultOp>(loc, result);
4439
4440 // X or Y or both are NaNs -- result may be X, Y, or a qNaN
4441 builder.setInsertionPointToStart(&ifOp3.getElseRegion().front());
4442 if constexpr (isNum) {
4443 pred = mlir::arith::CmpFPredicate::ORD; // check for a non-NaN
4444 resultIsX = builder.create<mlir::arith::CmpFOp>(loc, pred, x, x);
4445 resultIsY = builder.create<mlir::arith::CmpFOp>(loc, pred, y, y);
4446 } else {
4447 resultIsX = resultIsY = builder.createBool(loc, false);
4448 }
4449 mlir::Value qNaN =
4450 genIeeeValue(resultType, builder.createIntegerConstant(
4451 loc, i8Ty, _FORTRAN_RUNTIME_IEEE_QUIET_NAN));
4452 result = builder.create<mlir::arith::SelectOp>(
4453 loc, resultIsX, x,
4454 builder.create<mlir::arith::SelectOp>(loc, resultIsY, y, qNaN));
4455 mlir::Value hasSNaNOp = builder.create<mlir::arith::OrIOp>(
4456 loc, genIsFPClass(builder.getI1Type(), args[0], snanTest),
4457 genIsFPClass(builder.getI1Type(), args[1], snanTest));
4458 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID, hasSNaNOp);
4459 builder.create<fir::ResultOp>(loc, result);
4460
4461 // Unwind the if nest.
4462 builder.setInsertionPointAfter(ifOp3);
4463 builder.create<fir::ResultOp>(loc, ifOp3.getResult(0));
4464 builder.setInsertionPointAfter(ifOp2);
4465 builder.create<fir::ResultOp>(loc, ifOp2.getResult(0));
4466 builder.setInsertionPointAfter(ifOp1);
4467 return ifOp1.getResult(0);
4468}
4469
4470// IEEE_QUIET_EQ, IEEE_QUIET_GE, IEEE_QUIET_GT,
4471// IEEE_QUIET_LE, IEEE_QUIET_LT, IEEE_QUIET_NE
4472template <mlir::arith::CmpFPredicate pred>
4473mlir::Value
4474IntrinsicLibrary::genIeeeQuietCompare(mlir::Type resultType,
4475 llvm::ArrayRef<mlir::Value> args) {
4476 // Compare X and Y with special case treatment of NaN operands.
4477 assert(args.size() == 2);
4478 mlir::Value hasSNaNOp = builder.create<mlir::arith::OrIOp>(
4479 loc, genIsFPClass(builder.getI1Type(), args[0], snanTest),
4480 genIsFPClass(builder.getI1Type(), args[1], snanTest));
4481 mlir::Value res =
4482 builder.create<mlir::arith::CmpFOp>(loc, pred, args[0], args[1]);
4483 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID, hasSNaNOp);
4484 return builder.create<fir::ConvertOp>(loc, resultType, res);
4485}
4486
4487// IEEE_SET_FLAG, IEEE_SET_HALTING_MODE
4488template <bool isFlag>
4489void IntrinsicLibrary::genIeeeSetFlagOrHaltingMode(
4490 llvm::ArrayRef<fir::ExtendedValue> args) {
4491 // IEEE_SET_FLAG: Set an exception FLAG to a FLAG_VALUE.
4492 // IEEE_SET_HALTING: Set an exception halting mode FLAG to a HALTING value.
4493 assert(args.size() == 2);
4494 mlir::Type i1Ty = builder.getI1Type();
4495 mlir::Type i32Ty = builder.getIntegerType(32);
4496 auto [fieldRef, ignore] = getFieldRef(builder, loc, getBase(args[0]));
4497 mlir::Value field = builder.create<fir::LoadOp>(loc, fieldRef);
4498 mlir::Value except = fir::runtime::genMapException(
4499 builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, field));
4500 auto ifOp = builder.create<fir::IfOp>(
4501 loc, builder.create<fir::ConvertOp>(loc, i1Ty, getBase(args[1])),
4502 /*withElseRegion=*/true);
4503 builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
4504 genRuntimeCall(isFlag ? "feraiseexcept" : "feenableexcept", i32Ty, except);
4505 builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
4506 genRuntimeCall(isFlag ? "feclearexcept" : "fedisableexcept", i32Ty, except);
4507 builder.setInsertionPointAfter(ifOp);
4508}
4509
4510// IEEE_SET_ROUNDING_MODE
4511void IntrinsicLibrary::genIeeeSetRoundingMode(
4512 llvm::ArrayRef<fir::ExtendedValue> args) {
4513 // Set the current floating point rounding mode to the value of arg
4514 // ROUNDING_VALUE. Values are llvm.get.rounding encoding values.
4515 // Generate an error if the value of optional arg RADIX is not 2.
4516 assert(args.size() == 1 || args.size() == 2);
4517 if (args.size() == 2)
4518 checkRadix(builder, loc, fir::getBase(args[1]), "ieee_set_rounding_mode");
4519 auto [fieldRef, ignore] = getFieldRef(builder, loc, fir::getBase(args[0]));
4520 mlir::func::FuncOp setRound = fir::factory::getLlvmSetRounding(builder);
4521 mlir::Value mode = builder.create<fir::LoadOp>(loc, fieldRef);
4522 mode = builder.create<fir::ConvertOp>(
4523 loc, setRound.getFunctionType().getInput(0), mode);
4524 builder.create<fir::CallOp>(loc, setRound, mode);
4525}
4526
4527// IEEE_SIGNALING_EQ, IEEE_SIGNALING_GE, IEEE_SIGNALING_GT,
4528// IEEE_SIGNALING_LE, IEEE_SIGNALING_LT, IEEE_SIGNALING_NE
4529template <mlir::arith::CmpFPredicate pred>
4530mlir::Value
4531IntrinsicLibrary::genIeeeSignalingCompare(mlir::Type resultType,
4532 llvm::ArrayRef<mlir::Value> args) {
4533 // Compare X and Y with special case treatment of NaN operands.
4534 assert(args.size() == 2);
4535 mlir::Value hasNaNOp = genIeeeUnordered(mlir::Type{}, args);
4536 mlir::Value res =
4537 builder.create<mlir::arith::CmpFOp>(loc, pred, args[0], args[1]);
4538 genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID, hasNaNOp);
4539 return builder.create<fir::ConvertOp>(loc, resultType, res);
4540}
4541
4542// IEEE_SIGNBIT
4543mlir::Value IntrinsicLibrary::genIeeeSignbit(mlir::Type resultType,
4544 llvm::ArrayRef<mlir::Value> args) {
4545 // Check if the sign bit of arg X is set.
4546 assert(args.size() == 1);
4547 mlir::Value realVal = args[0];
4548 mlir::FloatType realType = realVal.getType().dyn_cast<mlir::FloatType>();
4549 int bitWidth = realType.getWidth();
4550 if (realType == mlir::FloatType::getBF16(builder.getContext())) {
4551 // Workaround: can't bitcast or convert real(3) to integer(2) or real(2).
4552 realVal = builder.createConvert(
4553 loc, mlir::FloatType::getF32(builder.getContext()), realVal);
4554 bitWidth = 32;
4555 }
4556 mlir::Type intType = builder.getIntegerType(bitWidth);
4557 mlir::Value intVal =
4558 builder.create<mlir::arith::BitcastOp>(loc, intType, realVal);
4559 mlir::Value shift = builder.createIntegerConstant(loc, intType, bitWidth - 1);
4560 mlir::Value sign = builder.create<mlir::arith::ShRUIOp>(loc, intVal, shift);
4561 return builder.createConvert(loc, resultType, sign);
4562}
4563
4564// IEEE_SUPPORT_FLAG, IEEE_SUPPORT_HALTING
4565mlir::Value IntrinsicLibrary::genIeeeSupportFlagOrHalting(
4566 mlir::Type resultType, llvm::ArrayRef<mlir::Value> args) {
4567 // Check if a floating point exception or halting mode FLAG is supported.
4568 // An IEEE_SUPPORT_FLAG flag is supported either for all type kinds or none.
4569 // An optional kind argument X is therefore ignored.
4570 // Standard flags are all supported.
4571 // The nonstandard DENORM extension is not supported. (At least for now.)
4572 assert(args.size() == 1 || args.size() == 2);
4573 auto [fieldRef, fieldTy] = getFieldRef(builder, loc, args[0]);
4574 mlir::Value flag = builder.create<fir::LoadOp>(loc, fieldRef);
4575 mlir::Value mask = builder.createIntegerConstant( // values are powers of 2
4576 loc, fieldTy,
4577 _FORTRAN_RUNTIME_IEEE_INVALID | _FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO |
4578 _FORTRAN_RUNTIME_IEEE_OVERFLOW | _FORTRAN_RUNTIME_IEEE_UNDERFLOW |
4579 _FORTRAN_RUNTIME_IEEE_INEXACT);
4580 return builder.createConvert(
4581 loc, resultType,
4582 builder.create<mlir::arith::CmpIOp>(
4583 loc, mlir::arith::CmpIPredicate::ne,
4584 builder.create<mlir::arith::AndIOp>(loc, flag, mask),
4585 builder.createIntegerConstant(loc, fieldTy, 0)));
4586}
4587
4588// IEEE_SUPPORT_ROUNDING
4589mlir::Value
4590IntrinsicLibrary::genIeeeSupportRounding(mlir::Type resultType,
4591 llvm::ArrayRef<mlir::Value> args) {
4592 // Check if floating point rounding mode ROUND_VALUE is supported.
4593 // Rounding is supported either for all type kinds or none.
4594 // An optional X kind argument is therefore ignored.
4595 // Values are chosen to match the llvm.get.rounding encoding:
4596 // 0 - toward zero [supported]
4597 // 1 - to nearest, ties to even [supported] - default
4598 // 2 - toward positive infinity [supported]
4599 // 3 - toward negative infinity [supported]
4600 // 4 - to nearest, ties away from zero [not supported]
4601 assert(args.size() == 1 || args.size() == 2);
4602 auto [fieldRef, fieldTy] = getFieldRef(builder, loc, args[0]);
4603 mlir::Value mode = builder.create<fir::LoadOp>(loc, fieldRef);
4604 mlir::Value lbOk = builder.create<mlir::arith::CmpIOp>(
4605 loc, mlir::arith::CmpIPredicate::sge, mode,
4606 builder.createIntegerConstant(loc, fieldTy,
4607 _FORTRAN_RUNTIME_IEEE_TO_ZERO));
4608 mlir::Value ubOk = builder.create<mlir::arith::CmpIOp>(
4609 loc, mlir::arith::CmpIPredicate::sle, mode,
4610 builder.createIntegerConstant(loc, fieldTy, _FORTRAN_RUNTIME_IEEE_DOWN));
4611 return builder.createConvert(
4612 loc, resultType, builder.create<mlir::arith::AndIOp>(loc, lbOk, ubOk));
4613}
4614
4615// IEEE_UNORDERED
4616mlir::Value
4617IntrinsicLibrary::genIeeeUnordered(mlir::Type resultType,
4618 llvm::ArrayRef<mlir::Value> args) {
4619 // Check if REAL args X or Y or both are (signaling or quiet) NaNs.
4620 // If there is no result type return an i1 result.
4621 assert(args.size() == 2);
4622 if (args[0].getType() == args[1].getType()) {
4623 mlir::Value res = builder.create<mlir::arith::CmpFOp>(
4624 loc, mlir::arith::CmpFPredicate::UNO, args[0], args[1]);
4625 return resultType ? builder.createConvert(loc, resultType, res) : res;
4626 }
4627 assert(resultType && "expecting a (mixed arg type) unordered result type");
4628 mlir::Type i1Ty = builder.getI1Type();
4629 mlir::Value xIsNan = genIsFPClass(i1Ty, args[0], nanTest);
4630 mlir::Value yIsNan = genIsFPClass(i1Ty, args[1], nanTest);
4631 mlir::Value res = builder.create<mlir::arith::OrIOp>(loc, xIsNan, yIsNan);
4632 return builder.createConvert(loc, resultType, res);
4633}
4634
4635// IEEE_VALUE
4636mlir::Value IntrinsicLibrary::genIeeeValue(mlir::Type resultType,
4637 llvm::ArrayRef<mlir::Value> args) {
4638 // Return a KIND(X) REAL number of IEEE_CLASS_TYPE CLASS.
4639 // A user call has two arguments:
4640 // - arg[0] is X (ignored, since the resultType is provided)
4641 // - arg[1] is CLASS, an IEEE_CLASS_TYPE CLASS argument containing an index
4642 // A compiler generated call has one argument:
4643 // - arg[0] is an index constant
4644 assert(args.size() == 1 || args.size() == 2);
4645 mlir::FloatType realType = resultType.dyn_cast<mlir::FloatType>();
4646 int bitWidth = realType.getWidth();
4647 mlir::Type intType = builder.getIntegerType(bitWidth);
4648 mlir::Type valueTy = bitWidth <= 64 ? intType : builder.getIntegerType(64);
4649 constexpr int tableSize = _FORTRAN_RUNTIME_IEEE_OTHER_VALUE + 1;
4650 mlir::Type tableTy = fir::SequenceType::get(tableSize, valueTy);
4651 std::string tableName = RTNAME_STRING(IeeeValueTable_) +
4652 std::to_string(realType.isBF16() ? 3 : bitWidth >> 3);
4653 if (!builder.getNamedGlobal(tableName)) {
4654 llvm::SmallVector<mlir::Attribute, tableSize> values;
4655 auto insert = [&](std::int64_t v) {
4656 values.push_back(builder.getIntegerAttr(valueTy, v));
4657 };
4658 insert(0); // placeholder
4659 switch (bitWidth) {
4660 case 16:
4661 if (realType.isF16()) {
4662 // kind=2: 1 sign bit, 5 exponent bits, 10 significand bits
4663 /* IEEE_SIGNALING_NAN */ insert(0x7d00);
4664 /* IEEE_QUIET_NAN */ insert(0x7e00);
4665 /* IEEE_NEGATIVE_INF */ insert(0xfc00);
4666 /* IEEE_NEGATIVE_NORMAL */ insert(0xbc00);
4667 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8200);
4668 /* IEEE_NEGATIVE_ZERO */ insert(0x8000);
4669 /* IEEE_POSITIVE_ZERO */ insert(0x0000);
4670 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0200);
4671 /* IEEE_POSITIVE_NORMAL */ insert(0x3c00); // 1.0
4672 /* IEEE_POSITIVE_INF */ insert(0x7c00);
4673 break;
4674 }
4675 assert(realType.isBF16() && "unknown 16-bit real type");
4676 // kind=3: 1 sign bit, 8 exponent bits, 7 significand bits
4677 /* IEEE_SIGNALING_NAN */ insert(0x7fa0);
4678 /* IEEE_QUIET_NAN */ insert(0x7fc0);
4679 /* IEEE_NEGATIVE_INF */ insert(0xff80);
4680 /* IEEE_NEGATIVE_NORMAL */ insert(0xbf80);
4681 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8040);
4682 /* IEEE_NEGATIVE_ZERO */ insert(0x8000);
4683 /* IEEE_POSITIVE_ZERO */ insert(0x0000);
4684 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0040);
4685 /* IEEE_POSITIVE_NORMAL */ insert(0x3f80); // 1.0
4686 /* IEEE_POSITIVE_INF */ insert(0x7f80);
4687 break;
4688 case 32:
4689 // kind=4: 1 sign bit, 8 exponent bits, 23 significand bits
4690 /* IEEE_SIGNALING_NAN */ insert(0x7fa00000);
4691 /* IEEE_QUIET_NAN */ insert(0x7fc00000);
4692 /* IEEE_NEGATIVE_INF */ insert(0xff800000);
4693 /* IEEE_NEGATIVE_NORMAL */ insert(0xbf800000);
4694 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x80400000);
4695 /* IEEE_NEGATIVE_ZERO */ insert(0x80000000);
4696 /* IEEE_POSITIVE_ZERO */ insert(0x00000000);
4697 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x00400000);
4698 /* IEEE_POSITIVE_NORMAL */ insert(0x3f800000); // 1.0
4699 /* IEEE_POSITIVE_INF */ insert(0x7f800000);
4700 break;
4701 case 64:
4702 // kind=8: 1 sign bit, 11 exponent bits, 52 significand bits
4703 /* IEEE_SIGNALING_NAN */ insert(0x7ff4000000000000);
4704 /* IEEE_QUIET_NAN */ insert(0x7ff8000000000000);
4705 /* IEEE_NEGATIVE_INF */ insert(0xfff0000000000000);
4706 /* IEEE_NEGATIVE_NORMAL */ insert(0xbff0000000000000);
4707 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8008000000000000);
4708 /* IEEE_NEGATIVE_ZERO */ insert(0x8000000000000000);
4709 /* IEEE_POSITIVE_ZERO */ insert(0x0000000000000000);
4710 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0008000000000000);
4711 /* IEEE_POSITIVE_NORMAL */ insert(0x3ff0000000000000); // 1.0
4712 /* IEEE_POSITIVE_INF */ insert(0x7ff0000000000000);
4713 break;
4714 case 80:
4715 // kind=10: 1 sign bit, 15 exponent bits, 1+63 significand bits
4716 // 64 high order bits; 16 low order bits are 0.
4717 /* IEEE_SIGNALING_NAN */ insert(0x7fffa00000000000);
4718 /* IEEE_QUIET_NAN */ insert(0x7fffc00000000000);
4719 /* IEEE_NEGATIVE_INF */ insert(0xffff800000000000);
4720 /* IEEE_NEGATIVE_NORMAL */ insert(0xbfff800000000000);
4721 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8000400000000000);
4722 /* IEEE_NEGATIVE_ZERO */ insert(0x8000000000000000);
4723 /* IEEE_POSITIVE_ZERO */ insert(0x0000000000000000);
4724 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0000400000000000);
4725 /* IEEE_POSITIVE_NORMAL */ insert(0x3fff800000000000); // 1.0
4726 /* IEEE_POSITIVE_INF */ insert(0x7fff800000000000);
4727 break;
4728 case 128:
4729 // kind=16: 1 sign bit, 15 exponent bits, 112 significand bits
4730 // 64 high order bits; 64 low order bits are 0.
4731 /* IEEE_SIGNALING_NAN */ insert(0x7fff400000000000);
4732 /* IEEE_QUIET_NAN */ insert(0x7fff800000000000);
4733 /* IEEE_NEGATIVE_INF */ insert(0xffff000000000000);
4734 /* IEEE_NEGATIVE_NORMAL */ insert(0xbfff000000000000);
4735 /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8000200000000000);
4736 /* IEEE_NEGATIVE_ZERO */ insert(0x8000000000000000);
4737 /* IEEE_POSITIVE_ZERO */ insert(0x0000000000000000);
4738 /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0000200000000000);
4739 /* IEEE_POSITIVE_NORMAL */ insert(0x3fff000000000000); // 1.0
4740 /* IEEE_POSITIVE_INF */ insert(0x7fff000000000000);
4741 break;
4742 default:
4743 llvm_unreachable("unknown real type");
4744 }
4745 insert(0); // IEEE_OTHER_VALUE
4746 assert(values.size() == tableSize && "ieee value mismatch");
4747 builder.createGlobalConstant(
4748 loc, tableTy, tableName, builder.createLinkOnceLinkage(),
4749 mlir::DenseElementsAttr::get(
4750 mlir::RankedTensorType::get(tableSize, valueTy), values));
4751 }
4752
4753 mlir::Value which;
4754 if (args.size() == 2) { // user call
4755 auto [index, ignore] = getFieldRef(builder, loc, args[1]);
4756 which = builder.create<fir::LoadOp>(loc, index);
4757 } else { // compiler generated call
4758 which = args[0];
4759 }
4760 mlir::Value bits = builder.create<fir::LoadOp>(
4761 loc,
4762 builder.create<fir::CoordinateOp>(
4763 loc, builder.getRefType(valueTy),
4764 builder.create<fir::AddrOfOp>(loc, builder.getRefType(tableTy),
4765 builder.getSymbolRefAttr(tableName)),
4766 which));
4767 if (bitWidth > 64)
4768 bits = builder.create<mlir::arith::ShLIOp>(
4769 loc, builder.createConvert(loc, intType, bits),
4770 builder.createIntegerConstant(loc, intType, bitWidth - 64));
4771 return builder.create<mlir::arith::BitcastOp>(loc, realType, bits);
4772}
4773
4774// IEOR
4775mlir::Value IntrinsicLibrary::genIeor(mlir::Type resultType,
4776 llvm::ArrayRef<mlir::Value> args) {
4777 assert(args.size() == 2);
4778 return builder.create<mlir::arith::XOrIOp>(loc, args[0], args[1]);
4779}
4780
4781// INDEX
4782fir::ExtendedValue
4783IntrinsicLibrary::genIndex(mlir::Type resultType,
4784 llvm::ArrayRef<fir::ExtendedValue> args) {
4785 assert(args.size() >= 2 && args.size() <= 4);
4786
4787 mlir::Value stringBase = fir::getBase(args[0]);
4788 fir::KindTy kind =
4789 fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
4790 stringBase.getType());
4791 mlir::Value stringLen = fir::getLen(args[0]);
4792 mlir::Value substringBase = fir::getBase(args[1]);
4793 mlir::Value substringLen = fir::getLen(args[1]);
4794 mlir::Value back =
4795 isStaticallyAbsent(args, 2)
4796 ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
4797 : fir::getBase(args[2]);
4798 if (isStaticallyAbsent(args, 3))
4799 return builder.createConvert(
4800 loc, resultType,
4801 fir::runtime::genIndex(builder, loc, kind, stringBase, stringLen,
4802 substringBase, substringLen, back));
4803
4804 // Call the descriptor-based Index implementation
4805 mlir::Value string = builder.createBox(loc, args[0]);
4806 mlir::Value substring = builder.createBox(loc, args[1]);
4807 auto makeRefThenEmbox = [&](mlir::Value b) {
4808 fir::LogicalType logTy = fir::LogicalType::get(
4809 builder.getContext(), builder.getKindMap().defaultLogicalKind());
4810 mlir::Value temp = builder.createTemporary(loc, logTy);
4811 mlir::Value castb = builder.createConvert(loc, logTy, b);
4812 builder.create<fir::StoreOp>(loc, castb, temp);
4813 return builder.createBox(loc, temp);
4814 };
4815 mlir::Value backOpt = isStaticallyAbsent(args, 2)
4816 ? builder.create<fir::AbsentOp>(
4817 loc, fir::BoxType::get(builder.getI1Type()))
4818 : makeRefThenEmbox(fir::getBase(args[2]));
4819 mlir::Value kindVal = isStaticallyAbsent(args, 3)
4820 ? builder.createIntegerConstant(
4821 loc, builder.getIndexType(),
4822 builder.getKindMap().defaultIntegerKind())
4823 : fir::getBase(args[3]);
4824 // Create mutable fir.box to be passed to the runtime for the result.
4825 fir::MutableBoxValue mutBox =
4826 fir::factory::createTempMutableBox(builder, loc, resultType);
4827 mlir::Value resBox = fir::factory::getMutableIRBox(builder, loc, mutBox);
4828 // Call runtime. The runtime is allocating the result.
4829 fir::runtime::genIndexDescriptor(builder, loc, resBox, string, substring,
4830 backOpt, kindVal);
4831 // Read back the result from the mutable box.
4832 return readAndAddCleanUp(mutBox, resultType, "INDEX");
4833}
4834
4835// IOR
4836mlir::Value IntrinsicLibrary::genIor(mlir::Type resultType,
4837 llvm::ArrayRef<mlir::Value> args) {
4838 assert(args.size() == 2);
4839 return builder.create<mlir::arith::OrIOp>(loc, args[0], args[1]);
4840}
4841
4842// IPARITY
4843fir::ExtendedValue
4844IntrinsicLibrary::genIparity(mlir::Type resultType,
4845 llvm::ArrayRef<fir::ExtendedValue> args) {
4846 return genReduction(fir::runtime::genIParity, fir::runtime::genIParityDim,
4847 "IPARITY", resultType, args);
4848}
4849
4850// IS_CONTIGUOUS
4851fir::ExtendedValue
4852IntrinsicLibrary::genIsContiguous(mlir::Type resultType,
4853 llvm::ArrayRef<fir::ExtendedValue> args) {
4854 assert(args.size() == 1);
4855 if (const auto *boxValue = args[0].getBoxOf<fir::BoxValue>())
4856 if (boxValue->hasAssumedRank())
4857 TODO(loc, "intrinsic: is_contiguous with assumed rank argument");
4858
4859 return builder.createConvert(
4860 loc, resultType,
4861 fir::runtime::genIsContiguous(builder, loc, fir::getBase(args[0])));
4862}
4863
4864// IS_IOSTAT_END, IS_IOSTAT_EOR
4865template <Fortran::runtime::io::Iostat value>
4866mlir::Value
4867IntrinsicLibrary::genIsIostatValue(mlir::Type resultType,
4868 llvm::ArrayRef<mlir::Value> args) {
4869 assert(args.size() == 1);
4870 return builder.create<mlir::arith::CmpIOp>(
4871 loc, mlir::arith::CmpIPredicate::eq, args[0],
4872 builder.createIntegerConstant(loc, args[0].getType(), value));
4873}
4874
4875// ISHFT
4876mlir::Value IntrinsicLibrary::genIshft(mlir::Type resultType,
4877 llvm::ArrayRef<mlir::Value> args) {
4878 // A conformant ISHFT(I,SHIFT) call satisfies:
4879 // abs(SHIFT) <= BIT_SIZE(I)
4880 // Return: abs(SHIFT) >= BIT_SIZE(I)
4881 // ? 0
4882 // : SHIFT < 0
4883 // ? I >> abs(SHIFT)
4884 // : I << abs(SHIFT)
4885 assert(args.size() == 2);
4886 mlir::Value bitSize = builder.createIntegerConstant(
4887 loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
4888 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
4889 mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
4890 mlir::Value absShift = genAbs(resultType, {shift});
4891 auto left = builder.create<mlir::arith::ShLIOp>(loc, args[0], absShift);
4892 auto right = builder.create<mlir::arith::ShRUIOp>(loc, args[0], absShift);
4893 auto shiftIsLarge = builder.create<mlir::arith::CmpIOp>(
4894 loc, mlir::arith::CmpIPredicate::sge, absShift, bitSize);
4895 auto shiftIsNegative = builder.create<mlir::arith::CmpIOp>(
4896 loc, mlir::arith::CmpIPredicate::slt, shift, zero);
4897 auto sel =
4898 builder.create<mlir::arith::SelectOp>(loc, shiftIsNegative, right, left);
4899 return builder.create<mlir::arith::SelectOp>(loc, shiftIsLarge, zero, sel);
4900}
4901
4902// ISHFTC
4903mlir::Value IntrinsicLibrary::genIshftc(mlir::Type resultType,
4904 llvm::ArrayRef<mlir::Value> args) {
4905 // A conformant ISHFTC(I,SHIFT,SIZE) call satisfies:
4906 // SIZE > 0
4907 // SIZE <= BIT_SIZE(I)
4908 // abs(SHIFT) <= SIZE
4909 // if SHIFT > 0
4910 // leftSize = abs(SHIFT)
4911 // rightSize = SIZE - abs(SHIFT)
4912 // else [if SHIFT < 0]
4913 // leftSize = SIZE - abs(SHIFT)
4914 // rightSize = abs(SHIFT)
4915 // unchanged = SIZE == BIT_SIZE(I) ? 0 : (I >> SIZE) << SIZE
4916 // leftMaskShift = BIT_SIZE(I) - leftSize
4917 // rightMaskShift = BIT_SIZE(I) - rightSize
4918 // left = (I >> rightSize) & (-1 >> leftMaskShift)
4919 // right = (I & (-1 >> rightMaskShift)) << leftSize
4920 // Return: SHIFT == 0 || SIZE == abs(SHIFT) ? I : (unchanged | left | right)
4921 assert(args.size() == 3);
4922 mlir::Value bitSize = builder.createIntegerConstant(
4923 loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
4924 mlir::Value I = args[0];
4925 mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
4926 mlir::Value size =
4927 args[2] ? builder.createConvert(loc, resultType, args[2]) : bitSize;
4928 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
4929 mlir::Value ones = builder.createAllOnesInteger(loc, resultType);
4930 mlir::Value absShift = genAbs(resultType, {shift});
4931 auto elseSize = builder.create<mlir::arith::SubIOp>(loc, size, absShift);
4932 auto shiftIsZero = builder.create<mlir::arith::CmpIOp>(
4933 loc, mlir::arith::CmpIPredicate::eq, shift, zero);
4934 auto shiftEqualsSize = builder.create<mlir::arith::CmpIOp>(
4935 loc, mlir::arith::CmpIPredicate::eq, absShift, size);
4936 auto shiftIsNop =
4937 builder.create<mlir::arith::OrIOp>(loc, shiftIsZero, shiftEqualsSize);
4938 auto shiftIsPositive = builder.create<mlir::arith::CmpIOp>(
4939 loc, mlir::arith::CmpIPredicate::sgt, shift, zero);
4940 auto leftSize = builder.create<mlir::arith::SelectOp>(loc, shiftIsPositive,
4941 absShift, elseSize);
4942 auto rightSize = builder.create<mlir::arith::SelectOp>(loc, shiftIsPositive,
4943 elseSize, absShift);
4944 auto hasUnchanged = builder.create<mlir::arith::CmpIOp>(
4945 loc, mlir::arith::CmpIPredicate::ne, size, bitSize);
4946 auto unchangedTmp1 = builder.create<mlir::arith::ShRUIOp>(loc, I, size);
4947 auto unchangedTmp2 =
4948 builder.create<mlir::arith::ShLIOp>(loc, unchangedTmp1, size);
4949 auto unchanged = builder.create<mlir::arith::SelectOp>(loc, hasUnchanged,
4950 unchangedTmp2, zero);
4951 auto leftMaskShift =
4952 builder.create<mlir::arith::SubIOp>(loc, bitSize, leftSize);
4953 auto leftMask =
4954 builder.create<mlir::arith::ShRUIOp>(loc, ones, leftMaskShift);
4955 auto leftTmp = builder.create<mlir::arith::ShRUIOp>(loc, I, rightSize);
4956 auto left = builder.create<mlir::arith::AndIOp>(loc, leftTmp, leftMask);
4957 auto rightMaskShift =
4958 builder.create<mlir::arith::SubIOp>(loc, bitSize, rightSize);
4959 auto rightMask =
4960 builder.create<mlir::arith::ShRUIOp>(loc, ones, rightMaskShift);
4961 auto rightTmp = builder.create<mlir::arith::AndIOp>(loc, I, rightMask);
4962 auto right = builder.create<mlir::arith::ShLIOp>(loc, rightTmp, leftSize);
4963 auto resTmp = builder.create<mlir::arith::OrIOp>(loc, unchanged, left);
4964 auto res = builder.create<mlir::arith::OrIOp>(loc, resTmp, right);
4965 return builder.create<mlir::arith::SelectOp>(loc, shiftIsNop, I, res);
4966}
4967
4968// LEADZ
4969mlir::Value IntrinsicLibrary::genLeadz(mlir::Type resultType,
4970 llvm::ArrayRef<mlir::Value> args) {
4971 assert(args.size() == 1);
4972
4973 mlir::Value result =
4974 builder.create<mlir::math::CountLeadingZerosOp>(loc, args);
4975
4976 return builder.createConvert(loc, resultType, result);
4977}
4978
4979// LEN
4980// Note that this is only used for an unrestricted intrinsic LEN call.
4981// Other uses of LEN are rewritten as descriptor inquiries by the front-end.
4982fir::ExtendedValue
4983IntrinsicLibrary::genLen(mlir::Type resultType,
4984 llvm::ArrayRef<fir::ExtendedValue> args) {
4985 // Optional KIND argument reflected in result type and otherwise ignored.
4986 assert(args.size() == 1 || args.size() == 2);
4987 mlir::Value len = fir::factory::readCharLen(builder, loc, args[0]);
4988 return builder.createConvert(loc, resultType, len);
4989}
4990
4991// LEN_TRIM
4992fir::ExtendedValue
4993IntrinsicLibrary::genLenTrim(mlir::Type resultType,
4994 llvm::ArrayRef<fir::ExtendedValue> args) {
4995 // Optional KIND argument reflected in result type and otherwise ignored.
4996 assert(args.size() == 1 || args.size() == 2);
4997 const fir::CharBoxValue *charBox = args[0].getCharBox();
4998 if (!charBox)
4999 TODO(loc, "intrinsic: len_trim for character array");
5000 auto len =
5001 fir::factory::CharacterExprHelper(builder, loc).createLenTrim(*charBox);
5002 return builder.createConvert(loc, resultType, len);
5003}
5004
5005// LGE, LGT, LLE, LLT
5006template <mlir::arith::CmpIPredicate pred>
5007fir::ExtendedValue
5008IntrinsicLibrary::genCharacterCompare(mlir::Type resultType,
5009 llvm::ArrayRef<fir::ExtendedValue> args) {
5010 assert(args.size() == 2);
5011 return fir::runtime::genCharCompare(
5012 builder, loc, pred, fir::getBase(args[0]), fir::getLen(args[0]),
5013 fir::getBase(args[1]), fir::getLen(args[1]));
5014}
5015
5016static bool isOptional(mlir::Value value) {
5017 auto varIface = mlir::dyn_cast_or_null<fir::FortranVariableOpInterface>(
5018 value.getDefiningOp());
5019 return varIface && varIface.isOptional();
5020}
5021
5022// LOC
5023fir::ExtendedValue
5024IntrinsicLibrary::genLoc(mlir::Type resultType,
5025 llvm::ArrayRef<fir::ExtendedValue> args) {
5026 assert(args.size() == 1);
5027 mlir::Value box = fir::getBase(args[0]);
5028 assert(fir::isa_box_type(box.getType()) &&
5029 "argument must have been lowered to box type");
5030 bool isFunc = box.getType().isa<fir::BoxProcType>();
5031 if (!isOptional(box)) {
5032 mlir::Value argAddr = getAddrFromBox(builder, loc, args[0], isFunc);
5033 return builder.createConvert(loc, resultType, argAddr);
5034 }
5035 // Optional assumed shape case. Although this is not specified in this GNU
5036 // intrinsic extension, LOC accepts absent optional and returns zero in that
5037 // case.
5038 // Note that the other OPTIONAL cases do not fall here since `box` was
5039 // created when preparing the argument cases, but the box can be safely be
5040 // used for all those cases and the address will be null if absent.
5041 mlir::Value isPresent =
5042 builder.create<fir::IsPresentOp>(loc, builder.getI1Type(), box);
5043 return builder
5044 .genIfOp(loc, {resultType}, isPresent,
5045 /*withElseRegion=*/true)
5046 .genThen([&]() {
5047 mlir::Value argAddr = getAddrFromBox(builder, loc, args[0], isFunc);
5048 mlir::Value cast = builder.createConvert(loc, resultType, argAddr);
5049 builder.create<fir::ResultOp>(loc, cast);
5050 })
5051 .genElse([&]() {
5052 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
5053 builder.create<fir::ResultOp>(loc, zero);
5054 })
5055 .getResults()[0];
5056}
5057
5058// MASKL, MASKR
5059template <typename Shift>
5060mlir::Value IntrinsicLibrary::genMask(mlir::Type resultType,
5061 llvm::ArrayRef<mlir::Value> args) {
5062 assert(args.size() == 2);
5063
5064 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
5065 mlir::Value ones = builder.createAllOnesInteger(loc, resultType);
5066 mlir::Value bitSize = builder.createIntegerConstant(
5067 loc, resultType, resultType.getIntOrFloatBitWidth());
5068 mlir::Value bitsToSet = builder.createConvert(loc, resultType, args[0]);
5069
5070 // The standard does not specify what to return if the number of bits to be
5071 // set, I < 0 or I >= BIT_SIZE(KIND). The shift instruction used below will
5072 // produce a poison value which may return a possibly platform-specific and/or
5073 // non-deterministic result. Other compilers don't produce a consistent result
5074 // in this case either, so we choose the most efficient implementation.
5075 mlir::Value shift =
5076 builder.create<mlir::arith::SubIOp>(loc, bitSize, bitsToSet);
5077 mlir::Value shifted = builder.create<Shift>(loc, ones, shift);
5078 mlir::Value isZero = builder.create<mlir::arith::CmpIOp>(
5079 loc, mlir::arith::CmpIPredicate::eq, bitsToSet, zero);
5080
5081 return builder.create<mlir::arith::SelectOp>(loc, isZero, zero, shifted);
5082}
5083
5084// MATMUL
5085fir::ExtendedValue
5086IntrinsicLibrary::genMatmul(mlir::Type resultType,
5087 llvm::ArrayRef<fir::ExtendedValue> args) {
5088 assert(args.size() == 2);
5089
5090 // Handle required matmul arguments
5091 fir::BoxValue matrixTmpA = builder.createBox(loc, args[0]);
5092 mlir::Value matrixA = fir::getBase(matrixTmpA);
5093 fir::BoxValue matrixTmpB = builder.createBox(loc, args[1]);
5094 mlir::Value matrixB = fir::getBase(matrixTmpB);
5095 unsigned resultRank =
5096 (matrixTmpA.rank() == 1 || matrixTmpB.rank() == 1) ? 1 : 2;
5097
5098 // Create mutable fir.box to be passed to the runtime for the result.
5099 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, resultRank);
5100 fir::MutableBoxValue resultMutableBox =
5101 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
5102 mlir::Value resultIrBox =
5103 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
5104 // Call runtime. The runtime is allocating the result.
5105 fir::runtime::genMatmul(builder, loc, resultIrBox, matrixA, matrixB);
5106 // Read result from mutable fir.box and add it to the list of temps to be
5107 // finalized by the StatementContext.
5108 return readAndAddCleanUp(resultMutableBox, resultType, "MATMUL");
5109}
5110
5111// MATMUL_TRANSPOSE
5112fir::ExtendedValue
5113IntrinsicLibrary::genMatmulTranspose(mlir::Type resultType,
5114 llvm::ArrayRef<fir::ExtendedValue> args) {
5115 assert(args.size() == 2);
5116
5117 // Handle required matmul_transpose arguments
5118 fir::BoxValue matrixTmpA = builder.createBox(loc, args[0]);
5119 mlir::Value matrixA = fir::getBase(matrixTmpA);
5120 fir::BoxValue matrixTmpB = builder.createBox(loc, args[1]);
5121 mlir::Value matrixB = fir::getBase(matrixTmpB);
5122 unsigned resultRank =
5123 (matrixTmpA.rank() == 1 || matrixTmpB.rank() == 1) ? 1 : 2;
5124
5125 // Create mutable fir.box to be passed to the runtime for the result.
5126 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, resultRank);
5127 fir::MutableBoxValue resultMutableBox =
5128 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
5129 mlir::Value resultIrBox =
5130 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
5131 // Call runtime. The runtime is allocating the result.
5132 fir::runtime::genMatmulTranspose(builder, loc, resultIrBox, matrixA, matrixB);
5133 // Read result from mutable fir.box and add it to the list of temps to be
5134 // finalized by the StatementContext.
5135 return readAndAddCleanUp(resultMutableBox, resultType, "MATMUL_TRANSPOSE");
5136}
5137
5138// MERGE
5139fir::ExtendedValue
5140IntrinsicLibrary::genMerge(mlir::Type,
5141 llvm::ArrayRef<fir::ExtendedValue> args) {
5142 assert(args.size() == 3);
5143 mlir::Value tsource = fir::getBase(args[0]);
5144 mlir::Value fsource = fir::getBase(args[1]);
5145 mlir::Value rawMask = fir::getBase(args[2]);
5146 mlir::Type type0 = fir::unwrapRefType(tsource.getType());
5147 bool isCharRslt = fir::isa_char(type0); // result is same as first argument
5148 mlir::Value mask = builder.createConvert(loc, builder.getI1Type(), rawMask);
5149
5150 // The result is polymorphic if and only if both TSOURCE and FSOURCE are
5151 // polymorphic. TSOURCE and FSOURCE are required to have the same type
5152 // (for both declared and dynamic types) so a simple convert op can be
5153 // used.
5154 mlir::Value tsourceCast = tsource;
5155 mlir::Value fsourceCast = fsource;
5156 auto convertToStaticType = [&](mlir::Value polymorphic,
5157 mlir::Value other) -> mlir::Value {
5158 mlir::Type otherType = other.getType();
5159 if (otherType.isa<fir::BaseBoxType>())
5160 return builder.create<fir::ReboxOp>(loc, otherType, polymorphic,
5161 /*shape*/ mlir::Value{},
5162 /*slice=*/mlir::Value{});
5163 return builder.create<fir::BoxAddrOp>(loc, otherType, polymorphic);
5164 };
5165 if (fir::isPolymorphicType(tsource.getType()) &&
5166 !fir::isPolymorphicType(fsource.getType())) {
5167 tsourceCast = convertToStaticType(tsource, fsource);
5168 } else if (!fir::isPolymorphicType(tsource.getType()) &&
5169 fir::isPolymorphicType(fsource.getType())) {
5170 fsourceCast = convertToStaticType(fsource, tsource);
5171 } else {
5172 // FSOURCE and TSOURCE are not polymorphic.
5173 // FSOURCE has the same type as TSOURCE, but they may not have the same MLIR
5174 // types (one can have dynamic length while the other has constant lengths,
5175 // or one may be a fir.logical<> while the other is an i1). Insert a cast to
5176 // fulfill mlir::SelectOp constraint that the MLIR types must be the same.
5177 fsourceCast = builder.createConvert(loc, tsource.getType(), fsource);
5178 }
5179 auto rslt = builder.create<mlir::arith::SelectOp>(loc, mask, tsourceCast,
5180 fsourceCast);
5181 if (isCharRslt) {
5182 // Need a CharBoxValue for character results
5183 const fir::CharBoxValue *charBox = args[0].getCharBox();
5184 fir::CharBoxValue charRslt(rslt, charBox->getLen());
5185 return charRslt;
5186 }
5187 return rslt;
5188}
5189
5190// MERGE_BITS
5191mlir::Value IntrinsicLibrary::genMergeBits(mlir::Type resultType,
5192 llvm::ArrayRef<mlir::Value> args) {
5193 assert(args.size() == 3);
5194
5195 mlir::Value i = builder.createConvert(loc, resultType, args[0]);
5196 mlir::Value j = builder.createConvert(loc, resultType, args[1]);
5197 mlir::Value mask = builder.createConvert(loc, resultType, args[2]);
5198 mlir::Value ones = builder.createAllOnesInteger(loc, resultType);
5199
5200 // MERGE_BITS(I, J, MASK) = IOR(IAND(I, MASK), IAND(J, NOT(MASK)))
5201 mlir::Value notMask = builder.create<mlir::arith::XOrIOp>(loc, mask, ones);
5202 mlir::Value lft = builder.create<mlir::arith::AndIOp>(loc, i, mask);
5203 mlir::Value rgt = builder.create<mlir::arith::AndIOp>(loc, j, notMask);
5204
5205 return builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
5206}
5207
5208// MOD
5209mlir::Value IntrinsicLibrary::genMod(mlir::Type resultType,
5210 llvm::ArrayRef<mlir::Value> args) {
5211 assert(args.size() == 2);
5212 if (resultType.isa<mlir::IntegerType>())
5213 return builder.create<mlir::arith::RemSIOp>(loc, args[0], args[1]);
5214
5215 // Use runtime.
5216 return builder.createConvert(
5217 loc, resultType, fir::runtime::genMod(builder, loc, args[0], args[1]));
5218}
5219
5220// MODULO
5221mlir::Value IntrinsicLibrary::genModulo(mlir::Type resultType,
5222 llvm::ArrayRef<mlir::Value> args) {
5223 // TODO: we'd better generate a runtime call here, when runtime error
5224 // checking is needed (to detect 0 divisor) or when precise math is requested.
5225 assert(args.size() == 2);
5226 // No floored modulo op in LLVM/MLIR yet. TODO: add one to MLIR.
5227 // In the meantime, use a simple inlined implementation based on truncated
5228 // modulo (MOD(A, P) implemented by RemIOp, RemFOp). This avoids making manual
5229 // division and multiplication from MODULO formula.
5230 // - If A/P > 0 or MOD(A,P)=0, then INT(A/P) = FLOOR(A/P), and MODULO = MOD.
5231 // - Otherwise, when A/P < 0 and MOD(A,P) !=0, then MODULO(A, P) =
5232 // A-FLOOR(A/P)*P = A-(INT(A/P)-1)*P = A-INT(A/P)*P+P = MOD(A,P)+P
5233 // Note that A/P < 0 if and only if A and P signs are different.
5234 if (resultType.isa<mlir::IntegerType>()) {
5235 auto remainder =
5236 builder.create<mlir::arith::RemSIOp>(loc, args[0], args[1]);
5237 auto argXor = builder.create<mlir::arith::XOrIOp>(loc, args[0], args[1]);
5238 mlir::Value zero = builder.createIntegerConstant(loc, argXor.getType(), 0);
5239 auto argSignDifferent = builder.create<mlir::arith::CmpIOp>(
5240 loc, mlir::arith::CmpIPredicate::slt, argXor, zero);
5241 auto remainderIsNotZero = builder.create<mlir::arith::CmpIOp>(
5242 loc, mlir::arith::CmpIPredicate::ne, remainder, zero);
5243 auto mustAddP = builder.create<mlir::arith::AndIOp>(loc, remainderIsNotZero,
5244 argSignDifferent);
5245 auto remPlusP =
5246 builder.create<mlir::arith::AddIOp>(loc, remainder, args[1]);
5247 return builder.create<mlir::arith::SelectOp>(loc, mustAddP, remPlusP,
5248 remainder);
5249 }
5250
5251 auto fastMathFlags = builder.getFastMathFlags();
5252 // F128 arith::RemFOp may be lowered to a runtime call that may be unsupported
5253 // on the target, so generate a call to Fortran Runtime's ModuloReal16.
5254 if (resultType == mlir::FloatType::getF128(builder.getContext()) ||
5255 (fastMathFlags & mlir::arith::FastMathFlags::ninf) ==
5256 mlir::arith::FastMathFlags::none)
5257 return builder.createConvert(
5258 loc, resultType,
5259 fir::runtime::genModulo(builder, loc, args[0], args[1]));
5260
5261 auto remainder = builder.create<mlir::arith::RemFOp>(loc, args[0], args[1]);
5262 mlir::Value zero = builder.createRealZeroConstant(loc, remainder.getType());
5263 auto remainderIsNotZero = builder.create<mlir::arith::CmpFOp>(
5264 loc, mlir::arith::CmpFPredicate::UNE, remainder, zero);
5265 auto aLessThanZero = builder.create<mlir::arith::CmpFOp>(
5266 loc, mlir::arith::CmpFPredicate::OLT, args[0], zero);
5267 auto pLessThanZero = builder.create<mlir::arith::CmpFOp>(
5268 loc, mlir::arith::CmpFPredicate::OLT, args[1], zero);
5269 auto argSignDifferent =
5270 builder.create<mlir::arith::XOrIOp>(loc, aLessThanZero, pLessThanZero);
5271 auto mustAddP = builder.create<mlir::arith::AndIOp>(loc, remainderIsNotZero,
5272 argSignDifferent);
5273 auto remPlusP = builder.create<mlir::arith::AddFOp>(loc, remainder, args[1]);
5274 return builder.create<mlir::arith::SelectOp>(loc, mustAddP, remPlusP,
5275 remainder);
5276}
5277
5278void IntrinsicLibrary::genMoveAlloc(llvm::ArrayRef<fir::ExtendedValue> args) {
5279 assert(args.size() == 4);
5280
5281 const fir::ExtendedValue &from = args[0];
5282 const fir::ExtendedValue &to = args[1];
5283 const fir::ExtendedValue &status = args[2];
5284 const fir::ExtendedValue &errMsg = args[3];
5285
5286 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
5287 mlir::Value errBox =
5288 isStaticallyPresent(errMsg)
5289 ? fir::getBase(errMsg)
5290 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
5291
5292 const fir::MutableBoxValue *fromBox = from.getBoxOf<fir::MutableBoxValue>();
5293 const fir::MutableBoxValue *toBox = to.getBoxOf<fir::MutableBoxValue>();
5294
5295 assert(fromBox && toBox && "move_alloc parameters must be mutable arrays");
5296
5297 mlir::Value fromAddr = fir::factory::getMutableIRBox(builder, loc, *fromBox);
5298 mlir::Value toAddr = fir::factory::getMutableIRBox(builder, loc, *toBox);
5299
5300 mlir::Value hasStat = builder.createBool(loc, isStaticallyPresent(status));
5301
5302 mlir::Value stat = fir::runtime::genMoveAlloc(builder, loc, toAddr, fromAddr,
5303 hasStat, errBox);
5304
5305 fir::factory::syncMutableBoxFromIRBox(builder, loc, *fromBox);
5306 fir::factory::syncMutableBoxFromIRBox(builder, loc, *toBox);
5307
5308 if (isStaticallyPresent(status)) {
5309 mlir::Value statAddr = fir::getBase(status);
5310 mlir::Value statIsPresentAtRuntime =
5311 builder.genIsNotNullAddr(loc, statAddr);
5312 builder.genIfThen(loc, statIsPresentAtRuntime)
5313 .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); })
5314 .end();
5315 }
5316}
5317
5318// MVBITS
5319void IntrinsicLibrary::genMvbits(llvm::ArrayRef<fir::ExtendedValue> args) {
5320 // A conformant MVBITS(FROM,FROMPOS,LEN,TO,TOPOS) call satisfies:
5321 // FROMPOS >= 0
5322 // LEN >= 0
5323 // TOPOS >= 0
5324 // FROMPOS + LEN <= BIT_SIZE(FROM)
5325 // TOPOS + LEN <= BIT_SIZE(TO)
5326 // MASK = -1 >> (BIT_SIZE(FROM) - LEN)
5327 // TO = LEN == 0 ? TO : ((!(MASK << TOPOS)) & TO) |
5328 // (((FROM >> FROMPOS) & MASK) << TOPOS)
5329 assert(args.size() == 5);
5330 auto unbox = [&](fir::ExtendedValue exv) {
5331 const mlir::Value *arg = exv.getUnboxed();
5332 assert(arg && "nonscalar mvbits argument");
5333 return *arg;
5334 };
5335 mlir::Value from = unbox(args[0]);
5336 mlir::Type resultType = from.getType();
5337 mlir::Value frompos = builder.createConvert(loc, resultType, unbox(args[1]));
5338 mlir::Value len = builder.createConvert(loc, resultType, unbox(args[2]));
5339 mlir::Value toAddr = unbox(args[3]);
5340 assert(fir::dyn_cast_ptrEleTy(toAddr.getType()) == resultType &&
5341 "mismatched mvbits types");
5342 auto to = builder.create<fir::LoadOp>(loc, resultType, toAddr);
5343 mlir::Value topos = builder.createConvert(loc, resultType, unbox(args[4]));
5344 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
5345 mlir::Value ones = builder.createAllOnesInteger(loc, resultType);
5346 mlir::Value bitSize = builder.createIntegerConstant(
5347 loc, resultType, resultType.cast<mlir::IntegerType>().getWidth());
5348 auto shiftCount = builder.create<mlir::arith::SubIOp>(loc, bitSize, len);
5349 auto mask = builder.create<mlir::arith::ShRUIOp>(loc, ones, shiftCount);
5350 auto unchangedTmp1 = builder.create<mlir::arith::ShLIOp>(loc, mask, topos);
5351 auto unchangedTmp2 =
5352 builder.create<mlir::arith::XOrIOp>(loc, unchangedTmp1, ones);
5353 auto unchanged = builder.create<mlir::arith::AndIOp>(loc, unchangedTmp2, to);
5354 auto frombitsTmp1 = builder.create<mlir::arith::ShRUIOp>(loc, from, frompos);
5355 auto frombitsTmp2 =
5356 builder.create<mlir::arith::AndIOp>(loc, frombitsTmp1, mask);
5357 auto frombits = builder.create<mlir::arith::ShLIOp>(loc, frombitsTmp2, topos);
5358 auto resTmp = builder.create<mlir::arith::OrIOp>(loc, unchanged, frombits);
5359 auto lenIsZero = builder.create<mlir::arith::CmpIOp>(
5360 loc, mlir::arith::CmpIPredicate::eq, len, zero);
5361 auto res = builder.create<mlir::arith::SelectOp>(loc, lenIsZero, to, resTmp);
5362 builder.create<fir::StoreOp>(loc, res, toAddr);
5363}
5364
5365// NEAREST
5366mlir::Value IntrinsicLibrary::genNearest(mlir::Type resultType,
5367 llvm::ArrayRef<mlir::Value> args) {
5368 assert(args.size() == 2);
5369
5370 mlir::Value realX = fir::getBase(args[0]);
5371 mlir::Value realS = fir::getBase(args[1]);
5372
5373 return builder.createConvert(
5374 loc, resultType, fir::runtime::genNearest(builder, loc, realX, realS));
5375}
5376
5377// NINT
5378mlir::Value IntrinsicLibrary::genNint(mlir::Type resultType,
5379 llvm::ArrayRef<mlir::Value> args) {
5380 assert(args.size() >= 1);
5381 // Skip optional kind argument to search the runtime; it is already reflected
5382 // in result type.
5383 return genRuntimeCall("nint", resultType, {args[0]});
5384}
5385
5386// NORM2
5387fir::ExtendedValue
5388IntrinsicLibrary::genNorm2(mlir::Type resultType,
5389 llvm::ArrayRef<fir::ExtendedValue> args) {
5390 assert(args.size() == 2);
5391
5392 // Handle required array argument
5393 mlir::Value array = builder.createBox(loc, args[0]);
5394 unsigned rank = fir::BoxValue(array).rank();
5395 assert(rank >= 1);
5396
5397 // Check if the dim argument is present
5398 bool absentDim = isStaticallyAbsent(args[1]);
5399
5400 // If dim argument is absent or the array is rank 1, then the result is
5401 // a scalar (since the the result is rank-1 or 0). Otherwise, the result is
5402 // an array.
5403 if (absentDim || rank == 1) {
5404 return fir::runtime::genNorm2(builder, loc, array);
5405 } else {
5406 // Create mutable fir.box to be passed to the runtime for the result.
5407 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
5408 fir::MutableBoxValue resultMutableBox =
5409 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
5410 mlir::Value resultIrBox =
5411 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
5412
5413 mlir::Value dim = fir::getBase(args[1]);
5414 fir::runtime::genNorm2Dim(builder, loc, resultIrBox, array, dim);
5415 // Handle cleanup of allocatable result descriptor and return
5416 return readAndAddCleanUp(resultMutableBox, resultType, "NORM2");
5417 }
5418}
5419
5420// NOT
5421mlir::Value IntrinsicLibrary::genNot(mlir::Type resultType,
5422 llvm::ArrayRef<mlir::Value> args) {
5423 assert(args.size() == 1);
5424 mlir::Value allOnes = builder.createAllOnesInteger(loc, resultType);
5425 return builder.create<mlir::arith::XOrIOp>(loc, args[0], allOnes);
5426}
5427
5428// NULL
5429fir::ExtendedValue
5430IntrinsicLibrary::genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue> args) {
5431 // NULL() without MOLD must be handled in the contexts where it can appear
5432 // (see table 16.5 of Fortran 2018 standard).
5433 assert(args.size() == 1 && isStaticallyPresent(args[0]) &&
5434 "MOLD argument required to lower NULL outside of any context");
5435 mlir::Type ptrTy = fir::getBase(args[0]).getType();
5436 if (ptrTy && fir::isBoxProcAddressType(ptrTy)) {
5437 auto boxProcType = mlir::cast<fir::BoxProcType>(fir::unwrapRefType(ptrTy));
5438 mlir::Value boxStorage = builder.createTemporary(loc, boxProcType);
5439 mlir::Value nullBoxProc =
5440 fir::factory::createNullBoxProc(builder, loc, boxProcType);
5441 builder.createStoreWithConvert(loc, nullBoxProc, boxStorage);
5442 return boxStorage;
5443 }
5444 const auto *mold = args[0].getBoxOf<fir::MutableBoxValue>();
5445 assert(mold && "MOLD must be a pointer or allocatable");
5446 fir::BaseBoxType boxType = mold->getBoxTy();
5447 mlir::Value boxStorage = builder.createTemporary(loc, boxType);
5448 mlir::Value box = fir::factory::createUnallocatedBox(
5449 builder, loc, boxType, mold->nonDeferredLenParams());
5450 builder.create<fir::StoreOp>(loc, box, boxStorage);
5451 return fir::MutableBoxValue(boxStorage, mold->nonDeferredLenParams(), {});
5452}
5453
5454// PACK
5455fir::ExtendedValue
5456IntrinsicLibrary::genPack(mlir::Type resultType,
5457 llvm::ArrayRef<fir::ExtendedValue> args) {
5458 [[maybe_unused]] auto numArgs = args.size();
5459 assert(numArgs == 2 || numArgs == 3);
5460
5461 // Handle required array argument
5462 mlir::Value array = builder.createBox(loc, args[0]);
5463
5464 // Handle required mask argument
5465 mlir::Value mask = builder.createBox(loc, args[1]);
5466
5467 // Handle optional vector argument
5468 mlir::Value vector = isStaticallyAbsent(args, 2)
5469 ? builder.create<fir::AbsentOp>(
5470 loc, fir::BoxType::get(builder.getI1Type()))
5471 : builder.createBox(loc, args[2]);
5472
5473 // Create mutable fir.box to be passed to the runtime for the result.
5474 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 1);
5475 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(
5476 builder, loc, resultArrayType, {},
5477 fir::isPolymorphicType(array.getType()) ? array : mlir::Value{});
5478 mlir::Value resultIrBox =
5479 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
5480
5481 fir::runtime::genPack(builder, loc, resultIrBox, array, mask, vector);
5482
5483 return readAndAddCleanUp(resultMutableBox, resultType, "PACK");
5484}
5485
5486// PARITY
5487fir::ExtendedValue
5488IntrinsicLibrary::genParity(mlir::Type resultType,
5489 llvm::ArrayRef<fir::ExtendedValue> args) {
5490
5491 assert(args.size() == 2);
5492 // Handle required mask argument
5493 mlir::Value mask = builder.createBox(loc, args[0]);
5494
5495 fir::BoxValue maskArry = builder.createBox(loc, args[0]);
5496 int rank = maskArry.rank();
5497 assert(rank >= 1);
5498
5499 // Handle optional dim argument
5500 bool absentDim = isStaticallyAbsent(args[1]);
5501 mlir::Value dim =
5502 absentDim ? builder.createIntegerConstant(loc, builder.getIndexType(), 1)
5503 : fir::getBase(args[1]);
5504
5505 if (rank == 1 || absentDim)
5506 return builder.createConvert(
5507 loc, resultType, fir::runtime::genParity(builder, loc, mask, dim));
5508
5509 // else use the result descriptor ParityDim() intrinsic
5510
5511 // Create mutable fir.box to be passed to the runtime for the result.
5512
5513 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, rank - 1);
5514 fir::MutableBoxValue resultMutableBox =
5515 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
5516 mlir::Value resultIrBox =
5517 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
5518
5519 // Call runtime. The runtime is allocating the result.
5520 fir::runtime::genParityDescriptor(builder, loc, resultIrBox, mask, dim);
5521 return readAndAddCleanUp(resultMutableBox, resultType, "PARITY");
5522}
5523
5524// POPCNT
5525mlir::Value IntrinsicLibrary::genPopcnt(mlir::Type resultType,
5526 llvm::ArrayRef<mlir::Value> args) {
5527 assert(args.size() == 1);
5528
5529 mlir::Value count = builder.create<mlir::math::CtPopOp>(loc, args);
5530
5531 return builder.createConvert(loc, resultType, count);
5532}
5533
5534// POPPAR
5535mlir::Value IntrinsicLibrary::genPoppar(mlir::Type resultType,
5536 llvm::ArrayRef<mlir::Value> args) {
5537 assert(args.size() == 1);
5538
5539 mlir::Value count = genPopcnt(resultType, args);
5540 mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
5541
5542 return builder.create<mlir::arith::AndIOp>(loc, count, one);
5543}
5544
5545// PRESENT
5546fir::ExtendedValue
5547IntrinsicLibrary::genPresent(mlir::Type,
5548 llvm::ArrayRef<fir::ExtendedValue> args) {
5549 assert(args.size() == 1);
5550 return builder.create<fir::IsPresentOp>(loc, builder.getI1Type(),
5551 fir::getBase(args[0]));
5552}
5553
5554// PRODUCT
5555fir::ExtendedValue
5556IntrinsicLibrary::genProduct(mlir::Type resultType,
5557 llvm::ArrayRef<fir::ExtendedValue> args) {
5558 return genReduction(fir::runtime::genProduct, fir::runtime::genProductDim,
5559 "PRODUCT", resultType, args);
5560}
5561
5562// RANDOM_INIT
5563void IntrinsicLibrary::genRandomInit(llvm::ArrayRef<fir::ExtendedValue> args) {
5564 assert(args.size() == 2);
5565 fir::runtime::genRandomInit(builder, loc, fir::getBase(args[0]),
5566 fir::getBase(args[1]));
5567}
5568
5569// RANDOM_NUMBER
5570void IntrinsicLibrary::genRandomNumber(
5571 llvm::ArrayRef<fir::ExtendedValue> args) {
5572 assert(args.size() == 1);
5573 fir::runtime::genRandomNumber(builder, loc, fir::getBase(args[0]));
5574}
5575
5576// RANDOM_SEED
5577void IntrinsicLibrary::genRandomSeed(llvm::ArrayRef<fir::ExtendedValue> args) {
5578 assert(args.size() == 3);
5579 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
5580 auto getDesc = [&](int i) {
5581 return isStaticallyPresent(args[i])
5582 ? fir::getBase(args[i])
5583 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
5584 };
5585 mlir::Value size = getDesc(0);
5586 mlir::Value put = getDesc(1);
5587 mlir::Value get = getDesc(2);
5588 fir::runtime::genRandomSeed(builder, loc, size, put, get);
5589}
5590
5591// REDUCE
5592fir::ExtendedValue
5593IntrinsicLibrary::genReduce(mlir::Type resultType,
5594 llvm::ArrayRef<fir::ExtendedValue> args) {
5595 TODO(loc, "intrinsic: reduce");
5596}
5597
5598// REPEAT
5599fir::ExtendedValue
5600IntrinsicLibrary::genRepeat(mlir::Type resultType,
5601 llvm::ArrayRef<fir::ExtendedValue> args) {
5602 assert(args.size() == 2);
5603 mlir::Value string = builder.createBox(loc, args[0]);
5604 mlir::Value ncopies = fir::getBase(args[1]);
5605 // Create mutable fir.box to be passed to the runtime for the result.
5606 fir::MutableBoxValue resultMutableBox =
5607 fir::factory::createTempMutableBox(builder, loc, resultType);
5608 mlir::Value resultIrBox =
5609 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
5610 // Call runtime. The runtime is allocating the result.
5611 fir::runtime::genRepeat(builder, loc, resultIrBox, string, ncopies);
5612 // Read result from mutable fir.box and add it to the list of temps to be
5613 // finalized by the StatementContext.
5614 return readAndAddCleanUp(resultMutableBox, resultType, "REPEAT");
5615}
5616
5617// RESHAPE
5618fir::ExtendedValue
5619IntrinsicLibrary::genReshape(mlir::Type resultType,
5620 llvm::ArrayRef<fir::ExtendedValue> args) {
5621 assert(args.size() == 4);
5622
5623 // Handle source argument
5624 mlir::Value source = builder.createBox(loc, args[0]);
5625
5626 // Handle shape argument
5627 mlir::Value shape = builder.createBox(loc, args[1]);
5628 assert(fir::BoxValue(shape).rank() == 1);
5629 mlir::Type shapeTy = shape.getType();
5630 mlir::Type shapeArrTy = fir::dyn_cast_ptrOrBoxEleTy(shapeTy);
5631 auto resultRank = shapeArrTy.cast<fir::SequenceType>().getShape()[0];
5632
5633 if (resultRank == fir::SequenceType::getUnknownExtent())
5634 TODO(loc, "intrinsic: reshape requires computing rank of result");
5635
5636 // Handle optional pad argument
5637 mlir::Value pad = isStaticallyAbsent(args[2])
5638 ? builder.create<fir::AbsentOp>(
5639 loc, fir::BoxType::get(builder.getI1Type()))
5640 : builder.createBox(loc, args[2]);
5641
5642 // Handle optional order argument
5643 mlir::Value order = isStaticallyAbsent(args[3])
5644 ? builder.create<fir::AbsentOp>(
5645 loc, fir::BoxType::get(builder.getI1Type()))
5646 : builder.createBox(loc, args[3]);
5647
5648 // Create mutable fir.box to be passed to the runtime for the result.
5649 mlir::Type type = builder.getVarLenSeqTy(resultType, resultRank);
5650 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(
5651 builder, loc, type, {},
5652 fir::isPolymorphicType(source.getType()) ? source : mlir::Value{});
5653
5654 mlir::Value resultIrBox =
5655 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
5656
5657 fir::runtime::genReshape(builder, loc, resultIrBox, source, shape, pad,
5658 order);
5659
5660 return readAndAddCleanUp(resultMutableBox, resultType, "RESHAPE");
5661}
5662
5663// RRSPACING
5664mlir::Value IntrinsicLibrary::genRRSpacing(mlir::Type resultType,
5665 llvm::ArrayRef<mlir::Value> args) {
5666 assert(args.size() == 1);
5667
5668 return builder.createConvert(
5669 loc, resultType,
5670 fir::runtime::genRRSpacing(builder, loc, fir::getBase(args[0])));
5671}
5672
5673// SAME_TYPE_AS
5674fir::ExtendedValue
5675IntrinsicLibrary::genSameTypeAs(mlir::Type resultType,
5676 llvm::ArrayRef<fir::ExtendedValue> args) {
5677 assert(args.size() == 2);
5678
5679 return builder.createConvert(
5680 loc, resultType,
5681 fir::runtime::genSameTypeAs(builder, loc, fir::getBase(args[0]),
5682 fir::getBase(args[1])));
5683}
5684
5685// SCALE
5686mlir::Value IntrinsicLibrary::genScale(mlir::Type resultType,
5687 llvm::ArrayRef<mlir::Value> args) {
5688 assert(args.size() == 2);
5689
5690 mlir::Value realX = fir::getBase(args[0]);
5691 mlir::Value intI = fir::getBase(args[1]);
5692
5693 return builder.createConvert(
5694 loc, resultType, fir::runtime::genScale(builder, loc, realX, intI));
5695}
5696
5697// SCAN
5698fir::ExtendedValue
5699IntrinsicLibrary::genScan(mlir::Type resultType,
5700 llvm::ArrayRef<fir::ExtendedValue> args) {
5701
5702 assert(args.size() == 4);
5703
5704 if (isStaticallyAbsent(args[3])) {
5705 // Kind not specified, so call scan/verify runtime routine that is
5706 // specialized on the kind of characters in string.
5707
5708 // Handle required string base arg
5709 mlir::Value stringBase = fir::getBase(args[0]);
5710
5711 // Handle required set string base arg
5712 mlir::Value setBase = fir::getBase(args[1]);
5713
5714 // Handle kind argument; it is the kind of character in this case
5715 fir::KindTy kind =
5716 fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
5717 stringBase.getType());
5718
5719 // Get string length argument
5720 mlir::Value stringLen = fir::getLen(args[0]);
5721
5722 // Get set string length argument
5723 mlir::Value setLen = fir::getLen(args[1]);
5724
5725 // Handle optional back argument
5726 mlir::Value back =
5727 isStaticallyAbsent(args[2])
5728 ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
5729 : fir::getBase(args[2]);
5730
5731 return builder.createConvert(loc, resultType,
5732 fir::runtime::genScan(builder, loc, kind,
5733 stringBase, stringLen,
5734 setBase, setLen, back));
5735 }
5736 // else use the runtime descriptor version of scan/verify
5737
5738 // Handle optional argument, back
5739 auto makeRefThenEmbox = [&](mlir::Value b) {
5740 fir::LogicalType logTy = fir::LogicalType::get(
5741 builder.getContext(), builder.getKindMap().defaultLogicalKind());
5742 mlir::Value temp = builder.createTemporary(loc, logTy);
5743 mlir::Value castb = builder.createConvert(loc, logTy, b);
5744 builder.create<fir::StoreOp>(loc, castb, temp);
5745 return builder.createBox(loc, temp);
5746 };
5747 mlir::Value back = fir::isUnboxedValue(args[2])
5748 ? makeRefThenEmbox(*args[2].getUnboxed())
5749 : builder.create<fir::AbsentOp>(
5750 loc, fir::BoxType::get(builder.getI1Type()));
5751
5752 // Handle required string argument
5753 mlir::Value string = builder.createBox(loc, args[0]);
5754
5755 // Handle required set argument
5756 mlir::Value set = builder.createBox(loc, args[1]);
5757
5758 // Handle kind argument
5759 mlir::Value kind = fir::getBase(args[3]);
5760
5761 // Create result descriptor
5762 fir::MutableBoxValue resultMutableBox =
5763 fir::factory::createTempMutableBox(builder, loc, resultType);
5764 mlir::Value resultIrBox =
5765 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
5766
5767 fir::runtime::genScanDescriptor(builder, loc, resultIrBox, string, set, back,
5768 kind);
5769
5770 // Handle cleanup of allocatable result descriptor and return
5771 return readAndAddCleanUp(resultMutableBox, resultType, "SCAN");
5772}
5773
5774// SELECTED_INT_KIND
5775mlir::Value
5776IntrinsicLibrary::genSelectedIntKind(mlir::Type resultType,
5777 llvm::ArrayRef<mlir::Value> args) {
5778 assert(args.size() == 1);
5779
5780 return builder.createConvert(
5781 loc, resultType,
5782 fir::runtime::genSelectedIntKind(builder, loc, fir::getBase(args[0])));
5783}
5784
5785// SELECTED_REAL_KIND
5786mlir::Value
5787IntrinsicLibrary::genSelectedRealKind(mlir::Type resultType,
5788 llvm::ArrayRef<mlir::Value> args) {
5789 assert(args.size() == 3);
5790
5791 // Handle optional precision(P) argument
5792 mlir::Value precision =
5793 isStaticallyAbsent(args[0])
5794 ? builder.create<fir::AbsentOp>(
5795 loc, fir::ReferenceType::get(builder.getI1Type()))
5796 : fir::getBase(args[0]);
5797
5798 // Handle optional range(R) argument
5799 mlir::Value range =
5800 isStaticallyAbsent(args[1])
5801 ? builder.create<fir::AbsentOp>(
5802 loc, fir::ReferenceType::get(builder.getI1Type()))
5803 : fir::getBase(args[1]);
5804
5805 // Handle optional radix(RADIX) argument
5806 mlir::Value radix =
5807 isStaticallyAbsent(args[2])
5808 ? builder.create<fir::AbsentOp>(
5809 loc, fir::ReferenceType::get(builder.getI1Type()))
5810 : fir::getBase(args[2]);
5811
5812 return builder.createConvert(
5813 loc, resultType,
5814 fir::runtime::genSelectedRealKind(builder, loc, precision, range, radix));
5815}
5816
5817// SET_EXPONENT
5818mlir::Value IntrinsicLibrary::genSetExponent(mlir::Type resultType,
5819 llvm::ArrayRef<mlir::Value> args) {
5820 assert(args.size() == 2);
5821
5822 return builder.createConvert(
5823 loc, resultType,
5824 fir::runtime::genSetExponent(builder, loc, fir::getBase(args[0]),
5825 fir::getBase(args[1])));
5826}
5827
5828// SHAPE
5829fir::ExtendedValue
5830IntrinsicLibrary::genShape(mlir::Type resultType,
5831 llvm::ArrayRef<fir::ExtendedValue> args) {
5832 assert(args.size() >= 1);
5833 const fir::ExtendedValue &array = args[0];
5834 int rank = array.rank();
5835 if (rank == 0)
5836 TODO(loc, "shape intrinsic lowering with assumed-rank source");
5837 mlir::Type indexType = builder.getIndexType();
5838 mlir::Type extentType = fir::unwrapSequenceType(resultType);
5839 mlir::Type seqType = fir::SequenceType::get(
5840 {static_cast<fir::SequenceType::Extent>(rank)}, extentType);
5841 mlir::Value shapeArray = builder.createTemporary(loc, seqType);
5842 mlir::Type shapeAddrType = builder.getRefType(extentType);
5843 for (int dim = 0; dim < rank; ++dim) {
5844 mlir::Value extent = fir::factory::readExtent(builder, loc, array, dim);
5845 extent = builder.createConvert(loc, extentType, extent);
5846 auto index = builder.createIntegerConstant(loc, indexType, dim);
5847 auto shapeAddr = builder.create<fir::CoordinateOp>(loc, shapeAddrType,
5848 shapeArray, index);
5849 builder.create<fir::StoreOp>(loc, extent, shapeAddr);
5850 }
5851 mlir::Value shapeArrayExtent =
5852 builder.createIntegerConstant(loc, indexType, rank);
5853 llvm::SmallVector<mlir::Value> extents{shapeArrayExtent};
5854 return fir::ArrayBoxValue{shapeArray, extents};
5855}
5856
5857// SHIFTL, SHIFTR
5858template <typename Shift>
5859mlir::Value IntrinsicLibrary::genShift(mlir::Type resultType,
5860 llvm::ArrayRef<mlir::Value> args) {
5861 assert(args.size() == 2);
5862
5863 // If SHIFT < 0 or SHIFT >= BIT_SIZE(I), return 0. This is not required by
5864 // the standard. However, several other compilers behave this way, so try and
5865 // maintain compatibility with them to an extent.
5866
5867 unsigned bits = resultType.getIntOrFloatBitWidth();
5868 mlir::Value bitSize = builder.createIntegerConstant(loc, resultType, bits);
5869 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
5870 mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
5871
5872 mlir::Value tooSmall = builder.create<mlir::arith::CmpIOp>(
5873 loc, mlir::arith::CmpIPredicate::slt, shift, zero);
5874 mlir::Value tooLarge = builder.create<mlir::arith::CmpIOp>(
5875 loc, mlir::arith::CmpIPredicate::sge, shift, bitSize);
5876 mlir::Value outOfBounds =
5877 builder.create<mlir::arith::OrIOp>(loc, tooSmall, tooLarge);
5878
5879 mlir::Value shifted = builder.create<Shift>(loc, args[0], shift);
5880 return builder.create<mlir::arith::SelectOp>(loc, outOfBounds, zero, shifted);
5881}
5882
5883// SHIFTA
5884mlir::Value IntrinsicLibrary::genShiftA(mlir::Type resultType,
5885 llvm::ArrayRef<mlir::Value> args) {
5886 unsigned bits = resultType.getIntOrFloatBitWidth();
5887 mlir::Value bitSize = builder.createIntegerConstant(loc, resultType, bits);
5888 mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
5889 mlir::Value shiftEqBitSize = builder.create<mlir::arith::CmpIOp>(
5890 loc, mlir::arith::CmpIPredicate::eq, shift, bitSize);
5891
5892 // Lowering of mlir::arith::ShRSIOp is using `ashr`. `ashr` is undefined when
5893 // the shift amount is equal to the element size.
5894 // So if SHIFT is equal to the bit width then it is handled as a special case.
5895 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
5896 mlir::Value minusOne = builder.createMinusOneInteger(loc, resultType);
5897 mlir::Value valueIsNeg = builder.create<mlir::arith::CmpIOp>(
5898 loc, mlir::arith::CmpIPredicate::slt, args[0], zero);
5899 mlir::Value specialRes =
5900 builder.create<mlir::arith::SelectOp>(loc, valueIsNeg, minusOne, zero);
5901
5902 mlir::Value shifted =
5903 builder.create<mlir::arith::ShRSIOp>(loc, args[0], shift);
5904 return builder.create<mlir::arith::SelectOp>(loc, shiftEqBitSize, specialRes,
5905 shifted);
5906}
5907
5908// SIGNAL
5909void IntrinsicLibrary::genSignalSubroutine(
5910 llvm::ArrayRef<fir::ExtendedValue> args) {
5911 assert(args.size() == 2 || args.size() == 3);
5912 mlir::Value number = fir::getBase(args[0]);
5913 mlir::Value handler = fir::getBase(args[1]);
5914 mlir::Value status;
5915 if (args.size() == 3)
5916 status = fir::getBase(args[2]);
5917 fir::runtime::genSignal(builder, loc, number, handler, status);
5918}
5919
5920// SIGN
5921mlir::Value IntrinsicLibrary::genSign(mlir::Type resultType,
5922 llvm::ArrayRef<mlir::Value> args) {
5923 assert(args.size() == 2);
5924 if (resultType.isa<mlir::IntegerType>()) {
5925 mlir::Value abs = genAbs(resultType, {args[0]});
5926 mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
5927 auto neg = builder.create<mlir::arith::SubIOp>(loc, zero, abs);
5928 auto cmp = builder.create<mlir::arith::CmpIOp>(
5929 loc, mlir::arith::CmpIPredicate::slt, args[1], zero);
5930 return builder.create<mlir::arith::SelectOp>(loc, cmp, neg, abs);
5931 }
5932 return genRuntimeCall("sign", resultType, args);
5933}
5934
5935// SIND
5936mlir::Value IntrinsicLibrary::genSind(mlir::Type resultType,
5937 llvm::ArrayRef<mlir::Value> args) {
5938 assert(args.size() == 1);
5939 mlir::MLIRContext *context = builder.getContext();
5940 mlir::FunctionType ftype =
5941 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});
5942 llvm::APFloat pi = llvm::APFloat(llvm::numbers::pi);
5943 mlir::Value dfactor = builder.createRealConstant(
5944 loc, mlir::FloatType::getF64(context), pi / llvm::APFloat(180.0));
5945 mlir::Value factor = builder.createConvert(loc, args[0].getType(), dfactor);
5946 mlir::Value arg = builder.create<mlir::arith::MulFOp>(loc, args[0], factor);
5947 return getRuntimeCallGenerator("sin", ftype)(builder, loc, {arg});
5948}
5949
5950// SIZE
5951fir::ExtendedValue
5952IntrinsicLibrary::genSize(mlir::Type resultType,
5953 llvm::ArrayRef<fir::ExtendedValue> args) {
5954 // Note that the value of the KIND argument is already reflected in the
5955 // resultType
5956 assert(args.size() == 3);
5957 if (const auto *boxValue = args[0].getBoxOf<fir::BoxValue>())
5958 if (boxValue->hasAssumedRank())
5959 TODO(loc, "intrinsic: size with assumed rank argument");
5960
5961 // Get the ARRAY argument
5962 mlir::Value array = builder.createBox(loc, args[0]);
5963
5964 // The front-end rewrites SIZE without the DIM argument to
5965 // an array of SIZE with DIM in most cases, but it may not be
5966 // possible in some cases like when in SIZE(function_call()).
5967 if (isStaticallyAbsent(args, 1))
5968 return builder.createConvert(loc, resultType,
5969 fir::runtime::genSize(builder, loc, array));
5970
5971 // Get the DIM argument.
5972 mlir::Value dim = fir::getBase(args[1]);
5973 if (std::optional<std::int64_t> cstDim = fir::getIntIfConstant(dim)) {
5974 // If it is a compile time constant, skip the runtime call.
5975 return builder.createConvert(loc, resultType,
5976 fir::factory::readExtent(builder, loc,
5977 fir::BoxValue{array},
5978 cstDim.value() - 1));
5979 }
5980 if (!fir::isa_ref_type(dim.getType()))
5981 return builder.createConvert(
5982 loc, resultType, fir::runtime::genSizeDim(builder, loc, array, dim));
5983
5984 mlir::Value isDynamicallyAbsent = builder.genIsNullAddr(loc, dim);
5985 return builder
5986 .genIfOp(loc, {resultType}, isDynamicallyAbsent,
5987 /*withElseRegion=*/true)
5988 .genThen([&]() {
5989 mlir::Value size = builder.createConvert(
5990 loc, resultType, fir::runtime::genSize(builder, loc, array));
5991 builder.create<fir::ResultOp>(loc, size);
5992 })
5993 .genElse([&]() {
5994 mlir::Value dimValue = builder.create<fir::LoadOp>(loc, dim);
5995 mlir::Value size = builder.createConvert(
5996 loc, resultType,
5997 fir::runtime::genSizeDim(builder, loc, array, dimValue));
5998 builder.create<fir::ResultOp>(loc, size);
5999 })
6000 .getResults()[0];
6001}
6002
6003// SIZEOF
6004fir::ExtendedValue
6005IntrinsicLibrary::genSizeOf(mlir::Type resultType,
6006 llvm::ArrayRef<fir::ExtendedValue> args) {
6007 assert(args.size() == 1);
6008 mlir::Value box = fir::getBase(args[0]);
6009 mlir::Value eleSize = builder.create<fir::BoxEleSizeOp>(loc, resultType, box);
6010 if (!fir::isArray(args[0]))
6011 return eleSize;
6012 mlir::Value arraySize = builder.createConvert(
6013 loc, resultType, fir::runtime::genSize(builder, loc, box));
6014 return builder.create<mlir::arith::MulIOp>(loc, eleSize, arraySize);
6015}
6016
6017// TAND
6018mlir::Value IntrinsicLibrary::genTand(mlir::Type resultType,
6019 llvm::ArrayRef<mlir::Value> args) {
6020 assert(args.size() == 1);
6021 mlir::MLIRContext *context = builder.getContext();
6022 mlir::FunctionType ftype =
6023 mlir::FunctionType::get(context, {resultType}, {args[0].getType()});
6024 llvm::APFloat pi = llvm::APFloat(llvm::numbers::pi);
6025 mlir::Value dfactor = builder.createRealConstant(
6026 loc, mlir::FloatType::getF64(context), pi / llvm::APFloat(180.0));
6027 mlir::Value factor = builder.createConvert(loc, args[0].getType(), dfactor);
6028 mlir::Value arg = builder.create<mlir::arith::MulFOp>(loc, args[0], factor);
6029 return getRuntimeCallGenerator("tan", ftype)(builder, loc, {arg});
6030}
6031
6032// TRAILZ
6033mlir::Value IntrinsicLibrary::genTrailz(mlir::Type resultType,
6034 llvm::ArrayRef<mlir::Value> args) {
6035 assert(args.size() == 1);
6036
6037 mlir::Value result =
6038 builder.create<mlir::math::CountTrailingZerosOp>(loc, args);
6039
6040 return builder.createConvert(loc, resultType, result);
6041}
6042
6043static bool hasDefaultLowerBound(const fir::ExtendedValue &exv) {
6044 return exv.match(
6045 [](const fir::ArrayBoxValue &arr) { return arr.getLBounds().empty(); },
6046 [](const fir::CharArrayBoxValue &arr) {
6047 return arr.getLBounds().empty();
6048 },
6049 [](const fir::BoxValue &arr) { return arr.getLBounds().empty(); },
6050 [](const auto &) { return false; });
6051}
6052
6053/// Compute the lower bound in dimension \p dim (zero based) of \p array
6054/// taking care of returning one when the related extent is zero.
6055static mlir::Value computeLBOUND(fir::FirOpBuilder &builder, mlir::Location loc,
6056 const fir::ExtendedValue &array, unsigned dim,
6057 mlir::Value zero, mlir::Value one) {
6058 assert(dim < array.rank() && "invalid dimension");
6059 if (hasDefaultLowerBound(array))
6060 return one;
6061 mlir::Value lb = fir::factory::readLowerBound(builder, loc, array, dim, one);
6062 mlir::Value extent = fir::factory::readExtent(builder, loc, array, dim);
6063 zero = builder.createConvert(loc, extent.getType(), zero);
6064 // Note: for assumed size, the extent is -1, and the lower bound should
6065 // be returned. It is important to test extent == 0 and not extent > 0.
6066 auto dimIsEmpty = builder.create<mlir::arith::CmpIOp>(
6067 loc, mlir::arith::CmpIPredicate::eq, extent, zero);
6068 one = builder.createConvert(loc, lb.getType(), one);
6069 return builder.create<mlir::arith::SelectOp>(loc, dimIsEmpty, one, lb);
6070}
6071
6072/// Create a fir.box to be passed to the LBOUND/UBOUND runtime.
6073/// This ensure that local lower bounds of assumed shape are propagated and that
6074/// a fir.box with equivalent LBOUNDs.
6075static mlir::Value
6076createBoxForRuntimeBoundInquiry(mlir::Location loc, fir::FirOpBuilder &builder,
6077 const fir::ExtendedValue &array) {
6078 return array.match(
6079 [&](const fir::BoxValue &boxValue) -> mlir::Value {
6080 // This entity is mapped to a fir.box that may not contain the local
6081 // lower bound information if it is a dummy. Rebox it with the local
6082 // shape information.
6083 mlir::Value localShape = builder.createShape(loc, array);
6084 mlir::Value oldBox = boxValue.getAddr();
6085 return builder.create<fir::ReboxOp>(loc, oldBox.getType(), oldBox,
6086 localShape,
6087 /*slice=*/mlir::Value{});
6088 },
6089 [&](const auto &) -> mlir::Value {
6090 // This is a pointer/allocatable, or an entity not yet tracked with a
6091 // fir.box. For pointer/allocatable, createBox will forward the
6092 // descriptor that contains the correct lower bound information. For
6093 // other entities, a new fir.box will be made with the local lower
6094 // bounds.
6095 return builder.createBox(loc, array);
6096 });
6097}
6098
6099// LBOUND
6100fir::ExtendedValue
6101IntrinsicLibrary::genLbound(mlir::Type resultType,
6102 llvm::ArrayRef<fir::ExtendedValue> args) {
6103 assert(args.size() == 2 || args.size() == 3);
6104 const fir::ExtendedValue &array = args[0];
6105 if (const auto *boxValue = array.getBoxOf<fir::BoxValue>())
6106 if (boxValue->hasAssumedRank())
6107 TODO(loc, "intrinsic: lbound with assumed rank argument");
6108
6109 mlir::Type indexType = builder.getIndexType();
6110
6111 // Semantics builds signatures for LBOUND calls as either
6112 // LBOUND(array, dim, [kind]) or LBOUND(array, [kind]).
6113 if (args.size() == 2 || isStaticallyAbsent(args, 1)) {
6114 // DIM is absent.
6115 mlir::Type lbType = fir::unwrapSequenceType(resultType);
6116 unsigned rank = array.rank();
6117 mlir::Type lbArrayType = fir::SequenceType::get(
6118 {static_cast<fir::SequenceType::Extent>(array.rank())}, lbType);
6119 mlir::Value lbArray = builder.createTemporary(loc, lbArrayType);
6120 mlir::Type lbAddrType = builder.getRefType(lbType);
6121 mlir::Value one = builder.createIntegerConstant(loc, lbType, 1);
6122 mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0);
6123 for (unsigned dim = 0; dim < rank; ++dim) {
6124 mlir::Value lb = computeLBOUND(builder, loc, array, dim, zero, one);
6125 lb = builder.createConvert(loc, lbType, lb);
6126 auto index = builder.createIntegerConstant(loc, indexType, dim);
6127 auto lbAddr =
6128 builder.create<fir::CoordinateOp>(loc, lbAddrType, lbArray, index);
6129 builder.create<fir::StoreOp>(loc, lb, lbAddr);
6130 }
6131 mlir::Value lbArrayExtent =
6132 builder.createIntegerConstant(loc, indexType, rank);
6133 llvm::SmallVector<mlir::Value> extents{lbArrayExtent};
6134 return fir::ArrayBoxValue{lbArray, extents};
6135 }
6136 // DIM is present.
6137 mlir::Value dim = fir::getBase(args[1]);
6138
6139 // If it is a compile time constant, skip the runtime call.
6140 if (std::optional<std::int64_t> cstDim = fir::getIntIfConstant(dim)) {
6141 mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
6142 mlir::Value zero = builder.createIntegerConstant(loc, indexType, 0);
6143 mlir::Value lb = computeLBOUND(builder, loc, array, *cstDim - 1, zero, one);
6144 return builder.createConvert(loc, resultType, lb);
6145 }
6146
6147 fir::ExtendedValue box = createBoxForRuntimeBoundInquiry(loc, builder, array);
6148 return builder.createConvert(
6149 loc, resultType,
6150 fir::runtime::genLboundDim(builder, loc, fir::getBase(box), dim));
6151}
6152
6153// UBOUND
6154fir::ExtendedValue
6155IntrinsicLibrary::genUbound(mlir::Type resultType,
6156 llvm::ArrayRef<fir::ExtendedValue> args) {
6157 assert(args.size() == 3 || args.size() == 2);
6158 if (args.size() == 3) {
6159 // Handle calls to UBOUND with the DIM argument, which return a scalar
6160 mlir::Value extent = fir::getBase(genSize(resultType, args));
6161 mlir::Value lbound = fir::getBase(genLbound(resultType, args));
6162
6163 mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
6164 mlir::Value ubound = builder.create<mlir::arith::SubIOp>(loc, lbound, one);
6165 return builder.create<mlir::arith::AddIOp>(loc, ubound, extent);
6166 } else {
6167 // Handle calls to UBOUND without the DIM argument, which return an array
6168 mlir::Value kind = isStaticallyAbsent(args[1])
6169 ? builder.createIntegerConstant(
6170 loc, builder.getIndexType(),
6171 builder.getKindMap().defaultIntegerKind())
6172 : fir::getBase(args[1]);
6173
6174 // Create mutable fir.box to be passed to the runtime for the result.
6175 mlir::Type type = builder.getVarLenSeqTy(resultType, /*rank=*/1);
6176 fir::MutableBoxValue resultMutableBox =
6177 fir::factory::createTempMutableBox(builder, loc, type);
6178 mlir::Value resultIrBox =
6179 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
6180
6181 fir::ExtendedValue box =
6182 createBoxForRuntimeBoundInquiry(loc, builder, args[0]);
6183 fir::runtime::genUbound(builder, loc, resultIrBox, fir::getBase(box), kind);
6184
6185 return readAndAddCleanUp(resultMutableBox, resultType, "UBOUND");
6186 }
6187 return mlir::Value();
6188}
6189
6190// SPACING
6191mlir::Value IntrinsicLibrary::genSpacing(mlir::Type resultType,
6192 llvm::ArrayRef<mlir::Value> args) {
6193 assert(args.size() == 1);
6194
6195 return builder.createConvert(
6196 loc, resultType,
6197 fir::runtime::genSpacing(builder, loc, fir::getBase(args[0])));
6198}
6199
6200// SPREAD
6201fir::ExtendedValue
6202IntrinsicLibrary::genSpread(mlir::Type resultType,
6203 llvm::ArrayRef<fir::ExtendedValue> args) {
6204
6205 assert(args.size() == 3);
6206
6207 // Handle source argument
6208 mlir::Value source = builder.createBox(loc, args[0]);
6209 fir::BoxValue sourceTmp = source;
6210 unsigned sourceRank = sourceTmp.rank();
6211
6212 // Handle Dim argument
6213 mlir::Value dim = fir::getBase(args[1]);
6214
6215 // Handle ncopies argument
6216 mlir::Value ncopies = fir::getBase(args[2]);
6217
6218 // Generate result descriptor
6219 mlir::Type resultArrayType =
6220 builder.getVarLenSeqTy(resultType, sourceRank + 1);
6221 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(
6222 builder, loc, resultArrayType, {},
6223 fir::isPolymorphicType(source.getType()) ? source : mlir::Value{});
6224 mlir::Value resultIrBox =
6225 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
6226
6227 fir::runtime::genSpread(builder, loc, resultIrBox, source, dim, ncopies);
6228
6229 return readAndAddCleanUp(resultMutableBox, resultType, "SPREAD");
6230}
6231
6232// STORAGE_SIZE
6233fir::ExtendedValue
6234IntrinsicLibrary::genStorageSize(mlir::Type resultType,
6235 llvm::ArrayRef<fir::ExtendedValue> args) {
6236 assert(args.size() == 2 || args.size() == 1);
6237 mlir::Value box = fir::getBase(args[0]);
6238 mlir::Type boxTy = box.getType();
6239 mlir::Type kindTy = builder.getDefaultIntegerType();
6240 bool needRuntimeCheck = false;
6241 std::string errorMsg;
6242
6243 if (fir::isUnlimitedPolymorphicType(boxTy) &&
6244 (fir::isAllocatableType(boxTy) || fir::isPointerType(boxTy))) {
6245 needRuntimeCheck = true;
6246 errorMsg =
6247 fir::isPointerType(boxTy)
6248 ? "unlimited polymorphic disassociated POINTER in STORAGE_SIZE"
6249 : "unlimited polymorphic unallocated ALLOCATABLE in STORAGE_SIZE";
6250 }
6251 const fir::MutableBoxValue *mutBox = args[0].getBoxOf<fir::MutableBoxValue>();
6252 if (needRuntimeCheck && mutBox) {
6253 mlir::Value isNotAllocOrAssoc =
6254 fir::factory::genIsNotAllocatedOrAssociatedTest(builder, loc, *mutBox);
6255 builder.genIfThen(loc, isNotAllocOrAssoc)
6256 .genThen([&]() {
6257 fir::runtime::genReportFatalUserError(builder, loc, errorMsg);
6258 })
6259 .end();
6260 }
6261
6262 // Handle optional kind argument
6263 bool absentKind = isStaticallyAbsent(args, 1);
6264 if (!absentKind) {
6265 mlir::Operation *defKind = fir::getBase(args[1]).getDefiningOp();
6266 assert(mlir::isa<mlir::arith::ConstantOp>(*defKind) &&
6267 "kind not a constant");
6268 auto constOp = mlir::dyn_cast<mlir::arith::ConstantOp>(*defKind);
6269 kindTy = builder.getIntegerType(
6270 builder.getKindMap().getIntegerBitsize(fir::toInt(constOp)));
6271 }
6272
6273 box = builder.createBox(loc, args[0],
6274 /*isPolymorphic=*/args[0].isPolymorphic());
6275 mlir::Value eleSize = builder.create<fir::BoxEleSizeOp>(loc, kindTy, box);
6276 mlir::Value c8 = builder.createIntegerConstant(loc, kindTy, 8);
6277 return builder.create<mlir::arith::MulIOp>(loc, eleSize, c8);
6278}
6279
6280// SUM
6281fir::ExtendedValue
6282IntrinsicLibrary::genSum(mlir::Type resultType,
6283 llvm::ArrayRef<fir::ExtendedValue> args) {
6284 return genReduction(fir::runtime::genSum, fir::runtime::genSumDim, "SUM",
6285 resultType, args);
6286}
6287
6288// SYSTEM
6289void IntrinsicLibrary::genSystem(llvm::ArrayRef<fir::ExtendedValue> args) {
6290 assert(args.size() == 2);
6291 mlir::Value command = fir::getBase(args[0]);
6292 const fir::ExtendedValue &exitstat = args[1];
6293 assert(command && "expected COMMAND parameter");
6294
6295 mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
6296
6297 mlir::Value waitBool = builder.createBool(loc, true);
6298 mlir::Value exitstatBox =
6299 isStaticallyPresent(exitstat)
6300 ? fir::getBase(exitstat)
6301 : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
6302
6303 // Create a dummmy cmdstat to prevent EXECUTE_COMMAND_LINE terminate itself
6304 // when cmdstat is assigned with a non-zero value but not present
6305 mlir::Value tempValue =
6306 builder.createIntegerConstant(loc, builder.getI2Type(), 0);
6307 mlir::Value temp = builder.createTemporary(loc, builder.getI16Type());
6308 mlir::Value castVal =
6309 builder.createConvert(loc, builder.getI16Type(), tempValue);
6310 builder.create<fir::StoreOp>(loc, castVal, temp);
6311 mlir::Value cmdstatBox = builder.createBox(loc, temp);
6312
6313 mlir::Value cmdmsgBox =
6314 builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
6315
6316 fir::runtime::genExecuteCommandLine(builder, loc, command, waitBool,
6317 exitstatBox, cmdstatBox, cmdmsgBox);
6318}
6319
6320// SYSTEM_CLOCK
6321void IntrinsicLibrary::genSystemClock(llvm::ArrayRef<fir::ExtendedValue> args) {
6322 assert(args.size() == 3);
6323 fir::runtime::genSystemClock(builder, loc, fir::getBase(args[0]),
6324 fir::getBase(args[1]), fir::getBase(args[2]));
6325}
6326
6327// SLEEP
6328void IntrinsicLibrary::genSleep(llvm::ArrayRef<fir::ExtendedValue> args) {
6329 assert(args.size() == 1 && "SLEEP has one compulsory argument");
6330 fir::runtime::genSleep(builder, loc, fir::getBase(args[0]));
6331}
6332
6333// TRANSFER
6334fir::ExtendedValue
6335IntrinsicLibrary::genTransfer(mlir::Type resultType,
6336 llvm::ArrayRef<fir::ExtendedValue> args) {
6337
6338 assert(args.size() >= 2); // args.size() == 2 when size argument is omitted.
6339
6340 // Handle source argument
6341 mlir::Value source = builder.createBox(loc, args[0]);
6342
6343 // Handle mold argument
6344 mlir::Value mold = builder.createBox(loc, args[1]);
6345 fir::BoxValue moldTmp = mold;
6346 unsigned moldRank = moldTmp.rank();
6347
6348 bool absentSize = (args.size() == 2);
6349
6350 // Create mutable fir.box to be passed to the runtime for the result.
6351 mlir::Type type = (moldRank == 0 && absentSize)
6352 ? resultType
6353 : builder.getVarLenSeqTy(resultType, 1);
6354 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(
6355 builder, loc, type, {},
6356 fir::isPolymorphicType(mold.getType()) ? mold : mlir::Value{});
6357
6358 if (moldRank == 0 && absentSize) {
6359 // This result is a scalar in this case.
6360 mlir::Value resultIrBox =
6361 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
6362
6363 fir::runtime::genTransfer(builder, loc, resultIrBox, source, mold);
6364 } else {
6365 // The result is a rank one array in this case.
6366 mlir::Value resultIrBox =
6367 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
6368
6369 if (absentSize) {
6370 fir::runtime::genTransfer(builder, loc, resultIrBox, source, mold);
6371 } else {
6372 mlir::Value sizeArg = fir::getBase(args[2]);
6373 fir::runtime::genTransferSize(builder, loc, resultIrBox, source, mold,
6374 sizeArg);
6375 }
6376 }
6377 return readAndAddCleanUp(resultMutableBox, resultType, "TRANSFER");
6378}
6379
6380// TRANSPOSE
6381fir::ExtendedValue
6382IntrinsicLibrary::genTranspose(mlir::Type resultType,
6383 llvm::ArrayRef<fir::ExtendedValue> args) {
6384
6385 assert(args.size() == 1);
6386
6387 // Handle source argument
6388 mlir::Value source = builder.createBox(loc, args[0]);
6389
6390 // Create mutable fir.box to be passed to the runtime for the result.
6391 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, 2);
6392 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(
6393 builder, loc, resultArrayType, {},
6394 fir::isPolymorphicType(source.getType()) ? source : mlir::Value{});
6395 mlir::Value resultIrBox =
6396 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
6397 // Call runtime. The runtime is allocating the result.
6398 fir::runtime::genTranspose(builder, loc, resultIrBox, source);
6399 // Read result from mutable fir.box and add it to the list of temps to be
6400 // finalized by the StatementContext.
6401 return readAndAddCleanUp(resultMutableBox, resultType, "TRANSPOSE");
6402}
6403
6404// TRIM
6405fir::ExtendedValue
6406IntrinsicLibrary::genTrim(mlir::Type resultType,
6407 llvm::ArrayRef<fir::ExtendedValue> args) {
6408 assert(args.size() == 1);
6409 mlir::Value string = builder.createBox(loc, args[0]);
6410 // Create mutable fir.box to be passed to the runtime for the result.
6411 fir::MutableBoxValue resultMutableBox =
6412 fir::factory::createTempMutableBox(builder, loc, resultType);
6413 mlir::Value resultIrBox =
6414 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
6415 // Call runtime. The runtime is allocating the result.
6416 fir::runtime::genTrim(builder, loc, resultIrBox, string);
6417 // Read result from mutable fir.box and add it to the list of temps to be
6418 // finalized by the StatementContext.
6419 return readAndAddCleanUp(resultMutableBox, resultType, "TRIM");
6420}
6421
6422// Compare two FIR values and return boolean result as i1.
6423template <Extremum extremum, ExtremumBehavior behavior>
6424static mlir::Value createExtremumCompare(mlir::Location loc,
6425 fir::FirOpBuilder &builder,
6426 mlir::Value left, mlir::Value right) {
6427 static constexpr mlir::arith::CmpIPredicate integerPredicate =
6428 extremum == Extremum::Max ? mlir::arith::CmpIPredicate::sgt
6429 : mlir::arith::CmpIPredicate::slt;
6430 static constexpr mlir::arith::CmpFPredicate orderedCmp =
6431 extremum == Extremum::Max ? mlir::arith::CmpFPredicate::OGT
6432 : mlir::arith::CmpFPredicate::OLT;
6433 mlir::Type type = left.getType();
6434 mlir::Value result;
6435 if (fir::isa_real(type)) {
6436 // Note: the signaling/quit aspect of the result required by IEEE
6437 // cannot currently be obtained with LLVM without ad-hoc runtime.
6438 if constexpr (behavior == ExtremumBehavior::IeeeMinMaximumNumber) {
6439 // Return the number if one of the inputs is NaN and the other is
6440 // a number.
6441 auto leftIsResult =
6442 builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
6443 auto rightIsNan = builder.create<mlir::arith::CmpFOp>(
6444 loc, mlir::arith::CmpFPredicate::UNE, right, right);
6445 result =
6446 builder.create<mlir::arith::OrIOp>(loc, leftIsResult, rightIsNan);
6447 } else if constexpr (behavior == ExtremumBehavior::IeeeMinMaximum) {
6448 // Always return NaNs if one the input is NaNs
6449 auto leftIsResult =
6450 builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
6451 auto leftIsNan = builder.create<mlir::arith::CmpFOp>(
6452 loc, mlir::arith::CmpFPredicate::UNE, left, left);
6453 result = builder.create<mlir::arith::OrIOp>(loc, leftIsResult, leftIsNan);
6454 } else if constexpr (behavior == ExtremumBehavior::MinMaxss) {
6455 // If the left is a NaN, return the right whatever it is.
6456 result =
6457 builder.create<mlir::arith::CmpFOp>(loc, orderedCmp, left, right);
6458 } else if constexpr (behavior == ExtremumBehavior::PgfortranLlvm) {
6459 // If one of the operand is a NaN, return left whatever it is.
6460 static constexpr auto unorderedCmp =
6461 extremum == Extremum::Max ? mlir::arith::CmpFPredicate::UGT
6462 : mlir::arith::CmpFPredicate::ULT;
6463 result =
6464 builder.create<mlir::arith::CmpFOp>(loc, unorderedCmp, left, right);
6465 } else {
6466 // TODO: ieeeMinNum/ieeeMaxNum
6467 static_assert(behavior == ExtremumBehavior::IeeeMinMaxNum,
6468 "ieeeMinNum/ieeeMaxNum behavior not implemented");
6469 }
6470 } else if (fir::isa_integer(type)) {
6471 result =
6472 builder.create<mlir::arith::CmpIOp>(loc, integerPredicate, left, right);
6473 } else if (fir::isa_char(type) || fir::isa_char(fir::unwrapRefType(type))) {
6474 // TODO: ! character min and max is tricky because the result
6475 // length is the length of the longest argument!
6476 // So we may need a temp.
6477 TODO(loc, "intrinsic: min and max for CHARACTER");
6478 }
6479 assert(result && "result must be defined");
6480 return result;
6481}
6482
6483// UNPACK
6484fir::ExtendedValue
6485IntrinsicLibrary::genUnpack(mlir::Type resultType,
6486 llvm::ArrayRef<fir::ExtendedValue> args) {
6487 assert(args.size() == 3);
6488
6489 // Handle required vector argument
6490 mlir::Value vector = builder.createBox(loc, args[0]);
6491
6492 // Handle required mask argument
6493 fir::BoxValue maskBox = builder.createBox(loc, args[1]);
6494 mlir::Value mask = fir::getBase(maskBox);
6495 unsigned maskRank = maskBox.rank();
6496
6497 // Handle required field argument
6498 mlir::Value field = builder.createBox(loc, args[2]);
6499
6500 // Create mutable fir.box to be passed to the runtime for the result.
6501 mlir::Type resultArrayType = builder.getVarLenSeqTy(resultType, maskRank);
6502 fir::MutableBoxValue resultMutableBox = fir::factory::createTempMutableBox(
6503 builder, loc, resultArrayType, {},
6504 fir::isPolymorphicType(vector.getType()) ? vector : mlir::Value{});
6505 mlir::Value resultIrBox =
6506 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
6507
6508 fir::runtime::genUnpack(builder, loc, resultIrBox, vector, mask, field);
6509
6510 return readAndAddCleanUp(resultMutableBox, resultType, "UNPACK");
6511}
6512
6513// VERIFY
6514fir::ExtendedValue
6515IntrinsicLibrary::genVerify(mlir::Type resultType,
6516 llvm::ArrayRef<fir::ExtendedValue> args) {
6517
6518 assert(args.size() == 4);
6519
6520 if (isStaticallyAbsent(args[3])) {
6521 // Kind not specified, so call scan/verify runtime routine that is
6522 // specialized on the kind of characters in string.
6523
6524 // Handle required string base arg
6525 mlir::Value stringBase = fir::getBase(args[0]);
6526
6527 // Handle required set string base arg
6528 mlir::Value setBase = fir::getBase(args[1]);
6529
6530 // Handle kind argument; it is the kind of character in this case
6531 fir::KindTy kind =
6532 fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
6533 stringBase.getType());
6534
6535 // Get string length argument
6536 mlir::Value stringLen = fir::getLen(args[0]);
6537
6538 // Get set string length argument
6539 mlir::Value setLen = fir::getLen(args[1]);
6540
6541 // Handle optional back argument
6542 mlir::Value back =
6543 isStaticallyAbsent(args[2])
6544 ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
6545 : fir::getBase(args[2]);
6546
6547 return builder.createConvert(
6548 loc, resultType,
6549 fir::runtime::genVerify(builder, loc, kind, stringBase, stringLen,
6550 setBase, setLen, back));
6551 }
6552 // else use the runtime descriptor version of scan/verify
6553
6554 // Handle optional argument, back
6555 auto makeRefThenEmbox = [&](mlir::Value b) {
6556 fir::LogicalType logTy = fir::LogicalType::get(
6557 builder.getContext(), builder.getKindMap().defaultLogicalKind());
6558 mlir::Value temp = builder.createTemporary(loc, logTy);
6559 mlir::Value castb = builder.createConvert(loc, logTy, b);
6560 builder.create<fir::StoreOp>(loc, castb, temp);
6561 return builder.createBox(loc, temp);
6562 };
6563 mlir::Value back = fir::isUnboxedValue(args[2])
6564 ? makeRefThenEmbox(*args[2].getUnboxed())
6565 : builder.create<fir::AbsentOp>(
6566 loc, fir::BoxType::get(builder.getI1Type()));
6567
6568 // Handle required string argument
6569 mlir::Value string = builder.createBox(loc, args[0]);
6570
6571 // Handle required set argument
6572 mlir::Value set = builder.createBox(loc, args[1]);
6573
6574 // Handle kind argument
6575 mlir::Value kind = fir::getBase(args[3]);
6576
6577 // Create result descriptor
6578 fir::MutableBoxValue resultMutableBox =
6579 fir::factory::createTempMutableBox(builder, loc, resultType);
6580 mlir::Value resultIrBox =
6581 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
6582
6583 fir::runtime::genVerifyDescriptor(builder, loc, resultIrBox, string, set,
6584 back, kind);
6585
6586 // Handle cleanup of allocatable result descriptor and return
6587 return readAndAddCleanUp(resultMutableBox, resultType, "VERIFY");
6588}
6589
6590/// Process calls to Minloc, Maxloc intrinsic functions
6591template <typename FN, typename FD>
6592fir::ExtendedValue
6593IntrinsicLibrary::genExtremumloc(FN func, FD funcDim, llvm::StringRef errMsg,
6594 mlir::Type resultType,
6595 llvm::ArrayRef<fir::ExtendedValue> args) {
6596
6597 assert(args.size() == 5);
6598
6599 // Handle required array argument
6600 mlir::Value array = builder.createBox(loc, args[0]);
6601 unsigned rank = fir::BoxValue(array).rank();
6602 assert(rank >= 1);
6603
6604 // Handle optional mask argument
6605 auto mask = isStaticallyAbsent(args[2])
6606 ? builder.create<fir::AbsentOp>(
6607 loc, fir::BoxType::get(builder.getI1Type()))
6608 : builder.createBox(loc, args[2]);
6609
6610 // Handle optional kind argument
6611 auto kind = isStaticallyAbsent(args[3])
6612 ? builder.createIntegerConstant(
6613 loc, builder.getIndexType(),
6614 builder.getKindMap().defaultIntegerKind())
6615 : fir::getBase(args[3]);
6616
6617 // Handle optional back argument
6618 auto back = isStaticallyAbsent(args[4]) ? builder.createBool(loc, false)
6619 : fir::getBase(args[4]);
6620
6621 bool absentDim = isStaticallyAbsent(args[1]);
6622
6623 if (!absentDim && rank == 1) {
6624 // If dim argument is present and the array is rank 1, then the result is
6625 // a scalar (since the the result is rank-1 or 0).
6626 // Therefore, we use a scalar result descriptor with Min/MaxlocDim().
6627 mlir::Value dim = fir::getBase(args[1]);
6628 // Create mutable fir.box to be passed to the runtime for the result.
6629 fir::MutableBoxValue resultMutableBox =
6630 fir::factory::createTempMutableBox(builder, loc, resultType);
6631 mlir::Value resultIrBox =
6632 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
6633
6634 funcDim(builder, loc, resultIrBox, array, dim, mask, kind, back);
6635
6636 // Handle cleanup of allocatable result descriptor and return
6637 return readAndAddCleanUp(resultMutableBox, resultType, errMsg);
6638 }
6639
6640 // Note: The Min/Maxloc/val cases below have an array result.
6641
6642 // Create mutable fir.box to be passed to the runtime for the result.
6643 mlir::Type resultArrayType =
6644 builder.getVarLenSeqTy(resultType, absentDim ? 1 : rank - 1);
6645 fir::MutableBoxValue resultMutableBox =
6646 fir::factory::createTempMutableBox(builder, loc, resultArrayType);
6647 mlir::Value resultIrBox =
6648 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
6649
6650 if (absentDim) {
6651 // Handle min/maxloc/val case where there is no dim argument
6652 // (calls Min/Maxloc()/MinMaxval() runtime routine)
6653 func(builder, loc, resultIrBox, array, mask, kind, back);
6654 } else {
6655 // else handle min/maxloc case with dim argument (calls
6656 // Min/Max/loc/val/Dim() runtime routine).
6657 mlir::Value dim = fir::getBase(args[1]);
6658 funcDim(builder, loc, resultIrBox, array, dim, mask, kind, back);
6659 }
6660 return readAndAddCleanUp(resultMutableBox, resultType, errMsg);
6661}
6662
6663// MAXLOC
6664fir::ExtendedValue
6665IntrinsicLibrary::genMaxloc(mlir::Type resultType,
6666 llvm::ArrayRef<fir::ExtendedValue> args) {
6667 return genExtremumloc(fir::runtime::genMaxloc, fir::runtime::genMaxlocDim,
6668 "MAXLOC", resultType, args);
6669}
6670
6671/// Process calls to Maxval and Minval
6672template <typename FN, typename FD, typename FC>
6673fir::ExtendedValue
6674IntrinsicLibrary::genExtremumVal(FN func, FD funcDim, FC funcChar,
6675 llvm::StringRef errMsg, mlir::Type resultType,
6676 llvm::ArrayRef<fir::ExtendedValue> args) {
6677
6678 assert(args.size() == 3);
6679
6680 // Handle required array argument
6681 fir::BoxValue arryTmp = builder.createBox(loc, args[0]);
6682 mlir::Value array = fir::getBase(arryTmp);
6683 int rank = arryTmp.rank();
6684 assert(rank >= 1);
6685 bool hasCharacterResult = arryTmp.isCharacter();
6686
6687 // Handle optional mask argument
6688 auto mask = isStaticallyAbsent(args[2])
6689 ? builder.create<fir::AbsentOp>(
6690 loc, fir::BoxType::get(builder.getI1Type()))
6691 : builder.createBox(loc, args[2]);
6692
6693 bool absentDim = isStaticallyAbsent(args[1]);
6694
6695 // For Maxval/MinVal, we call the type specific versions of
6696 // Maxval/Minval because the result is scalar in the case below.
6697 if (!hasCharacterResult && (absentDim || rank == 1))
6698 return func(builder, loc, array, mask);
6699
6700 if (hasCharacterResult && (absentDim || rank == 1)) {
6701 // Create mutable fir.box to be passed to the runtime for the result.
6702 fir::MutableBoxValue resultMutableBox =
6703 fir::factory::createTempMutableBox(builder, loc, resultType);
6704 mlir::Value resultIrBox =
6705 fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
6706
6707 funcChar(builder, loc, resultIrBox, array, mask);
6708
6709 // Handle cleanup of allocatable result descriptor and return
6710 return readAndAddCleanUp(resultMutableBox, resultType, errMsg);
6711 }
6712
6713 // Handle Min/Maxval cases that have an array result.
6714 auto resultMutableBox =
6715 genFuncDim(funcDim, resultType, builder, loc, array, args[1], mask, rank);
6716 return readAndAddCleanUp(resultMutableBox, resultType, errMsg);
6717}
6718
6719// MAXVAL
6720fir::ExtendedValue
6721IntrinsicLibrary::genMaxval(mlir::Type resultType,
6722 llvm::ArrayRef<fir::ExtendedValue> args) {
6723 return genExtremumVal(fir::runtime::genMaxval, fir::runtime::genMaxvalDim,
6724 fir::runtime::genMaxvalChar, "MAXVAL", resultType,
6725 args);
6726}
6727
6728// MINLOC
6729fir::ExtendedValue
6730IntrinsicLibrary::genMinloc(mlir::Type resultType,
6731 llvm::ArrayRef<fir::ExtendedValue> args) {
6732 return genExtremumloc(fir::runtime::genMinloc, fir::runtime::genMinlocDim,
6733 "MINLOC", resultType, args);
6734}
6735
6736// MINVAL
6737fir::ExtendedValue
6738IntrinsicLibrary::genMinval(mlir::Type resultType,
6739 llvm::ArrayRef<fir::ExtendedValue> args) {
6740 return genExtremumVal(fir::runtime::genMinval, fir::runtime::genMinvalDim,
6741 fir::runtime::genMinvalChar, "MINVAL", resultType,
6742 args);
6743}
6744
6745// MIN and MAX
6746template <Extremum extremum, ExtremumBehavior behavior>
6747mlir::Value IntrinsicLibrary::genExtremum(mlir::Type,
6748 llvm::ArrayRef<mlir::Value> args) {
6749 assert(args.size() >= 1);
6750 mlir::Value result = args[0];
6751 for (auto arg : args.drop_front()) {
6752 mlir::Value mask =
6753 createExtremumCompare<extremum, behavior>(loc, builder, result, arg);
6754 result = builder.create<mlir::arith::SelectOp>(loc, mask, result, arg);
6755 }
6756 return result;
6757}
6758
6759//===----------------------------------------------------------------------===//
6760// Argument lowering rules interface for intrinsic or intrinsic module
6761// procedure.
6762//===----------------------------------------------------------------------===//
6763
6764const IntrinsicArgumentLoweringRules *
6765getIntrinsicArgumentLowering(llvm::StringRef specificName) {
6766 llvm::StringRef name = genericName(specificName);
6767 if (const IntrinsicHandler *handler = findIntrinsicHandler(name))
6768 if (!handler->argLoweringRules.hasDefaultRules())
6769 return &handler->argLoweringRules;
6770 if (const IntrinsicHandler *ppcHandler = findPPCIntrinsicHandler(name))
6771 if (!ppcHandler->argLoweringRules.hasDefaultRules())
6772 return &ppcHandler->argLoweringRules;
6773 return nullptr;
6774}
6775
6776/// Return how argument \p argName should be lowered given the rules for the
6777/// intrinsic function.
6778fir::ArgLoweringRule
6779lowerIntrinsicArgumentAs(const IntrinsicArgumentLoweringRules &rules,
6780 unsigned position) {
6781 assert(position < sizeof(rules.args) / (sizeof(decltype(*rules.args))) &&
6782 "invalid argument");
6783 return {rules.args[position].lowerAs,
6784 rules.args[position].handleDynamicOptional};
6785}
6786
6787//===----------------------------------------------------------------------===//
6788// Public intrinsic call helpers
6789//===----------------------------------------------------------------------===//
6790
6791std::pair<fir::ExtendedValue, bool>
6792genIntrinsicCall(fir::FirOpBuilder &builder, mlir::Location loc,
6793 llvm::StringRef name, std::optional<mlir::Type> resultType,
6794 llvm::ArrayRef<fir::ExtendedValue> args,
6795 Fortran::lower::AbstractConverter *converter) {
6796 return IntrinsicLibrary{builder, loc, converter}.genIntrinsicCall(
6797 name, resultType, args);
6798}
6799
6800mlir::Value genMax(fir::FirOpBuilder &builder, mlir::Location loc,
6801 llvm::ArrayRef<mlir::Value> args) {
6802 assert(args.size() > 0 && "max requires at least one argument");
6803 return IntrinsicLibrary{builder, loc}
6804 .genExtremum<Extremum::Max, ExtremumBehavior::MinMaxss>(args[0].getType(),
6805 args);
6806}
6807
6808mlir::Value genMin(fir::FirOpBuilder &builder, mlir::Location loc,
6809 llvm::ArrayRef<mlir::Value> args) {
6810 assert(args.size() > 0 && "min requires at least one argument");
6811 return IntrinsicLibrary{builder, loc}
6812 .genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>(args[0].getType(),
6813 args);
6814}
6815
6816mlir::Value genDivC(fir::FirOpBuilder &builder, mlir::Location loc,
6817 mlir::Type type, mlir::Value x, mlir::Value y) {
6818 return IntrinsicLibrary{builder, loc}.genRuntimeCall("divc", type, {x, y});
6819}
6820
6821mlir::Value genPow(fir::FirOpBuilder &builder, mlir::Location loc,
6822 mlir::Type type, mlir::Value x, mlir::Value y) {
6823 // TODO: since there is no libm version of pow with integer exponent,
6824 // we have to provide an alternative implementation for
6825 // "precise/strict" FP mode.
6826 // One option is to generate internal function with inlined
6827 // implementation and mark it 'strictfp'.
6828 // Another option is to implement it in Fortran runtime library
6829 // (just like matmul).
6830 return IntrinsicLibrary{builder, loc}.genRuntimeCall("pow", type, {x, y});
6831}
6832
6833mlir::SymbolRefAttr
6834getUnrestrictedIntrinsicSymbolRefAttr(fir::FirOpBuilder &builder,
6835 mlir::Location loc, llvm::StringRef name,
6836 mlir::FunctionType signature) {
6837 return IntrinsicLibrary{builder, loc}.getUnrestrictedIntrinsicSymbolRefAttr(
6838 name, signature);
6839}
6840} // namespace fir
6841

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