[flang] Allow more concurrently open NEWUNIT= values, with recycling

Add a header-only implementation of Briggs & Torczon's fast small
integer set data structure to flang/include/flang/Common, and use
it in the runtime to manage a pool of Fortran unit numbers with
recycling.  This replaces the bit set previously used for that
purpose.  The set is initialized on demand with the negations of
all the NEWUNIT= unit numbers that can be returned to any kind
of integer variable.

For programs that require more concurrently open NEWUNIT= unit
numbers than the pool can hold, they are now allocated with a
non-recycling counter.  This allows as many open units as the
operating system provides.

Many of the top-line comments in flang/unittests/Runtime had the
wrong path name.  I noticed this while adding a unit test for the
fast integer set data structure, and cleaned them up.

Differential Revision: https://reviews.llvm.org/D120685

flang/include/flang/Common/fast-int-set.h

@@ -0,0 +1,106 @@
+//===-- include/flang/Common/fast-int-set.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
+//
+//===----------------------------------------------------------------------===//
+
+// Implements a Briggs-Torczon fast set of integers in a fixed small range
+// [0..(n-1)] This is a data structure with no dynamic memory allocation and all
+// O(1) elemental operations.  It does not need to initialize its internal state
+// arrays, but you can call its InitializeState() member function to avoid
+// complaints from valgrind.
+
+// The set is implemented with two arrays and an element count.
+// 1) The distinct values in the set occupy the leading elements of
+//    value_[0 .. size_-1] in arbitrary order.  Their positions may change
+//    when other values are removed from the set with Remove().
+// 2) For 0 <= j < size_, index_[value_[j]] == j.
+// 3) If only Add() and PopValue() are used, the popped values will be the
+//    most recently Add()ed distinct unpopped values; i.e., the value_ array
+//    will function as a stack whose top is at (size_-1).
+
+#ifndef FORTRAN_COMMON_FAST_INT_SET_H_
+#define FORTRAN_COMMON_FAST_INT_SET_H_
+
+#include <optional>
+
+namespace Fortran::common {
+
+template <int N> class FastIntSet {
+public:
+  static_assert(N > 0);
+  static constexpr int maxValue{N - 1};
+
+  int size() const { return size_; }
+  const int *value() const { return &value_[0]; }
+
+  bool IsValidValue(int n) const { return n >= 0 && n <= maxValue; }
+
+  void Clear() { size_ = 0; }
+
+  bool IsEmpty() const { return size_ == 0; }
+
+  void InitializeState() {
+    if (!isFullyInitialized_) {
+      for (int j{size_}; j < N; ++j) {
+        value_[j] = index_[j] = 0;
+      }
+      isFullyInitialized_ = true;
+    }
+  }
+
+  bool Contains(int n) const {
+    if (IsValidValue(n)) {
+      int j{index_[n]};
+      return j >= 0 && j < size_ && value_[j] == n;
+    } else {
+      return false;
+    }
+  }
+
+  bool Add(int n) {
+    if (IsValidValue(n)) {
+      if (!UncheckedContains(n)) {
+        value_[index_[n] = size_++] = n;
+      }
+      return true;
+    } else {
+      return false;
+    }
+  }
+
+  bool Remove(int n) {
+    if (IsValidValue(n)) {
+      if (UncheckedContains(n)) {
+        int last{value_[--size_]};
+        value_[index_[last] = index_[n]] = last;
+      }
+      return true;
+    } else {
+      return false;
+    }
+  }
+
+  std::optional<int> PopValue() {
+    if (IsEmpty()) {
+      return std::nullopt;
+    } else {
+      return value_[--size_];
+    }
+  }
+
+private:
+  bool UncheckedContains(int n) const {
+    int j{index_[n]};
+    return j >= 0 && j < size_ && value_[j] == n;
+  }
+
+  int value_[N];
+  int index_[N];
+  int size_{0};
+  bool isFullyInitialized_{false}; // memory was cleared
+};
+} // namespace Fortran::common
+#endif // FORTRAN_COMMON_FAST_INT_SET_H_

flang/runtime/io-api.cpp

@@ -908,8 +908,11 @@ bool IONAME(GetNewUnit)(Cookie cookie, int &unit, int kind) {
     io.GetIoErrorHandler().Crash(
         "GetNewUnit() called when not in an OPEN statement");
   }
