[flang] IEEE_ARITHMETIC intrinsic module procedures

[vdonaldson]

Summary

Implement

• IEEE_CLASS
• IEEE_COPY_SIGN
• IEEE_GET_ROUNDING_MODE
• IEEE_IS_FINITE
• IEEE_IS_NAN
• IEEE_IS_NEGATIVE
• IEEE_IS_NORMAL
• IEEE_SET_ROUNDING_MODE
• IEEE_SIGNBIT
• IEEE_SUPPORT_ROUNDING
• IEEE_UNORDERED
• IEEE_VALUE

for all REAL kinds (2, 3, 4, 8, 10, 16) where applicable.

[clementval]

LGTM

[vdonaldson]

https://reviews.llvm.org/D154144

flang/include/flang/Lower/PFTBuilder.h

struct FunctionLikeUnit : public ProgramUnit {
   /// SubprogramDetails. Evaluations are filled in for alternate entries.
   llvm::SmallVector<std::pair<const semantics::Symbol *, Evaluation *>, 1>
       entryPointList{std::pair{nullptr, nullptr}};
   /// Current index into entryPointList. Index 0 is the primary entry point.
   int activeEntry = 0;
   /// Primary result for function subprograms with alternate entries. This
   /// is one of the largest result values, not necessarily the first one.
   const semantics::Symbol *primaryResult{nullptr};
+  bool mayModifyRoundingMode{false};
   /// Terminal basic block (if any)
   mlir::Block *finalBlock{};
   HostAssociations hostAssociations;
 };
 
 /// Module-like units contain a list of function-like units.
 struct ModuleLikeUnit : public ProgramUnit {
   // wrapper statements for module-like syntactic structures

flang/include/flang/Optimizer/Builder/IntrinsicCall.h

struct IntrinsicLibrary {
   /// in the llvm::ArrayRef.
   mlir::Value genIand(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genIany(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genIbclr(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIbits(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIbset(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genIchar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genFindloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  mlir::Value genIeeeClass(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  mlir::Value genIeeeCopySign(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  void genIeeeGetRoundingMode(llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genIeeeIsFinite(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  mlir::Value genIeeeIsNan(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  mlir::Value genIeeeIsNegative(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIeeeIsNormal(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  void genIeeeSetRoundingMode(llvm::ArrayRef<fir::ExtendedValue>);
+  mlir::Value genIeeeSignbit(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  mlir::Value genIeeeSupportRounding(mlir::Type, llvm::ArrayRef<mlir::Value>);
   template <mlir::arith::CmpIPredicate pred>
-  fir::ExtendedValue genIeeeTypeCompare(mlir::Type,
-                                        llvm::ArrayRef<fir::ExtendedValue>);
+  mlir::Value genIeeeTypeCompare(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  mlir::Value genIeeeUnordered(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  mlir::Value genIeeeValue(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIeor(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genIndex(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genIor(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genIparity(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genIsContiguous(mlir::Type,
                                      llvm::ArrayRef<fir::ExtendedValue>);
   template <Fortran::runtime::io::Iostat value>
   mlir::Value genIsIostatValue(mlir::Type, llvm::ArrayRef<mlir::Value>);
-  mlir::Value genIsNan(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIsFPClass(mlir::Type, llvm::ArrayRef<mlir::Value>,
                            int fpclass);
   mlir::Value genIshft(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIshftc(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genLbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genLeadz(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);

flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h

 mlir::func::FuncOp getLlvmMemmove(FirOpBuilder &builder);
 
 /// Get the LLVM intrinsic for `memset`. Use the 64 bit version.
 mlir::func::FuncOp getLlvmMemset(FirOpBuilder &builder);
 
 /// Get the C standard library `realloc` function.
 mlir::func::FuncOp getRealloc(FirOpBuilder &builder);
 
+/// Get the `llvm.get.rounding` intrinsic.
+mlir::func::FuncOp getLlvmGetRounding(FirOpBuilder &builder);
+
+/// Get the `llvm.set.rounding` intrinsic.
+mlir::func::FuncOp getLlvmSetRounding(FirOpBuilder &builder);
+
 /// Get the `llvm.stacksave` intrinsic.
 mlir::func::FuncOp getLlvmStackSave(FirOpBuilder &builder);
 
 /// Get the `llvm.stackrestore` intrinsic.
 mlir::func::FuncOp getLlvmStackRestore(FirOpBuilder &builder);
 
 /// Get the `llvm.init.trampoline` intrinsic.
 mlir::func::FuncOp getLlvmInitTrampoline(FirOpBuilder &builder);
 
 /// Get the `llvm.adjust.trampoline` intrinsic.
 mlir::func::FuncOp getLlvmAdjustTrampoline(FirOpBuilder &builder);
 
 } // namespace fir::factory
 
 #endif // FLANG_OPTIMIZER_BUILDER_LOWLEVELINTRINSICS_H

flang/include/flang/Runtime/ieee_arithmetic.h

+#if 0 /*===-- include/flang/Runtime/ieee_arithmetic.h -------------------===*/
+/*
+ * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+ * See https://llvm.org/LICENSE.txt for license information.
+ * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+ *
+ *===----------------------------------------------------------------------===*/
+#endif
+#if 0
+This header can be included into both Fortran and C/C++.
+
+Fortran 2018 Clause 17.2 Fortran intrinsic module ieee_exceptions values.
+#endif
+
+#ifndef FORTRAN_RUNTIME_IEEE_ARITHMETIC_H_
+#define FORTRAN_RUNTIME_IEEE_ARITHMETIC_H_
+
+#if 0
+ieee_class_type values
+The sequence is that of f18 clause 17.2p3, but nothing depends on that.
+#endif
+#define _FORTRAN_RUNTIME_IEEE_SIGNALING_NAN 1
+#define _FORTRAN_RUNTIME_IEEE_QUIET_NAN 2
+#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_INF 3
+#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL 4
+#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL 5
+#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO 6
+#define _FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO 7
+#define _FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL 8
+#define _FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL 9
+#define _FORTRAN_RUNTIME_IEEE_POSITIVE_INF 10
+#define _FORTRAN_RUNTIME_IEEE_OTHER_VALUE 11
+
+#if 0
+ieee_round_type values
+The values are those of the llvm.get.rounding instrinsic, which is assumed by
+intrinsic module procedures ieee_get_rounding_mode, ieee_set_rounding_mode,
+and ieee_support_rounding.
+#endif
+#define _FORTRAN_RUNTIME_IEEE_TO_ZERO 0
+#define _FORTRAN_RUNTIME_IEEE_NEAREST 1
+#define _FORTRAN_RUNTIME_IEEE_UP 2
+#define _FORTRAN_RUNTIME_IEEE_DOWN 3
+#define _FORTRAN_RUNTIME_IEEE_AWAY 4
+#define _FORTRAN_RUNTIME_IEEE_OTHER 5
+
+#endif

flang/lib/Evaluate/fold-logical.cpp

if (args[0] && args[0]->UnwrapExpr() &&
       return FoldElementalIntrinsic<T, DefaultReal>(context, std::move(funcRef),
           ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) {
             return Scalar<T>{x.IsNotANumber()};
           }));
     }
   } else if (name == "__builtin_ieee_is_negative") {
     auto restorer{context.messages().DiscardMessages()};
     using DefaultReal = Type<TypeCategory::Real, 4>;
+    if (args[0] && args[0]->UnwrapExpr() &&
+        IsActuallyConstant(*args[0]->UnwrapExpr())) {
       return FoldElementalIntrinsic<T, DefaultReal>(context, std::move(funcRef),
           ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) {
             return Scalar<T>{x.IsNegative()};
           }));
+    }
   } else if (name == "__builtin_ieee_is_normal") {
     auto restorer{context.messages().DiscardMessages()};
     using DefaultReal = Type<TypeCategory::Real, 4>;
     if (args[0] && args[0]->UnwrapExpr() &&
         IsActuallyConstant(*args[0]->UnwrapExpr())) {
       return FoldElementalIntrinsic<T, DefaultReal>(context, std::move(funcRef),
           ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) {
             return Scalar<T>{x.IsNormal()};

flang/lib/Lower/Bridge.cpp

void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
     builder = new fir::FirOpBuilder(func, bridge.getKindMap());
     assert(builder && "FirOpBuilder did not instantiate");
     builder->setFastMathFlags(bridge.getLoweringOptions().getMathOptions());
     builder->setInsertionPointToStart(&func.front());
     func.setVisibility(mlir::SymbolTable::Visibility::Public);
     assert(blockId == 0 && "invalid blockId");
     assert(activeConstructStack.empty() && "invalid construct stack state");
 
+    // Get the rounding mode at function entry, and arrange for it to be
+    // restored at all function exits.
+    if (!funit.isMainProgram() && funit.mayModifyRoundingMode) {
+      mlir::func::FuncOp getRound = fir::factory::getLlvmGetRounding(*builder);
+      mlir::func::FuncOp setRound = fir::factory::getLlvmSetRounding(*builder);
+      mlir::Value roundMode =
+          builder->create<fir::CallOp>(toLocation(), getRound).getResult(0);
+      mlir::Location endLoc =
+          toLocation(Fortran::lower::pft::stmtSourceLoc(funit.endStmt));
+      bridge.fctCtx().attachCleanup(
+          [=]() { builder->create<fir::CallOp>(endLoc, setRound, roundMode); });
+    }
+
     mapDummiesAndResults(funit, callee);
 
     // Map host associated symbols from parent procedure if any.
     if (funit.parentHasHostAssoc())
       funit.parentHostAssoc().internalProcedureBindings(*this, localSymbols);
 
     // Non-primary results of a function with multiple entry points.
     // These result values share storage with the primary result.

flang/lib/Lower/PFTBuilder.cpp

if constexpr (lower::pft::isFunctionLike<A>) {
       if constexpr (lower::pft::isConstructStmt<T> ||
                     lower::pft::isOtherStmt<T>) {
         addEvaluation(lower::pft::Evaluation{
             stmt.unwrapped, pftParentStack.back(), stmt.position, stmt.label});
         return false;
       } else if constexpr (std::is_same_v<T, parser::ActionStmt>) {
         return std::visit(
             common::visitors{
+                [&](const common::Indirection<parser::CallStmt> &x) {
+                  addEvaluation(lower::pft::Evaluation{
+                      removeIndirection(x), pftParentStack.back(),
+                      stmt.position, stmt.label});
+                  checkForRoundingModeCall(x.value());
+                  return true;
+                },
                 [&](const common::Indirection<parser::IfStmt> &x) {
                   convertIfStmt(x.value(), stmt.position, stmt.label);
                   return false;
                 },
                 [&](const auto &x) {
                   addEvaluation(lower::pft::Evaluation{
                       removeIndirection(x), pftParentStack.back(),
                       stmt.position, stmt.label});
                   return true;
                 },
             },
             stmt.unwrapped.u);
       }
     }
     return true;
   }
 
+  /// Check for a call statement that could modify the fp rounding mode.
+  void checkForRoundingModeCall(const parser::CallStmt &callStmt) {
+    const auto &pd = std::get<parser::ProcedureDesignator>(callStmt.call.t);
+    const auto *callName = std::get_if<parser::Name>(&pd.u);
+    if (!callName)
+      return;
+    const Fortran::semantics::Symbol &procSym = callName->symbol->GetUltimate();
+    llvm::StringRef procName = toStringRef(procSym.name());
+    if (!procName.startswith("ieee_set_"))
+      return;
+    if (procName == "ieee_set_rounding_mode_0" ||
+        procName == "ieee_set_modes_0" || procName == "ieee_set_status_0")
+      evaluationListStack.back()
+          ->back()
+          .getOwningProcedure()
+          ->mayModifyRoundingMode = true;
+  }
+
   /// Convert an IfStmt into an IfConstruct, retaining the IfStmt as the
   /// first statement of the construct.
   void convertIfStmt(const parser::IfStmt &ifStmt, parser::CharBlock position,
                      std::optional<parser::Label> label) {
     // Generate a skeleton IfConstruct parse node. Its components are never
     // referenced. The actual components are available via the IfConstruct
     // evaluation's nested evaluationList, with the ifStmt in the position of
     // the otherwise normal IfThenStmt. Caution: All other PFT nodes reference

flang/lib/Optimizer/Builder/IntrinsicCall.cpp

 #include "flang/Optimizer/Builder/Runtime/Stop.h"
 #include "flang/Optimizer/Builder/Runtime/Transformational.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
 #include "flang/Optimizer/Dialect/Support/FIRContext.h"
 #include "flang/Optimizer/Support/FatalError.h"
 #include "flang/Optimizer/Support/Utils.h"
 #include "flang/Runtime/entry-names.h"
+#include "flang/Runtime/ieee_arithmetic.h"
 #include "flang/Runtime/iostat.h"
 #include "mlir/Dialect/Complex/IR/Complex.h"
 #include "mlir/Dialect/LLVMIR/LLVMDialect.h"
 #include "mlir/Dialect/Math/IR/Math.h"
 #include "mlir/Dialect/Vector/IR/VectorOps.h"
 #include "llvm/Support/CommandLine.h"
 #include "llvm/Support/Debug.h"
 #include "llvm/Support/MathExtras.h"
static constexpr IntrinsicHandler handlers[]{
      {{{"array", asBox},
        {"dim", asValue},
        {"mask", asBox, handleDynamicOptional}}},
      /*isElemental=*/false},
     {"ibclr", &I::genIbclr},
     {"ibits", &I::genIbits},
     {"ibset", &I::genIbset},
     {"ichar", &I::genIchar},
+    {"ieee_class", &I::genIeeeClass},
     {"ieee_class_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},
     {"ieee_class_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},
+    {"ieee_copy_sign", &I::genIeeeCopySign},
+    {"ieee_get_rounding_mode",
+     &I::genIeeeGetRoundingMode,
+     {{{"round_value", asAddr, handleDynamicOptional},
+       {"radix", asValue, handleDynamicOptional}}},
+     /*isElemental=*/false},
     {"ieee_is_finite", &I::genIeeeIsFinite},
-    {"ieee_is_nan", &I::genIsNan},
+    {"ieee_is_nan", &I::genIeeeIsNan},
+    {"ieee_is_negative", &I::genIeeeIsNegative},
     {"ieee_is_normal", &I::genIeeeIsNormal},
     {"ieee_round_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},
     {"ieee_round_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},
+    {"ieee_set_rounding_mode",
+     &I::genIeeeSetRoundingMode,
+     {{{"round_value", asValue, handleDynamicOptional},
+       {"radix", asValue, handleDynamicOptional}}},
+     /*isElemental=*/false},
+    {"ieee_signbit", &I::genIeeeSignbit},
+    {"ieee_support_rounding", &I::genIeeeSupportRounding},
+    {"ieee_unordered", &I::genIeeeUnordered},
+    {"ieee_value", &I::genIeeeValue},
     {"ieor", &I::genIeor},
     {"index",
      &I::genIndex,
      {{{"string", asAddr},
        {"substring", asAddr},
        {"back", asValue, handleDynamicOptional},
        {"kind", asValue}}}},
     {"ior", &I::genIor},
     {"iparity",
      &I::genIparity,
      {{{"array", asBox},
        {"dim", asValue},
        {"mask", asBox, handleDynamicOptional}}},
      /*isElemental=*/false},
     {"is_contiguous",
      &I::genIsContiguous,
      {{{"array", asBox}}},
      /*isElemental=*/false},
     {"is_iostat_end", &I::genIsIostatValue<Fortran::runtime::io::IostatEnd>},
     {"is_iostat_eor", &I::genIsIostatValue<Fortran::runtime::io::IostatEor>},
     {"ishft", &I::genIshft},
     {"ishftc", &I::genIshftc},
-    {"isnan", &I::genIsNan},
+    {"isnan", &I::genIeeeIsNan},
     {"lbound",
      &I::genLbound,
      {{{"array", asInquired}, {"dim", asValue}, {"kind", asValue}}},
      /*isElemental=*/false},
     {"leadz", &I::genLeadz},
     {"len",
      &I::genLen,
      {{{"string", asInquired}, {"kind", asValue}}},
IntrinsicLibrary::genIchar(mlir::Type resultType,
   }
   LLVM_DEBUG(llvm::dbgs() << "ichar(" << charVal << ")\n");
   auto code = helper.extractCodeFromSingleton(charVal);
   if (code.getType() == resultType)
     return code;
   return builder.create<mlir::arith::ExtUIOp>(loc, resultType, code);
 }
 
+// Return a reference to the contents of a derived type with one field.
+// Also return the field type.
+static std::pair<mlir::Value, mlir::Type>
+getFieldRef(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value rec) {
+  auto recType =
+      fir::unwrapPassByRefType(rec.getType()).dyn_cast<fir::RecordType>();
+  assert(recType.getTypeList().size() == 1 && "expected exactly one component");
+  auto [fieldName, fieldTy] = recType.getTypeList().front();
+  mlir::Value field = builder.create<fir::FieldIndexOp>(
+      loc, fir::FieldType::get(recType.getContext()), fieldName, recType,
+      fir::getTypeParams(rec));
+  return {builder.create<fir::CoordinateOp>(loc, builder.getRefType(fieldTy),
+                                            rec, field),
+          fieldTy};
+}
+
 // IEEE_CLASS_TYPE OPERATOR(==), OPERATOR(/=)
 // IEEE_ROUND_TYPE OPERATOR(==), OPERATOR(/=)
 template <mlir::arith::CmpIPredicate pred>
-fir::ExtendedValue
+mlir::Value
 IntrinsicLibrary::genIeeeTypeCompare(mlir::Type resultType,
-                                     llvm::ArrayRef<fir::ExtendedValue> args) {
+                                     llvm::ArrayRef<mlir::Value> args) {
   assert(args.size() == 2);
-  mlir::Value arg0 = fir::getBase(args[0]);
-  mlir::Value arg1 = fir::getBase(args[1]);
-  auto recType =
-      fir::unwrapPassByRefType(arg0.getType()).dyn_cast<fir::RecordType>();
-  assert(recType.getTypeList().size() == 1 && "expected exactly one component");
-  auto [fieldName, fieldType] = recType.getTypeList().front();
-  mlir::Type fieldIndexType = fir::FieldType::get(recType.getContext());
-  mlir::Value field = builder.create<fir::FieldIndexOp>(
-      loc, fieldIndexType, fieldName, recType, fir::getTypeParams(arg0));
-  mlir::Value left = builder.create<fir::LoadOp>(
-      loc, fieldType,
-      builder.create<fir::CoordinateOp>(loc, builder.getRefType(fieldType),
-                                        arg0, field));
-  mlir::Value right = builder.create<fir::LoadOp>(
-      loc, fieldType,
-      builder.create<fir::CoordinateOp>(loc, builder.getRefType(fieldType),
-                                        arg1, field));
+  auto [leftRef, fieldTy] = getFieldRef(builder, loc, fir::getBase(args[0]));
+  auto [rightRef, ignore] = getFieldRef(builder, loc, fir::getBase(args[1]));
+  mlir::Value left = builder.create<fir::LoadOp>(loc, fieldTy, leftRef);
+  mlir::Value right = builder.create<fir::LoadOp>(loc, fieldTy, rightRef);
   return builder.create<mlir::arith::CmpIOp>(loc, pred, left, right);
 }
 
+// IEEE_CLASS
+mlir::Value IntrinsicLibrary::genIeeeClass(mlir::Type resultType,
+                                           llvm::ArrayRef<mlir::Value> args) {
+  // Classify REAL argument X as one of 11 IEEE_CLASS_TYPE values via
+  // a table lookup on an index built from 5 values derived from X.
+  // In indexing order, the values are:
+  //
+  //   [s] sign bit
+  //   [e] exponent != 0
+  //   [m] exponent == 1..1 (max exponent)
+  //   [l] low-order significand != 0
+  //   [h] high-order significand (kind=10: 2 bits; other kinds: 1 bit)
+  //
+  // kind=10 values have an explicit high-order integer significand bit,
+  // whereas this bit is implicit for other kinds. This requires using a 6-bit
+  // index into a 64-slot table for kind=10 argument classification queries
+  // vs. a 5-bit index into a 32-slot table for other argument kind queries.
+  // The instruction sequence is the same for the two cases.
+  //
+  // Placing the [l] and [h] significand bits in "swapped" order rather than
+  // "natural" order enables more efficient generated code.
+
+  assert(args.size() == 1);
+  mlir::Value realVal = fir::getBase(args[0]);
+  mlir::FloatType realType = realVal.getType().dyn_cast<mlir::FloatType>();
+  mlir::Type intType = builder.getIntegerType(realType.getWidth());
+  mlir::Value intVal =
+      builder.create<mlir::arith::BitcastOp>(loc, intType, realVal);
+  llvm::StringRef tableName = RTNAME_STRING(IeeeClassTable);
+  uint64_t highSignificandSize = (realType.getWidth() == 80) + 1;
+
+  // Get masks and shift counts.
+  mlir::Value signShift, highSignificandShift, exponentMask, lowSignificandMask;
+  auto createIntegerConstant = [&](uint64_t k) {
+    return builder.createIntegerConstant(loc, intType, k);
+  };
+  auto getMasksAndShifts = [&](uint64_t totalSize, uint64_t exponentSize,
+                               uint64_t significandSize,
+                               bool hasExplicitBit = false) {
+    assert(1 + exponentSize + significandSize == totalSize &&
+           "invalid floating point fields");
+    constexpr uint64_t one = 1; // type promotion
+    uint64_t lowSignificandSize = significandSize - hasExplicitBit - 1;
+    signShift = createIntegerConstant(totalSize - 1 - hasExplicitBit - 4);
+    highSignificandShift = createIntegerConstant(lowSignificandSize);
+    if (totalSize <= 64) {
+      exponentMask =
+          createIntegerConstant(((one << exponentSize) - 1) << significandSize);
+      lowSignificandMask =
+          createIntegerConstant((one << lowSignificandSize) - 1);
+      return;
+    }
+    // Mlir can't directly build large constants. Build them in steps.
+    // The folded end result is the same.
+    mlir::Value sixtyfour = createIntegerConstant(64);
+    exponentMask = createIntegerConstant(((one << exponentSize) - 1)
+                                         << (significandSize - 64));
+    exponentMask =
+        builder.create<mlir::arith::ShLIOp>(loc, exponentMask, sixtyfour);
+    if (lowSignificandSize <= 64) {
+      lowSignificandMask =
+          createIntegerConstant((one << lowSignificandSize) - 1);
+      return;
+    }
+    mlir::Value ones = createIntegerConstant(0xffffffffffffffff);
+    lowSignificandMask =
+        createIntegerConstant((one << (lowSignificandSize - 64)) - 1);
+    lowSignificandMask =
+        builder.create<mlir::arith::ShLIOp>(loc, lowSignificandMask, sixtyfour);
+    lowSignificandMask =
+        builder.create<mlir::arith::OrIOp>(loc, lowSignificandMask, ones);
+  };
+  switch (realType.getWidth()) {
+  case 16:
+    if (realType.isF16()) {
+      // kind=2: 1 sign bit, 5 exponent bits, 10 significand bits
+      getMasksAndShifts(16, 5, 10);
+    } else {
+      // kind=3: 1 sign bit, 8 exponent bits, 7 significand bits
+      getMasksAndShifts(16, 8, 7);
+    }
+    break;
+  case 32: // kind=4: 1 sign bit, 8 exponent bits, 23 significand bits
+    getMasksAndShifts(32, 8, 23);
+    break;
+  case 64: // kind=8: 1 sign bit, 11 exponent bits, 52 significand bits
+    getMasksAndShifts(64, 11, 52);
+    break;
+  case 80: // kind=10: 1 sign bit, 15 exponent bits, 1+63 significand bits
+    getMasksAndShifts(80, 15, 64, /*hasExplicitBit=*/true);
+    tableName = RTNAME_STRING(IeeeClassTable_10);
+    break;
+  case 128: // kind=16: 1 sign bit, 15 exponent bits, 112 significand bits
+    getMasksAndShifts(128, 15, 112);
+    break;
+  default:
+    llvm_unreachable("unknown real type");
+  }
+
+  // [s] sign bit
+  int pos = 3 + highSignificandSize;
+  mlir::Value index = builder.create<mlir::arith::AndIOp>(
+      loc, builder.create<mlir::arith::ShRUIOp>(loc, intVal, signShift),
+      createIntegerConstant(1 << pos));
+
+  // [e] exponent != 0
+  mlir::Value exponent =
+      builder.create<mlir::arith::AndIOp>(loc, intVal, exponentMask);
+  mlir::Value zero = createIntegerConstant(0);
+  index = builder.create<mlir::arith::OrIOp>(
+      loc, index,
+      builder.create<mlir::arith::SelectOp>(
+          loc,
+          builder.create<mlir::arith::CmpIOp>(
+              loc, mlir::arith::CmpIPredicate::ne, exponent, zero),
+          createIntegerConstant(1 << --pos), zero));
+
+  // [m] exponent == 1..1 (max exponent)
+  index = builder.create<mlir::arith::OrIOp>(
+      loc, index,
+      builder.create<mlir::arith::SelectOp>(
+          loc,
+          builder.create<mlir::arith::CmpIOp>(
+              loc, mlir::arith::CmpIPredicate::eq, exponent, exponentMask),
+          createIntegerConstant(1 << --pos), zero));
+
+  // [l] low-order significand != 0
+  index = builder.create<mlir::arith::OrIOp>(
+      loc, index,
+      builder.create<mlir::arith::SelectOp>(
+          loc,
+          builder.create<mlir::arith::CmpIOp>(
+              loc, mlir::arith::CmpIPredicate::ne,
+              builder.create<mlir::arith::AndIOp>(loc, intVal,
+                                                  lowSignificandMask),
+              zero),
+          createIntegerConstant(1 << --pos), zero));
+
+  // [h] high-order significand (1 or 2 bits)
+  index = builder.create<mlir::arith::OrIOp>(
+      loc, index,
+      builder.create<mlir::arith::AndIOp>(
+          loc,
+          builder.create<mlir::arith::ShRUIOp>(loc, intVal,
+                                               highSignificandShift),
+          createIntegerConstant((1 << highSignificandSize) - 1)));
+
+  int tableSize = 1 << (4 + highSignificandSize);
+  mlir::Type int8Ty = builder.getIntegerType(8);
+  mlir::Type tableTy = fir::SequenceType::get(tableSize, int8Ty);
+  if (!builder.getNamedGlobal(tableName)) {
+    llvm::SmallVector<mlir::Attribute, 64> values;
+    auto insert = [&](std::int8_t which) {
+      values.push_back(builder.getIntegerAttr(int8Ty, which));
+    };
+    // If indexing value [e] is 0, value [m] can't be 1. (If the exponent is 0,
+    // it can't be the max exponent). Use IEEE_OTHER_VALUE for impossible
+    // combinations.
+    constexpr std::int8_t impossible = _FORTRAN_RUNTIME_IEEE_OTHER_VALUE;
+    if (tableSize == 32) {
+      //   s   e m   l h     kinds 2,3,4,8,16
+      //   ===================================================================
+      /*   0   0 0   0 0  */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO);
+      /*   0   0 0   0 1  */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+      /*   0   0 0   1 0  */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+      /*   0   0 0   1 1  */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+      /*   0   0 1   0 0  */ insert(impossible);
+      /*   0   0 1   0 1  */ insert(impossible);
+      /*   0   0 1   1 0  */ insert(impossible);
+      /*   0   0 1   1 1  */ insert(impossible);
+      /*   0   1 0   0 0  */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
+      /*   0   1 0   0 1  */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
+      /*   0   1 0   1 0  */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
+      /*   0   1 0   1 1  */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
+      /*   0   1 1   0 0  */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_INF);
+      /*   0   1 1   0 1  */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
+      /*   0   1 1   1 0  */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);
+      /*   0   1 1   1 1  */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
+      /*   1   0 0   0 0  */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO);
+      /*   1   0 0   0 1  */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+      /*   1   0 0   1 0  */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+      /*   1   0 0   1 1  */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+      /*   1   0 1   0 0  */ insert(impossible);
+      /*   1   0 1   0 1  */ insert(impossible);
+      /*   1   0 1   1 0  */ insert(impossible);
+      /*   1   0 1   1 1  */ insert(impossible);
+      /*   1   1 0   0 0  */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
+      /*   1   1 0   0 1  */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
+      /*   1   1 0   1 0  */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
+      /*   1   1 0   1 1  */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
+      /*   1   1 1   0 0  */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_INF);
+      /*   1   1 1   0 1  */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
+      /*   1   1 1   1 0  */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);
+      /*   1   1 1   1 1  */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
+    } else {
+      // Unlike values of other kinds, kind=10 values can be "invalid", and
+      // can appear in code. Use IEEE_OTHER_VALUE for invalid bit patterns.
+      // Runtime IO may print an invalid value as a NaN.
+      constexpr std::int8_t invalid = _FORTRAN_RUNTIME_IEEE_OTHER_VALUE;
+      //   s   e m   l  h    kind 10
+      //   ===================================================================
+      /*   0   0 0   0 00 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO);
+      /*   0   0 0   0 01 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+      /*   0   0 0   0 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+      /*   0   0 0   0 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+      /*   0   0 0   1 00 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+      /*   0   0 0   1 01 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+      /*   0   0 0   1 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+      /*   0   0 0   1 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL);
+      /*   0   0 1   0 00 */ insert(impossible);
+      /*   0   0 1   0 01 */ insert(impossible);
+      /*   0   0 1   0 10 */ insert(impossible);
+      /*   0   0 1   0 11 */ insert(impossible);
+      /*   0   0 1   1 00 */ insert(impossible);
+      /*   0   0 1   1 01 */ insert(impossible);
+      /*   0   0 1   1 10 */ insert(impossible);
+      /*   0   0 1   1 11 */ insert(impossible);
+      /*   0   1 0   0 00 */ insert(invalid);
+      /*   0   1 0   0 01 */ insert(invalid);
+      /*   0   1 0   0 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
+      /*   0   1 0   0 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
+      /*   0   1 0   1 00 */ insert(invalid);
+      /*   0   1 0   1 01 */ insert(invalid);
+      /*   0   1 0   1 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
+      /*   0   1 0   1 11 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL);
+      /*   0   1 1   0 00 */ insert(invalid);
+      /*   0   1 1   0 01 */ insert(invalid);
+      /*   0   1 1   0 10 */ insert(_FORTRAN_RUNTIME_IEEE_POSITIVE_INF);
+      /*   0   1 1   0 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
+      /*   0   1 1   1 00 */ insert(invalid);
+      /*   0   1 1   1 01 */ insert(invalid);
+      /*   0   1 1   1 10 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);
+      /*   0   1 1   1 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
+      /*   1   0 0   0 00 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO);
+      /*   1   0 0   0 01 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+      /*   1   0 0   0 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+      /*   1   0 0   0 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+      /*   1   0 0   1 00 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+      /*   1   0 0   1 01 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+      /*   1   0 0   1 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+      /*   1   0 0   1 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL);
+      /*   1   0 1   0 00 */ insert(impossible);
+      /*   1   0 1   0 01 */ insert(impossible);
+      /*   1   0 1   0 10 */ insert(impossible);
+      /*   1   0 1   0 11 */ insert(impossible);
+      /*   1   0 1   1 00 */ insert(impossible);
+      /*   1   0 1   1 01 */ insert(impossible);
+      /*   1   0 1   1 10 */ insert(impossible);
+      /*   1   0 1   1 11 */ insert(impossible);
+      /*   1   1 0   0 00 */ insert(invalid);
+      /*   1   1 0   0 01 */ insert(invalid);
+      /*   1   1 0   0 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
+      /*   1   1 0   0 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
+      /*   1   1 0   1 00 */ insert(invalid);
+      /*   1   1 0   1 01 */ insert(invalid);
+      /*   1   1 0   1 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
+      /*   1   1 0   1 11 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL);
+      /*   1   1 1   0 00 */ insert(invalid);
+      /*   1   1 1   0 01 */ insert(invalid);
+      /*   1   1 1   0 10 */ insert(_FORTRAN_RUNTIME_IEEE_NEGATIVE_INF);
+      /*   1   1 1   0 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
+      /*   1   1 1   1 00 */ insert(invalid);
+      /*   1   1 1   1 01 */ insert(invalid);
+      /*   1   1 1   1 10 */ insert(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN);
+      /*   1   1 1   1 11 */ insert(_FORTRAN_RUNTIME_IEEE_QUIET_NAN);
+    }
+    builder.createGlobalConstant(
+        loc, tableTy, tableName, builder.createLinkOnceLinkage(),
+        mlir::DenseElementsAttr::get(
+            mlir::RankedTensorType::get(tableSize, int8Ty), values));
+  }
+
+  return builder.create<fir::CoordinateOp>(
+      loc, builder.getRefType(resultType),
+      builder.create<fir::AddrOfOp>(loc, builder.getRefType(tableTy),
+                                    builder.getSymbolRefAttr(tableName)),
+      index);
+}
+
+// IEEE_COPY_SIGN
+mlir::Value
+IntrinsicLibrary::genIeeeCopySign(mlir::Type resultType,
+                                  llvm::ArrayRef<mlir::Value> args) {
+  // Copy the sign of REAL arg Y to REAL arg X.
+  assert(args.size() == 2);
+  mlir::Value xRealVal = fir::getBase(args[0]);
+  mlir::Value yRealVal = fir::getBase(args[1]);
+  mlir::FloatType xRealType = xRealVal.getType().dyn_cast<mlir::FloatType>();
+  mlir::FloatType yRealType = yRealVal.getType().dyn_cast<mlir::FloatType>();
+
+  if (yRealType == mlir::FloatType::getBF16(builder.getContext())) {
+    // Workaround: CopySignOp and BitcastOp don't work for kind 3 arg Y.
+    // This conversion should always preserve the sign bit.
+    yRealVal = builder.createConvert(
+        loc, mlir::FloatType::getF32(builder.getContext()), yRealVal);
+    yRealType = mlir::FloatType::getF32(builder.getContext());
+  }
+
+  // Args have the same type.
+  if (xRealType == yRealType)
+    return builder.create<mlir::LLVM::CopySignOp>(loc, xRealVal, yRealVal);
+
+  // Args have different types.
+  mlir::Type xIntType = builder.getIntegerType(xRealType.getWidth());
+  mlir::Type yIntType = builder.getIntegerType(yRealType.getWidth());
+  mlir::Value xIntVal =
+      builder.create<mlir::arith::BitcastOp>(loc, xIntType, xRealVal);
+  mlir::Value yIntVal =
+      builder.create<mlir::arith::BitcastOp>(loc, yIntType, yRealVal);
+  mlir::Value xZero = builder.createIntegerConstant(loc, xIntType, 0);
+  mlir::Value yZero = builder.createIntegerConstant(loc, yIntType, 0);
+  mlir::Value xOne = builder.createIntegerConstant(loc, xIntType, 1);
+  mlir::Value ySign = builder.create<mlir::arith::ShRUIOp>(
+      loc, yIntVal,
+      builder.createIntegerConstant(loc, yIntType, yRealType.getWidth() - 1));
+  mlir::Value xAbs = builder.create<mlir::arith::ShRUIOp>(
+      loc, builder.create<mlir::arith::ShLIOp>(loc, xIntVal, xOne), xOne);
+  mlir::Value xSign = builder.create<mlir::arith::SelectOp>(
+      loc,
+      builder.create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::eq,
+                                          ySign, yZero),
+      xZero,
+      builder.create<mlir::arith::ShLIOp>(
+          loc, xOne,
+          builder.createIntegerConstant(loc, xIntType,
+                                        xRealType.getWidth() - 1)));
+  return builder.create<mlir::arith::BitcastOp>(
+      loc, xRealType, builder.create<mlir::arith::OrIOp>(loc, xAbs, xSign));
+}
+
+// Check that an explicit ieee_[get|set]_rounding_mode call radix value is 2.
+static void checkRadix(fir::FirOpBuilder &builder, mlir::Location loc,
+                       mlir::Value radix, std::string procName) {
+  mlir::Value notTwo = builder.create<mlir::arith::CmpIOp>(
+      loc, mlir::arith::CmpIPredicate::ne, radix,
+      builder.createIntegerConstant(loc, radix.getType(), 2));
+  auto ifOp = builder.create<fir::IfOp>(loc, notTwo,
+                                        /*withElseRegion=*/false);
+  builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
+  fir::runtime::genReportFatalUserError(builder, loc,
+                                        procName + " radix argument must be 2");
+  builder.setInsertionPointAfter(ifOp);
+}
+
+// IEEE_GET_ROUNDING_MODE
+void IntrinsicLibrary::genIeeeGetRoundingMode(
+    llvm::ArrayRef<fir::ExtendedValue> args) {
+  // Set arg ROUNDING_VALUE to the current floating point rounding mode.
+  // Values are chosen to match the llvm.get.rounding encoding.
+  // Generate an error if the value of optional arg RADIX is not 2.
+  assert(args.size() == 1 || args.size() == 2);
+  if (args.size() == 2)
+    checkRadix(builder, loc, fir::getBase(args[1]), "ieee_get_rounding_mode");
+  auto [fieldRef, fieldTy] = getFieldRef(builder, loc, fir::getBase(args[0]));
+  mlir::func::FuncOp getRound = fir::factory::getLlvmGetRounding(builder);
+  mlir::Value mode = builder.create<fir::CallOp>(loc, getRound).getResult(0);
+  mode = builder.createConvert(loc, fieldTy, mode);
+  builder.create<fir::StoreOp>(loc, mode, fieldRef);
+}
+
+mlir::Value IntrinsicLibrary::genIsFPClass(mlir::Type resultType,
+                                           llvm::ArrayRef<mlir::Value> args,
+                                           int fpclass) {
+  assert(args.size() == 1);
+  mlir::Type i1Ty = builder.getI1Type();
+  mlir::Value isfpclass =
+      builder.create<mlir::LLVM::IsFPClass>(loc, i1Ty, args[0], fpclass);
+  return builder.createConvert(loc, resultType, isfpclass);
+}
+
 // IEEE_IS_FINITE
 mlir::Value
 IntrinsicLibrary::genIeeeIsFinite(mlir::Type resultType,
                                   llvm::ArrayRef<mlir::Value> args) {
-  // IEEE_IS_FINITE(X) is true iff exponent(X) is the max exponent of kind(X).
+  // Check if arg X is a (negative or positive) (normal, denormal, or zero).
+  assert(args.size() == 1);
+  return genIsFPClass(resultType, args, 0b0111111000);
+}
+
+// IEEE_IS_NAN
+mlir::Value IntrinsicLibrary::genIeeeIsNan(mlir::Type resultType,
+                                           llvm::ArrayRef<mlir::Value> args) {
+  // Check if arg X is a (signaling or quiet) NaN.
   assert(args.size() == 1);
-  mlir::Value floatVal = fir::getBase(args[0]);
-  mlir::FloatType floatType = floatVal.getType().dyn_cast<mlir::FloatType>();
-  int floatBits = floatType.getWidth();
-  mlir::Type intType = builder.getIntegerType(
-      floatType.isa<mlir::Float80Type>() ? 128 : floatBits);
+  return genIsFPClass(resultType, args, 0b0000000011);
+}
+
+// IEEE_IS_NEGATIVE
+mlir::Value
+IntrinsicLibrary::genIeeeIsNegative(mlir::Type resultType,
+                                    llvm::ArrayRef<mlir::Value> args) {
+  // Check if arg X is a negative (infinity, normal, denormal or zero).
+  assert(args.size() == 1);
+  return genIsFPClass(resultType, args, 0b0000111100);
+}
+
+// IEEE_IS_NORMAL
+mlir::Value
+IntrinsicLibrary::genIeeeIsNormal(mlir::Type resultType,
+                                  llvm::ArrayRef<mlir::Value> args) {
+  // Check if arg X is a (negative or positive) (normal or zero).
+  assert(args.size() == 1);
+  return genIsFPClass(resultType, args, 0b0101101000);
+}
+
+// IEEE_SET_ROUNDING_MODE
+void IntrinsicLibrary::genIeeeSetRoundingMode(
+    llvm::ArrayRef<fir::ExtendedValue> args) {
+  // Set the current floating point rounding mode to the value of arg
+  // ROUNDING_VALUE. Values are llvm.get.rounding encoding values.
+  // Generate an error if the value of optional arg RADIX is not 2.
+  assert(args.size() == 1 || args.size() == 2);
+  if (args.size() == 2)
+    checkRadix(builder, loc, fir::getBase(args[1]), "ieee_set_rounding_mode");
+  auto [fieldRef, ignore] = getFieldRef(builder, loc, fir::getBase(args[0]));
+  mlir::func::FuncOp setRound = fir::factory::getLlvmSetRounding(builder);
+  mlir::Value mode = builder.create<fir::LoadOp>(loc, fieldRef);
+  mode = builder.create<fir::ConvertOp>(
+      loc, setRound.getFunctionType().getInput(0), mode);
+  builder.create<fir::CallOp>(loc, setRound, mode);
+}
+
+// IEEE_SIGNBIT
+mlir::Value IntrinsicLibrary::genIeeeSignbit(mlir::Type resultType,
+                                             llvm::ArrayRef<mlir::Value> args) {
+  // Check if the sign bit of arg X is set.
+  assert(args.size() == 1);
+  mlir::Value realVal = fir::getBase(args[0]);
+  mlir::FloatType realType = realVal.getType().dyn_cast<mlir::FloatType>();
+  int bitWidth = realType.getWidth();
+  if (realType == mlir::FloatType::getBF16(builder.getContext())) {
+    // Workaround: can't bitcast or convert real(3) to integer(2) or real(2).
+    realVal = builder.createConvert(
+        loc, mlir::FloatType::getF32(builder.getContext()), realVal);
+    bitWidth = 32;
+  }
+  mlir::Type intType = builder.getIntegerType(bitWidth);
   mlir::Value intVal =
-      builder.create<mlir::arith::BitcastOp>(loc, intType, floatVal);
-  int significandBits;
-  if (floatType.isa<mlir::Float32Type>())
-    significandBits = 23;
-  else if (floatType.isa<mlir::Float64Type>())
-    significandBits = 52;
-  else // problems elsewhere for other kinds
-    TODO(loc, "intrinsic module procedure: ieee_is_finite");
-  mlir::Value significand =
-      builder.createIntegerConstant(loc, intType, significandBits);
-  int exponentBits = floatBits - 1 - significandBits;
-  mlir::Value maxExponent =
-      builder.createIntegerConstant(loc, intType, (1 << exponentBits) - 1);
-  mlir::Value exponent = genIbits(
-      intType, {intVal, significand,
-                builder.createIntegerConstant(loc, intType, exponentBits)});
+      builder.create<mlir::arith::BitcastOp>(loc, intType, realVal);
+  mlir::Value shift = builder.createIntegerConstant(loc, intType, bitWidth - 1);
+  mlir::Value sign = builder.create<mlir::arith::ShRUIOp>(loc, intVal, shift);
+  return builder.createConvert(loc, resultType, sign);
+}
+
+// IEEE_SUPPORT_ROUNDING
+mlir::Value
+IntrinsicLibrary::genIeeeSupportRounding(mlir::Type resultType,
+                                         llvm::ArrayRef<mlir::Value> args) {
+  // Check if floating point rounding mode ROUND_VALUE is supported.
+  // Rounding is supported either for all type kinds or none.
+  // An optional X kind argument is therefore ignored.
+  // Values are chosen to match the llvm.get.rounding encoding:
+  //  0 - toward zero [supported]
+  //  1 - to nearest, ties to even [supported] - default
+  //  2 - toward positive infinity [supported]
+  //  3 - toward negative infinity [supported]
+  //  4 - to nearest, ties away from zero [not supported]
+  assert(args.size() == 1 || args.size() == 2);
+  auto [fieldRef, fieldTy] = getFieldRef(builder, loc, fir::getBase(args[0]));
+  mlir::Value mode = builder.create<fir::LoadOp>(loc, fieldRef);
+  mlir::Value lbOk = builder.create<mlir::arith::CmpIOp>(
+      loc, mlir::arith::CmpIPredicate::sge, mode,
+      builder.createIntegerConstant(loc, fieldTy,
+                                    _FORTRAN_RUNTIME_IEEE_TO_ZERO));
+  mlir::Value ubOk = builder.create<mlir::arith::CmpIOp>(
+      loc, mlir::arith::CmpIPredicate::sle, mode,
+      builder.createIntegerConstant(loc, fieldTy, _FORTRAN_RUNTIME_IEEE_DOWN));
   return builder.createConvert(
-      loc, resultType,
-      builder.create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::ne,
-                                          exponent, maxExponent));
+      loc, resultType, builder.create<mlir::arith::AndIOp>(loc, lbOk, ubOk));
 }
 
+// IEEE_UNORDERED
 mlir::Value
-IntrinsicLibrary::genIeeeIsNormal(mlir::Type resultType,
+IntrinsicLibrary::genIeeeUnordered(mlir::Type resultType,
                                    llvm::ArrayRef<mlir::Value> args) {
-  // Check if is positive or negative normal
-  return genIsFPClass(resultType, args, 0b101101000);
+  // Check if REAL args X or Y or both are (signaling or quiet) NaNs.
+  assert(args.size() == 2);
+  mlir::Type i1Ty = builder.getI1Type();
+  mlir::Value xIsNan = genIsFPClass(i1Ty, args[0], 0b0000000011);
+  mlir::Value yIsNan = genIsFPClass(i1Ty, args[1], 0b0000000011);
+  mlir::Value res = builder.create<mlir::arith::OrIOp>(loc, xIsNan, yIsNan);
+  return builder.createConvert(loc, resultType, res);
+}
+
+// IEEE_VALUE
+mlir::Value IntrinsicLibrary::genIeeeValue(mlir::Type resultType,
+                                           llvm::ArrayRef<mlir::Value> args) {
+  // Return a KIND(X) REAL number of IEEE_CLASS_TYPE CLASS.
+  assert(args.size() == 2);
+  mlir::FloatType realType =
+      fir::getBase(args[0]).getType().dyn_cast<mlir::FloatType>();
+  int bitWidth = realType.getWidth();
+  mlir::Type intType = builder.getIntegerType(bitWidth);
+  mlir::Type valueTy = bitWidth <= 64 ? intType : builder.getIntegerType(64);
+  constexpr int tableSize = _FORTRAN_RUNTIME_IEEE_OTHER_VALUE + 1;
+  mlir::Type tableTy = fir::SequenceType::get(tableSize, valueTy);
+  std::string tableName = RTNAME_STRING(IeeeValueTable_) +
+                          std::to_string(realType.isBF16() ? 3 : bitWidth >> 3);
+  if (!builder.getNamedGlobal(tableName)) {
+    llvm::SmallVector<mlir::Attribute, tableSize> values;
+    auto insert = [&](std::int64_t v) {
+      values.push_back(builder.getIntegerAttr(valueTy, v));
+    };
+    insert(0); // placeholder
+    switch (bitWidth) {
+    case 16:
+      if (realType.isF16()) {
+        // kind=2: 1 sign bit, 5 exponent bits, 10 significand bits
+        /* IEEE_SIGNALING_NAN      */ insert(0x7d00);
+        /* IEEE_QUIET_NAN          */ insert(0x7e00);
+        /* IEEE_NEGATIVE_INF       */ insert(0xfc00);
+        /* IEEE_NEGATIVE_NORMAL    */ insert(0xbc00);
+        /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8200);
+        /* IEEE_NEGATIVE_ZERO      */ insert(0x8000);
+        /* IEEE_POSITIVE_ZERO      */ insert(0x0000);
+        /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0200);
+        /* IEEE_POSITIVE_NORMAL    */ insert(0x3c00); // 1.0
+        /* IEEE_POSITIVE_INF       */ insert(0x7c00);
+        break;
+      }
+      assert(realType.isBF16() && "unknown 16-bit real type");
+      // kind=3: 1 sign bit, 8 exponent bits, 7 significand bits
+      /* IEEE_SIGNALING_NAN      */ insert(0x7fa0);
+      /* IEEE_QUIET_NAN          */ insert(0x7fc0);
+      /* IEEE_NEGATIVE_INF       */ insert(0xff80);
+      /* IEEE_NEGATIVE_NORMAL    */ insert(0xbf80);
+      /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8040);
+      /* IEEE_NEGATIVE_ZERO      */ insert(0x8000);
+      /* IEEE_POSITIVE_ZERO      */ insert(0x0000);
+      /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0040);
+      /* IEEE_POSITIVE_NORMAL    */ insert(0x3f80); // 1.0
+      /* IEEE_POSITIVE_INF       */ insert(0x7f80);
+      break;
+    case 32:
+      // kind=4: 1 sign bit, 8 exponent bits, 23 significand bits
+      /* IEEE_SIGNALING_NAN      */ insert(0x7fa00000);
+      /* IEEE_QUIET_NAN          */ insert(0x7fc00000);
+      /* IEEE_NEGATIVE_INF       */ insert(0xff800000);
+      /* IEEE_NEGATIVE_NORMAL    */ insert(0xbf800000);
+      /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x80400000);
+      /* IEEE_NEGATIVE_ZERO      */ insert(0x80000000);
+      /* IEEE_POSITIVE_ZERO      */ insert(0x00000000);
+      /* IEEE_POSITIVE_SUBNORMAL */ insert(0x00400000);
+      /* IEEE_POSITIVE_NORMAL    */ insert(0x3f800000); // 1.0
+      /* IEEE_POSITIVE_INF       */ insert(0x7f800000);
+      break;
+    case 64:
+      // kind=8: 1 sign bit, 11 exponent bits, 52 significand bits
+      /* IEEE_SIGNALING_NAN      */ insert(0x7ff4000000000000);
+      /* IEEE_QUIET_NAN          */ insert(0x7ff8000000000000);
+      /* IEEE_NEGATIVE_INF       */ insert(0xfff0000000000000);
+      /* IEEE_NEGATIVE_NORMAL    */ insert(0xbff0000000000000);
+      /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8008000000000000);
+      /* IEEE_NEGATIVE_ZERO      */ insert(0x8000000000000000);
+      /* IEEE_POSITIVE_ZERO      */ insert(0x0000000000000000);
+      /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0008000000000000);
+      /* IEEE_POSITIVE_NORMAL    */ insert(0x3ff0000000000000); // 1.0
+      /* IEEE_POSITIVE_INF       */ insert(0x7ff0000000000000);
+      break;
+    case 80:
+      // kind=10: 1 sign bit, 15 exponent bits, 1+63 significand bits
+      // 64 high order bits; 16 low order bits are 0.
+      /* IEEE_SIGNALING_NAN      */ insert(0x7fffa00000000000);
+      /* IEEE_QUIET_NAN          */ insert(0x7fffc00000000000);
+      /* IEEE_NEGATIVE_INF       */ insert(0xffff800000000000);
+      /* IEEE_NEGATIVE_NORMAL    */ insert(0xbfff800000000000);
+      /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8000400000000000);
+      /* IEEE_NEGATIVE_ZERO      */ insert(0x8000000000000000);
+      /* IEEE_POSITIVE_ZERO      */ insert(0x0000000000000000);
+      /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0000400000000000);
+      /* IEEE_POSITIVE_NORMAL    */ insert(0x3fff800000000000); // 1.0
+      /* IEEE_POSITIVE_INF       */ insert(0x7fff800000000000);
+      break;
+    case 128:
+      // kind=16: 1 sign bit, 15 exponent bits, 112 significand bits
+      // 64 high order bits; 64 low order bits are 0.
+      /* IEEE_SIGNALING_NAN      */ insert(0x7fff400000000000);
+      /* IEEE_QUIET_NAN          */ insert(0x7fff800000000000);
+      /* IEEE_NEGATIVE_INF       */ insert(0xffff000000000000);
+      /* IEEE_NEGATIVE_NORMAL    */ insert(0xbfff000000000000);
+      /* IEEE_NEGATIVE_SUBNORMAL */ insert(0x8000200000000000);
+      /* IEEE_NEGATIVE_ZERO      */ insert(0x8000000000000000);
+      /* IEEE_POSITIVE_ZERO      */ insert(0x0000000000000000);
+      /* IEEE_POSITIVE_SUBNORMAL */ insert(0x0000200000000000);
+      /* IEEE_POSITIVE_NORMAL    */ insert(0x3fff000000000000); // 1.0
+      /* IEEE_POSITIVE_INF       */ insert(0x7fff000000000000);
+      break;
+    default:
+      llvm_unreachable("unknown real type");
+    }
+    insert(0); // IEEE_OTHER_VALUE
+    assert(values.size() == tableSize && "ieee value mismatch");
+    builder.createGlobalConstant(
+        loc, tableTy, tableName, builder.createLinkOnceLinkage(),
+        mlir::DenseElementsAttr::get(
+            mlir::RankedTensorType::get(tableSize, valueTy), values));
+  }
+
+  auto [fieldRef, ignore] = getFieldRef(builder, loc, fir::getBase(args[1]));
+  mlir::Value which = builder.create<fir::LoadOp>(loc, fieldRef);
+  mlir::Value bits = builder.create<fir::LoadOp>(
+      loc,
+      builder.create<fir::CoordinateOp>(
+          loc, builder.getRefType(valueTy),
+          builder.create<fir::AddrOfOp>(loc, builder.getRefType(tableTy),
+                                        builder.getSymbolRefAttr(tableName)),
+          which));
+  if (bitWidth > 64)
+    bits = builder.create<mlir::arith::ShLIOp>(
+        loc, builder.createConvert(loc, intType, bits),
+        builder.createIntegerConstant(loc, intType, bitWidth - 64));
+  return builder.create<mlir::arith::BitcastOp>(loc, realType, bits);
 }
 
 // IEOR
 mlir::Value IntrinsicLibrary::genIeor(mlir::Type resultType,
                                       llvm::ArrayRef<mlir::Value> args) {
   assert(args.size() == 2);
   return builder.create<mlir::arith::XOrIOp>(loc, args[0], args[1]);
 }

 IntrinsicLibrary::genIsIostatValue(mlir::Type resultType,
                                    llvm::ArrayRef<mlir::Value> args) {
   assert(args.size() == 1);
   return builder.create<mlir::arith::CmpIOp>(
       loc, mlir::arith::CmpIPredicate::eq, args[0],
       builder.createIntegerConstant(loc, args[0].getType(), value));
 }
 
-mlir::Value IntrinsicLibrary::genIsFPClass(mlir::Type resultType,
-                                           llvm::ArrayRef<mlir::Value> args,
-                                           int fpclass) {
-  assert(args.size() == 1);
-  mlir::MLIRContext *context = builder.getContext();
-  mlir::IntegerType i1ty = mlir::IntegerType::get(context, 1);
-
-  mlir::Value isfpclass =
-      builder.create<mlir::LLVM::IsFPClass>(loc, i1ty, args[0], fpclass);
-  return builder.createConvert(loc, resultType, isfpclass);
-}
-
-mlir::Value IntrinsicLibrary::genIsNan(mlir::Type resultType,
-                                       llvm::ArrayRef<mlir::Value> args) {
-  // Check is signaling or quiet nan
-  return genIsFPClass(resultType, args, 0b11);
-}
-
 // ISHFT
 mlir::Value IntrinsicLibrary::genIshft(mlir::Type resultType,
                                        llvm::ArrayRef<mlir::Value> args) {
   // A conformant ISHFT(I,SHIFT) call satisfies:
   //     abs(SHIFT) <= BIT_SIZE(I)
   // Return:  abs(SHIFT) >= BIT_SIZE(I)
   //              ? 0
   //              : SHIFT < 0

 IntrinsicLibrary::genLbound(mlir::Type resultType,
                             llvm::ArrayRef<fir::ExtendedValue> args) {
   assert(args.size() == 2 || args.size() == 3);
   const fir::ExtendedValue &array = args[0];
   if (const auto *boxValue = array.getBoxOf<fir::BoxValue>())
     if (boxValue->hasAssumedRank())
       TODO(loc, "intrinsic: lbound with assumed rank argument");
 
-  //===----------------------------------------------------------------------===//
   mlir::Type indexType = builder.getIndexType();
 
   // Semantics builds signatures for LBOUND calls as either
   // LBOUND(array, dim, [kind]) or LBOUND(array, [kind]).
   if (args.size() == 2 || isStaticallyAbsent(args, 1)) {
     // DIM is absent.
     mlir::Type lbType = fir::unwrapSequenceType(resultType);
     unsigned rank = array.rank();

flang/lib/Optimizer/Builder/LowLevelIntrinsics.cpp

 mlir::func::FuncOp fir::factory::getRealloc(fir::FirOpBuilder &builder) {
   auto ptrTy = builder.getRefType(builder.getIntegerType(8));
   llvm::SmallVector<mlir::Type> args = {ptrTy, builder.getI64Type()};
   auto reallocTy = mlir::FunctionType::get(builder.getContext(), args, {ptrTy});
   return builder.addNamedFunction(builder.getUnknownLoc(), "realloc",
                                   reallocTy);
 }
 
+mlir::func::FuncOp
+fir::factory::getLlvmGetRounding(fir::FirOpBuilder &builder) {
+  auto int32Ty = builder.getIntegerType(32);
+  auto funcTy =
+      mlir::FunctionType::get(builder.getContext(), std::nullopt, {int32Ty});
+  return builder.addNamedFunction(builder.getUnknownLoc(), "llvm.get.rounding",
+                                  funcTy);
+}
+
+mlir::func::FuncOp
+fir::factory::getLlvmSetRounding(fir::FirOpBuilder &builder) {
+  auto int32Ty = builder.getIntegerType(32);
+  auto funcTy =
+      mlir::FunctionType::get(builder.getContext(), {int32Ty}, std::nullopt);
+  return builder.addNamedFunction(builder.getUnknownLoc(), "llvm.set.rounding",
+                                  funcTy);
+}
+
 mlir::func::FuncOp fir::factory::getLlvmStackSave(fir::FirOpBuilder &builder) {
   auto ptrTy = builder.getRefType(builder.getIntegerType(8));
   auto funcTy =
       mlir::FunctionType::get(builder.getContext(), std::nullopt, {ptrTy});
   return builder.addNamedFunction(builder.getUnknownLoc(), "llvm.stacksave",
                                   funcTy);
 }
 

flang/module/ieee_arithmetic.f90

 !===-- module/ieee_arithmetic.f90 ------------------------------------------===!
 !
 ! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 ! See https://llvm.org/LICENSE.txt for license information.
 ! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 !
 !===------------------------------------------------------------------------===!
 
 ! Fortran 2018 Clause 17
 
+! ieee_class_type and ieee_round_type values
+include '../include/flang/Runtime/ieee_arithmetic.h'
+
 module ieee_arithmetic
   ! 17.1: "The module IEEE_ARITHMETIC behaves as if it contained a
   ! USE statement for IEEE_EXCEPTIONS; everything that is public in
   ! IEEE_EXCEPTIONS is public in IEEE_ARITHMETIC."
   use __Fortran_ieee_exceptions
 
   use __Fortran_builtins, only: &
     ieee_fma => __builtin_fma, &
module ieee_arithmetic
   implicit none
 
   type :: ieee_class_type
     private
     integer(kind=1) :: which = 0
   end type ieee_class_type
 
   type(ieee_class_type), parameter :: &
-    ieee_signaling_nan = ieee_class_type(1), &
-    ieee_quiet_nan = ieee_class_type(2), &
-    ieee_negative_inf = ieee_class_type(3), &
-    ieee_negative_normal = ieee_class_type(4), &
-    ieee_negative_denormal = ieee_class_type(5), &
-    ieee_negative_zero = ieee_class_type(6), &
-    ieee_positive_zero = ieee_class_type(7), &
-    ieee_positive_subnormal = ieee_class_type(8), &
-    ieee_positive_normal = ieee_class_type(9), &
-    ieee_positive_inf = ieee_class_type(10), &
-    ieee_other_value = ieee_class_type(11)
+    ieee_signaling_nan = ieee_class_type(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN), &
+    ieee_quiet_nan = ieee_class_type(_FORTRAN_RUNTIME_IEEE_QUIET_NAN), &
+    ieee_negative_inf = ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_INF), &
+    ieee_negative_normal = ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL), &
+    ieee_negative_subnormal = ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL), &
+    ieee_negative_zero = ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO), &
+    ieee_positive_zero = ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO), &
+    ieee_positive_subnormal = ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL), &
+    ieee_positive_normal = ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL), &
+    ieee_positive_inf = ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_INF), &
+    ieee_other_value = ieee_class_type(_FORTRAN_RUNTIME_IEEE_OTHER_VALUE)
 
   type(ieee_class_type), parameter :: &
-    ieee_negative_subnormal = ieee_negative_denormal, &
-    ieee_positive_denormal = ieee_negative_subnormal
+    ieee_negative_denormal = ieee_negative_subnormal, &
+    ieee_positive_denormal = ieee_positive_subnormal
 
   type :: ieee_round_type
     private
     integer(kind=1) :: mode = 0
   end type ieee_round_type
 
   type(ieee_round_type), parameter :: &
-    ieee_nearest = ieee_round_type(1), &
-    ieee_to_zero = ieee_round_type(2), &
-    ieee_up = ieee_round_type(3), &
-    ieee_down = ieee_round_type(4), &
-    ieee_away = ieee_round_type(5), &
-    ieee_other = ieee_round_type(6)
+    ieee_to_zero = ieee_round_type(_FORTRAN_RUNTIME_IEEE_TO_ZERO), &
+    ieee_nearest = ieee_round_type(_FORTRAN_RUNTIME_IEEE_NEAREST), &
+    ieee_up = ieee_round_type(_FORTRAN_RUNTIME_IEEE_UP), &
+    ieee_down = ieee_round_type(_FORTRAN_RUNTIME_IEEE_DOWN), &
+    ieee_away = ieee_round_type(_FORTRAN_RUNTIME_IEEE_AWAY), &
+    ieee_other = ieee_round_type(_FORTRAN_RUNTIME_IEEE_OTHER)
 
   interface operator(==)
     elemental logical function ieee_class_eq(x, y)
       import ieee_class_type
       type(ieee_class_type), intent(in) :: x, y
     end function ieee_class_eq
     elemental logical function ieee_round_eq(x, y)
       import ieee_round_type

flang/test/Lower/Intrinsics/ieee_class.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+#ifndef RK
+#define RK 8
+#endif
+
+module m
+  integer, parameter :: k = RK
+  character(20) :: tag(11)
+contains
+  ! CHECK-LABEL: func @_QMmPinit
+  subroutine init
+    tag( 1) = 'signaling_nan';      tag( 2) = 'quiet_nan'
+    tag( 3) = 'negative_inf';       tag( 4) = 'negative_normal'
+    tag( 5) = 'negative_denormal';  tag( 6) = 'negative_zero'
+    tag( 7) = 'positive_zero';      tag( 8) = 'positive_denormal'
+    tag( 9) = 'positive_normal';    tag(10) = 'positive_inf'
+    tag(11) = 'other_value'
+  end
+  ! CHECK-LABEL: func @_QMmPout
+  subroutine out(x,v)
+    use ieee_arithmetic
+    real(k) :: x
+    integer :: v
+    logical :: L(4)
+    L(1) = ieee_is_finite(x)
+    L(2) = ieee_is_nan(x)
+    L(3) = ieee_is_negative(x)
+    L(4) = ieee_is_normal(x)
+!   if (k== 2) print "('  k=2 ',f7.2,z6.4,  i4,': ',a18,4L2)", x,x, v, tag(v), L
+!   if (k== 3) print "('  k=3 ',f7.2,z6.4,  i4,': ',a18,4L2)", x,x, v, tag(v), L
+!   if (k== 4) print "('  k=4 ',f7.2,z10.8, i4,': ',a18,4L2)", x,x, v, tag(v), L
+    if (k== 8) print "('  k=8 ',f7.2,z18.16,i4,': ',a18,4L2)", x,x, v, tag(v), L
+!   if (k==10) print "('  k=10',f7.2,z22.20,i4,': ',a18,4L2)", x,x, v, tag(v), L
+!   if (k==16) print "('  k=16',f7.2,z34.32,i4,': ',a18,4L2)", x,x, v, tag(v), L
+  end
+end module m
+
+! CHECK-LABEL: func @_QPclassify
+subroutine classify(x)
+  use m; use ieee_arithmetic
+  real(k) :: x
+  ! CHECK-DAG: %[[V_0:[0-9]+]] = fir.alloca i32 {adapt.valuebyref}
+  ! CHECK-DAG: %[[V_1:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+  ! CHECK-DAG: %[[V_2:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}> {bindc_name = "r", uniq_name = "_QFclassifyEr"}
+  type(ieee_class_type) :: r
+
+  ! CHECK:     %[[V_8:[0-9]+]] = fir.load %arg0 : !fir.ref<f64>
+  ! CHECK:     %[[V_9:[0-9]+]] = arith.bitcast %[[V_8]] : f64 to i64
+  ! CHECK:     %[[V_10:[0-9]+]] = arith.shrui %[[V_9]], %c59{{.*}} : i64
+  ! CHECK:     %[[V_11:[0-9]+]] = arith.andi %[[V_10]], %c16{{.*}} : i64
+  ! CHECK:     %[[V_12:[0-9]+]] = arith.andi %[[V_9]], %c9218868437227405312{{.*}} : i64
+  ! CHECK:     %[[V_13:[0-9]+]] = arith.cmpi ne, %[[V_12]], %c0{{.*}} : i64
+  ! CHECK:     %[[V_14:[0-9]+]] = arith.select %[[V_13]], %c8{{.*}}, %c0{{.*}} : i64
+  ! CHECK:     %[[V_15:[0-9]+]] = arith.ori %[[V_11]], %[[V_14]] : i64
+  ! CHECK:     %[[V_16:[0-9]+]] = arith.cmpi eq, %[[V_12]], %c9218868437227405312{{.*}} : i64
+  ! CHECK:     %[[V_17:[0-9]+]] = arith.select %[[V_16]], %c4{{.*}}, %c0{{.*}} : i64
+  ! CHECK:     %[[V_18:[0-9]+]] = arith.ori %[[V_15]], %[[V_17]] : i64
+  ! CHECK:     %[[V_19:[0-9]+]] = arith.andi %[[V_9]], %c2251799813685247{{.*}} : i64
+  ! CHECK:     %[[V_20:[0-9]+]] = arith.cmpi ne, %[[V_19]], %c0{{.*}} : i64
+  ! CHECK:     %[[V_21:[0-9]+]] = arith.select %[[V_20]], %c2{{.*}}, %c0{{.*}} : i64
+  ! CHECK:     %[[V_22:[0-9]+]] = arith.ori %[[V_18]], %[[V_21]] : i64
+  ! CHECK:     %[[V_23:[0-9]+]] = arith.shrui %[[V_9]], %c51{{.*}} : i64
+  ! CHECK:     %[[V_24:[0-9]+]] = arith.andi %[[V_23]], %c1{{.*}} : i64
+  ! CHECK:     %[[V_25:[0-9]+]] = arith.ori %[[V_22]], %[[V_24]] : i64
+  ! CHECK:     %[[V_26:[0-9]+]] = fir.address_of(@_FortranAIeeeClassTable) : !fir.ref<!fir.array<32xi8>>
+  ! CHECK:     %[[V_27:[0-9]+]] = fir.coordinate_of %[[V_26]], %[[V_25]] : (!fir.ref<!fir.array<32xi8>>, i64) -> !fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>
+  ! CHECK:     %[[V_28:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+  ! CHECK:     %[[V_29:[0-9]+]] = fir.coordinate_of %[[V_27]], %[[V_28]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+  ! CHECK:     %[[V_30:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+  ! CHECK:     %[[V_31:[0-9]+]] = fir.coordinate_of %[[V_2]], %[[V_30]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+  ! CHECK:     %[[V_32:[0-9]+]] = fir.load %[[V_29]] : !fir.ref<i8>
+  ! CHECK:     fir.store %[[V_32]] to %[[V_31]] : !fir.ref<i8>
+  r = ieee_class(x)
+
+! if (r==ieee_signaling_nan)      call out(x, 1)
+! if (r==ieee_quiet_nan)          call out(x, 2)
+  ! CHECK:     %[[V_38:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+  ! CHECK:     %[[V_39:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_38]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+  ! CHECK:     fir.store %c3{{.*}} to %[[V_39]] : !fir.ref<i8>
+  ! CHECK:     %[[V_40:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+  ! CHECK:     %[[V_41:[0-9]+]] = fir.coordinate_of %[[V_2]], %[[V_40]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+  ! CHECK:     %[[V_42:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+  ! CHECK:     %[[V_43:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_42]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+  ! CHECK:     %[[V_44:[0-9]+]] = fir.load %[[V_41]] : !fir.ref<i8>
+  ! CHECK:     %[[V_45:[0-9]+]] = fir.load %[[V_43]] : !fir.ref<i8>
+  ! CHECK:     %[[V_46:[0-9]+]] = arith.cmpi eq, %[[V_44]], %[[V_45]] : i8
+  ! CHECK:     fir.if %[[V_46]] {
+  ! CHECK:       fir.store %c3{{.*}} to %[[V_0]] : !fir.ref<i32>
+  ! CHECK:       fir.call @_QMmPout(%arg0, %[[V_0]]) {{.*}} : (!fir.ref<f64>, !fir.ref<i32>) -> ()
+  ! CHECK:     }
+  if (r==ieee_negative_inf)       call out(x, 3)
+! if (r==ieee_negative_normal)    call out(x, 4)
+! if (r==ieee_negative_denormal)  call out(x, 5)
+! if (r==ieee_negative_zero)      call out(x, 6)
+! if (r==ieee_positive_zero)      call out(x, 7)
+! if (r==ieee_positive_denormal)  call out(x, 8)
+! if (r==ieee_positive_normal)    call out(x, 9)
+! if (r==ieee_positive_inf)       call out(x,10)
+! if (r==ieee_other_value)        call out(x,11)
+end
+
+! CHECK-LABEL: func @_QQmain
+program p
+  use m; use ieee_arithmetic
+  real(k) :: x(10)
+
+  call init
+
+! x(1)  = ieee_value(x(1), ieee_signaling_nan)
+! x(2)  = ieee_value(x(1), ieee_quiet_nan)
+  ! CHECK:     %[[V_0:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+  ! CHECK:     %[[V_2:[0-9]+]] = fir.address_of(@_QFEx) : !fir.ref<!fir.array<10xf64>>
+  ! CHECK:     %[[V_8:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+  ! CHECK:     %[[V_9:[0-9]+]] = fir.coordinate_of %[[V_0]], %[[V_8]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+  ! CHECK:     fir.store %c3{{.*}} to %[[V_9]] : !fir.ref<i8>
+  ! CHECK:     %[[V_10:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+  ! CHECK:     %[[V_11:[0-9]+]] = fir.coordinate_of %[[V_0]], %[[V_10]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+  ! CHECK:     %[[V_12:[0-9]+]] = fir.load %[[V_11]] : !fir.ref<i8>
+  ! CHECK:     %[[V_13:[0-9]+]] = fir.address_of(@_FortranAIeeeValueTable_8) : !fir.ref<!fir.array<12xi64>>
+  ! CHECK:     %[[V_14:[0-9]+]] = fir.coordinate_of %[[V_13]], %[[V_12]] : (!fir.ref<!fir.array<12xi64>>, i8) -> !fir.ref<i64>
+  ! CHECK:     %[[V_15:[0-9]+]] = fir.load %[[V_14]] : !fir.ref<i64>
+  ! CHECK:     %[[V_16:[0-9]+]] = arith.bitcast %[[V_15]] : i64 to f64
+  ! CHECK:     %[[V_17:[0-9]+]] = arith.subi %c3{{.*}}, %c1{{.*}} : i64
+  ! CHECK:     %[[V_18:[0-9]+]] = fir.coordinate_of %[[V_2]], %[[V_17]] : (!fir.ref<!fir.array<10xf64>>, i64) -> !fir.ref<f64>
+  ! CHECK:     fir.store %[[V_16]] to %[[V_18]] : !fir.ref<f64>
+  x(3)  = ieee_value(x(1), ieee_negative_inf)
+! x(4)  = ieee_value(x(1), ieee_negative_normal)
+! x(5)  = ieee_value(x(1), ieee_negative_subnormal)
+! x(6)  = ieee_value(x(1), ieee_negative_zero)
+! x(7)  = ieee_value(x(1), ieee_positive_zero)
+! x(8)  = ieee_value(x(1), ieee_positive_subnormal)
+! x(9)  = ieee_value(x(1), ieee_positive_normal)
+! x(10) = ieee_value(x(1), ieee_positive_inf)
+
+  do i = 1,10
+    call classify(x(i))
+  enddo
+end
+
+! CHECK: fir.global linkonce @_FortranAIeeeClassTable(dense<[7, 8, 8, 8, 11, 11, 11, 11, 9, 9, 9, 9, 10, 2, 1, 2, 6, 5, 5, 5, 11, 11, 11, 11, 4, 4, 4, 4, 3, 2, 1, 2]> : tensor<32xi8>) constant : !fir.array<32xi8>
+! CHECK: fir.global linkonce @_FortranAIeeeValueTable_8(dense<[0, 9219994337134247936, 9221120237041090560, -4503599627370496, -4616189618054758400, -9221120237041090560, -9223372036854775808, 0, 2251799813685248, 4607182418800017408, 9218868437227405312, 0]> : tensor<12xi64>) constant : !fir.array<12xi64>

flang/test/Lower/Intrinsics/ieee_class_queries.f90

+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+  ! CHECK-LABEL: func @_QQmain
+  use ieee_arithmetic, only: ieee_is_finite, ieee_is_nan, ieee_is_negative, &
+                             ieee_is_normal
+  real(2) :: x2 = -2.0
+  real(3) :: x3 = -3.0
+  real(4) :: x4 = -4.0
+  real(8) :: x8 = -8.0
+  real(10) :: x10 = -10.0
+  real(16) :: x16 = -16.0
+
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 504 : i32}> : (f16) -> i1
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 60 : i32}> : (f16) -> i1
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 360 : i32}> : (f16) -> i1
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 3 : i32}> : (f16) -> i1
+  print*, ieee_is_finite(x2), ieee_is_negative(x2), ieee_is_normal(x2), &
+          ieee_is_nan(x2)
+
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 504 : i32}> : (bf16) -> i1
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 60 : i32}> : (bf16) -> i1
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 360 : i32}> : (bf16) -> i1
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 3 : i32}> : (bf16) -> i1
+  print*, ieee_is_finite(x3), ieee_is_negative(x3), ieee_is_normal(x3), &
+          ieee_is_nan(x3)
+
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 504 : i32}> : (f32) -> i1
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 60 : i32}> : (f32) -> i1
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 360 : i32}> : (f32) -> i1
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 3 : i32}> : (f32) -> i1
+  print*, ieee_is_finite(x4), ieee_is_negative(x4), ieee_is_normal(x4), &
+          ieee_is_nan(x4)
+
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 504 : i32}> : (f64) -> i1
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 60 : i32}> : (f64) -> i1
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 360 : i32}> : (f64) -> i1
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 3 : i32}> : (f64) -> i1
+  print*, ieee_is_finite(x8), ieee_is_negative(x8), ieee_is_normal(x8), &
+          ieee_is_nan(x8)
+
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 504 : i32}> : (f80) -> i1
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 60 : i32}> : (f80) -> i1
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 360 : i32}> : (f80) -> i1
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 3 : i32}> : (f80) -> i1
+  print*, ieee_is_finite(x10), ieee_is_negative(x10), ieee_is_normal(x10), &
+          ieee_is_nan(x10)
+
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 504 : i32}> : (f128) -> i1
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 60 : i32}> : (f128) -> i1
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 360 : i32}> : (f128) -> i1
+  ! CHECK:     "llvm.intr.is.fpclass"(%{{.*}}) <{bit = 3 : i32}> : (f128) -> i1
+  print*, ieee_is_finite(x16), ieee_is_negative(x16), ieee_is_normal(x16), &
+          ieee_is_nan(x16)
+
+  end

flang/test/Lower/Intrinsics/ieee_copy_sign.f90

+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+! CHECK-LABEL: c.func @_QQmain
+program cs
+  use ieee_arithmetic
+
+  ! CHECK-DAG: %[[V_0:[0-9]+]] = fir.alloca f16 {adapt.valuebyref}
+  ! CHECK-DAG: %[[V_1:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+  ! CHECK:     %[[V_2:[0-9]+]] = fir.address_of(@_QFEx2) : !fir.ref<f16>
+  ! CHECK:     %[[V_3:[0-9]+]] = fir.address_of(@_QFEx4) : !fir.ref<f32>
+  ! CHECK:     %[[V_4:[0-9]+]] = fir.address_of(@_QFEy4) : !fir.ref<f32>
+  real(2) :: x2 =    2.0
+  real(4) :: x4 =    4.0
+  real(4) :: y4 = -100.0
+
+  ! CHECK:     %[[V_8:[0-9]+]] = fir.load %[[V_3]] : !fir.ref<f32>
+  ! CHECK:     %[[V_9:[0-9]+]] = fir.load %[[V_4]] : !fir.ref<f32>
+  ! CHECK:     %[[V_10:[0-9]+]] = llvm.intr.copysign(%[[V_8]], %[[V_9]])  : (f32, f32) -> f32
+  ! CHECK:     %[[V_11:[0-9]+]] = fir.call @_FortranAioOutputReal32(%{{.*}}, %[[V_10]]) {{.*}} : (!fir.ref<i8>, f32) -> i1
+  print*, ieee_copy_sign(x4, y4)
+
+  ! CHECK:     %[[V_16:[0-9]+]] = fir.load %[[V_2]] : !fir.ref<f16>
+  ! CHECK:     %[[V_22:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+  ! CHECK:     %[[V_23:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_22]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+  ! CHECK:     fir.store %c2{{.*}} to %[[V_23]] : !fir.ref<i8>
+
+  ! CHECK:     %[[V_24:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+  ! CHECK:     %[[V_25:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_24]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+  ! CHECK:     %[[V_26:[0-9]+]] = fir.load %[[V_25]] : !fir.ref<i8>
+  ! CHECK:     %[[V_27:[0-9]+]] = fir.address_of(@_FortranAIeeeValueTable_16) : !fir.ref<!fir.array<12xi64>>
+  ! CHECK:     %[[V_28:[0-9]+]] = fir.coordinate_of %[[V_27]], %[[V_26]] : (!fir.ref<!fir.array<12xi64>>, i8) -> !fir.ref<i64>
+  ! CHECK:     %[[V_29:[0-9]+]] = fir.load %[[V_28]] : !fir.ref<i64>
+  ! CHECK:     %[[V_30:[0-9]+]] = fir.convert %[[V_29]] : (i64) -> i128
+  ! CHECK:     %[[V_31:[0-9]+]] = arith.shli %[[V_30]], %c64{{.*}} : i128
+  ! CHECK:     %[[V_32:[0-9]+]] = arith.bitcast %[[V_31]] : i128 to f128
+  ! CHECK:     %[[V_33:[0-9]+]] = arith.negf %[[V_32]] {{.*}} : f128
+  ! CHECK:     %[[V_34:[0-9]+]] = arith.bitcast %[[V_16]] : f16 to i16
+  ! CHECK:     %[[V_35:[0-9]+]] = arith.bitcast %[[V_33]] : f128 to i128
+  ! CHECK:     %[[V_36:[0-9]+]] = arith.shrui %[[V_35]], %c127{{.*}} : i128
+  ! CHECK:     %[[V_37:[0-9]+]] = arith.shli %[[V_34]], %c1{{.*}} : i16
+  ! CHECK:     %[[V_38:[0-9]+]] = arith.shrui %[[V_37]], %c1{{.*}} : i16
+  ! CHECK:     %[[V_39:[0-9]+]] = arith.shli %c1{{.*}}, %c15{{.*}} : i16
+  ! CHECK:     %[[V_40:[0-9]+]] = arith.cmpi eq, %[[V_36]], %c0{{.*}} : i128
+  ! CHECK:     %[[V_41:[0-9]+]] = arith.select %[[V_40]], %c0{{.*}}, %[[V_39]] : i16
+  ! CHECK:     %[[V_42:[0-9]+]] = arith.ori %[[V_38]], %[[V_41]] : i16
+  ! CHECK:     %[[V_43:[0-9]+]] = arith.bitcast %[[V_42]] : i16 to f16
+  ! CHECK:     fir.store %[[V_43]] to %[[V_0]] : !fir.ref<f16>
+  print*, ieee_copy_sign(x2, -ieee_value(0.0_16, ieee_quiet_nan))
+end
+
+! CHECK: fir.global linkonce @_FortranAIeeeValueTable_16(dense<[0, 9223160930622242816, 9223231299366420480, -281474976710656, -4611967493404098560, -9223336852482686976, -9223372036854775808, 0, 35184372088832, 4611404543450677248, 9223090561878065152, 0]> : tensor<12xi64>) constant : !fir.array<12xi64>

flang/test/Lower/Intrinsics/ieee_is_finite.f90

 ! RUN: bbc -emit-fir %s -o - | FileCheck %s
 
-! CHECK-LABEL: @_QPis_finite_test
+! CHECK-LABEL: c.func @_QPis_finite_test
 subroutine is_finite_test(x, y)
   use ieee_arithmetic, only: ieee_is_finite
   real(4) x
   real(8) y
-  ! CHECK:   %[[V_3:[0-9]+]] = fir.load %arg0 : !fir.ref<f32>
-  ! CHECK:   %[[V_4:[0-9]+]] = arith.bitcast %[[V_3]] : f32 to i32
-  ! CHECK:   %[[V_5:[0-9]+]] = arith.subi %c32{{.*}}, %c8{{.*}} : i32
-  ! CHECK:   %[[V_6:[0-9]+]] = arith.shrui %c-1{{.*}}, %[[V_5]] : i32
-  ! CHECK:   %[[V_7:[0-9]+]] = arith.shrsi %[[V_4]], %c23{{.*}} : i32
-  ! CHECK:   %[[V_8:[0-9]+]] = arith.andi %[[V_7]], %[[V_6]] : i32
-  ! CHECK:   %[[V_9:[0-9]+]] = arith.cmpi eq, %c8{{.*}}, %c0{{.*}} : i32
-  ! CHECK:   %[[V_10:[0-9]+]] = arith.select %[[V_9]], %c0{{.*}}, %[[V_8]] : i32
-  ! CHECK:   %[[V_11:[0-9]+]] = arith.cmpi ne, %[[V_10]], %c255{{.*}} : i32
-  ! CHECK:   %[[V_12:[0-9]+]] = fir.convert %[[V_11]] : (i1) -> !fir.logical<4>
-  ! CHECK:   %[[V_13:[0-9]+]] = fir.convert %[[V_12]] : (!fir.logical<4>) -> i1
+
+  ! CHECK:     %[[V_3:[0-9]+]] = fir.load %arg0 : !fir.ref<f32>
+  ! CHECK:     %[[V_4:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_3]]) <{bit = 504 : i32}> : (f32) -> i1
+  ! CHECK:     %[[V_5:[0-9]+]] = fir.convert %[[V_4]] : (i1) -> !fir.logical<4>
+  ! CHECK:     %[[V_6:[0-9]+]] = fir.convert %[[V_5]] : (!fir.logical<4>) -> i1
+  ! CHECK:     %[[V_7:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_6]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
   print*, ieee_is_finite(x)
 
-  ! CHECK:   %[[V_19:[0-9]+]] = fir.load %arg0 : !fir.ref<f32>
-  ! CHECK:   %[[V_20:[0-9]+]] = fir.load %arg0 : !fir.ref<f32>
-  ! CHECK:   %[[V_21:[0-9]+]] = arith.addf %[[V_19]], %[[V_20]] {{.*}}: f32
-  ! CHECK:   %[[V_22:[0-9]+]] = arith.bitcast %[[V_21]] : f32 to i32
-  ! CHECK:   %[[V_23:[0-9]+]] = arith.subi %c32{{.*}}, %c8{{.*}} : i32
-  ! CHECK:   %[[V_24:[0-9]+]] = arith.shrui %c-1{{.*}}, %[[V_23]] : i32
-  ! CHECK:   %[[V_25:[0-9]+]] = arith.shrsi %[[V_22]], %c23{{.*}} : i32
-  ! CHECK:   %[[V_26:[0-9]+]] = arith.andi %[[V_25]], %[[V_24]] : i32
-  ! CHECK:   %[[V_27:[0-9]+]] = arith.cmpi eq, %c8{{.*}}, %c0{{.*}} : i32
-  ! CHECK:   %[[V_28:[0-9]+]] = arith.select %[[V_27]], %c0{{.*}}, %[[V_26]] : i32
-  ! CHECK:   %[[V_29:[0-9]+]] = arith.cmpi ne, %[[V_28]], %c255{{.*}} : i32
-  ! CHECK:   %[[V_30:[0-9]+]] = fir.convert %[[V_29]] : (i1) -> !fir.logical<4>
-  ! CHECK:   %[[V_31:[0-9]+]] = fir.convert %[[V_30]] : (!fir.logical<4>) -> i1
+  ! CHECK:     %[[V_12:[0-9]+]] = fir.load %arg0 : !fir.ref<f32>
+  ! CHECK:     %[[V_13:[0-9]+]] = fir.load %arg0 : !fir.ref<f32>
+  ! CHECK:     %[[V_14:[0-9]+]] = arith.addf %[[V_12]], %[[V_13]] {{.*}} : f32
+  ! CHECK:     %[[V_15:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_14]]) <{bit = 504 : i32}> : (f32) -> i1
+  ! CHECK:     %[[V_16:[0-9]+]] = fir.convert %[[V_15]] : (i1) -> !fir.logical<4>
+  ! CHECK:     %[[V_17:[0-9]+]] = fir.convert %[[V_16]] : (!fir.logical<4>) -> i1
+  ! CHECK:     %[[V_18:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_17]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
   print*, ieee_is_finite(x+x)
 
-  ! CHECK:   %[[V_37:[0-9]+]] = fir.load %arg1 : !fir.ref<f64>
-  ! CHECK:   %[[V_38:[0-9]+]] = arith.bitcast %[[V_37]] : f64 to i64
-  ! CHECK:   %[[V_39:[0-9]+]] = arith.subi %c64{{.*}}, %c11{{.*}} : i64
-  ! CHECK:   %[[V_40:[0-9]+]] = arith.shrui %c-1{{.*}}, %[[V_39]] : i64
-  ! CHECK:   %[[V_41:[0-9]+]] = arith.shrsi %[[V_38]], %c52{{.*}} : i64
-  ! CHECK:   %[[V_42:[0-9]+]] = arith.andi %[[V_41]], %[[V_40]] : i64
-  ! CHECK:   %[[V_43:[0-9]+]] = arith.cmpi eq, %c11{{.*}}, %c0{{.*}} : i64
-  ! CHECK:   %[[V_44:[0-9]+]] = arith.select %[[V_43]], %c0{{.*}}, %[[V_42]] : i64
-  ! CHECK:   %[[V_45:[0-9]+]] = arith.cmpi ne, %[[V_44]], %c2047{{.*}} : i64
-  ! CHECK:   %[[V_46:[0-9]+]] = fir.convert %[[V_45]] : (i1) -> !fir.logical<4>
-  ! CHECK:   %[[V_47:[0-9]+]] = fir.convert %[[V_46]] : (!fir.logical<4>) -> i1
+  ! CHECK:     %[[V_23:[0-9]+]] = fir.load %arg1 : !fir.ref<f64>
+  ! CHECK:     %[[V_24:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_23]]) <{bit = 504 : i32}> : (f64) -> i1
+  ! CHECK:     %[[V_25:[0-9]+]] = fir.convert %[[V_24]] : (i1) -> !fir.logical<4>
+  ! CHECK:     %[[V_26:[0-9]+]] = fir.convert %[[V_25]] : (!fir.logical<4>) -> i1
+  ! CHECK:     %[[V_27:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_26]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
   print*, ieee_is_finite(y)
 
-  ! CHECK:   %[[V_53:[0-9]+]] = fir.load %arg1 : !fir.ref<f64>
-  ! CHECK:   %[[V_54:[0-9]+]] = fir.load %arg1 : !fir.ref<f64>
-  ! CHECK:   %[[V_55:[0-9]+]] = arith.addf %[[V_53]], %[[V_54]] {{.*}}: f64
-  ! CHECK:   %[[V_56:[0-9]+]] = arith.bitcast %[[V_55]] : f64 to i64
-  ! CHECK:   %[[V_57:[0-9]+]] = arith.subi %c64{{.*}}, %c11{{.*}} : i64
-  ! CHECK:   %[[V_58:[0-9]+]] = arith.shrui %c-1{{.*}}, %[[V_57]] : i64
-  ! CHECK:   %[[V_59:[0-9]+]] = arith.shrsi %[[V_56]], %c52{{.*}} : i64
-  ! CHECK:   %[[V_60:[0-9]+]] = arith.andi %[[V_59]], %[[V_58]] : i64
-  ! CHECK:   %[[V_61:[0-9]+]] = arith.cmpi eq, %c11{{.*}}, %c0{{.*}} : i64
-  ! CHECK:   %[[V_62:[0-9]+]] = arith.select %[[V_61]], %c0{{.*}}, %[[V_60]] : i64
-  ! CHECK:   %[[V_63:[0-9]+]] = arith.cmpi ne, %[[V_62]], %c2047{{.*}} : i64
-  ! CHECK:   %[[V_64:[0-9]+]] = fir.convert %[[V_63]] : (i1) -> !fir.logical<4>
-  ! CHECK:   %[[V_65:[0-9]+]] = fir.convert %[[V_64]] : (!fir.logical<4>) -> i1
+  ! CHECK:     %[[V_32:[0-9]+]] = fir.load %arg1 : !fir.ref<f64>
+  ! CHECK:     %[[V_33:[0-9]+]] = fir.load %arg1 : !fir.ref<f64>
+  ! CHECK:     %[[V_34:[0-9]+]] = arith.addf %[[V_32]], %[[V_33]] {{.*}} : f64
+  ! CHECK:     %[[V_35:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_34]]) <{bit = 504 : i32}> : (f64) -> i1
+  ! CHECK:     %[[V_36:[0-9]+]] = fir.convert %[[V_35]] : (i1) -> !fir.logical<4>
+  ! CHECK:     %[[V_37:[0-9]+]] = fir.convert %[[V_36]] : (!fir.logical<4>) -> i1
+  ! CHECK:     %[[V_38:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_37]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
   print*, ieee_is_finite(y+y)
 end subroutine is_finite_test
 
+! CHECK-LABEL: c.func @_QQmain
   real(4) x
   real(8) y
+  ! CHECK:     %[[V_0:[0-9]+]] = fir.alloca f64 {adapt.valuebyref}
+  ! CHECK:     %[[V_1:[0-9]+]] = fir.alloca f32 {adapt.valuebyref}
+  ! CHECK:     %cst = arith.constant 3.40282347E+38 : f32
+  ! CHECK:     fir.store %cst to %[[V_1]] : !fir.ref<f32>
+  ! CHECK:     %cst_0 = arith.constant 1.7976931348623157E+308 : f64
+  ! CHECK:     fir.store %cst_0 to %[[V_0]] : !fir.ref<f64>
+  ! CHECK:     fir.call @_QPis_finite_test(%[[V_1]], %[[V_0]]) {{.*}} : (!fir.ref<f32>, !fir.ref<f64>) -> ()
   call is_finite_test(huge(x), huge(y))
 end

flang/test/Lower/Intrinsics/ieee_operator_eq.f90

-! RUN: bbc -emit-fir %s -o - | FileCheck %s
+! RUN: bbc -emit-fir -o - %s | FileCheck %s
 
-! CHECK-LABEL: @_QPs
+! CHECK-LABEL: c.func @_QPs
 subroutine s(r1,r2)
   use ieee_arithmetic, only: ieee_round_type, operator(==)
   type(ieee_round_type) :: r1, r2
   ! CHECK:   %[[V_3:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
   ! CHECK:   %[[V_4:[0-9]+]] = fir.coordinate_of %arg0, %[[V_3]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
-  ! CHECK:   %[[V_5:[0-9]+]] = fir.load %[[V_4]] : !fir.ref<i8>
-  ! CHECK:   %[[V_6:[0-9]+]] = fir.coordinate_of %arg1, %[[V_3]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
-  ! CHECK:   %[[V_7:[0-9]+]] = fir.load %[[V_6]] : !fir.ref<i8>
-  ! CHECK:   %[[V_8:[0-9]+]] = arith.cmpi eq, %[[V_5]], %[[V_7]] : i8
-  ! CHECK:   %[[V_9:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_8]]) {{.*}}: (!fir.ref<i8>, i1) -> i1
+  ! CHECK:   %[[V_5:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+  ! CHECK:   %[[V_6:[0-9]+]] = fir.coordinate_of %arg1, %[[V_5]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+  ! CHECK:   %[[V_7:[0-9]+]] = fir.load %[[V_4]] : !fir.ref<i8>
+  ! CHECK:   %[[V_8:[0-9]+]] = fir.load %[[V_6]] : !fir.ref<i8>
+  ! CHECK:   %[[V_9:[0-9]+]] = arith.cmpi eq, %[[V_7]], %[[V_8]] : i8
+  ! CHECK:   %[[V_10:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}} %[[V_9]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
+  ! CHECK:   return
+  ! CHECK: }
   print*, r1 == r2
 end
 
-! CHECK-LABEL: @_QQmain
+! CHECK-LABEL: c.func @_QQmain
   use ieee_arithmetic, only: ieee_round_type, ieee_nearest, ieee_to_zero
   interface
     subroutine s(r1,r2)
       import ieee_round_type
       type(ieee_round_type) :: r1, r2
     end
   end interface
+
   ! CHECK:   %[[V_0:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
   ! CHECK:   %[[V_1:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
   ! CHECK:   %[[V_2:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
   ! CHECK:   %[[V_3:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
-  ! CHECK:   %[[V_4:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
-  ! CHECK:   %[[V_5:[0-9]+]] = fir.coordinate_of %[[V_3]], %[[V_4]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
-  ! CHECK:   fir.store %c2{{.*}} to %[[V_5]] : !fir.ref<i8>
-  ! CHECK:   %[[V_6:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
-  ! CHECK:   %[[V_7:[0-9]+]] = fir.coordinate_of %[[V_2]], %[[V_6]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
-  ! CHECK:   fir.store %c1{{.*}} to %[[V_7]] : !fir.ref<i8>
+  ! CHECK:   %[[V_9:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+  ! CHECK:   %[[V_10:[0-9]+]] = fir.coordinate_of %[[V_3]], %[[V_9]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+  ! CHECK:   fir.store %c0{{.*}} to %[[V_10]] : !fir.ref<i8>
+  ! CHECK:   %[[V_16:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+  ! CHECK:   %[[V_17:[0-9]+]] = fir.coordinate_of %[[V_2]], %[[V_16]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+  ! CHECK:   fir.store %c1{{.*}} to %[[V_17]] : !fir.ref<i8>
+  ! CHECK:   fir.call @_QPs(%[[V_3]], %[[V_2]]) {{.*}} : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>) -> ()
   call s(ieee_to_zero, ieee_nearest)
 
-  ! CHECK:   fir.call @_QPs(%[[V_3]], %[[V_2]]) {{.*}}: (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>) -> ()
-  ! CHECK:   %[[V_8:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
-  ! CHECK:   %[[V_9:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_8]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
-  ! CHECK:   fir.store %c1{{.*}} to %[[V_9]] : !fir.ref<i8>
-  ! CHECK:   %[[V_10:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
-  ! CHECK:   %[[V_11:[0-9]+]] = fir.coordinate_of %[[V_0]], %[[V_10]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
-  ! CHECK:   fir.store %c1{{.*}} to %[[V_11]] : !fir.ref<i8>
-  ! CHECK:   fir.call @_QPs(%[[V_1]], %[[V_0]]) {{.*}}: (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>) -> ()
+  ! CHECK:   %[[V_23:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+  ! CHECK:   %[[V_24:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_23]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+  ! CHECK:   fir.store %c1{{.*}} to %[[V_24]] : !fir.ref<i8>
+  ! CHECK:   %[[V_30:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+  ! CHECK:   %[[V_31:[0-9]+]] = fir.coordinate_of %[[V_0]], %[[V_30]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+  ! CHECK:   fir.store %c1{{.*}} to %[[V_31]] : !fir.ref<i8>
+  ! CHECK:   fir.call @_QPs(%[[V_1]], %[[V_0]]) {{.*}} : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>) -> ()
   call s(ieee_nearest, ieee_nearest)
 end
+

flang/test/Lower/Intrinsics/ieee_rounding.f90

+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+! CHECK-LABEL: c.func @_QQmain
+program r
+  use ieee_arithmetic
+  ! CHECK-DAG: %[[V_0:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+  ! CHECK-DAG: %[[V_1:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+  ! CHECK-DAG: %[[V_2:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}> {bindc_name = "round_value", uniq_name = "_QFEround_value"}
+  type(ieee_round_type) :: round_value
+
+  ! CHECK:     %[[V_13:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+  ! CHECK:     %[[V_14:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_13]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+  ! CHECK:     fir.store %c3{{.*}} to %[[V_14]] : !fir.ref<i8>
+  ! CHECK:     %[[V_15:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+  ! CHECK:     %[[V_16:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_15]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+  ! CHECK:     %[[V_17:[0-9]+]] = fir.load %[[V_16]] : !fir.ref<i8>
+  ! CHECK:     %[[V_18:[0-9]+]] = arith.cmpi sge, %[[V_17]], %c0{{.*}} : i8
+  ! CHECK:     %[[V_19:[0-9]+]] = arith.cmpi sle, %[[V_17]], %c3{{.*}} : i8
+  ! CHECK:     %[[V_20:[0-9]+]] = arith.andi %[[V_18]], %[[V_19]] : i1
+  ! CHECK:     %[[V_21:[0-9]+]] = fir.convert %[[V_20]] : (i1) -> !fir.logical<4>
+  ! CHECK:     %[[V_22:[0-9]+]] = fir.convert %[[V_21]] : (!fir.logical<4>) -> i1
+  ! CHECK:     fir.if %[[V_22]] {
+  if (ieee_support_rounding(ieee_down)) then
+    ! CHECK:       %[[V_23:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+    ! CHECK:       %[[V_24:[0-9]+]] = fir.coordinate_of %[[V_2]], %[[V_23]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+    ! CHECK:       %[[V_25:[0-9]+]] = fir.call @llvm.get.rounding() {{.*}} : () -> i32
+    ! CHECK:       %[[V_26:[0-9]+]] = fir.convert %[[V_25]] : (i32) -> i8
+    ! CHECK:       fir.store %[[V_26]] to %[[V_24]] : !fir.ref<i8>
+    call ieee_get_rounding_mode(round_value)
+
+    ! CHECK:       %[[V_32:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+    ! CHECK:       %[[V_33:[0-9]+]] = fir.coordinate_of %[[V_0]], %[[V_32]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+    ! CHECK:       fir.store %c3{{.*}} to %[[V_33]] : !fir.ref<i8>
+    ! CHECK:       %[[V_34:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+    ! CHECK:       %[[V_35:[0-9]+]] = fir.coordinate_of %[[V_0]], %[[V_34]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+    ! CHECK:       %[[V_36:[0-9]+]] = fir.load %[[V_35]] : !fir.ref<i8>
+    ! CHECK:       %[[V_37:[0-9]+]] = fir.convert %[[V_36]] : (i8) -> i32
+    ! CHECK:       fir.call @llvm.set.rounding(%[[V_37]]) {{.*}} : (i32) -> ()
+    call ieee_set_rounding_mode(ieee_down)
+    print*, 'ok'
+
+    ! CHECK:       %[[V_46:[0-9]+]] = fir.field_index mode, !fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>
+    ! CHECK:       %[[V_47:[0-9]+]] = fir.coordinate_of %[[V_2]], %[[V_46]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{mode:i8}>>, !fir.field) -> !fir.ref<i8>
+    ! CHECK:       %[[V_48:[0-9]+]] = fir.load %[[V_47]] : !fir.ref<i8>
+    ! CHECK:       %[[V_49:[0-9]+]] = fir.convert %[[V_48]] : (i8) -> i32
+    ! CHECK:       fir.call @llvm.set.rounding(%[[V_49]]) {{.*}} : (i32) -> ()
+    call ieee_set_rounding_mode(round_value)
+  endif
+end

flang/test/Lower/Intrinsics/ieee_signbit.f90

+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+! CHECK-LABEL: c.func @_QQmain
+use ieee_arithmetic
+! CHECK:     %[[V_0:[0-9]+]] = fir.alloca f32 {bindc_name = "x", uniq_name = "_QFEx"}
+! CHECK:     %cst = arith.constant -2.000000e+00 : f32
+! CHECK:     fir.store %cst to %[[V_0]] : !fir.ref<f32>
+x = -2.0
+
+! CHECK:     %[[V_4:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<f32>
+! CHECK:     %[[V_5:[0-9]+]] = arith.bitcast %[[V_4]] : f32 to i32
+! CHECK:     %[[V_6:[0-9]+]] = arith.shrui %[[V_5]], %c31{{.*}} : i32
+! CHECK:     %[[V_7:[0-9]+]] = fir.convert %[[V_6]] : (i32) -> !fir.logical<4>
+! CHECK:     %[[V_8:[0-9]+]] = fir.convert %[[V_7]] : (!fir.logical<4>) -> i1
+! CHECK:     %[[V_9:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_8]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
+
+! CHECK:     %cst_0 = arith.constant 1.700000e+01 : f32
+! CHECK:     %[[V_10:[0-9]+]] = arith.bitcast %cst_0 : f32 to i32
+! CHECK:     %[[V_11:[0-9]+]] = arith.shrui %[[V_10]], %c31{{.*}} : i32
+! CHECK:     %[[V_12:[0-9]+]] = fir.convert %[[V_11]] : (i32) -> !fir.logical<4>
+! CHECK:     %[[V_13:[0-9]+]] = fir.convert %[[V_12]] : (!fir.logical<4>) -> i1
+! CHECK:     %[[V_14:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_13]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
+print*, ieee_signbit(x), ieee_signbit(17.0)
+end

flang/test/Lower/Intrinsics/ieee_unordered.f90

+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+! CHECK-LABEL: func @_QQmain
+use ieee_arithmetic
+! CHECK-DAG: %[[V_0:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+! CHECK-DAG: %[[V_1:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+! CHECK-DAG: %[[V_2:[0-9]+]] = fir.alloca f128 {bindc_name = "x", uniq_name = "_QFEx"}
+! CHECK-DAG: %[[V_3:[0-9]+]] = fir.alloca f128 {bindc_name = "y", uniq_name = "_QFEy"}
+! CHECK-DAG: %[[V_4:[0-9]+]] = fir.alloca f128 {bindc_name = "z", uniq_name = "_QFEz"}
+real(16) :: x, y, z
+
+x = -17.0
+
+! CHECK:     %[[V_10:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+! CHECK:     %[[V_11:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_10]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+! CHECK:     fir.store %c3{{.*}} to %[[V_11]] : !fir.ref<i8>
+
+! CHECK:     %[[V_12:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+! CHECK:     %[[V_13:[0-9]+]] = fir.coordinate_of %[[V_1]], %[[V_12]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+! CHECK:     %[[V_14:[0-9]+]] = fir.load %[[V_13]] : !fir.ref<i8>
+! CHECK:     %[[V_15:[0-9]+]] = fir.address_of(@_FortranAIeeeValueTable_16) : !fir.ref<!fir.array<12xi64>>
+! CHECK:     %[[V_16:[0-9]+]] = fir.coordinate_of %[[V_15]], %[[V_14]] : (!fir.ref<!fir.array<12xi64>>, i8) -> !fir.ref<i64>
+! CHECK:     %[[V_17:[0-9]+]] = fir.load %[[V_16]] : !fir.ref<i64>
+! CHECK:     %[[V_18:[0-9]+]] = fir.convert %[[V_17]] : (i64) -> i128
+! CHECK:     %[[V_19:[0-9]+]] = arith.shli %[[V_18]], %c64{{.*}} : i128
+! CHECK:     %[[V_20:[0-9]+]] = arith.bitcast %[[V_19]] : i128 to f128
+! CHECK:     fir.store %[[V_20]] to %[[V_3]] : !fir.ref<f128>
+y = ieee_value(y, ieee_negative_inf)
+
+! CHECK:     %[[V_26:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+! CHECK:     %[[V_27:[0-9]+]] = fir.coordinate_of %[[V_0]], %[[V_26]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+! CHECK:     fir.store %c2{{.*}} to %[[V_27]] : !fir.ref<i8>
+! CHECK:     %[[V_28:[0-9]+]] = fir.field_index which, !fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>
+! CHECK:     %[[V_29:[0-9]+]] = fir.coordinate_of %[[V_0]], %[[V_28]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_class_type{which:i8}>>, !fir.field) -> !fir.ref<i8>
+! CHECK:     %[[V_30:[0-9]+]] = fir.load %[[V_29]] : !fir.ref<i8>
+! CHECK:     %[[V_31:[0-9]+]] = fir.address_of(@_FortranAIeeeValueTable_16) : !fir.ref<!fir.array<12xi64>>
+! CHECK:     %[[V_32:[0-9]+]] = fir.coordinate_of %[[V_31]], %[[V_30]] : (!fir.ref<!fir.array<12xi64>>, i8) -> !fir.ref<i64>
+! CHECK:     %[[V_33:[0-9]+]] = fir.load %[[V_32]] : !fir.ref<i64>
+! CHECK:     %[[V_34:[0-9]+]] = fir.convert %[[V_33]] : (i64) -> i128
+! CHECK:     %[[V_35:[0-9]+]] = arith.shli %[[V_34]], %c64{{.*}} : i128
+! CHECK:     %[[V_36:[0-9]+]] = arith.bitcast %[[V_35]] : i128 to f128
+! CHECK:     fir.store %[[V_36]] to %[[V_4]] : !fir.ref<f128>
+z = ieee_value(z, ieee_quiet_nan)
+
+! CHECK:     %[[V_40:[0-9]+]] = fir.load %[[V_2]] : !fir.ref<f128>
+! CHECK:     %[[V_41:[0-9]+]] = fir.load %[[V_3]] : !fir.ref<f128>
+! CHECK:     %[[V_42:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_40]]) <{bit = 3 : i32}> : (f128) -> i1
+! CHECK:     %[[V_43:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_41]]) <{bit = 3 : i32}> : (f128) -> i1
+! CHECK:     %[[V_44:[0-9]+]] = arith.ori %[[V_42]], %[[V_43]] : i1
+! CHECK:     %[[V_45:[0-9]+]] = fir.convert %[[V_44]] : (i1) -> !fir.logical<4>
+! CHECK:     %[[V_46:[0-9]+]] = fir.convert %[[V_45]] : (!fir.logical<4>) -> i1
+! CHECK:     %[[V_47:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_46]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
+
+! CHECK:     %[[V_48:[0-9]+]] = fir.load %[[V_2]] : !fir.ref<f128>
+! CHECK:     %[[V_49:[0-9]+]] = fir.load %[[V_4]] : !fir.ref<f128>
+! CHECK:     %[[V_50:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_48]]) <{bit = 3 : i32}> : (f128) -> i1
+! CHECK:     %[[V_51:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_49]]) <{bit = 3 : i32}> : (f128) -> i1
+! CHECK:     %[[V_52:[0-9]+]] = arith.ori %[[V_50]], %[[V_51]] : i1
+! CHECK:     %[[V_53:[0-9]+]] = fir.convert %[[V_52]] : (i1) -> !fir.logical<4>
+! CHECK:     %[[V_54:[0-9]+]] = fir.convert %[[V_53]] : (!fir.logical<4>) -> i1
+! CHECK:     %[[V_55:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_54]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
+
+! CHECK:     %[[V_56:[0-9]+]] = fir.load %[[V_3]] : !fir.ref<f128>
+! CHECK:     %[[V_57:[0-9]+]] = fir.load %[[V_4]] : !fir.ref<f128>
+! CHECK:     %[[V_58:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_56]]) <{bit = 3 : i32}> : (f128) -> i1
+! CHECK:     %[[V_59:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_57]]) <{bit = 3 : i32}> : (f128) -> i1
+! CHECK:     %[[V_60:[0-9]+]] = arith.ori %[[V_58]], %[[V_59]] : i1
+! CHECK:     %[[V_61:[0-9]+]] = fir.convert %[[V_60]] : (i1) -> !fir.logical<4>
+! CHECK:     %[[V_62:[0-9]+]] = fir.convert %[[V_61]] : (!fir.logical<4>) -> i1
+! CHECK:     %[[V_63:[0-9]+]] = fir.call @_FortranAioOutputLogical(%{{.*}}, %[[V_62]]) {{.*}} : (!fir.ref<i8>, i1) -> i1
+print*, ieee_unordered(x,y), ieee_unordered(x,z), ieee_unordered(y,z)
+end