[flang-commits] [flang] [flang] GETPID runtime and lower intrinsic implementation (PR #70442)

Yi Wu via flang-commits flang-commits at lists.llvm.org
Thu Nov 2 08:21:14 PDT 2023


https://github.com/PAX-12-WU updated https://github.com/llvm/llvm-project/pull/70442

>From 174d304544e576f251ecb634c7124a53d2c4f367 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Fri, 27 Oct 2023 09:16:11 +0000
Subject: [PATCH] [flang] GETPID runtime and lower intrinsic implementation

Runtime function GetPID calls the function getpid
from unistd.h or processthreadsapi.h base on the OS.

Processthreadsapi.g is supported since Windows XP:
https://learn.microsoft.com/en-us/windows/win32/api/processthreadsapi/nf-processthreadsapi-getcurrentprocessid
and GetCurrentProcessId returns a DWORD, an unsigned 32-bit int:
https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-dtyp/262627d8-3418-4627-9218-4ffe110850b2
---
 flang/docs/Intrinsics.md                         |  2 +-
 .../flang/Optimizer/Builder/IntrinsicCall.h      |  2 ++
 .../flang/Optimizer/Builder/Runtime/Command.h    |  4 ++++
 .../flang/Optimizer/Builder/Runtime/RTBuilder.h  | 14 ++++++++++++++
 flang/include/flang/Runtime/command.h            | 10 ++++++++++
 flang/lib/Evaluate/intrinsics.cpp                |  1 +
 flang/lib/Optimizer/Builder/IntrinsicCall.cpp    |  9 +++++++++
 flang/lib/Optimizer/Builder/Runtime/Command.cpp  |  8 ++++++++
 flang/runtime/command.cpp                        | 13 +++++++++++++
 flang/test/Lower/Intrinsics/getpid.f90           | 16 ++++++++++++++++
 .../Optimizer/Builder/Runtime/CommandTest.cpp    |  7 +++++++
 flang/unittests/Runtime/CommandTest.cpp          |  5 +++++
 12 files changed, 90 insertions(+), 1 deletion(-)
 create mode 100644 flang/test/Lower/Intrinsics/getpid.f90

diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index ab0a940e53e5538..fef2b4ea4dd8c85 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 06db8cf9e9dc923..5065f11ae9e7264 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<mlir::Value> args);
   void genGetCommand(mlir::ArrayRef<fir::ExtendedValue> args);
+  mlir::Value genGetPID(mlir::Type resultType,
+                        llvm::ArrayRef<mlir::Value> args);
   void genGetCommandArgument(mlir::ArrayRef<fir::ExtendedValue> args);
   void genGetEnvironmentVariable(llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genIall(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Command.h b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
index 9ecdba2c995b713..976fb3aa0b6fbb7 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 b2774263e7a31a4..99558cf03d4ffe7 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 <cstdint>
 #include <functional>
 
+#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 <typename T>
 static constexpr TypeBuilderFunc getModel();
+
+template <>
+constexpr TypeBuilderFunc getModel<unsigned int>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(context, 8 * sizeof(unsigned int));
+  };
+}
+
 template <>
 constexpr TypeBuilderFunc getModel<short int>() {
   return [](mlir::MLIRContext *context) -> mlir::Type {
diff --git a/flang/include/flang/Runtime/command.h b/flang/include/flang/Runtime/command.h
index ec6289390545479..d0c1ce5d90e951f 100644
--- a/flang/include/flang/Runtime/command.h
+++ b/flang/include/flang/Runtime/command.h
@@ -11,6 +11,13 @@
 
 #include "flang/Runtime/entry-names.h"
 
+#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
+
 #include <cstdint>
 
 namespace Fortran::runtime {
@@ -23,6 +30,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 e4125f6572aa983..e2599c75fe6b72d 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -499,6 +499,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 0a023bc6b21ea03..454d38592a8bc4f 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,
@@ -2936,6 +2937,14 @@ void IntrinsicLibrary::genGetCommand(llvm::ArrayRef<fir::ExtendedValue> args) {
   }
 }
 
+// GETPID
+mlir::Value IntrinsicLibrary::genGetPID(mlir::Type resultType,
+                                        llvm::ArrayRef<mlir::Value> 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<fir::ExtendedValue> args) {
diff --git a/flang/lib/Optimizer/Builder/Runtime/Command.cpp b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
index f56475a97487835..1d719e7bbd9a2d1 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<fir::CallOp>(loc, runtimeFunc, args).getResult(0);
 }
 
+mlir::Value fir::runtime::genGetPID(fir::FirOpBuilder &builder,
+                                    mlir::Location loc) {
+  auto runtimeFunc =
+      fir::runtime::getRuntimeFunc<mkRTKey(GetPID)>(loc, builder);
+
+  return builder.create<fir::CallOp>(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 b81a0791c5e571b..efc80e9559924f6 100644
--- a/flang/runtime/command.cpp
+++ b/flang/runtime/command.cpp
@@ -15,6 +15,17 @@
 #include <cstdlib>
 #include <limits>
 
+#ifdef _WIN32
+// On Windows GetCurrentProcessId returns a DWORD aka uint32_t
+#define WIN32_LEAN_AND_MEAN
+#define NOMINMAX
+#include <processthreadsapi.h>
+#include <windows.h>
+inline pid_t getpid() { return GetCurrentProcessId(); }
+#else
+#include <unistd.h> //getpid()
+#endif
+
 namespace Fortran::runtime {
 std::int32_t RTNAME(ArgumentCount)() {
   int argc{executionEnvironment.argc};
@@ -25,6 +36,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 000000000000000..be459ad9e44874e
--- /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<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+! CHECK:         %[[VAL_2:.*]] = fir.call @_FortranAGetPID() fastmath<contract> : () -> i32
+! CHECK:         hlfir.assign %[[VAL_2:.*]] to %[[VAL_1:.*]]#0 : i32, !fir.ref<i32>
+! 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 acc79ae63e9f698..58a151447d5b4f7 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 c3571c9684e4b07..9f66c7924c86e3c 100644
--- a/flang/unittests/Runtime/CommandTest.cpp
+++ b/flang/unittests/Runtime/CommandTest.cpp
@@ -388,6 +388,11 @@ TEST_F(OnlyValidArguments, GetCommandShortLength) {
   CheckDescriptorEqInt<short>(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) {



More information about the flang-commits mailing list