[flang-commits] [flang] 1119c15 - [flang][hlfir] Enable lowering and passing of allocatables and pointers.
Jean Perier via flang-commits
flang-commits at lists.llvm.org
Thu Jan 19 05:19:08 PST 2023
Author: Jean Perier
Date: 2023-01-19T14:18:22+01:00
New Revision: 1119c15ef5c55f2fe8a219443a9ea28f82ffe870
URL: https://github.com/llvm/llvm-project/commit/1119c15ef5c55f2fe8a219443a9ea28f82ffe870
DIFF: https://github.com/llvm/llvm-project/commit/1119c15ef5c55f2fe8a219443a9ea28f82ffe870.diff
LOG: [flang][hlfir] Enable lowering and passing of allocatables and pointers.
Adds support for:
- referencing a whole allocatable/pointer symbol
- passing allocatable/pointer in a call
This required update in HLFIRTools.cpp helpers so that the
raw address, extents, lower bounds, and type parameters of a
fir.box/fir.class can be extracted.
This is required because in hlfir lowering, dereferencing a
pointer/alloc is only doing the fir.load fir.box part, and the
helpers have to be able to reason about that fir.box without the
help of a "fir::FortranVariableOpInterface".
Missing:
- referencing part of allocatable/pointer (will need to update
Designator lowering to dereference the pointer/alloc). Same
for whole allocatable and pointer components.
- allocate/deallocate/pointer assignment statements.
- Whole allocatable assignment.
- Lower inquires.
Differential Revision: https://reviews.llvm.org/D142043
Added:
flang/test/Lower/HLFIR/allocatables-and-pointers.f90
Modified:
flang/include/flang/Lower/Allocatable.h
flang/include/flang/Optimizer/Builder/HLFIRTools.h
flang/include/flang/Optimizer/Dialect/FIROps.td
flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td
flang/lib/Lower/Allocatable.cpp
flang/lib/Lower/ConvertCall.cpp
flang/lib/Lower/ConvertVariable.cpp
flang/lib/Optimizer/Builder/HLFIRTools.cpp
flang/lib/Optimizer/Dialect/FIROps.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/Allocatable.h b/flang/include/flang/Lower/Allocatable.h
index e839f047449fc..17e245de6b0a3 100644
--- a/flang/include/flang/Lower/Allocatable.h
+++ b/flang/include/flang/Lower/Allocatable.h
@@ -60,11 +60,10 @@ void genDeallocateBox(AbstractConverter &converter,
/// Create a MutableBoxValue for an allocatable or pointer entity.
/// If the variables is a local variable that is not a dummy, it will be
/// initialized to unallocated/diassociated status.
-fir::MutableBoxValue createMutableBox(AbstractConverter &converter,
- mlir::Location loc,
- const pft::Variable &var,
- mlir::Value boxAddr,
- mlir::ValueRange nonDeferredParams);
+fir::MutableBoxValue
+createMutableBox(AbstractConverter &converter, mlir::Location loc,
+ const pft::Variable &var, mlir::Value boxAddr,
+ mlir::ValueRange nonDeferredParams, bool alwaysUseBox);
/// Assign a boxed value to a boxed variable, \p box (known as a
/// MutableBoxValue). Expression \p source will be lowered to build the
diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
index ac5e4be397c18..3f926d99fcfeb 100644
--- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h
+++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
@@ -77,13 +77,20 @@ class Entity : public mlir::Value {
bool isBoxAddressOrValue() const {
return hlfir::isBoxAddressOrValueType(getType());
}
- bool isArray() const {
+ /// Is this an array or an assumed ranked entity?
+ bool isArray() const { return getRank() != 0; }
+
+ /// Return the rank of this entity or -1 if it is an assumed rank.
+ int getRank() const {
mlir::Type type = fir::unwrapPassByRefType(fir::unwrapRefType(getType()));
- if (type.isa<fir::SequenceType>())
- return true;
+ if (auto seqTy = type.dyn_cast<fir::SequenceType>()) {
+ if (seqTy.hasUnknownShape())
+ return -1;
+ return seqTy.getDimension();
+ }
if (auto exprType = type.dyn_cast<hlfir::ExprType>())
- return exprType.isArray();
- return false;
+ return exprType.getRank();
+ return 0;
}
bool isScalar() const { return !isArray(); }
@@ -107,6 +114,10 @@ class Entity : public mlir::Value {
return getFortranElementType().isa<fir::CharacterType>();
}
+ bool isDerivedWithLengthParameters() const {
+ return fir::isRecordWithTypeParameters(getFortranElementType());
+ }
+
bool hasNonDefaultLowerBounds() const {
if (!isBoxAddressOrValue() || isScalar())
return false;
@@ -123,10 +134,37 @@ class Entity : public mlir::Value {
return true;
}
+ // Is this entity known to be contiguous at compile time?
+ // Note that when this returns false, the entity may still
+ // turn-out to be contiguous at runtime.
+ bool isSimplyContiguous() const {
+ // If this can be described without a fir.box in FIR, this must
+ // be contiguous.
+ if (!hlfir::isBoxAddressOrValueType(getFirBase().getType()))
+ return true;
+ // Otherwise, if this entity has a visible declaration in FIR,
+ // or is the dereference of an allocatable or contiguous pointer
+ // it is simply contiguous.
+ if (auto varIface = getMaybeDereferencedVariableInterface())
+ return varIface.isAllocatable() || varIface.hasContiguousAttr();
+ return false;
+ }
+
fir::FortranVariableOpInterface getIfVariableInterface() const {
return this->getDefiningOp<fir::FortranVariableOpInterface>();
}
+ // Return a "declaration" operation for this variable if visible,
+ // or the "declaration" operation of the allocatable/pointer this
+ // variable was dereferenced from (if it is visible).
+ fir::FortranVariableOpInterface
+ getMaybeDereferencedVariableInterface() const {
+ mlir::Value base = *this;
+ if (auto loadOp = base.getDefiningOp<fir::LoadOp>())
+ base = loadOp.getMemref();
+ return base.getDefiningOp<fir::FortranVariableOpInterface>();
+ }
+
// Get the entity as an mlir SSA value containing all the shape, type
// parameters and dynamic shape information.
mlir::Value getBase() const { return *this; }
diff --git a/flang/include/flang/Optimizer/Dialect/FIROps.td b/flang/include/flang/Optimizer/Dialect/FIROps.td
index acdea4f8aa8d1..c22deac8e1d10 100644
--- a/flang/include/flang/Optimizer/Dialect/FIROps.td
+++ b/flang/include/flang/Optimizer/Dialect/FIROps.td
@@ -979,6 +979,8 @@ def fir_BoxAddrOp : fir_SimpleOneResultOp<"box_addr", [NoMemoryEffect]> {
let results = (outs AnyCodeOrDataRefLike);
let hasFolder = 1;
+
+ let builders = [OpBuilder<(ins "mlir::Value":$val)>];
}
def fir_BoxCharLenOp : fir_SimpleOp<"boxchar_len", [NoMemoryEffect]> {
diff --git a/flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td b/flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td
index e4738d962e03f..1d6ab6f49c189 100644
--- a/flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td
+++ b/flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td
@@ -122,6 +122,15 @@ def fir_FortranVariableOpInterface : OpInterface<"FortranVariableOpInterface"> {
fir::FortranVariableFlagsEnum::optional);
}
+ /// Does this variable have the Fortran CONTIGUOUS attribute?
+ /// Note that not having this attribute does not imply the
+ /// variable is not contiguous.
+ bool hasContiguousAttr() {
+ auto attrs = getFortranAttrs();
+ return attrs && bitEnumContainsAny(*attrs,
+ fir::FortranVariableFlagsEnum::contiguous);
+ }
+
/// Is this a Fortran character variable?
bool isCharacter() {
return getElementType().isa<fir::CharacterType>();
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index c5320421f8120..5e34ab101c865 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -836,7 +836,7 @@ static fir::MutableProperties
createMutableProperties(Fortran::lower::AbstractConverter &converter,
mlir::Location loc,
const Fortran::lower::pft::Variable &var,
- mlir::ValueRange nonDeferredParams) {
+ mlir::ValueRange nonDeferredParams, bool alwaysUseBox) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
const Fortran::semantics::Symbol &sym = var.getSymbol();
// Globals and dummies may be associated, creating local variables would
@@ -850,7 +850,7 @@ createMutableProperties(Fortran::lower::AbstractConverter &converter,
// Pointer/Allocatable in internal procedure are descriptors in the host link,
// and it would increase complexity to sync this descriptor with the local
// values every time the host link is escaping.
- if (var.isGlobal() || Fortran::semantics::IsDummy(sym) ||
+ if (alwaysUseBox || var.isGlobal() || Fortran::semantics::IsDummy(sym) ||
Fortran::semantics::IsFunctionResult(sym) ||
sym.attrs().test(Fortran::semantics::Attr::VOLATILE) ||
isNonContiguousArrayPointer(sym) || useAllocateRuntime ||
@@ -903,10 +903,10 @@ createMutableProperties(Fortran::lower::AbstractConverter &converter,
fir::MutableBoxValue Fortran::lower::createMutableBox(
Fortran::lower::AbstractConverter &converter, mlir::Location loc,
const Fortran::lower::pft::Variable &var, mlir::Value boxAddr,
- mlir::ValueRange nonDeferredParams) {
+ mlir::ValueRange nonDeferredParams, bool alwaysUseBox) {
- fir::MutableProperties mutableProperties =
- createMutableProperties(converter, loc, var, nonDeferredParams);
+ fir::MutableProperties mutableProperties = createMutableProperties(
+ converter, loc, var, nonDeferredParams, alwaysUseBox);
fir::MutableBoxValue box(boxAddr, nonDeferredParams, mutableProperties);
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
if (!var.isGlobal() && !Fortran::semantics::IsDummy(var.getSymbol()))
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index b6015ae83df21..a682697258d0f 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -637,7 +637,41 @@ genUserCall(PreparedActualArguments &loweredActuals,
TODO(loc, "HLFIR PassBy::Box");
} break;
case PassBy::MutableBox: {
- TODO(loc, "HLFIR PassBy::MutableBox");
+ if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
+ *expr)) {
+ // If expr is NULL(), the mutableBox created must be a deallocated
+ // pointer with the dummy argument characteristics (see table 16.5
+ // in Fortran 2018 standard).
+ // No length parameters are set for the created box because any non
+ // deferred type parameters of the dummy will be evaluated on the
+ // callee side, and it is illegal to use NULL without a MOLD if any
+ // dummy length parameters are assumed.
+ mlir::Type boxTy = fir::dyn_cast_ptrEleTy(argTy);
+ assert(boxTy && boxTy.isa<fir::BoxType>() && "must be a fir.box type");
+ mlir::Value boxStorage = builder.createTemporary(loc, boxTy);
+ mlir::Value nullBox = fir::factory::createUnallocatedBox(
+ builder, loc, boxTy, /*nonDeferredParams=*/{});
+ builder.create<fir::StoreOp>(loc, nullBox, boxStorage);
+ caller.placeInput(arg, boxStorage);
+ continue;
+ }
+ if (fir::isPointerType(argTy) &&
+ !Fortran::evaluate::IsObjectPointer(
+ *expr, callContext.converter.getFoldingContext())) {
+ // Passing a non POINTER actual argument to a POINTER dummy argument.
+ // Create a pointer of the dummy argument type and assign the actual
+ // argument to it.
+ TODO(loc, "Associate POINTER dummy to TARGET argument in HLFIR");
+ continue;
+ }
+ // Passing a POINTER to a POINTER, or an ALLOCATABLE to an ALLOCATABLE.
+ assert(actual.isMutableBox() && "actual must be a mutable box");
+ caller.placeInput(arg, actual);
+ if (fir::isAllocatableType(argTy) && arg.isIntentOut() &&
+ Fortran::semantics::IsBindCProcedure(
+ *callContext.procRef.proc().GetSymbol())) {
+ TODO(loc, "BIND(C) INTENT(OUT) allocatable deallocation in HLFIR");
+ }
} break;
}
}
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 3a6f432b40545..fff076bb05498 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -1428,10 +1428,23 @@ genAllocatableOrPointerDeclare(Fortran::lower::AbstractConverter &converter,
Fortran::lower::SymMap &symMap,
const Fortran::semantics::Symbol &sym,
fir::MutableBoxValue box, bool force = false) {
- if (converter.getLoweringOptions().getLowerToHighLevelFIR())
- TODO(genLocation(converter, sym),
- "generate fir.declare for allocatable or pointers");
- symMap.addAllocatableOrPointer(sym, box, force);
+ if (!converter.getLoweringOptions().getLowerToHighLevelFIR()) {
+ symMap.addAllocatableOrPointer(sym, box, force);
+ return;
+ }
+ assert(!box.isDescribedByVariables() &&
+ "HLFIR alloctables/pointers must be fir.ref<fir.box>");
+ mlir::Value base = box.getAddr();
+ mlir::Value explictLength;
+ if (box.hasNonDeferredLenParams()) {
+ if (!box.isCharacter())
+ TODO(genLocation(converter, sym),
+ "Pointer or Allocatable parametrized derived type");
+ explictLength = box.nonDeferredLenParams()[0];
+ }
+ genDeclareSymbol(converter, symMap, sym, base, explictLength,
+ /*shape=*/std::nullopt,
+ /*lbounds=*/std::nullopt, force);
}
/// Map a symbol represented with a runtime descriptor to its FIR fir.box and
@@ -1522,7 +1535,9 @@ void Fortran::lower::mapSymbolAttributes(
"derived type allocatable or pointer with length parameters");
}
fir::MutableBoxValue box = Fortran::lower::createMutableBox(
- converter, loc, var, boxAlloc, nonDeferredLenParams);
+ converter, loc, var, boxAlloc, nonDeferredLenParams,
+ /*alwaysUseBox=*/
+ converter.getLoweringOptions().getLowerToHighLevelFIR());
genAllocatableOrPointerDeclare(converter, symMap, var.getSymbol(), box,
replace);
return;
diff --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
index cc2b46c00c210..146a063ccb10d 100644
--- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp
+++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
@@ -11,6 +11,7 @@
//===----------------------------------------------------------------------===//
#include "flang/Optimizer/Builder/HLFIRTools.h"
+#include "flang/Optimizer/Builder/Character.h"
#include "flang/Optimizer/Builder/FIRBuilder.h"
#include "flang/Optimizer/Builder/MutableBox.h"
#include "flang/Optimizer/Builder/Todo.h"
@@ -20,7 +21,8 @@
// Return explicit extents. If the base is a fir.box, this won't read it to
// return the extents and will instead return an empty vector.
-static llvm::SmallVector<mlir::Value> getExplicitExtents(mlir::Value shape) {
+static llvm::SmallVector<mlir::Value>
+getExplicitExtentsFromShape(mlir::Value shape) {
llvm::SmallVector<mlir::Value> result;
auto *shapeOp = shape.getDefiningOp();
if (auto s = mlir::dyn_cast_or_null<fir::ShapeOp>(shapeOp)) {
@@ -39,13 +41,14 @@ static llvm::SmallVector<mlir::Value> getExplicitExtents(mlir::Value shape) {
static llvm::SmallVector<mlir::Value>
getExplicitExtents(fir::FortranVariableOpInterface var) {
if (mlir::Value shape = var.getShape())
- return getExplicitExtents(var.getShape());
+ return getExplicitExtentsFromShape(var.getShape());
return {};
}
// Return explicit lower bounds. For pointers and allocatables, this will not
// read the lower bounds and instead return an empty vector.
-static llvm::SmallVector<mlir::Value> getExplicitLbounds(mlir::Value shape) {
+static llvm::SmallVector<mlir::Value>
+getExplicitLboundsFromShape(mlir::Value shape) {
llvm::SmallVector<mlir::Value> result;
auto *shapeOp = shape.getDefiningOp();
if (auto s = mlir::dyn_cast_or_null<fir::ShapeOp>(shapeOp)) {
@@ -64,41 +67,97 @@ static llvm::SmallVector<mlir::Value> getExplicitLbounds(mlir::Value shape) {
static llvm::SmallVector<mlir::Value>
getExplicitLbounds(fir::FortranVariableOpInterface var) {
if (mlir::Value shape = var.getShape())
- return getExplicitLbounds(shape);
+ return getExplicitLboundsFromShape(shape);
return {};
}
+static void
+genLboundsAndExtentsFromBox(mlir::Location loc, fir::FirOpBuilder &builder,
+ hlfir::Entity boxEntity,
+ llvm::SmallVectorImpl<mlir::Value> &lbounds,
+ llvm::SmallVectorImpl<mlir::Value> *extents) {
+ assert(boxEntity.getType().isa<fir::BaseBoxType>() && "must be a box");
+ mlir::Type idxTy = builder.getIndexType();
+ const int rank = boxEntity.getRank();
+ for (int i = 0; i < rank; ++i) {
+ mlir::Value dim = builder.createIntegerConstant(loc, idxTy, i);
+ auto dimInfo = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy,
+ boxEntity, dim);
+ lbounds.push_back(dimInfo.getLowerBound());
+ if (extents)
+ extents->push_back(dimInfo.getExtent());
+ }
+}
+
static llvm::SmallVector<mlir::Value>
-getExplicitTypeParams(fir::FortranVariableOpInterface var) {
+getNonDefaultLowerBounds(mlir::Location loc, fir::FirOpBuilder &builder,
+ hlfir::Entity entity) {
+ if (!entity.hasNonDefaultLowerBounds())
+ return {};
+ if (auto varIface = entity.getIfVariableInterface()) {
+ llvm::SmallVector<mlir::Value> lbounds = getExplicitLbounds(varIface);
+ if (!lbounds.empty())
+ return lbounds;
+ }
+ if (entity.isMutableBox())
+ entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
+ llvm::SmallVector<mlir::Value> lowerBounds;
+ genLboundsAndExtentsFromBox(loc, builder, entity, lowerBounds,
+ /*extents=*/nullptr);
+ return lowerBounds;
+}
+
+static llvm::SmallVector<mlir::Value> toSmallVector(mlir::ValueRange range) {
llvm::SmallVector<mlir::Value> res;
- mlir::OperandRange range = var.getExplicitTypeParams();
res.append(range.begin(), range.end());
return res;
}
-std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
-hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
- hlfir::Entity entity) {
- if (auto variable = entity.getIfVariableInterface())
- return {hlfir::translateToExtendedValue(loc, builder, variable), {}};
- if (entity.isVariable()) {
- if (entity.isScalar() && !entity.hasLengthParameters() &&
- !hlfir::isBoxAddressOrValueType(entity.getType()))
- return {fir::ExtendedValue{entity.getBase()}, std::nullopt};
- TODO(loc, "HLFIR variable to fir::ExtendedValue without a "
- "FortranVariableOpInterface");
- }
- if (entity.getType().isa<hlfir::ExprType>()) {
- hlfir::AssociateOp associate = hlfir::genAssociateExpr(
- loc, builder, entity, entity.getType(), "adapt.valuebyref");
- auto *bldr = &builder;
- hlfir::CleanupFunction cleanup = [bldr, loc, associate]() -> void {
- bldr->create<hlfir::EndAssociateOp>(loc, associate);
- };
- hlfir::Entity temp{associate.getBase()};
- return {translateToExtendedValue(loc, builder, temp).first, cleanup};
- }
- return {{static_cast<mlir::Value>(entity)}, {}};
+static llvm::SmallVector<mlir::Value> getExplicitTypeParams(hlfir::Entity var) {
+ if (auto varIface = var.getMaybeDereferencedVariableInterface())
+ return toSmallVector(varIface.getExplicitTypeParams());
+ return {};
+}
+
+static mlir::Value tryGettingNonDeferredCharLen(hlfir::Entity var) {
+ if (auto varIface = var.getMaybeDereferencedVariableInterface())
+ if (!varIface.getExplicitTypeParams().empty())
+ return varIface.getExplicitTypeParams()[0];
+ return mlir::Value{};
+}
+
+static mlir::Value genCharacterVariableLength(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ hlfir::Entity var) {
+ if (mlir::Value len = tryGettingNonDeferredCharLen(var))
+ return len;
+ auto charType = var.getFortranElementType().cast<fir::CharacterType>();
+ if (charType.hasConstantLen())
+ return builder.createIntegerConstant(loc, builder.getIndexType(),
+ charType.getLen());
+ if (var.isMutableBox())
+ var = hlfir::Entity{builder.create<fir::LoadOp>(loc, var)};
+ mlir::Value len = fir::factory::CharacterExprHelper{builder, loc}.getLength(
+ var.getFirBase());
+ assert(len && "failed to retrieve length");
+ return len;
+}
+
+static fir::CharBoxValue genUnboxChar(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ mlir::Value boxChar) {
+ if (auto emboxChar = boxChar.getDefiningOp<fir::EmboxCharOp>())
+ return {emboxChar.getMemref(), emboxChar.getLen()};
+ mlir::Type refType = fir::ReferenceType::get(
+ boxChar.getType().cast<fir::BoxCharType>().getEleTy());
+ auto unboxed = builder.create<fir::UnboxCharOp>(
+ loc, refType, builder.getIndexType(), boxChar);
+ mlir::Value addr = unboxed.getResult(0);
+ mlir::Value len = unboxed.getResult(1);
+ if (auto varIface = boxChar.getDefiningOp<fir::FortranVariableOpInterface>())
+ if (mlir::Value explicitlen = varIface.getExplicitCharLen())
+ len = explicitlen;
+ return {addr, len};
}
mlir::Value hlfir::Entity::getFirBase() const {
@@ -113,39 +172,6 @@ mlir::Value hlfir::Entity::getFirBase() const {
return getBase();
}
-fir::ExtendedValue
-hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
- fir::FortranVariableOpInterface variable) {
- /// When going towards FIR, use the original base value to avoid
- /// introducing descriptors at runtime when they are not required.
- mlir::Value firBase = Entity{variable}.getFirBase();
- if (variable.isPointer() || variable.isAllocatable())
- TODO(variable->getLoc(), "pointer or allocatable "
- "FortranVariableOpInterface to extendedValue");
- if (firBase.getType().isa<fir::BaseBoxType>())
- return fir::BoxValue(firBase, getExplicitLbounds(variable),
- getExplicitTypeParams(variable));
-
- if (variable.isCharacter()) {
- if (variable.isArray())
- return fir::CharArrayBoxValue(firBase, variable.getExplicitCharLen(),
- getExplicitExtents(variable),
- getExplicitLbounds(variable));
- if (auto boxCharType = firBase.getType().dyn_cast<fir::BoxCharType>()) {
- auto unboxed = builder.create<fir::UnboxCharOp>(
- loc, fir::ReferenceType::get(boxCharType.getEleTy()),
- builder.getIndexType(), firBase);
- return fir::CharBoxValue(unboxed.getResult(0),
- variable.getExplicitCharLen());
- }
- return fir::CharBoxValue(firBase, variable.getExplicitCharLen());
- }
- if (variable.isArray())
- return fir::ArrayBoxValue(firBase, getExplicitExtents(variable),
- getExplicitLbounds(variable));
- return firBase;
-}
-
fir::FortranVariableOpInterface
hlfir::genDeclare(mlir::Location loc, fir::FirOpBuilder &builder,
const fir::ExtendedValue &exv, llvm::StringRef name,
@@ -222,11 +248,8 @@ mlir::Value hlfir::genVariableRawAddress(mlir::Location loc,
if (var.isMutableBox())
baseAddr = builder.create<fir::LoadOp>(loc, baseAddr);
// Get raw address.
- if (baseAddr.getType().isa<fir::BaseBoxType>()) {
- auto addrType =
- fir::ReferenceType::get(fir::unwrapPassByRefType(baseAddr.getType()));
- baseAddr = builder.create<fir::BoxAddrOp>(loc, addrType, baseAddr);
- }
+ if (baseAddr.getType().isa<fir::BaseBoxType>())
+ baseAddr = builder.create<fir::BoxAddrOp>(loc, baseAddr);
return baseAddr;
}
@@ -260,19 +283,6 @@ hlfir::Entity hlfir::loadTrivialScalar(mlir::Location loc,
return entity;
}
-static std::optional<llvm::SmallVector<mlir::Value>>
-getNonDefaultLowerBounds(mlir::Location loc, fir::FirOpBuilder &builder,
- hlfir::Entity entity) {
- if (!entity.hasNonDefaultLowerBounds())
- return std::nullopt;
- if (auto varIface = entity.getIfVariableInterface()) {
- llvm::SmallVector<mlir::Value> lbounds = getExplicitLbounds(varIface);
- if (!lbounds.empty())
- return lbounds;
- }
- TODO(loc, "get non default lower bounds without FortranVariableInterface");
-}
-
hlfir::Entity hlfir::getElementAt(mlir::Location loc,
fir::FirOpBuilder &builder, Entity entity,
mlir::ValueRange oneBasedIndices) {
@@ -288,11 +298,13 @@ hlfir::Entity hlfir::getElementAt(mlir::Location loc,
// based on the array operand lower bounds.
mlir::Type resultType = hlfir::getVariableElementType(entity);
hlfir::DesignateOp designate;
- if (auto lbounds = getNonDefaultLowerBounds(loc, builder, entity)) {
+ llvm::SmallVector<mlir::Value> lbounds =
+ getNonDefaultLowerBounds(loc, builder, entity);
+ if (!lbounds.empty()) {
llvm::SmallVector<mlir::Value> indices;
mlir::Type idxTy = builder.getIndexType();
mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
- for (auto [oneBased, lb] : llvm::zip(oneBasedIndices, *lbounds)) {
+ for (auto [oneBased, lb] : llvm::zip(oneBasedIndices, lbounds)) {
auto lbIdx = builder.createConvert(loc, idxTy, lb);
auto oneBasedIdx = builder.createConvert(loc, idxTy, oneBased);
auto shift = builder.create<mlir::arith::SubIOp>(loc, lbIdx, one);
@@ -348,8 +360,8 @@ hlfir::genBounds(mlir::Location loc, fir::FirOpBuilder &builder,
assert((shape.getType().isa<fir::ShapeShiftType>() ||
shape.getType().isa<fir::ShapeType>()) &&
"shape must contain extents");
- auto extents = getExplicitExtents(shape);
- auto lowers = getExplicitLbounds(shape);
+ auto extents = getExplicitExtentsFromShape(shape);
+ auto lowers = getExplicitLboundsFromShape(shape);
assert(lowers.empty() || lowers.size() == extents.size());
mlir::Type idxTy = builder.getIndexType();
mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
@@ -379,13 +391,44 @@ static hlfir::Entity followEntitySource(hlfir::Entity entity) {
return entity;
}
+llvm::SmallVector<mlir::Value> getVariableExtents(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ hlfir::Entity variable) {
+ llvm::SmallVector<mlir::Value> extents;
+ if (fir::FortranVariableOpInterface varIface =
+ variable.getIfVariableInterface()) {
+ extents = getExplicitExtents(varIface);
+ if (!extents.empty())
+ return extents;
+ }
+
+ if (variable.isMutableBox())
+ variable = hlfir::derefPointersAndAllocatables(loc, builder, variable);
+ // Use the type shape information, and/or the fir.box/fir.class shape
+ // information if any extents are not static.
+ fir::SequenceType seqTy =
+ hlfir::getFortranElementOrSequenceType(variable.getType())
+ .cast<fir::SequenceType>();
+ mlir::Type idxTy = builder.getIndexType();
+ for (auto typeExtent : seqTy.getShape())
+ if (typeExtent != fir::SequenceType::getUnknownExtent()) {
+ extents.push_back(builder.createIntegerConstant(loc, idxTy, typeExtent));
+ } else {
+ assert(variable.getType().isa<fir::BaseBoxType>() &&
+ "array variable with dynamic extent must be boxed");
+ mlir::Value dim =
+ builder.createIntegerConstant(loc, idxTy, extents.size());
+ auto dimInfo = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy,
+ variable, dim);
+ extents.push_back(dimInfo.getExtent());
+ }
+ return extents;
+}
+
mlir::Value hlfir::genShape(mlir::Location loc, fir::FirOpBuilder &builder,
hlfir::Entity entity) {
assert(entity.isArray() && "entity must be an array");
- if (entity.isMutableBox())
- entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
- else
- entity = followEntitySource(entity);
+ entity = followEntitySource(entity);
if (entity.getType().isa<hlfir::ExprType>()) {
if (auto elemental = entity.getDefiningOp<hlfir::ElementalOp>())
@@ -402,43 +445,16 @@ mlir::Value hlfir::genShape(mlir::Location loc, fir::FirOpBuilder &builder,
return builder.create<fir::ShapeOp>(loc, s.getExtents());
}
}
- // There is no shape lying around for this entity: build one using
- // the type shape information, and/or the fir.box/fir.class shape
- // information if any extents are not static.
- fir::SequenceType seqTy =
- hlfir::getFortranElementOrSequenceType(entity.getType())
- .cast<fir::SequenceType>();
- llvm::SmallVector<mlir::Value> extents;
- mlir::Type idxTy = builder.getIndexType();
- for (auto typeExtent : seqTy.getShape())
- if (typeExtent != fir::SequenceType::getUnknownExtent()) {
- extents.push_back(builder.createIntegerConstant(loc, idxTy, typeExtent));
- } else {
- assert(entity.getType().isa<fir::BaseBoxType>() &&
- "array variable with dynamic extent must be boxes");
- mlir::Value dim =
- builder.createIntegerConstant(loc, idxTy, extents.size());
- auto dimInfo =
- builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, entity, dim);
- extents.push_back(dimInfo.getExtent());
- }
- return builder.create<fir::ShapeOp>(loc, extents);
+ // There is no shape lying around for this entity. Retrieve the extents and
+ // build a new fir.shape.
+ return builder.create<fir::ShapeOp>(loc,
+ getVariableExtents(loc, builder, entity));
}
llvm::SmallVector<mlir::Value>
hlfir::getIndexExtents(mlir::Location loc, fir::FirOpBuilder &builder,
mlir::Value shape) {
- llvm::SmallVector<mlir::Value> extents;
- if (auto s = shape.getDefiningOp<fir::ShapeOp>()) {
- auto e = s.getExtents();
- extents.insert(extents.end(), e.begin(), e.end());
- } else if (auto s = shape.getDefiningOp<fir::ShapeShiftOp>()) {
- auto e = s.getExtents();
- extents.insert(extents.end(), e.begin(), e.end());
- } else {
- // TODO: add fir.get_extent ops on fir.shape<> ops.
- TODO(loc, "get extents from fir.shape without fir::ShapeOp parent op");
- }
+ llvm::SmallVector<mlir::Value> extents = getExplicitExtentsFromShape(shape);
mlir::Type indexType = builder.getIndexType();
for (auto &extent : extents)
extent = builder.createConvert(loc, indexType, extent);
@@ -478,9 +494,7 @@ void hlfir::genLengthParameters(mlir::Location loc, fir::FirOpBuilder &builder,
}
if (entity.isCharacter()) {
- auto [exv, cleanup] = translateToExtendedValue(loc, builder, entity);
- assert(!cleanup && "translation of entity should not yield cleanup");
- result.push_back(fir::factory::readCharLen(builder, loc, exv));
+ result.push_back(genCharacterVariableLength(loc, builder, entity));
return;
}
TODO(loc, "inquire PDTs length parameters in HLFIR");
@@ -530,8 +544,27 @@ std::pair<mlir::Value, mlir::Value> hlfir::genVariableFirBaseShapeAndParams(
hlfir::Entity hlfir::derefPointersAndAllocatables(mlir::Location loc,
fir::FirOpBuilder &builder,
Entity entity) {
- if (entity.isMutableBox())
- return hlfir::Entity{builder.create<fir::LoadOp>(loc, entity).getResult()};
+ if (entity.isMutableBox()) {
+ hlfir::Entity boxLoad{builder.create<fir::LoadOp>(loc, entity)};
+ if (entity.isScalar()) {
+ mlir::Type elementType = boxLoad.getFortranElementType();
+ if (fir::isa_trivial(elementType))
+ return hlfir::Entity{builder.create<fir::BoxAddrOp>(loc, boxLoad)};
+ if (auto charType = elementType.dyn_cast<fir::CharacterType>()) {
+ mlir::Value base = builder.create<fir::BoxAddrOp>(loc, boxLoad);
+ if (charType.hasConstantLen())
+ return hlfir::Entity{base};
+ mlir::Value len = genCharacterVariableLength(loc, builder, entity);
+ auto boxCharType =
+ fir::BoxCharType::get(builder.getContext(), charType.getFKind());
+ return hlfir::Entity{
+ builder.create<fir::EmboxCharOp>(loc, boxCharType, base, len)
+ .getResult()};
+ }
+ }
+ // Keep the entity boxed for now.
+ return boxLoad;
+ }
return entity;
}
@@ -623,3 +656,81 @@ hlfir::genLoopNest(mlir::Location loc, fir::FirOpBuilder &builder,
builder.restoreInsertionPoint(insPt);
return {innerLoop, indices};
}
+
+static fir::ExtendedValue
+translateVariableToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
+ hlfir::Entity variable) {
+ assert(variable.isVariable() && "must be a variable");
+ /// When going towards FIR, use the original base value to avoid
+ /// introducing descriptors at runtime when they are not required.
+ mlir::Value firBase = variable.getFirBase();
+ if (variable.isMutableBox())
+ return fir::MutableBoxValue(firBase, getExplicitTypeParams(variable),
+ fir::MutableProperties{});
+
+ if (firBase.getType().isa<fir::BaseBoxType>()) {
+ if (!variable.isSimplyContiguous() || variable.isPolymorphic() ||
+ variable.isDerivedWithLengthParameters()) {
+ llvm::SmallVector<mlir::Value> nonDefaultLbounds =
+ getNonDefaultLowerBounds(loc, builder, variable);
+ return fir::BoxValue(firBase, nonDefaultLbounds,
+ getExplicitTypeParams(variable));
+ }
+ // Otherwise, the variable can be represented in a fir::ExtendedValue
+ // without the overhead of a fir.box.
+ firBase = genVariableRawAddress(loc, builder, variable);
+ }
+
+ if (variable.isScalar()) {
+ if (variable.isCharacter()) {
+ if (firBase.getType().isa<fir::BoxCharType>())
+ return genUnboxChar(loc, builder, firBase);
+ mlir::Value len = genCharacterVariableLength(loc, builder, variable);
+ return fir::CharBoxValue{firBase, len};
+ }
+ return firBase;
+ }
+ llvm::SmallVector<mlir::Value> extents;
+ llvm::SmallVector<mlir::Value> nonDefaultLbounds;
+ if (variable.getType().isa<fir::BaseBoxType>() &&
+ !variable.getIfVariableInterface()) {
+ // This special case avoids generating two generating to sets of identical
+ // fir.box_dim to get both the lower bounds and extents.
+ genLboundsAndExtentsFromBox(loc, builder, variable, nonDefaultLbounds,
+ &extents);
+ } else {
+ extents = getVariableExtents(loc, builder, variable);
+ nonDefaultLbounds = getNonDefaultLowerBounds(loc, builder, variable);
+ }
+ if (variable.isCharacter())
+ return fir::CharArrayBoxValue{
+ firBase, genCharacterVariableLength(loc, builder, variable), extents,
+ nonDefaultLbounds};
+ return fir::ArrayBoxValue{firBase, extents, nonDefaultLbounds};
+}
+
+fir::ExtendedValue
+hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
+ fir::FortranVariableOpInterface var) {
+ return translateVariableToExtendedValue(loc, builder, var);
+}
+
+std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
+hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
+ hlfir::Entity entity) {
+ if (entity.isVariable())
+ return {translateVariableToExtendedValue(loc, builder, entity),
+ std::nullopt};
+
+ if (entity.getType().isa<hlfir::ExprType>()) {
+ hlfir::AssociateOp associate = hlfir::genAssociateExpr(
+ loc, builder, entity, entity.getType(), "adapt.valuebyref");
+ auto *bldr = &builder;
+ hlfir::CleanupFunction cleanup = [bldr, loc, associate]() -> void {
+ bldr->create<hlfir::EndAssociateOp>(loc, associate);
+ };
+ hlfir::Entity temp{associate.getBase()};
+ return {translateToExtendedValue(loc, builder, temp).first, cleanup};
+ }
+ return {{static_cast<mlir::Value>(entity)}, {}};
+}
diff --git a/flang/lib/Optimizer/Dialect/FIROps.cpp b/flang/lib/Optimizer/Dialect/FIROps.cpp
index e6dced8988ce0..b093f693b08f3 100644
--- a/flang/lib/Optimizer/Dialect/FIROps.cpp
+++ b/flang/lib/Optimizer/Dialect/FIROps.cpp
@@ -600,6 +600,26 @@ mlir::LogicalResult fir::ArrayModifyOp::verify() {
// BoxAddrOp
//===----------------------------------------------------------------------===//
+void fir::BoxAddrOp::build(mlir::OpBuilder &builder,
+ mlir::OperationState &result, mlir::Value val) {
+ mlir::Type type =
+ llvm::TypeSwitch<mlir::Type, mlir::Type>(val.getType())
+ .Case<fir::BoxType>([&](fir::BoxType ty) -> mlir::Type {
+ mlir::Type eleTy = ty.getEleTy();
+ if (fir::isa_ref_type(eleTy))
+ return eleTy;
+ return fir::ReferenceType::get(eleTy);
+ })
+ .Case<fir::BoxCharType>([&](fir::BoxCharType ty) -> mlir::Type {
+ return fir::ReferenceType::get(ty.getEleTy());
+ })
+ .Case<fir::BoxProcType>(
+ [&](fir::BoxProcType ty) { return ty.getEleTy(); })
+ .Default([&](const auto &) { return mlir::Type{}; });
+ assert(type && "bad val type");
+ build(builder, result, type, val);
+}
+
mlir::OpFoldResult fir::BoxAddrOp::fold(FoldAdaptor adaptor) {
if (auto *v = getVal().getDefiningOp()) {
if (auto box = mlir::dyn_cast<fir::EmboxOp>(v)) {
diff --git a/flang/test/Lower/HLFIR/allocatables-and-pointers.f90 b/flang/test/Lower/HLFIR/allocatables-and-pointers.f90
new file mode 100644
index 0000000000000..e0685e04cc19f
--- /dev/null
+++ b/flang/test/Lower/HLFIR/allocatables-and-pointers.f90
@@ -0,0 +1,156 @@
+! Test lowering of whole allocatable and pointers to HLFIR
+! RUN: bbc -emit-fir -hlfir -o - %s 2>&1 | FileCheck %s
+
+subroutine passing_allocatable(x)
+ interface
+ subroutine takes_allocatable(y)
+ real, allocatable :: y(:)
+ end subroutine
+ subroutine takes_array(y)
+ real :: y(*)
+ end subroutine
+ end interface
+ real, allocatable :: x(:)
+ call takes_allocatable(x)
+ call takes_array(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPpassing_allocatable(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = {{.*}}Ex"}
+! CHECK: fir.call @_QPtakes_allocatable(%[[VAL_1]]#0) {{.*}} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
+! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+! CHECK: fir.call @_QPtakes_array(%[[VAL_4]]) {{.*}} : (!fir.ref<!fir.array<?xf32>>) -> ()
+
+subroutine passing_pointer(x)
+ interface
+ subroutine takes_pointer(y)
+ real, pointer :: y(:)
+ end subroutine
+ end interface
+ real, pointer :: x(:)
+ call takes_pointer(x)
+ call takes_pointer(NULL())
+end subroutine
+! CHECK-LABEL: func.func @_QPpassing_pointer(
+! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = {{.*}}Ex"}
+! CHECK: fir.call @_QPtakes_pointer(%[[VAL_2]]#0) {{.*}} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> ()
+! CHECK: %[[VAL_3:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
+! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_3]](%[[VAL_5]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK: fir.store %[[VAL_6]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK: fir.call @_QPtakes_pointer(%[[VAL_1]]) {{.*}} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> ()
+
+subroutine passing_contiguous_pointer(x)
+ interface
+ subroutine takes_array(y)
+ real :: y(*)
+ end subroutine
+ end interface
+ real, pointer, contiguous :: x(:)
+ call takes_array(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPpassing_contiguous_pointer(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<contiguous, pointer>, uniq_name = {{.*}}Ex"}
+! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
+! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ptr<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+! CHECK: fir.call @_QPtakes_array(%[[VAL_4]]) {{.*}} : (!fir.ref<!fir.array<?xf32>>) -> ()
+
+subroutine character_allocatable_cst_len(x)
+ character(10), allocatable :: x
+ call takes_char(x)
+ call takes_char(x//"hello")
+end subroutine
+! CHECK-LABEL: func.func @_QPcharacter_allocatable_cst_len(
+! CHECK: %[[VAL_1:.*]] = arith.constant 10 : index
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] typeparams %[[VAL_1:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = {{.*}}Ex"}
+! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>>
+! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box<!fir.heap<!fir.char<1,10>>>) -> !fir.heap<!fir.char<1,10>>
+! CHECK: %[[VAL_5:.*]] = arith.constant 10 : index
+! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_4]] : (!fir.heap<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,10>>
+! CHECK: %[[VAL_7:.*]] = fir.emboxchar %[[VAL_6]], %[[VAL_5]] : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>
+! CHECK: fir.call @_QPtakes_char(%[[VAL_7]]) {{.*}} : (!fir.boxchar<1>) -> ()
+! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>>
+! CHECK: %[[VAL_9:.*]] = fir.box_addr %[[VAL_8]] : (!fir.box<!fir.heap<!fir.char<1,10>>>) -> !fir.heap<!fir.char<1,10>>
+! CHECK: %[[VAL_12:.*]]:2 = hlfir.declare %[[VAL_10:[a-z0-9]*]] typeparams %[[VAL_11:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<parameter>
+! CHECK: %[[VAL_13:.*]] = arith.constant 10 : index
+! CHECK: %[[VAL_14:.*]] = arith.addi %[[VAL_13]], %[[VAL_11]] : index
+! CHECK: %[[VAL_15:.*]] = hlfir.concat %[[VAL_9]], %[[VAL_12]]#0 len %[[VAL_14]] : (!fir.heap<!fir.char<1,10>>, !fir.ref<!fir.char<1,5>>, index) -> !hlfir.expr<!fir.char<1,15>>
+
+subroutine character_allocatable_dyn_len(x, l)
+ integer(8) :: l
+ character(l), allocatable :: x
+ call takes_char(x)
+ call takes_char(x//"hello")
+end subroutine
+! CHECK-LABEL: func.func @_QPcharacter_allocatable_dyn_len(
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] {uniq_name = {{.*}}El"}
+! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<i64>
+! CHECK: %[[VAL_4:.*]] = arith.constant 0 : i64
+! CHECK: %[[VAL_5:.*]] = arith.cmpi sgt, %[[VAL_3]], %[[VAL_4]] : i64
+! CHECK: %[[VAL_6:.*]] = arith.select %[[VAL_5]], %[[VAL_3]], %[[VAL_4]] : i64
+! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] typeparams %[[VAL_6:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = {{.*}}Ex"}
+! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+! CHECK: %[[VAL_9:.*]] = fir.box_addr %[[VAL_8]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
+! CHECK: %[[VAL_10:.*]] = fir.emboxchar %[[VAL_9]], %[[VAL_6]] : (!fir.heap<!fir.char<1,?>>, i64) -> !fir.boxchar<1>
+! CHECK: fir.call @_QPtakes_char(%[[VAL_10]]) {{.*}} : (!fir.boxchar<1>) -> ()
+! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+! CHECK: %[[VAL_12:.*]] = fir.box_addr %[[VAL_11]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
+! CHECK: %[[VAL_13:.*]] = fir.emboxchar %[[VAL_12]], %[[VAL_6]] : (!fir.heap<!fir.char<1,?>>, i64) -> !fir.boxchar<1>
+! CHECK: %[[VAL_16:.*]]:2 = hlfir.declare %[[VAL_14:[a-z0-9]*]] typeparams %[[VAL_15:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<parameter>
+! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_6]] : (i64) -> index
+! CHECK: %[[VAL_18:.*]] = arith.addi %[[VAL_17]], %[[VAL_15]] : index
+! CHECK: %[[VAL_19:.*]] = hlfir.concat %[[VAL_13]], %[[VAL_16]]#0 len %[[VAL_18]] : (!fir.boxchar<1>, !fir.ref<!fir.char<1,5>>, index) -> !hlfir.expr<!fir.char<1,?>>
+
+subroutine print_allocatable(x)
+ real, allocatable :: x(:)
+ print *, x
+end subroutine
+! CHECK-LABEL: func.func @_QPprint_allocatable(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = {{.*}}Ex"}
+! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_1]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.box<none>
+! CHECK: %[[VAL_9:.*]] = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[VAL_8]])
+
+subroutine print_pointer(x)
+ real, pointer :: x(:)
+ print *, x
+end subroutine
+! CHECK-LABEL: func.func @_QPprint_pointer(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = {{.*}}Ex"}
+! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_1]]#1 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
+! CHECK: %[[VAL_9:.*]] = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[VAL_8]])
+
+subroutine elemental_expr(x)
+ integer, pointer :: x(:, :)
+ call takes_array_2(x+42)
+end subroutine
+! CHECK-LABEL: func.func @_QPelemental_expr(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = {{.*}}Ex"}
+! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xi32>>>>
+! CHECK: %[[VAL_3:.*]] = arith.constant 42 : i32
+! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_6:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_7:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_8:.*]] = fir.shape %[[VAL_5]]#1, %[[VAL_7]]#1 : (index, index) -> !fir.shape<2>
+! CHECK: %[[VAL_9:.*]] = hlfir.elemental %[[VAL_8]] : (!fir.shape<2>) -> !hlfir.expr<?x?xi32> {
+! CHECK: ^bb0(%[[VAL_10:.*]]: index, %[[VAL_11:.*]]: index):
+! CHECK: %[[VAL_12:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_13:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_12]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_14:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_15:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_14]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_16:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_17:.*]] = arith.subi %[[VAL_13]]#0, %[[VAL_16]] : index
+! CHECK: %[[VAL_18:.*]] = arith.addi %[[VAL_10]], %[[VAL_17]] : index
+! CHECK: %[[VAL_19:.*]] = arith.subi %[[VAL_15]]#0, %[[VAL_16]] : index
+! CHECK: %[[VAL_20:.*]] = arith.addi %[[VAL_11]], %[[VAL_19]] : index
+! CHECK: %[[VAL_21:.*]] = hlfir.designate %[[VAL_2]] (%[[VAL_18]], %[[VAL_20]]) : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index, index) -> !fir.ref<i32>
+! CHECK: %[[VAL_22:.*]] = fir.load %[[VAL_21]] : !fir.ref<i32>
+! CHECK: %[[VAL_23:.*]] = arith.addi %[[VAL_22]], %[[VAL_3]] : i32
+! CHECK: hlfir.yield_element %[[VAL_23]] : i32
+! CHECK: }
More information about the flang-commits
mailing list