diff --git a/flang/include/flang/Lower/OpenACC.h b/flang/include/flang/Lower/OpenACC.h --- a/flang/include/flang/Lower/OpenACC.h +++ b/flang/include/flang/Lower/OpenACC.h @@ -40,6 +40,7 @@ namespace semantics { class SemanticsContext; +class Symbol; } namespace lower { @@ -86,6 +87,14 @@ mlir::Location, mlir::Type); +void attachDeclarePostAllocAction(AbstractConverter &, fir::FirOpBuilder &, + const Fortran::semantics::Symbol &); +void attachDeclarePreDeallocAction(AbstractConverter &, fir::FirOpBuilder &, + mlir::Value beginOpValue, + const Fortran::semantics::Symbol &); +void attachDeclarePostDeallocAction(AbstractConverter &, fir::FirOpBuilder &, + const Fortran::semantics::Symbol &); + } // namespace lower } // namespace Fortran diff --git a/flang/include/flang/Optimizer/Builder/MutableBox.h b/flang/include/flang/Optimizer/Builder/MutableBox.h --- a/flang/include/flang/Optimizer/Builder/MutableBox.h +++ b/flang/include/flang/Optimizer/Builder/MutableBox.h @@ -131,8 +131,8 @@ mlir::ValueRange lenParams, llvm::StringRef allocName, bool mustBeHeap = false); -void genInlinedDeallocate(fir::FirOpBuilder &builder, mlir::Location loc, - const fir::MutableBoxValue &box); +mlir::Value genInlinedDeallocate(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box); /// When the MutableBoxValue was passed as a fir.ref to a call that may /// have modified it, update the MutableBoxValue according to the diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp --- a/flang/lib/Lower/Allocatable.cpp +++ b/flang/lib/Lower/Allocatable.cpp @@ -16,6 +16,7 @@ #include "flang/Lower/ConvertType.h" #include "flang/Lower/IterationSpace.h" #include "flang/Lower/Mangler.h" +#include "flang/Lower/OpenACC.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/Runtime.h" #include "flang/Lower/StatementContext.h" @@ -387,6 +388,7 @@ genSourceMoldAllocation(alloc, boxAddr, /*isSource=*/false); else genSimpleAllocation(alloc, boxAddr); + postAllocationAction(alloc); } static bool lowerBoundsAreOnes(const Allocation &alloc) { @@ -442,6 +444,12 @@ /*mustBeHeap=*/true); } + void postAllocationAction(const Allocation &alloc) { + if (alloc.getSymbol().test(Fortran::semantics::Symbol::Flag::AccDeclare)) + Fortran::lower::attachDeclarePostAllocAction(converter, builder, + alloc.getSymbol()); + } + void genSimpleAllocation(const Allocation &alloc, const fir::MutableBoxValue &box) { if (!box.isDerived() && !errorManager.hasStatSpec() && @@ -730,16 +738,15 @@ //===----------------------------------------------------------------------===// // Generate deallocation of a pointer/allocatable. -static void genDeallocate(fir::FirOpBuilder &builder, mlir::Location loc, - const fir::MutableBoxValue &box, - ErrorManager &errorManager, - mlir::Value declaredTypeDesc = {}) { +static mlir::Value genDeallocate(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box, + ErrorManager &errorManager, + mlir::Value declaredTypeDesc = {}) { // Deallocate intrinsic types inline. if (!box.isDerived() && !box.isPolymorphic() && !box.isUnlimitedPolymorphic() && !errorManager.hasStatSpec() && !useAllocateRuntime) { - fir::factory::genInlinedDeallocate(builder, loc, box); - return; + return fir::factory::genInlinedDeallocate(builder, loc, box); } // Use runtime calls to deallocate descriptor cases. Sync MutableBoxValue // with its descriptor before and after calls if needed. @@ -748,6 +755,7 @@ genRuntimeDeallocate(builder, loc, box, errorManager, declaredTypeDesc); fir::factory::syncMutableBoxFromIRBox(builder, loc, box); errorManager.assignStat(builder, loc, stat); + return stat; } void Fortran::lower::genDeallocateBox( @@ -762,6 +770,22 @@ genDeallocate(builder, loc, box, errorManager, declaredTypeDesc); } +static void preDeallocationAction(Fortran::lower::AbstractConverter &converter, + fir::FirOpBuilder &builder, + mlir::Value beginOpValue, + const Fortran::semantics::Symbol &sym) { + if (sym.test(Fortran::semantics::Symbol::Flag::AccDeclare)) + Fortran::lower::attachDeclarePreDeallocAction(converter, builder, + beginOpValue, sym); +} + +static void postDeallocationAction(Fortran::lower::AbstractConverter &converter, + fir::FirOpBuilder &builder, + const Fortran::semantics::Symbol &sym) { + if (sym.test(Fortran::semantics::Symbol::Flag::AccDeclare)) + Fortran::lower::attachDeclarePostDeallocAction(converter, builder, sym); +} + void Fortran::lower::genDeallocateStmt( Fortran::lower::AbstractConverter &converter, const Fortran::parser::DeallocateStmt &stmt, mlir::Location loc) { @@ -784,12 +808,11 @@ mlir::OpBuilder::InsertPoint insertPt = builder.saveInsertionPoint(); for (const Fortran::parser::AllocateObject &allocateObject : std::get>(stmt.t)) { + const Fortran::semantics::Symbol &symbol = unwrapSymbol(allocateObject); fir::MutableBoxValue box = genMutableBoxValue(converter, loc, allocateObject); - mlir::Value declaredTypeDesc = {}; if (box.isPolymorphic()) { - const Fortran::semantics::Symbol &symbol = unwrapSymbol(allocateObject); assert(symbol.GetType()); if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec = symbol.GetType()->AsDerived()) { @@ -797,7 +820,10 @@ Fortran::lower::getTypeDescAddr(converter, loc, *derivedTypeSpec); } } - genDeallocate(builder, loc, box, errorManager, declaredTypeDesc); + mlir::Value beginOpValue = + genDeallocate(builder, loc, box, errorManager, declaredTypeDesc); + preDeallocationAction(converter, builder, beginOpValue, symbol); + postDeallocationAction(converter, builder, symbol); } builder.restoreInsertionPoint(insertPt); } diff --git a/flang/lib/Lower/OpenACC.cpp b/flang/lib/Lower/OpenACC.cpp --- a/flang/lib/Lower/OpenACC.cpp +++ b/flang/lib/Lower/OpenACC.cpp @@ -2780,3 +2780,44 @@ }, accDeclConstruct.u); } + +void Fortran::lower::attachDeclarePostAllocAction( + AbstractConverter &converter, fir::FirOpBuilder &builder, + const Fortran::semantics::Symbol &sym) { + std::stringstream fctName; + fctName << converter.mangleName(sym) << declarePostAllocSuffix.str(); + mlir::Operation &op = builder.getInsertionBlock()->back(); + op.setAttr(mlir::acc::getDeclareActionAttrName(), + mlir::acc::DeclareActionAttr::get( + builder.getContext(), + /*preAlloc=*/{}, + /*postAlloc=*/builder.getSymbolRefAttr(fctName.str()), + /*preDealloc=*/{}, /*postDealloc=*/{})); +} + +void Fortran::lower::attachDeclarePreDeallocAction( + AbstractConverter &converter, fir::FirOpBuilder &builder, + mlir::Value beginOpValue, const Fortran::semantics::Symbol &sym) { + std::stringstream fctName; + fctName << converter.mangleName(sym) << declarePreDeallocSuffix.str(); + beginOpValue.getDefiningOp()->setAttr( + mlir::acc::getDeclareActionAttrName(), + mlir::acc::DeclareActionAttr::get( + builder.getContext(), + /*preAlloc=*/{}, /*postAlloc=*/{}, + /*preDealloc=*/builder.getSymbolRefAttr(fctName.str()), + /*postDealloc=*/{})); +} + +void Fortran::lower::attachDeclarePostDeallocAction( + AbstractConverter &converter, fir::FirOpBuilder &builder, + const Fortran::semantics::Symbol &sym) { + std::stringstream fctName; + fctName << converter.mangleName(sym) << declarePostAllocSuffix.str(); + mlir::Operation &op = builder.getInsertionBlock()->back(); + op.setAttr(mlir::acc::getDeclareActionAttrName(), + mlir::acc::DeclareActionAttr::get( + builder.getContext(), + /*preAlloc=*/{}, /*postAlloc=*/{}, /*preDealloc=*/{}, + /*postDealloc=*/builder.getSymbolRefAttr(fctName.str()))); +} diff --git a/flang/lib/Optimizer/Builder/MutableBox.cpp b/flang/lib/Optimizer/Builder/MutableBox.cpp --- a/flang/lib/Optimizer/Builder/MutableBox.cpp +++ b/flang/lib/Optimizer/Builder/MutableBox.cpp @@ -753,12 +753,14 @@ fir::MustBeHeapAttr::get(builder.getContext(), mustBeHeap)); } -void fir::factory::genInlinedDeallocate(fir::FirOpBuilder &builder, - mlir::Location loc, - const fir::MutableBoxValue &box) { +mlir::Value +fir::factory::genInlinedDeallocate(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box) { auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress(); genFinalizeAndFree(builder, loc, addr); MutablePropertyWriter{builder, loc, box}.setUnallocatedStatus(); + return addr; } fir::factory::MutableBoxReallocation fir::factory::genReallocIfNeeded( diff --git a/flang/test/Lower/OpenACC/acc-declare.f90 b/flang/test/Lower/OpenACC/acc-declare.f90 --- a/flang/test/Lower/OpenACC/acc-declare.f90 +++ b/flang/test/Lower/OpenACC/acc-declare.f90 @@ -265,6 +265,24 @@ ! CHECK: %[[DEVICEPTR:.*]] = acc.deviceptr varPtr(%[[ALLOCA]] : !fir.ref>) bounds(%{{.*}}) -> !fir.ref> {name = "dataparam"} ! CHECK: acc.declare_enter dataOperands(%[[DEVICEPTR]] : !fir.ref>) + subroutine acc_declare_allocate() + integer, allocatable :: a(:) + !$acc declare create(a) + + allocate(a(100)) + +! CHECK: %{{.*}} = fir.allocmem !fir.array, %{{.*}} {fir.must_be_heap = true, uniq_name = "_QMacc_declareFacc_declare_allocateEa.alloc"} +! CHECK: fir.store %{{.*}} to %{{.*}} {acc.declare_action = #acc.declare_action} : !fir.ref>>> + + deallocate(a) + +! CHECK: %{{.*}} = fir.box_addr %{{.*}} {acc.declare_action = #acc.declare_action} : (!fir.box>>) -> !fir.heap> + +! CHECK: fir.freemem %{{.*}} : !fir.heap> +! CHECK: fir.store %{{.*}} to %{{.*}} {acc.declare_action = #acc.declare_action} : !fir.ref>>> + + end subroutine + end module module acc_declare_allocatable_test @@ -314,3 +332,21 @@ ! CHECK: acc.delete accPtr(%[[DEVICEPTR]] : !fir.ref>>>) {dataClause = #acc, name = "data1", structured = false} ! CHECK: acc.terminator ! CHECK: } + +! Test that the pre/post alloc/dealloc attributes are set when the +! allocate/deallocate statement are in a different module. +module acc_declare_allocatable_test2 +contains + subroutine init() + use acc_declare_allocatable_test + allocate(data1(100)) +! CHECK: fir.store %{{.*}} to %{{.*}} {acc.declare_action = #acc.declare_action} : !fir.ref>>> + end subroutine + + subroutine finalize() + use acc_declare_allocatable_test + deallocate(data1) +! CHECK: %{{.*}} = fir.box_addr %{{.*}} {acc.declare_action = #acc.declare_action} : (!fir.box>>) -> !fir.heap> +! CHECK: fir.store %{{.*}} to %{{.*}} {acc.declare_action = #acc.declare_action} : !fir.ref>>> + end subroutine +end module