diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Command.h b/flang/include/flang/Optimizer/Builder/Runtime/Command.h --- a/flang/include/flang/Optimizer/Builder/Runtime/Command.h +++ b/flang/include/flang/Optimizer/Builder/Runtime/Command.h @@ -23,6 +23,14 @@ /// 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 diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -505,6 +505,7 @@ mlir::Value genFloor(mlir::Type, llvm::ArrayRef); mlir::Value genFraction(mlir::Type resultType, mlir::ArrayRef args); + void genGetCommand(mlir::ArrayRef args); void genGetCommandArgument(mlir::ArrayRef args); void genGetEnvironmentVariable(llvm::ArrayRef); fir::ExtendedValue genIall(mlir::Type, llvm::ArrayRef); @@ -802,6 +803,13 @@ {"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}, @@ -3188,6 +3196,44 @@ fir::runtime::genFraction(builder, loc, fir::getBase(args[0]))); } +// GET_COMMAND +void IntrinsicLibrary::genGetCommand(llvm::ArrayRef 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(loc, boxNoneTy).getResult(); + mlir::Value lenBox = + isStaticallyPresent(length) + ? fir::getBase(length) + : builder.create(loc, boxNoneTy).getResult(); + mlir::Value errBox = + isStaticallyPresent(errmsg) + ? fir::getBase(errmsg) + : builder.create(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 args) { diff --git a/flang/lib/Optimizer/Builder/Runtime/Command.cpp b/flang/lib/Optimizer/Builder/Runtime/Command.cpp --- a/flang/lib/Optimizer/Builder/Runtime/Command.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Command.cpp @@ -32,6 +32,22 @@ return builder.create(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(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 args = + fir::runtime::createArguments(builder, loc, runtimeFuncTy, command, + length, errmsg, sourceFile, sourceLine); + return builder.create(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) { diff --git a/flang/test/Lower/Intrinsics/get_command.f90 b/flang/test/Lower/Intrinsics/get_command.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/get_command.f90 @@ -0,0 +1,123 @@ +! 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.box> +! CHECK: %[[VAL_2:.*]] = fir.absent !fir.box +! CHECK: %[[VAL_3:.*]] = fir.absent !fir.box +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_1]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_8:.*]] = fir.call @_FortranAGetCommand(%[[VAL_6]], %[[VAL_2]], %[[VAL_3]], %{{.*}}, %{{.*}}) : (!fir.box, !fir.box, !fir.box, !fir.ref, 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) -> !fir.box +! CHECK: %[[VAL_2:.*]] = fir.absent !fir.box +! CHECK: %[[VAL_3:.*]] = fir.absent !fir.box +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_1]] : (!fir.box) -> !fir.box +! CHECK: %[[VAL_8:.*]] = fir.call @_FortranAGetCommand(%[[VAL_2]], %[[VAL_6]], %[[VAL_3]], %{{.*}}, %{{.*}}) : (!fir.box, !fir.box, !fir.box, !fir.ref, 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.box> +! CHECK: %[[VAL_3:.*]] = fir.absent !fir.box +! CHECK: %[[VAL_4:.*]] = fir.absent !fir.box +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_9:.*]] = fir.call @_FortranAGetCommand(%[[VAL_7]], %[[VAL_3]], %[[VAL_4]], %{{.*}}, %{{.*}}) : (!fir.box, !fir.box, !fir.box, !fir.ref, i32) -> i32 +! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_1]] : (!fir.ref) -> 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 +! 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.box> +! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_1]] : (!fir.ref>) -> !fir.box> +! CHECK: %[[VAL_4:.*]] = fir.absent !fir.box +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_3]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_10:.*]] = fir.call @_FortranAGetCommand(%[[VAL_7]], %[[VAL_4]], %[[VAL_8]], %{{.*}}, %{{.*}}) : (!fir.box, !fir.box, !fir.box, !fir.ref, 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.box> +! CHECK: %[[VAL_3:.*]] = fir.absent !fir.box +! CHECK: %[[VAL_4:.*]] = fir.absent !fir.box +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_9:.*]] = fir.call @_FortranAGetCommand(%[[VAL_7]], %[[VAL_3]], %[[VAL_4]], %{{.*}}, %{{.*}}) : (!fir.box, !fir.box, !fir.box, !fir.ref, i32) -> i32 +! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_1]] : (!fir.ref) -> 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 +! 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.box> +! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_2]] : (!fir.ref) -> !fir.box +! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_1]] : (!fir.ref>) -> !fir.box> +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_4]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_5]] : (!fir.box) -> !fir.box +! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_6]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_13:.*]] = fir.call @_FortranAGetCommand(%[[VAL_9]], %[[VAL_10]], %[[VAL_11]], %{{.*}}, %{{.*}}) : (!fir.box, !fir.box, !fir.box, !fir.ref, i32) -> i32 +! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_3]] : (!fir.ref) -> 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 +! CHECK: } +! CHECK: return +! CHECK: } + +subroutine all_args() + character(10) :: cmd + character(50) :: err + integer :: len, stat + call get_command(cmd, len, stat, err) +end