Magic-Mirror/llvm-capstone
1
0
Fork 0
mirror of https://github.com/capstone-engine/llvm-capstone.git synced 2024-10-07 02:43:57 +00:00
Code Issues Actions 4 Packages Projects Releases Wiki Activity

[flang] IEEE_ARITHMETIC and IEEE_EXCEPTIONS intrinsic module procedures (#74138)

Browse Source 
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
This commit is contained in:
vdonaldson 2023-12-04 09:55:54 -08:00 committed by GitHub
parent f368e6424f
commit 3aba9264b3
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
32 changed files with 2804 additions and 208 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
flang/include/flang/Lower/ConvertVariable.h
View File

@ -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

2
flang/include/flang/Lower/PFTBuilder.h
View File

@ -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{};

52
flang/include/flang/Optimizer/Builder/IntrinsicCall.h
View File

@ -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

18
flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h
View File

@ -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

30
flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h Normal file
View File

@ -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

32
flang/include/flang/Runtime/exceptions.h Normal file
View File

@ -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_

47
flang/include/flang/Runtime/ieee_arithmetic.h
View File

@ -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

50
flang/include/flang/Runtime/magic-numbers.h
View File

@ -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

149
flang/lib/Lower/Bridge.cpp
View File

@ -193,8 +193,7 @@ public:
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 @@ public:
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 @@ public:
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 @@ public:
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 @@ private:
}
}
/// 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 @@ private:
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 @@ private:
builder = nullptr;
localSymbols.clear();
}
/// Instantiate the data from a BLOCK DATA unit.
void lowerBlockData(Fortran::lower::pft::BlockDataUnit &bdunit) {
createGlobalOutsideOfFunctionLowering([&]() {
@ -4563,6 +4612,48 @@ private:
[&]() { 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());

14
flang/lib/Lower/ConvertVariable.cpp
View File

@ -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);

52
flang/lib/Lower/PFTBuilder.cpp
View File

@ -109,7 +109,7 @@ public:
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 @@ public:
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 @@ private:
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

1
flang/lib/Optimizer/Builder/CMakeLists.txt
View File

@ -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

527
flang/lib/Optimizer/Builder/IntrinsicCall.cpp
View File

@ -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>(

53
flang/lib/Optimizer/Builder/LowLevelIntrinsics.cpp
View File

@ -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);
}

22
flang/lib/Optimizer/Builder/Runtime/Exceptions.cpp Normal file
View File

@ -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);
}

2
flang/module/__cuda_builtins.f90
View File

@ -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, &

11
flang/module/__fortran_builtins.f90
View File

@ -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 @@ module __Fortran_builtins
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 @@ module __Fortran_builtins
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 @@ module __Fortran_builtins
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

71
flang/module/__fortran_ieee_exceptions.f90
View File

@ -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 @@ module __Fortran_ieee_exceptions
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 @@ module __Fortran_ieee_exceptions
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 @@ module __Fortran_ieee_exceptions
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 @@ module __Fortran_ieee_exceptions
end function ieee_support_halting_0
end interface
end module __Fortran_ieee_exceptions
end module __fortran_ieee_exceptions

19
flang/module/__fortran_type_info.f90
View File

@ -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 @@ module __Fortran_type_info
! 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 @@ module __Fortran_type_info
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

66
flang/module/ieee_arithmetic.f90
View File

@ -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 @@ module ieee_arithmetic
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 @@ module ieee_arithmetic
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; \

2
flang/module/ieee_exceptions.f90
View File

@ -7,5 +7,5 @@
!===------------------------------------------------------------------------===!
module ieee_exceptions
use __Fortran_ieee_exceptions
use __fortran_ieee_exceptions
end module ieee_exceptions

2
flang/module/iso_c_binding.f90
View File

@ -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, &

10
flang/module/iso_fortran_env.f90
View File

@ -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

1
flang/runtime/CMakeLists.txt
View File

@ -104,6 +104,7 @@ set(sources
edit-input.cpp
edit-output.cpp
environment.cpp
exceptions.cpp
extensions.cpp
extrema.cpp
file.cpp

91
flang/runtime/exceptions.cpp Normal file
View File

@ -0,0 +1,91 @@
//===-- 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>
#ifndef __FE_DENORM
#define __FE_DENORM 0 // denorm is nonstandard
#endif
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 == 0 || 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) {
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:
if (__FE_DENORM) {
return __FE_DENORM;
}
break;
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.
#ifndef _WIN32
static_assert(
sizeof(femode_t) <= sizeof(int) * _FORTRAN_RUNTIME_IEEE_FEMODE_T_EXTENT,
"increase ieee_modes_type size");
#endif
static_assert(
sizeof(fenv_t) <= sizeof(int) * _FORTRAN_RUNTIME_IEEE_FENV_T_EXTENT,
"increase ieee_status_type size");
} // extern "C"
} // namespace Fortran::runtime

270
flang/test/Lower/Intrinsics/ieee_compare.f90 Normal file
View File

@ -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-DAG: %[[V_182:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_181]]) <{bit = 1 : i32}> : (f32) -> i1
! CHECK-DAG: %[[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-DAG: %[[V_214:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_213]]) <{bit = 1 : i32}> : (f32) -> i1
! CHECK-DAG: %[[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-DAG: %[[V_246:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_245]]) <{bit = 1 : i32}> : (f32) -> i1
! CHECK-DAG: %[[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-DAG: %[[V_278:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_277]]) <{bit = 1 : i32}> : (f32) -> i1
! CHECK-DAG: %[[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-DAG: %[[V_310:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_309]]) <{bit = 1 : i32}> : (f32) -> i1
! CHECK-DAG: %[[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-DAG: %[[V_342:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_341]]) <{bit = 1 : i32}> : (f32) -> i1
! CHECK-DAG: %[[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

82
flang/test/Lower/Intrinsics/ieee_femodes.f90 Normal file
View File

@ -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

120
flang/test/Lower/Intrinsics/ieee_festatus.f90 Normal file
View File

@ -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

524
flang/test/Lower/Intrinsics/ieee_flag.f90 Normal file
View File

@ -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

118
flang/test/Lower/Intrinsics/ieee_logb.f90 Normal file
View File

@ -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

553
flang/test/Lower/Intrinsics/ieee_max_min.f90 Normal file
View File

@ -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-DAG: %[[V_699:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_209]]) <{bit = 1 : i32}> : (f32) -> i1
! CHECK-DAG: %[[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-DAG: %[[V_699:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_274]]) <{bit = 1 : i32}> : (f32) -> i1
! CHECK-DAG: %[[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-DAG: %[[V_703:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_335]]) <{bit = 1 : i32}> : (f32) -> i1
! CHECK-DAG: %[[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-DAG: %[[V_703:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_394]]) <{bit = 1 : i32}> : (f32) -> i1
! CHECK-DAG: %[[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-DAG: %[[V_699:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_455]]) <{bit = 1 : i32}> : (f32) -> i1
! CHECK-DAG: %[[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-DAG: %[[V_699:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_514]]) <{bit = 1 : i32}> : (f32) -> i1
! CHECK-DAG: %[[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-DAG: %[[V_703:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_575]]) <{bit = 1 : i32}> : (f32) -> i1
! CHECK-DAG: %[[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-DAG: %[[V_703:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_634]]) <{bit = 1 : i32}> : (f32) -> i1
! CHECK-DAG: %[[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

12
flang/test/Lower/Intrinsics/ieee_unordered.f90
View File

@ -44,27 +44,21 @@ z = ieee_value(z, ieee_quiet_nan)
! CHECK: %[[V_40:[0-9]+]] = fir.load %[[V_2]] : !fir.ref<f128>
! CHECK: %[[V_41:[0-9]+]] = fir.load %[[V_3]] : !fir.ref<f128>
! CHECK: %[[V_42:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_40]]) <{bit = 3 : i32}> : (f128) -> i1
! CHECK: %[[V_43:[0-9]+]] = "llvm.intr.is.fpclass"(%[[V_41]]) <{bit = 3 : i32}> : (f128) -> i1
! CHECK: %[[V_44:[0-9]+]] = arith.ori %[[V_42]], %[[V_43]] : i1
! CHECK: %[[V_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