Move deallocation of I/O resources under STOP to a critical section

[NimishMishra]

Presence of a STOP region in a multithreaded environment (eg. inside OpenMP parallel) causes race in deallocation of I/O resources. This leads to runtime failures like reported in #73104. This patch moves such deallocations to a critical section.

[llvmbot]

@llvm/pr-subscribers-flang-runtime

Author: None (NimishMishra)

Changes

Presence of a STOP region in a multithreaded environment (eg. inside OpenMP parallel) causes race in deallocation of I/O resources. This leads to runtime failures like reported in #73104. This patch moves such deallocations to a critical section.

---

Full diff: https://github.com/llvm/llvm-project/pull/74181.diff

1 Files Affected:

• (modified) flang/runtime/stop.cpp (+6-2)

diff --git a/flang/runtime/stop.cpp b/flang/runtime/stop.cpp
index 98324da1d91e166..f6e5f0c593024b7 100644
--- a/flang/runtime/stop.cpp
+++ b/flang/runtime/stop.cpp
@@ -16,6 +16,7 @@
 #include <cstdio>
 #include <cstdlib>
 
+static Fortran::runtime::Lock lock;
 extern "C" {
 
 static void DescribeIEEESignaledExceptions() {
@@ -52,7 +53,8 @@ static void CloseAllExternalUnits(const char *why) {
 
 [[noreturn]] void RTNAME(StopStatement)(
     int code, bool isErrorStop, bool quiet) {
-  CloseAllExternalUnits("STOP statement");
+
+  Fortran::runtime::CriticalSection critical{lock};
   if (Fortran::runtime::executionEnvironment.noStopMessage && code == 0) {
     quiet = true;
   }
@@ -64,12 +66,13 @@ static void CloseAllExternalUnits(const char *why) {
     std::fputc('\n', stderr);
     DescribeIEEESignaledExceptions();
   }
+  CloseAllExternalUnits("STOP statement");
   std::exit(code);
 }
 
 [[noreturn]] void RTNAME(StopStatementText)(
     const char *code, std::size_t length, bool isErrorStop, bool quiet) {
-  CloseAllExternalUnits("STOP statement");
+  Fortran::runtime::CriticalSection critical{lock};
   if (!quiet) {
     if (Fortran::runtime::executionEnvironment.noStopMessage && !isErrorStop) {
       std::fprintf(stderr, "%.*s\n", static_cast<int>(length), code);
@@ -79,6 +82,7 @@ static void CloseAllExternalUnits(const char *why) {
     }
     DescribeIEEESignaledExceptions();
   }
+  CloseAllExternalUnits("STOP statement");
   if (isErrorStop) {
     std::exit(EXIT_FAILURE);
   } else {

[klausler]

I don't understand why this lock is needed here. CloseAllExternalUnits ends up calling ExternalFileUnit::CloseAll, which already has a critical section in it.

[NimishMishra]

I don't understand why this lock is needed here. CloseAllExternalUnits ends up calling ExternalFileUnit::CloseAll, which already has a critical section in it.

It seems like ExternalFileUnit::CloseAll is closing up the I/O buffers while other threads in the parallel region are still operating upon them. The ExternalFileUnit::CloseAll critical section is for the collection of buckets to be freed. I was wondering if increasing the scope of the critical section could help, and hence went this way in this patch.

Could I do this better? Ideally, we would want all threads to flush their contents before closing the I/O buffers.

[klausler]

I don't understand why this lock is needed here. CloseAllExternalUnits ends up calling ExternalFileUnit::CloseAll, which already has a critical section in it.

It seems like ExternalFileUnit::CloseAll is closing up the I/O buffers while other threads in the parallel region are still operating upon them. The ExternalFileUnit::CloseAll critical section is for the collection of buckets to be freed. I was wondering if increasing the scope of the critical section could help, and hence went this way in this patch.

Could I do this better? Ideally, we would want all threads to flush their contents before closing the I/O buffers.

The lock you're introducing here is going to help only if all threads execute a STOP statement, right? If one or more threads do not STOP, they'll need to be terminated by some other means. Perhaps you need some kind of interrupt with a barrier.