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