mirrors/llvm-project
0
0
Fork 0
mirror of https://github.com/llvm/llvm-project.git synced 2025-04-24 19:46:07 +00:00
Code Issues Projects Releases Wiki Activity

[flang] add procedure flags to fir.dispatch (#110970)

Browse Source 
Currently, it is not possible to distinguish between BIND(C) from
non-BIND(C) type bound procedure call at the FIR level.
This will be a problem when dealing with derived type BIND(C) function
where the ABI differ between BIND(C)/non-BIND(C) but the FIR signature
looks like the same at the FIR level.

Fix this by adding the Fortran procedure attributes to fir.distpatch,
and propagating it until the related fir.call is generated in
fir.dispatch codegen.
This commit is contained in:
jeanPerier 2024-10-03 17:10:03 +02:00 committed by GitHub
parent 79b32bcda6
commit a78359c2ed
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
8 changed files with 46 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
flang/include/flang/Optimizer/Dialect/FIROps.td
View File

@ -2516,7 +2516,8 @@ def fir_DispatchOp : fir_Op<"dispatch", []> {
StrAttr:$method,
fir_ClassType:$object,
Variadic<AnyType>:$args,
OptionalAttr<I32Attr>:$pass_arg_pos
OptionalAttr<I32Attr>:$pass_arg_pos,
OptionalAttr<fir_FortranProcedureFlagsAttr>:$procedure_attrs
);
let results = (outs Variadic<AnyType>:$results);
@ -2525,7 +2526,8 @@ def fir_DispatchOp : fir_Op<"dispatch", []> {
let assemblyFormat = [{
$method `(` $object `:` qualified(type($object)) `)`
( `(` $args^ `:` type($args) `)` )? (`->` type($results)^)? attr-dict
( `(` $args^ `:` type($args) `)` )? (`->` type($results)^)?
(`proc_attrs` $procedure_attrs^)? attr-dict
}];
let extraClassDeclaration = [{

8
flang/lib/Lower/ConvertCall.cpp
View File

@ -523,6 +523,8 @@ std::pair<fir::ExtendedValue, bool> Fortran::lower::genCallOpAndResult(
mlir::Value callResult;
unsigned callNumResults;
fir::FortranProcedureFlagsEnumAttr procAttrs =
caller.getProcedureAttrs(builder.getContext());
if (!caller.getCallDescription().chevrons().empty()) {
// A call to a CUDA kernel with the chevron syntax.
@ -610,7 +612,7 @@ std::pair<fir::ExtendedValue, bool> Fortran::lower::genCallOpAndResult(
dispatch = builder.create<fir::DispatchOp>(
loc, funcType.getResults(), builder.getStringAttr(procName),
caller.getInputs()[*passArg], operands,
builder.getI32IntegerAttr(*passArg));
builder.getI32IntegerAttr(*passArg), procAttrs);
} else {
// NOPASS
const Fortran::evaluate::Component *component =
@ -625,15 +627,13 @@ std::pair<fir::ExtendedValue, bool> Fortran::lower::genCallOpAndResult(
passObject = builder.create<fir::LoadOp>(loc, passObject);
dispatch = builder.create<fir::DispatchOp>(
loc, funcType.getResults(), builder.getStringAttr(procName),
passObject, operands, nullptr);
passObject, operands, nullptr, procAttrs);
}
callNumResults = dispatch.getNumResults();
if (callNumResults != 0)
callResult = dispatch.getResult(0);
} else {
// Standard procedure call with fir.call.
fir::FortranProcedureFlagsEnumAttr procAttrs =
caller.getProcedureAttrs(builder.getContext());
auto call = builder.create<fir::CallOp>(
loc, funcType.getResults(), funcSymbolAttr, operands, procAttrs);

3
flang/lib/Optimizer/CodeGen/TargetRewrite.cpp
View File

@ -507,7 +507,8 @@ public:
fir::DispatchOp dispatchOp = rewriter->create<A>(
loc, newResTys, rewriter->getStringAttr(callOp.getMethod()),
callOp.getOperands()[0], newOpers,
rewriter->getI32IntegerAttr(*callOp.getPassArgPos() + passArgShift));
rewriter->getI32IntegerAttr(*callOp.getPassArgPos() + passArgShift),
callOp.getProcedureAttrsAttr());
if (wrap)
newCallResults.push_back((*wrap)(dispatchOp.getOperation()));
else

17
flang/lib/Optimizer/Transforms/AbstractResult.cpp
View File

@ -154,17 +154,14 @@ public:
newOperands.emplace_back(arg);
unsigned passArgShift = newOperands.size();
newOperands.append(op.getOperands().begin() + 1, op.getOperands().end());
fir::DispatchOp newDispatchOp;
mlir::IntegerAttr passArgPos;
if (op.getPassArgPos())
newOp = rewriter.create<fir::DispatchOp>(
loc, newResultTypes, rewriter.getStringAttr(op.getMethod()),
op.getOperands()[0], newOperands,
rewriter.getI32IntegerAttr(*op.getPassArgPos() + passArgShift));
else
newOp = rewriter.create<fir::DispatchOp>(
loc, newResultTypes, rewriter.getStringAttr(op.getMethod()),
op.getOperands()[0], newOperands, nullptr);
passArgPos =
rewriter.getI32IntegerAttr(*op.getPassArgPos() + passArgShift);
newOp = rewriter.create<fir::DispatchOp>(
loc, newResultTypes, rewriter.getStringAttr(op.getMethod()),
op.getOperands()[0], newOperands, passArgPos,
op.getProcedureAttrsAttr());
}
if (isResultBuiltinCPtr) {

6
flang/lib/Optimizer/Transforms/PolymorphicOpConversion.cpp
View File

@ -205,10 +205,8 @@ struct DispatchOpConv : public OpConversionPattern<fir::DispatchOp> {
// Make the call.
llvm::SmallVector<mlir::Value> args{funcPtr};
args.append(dispatch.getArgs().begin(), dispatch.getArgs().end());
// FIXME: add procedure_attrs to fir.dispatch and propagate to fir.call.
rewriter.replaceOpWithNewOp<fir::CallOp>(
dispatch, resTypes, nullptr, args,
/*procedure_attrs=*/fir::FortranProcedureFlagsEnumAttr{});
rewriter.replaceOpWithNewOp<fir::CallOp>(dispatch, resTypes, nullptr, args,
dispatch.getProcedureAttrsAttr());
return mlir::success();
}

21
flang/test/Fir/dispatch.f90
View File

@ -18,6 +18,7 @@ module dispatch1
procedure :: proc_with_values => proc_p1
procedure, nopass :: proc_nopass => proc_nopass_p1
procedure, pass(this) :: proc_pass => proc_pass_p1
procedure, nopass :: z_proc_nopass_bindc => proc_nopass_bindc_p1
end type
type, extends(p1) :: p2
@ -30,6 +31,7 @@ module dispatch1
procedure :: proc_with_values => proc_p2
procedure, nopass :: proc_nopass => proc_nopass_p2
procedure, pass(this) :: proc_pass => proc_pass_p2
procedure, nopass :: z_proc_nopass_bindc => proc_nopass_bindc_p2
end type
type, abstract :: a1
@ -118,16 +120,24 @@ contains
print*, 'call proc_nopass_p2'
end subroutine
subroutine proc_nopass_bindc_p1() bind(c)
print*, 'call proc_nopass_bindc_p1'
end subroutine
subroutine proc_nopass_bindc_p2() bind(c)
print*, 'call proc_nopass_bindc_p2'
end subroutine
subroutine proc_pass_p1(i, this)
integer :: i
class(p1) :: this
print*, 'call proc_nopass_p1'
print*, 'call proc_pass_p1'
end subroutine
subroutine proc_pass_p2(i, this)
integer :: i
class(p2) :: this
print*, 'call proc_nopass_p2'
print*, 'call proc_pass_p2'
end subroutine
subroutine display_class(p)
@ -140,6 +150,7 @@ contains
call p%proc_with_values(2.5)
call p%proc_nopass()
call p%proc_pass(1)
call p%z_proc_nopass_bindc()
end subroutine
subroutine no_pass_array(a)
@ -297,6 +308,10 @@ end
! CHECK: %[[FUNC_PTR:.*]] = fir.convert %[[FUNC_ADDR]] : (i64) -> ((!fir.ref<i32>, [[CLASS]]) -> ())
! CHECK: fir.call %[[FUNC_PTR]](%{{.*}}, %[[ARG_DECL]]#0) : (!fir.ref<i32>, [[CLASS]]) -> ()
! Test attributes are propagated from fir.dispatch to fir.call
! for `call p%z_proc_nopass_bindc()`
! CHECK: fir.call %{{.*}}() proc_attrs<bind_c> : () -> ()
! CHECK-LABEL: _QMdispatch1Pno_pass_array
! CHECK-LABEL: _QMdispatch1Pno_pass_array_allocatable
! CHECK-LABEL: _QMdispatch1Pno_pass_array_pointer
@ -316,6 +331,7 @@ end
! BT: fir.dt_entry "proc_nopass", @_QMdispatch1Pproc_nopass_p1
! BT: fir.dt_entry "proc_pass", @_QMdispatch1Pproc_pass_p1
! BT: fir.dt_entry "proc_with_values", @_QMdispatch1Pproc_p1
! BT: fir.dt_entry "z_proc_nopass_bindc", @proc_nopass_bindc_p1
! BT: }
! BT-LABEL: fir.type_info @_QMdispatch1Ta1
@ -334,5 +350,6 @@ end
! BT: fir.dt_entry "proc_nopass", @_QMdispatch1Pproc_nopass_p2
! BT: fir.dt_entry "proc_pass", @_QMdispatch1Pproc_pass_p2
! BT: fir.dt_entry "proc_with_values", @_QMdispatch1Pproc_p2
! BT: fir.dt_entry "z_proc_nopass_bindc", @proc_nopass_bindc_p2
! BT: fir.dt_entry "display3", @_QMdispatch1Pdisplay3
! BT: }

4
flang/test/Fir/fir-ops.fir
View File

@ -805,8 +805,8 @@ func.func private @dispatch(%arg0: !fir.class<!fir.type<dispatch_derived1{a:i32,
fir.dispatch "proc1"(%arg0 : !fir.class<!fir.type<dispatch_derived1{a:i32,b:i32}>>) (%arg0 : !fir.class<!fir.type<dispatch_derived1{a:i32,b:i32}>>) {pass_arg_pos = 0 : i32}
// CHECK: fir.dispatch "proc1"(%[[CLASS]] : !fir.class<!fir.type<dispatch_derived1{a:i32,b:i32}>>) (%[[CLASS]] : !fir.class<!fir.type<dispatch_derived1{a:i32,b:i32}>>) {pass_arg_pos = 0 : i32}
fir.dispatch "proc2"(%arg0 : !fir.class<!fir.type<dispatch_derived1{a:i32,b:i32}>>)
// CHECK: fir.dispatch "proc2"(%[[CLASS]] : !fir.class<!fir.type<dispatch_derived1{a:i32,b:i32}>>)
fir.dispatch "proc2"(%arg0 : !fir.class<!fir.type<dispatch_derived1{a:i32,b:i32}>>) proc_attrs<pure>
// CHECK: fir.dispatch "proc2"(%[[CLASS]] : !fir.class<!fir.type<dispatch_derived1{a:i32,b:i32}>>) proc_attrs <pure>
fir.dispatch "proc3"(%arg0 : !fir.class<!fir.type<dispatch_derived1{a:i32,b:i32}>>) (%arg1, %arg0 : i32, !fir.class<!fir.type<dispatch_derived1{a:i32,b:i32}>>) {pass_arg_pos = 1 : i32}
// CHECK: fir.dispatch "proc3"(%[[CLASS]] : !fir.class<!fir.type<dispatch_derived1{a:i32,b:i32}>>) (%[[INTARG]], %[[CLASS]] : i32, !fir.class<!fir.type<dispatch_derived1{a:i32,b:i32}>>) {pass_arg_pos = 1 : i32}

12
flang/test/Lower/polymorphic.f90
View File

@ -578,7 +578,7 @@ module polymorphic_test
! CHECK: %[[LOOP_RES:.*]] = fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD_TMP]]) -> (!fir.array<5xi32>) {
! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.class<!fir.array<5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] source_box %[[P]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.class<!fir.array<5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
! CHECK: %[[RES:.*]] = fir.dispatch "elemental_fct"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> i32 {pass_arg_pos = 0 : i32}
! CHECK: %[[RES:.*]] = fir.dispatch "elemental_fct"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> i32 proc_attrs <elemental, pure> {pass_arg_pos = 0 : i32}
! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %[[RES]], %[[IND]] : (!fir.array<5xi32>, i32, index) -> !fir.array<5xi32>
! CHECK: fir.result %[[ARR_UP]] : !fir.array<5xi32>
! CHECK: }
@ -609,7 +609,7 @@ module polymorphic_test
! CHECK: %[[LOOP_RES0:.*]] = fir.do_loop %[[IND1:.*]] = %[[C0]] to %[[UB0]] step %[[C1]] unordered iter_args(%[[ARG0:.*]] = %[[ARG]]) -> (!fir.array<5x5xi32>) {
! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND1]], %[[IND0]] : (!fir.class<!fir.array<5x5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] source_box %[[P]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.class<!fir.array<5x5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
! CHECK: %[[RES:.*]] = fir.dispatch "elemental_fct"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> i32 {pass_arg_pos = 0 : i32}
! CHECK: %[[RES:.*]] = fir.dispatch "elemental_fct"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> i32 proc_attrs <elemental, pure> {pass_arg_pos = 0 : i32}
! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG0]], %[[RES]], %[[IND1]], %[[IND0]] : (!fir.array<5x5xi32>, i32, index, index) -> !fir.array<5x5xi32>
! CHECK: fir.result %[[ARR_UP]] : !fir.array<5x5xi32>
! CHECK: }
@ -663,7 +663,7 @@ module polymorphic_test
! CHECK: fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] {
! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.class<!fir.array<10x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] source_box %[[P]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.class<!fir.array<10x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
! CHECK: fir.dispatch "elemental_sub"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) {pass_arg_pos = 0 : i32}
! CHECK: fir.dispatch "elemental_sub"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) proc_attrs <elemental, pure> {pass_arg_pos = 0 : i32}
! CHECK: }
! CHECK: %[[C1:.*]] = arith.constant 1 : index
! CHECK: %[[C0:.*]] = arith.constant 0 : index
@ -671,7 +671,7 @@ module polymorphic_test
! CHECK: fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] {
! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.class<!fir.array<10x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] source_box %[[P]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.class<!fir.array<10x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
! CHECK: fir.dispatch "elemental_sub_pass"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%{{.*}}, %[[EMBOXED]] : !fir.ref<i32>, !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) {pass_arg_pos = 1 : i32}
! CHECK: fir.dispatch "elemental_sub_pass"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%{{.*}}, %[[EMBOXED]] : !fir.ref<i32>, !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) proc_attrs <elemental, pure> {pass_arg_pos = 1 : i32}
! CHECK: }
subroutine test_elemental_sub_array_assumed(t)
@ -718,7 +718,7 @@ module polymorphic_test
! CHECK: fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] {
! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] source_box %[[P]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
! CHECK: fir.dispatch "elemental_sub"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) {pass_arg_pos = 0 : i32}
! CHECK: fir.dispatch "elemental_sub"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) proc_attrs <elemental, pure> {pass_arg_pos = 0 : i32}
! CHECK: }
! CHECK: %[[C0:.*]] = arith.constant 0 : index
! CHECK: %[[P_DIMS:.*]]:3 = fir.box_dims %[[P]], %[[C0]] : (!fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> (index, index, index)
@ -728,7 +728,7 @@ module polymorphic_test
! CHECK: fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] {
! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] source_box %[[P]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
! CHECK: fir.dispatch "elemental_sub_pass"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%{{.*}}, %[[EMBOXED]] : !fir.ref<i32>, !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) {pass_arg_pos = 1 : i32}
! CHECK: fir.dispatch "elemental_sub_pass"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%{{.*}}, %[[EMBOXED]] : !fir.ref<i32>, !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) proc_attrs <elemental, pure> {pass_arg_pos = 1 : i32}
! CHECK: }
subroutine write_p1(dtv, unit, iotype, v_list, iostat, iomsg)