[flang][runtime] Implement SLEEP intrinsic (#79074)

This intrinsic is a gnu extension. See
https://gcc.gnu.org/onlinedocs/gfortran/SLEEP.html

This intrinsic is used in minighost:
https://github.com/Mantevo/miniGhost/blob/c2102b521568a74862fa5abb074b1fc8041fc222/ref/MG_UTILS.F#L606

Author: tblah

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.
-

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>);

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
 

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_

flang/lib/Evaluate/intrinsics.cpp

@@ -1401,6 +1401,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

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,

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);
+}

flang/runtime/extensions.cpp

@@ -14,8 +14,11 @@
 #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 <chrono>
 #include <ctime>
+#include <thread>
 
 #ifdef _WIN32
 inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time,
@@ -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;
+  }
+  std::this_thread::sleep_for(std::chrono::seconds(seconds));
+}
+
 } // namespace Fortran::runtime
 } // extern "C"

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:         }