diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md index ab0a940e53e55..fef2b4ea4dd8c 100644 --- a/flang/docs/Intrinsics.md +++ b/flang/docs/Intrinsics.md @@ -750,7 +750,7 @@ This phase currently supports all the intrinsic procedures listed above but the | Coarray intrinsic functions | IMAGE_INDEX, COSHAPE | | 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, NUMARG, BADDRESS, IADDR, CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC | +| 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 | | Atomic intrinsic subroutines | ATOMIC_ADD | | Collective intrinsic subroutines | CO_REDUCE | diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h index 06db8cf9e9dc9..5065f11ae9e72 100644 --- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h +++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h @@ -223,6 +223,8 @@ struct IntrinsicLibrary { mlir::Value genFraction(mlir::Type resultType, mlir::ArrayRef args); void genGetCommand(mlir::ArrayRef args); + mlir::Value genGetPID(mlir::Type resultType, + llvm::ArrayRef args); void genGetCommandArgument(mlir::ArrayRef args); void genGetEnvironmentVariable(llvm::ArrayRef); fir::ExtendedValue genIall(mlir::Type, llvm::ArrayRef); diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Command.h b/flang/include/flang/Optimizer/Builder/Runtime/Command.h index 9ecdba2c995b7..976fb3aa0b6fb 100644 --- a/flang/include/flang/Optimizer/Builder/Runtime/Command.h +++ b/flang/include/flang/Optimizer/Builder/Runtime/Command.h @@ -31,6 +31,10 @@ mlir::Value genGetCommand(fir::FirOpBuilder &, mlir::Location, mlir::Value command, mlir::Value length, mlir::Value errmsg); +/// Generate a call to the GetPID runtime function which implements the +/// GETPID intrinsic. +mlir::Value genGetPID(fir::FirOpBuilder &, mlir::Location); + /// Generate a call to the GetCommandArgument runtime function which implements /// the GET_COMMAND_ARGUMENT intrinsic. /// \p value, \p length and \p errmsg must be fir.box that can be absent (but diff --git a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h index b2774263e7a31..99558cf03d4ff 100644 --- a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h +++ b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h @@ -25,8 +25,14 @@ #include "mlir/IR/BuiltinTypes.h" #include "mlir/IR/MLIRContext.h" #include "llvm/ADT/SmallVector.h" +#include #include +#ifdef _WIN32 +// On Windows* OS GetCurrentProcessId returns DWORD aka uint32_t +typedef std::uint32_t pid_t; +#endif + // Incomplete type indicating C99 complex ABI in interfaces. Beware, _Complex // and std::complex are layout compatible, but not compatible in all ABI call // interfaces (e.g. X86 32 bits). _Complex is not standard C++, so do not use @@ -62,6 +68,14 @@ using FuncTypeBuilderFunc = mlir::FunctionType (*)(mlir::MLIRContext *); /// standard type `i32` when `sizeof(int)` is 4. template static constexpr TypeBuilderFunc getModel(); + +template <> +constexpr TypeBuilderFunc getModel() { + return [](mlir::MLIRContext *context) -> mlir::Type { + return mlir::IntegerType::get(context, 8 * sizeof(unsigned int)); + }; +} + template <> constexpr TypeBuilderFunc getModel() { return [](mlir::MLIRContext *context) -> mlir::Type { diff --git a/flang/include/flang/Runtime/command.h b/flang/include/flang/Runtime/command.h index ec62893905454..c67d171c8e2f1 100644 --- a/flang/include/flang/Runtime/command.h +++ b/flang/include/flang/Runtime/command.h @@ -10,9 +10,15 @@ #define FORTRAN_RUNTIME_COMMAND_H_ #include "flang/Runtime/entry-names.h" - #include +#ifdef _WIN32 +// On Windows* OS GetCurrentProcessId returns DWORD aka uint32_t +typedef std::uint32_t pid_t; +#else +#include "sys/types.h" //pid_t +#endif + namespace Fortran::runtime { class Descriptor; @@ -23,6 +29,9 @@ extern "C" { // integer kind. std::int32_t RTNAME(ArgumentCount)(); +// Calls getpid() +pid_t RTNAME(GetPID)(); + // 16.9.82 GET_COMMAND // Try to get the value of the whole command. All of the parameters are // optional. diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index c711b4feaca48..9e78a1b0f4f5b 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -500,6 +500,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ {"gamma", {{"x", SameReal}}, SameReal}, {"get_team", {{"level", DefaultInt, Rank::scalar, Optionality::optional}}, TeamType, Rank::scalar, IntrinsicClass::transformationalFunction}, + {"getpid", {}, DefaultInt}, {"huge", {{"x", SameIntOrReal, Rank::anyOrAssumedRank, Optionality::required, common::Intent::In, {ArgFlag::canBeNull}}}, diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index fe40fd821f010..24fdbe97856b3 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -253,6 +253,7 @@ static constexpr IntrinsicHandler handlers[]{ {"trim_name", asAddr, handleDynamicOptional}, {"errmsg", asBox, handleDynamicOptional}}}, /*isElemental=*/false}, + {"getpid", &I::genGetPID}, {"iachar", &I::genIchar}, {"iall", &I::genIall, @@ -2944,6 +2945,14 @@ void IntrinsicLibrary::genGetCommand(llvm::ArrayRef args) { } } +// GETPID +mlir::Value IntrinsicLibrary::genGetPID(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 0 && "getpid takes no input"); + return builder.createConvert(loc, resultType, + fir::runtime::genGetPID(builder, loc)); +} + // GET_COMMAND_ARGUMENT void IntrinsicLibrary::genGetCommandArgument( llvm::ArrayRef args) { diff --git a/flang/lib/Optimizer/Builder/Runtime/Command.cpp b/flang/lib/Optimizer/Builder/Runtime/Command.cpp index f56475a974878..1d719e7bbd9a2 100644 --- a/flang/lib/Optimizer/Builder/Runtime/Command.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Command.cpp @@ -48,6 +48,14 @@ mlir::Value fir::runtime::genGetCommand(fir::FirOpBuilder &builder, return builder.create(loc, runtimeFunc, args).getResult(0); } +mlir::Value fir::runtime::genGetPID(fir::FirOpBuilder &builder, + mlir::Location loc) { + auto runtimeFunc = + fir::runtime::getRuntimeFunc(loc, builder); + + return builder.create(loc, runtimeFunc).getResult(0); +} + mlir::Value fir::runtime::genGetCommandArgument( fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value number, mlir::Value value, mlir::Value length, mlir::Value errmsg) { diff --git a/flang/runtime/command.cpp b/flang/runtime/command.cpp index b81a0791c5e57..8e6135b5487c0 100644 --- a/flang/runtime/command.cpp +++ b/flang/runtime/command.cpp @@ -15,6 +15,18 @@ #include #include +#ifdef _WIN32 +#define WIN32_LEAN_AND_MEAN +#define NOMINMAX +#include + +// On Windows GetCurrentProcessId returns a DWORD aka uint32_t +#include +inline pid_t getpid() { return GetCurrentProcessId(); } +#else +#include //getpid() +#endif + namespace Fortran::runtime { std::int32_t RTNAME(ArgumentCount)() { int argc{executionEnvironment.argc}; @@ -25,6 +37,8 @@ std::int32_t RTNAME(ArgumentCount)() { return 0; } +pid_t RTNAME(GetPID)() { return getpid(); } + // Returns the length of the \p string. Assumes \p string is valid. static std::int64_t StringLength(const char *string) { std::size_t length{std::strlen(string)}; diff --git a/flang/test/Lower/Intrinsics/getpid.f90 b/flang/test/Lower/Intrinsics/getpid.f90 new file mode 100644 index 0000000000000..be459ad9e4487 --- /dev/null +++ b/flang/test/Lower/Intrinsics/getpid.f90 @@ -0,0 +1,16 @@ +! RUN: bbc -emit-hlfir %s -o - | FileCheck %s + +! CHECK-LABEL: func.func @_QPall_args() { +! CHECK: %[[VAL_0:.*]] = fir.alloca i32 {bindc_name = "pid", uniq_name = "_QFall_argsEpid"} +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %0 {uniq_name = "_QFall_argsEpid"} : (!fir.ref) -> (!fir.ref, !fir.ref) +! CHECK: %[[VAL_2:.*]] = fir.call @_FortranAGetPID() fastmath : () -> i32 +! CHECK: hlfir.assign %[[VAL_2:.*]] to %[[VAL_1:.*]]#0 : i32, !fir.ref +! CHECK: return +! CHECK: } + +subroutine all_args() + integer :: pid + pid = getpid() +end + + diff --git a/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp b/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp index acc79ae63e9f6..58a151447d5b4 100644 --- a/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp +++ b/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp @@ -44,3 +44,10 @@ TEST_F(RuntimeCallTest, genGetEnvVariable) { checkCallOp(result.getDefiningOp(), "_FortranAGetEnvVariable", /*nbArgs=*/5, /*addLocArgs=*/true); } + +TEST_F(RuntimeCallTest, genGetPID) { + mlir::Location loc = firBuilder->getUnknownLoc(); + mlir::Value result = fir::runtime::genGetPID(*firBuilder, loc); + checkCallOp(result.getDefiningOp(), "_FortranAGetPID", /*nbArgs=*/0, + /*addLocArgs=*/false); +} \ No newline at end of file diff --git a/flang/unittests/Runtime/CommandTest.cpp b/flang/unittests/Runtime/CommandTest.cpp index c3571c9684e4b..9f66c7924c86e 100644 --- a/flang/unittests/Runtime/CommandTest.cpp +++ b/flang/unittests/Runtime/CommandTest.cpp @@ -388,6 +388,11 @@ TEST_F(OnlyValidArguments, GetCommandShortLength) { CheckDescriptorEqInt(length.get(), 51); } +TEST_F(ZeroArguments, GetPID) { + // pid should always greater than 0, in both linux and windows + EXPECT_GT(RTNAME(GetPID)(), 0); +} + class EnvironmentVariables : public CommandFixture { protected: EnvironmentVariables() : CommandFixture(0, nullptr) {