-  if (!SetInteger(unit, kind, open->unit().unitNumber())) {
-    open->SignalError("GetNewUnit(): Bad INTEGER kind(%d) for result");
+  std::int64_t result{open->unit().unitNumber()};
+  if (!SetInteger(unit, kind, result)) {
+    open->SignalError("GetNewUnit(): Bad INTEGER kind(%d) or out-of-range "
+                      "value(%jd) for result",
+        kind, static_cast<std::intmax_t>(result));
   }
   return true;
 }
@@ -1175,8 +1178,13 @@ bool IONAME(InquireInteger64)(
   IoStatementState &io{*cookie};
   std::int64_t n;
   if (io.Inquire(inquiry, n)) {
-    SetInteger(result, kind, n);
-    return true;
+    if (SetInteger(result, kind, n)) {
+      return true;
+    }
+    io.GetIoErrorHandler().SignalError(
+        "InquireInteger64(): Bad INTEGER kind(%d) or out-of-range value(%jd) "
+        "for result",
+        kind, static_cast<std::intmax_t>(n));
   }
   return false;
 }

flang/runtime/tools.h

@@ -96,16 +96,16 @@ inline bool SetInteger(INT &x, int kind, std::int64_t value) {
   switch (kind) {
   case 1:
     reinterpret_cast<CppTypeFor<TypeCategory::Integer, 1> &>(x) = value;
-    return true;
+    return value == reinterpret_cast<CppTypeFor<TypeCategory::Integer, 1> &>(x);
   case 2:
     reinterpret_cast<CppTypeFor<TypeCategory::Integer, 2> &>(x) = value;
-    return true;
+    return value == reinterpret_cast<CppTypeFor<TypeCategory::Integer, 2> &>(x);
   case 4:
     reinterpret_cast<CppTypeFor<TypeCategory::Integer, 4> &>(x) = value;
-    return true;
+    return value == reinterpret_cast<CppTypeFor<TypeCategory::Integer, 4> &>(x);
   case 8:
     reinterpret_cast<CppTypeFor<TypeCategory::Integer, 8> &>(x) = value;
-    return true;
+    return value == reinterpret_cast<CppTypeFor<TypeCategory::Integer, 8> &>(x);
   default:
     return false;
   }

flang/runtime/unit-map.cpp

@@ -10,19 +10,30 @@
 
 namespace Fortran::runtime::io {
 
+void UnitMap::Initialize() {
+  if (!isInitialized_) {
+    freeNewUnits_.InitializeState();
+    // Unit number -1 is reserved.
+    // The unit numbers are pushed in reverse order so that the first
+    // ones to be popped will be small and suitable for use as kind=1
+    // integers.
+    for (int j{freeNewUnits_.maxValue}; j > 1; --j) {
+      freeNewUnits_.Add(j);
+    }
+    isInitialized_ = true;
+  }
+}
+
 // See 12.5.6.12 in Fortran 2018.  NEWUNIT= unit numbers are negative,
-// and not equal -1 (or ERROR_UNIT, if it were negative, which it isn't.)
+// and not equal to -1 (or ERROR_UNIT, if it were negative, which it isn't.)
 ExternalFileUnit &UnitMap::NewUnit(const Terminator &terminator) {
   CriticalSection critical{lock_};
-  std::optional<std::size_t> n;
-  n = (~busyNewUnits_).LeastElement();
-  if (!n.has_value()) {
-    terminator.Crash(
-        "No available unit number for NEWUNIT= or internal child I/O");
+  Initialize();
+  std::optional<int> n{freeNewUnits_.PopValue()};
+  if (!n) {
+    n = emergencyNewUnit_++;
   }
-  busyNewUnits_.set(*n);
-  // bit position 0 <-> unit -2; kind=1 units are in [-65..-2]
-  return Create(static_cast<int>(-2 - *n), terminator);
+  return Create(-*n, terminator);
 }
 
 ExternalFileUnit *UnitMap::LookUpForClose(int n) {
@@ -53,7 +64,7 @@ void UnitMap::DestroyClosed(ExternalFileUnit &unit) {
       if (&p->unit == &unit) {
         int n{unit.unitNumber()};
         if (n <= -2) {
-          busyNewUnits_.reset(static_cast<std::size_t>(-2 - n));
+          freeNewUnits_.Add(-n);
         }
         if (previous) {
           previous->next.swap(p->next);

flang/runtime/unit-map.h

@@ -14,7 +14,7 @@
 
 #include "lock.h"
 #include "unit.h"
-#include "flang/Common/constexpr-bitset.h"
+#include "flang/Common/fast-int-set.h"
 #include "flang/Runtime/memory.h"
 #include <cstdint>
 #include <cstdlib>
@@ -60,8 +60,15 @@ class UnitMap {
   };
 
   static constexpr int buckets_{1031}; // must be prime
+
+  // The pool of recyclable new unit numbers uses the range that
+  // works even with INTEGER(kind=1).  0 and -1 are never used.
+  static constexpr int maxNewUnits_{129}; // [ -128 .. 0 ]
+
   int Hash(int n) { return std::abs(n) % buckets_; }
 
+  void Initialize();
+
   ExternalFileUnit *Find(int n) {
     Chain *previous{nullptr};
     int hash{Hash(n)};
@@ -82,9 +89,11 @@ class UnitMap {
   ExternalFileUnit &Create(int, const Terminator &);
 
   Lock lock_;
+  bool isInitialized_{false};
   OwningPtr<Chain> bucket_[buckets_]{}; // all owned by *this
-  common::BitSet<64> busyNewUnits_;
   OwningPtr<Chain> closing_{nullptr}; // units during CLOSE statement
+  common::FastIntSet<maxNewUnits_> freeNewUnits_;
+  int emergencyNewUnit_{maxNewUnits_}; // not recycled
 };
 } // namespace Fortran::runtime::io
 #endif // FORTRAN_RUNTIME_UNIT_MAP_H_

flang/unittests/CMakeLists.txt

@@ -37,6 +37,7 @@ function(add_flang_nongtest_unittest test_name)
 endfunction()
 
 add_subdirectory(Optimizer)
+add_subdirectory(Common)
 add_subdirectory(Decimal)
 add_subdirectory(Evaluate)
 add_subdirectory(Runtime)

flang/unittests/Common/CMakeLists.txt

@@ -0,0 +1,3 @@
+add_flang_unittest(FlangCommonTests
+  FastIntSetTest.cpp
+)

flang/unittests/Common/FastIntSetTest.cpp

@@ -0,0 +1,105 @@
+//===-- flang/unittests/Common/FastIntSetTest.cpp ---------------*- 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
+//
+//===----------------------------------------------------------------------===//
+
+#include "gtest/gtest.h"
+#include "flang/Common/fast-int-set.h"
+#include <optional>
+
+TEST(FastIntSetTests, Sanity) {
+  static constexpr int N{100};
+  Fortran::common::FastIntSet<N> set;
+
+  ASSERT_FALSE(set.IsValidValue(-1));
+  ASSERT_TRUE(set.IsValidValue(0));
+  ASSERT_TRUE(set.IsValidValue(N - 1));
+  ASSERT_FALSE(set.IsValidValue(N));
+  ASSERT_TRUE(set.IsEmpty());
+  ASSERT_EQ(set.size(), 0);
+  ASSERT_FALSE(set.Contains(0));
+  ASSERT_FALSE(set.Contains(N - 1));
+
+  ASSERT_TRUE(set.Add(0));
+  ASSERT_FALSE(set.IsEmpty());
+  ASSERT_EQ(set.size(), 1);
+  ASSERT_TRUE(set.Contains(0));
+
+  ASSERT_TRUE(set.Add(0)); // duplicate
+  ASSERT_EQ(set.size(), 1);
+  ASSERT_TRUE(set.Contains(0));
+
+  ASSERT_TRUE(set.Remove(0));
+  ASSERT_TRUE(set.IsEmpty());
+  ASSERT_EQ(set.size(), 0);
+  ASSERT_FALSE(set.Contains(0));
+
+  ASSERT_FALSE(set.Add(N));
+  ASSERT_TRUE(set.IsEmpty());
+  ASSERT_EQ(set.size(), 0);
+  ASSERT_FALSE(set.Contains(N));
+
+  ASSERT_TRUE(set.Add(N - 1));
+  ASSERT_FALSE(set.IsEmpty());
+  ASSERT_EQ(set.size(), 1);
+  ASSERT_TRUE(set.Contains(N - 1));
+
+  std::optional<int> x;
+  x = set.PopValue();
+  ASSERT_TRUE(x.has_value());
+  ASSERT_EQ(*x, N - 1);
+  ASSERT_TRUE(set.IsEmpty());
+  ASSERT_EQ(set.size(), 0);
+
+  x = set.PopValue();
+  ASSERT_FALSE(x.has_value());
+
+  for (int j{0}; j < N; ++j) {
+    ASSERT_TRUE(set.Add(j)) << j;
+  }
+  ASSERT_FALSE(set.IsEmpty());
+  ASSERT_EQ(set.size(), N);
+  for (int j{0}; j < N; ++j) {
+    ASSERT_TRUE(set.Contains(j)) << j;
+  }
+
+  for (int j{0}; j < N; ++j) {
+    ASSERT_TRUE(set.Remove(j)) << j;
+    ASSERT_EQ(set.size(), N - j - 1) << j;
+    ASSERT_FALSE(set.Contains(j)) << j;
+  }
+
+  ASSERT_TRUE(set.IsEmpty());
+  ASSERT_EQ(set.size(), 0);
+
+  for (int j{N - 1}; j >= 0; --j) {
+    ASSERT_TRUE(set.Add(j)) << j;
+  }
+  for (int j{0}; j < N; j++) {
+    x = set.PopValue();
+    ASSERT_TRUE(x.has_value());
+    ASSERT_EQ(*x, j) << j;
+  }
+  ASSERT_TRUE(set.IsEmpty());
+  ASSERT_EQ(set.size(), 0);
+
+  for (int j{0}; j < N; j++) {
+    ASSERT_TRUE(set.Add(j)) << j;
+  }
+  ASSERT_FALSE(set.IsEmpty());
+  ASSERT_EQ(set.size(), N);
+  for (int j{0}; j < N; j += 2) {
+    ASSERT_TRUE(set.Remove(j)) << j;
+  }
+  ASSERT_FALSE(set.IsEmpty());
+  ASSERT_EQ(set.size(), N / 2);
+  for (int j{0}; j < N; j++) {
+    ASSERT_EQ(set.Contains(j), (j & 1) == 1);
+  }
+
+  set.Clear();
+  ASSERT_TRUE(set.IsEmpty());
+}

flang/unittests/Runtime/BufferTest.cpp

@@ -1,4 +1,4 @@
-//===-- flang/unittests/RuntimeGTest/BufferTest.cpp -------------*- C++ -*-===//
+//===-- flang/unittests/Runtime/BufferTest.cpp ------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.

flang/unittests/Runtime/CharacterTest.cpp

@@ -1,4 +1,4 @@
-//===-- flang/unittests/RuntimeGTest/CharacterTest.cpp ----------*- C++ -*-===//
+//===-- flang/unittests/Runtime/CharacterTest.cpp ---------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.

flang/unittests/Runtime/CommandTest.cpp

@@ -1,4 +1,4 @@
-//===-- flang/unittests/RuntimeGTest/CommandTest.cpp ----------------------===//
+//===-- flang/unittests/Runtime/CommandTest.cpp ---------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.

flang/unittests/Runtime/CrashHandlerFixture.cpp

@@ -1,4 +1,4 @@
-//===-- flang/unittests/RuntimeGTest/CrashHandlerFixture.cpp ----*- C++ -*-===//
+//===-- flang/unittests/Runtime/CrashHandlerFixture.cpp ---------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.

flang/unittests/Runtime/CrashHandlerFixture.h

@@ -1,4 +1,4 @@
-//===-- flang/unittests/RuntimeGTest/CrashHandlerFixture.h ------*- C++ -*-===//
+//===-- flang/unittests/Runtime/CrashHandlerFixture.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.

flang/unittests/Runtime/Format.cpp

@@ -1,4 +1,4 @@
-//===-- flang/unittests/RuntimeGTest/Format.cpp -----------------*- C++ -*-===//
+//===-- flang/unittests/Runtime/Format.cpp ----------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.