[flang-commits] [flang] [flang][runtime] Implement SLEEP intrinsic (PR #79074)

Tom Eccles via flang-commits flang-commits at lists.llvm.org
Wed Jan 24 09:14:06 PST 2024


https://github.com/tblah updated https://github.com/llvm/llvm-project/pull/79074

>From 696b3231b4a8a90f466ced05b05208b79db2f71a Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Wed, 17 Jan 2024 18:40:01 +0000
Subject: [PATCH 1/5] [flang][runtime] Implement SLEEP intrinsic

This intrinsic is a gnu extension. See
https://gcc.gnu.org/onlinedocs/gfortran/SLEEP.html
---
 flang/docs/Intrinsics.md                      |  3 +--
 .../flang/Optimizer/Builder/IntrinsicCall.h   |  1 +
 .../Optimizer/Builder/Runtime/Intrinsics.h    |  4 +++
 flang/include/flang/Runtime/extensions.h      |  5 ++++
 flang/lib/Evaluate/intrinsics.cpp             |  8 ++++--
 flang/lib/Optimizer/Builder/IntrinsicCall.cpp |  7 +++++
 .../Optimizer/Builder/Runtime/Intrinsics.cpp  | 10 +++++++
 flang/runtime/extensions.cpp                  | 15 ++++++++++-
 flang/test/Lower/Intrinsics/sleep.f90         | 27 +++++++++++++++++++
 9 files changed, 75 insertions(+), 5 deletions(-)
 create mode 100644 flang/test/Lower/Intrinsics/sleep.f90

diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 5ade25740329771..a3888111430a0e2 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -757,7 +757,7 @@ This phase currently supports all the intrinsic procedures listed above but the
 | Object characteristic inquiry functions | ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF, IS_CONTIGUOUS, PRESENT, RANK, SAME_TYPE, STORAGE_SIZE |
 | Type inquiry intrinsic functions | BIT_SIZE, DIGITS, EPSILON, HUGE, KIND, MAXEXPONENT, MINEXPONENT, NEW_LINE, PRECISION, RADIX, RANGE, TINY|
 | Non-standard intrinsic functions | AND, OR, XOR, SHIFT, ZEXT, IZEXT, COSD, SIND, TAND, ACOSD, ASIND, ATAND, ATAN2D, COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT, QCMPLX, DREAL, DFLOAT, QEXT, QFLOAT, QREAL, DNUM, NUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN, SIZEOF, MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR, IARG, IARGC, NARGS, GETPID, NUMARG, BADDRESS, IADDR, CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC |
-| Intrinsic subroutines |MVBITS (elemental), CPU_TIME, DATE_AND_TIME, EVENT_QUERY, EXECUTE_COMMAND_LINE, GET_COMMAND, GET_COMMAND_ARGUMENT, GET_ENVIRONMENT_VARIABLE, MOVE_ALLOC, RANDOM_INIT, RANDOM_NUMBER, RANDOM_SEED, SYSTEM_CLOCK |
+| Intrinsic subroutines |MVBITS (elemental), CPU_TIME, DATE_AND_TIME, EVENT_QUERY, EXECUTE_COMMAND_LINE, GET_COMMAND, GET_COMMAND_ARGUMENT, GET_ENVIRONMENT_VARIABLE, MOVE_ALLOC, RANDOM_INIT, RANDOM_NUMBER, RANDOM_SEED, SLEEP, SYSTEM_CLOCK |
 | Atomic intrinsic subroutines | ATOMIC_ADD |
 | Collective intrinsic subroutines | CO_REDUCE |
 | Library subroutines | FDATE, GETLOG |
@@ -908,4 +908,3 @@ used in constant expressions have currently no folding support at all.
   - If a condition occurs that would assign a nonzero value to `CMDSTAT` but the `CMDSTAT` variable is not present, error termination is initiated.
     - On POSIX-compatible systems, the child process (async process) will be terminated with no effect on the parent process (continues).
     - On Windows, error termination is not initiated.
-
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 80f79d42fc2b75c..275878a0b2ad174 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -339,6 +339,7 @@ struct IntrinsicLibrary {
   fir::ExtendedValue genStorageSize(mlir::Type,
                                     llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  void genSleep(llvm::ArrayRef<fir::ExtendedValue>);
   void genSystemClock(llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genTand(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genTrailz(mlir::Type, llvm::ArrayRef<mlir::Value>);
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
index 9a37c15e9fb4ce2..a92e03afa60d778 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
@@ -64,6 +64,10 @@ void genTransferSize(fir::FirOpBuilder &builder, mlir::Location loc,
 /// all intrinsic arguments are optional and may appear here as mlir::Value{}
 void genSystemClock(fir::FirOpBuilder &, mlir::Location, mlir::Value count,
                     mlir::Value rate, mlir::Value max);
+
+/// generate sleep runtime call
+void genSleep(fir::FirOpBuilder &builder, mlir::Location loc,
+              mlir::Value seconds);
 } // namespace runtime
 } // namespace fir
 
diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h
index 1ed750f3b70e0f3..515e9eb3e7b5e1d 100644
--- a/flang/include/flang/Runtime/extensions.h
+++ b/flang/include/flang/Runtime/extensions.h
@@ -12,6 +12,8 @@
 #ifndef FORTRAN_RUNTIME_EXTENSIONS_H_
 #define FORTRAN_RUNTIME_EXTENSIONS_H_
 
+#include "flang/Runtime/entry-names.h"
+
 #define FORTRAN_PROCEDURE_NAME(name) name##_
 
 #include <cstddef>
@@ -35,5 +37,8 @@ void FORTRAN_PROCEDURE_NAME(getarg)(
 // GNU extension subroutine GETLOG(C).
 void FORTRAN_PROCEDURE_NAME(getlog)(char *name, std::int64_t length);
 
+// GNU extension subroutine SLEEP(SECONDS)
+void RTNAME(Sleep)(std::int64_t seconds);
+
 } // extern "C"
 #endif // FORTRAN_RUNTIME_EXTENSIONS_H_
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index da6d5970089884c..3c912b01906d7cc 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1395,6 +1395,10 @@ static const IntrinsicInterface intrinsicSubroutine[]{
             {"count_max", AnyInt, Rank::scalar, Optionality::optional,
                 common::Intent::Out}},
         {}, Rank::elemental, IntrinsicClass::impureSubroutine},
+    {"sleep",
+        {{"seconds", AnyInt, Rank::scalar, Optionality::required,
+            common::Intent::In}},
+        {}, Rank::elemental, IntrinsicClass::impureSubroutine},
 };
 
 // TODO: Intrinsic subroutine EVENT_QUERY
@@ -1412,8 +1416,8 @@ static DynamicType GetBuiltinDerivedType(
   auto iter{
       builtinsScope->find(semantics::SourceName{which, std::strlen(which)})};
   if (iter == builtinsScope->cend()) {
-    common::die(
-        "INTERNAL: The __fortran_builtins module does not define the type '%s'",
+    common::die("INTERNAL: The __fortran_builtins module does not define the "
+                "type '%s'",
         which);
   }
   const semantics::Symbol &symbol{*iter->second};
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index ac7d4fbe23e6738..b125258fa017db7 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -556,6 +556,7 @@ static constexpr IntrinsicHandler handlers[]{
        {"dim", asAddr, handleDynamicOptional},
        {"kind", asValue}}},
      /*isElemental=*/false},
+    {"sleep", &I::genSleep, {{{"seconds", asValue}}}, /*isElemental=*/false},
     {"spacing", &I::genSpacing},
     {"spread",
      &I::genSpread,
@@ -5924,6 +5925,12 @@ void IntrinsicLibrary::genSystemClock(llvm::ArrayRef<fir::ExtendedValue> args) {
                                fir::getBase(args[1]), fir::getBase(args[2]));
 }
 
+// SLEEP
+void IntrinsicLibrary::genSleep(llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 1 && "SLEEP has one compulsory argument");
+  fir::runtime::genSleep(builder, loc, fir::getBase(args[0]));
+}
+
 // TRANSFER
 fir::ExtendedValue
 IntrinsicLibrary::genTransfer(mlir::Type resultType,
diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
index 63d66adf222f640..9058ff6325b1229 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
@@ -12,6 +12,7 @@
 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
 #include "flang/Parser/parse-tree.h"
+#include "flang/Runtime/extensions.h"
 #include "flang/Runtime/misc-intrinsic.h"
 #include "flang/Runtime/pointer.h"
 #include "flang/Runtime/random.h"
@@ -235,3 +236,12 @@ void fir::runtime::genSystemClock(fir::FirOpBuilder &builder,
   if (max)
     makeCall(getRuntimeFunc<mkRTKey(SystemClockCountMax)>(loc, builder), max);
 }
+
+void fir::runtime::genSleep(fir::FirOpBuilder &builder, mlir::Location loc,
+                            mlir::Value seconds) {
+  mlir::Type int64 = builder.getIntegerType(64);
+  seconds = builder.create<fir::ConvertOp>(loc, int64, seconds);
+  mlir::func::FuncOp func{
+      fir::runtime::getRuntimeFunc<mkRTKey(Sleep)>(loc, builder)};
+  builder.create<fir::CallOp>(loc, func, seconds);
+}
\ No newline at end of file
diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp
index 2740c854b807818..42adc13ce532e45 100644
--- a/flang/runtime/extensions.cpp
+++ b/flang/runtime/extensions.cpp
@@ -14,6 +14,7 @@
 #include "tools.h"
 #include "flang/Runtime/command.h"
 #include "flang/Runtime/descriptor.h"
+#include "flang/Runtime/entry-names.h"
 #include "flang/Runtime/io-api.h"
 #include <ctime>
 
@@ -39,8 +40,10 @@ inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time,
 #endif
 
 #if _REENTRANT || _POSIX_C_SOURCE >= 199506L
-// System is posix-compliant and has getlogin_r
+// System is posix-compliant and has getlogin_r and sleep
 #include <unistd.h>
+#elif _WIN32
+#include <windows.h> // for sleep
 #endif
 
 extern "C" {
@@ -113,5 +116,15 @@ void FORTRAN_PROCEDURE_NAME(getlog)(char *arg, std::int64_t length) {
 #endif
 }
 
+// CALL SLEEP(SECONDS)
+void RTNAME(Sleep)(std::int64_t seconds) {
+  // ensure that conversion to unsigned makes sense,
+  // sleep(0) is an immidiate return anyway
+  if (seconds < 1) {
+    return;
+  }
+  sleep(static_cast<unsigned>(seconds));
+}
+
 } // namespace Fortran::runtime
 } // extern "C"
diff --git a/flang/test/Lower/Intrinsics/sleep.f90 b/flang/test/Lower/Intrinsics/sleep.f90
new file mode 100644
index 000000000000000..c4a7b381602cadb
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/sleep.f90
@@ -0,0 +1,27 @@
+! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+
+subroutine test_sleep()
+! CHECK-LABEL:   func.func @_QPtest_sleep() {
+
+  call sleep(1_2)
+! CHECK:           %[[VAL_0:.*]] = arith.constant 1 : i16
+! CHECK:           %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (i16) -> i64
+! CHECK:           %[[VAL_2:.*]] = fir.call @_FortranASleep(%[[VAL_1]]) fastmath<contract> : (i64) -> none
+
+  call sleep(1_4)
+! CHECK:           %[[VAL_3:.*]] = arith.constant 1 : i32
+! CHECK:           %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (i32) -> i64
+! CHECK:           %[[VAL_5:.*]] = fir.call @_FortranASleep(%[[VAL_4]]) fastmath<contract> : (i64) -> none
+
+  call sleep(1_8)
+! CHECK:           %[[VAL_6:.*]] = arith.constant 1 : i64
+! CHECK:           %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i64) -> i64
+! CHECK:           %[[VAL_8:.*]] = fir.call @_FortranASleep(%[[VAL_7]]) fastmath<contract> : (i64) -> none
+
+  call sleep(1_16)
+! CHECK:           %[[VAL_9:.*]] = arith.constant 1 : i128
+! CHECK:           %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i128) -> i64
+! CHECK:           %[[VAL_11:.*]] = fir.call @_FortranASleep(%[[VAL_10]]) fastmath<contract> : (i64) -> none
+end
+! CHECK:           return
+! CHECK:         }

