Skip to content

Commit 1a3ab4a

Browse files
authored
Merge pull request #1007 from flang-compiler/jpr-derived-array-assign
Lower derived array assignments and improve derived scalar assignments
2 parents 31c0214 + de7bbdd commit 1a3ab4a

File tree

9 files changed

+296
-112
lines changed

9 files changed

+296
-112
lines changed

flang/include/flang/Optimizer/Builder/FIRBuilder.h

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,9 @@ class FirOpBuilder : public mlir::OpBuilder {
3939
public:
4040
explicit FirOpBuilder(mlir::Operation *op, const fir::KindMapping &kindMap)
4141
: OpBuilder{op}, kindMap{kindMap} {}
42+
explicit FirOpBuilder(mlir::OpBuilder &builder,
43+
const fir::KindMapping &kindMap)
44+
: OpBuilder{builder}, kindMap{kindMap} {}
4245

4346
/// Get the current Region of the insertion point.
4447
mlir::Region &getRegion() { return *getBlock()->getParent(); }
@@ -422,6 +425,12 @@ fir::ExtendedValue componentToExtendedValue(fir::FirOpBuilder &builder,
422425
mlir::Location loc,
423426
mlir::Value component);
424427

428+
/// Assign \p rhs to \p lhs. Both \p rhs and \p lhs must be scalar derived
429+
/// types. The assignment follows Fortran intrinsic assignment semantic for
430+
/// derived types (10.2.1.3 point 13).
431+
void genRecordAssignment(fir::FirOpBuilder &builder, mlir::Location loc,
432+
const fir::ExtendedValue &lhs,
433+
const fir::ExtendedValue &rhs);
425434
} // namespace fir::factory
426435

427436
#endif // FORTRAN_OPTIMIZER_BUILDER_FIRBUILDER_H
Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,32 @@
1+
//===-- Assign.h - generate assignment runtime API calls ----*- C++ -*-===//
2+
//
3+
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4+
// See https://llvm.org/LICENSE.txt for license information.
5+
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6+
//
7+
//===----------------------------------------------------------------------===//
8+
9+
#ifndef FORTRAN_OPTIMIZER_RUNTIME_ASSIGN_H
10+
#define FORTRAN_OPTIMIZER_RUNTIME_ASSIGN_H
11+
12+
namespace mlir {
13+
class Value;
14+
class Location;
15+
} // namespace mlir
16+
17+
namespace fir {
18+
class FirOpBuilder;
19+
}
20+
21+
namespace fir::runtime {
22+
23+
/// Generate runtime call to assign \p sourceBox to \p destBox.
24+
/// \p destBox must be a fir.ref<fir.box<T>> and \p sourceBox a fir.box<T>.
25+
/// \p destBox Fortran descriptor may be modified if destBox is an allocatable
26+
/// according to Fortran allocatable assignment rules, otherwise it is not
27+
/// modified.
28+
void genAssign(fir::FirOpBuilder &builder, mlir::Location loc,
29+
mlir::Value destBox, mlir::Value sourceBox);
30+
31+
} // namespace fir::runtime
32+
#endif // FORTRAN_OPTIMIZER_RUNTIME_ASSIGN_H

flang/lib/Lower/Bridge.cpp

Lines changed: 1 addition & 64 deletions
Original file line numberDiff line numberDiff line change
@@ -1729,69 +1729,6 @@ class FirConverter : public Fortran::lower::AbstractConverter {
17291729
!Fortran::evaluate::HasVectorSubscript(expr);
17301730
}
17311731

