diff --git a/flang/include/flang/Evaluate/target.h b/flang/include/flang/Evaluate/target.h index 154561ce868e..e07f916b875e 100644 --- a/flang/include/flang/Evaluate/target.h +++ b/flang/include/flang/Evaluate/target.h @@ -112,6 +112,9 @@ public: bool isPPC() const { return isPPC_; } void set_isPPC(bool isPPC = false); + bool isSPARC() const { return isSPARC_; } + void set_isSPARC(bool isSPARC = false); + bool isOSWindows() const { return isOSWindows_; } void set_isOSWindows(bool isOSWindows = false) { isOSWindows_ = isOSWindows; @@ -126,6 +129,7 @@ private: std::uint8_t align_[common::TypeCategory_enumSize][maxKind + 1]{}; bool isBigEndian_{false}; bool isPPC_{false}; + bool isSPARC_{false}; bool isOSWindows_{false}; bool haltingSupportIsUnknownAtCompileTime_{false}; bool areSubnormalsFlushedToZero_{false}; diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h index 18f84c7021e1..9c9c0609f4fc 100644 --- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h +++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h @@ -269,10 +269,8 @@ struct IntrinsicLibrary { mlir::Value genIeeeCopySign(mlir::Type, llvm::ArrayRef); void genIeeeGetFlag(llvm::ArrayRef); void genIeeeGetHaltingMode(llvm::ArrayRef); - template - void genIeeeGetOrSetModes(llvm::ArrayRef); - template - void genIeeeGetOrSetStatus(llvm::ArrayRef); + template + void genIeeeGetOrSetModesOrStatus(llvm::ArrayRef); void genIeeeGetRoundingMode(llvm::ArrayRef); void genIeeeGetUnderflowMode(llvm::ArrayRef); mlir::Value genIeeeInt(mlir::Type, llvm::ArrayRef); diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h b/flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h index f44e0c95ef6d..7487444f3a7a 100644 --- a/flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h +++ b/flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h @@ -33,5 +33,9 @@ mlir::Value genGetUnderflowMode(fir::FirOpBuilder &builder, mlir::Location loc); void genSetUnderflowMode(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value bit); +mlir::Value genGetModesTypeSize(fir::FirOpBuilder &builder, mlir::Location loc); +mlir::Value genGetStatusTypeSize(fir::FirOpBuilder &builder, + mlir::Location loc); + } // namespace fir::runtime #endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXCEPTIONS_H diff --git a/flang/include/flang/Runtime/exceptions.h b/flang/include/flang/Runtime/exceptions.h index 483d0271bcab..62c21f01c128 100644 --- a/flang/include/flang/Runtime/exceptions.h +++ b/flang/include/flang/Runtime/exceptions.h @@ -13,6 +13,7 @@ #include "flang/Runtime/entry-names.h" #include +#include namespace Fortran::runtime { @@ -32,6 +33,10 @@ bool RTNAME(SupportHalting)(uint32_t except); bool RTNAME(GetUnderflowMode)(void); 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" } // namespace Fortran::runtime #endif // FORTRAN_RUNTIME_EXCEPTIONS_H_ diff --git a/flang/include/flang/Runtime/magic-numbers.h b/flang/include/flang/Runtime/magic-numbers.h index 1d3c5dca0b4b..6788ba098bcf 100644 --- a/flang/include/flang/Runtime/magic-numbers.h +++ b/flang/include/flang/Runtime/magic-numbers.h @@ -118,11 +118,10 @@ ieee_arithmetic module rounding procedures. #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. +INTEGER(kind=4) extents for ieee_exceptions module types ieee_modes_type and +ieee_status_type. These extent values are large enough to hold femode_t and +fenv_t data in many environments. An environment that does not meet these +size constraints may allocate memory with runtime size values. #endif #define _FORTRAN_RUNTIME_IEEE_FEMODE_T_EXTENT 2 #define _FORTRAN_RUNTIME_IEEE_FENV_T_EXTENT 8 diff --git a/flang/include/flang/Tools/TargetSetup.h b/flang/include/flang/Tools/TargetSetup.h index 709c4bbe4b7b..d1b0da3a42c8 100644 --- a/flang/include/flang/Tools/TargetSetup.h +++ b/flang/include/flang/Tools/TargetSetup.h @@ -71,6 +71,9 @@ namespace Fortran::tools { if (targetTriple.isPPC()) targetCharacteristics.set_isPPC(true); + if (targetTriple.isSPARC()) + targetCharacteristics.set_isSPARC(true); + if (targetTriple.isOSWindows()) targetCharacteristics.set_isOSWindows(true); diff --git a/flang/lib/Evaluate/target.cpp b/flang/lib/Evaluate/target.cpp index 409e28c767e1..94dc35ecd590 100644 --- a/flang/lib/Evaluate/target.cpp +++ b/flang/lib/Evaluate/target.cpp @@ -104,6 +104,7 @@ void TargetCharacteristics::set_isBigEndian(bool isBig) { } void TargetCharacteristics::set_isPPC(bool isPowerPC) { isPPC_ = isPowerPC; } +void TargetCharacteristics::set_isSPARC(bool isSPARC) { isSPARC_ = isSPARC; } void TargetCharacteristics::set_areSubnormalsFlushedToZero(bool yes) { areSubnormalsFlushedToZero_ = yes; diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index e6d0f044dcf8..f6f2e15e469e 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -50,6 +50,7 @@ #include "llvm/Support/Debug.h" #include "llvm/Support/MathExtras.h" #include "llvm/Support/raw_ostream.h" +#include // temporary -- only used in genIeeeGetOrSetModesOrStatus #include #include @@ -318,13 +319,15 @@ static constexpr IntrinsicHandler handlers[]{ {"ieee_get_halting_mode", &I::genIeeeGetHaltingMode, {{{"flag", asValue}, {"halting", asAddr}}}}, - {"ieee_get_modes", &I::genIeeeGetOrSetModes}, + {"ieee_get_modes", + &I::genIeeeGetOrSetModesOrStatus}, {"ieee_get_rounding_mode", &I::genIeeeGetRoundingMode, {{{"round_value", asAddr, handleDynamicOptional}, {"radix", asValue, handleDynamicOptional}}}, /*isElemental=*/false}, - {"ieee_get_status", &I::genIeeeGetOrSetStatus}, + {"ieee_get_status", + &I::genIeeeGetOrSetModesOrStatus}, {"ieee_get_underflow_mode", &I::genIeeeGetUnderflowMode, {{{"gradual", asAddr}}}, @@ -368,13 +371,15 @@ static constexpr IntrinsicHandler handlers[]{ {"ieee_set_flag", &I::genIeeeSetFlagOrHaltingMode}, {"ieee_set_halting_mode", &I::genIeeeSetFlagOrHaltingMode}, - {"ieee_set_modes", &I::genIeeeGetOrSetModes}, + {"ieee_set_modes", + &I::genIeeeGetOrSetModesOrStatus}, {"ieee_set_rounding_mode", &I::genIeeeSetRoundingMode, {{{"round_value", asValue, handleDynamicOptional}, {"radix", asValue, handleDynamicOptional}}}, /*isElemental=*/false}, - {"ieee_set_status", &I::genIeeeGetOrSetStatus}, + {"ieee_set_status", + &I::genIeeeGetOrSetModesOrStatus}, {"ieee_set_underflow_mode", &I::genIeeeSetUnderflowMode}, {"ieee_signaling_eq", &I::genIeeeSignalingCompare}, @@ -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. // Also return the field type. static std::pair -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 = mlir::dyn_cast(fir::unwrapPassByRefType(rec.getType())); - assert(recType.getTypeList().size() == 1 && "expected exactly one component"); - auto [fieldName, fieldTy] = recType.getTypeList().front(); + assert(index < recType.getTypeList().size() && "not enough components"); + auto [fieldName, fieldTy] = recType.getTypeList()[index]; mlir::Value field = builder.create( loc, fir::FieldType::get(recType.getContext()), fieldName, recType, fir::getTypeParams(rec)); @@ -4502,15 +4508,60 @@ void IntrinsicLibrary::genIeeeGetHaltingMode( } // IEEE_GET_MODES, IEEE_SET_MODES -template -void IntrinsicLibrary::genIeeeGetOrSetModes( +// IEEE_GET_STATUS, IEEE_SET_STATUS +template +void IntrinsicLibrary::genIeeeGetOrSetModesOrStatus( llvm::ArrayRef args) { assert(args.size() == 1); - mlir::Type ptrTy = builder.getRefType(builder.getIntegerType(32)); +#ifndef __GLIBC_USE_IEC_60559_BFP_EXT // only use of "#include " + // 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::Value addr = - builder.create(loc, ptrTy, getBase(args[0])); - genRuntimeCall(isGet ? "fegetmode" : "fesetmode", i32Ty, addr); + mlir::Type i64Ty = builder.getIntegerType(64); + mlir::Type ptrTy = builder.getRefType(i32Ty); + 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( + loc, builder.create(loc, fieldRef)); + mlir::Type heapTy = addr.getType(); + mlir::Value allocated = builder.create( + loc, mlir::arith::CmpIPredicate::ne, + builder.createConvert(loc, i64Ty, addr), + builder.createIntegerConstant(loc, i64Ty, 0)); + auto ifOp = builder.create(loc, heapTy, allocated, + /*withElseRegion=*/true); + builder.setInsertionPointToStart(&ifOp.getThenRegion().front()); + builder.create(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(loc, extractSequenceType(heapTy), + /*typeparams=*/std::nullopt, byteSize); + mlir::Value shape = builder.create(loc, byteSize); + builder.create( + loc, builder.create(loc, fieldTy, addr, shape), fieldRef); + builder.create(loc, addr); + builder.setInsertionPointAfter(ifOp); + addr = builder.create(loc, ptrTy, ifOp.getResult(0)); + } else { + // Place floating point environment data in __data storage. + addr = builder.create(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. @@ -4543,18 +4594,6 @@ void IntrinsicLibrary::genIeeeGetRoundingMode( builder.create(loc, mode, fieldRef); } -// IEEE_GET_STATUS, IEEE_SET_STATUS -template -void IntrinsicLibrary::genIeeeGetOrSetStatus( - llvm::ArrayRef args) { - assert(args.size() == 1); - mlir::Type ptrTy = builder.getRefType(builder.getIntegerType(32)); - mlir::Type i32Ty = builder.getIntegerType(32); - mlir::Value addr = - builder.create(loc, ptrTy, getBase(args[0])); - genRuntimeCall(isGet ? "fegetenv" : "fesetenv", i32Ty, addr); -} - // IEEE_GET_UNDERFLOW_MODE void IntrinsicLibrary::genIeeeGetUnderflowMode( llvm::ArrayRef args) { diff --git a/flang/lib/Optimizer/Builder/Runtime/Exceptions.cpp b/flang/lib/Optimizer/Builder/Runtime/Exceptions.cpp index 630281fdb593..c545b3d00b4d 100644 --- a/flang/lib/Optimizer/Builder/Runtime/Exceptions.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Exceptions.cpp @@ -42,3 +42,17 @@ void fir::runtime::genSetUnderflowMode(fir::FirOpBuilder &builder, fir::runtime::getRuntimeFunc(loc, builder)}; builder.create(loc, func, flag); } + +mlir::Value fir::runtime::genGetModesTypeSize(fir::FirOpBuilder &builder, + mlir::Location loc) { + mlir::func::FuncOp func{ + fir::runtime::getRuntimeFunc(loc, builder)}; + return builder.create(loc, func).getResult(0); +} + +mlir::Value fir::runtime::genGetStatusTypeSize(fir::FirOpBuilder &builder, + mlir::Location loc) { + mlir::func::FuncOp func{ + fir::runtime::getRuntimeFunc(loc, builder)}; + return builder.create(loc, func).getResult(0); +} diff --git a/flang/module/__fortran_ieee_exceptions.f90 b/flang/module/__fortran_ieee_exceptions.f90 index 6691012eda23..3ac9b993186a 100644 --- a/flang/module/__fortran_ieee_exceptions.f90 +++ b/flang/module/__fortran_ieee_exceptions.f90 @@ -36,13 +36,15 @@ module __fortran_ieee_exceptions ieee_all(*) = [ ieee_usual, ieee_underflow, ieee_inexact ] 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=1), allocatable :: __allocatable_data(:) end type ieee_modes_type 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=1), allocatable :: __allocatable_data(:) end type ieee_status_type ! Define specifics with 1 LOGICAL or REAL argument for generic G. diff --git a/flang/runtime/exceptions.cpp b/flang/runtime/exceptions.cpp index 2fa2baa2ec84..f541b8e844ad 100644 --- a/flang/runtime/exceptions.cpp +++ b/flang/runtime/exceptions.cpp @@ -15,14 +15,10 @@ #include #endif -// When not supported, these macro are undefined in cfenv.h, -// set them to zero in that case. +// fenv.h may not define exception macros. #ifndef FE_INVALID #define FE_INVALID 0 #endif -#ifndef __FE_DENORM -#define __FE_DENORM 0 // denorm is nonstandard -#endif #ifndef FE_DIVBYZERO #define FE_DIVBYZERO 0 #endif @@ -46,7 +42,11 @@ uint32_t RTNAME(MapException)(uint32_t excepts) { Terminator terminator{__FILE__, __LINE__}; 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 o{FE_OVERFLOW}; 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 mapSize{sizeof(map) / sizeof(uint32_t)}; static_assert(mapSize == 64); - if (excepts == 0 || excepts >= mapSize) { + if (excepts >= mapSize) { terminator.Crash("Invalid excepts value: %d", 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; } -// 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 // continue execution when a given exception is raised. bool RTNAME(SupportHalting)([[maybe_unused]] uint32_t except) { @@ -103,7 +91,7 @@ bool RTNAME(SupportHalting)([[maybe_unused]] uint32_t except) { } 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 // GRADUAL argument. It affects real computations of kinds 3, 4, and 8. return _MM_GET_FLUSH_ZERO_MODE() == _MM_FLUSH_ZERO_OFF; @@ -112,12 +100,23 @@ bool RTNAME(GetUnderflowMode)(void) { #endif } 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 // 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); #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" } // namespace Fortran::runtime diff --git a/flang/test/Lower/Intrinsics/ieee_femodes.f90 b/flang/test/Lower/Intrinsics/ieee_femodes.f90 deleted file mode 100644 index abb264cb027e..000000000000 --- a/flang/test/Lower/Intrinsics/ieee_femodes.f90 +++ /dev/null @@ -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.ref}>> - 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.ref> - type(ieee_round_type) :: round - - ! CHECK: %[[VAL_78:.*]] = fir.address_of(@_QQro._QM__fortran_builtinsT__builtin_ieee_round_type.0) : !fir.ref> - ! CHECK: %[[VAL_79:.*]] = fir.declare %[[VAL_78]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QQro._QM__fortran_builtinsT__builtin_ieee_round_type.0"} : (!fir.ref>) -> !fir.ref> - - ! 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.field) -> !fir.ref - ! CHECK: %[[VAL_82:.*]] = fir.load %[[VAL_81]] : !fir.ref - ! CHECK: %[[VAL_83:.*]] = fir.convert %[[VAL_82]] : (i8) -> i32 - ! CHECK: fir.call @llvm.set.rounding(%[[VAL_83]]) fastmath : (i32) -> () - call ieee_set_rounding_mode(ieee_up) - - ! CHECK: %[[VAL_84:.*]] = fir.coordinate_of %[[VAL_72]], %[[VAL_80]] : (!fir.ref>, !fir.field) -> !fir.ref - ! CHECK: %[[VAL_85:.*]] = fir.call @llvm.get.rounding() fastmath : () -> i32 - ! CHECK: %[[VAL_86:.*]] = fir.convert %[[VAL_85]] : (i32) -> i8 - ! CHECK: fir.store %[[VAL_86]] to %[[VAL_84]] : !fir.ref - call ieee_get_rounding_mode(round) - - print*, 'rounding_mode [up ] : ', mode_name(round) - - ! CHECK: %[[VAL_103:.*]] = fir.convert %[[VAL_70]] : (!fir.ref}>>) -> !fir.ref - ! CHECK: %[[VAL_104:.*]] = fir.call @fegetmode(%[[VAL_103]]) fastmath : (!fir.ref) -> i32 - call ieee_get_modes(modes) - - ! CHECK: %[[VAL_105:.*]] = fir.address_of(@_QQro._QM__fortran_builtinsT__builtin_ieee_round_type.1) : !fir.ref> - ! CHECK: %[[VAL_106:.*]] = fir.declare %[[VAL_105]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QQro._QM__fortran_builtinsT__builtin_ieee_round_type.1"} : (!fir.ref>) -> !fir.ref> - ! CHECK: %[[VAL_107:.*]] = fir.coordinate_of %[[VAL_106]], %[[VAL_80]] : (!fir.ref>, !fir.field) -> !fir.ref - ! CHECK: %[[VAL_108:.*]] = fir.load %[[VAL_107]] : !fir.ref - ! CHECK: %[[VAL_109:.*]] = fir.convert %[[VAL_108]] : (i8) -> i32 - ! CHECK: fir.call @llvm.set.rounding(%[[VAL_109]]) fastmath : (i32) -> () - call ieee_set_rounding_mode(ieee_to_zero) - - ! CHECK: %[[VAL_110:.*]] = fir.call @llvm.get.rounding() fastmath : () -> i32 - ! CHECK: %[[VAL_111:.*]] = fir.convert %[[VAL_110]] : (i32) -> i8 - ! CHECK: fir.store %[[VAL_111]] to %[[VAL_84]] : !fir.ref - call ieee_get_rounding_mode(round) - - print*, 'rounding_mode [to_zero] : ', mode_name(round) - - ! CHECK: %[[VAL_126:.*]] = fir.call @fesetmode(%[[VAL_103]]) fastmath : (!fir.ref) -> i32 - call ieee_set_modes(modes) - - ! CHECK: %[[VAL_127:.*]] = fir.call @llvm.get.rounding() fastmath : () -> i32 - ! CHECK: %[[VAL_128:.*]] = fir.convert %[[VAL_127]] : (i32) -> i8 - ! CHECK: fir.store %[[VAL_128]] to %[[VAL_84]] : !fir.ref - call ieee_get_rounding_mode(round) - - print*, 'rounding_mode [up ] : ', mode_name(round) - -contains - character(7) function mode_name(m) - type(ieee_round_type), intent(in) :: m - if (m == ieee_nearest) then - mode_name = 'nearest' - else if (m == ieee_to_zero) then - mode_name = 'to_zero' - else if (m == ieee_up) then - mode_name = 'up' - else if (m == ieee_down) then - mode_name = 'down' - else if (m == ieee_away) then - mode_name = 'away' - else if (m == ieee_other) then - mode_name = 'other' - else - mode_name = '???' - endif - end -end diff --git a/flang/test/Lower/Intrinsics/ieee_festatus.f90 b/flang/test/Lower/Intrinsics/ieee_festatus.f90 deleted file mode 100644 index 66b1472101ef..000000000000 --- a/flang/test/Lower/Intrinsics/ieee_festatus.f90 +++ /dev/null @@ -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>> - ! 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, uniq_name = "_QM__fortran_ieee_exceptionsECieee_all"} : (!fir.ref>>, !fir.shape<1>) -> !fir.ref>> - ! CHECK: %[[V_53:[0-9]+]] = fir.address_of(@_QM__fortran_ieee_exceptionsECieee_usual) : !fir.ref>> - ! 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, uniq_name = "_QM__fortran_ieee_exceptionsECieee_usual"} : (!fir.ref>>, !fir.shape<1>) -> !fir.ref>> - 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.ref}>> - 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.shape<1>) -> !fir.ref>> - 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>> - ! CHECK: %[[V_61:[0-9]+]] = fir.declare %[[V_60]](%[[V_1]]) {fortran_attrs = #fir.var_attrs, uniq_name = "_QQro.5x_QM__fortran_builtinsT__builtin_ieee_flag_type.0"} : (!fir.ref>>, !fir.shape<1>) -> !fir.ref>> - ! 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.shape<1>, index) -> !fir.ref> - ! 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.field) -> !fir.ref - ! CHECK: %[[V_98:[0-9]+]] = fir.load %[[V_97]] : !fir.ref - ! CHECK: %[[V_99:[0-9]+]] = fir.convert %[[V_98]] : (i8) -> i32 - ! CHECK: %[[V_100:[0-9]+]] = fir.call @_FortranAMapException(%[[V_99]]) fastmath : (i32) -> i32 - ! CHECK: fir.if %true{{[_0-9]*}} { - ! CHECK: %[[V_101:[0-9]+]] = fir.call @feenableexcept(%[[V_100]]) fastmath : (i32) -> i32 - ! CHECK: } else { - ! CHECK: %[[V_101:[0-9]+]] = fir.call @fedisableexcept(%[[V_100]]) fastmath : (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, uniq_name = "_QQro.5x_QM__fortran_builtinsT__builtin_ieee_flag_type.0"} : (!fir.ref>>, !fir.shape<1>) -> !fir.ref>> - ! 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.shape<1>, index) -> !fir.ref> - ! CHECK: %[[V_96:[0-9]+]] = fir.array_coor %[[V_59]](%[[V_1]]) %arg0 : (!fir.ref>>, !fir.shape<1>, index) -> !fir.ref> - ! 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.field) -> !fir.ref - ! CHECK: %[[V_99:[0-9]+]] = fir.load %[[V_98]] : !fir.ref - ! CHECK: %[[V_100:[0-9]+]] = fir.call @fegetexcept() fastmath : () -> i32 - ! CHECK: %[[V_101:[0-9]+]] = fir.convert %[[V_99]] : (i8) -> i32 - ! CHECK: %[[V_102:[0-9]+]] = fir.call @_FortranAMapException(%[[V_101]]) fastmath : (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> - ! 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.ref - ! CHECK: %[[V_76:[0-9]+]] = fir.call @fegetenv(%[[V_75]]) fastmath : (!fir.ref) -> 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>> - ! CHECK: %[[V_78:[0-9]+]] = fir.declare %[[V_77]](%[[V_54]]) {fortran_attrs = #fir.var_attrs, uniq_name = "_QQro.3x_QM__fortran_builtinsT__builtin_ieee_flag_type.1"} : (!fir.ref>>, !fir.shape<1>) -> !fir.ref>> - ! 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.shape<1>, index) -> !fir.ref> - ! 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.field) -> !fir.ref - ! CHECK: %[[V_98:[0-9]+]] = fir.load %[[V_97]] : !fir.ref - ! CHECK: %[[V_99:[0-9]+]] = fir.convert %[[V_98]] : (i8) -> i32 - ! CHECK: %[[V_100:[0-9]+]] = fir.call @_FortranAMapException(%[[V_99]]) fastmath : (i32) -> i32 - ! CHECK: fir.if %false{{[_0-9]*}} { - ! CHECK: %[[V_101:[0-9]+]] = fir.call @feenableexcept(%[[V_100]]) fastmath : (i32) -> i32 - ! CHECK: } else { - ! CHECK: %[[V_101:[0-9]+]] = fir.call @fedisableexcept(%[[V_100]]) fastmath : (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, uniq_name = "_QQro.5x_QM__fortran_builtinsT__builtin_ieee_flag_type.0"} : (!fir.ref>>, !fir.shape<1>) -> !fir.ref>> - ! 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.shape<1>, index) -> !fir.ref> - ! CHECK: %[[V_96:[0-9]+]] = fir.array_coor %[[V_59]](%[[V_1]]) %arg0 : (!fir.ref>>, !fir.shape<1>, index) -> !fir.ref> - ! 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.field) -> !fir.ref - ! CHECK: %[[V_99:[0-9]+]] = fir.load %[[V_98]] : !fir.ref - ! CHECK: %[[V_100:[0-9]+]] = fir.call @fegetexcept() fastmath : () -> i32 - ! CHECK: %[[V_101:[0-9]+]] = fir.convert %[[V_99]] : (i8) -> i32 - ! CHECK: %[[V_102:[0-9]+]] = fir.call @_FortranAMapException(%[[V_101]]) fastmath : (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> - ! 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 : (!fir.ref) -> i32 - ! CHECK: %[[V_88:[0-9]+]] = fir.declare %[[V_60]](%[[V_1]]) {fortran_attrs = #fir.var_attrs, uniq_name = "_QQro.5x_QM__fortran_builtinsT__builtin_ieee_flag_type.0"} : (!fir.ref>>, !fir.shape<1>) -> !fir.ref>> - 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.shape<1>, index) -> !fir.ref> - ! CHECK: %[[V_96:[0-9]+]] = fir.array_coor %[[V_59]](%[[V_1]]) %arg0 : (!fir.ref>>, !fir.shape<1>, index) -> !fir.ref> - ! 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.field) -> !fir.ref - ! CHECK: %[[V_99:[0-9]+]] = fir.load %[[V_98]] : !fir.ref - ! CHECK: %[[V_100:[0-9]+]] = fir.call @fegetexcept() fastmath : () -> i32 - ! CHECK: %[[V_101:[0-9]+]] = fir.convert %[[V_99]] : (i8) -> i32 - ! CHECK: %[[V_102:[0-9]+]] = fir.call @_FortranAMapException(%[[V_101]]) fastmath : (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> - ! CHECK: } - call ieee_get_halting_mode(ieee_all, v) - - print*, 'halting_mode [T T T T T] :', v -end