[flang-commits] [flang] [flang] IEEE_ARITHMETIC and IEEE_EXCEPTIONS intrinsic module procedures (PR #74138)
via flang-commits
flang-commits at lists.llvm.org
Fri Dec 1 12:38:54 PST 2023
https://github.com/vdonaldson created https://github.com/llvm/llvm-project/pull/74138
Implement a selection of intrinsic module procedures that involve exceptions.
- IEEE_GET_FLAG
- IEEE_GET_HALTING_MODE
- IEEE_GET_MODES
- IEEE_GET_STATUS
- IEEE_LOGB
- [f23] IEEE_MAX, IEEE_MAX_MAG, IEEE_MAX_NUM, IEEE_MAX_NUM_MAG
- [f23] IEEE_MIN, IEEE_MIN_MAG, IEEE_MIN_NUM, IEEE_MIN_NUM_MAG
- IEEE_QUIET_EQ, IEEE_QUIET_GE, IEEE_QUIET_GT,
- IEEE_QUIET_LE, IEEE_QUIET_LT, IEEE_QUIET_NE
- IEEE_SET_FLAG
- IEEE_SET_HALTING_MODE
- IEEE_SET_MODES
- IEEE_SET_STATUS
- IEEE_SIGNALING_EQ, IEEE_SIGNALING_GE, IEEE_SIGNALING_GT,
- IEEE_SIGNALING_LE, IEEE_SIGNALING_LT, IEEE_SIGNALING_NE
- IEEE_SUPPORT_FLAG
- IEEE_SUPPORT_HALTING
>From 9f3c3199a5a149d65171368150f048c6807b9ba0 Mon Sep 17 00:00:00 2001
From: V Donaldson <vdonaldson at nvidia.com>
Date: Fri, 1 Dec 2023 10:24:20 -0800
Subject: [PATCH] [flang] IEEE_ARITHMETIC and IEEE_EXCEPTIONS intrinsic module
procedures
Implement a selection of intrinsic module procedures that involve exceptions.
- IEEE_GET_FLAG
- IEEE_GET_HALTING_MODE
- IEEE_GET_MODES
- IEEE_GET_STATUS
- IEEE_LOGB
- [f23] IEEE_MAX, IEEE_MAX_MAG, IEEE_MAX_NUM, IEEE_MAX_NUM_MAG
- [f23] IEEE_MIN, IEEE_MIN_MAG, IEEE_MIN_NUM, IEEE_MIN_NUM_MAG
- IEEE_QUIET_EQ, IEEE_QUIET_GE, IEEE_QUIET_GT,
- IEEE_QUIET_LE, IEEE_QUIET_LT, IEEE_QUIET_NE
- IEEE_SET_FLAG
- IEEE_SET_HALTING_MODE
- IEEE_SET_MODES
- IEEE_SET_STATUS
- IEEE_SIGNALING_EQ, IEEE_SIGNALING_GE, IEEE_SIGNALING_GT,
- IEEE_SIGNALING_LE, IEEE_SIGNALING_LT, IEEE_SIGNALING_NE
- IEEE_SUPPORT_FLAG
- IEEE_SUPPORT_HALTING
---
flang/include/flang/Lower/ConvertVariable.h | 9 +-
flang/include/flang/Lower/PFTBuilder.h | 2 +
.../flang/Optimizer/Builder/IntrinsicCall.h | 52 +-
.../Optimizer/Builder/LowLevelIntrinsics.h | 18 +
.../Optimizer/Builder/Runtime/Exceptions.h | 30 +
flang/include/flang/Runtime/exceptions.h | 32 +
flang/include/flang/Runtime/ieee_arithmetic.h | 47 --
flang/include/flang/Runtime/magic-numbers.h | 50 ++
flang/lib/Lower/Bridge.cpp | 149 ++++-
flang/lib/Lower/ConvertVariable.cpp | 14 +-
flang/lib/Lower/PFTBuilder.cpp | 52 +-
flang/lib/Optimizer/Builder/CMakeLists.txt | 1 +
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 527 ++++++++++++++++-
.../Optimizer/Builder/LowLevelIntrinsics.cpp | 53 +-
.../Optimizer/Builder/Runtime/Exceptions.cpp | 22 +
flang/module/__cuda_builtins.f90 | 2 +-
flang/module/__fortran_builtins.f90 | 11 +-
flang/module/__fortran_ieee_exceptions.f90 | 71 ++-
flang/module/__fortran_type_info.f90 | 19 +-
flang/module/ieee_arithmetic.f90 | 66 ++-
flang/module/ieee_exceptions.f90 | 2 +-
flang/module/iso_c_binding.f90 | 2 +-
flang/module/iso_fortran_env.f90 | 10 +-
flang/runtime/CMakeLists.txt | 1 +
flang/runtime/exceptions.cpp | 81 +++
flang/test/Lower/Intrinsics/ieee_compare.f90 | 270 +++++++++
flang/test/Lower/Intrinsics/ieee_femodes.f90 | 82 +++
flang/test/Lower/Intrinsics/ieee_festatus.f90 | 120 ++++
flang/test/Lower/Intrinsics/ieee_flag.f90 | 524 +++++++++++++++++
flang/test/Lower/Intrinsics/ieee_logb.f90 | 118 ++++
flang/test/Lower/Intrinsics/ieee_max_min.f90 | 553 ++++++++++++++++++
.../test/Lower/Intrinsics/ieee_unordered.f90 | 12 +-
32 files changed, 2794 insertions(+), 208 deletions(-)
create mode 100644 flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h
create mode 100644 flang/include/flang/Runtime/exceptions.h
delete mode 100644 flang/include/flang/Runtime/ieee_arithmetic.h
create mode 100644 flang/lib/Optimizer/Builder/Runtime/Exceptions.cpp
create mode 100644 flang/runtime/exceptions.cpp
create mode 100644 flang/test/Lower/Intrinsics/ieee_compare.f90
create mode 100644 flang/test/Lower/Intrinsics/ieee_femodes.f90
create mode 100644 flang/test/Lower/Intrinsics/ieee_festatus.f90
create mode 100644 flang/test/Lower/Intrinsics/ieee_flag.f90
create mode 100644 flang/test/Lower/Intrinsics/ieee_logb.f90
create mode 100644 flang/test/Lower/Intrinsics/ieee_max_min.f90
diff --git a/flang/include/flang/Lower/ConvertVariable.h b/flang/include/flang/Lower/ConvertVariable.h
index 9d5e1f8520f1f46..7da04fea35167d7 100644
--- a/flang/include/flang/Lower/ConvertVariable.h
+++ b/flang/include/flang/Lower/ConvertVariable.h
@@ -106,10 +106,13 @@ fir::ExtendedValue
genExtAddrInInitializer(Fortran::lower::AbstractConverter &converter,
mlir::Location loc, const SomeExpr &addr);
-/// Create global variable from a compiler generated object symbol that
-/// describes a derived type for the runtime.
+/// Create a global variable for an intrinsic module object.
+void createIntrinsicModuleGlobal(Fortran::lower::AbstractConverter &converter,
+ const pft::Variable &);
+
+/// Create a global variable for a compiler generated object that describes a
+/// derived type for the runtime.
void createRuntimeTypeInfoGlobal(Fortran::lower::AbstractConverter &converter,
- mlir::Location loc,
const Fortran::semantics::Symbol &typeInfoSym);
/// Translate the Fortran attributes of \p sym into the FIR variable attribute
diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h
index 6f68dc7c9f525f1..9c6696ff79dae16 100644
--- a/flang/include/flang/Lower/PFTBuilder.h
+++ b/flang/include/flang/Lower/PFTBuilder.h
@@ -708,6 +708,8 @@ struct FunctionLikeUnit : public ProgramUnit {
/// 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 hasIeeeAccess{false};
+ bool mayModifyHaltingMode{false};
bool mayModifyRoundingMode{false};
/// Terminal basic block (if any)
mlir::Block *finalBlock{};
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 5065f11ae9e7264..ba0c4806c759e15 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -182,7 +182,6 @@ struct IntrinsicLibrary {
llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genBesselYn(mlir::Type,
llvm::ArrayRef<fir::ExtendedValue>);
- /// Lower a bitwise comparison intrinsic using the given comparator.
template <mlir::arith::CmpIPredicate pred>
mlir::Value genBitwiseCompare(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args);
@@ -228,8 +227,6 @@ struct IntrinsicLibrary {
void genGetCommandArgument(mlir::ArrayRef<fir::ExtendedValue> args);
void genGetEnvironmentVariable(llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genIall(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
- /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments
- /// 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>);
@@ -239,13 +236,32 @@ struct IntrinsicLibrary {
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 genIeeeGetFlag(llvm::ArrayRef<fir::ExtendedValue>);
+ void genIeeeGetHaltingMode(llvm::ArrayRef<fir::ExtendedValue>);
+ template <bool isGet>
+ void genIeeeGetOrSetModes(llvm::ArrayRef<fir::ExtendedValue>);
+ template <bool isGet>
+ void genIeeeGetOrSetStatus(llvm::ArrayRef<fir::ExtendedValue>);
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>);
+ mlir::Value genIeeeLogb(mlir::Type, mlir::ArrayRef<mlir::Value>);
+ template <bool isMax, bool isNum, bool isMag>
+ mlir::Value genIeeeMaxMin(mlir::Type, llvm::ArrayRef<mlir::Value>);
+ template <mlir::arith::CmpFPredicate pred>
+ mlir::Value genIeeeQuietCompare(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value>);
+ template <bool isFlag>
+ void genIeeeSetFlagOrHaltingMode(llvm::ArrayRef<fir::ExtendedValue>);
void genIeeeSetRoundingMode(llvm::ArrayRef<fir::ExtendedValue>);
+ template <mlir::arith::CmpFPredicate pred>
+ mlir::Value genIeeeSignalingCompare(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value>);
mlir::Value genIeeeSignbit(mlir::Type, llvm::ArrayRef<mlir::Value>);
+ mlir::Value genIeeeSupportFlagOrHalting(mlir::Type,
+ llvm::ArrayRef<mlir::Value>);
mlir::Value genIeeeSupportRounding(mlir::Type, llvm::ArrayRef<mlir::Value>);
template <mlir::arith::CmpIPredicate pred>
mlir::Value genIeeeTypeCompare(mlir::Type, llvm::ArrayRef<mlir::Value>);
@@ -332,6 +348,7 @@ struct IntrinsicLibrary {
fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genUnpack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genVerify(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+
/// Implement all conversion functions like DBLE, the first argument is
/// the value to convert. There may be an additional KIND arguments that
/// is ignored because this is already reflected in the result type.
@@ -358,6 +375,10 @@ struct IntrinsicLibrary {
mlir::Type resultType,
llvm::ArrayRef<fir::ExtendedValue> args);
+ /// Generate code to raise \p except if \p cond is absent,
+ /// or present and true.
+ void genRaiseExcept(int except, mlir::Value cond = {});
+
/// Define the different FIR generators that can be mapped to intrinsic to
/// generate the related code.
using ElementalGenerator = decltype(&IntrinsicLibrary::genAbs);
@@ -494,6 +515,7 @@ struct MathOperation {
// Enum of most supported intrinsic argument or return types.
enum class ParamTypeId {
Void,
+ Address, // pointer (to an [array of] Integers of some kind)
Integer,
Real,
Complex,
@@ -531,17 +553,19 @@ struct ParamType {
namespace Ty {
using Void = ParamType<ParamTypeId::Void, 0>;
template <int k>
-using Real = ParamType<ParamTypeId::Real, k>;
+using Address = ParamType<ParamTypeId::Address, k>;
template <int k>
using Integer = ParamType<ParamTypeId::Integer, k>;
template <int k>
+using Real = ParamType<ParamTypeId::Real, k>;
+template <int k>
using Complex = ParamType<ParamTypeId::Complex, k>;
template <int k>
using IntegerVector = ParamType<ParamTypeId::IntegerVector, k>;
template <int k>
-using RealVector = ParamType<ParamTypeId::RealVector, k>;
-template <int k>
using UnsignedVector = ParamType<ParamTypeId::UnsignedVector, k>;
+template <int k>
+using RealVector = ParamType<ParamTypeId::RealVector, k>;
} // namespace Ty
// Helper function that generates most types that are supported for intrinsic
@@ -556,6 +580,11 @@ static inline mlir::Type getTypeHelper(mlir::MLIRContext *context,
case ParamTypeId::Void:
llvm::report_fatal_error("can not get type of void");
break;
+ case ParamTypeId::Address:
+ bits = builder.getKindMap().getIntegerBitsize(kind);
+ assert(bits != 0 && "failed to convert address kind to integer bitsize");
+ r = fir::ReferenceType::get(mlir::IntegerType::get(context, bits));
+ break;
case ParamTypeId::Integer:
case ParamTypeId::IntegerVector:
bits = builder.getKindMap().getIntegerBitsize(kind);
@@ -576,23 +605,20 @@ static inline mlir::Type getTypeHelper(mlir::MLIRContext *context,
break;
}
- mlir::Type fTy;
switch (typeId) {
case ParamTypeId::Void:
+ case ParamTypeId::Address:
case ParamTypeId::Integer:
case ParamTypeId::Real:
case ParamTypeId::Complex:
- // keep original type for void and non-vector
- fTy = r;
break;
case ParamTypeId::IntegerVector:
case ParamTypeId::UnsignedVector:
case ParamTypeId::RealVector:
- // convert to FIR vector type
- fTy = fir::VectorType::get(getVecLen(r), r);
- break;
+ // convert to vector type
+ r = fir::VectorType::get(getVecLen(r), r);
}
- return fTy;
+ return r;
}
// Generic function type generator that supports most of the function types
diff --git a/flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h b/flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h
index a6dcfe6fa9564be..e5a7113149346c4 100644
--- a/flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h
+++ b/flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h
@@ -54,6 +54,24 @@ mlir::func::FuncOp getLlvmInitTrampoline(FirOpBuilder &builder);
/// Get the `llvm.adjust.trampoline` intrinsic.
mlir::func::FuncOp getLlvmAdjustTrampoline(FirOpBuilder &builder);
+/// Get the libm (fenv.h) `feclearexcept` function.
+mlir::func::FuncOp getFeclearexcept(FirOpBuilder &builder);
+
+/// Get the libm (fenv.h) `fedisableexcept` function.
+mlir::func::FuncOp getFedisableexcept(FirOpBuilder &builder);
+
+/// Get the libm (fenv.h) `feenableexcept` function.
+mlir::func::FuncOp getFeenableexcept(FirOpBuilder &builder);
+
+/// Get the libm (fenv.h) `fegetexcept` function.
+mlir::func::FuncOp getFegetexcept(FirOpBuilder &builder);
+
+/// Get the libm (fenv.h) `feraiseexcept` function.
+mlir::func::FuncOp getFeraiseexcept(FirOpBuilder &builder);
+
+/// Get the libm (fenv.h) `fetestexcept` function.
+mlir::func::FuncOp getFetestexcept(FirOpBuilder &builder);
+
} // namespace fir::factory
#endif // FLANG_OPTIMIZER_BUILDER_LOWLEVELINTRINSICS_H
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h b/flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h
new file mode 100644
index 000000000000000..29745b8c231db39
--- /dev/null
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h
@@ -0,0 +1,30 @@
+//===-- Exceptions.h --------------------------------------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXCEPTIONS_H
+#define FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXCEPTIONS_H
+
+#include "mlir/IR/Value.h"
+
+namespace mlir {
+class Location;
+} // namespace mlir
+
+namespace fir {
+class FirOpBuilder;
+}
+
+namespace fir::runtime {
+
+/// Generate a runtime call to map an ieee_flag_type exception value to a
+/// libm fenv.h value.
+mlir::Value genMapException(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value except);
+
+} // namespace fir::runtime
+#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXCEPTIONS_H
diff --git a/flang/include/flang/Runtime/exceptions.h b/flang/include/flang/Runtime/exceptions.h
new file mode 100644
index 000000000000000..8f806ab9ad98ace
--- /dev/null
+++ b/flang/include/flang/Runtime/exceptions.h
@@ -0,0 +1,32 @@
+//===-- include/flang/Runtime/exceptions.h ----------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+// Map Fortran ieee_arithmetic module exceptions to fenv.h exceptions.
+
+#ifndef FORTRAN_RUNTIME_EXCEPTIONS_H_
+#define FORTRAN_RUNTIME_EXCEPTIONS_H_
+
+#include "flang/Runtime/entry-names.h"
+#include "flang/Runtime/magic-numbers.h"
+#include <cinttypes>
+
+namespace Fortran::runtime {
+
+class Descriptor;
+
+extern "C" {
+
+// Map a (single) IEEE_FLAG_TYPE exception value to a libm fenv.h value.
+// This could be extended to handle sets of exceptions, but there is no
+// current use case for that. This mapping is done at runtime to support
+// cross compilation.
+std::int32_t RTNAME(MapException)(std::int32_t except);
+
+} // extern "C"
+} // namespace Fortran::runtime
+#endif // FORTRAN_RUNTIME_EXCEPTIONS_H_
diff --git a/flang/include/flang/Runtime/ieee_arithmetic.h b/flang/include/flang/Runtime/ieee_arithmetic.h
deleted file mode 100644
index 7a264fd2232220d..000000000000000
--- a/flang/include/flang/Runtime/ieee_arithmetic.h
+++ /dev/null
@@ -1,47 +0,0 @@
-#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
diff --git a/flang/include/flang/Runtime/magic-numbers.h b/flang/include/flang/Runtime/magic-numbers.h
index 4ee1fca539bd2f7..d00d5027d4ed272 100644
--- a/flang/include/flang/Runtime/magic-numbers.h
+++ b/flang/include/flang/Runtime/magic-numbers.h
@@ -59,4 +59,54 @@ same allocatable.
#endif
#define FORTRAN_RUNTIME_STAT_MOVE_ALLOC_SAME_ALLOCATABLE 109
+#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_flag_type values
+The values are those of a common but not universal fenv.h file.
+The denorm value is a nonstandard extension.
+#endif
+#define _FORTRAN_RUNTIME_IEEE_INVALID 1
+#define _FORTRAN_RUNTIME_IEEE_DENORM 2
+#define _FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO 4
+#define _FORTRAN_RUNTIME_IEEE_OVERFLOW 8
+#define _FORTRAN_RUNTIME_IEEE_UNDERFLOW 16
+#define _FORTRAN_RUNTIME_IEEE_INEXACT 32
+
+#if 0
+ieee_round_type values
+The values are those of the llvm.get.rounding instrinsic, which is assumed by
+ieee_arithmetic module rounding procedures.
+#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
+
+#if 0
+The size of derived types ieee_modes_type and ieee_status_type from intrinsic
+module ieee_exceptions must be large enough to hold an fenv.h object of type
+femode_t and fenv_t, respectively. These types have members that are declared
+as int arrays with the following extents to allow build time validation of
+these sizes in cross compilation environments.
+#endif
+#define _FORTRAN_RUNTIME_IEEE_FEMODE_T_EXTENT 2
+#define _FORTRAN_RUNTIME_IEEE_FENV_T_EXTENT 8
+
#endif
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 61c02c8960176f2..19caaca72d6eefe 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -193,8 +193,7 @@ class TypeInfoConverter {
private:
void createTypeInfoOpAndGlobal(Fortran::lower::AbstractConverter &converter,
const TypeInfo &info) {
- Fortran::lower::createRuntimeTypeInfoGlobal(converter, info.loc,
- info.symbol.get());
+ Fortran::lower::createRuntimeTypeInfoGlobal(converter, info.symbol.get());
createTypeInfoOp(converter, info);
}
@@ -281,19 +280,15 @@ class FirConverter : public Fortran::lower::AbstractConverter {
void run(Fortran::lower::pft::Program &pft) {
// Preliminary translation pass.
- // - Lower common blocks from the PFT common block list that contains a
- // consolidated list of the common blocks (with the initialization if any in
- // the Program, and with the common block biggest size in all its
- // appearance). This is done before lowering any scope declarations because
- // it is not know at the local scope level what MLIR type common blocks
- // should have to suit all its usage in the compilation unit.
+ // Lower common blocks, taking into account initialization and the largest
+ // size of all instances of each common block. This is done before lowering
+ // since the global definition may differ from any one local definition.
lowerCommonBlocks(pft.getCommonBlocks());
- // - Declare all functions that have definitions so that definition
- // signatures prevail over call site signatures.
- // - Define module variables and OpenMP/OpenACC declarative construct so
- // that they are available before lowering any function that may use
- // them.
+ // - Declare all functions that have definitions so that definition
+ // signatures prevail over call site signatures.
+ // - Define module variables and OpenMP/OpenACC declarative constructs so
+ // they are available before lowering any function that may use them.
bool hasMainProgram = false;
const Fortran::semantics::Symbol *globalOmpRequiresSymbol = nullptr;
for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) {
@@ -321,6 +316,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
u);
}
+ // Create definitions of intrinsic module constants.
+ createGlobalOutsideOfFunctionLowering(
+ [&]() { createIntrinsicModuleDefinitions(pft); });
+
// Primary translation pass.
for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) {
std::visit(
@@ -341,10 +340,9 @@ class FirConverter : public Fortran::lower::AbstractConverter {
u);
}
- /// Once all the code has been translated, create runtime type info
- /// global data structure for the derived types that have been
- /// processed as well as the fir.type_info operations with the
- /// dispatch tables.
+ // Once all the code has been translated, create global runtime type info
+ // data structures for the derived types that have been processed, as well
+ // as fir.type_info operations for the dispatch tables.
createGlobalOutsideOfFunctionLowering(
[&]() { typeInfoConverter.createTypeInfo(*this); });
@@ -4250,6 +4248,64 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
}
+ /// Where applicable, save the exception state and halting and rounding
+ /// modes at function entry and restore them at function exits.
+ void manageFPEnvironment(Fortran::lower::pft::FunctionLikeUnit &funit) {
+ mlir::Location loc = toLocation();
+ mlir::Location endLoc =
+ toLocation(Fortran::lower::pft::stmtSourceLoc(funit.endStmt));
+ if (funit.hasIeeeAccess) {
+ // Subject to F18 Clause 17.1p3, 17.3p3 states: If a flag is signaling
+ // on entry to a procedure [...], the processor will set it to quiet
+ // on entry and restore it to signaling on return. If a flag signals
+ // during execution of a procedure, the processor shall not set it to
+ // quiet on return.
+ mlir::func::FuncOp testExcept = fir::factory::getFetestexcept(*builder);
+ mlir::func::FuncOp clearExcept = fir::factory::getFeclearexcept(*builder);
+ mlir::func::FuncOp raiseExcept = fir::factory::getFeraiseexcept(*builder);
+ mlir::Value ones = builder->createIntegerConstant(
+ loc, testExcept.getFunctionType().getInput(0), -1);
+ mlir::Value exceptSet =
+ builder->create<fir::CallOp>(loc, testExcept, ones).getResult(0);
+ builder->create<fir::CallOp>(loc, clearExcept, exceptSet);
+ bridge.fctCtx().attachCleanup([=]() {
+ builder->create<fir::CallOp>(endLoc, raiseExcept, exceptSet);
+ });
+ }
+ if (funit.mayModifyHaltingMode) {
+ // F18 Clause 17.6p1: In a procedure [...], the processor shall not
+ // change the halting mode on entry, and on return shall ensure that
+ // the halting mode is the same as it was on entry.
+ mlir::func::FuncOp getExcept = fir::factory::getFegetexcept(*builder);
+ mlir::func::FuncOp disableExcept =
+ fir::factory::getFedisableexcept(*builder);
+ mlir::func::FuncOp enableExcept =
+ fir::factory::getFeenableexcept(*builder);
+ mlir::Value exceptSet =
+ builder->create<fir::CallOp>(loc, getExcept).getResult(0);
+ mlir::Value ones = builder->createIntegerConstant(
+ loc, disableExcept.getFunctionType().getInput(0), -1);
+ bridge.fctCtx().attachCleanup([=]() {
+ builder->create<fir::CallOp>(endLoc, disableExcept, ones);
+ builder->create<fir::CallOp>(endLoc, enableExcept, exceptSet);
+ });
+ }
+ if (funit.mayModifyRoundingMode) {
+ // F18 Clause 17.4.5: In a procedure [...], the processor shall not
+ // change the rounding modes on entry, and on return shall ensure that
+ // the rounding modes are the same as they were on entry.
+ mlir::func::FuncOp getRounding =
+ fir::factory::getLlvmGetRounding(*builder);
+ mlir::func::FuncOp setRounding =
+ fir::factory::getLlvmSetRounding(*builder);
+ mlir::Value roundingMode =
+ builder->create<fir::CallOp>(loc, getRounding).getResult(0);
+ bridge.fctCtx().attachCleanup([=]() {
+ builder->create<fir::CallOp>(endLoc, setRounding, roundingMode);
+ });
+ }
+ }
+
/// Start translation of a function.
void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
assert(!builder && "expected nullptr");
@@ -4269,18 +4325,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
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); });
- }
+ // Manage floating point exception, halting mode, and rounding mode
+ // settings at function entry and exit.
+ if (!funit.isMainProgram())
+ manageFPEnvironment(funit);
mapDummiesAndResults(funit, callee);
@@ -4543,6 +4591,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
builder = nullptr;
localSymbols.clear();
}
+
/// Instantiate the data from a BLOCK DATA unit.
void lowerBlockData(Fortran::lower::pft::BlockDataUnit &bdunit) {
createGlobalOutsideOfFunctionLowering([&]() {
@@ -4563,6 +4612,48 @@ class FirConverter : public Fortran::lower::AbstractConverter {
[&]() { Fortran::lower::defineCommonBlocks(*this, commonBlocks); });
}
+ /// Create intrinsic module array constant definitions.
+ void createIntrinsicModuleDefinitions(Fortran::lower::pft::Program &pft) {
+ // The intrinsic module scope, if present, is the first scope.
+ const Fortran::semantics::Scope *intrinsicModuleScope = nullptr;
+ for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) {
+ std::visit(Fortran::common::visitors{
+ [&](Fortran::lower::pft::FunctionLikeUnit &f) {
+ intrinsicModuleScope = &f.getScope().parent();
+ },
+ [&](Fortran::lower::pft::ModuleLikeUnit &m) {
+ intrinsicModuleScope = &m.getScope().parent();
+ },
+ [&](Fortran::lower::pft::BlockDataUnit &b) {},
+ [&](Fortran::lower::pft::CompilerDirectiveUnit &d) {},
+ [&](Fortran::lower::pft::OpenACCDirectiveUnit &d) {},
+ },
+ u);
+ if (intrinsicModuleScope) {
+ while (!intrinsicModuleScope->IsGlobal())
+ intrinsicModuleScope = &intrinsicModuleScope->parent();
+ intrinsicModuleScope = &intrinsicModuleScope->children().front();
+ break;
+ }
+ }
+ if (!intrinsicModuleScope || !intrinsicModuleScope->IsIntrinsicModules())
+ return;
+ for (const auto &scope : intrinsicModuleScope->children()) {
+ llvm::StringRef modName = toStringRef(scope.symbol()->name());
+ if (modName != "__fortran_ieee_exceptions")
+ continue;
+ for (auto &var : Fortran::lower::pft::getScopeVariableList(scope)) {
+ const Fortran::semantics::Symbol &sym = var.getSymbol();
+ if (sym.test(Fortran::semantics::Symbol::Flag::CompilerCreated))
+ continue;
+ const auto *object =
+ sym.detailsIf<Fortran::semantics::ObjectEntityDetails>();
+ if (object && object->IsArray() && object->init())
+ Fortran::lower::createIntrinsicModuleGlobal(*this, var);
+ }
+ }
+ }
+
/// Lower a procedure (nest).
void lowerFunc(Fortran::lower::pft::FunctionLikeUnit &funit) {
setCurrentPosition(funit.getStartingSourceLoc());
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index d4f738e5dae116f..7bdb501e757cc6f 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -639,11 +639,11 @@ static void instantiateGlobal(Fortran::lower::AbstractConverter &converter,
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
std::string globalName = converter.mangleName(sym);
mlir::Location loc = genLocation(converter, sym);
- fir::GlobalOp global = builder.getNamedGlobal(globalName);
mlir::StringAttr linkage = getLinkageAttribute(builder, var);
+ fir::GlobalOp global;
if (var.isModuleOrSubmoduleVariable()) {
- // A module global was or will be defined when lowering the module. Emit
- // only a declaration if the global does not exist at that point.
+ // A non-intrinsic module global is defined when lowering the module.
+ // Emit only a declaration if the global does not exist.
global = declareGlobal(converter, var, globalName, linkage);
} else {
global = defineGlobal(converter, var, globalName, linkage);
@@ -2274,8 +2274,14 @@ void Fortran::lower::mapSymbolAttributes(
preAlloc);
}
+void Fortran::lower::createIntrinsicModuleGlobal(
+ Fortran::lower::AbstractConverter &converter, const pft::Variable &var) {
+ defineGlobal(converter, var, converter.mangleName(var.getSymbol()),
+ converter.getFirOpBuilder().createLinkOnceODRLinkage());
+}
+
void Fortran::lower::createRuntimeTypeInfoGlobal(
- Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+ Fortran::lower::AbstractConverter &converter,
const Fortran::semantics::Symbol &typeInfoSym) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
std::string globalName = converter.mangleName(typeInfoSym);
diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp
index bc207ba4b9f1254..32ed539c775b827 100644
--- a/flang/lib/Lower/PFTBuilder.cpp
+++ b/flang/lib/Lower/PFTBuilder.cpp
@@ -109,7 +109,7 @@ class PFTBuilder {
addEvaluation(lower::pft::Evaluation{
removeIndirection(x), pftParentStack.back(),
stmt.position, stmt.label});
- checkForRoundingModeCall(x.value());
+ checkForFPEnvironmentCalls(x.value());
return true;
},
[&](const common::Indirection<parser::IfStmt> &x) {
@@ -129,22 +129,43 @@ class PFTBuilder {
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);
+ /// Check for calls that could modify the floating point environment.
+ /// See F18 Clauses
+ /// - 17.1p3 (Overview of IEEE arithmetic support)
+ /// - 17.3p3 (The exceptions)
+ /// - 17.4p5 (The rounding modes)
+ /// - 17.6p1 (Halting)
+ void checkForFPEnvironmentCalls(const parser::CallStmt &callStmt) {
+ const auto *callName = std::get_if<parser::Name>(
+ &std::get<parser::ProcedureDesignator>(callStmt.call.t).u);
if (!callName)
return;
const Fortran::semantics::Symbol &procSym = callName->symbol->GetUltimate();
+ if (!procSym.owner().IsModule())
+ return;
+ const Fortran::semantics::Symbol &modSym = *procSym.owner().symbol();
+ if (!modSym.attrs().test(Fortran::semantics::Attr::INTRINSIC))
+ return;
+ // Modules IEEE_FEATURES, IEEE_EXCEPTIONS, and IEEE_ARITHMETIC get common
+ // declarations from several __fortran_... support module files.
+ llvm::StringRef modName = toStringRef(modSym.name());
+ if (!modName.startswith("ieee_") && !modName.startswith("__fortran_"))
+ return;
llvm::StringRef procName = toStringRef(procSym.name());
+ if (!procName.startswith("ieee_"))
+ return;
+ lower::pft::FunctionLikeUnit *proc =
+ evaluationListStack.back()->back().getOwningProcedure();
+ proc->hasIeeeAccess = true;
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;
+ if (procName.startswith("ieee_set_modes_") ||
+ procName.startswith("ieee_set_status_"))
+ proc->mayModifyHaltingMode = proc->mayModifyRoundingMode = true;
+ else if (procName.startswith("ieee_set_halting_mode_"))
+ proc->mayModifyHaltingMode = true;
+ else if (procName.startswith("ieee_set_rounding_mode_"))
+ proc->mayModifyRoundingMode = true;
}
/// Convert an IfStmt into an IfConstruct, retaining the IfStmt as the
@@ -1667,9 +1688,8 @@ struct SymbolDependenceAnalysis {
Fortran::lower::pft::FunctionLikeUnit::FunctionLikeUnit(
const parser::MainProgram &func, const lower::pft::PftNode &parent,
const semantics::SemanticsContext &semanticsContext)
- : ProgramUnit{func, parent}, endStmt{
- getFunctionStmt<parser::EndProgramStmt>(
- func)} {
+ : ProgramUnit{func, parent},
+ endStmt{getFunctionStmt<parser::EndProgramStmt>(func)} {
const auto &programStmt =
std::get<std::optional<parser::Statement<parser::ProgramStmt>>>(func.t);
if (programStmt.has_value()) {
@@ -1753,8 +1773,8 @@ Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit(
Fortran::lower::pft::ModuleLikeUnit::ModuleLikeUnit(
const parser::Submodule &m, const lower::pft::PftNode &parent)
- : ProgramUnit{m, parent}, beginStmt{getModuleStmt<parser::SubmoduleStmt>(
- m)},
+ : ProgramUnit{m, parent},
+ beginStmt{getModuleStmt<parser::SubmoduleStmt>(m)},
endStmt{getModuleStmt<parser::EndSubmoduleStmt>(m)} {}
parser::CharBlock
diff --git a/flang/lib/Optimizer/Builder/CMakeLists.txt b/flang/lib/Optimizer/Builder/CMakeLists.txt
index 5e5daffd3ed7de9..9877c6b53792361 100644
--- a/flang/lib/Optimizer/Builder/CMakeLists.txt
+++ b/flang/lib/Optimizer/Builder/CMakeLists.txt
@@ -19,6 +19,7 @@ add_flang_library(FIRBuilder
Runtime/Command.cpp
Runtime/Derived.cpp
Runtime/EnvironmentDefaults.cpp
+ Runtime/Exceptions.cpp
Runtime/Inquiry.cpp
Runtime/Intrinsics.cpp
Runtime/Numeric.cpp
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 2b6beffd851a133..f908322bdb20312 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -25,6 +25,7 @@
#include "flang/Optimizer/Builder/Runtime/Character.h"
#include "flang/Optimizer/Builder/Runtime/Command.h"
#include "flang/Optimizer/Builder/Runtime/Derived.h"
+#include "flang/Optimizer/Builder/Runtime/Exceptions.h"
#include "flang/Optimizer/Builder/Runtime/Inquiry.h"
#include "flang/Optimizer/Builder/Runtime/Intrinsics.h"
#include "flang/Optimizer/Builder/Runtime/Numeric.h"
@@ -38,7 +39,6 @@
#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"
@@ -276,23 +276,73 @@ static constexpr IntrinsicHandler handlers[]{
{"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_flag",
+ &I::genIeeeGetFlag,
+ {{{"flag", asValue}, {"flag_value", asAddr}}}},
+ {"ieee_get_halting_mode",
+ &I::genIeeeGetHaltingMode,
+ {{{"flag", asValue}, {"halting", asAddr}}}},
+ {"ieee_get_modes", &I::genIeeeGetOrSetModes</*isGet=*/true>},
{"ieee_get_rounding_mode",
&I::genIeeeGetRoundingMode,
{{{"round_value", asAddr, handleDynamicOptional},
{"radix", asValue, handleDynamicOptional}}},
/*isElemental=*/false},
+ {"ieee_get_status", &I::genIeeeGetOrSetStatus</*isGet=*/true>},
{"ieee_is_finite", &I::genIeeeIsFinite},
{"ieee_is_nan", &I::genIeeeIsNan},
{"ieee_is_negative", &I::genIeeeIsNegative},
{"ieee_is_normal", &I::genIeeeIsNormal},
+ {"ieee_logb", &I::genIeeeLogb},
+ {"ieee_max",
+ &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/false, /*isMag=*/false>},
+ {"ieee_max_mag",
+ &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/false, /*isMag=*/true>},
+ {"ieee_max_num",
+ &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/true, /*isMag=*/false>},
+ {"ieee_max_num_mag",
+ &I::genIeeeMaxMin</*isMax=*/true, /*isNum=*/true, /*isMag=*/true>},
+ {"ieee_min",
+ &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/false, /*isMag=*/false>},
+ {"ieee_min_mag",
+ &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/false, /*isMag=*/true>},
+ {"ieee_min_num",
+ &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/true, /*isMag=*/false>},
+ {"ieee_min_num_mag",
+ &I::genIeeeMaxMin</*isMax=*/false, /*isNum=*/true, /*isMag=*/true>},
+ {"ieee_quiet_eq", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OEQ>},
+ {"ieee_quiet_ge", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OGE>},
+ {"ieee_quiet_gt", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OGT>},
+ {"ieee_quiet_le", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OLE>},
+ {"ieee_quiet_lt", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::OLT>},
+ {"ieee_quiet_ne", &I::genIeeeQuietCompare<mlir::arith::CmpFPredicate::UNE>},
{"ieee_round_eq", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::eq>},
{"ieee_round_ne", &I::genIeeeTypeCompare<mlir::arith::CmpIPredicate::ne>},
+ {"ieee_set_flag", &I::genIeeeSetFlagOrHaltingMode</*isFlag=*/true>},
+ {"ieee_set_halting_mode",
+ &I::genIeeeSetFlagOrHaltingMode</*isFlag=*/false>},
+ {"ieee_set_modes", &I::genIeeeGetOrSetModes</*isGet=*/false>},
{"ieee_set_rounding_mode",
&I::genIeeeSetRoundingMode,
{{{"round_value", asValue, handleDynamicOptional},
{"radix", asValue, handleDynamicOptional}}},
/*isElemental=*/false},
+ {"ieee_set_status", &I::genIeeeGetOrSetStatus</*isGet=*/false>},
+ {"ieee_signaling_eq",
+ &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OEQ>},
+ {"ieee_signaling_ge",
+ &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OGE>},
+ {"ieee_signaling_gt",
+ &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OGT>},
+ {"ieee_signaling_le",
+ &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OLE>},
+ {"ieee_signaling_lt",
+ &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OLT>},
+ {"ieee_signaling_ne",
+ &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::UNE>},
{"ieee_signbit", &I::genIeeeSignbit},
+ {"ieee_support_flag", &I::genIeeeSupportFlagOrHalting},
+ {"ieee_support_halting", &I::genIeeeSupportFlagOrHalting},
{"ieee_support_rounding", &I::genIeeeSupportRounding},
{"ieee_unordered", &I::genIeeeUnordered},
{"ieee_value", &I::genIeeeValue},
@@ -912,6 +962,27 @@ static constexpr MathOperation mathOperations[] = {
genComplexMathOp<mlir::complex::ExpOp>},
{"exp", "cexp", genFuncType<Ty::Complex<8>, Ty::Complex<8>>,
genComplexMathOp<mlir::complex::ExpOp>},
+ {"feclearexcept", "feclearexcept",
+ genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},
+ {"fedisableexcept", "fedisableexcept",
+ genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},
+ {"feenableexcept", "feenableexcept",
+ genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},
+ {"fegetenv", "fegetenv", genFuncType<Ty::Integer<4>, Ty::Address<4>>,
+ genLibCall},
+ {"fegetexcept", "fegetexcept", genFuncType<Ty::Integer<4>>, genLibCall},
+ {"fegetmode", "fegetmode", genFuncType<Ty::Integer<4>, Ty::Address<4>>,
+ genLibCall},
+ {"feraiseexcept", "feraiseexcept",
+ genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},
+ {"fesetenv", "fesetenv", genFuncType<Ty::Integer<4>, Ty::Address<4>>,
+ genLibCall},
+ {"fesetmode", "fesetmode", genFuncType<Ty::Integer<4>, Ty::Address<4>>,
+ genLibCall},
+ {"fetestexcept", "fetestexcept",
+ genFuncType<Ty::Integer<4>, Ty::Integer<4>>, genLibCall},
+ {"feupdateenv", "feupdateenv", genFuncType<Ty::Integer<4>, Ty::Address<4>>,
+ genLibCall},
// math::FloorOp returns a real, while Fortran FLOOR returns integer.
{"floor", "floorf", genFuncType<Ty::Real<4>, Ty::Real<4>>,
genMathOp<mlir::math::FloorOp>},
@@ -3259,6 +3330,50 @@ IntrinsicLibrary::genIchar(mlir::Type resultType,
return builder.create<mlir::arith::ExtUIOp>(loc, resultType, code);
}
+/// llvm floating point class intrinsic test values
+/// 0 Signaling NaN
+/// 1 Quiet NaN
+/// 2 Negative infinity
+/// 3 Negative normal
+/// 4 Negative subnormal
+/// 5 Negative zero
+/// 6 Positive zero
+/// 7 Positive subnormal
+/// 8 Positive normal
+/// 9 Positive infinity
+static constexpr int finiteTest = 0b0111111000;
+static constexpr int nanTest = 0b0000000011;
+static constexpr int negativeTest = 0b0000111100;
+static constexpr int normalTest = 0b0101101000;
+static constexpr int positiveTest = 0b1111000000;
+static constexpr int snanTest = 0b0000000001;
+
+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);
+}
+
+/// Generate code to raise \p except if \p cond is absent, or present and true.
+void IntrinsicLibrary::genRaiseExcept(int except, mlir::Value cond) {
+ fir::IfOp ifOp;
+ if (cond) {
+ ifOp = builder.create<fir::IfOp>(loc, cond, /*withElseRegion=*/false);
+ builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
+ }
+ mlir::Type i32Ty = builder.getIntegerType(32);
+ genRuntimeCall(
+ "feraiseexcept", i32Ty,
+ fir::runtime::genMapException(
+ builder, loc, builder.createIntegerConstant(loc, i32Ty, except)));
+ if (cond)
+ builder.setInsertionPointAfter(ifOp);
+}
+
// 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>
@@ -3282,8 +3397,8 @@ mlir::Value
IntrinsicLibrary::genIeeeTypeCompare(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
assert(args.size() == 2);
- auto [leftRef, fieldTy] = getFieldRef(builder, loc, fir::getBase(args[0]));
- auto [rightRef, ignore] = getFieldRef(builder, loc, fir::getBase(args[1]));
+ auto [leftRef, fieldTy] = getFieldRef(builder, loc, args[0]);
+ auto [rightRef, ignore] = getFieldRef(builder, loc, 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);
@@ -3312,7 +3427,7 @@ mlir::Value IntrinsicLibrary::genIeeeClass(mlir::Type resultType,
// "natural" order enables more efficient generated code.
assert(args.size() == 1);
- mlir::Value realVal = fir::getBase(args[0]);
+ mlir::Value realVal = args[0];
mlir::FloatType realType = realVal.getType().dyn_cast<mlir::FloatType>();
mlir::Type intType = builder.getIntegerType(realType.getWidth());
mlir::Value intVal =
@@ -3574,8 +3689,8 @@ 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::Value xRealVal = args[0];
+ mlir::Value yRealVal = args[1];
mlir::FloatType xRealType = xRealVal.getType().dyn_cast<mlir::FloatType>();
mlir::FloatType yRealType = yRealVal.getType().dyn_cast<mlir::FloatType>();
@@ -3619,6 +3734,67 @@ IntrinsicLibrary::genIeeeCopySign(mlir::Type resultType,
loc, xRealType, builder.create<mlir::arith::OrIOp>(loc, xAbs, xSign));
}
+// IEEE_GET_FLAG
+void IntrinsicLibrary::genIeeeGetFlag(llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert(args.size() == 2);
+ // Set FLAG_VALUE=.TRUE. if the exception specified by FLAG is signaling.
+ mlir::Value flag = fir::getBase(args[0]);
+ mlir::Value flagValue = fir::getBase(args[1]);
+ mlir::Type resultTy =
+ flagValue.getType().dyn_cast<fir::ReferenceType>().getEleTy();
+ mlir::Type i32Ty = builder.getIntegerType(32);
+ mlir::Value zero = builder.createIntegerConstant(loc, i32Ty, 0);
+ auto [fieldRef, ignore] = getFieldRef(builder, loc, flag);
+ mlir::Value field = builder.create<fir::LoadOp>(loc, fieldRef);
+ mlir::Value exceptSet = IntrinsicLibrary::genRuntimeCall(
+ "fetestexcept", i32Ty,
+ fir::runtime::genMapException(
+ builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, field)));
+ mlir::Value logicalResult = builder.create<fir::ConvertOp>(
+ loc, resultTy,
+ builder.create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::ne,
+ exceptSet, zero));
+ builder.create<fir::StoreOp>(loc, logicalResult, flagValue);
+}
+
+// IEEE_GET_HALTING_MODE
+void IntrinsicLibrary::genIeeeGetHaltingMode(
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ // Set HALTING=.TRUE. if the exception specified by FLAG will cause halting.
+ assert(args.size() == 2);
+ mlir::Value flag = fir::getBase(args[0]);
+ mlir::Value halting = fir::getBase(args[1]);
+ mlir::Type resultTy =
+ halting.getType().dyn_cast<fir::ReferenceType>().getEleTy();
+ mlir::Type i32Ty = builder.getIntegerType(32);
+ mlir::Value zero = builder.createIntegerConstant(loc, i32Ty, 0);
+ auto [fieldRef, ignore] = getFieldRef(builder, loc, flag);
+ mlir::Value field = builder.create<fir::LoadOp>(loc, fieldRef);
+ mlir::Value haltSet =
+ IntrinsicLibrary::genRuntimeCall("fegetexcept", i32Ty, {});
+ mlir::Value intResult = builder.create<mlir::arith::AndIOp>(
+ loc, haltSet,
+ fir::runtime::genMapException(
+ builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, field)));
+ mlir::Value logicalResult = builder.create<fir::ConvertOp>(
+ loc, resultTy,
+ builder.create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::ne,
+ intResult, zero));
+ builder.create<fir::StoreOp>(loc, logicalResult, halting);
+}
+
+// IEEE_GET_MODES, IEEE_SET_MODES
+template <bool isGet>
+void IntrinsicLibrary::genIeeeGetOrSetModes(
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert(args.size() == 1);
+ mlir::Type ptrTy = builder.getRefType(builder.getIntegerType(32));
+ mlir::Type i32Ty = builder.getIntegerType(32);
+ mlir::Value addr =
+ builder.create<fir::ConvertOp>(loc, ptrTy, getBase(args[0]));
+ genRuntimeCall(isGet ? "fegetmode" : "fesetmode", i32Ty, addr);
+}
+
// 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) {
@@ -3649,14 +3825,16 @@ void IntrinsicLibrary::genIeeeGetRoundingMode(
builder.create<fir::StoreOp>(loc, mode, fieldRef);
}
-mlir::Value IntrinsicLibrary::genIsFPClass(mlir::Type resultType,
- llvm::ArrayRef<mlir::Value> args,
- int fpclass) {
+// IEEE_GET_STATUS, IEEE_SET_STATUS
+template <bool isGet>
+void IntrinsicLibrary::genIeeeGetOrSetStatus(
+ llvm::ArrayRef<fir::ExtendedValue> args) {
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);
+ mlir::Type ptrTy = builder.getRefType(builder.getIntegerType(32));
+ mlir::Type i32Ty = builder.getIntegerType(32);
+ mlir::Value addr =
+ builder.create<fir::ConvertOp>(loc, ptrTy, getBase(args[0]));
+ genRuntimeCall(isGet ? "fegetenv" : "fesetenv", i32Ty, addr);
}
// IEEE_IS_FINITE
@@ -3665,7 +3843,7 @@ IntrinsicLibrary::genIeeeIsFinite(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
// Check if arg X is a (negative or positive) (normal, denormal, or zero).
assert(args.size() == 1);
- return genIsFPClass(resultType, args, 0b0111111000);
+ return genIsFPClass(resultType, args, finiteTest);
}
// IEEE_IS_NAN
@@ -3673,7 +3851,7 @@ 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);
- return genIsFPClass(resultType, args, 0b0000000011);
+ return genIsFPClass(resultType, args, nanTest);
}
// IEEE_IS_NEGATIVE
@@ -3682,7 +3860,7 @@ 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);
+ return genIsFPClass(resultType, args, negativeTest);
}
// IEEE_IS_NORMAL
@@ -3691,7 +3869,249 @@ 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);
+ return genIsFPClass(resultType, args, normalTest);
+}
+
+// IEEE_LOGB
+mlir::Value IntrinsicLibrary::genIeeeLogb(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args) {
+ // Exponent of X, with special case treatment for some input values.
+ // Return: X == 0
+ // ? -infinity (and raise FE_DIVBYZERO)
+ // : ieee_is_finite(X)
+ // ? exponent(X) - 1 // unbiased exponent of X
+ // : ieee_copy_sign(X, 1.0) // +infinity or NaN
+ assert(args.size() == 1);
+ mlir::Value realVal = args[0];
+ mlir::FloatType realType = realVal.getType().dyn_cast<mlir::FloatType>();
+ int bitWidth = realType.getWidth();
+ mlir::Type intType = builder.getIntegerType(realType.getWidth());
+ mlir::Value intVal =
+ builder.create<mlir::arith::BitcastOp>(loc, intType, realVal);
+ mlir::Type i1Ty = builder.getI1Type();
+
+ int exponentBias, significandSize;
+ switch (bitWidth) {
+ case 16:
+ if (realType.isF16()) {
+ // kind=2: 1 sign bit, 5 exponent bits, 10 significand bits
+ exponentBias = (1 << (5 - 1)) - 1; // 15
+ significandSize = 10;
+ break;
+ }
+ assert(realType.isBF16() && "unknown 16-bit real type");
+ // kind=3: 1 sign bit, 8 exponent bits, 7 significand bits
+ exponentBias = (1 << (8 - 1)) - 1; // 127
+ significandSize = 7;
+ break;
+ case 32:
+ // kind=4: 1 sign bit, 8 exponent bits, 23 significand bits
+ exponentBias = (1 << (8 - 1)) - 1; // 127
+ significandSize = 23;
+ break;
+ case 64:
+ // kind=8: 1 sign bit, 11 exponent bits, 52 significand bits
+ exponentBias = (1 << (11 - 1)) - 1; // 1023
+ significandSize = 52;
+ break;
+ case 80:
+ // kind=10: 1 sign bit, 15 exponent bits, 1+63 significand bits
+ exponentBias = (1 << (15 - 1)) - 1; // 16383
+ significandSize = 64;
+ break;
+ case 128:
+ // kind=16: 1 sign bit, 15 exponent bits, 112 significand bits
+ exponentBias = (1 << (15 - 1)) - 1; // 16383
+ significandSize = 112;
+ break;
+ default:
+ llvm_unreachable("unknown real type");
+ }
+
+ mlir::Value isZero = builder.create<mlir::arith::CmpFOp>(
+ loc, mlir::arith::CmpFPredicate::OEQ, realVal,
+ builder.createRealZeroConstant(loc, resultType));
+ auto outerIfOp = builder.create<fir::IfOp>(loc, resultType, isZero,
+ /*withElseRegion=*/true);
+ // X is zero -- result is -infinity
+ builder.setInsertionPointToStart(&outerIfOp.getThenRegion().front());
+ genRaiseExcept(_FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO);
+ mlir::Value ones = builder.createIntegerConstant(loc, intType, -1);
+ mlir::Value result = builder.create<mlir::arith::ShLIOp>(
+ loc, ones,
+ builder.createIntegerConstant(loc, intType,
+ // kind=10 high-order bit is explicit
+ significandSize - (bitWidth == 80)));
+ result = builder.create<mlir::arith::BitcastOp>(loc, resultType, result);
+ builder.create<fir::ResultOp>(loc, result);
+
+ builder.setInsertionPointToStart(&outerIfOp.getElseRegion().front());
+ mlir::Value one = builder.createIntegerConstant(loc, intType, 1);
+ mlir::Value shiftLeftOne =
+ builder.create<mlir::arith::ShLIOp>(loc, intVal, one);
+ mlir::Value isFinite = genIsFPClass(i1Ty, args, finiteTest);
+ auto innerIfOp = builder.create<fir::IfOp>(loc, resultType, isFinite,
+ /*withElseRegion=*/true);
+ // X is non-zero finite -- result is unbiased exponent of X
+ builder.setInsertionPointToStart(&innerIfOp.getThenRegion().front());
+ mlir::Value biasedExponent = builder.create<mlir::arith::ShRUIOp>(
+ loc, shiftLeftOne,
+ builder.createIntegerConstant(loc, intType, significandSize + 1));
+ result = builder.create<mlir::arith::SubIOp>(
+ loc, biasedExponent,
+ builder.createIntegerConstant(loc, intType, exponentBias));
+ result = builder.create<fir::ConvertOp>(loc, resultType, result);
+ builder.create<fir::ResultOp>(loc, result);
+
+ // X is infinity or NaN -- result is +infinity or NaN
+ builder.setInsertionPointToStart(&innerIfOp.getElseRegion().front());
+ result = builder.create<mlir::arith::ShRUIOp>(loc, shiftLeftOne, one);
+ result = builder.create<mlir::arith::BitcastOp>(loc, resultType, result);
+ builder.create<fir::ResultOp>(loc, result);
+
+ // Unwind the if nest.
+ builder.setInsertionPointToEnd(&outerIfOp.getElseRegion().front());
+ builder.create<fir::ResultOp>(loc, innerIfOp.getResult(0));
+ builder.setInsertionPointAfter(outerIfOp);
+ return outerIfOp.getResult(0);
+}
+
+// IEEE_MAX, IEEE_MAX_MAG, IEEE_MAX_NUM, IEEE_MAX_NUM_MAG
+// IEEE_MIN, IEEE_MIN_MAG, IEEE_MIN_NUM, IEEE_MIN_NUM_MAG
+template <bool isMax, bool isNum, bool isMag>
+mlir::Value IntrinsicLibrary::genIeeeMaxMin(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args) {
+ // Maximum/minimum of X and Y with special case treatment of NaN operands.
+ // The f18 definitions of these procedures (where applicable) are incomplete.
+ // And f18 results involving NaNs are different from and incompatible with
+ // f23 results. This code implements the f23 procedures.
+ // For IEEE_MAX_MAG and IEEE_MAX_NUM_MAG:
+ // if (ABS(X) > ABS(Y))
+ // return X
+ // else if (ABS(Y) > ABS(X))
+ // return Y
+ // else if (ABS(X) == ABS(Y))
+ // return IEEE_SIGNBIT(Y) ? X : Y
+ // // X or Y or both are NaNs
+ // if (X is an sNaN or Y is an sNaN) raise FE_INVALID
+ // if (IEEE_MAX_NUM_MAG and X is not a NaN) return X
+ // if (IEEE_MAX_NUM_MAG and Y is not a NaN) return Y
+ // return a qNaN
+ // For IEEE_MAX, IEEE_MAX_NUM: compare X vs. Y rather than ABS(X) vs. ABS(Y)
+ // IEEE_MIN, IEEE_MIN_MAG, IEEE_MIN_NUM, IEEE_MIN_NUM_MAG: invert comparisons
+ assert(args.size() == 2);
+ mlir::Value x = args[0];
+ mlir::Value y = args[1];
+ mlir::Value x1, y1; // X or ABS(X), Y or ABS(Y)
+ if constexpr (isMag) {
+ mlir::Value zero = builder.createRealZeroConstant(loc, resultType);
+ x1 = builder.create<mlir::math::CopySignOp>(loc, x, zero);
+ y1 = builder.create<mlir::math::CopySignOp>(loc, y, zero);
+ } else {
+ x1 = x;
+ y1 = y;
+ }
+ mlir::Type i1Ty = builder.getI1Type();
+ mlir::Type i8Ty = builder.getIntegerType(8);
+ mlir::arith::CmpFPredicate pred;
+ mlir::Value cmp, result, resultIsX, resultIsY;
+
+ // X1 < Y1 -- MAX result is Y; MIN result is X.
+ pred = mlir::arith::CmpFPredicate::OLT;
+ cmp = builder.create<mlir::arith::CmpFOp>(loc, pred, x1, y1);
+ auto ifOp1 = builder.create<fir::IfOp>(loc, resultType, cmp, true);
+ builder.setInsertionPointToStart(&ifOp1.getThenRegion().front());
+ result = isMax ? y : x;
+ builder.create<fir::ResultOp>(loc, result);
+
+ // X1 > Y1 -- MAX result is X; MIN result is Y.
+ builder.setInsertionPointToStart(&ifOp1.getElseRegion().front());
+ pred = mlir::arith::CmpFPredicate::OGT;
+ cmp = builder.create<mlir::arith::CmpFOp>(loc, pred, x1, y1);
+ auto ifOp2 = builder.create<fir::IfOp>(loc, resultType, cmp, true);
+ builder.setInsertionPointToStart(&ifOp2.getThenRegion().front());
+ result = isMax ? x : y;
+ builder.create<fir::ResultOp>(loc, result);
+
+ // X1 == Y1 -- MAX favors a positive result; MIN favors a negative result.
+ builder.setInsertionPointToStart(&ifOp2.getElseRegion().front());
+ pred = mlir::arith::CmpFPredicate::OEQ;
+ cmp = builder.create<mlir::arith::CmpFOp>(loc, pred, x1, y1);
+ auto ifOp3 = builder.create<fir::IfOp>(loc, resultType, cmp, true);
+ builder.setInsertionPointToStart(&ifOp3.getThenRegion().front());
+ resultIsX = isMax ? genIsFPClass(i1Ty, x, positiveTest)
+ : genIsFPClass(i1Ty, x, negativeTest);
+ result = builder.create<mlir::arith::SelectOp>(loc, resultIsX, x, y);
+ builder.create<fir::ResultOp>(loc, result);
+
+ // X or Y or both are NaNs -- result may be X, Y, or a qNaN
+ builder.setInsertionPointToStart(&ifOp3.getElseRegion().front());
+ if constexpr (isNum) {
+ pred = mlir::arith::CmpFPredicate::ORD; // check for a non-NaN
+ resultIsX = builder.create<mlir::arith::CmpFOp>(loc, pred, x, x);
+ resultIsY = builder.create<mlir::arith::CmpFOp>(loc, pred, y, y);
+ } else {
+ resultIsX = resultIsY = builder.createBool(loc, false);
+ }
+ mlir::Value qNaN =
+ genIeeeValue(resultType, builder.createIntegerConstant(
+ loc, i8Ty, _FORTRAN_RUNTIME_IEEE_QUIET_NAN));
+ result = builder.create<mlir::arith::SelectOp>(
+ loc, resultIsX, x,
+ builder.create<mlir::arith::SelectOp>(loc, resultIsY, y, qNaN));
+ mlir::Value hasSNaNOp = builder.create<mlir::arith::OrIOp>(
+ loc, genIsFPClass(builder.getI1Type(), args[0], snanTest),
+ genIsFPClass(builder.getI1Type(), args[1], snanTest));
+ genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID, hasSNaNOp);
+ builder.create<fir::ResultOp>(loc, result);
+
+ // Unwind the if nest.
+ builder.setInsertionPointAfter(ifOp3);
+ builder.create<fir::ResultOp>(loc, ifOp3.getResult(0));
+ builder.setInsertionPointAfter(ifOp2);
+ builder.create<fir::ResultOp>(loc, ifOp2.getResult(0));
+ builder.setInsertionPointAfter(ifOp1);
+ return ifOp1.getResult(0);
+}
+
+// IEEE_QUIET_EQ, IEEE_QUIET_GE, IEEE_QUIET_GT,
+// IEEE_QUIET_LE, IEEE_QUIET_LT, IEEE_QUIET_NE
+template <mlir::arith::CmpFPredicate pred>
+mlir::Value
+IntrinsicLibrary::genIeeeQuietCompare(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args) {
+ // Compare X and Y with special case treatment of NaN operands.
+ assert(args.size() == 2);
+ mlir::Value hasSNaNOp = builder.create<mlir::arith::OrIOp>(
+ loc, genIsFPClass(builder.getI1Type(), args[0], snanTest),
+ genIsFPClass(builder.getI1Type(), args[1], snanTest));
+ mlir::Value res =
+ builder.create<mlir::arith::CmpFOp>(loc, pred, args[0], args[1]);
+ genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID, hasSNaNOp);
+ return builder.create<fir::ConvertOp>(loc, resultType, res);
+}
+
+// IEEE_SET_FLAG, IEEE_SET_HALTING_MODE
+template <bool isFlag>
+void IntrinsicLibrary::genIeeeSetFlagOrHaltingMode(
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ // IEEE_SET_FLAG: Set an exception FLAG to a FLAG_VALUE.
+ // IEEE_SET_HALTING: Set an exception halting mode FLAG to a HALTING value.
+ assert(args.size() == 2);
+ mlir::Type i1Ty = builder.getI1Type();
+ mlir::Type i32Ty = builder.getIntegerType(32);
+ auto [fieldRef, ignore] = getFieldRef(builder, loc, getBase(args[0]));
+ mlir::Value field = builder.create<fir::LoadOp>(loc, fieldRef);
+ mlir::Value except = fir::runtime::genMapException(
+ builder, loc, builder.create<fir::ConvertOp>(loc, i32Ty, field));
+ auto ifOp = builder.create<fir::IfOp>(
+ loc, builder.create<fir::ConvertOp>(loc, i1Ty, getBase(args[1])),
+ /*withElseRegion=*/true);
+ builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
+ genRuntimeCall(isFlag ? "feraiseexcept" : "feenableexcept", i32Ty, except);
+ builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
+ genRuntimeCall(isFlag ? "feclearexcept" : "fedisableexcept", i32Ty, except);
+ builder.setInsertionPointAfter(ifOp);
}
// IEEE_SET_ROUNDING_MODE
@@ -3711,12 +4131,27 @@ void IntrinsicLibrary::genIeeeSetRoundingMode(
builder.create<fir::CallOp>(loc, setRound, mode);
}
+// IEEE_SIGNALING_EQ, IEEE_SIGNALING_GE, IEEE_SIGNALING_GT,
+// IEEE_SIGNALING_LE, IEEE_SIGNALING_LT, IEEE_SIGNALING_NE
+template <mlir::arith::CmpFPredicate pred>
+mlir::Value
+IntrinsicLibrary::genIeeeSignalingCompare(mlir::Type resultType,
+ llvm::ArrayRef<mlir::Value> args) {
+ // Compare X and Y with special case treatment of NaN operands.
+ assert(args.size() == 2);
+ mlir::Value hasNaNOp = genIeeeUnordered(mlir::Type{}, args);
+ mlir::Value res =
+ builder.create<mlir::arith::CmpFOp>(loc, pred, args[0], args[1]);
+ genRaiseExcept(_FORTRAN_RUNTIME_IEEE_INVALID, hasNaNOp);
+ return builder.create<fir::ConvertOp>(loc, resultType, res);
+}
+
// 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::Value realVal = args[0];
mlir::FloatType realType = realVal.getType().dyn_cast<mlir::FloatType>();
int bitWidth = realType.getWidth();
if (realType == mlir::FloatType::getBF16(builder.getContext())) {
@@ -3733,6 +4168,30 @@ mlir::Value IntrinsicLibrary::genIeeeSignbit(mlir::Type resultType,
return builder.createConvert(loc, resultType, sign);
}
+// IEEE_SUPPORT_FLAG, IEEE_SUPPORT_HALTING
+mlir::Value IntrinsicLibrary::genIeeeSupportFlagOrHalting(
+ mlir::Type resultType, llvm::ArrayRef<mlir::Value> args) {
+ // Check if a floating point exception or halting mode FLAG is supported.
+ // An IEEE_SUPPORT_FLAG flag is supported either for all type kinds or none.
+ // An optional kind argument X is therefore ignored.
+ // Standard flags are all supported.
+ // The nonstandard DENORM extension is not supported. (At least for now.)
+ assert(args.size() == 1 || args.size() == 2);
+ auto [fieldRef, fieldTy] = getFieldRef(builder, loc, args[0]);
+ mlir::Value flag = builder.create<fir::LoadOp>(loc, fieldRef);
+ mlir::Value mask = builder.createIntegerConstant( // values are powers of 2
+ loc, fieldTy,
+ _FORTRAN_RUNTIME_IEEE_INVALID | _FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO |
+ _FORTRAN_RUNTIME_IEEE_OVERFLOW | _FORTRAN_RUNTIME_IEEE_UNDERFLOW |
+ _FORTRAN_RUNTIME_IEEE_INEXACT);
+ return builder.createConvert(
+ loc, resultType,
+ builder.create<mlir::arith::CmpIOp>(
+ loc, mlir::arith::CmpIPredicate::ne,
+ builder.create<mlir::arith::AndIOp>(loc, flag, mask),
+ builder.createIntegerConstant(loc, fieldTy, 0)));
+}
+
// IEEE_SUPPORT_ROUNDING
mlir::Value
IntrinsicLibrary::genIeeeSupportRounding(mlir::Type resultType,
@@ -3747,7 +4206,7 @@ IntrinsicLibrary::genIeeeSupportRounding(mlir::Type resultType,
// 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]));
+ auto [fieldRef, fieldTy] = getFieldRef(builder, loc, 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,
@@ -3765,10 +4224,17 @@ mlir::Value
IntrinsicLibrary::genIeeeUnordered(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
// Check if REAL args X or Y or both are (signaling or quiet) NaNs.
+ // If there is no result type return an i1 result.
assert(args.size() == 2);
+ if (args[0].getType() == args[1].getType()) {
+ mlir::Value res = builder.create<mlir::arith::CmpFOp>(
+ loc, mlir::arith::CmpFPredicate::UNO, args[0], args[1]);
+ return resultType ? builder.createConvert(loc, resultType, res) : res;
+ }
+ assert(resultType && "expecting a (mixed arg type) unordered result type");
mlir::Type i1Ty = builder.getI1Type();
- mlir::Value xIsNan = genIsFPClass(i1Ty, args[0], 0b0000000011);
- mlir::Value yIsNan = genIsFPClass(i1Ty, args[1], 0b0000000011);
+ mlir::Value xIsNan = genIsFPClass(i1Ty, args[0], nanTest);
+ mlir::Value yIsNan = genIsFPClass(i1Ty, args[1], nanTest);
mlir::Value res = builder.create<mlir::arith::OrIOp>(loc, xIsNan, yIsNan);
return builder.createConvert(loc, resultType, res);
}
@@ -3777,9 +4243,13 @@ IntrinsicLibrary::genIeeeUnordered(mlir::Type resultType,
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>();
+ // A user call has two arguments:
+ // - arg[0] is X (ignored, since the resultType is provided)
+ // - arg[1] is CLASS, an IEEE_CLASS_TYPE CLASS argument containing an index
+ // A compiler generated call has one argument:
+ // - arg[0] is an index constant
+ assert(args.size() == 1 || args.size() == 2);
+ mlir::FloatType realType = resultType.dyn_cast<mlir::FloatType>();
int bitWidth = realType.getWidth();
mlir::Type intType = builder.getIntegerType(bitWidth);
mlir::Type valueTy = bitWidth <= 64 ? intType : builder.getIntegerType(64);
@@ -3887,8 +4357,13 @@ mlir::Value IntrinsicLibrary::genIeeeValue(mlir::Type resultType,
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 which;
+ if (args.size() == 2) { // user call
+ auto [index, ignore] = getFieldRef(builder, loc, args[1]);
+ which = builder.create<fir::LoadOp>(loc, index);
+ } else { // compiler generated call
+ which = args[0];
+ }
mlir::Value bits = builder.create<fir::LoadOp>(
loc,
builder.create<fir::CoordinateOp>(
diff --git a/flang/lib/Optimizer/Builder/LowLevelIntrinsics.cpp b/flang/lib/Optimizer/Builder/LowLevelIntrinsics.cpp
index f0dd83523cd92d1..1d07b1e724d745b 100644
--- a/flang/lib/Optimizer/Builder/LowLevelIntrinsics.cpp
+++ b/flang/lib/Optimizer/Builder/LowLevelIntrinsics.cpp
@@ -92,8 +92,8 @@ fir::factory::getLlvmStackRestore(fir::FirOpBuilder &builder) {
auto ptrTy = builder.getRefType(builder.getIntegerType(8));
auto funcTy =
mlir::FunctionType::get(builder.getContext(), {ptrTy}, std::nullopt);
- return builder.addNamedFunction(builder.getUnknownLoc(), "llvm.stackrestore.p0",
- funcTy);
+ return builder.addNamedFunction(builder.getUnknownLoc(),
+ "llvm.stackrestore.p0", funcTy);
}
mlir::func::FuncOp
@@ -112,3 +112,52 @@ fir::factory::getLlvmAdjustTrampoline(fir::FirOpBuilder &builder) {
return builder.addNamedFunction(builder.getUnknownLoc(),
"llvm.adjust.trampoline", funcTy);
}
+
+mlir::func::FuncOp fir::factory::getFeclearexcept(fir::FirOpBuilder &builder) {
+ auto int32Ty = builder.getIntegerType(32);
+ auto funcTy =
+ mlir::FunctionType::get(builder.getContext(), {int32Ty}, {int32Ty});
+ return builder.addNamedFunction(builder.getUnknownLoc(), "feclearexcept",
+ funcTy);
+}
+
+mlir::func::FuncOp
+fir::factory::getFedisableexcept(fir::FirOpBuilder &builder) {
+ auto int32Ty = builder.getIntegerType(32);
+ auto funcTy =
+ mlir::FunctionType::get(builder.getContext(), {int32Ty}, {int32Ty});
+ return builder.addNamedFunction(builder.getUnknownLoc(), "fedisableexcept",
+ funcTy);
+}
+
+mlir::func::FuncOp fir::factory::getFeenableexcept(fir::FirOpBuilder &builder) {
+ auto int32Ty = builder.getIntegerType(32);
+ auto funcTy =
+ mlir::FunctionType::get(builder.getContext(), {int32Ty}, {int32Ty});
+ return builder.addNamedFunction(builder.getUnknownLoc(), "feenableexcept",
+ funcTy);
+}
+
+mlir::func::FuncOp fir::factory::getFegetexcept(fir::FirOpBuilder &builder) {
+ auto int32Ty = builder.getIntegerType(32);
+ auto funcTy =
+ mlir::FunctionType::get(builder.getContext(), std::nullopt, {int32Ty});
+ return builder.addNamedFunction(builder.getUnknownLoc(), "fegetexcept",
+ funcTy);
+}
+
+mlir::func::FuncOp fir::factory::getFeraiseexcept(fir::FirOpBuilder &builder) {
+ auto int32Ty = builder.getIntegerType(32);
+ auto funcTy =
+ mlir::FunctionType::get(builder.getContext(), {int32Ty}, {int32Ty});
+ return builder.addNamedFunction(builder.getUnknownLoc(), "feraiseexcept",
+ funcTy);
+}
+
+mlir::func::FuncOp fir::factory::getFetestexcept(fir::FirOpBuilder &builder) {
+ auto int32Ty = builder.getIntegerType(32);
+ auto funcTy =
+ mlir::FunctionType::get(builder.getContext(), {int32Ty}, {int32Ty});
+ return builder.addNamedFunction(builder.getUnknownLoc(), "fetestexcept",
+ funcTy);
+}
diff --git a/flang/lib/Optimizer/Builder/Runtime/Exceptions.cpp b/flang/lib/Optimizer/Builder/Runtime/Exceptions.cpp
new file mode 100644
index 000000000000000..294ccbaf82a0669
--- /dev/null
+++ b/flang/lib/Optimizer/Builder/Runtime/Exceptions.cpp
@@ -0,0 +1,22 @@
+//===-- Exceptions.cpp ----------------------------------------------------===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Optimizer/Builder/Runtime/Exceptions.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
+#include "flang/Runtime/exceptions.h"
+
+using namespace Fortran::runtime;
+
+mlir::Value fir::runtime::genMapException(fir::FirOpBuilder &builder,
+ mlir::Location loc,
+ mlir::Value except) {
+ mlir::func::FuncOp func{
+ fir::runtime::getRuntimeFunc<mkRTKey(MapException)>(loc, builder)};
+ return builder.create<fir::CallOp>(loc, func, except).getResult(0);
+}
diff --git a/flang/module/__cuda_builtins.f90 b/flang/module/__cuda_builtins.f90
index 64cb21abe0c570e..50e0d2682ef3015 100644
--- a/flang/module/__cuda_builtins.f90
+++ b/flang/module/__cuda_builtins.f90
@@ -10,7 +10,7 @@
! subprograms.
module __CUDA_builtins
- use __Fortran_builtins, only: &
+ use __fortran_builtins, only: &
threadIdx => __builtin_threadIdx, &
blockDim => __builtin_blockDim, &
blockIdx => __builtin_blockIdx, &
diff --git a/flang/module/__fortran_builtins.f90 b/flang/module/__fortran_builtins.f90
index 347f8d7b702c137..0bc66def847edea 100644
--- a/flang/module/__fortran_builtins.f90
+++ b/flang/module/__fortran_builtins.f90
@@ -10,7 +10,7 @@
! from being usable on INTRINSIC statements, and force the program
! to USE the standard intrinsic modules in order to access the
! standard names of the procedures.
-module __Fortran_builtins
+module __fortran_builtins
intrinsic :: __builtin_c_loc
intrinsic :: __builtin_c_f_pointer
@@ -41,7 +41,8 @@
end type
integer, parameter :: __builtin_atomic_int_kind = selected_int_kind(18)
- integer, parameter :: __builtin_atomic_logical_kind = __builtin_atomic_int_kind
+ integer, parameter :: &
+ __builtin_atomic_logical_kind = __builtin_atomic_int_kind
procedure(type(__builtin_c_ptr)) :: __builtin_c_loc
@@ -49,7 +50,8 @@
integer :: x=1, y=1, z=1
end type
type(__builtin_dim3) :: &
- __builtin_threadIdx, __builtin_blockDim, __builtin_blockIdx, __builtin_gridDim
+ __builtin_threadIdx, __builtin_blockDim, __builtin_blockIdx, &
+ __builtin_gridDim
integer, parameter :: __builtin_warpsize = 32
intrinsic :: __builtin_fma
@@ -90,7 +92,8 @@
private :: c_associated_c_ptr, c_associated_c_funptr
type(__builtin_c_ptr), parameter :: __builtin_c_null_ptr = __builtin_c_ptr(0)
- type(__builtin_c_funptr), parameter :: __builtin_c_null_funptr = __builtin_c_funptr(0)
+ type(__builtin_c_funptr), parameter :: &
+ __builtin_c_null_funptr = __builtin_c_funptr(0)
contains
diff --git a/flang/module/__fortran_ieee_exceptions.f90 b/flang/module/__fortran_ieee_exceptions.f90
index 785c4adaec25d55..047064a7bc8aafa 100644
--- a/flang/module/__fortran_ieee_exceptions.f90
+++ b/flang/module/__fortran_ieee_exceptions.f90
@@ -11,7 +11,9 @@
! here under another name so that IEEE_ARITHMETIC can USE it and export its
! declarations without clashing with a non-intrinsic module in a program.
-module __Fortran_ieee_exceptions
+include '../include/flang/Runtime/magic-numbers.h'
+
+module __fortran_ieee_exceptions
type :: ieee_flag_type ! Fortran 2018, 17.2 & 17.3
private
@@ -19,23 +21,26 @@
end type ieee_flag_type
type(ieee_flag_type), parameter :: &
- ieee_invalid = ieee_flag_type(1), &
- ieee_overflow = ieee_flag_type(2), &
- ieee_divide_by_zero = ieee_flag_type(4), &
- ieee_underflow = ieee_flag_type(8), &
- ieee_inexact = ieee_flag_type(16), &
- ieee_denorm = ieee_flag_type(32) ! PGI extension
+ ieee_invalid = ieee_flag_type(_FORTRAN_RUNTIME_IEEE_INVALID), &
+ ieee_overflow = ieee_flag_type(_FORTRAN_RUNTIME_IEEE_OVERFLOW), &
+ ieee_divide_by_zero = &
+ ieee_flag_type(_FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO), &
+ ieee_underflow = ieee_flag_type(_FORTRAN_RUNTIME_IEEE_UNDERFLOW), &
+ ieee_inexact = ieee_flag_type(_FORTRAN_RUNTIME_IEEE_INEXACT), &
+ ieee_denorm = ieee_flag_type(_FORTRAN_RUNTIME_IEEE_DENORM) ! extension
type(ieee_flag_type), parameter :: &
ieee_usual(*) = [ ieee_overflow, ieee_divide_by_zero, ieee_invalid ], &
ieee_all(*) = [ ieee_usual, ieee_underflow, ieee_inexact ]
type :: ieee_modes_type ! Fortran 2018, 17.7
- private
+ private ! opaque fenv.h femode_t data
+ integer(kind=4) :: __data(_FORTRAN_RUNTIME_IEEE_FEMODE_T_EXTENT)
end type ieee_modes_type
type :: ieee_status_type ! Fortran 2018, 17.7
- private
+ private ! opaque fenv.h fenv_t data
+ integer(kind=4) :: __data(_FORTRAN_RUNTIME_IEEE_FENV_T_EXTENT)
end type ieee_status_type
! Define specifics with 1 LOGICAL or REAL argument for generic G.
@@ -61,21 +66,29 @@
G##_a2, G##_a3, G##_a4, G##_a8, G##_a16
#endif
+#define IEEE_GET_FLAG_L(FVKIND) \
+ elemental subroutine ieee_get_flag_l##FVKIND(flag, flag_value); \
+ import ieee_flag_type; \
+ type(ieee_flag_type), intent(in) :: flag; \
+ logical(FVKIND), intent(out) :: flag_value; \
+ end subroutine ieee_get_flag_l##FVKIND;
interface ieee_get_flag
- elemental subroutine ieee_get_flag_0(flag, flag_value)
- import ieee_flag_type
- type(ieee_flag_type), intent(in) :: flag
- logical, intent(out) :: flag_value
- end subroutine ieee_get_flag_0
- end interface
+ SPECIFICS_L(IEEE_GET_FLAG_L)
+ end interface ieee_get_flag
+ PRIVATE_L(IEEE_GET_FLAG)
+#undef IEEE_GET_FLAG_L
+#define IEEE_GET_HALTING_MODE_L(HKIND) \
+ elemental subroutine ieee_get_halting_mode_l##HKIND(flag, halting); \
+ import ieee_flag_type; \
+ type(ieee_flag_type), intent(in) :: flag; \
+ logical(HKIND), intent(out) :: halting; \
+ end subroutine ieee_get_halting_mode_l##HKIND;
interface ieee_get_halting_mode
- elemental subroutine ieee_get_halting_mode_0(flag, halting)
- import ieee_flag_type
- type(ieee_flag_type), intent(in) :: flag
- logical, intent(out) :: halting
- end subroutine ieee_get_halting_mode_0
- end interface
+ SPECIFICS_L(IEEE_GET_HALTING_MODE_L)
+ end interface ieee_get_halting_mode
+ PRIVATE_L(IEEE_GET_HALTING_MODE)
+#undef IEEE_GET_HALTING_MODE_L
interface ieee_get_modes
pure subroutine ieee_get_modes_0(modes)
@@ -92,28 +105,26 @@ end subroutine ieee_get_status_0
end interface
#define IEEE_SET_FLAG_L(FVKIND) \
- pure subroutine ieee_set_flag_l##FVKIND(flag,flag_value); \
+ elemental subroutine ieee_set_flag_l##FVKIND(flag, flag_value); \
import ieee_flag_type; \
- type(ieee_flag_type), intent(in) :: flag(..); \
- logical(FVKIND), intent(in) :: flag_value(..); \
+ type(ieee_flag_type), intent(in) :: flag; \
+ logical(FVKIND), intent(in) :: flag_value; \
end subroutine ieee_set_flag_l##FVKIND;
interface ieee_set_flag
SPECIFICS_L(IEEE_SET_FLAG_L)
end interface ieee_set_flag
- private :: ieee_set_flag_1
PRIVATE_L(IEEE_SET_FLAG)
#undef IEEE_SET_FLAG_L
#define IEEE_SET_HALTING_MODE_L(HKIND) \
- pure subroutine ieee_set_halting_mode_l##HKIND(flag,halting); \
+ elemental subroutine ieee_set_halting_mode_l##HKIND(flag, halting); \
import ieee_flag_type; \
- type(ieee_flag_type), intent(in) :: flag(..); \
- logical(HKIND), intent(in) :: halting(..); \
+ type(ieee_flag_type), intent(in) :: flag; \
+ logical(HKIND), intent(in) :: halting; \
end subroutine ieee_set_halting_mode_l##HKIND;
interface ieee_set_halting_mode
SPECIFICS_L(IEEE_SET_HALTING_MODE_L)
end interface ieee_set_halting_mode
- private :: ieee_set_halting_mode_1
PRIVATE_L(IEEE_SET_HALTING_MODE)
#undef IEEE_SET_HALTING_MODE_L
@@ -154,4 +165,4 @@ pure logical function ieee_support_halting_0(flag)
end function ieee_support_halting_0
end interface
-end module __Fortran_ieee_exceptions
+end module __fortran_ieee_exceptions
diff --git a/flang/module/__fortran_type_info.f90 b/flang/module/__fortran_type_info.f90
index 8a517bd1d5422d0..9dc8b3de724e895 100644
--- a/flang/module/__fortran_type_info.f90
+++ b/flang/module/__fortran_type_info.f90
@@ -11,9 +11,10 @@
! The Semantics phase of the compiler requires the module file of this module
! in order to generate description tables for all other derived types.
-module __Fortran_type_info
+module __fortran_type_info
- use, intrinsic :: __Fortran_builtins, only: __builtin_c_ptr, __builtin_c_funptr
+ use, intrinsic :: __fortran_builtins, &
+ only: __builtin_c_ptr, __builtin_c_funptr
private
@@ -30,16 +31,19 @@
! Instances of parameterized derived types use the "uninstantiated"
! component to point to the pristine original definition.
type(DerivedType), pointer :: uninstantiated
- integer(kind=int64), pointer, contiguous :: kindParameter(:) ! values of instance
- integer(1), pointer, contiguous :: lenParameterKind(:) ! INTEGER kinds of LEN types
+ ! values of instance
+ integer(kind=int64), pointer, contiguous :: kindParameter(:)
+ ! INTEGER kinds of LEN types
+ integer(1), pointer, contiguous :: lenParameterKind(:)
! Data components appear in component order.
! The parent component, if any, appears explicitly and first.
type(Component), pointer, contiguous :: component(:) ! data components
- type(ProcPtrComponent), pointer, contiguous :: procptr(:) ! procedure pointers
+ ! procedure pointers
+ type(ProcPtrComponent), pointer, contiguous :: procptr(:)
! Special bindings of the ancestral types are not duplicated here.
! Bindings are in ascending order of their "which" code values.
type(SpecialBinding), pointer, contiguous :: special(:)
- ! A little-endian bit set of SpecialBinding::Which codes present in "special"
+ ! little-endian bit set of SpecialBinding::Which codes present in "special"
integer(4) :: specialBitSet
integer(1) :: hasParent
integer(1) :: noInitializationNeeded ! 1 if no component w/ init
@@ -86,7 +90,8 @@
integer(kind=int64) :: offset
type(Value) :: characterLen ! for category == Character
type(DerivedType), pointer :: derived ! for category == Derived
- type(Value), pointer, contiguous :: lenValue(:) ! (SIZE(derived%lenParameterKind))
+ ! (SIZE(derived%lenParameterKind))
+ type(Value), pointer, contiguous :: lenValue(:)
type(Value), pointer, contiguous :: bounds(:, :) ! (2, rank): lower, upper
type(__builtin_c_ptr) :: initialization
end type
diff --git a/flang/module/ieee_arithmetic.f90 b/flang/module/ieee_arithmetic.f90
index 36792ed96629eb4..98f264f34152f8e 100644
--- a/flang/module/ieee_arithmetic.f90
+++ b/flang/module/ieee_arithmetic.f90
@@ -8,16 +8,16 @@
! Fortran 2018 Clause 17
-! ieee_class_type and ieee_round_type values
-include '../include/flang/Runtime/ieee_arithmetic.h'
+include '../include/flang/Runtime/magic-numbers.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
+ ! F18 Clause 17.1p1:
+ ! 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: &
+ use __fortran_builtins, only: &
ieee_fma => __builtin_fma, &
ieee_is_nan => __builtin_ieee_is_nan, &
ieee_is_negative => __builtin_ieee_is_negative, &
@@ -49,12 +49,16 @@ module ieee_arithmetic
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_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_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)
@@ -294,6 +298,26 @@ end function ieee_logb_a##XKIND;
PRIVATE_R(IEEE_LOGB)
#undef IEEE_LOGB_R
+#define IEEE_MAX_R(XKIND) \
+ elemental real(XKIND) function ieee_max_a##XKIND(x, y); \
+ real(XKIND), intent(in) :: x, y; \
+ end function ieee_max_a##XKIND;
+ interface ieee_max
+ SPECIFICS_R(IEEE_MAX_R)
+ end interface ieee_max
+ PRIVATE_R(IEEE_MAX)
+#undef IEEE_MAX_R
+
+#define IEEE_MAX_MAG_R(XKIND) \
+ elemental real(XKIND) function ieee_max_mag_a##XKIND(x, y); \
+ real(XKIND), intent(in) :: x, y; \
+ end function ieee_max_mag_a##XKIND;
+ interface ieee_max_mag
+ SPECIFICS_R(IEEE_MAX_MAG_R)
+ end interface ieee_max_mag
+ PRIVATE_R(IEEE_MAX_MAG)
+#undef IEEE_MAX_MAG_R
+
#define IEEE_MAX_NUM_R(XKIND) \
elemental real(XKIND) function ieee_max_num_a##XKIND(x, y); \
real(XKIND), intent(in) :: x, y; \
@@ -314,6 +338,26 @@ end function ieee_max_num_mag_a##XKIND;
PRIVATE_R(IEEE_MAX_NUM_MAG)
#undef IEEE_MAX_NUM_MAG_R
+#define IEEE_MIN_R(XKIND) \
+ elemental real(XKIND) function ieee_min_a##XKIND(x, y); \
+ real(XKIND), intent(in) :: x, y; \
+ end function ieee_min_a##XKIND;
+ interface ieee_min
+ SPECIFICS_R(IEEE_MIN_R)
+ end interface ieee_min
+ PRIVATE_R(IEEE_MIN)
+#undef IEEE_MIN_R
+
+#define IEEE_MIN_MAG_R(XKIND) \
+ elemental real(XKIND) function ieee_min_mag_a##XKIND(x, y); \
+ real(XKIND), intent(in) :: x, y; \
+ end function ieee_min_mag_a##XKIND;
+ interface ieee_min_mag
+ SPECIFICS_R(IEEE_MIN_MAG_R)
+ end interface ieee_min_mag
+ PRIVATE_R(IEEE_MIN_MAG)
+#undef IEEE_MIN_MAG_R
+
#define IEEE_MIN_NUM_R(XKIND) \
elemental real(XKIND) function ieee_min_num_a##XKIND(x, y); \
real(XKIND), intent(in) :: x, y; \
diff --git a/flang/module/ieee_exceptions.f90 b/flang/module/ieee_exceptions.f90
index 2d050412772a5f7..e9ededb8ee1652d 100644
--- a/flang/module/ieee_exceptions.f90
+++ b/flang/module/ieee_exceptions.f90
@@ -7,5 +7,5 @@
!===------------------------------------------------------------------------===!
module ieee_exceptions
- use __Fortran_ieee_exceptions
+ use __fortran_ieee_exceptions
end module ieee_exceptions
diff --git a/flang/module/iso_c_binding.f90 b/flang/module/iso_c_binding.f90
index 9dd6c10f61080a6..a34c1d84afbf149 100644
--- a/flang/module/iso_c_binding.f90
+++ b/flang/module/iso_c_binding.f90
@@ -10,7 +10,7 @@
module iso_c_binding
- use __Fortran_builtins, only: &
+ use __fortran_builtins, only: &
c_associated => __builtin_c_associated, &
c_funloc => __builtin_c_funloc, &
c_funptr => __builtin_c_funptr, &
diff --git a/flang/module/iso_fortran_env.f90 b/flang/module/iso_fortran_env.f90
index ac1847128beb35e..f1d540bc8e45198 100644
--- a/flang/module/iso_fortran_env.f90
+++ b/flang/module/iso_fortran_env.f90
@@ -9,11 +9,11 @@
! See Fortran 2018, clause 16.10.2
! TODO: These are placeholder values so that some tests can be run.
-include '../include/flang/Runtime/magic-numbers.h' ! for IOSTAT= error/end code values
+include '../include/flang/Runtime/magic-numbers.h' ! IOSTAT values
module iso_fortran_env
- use __Fortran_builtins, only: &
+ use __fortran_builtins, only: &
event_type => __builtin_event_type, &
lock_type => __builtin_lock_type, &
team_type => __builtin_team_type, &
@@ -142,9 +142,11 @@ module iso_fortran_env
integer, parameter :: stat_failed_image = FORTRAN_RUNTIME_STAT_FAILED_IMAGE
integer, parameter :: stat_locked = FORTRAN_RUNTIME_STAT_LOCKED
- integer, parameter :: stat_locked_other_image = FORTRAN_RUNTIME_STAT_LOCKED_OTHER_IMAGE
+ integer, parameter :: &
+ stat_locked_other_image = FORTRAN_RUNTIME_STAT_LOCKED_OTHER_IMAGE
integer, parameter :: stat_stopped_image = FORTRAN_RUNTIME_STAT_STOPPED_IMAGE
integer, parameter :: stat_unlocked = FORTRAN_RUNTIME_STAT_UNLOCKED
- integer, parameter :: stat_unlocked_failed_image = FORTRAN_RUNTIME_STAT_UNLOCKED_FAILED_IMAGE
+ integer, parameter :: &
+ stat_unlocked_failed_image = FORTRAN_RUNTIME_STAT_UNLOCKED_FAILED_IMAGE
end module iso_fortran_env
diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt
index 68ae97bed4e329e..bf3aa5af3c88e33 100644
--- a/flang/runtime/CMakeLists.txt
+++ b/flang/runtime/CMakeLists.txt
@@ -104,6 +104,7 @@ set(sources
edit-input.cpp
edit-output.cpp
environment.cpp
+ exceptions.cpp
extensions.cpp
extrema.cpp
file.cpp
diff --git a/flang/runtime/exceptions.cpp b/flang/runtime/exceptions.cpp
new file mode 100644
index 000000000000000..7e1fb17a314318a
--- /dev/null
+++ b/flang/runtime/exceptions.cpp
@@ -0,0 +1,81 @@
+//===-- runtime/exceptions.cpp --------------------------------------===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+// Map Fortran ieee_arithmetic module exceptions to fenv.h exceptions.
+
+#include "flang/Runtime/exceptions.h"
+#include "terminator.h"
+#include "flang/Runtime/magic-numbers.h"
+#include <cfenv>
+
+namespace Fortran::runtime {
+
+extern "C" {
+
+std::int32_t RTNAME(MapException)(int32_t except) {
+ Terminator terminator{__FILE__, __LINE__};
+
+ static constexpr int32_t mask = _FORTRAN_RUNTIME_IEEE_INVALID |
+ _FORTRAN_RUNTIME_IEEE_DENORM | _FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO |
+ _FORTRAN_RUNTIME_IEEE_OVERFLOW | _FORTRAN_RUNTIME_IEEE_UNDERFLOW |
+ _FORTRAN_RUNTIME_IEEE_INEXACT;
+ if (except != (except & mask))
+ terminator.Crash("Invalid exception value: %d", except);
+
+ // Fortran and fenv.h values are identical; return the value.
+ if constexpr (_FORTRAN_RUNTIME_IEEE_INVALID == FE_INVALID &&
+ _FORTRAN_RUNTIME_IEEE_DENORM == __FE_DENORM &&
+ _FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO == FE_DIVBYZERO &&
+ _FORTRAN_RUNTIME_IEEE_OVERFLOW == FE_OVERFLOW &&
+ _FORTRAN_RUNTIME_IEEE_UNDERFLOW == FE_UNDERFLOW &&
+ _FORTRAN_RUNTIME_IEEE_INEXACT == FE_INEXACT)
+ if (except)
+ return except;
+
+ // fenv.h calls that take exception arguments are able to process multiple
+ // exceptions in one call, such as FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID.
+ // And intrinsic module procedures that manage exceptions are elemental
+ // procedures that may specify multiple exceptions, such as ieee_all.
+ // However, general elemental call processing places single scalar arguments
+ // in a loop. As a consequence, argument 'except' here will be a power of
+ // two, corresponding to a single exception. If code generation were
+ // modified to bypass normal elemental call processing for calls with
+ // ieee_usual, ieee_all, or user-specified array arguments, this switch
+ // could be extended to support that.
+
+ // Fortran and fenv.h values differ.
+ switch (except) {
+ case _FORTRAN_RUNTIME_IEEE_INVALID:
+ return FE_INVALID;
+ case _FORTRAN_RUNTIME_IEEE_DENORM:
+ return __FE_DENORM;
+ case _FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO:
+ return FE_DIVBYZERO;
+ case _FORTRAN_RUNTIME_IEEE_OVERFLOW:
+ return FE_OVERFLOW;
+ case _FORTRAN_RUNTIME_IEEE_UNDERFLOW:
+ return FE_UNDERFLOW;
+ case _FORTRAN_RUNTIME_IEEE_INEXACT:
+ return FE_INEXACT;
+ }
+
+ terminator.Crash("Invalid exception set: %d", except);
+}
+
+// Verify that the size of ieee_modes_type and ieee_status_type objects from
+// intrinsic module file __fortran_ieee_exceptions.f90 are large enough to
+// hold femode_t and fenv_t objects, respectively.
+static_assert(
+ sizeof(femode_t) <= sizeof(int) * _FORTRAN_RUNTIME_IEEE_FEMODE_T_EXTENT,
+ "increase ieee_modes_type size");
+static_assert(
+ sizeof(fenv_t) <= sizeof(int) * _FORTRAN_RUNTIME_IEEE_FENV_T_EXTENT,
+ "increase ieee_status_type size");
+
+} // extern "C"
+} // namespace Fortran::runtime
diff --git a/flang/test/Lower/Intrinsics/ieee_compare.f90 b/flang/test/Lower/Intrinsics/ieee_compare.f90
new file mode 100644
index 000000000000000..36a27d50a2b22ba
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/ieee_compare.f90
@@ -0,0 +1,270 @@
+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+! CHECK-LABEL: c.func @_QQmain
+program p
+ use ieee_arithmetic
+
+ ! CHECK: %[[V_0:[0-9]+]] = fir.alloca i32 {bindc_name = "i", uniq_name = "_QFEi"}
+ ! CHECK: %[[V_1:[0-9]+]] = fir.declare %[[V_0]] {uniq_name = "_QFEi"} : (!fir.ref<i32>) -> !fir.ref<i32>
+ ! CHECK: %[[V_58:[0-9]+]] = fir.alloca i32 {bindc_name = "j", uniq_name = "_QFEj"}
+ ! CHECK: %[[V_59:[0-9]+]] = fir.declare %[[V_58]] {uniq_name = "_QFEj"} : (!fir.ref<i32>) -> !fir.ref<i32>
+ ! CHECK: %[[V_60:[0-9]+]] = fir.address_of(@_QFEx) : !fir.ref<!fir.array<10xf32>>
+ ! CHECK: %[[V_61:[0-9]+]] = fir.shape %c10{{.*}} : (index) -> !fir.shape<1>
+ ! CHECK: %[[V_62:[0-9]+]] = fir.declare %[[V_60]](%[[V_61]]) {uniq_name = "_QFEx"} : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>) -> !fir.ref<!fir.array<10xf32>>
+ real(4) :: x(10)
+
+ x( 1) = ieee_value(x(1), ieee_signaling_nan)
+ x( 2) = ieee_value(x(1), ieee_quiet_nan)
+ 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_denormal)
+ 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_denormal)
+ x( 9) = ieee_value(x(1), ieee_positive_normal)
+ x(10) = ieee_value(x(1), ieee_positive_inf)
+
+ do i = lbound(x,1), ubound(x,1)
+ do j = lbound(x,1), ubound(x,1)
+ ! CHECK: %[[V_153:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ ! CHECK: fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_174:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_175:[0-9]+]] = fir.convert %[[V_174]] : (i32) -> i64
+ ! CHECK: %[[V_176:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_175]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_177:[0-9]+]] = fir.load %[[V_59]] : !fir.ref<i32>
+ ! CHECK: %[[V_178:[0-9]+]] = fir.convert %[[V_177]] : (i32) -> i64
+ ! CHECK: %[[V_179:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_178]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_180:[0-9]+]] = fir.load %[[V_176]] : !fir.ref<f32>
+ ! CHECK: %[[V_181:[0-9]+]] = fir.load %[[V_179]] : !fir.ref<f32>
+ ! CHECK: %[[V_182:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_181]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_183:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_180]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_184:[0-9]+]] = arith.ori %[[V_183]], %[[V_182]] : i1
+ ! CHECK: %[[V_185:[0-9]+]] = arith.cmpf oeq, %[[V_180]], %[[V_181]] : f32
+ ! CHECK: fir.if %[[V_184]] {
+ ! CHECK: %[[V_526:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_527:[0-9]+]] = fir.call @feraiseexcept(%[[V_526]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_186:[0-9]+]] = fir.call @_FortranAioOutputLogical(%[[V_153]], %[[V_185]]) fastmath<contract> : (!fir.ref<i8>, i1) -> i1
+ print*, ' [Q]', x(i), 'eq', x(j), ieee_quiet_eq(x(i), x(j))
+
+ ! CHECK: %[[V_188:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ ! CHECK: fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_206:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_207:[0-9]+]] = fir.convert %[[V_206]] : (i32) -> i64
+ ! CHECK: %[[V_208:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_207]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_209:[0-9]+]] = fir.load %[[V_59]] : !fir.ref<i32>
+ ! CHECK: %[[V_210:[0-9]+]] = fir.convert %[[V_209]] : (i32) -> i64
+ ! CHECK: %[[V_211:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_210]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_212:[0-9]+]] = fir.load %[[V_208]] : !fir.ref<f32>
+ ! CHECK: %[[V_213:[0-9]+]] = fir.load %[[V_211]] : !fir.ref<f32>
+ ! CHECK: %[[V_214:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_213]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_215:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_212]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_216:[0-9]+]] = arith.ori %[[V_215]], %[[V_214]] : i1
+ ! CHECK: %[[V_217:[0-9]+]] = arith.cmpf oge, %[[V_212]], %[[V_213]] : f32
+ ! CHECK: fir.if %[[V_216]] {
+ ! CHECK: %[[V_526:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_527:[0-9]+]] = fir.call @feraiseexcept(%[[V_526]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_218:[0-9]+]] = fir.call @_FortranAioOutputLogical(%[[V_188]], %[[V_217]]) fastmath<contract> : (!fir.ref<i8>, i1) -> i1
+ print*, ' [Q]', x(i), 'ge', x(j), ieee_quiet_ge(x(i), x(j))
+
+ ! CHECK: %[[V_220:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ ! CHECK: fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_238:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_239:[0-9]+]] = fir.convert %[[V_238]] : (i32) -> i64
+ ! CHECK: %[[V_240:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_239]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_241:[0-9]+]] = fir.load %[[V_59]] : !fir.ref<i32>
+ ! CHECK: %[[V_242:[0-9]+]] = fir.convert %[[V_241]] : (i32) -> i64
+ ! CHECK: %[[V_243:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_242]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_244:[0-9]+]] = fir.load %[[V_240]] : !fir.ref<f32>
+ ! CHECK: %[[V_245:[0-9]+]] = fir.load %[[V_243]] : !fir.ref<f32>
+ ! CHECK: %[[V_246:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_245]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_247:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_244]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_248:[0-9]+]] = arith.ori %[[V_247]], %[[V_246]] : i1
+ ! CHECK: %[[V_249:[0-9]+]] = arith.cmpf ogt, %[[V_244]], %[[V_245]] : f32
+ ! CHECK: fir.if %[[V_248]] {
+ ! CHECK: %[[V_526:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_527:[0-9]+]] = fir.call @feraiseexcept(%[[V_526]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_250:[0-9]+]] = fir.call @_FortranAioOutputLogical(%[[V_220]], %[[V_249]]) fastmath<contract> : (!fir.ref<i8>, i1) -> i1
+ print*, ' [Q]', x(i), 'gt', x(j), ieee_quiet_gt(x(i), x(j))
+
+ ! CHECK: %[[V_252:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ ! CHECK: fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_270:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_271:[0-9]+]] = fir.convert %[[V_270]] : (i32) -> i64
+ ! CHECK: %[[V_272:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_271]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_273:[0-9]+]] = fir.load %[[V_59]] : !fir.ref<i32>
+ ! CHECK: %[[V_274:[0-9]+]] = fir.convert %[[V_273]] : (i32) -> i64
+ ! CHECK: %[[V_275:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_274]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_276:[0-9]+]] = fir.load %[[V_272]] : !fir.ref<f32>
+ ! CHECK: %[[V_277:[0-9]+]] = fir.load %[[V_275]] : !fir.ref<f32>
+ ! CHECK: %[[V_278:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_277]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_279:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_276]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_280:[0-9]+]] = arith.ori %[[V_279]], %[[V_278]] : i1
+ ! CHECK: %[[V_281:[0-9]+]] = arith.cmpf ole, %[[V_276]], %[[V_277]] : f32
+ ! CHECK: fir.if %[[V_280]] {
+ ! CHECK: %[[V_526:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_527:[0-9]+]] = fir.call @feraiseexcept(%[[V_526]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_282:[0-9]+]] = fir.call @_FortranAioOutputLogical(%[[V_252]], %[[V_281]]) fastmath<contract> : (!fir.ref<i8>, i1) -> i1
+ print*, ' [Q]', x(i), 'le', x(j), ieee_quiet_le(x(i), x(j))
+
+ ! CHECK: %[[V_284:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ ! CHECK: fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_302:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_303:[0-9]+]] = fir.convert %[[V_302]] : (i32) -> i64
+ ! CHECK: %[[V_304:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_303]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_305:[0-9]+]] = fir.load %[[V_59]] : !fir.ref<i32>
+ ! CHECK: %[[V_306:[0-9]+]] = fir.convert %[[V_305]] : (i32) -> i64
+ ! CHECK: %[[V_307:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_306]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_308:[0-9]+]] = fir.load %[[V_304]] : !fir.ref<f32>
+ ! CHECK: %[[V_309:[0-9]+]] = fir.load %[[V_307]] : !fir.ref<f32>
+ ! CHECK: %[[V_310:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_309]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_311:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_308]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_312:[0-9]+]] = arith.ori %[[V_311]], %[[V_310]] : i1
+ ! CHECK: %[[V_313:[0-9]+]] = arith.cmpf olt, %[[V_308]], %[[V_309]] : f32
+ ! CHECK: fir.if %[[V_312]] {
+ ! CHECK: %[[V_526:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_527:[0-9]+]] = fir.call @feraiseexcept(%[[V_526]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_314:[0-9]+]] = fir.call @_FortranAioOutputLogical(%[[V_284]], %[[V_313]]) fastmath<contract> : (!fir.ref<i8>, i1) -> i1
+ print*, ' [Q]', x(i), 'lt', x(j), ieee_quiet_lt(x(i), x(j))
+
+ ! CHECK: %[[V_316:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ ! CHECK: fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_334:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_335:[0-9]+]] = fir.convert %[[V_334]] : (i32) -> i64
+ ! CHECK: %[[V_336:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_335]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_337:[0-9]+]] = fir.load %[[V_59]] : !fir.ref<i32>
+ ! CHECK: %[[V_338:[0-9]+]] = fir.convert %[[V_337]] : (i32) -> i64
+ ! CHECK: %[[V_339:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_338]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_340:[0-9]+]] = fir.load %[[V_336]] : !fir.ref<f32>
+ ! CHECK: %[[V_341:[0-9]+]] = fir.load %[[V_339]] : !fir.ref<f32>
+ ! CHECK: %[[V_342:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_341]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_343:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_340]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_344:[0-9]+]] = arith.ori %[[V_343]], %[[V_342]] : i1
+ ! CHECK: %[[V_345:[0-9]+]] = arith.cmpf une, %[[V_340]], %[[V_341]] : f32
+ ! CHECK: fir.if %[[V_344]] {
+ ! CHECK: %[[V_526:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_527:[0-9]+]] = fir.call @feraiseexcept(%[[V_526]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_346:[0-9]+]] = fir.call @_FortranAioOutputLogical(%[[V_316]], %[[V_345]]) fastmath<contract> : (!fir.ref<i8>, i1) -> i1
+ print*, ' [Q]', x(i), 'ne', x(j), ieee_quiet_ne(x(i), x(j))
+
+ ! CHECK: %[[V_348:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ ! CHECK: fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_366:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_367:[0-9]+]] = fir.convert %[[V_366]] : (i32) -> i64
+ ! CHECK: %[[V_368:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_367]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_369:[0-9]+]] = fir.load %[[V_59]] : !fir.ref<i32>
+ ! CHECK: %[[V_370:[0-9]+]] = fir.convert %[[V_369]] : (i32) -> i64
+ ! CHECK: %[[V_371:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_370]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_372:[0-9]+]] = fir.load %[[V_368]] : !fir.ref<f32>
+ ! CHECK: %[[V_373:[0-9]+]] = fir.load %[[V_371]] : !fir.ref<f32>
+ ! CHECK: %[[V_374:[0-9]+]] = arith.cmpf uno, %[[V_372]], %[[V_373]] : f32
+ ! CHECK: %[[V_375:[0-9]+]] = arith.cmpf oeq, %[[V_372]], %[[V_373]] : f32
+ ! CHECK: fir.if %[[V_374]] {
+ ! CHECK: %[[V_526:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_527:[0-9]+]] = fir.call @feraiseexcept(%[[V_526]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_376:[0-9]+]] = fir.call @_FortranAioOutputLogical(%[[V_348]], %[[V_375]]) fastmath<contract> : (!fir.ref<i8>, i1) -> i1
+ print*, ' [S]', x(i), 'eq', x(j), ieee_signaling_eq(x(i), x(j))
+
+ ! CHECK: %[[V_378:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ ! CHECK: fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_395:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_396:[0-9]+]] = fir.convert %[[V_395]] : (i32) -> i64
+ ! CHECK: %[[V_397:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_396]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_398:[0-9]+]] = fir.load %[[V_59]] : !fir.ref<i32>
+ ! CHECK: %[[V_399:[0-9]+]] = fir.convert %[[V_398]] : (i32) -> i64
+ ! CHECK: %[[V_400:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_399]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_401:[0-9]+]] = fir.load %[[V_397]] : !fir.ref<f32>
+ ! CHECK: %[[V_402:[0-9]+]] = fir.load %[[V_400]] : !fir.ref<f32>
+ ! CHECK: %[[V_403:[0-9]+]] = arith.cmpf uno, %[[V_401]], %[[V_402]] : f32
+ ! CHECK: %[[V_404:[0-9]+]] = arith.cmpf oge, %[[V_401]], %[[V_402]] : f32
+ ! CHECK: fir.if %[[V_403]] {
+ ! CHECK: %[[V_526:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_527:[0-9]+]] = fir.call @feraiseexcept(%[[V_526]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_405:[0-9]+]] = fir.call @_FortranAioOutputLogical(%[[V_378]], %[[V_404]]) fastmath<contract> : (!fir.ref<i8>, i1) -> i1
+ print*, ' [S]', x(i), 'ge', x(j), ieee_signaling_ge(x(i), x(j))
+
+ ! CHECK: %[[V_407:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ ! CHECK: fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_424:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_425:[0-9]+]] = fir.convert %[[V_424]] : (i32) -> i64
+ ! CHECK: %[[V_426:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_425]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_427:[0-9]+]] = fir.load %[[V_59]] : !fir.ref<i32>
+ ! CHECK: %[[V_428:[0-9]+]] = fir.convert %[[V_427]] : (i32) -> i64
+ ! CHECK: %[[V_429:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_428]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_430:[0-9]+]] = fir.load %[[V_426]] : !fir.ref<f32>
+ ! CHECK: %[[V_431:[0-9]+]] = fir.load %[[V_429]] : !fir.ref<f32>
+ ! CHECK: %[[V_432:[0-9]+]] = arith.cmpf uno, %[[V_430]], %[[V_431]] : f32
+ ! CHECK: %[[V_433:[0-9]+]] = arith.cmpf ogt, %[[V_430]], %[[V_431]] : f32
+ ! CHECK: fir.if %[[V_432]] {
+ ! CHECK: %[[V_526:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_527:[0-9]+]] = fir.call @feraiseexcept(%[[V_526]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_434:[0-9]+]] = fir.call @_FortranAioOutputLogical(%[[V_407]], %[[V_433]]) fastmath<contract> : (!fir.ref<i8>, i1) -> i1
+ print*, ' [S]', x(i), 'gt', x(j), ieee_signaling_gt(x(i), x(j))
+
+ ! CHECK: %[[V_436:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ ! CHECK: fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_453:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_454:[0-9]+]] = fir.convert %[[V_453]] : (i32) -> i64
+ ! CHECK: %[[V_455:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_454]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_456:[0-9]+]] = fir.load %[[V_59]] : !fir.ref<i32>
+ ! CHECK: %[[V_457:[0-9]+]] = fir.convert %[[V_456]] : (i32) -> i64
+ ! CHECK: %[[V_458:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_457]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_459:[0-9]+]] = fir.load %[[V_455]] : !fir.ref<f32>
+ ! CHECK: %[[V_460:[0-9]+]] = fir.load %[[V_458]] : !fir.ref<f32>
+ ! CHECK: %[[V_461:[0-9]+]] = arith.cmpf uno, %[[V_459]], %[[V_460]] : f32
+ ! CHECK: %[[V_462:[0-9]+]] = arith.cmpf ole, %[[V_459]], %[[V_460]] : f32
+ ! CHECK: fir.if %[[V_461]] {
+ ! CHECK: %[[V_526:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_527:[0-9]+]] = fir.call @feraiseexcept(%[[V_526]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_463:[0-9]+]] = fir.call @_FortranAioOutputLogical(%[[V_436]], %[[V_462]]) fastmath<contract> : (!fir.ref<i8>, i1) -> i1
+ print*, ' [S]', x(i), 'le', x(j), ieee_signaling_le(x(i), x(j))
+
+ ! CHECK: %[[V_465:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ ! CHECK: fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_482:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_483:[0-9]+]] = fir.convert %[[V_482]] : (i32) -> i64
+ ! CHECK: %[[V_484:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_483]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_485:[0-9]+]] = fir.load %[[V_59]] : !fir.ref<i32>
+ ! CHECK: %[[V_486:[0-9]+]] = fir.convert %[[V_485]] : (i32) -> i64
+ ! CHECK: %[[V_487:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_486]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_488:[0-9]+]] = fir.load %[[V_484]] : !fir.ref<f32>
+ ! CHECK: %[[V_489:[0-9]+]] = fir.load %[[V_487]] : !fir.ref<f32>
+ ! CHECK: %[[V_490:[0-9]+]] = arith.cmpf uno, %[[V_488]], %[[V_489]] : f32
+ ! CHECK: %[[V_491:[0-9]+]] = arith.cmpf olt, %[[V_488]], %[[V_489]] : f32
+ ! CHECK: fir.if %[[V_490]] {
+ ! CHECK: %[[V_526:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_527:[0-9]+]] = fir.call @feraiseexcept(%[[V_526]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_492:[0-9]+]] = fir.call @_FortranAioOutputLogical(%[[V_465]], %[[V_491]]) fastmath<contract> : (!fir.ref<i8>, i1) -> i1
+ print*, ' [S]', x(i), 'lt', x(j), ieee_signaling_lt(x(i), x(j))
+
+ ! CHECK: %[[V_494:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ ! CHECK: fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_511:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_512:[0-9]+]] = fir.convert %[[V_511]] : (i32) -> i64
+ ! CHECK: %[[V_513:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_512]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_514:[0-9]+]] = fir.load %[[V_59]] : !fir.ref<i32>
+ ! CHECK: %[[V_515:[0-9]+]] = fir.convert %[[V_514]] : (i32) -> i64
+ ! CHECK: %[[V_516:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_61]]) %[[V_515]] : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>, i64) -> !fir.ref<f32>
+ ! CHECK: %[[V_517:[0-9]+]] = fir.load %[[V_513]] : !fir.ref<f32>
+ ! CHECK: %[[V_518:[0-9]+]] = fir.load %[[V_516]] : !fir.ref<f32>
+ ! CHECK: %[[V_519:[0-9]+]] = arith.cmpf uno, %[[V_517]], %[[V_518]] : f32
+ ! CHECK: %[[V_520:[0-9]+]] = arith.cmpf une, %[[V_517]], %[[V_518]] : f32
+ ! CHECK: fir.if %[[V_519]] {
+ ! CHECK: %[[V_526:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_527:[0-9]+]] = fir.call @feraiseexcept(%[[V_526]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_521:[0-9]+]] = fir.call @_FortranAioOutputLogical(%[[V_494]], %[[V_520]]) fastmath<contract> : (!fir.ref<i8>, i1) -> i1
+ print*, ' [S]', x(i), 'ne', x(j), ieee_signaling_ne(x(i), x(j))
+ enddo
+ enddo
+end
diff --git a/flang/test/Lower/Intrinsics/ieee_femodes.f90 b/flang/test/Lower/Intrinsics/ieee_femodes.f90
new file mode 100644
index 000000000000000..75ff8291854df03
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/ieee_femodes.f90
@@ -0,0 +1,82 @@
+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+! CHECK-LABEL: c.func @_QQmain
+program m
+ use ieee_arithmetic
+ use ieee_exceptions
+
+ ! CHECK: %[[V_59:[0-9]+]] = fir.alloca !fir.type<_QM__fortran_ieee_exceptionsTieee_modes_type{_QM__fortran_ieee_exceptionsTieee_modes_type.__data:!fir.array<2xi32>}> {bindc_name = "modes", uniq_name = "_QFEmodes"}
+ ! CHECK: %[[V_60:[0-9]+]] = fir.declare %[[V_59]] {uniq_name = "_QFEmodes"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_modes_type{_QM__fortran_ieee_exceptionsTieee_modes_type.__data:!fir.array<2xi32>}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_modes_type{_QM__fortran_ieee_exceptionsTieee_modes_type.__data:!fir.array<2xi32>}>>
+ type(ieee_modes_type) :: modes
+
+ ! CHECK: %[[V_61:[0-9]+]] = fir.alloca !fir.type<_QMieee_arithmeticTieee_round_type{_QMieee_arithmeticTieee_round_type.mode:i8}> {bindc_name = "round", uniq_name = "_QFEround"}
+ ! CHECK: %[[V_62:[0-9]+]] = fir.declare %[[V_61]] {uniq_name = "_QFEround"} : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{_QMieee_arithmeticTieee_round_type.mode:i8}>>) -> !fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{_QMieee_arithmeticTieee_round_type.mode:i8}>>
+ type(ieee_round_type) :: round
+
+ ! CHECK: %[[V_68:[0-9]+]] = fir.address_of(@_QQro._QMieee_arithmeticTieee_round_type.0) : !fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{_QMieee_arithmeticTieee_round_type.mode:i8}>>
+ ! CHECK: %[[V_69:[0-9]+]] = fir.declare %[[V_68]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QMieee_arithmeticTieee_round_type.0"} : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{_QMieee_arithmeticTieee_round_type.mode:i8}>>) -> !fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{_QMieee_arithmeticTieee_round_type.mode:i8}>>
+
+ ! CHECK: %[[V_70:[0-9]+]] = fir.field_index _QMieee_arithmeticTieee_round_type.mode, !fir.type<_QMieee_arithmeticTieee_round_type{_QMieee_arithmeticTieee_round_type.mode:i8}>
+ ! CHECK: %[[V_71:[0-9]+]] = fir.coordinate_of %[[V_69]], %[[V_70]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{_QMieee_arithmeticTieee_round_type.mode:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_72:[0-9]+]] = fir.load %[[V_71]] : !fir.ref<i8>
+ ! CHECK: %[[V_73:[0-9]+]] = fir.convert %[[V_72]] : (i8) -> i32
+ ! CHECK: fir.call @llvm.set.rounding(%[[V_73]]) fastmath<contract> : (i32) -> ()
+ call ieee_set_rounding_mode(ieee_up)
+
+ ! CHECK: %[[V_74:[0-9]+]] = fir.coordinate_of %[[V_62]], %[[V_70]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{_QMieee_arithmeticTieee_round_type.mode:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_75:[0-9]+]] = fir.call @llvm.get.rounding() fastmath<contract> : () -> i32
+ ! CHECK: %[[V_76:[0-9]+]] = fir.convert %[[V_75]] : (i32) -> i8
+ ! CHECK: fir.store %[[V_76]] to %[[V_74]] : !fir.ref<i8>
+ call ieee_get_rounding_mode(round)
+
+ print*, 'rounding_mode [up ] : ', mode_name(round)
+
+ ! CHECK: %[[V_93:[0-9]+]] = fir.convert %[[V_60]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_modes_type{_QM__fortran_ieee_exceptionsTieee_modes_type.__data:!fir.array<2xi32>}>>) -> !fir.ref<i32>
+ ! CHECK: %[[V_94:[0-9]+]] = fir.call @fegetmode(%[[V_93]]) fastmath<contract> : (!fir.ref<i32>) -> i32
+ call ieee_get_modes(modes)
+
+ ! CHECK: %[[V_95:[0-9]+]] = fir.address_of(@_QQro._QMieee_arithmeticTieee_round_type.1) : !fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{_QMieee_arithmeticTieee_round_type.mode:i8}>>
+ ! CHECK: %[[V_96:[0-9]+]] = fir.declare %[[V_95]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QMieee_arithmeticTieee_round_type.1"} : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{_QMieee_arithmeticTieee_round_type.mode:i8}>>) -> !fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{_QMieee_arithmeticTieee_round_type.mode:i8}>>
+ ! CHECK: %[[V_97:[0-9]+]] = fir.coordinate_of %[[V_96]], %[[V_70]] : (!fir.ref<!fir.type<_QMieee_arithmeticTieee_round_type{_QMieee_arithmeticTieee_round_type.mode:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_98:[0-9]+]] = fir.load %[[V_97]] : !fir.ref<i8>
+ ! CHECK: %[[V_99:[0-9]+]] = fir.convert %[[V_98]] : (i8) -> i32
+ ! CHECK: fir.call @llvm.set.rounding(%[[V_99]]) fastmath<contract> : (i32) -> ()
+ call ieee_set_rounding_mode(ieee_to_zero)
+
+ ! CHECK: %[[V_100:[0-9]+]] = fir.call @llvm.get.rounding() fastmath<contract> : () -> i32
+ ! CHECK: %[[V_101:[0-9]+]] = fir.convert %[[V_100]] : (i32) -> i8
+ ! CHECK: fir.store %[[V_101]] to %[[V_74]] : !fir.ref<i8>
+ call ieee_get_rounding_mode(round)
+
+ print*, 'rounding_mode [to_zero] : ', mode_name(round)
+
+ ! CHECK: %[[V_116:[0-9]+]] = fir.call @fesetmode(%[[V_93]]) fastmath<contract> : (!fir.ref<i32>) -> i32
+ call ieee_set_modes(modes)
+
+ ! CHECK: %[[V_117:[0-9]+]] = fir.call @llvm.get.rounding() fastmath<contract> : () -> i32
+ ! CHECK: %[[V_118:[0-9]+]] = fir.convert %[[V_117]] : (i32) -> i8
+ ! CHECK: fir.store %[[V_118]] to %[[V_74]] : !fir.ref<i8>
+ call ieee_get_rounding_mode(round)
+
+ print*, 'rounding_mode [up ] : ', mode_name(round)
+
+contains
+ character(7) function mode_name(m)
+ type(ieee_round_type), intent(in) :: m
+ if (m == ieee_nearest) then
+ mode_name = 'nearest'
+ else if (m == ieee_to_zero) then
+ mode_name = 'to_zero'
+ else if (m == ieee_up) then
+ mode_name = 'up'
+ else if (m == ieee_down) then
+ mode_name = 'down'
+ else if (m == ieee_away) then
+ mode_name = 'away'
+ else if (m == ieee_other) then
+ mode_name = 'other'
+ else
+ mode_name = '???'
+ endif
+ end
+end
diff --git a/flang/test/Lower/Intrinsics/ieee_festatus.f90 b/flang/test/Lower/Intrinsics/ieee_festatus.f90
new file mode 100644
index 000000000000000..0fbaf2f4d00c7f6
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/ieee_festatus.f90
@@ -0,0 +1,120 @@
+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+! CHECK-LABEL: c.func @_QQmain
+program s
+ use ieee_arithmetic
+
+ ! CHECK: %[[V_0:[0-9]+]] = fir.address_of(@_QM__fortran_ieee_exceptionsECieee_all) : !fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: %[[V_1:[0-9]+]] = fir.shape %c5{{.*}} : (index) -> !fir.shape<1>
+ ! CHECK: %[[V_2:[0-9]+]] = fir.declare %[[V_0]](%[[V_1]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QM__fortran_ieee_exceptionsECieee_all"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: %[[V_53:[0-9]+]] = fir.address_of(@_QM__fortran_ieee_exceptionsECieee_usual) : !fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: %[[V_54:[0-9]+]] = fir.shape %c3{{.*}} : (index) -> !fir.shape<1>
+ ! CHECK: %[[V_55:[0-9]+]] = fir.declare %[[V_53]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QM__fortran_ieee_exceptionsECieee_usual"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ use ieee_exceptions
+
+ ! CHECK: %[[V_56:[0-9]+]] = fir.alloca !fir.type<_QM__fortran_ieee_exceptionsTieee_status_type{_QM__fortran_ieee_exceptionsTieee_status_type.__data:!fir.array<8xi32>}> {bindc_name = "status", uniq_name = "_QFEstatus"}
+ ! CHECK: %[[V_57:[0-9]+]] = fir.declare %[[V_56]] {uniq_name = "_QFEstatus"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_status_type{_QM__fortran_ieee_exceptionsTieee_status_type.__data:!fir.array<8xi32>}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_status_type{_QM__fortran_ieee_exceptionsTieee_status_type.__data:!fir.array<8xi32>}>>
+ type(ieee_status_type) :: status
+
+ ! CHECK: %[[V_58:[0-9]+]] = fir.alloca !fir.array<5x!fir.logical<4>> {bindc_name = "v", uniq_name = "_QFEv"}
+ ! CHECK: %[[V_59:[0-9]+]] = fir.declare %[[V_58]](%[[V_1]]) {uniq_name = "_QFEv"} : (!fir.ref<!fir.array<5x!fir.logical<4>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.logical<4>>>
+ logical :: v(size(ieee_all))
+
+ ! CHECK: %[[V_60:[0-9]+]] = fir.address_of(@_QQro.5x_QM__fortran_ieee_exceptionsTieee_flag_type.0) : !fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: %[[V_61:[0-9]+]] = fir.declare %[[V_60]](%[[V_1]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.5x_QM__fortran_ieee_exceptionsTieee_flag_type.0"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c5{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_95:[0-9]+]] = fir.array_coor %[[V_61]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_96:[0-9]+]] = fir.field_index _QM__fortran_ieee_exceptionsTieee_flag_type.flag, !fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>
+ ! CHECK: %[[V_97:[0-9]+]] = fir.coordinate_of %[[V_95]], %[[V_96]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_98:[0-9]+]] = fir.load %[[V_97]] : !fir.ref<i8>
+ ! CHECK: %[[V_99:[0-9]+]] = fir.convert %[[V_98]] : (i8) -> i32
+ ! CHECK: %[[V_100:[0-9]+]] = fir.call @_FortranAMapException(%[[V_99]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %true{{[_0-9]*}} {
+ ! CHECK: %[[V_101:[0-9]+]] = fir.call @feenableexcept(%[[V_100]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_101:[0-9]+]] = fir.call @fedisableexcept(%[[V_100]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: }
+ call ieee_set_halting_mode(ieee_all, .true.)
+
+ ! CHECK: %[[V_62:[0-9]+]] = fir.declare %[[V_60]](%[[V_1]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.5x_QM__fortran_ieee_exceptionsTieee_flag_type.0"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c5{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_95:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_96:[0-9]+]] = fir.array_coor %[[V_59]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_97:[0-9]+]] = fir.field_index _QM__fortran_ieee_exceptionsTieee_flag_type.flag, !fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>
+ ! CHECK: %[[V_98:[0-9]+]] = fir.coordinate_of %[[V_95]], %[[V_97]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_99:[0-9]+]] = fir.load %[[V_98]] : !fir.ref<i8>
+ ! CHECK: %[[V_100:[0-9]+]] = fir.call @fegetexcept() fastmath<contract> : () -> i32
+ ! CHECK: %[[V_101:[0-9]+]] = fir.convert %[[V_99]] : (i8) -> i32
+ ! CHECK: %[[V_102:[0-9]+]] = fir.call @_FortranAMapException(%[[V_101]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_103:[0-9]+]] = arith.andi %[[V_100]], %[[V_102]] : i32
+ ! CHECK: %[[V_104:[0-9]+]] = arith.cmpi ne, %[[V_103]], %c0{{.*}} : i32
+ ! CHECK: %[[V_105:[0-9]+]] = fir.convert %[[V_104]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_105]] to %[[V_96]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: }
+ call ieee_get_halting_mode(ieee_all, v)
+
+ print*, 'halting_mode [T T T T T] :', v
+
+ ! CHECK: %[[V_75:[0-9]+]] = fir.convert %[[V_57]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_status_type{_QM__fortran_ieee_exceptionsTieee_status_type.__data:!fir.array<8xi32>}>>) -> !fir.ref<i32>
+ ! CHECK: %[[V_76:[0-9]+]] = fir.call @fegetenv(%[[V_75]]) fastmath<contract> : (!fir.ref<i32>) -> i32
+ call ieee_get_status(status)
+
+ ! CHECK: %[[V_77:[0-9]+]] = fir.address_of(@_QQro.3x_QM__fortran_ieee_exceptionsTieee_flag_type.1) : !fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: %[[V_78:[0-9]+]] = fir.declare %[[V_77]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_ieee_exceptionsTieee_flag_type.1"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_95:[0-9]+]] = fir.array_coor %[[V_78]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_96:[0-9]+]] = fir.field_index _QM__fortran_ieee_exceptionsTieee_flag_type.flag, !fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>
+ ! CHECK: %[[V_97:[0-9]+]] = fir.coordinate_of %[[V_95]], %[[V_96]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_98:[0-9]+]] = fir.load %[[V_97]] : !fir.ref<i8>
+ ! CHECK: %[[V_99:[0-9]+]] = fir.convert %[[V_98]] : (i8) -> i32
+ ! CHECK: %[[V_100:[0-9]+]] = fir.call @_FortranAMapException(%[[V_99]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %false{{[_0-9]*}} {
+ ! CHECK: %[[V_101:[0-9]+]] = fir.call @feenableexcept(%[[V_100]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_101:[0-9]+]] = fir.call @fedisableexcept(%[[V_100]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: }
+ call ieee_set_halting_mode(ieee_usual, .false.)
+
+ ! CHECK: %[[V_79:[0-9]+]] = fir.declare %[[V_60]](%[[V_1]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.5x_QM__fortran_ieee_exceptionsTieee_flag_type.0"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c5{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_95:[0-9]+]] = fir.array_coor %[[V_79]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_96:[0-9]+]] = fir.array_coor %[[V_59]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_97:[0-9]+]] = fir.field_index _QM__fortran_ieee_exceptionsTieee_flag_type.flag, !fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>
+ ! CHECK: %[[V_98:[0-9]+]] = fir.coordinate_of %[[V_95]], %[[V_97]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_99:[0-9]+]] = fir.load %[[V_98]] : !fir.ref<i8>
+ ! CHECK: %[[V_100:[0-9]+]] = fir.call @fegetexcept() fastmath<contract> : () -> i32
+ ! CHECK: %[[V_101:[0-9]+]] = fir.convert %[[V_99]] : (i8) -> i32
+ ! CHECK: %[[V_102:[0-9]+]] = fir.call @_FortranAMapException(%[[V_101]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_103:[0-9]+]] = arith.andi %[[V_100]], %[[V_102]] : i32
+ ! CHECK: %[[V_104:[0-9]+]] = arith.cmpi ne, %[[V_103]], %c0{{.*}} : i32
+ ! CHECK: %[[V_105:[0-9]+]] = fir.convert %[[V_104]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_105]] to %[[V_96]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: }
+ call ieee_get_halting_mode(ieee_all, v)
+
+ print*, 'halting_mode [F F F T T] :', v
+
+ ! CHECK: %[[V_87:[0-9]+]] = fir.call @fesetenv(%[[V_75]]) fastmath<contract> : (!fir.ref<i32>) -> i32
+ ! CHECK: %[[V_88:[0-9]+]] = fir.declare %[[V_60]](%[[V_1]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.5x_QM__fortran_ieee_exceptionsTieee_flag_type.0"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ call ieee_set_status(status)
+
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c5{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_95:[0-9]+]] = fir.array_coor %[[V_88]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_96:[0-9]+]] = fir.array_coor %[[V_59]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_97:[0-9]+]] = fir.field_index _QM__fortran_ieee_exceptionsTieee_flag_type.flag, !fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>
+ ! CHECK: %[[V_98:[0-9]+]] = fir.coordinate_of %[[V_95]], %[[V_97]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_99:[0-9]+]] = fir.load %[[V_98]] : !fir.ref<i8>
+ ! CHECK: %[[V_100:[0-9]+]] = fir.call @fegetexcept() fastmath<contract> : () -> i32
+ ! CHECK: %[[V_101:[0-9]+]] = fir.convert %[[V_99]] : (i8) -> i32
+ ! CHECK: %[[V_102:[0-9]+]] = fir.call @_FortranAMapException(%[[V_101]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_103:[0-9]+]] = arith.andi %[[V_100]], %[[V_102]] : i32
+ ! CHECK: %[[V_104:[0-9]+]] = arith.cmpi ne, %[[V_103]], %c0{{.*}} : i32
+ ! CHECK: %[[V_105:[0-9]+]] = fir.convert %[[V_104]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_105]] to %[[V_96]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: }
+ call ieee_get_halting_mode(ieee_all, v)
+
+ print*, 'halting_mode [T T T T T] :', v
+end
diff --git a/flang/test/Lower/Intrinsics/ieee_flag.f90 b/flang/test/Lower/Intrinsics/ieee_flag.f90
new file mode 100644
index 000000000000000..7cd24c07ce9bd74
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/ieee_flag.f90
@@ -0,0 +1,524 @@
+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+! CHECK-LABEL: c.func @_QQmain
+
+ ! CHECK: %[[V_0:[0-9]+]] = fir.address_of(@_QM__fortran_ieee_exceptionsECieee_all) : !fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: %[[V_1:[0-9]+]] = fir.shape %c5{{.*}} : (index) -> !fir.shape<1>
+ ! CHECK: %[[V_2:[0-9]+]] = fir.declare %[[V_0]](%[[V_1]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QM__fortran_ieee_exceptionsECieee_all"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: %[[V_53:[0-9]+]] = fir.address_of(@_QM__fortran_ieee_exceptionsECieee_usual) : !fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: %[[V_54:[0-9]+]] = fir.shape %c3{{.*}} : (index) -> !fir.shape<1>
+ ! CHECK: %[[V_55:[0-9]+]] = fir.declare %[[V_53]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QM__fortran_ieee_exceptionsECieee_usual"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ use ieee_arithmetic
+
+ ! CHECK: %[[V_56:[0-9]+]] = fir.alloca !fir.logical<4> {bindc_name = "v", uniq_name = "_QFEv"}
+ ! CHECK: %[[V_57:[0-9]+]] = fir.declare %[[V_56]] {uniq_name = "_QFEv"} : (!fir.ref<!fir.logical<4>>) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_58:[0-9]+]] = fir.alloca !fir.array<2x!fir.logical<4>> {bindc_name = "v2", uniq_name = "_QFEv2"}
+ ! CHECK: %[[V_59:[0-9]+]] = fir.shape %c2{{.*}} : (index) -> !fir.shape<1>
+ ! CHECK: %[[V_60:[0-9]+]] = fir.declare %[[V_58]](%[[V_59]]) {uniq_name = "_QFEv2"} : (!fir.ref<!fir.array<2x!fir.logical<4>>>, !fir.shape<1>) -> !fir.ref<!fir.array<2x!fir.logical<4>>>
+ ! CHECK: %[[V_61:[0-9]+]] = fir.alloca !fir.array<5x!fir.logical<4>> {bindc_name = "v_all", uniq_name = "_QFEv_all"}
+ ! CHECK: %[[V_62:[0-9]+]] = fir.declare %[[V_61]](%[[V_1]]) {uniq_name = "_QFEv_all"} : (!fir.ref<!fir.array<5x!fir.logical<4>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.logical<4>>>
+ ! CHECK: %[[V_63:[0-9]+]] = fir.alloca !fir.array<3x!fir.logical<4>> {bindc_name = "v_usual", uniq_name = "_QFEv_usual"}
+ ! CHECK: %[[V_64:[0-9]+]] = fir.declare %[[V_63]](%[[V_54]]) {uniq_name = "_QFEv_usual"} : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.logical<4>>>
+ logical :: v, v2(2), v_usual(size(ieee_usual)), v_all(size(ieee_all))
+
+ ! CHECK: %[[V_67:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ print*, 'Flag'
+
+ ! CHECK: %[[V_74:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ ! CHECK: %[[V_80:[0-9]+]] = fir.address_of(@_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.0) : !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_81:[0-9]+]] = fir.declare %[[V_80]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.0"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_82:[0-9]+]] = fir.field_index _QM__fortran_ieee_exceptionsTieee_flag_type.flag, !fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>
+ ! CHECK: %[[V_83:[0-9]+]] = fir.coordinate_of %[[V_81]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_84:[0-9]+]] = fir.load %[[V_83]] : !fir.ref<i8>
+ ! CHECK: %[[V_85:[0-9]+]] = arith.andi %[[V_84]], %c61{{.*}} : i8
+ ! CHECK: %[[V_86:[0-9]+]] = arith.cmpi ne, %[[V_85]], %c0{{.*}} : i8
+ ! CHECK: %[[V_87:[0-9]+]] = fir.call @_FortranAioOutputLogical(%[[V_74]], %[[V_86]]) fastmath<contract> : (!fir.ref<i8>, i1) -> i1
+ ! CHECK: %[[V_88:[0-9]+]] = fir.declare %[[V_80]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.0"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_89:[0-9]+]] = fir.coordinate_of %[[V_88]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_90:[0-9]+]] = fir.load %[[V_89]] : !fir.ref<i8>
+ ! CHECK: %[[V_91:[0-9]+]] = arith.andi %[[V_90]], %c61{{.*}} : i8
+ ! CHECK: %[[V_92:[0-9]+]] = arith.cmpi ne, %[[V_91]], %c0{{.*}} : i8
+ ! CHECK: %[[V_93:[0-9]+]] = fir.call @_FortranAioOutputLogical(%[[V_74]], %[[V_92]]) fastmath<contract> : (!fir.ref<i8>, i1) -> i1
+ print*, 'support invalid: ', &
+ ieee_support_flag(ieee_invalid), ieee_support_flag(ieee_invalid, 0.)
+
+ ! CHECK: %[[V_95:[0-9]+]] = fir.declare %[[V_80]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.0"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_96:[0-9]+]] = fir.coordinate_of %[[V_95]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_97:[0-9]+]] = fir.load %[[V_96]] : !fir.ref<i8>
+ ! CHECK: %[[V_98:[0-9]+]] = fir.convert %[[V_97]] : (i8) -> i32
+ ! CHECK: %[[V_99:[0-9]+]] = fir.call @_FortranAMapException(%[[V_98]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %false{{[_0-9]*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.call @feraiseexcept(%[[V_99]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.call @feclearexcept(%[[V_99]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ call ieee_set_flag(ieee_invalid, .false.)
+
+ ! CHECK: %[[V_100:[0-9]+]] = fir.declare %[[V_80]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.0"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_101:[0-9]+]] = fir.coordinate_of %[[V_100]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_102:[0-9]+]] = fir.load %[[V_101]] : !fir.ref<i8>
+ ! CHECK: %[[V_103:[0-9]+]] = fir.convert %[[V_102]] : (i8) -> i32
+ ! CHECK: %[[V_104:[0-9]+]] = fir.call @_FortranAMapException(%[[V_103]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_105:[0-9]+]] = fir.call @fetestexcept(%[[V_104]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_106:[0-9]+]] = arith.cmpi ne, %[[V_105]], %c0{{.*}} : i32
+ ! CHECK: %[[V_107:[0-9]+]] = fir.convert %[[V_106]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_107]] to %[[V_57]] : !fir.ref<!fir.logical<4>>
+ call ieee_get_flag(ieee_invalid, v)
+
+ ! CHECK: %[[V_108:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ print*, 'invalid[F]: ', v
+
+ ! CHECK: %[[V_118:[0-9]+]] = fir.declare %[[V_80]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.0"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_119:[0-9]+]] = fir.coordinate_of %[[V_118]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_120:[0-9]+]] = fir.load %[[V_119]] : !fir.ref<i8>
+ ! CHECK: %[[V_121:[0-9]+]] = fir.convert %[[V_120]] : (i8) -> i32
+ ! CHECK: %[[V_122:[0-9]+]] = fir.call @_FortranAMapException(%[[V_121]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %true{{[_0-9]*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.call @feraiseexcept(%[[V_122]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.call @feclearexcept(%[[V_122]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ call ieee_set_flag(ieee_invalid, .true.)
+
+ ! CHECK: %[[V_123:[0-9]+]] = fir.declare %[[V_80]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.0"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_124:[0-9]+]] = fir.coordinate_of %[[V_123]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_125:[0-9]+]] = fir.load %[[V_124]] : !fir.ref<i8>
+ ! CHECK: %[[V_126:[0-9]+]] = fir.convert %[[V_125]] : (i8) -> i32
+ ! CHECK: %[[V_127:[0-9]+]] = fir.call @_FortranAMapException(%[[V_126]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_128:[0-9]+]] = fir.call @fetestexcept(%[[V_127]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_129:[0-9]+]] = arith.cmpi ne, %[[V_128]], %c0{{.*}} : i32
+ ! CHECK: %[[V_130:[0-9]+]] = fir.convert %[[V_129]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_130]] to %[[V_57]] : !fir.ref<!fir.logical<4>>
+ call ieee_get_flag(ieee_invalid, v)
+
+ ! CHECK: %[[V_131:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ print*, 'invalid[T]: ', v
+
+ ! CHECK: %[[V_140:[0-9]+]] = fir.address_of(@_QQro.2x_QM__fortran_ieee_exceptionsTieee_flag_type.1) : !fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: %[[V_141:[0-9]+]] = fir.declare %[[V_140]](%[[V_59]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.2x_QM__fortran_ieee_exceptionsTieee_flag_type.1"} : (!fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c2{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_141]](%[[V_59]]) %arg0 : (!fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<i8>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.convert %[[V_312]] : (i8) -> i32
+ ! CHECK: %[[V_314:[0-9]+]] = fir.call @_FortranAMapException(%[[V_313]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %false{{[_0-9]*}} {
+ ! CHECK: %[[V_315:[0-9]+]] = fir.call @feraiseexcept(%[[V_314]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_315:[0-9]+]] = fir.call @feclearexcept(%[[V_314]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: }
+ call ieee_set_flag([ieee_invalid, ieee_overflow], .false.)
+
+ ! CHECK: %[[V_142:[0-9]+]] = fir.address_of(@_QQro.2x_QM__fortran_ieee_exceptionsTieee_flag_type.2) : !fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: %[[V_143:[0-9]+]] = fir.declare %[[V_142]](%[[V_59]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.2x_QM__fortran_ieee_exceptionsTieee_flag_type.2"} : (!fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c2{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_143]](%[[V_59]]) %arg0 : (!fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_60]](%[[V_59]]) %arg0 : (!fir.ref<!fir.array<2x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
+ ! CHECK: %[[V_314:[0-9]+]] = fir.convert %[[V_313]] : (i8) -> i32
+ ! CHECK: %[[V_315:[0-9]+]] = fir.call @_FortranAMapException(%[[V_314]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_316:[0-9]+]] = fir.call @fetestexcept(%[[V_315]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_317:[0-9]+]] = arith.cmpi ne, %[[V_316]], %c0{{.*}} : i32
+ ! CHECK: %[[V_318:[0-9]+]] = fir.convert %[[V_317]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_318]] to %[[V_311]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: }
+ call ieee_get_flag([ieee_overflow, ieee_invalid], v2)
+
+ ! CHECK: %[[V_144:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ print*, '[overflow[F], invalid[F]]: ', v2
+
+ ! CHECK: %[[V_154:[0-9]+]] = fir.declare %[[V_140]](%[[V_59]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.2x_QM__fortran_ieee_exceptionsTieee_flag_type.1"} : (!fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: %[[V_155:[0-9]+]] = fir.address_of(@_QQro.2xl4.3) : !fir.ref<!fir.array<2x!fir.logical<4>>>
+ ! CHECK: %[[V_156:[0-9]+]] = fir.declare %[[V_155]](%[[V_59]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.2xl4.3"} : (!fir.ref<!fir.array<2x!fir.logical<4>>>, !fir.shape<1>) -> !fir.ref<!fir.array<2x!fir.logical<4>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c2{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_154]](%[[V_59]]) %arg0 : (!fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_156]](%[[V_59]]) %arg0 : (!fir.ref<!fir.array<2x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_314:[0-9]+]] = fir.load %[[V_313]] : !fir.ref<i8>
+ ! CHECK: %[[V_315:[0-9]+]] = fir.convert %[[V_314]] : (i8) -> i32
+ ! CHECK: %[[V_316:[0-9]+]] = fir.call @_FortranAMapException(%[[V_315]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_317:[0-9]+]] = fir.convert %[[V_312]] : (!fir.logical<4>) -> i1
+ ! CHECK: fir.if %[[V_317]] {
+ ! CHECK: %[[V_318:[0-9]+]] = fir.call @feraiseexcept(%[[V_316]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_318:[0-9]+]] = fir.call @feclearexcept(%[[V_316]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: }
+ call ieee_set_flag([ieee_invalid, ieee_overflow], [.false., .true.])
+
+ ! CHECK: %[[V_157:[0-9]+]] = fir.declare %[[V_142]](%[[V_59]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.2x_QM__fortran_ieee_exceptionsTieee_flag_type.2"} : (!fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c2{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_157]](%[[V_59]]) %arg0 : (!fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_60]](%[[V_59]]) %arg0 : (!fir.ref<!fir.array<2x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
+ ! CHECK: %[[V_314:[0-9]+]] = fir.convert %[[V_313]] : (i8) -> i32
+ ! CHECK: %[[V_315:[0-9]+]] = fir.call @_FortranAMapException(%[[V_314]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_316:[0-9]+]] = fir.call @fetestexcept(%[[V_315]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_317:[0-9]+]] = arith.cmpi ne, %[[V_316]], %c0{{.*}} : i32
+ ! CHECK: %[[V_318:[0-9]+]] = fir.convert %[[V_317]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_318]] to %[[V_311]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: }
+ call ieee_get_flag([ieee_overflow, ieee_invalid], v2)
+
+ ! CHECK: %[[V_158:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ print*, '[overflow[T], invalid[F]]: ', v2
+
+ ! CHECK: %[[V_165:[0-9]+]] = fir.address_of(@_QQro.3x_QM__fortran_ieee_exceptionsTieee_flag_type.4) : !fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: %[[V_166:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_ieee_exceptionsTieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_166]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<i8>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.convert %[[V_312]] : (i8) -> i32
+ ! CHECK: %[[V_314:[0-9]+]] = fir.call @_FortranAMapException(%[[V_313]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %true{{[_0-9]*}} {
+ ! CHECK: %[[V_315:[0-9]+]] = fir.call @feraiseexcept(%[[V_314]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_315:[0-9]+]] = fir.call @feclearexcept(%[[V_314]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: }
+ call ieee_set_flag(ieee_usual, .true.)
+
+ ! CHECK: %[[V_167:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_ieee_exceptionsTieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_167]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_64]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
+ ! CHECK: %[[V_314:[0-9]+]] = fir.convert %[[V_313]] : (i8) -> i32
+ ! CHECK: %[[V_315:[0-9]+]] = fir.call @_FortranAMapException(%[[V_314]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_316:[0-9]+]] = fir.call @fetestexcept(%[[V_315]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_317:[0-9]+]] = arith.cmpi ne, %[[V_316]], %c0{{.*}} : i32
+ ! CHECK: %[[V_318:[0-9]+]] = fir.convert %[[V_317]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_318]] to %[[V_311]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: }
+ call ieee_get_flag(ieee_usual, v_usual)
+
+ ! CHECK: %[[V_168:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ print*, '[overflow[T], divide_by_zero[T], invalid[T]]: ', v_usual
+
+ ! CHECK: %[[V_178:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_ieee_exceptionsTieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: %[[V_179:[0-9]+]] = fir.address_of(@_QQro.3xl4.5) : !fir.ref<!fir.array<3x!fir.logical<4>>>
+ ! CHECK: %[[V_180:[0-9]+]] = fir.declare %[[V_179]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3xl4.5"} : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.logical<4>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_178]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_180]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_314:[0-9]+]] = fir.load %[[V_313]] : !fir.ref<i8>
+ ! CHECK: %[[V_315:[0-9]+]] = fir.convert %[[V_314]] : (i8) -> i32
+ ! CHECK: %[[V_316:[0-9]+]] = fir.call @_FortranAMapException(%[[V_315]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_317:[0-9]+]] = fir.convert %[[V_312]] : (!fir.logical<4>) -> i1
+ ! CHECK: fir.if %[[V_317]] {
+ ! CHECK: %[[V_318:[0-9]+]] = fir.call @feraiseexcept(%[[V_316]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_318:[0-9]+]] = fir.call @feclearexcept(%[[V_316]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: }
+ call ieee_set_flag(ieee_usual, [.true., .false., .true.])
+
+ ! CHECK: %[[V_181:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_ieee_exceptionsTieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_181]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_64]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
+ ! CHECK: %[[V_314:[0-9]+]] = fir.convert %[[V_313]] : (i8) -> i32
+ ! CHECK: %[[V_315:[0-9]+]] = fir.call @_FortranAMapException(%[[V_314]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_316:[0-9]+]] = fir.call @fetestexcept(%[[V_315]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_317:[0-9]+]] = arith.cmpi ne, %[[V_316]], %c0{{.*}} : i32
+ ! CHECK: %[[V_318:[0-9]+]] = fir.convert %[[V_317]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_318]] to %[[V_311]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: }
+ call ieee_get_flag(ieee_usual, v_usual)
+
+ ! CHECK: %[[V_182:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ print*, '[overflow[T], divide_by_zero[F], invalid[T]]: ', v_usual
+
+ ! CHECK: %[[V_189:[0-9]+]] = fir.address_of(@_QQro.5x_QM__fortran_ieee_exceptionsTieee_flag_type.6) : !fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: %[[V_190:[0-9]+]] = fir.declare %[[V_189]](%[[V_1]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.5x_QM__fortran_ieee_exceptionsTieee_flag_type.6"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c5{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_190]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<i8>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.convert %[[V_312]] : (i8) -> i32
+ ! CHECK: %[[V_314:[0-9]+]] = fir.call @_FortranAMapException(%[[V_313]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %false{{[_0-9]*}} {
+ ! CHECK: %[[V_315:[0-9]+]] = fir.call @feraiseexcept(%[[V_314]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_315:[0-9]+]] = fir.call @feclearexcept(%[[V_314]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: }
+ call ieee_set_flag(ieee_all, .false.)
+
+ ! CHECK: %[[V_191:[0-9]+]] = fir.declare %[[V_189]](%[[V_1]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.5x_QM__fortran_ieee_exceptionsTieee_flag_type.6"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c5{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_191]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
+ ! CHECK: %[[V_314:[0-9]+]] = fir.convert %[[V_313]] : (i8) -> i32
+ ! CHECK: %[[V_315:[0-9]+]] = fir.call @_FortranAMapException(%[[V_314]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_316:[0-9]+]] = fir.call @fetestexcept(%[[V_315]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_317:[0-9]+]] = arith.cmpi ne, %[[V_316]], %c0{{.*}} : i32
+ ! CHECK: %[[V_318:[0-9]+]] = fir.convert %[[V_317]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_318]] to %[[V_311]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: }
+ call ieee_get_flag(ieee_all, v_all)
+
+ ! CHECK: %[[V_192:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ print*, 'all[F]: ', v_all
+
+ ! CHECK: %[[V_202:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ print*
+
+ ! CHECK: %[[V_204:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ print*, 'Halting'
+
+ ! CHECK: %[[V_211:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ ! CHECK: %[[V_215:[0-9]+]] = fir.declare %[[V_80]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.0"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_216:[0-9]+]] = fir.coordinate_of %[[V_215]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_217:[0-9]+]] = fir.load %[[V_216]] : !fir.ref<i8>
+ ! CHECK: %[[V_218:[0-9]+]] = arith.andi %[[V_217]], %c61{{.*}} : i8
+ ! CHECK: %[[V_219:[0-9]+]] = arith.cmpi ne, %[[V_218]], %c0{{.*}} : i8
+ ! CHECK: %[[V_220:[0-9]+]] = fir.call @_FortranAioOutputLogical(%[[V_211]], %[[V_219]]) fastmath<contract> : (!fir.ref<i8>, i1) -> i1
+ print*, 'support invalid: ', ieee_support_halting(ieee_invalid)
+
+ ! CHECK: %[[V_222:[0-9]+]] = fir.declare %[[V_80]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.0"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_223:[0-9]+]] = fir.coordinate_of %[[V_222]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_224:[0-9]+]] = fir.load %[[V_223]] : !fir.ref<i8>
+ ! CHECK: %[[V_225:[0-9]+]] = fir.convert %[[V_224]] : (i8) -> i32
+ ! CHECK: %[[V_226:[0-9]+]] = fir.call @_FortranAMapException(%[[V_225]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %false{{[_0-9]*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.call @feenableexcept(%[[V_226]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.call @fedisableexcept(%[[V_226]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ call ieee_set_halting_mode(ieee_invalid, .false.)
+
+ ! CHECK: %[[V_227:[0-9]+]] = fir.declare %[[V_80]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.0"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_228:[0-9]+]] = fir.coordinate_of %[[V_227]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_229:[0-9]+]] = fir.load %[[V_228]] : !fir.ref<i8>
+ ! CHECK: %[[V_230:[0-9]+]] = fir.call @fegetexcept() fastmath<contract> : () -> i32
+ ! CHECK: %[[V_231:[0-9]+]] = fir.convert %[[V_229]] : (i8) -> i32
+ ! CHECK: %[[V_232:[0-9]+]] = fir.call @_FortranAMapException(%[[V_231]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_233:[0-9]+]] = arith.andi %[[V_230]], %[[V_232]] : i32
+ ! CHECK: %[[V_234:[0-9]+]] = arith.cmpi ne, %[[V_233]], %c0{{.*}} : i32
+ ! CHECK: %[[V_235:[0-9]+]] = fir.convert %[[V_234]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_235]] to %[[V_57]] : !fir.ref<!fir.logical<4>>
+ call ieee_get_halting_mode(ieee_invalid, v)
+
+ ! CHECK: %[[V_236:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ print*, 'invalid[F]: ', v
+
+ ! CHECK: %[[V_244:[0-9]+]] = fir.declare %[[V_80]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.0"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_245:[0-9]+]] = fir.coordinate_of %[[V_244]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_246:[0-9]+]] = fir.load %[[V_245]] : !fir.ref<i8>
+ ! CHECK: %[[V_247:[0-9]+]] = fir.convert %[[V_246]] : (i8) -> i32
+ ! CHECK: %[[V_248:[0-9]+]] = fir.call @_FortranAMapException(%[[V_247]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %true{{[_0-9]*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.call @feenableexcept(%[[V_248]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.call @fedisableexcept(%[[V_248]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ call ieee_set_halting_mode(ieee_invalid, .true.)
+
+ ! CHECK: %[[V_249:[0-9]+]] = fir.declare %[[V_80]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.0"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_250:[0-9]+]] = fir.coordinate_of %[[V_249]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_251:[0-9]+]] = fir.load %[[V_250]] : !fir.ref<i8>
+ ! CHECK: %[[V_252:[0-9]+]] = fir.call @fegetexcept() fastmath<contract> : () -> i32
+ ! CHECK: %[[V_253:[0-9]+]] = fir.convert %[[V_251]] : (i8) -> i32
+ ! CHECK: %[[V_254:[0-9]+]] = fir.call @_FortranAMapException(%[[V_253]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_255:[0-9]+]] = arith.andi %[[V_252]], %[[V_254]] : i32
+ ! CHECK: %[[V_256:[0-9]+]] = arith.cmpi ne, %[[V_255]], %c0{{.*}} : i32
+ ! CHECK: %[[V_257:[0-9]+]] = fir.convert %[[V_256]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_257]] to %[[V_57]] : !fir.ref<!fir.logical<4>>
+ call ieee_get_halting_mode(ieee_invalid, v)
+
+ ! CHECK: %[[V_258:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ print*, 'invalid[T]: ', v
+
+ ! CHECK: %[[V_266:[0-9]+]] = fir.declare %[[V_140]](%[[V_59]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.2x_QM__fortran_ieee_exceptionsTieee_flag_type.1"} : (!fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c2{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_266]](%[[V_59]]) %arg0 : (!fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<i8>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.convert %[[V_312]] : (i8) -> i32
+ ! CHECK: %[[V_314:[0-9]+]] = fir.call @_FortranAMapException(%[[V_313]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %false{{[_0-9]*}} {
+ ! CHECK: %[[V_315:[0-9]+]] = fir.call @feenableexcept(%[[V_314]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_315:[0-9]+]] = fir.call @fedisableexcept(%[[V_314]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: }
+ call ieee_set_halting_mode([ieee_invalid, ieee_overflow], .false.)
+
+ ! CHECK: %[[V_267:[0-9]+]] = fir.declare %[[V_142]](%[[V_59]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.2x_QM__fortran_ieee_exceptionsTieee_flag_type.2"} : (!fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c2{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_267]](%[[V_59]]) %arg0 : (!fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_60]](%[[V_59]]) %arg0 : (!fir.ref<!fir.array<2x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
+ ! CHECK: %[[V_314:[0-9]+]] = fir.call @fegetexcept() fastmath<contract> : () -> i32
+ ! CHECK: %[[V_315:[0-9]+]] = fir.convert %[[V_313]] : (i8) -> i32
+ ! CHECK: %[[V_316:[0-9]+]] = fir.call @_FortranAMapException(%[[V_315]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_317:[0-9]+]] = arith.andi %[[V_314]], %[[V_316]] : i32
+ ! CHECK: %[[V_318:[0-9]+]] = arith.cmpi ne, %[[V_317]], %c0{{.*}} : i32
+ ! CHECK: %[[V_319:[0-9]+]] = fir.convert %[[V_318]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_319]] to %[[V_311]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: }
+ call ieee_get_halting_mode([ieee_overflow, ieee_invalid], v2)
+
+ ! CHECK: %[[V_268:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ print*, '[overflow[F], invalid[F]]: ', v2
+
+ ! CHECK: %[[V_274:[0-9]+]] = fir.declare %[[V_140]](%[[V_59]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.2x_QM__fortran_ieee_exceptionsTieee_flag_type.1"} : (!fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: %[[V_275:[0-9]+]] = fir.declare %[[V_155]](%[[V_59]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.2xl4.3"} : (!fir.ref<!fir.array<2x!fir.logical<4>>>, !fir.shape<1>) -> !fir.ref<!fir.array<2x!fir.logical<4>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c2{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_274]](%[[V_59]]) %arg0 : (!fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_275]](%[[V_59]]) %arg0 : (!fir.ref<!fir.array<2x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_314:[0-9]+]] = fir.load %[[V_313]] : !fir.ref<i8>
+ ! CHECK: %[[V_315:[0-9]+]] = fir.convert %[[V_314]] : (i8) -> i32
+ ! CHECK: %[[V_316:[0-9]+]] = fir.call @_FortranAMapException(%[[V_315]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_317:[0-9]+]] = fir.convert %[[V_312]] : (!fir.logical<4>) -> i1
+ ! CHECK: fir.if %[[V_317]] {
+ ! CHECK: %[[V_318:[0-9]+]] = fir.call @feenableexcept(%[[V_316]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_318:[0-9]+]] = fir.call @fedisableexcept(%[[V_316]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: }
+ call ieee_set_halting_mode([ieee_invalid, ieee_overflow], [.false., .true.])
+
+ ! CHECK: %[[V_276:[0-9]+]] = fir.declare %[[V_142]](%[[V_59]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.2x_QM__fortran_ieee_exceptionsTieee_flag_type.2"} : (!fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c2{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_276]](%[[V_59]]) %arg0 : (!fir.ref<!fir.array<2x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_60]](%[[V_59]]) %arg0 : (!fir.ref<!fir.array<2x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
+ ! CHECK: %[[V_314:[0-9]+]] = fir.call @fegetexcept() fastmath<contract> : () -> i32
+ ! CHECK: %[[V_315:[0-9]+]] = fir.convert %[[V_313]] : (i8) -> i32
+ ! CHECK: %[[V_316:[0-9]+]] = fir.call @_FortranAMapException(%[[V_315]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_317:[0-9]+]] = arith.andi %[[V_314]], %[[V_316]] : i32
+ ! CHECK: %[[V_318:[0-9]+]] = arith.cmpi ne, %[[V_317]], %c0{{.*}} : i32
+ ! CHECK: %[[V_319:[0-9]+]] = fir.convert %[[V_318]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_319]] to %[[V_311]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: }
+ call ieee_get_halting_mode([ieee_overflow, ieee_invalid], v2)
+
+ ! CHECK: %[[V_277:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ print*, '[overflow[T], invalid[F]]: ', v2
+
+ ! CHECK: %[[V_283:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_ieee_exceptionsTieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_283]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<i8>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.convert %[[V_312]] : (i8) -> i32
+ ! CHECK: %[[V_314:[0-9]+]] = fir.call @_FortranAMapException(%[[V_313]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %true{{[_0-9]*}} {
+ ! CHECK: %[[V_315:[0-9]+]] = fir.call @feenableexcept(%[[V_314]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_315:[0-9]+]] = fir.call @fedisableexcept(%[[V_314]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: }
+ call ieee_set_halting_mode(ieee_usual, .true.)
+
+ ! CHECK: %[[V_284:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_ieee_exceptionsTieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_284]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_64]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
+ ! CHECK: %[[V_314:[0-9]+]] = fir.call @fegetexcept() fastmath<contract> : () -> i32
+ ! CHECK: %[[V_315:[0-9]+]] = fir.convert %[[V_313]] : (i8) -> i32
+ ! CHECK: %[[V_316:[0-9]+]] = fir.call @_FortranAMapException(%[[V_315]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_317:[0-9]+]] = arith.andi %[[V_314]], %[[V_316]] : i32
+ ! CHECK: %[[V_318:[0-9]+]] = arith.cmpi ne, %[[V_317]], %c0{{.*}} : i32
+ ! CHECK: %[[V_319:[0-9]+]] = fir.convert %[[V_318]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_319]] to %[[V_311]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: }
+ call ieee_get_halting_mode(ieee_usual, v_usual)
+
+ ! CHECK: %[[V_285:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ print*, '[overflow[T], divide_by_zero[T], invalid[T]]: ', v_usual
+
+ ! CHECK: %[[V_291:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_ieee_exceptionsTieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: %[[V_292:[0-9]+]] = fir.declare %[[V_179]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3xl4.5"} : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.logical<4>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_291]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_292]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_314:[0-9]+]] = fir.load %[[V_313]] : !fir.ref<i8>
+ ! CHECK: %[[V_315:[0-9]+]] = fir.convert %[[V_314]] : (i8) -> i32
+ ! CHECK: %[[V_316:[0-9]+]] = fir.call @_FortranAMapException(%[[V_315]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_317:[0-9]+]] = fir.convert %[[V_312]] : (!fir.logical<4>) -> i1
+ ! CHECK: fir.if %[[V_317]] {
+ ! CHECK: %[[V_318:[0-9]+]] = fir.call @feenableexcept(%[[V_316]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_318:[0-9]+]] = fir.call @fedisableexcept(%[[V_316]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: }
+ call ieee_set_halting_mode(ieee_usual, [.true., .false., .true.])
+
+ ! CHECK: %[[V_293:[0-9]+]] = fir.declare %[[V_165]](%[[V_54]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x_QM__fortran_ieee_exceptionsTieee_flag_type.4"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c3{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_293]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_64]](%[[V_54]]) %arg0 : (!fir.ref<!fir.array<3x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
+ ! CHECK: %[[V_314:[0-9]+]] = fir.call @fegetexcept() fastmath<contract> : () -> i32
+ ! CHECK: %[[V_315:[0-9]+]] = fir.convert %[[V_313]] : (i8) -> i32
+ ! CHECK: %[[V_316:[0-9]+]] = fir.call @_FortranAMapException(%[[V_315]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_317:[0-9]+]] = arith.andi %[[V_314]], %[[V_316]] : i32
+ ! CHECK: %[[V_318:[0-9]+]] = arith.cmpi ne, %[[V_317]], %c0{{.*}} : i32
+ ! CHECK: %[[V_319:[0-9]+]] = fir.convert %[[V_318]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_319]] to %[[V_311]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: }
+ call ieee_get_halting_mode(ieee_usual, v_usual)
+
+ ! CHECK: %[[V_294:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ print*, '[overflow[T], divide_by_zero[F], invalid[T]]: ', v_usual
+
+ ! CHECK: %[[V_300:[0-9]+]] = fir.declare %[[V_189]](%[[V_1]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.5x_QM__fortran_ieee_exceptionsTieee_flag_type.6"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c5{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_300]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.load %[[V_311]] : !fir.ref<i8>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.convert %[[V_312]] : (i8) -> i32
+ ! CHECK: %[[V_314:[0-9]+]] = fir.call @_FortranAMapException(%[[V_313]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %true{{[_0-9]*}} {
+ ! CHECK: %[[V_315:[0-9]+]] = fir.call @feenableexcept(%[[V_314]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_315:[0-9]+]] = fir.call @fedisableexcept(%[[V_314]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: }
+ call ieee_set_halting_mode(ieee_all, .true.)
+
+ ! CHECK: %[[V_301:[0-9]+]] = fir.declare %[[V_189]](%[[V_1]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.5x_QM__fortran_ieee_exceptionsTieee_flag_type.6"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>
+ ! CHECK: fir.do_loop %arg0 = %c1{{.*}} to %c5{{.*}} step %c1{{.*}} {
+ ! CHECK: %[[V_310:[0-9]+]] = fir.array_coor %[[V_301]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_311:[0-9]+]] = fir.array_coor %[[V_62]](%[[V_1]]) %arg0 : (!fir.ref<!fir.array<5x!fir.logical<4>>>, !fir.shape<1>, index) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_312:[0-9]+]] = fir.coordinate_of %[[V_310]], %[[V_82]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_313:[0-9]+]] = fir.load %[[V_312]] : !fir.ref<i8>
+ ! CHECK: %[[V_314:[0-9]+]] = fir.call @fegetexcept() fastmath<contract> : () -> i32
+ ! CHECK: %[[V_315:[0-9]+]] = fir.convert %[[V_313]] : (i8) -> i32
+ ! CHECK: %[[V_316:[0-9]+]] = fir.call @_FortranAMapException(%[[V_315]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_317:[0-9]+]] = arith.andi %[[V_314]], %[[V_316]] : i32
+ ! CHECK: %[[V_318:[0-9]+]] = arith.cmpi ne, %[[V_317]], %c0{{.*}} : i32
+ ! CHECK: %[[V_319:[0-9]+]] = fir.convert %[[V_318]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_319]] to %[[V_311]] : !fir.ref<!fir.logical<4>>
+ ! CHECK: }
+ call ieee_get_halting_mode(ieee_all, v_all)
+
+ ! CHECK: %[[V_302:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
+ print*, 'all[T]: ', v_all
+
+ stop
+ end
diff --git a/flang/test/Lower/Intrinsics/ieee_logb.f90 b/flang/test/Lower/Intrinsics/ieee_logb.f90
new file mode 100644
index 000000000000000..bbbdfbdc3a8e673
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/ieee_logb.f90
@@ -0,0 +1,118 @@
+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+! CHECK-LABEL: c.func @_QPout
+subroutine out(x)
+ use ieee_arithmetic
+ integer, parameter :: k = 8
+
+ ! CHECK: %[[V_60:[0-9]+]] = fir.alloca !fir.logical<4> {bindc_name = "l", uniq_name = "_QFoutEl"}
+ ! CHECK: %[[V_61:[0-9]+]] = fir.declare %[[V_60]] {uniq_name = "_QFoutEl"} : (!fir.ref<!fir.logical<4>>) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_62:[0-9]+]] = fir.alloca f64 {bindc_name = "r", uniq_name = "_QFoutEr"}
+ ! CHECK: %[[V_63:[0-9]+]] = fir.declare %[[V_62]] {uniq_name = "_QFoutEr"} : (!fir.ref<f64>) -> !fir.ref<f64>
+ ! CHECK: %[[V_64:[0-9]+]] = fir.declare %arg0 {uniq_name = "_QFoutEx"} : (!fir.ref<f64>) -> !fir.ref<f64>
+ real(k) :: x, r
+ logical :: L
+
+ ! CHECK: %[[V_65:[0-9]+]] = fir.address_of(@_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.0) : !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_66:[0-9]+]] = fir.declare %[[V_65]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.0"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_67:[0-9]+]] = fir.field_index _QM__fortran_ieee_exceptionsTieee_flag_type.flag, !fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>
+ ! CHECK: %[[V_68:[0-9]+]] = fir.coordinate_of %[[V_66]], %[[V_67]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_69:[0-9]+]] = fir.load %[[V_68]] : !fir.ref<i8>
+ ! CHECK: %[[V_70:[0-9]+]] = fir.convert %[[V_69]] : (i8) -> i32
+ ! CHECK: %[[V_71:[0-9]+]] = fir.call @_FortranAMapException(%[[V_70]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %false{{[_0-9]*}} {
+ ! CHECK: %[[V_101:[0-9]+]] = fir.call @feraiseexcept(%[[V_71]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_101:[0-9]+]] = fir.call @feclearexcept(%[[V_71]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ call ieee_set_flag(ieee_divide_by_zero, .false.)
+
+ ! CHECK: %[[V_72:[0-9]+]] = fir.load %[[V_64]] : !fir.ref<f64>
+ ! CHECK: %[[V_73:[0-9]+]] = arith.bitcast %[[V_72]] : f64 to i64
+ ! CHECK: %[[V_74:[0-9]+]] = arith.cmpf oeq, %[[V_72]], %cst{{[_0-9]*}} : f64
+ ! CHECK: %[[V_75:[0-9]+]] = fir.if %[[V_74]] -> (f64) {
+ ! CHECK: %[[V_101:[0-9]+]] = fir.call @_FortranAMapException(%c4{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_102:[0-9]+]] = fir.call @feraiseexcept(%[[V_101]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.result %cst{{[_0-9]*}} : f64
+ ! CHECK: } else {
+ ! CHECK: %[[V_101:[0-9]+]] = arith.shli %[[V_73]], %c1{{.*}} : i64
+ ! CHECK: %[[V_102:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_72]]) <{bit = 504 : i32}> : (f64) -> i1
+ ! CHECK: %[[V_103:[0-9]+]] = fir.if %[[V_102]] -> (f64) {
+ ! CHECK: %[[V_104:[0-9]+]] = arith.shrui %[[V_101]], %c53{{.*}} : i64
+ ! CHECK: %[[V_105:[0-9]+]] = arith.subi %[[V_104]], %c1023{{.*}} : i64
+ ! CHECK: %[[V_106:[0-9]+]] = fir.convert %[[V_105]] : (i64) -> f64
+ ! CHECK: fir.result %[[V_106]] : f64
+ ! CHECK: } else {
+ ! CHECK: %[[V_104:[0-9]+]] = arith.shrui %[[V_101]], %c1{{.*}} : i64
+ ! CHECK: %[[V_105:[0-9]+]] = arith.bitcast %[[V_104]] : i64 to f64
+ ! CHECK: fir.result %[[V_105]] : f64
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_103]] : f64
+ ! CHECK: }
+ ! CHECK: fir.store %[[V_75]] to %[[V_63]] : !fir.ref<f64>
+ r = ieee_logb(x)
+
+ ! CHECK: %[[V_76:[0-9]+]] = fir.declare %[[V_65]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.0"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_77:[0-9]+]] = fir.coordinate_of %[[V_76]], %[[V_67]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_78:[0-9]+]] = fir.load %[[V_77]] : !fir.ref<i8>
+ ! CHECK: %[[V_79:[0-9]+]] = fir.convert %[[V_78]] : (i8) -> i32
+ ! CHECK: %[[V_80:[0-9]+]] = fir.call @_FortranAMapException(%[[V_79]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_81:[0-9]+]] = fir.call @fetestexcept(%[[V_80]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_82:[0-9]+]] = arith.cmpi ne, %[[V_81]], %c0{{.*}} : i32
+ ! CHECK: %[[V_83:[0-9]+]] = fir.convert %[[V_82]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_83]] to %[[V_61]] : !fir.ref<!fir.logical<4>>
+ call ieee_get_flag(ieee_divide_by_zero, L)
+
+ 8 format (' kind=8 ', f12.2, z18.16, f9.1, l3, ' ')
+ write(*, 8) x, x, r, L
+end
+
+ use ieee_arithmetic
+ integer, parameter :: k = 8
+ real(k) :: x, r
+
+ call out(ieee_value(x, ieee_signaling_nan))
+ call out(ieee_value(x, ieee_quiet_nan))
+ call out(ieee_value(x, ieee_negative_inf))
+ call out( -huge(x))
+ call out( -huge(x)/2)
+ call out(-sqrt(huge(x)))
+ call out(-2000.0_k)
+ call out( -9.9_k)
+ call out( -9.0_k)
+ call out( -8.0_k)
+ call out( -7.0_k)
+ call out( -6.0_k)
+ call out( -5.0_k)
+ call out( -4.0_k)
+ call out( -3.9_k)
+ call out( -3.0_k)
+ call out( -2.0_k)
+ call out( -1.1_k)
+ call out(ieee_value(x, ieee_negative_normal))
+ call out( -.0001_k)
+ call out( -tiny(x))
+ call out(ieee_value(x, ieee_negative_subnormal))
+ call out(ieee_value(x, ieee_negative_zero))
+ call out(ieee_value(x, ieee_positive_zero))
+ call out(ieee_value(x, ieee_positive_subnormal))
+ call out(tiny(x))
+ call out(.0001_k)
+ call out(ieee_value(x, ieee_positive_normal))
+ call out( 1.1_k)
+ call out( 2.0_k)
+ call out( 3.0_k)
+ call out( 3.9_k)
+ call out( 4.0_k)
+ call out( 5.0_k)
+ call out( 6.0_k)
+ call out( 7.0_k)
+ call out( 8.0_k)
+ call out( 9.0_k)
+ call out( 9.9_k)
+ call out(2000.0_k)
+ call out( sqrt(huge(x)))
+ call out( huge(x)/2)
+ call out( huge(x))
+ call out(ieee_value(x, ieee_positive_inf))
+end
diff --git a/flang/test/Lower/Intrinsics/ieee_max_min.f90 b/flang/test/Lower/Intrinsics/ieee_max_min.f90
new file mode 100644
index 000000000000000..a4eff01d6ce9da2
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/ieee_max_min.f90
@@ -0,0 +1,553 @@
+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+function tag(x)
+ use ieee_arithmetic
+ character(12) :: tag
+ real(4) :: x
+ tag = '?????'
+ if (ieee_class(x) == ieee_signaling_nan ) tag = 'snan'
+ if (ieee_class(x) == ieee_quiet_nan ) tag = 'qnan'
+ if (ieee_class(x) == ieee_negative_inf ) tag = 'neg_inf'
+ if (ieee_class(x) == ieee_negative_normal ) tag = 'neg_norm'
+ if (ieee_class(x) == ieee_negative_denormal) tag = 'neg_denorm'
+ if (ieee_class(x) == ieee_negative_zero ) tag = 'neg_zero'
+ if (ieee_class(x) == ieee_positive_zero ) tag = 'pos_zero'
+ if (ieee_class(x) == ieee_positive_denormal) tag = 'pos_denorm'
+ if (ieee_class(x) == ieee_positive_normal ) tag = 'pos_norm'
+ if (ieee_class(x) == ieee_positive_inf ) tag = 'pos_inf'
+end
+
+! CHECK-LABEL: c.func @_QQmain
+program p
+ use ieee_arithmetic
+ character(12) :: tag
+
+ ! CHECK: %[[V_16:[0-9]+]] = fir.alloca f32 {bindc_name = "a", uniq_name = "_QFEa"}
+ ! CHECK: %[[V_17:[0-9]+]] = fir.declare %[[V_16]] {uniq_name = "_QFEa"} : (!fir.ref<f32>) -> !fir.ref<f32>
+ ! CHECK: %[[V_18:[0-9]+]] = fir.alloca f32 {bindc_name = "b", uniq_name = "_QFEb"}
+ ! CHECK: %[[V_19:[0-9]+]] = fir.declare %[[V_18]] {uniq_name = "_QFEb"} : (!fir.ref<f32>) -> !fir.ref<f32>
+ ! CHECK: %[[V_20:[0-9]+]] = fir.alloca !fir.logical<4> {bindc_name = "flag_value", uniq_name = "_QFEflag_value"}
+ ! CHECK: %[[V_21:[0-9]+]] = fir.declare %[[V_20]] {uniq_name = "_QFEflag_value"} : (!fir.ref<!fir.logical<4>>) -> !fir.ref<!fir.logical<4>>
+ ! CHECK: %[[V_82:[0-9]+]] = fir.alloca f32 {bindc_name = "r", uniq_name = "_QFEr"}
+ ! CHECK: %[[V_83:[0-9]+]] = fir.declare %[[V_82]] {uniq_name = "_QFEr"} : (!fir.ref<f32>) -> !fir.ref<f32>
+ logical :: flag_value
+ real(4) :: x(22), a, b, r
+
+ ! CHECK: %[[V_92:[0-9]+]] = fir.address_of(@_FortranAIeeeValueTable_4) : !fir.ref<!fir.array<12xi32>>
+
+ x( 1) = ieee_value(a, ieee_signaling_nan)
+ x( 2) = ieee_value(a, ieee_quiet_nan)
+ x( 3) = ieee_value(a, ieee_negative_inf)
+ x( 4) = -huge(a)
+ x( 5) = -1000
+ x( 6) = -10
+ x( 7) = ieee_value(a, ieee_negative_normal)
+ x( 8) = -.1
+ x( 9) = -.001
+ x(10) = -tiny(a)
+ x(11) = ieee_value(a, ieee_negative_denormal)
+ x(12) = ieee_value(a, ieee_negative_zero)
+ x(13) = ieee_value(a, ieee_positive_zero)
+ x(14) = ieee_value(a, ieee_positive_denormal)
+ x(15) = tiny(a)
+ x(16) = .001
+ x(17) = .1
+ x(18) = ieee_value(a, ieee_positive_normal)
+ x(19) = 10
+ x(20) = 1000
+ x(21) = huge(a)
+ x(22) = ieee_value(a, ieee_positive_inf)
+
+ 4 format(A8,'(',f10.2,z9.8 ,', ',f10.2,z9.8 ,') = ',f10.2,L3,' ',A)
+
+ do i = lbound(x,1), ubound(x,1)
+ print*
+ do j = lbound(x,1), ubound(x,1)
+ print*
+ a = x(i)
+ b = x(j)
+
+ ! CHECK: %[[V_201:[0-9]+]] = fir.address_of(@_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.10) : !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_202:[0-9]+]] = fir.declare %[[V_201]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.10"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_203:[0-9]+]] = fir.field_index _QM__fortran_ieee_exceptionsTieee_flag_type.flag, !fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>
+ ! CHECK: %[[V_204:[0-9]+]] = fir.coordinate_of %[[V_202]], %[[V_203]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_205:[0-9]+]] = fir.load %[[V_204]] : !fir.ref<i8>
+ ! CHECK: %[[V_206:[0-9]+]] = fir.convert %[[V_205]] : (i8) -> i32
+ ! CHECK: %[[V_207:[0-9]+]] = fir.call @_FortranAMapException(%[[V_206]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %false{{[_0-9]*}} {
+ ! CHECK: %[[V_692:[0-9]+]] = fir.call @feraiseexcept(%[[V_207]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_692:[0-9]+]] = fir.call @feclearexcept(%[[V_207]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_208:[0-9]+]] = fir.load %[[V_17]] : !fir.ref<f32>
+ ! CHECK: %[[V_209:[0-9]+]] = fir.load %[[V_19]] : !fir.ref<f32>
+ ! CHECK: %[[V_210:[0-9]+]] = arith.cmpf olt, %[[V_208]], %[[V_209]] : f32
+ ! CHECK: %[[V_211:[0-9]+]] = fir.if %[[V_210]] -> (f32) {
+ ! CHECK: fir.result %[[V_209]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_692:[0-9]+]] = arith.cmpf ogt, %[[V_208]], %[[V_209]] : f32
+ ! CHECK: %[[V_693:[0-9]+]] = fir.if %[[V_692]] -> (f32) {
+ ! CHECK: fir.result %[[V_208]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_694:[0-9]+]] = arith.cmpf oeq, %[[V_208]], %[[V_209]] : f32
+ ! CHECK: %[[V_695:[0-9]+]] = fir.if %[[V_694]] -> (f32) {
+ ! CHECK: %[[V_696:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_208]]) <{bit = 960 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_697:[0-9]+]] = arith.select %[[V_696]], %[[V_208]], %[[V_209]] : f32
+ ! CHECK: fir.result %[[V_697]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_696:[0-9]+]] = fir.coordinate_of %[[V_92]], %c2{{.*}} : (!fir.ref<!fir.array<12xi32>>, i8) -> !fir.ref<i32>
+ ! CHECK: %[[V_697:[0-9]+]] = fir.load %[[V_696]] : !fir.ref<i32>
+ ! CHECK: %[[V_698:[0-9]+]] = arith.bitcast %[[V_697]] : i32 to f32
+ ! CHECK: %[[V_699:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_209]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_700:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_208]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_701:[0-9]+]] = arith.ori %[[V_700]], %[[V_699]] : i1
+ ! CHECK: fir.if %[[V_701]] {
+ ! CHECK: %[[V_702:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_703:[0-9]+]] = fir.call @feraiseexcept(%[[V_702]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_698]] : f32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_695]] : f32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_693]] : f32
+ ! CHECK: }
+ ! CHECK: fir.store %[[V_211]] to %[[V_83]] : !fir.ref<f32>
+ ! CHECK: %[[V_212:[0-9]+]] = fir.declare %[[V_201]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.10"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_213:[0-9]+]] = fir.coordinate_of %[[V_212]], %[[V_203]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_214:[0-9]+]] = fir.load %[[V_213]] : !fir.ref<i8>
+ ! CHECK: %[[V_215:[0-9]+]] = fir.convert %[[V_214]] : (i8) -> i32
+ ! CHECK: %[[V_216:[0-9]+]] = fir.call @_FortranAMapException(%[[V_215]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_217:[0-9]+]] = fir.call @fetestexcept(%[[V_216]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_218:[0-9]+]] = arith.cmpi ne, %[[V_217]], %c0{{.*}} : i32
+ ! CHECK: %[[V_219:[0-9]+]] = fir.convert %[[V_218]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_219]] to %[[V_21]] : !fir.ref<!fir.logical<4>>
+ call ieee_set_flag(ieee_invalid, .false.)
+ r = ieee_max(a, b)
+ call ieee_get_flag(ieee_invalid, flag_value)
+ write(*, 4) 'max ', a, a, b, b, r, flag_value, trim(tag(r))
+
+ ! CHECK: %[[V_268:[0-9]+]] = fir.declare %[[V_201]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.10"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_269:[0-9]+]] = fir.coordinate_of %[[V_268]], %[[V_203]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_270:[0-9]+]] = fir.load %[[V_269]] : !fir.ref<i8>
+ ! CHECK: %[[V_271:[0-9]+]] = fir.convert %[[V_270]] : (i8) -> i32
+ ! CHECK: %[[V_272:[0-9]+]] = fir.call @_FortranAMapException(%[[V_271]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %false{{[_0-9]*}} {
+ ! CHECK: %[[V_692:[0-9]+]] = fir.call @feraiseexcept(%[[V_272]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_692:[0-9]+]] = fir.call @feclearexcept(%[[V_272]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_273:[0-9]+]] = fir.load %[[V_17]] : !fir.ref<f32>
+ ! CHECK: %[[V_274:[0-9]+]] = fir.load %[[V_19]] : !fir.ref<f32>
+ ! CHECK: %[[V_275:[0-9]+]] = math.copysign %[[V_273]], %cst{{[_0-9]*}} fastmath<contract> : f32
+ ! CHECK: %[[V_276:[0-9]+]] = math.copysign %[[V_274]], %cst{{[_0-9]*}} fastmath<contract> : f32
+ ! CHECK: %[[V_277:[0-9]+]] = arith.cmpf olt, %[[V_275]], %[[V_276]] : f32
+ ! CHECK: %[[V_278:[0-9]+]] = fir.if %[[V_277]] -> (f32) {
+ ! CHECK: fir.result %[[V_274]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_692:[0-9]+]] = arith.cmpf ogt, %[[V_275]], %[[V_276]] : f32
+ ! CHECK: %[[V_693:[0-9]+]] = fir.if %[[V_692]] -> (f32) {
+ ! CHECK: fir.result %[[V_273]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_694:[0-9]+]] = arith.cmpf oeq, %[[V_275]], %[[V_276]] : f32
+ ! CHECK: %[[V_695:[0-9]+]] = fir.if %[[V_694]] -> (f32) {
+ ! CHECK: %[[V_696:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_273]]) <{bit = 960 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_697:[0-9]+]] = arith.select %[[V_696]], %[[V_273]], %[[V_274]] : f32
+ ! CHECK: fir.result %[[V_697]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_696:[0-9]+]] = fir.coordinate_of %[[V_92]], %c2{{.*}} : (!fir.ref<!fir.array<12xi32>>, i8) -> !fir.ref<i32>
+ ! CHECK: %[[V_697:[0-9]+]] = fir.load %[[V_696]] : !fir.ref<i32>
+ ! CHECK: %[[V_698:[0-9]+]] = arith.bitcast %[[V_697]] : i32 to f32
+ ! CHECK: %[[V_699:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_274]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_700:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_273]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_701:[0-9]+]] = arith.ori %[[V_700]], %[[V_699]] : i1
+ ! CHECK: fir.if %[[V_701]] {
+ ! CHECK: %[[V_702:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_703:[0-9]+]] = fir.call @feraiseexcept(%[[V_702]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_698]] : f32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_695]] : f32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_693]] : f32
+ ! CHECK: }
+ ! CHECK: fir.store %[[V_278]] to %[[V_83]] : !fir.ref<f32>
+ ! CHECK: %[[V_279:[0-9]+]] = fir.declare %[[V_201]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.10"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_280:[0-9]+]] = fir.coordinate_of %[[V_279]], %[[V_203]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_281:[0-9]+]] = fir.load %[[V_280]] : !fir.ref<i8>
+ ! CHECK: %[[V_282:[0-9]+]] = fir.convert %[[V_281]] : (i8) -> i32
+ ! CHECK: %[[V_283:[0-9]+]] = fir.call @_FortranAMapException(%[[V_282]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_284:[0-9]+]] = fir.call @fetestexcept(%[[V_283]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_285:[0-9]+]] = arith.cmpi ne, %[[V_284]], %c0{{.*}} : i32
+ ! CHECK: %[[V_286:[0-9]+]] = fir.convert %[[V_285]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_286]] to %[[V_21]] : !fir.ref<!fir.logical<4>>
+ call ieee_set_flag(ieee_invalid, .false.)
+ r = ieee_max_mag(a, b)
+ call ieee_get_flag(ieee_invalid, flag_value)
+ write(*, 4) 'mag ', a, a, b, b, r, flag_value, trim(tag(r))
+
+ ! CHECK: %[[V_329:[0-9]+]] = fir.declare %[[V_201]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.10"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_330:[0-9]+]] = fir.coordinate_of %[[V_329]], %[[V_203]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_331:[0-9]+]] = fir.load %[[V_330]] : !fir.ref<i8>
+ ! CHECK: %[[V_332:[0-9]+]] = fir.convert %[[V_331]] : (i8) -> i32
+ ! CHECK: %[[V_333:[0-9]+]] = fir.call @_FortranAMapException(%[[V_332]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %false{{[_0-9]*}} {
+ ! CHECK: %[[V_692:[0-9]+]] = fir.call @feraiseexcept(%[[V_333]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_692:[0-9]+]] = fir.call @feclearexcept(%[[V_333]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_334:[0-9]+]] = fir.load %[[V_17]] : !fir.ref<f32>
+ ! CHECK: %[[V_335:[0-9]+]] = fir.load %[[V_19]] : !fir.ref<f32>
+ ! CHECK: %[[V_336:[0-9]+]] = arith.cmpf olt, %[[V_334]], %[[V_335]] : f32
+ ! CHECK: %[[V_337:[0-9]+]] = fir.if %[[V_336]] -> (f32) {
+ ! CHECK: fir.result %[[V_335]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_692:[0-9]+]] = arith.cmpf ogt, %[[V_334]], %[[V_335]] : f32
+ ! CHECK: %[[V_693:[0-9]+]] = fir.if %[[V_692]] -> (f32) {
+ ! CHECK: fir.result %[[V_334]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_694:[0-9]+]] = arith.cmpf oeq, %[[V_334]], %[[V_335]] : f32
+ ! CHECK: %[[V_695:[0-9]+]] = fir.if %[[V_694]] -> (f32) {
+ ! CHECK: %[[V_696:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_334]]) <{bit = 960 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_697:[0-9]+]] = arith.select %[[V_696]], %[[V_334]], %[[V_335]] : f32
+ ! CHECK: fir.result %[[V_697]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_696:[0-9]+]] = arith.cmpf ord, %[[V_334]], %[[V_334]] : f32
+ ! CHECK: %[[V_697:[0-9]+]] = arith.cmpf ord, %[[V_335]], %[[V_335]] : f32
+ ! CHECK: %[[V_698:[0-9]+]] = fir.coordinate_of %[[V_92]], %c2{{.*}} : (!fir.ref<!fir.array<12xi32>>, i8) -> !fir.ref<i32>
+ ! CHECK: %[[V_699:[0-9]+]] = fir.load %[[V_698]] : !fir.ref<i32>
+ ! CHECK: %[[V_700:[0-9]+]] = arith.bitcast %[[V_699]] : i32 to f32
+ ! CHECK: %[[V_701:[0-9]+]] = arith.select %[[V_697]], %[[V_335]], %[[V_700]] : f32
+ ! CHECK: %[[V_702:[0-9]+]] = arith.select %[[V_696]], %[[V_334]], %[[V_701]] : f32
+ ! CHECK: %[[V_703:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_335]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_704:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_334]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_705:[0-9]+]] = arith.ori %[[V_704]], %[[V_703]] : i1
+ ! CHECK: fir.if %[[V_705]] {
+ ! CHECK: %[[V_706:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_707:[0-9]+]] = fir.call @feraiseexcept(%[[V_706]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_702]] : f32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_695]] : f32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_693]] : f32
+ ! CHECK: }
+ ! CHECK: fir.store %[[V_337]] to %[[V_83]] : !fir.ref<f32>
+ ! CHECK: %[[V_338:[0-9]+]] = fir.declare %[[V_201]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.10"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_339:[0-9]+]] = fir.coordinate_of %[[V_338]], %[[V_203]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_340:[0-9]+]] = fir.load %[[V_339]] : !fir.ref<i8>
+ ! CHECK: %[[V_341:[0-9]+]] = fir.convert %[[V_340]] : (i8) -> i32
+ ! CHECK: %[[V_342:[0-9]+]] = fir.call @_FortranAMapException(%[[V_341]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_343:[0-9]+]] = fir.call @fetestexcept(%[[V_342]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_344:[0-9]+]] = arith.cmpi ne, %[[V_343]], %c0{{.*}} : i32
+ ! CHECK: %[[V_345:[0-9]+]] = fir.convert %[[V_344]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_345]] to %[[V_21]] : !fir.ref<!fir.logical<4>>
+ call ieee_set_flag(ieee_invalid, .false.)
+ r = ieee_max_num(a, b)
+ call ieee_get_flag(ieee_invalid, flag_value)
+ write(*, 4) 'max_num', a, a, b, b, r, flag_value, trim(tag(r))
+
+ ! CHECK: %[[V_388:[0-9]+]] = fir.declare %[[V_201]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.10"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_389:[0-9]+]] = fir.coordinate_of %[[V_388]], %[[V_203]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_390:[0-9]+]] = fir.load %[[V_389]] : !fir.ref<i8>
+ ! CHECK: %[[V_391:[0-9]+]] = fir.convert %[[V_390]] : (i8) -> i32
+ ! CHECK: %[[V_392:[0-9]+]] = fir.call @_FortranAMapException(%[[V_391]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %false{{[_0-9]*}} {
+ ! CHECK: %[[V_692:[0-9]+]] = fir.call @feraiseexcept(%[[V_392]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_692:[0-9]+]] = fir.call @feclearexcept(%[[V_392]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_393:[0-9]+]] = fir.load %[[V_17]] : !fir.ref<f32>
+ ! CHECK: %[[V_394:[0-9]+]] = fir.load %[[V_19]] : !fir.ref<f32>
+ ! CHECK: %[[V_395:[0-9]+]] = math.copysign %[[V_393]], %cst{{[_0-9]*}} fastmath<contract> : f32
+ ! CHECK: %[[V_396:[0-9]+]] = math.copysign %[[V_394]], %cst{{[_0-9]*}} fastmath<contract> : f32
+ ! CHECK: %[[V_397:[0-9]+]] = arith.cmpf olt, %[[V_395]], %[[V_396]] : f32
+ ! CHECK: %[[V_398:[0-9]+]] = fir.if %[[V_397]] -> (f32) {
+ ! CHECK: fir.result %[[V_394]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_692:[0-9]+]] = arith.cmpf ogt, %[[V_395]], %[[V_396]] : f32
+ ! CHECK: %[[V_693:[0-9]+]] = fir.if %[[V_692]] -> (f32) {
+ ! CHECK: fir.result %[[V_393]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_694:[0-9]+]] = arith.cmpf oeq, %[[V_395]], %[[V_396]] : f32
+ ! CHECK: %[[V_695:[0-9]+]] = fir.if %[[V_694]] -> (f32) {
+ ! CHECK: %[[V_696:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_393]]) <{bit = 960 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_697:[0-9]+]] = arith.select %[[V_696]], %[[V_393]], %[[V_394]] : f32
+ ! CHECK: fir.result %[[V_697]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_696:[0-9]+]] = arith.cmpf ord, %[[V_393]], %[[V_393]] : f32
+ ! CHECK: %[[V_697:[0-9]+]] = arith.cmpf ord, %[[V_394]], %[[V_394]] : f32
+ ! CHECK: %[[V_698:[0-9]+]] = fir.coordinate_of %[[V_92]], %c2{{.*}} : (!fir.ref<!fir.array<12xi32>>, i8) -> !fir.ref<i32>
+ ! CHECK: %[[V_699:[0-9]+]] = fir.load %[[V_698]] : !fir.ref<i32>
+ ! CHECK: %[[V_700:[0-9]+]] = arith.bitcast %[[V_699]] : i32 to f32
+ ! CHECK: %[[V_701:[0-9]+]] = arith.select %[[V_697]], %[[V_394]], %[[V_700]] : f32
+ ! CHECK: %[[V_702:[0-9]+]] = arith.select %[[V_696]], %[[V_393]], %[[V_701]] : f32
+ ! CHECK: %[[V_703:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_394]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_704:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_393]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_705:[0-9]+]] = arith.ori %[[V_704]], %[[V_703]] : i1
+ ! CHECK: fir.if %[[V_705]] {
+ ! CHECK: %[[V_706:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_707:[0-9]+]] = fir.call @feraiseexcept(%[[V_706]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_702]] : f32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_695]] : f32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_693]] : f32
+ ! CHECK: }
+ ! CHECK: fir.store %[[V_398]] to %[[V_83]] : !fir.ref<f32>
+ ! CHECK: %[[V_399:[0-9]+]] = fir.declare %[[V_201]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.10"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_400:[0-9]+]] = fir.coordinate_of %[[V_399]], %[[V_203]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_401:[0-9]+]] = fir.load %[[V_400]] : !fir.ref<i8>
+ ! CHECK: %[[V_402:[0-9]+]] = fir.convert %[[V_401]] : (i8) -> i32
+ ! CHECK: %[[V_403:[0-9]+]] = fir.call @_FortranAMapException(%[[V_402]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_404:[0-9]+]] = fir.call @fetestexcept(%[[V_403]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_405:[0-9]+]] = arith.cmpi ne, %[[V_404]], %c0{{.*}} : i32
+ ! CHECK: %[[V_406:[0-9]+]] = fir.convert %[[V_405]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_406]] to %[[V_21]] : !fir.ref<!fir.logical<4>>
+ call ieee_set_flag(ieee_invalid, .false.)
+ r = ieee_max_num_mag(a, b)
+ call ieee_get_flag(ieee_invalid, flag_value)
+ write(*, 4) 'mag_num', a, a, b, b, r, flag_value, trim(tag(r))
+
+ ! CHECK: %[[V_449:[0-9]+]] = fir.declare %[[V_201]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.10"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_450:[0-9]+]] = fir.coordinate_of %[[V_449]], %[[V_203]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_451:[0-9]+]] = fir.load %[[V_450]] : !fir.ref<i8>
+ ! CHECK: %[[V_452:[0-9]+]] = fir.convert %[[V_451]] : (i8) -> i32
+ ! CHECK: %[[V_453:[0-9]+]] = fir.call @_FortranAMapException(%[[V_452]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %false{{[_0-9]*}} {
+ ! CHECK: %[[V_692:[0-9]+]] = fir.call @feraiseexcept(%[[V_453]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_692:[0-9]+]] = fir.call @feclearexcept(%[[V_453]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_454:[0-9]+]] = fir.load %[[V_17]] : !fir.ref<f32>
+ ! CHECK: %[[V_455:[0-9]+]] = fir.load %[[V_19]] : !fir.ref<f32>
+ ! CHECK: %[[V_456:[0-9]+]] = arith.cmpf olt, %[[V_454]], %[[V_455]] : f32
+ ! CHECK: %[[V_457:[0-9]+]] = fir.if %[[V_456]] -> (f32) {
+ ! CHECK: fir.result %[[V_454]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_692:[0-9]+]] = arith.cmpf ogt, %[[V_454]], %[[V_455]] : f32
+ ! CHECK: %[[V_693:[0-9]+]] = fir.if %[[V_692]] -> (f32) {
+ ! CHECK: fir.result %[[V_455]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_694:[0-9]+]] = arith.cmpf oeq, %[[V_454]], %[[V_455]] : f32
+ ! CHECK: %[[V_695:[0-9]+]] = fir.if %[[V_694]] -> (f32) {
+ ! CHECK: %[[V_696:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_454]]) <{bit = 60 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_697:[0-9]+]] = arith.select %[[V_696]], %[[V_454]], %[[V_455]] : f32
+ ! CHECK: fir.result %[[V_697]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_696:[0-9]+]] = fir.coordinate_of %[[V_92]], %c2{{.*}} : (!fir.ref<!fir.array<12xi32>>, i8) -> !fir.ref<i32>
+ ! CHECK: %[[V_697:[0-9]+]] = fir.load %[[V_696]] : !fir.ref<i32>
+ ! CHECK: %[[V_698:[0-9]+]] = arith.bitcast %[[V_697]] : i32 to f32
+ ! CHECK: %[[V_699:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_455]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_700:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_454]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_701:[0-9]+]] = arith.ori %[[V_700]], %[[V_699]] : i1
+ ! CHECK: fir.if %[[V_701]] {
+ ! CHECK: %[[V_702:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_703:[0-9]+]] = fir.call @feraiseexcept(%[[V_702]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_698]] : f32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_695]] : f32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_693]] : f32
+ ! CHECK: }
+ ! CHECK: fir.store %[[V_457]] to %[[V_83]] : !fir.ref<f32>
+ ! CHECK: %[[V_458:[0-9]+]] = fir.declare %[[V_201]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.10"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_459:[0-9]+]] = fir.coordinate_of %[[V_458]], %[[V_203]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_460:[0-9]+]] = fir.load %[[V_459]] : !fir.ref<i8>
+ ! CHECK: %[[V_461:[0-9]+]] = fir.convert %[[V_460]] : (i8) -> i32
+ ! CHECK: %[[V_462:[0-9]+]] = fir.call @_FortranAMapException(%[[V_461]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_463:[0-9]+]] = fir.call @fetestexcept(%[[V_462]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_464:[0-9]+]] = arith.cmpi ne, %[[V_463]], %c0{{.*}} : i32
+ ! CHECK: %[[V_465:[0-9]+]] = fir.convert %[[V_464]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_465]] to %[[V_21]] : !fir.ref<!fir.logical<4>>
+ call ieee_set_flag(ieee_invalid, .false.)
+ r = ieee_min(a, b)
+ call ieee_get_flag(ieee_invalid, flag_value)
+ write(*, 4) 'min ', a, a, b, b, r, flag_value, trim(tag(r))
+
+ ! CHECK: %[[V_508:[0-9]+]] = fir.declare %[[V_201]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.10"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_509:[0-9]+]] = fir.coordinate_of %[[V_508]], %[[V_203]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_510:[0-9]+]] = fir.load %[[V_509]] : !fir.ref<i8>
+ ! CHECK: %[[V_511:[0-9]+]] = fir.convert %[[V_510]] : (i8) -> i32
+ ! CHECK: %[[V_512:[0-9]+]] = fir.call @_FortranAMapException(%[[V_511]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %false{{[_0-9]*}} {
+ ! CHECK: %[[V_692:[0-9]+]] = fir.call @feraiseexcept(%[[V_512]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_692:[0-9]+]] = fir.call @feclearexcept(%[[V_512]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_513:[0-9]+]] = fir.load %[[V_17]] : !fir.ref<f32>
+ ! CHECK: %[[V_514:[0-9]+]] = fir.load %[[V_19]] : !fir.ref<f32>
+ ! CHECK: %[[V_515:[0-9]+]] = math.copysign %[[V_513]], %cst{{[_0-9]*}} fastmath<contract> : f32
+ ! CHECK: %[[V_516:[0-9]+]] = math.copysign %[[V_514]], %cst{{[_0-9]*}} fastmath<contract> : f32
+ ! CHECK: %[[V_517:[0-9]+]] = arith.cmpf olt, %[[V_515]], %[[V_516]] : f32
+ ! CHECK: %[[V_518:[0-9]+]] = fir.if %[[V_517]] -> (f32) {
+ ! CHECK: fir.result %[[V_513]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_692:[0-9]+]] = arith.cmpf ogt, %[[V_515]], %[[V_516]] : f32
+ ! CHECK: %[[V_693:[0-9]+]] = fir.if %[[V_692]] -> (f32) {
+ ! CHECK: fir.result %[[V_514]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_694:[0-9]+]] = arith.cmpf oeq, %[[V_515]], %[[V_516]] : f32
+ ! CHECK: %[[V_695:[0-9]+]] = fir.if %[[V_694]] -> (f32) {
+ ! CHECK: %[[V_696:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_513]]) <{bit = 60 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_697:[0-9]+]] = arith.select %[[V_696]], %[[V_513]], %[[V_514]] : f32
+ ! CHECK: fir.result %[[V_697]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_696:[0-9]+]] = fir.coordinate_of %[[V_92]], %c2{{.*}} : (!fir.ref<!fir.array<12xi32>>, i8) -> !fir.ref<i32>
+ ! CHECK: %[[V_697:[0-9]+]] = fir.load %[[V_696]] : !fir.ref<i32>
+ ! CHECK: %[[V_698:[0-9]+]] = arith.bitcast %[[V_697]] : i32 to f32
+ ! CHECK: %[[V_699:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_514]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_700:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_513]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_701:[0-9]+]] = arith.ori %[[V_700]], %[[V_699]] : i1
+ ! CHECK: fir.if %[[V_701]] {
+ ! CHECK: %[[V_702:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_703:[0-9]+]] = fir.call @feraiseexcept(%[[V_702]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_698]] : f32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_695]] : f32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_693]] : f32
+ ! CHECK: }
+ ! CHECK: fir.store %[[V_518]] to %[[V_83]] : !fir.ref<f32>
+ ! CHECK: %[[V_519:[0-9]+]] = fir.declare %[[V_201]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.10"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_520:[0-9]+]] = fir.coordinate_of %[[V_519]], %[[V_203]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_521:[0-9]+]] = fir.load %[[V_520]] : !fir.ref<i8>
+ ! CHECK: %[[V_522:[0-9]+]] = fir.convert %[[V_521]] : (i8) -> i32
+ ! CHECK: %[[V_523:[0-9]+]] = fir.call @_FortranAMapException(%[[V_522]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_524:[0-9]+]] = fir.call @fetestexcept(%[[V_523]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_525:[0-9]+]] = arith.cmpi ne, %[[V_524]], %c0{{.*}} : i32
+ ! CHECK: %[[V_526:[0-9]+]] = fir.convert %[[V_525]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_526]] to %[[V_21]] : !fir.ref<!fir.logical<4>>
+ call ieee_set_flag(ieee_invalid, .false.)
+ r = ieee_min_mag(a, b)
+ call ieee_get_flag(ieee_invalid, flag_value)
+ write(*, 4) 'mig ', a, a, b, b, r, flag_value, trim(tag(r))
+
+ ! CHECK: %[[V_569:[0-9]+]] = fir.declare %[[V_201]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.10"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_570:[0-9]+]] = fir.coordinate_of %[[V_569]], %[[V_203]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_571:[0-9]+]] = fir.load %[[V_570]] : !fir.ref<i8>
+ ! CHECK: %[[V_572:[0-9]+]] = fir.convert %[[V_571]] : (i8) -> i32
+ ! CHECK: %[[V_573:[0-9]+]] = fir.call @_FortranAMapException(%[[V_572]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %false{{[_0-9]*}} {
+ ! CHECK: %[[V_692:[0-9]+]] = fir.call @feraiseexcept(%[[V_573]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_692:[0-9]+]] = fir.call @feclearexcept(%[[V_573]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_574:[0-9]+]] = fir.load %[[V_17]] : !fir.ref<f32>
+ ! CHECK: %[[V_575:[0-9]+]] = fir.load %[[V_19]] : !fir.ref<f32>
+ ! CHECK: %[[V_576:[0-9]+]] = arith.cmpf olt, %[[V_574]], %[[V_575]] : f32
+ ! CHECK: %[[V_577:[0-9]+]] = fir.if %[[V_576]] -> (f32) {
+ ! CHECK: fir.result %[[V_574]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_692:[0-9]+]] = arith.cmpf ogt, %[[V_574]], %[[V_575]] : f32
+ ! CHECK: %[[V_693:[0-9]+]] = fir.if %[[V_692]] -> (f32) {
+ ! CHECK: fir.result %[[V_575]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_694:[0-9]+]] = arith.cmpf oeq, %[[V_574]], %[[V_575]] : f32
+ ! CHECK: %[[V_695:[0-9]+]] = fir.if %[[V_694]] -> (f32) {
+ ! CHECK: %[[V_696:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_574]]) <{bit = 60 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_697:[0-9]+]] = arith.select %[[V_696]], %[[V_574]], %[[V_575]] : f32
+ ! CHECK: fir.result %[[V_697]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_696:[0-9]+]] = arith.cmpf ord, %[[V_574]], %[[V_574]] : f32
+ ! CHECK: %[[V_697:[0-9]+]] = arith.cmpf ord, %[[V_575]], %[[V_575]] : f32
+ ! CHECK: %[[V_698:[0-9]+]] = fir.coordinate_of %[[V_92]], %c2{{.*}} : (!fir.ref<!fir.array<12xi32>>, i8) -> !fir.ref<i32>
+ ! CHECK: %[[V_699:[0-9]+]] = fir.load %[[V_698]] : !fir.ref<i32>
+ ! CHECK: %[[V_700:[0-9]+]] = arith.bitcast %[[V_699]] : i32 to f32
+ ! CHECK: %[[V_701:[0-9]+]] = arith.select %[[V_697]], %[[V_575]], %[[V_700]] : f32
+ ! CHECK: %[[V_702:[0-9]+]] = arith.select %[[V_696]], %[[V_574]], %[[V_701]] : f32
+ ! CHECK: %[[V_703:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_575]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_704:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_574]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_705:[0-9]+]] = arith.ori %[[V_704]], %[[V_703]] : i1
+ ! CHECK: fir.if %[[V_705]] {
+ ! CHECK: %[[V_706:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_707:[0-9]+]] = fir.call @feraiseexcept(%[[V_706]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_702]] : f32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_695]] : f32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_693]] : f32
+ ! CHECK: }
+ ! CHECK: fir.store %[[V_577]] to %[[V_83]] : !fir.ref<f32>
+ ! CHECK: %[[V_578:[0-9]+]] = fir.declare %[[V_201]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.10"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_579:[0-9]+]] = fir.coordinate_of %[[V_578]], %[[V_203]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_580:[0-9]+]] = fir.load %[[V_579]] : !fir.ref<i8>
+ ! CHECK: %[[V_581:[0-9]+]] = fir.convert %[[V_580]] : (i8) -> i32
+ ! CHECK: %[[V_582:[0-9]+]] = fir.call @_FortranAMapException(%[[V_581]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_583:[0-9]+]] = fir.call @fetestexcept(%[[V_582]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_584:[0-9]+]] = arith.cmpi ne, %[[V_583]], %c0{{.*}} : i32
+ ! CHECK: %[[V_585:[0-9]+]] = fir.convert %[[V_584]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_585]] to %[[V_21]] : !fir.ref<!fir.logical<4>>
+ call ieee_set_flag(ieee_invalid, .false.)
+ r = ieee_min_num(a, b)
+ call ieee_get_flag(ieee_invalid, flag_value)
+ write(*, 4) 'min_num', a, a, b, b, r, flag_value, trim(tag(r))
+
+ ! CHECK: %[[V_628:[0-9]+]] = fir.declare %[[V_201]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.10"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_629:[0-9]+]] = fir.coordinate_of %[[V_628]], %[[V_203]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_630:[0-9]+]] = fir.load %[[V_629]] : !fir.ref<i8>
+ ! CHECK: %[[V_631:[0-9]+]] = fir.convert %[[V_630]] : (i8) -> i32
+ ! CHECK: %[[V_632:[0-9]+]] = fir.call @_FortranAMapException(%[[V_631]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: fir.if %false{{[_0-9]*}} {
+ ! CHECK: %[[V_692:[0-9]+]] = fir.call @feraiseexcept(%[[V_632]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: } else {
+ ! CHECK: %[[V_692:[0-9]+]] = fir.call @feclearexcept(%[[V_632]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: %[[V_633:[0-9]+]] = fir.load %[[V_17]] : !fir.ref<f32>
+ ! CHECK: %[[V_634:[0-9]+]] = fir.load %[[V_19]] : !fir.ref<f32>
+ ! CHECK: %[[V_635:[0-9]+]] = math.copysign %[[V_633]], %cst{{[_0-9]*}} fastmath<contract> : f32
+ ! CHECK: %[[V_636:[0-9]+]] = math.copysign %[[V_634]], %cst{{[_0-9]*}} fastmath<contract> : f32
+ ! CHECK: %[[V_637:[0-9]+]] = arith.cmpf olt, %[[V_635]], %[[V_636]] : f32
+ ! CHECK: %[[V_638:[0-9]+]] = fir.if %[[V_637]] -> (f32) {
+ ! CHECK: fir.result %[[V_633]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_692:[0-9]+]] = arith.cmpf ogt, %[[V_635]], %[[V_636]] : f32
+ ! CHECK: %[[V_693:[0-9]+]] = fir.if %[[V_692]] -> (f32) {
+ ! CHECK: fir.result %[[V_634]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_694:[0-9]+]] = arith.cmpf oeq, %[[V_635]], %[[V_636]] : f32
+ ! CHECK: %[[V_695:[0-9]+]] = fir.if %[[V_694]] -> (f32) {
+ ! CHECK: %[[V_696:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_633]]) <{bit = 60 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_697:[0-9]+]] = arith.select %[[V_696]], %[[V_633]], %[[V_634]] : f32
+ ! CHECK: fir.result %[[V_697]] : f32
+ ! CHECK: } else {
+ ! CHECK: %[[V_696:[0-9]+]] = arith.cmpf ord, %[[V_633]], %[[V_633]] : f32
+ ! CHECK: %[[V_697:[0-9]+]] = arith.cmpf ord, %[[V_634]], %[[V_634]] : f32
+ ! CHECK: %[[V_698:[0-9]+]] = fir.coordinate_of %[[V_92]], %c2{{.*}} : (!fir.ref<!fir.array<12xi32>>, i8) -> !fir.ref<i32>
+ ! CHECK: %[[V_699:[0-9]+]] = fir.load %[[V_698]] : !fir.ref<i32>
+ ! CHECK: %[[V_700:[0-9]+]] = arith.bitcast %[[V_699]] : i32 to f32
+ ! CHECK: %[[V_701:[0-9]+]] = arith.select %[[V_697]], %[[V_634]], %[[V_700]] : f32
+ ! CHECK: %[[V_702:[0-9]+]] = arith.select %[[V_696]], %[[V_633]], %[[V_701]] : f32
+ ! CHECK: %[[V_703:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_634]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_704:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_633]]) <{bit = 1 : i32}> : (f32) -> i1
+ ! CHECK: %[[V_705:[0-9]+]] = arith.ori %[[V_704]], %[[V_703]] : i1
+ ! CHECK: fir.if %[[V_705]] {
+ ! CHECK: %[[V_706:[0-9]+]] = fir.call @_FortranAMapException(%c1{{.*}}) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_707:[0-9]+]] = fir.call @feraiseexcept(%[[V_706]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_702]] : f32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_695]] : f32
+ ! CHECK: }
+ ! CHECK: fir.result %[[V_693]] : f32
+ ! CHECK: }
+ ! CHECK: fir.store %[[V_638]] to %[[V_83]] : !fir.ref<f32>
+ ! CHECK: %[[V_639:[0-9]+]] = fir.declare %[[V_201]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_ieee_exceptionsTieee_flag_type.10"} : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>
+ ! CHECK: %[[V_640:[0-9]+]] = fir.coordinate_of %[[V_639]], %[[V_203]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_flag_type{_QM__fortran_ieee_exceptionsTieee_flag_type.flag:i8}>>, !fir.field) -> !fir.ref<i8>
+ ! CHECK: %[[V_641:[0-9]+]] = fir.load %[[V_640]] : !fir.ref<i8>
+ ! CHECK: %[[V_642:[0-9]+]] = fir.convert %[[V_641]] : (i8) -> i32
+ ! CHECK: %[[V_643:[0-9]+]] = fir.call @_FortranAMapException(%[[V_642]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_644:[0-9]+]] = fir.call @fetestexcept(%[[V_643]]) fastmath<contract> : (i32) -> i32
+ ! CHECK: %[[V_645:[0-9]+]] = arith.cmpi ne, %[[V_644]], %c0{{.*}} : i32
+ ! CHECK: %[[V_646:[0-9]+]] = fir.convert %[[V_645]] : (i1) -> !fir.logical<4>
+ ! CHECK: fir.store %[[V_646]] to %[[V_21]] : !fir.ref<!fir.logical<4>>
+ call ieee_set_flag(ieee_invalid, .false.)
+ r = ieee_min_num_mag(a, b)
+ call ieee_get_flag(ieee_invalid, flag_value)
+ write(*, 4) 'mig_num', a, a, b, b, r, flag_value, trim(tag(r))
+ enddo
+ enddo
+end
diff --git a/flang/test/Lower/Intrinsics/ieee_unordered.f90 b/flang/test/Lower/Intrinsics/ieee_unordered.f90
index d953e4d36cd2b08..e6cbab7ef8c6aca 100644
--- a/flang/test/Lower/Intrinsics/ieee_unordered.f90
+++ b/flang/test/Lower/Intrinsics/ieee_unordered.f90
@@ -44,27 +44,21 @@
! 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_44:[0-9]+]] = arith.cmpf uno, %[[V_40]], %[[V_41]] : f128
! 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_52:[0-9]+]] = arith.cmpf uno, %[[V_48]], %[[V_49]] : f128
! 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_60:[0-9]+]] = arith.cmpf uno, %[[V_56]], %[[V_57]] : f128
! 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
More information about the flang-commits
mailing list