1732-
// Recursively assign members of a record type.
1733-
void genRecordAssignment(const fir::ExtendedValue &lhs,
1734-
const fir::ExtendedValue &rhs,
1735-
Fortran::lower::StatementContext &stmtCtx) {
1736-
auto loc = genLocation();
1737-
auto baseTy = fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(lhs).getType());
1738-
assert(baseTy && "must be a memory type");
1739-
auto lhsTy = baseTy.dyn_cast<fir::RecordType>();
1740-
assert(lhsTy && "must be a record type");
1741-
auto fieldTy = fir::FieldType::get(lhsTy.getContext());
1742-
for (auto [fldName, fldType] : lhsTy.getTypeList()) {
1743-
mlir::Value field = builder->create<fir::FieldIndexOp>(
1744-
loc, fieldTy, fldName, lhsTy, fir::getTypeParams(lhs));
1745-
auto fldRefTy = builder->getRefType(fldType);
1746-
auto fromCoor = builder->create<fir::CoordinateOp>(
1747-
loc, fldRefTy, fir::getBase(rhs), field);
1748-
auto from =
1749-
fir::factory::componentToExtendedValue(*builder, loc, fromCoor);
1750-
auto toCoor = builder->create<fir::CoordinateOp>(
1751-
loc, fldRefTy, fir::getBase(lhs), field);
1752-
auto to = fir::factory::componentToExtendedValue(*builder, loc, toCoor);
1753-
to.match(
1754-
[&](const fir::UnboxedValue &toPtr) {
1755-
// FIXME: this is incorrect after F95 to simply load/store derived
1756-
// type since they may have allocatable components that require
1757-
// deep-copy or may have defined assignment procedures.
1758-
auto loadVal =
1759-
builder->create<fir::LoadOp>(loc, fir::getBase(from));
1760-
builder->create<fir::StoreOp>(loc, loadVal, toPtr);
1761-
},
1762-
[&](const fir::CharBoxValue &) {
1763-
fir::factory::CharacterExprHelper{*builder, loc}.createAssign(to,
1764-
from);
1765-
},
1766-
[&](const fir::ArrayBoxValue &) {
1767-
Fortran::lower::createSomeArrayAssignment(*this, to, from,
1768-
localSymbols, stmtCtx);
1769-
},
1770-
[&](const fir::CharArrayBoxValue &) {
1771-
Fortran::lower::createSomeArrayAssignment(*this, to, from,
1772-
localSymbols, stmtCtx);
1773-
},
1774-
[&](const fir::BoxValue &toBox) {
1775-
fir::emitFatalError(loc, "derived type components must not be "
1776-
"represented by fir::BoxValue");
1777-
},
1778-
[&](const fir::MutableBoxValue &toBox) {
1779-
if (toBox.isPointer()) {
1780-
// Copy association status by copying the fir.box.
1781-
auto loadVal =
1782-
builder->create<fir::LoadOp>(loc, fir::getBase(from));
1783-
builder->create<fir::StoreOp>(loc, loadVal, fir::getBase(to));
1784-
return;
1785-
}
1786-
// For allocatable components, a deep copy is needed.
1787-
TODO(loc, "allocatable components in derived type assignment");
1788-
},
1789-
[&](const fir::ProcBoxValue &toBox) {
1790-
TODO(loc, "procedure pointer component in derived type assignment");
1791-
});
1792-
}
1793-
}
1794-
17951732
[[maybe_unused]] static bool
17961733
isFuncResultDesignator(const Fortran::lower::SomeExpr &expr) {
17971734
const auto *sym = Fortran::evaluate::GetFirstSymbol(expr);
@@ -1892,7 +1829,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
18921829
if (isDerivedCategory(lhsType->category())) {
18931830
// Fortran 2018 10.2.1.3 p13 and p14
18941831
// Recursively gen an assignment on each element pair.
1895-
genRecordAssignment(lhs, rhs, stmtCtx);
1832+
fir::factory::genRecordAssignment(*builder, loc, lhs, rhs);
18961833
return;
18971834
}
18981835
llvm_unreachable("unknown category");

flang/lib/Optimizer/Builder/FIRBuilder.cpp

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@
1414
#include "flang/Optimizer/Builder/MutableBox.h"
1515
#include "flang/Optimizer/Dialect/FIRAttr.h"
1616
#include "flang/Optimizer/Dialect/FIROpsSupport.h"
17+
#include "flang/Optimizer/Runtime/Assign.h"
1718
#include "flang/Optimizer/Support/FatalError.h"
1819
#include "flang/Optimizer/Support/InternalNames.h"
1920
#include "mlir/Dialect/OpenMP/OpenMPDialect.h"
@@ -740,3 +741,56 @@ fir::ExtendedValue fir::factory::componentToExtendedValue(
740741
return fir::ArrayBoxValue{component, extents};
741742
return component;
742743
}
744+
745+
/// Can the assignment of this record type be implement with a simple memory
746+
/// copy ?
747+
static bool recordTypeCanBeMemCopied(fir::RecordType recordType) {
748+
if (fir::hasDynamicSize(recordType))
749+
return false;
750+
for (auto [_, fieldType] : recordType.getTypeList()) {
751+
// Derived type component may have user assignment (so far, we cannot tell
752+
// in FIR, so assume it is always the case, TODO: get the actual info).
753+
if (fir::unwrapSequenceType(fieldType).isa<fir::RecordType>())
754+
return false;
755+
// Allocatable components need deep copy.
756+
if (auto boxType = fieldType.dyn_cast<fir::BoxType>())
757+
if (boxType.getEleTy().isa<fir::HeapType>())
758+
return false;
759+
}
760+
// Constant size components without user defined assignment and pointers can
761+
// be memcopied.
762+
return true;
763+
}
764+
765+
void fir::factory::genRecordAssignment(fir::FirOpBuilder &builder,
766+
mlir::Location loc,
767+
const fir::ExtendedValue &lhs,
768+
const fir::ExtendedValue &rhs) {
769+
assert(lhs.rank() == 0 && rhs.rank() == 0 && "assume scalar assignment");
770+
auto baseTy = fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(lhs).getType());
771+
assert(baseTy && "must be a memory type");
772+
// Box operands may be polymorphic, it is not entirely clear from 10.2.1.3
773+
// if the assignment is performed on the dynamic of declared type. Use the
774+
// runtime assuming it is performed on the dynamic type.
775+
bool hasBoxOperands = fir::getBase(lhs).getType().isa<fir::BoxType>() ||
776+
fir::getBase(rhs).getType().isa<fir::BoxType>();
777+
auto recTy = baseTy.dyn_cast<fir::RecordType>();
778+
assert(recTy && "must be a record type");
779+
if (hasBoxOperands || !recordTypeCanBeMemCopied(recTy)) {
780+
auto to = fir::getBase(builder.createBox(loc, lhs));
781+
auto from = fir::getBase(builder.createBox(loc, rhs));
782+
// The runtime entry point may modify the LHS descriptor if it is
783+
// an allocatable. Allocatable assignment is handle elsewhere in lowering,
784+
// so just create a fir.ref<fir.box<>> from the fir.box to comply with the
785+
// runtime interface, but assume the fir.box is unchanged.
786+
// TODO: does this holds true with polymorphic entities ?
787+
auto toMutableBox = builder.createTemporary(loc, to.getType());
788+
builder.create<fir::StoreOp>(loc, to, toMutableBox);
789+
fir::runtime::genAssign(builder, loc, toMutableBox, from);
790+
return;
791+
}
792+
// Otherwise, the derived type has compile time constant size and for which
793+
// the component by component assignment can be replaced by a memory copy.
794+
auto load = builder.create<fir::LoadOp>(loc, fir::getBase(rhs));
795+
builder.create<fir::StoreOp>(loc, load, fir::getBase(lhs));
796+
}
Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
//===-- Assign.cpp -- generate assignment runtime API calls ---------------===//
2+
//
3+
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4+
// See https://llvm.org/LICENSE.txt for license information.
5+
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6+
//
7+
//===----------------------------------------------------------------------===//
8+
9+
#include "flang/Optimizer/Runtime/Assign.h"
10+
#include "../../../runtime/assign.h"
11+
#include "flang/Optimizer/Builder/FIRBuilder.h"
12+
#include "flang/Optimizer/Runtime/RTBuilder.h"
13+
14+
using namespace Fortran::runtime;
15+
16+
void fir::runtime::genAssign(fir::FirOpBuilder &builder, mlir::Location loc,
17+
mlir::Value destBox, mlir::Value sourceBox) {
18+
auto func = fir::runtime::getRuntimeFunc<mkRTKey(Assign)>(loc, builder);
19+
auto fTy = func.getType();
20+
auto sourceFile = fir::factory::locationToFilename(builder, loc);
21+
auto sourceLine =
22+
fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));
23+
auto args = fir::runtime::createArguments(builder, loc, fTy, destBox,
24+
sourceBox, sourceFile, sourceLine);
25+
builder.create<fir::CallOp>(loc, func, args);
26+
}