>From 9bfebb2fb2d7aae9eb9489bda4c0f23f3f8d7d5e Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Tue, 23 Jan 2024 08:02:00 +0000
Subject: [PATCH 2/5] Un-split string

---
 flang/lib/Evaluate/intrinsics.cpp | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 3c912b01906d7cc..be45a54c30d1393 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1416,8 +1416,8 @@ static DynamicType GetBuiltinDerivedType(
   auto iter{
       builtinsScope->find(semantics::SourceName{which, std::strlen(which)})};
   if (iter == builtinsScope->cend()) {
-    common::die("INTERNAL: The __fortran_builtins module does not define the "
-                "type '%s'",
+    common::die(
+        "INTERNAL: The __fortran_builtins module does not define the type '%s'",
         which);
   }
   const semantics::Symbol &symbol{*iter->second};

>From 24a9e4bbf5f562e83bfe07d8b6b304c74c77626e Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Tue, 23 Jan 2024 08:10:16 +0000
Subject: [PATCH 3/5] Add missing new line

---
 flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
index 9058ff6325b1229..2be6a15852256c4 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
@@ -244,4 +244,5 @@ void fir::runtime::genSleep(fir::FirOpBuilder &builder, mlir::Location loc,
   mlir::func::FuncOp func{
       fir::runtime::getRuntimeFunc<mkRTKey(Sleep)>(loc, builder)};
   builder.create<fir::CallOp>(loc, func, seconds);
-}
\ No newline at end of file
+}
+

>From 7e8d8aa00317a683b518326624db3e9771eb52fd Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Wed, 24 Jan 2024 17:07:03 +0000
Subject: [PATCH 4/5] Use c++ std library sleep

---
 flang/runtime/extensions.cpp | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp
index 42adc13ce532e45..6170937f839a62b 100644
--- a/flang/runtime/extensions.cpp
+++ b/flang/runtime/extensions.cpp
@@ -16,7 +16,9 @@
 #include "flang/Runtime/descriptor.h"
 #include "flang/Runtime/entry-names.h"
 #include "flang/Runtime/io-api.h"
+#include <chrono>
 #include <ctime>
+#include <thread>
 
 #ifdef _WIN32
 inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time,
@@ -40,10 +42,8 @@ inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time,
 #endif
 
 #if _REENTRANT || _POSIX_C_SOURCE >= 199506L
-// System is posix-compliant and has getlogin_r and sleep
+// System is posix-compliant and has getlogin_r
 #include <unistd.h>
-#elif _WIN32
-#include <windows.h> // for sleep
 #endif
 
 extern "C" {
@@ -123,7 +123,7 @@ void RTNAME(Sleep)(std::int64_t seconds) {
   if (seconds < 1) {
     return;
   }
-  sleep(static_cast<unsigned>(seconds));
+  std::this_thread::sleep_for(std::chrono::seconds(seconds));
 }
 
 } // namespace Fortran::runtime

>From 2d8656029b6c20f3d729091a522760860f5ad4de Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Wed, 24 Jan 2024 17:10:52 +0000
Subject: [PATCH 5/5] Revert "Add missing new line"

This reverts commit 24a9e4bbf5f562e83bfe07d8b6b304c74c77626e.

This caused a CI failure in code formatting
---
 flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
index 2be6a15852256c4..9058ff6325b1229 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
@@ -244,5 +244,4 @@ void fir::runtime::genSleep(fir::FirOpBuilder &builder, mlir::Location loc,
   mlir::func::FuncOp func{
       fir::runtime::getRuntimeFunc<mkRTKey(Sleep)>(loc, builder)};
   builder.create<fir::CallOp>(loc, func, seconds);
-}
-
+}
\ No newline at end of file



More information about the flang-commits mailing list