From d8f72a31059c5ace0d9378c412bbf96e60d37301 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Thu, 6 Jun 2019 13:42:33 -0700 Subject: [PATCH] [flang] Placeholder for standard module iso_fortran_env Original-commit: flang-compiler/f18@386ebb04901f2fc46e7a5c2e64fbfa0586065acb Reviewed-on: https://github.com/flang-compiler/f18/pull/485 Tree-same-pre-rewrite: false --- flang/lib/common/default-kinds.cc | 6 ---- flang/lib/common/default-kinds.h | 13 ++++--- flang/lib/evaluate/common.cc | 8 ++--- flang/lib/evaluate/common.h | 11 +++--- flang/lib/evaluate/constant.cc | 16 ++++----- flang/lib/evaluate/constant.h | 11 +++--- flang/lib/evaluate/fold.cc | 27 ++++++++------- flang/lib/evaluate/formatting.cc | 4 +-- flang/lib/evaluate/variable.cc | 11 +++--- flang/module/iso_fortran_env.f90 | 72 +++++++++++++++++++++++++++++++++++++++ flang/tools/f18/f18-parse-demo.cc | 2 -- flang/tools/f18/f18.cc | 2 -- 12 files changed, 128 insertions(+), 55 deletions(-) create mode 100644 flang/module/iso_fortran_env.f90 diff --git a/flang/lib/common/default-kinds.cc b/flang/lib/common/default-kinds.cc index 18bdcb8..047996a 100644 --- a/flang/lib/common/default-kinds.cc +++ b/flang/lib/common/default-kinds.cc @@ -29,12 +29,6 @@ IntrinsicTypeDefaultKinds &IntrinsicTypeDefaultKinds::set_defaultIntegerKind( return *this; } -IntrinsicTypeDefaultKinds &IntrinsicTypeDefaultKinds::set_subscriptIntegerKind( - int k) { - subscriptIntegerKind_ = k; - return *this; -} - IntrinsicTypeDefaultKinds &IntrinsicTypeDefaultKinds::set_defaultRealKind( int k) { defaultRealKind_ = k; diff --git a/flang/lib/common/default-kinds.h b/flang/lib/common/default-kinds.h index 3190134..8b4ab24 100644 --- a/flang/lib/common/default-kinds.h +++ b/flang/lib/common/default-kinds.h @@ -16,21 +16,25 @@ #define FORTRAN_COMMON_DEFAULT_KINDS_H_ #include "Fortran.h" +#include // Represent the default values of the kind parameters of the -// various intrinsic types. These can be configured by means of -// the compiler command line. +// various intrinsic types. Most of these can be configured by +// means of the compiler command line; subscriptIntegerKind, +// however, is fixed at 8 because all address calculations are +// 64-bit safe. namespace Fortran::common { +using SubscriptCIntType = std::int64_t; + class IntrinsicTypeDefaultKinds { public: IntrinsicTypeDefaultKinds(); - int subscriptIntegerKind() const { return subscriptIntegerKind_; } + static constexpr int subscriptIntegerKind() { return 8; } int doublePrecisionKind() const { return doublePrecisionKind_; } int quadPrecisionKind() const { return quadPrecisionKind_; } IntrinsicTypeDefaultKinds &set_defaultIntegerKind(int); - IntrinsicTypeDefaultKinds &set_subscriptIntegerKind(int); IntrinsicTypeDefaultKinds &set_defaultRealKind(int); IntrinsicTypeDefaultKinds &set_doublePrecisionKind(int); IntrinsicTypeDefaultKinds &set_quadPrecisionKind(int); @@ -46,7 +50,6 @@ private: // storage unit, so their kinds are also forced. Default COMPLEX must always // comprise two default REAL components. int defaultIntegerKind_{4}; - int subscriptIntegerKind_{8}; // for large arrays int defaultRealKind_{defaultIntegerKind_}; int doublePrecisionKind_{2 * defaultRealKind_}; int quadPrecisionKind_{2 * doublePrecisionKind_}; diff --git a/flang/lib/evaluate/common.cc b/flang/lib/evaluate/common.cc index 0b71550..f2296a04 100644 --- a/flang/lib/evaluate/common.cc +++ b/flang/lib/evaluate/common.cc @@ -1,4 +1,4 @@ -// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved. +// Copyright (c) 2018-2019, NVIDIA CORPORATION. All rights reserved. // // Licensed under the Apache License, Version 2.0 (the "License"); // you may not use this file except in compliance with the License. @@ -35,14 +35,14 @@ void RealFlagWarnings( } } -std::int64_t &FoldingContext::StartImpliedDo( - parser::CharBlock name, std::int64_t n) { +common::SubscriptCIntType &FoldingContext::StartImpliedDo( + parser::CharBlock name, common::SubscriptCIntType n) { auto pair{impliedDos_.insert(std::make_pair(name, n))}; CHECK(pair.second); return pair.first->second; } -std::optional FoldingContext::GetImpliedDo( +std::optional FoldingContext::GetImpliedDo( parser::CharBlock name) const { if (auto iter{impliedDos_.find(name)}; iter != impliedDos_.cend()) { return {iter->second}; diff --git a/flang/lib/evaluate/common.h b/flang/lib/evaluate/common.h index 5d39abd..3f5b7e0 100644 --- a/flang/lib/evaluate/common.h +++ b/flang/lib/evaluate/common.h @@ -17,6 +17,7 @@ #include "intrinsics-library.h" #include "../common/Fortran.h" +#include "../common/default-kinds.h" #include "../common/enum-set.h" #include "../common/idioms.h" #include "../common/indirection.h" @@ -228,11 +229,13 @@ public: return hostIntrinsicsLibrary_; } - std::int64_t &StartImpliedDo(parser::CharBlock, std::int64_t = 1); - std::optional GetImpliedDo(parser::CharBlock) const; + common::SubscriptCIntType &StartImpliedDo( + parser::CharBlock, common::SubscriptCIntType = 1); + std::optional GetImpliedDo( + parser::CharBlock) const; void EndImpliedDo(parser::CharBlock); - std::map &impliedDos() { + std::map &impliedDos() { return impliedDos_; } @@ -247,7 +250,7 @@ private: bool flushSubnormalsToZero_{false}; bool bigEndian_{false}; const semantics::DerivedTypeSpec *pdtInstance_{nullptr}; - std::map impliedDos_; + std::map impliedDos_; HostIntrinsicProceduresLibrary hostIntrinsicsLibrary_; }; diff --git a/flang/lib/evaluate/constant.cc b/flang/lib/evaluate/constant.cc index 8be8c3c..a00a950 100644 --- a/flang/lib/evaluate/constant.cc +++ b/flang/lib/evaluate/constant.cc @@ -109,23 +109,23 @@ auto Constant::Reshape(ConstantSubscripts &&dims) const -> Constant { template Constant>::Constant( const Scalar &str) - : values_{str}, length_{static_cast(values_.size())} {} + : values_{str}, length_{static_cast(values_.size())} {} template Constant>::Constant(Scalar &&str) : values_{std::move(str)}, length_{ - static_cast(values_.size())} {} + static_cast(values_.size())} {} template -Constant>::Constant(std::int64_t len, +Constant>::Constant(LengthCIntType len, std::vector> &&strings, ConstantSubscripts &&dims) : length_{len}, shape_{std::move(dims)} { CHECK(strings.size() == TotalElementCount(shape_)); values_.assign(strings.size() * length_, static_cast::value_type>(' ')); - std::int64_t at{0}; + LengthCIntType at{0}; for (const auto &str : strings) { - auto strLen{static_cast(str.size())}; + auto strLen{static_cast(str.size())}; if (strLen > length_) { values_.replace(at, length_, str.substr(0, length_)); } else { @@ -133,7 +133,7 @@ Constant>::Constant(std::int64_t len, } at += length_; } - CHECK(at == static_cast(values_.size())); + CHECK(at == static_cast(values_.size())); } template Constant>::~Constant() {} @@ -148,7 +148,7 @@ std::size_t Constant>::size() const { if (length_ == 0) { return TotalElementCount(shape_); } else { - return static_cast(values_.size()) / length_; + return static_cast(values_.size()) / length_; } } @@ -165,7 +165,7 @@ auto Constant>::Reshape( std::size_t n{TotalElementCount(dims)}; CHECK(!empty() || n == 0); std::vector elements; - std::int64_t at{0}, limit{static_cast(values_.size())}; + LengthCIntType at{0}, limit{static_cast(values_.size())}; while (n-- > 0) { elements.push_back(values_.substr(at, length_)); at += length_; diff --git a/flang/lib/evaluate/constant.h b/flang/lib/evaluate/constant.h index 7217eb9..c5c9cc0 100644 --- a/flang/lib/evaluate/constant.h +++ b/flang/lib/evaluate/constant.h @@ -17,6 +17,7 @@ #include "formatting.h" #include "type.h" +#include "../common/default-kinds.h" #include #include #include @@ -35,12 +36,14 @@ template class Constant; // When describing shapes of constants or specifying 1-based subscript // values as indices into constants, use a vector of integers. -using ConstantSubscript = std::int64_t; +using ConstantSubscript = common::SubscriptCIntType; using ConstantSubscripts = std::vector; inline int GetRank(const ConstantSubscripts &s) { return static_cast(s.size()); } +using LengthCIntType = common::SubscriptCIntType; + std::size_t TotalElementCount(const ConstantSubscripts &); inline ConstantSubscripts InitialSubscripts(int rank) { @@ -127,7 +130,7 @@ public: CLASS_BOILERPLATE(Constant) explicit Constant(const Scalar &); explicit Constant(Scalar &&); - Constant(std::int64_t, std::vector &&, ConstantSubscripts &&); + Constant(LengthCIntType, std::vector &&, ConstantSubscripts &&); ~Constant(); int Rank() const { return GetRank(shape_); } @@ -138,7 +141,7 @@ public: std::size_t size() const; const ConstantSubscripts &shape() const { return shape_; } - std::int64_t LEN() const { return length_; } + LengthCIntType LEN() const { return length_; } std::optional> GetScalarValue() const { if (shape_.empty()) { @@ -160,7 +163,7 @@ public: private: Scalar values_; // one contiguous string - std::int64_t length_; + LengthCIntType length_; ConstantSubscripts shape_; }; diff --git a/flang/lib/evaluate/fold.cc b/flang/lib/evaluate/fold.cc index cb5185f..baf05db 100644 --- a/flang/lib/evaluate/fold.cc +++ b/flang/lib/evaluate/fold.cc @@ -267,8 +267,8 @@ static inline Expr FoldElementalIntrinsicHelper(FoldingContext &context, } // Build and return constant result if constexpr (TR::category == TypeCategory::Character) { - std::int64_t len{ - static_cast(results.size() ? results[0].length() : 0)}; + auto len{static_cast( + results.size() ? results[0].length() : 0)}; return Expr{Constant{len, std::move(results), std::move(shape)}}; } else { return Expr{Constant{std::move(results), std::move(shape)}}; @@ -966,8 +966,8 @@ static std::optional> GetConstantSubscript( } }, [](Triplet &triplet) -> std::optional> { - std::optional lbi{1}, ubi; - std::optional stride{ToInt64(triplet.stride())}; + std::optional lbi{1}, ubi; + std::optional stride{ToInt64(triplet.stride())}; if (auto lower{triplet.lower()}) { lbi = ToInt64(*lower); } @@ -1005,7 +1005,7 @@ std::optional> ApplySubscripts(parser::ContextualMessages &messages, for (const auto &ss : subscripts) { CHECK(ss.Rank() <= 1); if (ss.Rank() == 1) { - resultShape.push_back(static_cast(ss.size())); + resultShape.push_back(static_cast(ss.size())); elements *= ss.size(); } } @@ -1234,7 +1234,8 @@ Expr FoldOperation(FoldingContext &context, Designator &&designator) { Expr FoldOperation( FoldingContext &context, ImpliedDoIndex &&iDo) { - if (std::optional value{context.GetImpliedDo(iDo.name)}) { + if (std::optional value{ + context.GetImpliedDo(iDo.name)}) { return Expr{*value}; } else { return Expr{std::move(iDo)}; @@ -1248,13 +1249,13 @@ public: Expr FoldArray(ArrayConstructor &&array) { // Calls FoldArray(const ArrayConstructorValues &) below if (FoldArray(array)) { - auto n{static_cast(elements_.size())}; + auto n{static_cast(elements_.size())}; if constexpr (std::is_same_v) { return Expr{Constant{array.GetType().GetDerivedTypeSpec(), std::move(elements_), ConstantSubscripts{n}}}; } else if constexpr (T::category == TypeCategory::Character) { auto length{Fold(context_, common::Clone(array.LEN()))}; - if (std::optional lengthValue{ToInt64(length)}) { + if (std::optional lengthValue{ToInt64(length)}) { return Expr{Constant{ *lengthValue, std::move(elements_), ConstantSubscripts{n}}}; } @@ -1295,14 +1296,14 @@ private: Fold(context_, Expr{iDo.upper()})}; Expr stride{ Fold(context_, Expr{iDo.stride()})}; - std::optional start{ToInt64(lower)}, end{ToInt64(upper)}, - step{ToInt64(stride)}; + std::optional start{ToInt64(lower)}, + end{ToInt64(upper)}, step{ToInt64(stride)}; if (start.has_value() && end.has_value() && step.has_value()) { if (*step == 0) { return false; } bool result{true}; - std::int64_t &j{context_.StartImpliedDo(iDo.name(), *start)}; + common::SubscriptCIntType &j{context_.StartImpliedDo(iDo.name(), *start)}; if (*step > 0) { for (; j <= *end; j += *step) { result &= FoldArray(iDo.values()); @@ -2066,14 +2067,14 @@ Expr> FoldOperation( } using Result = Type; if (auto folded{OperandsAreConstants(x)}) { - auto oldLength{static_cast(folded->first.size())}; + auto oldLength{static_cast(folded->first.size())}; auto newLength{folded->second.ToInt64()}; if (newLength < oldLength) { folded->first.erase(newLength); } else { folded->first.append(newLength - oldLength, ' '); } - CHECK(static_cast(folded->first.size()) == newLength); + CHECK(static_cast(folded->first.size()) == newLength); return Expr{Constant{std::move(folded->first)}}; } return Expr{std::move(x)}; diff --git a/flang/lib/evaluate/formatting.cc b/flang/lib/evaluate/formatting.cc index b8e8552..7116442 100644 --- a/flang/lib/evaluate/formatting.cc +++ b/flang/lib/evaluate/formatting.cc @@ -84,8 +84,8 @@ std::ostream &Constant>::AsFortran( if (Rank() > 0) { o << '[' << GetType().AsFortran(std::to_string(length_)) << "::"; } - auto total{static_cast(size())}; - for (std::int64_t j{0}; j < total; ++j) { + auto total{static_cast(size())}; + for (LengthCIntType j{0}; j < total; ++j) { Scalar value{values_.substr(j * length_, length_)}; if (j > 0) { o << ','; diff --git a/flang/lib/evaluate/variable.cc b/flang/lib/evaluate/variable.cc index 48a703c..9013fbd 100644 --- a/flang/lib/evaluate/variable.cc +++ b/flang/lib/evaluate/variable.cc @@ -174,7 +174,7 @@ std::optional> Substring::Fold(FoldingContext &context) { lower_ = AsExpr(Constant{1}); } lower_.value() = evaluate::Fold(context, std::move(lower_.value().value())); - std::optional lbi{ToInt64(lower_.value().value())}; + std::optional lbi{ToInt64(lower_.value().value())}; if (lbi.has_value() && *lbi < 1) { context.messages().Say( "Lower bound (%jd) on substring is less than one"_en_US, @@ -186,9 +186,9 @@ std::optional> Substring::Fold(FoldingContext &context) { upper_ = upper(); } upper_.value() = evaluate::Fold(context, std::move(upper_.value().value())); - if (std::optional ubi{ToInt64(upper_.value().value())}) { + if (std::optional ubi{ToInt64(upper_.value().value())}) { auto *literal{std::get_if(&parent_)}; - std::optional length; + std::optional length; if (literal != nullptr) { length = (*literal)->data().size(); } else if (const Symbol * symbol{GetLastSymbol()}) { @@ -206,7 +206,8 @@ std::optional> Substring::Fold(FoldingContext &context) { } else if (length.has_value() && *ubi > *length) { context.messages().Say("Upper bound (%jd) on substring is greater " "than character length (%jd)"_en_US, - static_cast(*ubi), static_cast(*length)); + static_cast(*ubi), + static_cast(*length)); *ubi = *length; } if (lbi.has_value() && literal != nullptr) { @@ -222,7 +223,7 @@ std::optional> Substring::Fold(FoldingContext &context) { } parent_ = newStaticData; lower_ = AsExpr(Constant{1}); - std::int64_t length = newStaticData->data().size(); + LengthCIntType length = newStaticData->data().size(); upper_ = AsExpr(Constant{length}); switch (width) { case 1: diff --git a/flang/module/iso_fortran_env.f90 b/flang/module/iso_fortran_env.f90 new file mode 100644 index 0000000..37d07ba --- /dev/null +++ b/flang/module/iso_fortran_env.f90 @@ -0,0 +1,72 @@ +! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +! See Fortran 2018, clause 16.10.2 +! TODO: These are placeholder values so that some tests can be run. + +module iso_fortran_env + + integer, parameter :: atomic_int_kind = 8 + integer, parameter :: atomic_logical_kind = 8 + + integer, parameter :: character_kinds(:) = [1, 2, 4] + integer, parameter :: int8 = 1, int16 = 2, int32 = 4, int64 = 8, int128 = 16 + integer, parameter :: integer_kinds(:) = [int8, int16, int32, int64, int128] + integer, parameter :: logical_kinds(:) = [1, 2, 4, 8] + integer, parameter :: real16 = 2, real32 = 4, real64 = 8, real80 = 10, real128 = 16 + integer, parameter :: real_kinds(:) = [real16, 3, real32, real64, real80, real128] + + integer, parameter :: current_team = -1, initial_team = -2, parent_team = -3 + + integer, parameter :: input_unit = 5, output_unit = 6 + integer, parameter :: iostat_end = -1, iostat_eor = -2 + integer, parameter :: iostat_inquire_internal_unit = -1 + + integer, parameter :: character_storage_size = 8 + integer, parameter :: file_storage_size = 8 + integer, parameter :: numeric_storage_size = 32 + + integer, parameter :: stat_failed_image = -1 + integer, parameter :: stat_locked = 2 + integer, parameter :: stat_locked_other_image = 3 + integer, parameter :: stat_stopped_image = 4 + integer, parameter :: stat_unlocked = 5 + integer, parameter :: stat_unlocked_failed_image = 6 + + type :: event_type + private + integer(kind=atomic_int_kind) :: count = 0 + end type event_type + + type :: lock_type + private + integer(kind=atomic_int_kind) :: count = 0 + end type lock_type + + type :: team_type + private + integer(kind=int64) :: id = 0 + end type team_type + + contains + + character(len=80) function compiler_options() + compiler_options = 'COMPILER_OPTIONS() not yet implemented' + end function compiler_options + + character(len=80) function compiler_version() + compiler_version = 'f18 in development' + end function compiler_version +end module iso_fortran_env + diff --git a/flang/tools/f18/f18-parse-demo.cc b/flang/tools/f18/f18-parse-demo.cc index 47b6cf8..57e68dd 100644 --- a/flang/tools/f18/f18-parse-demo.cc +++ b/flang/tools/f18/f18-parse-demo.cc @@ -407,8 +407,6 @@ int main(int argc, char *const argv[]) { defaultKinds.set_defaultRealKind(8); } else if (arg == "-i8" || arg == "-fdefault-integer-8") { defaultKinds.set_defaultIntegerKind(8); - } else if (arg == "-fno-large-arrays") { - defaultKinds.set_subscriptIntegerKind(4); } else if (arg == "-help" || arg == "--help" || arg == "-?") { std::cerr << "f18-parse-demo options:\n" diff --git a/flang/tools/f18/f18.cc b/flang/tools/f18/f18.cc index 89e769d..ab59589 100644 --- a/flang/tools/f18/f18.cc +++ b/flang/tools/f18/f18.cc @@ -464,8 +464,6 @@ int main(int argc, char *const argv[]) { defaultKinds.set_defaultRealKind(8); } else if (arg == "-i8" || arg == "-fdefault-integer-8") { defaultKinds.set_defaultIntegerKind(8); - } else if (arg == "-fno-large-arrays") { - defaultKinds.set_subscriptIntegerKind(4); } else if (arg == "-module") { driver.moduleDirectory = args.front(); args.pop_front(); -- 2.7.4