Skip to content

Commit 86ea67e

Browse files
PeixinQiaoPeixinQiao
committed
[flang] Support lowering of intrinsic GET_COMMAND
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. Reviewed By: PeteSteinfeld, jeanPerier Differential Revision: https://reviews.llvm.org/D137887
1 parent 9d90cf2 commit 86ea67e

File tree

4 files changed

+193
-0
lines changed

4 files changed

+193
-0
lines changed

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

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,14 @@ namespace fir::runtime {
2323
/// Generate call to COMMAND_ARGUMENT_COUNT intrinsic runtime routine.
2424
mlir::Value genCommandArgumentCount(fir::FirOpBuilder &, mlir::Location);
2525

26+
/// Generate a call to the GetCommand runtime function which implements the
27+
/// GET_COMMAND intrinsic.
28+
/// \p command, \p length and \p errmsg must be fir.box that can be absent (but
29+
/// not null mlir values). The status value is returned.
30+
mlir::Value genGetCommand(fir::FirOpBuilder &, mlir::Location,
31+
mlir::Value command, mlir::Value length,
32+
mlir::Value errmsg);
33+
2634
/// Generate a call to the GetCommandArgument runtime function which implements
2735
/// the GET_COMMAND_ARGUMENT intrinsic.
2836
/// \p value, \p length and \p errmsg must be fir.box that can be absent (but

‎flang/lib/Lower/IntrinsicCall.cpp

Lines changed: 46 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -505,6 +505,7 @@ struct IntrinsicLibrary {
505505
mlir::Value genFloor(mlir::Type, llvm::ArrayRef<mlir::Value>);
506506
mlir::Value genFraction(mlir::Type resultType,
507507
mlir::ArrayRef<mlir::Value> args);
508+
void genGetCommand(mlir::ArrayRef<fir::ExtendedValue> args);
508509
void genGetCommandArgument(mlir::ArrayRef<fir::ExtendedValue> args);
509510
void genGetEnvironmentVariable(llvm::ArrayRef<fir::ExtendedValue>);
510511
fir::ExtendedValue genIall(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
@@ -802,6 +803,13 @@ static constexpr IntrinsicHandler handlers[]{
802803
{"exponent", &I::genExponent},
803804
{"floor", &I::genFloor},
804805
{"fraction", &I::genFraction},
806+
{"get_command",
807+
&I::genGetCommand,
808+
{{{"command", asBox, handleDynamicOptional},
809+
{"length", asBox, handleDynamicOptional},
810+
{"status", asAddr, handleDynamicOptional},
811+
{"errmsg", asBox, handleDynamicOptional}}},
812+
/*isElemental=*/false},
805813
{"get_command_argument",
806814
&I::genGetCommandArgument,
807815
{{{"number", asValue},
@@ -3188,6 +3196,44 @@ mlir::Value IntrinsicLibrary::genFraction(mlir::Type resultType,
31883196
fir::runtime::genFraction(builder, loc, fir::getBase(args[0])));
31893197
}
31903198

3199+
// GET_COMMAND
3200+
void IntrinsicLibrary::genGetCommand(llvm::ArrayRef<fir::ExtendedValue> args) {
3201+
assert(args.size() == 4);
3202+
const fir::ExtendedValue &command = args[0];
3203+
const fir::ExtendedValue &length = args[1];
3204+
const fir::ExtendedValue &status = args[2];
3205+
const fir::ExtendedValue &errmsg = args[3];
3206+
3207+
// If none of the optional parameters are present, do nothing.
3208+
if (!isStaticallyPresent(command) && !isStaticallyPresent(length) &&
3209+
!isStaticallyPresent(status) && !isStaticallyPresent(errmsg))
3210+
return;
3211+
3212+
mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
3213+
mlir::Value commandBox =
3214+
isStaticallyPresent(command)
3215+
? fir::getBase(command)
3216+
: builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3217+
mlir::Value lenBox =
3218+
isStaticallyPresent(length)
3219+
? fir::getBase(length)
3220+
: builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3221+
mlir::Value errBox =
3222+
isStaticallyPresent(errmsg)
3223+
? fir::getBase(errmsg)
3224+
: builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
3225+
mlir::Value stat =
3226+
fir::runtime::genGetCommand(builder, loc, commandBox, lenBox, errBox);
3227+
if (isStaticallyPresent(status)) {
3228+
mlir::Value statAddr = fir::getBase(status);
3229+
mlir::Value statIsPresentAtRuntime =
3230+
builder.genIsNotNullAddr(loc, statAddr);
3231+
builder.genIfThen(loc, statIsPresentAtRuntime)
3232+
.genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); })
3233+
.end();
3234+
}
3235+
}
3236+
31913237
// GET_COMMAND_ARGUMENT
31923238
void IntrinsicLibrary::genGetCommandArgument(
31933239
llvm::ArrayRef<fir::ExtendedValue> args) {

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

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,22 @@ mlir::Value fir::runtime::genCommandArgumentCount(fir::FirOpBuilder &builder,
3232
return builder.create<fir::CallOp>(loc, argumentCountFunc).getResult(0);
3333
}
3434

35+
mlir::Value fir::runtime::genGetCommand(fir::FirOpBuilder &builder,
36+
mlir::Location loc, mlir::Value command,
37+
mlir::Value length,
38+
mlir::Value errmsg) {
39+
auto runtimeFunc =
40+
fir::runtime::getRuntimeFunc<mkRTKey(GetCommand)>(loc, builder);
41+
mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();
42+
mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
43+
mlir::Value sourceLine =
44+
fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(4));
45+
llvm::SmallVector<mlir::Value> args =
46+
fir::runtime::createArguments(builder, loc, runtimeFuncTy, command,
47+
length, errmsg, sourceFile, sourceLine);
48+
return builder.create<fir::CallOp>(loc, runtimeFunc, args).getResult(0);
49+
}
50+
3551
mlir::Value fir::runtime::genGetCommandArgument(
3652
fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value number,
3753
mlir::Value value, mlir::Value length, mlir::Value errmsg) {

‎flang/test/Lower/Intrinsics/get_command.f90

Lines changed: 123 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,123 @@
1+
! RUN: bbc -emit-fir %s -o - | FileCheck %s
2+
3+
! CHECK-LABEL: func.func @_QPcommand_only() {
4+
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "cmd", uniq_name = "_QFcommand_onlyEcmd"}
5+
! CHECK: %[[VAL_1:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.char<1,10>>
6+
! CHECK: %[[VAL_2:.*]] = fir.absent !fir.box<none>
7+
! CHECK: %[[VAL_3:.*]] = fir.absent !fir.box<none>
8+
! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_1]] : (!fir.box<!fir.char<1,10>>) -> !fir.box<none>
9+
! 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
10+
! CHECK: return
11+
! CHECK: }
12+
13+
subroutine command_only()
14+
character(10) :: cmd
15+
call get_command(cmd)
16+
end
17+
18+
! CHECK-LABEL: func.func @_QPlength_only() {
19+
! CHECK: %[[VAL_0:.*]] = fir.alloca i32 {bindc_name = "len", uniq_name = "_QFlength_onlyElen"}
20+
! CHECK: %[[VAL_1:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<i32>) -> !fir.box<i32>
21+
! CHECK: %[[VAL_2:.*]] = fir.absent !fir.box<none>
22+
! CHECK: %[[VAL_3:.*]] = fir.absent !fir.box<none>
23+
! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_1]] : (!fir.box<i32>) -> !fir.box<none>
24+
! 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
25+
! CHECK: return
26+
! CHECK: }
27+
28+
subroutine length_only()
29+
integer :: len
30+
call get_command(length=len)
31+
end
32+
33+
! CHECK-LABEL: func.func @_QPstatus_only() {
34+
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "cmd", uniq_name = "_QFstatus_onlyEcmd"}
35+
! CHECK: %[[VAL_1:.*]] = fir.alloca i32 {bindc_name = "stat", uniq_name = "_QFstatus_onlyEstat"}
36+
! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.char<1,10>>
37+
! CHECK: %[[VAL_3:.*]] = fir.absent !fir.box<none>
38+
! CHECK: %[[VAL_4:.*]] = fir.absent !fir.box<none>
39+
! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (!fir.box<!fir.char<1,10>>) -> !fir.box<none>
40+
! 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
41+
! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<i32>) -> i64
42+
! CHECK: %[[VAL_11:.*]] = arith.constant 0 : i64
43+
! CHECK: %[[VAL_12:.*]] = arith.cmpi ne, %[[VAL_10]], %[[VAL_11]] : i64
44+
! CHECK: fir.if %[[VAL_12]] {
45+
! CHECK: fir.store %[[VAL_9]] to %[[VAL_1]] : !fir.ref<i32>
46+
! CHECK: }
47+
! CHECK: return
48+
! CHECK: }
49+
50+
subroutine status_only()
51+
character(10) :: cmd
52+
integer :: stat
53+
call get_command(cmd, status=stat)
54+
end
55+
56+
! CHECK-LABEL: func.func @_QPerrmsg_only() {
57+
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "cmd", uniq_name = "_QFerrmsg_onlyEcmd"}
58+
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.char<1,50> {bindc_name = "err", uniq_name = "_QFerrmsg_onlyEerr"}
59+
! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.char<1,10>>
60+
! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_1]] : (!fir.ref<!fir.char<1,50>>) -> !fir.box<!fir.char<1,50>>
61+
! CHECK: %[[VAL_4:.*]] = fir.absent !fir.box<none>
62+
! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (!fir.box<!fir.char<1,10>>) -> !fir.box<none>
63+
! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_3]] : (!fir.box<!fir.char<1,50>>) -> !fir.box<none>
64+
! 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
65+
! CHECK: return
66+
! CHECK: }
67+
68+
subroutine errmsg_only()
69+
character(10) :: cmd
70+
character(50) :: err
71+
call get_command(cmd, errmsg=err)
72+
end
73+
74+
! CHECK-LABEL: func.func @_QPcommand_status() {
75+
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "cmd", uniq_name = "_QFcommand_statusEcmd"}
76+
! CHECK: %[[VAL_1:.*]] = fir.alloca i32 {bindc_name = "stat", uniq_name = "_QFcommand_statusEstat"}
77+
! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.char<1,10>>
78+
! CHECK: %[[VAL_3:.*]] = fir.absent !fir.box<none>
79+
! CHECK: %[[VAL_4:.*]] = fir.absent !fir.box<none>
80+
! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (!fir.box<!fir.char<1,10>>) -> !fir.box<none>
81+
! 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
82+
! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<i32>) -> i64
83+
! CHECK: %[[VAL_11:.*]] = arith.constant 0 : i64
84+
! CHECK: %[[VAL_12:.*]] = arith.cmpi ne, %[[VAL_10]], %[[VAL_11]] : i64
85+
! CHECK: fir.if %[[VAL_12]] {
86+
! CHECK: fir.store %[[VAL_9]] to %[[VAL_1]] : !fir.ref<i32>
87+
! CHECK: }
88+
! CHECK: return
89+
! CHECK: }
90+
91+
subroutine command_status()
92+
character(10) :: cmd
93+
integer :: stat
94+
call get_command(cmd, status=stat)
95+
end
96+
97+
! CHECK-LABEL: func.func @_QPall_args() {
98+
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "cmd", uniq_name = "_QFall_argsEcmd"}
99+
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.char<1,50> {bindc_name = "err", uniq_name = "_QFall_argsEerr"}
100+
! CHECK: %[[VAL_2:.*]] = fir.alloca i32 {bindc_name = "len", uniq_name = "_QFall_argsElen"}
101+
! CHECK: %[[VAL_3:.*]] = fir.alloca i32 {bindc_name = "stat", uniq_name = "_QFall_argsEstat"}
102+
! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.char<1,10>>
103+
! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_2]] : (!fir.ref<i32>) -> !fir.box<i32>
104+
! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_1]] : (!fir.ref<!fir.char<1,50>>) -> !fir.box<!fir.char<1,50>>
105+
! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_4]] : (!fir.box<!fir.char<1,10>>) -> !fir.box<none>
106+
! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_5]] : (!fir.box<i32>) -> !fir.box<none>
107+
! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.char<1,50>>) -> !fir.box<none>
108+
! 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
109+
! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i32>) -> i64
110+
! CHECK: %[[VAL_15:.*]] = arith.constant 0 : i64
111+
! CHECK: %[[VAL_16:.*]] = arith.cmpi ne, %[[VAL_14]], %[[VAL_15]] : i64
112+
! CHECK: fir.if %[[VAL_16]] {
113+
! CHECK: fir.store %[[VAL_13]] to %[[VAL_3]] : !fir.ref<i32>
114+
! CHECK: }
115+
! CHECK: return
116+
! CHECK: }
117+
118+
subroutine all_args()
119+
character(10) :: cmd
120+
character(50) :: err
121+
integer :: len, stat
122+
call get_command(cmd, len, stat, err)
123+
end

0 commit comments

Comments
 (0)