[flang-commits] [flang] 23c2bed - [flang] Establish a single source of target information for semantics
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Wed Jul 6 10:25:48 PDT 2022
Author: Peter Klausler
Date: 2022-07-06T10:25:34-07:00
New Revision: 23c2bedfd93cfacc62009425c464e659a34e92e6
URL: https://github.com/llvm/llvm-project/commit/23c2bedfd93cfacc62009425c464e659a34e92e6
DIFF: https://github.com/llvm/llvm-project/commit/23c2bedfd93cfacc62009425c464e659a34e92e6.diff
LOG: [flang] Establish a single source of target information for semantics
Create a TargetCharacteristics class to centralize the few items of
target specific information that are relevant to semantics. Use the
new class for all target queries, including derived type component layout
modeling.
Future work will initialize this class with target information
provided or forwarded by the drivers, and use it to fold layout-dependent
intrinsic functions like TRANSFER().
Differential Revision: https://reviews.llvm.org/D129018
Updates: Attempts to work around build issues on Windows.
Added:
flang/include/flang/Evaluate/target.h
flang/lib/Evaluate/target.cpp
Modified:
flang/include/flang/Evaluate/common.h
flang/include/flang/Evaluate/complex.h
flang/include/flang/Evaluate/real.h
flang/include/flang/Evaluate/rounding-bits.h
flang/include/flang/Evaluate/static-data.h
flang/include/flang/Evaluate/type.h
flang/include/flang/Lower/Bridge.h
flang/include/flang/Semantics/semantics.h
flang/lib/Evaluate/CMakeLists.txt
flang/lib/Evaluate/characteristics.cpp
flang/lib/Evaluate/fold-implementation.h
flang/lib/Evaluate/fold-integer.cpp
flang/lib/Evaluate/host.cpp
flang/lib/Evaluate/int-power.h
flang/lib/Evaluate/intrinsics-library.cpp
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Evaluate/static-data.cpp
flang/lib/Evaluate/type.cpp
flang/lib/Frontend/FrontendActions.cpp
flang/lib/Lower/Bridge.cpp
flang/lib/Semantics/compute-offsets.cpp
flang/lib/Semantics/data-to-inits.cpp
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/semantics.cpp
flang/lib/Semantics/type.cpp
flang/test/Semantics/data05.f90
flang/tools/bbc/bbc.cpp
flang/unittests/Evaluate/expression.cpp
flang/unittests/Evaluate/folding.cpp
flang/unittests/Evaluate/fp-testing.h
flang/unittests/Evaluate/intrinsics.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/common.h b/flang/include/flang/Evaluate/common.h
index e3c07056addf1..251444d05bab3 100644
--- a/flang/include/flang/Evaluate/common.h
+++ b/flang/include/flang/Evaluate/common.h
@@ -27,6 +27,7 @@ class DerivedTypeSpec;
namespace Fortran::evaluate {
class IntrinsicProcTable;
+class TargetCharacteristics;
using common::ConstantSubscript;
using common::RelationalOperator;
@@ -139,21 +140,6 @@ template <typename A> struct ValueWithRealFlags {
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 @@ template <typename A> class Expr;
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 @@ class FoldingContext {
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 @@ class FoldingContext {
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<parser::CharBlock, ConstantSubscript> impliedDos_;
diff --git a/flang/include/flang/Evaluate/complex.h b/flang/include/flang/Evaluate/complex.h
index 2feb25bc353eb..200965ed92121 100644
--- a/flang/include/flang/Evaluate/complex.h
+++ b/flang/include/flang/Evaluate/complex.h
@@ -60,25 +60,26 @@ template <typename REAL_TYPE> class Complex {
}
template <typename INT>
- static ValueWithRealFlags<Complex> FromInteger(
- const INT &n, Rounding rounding = defaultRounding) {
+ static ValueWithRealFlags<Complex> FromInteger(const INT &n,
+ Rounding rounding = TargetCharacteristics::defaultRounding) {
ValueWithRealFlags<Complex> result;
result.value.re_ =
Part::FromInteger(n, rounding).AccumulateFlags(result.flags);
return result;
}
- ValueWithRealFlags<Complex> Add(
- const Complex &, Rounding rounding = defaultRounding) const;
- ValueWithRealFlags<Complex> Subtract(
- const Complex &, Rounding rounding = defaultRounding) const;
- ValueWithRealFlags<Complex> Multiply(
- const Complex &, Rounding rounding = defaultRounding) const;
- ValueWithRealFlags<Complex> Divide(
- const Complex &, Rounding rounding = defaultRounding) const;
+ ValueWithRealFlags<Complex> Add(const Complex &,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+ ValueWithRealFlags<Complex> Subtract(const Complex &,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+ ValueWithRealFlags<Complex> Multiply(const Complex &,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+ ValueWithRealFlags<Complex> Divide(const Complex &,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
// ABS/CABS = HYPOT(re_, imag_) = SQRT(re_**2 + im_**2)
- ValueWithRealFlags<Part> ABS(Rounding rounding = defaultRounding) const {
+ ValueWithRealFlags<Part> ABS(
+ Rounding rounding = TargetCharacteristics::defaultRounding) const {
return re_.HYPOT(im_, rounding);
}
diff --git a/flang/include/flang/Evaluate/real.h b/flang/include/flang/Evaluate/real.h
index 7665c64ef1ebc..37c4010674768 100644
--- a/flang/include/flang/Evaluate/real.h
+++ b/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 <cinttypes>
#include <limits>
#include <string>
@@ -107,33 +107,34 @@ class Real : public common::RealDetails<PREC> {
constexpr Real Negate() const { return {word_.IEOR(word_.MASKL(1))}; }
Relation Compare(const Real &) const;
- ValueWithRealFlags<Real> Add(
- const Real &, Rounding rounding = defaultRounding) const;
- ValueWithRealFlags<Real> Subtract(
- const Real &y, Rounding rounding = defaultRounding) const {
+ ValueWithRealFlags<Real> Add(const Real &,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+ ValueWithRealFlags<Real> Subtract(const Real &y,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const {
return Add(y.Negate(), rounding);
}
- ValueWithRealFlags<Real> Multiply(
- const Real &, Rounding rounding = defaultRounding) const;
- ValueWithRealFlags<Real> Divide(
- const Real &, Rounding rounding = defaultRounding) const;
+ ValueWithRealFlags<Real> Multiply(const Real &,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+ ValueWithRealFlags<Real> Divide(const Real &,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
- ValueWithRealFlags<Real> SQRT(Rounding rounding = defaultRounding) const;
+ ValueWithRealFlags<Real> SQRT(
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
// NEAREST(), IEEE_NEXT_AFTER(), IEEE_NEXT_UP(), and IEEE_NEXT_DOWN()
ValueWithRealFlags<Real> NEAREST(bool upward) const;
// HYPOT(x,y)=SQRT(x**2 + y**2) computed so as to avoid spurious
// intermediate overflows.
- ValueWithRealFlags<Real> HYPOT(
- const Real &, Rounding rounding = defaultRounding) const;
+ ValueWithRealFlags<Real> HYPOT(const Real &,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
// DIM(X,Y) = MAX(X-Y, 0)
- ValueWithRealFlags<Real> DIM(
- const Real &, Rounding rounding = defaultRounding) const;
+ ValueWithRealFlags<Real> 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<Real> MOD(
- const Real &, Rounding rounding = defaultRounding) const;
- ValueWithRealFlags<Real> MODULO(
- const Real &, Rounding rounding = defaultRounding) const;
+ ValueWithRealFlags<Real> MOD(const Real &,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
+ ValueWithRealFlags<Real> MODULO(const Real &,
+ Rounding rounding = TargetCharacteristics::defaultRounding) const;
template <typename INT> constexpr INT EXPONENT() const {
if (Exponent() == maxExponent) {
@@ -172,8 +173,8 @@ class Real : public common::RealDetails<PREC> {
// SCALE(); also known as IEEE_SCALB and (in IEEE-754 '08) ScaleB.
template <typename INT>
- ValueWithRealFlags<Real> SCALE(
- const INT &by, Rounding rounding = defaultRounding) const {
+ ValueWithRealFlags<Real> 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 @@ class Real : public common::RealDetails<PREC> {
}
template <typename INT>
- static ValueWithRealFlags<Real> FromInteger(
- const INT &n, Rounding rounding = defaultRounding) {
+ static ValueWithRealFlags<Real> FromInteger(const INT &n,
+ Rounding rounding = TargetCharacteristics::defaultRounding) {
bool isNegative{n.IsNegative()};
INT absN{n};
if (isNegative) {
@@ -294,7 +295,7 @@ class Real : public common::RealDetails<PREC> {
template <typename A>
static ValueWithRealFlags<Real> Convert(
- const A &x, Rounding rounding = defaultRounding) {
+ const A &x, Rounding rounding = TargetCharacteristics::defaultRounding) {
ValueWithRealFlags<Real> result;
if (x.IsNotANumber()) {
result.flags.set(RealFlag::InvalidArgument);
@@ -361,8 +362,8 @@ class Real : public common::RealDetails<PREC> {
return exponent;
}
- static ValueWithRealFlags<Real> Read(
- const char *&, Rounding rounding = defaultRounding);
+ static ValueWithRealFlags<Real> Read(const char *&,
+ Rounding rounding = TargetCharacteristics::defaultRounding);
std::string DumpHexadecimal() const;
// Emits a character representation for an equivalent Fortran constant
@@ -407,7 +408,7 @@ class Real : public common::RealDetails<PREC> {
// 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.
diff --git a/flang/include/flang/Evaluate/rounding-bits.h b/flang/include/flang/Evaluate/rounding-bits.h
index 7fddaa0fce730..c30b0fb703771 100644
--- a/flang/include/flang/Evaluate/rounding-bits.h
+++ b/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.
diff --git a/flang/include/flang/Evaluate/static-data.h b/flang/include/flang/Evaluate/static-data.h
index 8a12c9893e613..833cc6cc6f3fa 100644
--- a/flang/include/flang/Evaluate/static-data.h
+++ b/flang/include/flang/Evaluate/static-data.h
@@ -60,15 +60,14 @@ class StaticDataObject {
const std::vector<std::uint8_t> &data() const { return data_; }
std::vector<std::uint8_t> &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<std::string> AsString() const;
- std::optional<std::u16string> AsU16String() const;
- std::optional<std::u32string> AsU32String() const;
- llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
-
- static bool bigEndian;
+ std::optional<std::u16string> AsU16String(bool bigEndian = false) const;
+ std::optional<std::u32string> AsU32String(bool bigEndian = false) const;
+ llvm::raw_ostream &AsFortran(
+ llvm::raw_ostream &, bool bigEndian = false) const;
private:
StaticDataObject() {}
diff --git a/flang/include/flang/Evaluate/target.h b/flang/include/flang/Evaluate/target.h
new file mode 100644
index 0000000000000..feb3ae55e0d45
--- /dev/null
+++ b/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 <cstdint>
+
+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_
diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index 54cb50fc7898e..8f469daa439dd 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -43,6 +43,7 @@ bool IsDescriptor(const Symbol &);
namespace Fortran::evaluate {
using common::TypeCategory;
+class TargetCharacteristics;
// Specific intrinsic types are represented by specializations of
// this class template Type<CATEGORY, KIND>.
@@ -58,7 +59,6 @@ using Ascii = Type<TypeCategory::Character, 1>;
// 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 @@ class DynamicType {
}
std::optional<Expr<SubscriptInteger>> GetCharLength() const;
- std::size_t GetAlignment(const FoldingContext &) const;
+ std::size_t GetAlignment(const TargetCharacteristics &) const;
std::optional<Expr<SubscriptInteger>> MeasureSizeInBytes(
FoldingContext &, bool aligned) const;
@@ -448,9 +448,8 @@ template <typename CONST> struct TypeOfHelper {
template <typename CONST> using TypeOf = typename TypeOfHelper<CONST>::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
diff --git a/flang/include/flang/Lower/Bridge.h b/flang/include/flang/Lower/Bridge.h
index fe2b5b2870778..9b445e2177b40 100644
--- a/flang/include/flang/Lower/Bridge.h
+++ b/flang/include/flang/Lower/Bridge.h
@@ -25,6 +25,7 @@ class IntrinsicTypeDefaultKinds;
} // namespace common
namespace evaluate {
class IntrinsicProcTable;
+class TargetCharacteristics;
} // namespace evaluate
namespace parser {
class AllCookedSources;
@@ -49,10 +50,11 @@ class LoweringBridge {
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 @@ class LoweringBridge {
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 @@ class LoweringBridge {
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 @@ class LoweringBridge {
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<mlir::ModuleOp> module;
diff --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h
index cc57577f53c74..2d08a9f03557c 100644
--- a/flang/include/flang/Semantics/semantics.h
+++ b/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 <iosfwd>
#include <set>
@@ -96,6 +97,12 @@ class SemanticsContext {
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 @@ class SemanticsContext {
bool warningsAreErrors_{false};
bool debugModuleWriter_{false};
const evaluate::IntrinsicProcTable intrinsics_;
+ evaluate::TargetCharacteristics targetCharacteristics_;
Scope globalScope_;
Scope &intrinsicModulesScope_;
parser::Messages messages_;
diff --git a/flang/lib/Evaluate/CMakeLists.txt b/flang/lib/Evaluate/CMakeLists.txt
index 1bb82ac848310..7195edc3c0e56 100644
--- a/flang/lib/Evaluate/CMakeLists.txt
+++ b/flang/lib/Evaluate/CMakeLists.txt
@@ -45,6 +45,7 @@ add_flang_library(FortranEvaluate
real.cpp
shape.cpp
static-data.cpp
+ target.cpp
tools.cpp
type.cpp
variable.cpp
@@ -62,4 +63,3 @@ add_flang_library(FortranEvaluate
acc_gen
omp_gen
)
-
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 2cfdb9d282426..ea592e5b6a8f8 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -167,7 +167,10 @@ std::optional<Expr<SubscriptInteger>> TypeAndShape::MeasureElementSizeInBytes(
if (LEN_) {
CHECK(type_.category() == TypeCategory::Character);
return Fold(foldingContext,
- Expr<SubscriptInteger>{type_.kind()} * Expr<SubscriptInteger>{*LEN_});
+ Expr<SubscriptInteger>{
+ foldingContext.targetCharacteristics().GetByteSize(
+ type_.category(), type_.kind())} *
+ Expr<SubscriptInteger>{*LEN_});
}
if (auto elementBytes{type_.MeasureSizeInBytes(foldingContext, align)}) {
return Fold(foldingContext, std::move(*elementBytes));
diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index c0dee020f8fb8..6a04bfaf6834f 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -1622,7 +1622,7 @@ Expr<TO> FoldOperation(
"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 @@ Expr<T> FoldOperation(FoldingContext &context, Add<T> &&x) {
}
return Expr<T>{Constant<T>{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<T>{Constant<T>{sum.value}};
@@ -1774,10 +1775,10 @@ Expr<T> FoldOperation(FoldingContext &context, Subtract<T> &&x) {
}
return Expr<T>{Constant<T>{
diff erence.value}};
} else {
- auto
diff erence{
- folded->first.Subtract(folded->second, context.rounding())};
+ auto
diff erence{folded->first.Subtract(
+ folded->second, context.targetCharacteristics().roundingMode())};
RealFlagWarnings(context,
diff erence.flags, "subtraction");
- if (context.flushSubnormalsToZero()) {
+ if (context.targetCharacteristics().areSubnormalsFlushedToZero()) {
diff erence.value =
diff erence.value.FlushSubnormalToZero();
}
return Expr<T>{Constant<T>{
diff erence.value}};
@@ -1800,9 +1801,10 @@ Expr<T> FoldOperation(FoldingContext &context, Multiply<T> &&x) {
}
return Expr<T>{Constant<T>{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<T>{Constant<T>{product.value}};
@@ -1844,7 +1846,8 @@ Expr<T> FoldOperation(FoldingContext &context, Divide<T> &&x) {
}
return Expr<T>{Constant<T>{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 @@ Expr<T> FoldOperation(FoldingContext &context, Divide<T> &&x) {
if (!isCanonicalNaNOrInf) {
RealFlagWarnings(context, quotient.flags, "division");
}
- if (context.flushSubnormalsToZero()) {
+ if (context.targetCharacteristics().areSubnormalsFlushedToZero()) {
quotient.value = quotient.value.FlushSubnormalToZero();
}
return Expr<T>{Constant<T>{quotient.value}};
@@ -1913,7 +1916,7 @@ Expr<T> FoldOperation(FoldingContext &context, RealToIntPower<T> &&x) {
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<T>{Constant<T>{power.value}};
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index 8c1f2122a7ac9..54b6582cffd81 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -947,14 +947,15 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
}
} else if (name == "selected_int_kind") {
if (auto p{GetInt64Arg(args[0])}) {
- return Expr<T>{SelectedIntKind(*p)};
+ return Expr<T>{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<T>{SelectedRealKind(*p, *r, *radix)};
+ return Expr<T>{
+ context.targetCharacteristics().SelectedRealKind(*p, *r, *radix)};
}
}
}
diff --git a/flang/lib/Evaluate/host.cpp b/flang/lib/Evaluate/host.cpp
index b97a2619a2bb1..a2282e9cd82cd 100644
--- a/flang/lib/Evaluate/host.cpp
+++ b/flang/lib/Evaluate/host.cpp
@@ -36,7 +36,7 @@ void HostFloatingPointEnvironment::SetUpHostFloatingPointEnvironment(
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 @@ void HostFloatingPointEnvironment::SetUpHostFloatingPointEnvironment(
#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 @@ void HostFloatingPointEnvironment::SetUpHostFloatingPointEnvironment(
_mm_setcsr(currentMxcsr);
#endif
- switch (context.rounding().mode) {
+ switch (context.targetCharacteristics().roundingMode().mode) {
case common::RoundingMode::TiesToEven:
fesetround(FE_TONEAREST);
break;
diff --git a/flang/lib/Evaluate/int-power.h b/flang/lib/Evaluate/int-power.h
index e700cacd380ff..0d6a133ae73c5 100644
--- a/flang/lib/Evaluate/int-power.h
+++ b/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 <typename REAL, typename INT>
ValueWithRealFlags<REAL> TimesIntPowerOf(const REAL &factor, const REAL &base,
- const INT &power, Rounding rounding = defaultRounding) {
+ const INT &power,
+ Rounding rounding = TargetCharacteristics::defaultRounding) {
ValueWithRealFlags<REAL> result{factor};
if (base.IsNotANumber()) {
result.value = REAL::NotANumber();
@@ -49,8 +50,8 @@ ValueWithRealFlags<REAL> TimesIntPowerOf(const REAL &factor, const REAL &base,
}
template <typename REAL, typename INT>
-ValueWithRealFlags<REAL> IntPower(
- const REAL &base, const INT &power, Rounding rounding = defaultRounding) {
+ValueWithRealFlags<REAL> IntPower(const REAL &base, const INT &power,
+ Rounding rounding = TargetCharacteristics::defaultRounding) {
REAL one{REAL::FromInteger(INT{1}).value};
return TimesIntPowerOf(one, base, power, rounding);
}
diff --git a/flang/lib/Evaluate/intrinsics-library.cpp b/flang/lib/Evaluate/intrinsics-library.cpp
index e33c9fe525915..17cbc7db50083 100644
--- a/flang/lib/Evaluate/intrinsics-library.cpp
+++ b/flang/lib/Evaluate/intrinsics-library.cpp
@@ -149,7 +149,7 @@ static Expr<SomeType> ApplyHostFunctionHelper(FuncType func,
Scalar<TR> result{};
std::tuple<Scalar<TA>...> scalarArgs{
GetScalarConstantValue<TA>(args[I]).value()...};
- if (context.flushSubnormalsToZero() &&
+ if (context.targetCharacteristics().areSubnormalsFlushedToZero() &&
!hostFPE.hasSubnormalFlushingHardwareControl()) {
hostResult = func(host::CastFortranToHost<TA>(
FlushSubnormals<TA>(std::move(std::get<I>(scalarArgs))))...);
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index bc9e389cfed90..ff31aae6fdd47 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1679,7 +1679,8 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
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<int>(*code), 1};
} else {
diff --git a/flang/lib/Evaluate/static-data.cpp b/flang/lib/Evaluate/static-data.cpp
index a288b08ebfab5..9063de0f3a938 100644
--- a/flang/lib/Evaluate/static-data.cpp
+++ b/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 @@ llvm::raw_ostream &StaticDataObject::AsFortran(llvm::raw_ostream &o) const {
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<std::uint8_t>(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<std::uint8_t>(ch >> shift));
data_.push_back(static_cast<std::uint8_t>(ch >> (shift ^ 8)));
@@ -42,8 +42,9 @@ StaticDataObject &StaticDataObject::Push(const std::u16string &string) {
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<std::uint8_t>(ch >> shift));
data_.push_back(static_cast<std::uint8_t>(ch >> (shift ^ 8)));
@@ -64,9 +65,10 @@ std::optional<std::string> StaticDataObject::AsString() const {
return std::nullopt;
}
-std::optional<std::u16string> StaticDataObject::AsU16String() const {
+std::optional<std::u16string> 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 @@ std::optional<std::u16string> StaticDataObject::AsU16String() const {
return std::nullopt;
}
-std::optional<std::u32string> StaticDataObject::AsU32String() const {
+std::optional<std::u32string> 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;) {
diff --git a/flang/lib/Evaluate/target.cpp b/flang/lib/Evaluate/target.cpp
new file mode 100644
index 0000000000000..691487875179c
--- /dev/null
+++ b/flang/lib/Evaluate/target.cpp
@@ -0,0 +1,197 @@
+//===-- 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<std::size_t>(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) {
+ 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<int>(category)][kind] = byteSize;
+ align_[static_cast<int>(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<int>(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<int>(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<int>(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<int>;
+ using Types = IntegerTypes;
+ template <typename T> Result Test() const {
+ if (Scalar<T>::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<int>;
+ using Types = RealTypes;
+ template <typename T> Result Test() const {
+ if (Scalar<T>::PRECISION >= precision_ && Scalar<T>::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
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index 4971f722aee4a..97e707a34cc8b 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/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 @@ std::optional<Expr<SubscriptInteger>> DynamicType::GetCharLength() const {
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<std::size_t>(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 @@ std::optional<Expr<SubscriptInteger>> DynamicType::MeasureSizeInBytes(
FoldingContext &context, bool aligned) const {
switch (category_) {
case TypeCategory::Integer:
- return Expr<SubscriptInteger>{kind_};
case TypeCategory::Real:
- return Expr<SubscriptInteger>{RealKindBytes(kind_)};
case TypeCategory::Complex:
- return Expr<SubscriptInteger>{2 * RealKindBytes(kind_)};
+ case TypeCategory::Logical:
+ return Expr<SubscriptInteger>{
+ context.targetCharacteristics().GetByteSize(category_, kind_)};
case TypeCategory::Character:
if (auto len{GetCharLength()}) {
- return Fold(context, Expr<SubscriptInteger>{kind_} * std::move(*len));
+ return Fold(context,
+ Expr<SubscriptInteger>{
+ context.targetCharacteristics().GetByteSize(category_, kind_)} *
+ std::move(*len));
}
break;
- case TypeCategory::Logical:
- return Expr<SubscriptInteger>{kind_};
case TypeCategory::Derived:
if (derived_ && derived_->scope()) {
auto size{derived_->scope()->size()};
@@ -509,78 +492,6 @@ int SelectedCharKind(const std::string &s, int defaultKind) { // 16.9.168
}
}
-class SelectedIntKindVisitor {
-public:
- explicit SelectedIntKindVisitor(std::int64_t p) : precision_{p} {}
- using Result = std::optional<int>;
- using Types = IntegerTypes;
- template <typename T> Result Test() const {
- if (Scalar<T>::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<int>;
- using Types = RealTypes;
- template <typename T> Result Test() const {
- if (Scalar<T>::PRECISION >= precision_ && Scalar<T>::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<DynamicType> ComparisonType(
const DynamicType &t1, const DynamicType &t2) {
switch (t1.category()) {
diff --git a/flang/lib/Frontend/FrontendActions.cpp b/flang/lib/Frontend/FrontendActions.cpp
index c53d9f2347faf..df1b509aad685 100644
--- a/flang/lib/Frontend/FrontendActions.cpp
+++ b/flang/lib/Frontend/FrontendActions.cpp
@@ -146,6 +146,7 @@ bool CodeGenAction::beginSourceFileAction() {
llvm::ArrayRef<fir::KindTy>{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);
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index a77a34913c982..edcc440937a44 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -3174,7 +3174,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
Fortran::evaluate::FoldingContext
Fortran::lower::LoweringBridge::createFoldingContext() const {
- return {getDefaultKinds(), getIntrinsicTable()};
+ return {getDefaultKinds(), getIntrinsicTable(), getTargetCharacteristics()};
}
void Fortran::lower::LoweringBridge::lower(
@@ -3199,9 +3199,11 @@ Fortran::lower::LoweringBridge::LoweringBridge(
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) {
diff --git a/flang/lib/Semantics/compute-offsets.cpp b/flang/lib/Semantics/compute-offsets.cpp
index 82b4eeff390a3..c789fcecbbba0 100644
--- a/flang/lib/Semantics/compute-offsets.cpp
+++ b/flang/lib/Semantics/compute-offsets.cpp
@@ -313,33 +313,35 @@ std::size_t ComputeOffsetsHelper::DoSymbol(Symbol &symbol) {
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<std::size_t>(*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<std::size_t>(*size),
- chars->type().GetAlignment(foldingContext)};
+ chars->type().GetAlignment(targetCharacteristics)};
}
}
}
@@ -348,7 +350,8 @@ auto ComputeOffsetsHelper::GetSizeAndAlignment(
// 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;
}
diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
index b3c786c18c940..be333d9d8c1d5 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -673,7 +673,8 @@ static std::size_t ComputeMinElementBytes(
auto size{static_cast<std::size_t>(
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 @@ static bool CombineEquivalencedInitialization(
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;
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 366259caef945..7bcd97607a049 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -527,11 +527,12 @@ template <typename TYPE>
Constant<TYPE> ReadRealLiteral(
parser::CharBlock source, FoldingContext &context) {
const char *p{source.begin()};
- auto valWithFlags{Scalar<TYPE>::Read(p, context.rounding())};
+ auto valWithFlags{
+ Scalar<TYPE>::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 @@ MaybeExpr ExpressionAnalyzer::Analyze(
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 @@ DynamicType ExpressionAnalyzer::GetDefaultKindOfType(
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::CheckIntrinsicKind(
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) {
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index b3b7e306ae4a0..7384dd476b997 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -4325,7 +4325,7 @@ void DeclarationVisitor::Post(const parser::CharSelector::LengthAndKind &x) {
charInfo_.kind = EvaluateSubscriptIntExpr(x.kind);
std::optional<std::int64_t> 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);
diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp
index 762877d671dab..20fd0ab6c6d45 100644
--- a/flang/lib/Semantics/semantics.cpp
+++ b/flang/lib/Semantics/semantics.cpp
@@ -290,8 +290,8 @@ SemanticsContext::SemanticsContext(
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() {}
diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp
index 98ad4fd6d0361..442f5e320f779 100644
--- a/flang/lib/Semantics/type.cpp
+++ b/flang/lib/Semantics/type.cpp
@@ -518,7 +518,8 @@ const DeclTypeSpec &InstantiateHelper::InstantiateIntrinsicType(
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,
diff --git a/flang/test/Semantics/data05.f90 b/flang/test/Semantics/data05.f90
index 8e059c2c06527..7d7693ba3d21f 100644
--- a/flang/test/Semantics/data05.f90
+++ b/flang/test/Semantics/data05.f90
@@ -73,15 +73,15 @@ integer function ifunc2(n)
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
diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp
index f8a8b3a7e0dcc..6f2f326173f2b 100644
--- a/flang/tools/bbc/bbc.cpp
+++ b/flang/tools/bbc/bbc.cpp
@@ -207,7 +207,8 @@ static mlir::LogicalResult convertFortranSourceToMLIR(
fir::KindMapping kindMap(
&ctx, llvm::ArrayRef<fir::KindTy>{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();
diff --git a/flang/unittests/Evaluate/expression.cpp b/flang/unittests/Evaluate/expression.cpp
index 47419e410f581..732dc6dba7ff7 100644
--- a/flang/unittests/Evaluate/expression.cpp
+++ b/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 <cstdio>
@@ -20,8 +21,9 @@ int main() {
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());
diff --git a/flang/unittests/Evaluate/folding.cpp b/flang/unittests/Evaluate/folding.cpp
index b4fbf10297018..fd7e61f1a2dd9 100644
--- a/flang/unittests/Evaluate/folding.cpp
+++ b/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 <tuple>
@@ -44,10 +45,14 @@ void TestHostRuntimeSubnormalFlushing() {
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
diff --git a/flang/unittests/Evaluate/fp-testing.h b/flang/unittests/Evaluate/fp-testing.h
index ee06765879b3d..22dfa2d7d80c6 100644
--- a/flang/unittests/Evaluate/fp-testing.h
+++ b/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 <fenv.h>
using Fortran::common::RoundingMode;
diff --git a/flang/unittests/Evaluate/intrinsics.cpp b/flang/unittests/Evaluate/intrinsics.cpp
index 363171636dfc2..bb83e0c061547 100644
--- a/flang/unittests/Evaluate/intrinsics.cpp
+++ b/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 @@ struct TestCall {
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<SpecificCall> si{table.Probe(call, args, context)};
if (resultType.has_value()) {
TEST(si.has_value());
More information about the flang-commits
mailing list