[flang] Support lowering of intrinsic GET_COMMAND

[peixin]

Summary

As Fortran 2018 16.9.82, all the arguments of GET_COMMAND are optional.
When they are all absent, do nothing so to be consistent with gfortran
and ifort. The semantic analysis and runtime have been supported.

This intrinsic was introduced from F2003, and this supports the lowering
of it.

[PeteSteinfeld]

All builds and tests correctly and looks good.

Thanks for implementing this!

[jeanPerier]

LGTM, thanks

[peixin]

Rebase to fix the FIR FileCheck fail caused by fastmath problem.

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

 class FirOpBuilder;
 } // namespace fir
 
 namespace fir::runtime {
 
 /// Generate call to COMMAND_ARGUMENT_COUNT intrinsic runtime routine.
 mlir::Value genCommandArgumentCount(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
+/// not null mlir values). The status value is returned.
+mlir::Value genGetCommand(fir::FirOpBuilder &, mlir::Location,
+                          mlir::Value command, mlir::Value length,
+                          mlir::Value errmsg);
+
 /// 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
 /// not null mlir values). The status value is returned.
 mlir::Value genGetCommandArgument(fir::FirOpBuilder &, mlir::Location,
                                   mlir::Value number, mlir::Value value,
                                   mlir::Value length, mlir::Value errmsg);
 

flang/lib/Lower/IntrinsicCall.cpp

struct IntrinsicLibrary {
   fir::ExtendedValue genEoshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   void genExit(llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genExponent(mlir::Type, llvm::ArrayRef<mlir::Value>);
   template <Extremum, ExtremumBehavior>
   mlir::Value genExtremum(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genFloor(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genFraction(mlir::Type resultType,
                           mlir::ArrayRef<mlir::Value> args);
+  void genGetCommand(mlir::ArrayRef<fir::ExtendedValue> args);
   void genGetCommandArgument(mlir::ArrayRef<fir::ExtendedValue> args);
   void genGetEnvironmentVariable(llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genIall(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments
   /// in the llvm::ArrayRef.
   mlir::Value genIand(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genIany(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genIbclr(mlir::Type, llvm::ArrayRef<mlir::Value>);
static constexpr IntrinsicHandler handlers[]{
      /*isElemental=*/false},
     {"exit",
      &I::genExit,
      {{{"status", asValue, handleDynamicOptional}}},
      /*isElemental=*/false},
     {"exponent", &I::genExponent},
     {"floor", &I::genFloor},
     {"fraction", &I::genFraction},
+    {"get_command",
+     &I::genGetCommand,
+     {{{"command", asBox, handleDynamicOptional},
+       {"length", asBox, handleDynamicOptional},
+       {"status", asAddr, handleDynamicOptional},
+       {"errmsg", asBox, handleDynamicOptional}}},
+     /*isElemental=*/false},
     {"get_command_argument",
      &I::genGetCommandArgument,
      {{{"number", asValue},
        {"value", asBox, handleDynamicOptional},
        {"length", asBox, handleDynamicOptional},
        {"status", asAddr, handleDynamicOptional},
        {"errmsg", asBox, handleDynamicOptional}}},
      /*isElemental=*/false},
mlir::Value IntrinsicLibrary::genFraction(mlir::Type resultType,
                                           llvm::ArrayRef<mlir::Value> args) {
   assert(args.size() == 1);
 
   return builder.createConvert(
       loc, resultType,
       fir::runtime::genFraction(builder, loc, fir::getBase(args[0])));
 }
 
+// GET_COMMAND
+void IntrinsicLibrary::genGetCommand(llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 4);
+  const fir::ExtendedValue &command = args[0];
+  const fir::ExtendedValue &length = args[1];
+  const fir::ExtendedValue &status = args[2];
+  const fir::ExtendedValue &errmsg = args[3];
+
+  // If none of the optional parameters are present, do nothing.
+  if (!isStaticallyPresent(command) && !isStaticallyPresent(length) &&
+      !isStaticallyPresent(status) && !isStaticallyPresent(errmsg))
+    return;
+
+  mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
+  mlir::Value commandBox =
+      isStaticallyPresent(command)
+          ? fir::getBase(command)
+          : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+  mlir::Value lenBox =
+      isStaticallyPresent(length)
+          ? fir::getBase(length)
+          : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+  mlir::Value errBox =
+      isStaticallyPresent(errmsg)
+          ? fir::getBase(errmsg)
+          : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+  mlir::Value stat =
+      fir::runtime::genGetCommand(builder, loc, commandBox, lenBox, errBox);
+  if (isStaticallyPresent(status)) {
+    mlir::Value statAddr = fir::getBase(status);
+    mlir::Value statIsPresentAtRuntime =
+        builder.genIsNotNullAddr(loc, statAddr);
+    builder.genIfThen(loc, statIsPresentAtRuntime)
+        .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); })
+        .end();
+  }
+}
+
 // GET_COMMAND_ARGUMENT
 void IntrinsicLibrary::genGetCommandArgument(
     llvm::ArrayRef<fir::ExtendedValue> args) {
   assert(args.size() == 5);
   mlir::Value number = fir::getBase(args[0]);
   const fir::ExtendedValue &value = args[1];
   const fir::ExtendedValue &length = args[2];
   const fir::ExtendedValue &status = args[3];

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

 
 mlir::Value fir::runtime::genCommandArgumentCount(fir::FirOpBuilder &builder,
                                                   mlir::Location loc) {
   auto argumentCountFunc =
       fir::runtime::getRuntimeFunc<mkRTKey(ArgumentCount)>(loc, builder);
   return builder.create<fir::CallOp>(loc, argumentCountFunc).getResult(0);
 }
 
+mlir::Value fir::runtime::genGetCommand(fir::FirOpBuilder &builder,
+                                        mlir::Location loc, mlir::Value command,
+                                        mlir::Value length,
+                                        mlir::Value errmsg) {
+  auto runtimeFunc =
+      fir::runtime::getRuntimeFunc<mkRTKey(GetCommand)>(loc, builder);
+  mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();
+  mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
+  mlir::Value sourceLine =
+      fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(4));
+  llvm::SmallVector<mlir::Value> args =
+      fir::runtime::createArguments(builder, loc, runtimeFuncTy, command,
+                                    length, errmsg, sourceFile, sourceLine);
+  return builder.create<fir::CallOp>(loc, runtimeFunc, args).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) {
   auto runtimeFunc =
       fir::runtime::getRuntimeFunc<mkRTKey(GetCommandArgument)>(loc, builder);
   mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();
   mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
   mlir::Value sourceLine =

flang/test/Lower/Intrinsics/get_command.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPcommand_only() {
+! CHECK:         %[[VAL_0:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "cmd", uniq_name = "_QFcommand_onlyEcmd"}
+! CHECK:         %[[VAL_1:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.char<1,10>>
+! CHECK:         %[[VAL_2:.*]] = fir.absent !fir.box<none>
+! CHECK:         %[[VAL_3:.*]] = fir.absent !fir.box<none>
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_1]] : (!fir.box<!fir.char<1,10>>) -> !fir.box<none>
+! CHECK:         %[[VAL_8:.*]] = fir.call @_FortranAGetCommand(%[[VAL_6]], %[[VAL_2]], %[[VAL_3]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK:         return
+! CHECK:       }
+
+subroutine command_only()
+  character(10) :: cmd
+  call get_command(cmd)
+end
+
+! CHECK-LABEL: func.func @_QPlength_only() {
+! CHECK:         %[[VAL_0:.*]] = fir.alloca i32 {bindc_name = "len", uniq_name = "_QFlength_onlyElen"}
+! CHECK:         %[[VAL_1:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK:         %[[VAL_2:.*]] = fir.absent !fir.box<none>
+! CHECK:         %[[VAL_3:.*]] = fir.absent !fir.box<none>
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_1]] : (!fir.box<i32>) -> !fir.box<none>
+! CHECK:         %[[VAL_8:.*]] = fir.call @_FortranAGetCommand(%[[VAL_2]], %[[VAL_6]], %[[VAL_3]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK:         return
+! CHECK:       }
+
+subroutine length_only()
+  integer :: len
+  call get_command(length=len)
+end
+
+! CHECK-LABEL: func.func @_QPstatus_only() {
+! CHECK:         %[[VAL_0:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "cmd", uniq_name = "_QFstatus_onlyEcmd"}
+! CHECK:         %[[VAL_1:.*]] = fir.alloca i32 {bindc_name = "stat", uniq_name = "_QFstatus_onlyEstat"}
+! CHECK:         %[[VAL_2:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.char<1,10>>
+! CHECK:         %[[VAL_3:.*]] = fir.absent !fir.box<none>
+! CHECK:         %[[VAL_4:.*]] = fir.absent !fir.box<none>
+! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (!fir.box<!fir.char<1,10>>) -> !fir.box<none>
+! CHECK:         %[[VAL_9:.*]] = fir.call @_FortranAGetCommand(%[[VAL_7]], %[[VAL_3]], %[[VAL_4]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<i32>) -> i64
+! CHECK:         %[[VAL_11:.*]] = arith.constant 0 : i64
+! CHECK:         %[[VAL_12:.*]] = arith.cmpi ne, %[[VAL_10]], %[[VAL_11]] : i64
+! CHECK:         fir.if %[[VAL_12]] {
+! CHECK:           fir.store %[[VAL_9]] to %[[VAL_1]] : !fir.ref<i32>
+! CHECK:         }
+! CHECK:         return
+! CHECK:       }
+
+subroutine status_only()
+  character(10) :: cmd
+  integer :: stat
+  call get_command(cmd, status=stat)
+end
+
+! CHECK-LABEL: func.func @_QPerrmsg_only() {
+! CHECK:         %[[VAL_0:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "cmd", uniq_name = "_QFerrmsg_onlyEcmd"}
+! CHECK:         %[[VAL_1:.*]] = fir.alloca !fir.char<1,50> {bindc_name = "err", uniq_name = "_QFerrmsg_onlyEerr"}
+! CHECK:         %[[VAL_2:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.char<1,10>>
+! CHECK:         %[[VAL_3:.*]] = fir.embox %[[VAL_1]] : (!fir.ref<!fir.char<1,50>>) -> !fir.box<!fir.char<1,50>>
+! CHECK:         %[[VAL_4:.*]] = fir.absent !fir.box<none>
+! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (!fir.box<!fir.char<1,10>>) -> !fir.box<none>
+! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_3]] : (!fir.box<!fir.char<1,50>>) -> !fir.box<none>
+! CHECK:         %[[VAL_10:.*]] = fir.call @_FortranAGetCommand(%[[VAL_7]], %[[VAL_4]], %[[VAL_8]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK:         return
+! CHECK:       }
+
+subroutine errmsg_only()
+  character(10) :: cmd
+  character(50) :: err
+  call get_command(cmd, errmsg=err)
+end
+
+! CHECK-LABEL: func.func @_QPcommand_status() {
+! CHECK:         %[[VAL_0:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "cmd", uniq_name = "_QFcommand_statusEcmd"}
+! CHECK:         %[[VAL_1:.*]] = fir.alloca i32 {bindc_name = "stat", uniq_name = "_QFcommand_statusEstat"}
+! CHECK:         %[[VAL_2:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.char<1,10>>
+! CHECK:         %[[VAL_3:.*]] = fir.absent !fir.box<none>
+! CHECK:         %[[VAL_4:.*]] = fir.absent !fir.box<none>
+! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (!fir.box<!fir.char<1,10>>) -> !fir.box<none>
+! CHECK:         %[[VAL_9:.*]] = fir.call @_FortranAGetCommand(%[[VAL_7]], %[[VAL_3]], %[[VAL_4]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<i32>) -> i64
+! CHECK:         %[[VAL_11:.*]] = arith.constant 0 : i64
+! CHECK:         %[[VAL_12:.*]] = arith.cmpi ne, %[[VAL_10]], %[[VAL_11]] : i64
+! CHECK:         fir.if %[[VAL_12]] {
+! CHECK:           fir.store %[[VAL_9]] to %[[VAL_1]] : !fir.ref<i32>
+! CHECK:         }
+! CHECK:         return
+! CHECK:       }
+
+subroutine command_status()
+  character(10) :: cmd
+  integer :: stat
+  call get_command(cmd, status=stat)
+end
+
+! CHECK-LABEL: func.func @_QPall_args() {
+! CHECK:         %[[VAL_0:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "cmd", uniq_name = "_QFall_argsEcmd"}
+! CHECK:         %[[VAL_1:.*]] = fir.alloca !fir.char<1,50> {bindc_name = "err", uniq_name = "_QFall_argsEerr"}
+! CHECK:         %[[VAL_2:.*]] = fir.alloca i32 {bindc_name = "len", uniq_name = "_QFall_argsElen"}
+! CHECK:         %[[VAL_3:.*]] = fir.alloca i32 {bindc_name = "stat", uniq_name = "_QFall_argsEstat"}
+! CHECK:         %[[VAL_4:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.char<1,10>>
+! CHECK:         %[[VAL_5:.*]] = fir.embox %[[VAL_2]] : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK:         %[[VAL_6:.*]] = fir.embox %[[VAL_1]] : (!fir.ref<!fir.char<1,50>>) -> !fir.box<!fir.char<1,50>>
+! CHECK:         %[[VAL_9:.*]] = fir.convert %[[VAL_4]] : (!fir.box<!fir.char<1,10>>) -> !fir.box<none>
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_5]] : (!fir.box<i32>) -> !fir.box<none>
+! CHECK:         %[[VAL_11:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.char<1,50>>) -> !fir.box<none>
+! CHECK:         %[[VAL_13:.*]] = fir.call @_FortranAGetCommand(%[[VAL_9]], %[[VAL_10]], %[[VAL_11]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i32>) -> i64
+! CHECK:         %[[VAL_15:.*]] = arith.constant 0 : i64
+! CHECK:         %[[VAL_16:.*]] = arith.cmpi ne, %[[VAL_14]], %[[VAL_15]] : i64
+! CHECK:         fir.if %[[VAL_16]] {
+! CHECK:           fir.store %[[VAL_13]] to %[[VAL_3]] : !fir.ref<i32>
+! CHECK:         }
+! CHECK:         return
+! CHECK:       }
+
+subroutine all_args()
+  character(10) :: cmd
+  character(50) :: err
+  integer :: len, stat
+  call get_command(cmd, len, stat, err)
+end