[flang] Modifications to ieee floating point environment procedures (#121949)

Intrinsic module procedures ieee_get_modes, ieee_set_modes,
ieee_get_status, and ieee_set_status store and retrieve opaque data
values whose size varies by machine and OS environment. These data
values are usually, but not always small. Their sizes are not directly
known in a cross compilation environment. Address this issue by
implementing two mechanisms for processing these data values.
Environments that use typical small data sizes can access storage
defined at compile time. When this is not valid, data storage of any
size can be allocated at runtime.
This commit is contained in:
vdonaldson 2025-01-15 10:55:09 -05:00 committed by GitHub
parent 44ba43aa2b
commit ff862d6de9
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
13 changed files with 125 additions and 259 deletions

View File

@ -112,6 +112,9 @@ public:
bool isPPC() const { return isPPC_; } bool isPPC() const { return isPPC_; }
void set_isPPC(bool isPPC = false); void set_isPPC(bool isPPC = false);
bool isSPARC() const { return isSPARC_; }
void set_isSPARC(bool isSPARC = false);
bool isOSWindows() const { return isOSWindows_; } bool isOSWindows() const { return isOSWindows_; }
void set_isOSWindows(bool isOSWindows = false) { void set_isOSWindows(bool isOSWindows = false) {
isOSWindows_ = isOSWindows; isOSWindows_ = isOSWindows;
@ -126,6 +129,7 @@ private:
std::uint8_t align_[common::TypeCategory_enumSize][maxKind + 1]{}; std::uint8_t align_[common::TypeCategory_enumSize][maxKind + 1]{};
bool isBigEndian_{false}; bool isBigEndian_{false};
bool isPPC_{false}; bool isPPC_{false};
bool isSPARC_{false};
bool isOSWindows_{false}; bool isOSWindows_{false};
bool haltingSupportIsUnknownAtCompileTime_{false}; bool haltingSupportIsUnknownAtCompileTime_{false};
bool areSubnormalsFlushedToZero_{false}; bool areSubnormalsFlushedToZero_{false};

View File

@ -269,10 +269,8 @@ struct IntrinsicLibrary {
mlir::Value genIeeeCopySign(mlir::Type, llvm::ArrayRef<mlir::Value>); mlir::Value genIeeeCopySign(mlir::Type, llvm::ArrayRef<mlir::Value>);
void genIeeeGetFlag(llvm::ArrayRef<fir::ExtendedValue>); void genIeeeGetFlag(llvm::ArrayRef<fir::ExtendedValue>);
void genIeeeGetHaltingMode(llvm::ArrayRef<fir::ExtendedValue>); void genIeeeGetHaltingMode(llvm::ArrayRef<fir::ExtendedValue>);
template <bool isGet> template <bool isGet, bool isModes>
void genIeeeGetOrSetModes(llvm::ArrayRef<fir::ExtendedValue>); void genIeeeGetOrSetModesOrStatus(llvm::ArrayRef<fir::ExtendedValue>);
template <bool isGet>
void genIeeeGetOrSetStatus(llvm::ArrayRef<fir::ExtendedValue>);
void genIeeeGetRoundingMode(llvm::ArrayRef<fir::ExtendedValue>); void genIeeeGetRoundingMode(llvm::ArrayRef<fir::ExtendedValue>);
void genIeeeGetUnderflowMode(llvm::ArrayRef<fir::ExtendedValue>); void genIeeeGetUnderflowMode(llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genIeeeInt(mlir::Type, llvm::ArrayRef<mlir::Value>); mlir::Value genIeeeInt(mlir::Type, llvm::ArrayRef<mlir::Value>);

View File

@ -33,5 +33,9 @@ mlir::Value genGetUnderflowMode(fir::FirOpBuilder &builder, mlir::Location loc);
void genSetUnderflowMode(fir::FirOpBuilder &builder, mlir::Location loc, void genSetUnderflowMode(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value bit); mlir::Value bit);
mlir::Value genGetModesTypeSize(fir::FirOpBuilder &builder, mlir::Location loc);
mlir::Value genGetStatusTypeSize(fir::FirOpBuilder &builder,
mlir::Location loc);
} // namespace fir::runtime } // namespace fir::runtime
#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXCEPTIONS_H #endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXCEPTIONS_H

View File

@ -13,6 +13,7 @@
#include "flang/Runtime/entry-names.h" #include "flang/Runtime/entry-names.h"
#include <cinttypes> #include <cinttypes>
#include <cstddef>
namespace Fortran::runtime { namespace Fortran::runtime {
@ -32,6 +33,10 @@ bool RTNAME(SupportHalting)(uint32_t except);
bool RTNAME(GetUnderflowMode)(void); bool RTNAME(GetUnderflowMode)(void);
void RTNAME(SetUnderflowMode)(bool flag); void RTNAME(SetUnderflowMode)(bool flag);
// Get the byte size of ieee_modes_type and ieee_status_type data.
std::size_t RTNAME(GetModesTypeSize)(void);
std::size_t RTNAME(GetStatusTypeSize)(void);
} // extern "C" } // extern "C"
} // namespace Fortran::runtime } // namespace Fortran::runtime
#endif // FORTRAN_RUNTIME_EXCEPTIONS_H_ #endif // FORTRAN_RUNTIME_EXCEPTIONS_H_

View File

@ -118,11 +118,10 @@ ieee_arithmetic module rounding procedures.
#define _FORTRAN_RUNTIME_IEEE_OTHER 5 #define _FORTRAN_RUNTIME_IEEE_OTHER 5
#if 0 #if 0
The size of derived types ieee_modes_type and ieee_status_type from intrinsic INTEGER(kind=4) extents for ieee_exceptions module types ieee_modes_type and
module ieee_exceptions must be large enough to hold an fenv.h object of type ieee_status_type. These extent values are large enough to hold femode_t and
femode_t and fenv_t, respectively. These types have members that are declared fenv_t data in many environments. An environment that does not meet these
as int arrays with the following extents to allow build time validation of size constraints may allocate memory with runtime size values.
these sizes in cross compilation environments.
#endif #endif
#define _FORTRAN_RUNTIME_IEEE_FEMODE_T_EXTENT 2 #define _FORTRAN_RUNTIME_IEEE_FEMODE_T_EXTENT 2
#define _FORTRAN_RUNTIME_IEEE_FENV_T_EXTENT 8 #define _FORTRAN_RUNTIME_IEEE_FENV_T_EXTENT 8

View File

@ -71,6 +71,9 @@ namespace Fortran::tools {
if (targetTriple.isPPC()) if (targetTriple.isPPC())
targetCharacteristics.set_isPPC(true); targetCharacteristics.set_isPPC(true);
if (targetTriple.isSPARC())
targetCharacteristics.set_isSPARC(true);
if (targetTriple.isOSWindows()) if (targetTriple.isOSWindows())
targetCharacteristics.set_isOSWindows(true); targetCharacteristics.set_isOSWindows(true);

View File

@ -104,6 +104,7 @@ void TargetCharacteristics::set_isBigEndian(bool isBig) {
} }
void TargetCharacteristics::set_isPPC(bool isPowerPC) { isPPC_ = isPowerPC; } void TargetCharacteristics::set_isPPC(bool isPowerPC) { isPPC_ = isPowerPC; }
void TargetCharacteristics::set_isSPARC(bool isSPARC) { isSPARC_ = isSPARC; }
void TargetCharacteristics::set_areSubnormalsFlushedToZero(bool yes) { void TargetCharacteristics::set_areSubnormalsFlushedToZero(bool yes) {
areSubnormalsFlushedToZero_ = yes; areSubnormalsFlushedToZero_ = yes;

View File

@ -50,6 +50,7 @@
#include "llvm/Support/Debug.h" #include "llvm/Support/Debug.h"
#include "llvm/Support/MathExtras.h" #include "llvm/Support/MathExtras.h"
#include "llvm/Support/raw_ostream.h" #include "llvm/Support/raw_ostream.h"
#include <cfenv> // temporary -- only used in genIeeeGetOrSetModesOrStatus
#include <mlir/IR/Value.h> #include <mlir/IR/Value.h>
#include <optional> #include <optional>
@ -318,13 +319,15 @@ static constexpr IntrinsicHandler handlers[]{
{"ieee_get_halting_mode", {"ieee_get_halting_mode",
&I::genIeeeGetHaltingMode, &I::genIeeeGetHaltingMode,
{{{"flag", asValue}, {"halting", asAddr}}}}, {{{"flag", asValue}, {"halting", asAddr}}}},
{"ieee_get_modes", &I::genIeeeGetOrSetModes</*isGet=*/true>}, {"ieee_get_modes",
&I::genIeeeGetOrSetModesOrStatus</*isGet=*/true, /*isModes=*/true>},
{"ieee_get_rounding_mode", {"ieee_get_rounding_mode",
&I::genIeeeGetRoundingMode, &I::genIeeeGetRoundingMode,
{{{"round_value", asAddr, handleDynamicOptional}, {{{"round_value", asAddr, handleDynamicOptional},
{"radix", asValue, handleDynamicOptional}}}, {"radix", asValue, handleDynamicOptional}}},
/*isElemental=*/false}, /*isElemental=*/false},
{"ieee_get_status", &I::genIeeeGetOrSetStatus</*isGet=*/true>}, {"ieee_get_status",
&I::genIeeeGetOrSetModesOrStatus</*isGet=*/true, /*isModes=*/false>},
{"ieee_get_underflow_mode", {"ieee_get_underflow_mode",
&I::genIeeeGetUnderflowMode, &I::genIeeeGetUnderflowMode,
{{{"gradual", asAddr}}}, {{{"gradual", asAddr}}},
@ -368,13 +371,15 @@ static constexpr IntrinsicHandler handlers[]{
{"ieee_set_flag", &I::genIeeeSetFlagOrHaltingMode</*isFlag=*/true>}, {"ieee_set_flag", &I::genIeeeSetFlagOrHaltingMode</*isFlag=*/true>},
{"ieee_set_halting_mode", {"ieee_set_halting_mode",
&I::genIeeeSetFlagOrHaltingMode</*isFlag=*/false>}, &I::genIeeeSetFlagOrHaltingMode</*isFlag=*/false>},
{"ieee_set_modes", &I::genIeeeGetOrSetModes</*isGet=*/false>}, {"ieee_set_modes",
&I::genIeeeGetOrSetModesOrStatus</*isGet=*/false, /*isModes=*/true>},
{"ieee_set_rounding_mode", {"ieee_set_rounding_mode",
&I::genIeeeSetRoundingMode, &I::genIeeeSetRoundingMode,
{{{"round_value", asValue, handleDynamicOptional}, {{{"round_value", asValue, handleDynamicOptional},
{"radix", asValue, handleDynamicOptional}}}, {"radix", asValue, handleDynamicOptional}}},
/*isElemental=*/false}, /*isElemental=*/false},
{"ieee_set_status", &I::genIeeeGetOrSetStatus</*isGet=*/false>}, {"ieee_set_status",
&I::genIeeeGetOrSetModesOrStatus</*isGet=*/false, /*isModes=*/false>},
{"ieee_set_underflow_mode", &I::genIeeeSetUnderflowMode}, {"ieee_set_underflow_mode", &I::genIeeeSetUnderflowMode},
{"ieee_signaling_eq", {"ieee_signaling_eq",
&I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OEQ>}, &I::genIeeeSignalingCompare<mlir::arith::CmpFPredicate::OEQ>},
@ -4108,11 +4113,12 @@ void IntrinsicLibrary::genRaiseExcept(int excepts, mlir::Value cond) {
// Return a reference to the contents of a derived type with one field. // Return a reference to the contents of a derived type with one field.
// Also return the field type. // Also return the field type.
static std::pair<mlir::Value, mlir::Type> static std::pair<mlir::Value, mlir::Type>
getFieldRef(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value rec) { getFieldRef(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value rec,
unsigned index = 0) {
auto recType = auto recType =
mlir::dyn_cast<fir::RecordType>(fir::unwrapPassByRefType(rec.getType())); mlir::dyn_cast<fir::RecordType>(fir::unwrapPassByRefType(rec.getType()));
assert(recType.getTypeList().size() == 1 && "expected exactly one component"); assert(index < recType.getTypeList().size() && "not enough components");
auto [fieldName, fieldTy] = recType.getTypeList().front(); auto [fieldName, fieldTy] = recType.getTypeList()[index];
mlir::Value field = builder.create<fir::FieldIndexOp>( mlir::Value field = builder.create<fir::FieldIndexOp>(
loc, fir::FieldType::get(recType.getContext()), fieldName, recType, loc, fir::FieldType::get(recType.getContext()), fieldName, recType,
fir::getTypeParams(rec)); fir::getTypeParams(rec));
@ -4502,15 +4508,60 @@ void IntrinsicLibrary::genIeeeGetHaltingMode(
} }
// IEEE_GET_MODES, IEEE_SET_MODES // IEEE_GET_MODES, IEEE_SET_MODES
template <bool isGet> // IEEE_GET_STATUS, IEEE_SET_STATUS
void IntrinsicLibrary::genIeeeGetOrSetModes( template <bool isGet, bool isModes>
void IntrinsicLibrary::genIeeeGetOrSetModesOrStatus(
llvm::ArrayRef<fir::ExtendedValue> args) { llvm::ArrayRef<fir::ExtendedValue> args) {
assert(args.size() == 1); assert(args.size() == 1);
mlir::Type ptrTy = builder.getRefType(builder.getIntegerType(32)); #ifndef __GLIBC_USE_IEC_60559_BFP_EXT // only use of "#include <cfenv>"
// No definitions of fegetmode, fesetmode
llvm::StringRef func = isModes
? (isGet ? "ieee_get_modes" : "ieee_set_modes")
: (isGet ? "ieee_get_status" : "ieee_set_status");
TODO(loc, "intrinsic module procedure: " + func);
#else
mlir::Type i32Ty = builder.getIntegerType(32); mlir::Type i32Ty = builder.getIntegerType(32);
mlir::Value addr = mlir::Type i64Ty = builder.getIntegerType(64);
builder.create<fir::ConvertOp>(loc, ptrTy, getBase(args[0])); mlir::Type ptrTy = builder.getRefType(i32Ty);
genRuntimeCall(isGet ? "fegetmode" : "fesetmode", i32Ty, addr); mlir::Value addr;
if (fir::getTargetTriple(builder.getModule()).isSPARC()) {
// Floating point environment data is larger than the __data field
// allotment. Allocate data space from the heap.
auto [fieldRef, fieldTy] =
getFieldRef(builder, loc, fir::getBase(args[0]), 1);
addr = builder.create<fir::BoxAddrOp>(
loc, builder.create<fir::LoadOp>(loc, fieldRef));
mlir::Type heapTy = addr.getType();
mlir::Value allocated = builder.create<mlir::arith::CmpIOp>(
loc, mlir::arith::CmpIPredicate::ne,
builder.createConvert(loc, i64Ty, addr),
builder.createIntegerConstant(loc, i64Ty, 0));
auto ifOp = builder.create<fir::IfOp>(loc, heapTy, allocated,
/*withElseRegion=*/true);
builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
builder.create<fir::ResultOp>(loc, addr);
builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
mlir::Value byteSize =
isModes ? fir::runtime::genGetModesTypeSize(builder, loc)
: fir::runtime::genGetStatusTypeSize(builder, loc);
byteSize = builder.createConvert(loc, builder.getIndexType(), byteSize);
addr =
builder.create<fir::AllocMemOp>(loc, extractSequenceType(heapTy),
/*typeparams=*/std::nullopt, byteSize);
mlir::Value shape = builder.create<fir::ShapeOp>(loc, byteSize);
builder.create<fir::StoreOp>(
loc, builder.create<fir::EmboxOp>(loc, fieldTy, addr, shape), fieldRef);
builder.create<fir::ResultOp>(loc, addr);
builder.setInsertionPointAfter(ifOp);
addr = builder.create<fir::ConvertOp>(loc, ptrTy, ifOp.getResult(0));
} else {
// Place floating point environment data in __data storage.
addr = builder.create<fir::ConvertOp>(loc, ptrTy, getBase(args[0]));
}
llvm::StringRef func = isModes ? (isGet ? "fegetmode" : "fesetmode")
: (isGet ? "fegetenv" : "fesetenv");
genRuntimeCall(func, i32Ty, addr);
#endif
} }
// Check that an explicit ieee_[get|set]_rounding_mode call radix value is 2. // Check that an explicit ieee_[get|set]_rounding_mode call radix value is 2.
@ -4543,18 +4594,6 @@ void IntrinsicLibrary::genIeeeGetRoundingMode(
builder.create<fir::StoreOp>(loc, mode, fieldRef); builder.create<fir::StoreOp>(loc, mode, fieldRef);
} }
// IEEE_GET_STATUS, IEEE_SET_STATUS
template <bool isGet>
void IntrinsicLibrary::genIeeeGetOrSetStatus(
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 ? "fegetenv" : "fesetenv", i32Ty, addr);
}
// IEEE_GET_UNDERFLOW_MODE // IEEE_GET_UNDERFLOW_MODE
void IntrinsicLibrary::genIeeeGetUnderflowMode( void IntrinsicLibrary::genIeeeGetUnderflowMode(
llvm::ArrayRef<fir::ExtendedValue> args) { llvm::ArrayRef<fir::ExtendedValue> args) {

View File

@ -42,3 +42,17 @@ void fir::runtime::genSetUnderflowMode(fir::FirOpBuilder &builder,
fir::runtime::getRuntimeFunc<mkRTKey(SetUnderflowMode)>(loc, builder)}; fir::runtime::getRuntimeFunc<mkRTKey(SetUnderflowMode)>(loc, builder)};
builder.create<fir::CallOp>(loc, func, flag); builder.create<fir::CallOp>(loc, func, flag);
} }
mlir::Value fir::runtime::genGetModesTypeSize(fir::FirOpBuilder &builder,
mlir::Location loc) {
mlir::func::FuncOp func{
fir::runtime::getRuntimeFunc<mkRTKey(GetModesTypeSize)>(loc, builder)};
return builder.create<fir::CallOp>(loc, func).getResult(0);
}
mlir::Value fir::runtime::genGetStatusTypeSize(fir::FirOpBuilder &builder,
mlir::Location loc) {
mlir::func::FuncOp func{
fir::runtime::getRuntimeFunc<mkRTKey(GetStatusTypeSize)>(loc, builder)};
return builder.create<fir::CallOp>(loc, func).getResult(0);
}

View File

@ -36,13 +36,15 @@ module __fortran_ieee_exceptions
ieee_all(*) = [ ieee_usual, ieee_underflow, ieee_inexact ] ieee_all(*) = [ ieee_usual, ieee_underflow, ieee_inexact ]
type, public :: ieee_modes_type ! Fortran 2018, 17.7 type, public :: ieee_modes_type ! Fortran 2018, 17.7
private ! opaque fenv.h femode_t data private ! opaque fenv.h femode_t data; code will access only one component
integer(kind=4) :: __data(_FORTRAN_RUNTIME_IEEE_FEMODE_T_EXTENT) integer(kind=4) :: __data(_FORTRAN_RUNTIME_IEEE_FEMODE_T_EXTENT)
integer(kind=1), allocatable :: __allocatable_data(:)
end type ieee_modes_type end type ieee_modes_type
type, public :: ieee_status_type ! Fortran 2018, 17.7 type, public :: ieee_status_type ! Fortran 2018, 17.7
private ! opaque fenv.h fenv_t data private ! opaque fenv.h fenv_t data; code will access only one component
integer(kind=4) :: __data(_FORTRAN_RUNTIME_IEEE_FENV_T_EXTENT) integer(kind=4) :: __data(_FORTRAN_RUNTIME_IEEE_FENV_T_EXTENT)
integer(kind=1), allocatable :: __allocatable_data(:)
end type ieee_status_type end type ieee_status_type
! Define specifics with 1 LOGICAL or REAL argument for generic G. ! Define specifics with 1 LOGICAL or REAL argument for generic G.

View File

@ -15,14 +15,10 @@
#include <xmmintrin.h> #include <xmmintrin.h>
#endif #endif
// When not supported, these macro are undefined in cfenv.h, // fenv.h may not define exception macros.
// set them to zero in that case.
#ifndef FE_INVALID #ifndef FE_INVALID
#define FE_INVALID 0 #define FE_INVALID 0
#endif #endif
#ifndef __FE_DENORM
#define __FE_DENORM 0 // denorm is nonstandard
#endif
#ifndef FE_DIVBYZERO #ifndef FE_DIVBYZERO
#define FE_DIVBYZERO 0 #define FE_DIVBYZERO 0
#endif #endif
@ -46,7 +42,11 @@ uint32_t RTNAME(MapException)(uint32_t excepts) {
Terminator terminator{__FILE__, __LINE__}; Terminator terminator{__FILE__, __LINE__};
static constexpr uint32_t v{FE_INVALID}; static constexpr uint32_t v{FE_INVALID};
static constexpr uint32_t s{__FE_DENORM}; // subnormal #if __x86_64__
static constexpr uint32_t s{__FE_DENORM}; // nonstandard, not a #define
#else
static constexpr uint32_t s{0};
#endif
static constexpr uint32_t z{FE_DIVBYZERO}; static constexpr uint32_t z{FE_DIVBYZERO};
static constexpr uint32_t o{FE_OVERFLOW}; static constexpr uint32_t o{FE_OVERFLOW};
static constexpr uint32_t u{FE_UNDERFLOW}; static constexpr uint32_t u{FE_UNDERFLOW};
@ -62,25 +62,13 @@ uint32_t RTNAME(MapException)(uint32_t excepts) {
static constexpr uint32_t map[]{xm}; static constexpr uint32_t map[]{xm};
static constexpr uint32_t mapSize{sizeof(map) / sizeof(uint32_t)}; static constexpr uint32_t mapSize{sizeof(map) / sizeof(uint32_t)};
static_assert(mapSize == 64); static_assert(mapSize == 64);
if (excepts == 0 || excepts >= mapSize) { if (excepts >= mapSize) {
terminator.Crash("Invalid excepts value: %d", excepts); terminator.Crash("Invalid excepts value: %d", excepts);
} }
uint32_t except_value = map[excepts]; uint32_t except_value = map[excepts];
if (except_value == 0) {
terminator.Crash(
"Excepts value %d not supported by flang runtime", excepts);
}
return except_value; return except_value;
} }
// 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 fenv_t object.
// TODO: fenv_t can be way larger than
// sizeof(int) * _FORTRAN_RUNTIME_IEEE_FENV_T_EXTENT
// on some systems, e.g. Solaris, so omit object size comparison for now.
// TODO: consider femode_t object size comparison once its more mature.
// Check if the processor has the ability to control whether to halt or // Check if the processor has the ability to control whether to halt or
// continue execution when a given exception is raised. // continue execution when a given exception is raised.
bool RTNAME(SupportHalting)([[maybe_unused]] uint32_t except) { bool RTNAME(SupportHalting)([[maybe_unused]] uint32_t except) {
@ -103,7 +91,7 @@ bool RTNAME(SupportHalting)([[maybe_unused]] uint32_t except) {
} }
bool RTNAME(GetUnderflowMode)(void) { bool RTNAME(GetUnderflowMode)(void) {
#if __x86_64__ #if _MM_FLUSH_ZERO_MASK
// The MXCSR Flush to Zero flag is the negation of the ieee_get_underflow_mode // The MXCSR Flush to Zero flag is the negation of the ieee_get_underflow_mode
// GRADUAL argument. It affects real computations of kinds 3, 4, and 8. // GRADUAL argument. It affects real computations of kinds 3, 4, and 8.
return _MM_GET_FLUSH_ZERO_MODE() == _MM_FLUSH_ZERO_OFF; return _MM_GET_FLUSH_ZERO_MODE() == _MM_FLUSH_ZERO_OFF;
@ -112,12 +100,23 @@ bool RTNAME(GetUnderflowMode)(void) {
#endif #endif
} }
void RTNAME(SetUnderflowMode)(bool flag) { void RTNAME(SetUnderflowMode)(bool flag) {
#if __x86_64__ #if _MM_FLUSH_ZERO_MASK
// The MXCSR Flush to Zero flag is the negation of the ieee_set_underflow_mode // The MXCSR Flush to Zero flag is the negation of the ieee_set_underflow_mode
// GRADUAL argument. It affects real computations of kinds 3, 4, and 8. // GRADUAL argument. It affects real computations of kinds 3, 4, and 8.
_MM_SET_FLUSH_ZERO_MODE(flag ? _MM_FLUSH_ZERO_OFF : _MM_FLUSH_ZERO_ON); _MM_SET_FLUSH_ZERO_MODE(flag ? _MM_FLUSH_ZERO_OFF : _MM_FLUSH_ZERO_ON);
#endif #endif
} }
size_t RTNAME(GetModesTypeSize)(void) {
#ifdef __GLIBC_USE_IEC_60559_BFP_EXT
return sizeof(femode_t); // byte size of ieee_modes_type data
#else
return 8; // femode_t is not defined
#endif
}
size_t RTNAME(GetStatusTypeSize)(void) {
return sizeof(fenv_t); // byte size of ieee_status_type data
}
} // extern "C" } // extern "C"
} // namespace Fortran::runtime } // namespace Fortran::runtime

View File

@ -1,82 +0,0 @@
! RUN: bbc -emit-fir -o - %s | FileCheck %s
! CHECK-LABEL: c.func @_QQmain
program m
use ieee_arithmetic
use ieee_exceptions
! CHECK: %[[VAL_69:.*]] = 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: %[[VAL_70:.*]] = fir.declare %[[VAL_69]] {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: %[[VAL_71:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_ieee_round_type{_QM__fortran_builtinsT__builtin_ieee_round_type.mode:i8}> {bindc_name = "round", uniq_name = "_QFEround"}
! CHECK: %[[VAL_72:.*]] = fir.declare %[[VAL_71]] {uniq_name = "_QFEround"} : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_round_type{_QM__fortran_builtinsT__builtin_ieee_round_type.mode:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_round_type{_QM__fortran_builtinsT__builtin_ieee_round_type.mode:i8}>>
type(ieee_round_type) :: round
! CHECK: %[[VAL_78:.*]] = fir.address_of(@_QQro._QM__fortran_builtinsT__builtin_ieee_round_type.0) : !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_round_type{_QM__fortran_builtinsT__builtin_ieee_round_type.mode:i8}>>
! CHECK: %[[VAL_79:.*]] = fir.declare %[[VAL_78]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_builtinsT__builtin_ieee_round_type.0"} : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_round_type{_QM__fortran_builtinsT__builtin_ieee_round_type.mode:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_round_type{_QM__fortran_builtinsT__builtin_ieee_round_type.mode:i8}>>
! CHECK: %[[VAL_80:.*]] = fir.field_index _QM__fortran_builtinsT__builtin_ieee_round_type.mode, !fir.type<_QM__fortran_builtinsT__builtin_ieee_round_type{_QM__fortran_builtinsT__builtin_ieee_round_type.mode:i8}>
! CHECK: %[[VAL_81:.*]] = fir.coordinate_of %[[VAL_79]], %[[VAL_80]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_round_type{_QM__fortran_builtinsT__builtin_ieee_round_type.mode:i8}>>, !fir.field) -> !fir.ref<i8>
! CHECK: %[[VAL_82:.*]] = fir.load %[[VAL_81]] : !fir.ref<i8>
! CHECK: %[[VAL_83:.*]] = fir.convert %[[VAL_82]] : (i8) -> i32
! CHECK: fir.call @llvm.set.rounding(%[[VAL_83]]) fastmath<contract> : (i32) -> ()
call ieee_set_rounding_mode(ieee_up)
! CHECK: %[[VAL_84:.*]] = fir.coordinate_of %[[VAL_72]], %[[VAL_80]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_round_type{_QM__fortran_builtinsT__builtin_ieee_round_type.mode:i8}>>, !fir.field) -> !fir.ref<i8>
! CHECK: %[[VAL_85:.*]] = fir.call @llvm.get.rounding() fastmath<contract> : () -> i32
! CHECK: %[[VAL_86:.*]] = fir.convert %[[VAL_85]] : (i32) -> i8
! CHECK: fir.store %[[VAL_86]] to %[[VAL_84]] : !fir.ref<i8>
call ieee_get_rounding_mode(round)
print*, 'rounding_mode [up ] : ', mode_name(round)
! CHECK: %[[VAL_103:.*]] = fir.convert %[[VAL_70]] : (!fir.ref<!fir.type<_QM__fortran_ieee_exceptionsTieee_modes_type{_QM__fortran_ieee_exceptionsTieee_modes_type.__data:!fir.array<2xi32>}>>) -> !fir.ref<i32>
! CHECK: %[[VAL_104:.*]] = fir.call @fegetmode(%[[VAL_103]]) fastmath<contract> : (!fir.ref<i32>) -> i32
call ieee_get_modes(modes)
! CHECK: %[[VAL_105:.*]] = fir.address_of(@_QQro._QM__fortran_builtinsT__builtin_ieee_round_type.1) : !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_round_type{_QM__fortran_builtinsT__builtin_ieee_round_type.mode:i8}>>
! CHECK: %[[VAL_106:.*]] = fir.declare %[[VAL_105]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro._QM__fortran_builtinsT__builtin_ieee_round_type.1"} : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_round_type{_QM__fortran_builtinsT__builtin_ieee_round_type.mode:i8}>>) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_round_type{_QM__fortran_builtinsT__builtin_ieee_round_type.mode:i8}>>
! CHECK: %[[VAL_107:.*]] = fir.coordinate_of %[[VAL_106]], %[[VAL_80]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_round_type{_QM__fortran_builtinsT__builtin_ieee_round_type.mode:i8}>>, !fir.field) -> !fir.ref<i8>
! CHECK: %[[VAL_108:.*]] = fir.load %[[VAL_107]] : !fir.ref<i8>
! CHECK: %[[VAL_109:.*]] = fir.convert %[[VAL_108]] : (i8) -> i32
! CHECK: fir.call @llvm.set.rounding(%[[VAL_109]]) fastmath<contract> : (i32) -> ()
call ieee_set_rounding_mode(ieee_to_zero)
! CHECK: %[[VAL_110:.*]] = fir.call @llvm.get.rounding() fastmath<contract> : () -> i32
! CHECK: %[[VAL_111:.*]] = fir.convert %[[VAL_110]] : (i32) -> i8
! CHECK: fir.store %[[VAL_111]] to %[[VAL_84]] : !fir.ref<i8>
call ieee_get_rounding_mode(round)
print*, 'rounding_mode [to_zero] : ', mode_name(round)
! CHECK: %[[VAL_126:.*]] = fir.call @fesetmode(%[[VAL_103]]) fastmath<contract> : (!fir.ref<i32>) -> i32
call ieee_set_modes(modes)
! CHECK: %[[VAL_127:.*]] = fir.call @llvm.get.rounding() fastmath<contract> : () -> i32
! CHECK: %[[VAL_128:.*]] = fir.convert %[[VAL_127]] : (i32) -> i8
! CHECK: fir.store %[[VAL_128]] to %[[VAL_84]] : !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

View File

@ -1,120 +0,0 @@
! 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_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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_builtinsT__builtin_ieee_flag_type.0) : !fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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_builtinsT__builtin_ieee_flag_type.0"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_96:[0-9]+]] = fir.field_index _QM__fortran_builtinsT__builtin_ieee_flag_type.flag, !fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>
! CHECK: %[[V_97:[0-9]+]] = fir.coordinate_of %[[V_95]], %[[V_96]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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_builtinsT__builtin_ieee_flag_type.0"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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_builtinsT__builtin_ieee_flag_type.flag, !fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>
! CHECK: %[[V_98:[0-9]+]] = fir.coordinate_of %[[V_95]], %[[V_97]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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_builtinsT__builtin_ieee_flag_type.1) : !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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_builtinsT__builtin_ieee_flag_type.1"} : (!fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<3x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>
! CHECK: %[[V_96:[0-9]+]] = fir.field_index _QM__fortran_builtinsT__builtin_ieee_flag_type.flag, !fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>
! CHECK: %[[V_97:[0-9]+]] = fir.coordinate_of %[[V_95]], %[[V_96]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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_builtinsT__builtin_ieee_flag_type.0"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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_builtinsT__builtin_ieee_flag_type.flag, !fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>
! CHECK: %[[V_98:[0-9]+]] = fir.coordinate_of %[[V_95]], %[[V_97]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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_builtinsT__builtin_ieee_flag_type.0"} : (!fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<5x!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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_builtinsT__builtin_ieee_flag_type.flag, !fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_flag_type.flag:i8}>
! CHECK: %[[V_98:[0-9]+]] = fir.coordinate_of %[[V_95]], %[[V_97]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_ieee_flag_type{_QM__fortran_builtinsT__builtin_ieee_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