[flang] GETGID runtime and lowering intrinsics

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, NUMARG, BADDRESS, IADDR, CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC, GETGID |
 | 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 |

flang/include/flang/Optimizer/Builder/IntrinsicCall.h

@@ -225,6 +225,8 @@ struct IntrinsicLibrary {
   void genGetCommand(mlir::ArrayRef<fir::ExtendedValue> args);
   void genGetCommandArgument(mlir::ArrayRef<fir::ExtendedValue> args);
   void genGetEnvironmentVariable(llvm::ArrayRef<fir::ExtendedValue>);
+  mlir::Value genGetGID(mlir::Type resultType,
+                        llvm::ArrayRef<mlir::Value> args);
   fir::ExtendedValue genIall(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments
   /// in the llvm::ArrayRef.

flang/include/flang/Optimizer/Builder/Runtime/Command.h

@@ -23,6 +23,10 @@ namespace fir::runtime {
 /// Generate call to COMMAND_ARGUMENT_COUNT intrinsic runtime routine.
 mlir::Value genCommandArgumentCount(fir::FirOpBuilder &, mlir::Location);
 
+/// Generate a call to the GetGID runtime function which implements the
+/// GETGID intrinsic.
+mlir::Value genGetGID(fir::FirOpBuilder &, mlir::Location);
+
 /// Generate a call to the GetCommand runtime function which implements the
 /// GET_COMMAND intrinsic.
 /// \p command, \p length and \p errmsg must be fir.box that can be absent (but

flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h

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

flang/include/flang/Runtime/command.h

@@ -13,6 +13,12 @@
 
 #include <cstdint>
 
+#ifdef _WIN32
+typedef int gid_t;
+#else
+#include "sys/types.h" //gid_t
+#endif
+
 namespace Fortran::runtime {
 class Descriptor;
 
@@ -23,6 +29,9 @@ extern "C" {
 // integer kind.
 std::int32_t RTNAME(ArgumentCount)();
 
+// Calls getgid()
+gid_t RTNAME(GetGID)();
+
 // 16.9.82 GET_COMMAND
 // Try to get the value of the whole command. All of the parameters are
 // optional.

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},
+    {"getgid", {}, DefaultInt},
     {"huge",
         {{"x", SameIntOrReal, Rank::anyOrAssumedRank, Optionality::required,
             common::Intent::In, {ArgFlag::canBeNull}}},

flang/lib/Optimizer/Builder/IntrinsicCall.cpp

@@ -253,6 +253,7 @@ static constexpr IntrinsicHandler handlers[]{
        {"trim_name", asAddr, handleDynamicOptional},
        {"errmsg", asBox, handleDynamicOptional}}},
      /*isElemental=*/false},
+    {"getgid", &I::genGetGID},
     {"iachar", &I::genIchar},
     {"iall",
      &I::genIall,
@@ -2906,6 +2907,14 @@ mlir::Value IntrinsicLibrary::genFraction(mlir::Type resultType,
       fir::runtime::genFraction(builder, loc, fir::getBase(args[0])));
 }
 
+// GETGID
+mlir::Value IntrinsicLibrary::genGetGID(mlir::Type resultType,
+                                        llvm::ArrayRef<mlir::Value> args) {
+  assert(args.size() == 0 && "getgid takes no input");
+  return builder.createConvert(loc, resultType,
+                               fir::runtime::genGetGID(builder, loc));
+}
+
 // GET_COMMAND
 void IntrinsicLibrary::genGetCommand(llvm::ArrayRef<fir::ExtendedValue> args) {
   assert(args.size() == 4);

flang/lib/Optimizer/Builder/Runtime/Command.cpp

@@ -80,3 +80,11 @@ mlir::Value fir::runtime::genGetEnvVariable(fir::FirOpBuilder &builder,
       sourceFile, sourceLine);
   return builder.create<fir::CallOp>(loc, runtimeFunc, args).getResult(0);
 }
+
+mlir::Value fir::runtime::genGetGID(fir::FirOpBuilder &builder,
+                                    mlir::Location loc) {
+  auto runtimeFunc =
+      fir::runtime::getRuntimeFunc<mkRTKey(GetGID)>(loc, builder);
+
+  return builder.create<fir::CallOp>(loc, runtimeFunc).getResult(0);
+}

flang/runtime/command.cpp

@@ -15,6 +15,12 @@
 #include <cstdlib>
 #include <limits>
 
+#ifdef _WIN32
+inline gid_t getgid() { return 0; }
+#else
+#include <unistd.h>
+#endif
+
 namespace Fortran::runtime {
 std::int32_t RTNAME(ArgumentCount)() {
   int argc{executionEnvironment.argc};
@@ -25,6 +31,8 @@ std::int32_t RTNAME(ArgumentCount)() {
   return 0;
 }
 
+gid_t RTNAME(GetGID)() { return getgid(); }
+
 // 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)};

flang/test/Lower/Intrinsics/getgid.f90

@@ -0,0 +1,14 @@
+! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPall_args() {
+! CHECK:         %[[VAL_0:.*]] = fir.alloca i32 {bindc_name = "gid", uniq_name = "_QFall_argsEgid"}
+! CHECK:         %[[VAL_1:.*]]:2 = hlfir.declare %0 {uniq_name = "_QFall_argsEgid"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+! CHECK:         %[[VAL_2:.*]] = fir.call @_FortranAGetGID() fastmath<contract> : () -> i32
+! CHECK:         hlfir.assign %[[VAL_2:.*]] to %[[VAL_1:.*]]#0 : i32, !fir.ref<i32>
+! CHECK:         return
+! CHECK:       }
+
+subroutine all_args()
+  integer :: gid
+  gid = getgid()
+end

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, genGetGID) {
+  mlir::Location loc = firBuilder->getUnknownLoc();
+  mlir::Value result = fir::runtime::genGetGID(*firBuilder, loc);
+  checkCallOp(result.getDefiningOp(), "_FortranAGetGID", /*nbArgs=*/0,
+      /*addLocArgs=*/false);
+}

flang/unittests/Runtime/CommandTest.cpp

@@ -227,6 +227,12 @@ TEST_F(ZeroArguments, GetCommandArgument) {
 
 TEST_F(ZeroArguments, GetCommand) { CheckCommandValue(commandOnlyArgv, 1); }
 
+TEST_F(ZeroArguments, GetGID) {
+  CheckMissingArgumentValue(-1);
+  CheckArgumentValue(commandOnlyArgv[0], 0);
+  CheckMissingArgumentValue(1);
+}
+
 static const char *oneArgArgv[]{"aProgram", "anArgumentOfLength20"};
 class OneArgument : public CommandFixture {
 protected: