From 0f1fd64ae50f49df0490607e2d71dc97fc25b9cc Mon Sep 17 00:00:00 2001
From: peter klausler <pklausler@nvidia.com>
Date: Thu, 6 Jun 2019 13:56:22 -0700
Subject: [PATCH] [flang] Other changes moved to their own branch.

Original-commit: flang-compiler/f18@6a922d085af655c2345dfe1c6f2360982728e55f
Reviewed-on: https://github.com/flang-compiler/f18/pull/485
---
 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/tools/f18/f18-parse-demo.cc |  2 ++
 flang/tools/f18/f18.cc            |  2 ++
 11 files changed, 55 insertions(+), 56 deletions(-)

diff --git a/flang/lib/common/default-kinds.cc b/flang/lib/common/default-kinds.cc
index 047996a..18bdcb8 100644
--- a/flang/lib/common/default-kinds.cc
+++ b/flang/lib/common/default-kinds.cc
@@ -29,6 +29,12 @@ 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 8b4ab24..3190134 100644
--- a/flang/lib/common/default-kinds.h
+++ b/flang/lib/common/default-kinds.h
@@ -16,25 +16,21 @@
 #define FORTRAN_COMMON_DEFAULT_KINDS_H_
 
 #include "Fortran.h"
-#include <cstdint>
 
 // Represent the default values of the kind parameters of the
-// 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.
+// various intrinsic types.  These can be configured by means of
+// the compiler command line.
 namespace Fortran::common {
 
-using SubscriptCIntType = std::int64_t;
-
 class IntrinsicTypeDefaultKinds {
 public:
   IntrinsicTypeDefaultKinds();
-  static constexpr int subscriptIntegerKind() { return 8; }
+  int subscriptIntegerKind() const { return subscriptIntegerKind_; }
   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);
@@ -50,6 +46,7 @@ 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 f2296a04..0b71550 100644
--- a/flang/lib/evaluate/common.cc
+++ b/flang/lib/evaluate/common.cc
@@ -1,4 +1,4 @@
-// Copyright (c) 2018-2019, NVIDIA CORPORATION.  All rights reserved.
+// Copyright (c) 2018, 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(
   }
 }
 