flang/lib/Optimizer/Runtime/CMakeLists.txt

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
22

33
add_flang_library(FIRRuntime
4+
Assign.cpp
45
Character.cpp
56
Derived.cpp
67
Numeric.cpp

flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp

Lines changed: 18 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,10 @@
88

99
#include "PassDetail.h"
1010
#include "flang/Lower/Todo.h" // delete!
11+
#include "flang/Optimizer/Builder/BoxValue.h"
12+
#include "flang/Optimizer/Builder/FIRBuilder.h"
1113
#include "flang/Optimizer/Dialect/FIRDialect.h"
14+
#include "flang/Optimizer/Support/FIRContext.h"
1215
#include "flang/Optimizer/Transforms/Factory.h"
1316
#include "flang/Optimizer/Transforms/Passes.h"
1417
#include "mlir/Dialect/SCF/SCF.h"
@@ -519,7 +522,21 @@ class ArrayUpdateConversion : public mlir::OpRewritePattern<ArrayUpdateOp> {
519522
fir::factory::genCharacterCopy(input, recoverCharLen(input), coor,
520523
recoverCharLen(coor), rewriter, loc);
521524
} else if (inEleTy.isa<fir::RecordType>()) {
522-
TODO(loc, "copy derived type");
525+
fir::FirOpBuilder builder(
526+
rewriter,
527+
fir::getKindMapping(update->getParentOfType<mlir::ModuleOp>()));
528+
if (!update.typeparams().empty()) {
529+
auto boxTy = fir::BoxType::get(inEleTy);
530+
mlir::Value emptyShape, emptySlice;
531+
auto lhs = rewriter.create<fir::EmboxOp>(
532+
loc, boxTy, coor, emptyShape, emptySlice, update.typeparams());
533+
auto rhs = rewriter.create<fir::EmboxOp>(
534+
loc, boxTy, input, emptyShape, emptySlice, update.typeparams());
535+
fir::factory::genRecordAssignment(builder, loc, fir::BoxValue(lhs),
536+
fir::BoxValue(rhs));
537+
} else {
538+
fir::factory::genRecordAssignment(builder, loc, coor, input);
539+
}
523540
} else {
524541
llvm::report_fatal_error("not a legal reference type");
525542
}
Lines changed: 77 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,77 @@
1+
! Test derived type assignment lowering inside array expression
2+
! RUN: bbc %s -o - | FileCheck %s
3+
4+
module array_derived_assign
5+
type simple_copy
6+
integer :: i
7+
character(10) :: c(20)
8+
real, pointer :: p(:)
9+
end type
10+
type deep_copy
11+
integer :: i
12+
real, allocatable :: a(:)
13+
end type
14+
contains
15+
16+
! Simple copies are implemented inline.
17+
! CHECK-LABEL: func @_QMarray_derived_assignPtest_simple_copy(
18+
! CHECK-SAME: %[[T1:.*]]: !fir.ref<!fir.array<10x!fir.type<_QMarray_derived_assignTsimple_copy{i:i32,c:!fir.array<20x!fir.char<1,10>>,p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>,
19+
! CHECK-SAME: %[[T2:.*]]: !fir.ref<!fir.array<10x!fir.type<_QMarray_derived_assignTsimple_copy{i:i32,c:!fir.array<20x!fir.char<1,10>>,p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>) {
20+
subroutine test_simple_copy(t1, t2)
21+
type(simple_copy) :: t1(10), t2(10)
22+
! CHECK-DAG: %[[VAL_0:.*]] = constant 10 : index
23+
! CHECK-DAG: %[[VAL_1:.*]] = constant 0 : index
24+
! CHECK-DAG: %[[VAL_2:.*]] = constant 1 : index
25+
! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_0]] : (index) -> !fir.shape<1>
26+
! CHECK: br ^bb1(%[[VAL_1]], %[[VAL_0]] : index, index)
27+
! CHECK: ^bb1(%[[VAL_4:.*]]: index, %[[VAL_5:.*]]: index):
28+
! CHECK: %[[VAL_6:.*]] = cmpi sgt, %[[VAL_5]], %[[VAL_1]] : index
29+
! CHECK: cond_br %[[VAL_6]], ^bb2, ^bb3
30+
! CHECK: ^bb2:
31+
! CHECK: %[[VAL_7:.*]] = addi %[[VAL_4]], %[[VAL_2]] : index
32+
! CHECK: %[[VAL_8:.*]] = fir.array_coor %[[T2:.*]](%[[VAL_3]]) %[[VAL_7]] : (!fir.ref<!fir.array<10x!fir.type<_QMarray_derived_assignTsimple_copy{{.*}}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QMarray_derived_assignTsimple_copy{{.*}}>>
33+
! CHECK: %[[VAL_10:.*]] = fir.array_coor %[[T1:.*]](%[[VAL_3]]) %[[VAL_7]] : (!fir.ref<!fir.array<10x!fir.type<_QMarray_derived_assignTsimple_copy{{.*}}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QMarray_derived_assignTsimple_copy{{.*}}>>
34+
! CHECK: %[[VAL_12:.*]] = fir.load %[[VAL_8]] : !fir.ref<!fir.type<_QMarray_derived_assignTsimple_copy{{.*}}>>
35+
! CHECK: fir.store %[[VAL_12]] to %[[VAL_10]] : !fir.ref<!fir.type<_QMarray_derived_assignTsimple_copy{{.*}}>>
36+
! CHECK: %[[VAL_13:.*]] = subi %[[VAL_5]], %[[VAL_2]] : index
37+
! CHECK: br ^bb1(%[[VAL_7]], %[[VAL_13]] : index, index)
38+
! CHECK: ^bb3:
39+
! CHECK: return
40+
t1 = t2
41+
end subroutine
42+
43+
! Types require more complex assignments are passed to the runtime
44+
! CHECK-LABEL: func @_QMarray_derived_assignPtest_deep_copy(
45+
! CHECK-SAME: %[[T1:.*]]: !fir.ref<!fir.array<10x!fir.type<_QMarray_derived_assignTdeep_copy{i:i32,a:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>>,
46+
! CHECK-SAME: %[[T2:.*]]: !fir.ref<!fir.array<10x!fir.type<_QMarray_derived_assignTdeep_copy{i:i32,a:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>>) {
47+
subroutine test_deep_copy(t1, t2)
48+
type(deep_copy) :: t1(10), t2(10)
49+
! CHECK-DAG: %[[VAL_15:.*]] = constant 10 : index
50+
! CHECK-DAG: %[[VAL_16:.*]] = constant 0 : index
51+
! CHECK-DAG: %[[VAL_17:.*]] = constant 1 : index
52+
! CHECK: %[[VAL_18:.*]] = fir.alloca !fir.box<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>> {uniq_name = ""}
53+
! CHECK: %[[VAL_19:.*]] = fir.shape %[[VAL_15]] : (index) -> !fir.shape<1>
54+
! CHECK: br ^bb1(%[[VAL_16]], %[[VAL_15]] : index, index)
55+
! CHECK: ^bb1(%[[VAL_20:.*]]: index, %[[VAL_21:.*]]: index):
56+
! CHECK: %[[VAL_22:.*]] = cmpi sgt, %[[VAL_21]], %[[VAL_16]] : index
57+
! CHECK: cond_br %[[VAL_22]], ^bb2, ^bb3
58+
! CHECK: ^bb2:
59+
! CHECK: %[[VAL_23:.*]] = addi %[[VAL_20]], %[[VAL_17]] : index
60+
! CHECK: %[[VAL_24:.*]] = fir.array_coor %[[T2:.*]](%[[VAL_19]]) %[[VAL_23]] : (!fir.ref<!fir.array<10x!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>
61+
! CHECK: %[[VAL_26:.*]] = fir.array_coor %[[T1:.*]](%[[VAL_19]]) %[[VAL_23]] : (!fir.ref<!fir.array<10x!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>
62+
! CHECK: %[[VAL_28:.*]] = fir.embox %[[VAL_26]] : (!fir.ref<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>) -> !fir.box<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>
63+
! CHECK: %[[VAL_29:.*]] = fir.embox %[[VAL_24]] : (!fir.ref<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>) -> !fir.box<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>
64+
! CHECK: fir.store %[[VAL_28]] to %[[VAL_18]] : !fir.ref<!fir.box<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>>
65+
! CHECK: %[[VAL_30:.*]] = fir.address_of({{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
66+
! CHECK: %[[VAL_31:.*]] = fir.convert %[[VAL_18]] : (!fir.ref<!fir.box<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>>) -> !fir.ref<!fir.box<none>>
67+
! CHECK: %[[VAL_32:.*]] = fir.convert %[[VAL_29]] : (!fir.box<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>) -> !fir.box<none>
68+
! CHECK: %[[VAL_33:.*]] = fir.convert %[[VAL_30]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
69+
! CHECK: %[[VAL_34:.*]] = fir.call @_FortranAAssign(%[[VAL_31]], %[[VAL_32]], %[[VAL_33]], %{{.*}}) : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> none
70+
! CHECK: %[[VAL_35:.*]] = subi %[[VAL_21]], %[[VAL_17]] : index
71+
! CHECK: br ^bb1(%[[VAL_23]], %[[VAL_35]] : index, index)
72+
! CHECK: ^bb3:
73+
! CHECK: return
74+
t1 = t2
75+
end subroutine
76+
77+
end module

0 commit comments

Comments
 (0)