diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md index 5ade257403297..a3888111430a0 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 80f79d42fc2b7..275878a0b2ad1 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 genSum(mlir::Type, llvm::ArrayRef); + void genSleep(llvm::ArrayRef); void genSystemClock(llvm::ArrayRef); mlir::Value genTand(mlir::Type, llvm::ArrayRef); mlir::Value genTrailz(mlir::Type, llvm::ArrayRef); diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h index 9a37c15e9fb4c..a92e03afa60d7 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 1ed750f3b70e0..515e9eb3e7b5e 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 @@ -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 eeea5b5773fbe..7d5c545b67eb5 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/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 diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index a0baa409fe44b..467ee7810c68a 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 args) { fir::getBase(args[1]), fir::getBase(args[2])); } +// SLEEP +void IntrinsicLibrary::genSleep(llvm::ArrayRef 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 63d66adf222f6..9058ff6325b12 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(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(loc, int64, seconds); + mlir::func::FuncOp func{ + fir::runtime::getRuntimeFunc(loc, builder)}; + builder.create(loc, func, seconds); +} \ No newline at end of file diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp index 2740c854b8078..6170937f839a6 100644 --- a/flang/runtime/extensions.cpp +++ b/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 #include +#include #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" diff --git a/flang/test/Lower/Intrinsics/sleep.f90 b/flang/test/Lower/Intrinsics/sleep.f90 new file mode 100644 index 0000000000000..c4a7b381602ca --- /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 : (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 : (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 : (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 : (i64) -> none +end +! CHECK: return +! CHECK: }