-common::SubscriptCIntType &FoldingContext::StartImpliedDo(
-    parser::CharBlock name, common::SubscriptCIntType n) {
+std::int64_t &FoldingContext::StartImpliedDo(
+    parser::CharBlock name, std::int64_t n) {
   auto pair{impliedDos_.insert(std::make_pair(name, n))};
   CHECK(pair.second);
   return pair.first->second;
 }
 
-std::optional<common::SubscriptCIntType> FoldingContext::GetImpliedDo(
+std::optional<std::int64_t> 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 3f5b7e0..5d39abd 100644
--- a/flang/lib/evaluate/common.h
+++ b/flang/lib/evaluate/common.h
@@ -17,7 +17,6 @@
 
 #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"
@@ -229,13 +228,11 @@ public:
     return hostIntrinsicsLibrary_;
   }
 
-  common::SubscriptCIntType &StartImpliedDo(
-      parser::CharBlock, common::SubscriptCIntType = 1);
-  std::optional<common::SubscriptCIntType> GetImpliedDo(
-      parser::CharBlock) const;
+  std::int64_t &StartImpliedDo(parser::CharBlock, std::int64_t = 1);
+  std::optional<std::int64_t> GetImpliedDo(parser::CharBlock) const;
   void EndImpliedDo(parser::CharBlock);
 
-  std::map<parser::CharBlock, common::SubscriptCIntType> &impliedDos() {
+  std::map<parser::CharBlock, std::int64_t> &impliedDos() {
     return impliedDos_;
   }
 
@@ -250,7 +247,7 @@ private:
   bool flushSubnormalsToZero_{false};
   bool bigEndian_{false};
   const semantics::DerivedTypeSpec *pdtInstance_{nullptr};
-  std::map<parser::CharBlock, common::SubscriptCIntType> impliedDos_;
+  std::map<parser::CharBlock, std::int64_t> impliedDos_;
   HostIntrinsicProceduresLibrary hostIntrinsicsLibrary_;
 };
 
diff --git a/flang/lib/evaluate/constant.cc b/flang/lib/evaluate/constant.cc
index a00a950..8be8c3c 100644
--- a/flang/lib/evaluate/constant.cc
+++ b/flang/lib/evaluate/constant.cc
@@ -109,23 +109,23 @@ auto Constant<T>::Reshape(ConstantSubscripts &&dims) const -> Constant {
 template<int KIND>
 Constant<Type<TypeCategory::Character, KIND>>::Constant(
     const Scalar<Result> &str)
-  : values_{str}, length_{static_cast<LengthCIntType>(values_.size())} {}
+  : values_{str}, length_{static_cast<std::int64_t>(values_.size())} {}
 
 template<int KIND>
 Constant<Type<TypeCategory::Character, KIND>>::Constant(Scalar<Result> &&str)
   : values_{std::move(str)}, length_{
-                                 static_cast<LengthCIntType>(values_.size())} {}
+                                 static_cast<std::int64_t>(values_.size())} {}
 
 template<int KIND>
-Constant<Type<TypeCategory::Character, KIND>>::Constant(LengthCIntType len,
+Constant<Type<TypeCategory::Character, KIND>>::Constant(std::int64_t len,
     std::vector<Scalar<Result>> &&strings, ConstantSubscripts &&dims)
   : length_{len}, shape_{std::move(dims)} {
   CHECK(strings.size() == TotalElementCount(shape_));
   values_.assign(strings.size() * length_,
       static_cast<typename Scalar<Result>::value_type>(' '));
-  LengthCIntType at{0};
+  std::int64_t at{0};
   for (const auto &str : strings) {
-    auto strLen{static_cast<LengthCIntType>(str.size())};
+    auto strLen{static_cast<std::int64_t>(str.size())};
     if (strLen > length_) {
       values_.replace(at, length_, str.substr(0, length_));
     } else {
@@ -133,7 +133,7 @@ Constant<Type<TypeCategory::Character, KIND>>::Constant(LengthCIntType len,
     }
     at += length_;
   }
-  CHECK(at == static_cast<LengthCIntType>(values_.size()));
+  CHECK(at == static_cast<std::int64_t>(values_.size()));
 }
 
 template<int KIND> Constant<Type<TypeCategory::Character, KIND>>::~Constant() {}
@@ -148,7 +148,7 @@ std::size_t Constant<Type<TypeCategory::Character, KIND>>::size() const {
   if (length_ == 0) {
     return TotalElementCount(shape_);
   } else {
-    return static_cast<LengthCIntType>(values_.size()) / length_;
+    return static_cast<std::int64_t>(values_.size()) / length_;
   }
 }
 
@@ -165,7 +165,7 @@ auto Constant<Type<TypeCategory::Character, KIND>>::Reshape(
   std::size_t n{TotalElementCount(dims)};
   CHECK(!empty() || n == 0);
   std::vector<Element> elements;
-  LengthCIntType at{0}, limit{static_cast<LengthCIntType>(values_.size())};
+  std::int64_t at{0}, limit{static_cast<std::int64_t>(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 c5c9cc0..7217eb9 100644
--- a/flang/lib/evaluate/constant.h
+++ b/flang/lib/evaluate/constant.h
@@ -17,7 +17,6 @@
 
 #include "formatting.h"
 #include "type.h"
-#include "../common/default-kinds.h"
 #include <map>
 #include <ostream>
 #include <vector>
@@ -36,14 +35,12 @@ template<typename> class Constant;
 
 // When describing shapes of constants or specifying 1-based subscript
 // values as indices into constants, use a vector of integers.
-using ConstantSubscript = common::SubscriptCIntType;
+using ConstantSubscript = std::int64_t;
 using ConstantSubscripts = std::vector<ConstantSubscript>;
 inline int GetRank(const ConstantSubscripts &s) {
   return static_cast<int>(s.size());
 }
 
-using LengthCIntType = common::SubscriptCIntType;
-
 std::size_t TotalElementCount(const ConstantSubscripts &);
 
 inline ConstantSubscripts InitialSubscripts(int rank) {
@@ -130,7 +127,7 @@ public:
   CLASS_BOILERPLATE(Constant)
   explicit Constant(const Scalar<Result> &);
   explicit Constant(Scalar<Result> &&);
-  Constant(LengthCIntType, std::vector<Element> &&, ConstantSubscripts &&);
+  Constant(std::int64_t, std::vector<Element> &&, ConstantSubscripts &&);
   ~Constant();
 
   int Rank() const { return GetRank(shape_); }
@@ -141,7 +138,7 @@ public:
   std::size_t size() const;
   const ConstantSubscripts &shape() const { return shape_; }
 
-  LengthCIntType LEN() const { return length_; }
+  std::int64_t LEN() const { return length_; }
 
   std::optional<Scalar<Result>> GetScalarValue() const {
     if (shape_.empty()) {
@@ -163,7 +160,7 @@ public:
 
 private:
   Scalar<Result> values_;  // one contiguous string
-  LengthCIntType length_;
+  std::int64_t length_;
   ConstantSubscripts shape_;
 };
 
diff --git a/flang/lib/evaluate/fold.cc b/flang/lib/evaluate/fold.cc
index baf05db..cb5185f 100644
--- a/flang/lib/evaluate/fold.cc
+++ b/flang/lib/evaluate/fold.cc
@@ -267,8 +267,8 @@ static inline Expr<TR> FoldElementalIntrinsicHelper(FoldingContext &context,
     }
     // Build and return constant result
     if constexpr (TR::category == TypeCategory::Character) {
-      auto len{static_cast<LengthCIntType>(
-          results.size() ? results[0].length() : 0)};
+      std::int64_t len{
+          static_cast<std::int64_t>(results.size() ? results[0].length() : 0)};
       return Expr<TR>{Constant<TR>{len, std::move(results), std::move(shape)}};
     } else {
       return Expr<TR>{Constant<TR>{std::move(results), std::move(shape)}};
@@ -966,8 +966,8 @@ static std::optional<Constant<SubscriptInteger>> GetConstantSubscript(
             }
           },
           [](Triplet &triplet) -> std::optional<Constant<SubscriptInteger>> {
-            std::optional<ConstantSubscript> lbi{1}, ubi;
-            std::optional<ConstantSubscript> stride{ToInt64(triplet.stride())};
+            std::optional<std::int64_t> lbi{1}, ubi;
+            std::optional<std::int64_t> stride{ToInt64(triplet.stride())};
             if (auto lower{triplet.lower()}) {
               lbi = ToInt64(*lower);
             }
@@ -1005,7 +1005,7 @@ std::optional<Constant<T>> ApplySubscripts(parser::ContextualMessages &messages,
   for (const auto &ss : subscripts) {
     CHECK(ss.Rank() <= 1);
     if (ss.Rank() == 1) {
-      resultShape.push_back(static_cast<ConstantSubscript>(ss.size()));
+      resultShape.push_back(static_cast<std::int64_t>(ss.size()));
       elements *= ss.size();
     }
   }
@@ -1234,8 +1234,7 @@ Expr<T> FoldOperation(FoldingContext &context, Designator<T> &&designator) {
 
 Expr<ImpliedDoIndex::Result> FoldOperation(
     FoldingContext &context, ImpliedDoIndex &&iDo) {
-  if (std::optional<common::SubscriptCIntType> value{
-          context.GetImpliedDo(iDo.name)}) {
+  if (std::optional<std::int64_t> value{context.GetImpliedDo(iDo.name)}) {
     return Expr<ImpliedDoIndex::Result>{*value};
   } else {
     return Expr<ImpliedDoIndex::Result>{std::move(iDo)};
@@ -1249,13 +1248,13 @@ public:
   Expr<T> FoldArray(ArrayConstructor<T> &&array) {
     // Calls FoldArray(const ArrayConstructorValues<T> &) below
     if (FoldArray(array)) {
-      auto n{static_cast<ConstantSubscript>(elements_.size())};
+      auto n{static_cast<std::int64_t>(elements_.size())};
       if constexpr (std::is_same_v<T, SomeDerived>) {
         return Expr<T>{Constant<T>{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<LengthCIntType> lengthValue{ToInt64(length)}) {
+        if (std::optional<std::int64_t> lengthValue{ToInt64(length)}) {
           return Expr<T>{Constant<T>{
               *lengthValue, std::move(elements_), ConstantSubscripts{n}}};
         }
@@ -1296,14 +1295,14 @@ private:
         Fold(context_, Expr<SubscriptInteger>{iDo.upper()})};
     Expr<SubscriptInteger> stride{
         Fold(context_, Expr<SubscriptInteger>{iDo.stride()})};
-    std::optional<common::SubscriptCIntType> start{ToInt64(lower)},
-        end{ToInt64(upper)}, step{ToInt64(stride)};
+    std::optional<std::int64_t> 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};
-      common::SubscriptCIntType &j{context_.StartImpliedDo(iDo.name(), *start)};
+      std::int64_t &j{context_.StartImpliedDo(iDo.name(), *start)};
       if (*step > 0) {
         for (; j <= *end; j += *step) {
           result &= FoldArray(iDo.values());
@@ -2067,14 +2066,14 @@ Expr<Type<TypeCategory::Character, KIND>> FoldOperation(
   }
   using Result = Type<TypeCategory::Character, KIND>;
   if (auto folded{OperandsAreConstants(x)}) {
-    auto oldLength{static_cast<LengthCIntType>(folded->first.size())};
+    auto oldLength{static_cast<std::int64_t>(folded->first.size())};
     auto newLength{folded->second.ToInt64()};
     if (newLength < oldLength) {
       folded->first.erase(newLength);
     } else {
       folded->first.append(newLength - oldLength, ' ');
     }
-    CHECK(static_cast<LengthCIntType>(folded->first.size()) == newLength);
+    CHECK(static_cast<std::int64_t>(folded->first.size()) == newLength);
     return Expr<Result>{Constant<Result>{std::move(folded->first)}};
   }
   return Expr<Result>{std::move(x)};
diff --git a/flang/lib/evaluate/formatting.cc b/flang/lib/evaluate/formatting.cc
index 7116442..b8e8552 100644
--- a/flang/lib/evaluate/formatting.cc
+++ b/flang/lib/evaluate/formatting.cc
@@ -84,8 +84,8 @@ std::ostream &Constant<Type<TypeCategory::Character, KIND>>::AsFortran(
   if (Rank() > 0) {
     o << '[' << GetType().AsFortran(std::to_string(length_)) << "::";
   }
-  auto total{static_cast<LengthCIntType>(size())};
-  for (LengthCIntType j{0}; j < total; ++j) {
+  auto total{static_cast<std::int64_t>(size())};
+  for (std::int64_t j{0}; j < total; ++j) {
     Scalar<Result> 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 9013fbd..48a703c 100644
--- a/flang/lib/evaluate/variable.cc
+++ b/flang/lib/evaluate/variable.cc
@@ -174,7 +174,7 @@ std::optional<Expr<SomeCharacter>> Substring::Fold(FoldingContext &context) {
     lower_ = AsExpr(Constant<SubscriptInteger>{1});
   }
   lower_.value() = evaluate::Fold(context, std::move(lower_.value().value()));
-  std::optional<ConstantSubscript> lbi{ToInt64(lower_.value().value())};
+  std::optional<std::int64_t> 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<Expr<SomeCharacter>> Substring::Fold(FoldingContext &context) {
     upper_ = upper();
   }
   upper_.value() = evaluate::Fold(context, std::move(upper_.value().value()));
-  if (std::optional<ConstantSubscript> ubi{ToInt64(upper_.value().value())}) {
+  if (std::optional<std::int64_t> ubi{ToInt64(upper_.value().value())}) {
     auto *literal{std::get_if<StaticDataObject::Pointer>(&parent_)};
-    std::optional<LengthCIntType> length;
+    std::optional<std::int64_t> length;
     if (literal != nullptr) {
       length = (*literal)->data().size();
     } else if (const Symbol * symbol{GetLastSymbol()}) {
@@ -206,8 +206,7 @@ std::optional<Expr<SomeCharacter>> 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<std::intmax_t>(*ubi),
-          static_cast<std::intmax_t>(*length));
+          static_cast<std::intmax_t>(*ubi), static_cast<std::int64_t>(*length));
       *ubi = *length;
     }
     if (lbi.has_value() && literal != nullptr) {
@@ -223,7 +222,7 @@ std::optional<Expr<SomeCharacter>> Substring::Fold(FoldingContext &context) {
       }
       parent_ = newStaticData;
       lower_ = AsExpr(Constant<SubscriptInteger>{1});
-      LengthCIntType length = newStaticData->data().size();
+      std::int64_t length = newStaticData->data().size();
       upper_ = AsExpr(Constant<SubscriptInteger>{length});
       switch (width) {
       case 1:
diff --git a/flang/tools/f18/f18-parse-demo.cc b/flang/tools/f18/f18-parse-demo.cc
index 57e68dd..47b6cf8 100644
--- a/flang/tools/f18/f18-parse-demo.cc
+++ b/flang/tools/f18/f18-parse-demo.cc
@@ -407,6 +407,8 @@ 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 ab59589..89e769d 100644
--- a/flang/tools/f18/f18.cc
+++ b/flang/tools/f18/f18.cc
@@ -464,6 +464,8 @@ 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