mirrors/llvm-project
0
0
Fork 0
mirror of https://github.com/llvm/llvm-project.git synced 2025-04-19 08:36:44 +00:00
Code Issues Projects Releases Wiki Activity

[flang] Establish a single source of target information for semantics

Browse Source 
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.
This commit is contained in:
Peter Klausler 2022-07-01 11:40:44 -07:00
parent ff87ee4dee
commit 23c2bedfd9
34 changed files with 516 additions and 267 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
flang/include/flang/Evaluate/common.h
View File

@ -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 @@ public:
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 @@ private:
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_;

23
flang/include/flang/Evaluate/complex.h
View File

@ -60,25 +60,26 @@ public:
}
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);
}

53
flang/include/flang/Evaluate/real.h
View File

@ -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 @@ public:
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 @@ public:
// 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 @@ public:
}
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 @@ public:
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 @@ public:
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 @@ private:
// 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.

2
flang/include/flang/Evaluate/rounding-bits.h
View File

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

15
flang/include/flang/Evaluate/static-data.h
View File

@ -60,15 +60,14 @@ public:
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() {}

93
flang/include/flang/Evaluate/target.h Normal file
View File

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

9
flang/include/flang/Evaluate/type.h
View File

@ -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 @@ public:
}
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

12
flang/include/flang/Lower/Bridge.h
View File

@ -25,6 +25,7 @@ class IntrinsicTypeDefaultKinds;
} // namespace common
namespace evaluate {
class IntrinsicProcTable;
class TargetCharacteristics;
} // namespace evaluate
namespace parser {
class AllCookedSources;
@ -49,10 +50,11 @@ public:
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 @@ public:
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 @@ private:
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 @@ private:
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;

8
flang/include/flang/Semantics/semantics.h
View File

@ -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 @@ public:
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 @@ private:
bool warningsAreErrors_{false};
bool debugModuleWriter_{false};
const evaluate::IntrinsicProcTable intrinsics_;
evaluate::TargetCharacteristics targetCharacteristics_;
Scope globalScope_;
Scope &intrinsicModulesScope_;
parser::Messages messages_;

2
flang/lib/Evaluate/CMakeLists.txt
View File

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

5
flang/lib/Evaluate/characteristics.cpp
View File

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

25
flang/lib/Evaluate/fold-implementation.h
View File

@ -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>{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<T>{Constant<T>{difference.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}};

5
flang/lib/Evaluate/fold-integer.cpp
View File

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

8
flang/lib/Evaluate/host.cpp
View File

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

9
flang/lib/Evaluate/int-power.h
View File

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

2
flang/lib/Evaluate/intrinsics-library.cpp
View File

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

3
flang/lib/Evaluate/intrinsics.cpp
View File

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

31
flang/lib/Evaluate/static-data.cpp
View File

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

197
flang/lib/Evaluate/target.cpp Normal file
View File

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

115
flang/lib/Evaluate/type.cpp
View File

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

1
flang/lib/Frontend/FrontendActions.cpp
View File

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

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

@ -3174,7 +3174,7 @@ private:
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) {

21
flang/lib/Semantics/compute-offsets.cpp
View File

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

5
flang/lib/Semantics/data-to-inits.cpp
View File

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

42
flang/lib/Semantics/expression.cpp
View File

@ -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)) {
return true;
}
Say("%s*%jd is not a supported type"_err_en_US,
ToUpperCase(EnumToString(category)), size);
return false;
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;
}
}
bool ExpressionAnalyzer::AddImpliedDo(parser::CharBlock name, int kind) {

2
flang/lib/Semantics/resolve-names.cpp
View File

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

4
flang/lib/Semantics/semantics.cpp
View File

@ -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() {}

3
flang/lib/Semantics/type.cpp
View File

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

10
flang/test/Semantics/data05.f90
View File

@ -73,15 +73,15 @@ module m
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

3
flang/tools/bbc/bbc.cpp
View File

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

6
flang/unittests/Evaluate/expression.cpp
View File

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

9
flang/unittests/Evaluate/folding.cpp
View File

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

2
flang/unittests/Evaluate/fp-testing.h
View File

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

4
flang/unittests/Evaluate/intrinsics.cpp
View File

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