Index: flang/include/flang/Evaluate/common.h =================================================================== --- flang/include/flang/Evaluate/common.h +++ flang/include/flang/Evaluate/common.h @@ -27,6 +27,7 @@ namespace Fortran::evaluate { class IntrinsicProcTable; +class TargetCharacteristics; using common::ConstantSubscript; using common::RelationalOperator; @@ -139,21 +140,6 @@ RealFlags flags{}; }; -struct Rounding { - common::RoundingMode mode{common::RoundingMode::TiesToEven}; - // When set, emulate status flag behavior peculiar to x86 - // (viz., fail to set the Underflow flag when an inexact product of a - // multiplication is rounded up to a normal number from a subnormal - // in some rounding modes) -#if __x86_64__ - bool x86CompatibleBehavior{true}; -#else - bool x86CompatibleBehavior{false}; -#endif -}; - -static constexpr Rounding defaultRounding; - #if FLANG_BIG_ENDIAN constexpr bool isHostLittleEndian{false}; #elif FLANG_LITTLE_ENDIAN @@ -228,24 +214,22 @@ class FoldingContext { public: - FoldingContext( - const common::IntrinsicTypeDefaultKinds &d, const IntrinsicProcTable &t) - : defaults_{d}, intrinsics_{t} {} + FoldingContext(const common::IntrinsicTypeDefaultKinds &d, + const IntrinsicProcTable &t, const TargetCharacteristics &c) + : defaults_{d}, intrinsics_{t}, targetCharacteristics_{c} {} FoldingContext(const parser::ContextualMessages &m, const common::IntrinsicTypeDefaultKinds &d, const IntrinsicProcTable &t, - Rounding round = defaultRounding, bool flush = false) - : messages_{m}, defaults_{d}, intrinsics_{t}, rounding_{round}, - flushSubnormalsToZero_{flush} {} + const TargetCharacteristics &c) + : messages_{m}, defaults_{d}, intrinsics_{t}, targetCharacteristics_{c} {} FoldingContext(const FoldingContext &that) : messages_{that.messages_}, defaults_{that.defaults_}, - intrinsics_{that.intrinsics_}, rounding_{that.rounding_}, - flushSubnormalsToZero_{that.flushSubnormalsToZero_}, + intrinsics_{that.intrinsics_}, + targetCharacteristics_{that.targetCharacteristics_}, pdtInstance_{that.pdtInstance_}, impliedDos_{that.impliedDos_} {} FoldingContext( const FoldingContext &that, const parser::ContextualMessages &m) - : messages_{m}, defaults_{that.defaults_}, - intrinsics_{that.intrinsics_}, rounding_{that.rounding_}, - flushSubnormalsToZero_{that.flushSubnormalsToZero_}, + : messages_{m}, defaults_{that.defaults_}, intrinsics_{that.intrinsics_}, + targetCharacteristics_{that.targetCharacteristics_}, pdtInstance_{that.pdtInstance_}, impliedDos_{that.impliedDos_} {} parser::ContextualMessages &messages() { return messages_; } @@ -253,12 +237,11 @@ const common::IntrinsicTypeDefaultKinds &defaults() const { return defaults_; } - Rounding rounding() const { return rounding_; } - bool flushSubnormalsToZero() const { return flushSubnormalsToZero_; } - bool bigEndian() const { return bigEndian_; } - std::size_t maxAlignment() const { return maxAlignment_; } const semantics::DerivedTypeSpec *pdtInstance() const { return pdtInstance_; } const IntrinsicProcTable &intrinsics() const { return intrinsics_; } + const TargetCharacteristics &targetCharacteristics() const { + return targetCharacteristics_; + } bool inModuleFile() const { return inModuleFile_; } FoldingContext &set_inModuleFile(bool yes = true) { inModuleFile_ = yes; @@ -282,10 +265,7 @@ parser::ContextualMessages messages_; const common::IntrinsicTypeDefaultKinds &defaults_; const IntrinsicProcTable &intrinsics_; - Rounding rounding_{defaultRounding}; - bool flushSubnormalsToZero_{false}; - static constexpr bool bigEndian_{false}; // TODO: configure for target - static constexpr std::size_t maxAlignment_{8}; // TODO: configure for target + const TargetCharacteristics &targetCharacteristics_; const semantics::DerivedTypeSpec *pdtInstance_{nullptr}; bool inModuleFile_{false}; std::map impliedDos_; Index: flang/include/flang/Evaluate/complex.h =================================================================== --- flang/include/flang/Evaluate/complex.h +++ flang/include/flang/Evaluate/complex.h @@ -60,25 +60,26 @@ } template - static ValueWithRealFlags FromInteger( - const INT &n, Rounding rounding = defaultRounding) { + static ValueWithRealFlags FromInteger(const INT &n, + Rounding rounding = TargetCharacteristics::defaultRounding) { ValueWithRealFlags result; result.value.re_ = Part::FromInteger(n, rounding).AccumulateFlags(result.flags); return result; } - ValueWithRealFlags Add( - const Complex &, Rounding rounding = defaultRounding) const; - ValueWithRealFlags Subtract( - const Complex &, Rounding rounding = defaultRounding) const; - ValueWithRealFlags Multiply( - const Complex &, Rounding rounding = defaultRounding) const; - ValueWithRealFlags Divide( - const Complex &, Rounding rounding = defaultRounding) const; + ValueWithRealFlags Add(const Complex &, + Rounding rounding = TargetCharacteristics::defaultRounding) const; + ValueWithRealFlags Subtract(const Complex &, + Rounding rounding = TargetCharacteristics::defaultRounding) const; + ValueWithRealFlags Multiply(const Complex &, + Rounding rounding = TargetCharacteristics::defaultRounding) const; + ValueWithRealFlags Divide(const Complex &, + Rounding rounding = TargetCharacteristics::defaultRounding) const; // ABS/CABS = HYPOT(re_, imag_) = SQRT(re_**2 + im_**2) - ValueWithRealFlags ABS(Rounding rounding = defaultRounding) const { + ValueWithRealFlags ABS( + Rounding rounding = TargetCharacteristics::defaultRounding) const { return re_.HYPOT(im_, rounding); } Index: flang/include/flang/Evaluate/real.h =================================================================== --- flang/include/flang/Evaluate/real.h +++ flang/include/flang/Evaluate/real.h @@ -13,7 +13,7 @@ #include "integer.h" #include "rounding-bits.h" #include "flang/Common/real.h" -#include "flang/Evaluate/common.h" +#include "flang/Evaluate/target.h" #include #include #include @@ -107,33 +107,34 @@ constexpr Real Negate() const { return {word_.IEOR(word_.MASKL(1))}; } Relation Compare(const Real &) const; - ValueWithRealFlags Add( - const Real &, Rounding rounding = defaultRounding) const; - ValueWithRealFlags Subtract( - const Real &y, Rounding rounding = defaultRounding) const { + ValueWithRealFlags Add(const Real &, + Rounding rounding = TargetCharacteristics::defaultRounding) const; + ValueWithRealFlags Subtract(const Real &y, + Rounding rounding = TargetCharacteristics::defaultRounding) const { return Add(y.Negate(), rounding); } - ValueWithRealFlags Multiply( - const Real &, Rounding rounding = defaultRounding) const; - ValueWithRealFlags Divide( - const Real &, Rounding rounding = defaultRounding) const; + ValueWithRealFlags Multiply(const Real &, + Rounding rounding = TargetCharacteristics::defaultRounding) const; + ValueWithRealFlags Divide(const Real &, + Rounding rounding = TargetCharacteristics::defaultRounding) const; - ValueWithRealFlags SQRT(Rounding rounding = defaultRounding) const; + ValueWithRealFlags SQRT( + Rounding rounding = TargetCharacteristics::defaultRounding) const; // NEAREST(), IEEE_NEXT_AFTER(), IEEE_NEXT_UP(), and IEEE_NEXT_DOWN() ValueWithRealFlags NEAREST(bool upward) const; // HYPOT(x,y)=SQRT(x**2 + y**2) computed so as to avoid spurious // intermediate overflows. - ValueWithRealFlags HYPOT( - const Real &, Rounding rounding = defaultRounding) const; + ValueWithRealFlags HYPOT(const Real &, + Rounding rounding = TargetCharacteristics::defaultRounding) const; // DIM(X,Y) = MAX(X-Y, 0) - ValueWithRealFlags DIM( - const Real &, Rounding rounding = defaultRounding) const; + ValueWithRealFlags DIM(const Real &, + Rounding rounding = TargetCharacteristics::defaultRounding) const; // MOD(x,y) = x - AINT(x/y)*y // MODULO(x,y) = x - FLOOR(x/y)*y - ValueWithRealFlags MOD( - const Real &, Rounding rounding = defaultRounding) const; - ValueWithRealFlags MODULO( - const Real &, Rounding rounding = defaultRounding) const; + ValueWithRealFlags MOD(const Real &, + Rounding rounding = TargetCharacteristics::defaultRounding) const; + ValueWithRealFlags MODULO(const Real &, + Rounding rounding = TargetCharacteristics::defaultRounding) const; template constexpr INT EXPONENT() const { if (Exponent() == maxExponent) { @@ -172,8 +173,8 @@ // SCALE(); also known as IEEE_SCALB and (in IEEE-754 '08) ScaleB. template - ValueWithRealFlags SCALE( - const INT &by, Rounding rounding = defaultRounding) const { + ValueWithRealFlags SCALE(const INT &by, + Rounding rounding = TargetCharacteristics::defaultRounding) const { auto expo{exponentBias + by.ToInt64()}; if (IsZero()) { expo = exponentBias; // ignore by, don't overflow @@ -219,8 +220,8 @@ } template - static ValueWithRealFlags FromInteger( - const INT &n, Rounding rounding = defaultRounding) { + static ValueWithRealFlags FromInteger(const INT &n, + Rounding rounding = TargetCharacteristics::defaultRounding) { bool isNegative{n.IsNegative()}; INT absN{n}; if (isNegative) { @@ -294,7 +295,7 @@ template static ValueWithRealFlags Convert( - const A &x, Rounding rounding = defaultRounding) { + const A &x, Rounding rounding = TargetCharacteristics::defaultRounding) { ValueWithRealFlags result; if (x.IsNotANumber()) { result.flags.set(RealFlag::InvalidArgument); @@ -361,8 +362,8 @@ return exponent; } - static ValueWithRealFlags Read( - const char *&, Rounding rounding = defaultRounding); + static ValueWithRealFlags Read(const char *&, + Rounding rounding = TargetCharacteristics::defaultRounding); std::string DumpHexadecimal() const; // Emits a character representation for an equivalent Fortran constant @@ -407,7 +408,7 @@ // a maximal exponent and zero fraction doesn't signify infinity, although // this member function will detect overflow and encode infinities). RealFlags Normalize(bool negative, int exponent, const Fraction &fraction, - Rounding rounding = defaultRounding, + Rounding rounding = TargetCharacteristics::defaultRounding, RoundingBits *roundingBits = nullptr); // Rounds a result, if necessary, in place. Index: flang/include/flang/Evaluate/rounding-bits.h =================================================================== --- flang/include/flang/Evaluate/rounding-bits.h +++ flang/include/flang/Evaluate/rounding-bits.h @@ -9,6 +9,8 @@ #ifndef FORTRAN_EVALUATE_ROUNDING_BITS_H_ #define FORTRAN_EVALUATE_ROUNDING_BITS_H_ +#include "flang/Evaluate/target.h" + // A helper class used by Real<> to determine rounding of rational results // to floating-point values. Bits lost from intermediate computations by // being shifted rightward are accumulated in instances of this class. Index: flang/include/flang/Evaluate/static-data.h =================================================================== --- flang/include/flang/Evaluate/static-data.h +++ flang/include/flang/Evaluate/static-data.h @@ -60,15 +60,14 @@ const std::vector &data() const { return data_; } std::vector &data() { return data_; } - StaticDataObject &Push(const std::string &); - StaticDataObject &Push(const std::u16string &); - StaticDataObject &Push(const std::u32string &); + StaticDataObject &Push(const std::string &, bool /*ignored*/ = false); + StaticDataObject &Push(const std::u16string &, bool bigEndian = false); + StaticDataObject &Push(const std::u32string &, bool bigEndian = false); std::optional AsString() const; - std::optional AsU16String() const; - std::optional AsU32String() const; - llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; - - static bool bigEndian; + std::optional AsU16String(bool bigEndian = false) const; + std::optional AsU32String(bool bigEndian = false) const; + llvm::raw_ostream &AsFortran( + llvm::raw_ostream &, bool bigEndian = false) const; private: StaticDataObject() {} Index: flang/include/flang/Evaluate/target.h =================================================================== --- /dev/null +++ flang/include/flang/Evaluate/target.h @@ -0,0 +1,93 @@ +//===-- include/flang/Evaluate/target.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 +// +//===----------------------------------------------------------------------===// + +// Represents the minimal amount of target architecture information required by +// semantics. + +#ifndef FORTRAN_EVALUATE_TARGET_H_ +#define FORTRAN_EVALUATE_TARGET_H_ + +#include "flang/Common/Fortran.h" +#include "flang/Evaluate/common.h" +#include + +namespace Fortran::evaluate { + +// Floating-point rounding control +struct Rounding { + common::RoundingMode mode{common::RoundingMode::TiesToEven}; + // When set, emulate status flag behavior peculiar to x86 + // (viz., fail to set the Underflow flag when an inexact product of a + // multiplication is rounded up to a normal number from a subnormal + // in some rounding modes) +#if __x86_64__ + bool x86CompatibleBehavior{true}; +#else + bool x86CompatibleBehavior{false}; +#endif +}; + +class TargetCharacteristics { +public: + TargetCharacteristics(); + TargetCharacteristics &operator=(const TargetCharacteristics &) = default; + + bool isBigEndian() const { return isBigEndian_; } + void set_isBigEndian(bool isBig = true); + + bool areSubnormalsFlushedToZero() const { + return areSubnormalsFlushedToZero_; + } + void set_areSubnormalsFlushedToZero(bool yes = true); + + Rounding roundingMode() const { return roundingMode_; } + void set_roundingMode(Rounding); + + std::size_t procedurePointerByteSize() const { + return procedurePointerByteSize_; + } + std::size_t procedurePointerAlignment() const { + return procedurePointerAlignment_; + } + std::size_t descriptorAlignment() const { return descriptorAlignment_; } + std::size_t maxByteSize() const { return maxByteSize_; } + std::size_t maxAlignment() const { return maxAlignment_; } + + static bool CanSupportType(common::TypeCategory, std::int64_t kind); + bool EnableType(common::TypeCategory category, std::int64_t kind, + std::size_t byteSize, std::size_t align); + void DisableType(common::TypeCategory category, std::int64_t kind); + + std::size_t GetByteSize( + common::TypeCategory category, std::int64_t kind) const; + std::size_t GetAlignment( + common::TypeCategory category, std::int64_t kind) const; + bool IsTypeEnabled(common::TypeCategory category, std::int64_t kind) const; + + int SelectedIntKind(std::int64_t precision = 0) const; + int SelectedRealKind(std::int64_t precision = 0, std::int64_t range = 0, + std::int64_t radix = 2) const; + + static Rounding defaultRounding; + +private: + static constexpr int maxKind{32}; + std::uint8_t byteSize_[common::TypeCategory_enumSize][maxKind]{}; + std::uint8_t align_[common::TypeCategory_enumSize][maxKind]{}; + bool isBigEndian_{false}; + bool areSubnormalsFlushedToZero_{false}; + Rounding roundingMode_{defaultRounding}; + std::size_t procedurePointerByteSize_{8}; + std::size_t procedurePointerAlignment_{8}; + std::size_t descriptorAlignment_{8}; + std::size_t maxByteSize_{8 /*at least*/}; + std::size_t maxAlignment_{8 /*at least*/}; +}; + +} // namespace Fortran::evaluate +#endif // FORTRAN_EVALUATE_TARGET_H_ Index: flang/include/flang/Evaluate/type.h =================================================================== --- flang/include/flang/Evaluate/type.h +++ flang/include/flang/Evaluate/type.h @@ -43,6 +43,7 @@ namespace Fortran::evaluate { using common::TypeCategory; +class TargetCharacteristics; // Specific intrinsic types are represented by specializations of // this class template Type. @@ -58,7 +59,6 @@ // A predicate that is true when a kind value is a kind that could possibly // be supported for an intrinsic type category on some target instruction // set architecture. -// TODO: specialize for the actual target architecture static constexpr bool IsValidKindOfIntrinsicType( TypeCategory category, std::int64_t kind) { switch (category) { @@ -153,7 +153,7 @@ } std::optional> GetCharLength() const; - std::size_t GetAlignment(const FoldingContext &) const; + std::size_t GetAlignment(const TargetCharacteristics &) const; std::optional> MeasureSizeInBytes( FoldingContext &, bool aligned) const; @@ -448,9 +448,8 @@ template using TypeOf = typename TypeOfHelper::type; int SelectedCharKind(const std::string &, int defaultKind); -int SelectedIntKind(std::int64_t precision = 0); -int SelectedRealKind( - std::int64_t precision = 0, std::int64_t range = 0, std::int64_t radix = 2); +// SelectedIntKind and SelectedRealKind are now member functions of +// TargetCharactertics. // Given the dynamic types and kinds of two operands, determine the common // type to which they must be converted in order to be compared with Index: flang/include/flang/Lower/Bridge.h =================================================================== --- flang/include/flang/Lower/Bridge.h +++ flang/include/flang/Lower/Bridge.h @@ -25,6 +25,7 @@ } // namespace common namespace evaluate { class IntrinsicProcTable; +class TargetCharacteristics; } // namespace evaluate namespace parser { class AllCookedSources; @@ -49,10 +50,11 @@ create(mlir::MLIRContext &ctx, const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, const Fortran::evaluate::IntrinsicProcTable &intrinsics, + const Fortran::evaluate::TargetCharacteristics &targetCharacteristics, const Fortran::parser::AllCookedSources &allCooked, llvm::StringRef triple, fir::KindMapping &kindMap) { - return LoweringBridge(ctx, defaultKinds, intrinsics, allCooked, triple, - kindMap); + return LoweringBridge(ctx, defaultKinds, intrinsics, targetCharacteristics, + allCooked, triple, kindMap); } //===--------------------------------------------------------------------===// @@ -70,6 +72,10 @@ const Fortran::evaluate::IntrinsicProcTable &getIntrinsicTable() const { return intrinsics; } + const Fortran::evaluate::TargetCharacteristics & + getTargetCharacteristics() const { + return targetCharacteristics; + } const Fortran::parser::AllCookedSources *getCookedSource() const { return cooked; } @@ -99,6 +105,7 @@ mlir::MLIRContext &ctx, const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, const Fortran::evaluate::IntrinsicProcTable &intrinsics, + const Fortran::evaluate::TargetCharacteristics &targetCharacteristics, const Fortran::parser::AllCookedSources &cooked, llvm::StringRef triple, fir::KindMapping &kindMap); LoweringBridge() = delete; @@ -106,6 +113,7 @@ const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds; const Fortran::evaluate::IntrinsicProcTable &intrinsics; + const Fortran::evaluate::TargetCharacteristics &targetCharacteristics; const Fortran::parser::AllCookedSources *cooked; mlir::MLIRContext &context; std::unique_ptr module; Index: flang/include/flang/Semantics/semantics.h =================================================================== --- flang/include/flang/Semantics/semantics.h +++ flang/include/flang/Semantics/semantics.h @@ -14,6 +14,7 @@ #include "flang/Common/Fortran-features.h" #include "flang/Evaluate/common.h" #include "flang/Evaluate/intrinsics.h" +#include "flang/Evaluate/target.h" #include "flang/Parser/message.h" #include #include @@ -96,6 +97,12 @@ bool warningsAreErrors() const { return warningsAreErrors_; } bool debugModuleWriter() const { return debugModuleWriter_; } const evaluate::IntrinsicProcTable &intrinsics() const { return intrinsics_; } + const evaluate::TargetCharacteristics &targetCharacteristics() const { + return targetCharacteristics_; + } + evaluate::TargetCharacteristics &targetCharacteristics() { + return targetCharacteristics_; + } Scope &globalScope() { return globalScope_; } Scope &intrinsicModulesScope() { return intrinsicModulesScope_; } parser::Messages &messages() { return messages_; } @@ -244,6 +251,7 @@ bool warningsAreErrors_{false}; bool debugModuleWriter_{false}; const evaluate::IntrinsicProcTable intrinsics_; + evaluate::TargetCharacteristics targetCharacteristics_; Scope globalScope_; Scope &intrinsicModulesScope_; parser::Messages messages_; Index: flang/lib/Evaluate/CMakeLists.txt =================================================================== --- flang/lib/Evaluate/CMakeLists.txt +++ flang/lib/Evaluate/CMakeLists.txt @@ -45,6 +45,7 @@ real.cpp shape.cpp static-data.cpp + target.cpp tools.cpp type.cpp variable.cpp @@ -62,4 +63,3 @@ acc_gen omp_gen ) - Index: flang/lib/Evaluate/characteristics.cpp =================================================================== --- flang/lib/Evaluate/characteristics.cpp +++ flang/lib/Evaluate/characteristics.cpp @@ -167,7 +167,10 @@ if (LEN_) { CHECK(type_.category() == TypeCategory::Character); return Fold(foldingContext, - Expr{type_.kind()} * Expr{*LEN_}); + Expr{ + foldingContext.targetCharacteristics().GetByteSize( + type_.category(), type_.kind())} * + Expr{*LEN_}); } if (auto elementBytes{type_.MeasureSizeInBytes(foldingContext, align)}) { return Fold(foldingContext, std::move(*elementBytes)); Index: flang/lib/Evaluate/fold-implementation.h =================================================================== --- flang/lib/Evaluate/fold-implementation.h +++ flang/lib/Evaluate/fold-implementation.h @@ -1622,7 +1622,7 @@ "REAL(%d) to REAL(%d) conversion", Operand::kind, TO::kind); RealFlagWarnings(ctx, converted.flags, buffer); } - if (ctx.flushSubnormalsToZero()) { + if (ctx.targetCharacteristics().areSubnormalsFlushedToZero()) { converted.value = converted.value.FlushSubnormalToZero(); } return ScalarConstantToExpr(std::move(converted.value)); @@ -1749,9 +1749,10 @@ } return Expr{Constant{sum.value}}; } else { - auto sum{folded->first.Add(folded->second, context.rounding())}; + auto sum{folded->first.Add( + folded->second, context.targetCharacteristics().roundingMode())}; RealFlagWarnings(context, sum.flags, "addition"); - if (context.flushSubnormalsToZero()) { + if (context.targetCharacteristics().areSubnormalsFlushedToZero()) { sum.value = sum.value.FlushSubnormalToZero(); } return Expr{Constant{sum.value}}; @@ -1774,10 +1775,10 @@ } return Expr{Constant{difference.value}}; } else { - auto difference{ - folded->first.Subtract(folded->second, context.rounding())}; + auto difference{folded->first.Subtract( + folded->second, context.targetCharacteristics().roundingMode())}; RealFlagWarnings(context, difference.flags, "subtraction"); - if (context.flushSubnormalsToZero()) { + if (context.targetCharacteristics().areSubnormalsFlushedToZero()) { difference.value = difference.value.FlushSubnormalToZero(); } return Expr{Constant{difference.value}}; @@ -1800,9 +1801,10 @@ } return Expr{Constant{product.lower}}; } else { - auto product{folded->first.Multiply(folded->second, context.rounding())}; + auto product{folded->first.Multiply( + folded->second, context.targetCharacteristics().roundingMode())}; RealFlagWarnings(context, product.flags, "multiplication"); - if (context.flushSubnormalsToZero()) { + if (context.targetCharacteristics().areSubnormalsFlushedToZero()) { product.value = product.value.FlushSubnormalToZero(); } return Expr{Constant{product.value}}; @@ -1844,7 +1846,8 @@ } return Expr{Constant{quotAndRem.quotient}}; } else { - auto quotient{folded->first.Divide(folded->second, context.rounding())}; + auto quotient{folded->first.Divide( + folded->second, context.targetCharacteristics().roundingMode())}; // Don't warn about -1./0., 0./0., or 1./0. from a module file // they are interpreted as canonical Fortran representations of -Inf, // NaN, and Inf respectively. @@ -1861,7 +1864,7 @@ if (!isCanonicalNaNOrInf) { RealFlagWarnings(context, quotient.flags, "division"); } - if (context.flushSubnormalsToZero()) { + if (context.targetCharacteristics().areSubnormalsFlushedToZero()) { quotient.value = quotient.value.FlushSubnormalToZero(); } return Expr{Constant{quotient.value}}; @@ -1913,7 +1916,7 @@ if (auto folded{OperandsAreConstants(x.left(), y)}) { auto power{evaluate::IntPower(folded->first, folded->second)}; RealFlagWarnings(context, power.flags, "power with INTEGER exponent"); - if (context.flushSubnormalsToZero()) { + if (context.targetCharacteristics().areSubnormalsFlushedToZero()) { power.value = power.value.FlushSubnormalToZero(); } return Expr{Constant{power.value}}; Index: flang/lib/Evaluate/fold-integer.cpp =================================================================== --- flang/lib/Evaluate/fold-integer.cpp +++ flang/lib/Evaluate/fold-integer.cpp @@ -947,14 +947,15 @@ } } else if (name == "selected_int_kind") { if (auto p{GetInt64Arg(args[0])}) { - return Expr{SelectedIntKind(*p)}; + return Expr{context.targetCharacteristics().SelectedIntKind(*p)}; } } else if (name == "selected_real_kind" || name == "__builtin_ieee_selected_real_kind") { if (auto p{GetInt64ArgOr(args[0], 0)}) { if (auto r{GetInt64ArgOr(args[1], 0)}) { if (auto radix{GetInt64ArgOr(args[2], 2)}) { - return Expr{SelectedRealKind(*p, *r, *radix)}; + return Expr{ + context.targetCharacteristics().SelectedRealKind(*p, *r, *radix)}; } } } Index: flang/lib/Evaluate/host.cpp =================================================================== --- flang/lib/Evaluate/host.cpp +++ flang/lib/Evaluate/host.cpp @@ -36,7 +36,7 @@ hasSubnormalFlushingHardwareControl_ = true; originalMxcsr = _mm_getcsr(); unsigned int currentMxcsr{originalMxcsr}; - if (context.flushSubnormalsToZero()) { + if (context.targetCharacteristics().areSubnormalsFlushedToZero()) { currentMxcsr |= 0x8000; currentMxcsr |= 0x0040; } else { @@ -46,14 +46,14 @@ #elif defined(__aarch64__) #if defined(__GNU_LIBRARY__) hasSubnormalFlushingHardwareControl_ = true; - if (context.flushSubnormalsToZero()) { + if (context.targetCharacteristics().areSubnormalsFlushedToZero()) { currentFenv.__fpcr |= (1U << 24); // control register } else { currentFenv.__fpcr &= ~(1U << 24); // control register } #elif defined(__BIONIC__) hasSubnormalFlushingHardwareControl_ = true; - if (context.flushSubnormalsToZero()) { + if (context.targetCharacteristics().areSubnormalsFlushedToZero()) { currentFenv.__control |= (1U << 24); // control register } else { currentFenv.__control &= ~(1U << 24); // control register @@ -85,7 +85,7 @@ _mm_setcsr(currentMxcsr); #endif - switch (context.rounding().mode) { + switch (context.targetCharacteristics().roundingMode().mode) { case common::RoundingMode::TiesToEven: fesetround(FE_TONEAREST); break; Index: flang/lib/Evaluate/int-power.h =================================================================== --- flang/lib/Evaluate/int-power.h +++ flang/lib/Evaluate/int-power.h @@ -11,13 +11,14 @@ // Computes an integer power of a real or complex value. -#include "flang/Evaluate/common.h" +#include "flang/Evaluate/target.h" namespace Fortran::evaluate { template ValueWithRealFlags TimesIntPowerOf(const REAL &factor, const REAL &base, - const INT &power, Rounding rounding = defaultRounding) { + const INT &power, + Rounding rounding = TargetCharacteristics::defaultRounding) { ValueWithRealFlags result{factor}; if (base.IsNotANumber()) { result.value = REAL::NotANumber(); @@ -49,8 +50,8 @@ } template -ValueWithRealFlags IntPower( - const REAL &base, const INT &power, Rounding rounding = defaultRounding) { +ValueWithRealFlags IntPower(const REAL &base, const INT &power, + Rounding rounding = TargetCharacteristics::defaultRounding) { REAL one{REAL::FromInteger(INT{1}).value}; return TimesIntPowerOf(one, base, power, rounding); } Index: flang/lib/Evaluate/intrinsics-library.cpp =================================================================== --- flang/lib/Evaluate/intrinsics-library.cpp +++ flang/lib/Evaluate/intrinsics-library.cpp @@ -149,7 +149,7 @@ Scalar result{}; std::tuple...> scalarArgs{ GetScalarConstantValue(args[I]).value()...}; - if (context.flushSubnormalsToZero() && + if (context.targetCharacteristics().areSubnormalsFlushedToZero() && !hostFPE.hasSubnormalFlushingHardwareControl()) { hostResult = func(host::CastFortranToHost( FlushSubnormals(std::move(std::get(scalarArgs))))...); Index: flang/lib/Evaluate/intrinsics.cpp =================================================================== --- flang/lib/Evaluate/intrinsics.cpp +++ flang/lib/Evaluate/intrinsics.cpp @@ -1679,7 +1679,8 @@ if (auto *expr{kindArg->UnwrapExpr()}) { CHECK(expr->Rank() == 0); if (auto code{ToInt64(*expr)}) { - if (IsValidKindOfIntrinsicType(*category, *code)) { + if (context.targetCharacteristics().IsTypeEnabled( + *category, *code)) { if (*category == TypeCategory::Character) { // ACHAR & CHAR resultType = DynamicType{static_cast(*code), 1}; } else { Index: flang/lib/Evaluate/static-data.cpp =================================================================== --- flang/lib/Evaluate/static-data.cpp +++ flang/lib/Evaluate/static-data.cpp @@ -11,14 +11,13 @@ namespace Fortran::evaluate { -bool StaticDataObject::bigEndian{false}; - -llvm::raw_ostream &StaticDataObject::AsFortran(llvm::raw_ostream &o) const { +llvm::raw_ostream &StaticDataObject::AsFortran( + llvm::raw_ostream &o, bool bigEndian) const { if (auto string{AsString()}) { o << parser::QuoteCharacterLiteral(*string); - } else if (auto string{AsU16String()}) { + } else if (auto string{AsU16String(bigEndian)}) { o << "2_" << parser::QuoteCharacterLiteral(*string); - } else if (auto string{AsU32String()}) { + } else if (auto string{AsU32String(bigEndian)}) { o << "4_" << parser::QuoteCharacterLiteral(*string); } else { CRASH_NO_CASE; @@ -26,15 +25,16 @@ return o; } -StaticDataObject &StaticDataObject::Push(const std::string &string) { +StaticDataObject &StaticDataObject::Push(const std::string &string, bool) { for (auto ch : string) { data_.push_back(static_cast(ch)); } return *this; } -StaticDataObject &StaticDataObject::Push(const std::u16string &string) { - int shift{bigEndian * 8}; +StaticDataObject &StaticDataObject::Push( + const std::u16string &string, bool bigEndian) { + int shift{bigEndian ? 8 : 0}; for (auto ch : string) { data_.push_back(static_cast(ch >> shift)); data_.push_back(static_cast(ch >> (shift ^ 8))); @@ -42,8 +42,9 @@ return *this; } -StaticDataObject &StaticDataObject::Push(const std::u32string &string) { - int shift{bigEndian * 24}; +StaticDataObject &StaticDataObject::Push( + const std::u32string &string, bool bigEndian) { + int shift{bigEndian ? 24 : 0}; for (auto ch : string) { data_.push_back(static_cast(ch >> shift)); data_.push_back(static_cast(ch >> (shift ^ 8))); @@ -64,9 +65,10 @@ return std::nullopt; } -std::optional StaticDataObject::AsU16String() const { +std::optional StaticDataObject::AsU16String( + bool bigEndian) const { if (itemBytes_ == 2) { - int shift{bigEndian * 8}; + int shift{bigEndian ? 8 : 0}; std::u16string result; auto end{data_.cend()}; for (auto byte{data_.cbegin()}; byte < end;) { @@ -78,9 +80,10 @@ return std::nullopt; } -std::optional StaticDataObject::AsU32String() const { +std::optional StaticDataObject::AsU32String( + bool bigEndian) const { if (itemBytes_ == 4) { - int shift{bigEndian * 24}; + int shift{bigEndian ? 24 : 0}; std::u32string result; auto end{data_.cend()}; for (auto byte{data_.cbegin()}; byte < end;) { Index: flang/lib/Evaluate/target.cpp =================================================================== --- /dev/null +++ flang/lib/Evaluate/target.cpp @@ -0,0 +1,202 @@ +//===-- lib/Semantics/target.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/Evaluate/target.h" +#include "flang/Common/template.h" +#include "flang/Evaluate/common.h" +#include "flang/Evaluate/type.h" + +namespace Fortran::evaluate { + +Rounding TargetCharacteristics::defaultRounding; + +TargetCharacteristics::TargetCharacteristics() { + // TODO: Fill in the type information from command-line targeting information. + auto enableCategoryKinds{[this](TypeCategory category) { + for (int kind{0}; kind < maxKind; ++kind) { + if (CanSupportType(category, kind)) { + auto byteSize{static_cast(kind)}; + if (category == TypeCategory::Real || + category == TypeCategory::Complex) { + if (kind == 3) { + // non-IEEE 16-bit format (truncated 32-bit) + byteSize = 2; + } else if (kind == 10) { + // x87 floating-point -- follow gcc precedent for "long double" + byteSize = 16; + } + } + std::size_t align{byteSize}; + if (category == TypeCategory::Complex) { + byteSize = 2 * byteSize; + } + EnableType(category, kind, byteSize, align); + } + } + }}; + enableCategoryKinds(TypeCategory::Integer); + enableCategoryKinds(TypeCategory::Real); + enableCategoryKinds(TypeCategory::Complex); + enableCategoryKinds(TypeCategory::Character); + enableCategoryKinds(TypeCategory::Logical); + + isBigEndian_ = !isHostLittleEndian; + + areSubnormalsFlushedToZero_ = false; +} + +bool TargetCharacteristics::CanSupportType( + TypeCategory category, std::int64_t kind) { +#if !__x86_64__ + if ((category == TypeCategory::Real || category == TypeCategory::Complex) && + kind == 10) { + return false; + } +#endif + return IsValidKindOfIntrinsicType(category, kind); +} + +bool TargetCharacteristics::EnableType(common::TypeCategory category, + std::int64_t kind, std::size_t byteSize, std::size_t align) { + if (CanSupportType(category, kind)) { + byteSize_[static_cast(category)][kind] = byteSize; + align_[static_cast(category)][kind] = align; + maxByteSize_ = std::max(maxByteSize_, byteSize); + maxAlignment_ = std::max(maxAlignment_, align); + return true; + } else { + return false; + } +} + +void TargetCharacteristics::DisableType( + common::TypeCategory category, std::int64_t kind) { + if (kind >= 0 && kind < maxKind) { + align_[static_cast(category)][kind] = 0; + } +} + +std::size_t TargetCharacteristics::GetByteSize( + common::TypeCategory category, std::int64_t kind) const { + if (kind >= 0 && kind < maxKind) { + return byteSize_[static_cast(category)][kind]; + } else { + return 0; + } +} + +std::size_t TargetCharacteristics::GetAlignment( + common::TypeCategory category, std::int64_t kind) const { + if (kind >= 0 && kind < maxKind) { + return align_[static_cast(category)][kind]; + } else { + return 0; + } +} + +bool TargetCharacteristics::IsTypeEnabled( + common::TypeCategory category, std::int64_t kind) const { + return GetAlignment(category, kind) > 0; +} + +void TargetCharacteristics::set_isBigEndian(bool isBig) { + isBigEndian_ = isBig; +} + +void TargetCharacteristics::set_areSubnormalsFlushedToZero(bool yes) { + areSubnormalsFlushedToZero_ = yes; +} + +void TargetCharacteristics::set_roundingMode(Rounding rounding) { + roundingMode_ = rounding; +} + +// SELECTED_INT_KIND() -- F'2018 16.9.169 +class SelectedIntKindVisitor { +public: + SelectedIntKindVisitor( + const TargetCharacteristics &targetCharacteristics, std::int64_t p) + : targetCharacteristics_{targetCharacteristics}, precision_{p} {} + using Result = std::optional; + using Types = IntegerTypes; + template Result Test() const { + if (Scalar::RANGE >= precision_ && + targetCharacteristics_.IsTypeEnabled(T::category, T::kind)) { + return T::kind; + } else { + return std::nullopt; + } + } + +private: + const TargetCharacteristics &targetCharacteristics_; + std::int64_t precision_; +}; + +int TargetCharacteristics::SelectedIntKind(std::int64_t precision) const { + if (auto kind{ + common::SearchTypes(SelectedIntKindVisitor{*this, precision})}) { + return *kind; + } else { + return -1; + } +} + +// SELECTED_REAL_KIND() -- F'2018 16.9.170 +class SelectedRealKindVisitor { +public: + SelectedRealKindVisitor(const TargetCharacteristics &targetCharacteristics, + std::int64_t p, std::int64_t r) + : targetCharacteristics_{targetCharacteristics}, precision_{p}, range_{ + r} {} + using Result = std::optional; + using Types = RealTypes; + template Result Test() const { + if (Scalar::PRECISION >= precision_ && Scalar::RANGE >= range_ && + targetCharacteristics_.IsTypeEnabled(T::category, T::kind)) { + return {T::kind}; + } else { + return std::nullopt; + } + } + +private: + const TargetCharacteristics &targetCharacteristics_; + std::int64_t precision_, range_; +}; + +int TargetCharacteristics::SelectedRealKind( + std::int64_t precision, std::int64_t range, std::int64_t radix) const { + if (radix != 2) { + return -5; + } + if (auto kind{common::SearchTypes( + SelectedRealKindVisitor{*this, precision, range})}) { + return *kind; + } + // No kind has both sufficient precision and sufficient range. + // The negative return value encodes whether any kinds exist that + // could satisfy either constraint independently. + bool pOK{common::SearchTypes(SelectedRealKindVisitor{*this, precision, 0})}; + bool rOK{common::SearchTypes(SelectedRealKindVisitor{*this, 0, range})}; + if (pOK) { + if (rOK) { + return -4; + } else { + return -2; + } + } else { + if (rOK) { + return -1; + } else { + return -3; + } + } +} + +} // namespace Fortran::evaluate Index: flang/lib/Evaluate/type.cpp =================================================================== --- flang/lib/Evaluate/type.cpp +++ flang/lib/Evaluate/type.cpp @@ -8,9 +8,9 @@ #include "flang/Evaluate/type.h" #include "flang/Common/idioms.h" -#include "flang/Common/template.h" #include "flang/Evaluate/expression.h" #include "flang/Evaluate/fold.h" +#include "flang/Evaluate/target.h" #include "flang/Parser/characters.h" #include "flang/Semantics/scope.h" #include "flang/Semantics/symbol.h" @@ -127,32 +127,14 @@ return std::nullopt; } -static constexpr std::size_t RealKindBytes(int kind) { - switch (kind) { - case 3: // non-IEEE 16-bit format (truncated 32-bit) - return 2; - case 10: // 80387 80-bit extended precision - case 12: // possible variant spelling - return 16; - default: - return kind; - } -} - -std::size_t DynamicType::GetAlignment(const FoldingContext &context) const { - switch (category_) { - case TypeCategory::Integer: - case TypeCategory::Character: - case TypeCategory::Logical: - return std::min(kind_, context.maxAlignment()); - case TypeCategory::Real: - case TypeCategory::Complex: - return std::min(RealKindBytes(kind_), context.maxAlignment()); - case TypeCategory::Derived: +std::size_t DynamicType::GetAlignment( + const TargetCharacteristics &targetCharacteristics) const { + if (category_ == TypeCategory::Derived) { if (derived_ && derived_->scope()) { return derived_->scope()->alignment().value_or(1); } - break; + } else { + return targetCharacteristics.GetAlignment(category_, kind_); } return 1; // needs to be after switch to dodge a bogus gcc warning } @@ -161,18 +143,19 @@ FoldingContext &context, bool aligned) const { switch (category_) { case TypeCategory::Integer: - return Expr{kind_}; case TypeCategory::Real: - return Expr{RealKindBytes(kind_)}; case TypeCategory::Complex: - return Expr{2 * RealKindBytes(kind_)}; + case TypeCategory::Logical: + return Expr{ + context.targetCharacteristics().GetByteSize(category_, kind_)}; case TypeCategory::Character: if (auto len{GetCharLength()}) { - return Fold(context, Expr{kind_} * std::move(*len)); + return Fold(context, + Expr{ + context.targetCharacteristics().GetByteSize(category_, kind_)} * + std::move(*len)); } break; - case TypeCategory::Logical: - return Expr{kind_}; case TypeCategory::Derived: if (derived_ && derived_->scope()) { auto size{derived_->scope()->size()}; @@ -509,78 +492,6 @@ } } -class SelectedIntKindVisitor { -public: - explicit SelectedIntKindVisitor(std::int64_t p) : precision_{p} {} - using Result = std::optional; - using Types = IntegerTypes; - template Result Test() const { - if (Scalar::RANGE >= precision_) { - return T::kind; - } else { - return std::nullopt; - } - } - -private: - std::int64_t precision_; -}; - -int SelectedIntKind(std::int64_t precision) { - if (auto kind{common::SearchTypes(SelectedIntKindVisitor{precision})}) { - return *kind; - } else { - return -1; - } -} - -class SelectedRealKindVisitor { -public: - explicit SelectedRealKindVisitor(std::int64_t p, std::int64_t r) - : precision_{p}, range_{r} {} - using Result = std::optional; - using Types = RealTypes; - template Result Test() const { - if (Scalar::PRECISION >= precision_ && Scalar::RANGE >= range_) { - return {T::kind}; - } else { - return std::nullopt; - } - } - -private: - std::int64_t precision_, range_; -}; - -int SelectedRealKind( - std::int64_t precision, std::int64_t range, std::int64_t radix) { - if (radix != 2) { - return -5; - } - if (auto kind{ - common::SearchTypes(SelectedRealKindVisitor{precision, range})}) { - return *kind; - } - // No kind has both sufficient precision and sufficient range. - // The negative return value encodes whether any kinds exist that - // could satisfy either constraint independently. - bool pOK{common::SearchTypes(SelectedRealKindVisitor{precision, 0})}; - bool rOK{common::SearchTypes(SelectedRealKindVisitor{0, range})}; - if (pOK) { - if (rOK) { - return -4; - } else { - return -2; - } - } else { - if (rOK) { - return -1; - } else { - return -3; - } - } -} - std::optional ComparisonType( const DynamicType &t1, const DynamicType &t2) { switch (t1.category()) { Index: flang/lib/Frontend/FrontendActions.cpp =================================================================== --- flang/lib/Frontend/FrontendActions.cpp +++ flang/lib/Frontend/FrontendActions.cpp @@ -146,6 +146,7 @@ llvm::ArrayRef{fir::fromDefaultKinds(defKinds)}); lower::LoweringBridge lb = Fortran::lower::LoweringBridge::create( *mlirCtx, defKinds, ci.getInvocation().getSemanticsContext().intrinsics(), + ci.getInvocation().getSemanticsContext().targetCharacteristics(), ci.getParsing().allCooked(), ci.getInvocation().getTargetOpts().triple, kindMap); Index: flang/lib/Lower/Bridge.cpp =================================================================== --- flang/lib/Lower/Bridge.cpp +++ flang/lib/Lower/Bridge.cpp @@ -3174,7 +3174,7 @@ Fortran::evaluate::FoldingContext Fortran::lower::LoweringBridge::createFoldingContext() const { - return {getDefaultKinds(), getIntrinsicTable()}; + return {getDefaultKinds(), getIntrinsicTable(), getTargetCharacteristics()}; } void Fortran::lower::LoweringBridge::lower( @@ -3199,9 +3199,11 @@ mlir::MLIRContext &context, const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, const Fortran::evaluate::IntrinsicProcTable &intrinsics, + const Fortran::evaluate::TargetCharacteristics &targetCharacteristics, const Fortran::parser::AllCookedSources &cooked, llvm::StringRef triple, fir::KindMapping &kindMap) - : defaultKinds{defaultKinds}, intrinsics{intrinsics}, cooked{&cooked}, + : defaultKinds{defaultKinds}, intrinsics{intrinsics}, + targetCharacteristics{targetCharacteristics}, cooked{&cooked}, context{context}, kindMap{kindMap} { // Register the diagnostic handler. context.getDiagEngine().registerHandler([](mlir::Diagnostic &diag) { Index: flang/lib/Semantics/compute-offsets.cpp =================================================================== --- flang/lib/Semantics/compute-offsets.cpp +++ flang/lib/Semantics/compute-offsets.cpp @@ -313,33 +313,35 @@ auto ComputeOffsetsHelper::GetSizeAndAlignment( const Symbol &symbol, bool entire) -> SizeAndAlignment { - // TODO: The size of procedure pointers is not yet known - // and is independent of rank (and probably also the number - // of length type parameters). - auto &foldingContext{context_.foldingContext()}; - if (IsDescriptor(symbol) || IsProcedurePointer(symbol)) { + auto &targetCharacteristics{context_.targetCharacteristics()}; + if (IsDescriptor(symbol)) { const auto *derived{ evaluate::GetDerivedTypeSpec(evaluate::DynamicType::From(symbol))}; int lenParams{derived ? CountLenParameters(*derived) : 0}; std::size_t size{runtime::Descriptor::SizeInBytes( symbol.Rank(), derived != nullptr, lenParams)}; - return {size, foldingContext.maxAlignment()}; + return {size, targetCharacteristics.descriptorAlignment()}; + } + if (IsProcedurePointer(symbol)) { + return {targetCharacteristics.procedurePointerByteSize(), + targetCharacteristics.procedurePointerAlignment()}; } if (IsProcedure(symbol)) { return {}; } + auto &foldingContext{context_.foldingContext()}; if (auto chars{evaluate::characteristics::TypeAndShape::Characterize( symbol, foldingContext)}) { if (entire) { if (auto size{ToInt64(chars->MeasureSizeInBytes(foldingContext))}) { return {static_cast(*size), - chars->type().GetAlignment(foldingContext)}; + chars->type().GetAlignment(targetCharacteristics)}; } } else { // element size only if (auto size{ToInt64(chars->MeasureElementSizeInBytes( foldingContext, true /*aligned*/))}) { return {static_cast(*size), - chars->type().GetAlignment(foldingContext)}; + chars->type().GetAlignment(targetCharacteristics)}; } } } @@ -348,7 +350,8 @@ // Align a size to its natural alignment, up to maxAlignment. std::size_t ComputeOffsetsHelper::Align(std::size_t x, std::size_t alignment) { - alignment = std::min(alignment, context_.foldingContext().maxAlignment()); + alignment = + std::min(alignment, context_.targetCharacteristics().maxAlignment()); return (x + alignment - 1) & -alignment; } Index: flang/lib/Semantics/data-to-inits.cpp =================================================================== --- flang/lib/Semantics/data-to-inits.cpp +++ flang/lib/Semantics/data-to-inits.cpp @@ -673,7 +673,8 @@ auto size{static_cast( evaluate::ToInt64(dyType->MeasureSizeInBytes(foldingContext, true)) .value_or(1))}; - if (std::size_t alignment{dyType->GetAlignment(foldingContext)}) { + if (std::size_t alignment{ + dyType->GetAlignment(foldingContext.targetCharacteristics())}) { size = ((size + alignment - 1) / alignment) * alignment; } if (&s == &first) { @@ -753,7 +754,7 @@ combinedSymbol.set_size(bytes); std::size_t minElementBytes{ ComputeMinElementBytes(associated, foldingContext)}; - if (!evaluate::IsValidKindOfIntrinsicType( + if (!exprAnalyzer.GetFoldingContext().targetCharacteristics().IsTypeEnabled( TypeCategory::Integer, minElementBytes) || (bytes % minElementBytes) != 0) { minElementBytes = 1; Index: flang/lib/Semantics/expression.cpp =================================================================== --- flang/lib/Semantics/expression.cpp +++ flang/lib/Semantics/expression.cpp @@ -527,11 +527,12 @@ Constant ReadRealLiteral( parser::CharBlock source, FoldingContext &context) { const char *p{source.begin()}; - auto valWithFlags{Scalar::Read(p, context.rounding())}; + auto valWithFlags{ + Scalar::Read(p, context.targetCharacteristics().roundingMode())}; CHECK(p == source.end()); RealFlagWarnings(context, valWithFlags.flags, "conversion of REAL literal"); auto value{valWithFlags.value}; - if (context.flushSubnormalsToZero()) { + if (context.targetCharacteristics().areSubnormalsFlushedToZero()) { value = value.FlushSubnormalToZero(); } return {value}; @@ -904,7 +905,8 @@ StaticDataObject::Pointer staticData{StaticDataObject::Create()}; staticData->set_alignment(Result::kind) .set_itemBytes(Result::kind) - .Push(cp->GetScalarValue().value()); + .Push(cp->GetScalarValue().value(), + foldingContext_.targetCharacteristics().isBigEndian()); Substring substring{std::move(staticData), std::move(lower.value()), std::move(upper.value())}; return AsGenericExpr( @@ -3158,7 +3160,13 @@ bool ExpressionAnalyzer::CheckIntrinsicKind( TypeCategory category, std::int64_t kind) { - if (IsValidKindOfIntrinsicType(category, kind)) { // C712, C714, C715, C727 + if (foldingContext_.targetCharacteristics().IsTypeEnabled( + category, kind)) { // C712, C714, C715, C727 + return true; + } else if (foldingContext_.targetCharacteristics().CanSupportType( + category, kind)) { + Say("%s(KIND=%jd) is not an enabled type for this targe"_warn_en_US, + ToUpperCase(EnumToString(category)), kind); return true; } else { Say("%s(KIND=%jd) is not a supported type"_err_en_US, @@ -3169,17 +3177,29 @@ bool ExpressionAnalyzer::CheckIntrinsicSize( TypeCategory category, std::int64_t size) { + std::int64_t kind{size}; if (category == TypeCategory::Complex) { // COMPLEX*16 == COMPLEX(KIND=8) - if (size % 2 == 0 && IsValidKindOfIntrinsicType(category, size / 2)) { - return true; + if (size % 2 == 0) { + kind = size / 2; + } else { + Say("COMPLEX*%jd is not a supported type"_err_en_US, size); + return false; } - } else if (IsValidKindOfIntrinsicType(category, size)) { + } + if (foldingContext_.targetCharacteristics().IsTypeEnabled( + category, kind)) { // C712, C714, C715, C727 + return true; + } else if (foldingContext_.targetCharacteristics().CanSupportType( + category, kind)) { + Say("%s*%jd is not an enabled type for this target"_warn_en_US, + ToUpperCase(EnumToString(category)), size); return true; + } else { + Say("%s*%jd is not a supported type"_err_en_US, + ToUpperCase(EnumToString(category)), size); + return false; } - Say("%s*%jd is not a supported type"_err_en_US, - ToUpperCase(EnumToString(category)), size); - return false; } bool ExpressionAnalyzer::AddImpliedDo(parser::CharBlock name, int kind) { Index: flang/lib/Semantics/resolve-names.cpp =================================================================== --- flang/lib/Semantics/resolve-names.cpp +++ flang/lib/Semantics/resolve-names.cpp @@ -4325,7 +4325,7 @@ charInfo_.kind = EvaluateSubscriptIntExpr(x.kind); std::optional intKind{ToInt64(charInfo_.kind)}; if (intKind && - !evaluate::IsValidKindOfIntrinsicType( + !context().targetCharacteristics().IsTypeEnabled( TypeCategory::Character, *intKind)) { // C715, C719 Say(currStmtSource().value(), "KIND value (%jd) not valid for CHARACTER"_err_en_US, *intKind); Index: flang/lib/Semantics/semantics.cpp =================================================================== --- flang/lib/Semantics/semantics.cpp +++ flang/lib/Semantics/semantics.cpp @@ -290,8 +290,8 @@ intrinsics_{evaluate::IntrinsicProcTable::Configure(defaultKinds_)}, globalScope_{*this}, intrinsicModulesScope_{globalScope_.MakeScope( Scope::Kind::IntrinsicModules, nullptr)}, - foldingContext_{ - parser::ContextualMessages{&messages_}, defaultKinds_, intrinsics_} {} + foldingContext_{parser::ContextualMessages{&messages_}, defaultKinds_, + intrinsics_, targetCharacteristics_} {} SemanticsContext::~SemanticsContext() {} Index: flang/lib/Semantics/type.cpp =================================================================== --- flang/lib/Semantics/type.cpp +++ flang/lib/Semantics/type.cpp @@ -518,7 +518,8 @@ KindExpr copy{Fold(common::Clone(intrinsic.kind()))}; int kind{context().GetDefaultKind(intrinsic.category())}; if (auto value{evaluate::ToInt64(copy)}) { - if (evaluate::IsValidKindOfIntrinsicType(intrinsic.category(), *value)) { + if (foldingContext().targetCharacteristics().IsTypeEnabled( + intrinsic.category(), *value)) { kind = *value; } else { foldingContext().messages().Say(symbolName, Index: flang/test/Semantics/data05.f90 =================================================================== --- flang/test/Semantics/data05.f90 +++ flang/test/Semantics/data05.f90 @@ -73,15 +73,15 @@ end function subroutine s11 real, target, save :: arr(3,4) ! CHECK: arr, SAVE, TARGET size=48 offset=0: ObjectEntity type: REAL(4) shape: 1_8:3_8,1_8:4_8 - type(t1) :: d1 = t1(1,reshape([1,2,3,4],[2,2]),(6.,7.),.false.,'ab',arr,ifunc2,rfunc,extrfunc) ! CHECK: d1 size=184 offset=48: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc) + type(t1) :: d1 = t1(1,reshape([1,2,3,4],[2,2]),(6.,7.),.false.,'ab',arr,ifunc2,rfunc,extrfunc) ! CHECK: d1 size=168 offset=48: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc) type(t1(4,len=1)) :: d2 = t1(4)(xrp=extrfunc,rp=rfunc,ifptr=ifunc2,xp=arr,c='a& - &b',t=.false.,z=(6.,7.),x=reshape([1,2,3,4],[2,2]),j=1) ! CHECK: d2 size=184 offset=232: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc) - type(t1(2+2)) :: d3 ! CHECK: d3 (InDataStmt) size=184 offset=416: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc) + &b',t=.false.,z=(6.,7.),x=reshape([1,2,3,4],[2,2]),j=1) ! CHECK: d2 size=168 offset=216: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc) + type(t1(2+2)) :: d3 ! CHECK: d3 (InDataStmt) size=168 offset=384: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc) data d3/t1(1,reshape([1,2,3,4],[2,2]),(6.,7.),.false.,'ab',arr,ifunc2,rfunc,extrfunc)/ - type(t1) :: d4 ! CHECK: d4 (InDataStmt) size=184 offset=600: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc) + type(t1) :: d4 ! CHECK: d4 (InDataStmt) size=168 offset=552: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","a"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc) data d4/t1(4)(xrp=extrfunc,rp=rfunc,ifptr=ifunc2,xp=arr,c='ab',t=.false.,z=(6& &.,7.),x=reshape([1,2,3,4],[2,2]),j=1)/ - type(t1) :: d5 ! CHECK: d5 (InDataStmt) size=184 offset=784: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","b"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc) + type(t1) :: d5 ! CHECK: d5 (InDataStmt) size=168 offset=720: ObjectEntity type: TYPE(t1(kind=4_1,len=1_2)) init:t1(kind=4_1,len=1_2)(j=1_4,x=reshape([REAL(4)::1._4,2._4,3._4,4._4],shape=[2,2]),z=(6._4,7._4),t=.false._4,c=[CHARACTER(KIND=1,LEN=1)::"a","b"],xp=arr,ifptr=ifunc2,rp=rfunc,xrp=extrfunc) data d5%j/1/,d5%x/1,2,3,4/,d5%z%re/6./,d5%z%im/7./,d5%t/.false./,d5%c(1:1)/'a'/,d5%c(2:& &2)/'b'/,d5%xp/arr/,d5%ifptr/ifunc2/,d5%rp/rfunc/,d5%xrp/extrfunc/ end subroutine Index: flang/tools/bbc/bbc.cpp =================================================================== --- flang/tools/bbc/bbc.cpp +++ flang/tools/bbc/bbc.cpp @@ -207,7 +207,8 @@ fir::KindMapping kindMap( &ctx, llvm::ArrayRef{fir::fromDefaultKinds(defKinds)}); auto burnside = Fortran::lower::LoweringBridge::create( - ctx, defKinds, semanticsContext.intrinsics(), parsing.allCooked(), "", + ctx, defKinds, semanticsContext.intrinsics(), + semanticsContext.targetCharacteristics(), parsing.allCooked(), "", kindMap); burnside.lower(parseTree, semanticsContext); mlir::ModuleOp mlirModule = burnside.getModule(); Index: flang/unittests/Evaluate/expression.cpp =================================================================== --- flang/unittests/Evaluate/expression.cpp +++ flang/unittests/Evaluate/expression.cpp @@ -2,6 +2,7 @@ #include "testing.h" #include "flang/Evaluate/fold.h" #include "flang/Evaluate/intrinsics.h" +#include "flang/Evaluate/target.h" #include "flang/Evaluate/tools.h" #include "flang/Parser/message.h" #include @@ -20,8 +21,9 @@ MATCH("2_4+3_4*(-4_4)", ex1.AsFortran()); Fortran::common::IntrinsicTypeDefaultKinds defaults; auto intrinsics{Fortran::evaluate::IntrinsicProcTable::Configure(defaults)}; - FoldingContext context{ - Fortran::parser::ContextualMessages{nullptr}, defaults, intrinsics}; + TargetCharacteristics targetCharacteristics; + FoldingContext context{Fortran::parser::ContextualMessages{nullptr}, defaults, + intrinsics, targetCharacteristics}; ex1 = Fold(context, std::move(ex1)); MATCH("-10_4", ex1.AsFortran()); MATCH("1_4/2_4", (DefaultIntegerExpr{1} / DefaultIntegerExpr{2}).AsFortran()); Index: flang/unittests/Evaluate/folding.cpp =================================================================== --- flang/unittests/Evaluate/folding.cpp +++ flang/unittests/Evaluate/folding.cpp @@ -5,6 +5,7 @@ #include "flang/Evaluate/fold.h" #include "flang/Evaluate/intrinsics-library.h" #include "flang/Evaluate/intrinsics.h" +#include "flang/Evaluate/target.h" #include "flang/Evaluate/tools.h" #include @@ -44,10 +45,14 @@ Fortran::parser::ContextualMessages messages{src, nullptr}; Fortran::common::IntrinsicTypeDefaultKinds defaults; auto intrinsics{Fortran::evaluate::IntrinsicProcTable::Configure(defaults)}; + TargetCharacteristics flushingTargetCharacteristics; + flushingTargetCharacteristics.set_areSubnormalsFlushedToZero(true); + TargetCharacteristics noFlushingTargetCharacteristics; + noFlushingTargetCharacteristics.set_areSubnormalsFlushedToZero(false); FoldingContext flushingContext{ - messages, defaults, intrinsics, defaultRounding, true}; + messages, defaults, intrinsics, flushingTargetCharacteristics}; FoldingContext noFlushingContext{ - messages, defaults, intrinsics, defaultRounding, false}; + messages, defaults, intrinsics, noFlushingTargetCharacteristics}; DynamicType r4{R4{}.GetType()}; // Test subnormal argument flushing Index: flang/unittests/Evaluate/fp-testing.h =================================================================== --- flang/unittests/Evaluate/fp-testing.h +++ flang/unittests/Evaluate/fp-testing.h @@ -1,7 +1,7 @@ #ifndef FORTRAN_TEST_EVALUATE_FP_TESTING_H_ #define FORTRAN_TEST_EVALUATE_FP_TESTING_H_ -#include "flang/Evaluate/common.h" +#include "flang/Evaluate/target.h" #include using Fortran::common::RoundingMode; Index: flang/unittests/Evaluate/intrinsics.cpp =================================================================== --- flang/unittests/Evaluate/intrinsics.cpp +++ flang/unittests/Evaluate/intrinsics.cpp @@ -2,6 +2,7 @@ #include "testing.h" #include "flang/Evaluate/common.h" #include "flang/Evaluate/expression.h" +#include "flang/Evaluate/target.h" #include "flang/Evaluate/tools.h" #include "flang/Parser/provenance.h" #include "llvm/Support/raw_ostream.h" @@ -103,7 +104,8 @@ llvm::outs().flush(); CallCharacteristics call{fName.ToString()}; auto messages{strings.Messages(buffer)}; - FoldingContext context{messages, defaults, table}; + TargetCharacteristics targetCharacteristics; + FoldingContext context{messages, defaults, table, targetCharacteristics}; std::optional si{table.Probe(call, args, context)}; if (resultType.has_value()) { TEST(si.has_value());