[flang-commits] [flang] 5d25267 - [flang] Lower common block
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Mon Mar 14 10:05:24 PDT 2022
Author: Valentin Clement
Date: 2022-03-14T18:05:16+01:00
New Revision: 5d25267d80443b988065507d40ac3a1e902c778b
URL: https://github.com/llvm/llvm-project/commit/5d25267d80443b988065507d40ac3a1e902c778b
DIFF: https://github.com/llvm/llvm-project/commit/5d25267d80443b988065507d40ac3a1e902c778b.diff
LOG: [flang] Lower common block
This patch lowers common block variable to FIR.
This patch is part of the upstreaming effort from fir-dev branch.
Reviewed By: PeteSteinfeld
Differential Revision: https://reviews.llvm.org/D121610
Co-authored-by: V Donaldson <vdonaldson at nvidia.com>
Co-authored-by: Jean Perier <jperier at nvidia.com>
Added:
flang/test/Lower/common-block.f90
Modified:
flang/lib/Lower/ConvertVariable.cpp
Removed:
################################################################################
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 6e2a0a21edc46..c030bb00e99da 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -568,6 +568,232 @@ static void instantiateLocal(Fortran::lower::AbstractConverter &converter,
mapSymbolAttributes(converter, var, symMap, stmtCtx);
}
+/// Cast an alias address (variable part of an equivalence) to fir.ptr so that
+/// the optimizer is conservative and avoids doing copy elision in assignment
+/// involving equivalenced variables.
+/// TODO: Represent the equivalence aliasing constraint in another way to avoid
+/// pessimizing array assignments involving equivalenced variables.
+static mlir::Value castAliasToPointer(fir::FirOpBuilder &builder,
+ mlir::Location loc, mlir::Type aliasType,
+ mlir::Value aliasAddr) {
+ return builder.createConvert(loc, fir::PointerType::get(aliasType),
+ aliasAddr);
+}
+
+//===--------------------------------------------------------------===//
+// COMMON blocks instantiation
+//===--------------------------------------------------------------===//
+
+/// Does any member of the common block has an initializer ?
+static bool
+commonBlockHasInit(const Fortran::semantics::MutableSymbolVector &cmnBlkMems) {
+ for (const Fortran::semantics::MutableSymbolRef &mem : cmnBlkMems) {
+ if (const auto *memDet =
+ mem->detailsIf<Fortran::semantics::ObjectEntityDetails>())
+ if (memDet->init())
+ return true;
+ }
+ return false;
+}
+
+/// Build a tuple type for a common block based on the common block
+/// members and the common block size.
+/// This type is only needed to build common block initializers where
+/// the initial value is the collection of the member initial values.
+static mlir::TupleType getTypeOfCommonWithInit(
+ Fortran::lower::AbstractConverter &converter,
+ const Fortran::semantics::MutableSymbolVector &cmnBlkMems,
+ std::size_t commonSize) {
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ llvm::SmallVector<mlir::Type> members;
+ std::size_t counter = 0;
+ for (const Fortran::semantics::MutableSymbolRef &mem : cmnBlkMems) {
+ if (const auto *memDet =
+ mem->detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
+ if (mem->offset() > counter) {
+ fir::SequenceType::Shape len = {
+ static_cast<fir::SequenceType::Extent>(mem->offset() - counter)};
+ mlir::IntegerType byteTy = builder.getIntegerType(8);
+ auto memTy = fir::SequenceType::get(len, byteTy);
+ members.push_back(memTy);
+ counter = mem->offset();
+ }
+ if (memDet->init()) {
+ mlir::Type memTy = converter.genType(*mem);
+ members.push_back(memTy);
+ counter = mem->offset() + mem->size();
+ }
+ }
+ }
+ if (counter < commonSize) {
+ fir::SequenceType::Shape len = {
+ static_cast<fir::SequenceType::Extent>(commonSize - counter)};
+ mlir::IntegerType byteTy = builder.getIntegerType(8);
+ auto memTy = fir::SequenceType::get(len, byteTy);
+ members.push_back(memTy);
+ }
+ return mlir::TupleType::get(builder.getContext(), members);
+}
+
+/// Common block members may have aliases. They are not in the common block
+/// member list from the symbol. We need to know about these aliases if they
+/// have initializer to generate the common initializer.
+/// This function takes care of adding aliases with initializer to the member
+/// list.
+static Fortran::semantics::MutableSymbolVector
+getCommonMembersWithInitAliases(const Fortran::semantics::Symbol &common) {
+ const auto &commonDetails =
+ common.get<Fortran::semantics::CommonBlockDetails>();
+ auto members = commonDetails.objects();
+
+ // The number and size of equivalence and common is expected to be small, so
+ // no effort is given to optimize this loop of complexity equivalenced
+ // common members * common members
+ for (const Fortran::semantics::EquivalenceSet &set :
+ common.owner().equivalenceSets())
+ for (const Fortran::semantics::EquivalenceObject &obj : set) {
+ if (!obj.symbol.test(Fortran::semantics::Symbol::Flag::CompilerCreated)) {
+ if (const auto &details =
+ obj.symbol
+ .detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
+ const Fortran::semantics::Symbol *com =
+ FindCommonBlockContaining(obj.symbol);
+ if (!details->init() || com != &common)
+ continue;
+ // This is an alias with an init that belongs to the list
+ if (std::find(members.begin(), members.end(), obj.symbol) ==
+ members.end())
+ members.emplace_back(obj.symbol);
+ }
+ }
+ }
+ return members;
+}
+
+/// Define a global for a common block if it does not already exist in the
+/// mlir module.
+/// There is no "declare" version since there is not a
+/// scope that owns common blocks more that the others. All scopes using
+/// a common block attempts to define it with common linkage.
+static fir::GlobalOp
+defineCommonBlock(Fortran::lower::AbstractConverter &converter,
+ const Fortran::semantics::Symbol &common) {
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ std::string commonName = Fortran::lower::mangle::mangleName(common);
+ fir::GlobalOp global = builder.getNamedGlobal(commonName);
+ if (global)
+ return global;
+ Fortran::semantics::MutableSymbolVector cmnBlkMems =
+ getCommonMembersWithInitAliases(common);
+ mlir::Location loc = converter.genLocation(common.name());
+ mlir::IndexType idxTy = builder.getIndexType();
+ mlir::StringAttr linkage = builder.createCommonLinkage();
+ if (!common.name().size() || !commonBlockHasInit(cmnBlkMems)) {
+ // A blank (anonymous) COMMON block must always be initialized to zero.
+ // A named COMMON block sans initializers is also initialized to zero.
+ // mlir::Vector types must have a strictly positive size, so at least
+ // temporarily, force a zero size COMMON block to have one byte.
+ const auto sz = static_cast<fir::SequenceType::Extent>(
+ common.size() > 0 ? common.size() : 1);
+ fir::SequenceType::Shape shape = {sz};
+ mlir::IntegerType i8Ty = builder.getIntegerType(8);
+ auto commonTy = fir::SequenceType::get(shape, i8Ty);
+ auto vecTy = mlir::VectorType::get(sz, i8Ty);
+ mlir::Attribute zero = builder.getIntegerAttr(i8Ty, 0);
+ auto init = mlir::DenseElementsAttr::get(vecTy, llvm::makeArrayRef(zero));
+ return builder.createGlobal(loc, commonTy, commonName, linkage, init);
+ }
+
+ // Named common with initializer, sort members by offset before generating
+ // the type and initializer.
+ std::sort(cmnBlkMems.begin(), cmnBlkMems.end(),
+ [](auto &s1, auto &s2) { return s1->offset() < s2->offset(); });
+ mlir::TupleType commonTy =
+ getTypeOfCommonWithInit(converter, cmnBlkMems, common.size());
+ auto initFunc = [&](fir::FirOpBuilder &builder) {
+ mlir::Value cb = builder.create<fir::UndefOp>(loc, commonTy);
+ unsigned tupIdx = 0;
+ std::size_t offset = 0;
+ LLVM_DEBUG(llvm::dbgs() << "block {\n");
+ for (const Fortran::semantics::MutableSymbolRef &mem : cmnBlkMems) {
+ if (const auto *memDet =
+ mem->detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
+ if (mem->offset() > offset) {
+ ++tupIdx;
+ offset = mem->offset();
+ }
+ if (memDet->init()) {
+ LLVM_DEBUG(llvm::dbgs()
+ << "offset: " << mem->offset() << " is " << *mem << '\n');
+ Fortran::lower::StatementContext stmtCtx;
+ auto initExpr = memDet->init().value();
+ fir::ExtendedValue initVal =
+ Fortran::semantics::IsPointer(*mem)
+ ? Fortran::lower::genInitialDataTarget(
+ converter, loc, converter.genType(*mem), initExpr)
+ : genInitializerExprValue(converter, loc, initExpr, stmtCtx);
+ mlir::IntegerAttr offVal = builder.getIntegerAttr(idxTy, tupIdx);
+ mlir::Value castVal = builder.createConvert(
+ loc, commonTy.getType(tupIdx), fir::getBase(initVal));
+ cb = builder.create<fir::InsertValueOp>(loc, commonTy, cb, castVal,
+ builder.getArrayAttr(offVal));
+ ++tupIdx;
+ offset = mem->offset() + mem->size();
+ }
+ }
+ }
+ LLVM_DEBUG(llvm::dbgs() << "}\n");
+ builder.create<fir::HasValueOp>(loc, cb);
+ };
+ // create the global object
+ return builder.createGlobal(loc, commonTy, commonName,
+ /*isConstant=*/false, initFunc);
+}
+/// The COMMON block is a global structure. `var` will be at some offset
+/// within the COMMON block. Adds the address of `var` (COMMON + offset) to
+/// the symbol map.
+static void instantiateCommon(Fortran::lower::AbstractConverter &converter,
+ const Fortran::semantics::Symbol &common,
+ const Fortran::lower::pft::Variable &var,
+ Fortran::lower::SymMap &symMap) {
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ const Fortran::semantics::Symbol &varSym = var.getSymbol();
+ mlir::Location loc = converter.genLocation(varSym.name());
+
+ mlir::Value commonAddr;
+ if (Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(common))
+ commonAddr = symBox.getAddr();
+ if (!commonAddr) {
+ // introduce a local AddrOf and add it to the map
+ fir::GlobalOp global = defineCommonBlock(converter, common);
+ commonAddr = builder.create<fir::AddrOfOp>(loc, global.resultType(),
+ global.getSymbol());
+
+ symMap.addSymbol(common, commonAddr);
+ }
+ std::size_t byteOffset = varSym.GetUltimate().offset();
+ mlir::IntegerType i8Ty = builder.getIntegerType(8);
+ mlir::Type i8Ptr = builder.getRefType(i8Ty);
+ mlir::Type seqTy = builder.getRefType(builder.getVarLenSeqTy(i8Ty));
+ mlir::Value base = builder.createConvert(loc, seqTy, commonAddr);
+ mlir::Value offs =
+ builder.createIntegerConstant(loc, builder.getIndexType(), byteOffset);
+ auto varAddr = builder.create<fir::CoordinateOp>(loc, i8Ptr, base,
+ mlir::ValueRange{offs});
+ mlir::Type symType = converter.genType(var.getSymbol());
+ mlir::Value local;
+ if (Fortran::semantics::FindEquivalenceSet(var.getSymbol()) != nullptr)
+ local = castAliasToPointer(builder, loc, symType, varAddr);
+ else
+ local = builder.createConvert(loc, builder.getRefType(symType), varAddr);
+ Fortran::lower::StatementContext stmtCtx;
+ mapSymbolAttributes(converter, var, symMap, stmtCtx, local);
+}
+
+//===--------------------------------------------------------------===//
+// Lower Variables specification expressions and attributes
+//===--------------------------------------------------------------===//
+
/// Helper to decide if a dummy argument must be tracked in an BoxValue.
static bool lowerToBoxValue(const Fortran::semantics::Symbol &sym,
mlir::Value dummyArg) {
@@ -1197,9 +1423,10 @@ void Fortran::lower::defineModuleVariable(
TODO(loc, "defineModuleVariable aggregateStore");
}
const Fortran::semantics::Symbol &sym = var.getSymbol();
- if (Fortran::semantics::FindCommonBlockContaining(var.getSymbol())) {
- const mlir::Location loc = converter.genLocation(sym.name());
- TODO(loc, "defineModuleVariable common block");
+ if (const Fortran::semantics::Symbol *common =
+ Fortran::semantics::FindCommonBlockContaining(var.getSymbol())) {
+ // Define common block containing the variable.
+ defineCommonBlock(converter, *common);
} else if (var.isAlias()) {
// Do nothing. Mapping will be done on user side.
} else {
@@ -1216,9 +1443,10 @@ void Fortran::lower::instantiateVariable(AbstractConverter &converter,
const mlir::Location loc = converter.genLocation(sym.name());
if (var.isAggregateStore()) {
TODO(loc, "instantiateVariable AggregateStore");
- } else if (Fortran::semantics::FindCommonBlockContaining(
- var.getSymbol().GetUltimate())) {
- TODO(loc, "instantiateVariable Common");
+ } else if (const Fortran::semantics::Symbol *common =
+ Fortran::semantics::FindCommonBlockContaining(
+ var.getSymbol().GetUltimate())) {
+ instantiateCommon(converter, *common, var, symMap);
} else if (var.isAlias()) {
TODO(loc, "instantiateVariable Alias");
} else if (var.isGlobal()) {
diff --git a/flang/test/Lower/common-block.f90 b/flang/test/Lower/common-block.f90
new file mode 100644
index 0000000000000..f01b2f61aced3
--- /dev/null
+++ b/flang/test/Lower/common-block.f90
@@ -0,0 +1,73 @@
+! RUN: bbc %s -o - | tco | FileCheck %s
+
+! CHECK: @_QB = common global [8 x i8] zeroinitializer
+! CHECK: @_QBx = global { float, float } { float 1.0{{.*}}, float 2.0{{.*}} }
+! CHECK: @_QBy = common global [12 x i8] zeroinitializer
+! CHECK: @_QBz = global { i32, [4 x i8], float } { i32 42, [4 x i8] undef, float 3.000000e+00 }
+! CHECK: @_QBrien = common global [1 x i8] zeroinitializer
+! CHECK: @_QBwith_empty_equiv = common global [8 x i8] zeroinitializer
+
+! CHECK-LABEL: _QPs0
+subroutine s0
+ common // a0, b0
+
+ ! CHECK: call void @_QPs(float* bitcast ([8 x i8]* @_QB to float*), float* bitcast (i8* getelementptr inbounds ([8 x i8], [8 x i8]* @_QB, i32 0, i64 4) to float*))
+ call s(a0, b0)
+ end subroutine s0
+
+ ! CHECK-LABEL: _QPs1
+ subroutine s1
+ common /x/ a1, b1
+ data a1 /1.0/, b1 /2.0/
+
+ ! CHECK: call void @_QPs(float* getelementptr inbounds ({ float, float }, { float, float }* @_QBx, i32 0, i32 0), float* bitcast (i8* getelementptr (i8, i8* bitcast ({ float, float }* @_QBx to i8*), i64 4) to float*))
+ call s(a1, b1)
+ end subroutine s1
+
+ ! CHECK-LABEL: _QPs2
+ subroutine s2
+ common /y/ a2, b2, c2
+
+ ! CHECK: call void @_QPs(float* bitcast ([12 x i8]* @_QBy to float*), float* bitcast (i8* getelementptr inbounds ([12 x i8], [12 x i8]* @_QBy, i32 0, i64 4) to float*))
+ call s(a2, b2)
+ end subroutine s2
+
+ ! Test that common initialized through aliases of common members are getting
+ ! the correct initializer.
+ ! CHECK-LABEL: _QPs3
+ subroutine s3
+ integer :: i = 42
+ real :: x
+ complex :: c
+ real :: glue(2)
+ real :: y = 3.
+ equivalence (i, x), (glue(1), c), (glue(2), y)
+ ! x and c are not directly initialized, but overlapping aliases are.
+ common /z/ x, c
+ end subroutine s3
+
+ module mod_with_common
+ integer :: i, j
+ common /c_in_mod/ i, j
+ end module
+ ! CHECK-LABEL: _QPs4
+ subroutine s4
+ use mod_with_common
+ ! CHECK: load i32, i32* bitcast ([8 x i8]* @_QBc_in_mod to i32*)
+ print *, i
+ ! CHECK: load i32, i32* bitcast (i8* getelementptr inbounds ([8 x i8], [8 x i8]* @_QBc_in_mod, i32 0, i64 4) to i32*)
+ print *, j
+ end subroutine s4
+
+ ! CHECK-LABEL: _QPs5
+ subroutine s5
+ real r(1:0)
+ common /rien/ r
+ end subroutine s5
+
+ ! CHECK-LABEL: _QPs6
+ subroutine s6
+ real r1(1:0), r2(1:0), x, y
+ common /with_empty_equiv/ x, r1, y
+ equivalence(r1, r2)
+ end subroutine s6
More information about the flang-commits
mailing list