diff --git a/flang-rt/lib/runtime/CMakeLists.txt b/flang-rt/lib/runtime/CMakeLists.txt index 7fa8c2cb95417..b55c4b8662dbb 100644 --- a/flang-rt/lib/runtime/CMakeLists.txt +++ b/flang-rt/lib/runtime/CMakeLists.txt @@ -23,6 +23,7 @@ set(supported_sources assign.cpp buffer.cpp character.cpp + coarray.cpp connection.cpp copy.cpp derived-api.cpp diff --git a/flang-rt/lib/runtime/coarray.cpp b/flang-rt/lib/runtime/coarray.cpp new file mode 100644 index 0000000000000..11589efc16b72 --- /dev/null +++ b/flang-rt/lib/runtime/coarray.cpp @@ -0,0 +1,38 @@ +//===-- runtime/coarray.cpp -----------------------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Runtime/coarray.h" +#include "flang-rt/runtime/descriptor.h" +#include "flang-rt/runtime/type-info.h" + +namespace Fortran::runtime { + +extern "C" { +RT_EXT_API_GROUP_BEGIN + +void RTDEF(ComputeLastUcobound)( + int num_images, const Descriptor &lcobounds, const Descriptor &ucobounds) { + int corank = ucobounds.GetDimension(0).Extent(); + int64_t *lcobounds_ptr = (int64_t *)lcobounds.raw().base_addr; + int64_t *ucobounds_ptr = (int64_t *)ucobounds.raw().base_addr; + int64_t index = 1; + for (int i = 0; i < corank - 1; i++) { + index *= ucobounds_ptr[i] - lcobounds_ptr[i] + 1; + } + if (corank == 1) + ucobounds_ptr[0] = num_images - lcobounds_ptr[0] + 1; + else if (index < num_images) + ucobounds_ptr[corank - 1] = + (num_images / index) + (num_images % index != 0); + else + ucobounds_ptr[corank - 1] = lcobounds_ptr[corank - 1]; +} + +RT_EXT_API_GROUP_END +} +} // namespace Fortran::runtime diff --git a/flang/include/flang/Lower/MultiImageFortran.h b/flang/include/flang/Lower/MultiImageFortran.h index 82d415a219ae9..f029133c046cd 100644 --- a/flang/include/flang/Lower/MultiImageFortran.h +++ b/flang/include/flang/Lower/MultiImageFortran.h @@ -59,6 +59,25 @@ void genEndChangeTeamStmt(AbstractConverter &, pft::Evaluation &eval, void genFormTeamStatement(AbstractConverter &, pft::Evaluation &eval, const parser::FormTeamStmt &); +//===----------------------------------------------------------------------===// +// COARRAY utils +//===----------------------------------------------------------------------===// + +mlir::DenseI64ArrayAttr genLowerCoBounds(AbstractConverter &converter, + mlir::Location loc, + const semantics::Symbol &sym); + +mlir::DenseI64ArrayAttr genUpperCoBounds(AbstractConverter &converter, + mlir::Location loc, + const semantics::Symbol &sym); + +mlir::Value genAllocateCoarray( + AbstractConverter &converter, mlir::Location loc, + const semantics::Symbol &sym, mlir::Value addr, + const std::optional &allocSpec = + std::nullopt, + mlir::Value errMsg = {}, bool hasStat = false); + //===----------------------------------------------------------------------===// // COARRAY expressions //===----------------------------------------------------------------------===// diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h index 0b62ca1292d99..a79b73a8b02d1 100644 --- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h +++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h @@ -219,6 +219,7 @@ struct IntrinsicLibrary { llvm::ArrayRef); mlir::Value genCmplx(mlir::Type, llvm::ArrayRef); mlir::Value genConjg(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genCoshape(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genCount(mlir::Type, llvm::ArrayRef); void genCpuTime(llvm::ArrayRef); fir::ExtendedValue genCshift(mlir::Type, llvm::ArrayRef); @@ -335,6 +336,8 @@ struct IntrinsicLibrary { mlir::Value genIeeeUnordered(mlir::Type, llvm::ArrayRef); mlir::Value genIeeeValue(mlir::Type, llvm::ArrayRef); mlir::Value genIeor(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genImageIndex(mlir::Type, + llvm::ArrayRef); fir::ExtendedValue genIndex(mlir::Type, llvm::ArrayRef); mlir::Value genIor(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genIparity(mlir::Type, llvm::ArrayRef); @@ -349,6 +352,8 @@ struct IntrinsicLibrary { mlir::Value genIshft(mlir::Type, llvm::ArrayRef); mlir::Value genIshftc(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genLbound(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genLcobound(mlir::Type, + llvm::ArrayRef); mlir::Value genLeadz(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef); @@ -452,6 +457,8 @@ struct IntrinsicLibrary { llvm::ArrayRef); fir::ExtendedValue genTrim(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genUcobound(mlir::Type, + llvm::ArrayRef); fir::ExtendedValue genUnlink(std::optional resultType, llvm::ArrayRef args); fir::ExtendedValue genUnpack(mlir::Type, llvm::ArrayRef); diff --git a/flang/include/flang/Optimizer/Builder/MIFCommon.h b/flang/include/flang/Optimizer/Builder/MIFCommon.h new file mode 100644 index 0000000000000..6339c3255d5d8 --- /dev/null +++ b/flang/include/flang/Optimizer/Builder/MIFCommon.h @@ -0,0 +1,26 @@ +//===-- MIFCommon.h -------------------------------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_OPTIMIZER_TRANSFORMS_MIFCOMMON_H_ +#define FORTRAN_OPTIMIZER_TRANSFORMS_MIFCOMMON_H_ + +#include "flang/Lower/AbstractConverter.h" +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Dialect/MIF/MIFOps.h" +#include "flang/Runtime/coarray.h" +#include "mlir/IR/BuiltinOps.h" + +static constexpr llvm::StringRef coarrayHandleSuffix = "_coarray_handle"; + +namespace mif { + +std::string getFullUniqName(mlir::Value addr); + +} // namespace mif + +#endif // FORTRAN_OPTIMIZER_TRANSFORMS_MIFCOMMON_H_ diff --git a/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h b/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h index b014d925592cb..9e168ffe90d0d 100644 --- a/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h +++ b/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h @@ -136,6 +136,9 @@ static constexpr llvm::StringRef getAccessGroupsAttrName() { return "access_groups"; } +/// Attribute to mark coarray Fortran entities with the CORANK attribute. +constexpr llvm::StringRef getCorankAttrName() { return "fir.corank"; } + /// Does the function, \p func, have a host-associations tuple argument? /// Some internal procedures may have access to host procedure variables. bool hasHostAssociationArgument(mlir::func::FuncOp func); diff --git a/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td b/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td index 0d95123b0f9e5..556d9edc40c15 100644 --- a/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td +++ b/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td @@ -17,6 +17,7 @@ include "flang/Optimizer/Dialect/MIF/MIFDialect.td" include "flang/Optimizer/Dialect/FIRTypes.td" include "flang/Optimizer/Dialect/FIRAttr.td" +include "mlir/IR/BuiltinAttributes.td" class mif_Op traits> : Op; @@ -101,11 +102,13 @@ def mif_ThisImageOp : mif_Op<"this_image", [AttrSizedOperandSegments]> { value 5, `this_image(A)` has the value [5, 0, 0]. }]; - let arguments = (ins Optional:$coarray, - Optional:$dim, Optional:$team); - let results = (outs I32:$res); + let arguments = (ins Optional:$coarray, Optional:$dim, + Optional:$team); + let results = (outs AnyType:$res); - let builders = [OpBuilder<(ins "mlir::Value":$coarray, "mlir::Value":$team)>, + let builders = [OpBuilder<(ins "mlir::Value":$coarray, "mlir::Value":$dim, + "mlir::Value":$team)>, + OpBuilder<(ins "mlir::Value":$coarray, "mlir::Value":$team)>, OpBuilder<(ins "mlir::Value":$team)>]; let hasVerifier = 1; @@ -117,6 +120,124 @@ def mif_ThisImageOp : mif_Op<"this_image", [AttrSizedOperandSegments]> { }]; } +//===----------------------------------------------------------------------===// +// Coarray Queries +//===----------------------------------------------------------------------===// + +def mif_ImageIndexOp : mif_Op<"image_index", [AttrSizedOperandSegments]> { + let summary = "Image index from cosubscripts."; + let description = [{ + Arguments: + - `coarray`: Shall be a coarray of any type. + - `sub`: rank-one integer array of size equal to the corank of `coarray`. + - `team`: Shall be a scalar of type `team_type` from ISO_FORTRAN_ENV. + - `team_number`: It shall identify the initial team or a sibling team + of the current team. + + Usage: + - Case(1) : `call image_index(coarray, sub)` + - Case(2) : `call image_index(coarray, sub, team)` + - Case(3) : `call image_index(coarray, sub, team_number)` + + Result: If the value of `sub` is a valid sequence of cosubscripts for `coarray` in the + team specified by `team` or `team_number`, or the current team if neither `team` nor + `team_number` appears, the result is the index of the corresponding image in that team. + Otherwise, the result is zero. + }]; + + let arguments = (ins AnyType:$coarray, fir_BoxType:$sub, + Optional:$team, Optional:$team_number); + let builders = [OpBuilder<(ins "mlir::Value":$coarray, "mlir::Value":$sub, + "mlir::Value":$team)>]; + + let results = (outs I32); + + let hasVerifier = 1; + let assemblyFormat = [{ + `coarray` $coarray `sub` $sub + ( `team` $team^ )? + ( `team_number` $team_number^ )? + attr-dict `:` functional-type(operands, results) + }]; +} + +def mif_LcoboundOp : mif_Op<"lcobound", [NoMemoryEffect]> { + let summary = "Returns the lower cobound(s) associated with a coarray."; + let description = [{ + This operation returns the lower cobound(s) associated with a coarray. + Arguments: + - `coarray`: Shall be a coarray of any type. + - `dim`(optional) : Shall be an integer scalar. Its value shall be in the range of + `1 <= DIM <= N`, where `N` is the corank of the coarray. + Results: + - Case(1): If `dim` is present, the result is an integer scalar equal to + the lower cobound for codimension `dim`. + - Case(2): `dim` is absent, so the result is an array whose size matches + the corank of the indicated coarray. + }]; + + let arguments = (ins AnyType:$coarray, Optional:$dim); + let results = (outs AnyType); + + let builders = [OpBuilder<(ins "mlir::Value":$coarray, "mlir::Value":$dim)>, + OpBuilder<(ins "mlir::Value":$coarray)>]; + + let hasVerifier = 1; + let assemblyFormat = [{ + `coarray` $coarray + ( `dim` $dim^ )? + attr-dict `:` functional-type(operands, results) + }]; +} + +def mif_UcoboundOp : mif_Op<"ucobound", [NoMemoryEffect]> { + let summary = "Returns the upper cobound(s) associated with a coarray."; + let description = [{ + This operation returns the upper cobound(s) associated with a coarray. + Arguments: + - `coarray`: Shall be a coarray of any type. + - `dim`(optional) : Shall be an integer scalar. Its value shall be in the range of + `1 <= DIM <= N`, where `N` is the corank of the coarray. + Results: + - Case(1): If `dim` is present, the result is an integer scalar equal to + the upper cobound for codimension `dim`. + - Case(2): `dim` is absent, so the result is an array whose size matches + the corank of the indicated coarray. + }]; + + let arguments = (ins AnyType:$coarray, Optional:$dim); + let results = (outs AnyType); + + let builders = [OpBuilder<(ins "mlir::Value":$coarray, "mlir::Value":$dim)>, + OpBuilder<(ins "mlir::Value":$coarray)>]; + + let hasVerifier = 1; + let assemblyFormat = [{ + `coarray` $coarray + ( `dim` $dim^ )? + attr-dict `:` functional-type(operands, results) + }]; +} + +def mif_CoshapeOp : mif_Op<"coshape", [NoMemoryEffect]> { + let summary = "Return the sizes of codimensions of a coarray."; + let description = [{ + Argument: `coarray`: Shall be a coarray of any type. + Result : Is an array whose size matches the corank of the indicated coarray and + returns `UCOBOUND - LCOBOUND + 1`. + }]; + + let arguments = (ins AnyType:$coarray); + let builders = [OpBuilder<(ins "mlir::Value":$coarray)>]; + let results = (outs AnyBoxedArray); + + let hasVerifier = 1; + let assemblyFormat = [{ + `coarray` $coarray + attr-dict `:` functional-type(operands, results) + }]; +} + //===----------------------------------------------------------------------===// // Synchronization //===----------------------------------------------------------------------===// @@ -425,4 +546,59 @@ def mif_TeamNumberOp : mif_Op<"team_number", []> { }]; } +//===----------------------------------------------------------------------===// +// Allocation and Deallocation +//===----------------------------------------------------------------------===// + +def mif_AllocCoarrayOp + : mif_Op<"alloc_coarray", [AttrSizedOperandSegments, + MemoryEffects<[MemAlloc]>]> { + let summary = "Perform the allocation of a coarray and provide a " + "corresponding coarray descriptor"; + + let description = [{ + This operation allocates a coarray and provides the corresponding + coarray descriptor. This call is collective over the current team. + }]; + + let arguments = (ins StrAttr:$uniq_name, + Arg:$box, + DenseI64ArrayAttr:$lcobounds, DenseI64ArrayAttr:$ucobounds, + Arg, "", [MemWrite]>:$stat, + Arg, "", [MemWrite]>:$errmsg); + + let builders = [OpBuilder<(ins "mlir::Value":$box, "llvm::StringRef":$symName, + "mlir::DenseI64ArrayAttr":$lcobounds, + "mlir::DenseI64ArrayAttr":$ucobounds, "mlir::Value":$stat, + "mlir::Value":$errmsg)>, + OpBuilder<(ins "mlir::Value":$box, "llvm::StringRef":$symName, + "mlir::DenseI64ArrayAttr":$lcobounds, + "mlir::DenseI64ArrayAttr":$ucobounds)>]; + + let hasVerifier = 1; + let assemblyFormat = [{ + $box + (`stat` $stat^ )? + (`errmsg` $errmsg^ )? + attr-dict `:` functional-type(operands, results) + }]; +} + +def mif_DeallocCoarrayOp + : mif_Op<"dealloc_coarray", [AttrSizedOperandSegments, + MemoryEffects<[MemFree]>]> { + let summary = "Perform the deallocation of a coarray"; + let description = [{ + This call releases memory allocated by `mif_AllocCoarrayOp` for a coarray. + }]; + let arguments = (ins Arg:$coarray, + Arg, "", [MemWrite]>:$stat, + Arg, "", [MemWrite]>:$errmsg); + + let assemblyFormat = [{ + $coarray (`stat` $stat^ )? (`errmsg` $errmsg^ )? + attr-dict `:` functional-type(operands, results) + }]; +} + #endif // FORTRAN_DIALECT_MIF_MIF_OPS diff --git a/flang/include/flang/Optimizer/Transforms/MIFOpConversion.h b/flang/include/flang/Optimizer/Transforms/MIFOpConversion.h index 93c724748102c..6b9e71496e847 100644 --- a/flang/include/flang/Optimizer/Transforms/MIFOpConversion.h +++ b/flang/include/flang/Optimizer/Transforms/MIFOpConversion.h @@ -20,7 +20,9 @@ class LLVMTypeConverter; namespace mif { /// Patterns that convert MIF operations to runtime calls. -void populateMIFOpConversionPatterns(mlir::RewritePatternSet &patterns); +void populateMIFOpConversionPatterns(const fir::LLVMTypeConverter &converter, + mlir::DataLayout &dl, + mlir::RewritePatternSet &patterns); } // namespace mif diff --git a/flang/include/flang/Runtime/coarray.h b/flang/include/flang/Runtime/coarray.h new file mode 100644 index 0000000000000..4519179489147 --- /dev/null +++ b/flang/include/flang/Runtime/coarray.h @@ -0,0 +1,24 @@ +//===-- include/flang/Runtime/coarray.h --------------------------*- C++-*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_RUNTIME_COARRAY_H +#define FORTRAN_RUNTIME_COARRAY_H + +#include "flang/Runtime/descriptor-consts.h" +#include "flang/Runtime/entry-names.h" + +namespace Fortran::runtime { +// class Descriptor; +extern "C" { + +void RTDECL(ComputeLastUcobound)( + int num_images, const Descriptor &lcobounds, const Descriptor &ucobounds); +} +} // namespace Fortran::runtime + +#endif // FORTRAN_RUNTIME_COARRAY_H diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp index 1912027f8742d..839a54c651e23 100644 --- a/flang/lib/Lower/Allocatable.cpp +++ b/flang/lib/Lower/Allocatable.cpp @@ -18,6 +18,7 @@ #include "flang/Lower/ConvertVariable.h" #include "flang/Lower/IterationSpace.h" #include "flang/Lower/Mangler.h" +#include "flang/Lower/MultiImageFortran.h" #include "flang/Lower/OpenACC.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/Runtime.h" @@ -29,6 +30,7 @@ #include "flang/Optimizer/Dialect/CUF/CUFOps.h" #include "flang/Optimizer/Dialect/FIROps.h" #include "flang/Optimizer/Dialect/FIROpsSupport.h" +#include "flang/Optimizer/Dialect/MIF/MIFOps.h" #include "flang/Optimizer/HLFIR/HLFIROps.h" #include "flang/Optimizer/Support/FatalError.h" #include "flang/Optimizer/Support/InternalNames.h" @@ -325,11 +327,12 @@ class AllocateStmtHelper { struct Allocation { const Fortran::parser::Allocation &alloc; const Fortran::semantics::DeclTypeSpec &type; - bool hasCoarraySpec() const { + const std::optional & + getCoarraySpec() const { return std::get>( - alloc.t) - .has_value(); + alloc.t); } + bool hasCoarraySpec() const { return getCoarraySpec().has_value(); } const Fortran::parser::AllocateObject &getAllocObj() const { return std::get(alloc.t); } @@ -478,6 +481,29 @@ class AllocateStmtHelper { !box.isPointer(); unsigned allocatorIdx = Fortran::lower::getAllocatorIdx(alloc.getSymbol()); + const Fortran::lower::SomeExpr *expr = + Fortran::semantics::GetExpr(alloc.getAllocObj()); + std::optional dataRef = + !expr ? std::nullopt : Fortran::evaluate::ExtractDataRef(expr); + bool isCoarrayAllocate = alloc.hasCoarraySpec(); + + if (isCoarrayAllocate) { + errorManager.genStatCheck(builder, loc); + genAllocateObjectInit(box, allocatorIdx); + Fortran::lower::StatementContext stmtCtx; + genSetType(alloc, box, loc); + genSetDeferredLengthParameters(alloc, box); + genAllocateObjectBounds(alloc, box); + mlir::Value stat; + stat = Fortran::lower::genAllocateCoarray( + converter, loc, alloc.getSymbol(), box.getAddr(), + alloc.getCoarraySpec(), errorManager.errMsgAddr); + fir::factory::syncMutableBoxFromIRBox(builder, loc, box); + postAllocationAction(alloc, box); + errorManager.assignStat(builder, loc, stat); + return; + } + if (inlineAllocation && ((isCudaAllocate && isCudaDeviceContext) || !isCudaAllocate)) { // Pointers must use PointerAllocate so that their deallocations @@ -501,8 +527,6 @@ class AllocateStmtHelper { // Generate a sequence of runtime calls. errorManager.genStatCheck(builder, loc); genAllocateObjectInit(box, allocatorIdx); - if (alloc.hasCoarraySpec()) - TODO(loc, "coarray: allocation of a coarray object"); if (alloc.type.IsPolymorphic()) genSetType(alloc, box, loc); genSetDeferredLengthParameters(alloc, box); @@ -884,13 +908,32 @@ genDeallocate(fir::FirOpBuilder &builder, Fortran::lower::AbstractConverter &converter, mlir::Location loc, const fir::MutableBoxValue &box, ErrorManager &errorManager, mlir::Value declaredTypeDesc = {}, - const Fortran::semantics::Symbol *symbol = nullptr) { + const Fortran::semantics::Symbol *symbol = nullptr, + const Fortran::lower::SomeExpr *allocExpr = nullptr) { bool isCudaSymbol = symbol && Fortran::semantics::HasCUDAAttr(*symbol); bool isCudaDeviceContext = cuf::isCUDADeviceContext(builder.getRegion()); bool inlineDeallocation = !box.isDerived() && !box.isPolymorphic() && !box.hasAssumedRank() && !box.isUnlimitedPolymorphic() && !errorManager.hasStatSpec() && !useAllocateRuntime && !box.isPointer(); + + std::optional dataRef = + !allocExpr ? std::nullopt : Fortran::evaluate::ExtractDataRef(allocExpr); + bool isCoarraySymbol = symbol && Fortran::evaluate::IsCoarray(*symbol); + + // Deallocate coarray + if (isCoarraySymbol) { + mlir::Value ret = builder.createTemporary(loc, builder.getI32Type()); + mif::DeallocCoarrayOp::create(builder, loc, box.getAddr(), ret, + errorManager.errMsgAddr); + ret = fir::LoadOp::create(builder, loc, ret); + fir::factory::syncMutableBoxFromIRBox(builder, loc, box); + if (symbol) + postDeallocationAction(converter, builder, *symbol); + errorManager.assignStat(builder, loc, ret); + return ret; + } + // Deallocate intrinsic types inline. if (inlineDeallocation && ((isCudaSymbol && isCudaDeviceContext) || !isCudaSymbol)) { @@ -975,6 +1018,8 @@ void Fortran::lower::genDeallocateStmt( for (const Fortran::parser::AllocateObject &allocateObject : std::get>(stmt.t)) { const Fortran::semantics::Symbol &symbol = unwrapSymbol(allocateObject); + const Fortran::lower::SomeExpr *allocExpr = + Fortran::semantics::GetExpr(allocateObject); fir::MutableBoxValue box = genMutableBoxValue(converter, loc, allocateObject); mlir::Value declaredTypeDesc = {}; @@ -987,8 +1032,9 @@ void Fortran::lower::genDeallocateStmt( Fortran::lower::getTypeDescAddr(converter, loc, *derivedTypeSpec); } } - mlir::Value beginOpValue = genDeallocate( - builder, converter, loc, box, errorManager, declaredTypeDesc, &symbol); + mlir::Value beginOpValue = + genDeallocate(builder, converter, loc, box, errorManager, + declaredTypeDesc, &symbol, allocExpr); preDeallocationAction(converter, builder, beginOpValue, symbol); } builder.restoreInsertionPoint(insertPt); diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index d72f74b440c53..17068c1fdc085 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -2149,6 +2149,22 @@ static std::optional genCustomIntrinsicRefCore( loc, builder, result, ".tmp.custom_intrinsic_result")}}; } +static mlir::IntegerAttr +getCorankFromExpr(fir::FirOpBuilder &builder, + const Fortran::lower::SomeExpr &expr) { + mlir::IntegerAttr corankAttr; + if (auto dataRef{Fortran::evaluate::ExtractDataRef(expr)}) { + const Fortran::semantics::Symbol sym = dataRef->GetLastSymbol(); + if (const auto *object = + sym.GetUltimate() + .detailsIf()) + if (object->coshape().size()) + corankAttr = builder.getIntegerAttr(builder.getI32Type(), + object->coshape().size()); + } + return corankAttr; +} + /// Lower calls to intrinsic procedures with actual arguments that have been /// pre-lowered but have not yet been prepared according to the interface. static std::optional @@ -2172,6 +2188,11 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals, const fir::IntrinsicArgumentLoweringRules *argLowering = intrinsicEntry.getArgumentLoweringRules(); for (auto arg : llvm::enumerate(loweredActuals)) { + // Trying to retrieve the corank of a variable if this is a coarray + mlir::IntegerAttr corankAttr; + if (const Fortran::lower::SomeExpr *expr = + callContext.procRef.UnwrapArgExpr(arg.index())) + corankAttr = getCorankFromExpr(builder, *expr); if (!arg.value()) { operands.emplace_back(fir::getAbsentIntrinsicArgument()); continue; @@ -2221,6 +2242,9 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals, genOptionalValue(builder, loc, getActualFortranElementType(), getActualCb, isPresent); addToCleanups(std::move(cleanup)); + if (corankAttr) + fir::getBase(exv).getDefiningOp()->setAttr(fir::getCorankAttrName(), + corankAttr); operands.emplace_back(exv); continue; } @@ -2228,6 +2252,9 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals, hlfir::Entity actual = arg.value()->getActual(loc, builder); auto [exv, cleanup] = genOptionalAddr(builder, loc, actual, isPresent); addToCleanups(std::move(cleanup)); + if (corankAttr) + fir::getBase(exv).getDefiningOp()->setAttr(fir::getCorankAttrName(), + corankAttr); operands.emplace_back(exv); continue; } @@ -2235,6 +2262,9 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals, hlfir::Entity actual = arg.value()->getActual(loc, builder); auto [exv, cleanup] = genOptionalBox(builder, loc, actual, isPresent); addToCleanups(std::move(cleanup)); + if (corankAttr) + fir::getBase(exv).getDefiningOp()->setAttr(fir::getCorankAttrName(), + corankAttr); operands.emplace_back(exv); continue; } @@ -2251,18 +2281,30 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals, } hlfir::Entity actual = arg.value()->getActual(loc, builder); + fir::ExtendedValue exv; switch (argRules.lowerAs) { case fir::LowerIntrinsicArgAs::Value: - operands.emplace_back( - Fortran::lower::convertToValue(loc, converter, actual, stmtCtx)); + exv = Fortran::lower::convertToValue(loc, converter, actual, stmtCtx); + if (corankAttr) + fir::getBase(exv).getDefiningOp()->setAttr(fir::getCorankAttrName(), + corankAttr); + operands.emplace_back(exv); continue; case fir::LowerIntrinsicArgAs::Addr: - operands.emplace_back(Fortran::lower::convertToAddress( - loc, converter, actual, stmtCtx, getActualFortranElementType())); + exv = Fortran::lower::convertToAddress(loc, converter, actual, stmtCtx, + getActualFortranElementType()); + if (corankAttr) + fir::getBase(exv).getDefiningOp()->setAttr(fir::getCorankAttrName(), + corankAttr); + operands.emplace_back(exv); continue; case fir::LowerIntrinsicArgAs::Box: - operands.emplace_back(Fortran::lower::convertToBox( - loc, converter, actual, stmtCtx, getActualFortranElementType())); + exv = Fortran::lower::convertToBox(loc, converter, actual, stmtCtx, + getActualFortranElementType()); + if (corankAttr) + fir::getBase(exv).getDefiningOp()->setAttr(fir::getCorankAttrName(), + corankAttr); + operands.emplace_back(exv); continue; case fir::LowerIntrinsicArgAs::Inquired: if (const Fortran::lower::SomeExpr *expr = @@ -2934,6 +2976,10 @@ genCustomIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic *intrinsic, } if (!exv) llvm_unreachable("bad switch"); + if (mlir::IntegerAttr corankAttr = getCorankFromExpr(builder, expr)) + fir::getBase(*exv).getDefiningOp()->setAttr(fir::getCorankAttrName(), + corankAttr); + actual = extendedValueToHlfirEntity(loc, builder, exv.value(), "tmp.custom_intrinsic_arg"); loweredActuals.emplace_back(Fortran::lower::PreparedActualArgument{ diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp index 0ededb364bfea..2e308324d09ae 100644 --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -21,6 +21,7 @@ #include "flang/Lower/ConvertExprToHLFIR.h" #include "flang/Lower/ConvertProcedureDesignator.h" #include "flang/Lower/Mangler.h" +#include "flang/Lower/MultiImageFortran.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/StatementContext.h" #include "flang/Lower/Support/Utils.h" @@ -36,6 +37,7 @@ #include "flang/Optimizer/Dialect/FIRAttr.h" #include "flang/Optimizer/Dialect/FIRDialect.h" #include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Dialect/MIF/MIFOps.h" #include "flang/Optimizer/Dialect/Support/FIRContext.h" #include "flang/Optimizer/HLFIR/HLFIROps.h" #include "flang/Optimizer/Support/FatalError.h" @@ -1132,6 +1134,23 @@ static void instantiateLocal(Fortran::lower::AbstractConverter &converter, }); } } + if (Fortran::evaluate::IsCoarray(var.getSymbol()) && + !Fortran::semantics::IsAllocatableOrPointer(var.getSymbol()) && + !Fortran::semantics::IsDummy(var.getSymbol())) { + mlir::Location loc = converter.getCurrentLocation(); + fir::ExtendedValue exv = + converter.getSymbolExtendedValue(var.getSymbol(), &symMap); + auto *sym = &var.getSymbol(); + const Fortran::semantics::Scope &owner = sym->owner(); + if (owner.kind() != Fortran::semantics::Scope::Kind::MainProgram) { + auto *converterPtr = &converter; + converter.getFctCtx().attachCleanup([converterPtr, builder, loc, exv]() { + mif::DeallocCoarrayOp::create(*builder, loc, fir::getBase(exv), + /*stat*/ mlir::Value{}, + /*errmsg*/ mlir::Value{}); + }); + } + } if (std::optional cleanup = needDeallocationOrFinalization(var)) { auto *builder = &converter.getFirOpBuilder(); @@ -2186,6 +2205,11 @@ void Fortran::lower::mapSymbolAttributes( } if (isDummy) { + if (Fortran::evaluate::IsCoarray(sym)) + // Operation in MIF dialect to create an alias of the coarray not + // yet supported (by using the procedure provided by PRIF). + TODO(loc, "coarray dummy argument not yet supported."); + mlir::Value dummyArg = symMap.lookupSymbol(sym).getAddr(); if (lowerToBoxValue(sym, dummyArg, converter)) { llvm::SmallVector lbounds; @@ -2480,6 +2504,13 @@ void Fortran::lower::mapSymbolAttributes( } } + if (Fortran::evaluate::IsCoarray(sym)) { + Fortran::lower::genAllocateCoarray(converter, loc, sym, addr); + ::genDeclareSymbol(converter, symMap, sym, addr, len, extents, lbounds, + replace); + return; + } + // Allocate or extract raw address for the entity if (!addr) { if (arg) { diff --git a/flang/lib/Lower/MultiImageFortran.cpp b/flang/lib/Lower/MultiImageFortran.cpp index 4f5b6a500d24f..a498a10f3e74b 100644 --- a/flang/lib/Lower/MultiImageFortran.cpp +++ b/flang/lib/Lower/MultiImageFortran.cpp @@ -15,6 +15,7 @@ #include "flang/Lower/AbstractConverter.h" #include "flang/Lower/SymbolMap.h" #include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Optimizer/Builder/MIFCommon.h" #include "flang/Optimizer/Builder/Todo.h" #include "flang/Parser/parse-tree.h" #include "flang/Semantics/expression.h" @@ -257,6 +258,135 @@ void Fortran::lower::genFormTeamStatement( errMsgAddr); } +//===----------------------------------------------------------------------===// +// COARRAY utils +//===----------------------------------------------------------------------===// + +mlir::DenseI64ArrayAttr +Fortran::lower::genLowerCoBounds(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, + const Fortran::semantics::Symbol &sym) { + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + mlir::DenseI64ArrayAttr lcobounds; + + if (Fortran::semantics::IsAllocatableOrObjectPointer(&sym)) + return {}; + if (const auto *object = + sym.GetUltimate() + .detailsIf()) { + llvm::SmallVector lcbs; + for (const Fortran::semantics::ShapeSpec &cobounds : object->coshape()) { + if (auto lb = cobounds.lbound().GetExplicit()) { + if (auto constant = Fortran::evaluate::ToInt64(*lb)) + lcbs.push_back(*constant); + else + lcbs.push_back(1); // default lcobounds + } + } + lcobounds = mlir::DenseI64ArrayAttr::get(builder.getContext(), lcbs); + } + return lcobounds; +} + +mlir::DenseI64ArrayAttr +Fortran::lower::genUpperCoBounds(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, + const Fortran::semantics::Symbol &sym) { + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + mlir::DenseI64ArrayAttr ucobounds; + + if (Fortran::semantics::IsAllocatableOrObjectPointer(&sym)) + return {}; + if (const auto *object = + sym.GetUltimate() + .detailsIf()) { + llvm::SmallVector ucbs; + for (const Fortran::semantics::ShapeSpec &cobounds : object->coshape()) { + if (cobounds.ubound().isStar()) { + ucbs.push_back(-1); + } else if (auto ub = cobounds.ubound().GetExplicit()) { + if (auto constant = Fortran::evaluate::ToInt64(*ub)) + ucbs.push_back(*constant); + else { + if (auto lb = cobounds.lbound().GetExplicit()) { + if (auto constant2 = Fortran::evaluate::ToInt64(*lb)) + ucbs.push_back(*constant2); + else + ucbs.push_back(1); // use lcobound as default value + } + } + } + } + ucobounds = mlir::DenseI64ArrayAttr::get(builder.getContext(), ucbs); + } + return ucobounds; +} + +static std::tuple +genCoBoundsAttrs(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, + const Fortran::parser::AllocateCoarraySpec &allocSpec) { + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + llvm::SmallVector lcbs, ucbs; + + const std::list &coshapeSpecs = + std::get<0>(allocSpec.t); + for (const Fortran::parser::AllocateCoshapeSpec &coshapeSpec : coshapeSpecs) { + std::int64_t lb; + if (const std::optional &lbExpr = + std::get<0>(coshapeSpec.t)) + lb = *Fortran::evaluate::ToInt64(Fortran::semantics::GetExpr(*lbExpr)); + else + lb = 1; + lcbs.push_back(lb); + ucbs.push_back(*Fortran::evaluate::ToInt64( + Fortran::semantics::GetExpr(std::get<1>(coshapeSpec.t)))); + } + + const std::optional &lastBound = + std::get<1>(allocSpec.t); + if (lastBound.has_value()) + lcbs.push_back( + *Fortran::evaluate::ToInt64(Fortran::semantics::GetExpr(*lastBound))); + else + lcbs.push_back(1); + ucbs.push_back(-1); + + mlir::DenseI64ArrayAttr lcobounds = + mlir::DenseI64ArrayAttr::get(builder.getContext(), lcbs); + mlir::DenseI64ArrayAttr ucobounds = + mlir::DenseI64ArrayAttr::get(builder.getContext(), ucbs); + return {lcobounds, ucobounds}; +} + +mlir::Value Fortran::lower::genAllocateCoarray( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + const Fortran::semantics::Symbol &sym, mlir::Value addr, + const std::optional &allocSpec, + mlir::Value errmsg, bool hasStat) { + converter.checkCoarrayEnabled(); + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + + mlir::Value stat; + if (hasStat) + stat = builder.createTemporary(loc, builder.getI32Type()); + + mlir::DenseI64ArrayAttr lcobounds, ucobounds; + if (allocSpec.has_value()) { + std::tie(lcobounds, ucobounds) = + genCoBoundsAttrs(converter, loc, *allocSpec); + } else { + lcobounds = Fortran::lower::genLowerCoBounds(converter, loc, sym); + ucobounds = Fortran::lower::genUpperCoBounds(converter, loc, sym); + } + std::string uniqName = mif::getFullUniqName(addr); + if (uniqName.empty()) + uniqName = converter.mangleName(sym); + mif::AllocCoarrayOp::create(builder, loc, addr, uniqName, lcobounds, + ucobounds, stat, errmsg); + return stat; +} + //===----------------------------------------------------------------------===// // COARRAY expressions //===----------------------------------------------------------------------===// diff --git a/flang/lib/Optimizer/Builder/CMakeLists.txt b/flang/lib/Optimizer/Builder/CMakeLists.txt index 37c9c2d703c76..6f7526fecaeb9 100644 --- a/flang/lib/Optimizer/Builder/CMakeLists.txt +++ b/flang/lib/Optimizer/Builder/CMakeLists.txt @@ -12,6 +12,7 @@ add_flang_library(FIRBuilder HLFIRTools.cpp IntrinsicCall.cpp LowLevelIntrinsics.cpp + MIFCommon.cpp MutableBox.cpp PPCIntrinsicCall.cpp Runtime/Allocatable.cpp diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index 2541e41bb405a..2df2d29ee186d 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -237,6 +237,10 @@ static constexpr IntrinsicHandler handlers[]{ {"command_argument_count", &I::genCommandArgumentCount}, {"conjg", &I::genConjg}, {"cosd", &I::genCosd}, + {"coshape", + &I::genCoshape, + {{{"coarray", asAddr}, {"kind", asValue}}}, + false}, {"cospi", &I::genCospi}, {"count", &I::genCount, @@ -487,6 +491,13 @@ static constexpr IntrinsicHandler handlers[]{ {"ieee_unordered", &I::genIeeeUnordered}, {"ieee_value", &I::genIeeeValue}, {"ieor", &I::genIeor}, + {"image_index", + &I::genImageIndex, + {{{"coarray", asAddr}, + {"sub", asBox}, + {"team", asAddr}, + {"team_number", asAddr}}}, + /*isElemental*/ false}, {"index", &I::genIndex, {{{"string", asAddr}, @@ -517,6 +528,10 @@ static constexpr IntrinsicHandler handlers[]{ &I::genLbound, {{{"array", asInquired}, {"dim", asValue}, {"kind", asValue}}}, /*isElemental=*/false}, + {"lcobound", + &I::genLcobound, + {{{"coarray", asAddr}, {"dim", asValue}, {"kind", asValue}}}, + /*isElemental=*/false}, {"leadz", &I::genLeadz}, {"len", &I::genLen, @@ -781,8 +796,8 @@ static constexpr IntrinsicHandler handlers[]{ /*isElemental=*/false}, {"this_image", &I::genThisImage, - {{{"coarray", asBox}, - {"dim", asAddr}, + {{{"coarray", asAddr}, + {"dim", asValue}, {"team", asBox, handleDynamicOptional}}}, /*isElemental=*/false}, {"time", &I::genTime, {}, /*isElemental=*/false}, @@ -800,6 +815,10 @@ static constexpr IntrinsicHandler handlers[]{ &I::genUbound, {{{"array", asBox}, {"dim", asValue}, {"kind", asValue}}}, /*isElemental=*/false}, + {"ucobound", + &I::genUcobound, + {{{"coarray", asAddr}, {"dim", asValue}, {"kind", asValue}}}, + /*isElemental=*/false}, {"umaskl", &I::genMask}, {"umaskr", &I::genMask}, {"unlink", @@ -3448,6 +3467,17 @@ mlir::Value IntrinsicLibrary::genCospi(mlir::Type resultType, return getRuntimeCallGenerator("cos", ftype)(builder, loc, {arg}); } +// COSHAPE +fir::ExtendedValue +IntrinsicLibrary::genCoshape(mlir::Type, + llvm::ArrayRef args) { + converter->checkCoarrayEnabled(); + assert(args.size() == 2); + + return mif::CoshapeOp::create(builder, loc, + /*coarray*/ fir::getBase(args[0])); +} + // COUNT fir::ExtendedValue IntrinsicLibrary::genCount(mlir::Type resultType, @@ -6097,6 +6127,22 @@ mlir::Value IntrinsicLibrary::genIeor(mlir::Type resultType, args[1]); } +// IMAGE_INDEX +fir::ExtendedValue +IntrinsicLibrary::genImageIndex(mlir::Type resultType, + llvm::ArrayRef args) { + converter->checkCoarrayEnabled(); + assert(args.size() == 2 || args.size() == 3); + + mlir::Value team; + if (args.size() > 2) { + team = fir::getBase(args[2]); + } + return mif::ImageIndexOp::create(builder, loc, + /*coarray*/ fir::getBase(args[0]), + /*sub*/ fir::getBase(args[1]), team); +} + // INDEX fir::ExtendedValue IntrinsicLibrary::genIndex(mlir::Type resultType, @@ -8102,11 +8148,21 @@ IntrinsicLibrary::genThisImage(mlir::Type resultType, converter->checkCoarrayEnabled(); assert(args.size() >= 1 && args.size() <= 3); const bool coarrayIsAbsent = args.size() == 1; + const bool dimIsAbsent = args.size() < 3; mlir::Value team = fir::getBase(args[args.size() - 1]); - if (!coarrayIsAbsent) - TODO(loc, "this_image with coarray argument."); - mlir::Value res = mif::ThisImageOp::create(builder, loc, team); + if (!coarrayIsAbsent && dimIsAbsent) { + mlir::Value res = + mif::ThisImageOp::create(builder, loc, fir::getBase(args[0]), team); + return res; + } + mlir::Value res; + if (!dimIsAbsent) { + mlir::Value coarray = fir::getBase(args[0]); + mlir::Value dim = fir::getBase(args[1]); + res = mif::ThisImageOp::create(builder, loc, coarray, dim, team); + } else + res = mif::ThisImageOp::create(builder, loc, team); return builder.createConvert(loc, resultType, res); } @@ -8211,6 +8267,22 @@ IntrinsicLibrary::genLbound(mlir::Type resultType, fir::runtime::genLboundDim(builder, loc, fir::getBase(box), dim)); } +// LCOBOUND +fir::ExtendedValue +IntrinsicLibrary::genLcobound(mlir::Type resultType, + llvm::ArrayRef args) { + converter->checkCoarrayEnabled(); + assert(args.size() == 2 || args.size() == 3); + + mlir::Value coarray = fir::getBase(args[0]); + const bool dimIsAbsent = args.size() == 2 || isStaticallyAbsent(args, 1); + if (!dimIsAbsent) { + mlir::Value dim = fir::getBase(args[1]); + return mif::LcoboundOp::create(builder, loc, resultType, coarray, dim); + } + return mif::LcoboundOp::create(builder, loc, coarray); +} + // UBOUND fir::ExtendedValue IntrinsicLibrary::genUbound(mlir::Type resultType, @@ -8233,6 +8305,22 @@ IntrinsicLibrary::genUbound(mlir::Type resultType, /*needAccurateLowerBound=*/true); } +// UCOBOUND +fir::ExtendedValue +IntrinsicLibrary::genUcobound(mlir::Type resultType, + llvm::ArrayRef args) { + converter->checkCoarrayEnabled(); + assert(args.size() == 2 || args.size() == 3); + + mlir::Value coarray = fir::getBase(args[0]); + const bool dimIsAbsent = args.size() == 2 || isStaticallyAbsent(args, 1); + if (!dimIsAbsent) { + mlir::Value dim = fir::getBase(args[1]); + return mif::UcoboundOp::create(builder, loc, resultType, coarray, dim); + } + return mif::UcoboundOp::create(builder, loc, coarray); +} + // SPACING mlir::Value IntrinsicLibrary::genSpacing(mlir::Type resultType, llvm::ArrayRef args) { diff --git a/flang/lib/Optimizer/Builder/MIFCommon.cpp b/flang/lib/Optimizer/Builder/MIFCommon.cpp new file mode 100644 index 0000000000000..cfed95b8220ff --- /dev/null +++ b/flang/lib/Optimizer/Builder/MIFCommon.cpp @@ -0,0 +1,63 @@ +//===-- CUFCommon.cpp - Shared functions between passes ---------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Optimizer/Builder/MIFCommon.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Optimizer/Dialect/MIF/MIFOps.h" +#include "flang/Optimizer/Dialect/Support/KindMapping.h" +#include "flang/Optimizer/HLFIR/HLFIROps.h" +#include "mlir/Dialect/Func/IR/FuncOps.h" +#include "llvm/ADT/TypeSwitch.h" + +std::string mif::getFullUniqName(mlir::Value addr) { + mlir::Operation *op = addr.getDefiningOp(); + if (auto designateOp = mlir::dyn_cast(op)) { + if (designateOp.getComponent()) + return getFullUniqName(designateOp.getMemref()) + "." + + designateOp.getComponent()->getValue().str(); + return getFullUniqName(designateOp.getMemref()); + } else if (auto declareOp = mlir::dyn_cast(op)) + return declareOp.getUniqName().getValue().str(); + else if (auto declareOp = mlir::dyn_cast(op)) + return declareOp.getUniqName().getValue().str(); + else if (auto load = mlir::dyn_cast(op)) + return getFullUniqName(load.getMemref()); + else if (auto ba = mlir::dyn_cast(op)) + return getFullUniqName(ba.getVal()); + else if (auto rb = mlir::dyn_cast(op)) + return getFullUniqName(rb.getBox()); + else if (auto eb = mlir::dyn_cast(op)) + return getFullUniqName(eb.getMemref()); + else if (auto ebc = mlir::dyn_cast(op)) + return getFullUniqName(ebc.getMemref()); + else if (auto c = mlir::dyn_cast(op)) { + if (c.getFieldIndicesAttr()) { + mlir::Type eleTy = fir::getFortranElementType(c.getRef().getType()); + std::string uniqName = getFullUniqName(c.getRef()); + for (auto index : c.getIndices()) { + llvm::TypeSwitch(index) + .Case([&](mlir::IntegerAttr intAttr) { + if (auto recordType = llvm::dyn_cast(eleTy)) { + int fieldId = intAttr.getInt(); + if (fieldId < static_cast(recordType.getNumFields())) { + auto nameAndType = recordType.getTypeList()[fieldId]; + auto rrr = getFullUniqName(c.getRef()) + "." + + std::get(nameAndType); + uniqName += "." + std::get(nameAndType); + } + } + }) + .Case( + [&](mlir::Value v) { return getFullUniqName(v); }); + } + return uniqName; + } + return getFullUniqName(c.getRef()); + } + return ""; +} diff --git a/flang/lib/Optimizer/Dialect/MIF/CMakeLists.txt b/flang/lib/Optimizer/Dialect/MIF/CMakeLists.txt index d53937ebb49d4..15770dcef126b 100644 --- a/flang/lib/Optimizer/Dialect/MIF/CMakeLists.txt +++ b/flang/lib/Optimizer/Dialect/MIF/CMakeLists.txt @@ -8,6 +8,7 @@ add_flang_library(MIFDialect LINK_LIBS FIRDialect FIRDialectSupport + HLFIRDialect LINK_COMPONENTS AsmParser diff --git a/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp b/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp index 8b04226d4063d..260477476f237 100644 --- a/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp +++ b/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp @@ -9,11 +9,52 @@ #include "flang/Optimizer/Dialect/MIF/MIFOps.h" #include "flang/Optimizer/Builder/Todo.h" #include "flang/Optimizer/Dialect/FIRAttr.h" +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Dialect/FIROpsSupport.h" #include "flang/Optimizer/Dialect/FIRType.h" #include "flang/Optimizer/Dialect/MIF/MIFDialect.h" +#include "flang/Optimizer/HLFIR/HLFIROps.h" #include "mlir/IR/Matchers.h" #include "mlir/IR/PatternMatch.h" #include "llvm/ADT/SmallVector.h" +#include + +template +static llvm::LogicalResult checkCorankAttr(T op) { + mlir::Value coarray = op.getCoarray(); + if (!coarray.getDefiningOp()->hasAttr(fir::getCorankAttrName())) + return op.emitOpError("`coarray` must have a corank integer attribute."); + return mlir::success(); +} + +// Function used to check if a type has POINTER or ALLOCATABLE component. +// Currently an allocation of coarray with this kind of component are not yet +// supported. +static bool hasAllocatableOrPointerComponent(mlir::Type type) { + type = fir::unwrapPassByRefType(type); + if (fir::isa_box_type(type)) + return hasAllocatableOrPointerComponent(type); + if (auto recType = mlir::dyn_cast(type)) { + for (auto field : recType.getTypeList()) { + mlir::Type fieldType = fir::unwrapPassByRefType(field.second); + if (mlir::isa(fieldType)) + return true; + if (mlir::isa(fieldType)) + return true; + if (auto fieldRecType = mlir::dyn_cast(fieldType)) + return hasAllocatableOrPointerComponent(fieldRecType); + if (auto seqTy = mlir::dyn_cast(fieldType)) { + if (seqTy.hasUnknownShape() || seqTy.hasDynamicExtents()) + return true; + mlir::Type eleTy = seqTy.getEleTy(); + if (mlir::isa(eleTy) || + mlir::isa(eleTy)) + return true; + } + } + } + return false; +} //===----------------------------------------------------------------------===// // NumImagesOp @@ -41,22 +82,35 @@ llvm::LogicalResult mif::NumImagesOp::verify() { // ThisImageOp //===----------------------------------------------------------------------===// +void mif::ThisImageOp::build(mlir::OpBuilder &builder, + mlir::OperationState &result, mlir::Value coarray, + mlir::Value dim, mlir::Value team) { + mlir::Type resultTy = builder.getI32Type(); + build(builder, result, resultTy, coarray, dim, team); +} + void mif::ThisImageOp::build(mlir::OpBuilder &builder, mlir::OperationState &result, mlir::Value coarray, mlir::Value team) { - build(builder, result, coarray, /*dim*/ mlir::Value{}, team); + mlir::Type i64Ty = builder.getI64Type(); + mlir::Type resultTy = fir::BoxType::get( + fir::SequenceType::get({fir::SequenceType::getUnknownExtent()}, i64Ty)); + build(builder, result, resultTy, coarray, /*dim*/ mlir::Value{}, team); } void mif::ThisImageOp::build(mlir::OpBuilder &builder, mlir::OperationState &result, mlir::Value team) { - build(builder, result, /*coarray*/ mlir::Value{}, /*dim*/ mlir::Value{}, - team); + mlir::Type resultTy = builder.getI32Type(); + build(builder, result, resultTy, /*coarray*/ mlir::Value{}, + /*dim*/ mlir::Value{}, team); } llvm::LogicalResult mif::ThisImageOp::verify() { if (getDim() && !getCoarray()) return emitOpError( "`dim` must be provied at the same time as the `coarray` argument."); + if (getCoarray()) + return checkCorankAttr(*this); return mlir::success(); } @@ -202,5 +256,128 @@ static void printChangeTeamOpBody(mlir::OpAsmPrinter &p, mif::ChangeTeamOp op, /*printBlockTerminators=*/true); } +//===----------------------------------------------------------------------===// +// AllocCoarrayOp +//===----------------------------------------------------------------------===// + +void mif::AllocCoarrayOp::build(mlir::OpBuilder &builder, + mlir::OperationState &result, mlir::Value box, + llvm::StringRef symName, + mlir::DenseI64ArrayAttr lcbs, + mlir::DenseI64ArrayAttr ucbs, mlir::Value stat, + mlir::Value errmsg) { + mlir::StringAttr nameAttr = builder.getStringAttr(symName); + build(builder, result, nameAttr, box, lcbs, ucbs, stat, errmsg); +} + +void mif::AllocCoarrayOp::build(mlir::OpBuilder &builder, + mlir::OperationState &result, mlir::Value box, + llvm::StringRef symName, + mlir::DenseI64ArrayAttr lcbs, + mlir::DenseI64ArrayAttr ucbs) { + build(builder, result, symName, box, lcbs, ucbs, /*stat*/ mlir::Value{}, + /*errmsg*/ mlir::Value{}); +} + +llvm::LogicalResult mif::AllocCoarrayOp::verify() { + if (hasAllocatableOrPointerComponent(getBox().getType())) + TODO(getLoc(), + "Derived type coarray with at least one ALLOCATABLE or POINTER " + "component"); + return mlir::success(); +} + +//===----------------------------------------------------------------------===// +// LcoboundOp +//===----------------------------------------------------------------------===// + +void mif::LcoboundOp::build(mlir::OpBuilder &builder, + mlir::OperationState &result, mlir::Value coarray, + mlir::Value dim) { + // By default the result type is an I64 + mlir::Type resultTy = builder.getI64Type(); + build(builder, result, resultTy, coarray, dim); +} + +void mif::LcoboundOp::build(mlir::OpBuilder &builder, + mlir::OperationState &result, mlir::Value coarray) { + mlir::Type i64Ty = builder.getI64Type(); + mlir::Type resultTy = fir::BoxType::get( + fir::SequenceType::get({fir::SequenceType::getUnknownExtent()}, i64Ty)); + build(builder, result, resultTy, coarray, /*dim*/ mlir::Value{}); +} + +llvm::LogicalResult mif::LcoboundOp::verify() { + if (getCoarray()) + return checkCorankAttr(*this); + return mlir::success(); +} + +//===----------------------------------------------------------------------===// +// UcoboundOp +//===----------------------------------------------------------------------===// + +void mif::UcoboundOp::build(mlir::OpBuilder &builder, + mlir::OperationState &result, mlir::Value coarray, + mlir::Value dim) { + // By default the result type is an I64 + mlir::Type resultTy = builder.getI64Type(); + build(builder, result, resultTy, coarray, dim); +} + +void mif::UcoboundOp::build(mlir::OpBuilder &builder, + mlir::OperationState &result, mlir::Value coarray) { + mlir::Type i64Ty = builder.getI64Type(); + mlir::Type resultTy = fir::BoxType::get( + fir::SequenceType::get({fir::SequenceType::getUnknownExtent()}, i64Ty)); + build(builder, result, resultTy, coarray, /*dim*/ mlir::Value{}); +} + +llvm::LogicalResult mif::UcoboundOp::verify() { + if (getCoarray()) + return checkCorankAttr(*this); + return mlir::success(); +} + +//===----------------------------------------------------------------------===// +// CoshapeOp +//===----------------------------------------------------------------------===// + +void mif::CoshapeOp::build(mlir::OpBuilder &builder, + mlir::OperationState &result, mlir::Value coarray) { + mlir::Type i64Ty = builder.getI64Type(); + mlir::Type resultTy = fir::BoxType::get( + fir::SequenceType::get({fir::SequenceType::getUnknownExtent()}, i64Ty)); + build(builder, result, resultTy, coarray); +} + +llvm::LogicalResult mif::CoshapeOp::verify() { + if (getCoarray()) + return checkCorankAttr(*this); + return mlir::success(); +} + +//===----------------------------------------------------------------------===// +// ImageIndexOp +//===----------------------------------------------------------------------===// + +void mif::ImageIndexOp::build(mlir::OpBuilder &builder, + mlir::OperationState &result, mlir::Value coarray, + mlir::Value sub, mlir::Value teamArg) { + bool isTeamNumber = + teamArg && fir::unwrapPassByRefType(teamArg.getType()).isInteger(); + if (!isTeamNumber) + build(builder, result, coarray, sub, teamArg, /*team*/ mlir::Value{}); + else + build(builder, result, coarray, sub, /*team_number*/ mlir::Value{}, + teamArg); +} + +llvm::LogicalResult mif::ImageIndexOp::verify() { + if (getCoarray()) + return checkCorankAttr(*this); + return mlir::success(); +} + #define GET_OP_CLASSES #include "flang/Optimizer/Dialect/MIF/MIFOps.cpp.inc" diff --git a/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp b/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp index fed941c0afbe6..7a3ec2ddf0715 100644 --- a/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp +++ b/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp @@ -7,6 +7,12 @@ //===----------------------------------------------------------------------===// #include "flang/Optimizer/Transforms/MIFOpConversion.h" +#include "flang/Lower/ConvertExpr.h" +#include "flang/Optimizer/Builder/BoxValue.h" +#include "flang/Optimizer/Builder/Character.h" +#include "flang/Optimizer/Builder/MIFCommon.h" +#include "flang/Optimizer/Builder/MutableBox.h" +#include "flang/Optimizer/Builder/Runtime/Inquiry.h" #include "flang/Optimizer/Builder/Runtime/RTBuilder.h" #include "flang/Optimizer/Builder/Todo.h" #include "flang/Optimizer/CodeGen/TypeConverter.h" @@ -16,6 +22,7 @@ #include "flang/Optimizer/HLFIR/HLFIROps.h" #include "flang/Optimizer/Support/DataLayout.h" #include "flang/Optimizer/Support/InternalNames.h" +#include "flang/Runtime/coarray.h" #include "flang/Runtime/stop.h" #include "mlir/IR/Matchers.h" #include "mlir/Transforms/DialectConversion.h" @@ -47,6 +54,248 @@ static mlir::Type getPRIFErrmsgType(fir::FirOpBuilder &builder) { builder.getContext(), 1, fir::CharacterType::unknownLen())); } +static mlir::Type +genBoxedSequenceType(mlir::Type eleTy, + std::optional rank = std::nullopt) { + if (rank.has_value()) + return fir::BoxType::get(fir::SequenceType::get({rank.value()}, eleTy)); + return fir::BoxType::get( + fir::SequenceType::get({fir::SequenceType::getUnknownExtent()}, eleTy)); +} + +static mlir::Type getCoarrayHandleType(fir::FirOpBuilder &builder, + mlir::Location loc) { + // Defining the coarray handle type + std::string handleDTName = + fir::NameUniquer::doType({"prif"}, {}, 0, "prif_coarray_handle", {}); + fir::RecordType handleTy = + fir::RecordType::get(builder.getContext(), handleDTName); + mlir::Type infoTy = + fir::BoxType::get(fir::PointerType::get(builder.getNoneType())); + handleTy.finalize({}, {{"info", infoTy}}); + + // Checking if the type information was generated + fir::TypeInfoOp dt; + fir::RecordType parentType{}; + mlir::OpBuilder::InsertPoint insertPointIfCreated; + std::tie(dt, insertPointIfCreated) = + builder.createTypeInfoOp(loc, handleTy, parentType); + if (insertPointIfCreated.isSet()) { + // fir.type_info wasn't built in a previous call. + dt->setAttr(dt.getNoInitAttrName(), builder.getUnitAttr()); + dt->setAttr(dt.getNoDestroyAttrName(), builder.getUnitAttr()); + dt->setAttr(dt.getNoFinalAttrName(), builder.getUnitAttr()); + builder.restoreInsertionPoint(insertPointIfCreated); + // Create global op + // FIXME: replace handleTy by the Derived type that describe handleTy + std::string globalName = + fir::NameUniquer::getTypeDescriptorName(handleDTName); + auto linkage = builder.createLinkOnceODRLinkage(); + builder.createGlobal(loc, handleTy, globalName, linkage); + } + return handleTy; +} + +mlir::Value getCoarrayHandle(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value coarray) { + mlir::Type boxTy = fir::BoxType::get(builder.getNoneType()); + std::string uniqName = mif::getFullUniqName(coarray); + if (!uniqName.empty()) { + std::string globalName = uniqName + coarrayHandleSuffix.str(); + mlir::SymbolRefAttr symAttr = + mlir::SymbolRefAttr::get(builder.getContext(), globalName); + mlir::Value coarrayHandle = + fir::AddrOfOp::create(builder, loc, builder.getRefType(boxTy), symAttr); + return fir::LoadOp::create(builder, loc, coarrayHandle); + } + + mlir::emitError(coarray.getLoc(), + "Unable to locate the coarray handle for this argument."); +} + +std::int64_t getCorankFromAttr(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value coarray) { + std::int64_t corank = 0; + if (auto intAttr = coarray.getDefiningOp()->getAttrOfType( + fir::getCorankAttrName())) + corank = intAttr.getInt(); + return corank; +} + +// Function to generate the PRIF runtime function call to retrieve +// the number of images in the current team +static mlir::Value getNumImages(fir::FirOpBuilder &builder, + mlir::Location loc) { + mlir::Type i32Ty = builder.getI32Type(); + mlir::Value result = builder.createTemporary(loc, i32Ty); + mlir::FunctionType ftype = mlir::FunctionType::get( + builder.getContext(), + /*inputs*/ {builder.getRefType(i32Ty)}, /*results*/ {}); + mlir::func::FuncOp funcOp = + builder.createFunction(loc, getPRIFProcName("num_images"), ftype); + llvm::SmallVector args = + fir::runtime::createArguments(builder, loc, ftype, result); + fir::CallOp::create(builder, loc, funcOp, args); + return fir::LoadOp::create(builder, loc, result); +} + +static std::pair +genCoBounds(fir::FirOpBuilder &builder, mlir::Location loc, + mif::AllocCoarrayOp op) { + mlir::Value ucobounds, lcobounds; + mlir::DenseI64ArrayAttr lcbsAttr = op.getLcoboundsAttr(); + mlir::DenseI64ArrayAttr ucbsAttr = op.getUcoboundsAttr(); + + size_t corank = lcbsAttr.size(); + mlir::Type i64Ty = builder.getI64Type(); + mlir::Type addrType = builder.getRefType(i64Ty); + mlir::Type arrayType = fir::SequenceType::get( + {static_cast(corank)}, i64Ty); + lcobounds = builder.createTemporary(loc, arrayType); + ucobounds = builder.createTemporary(loc, arrayType); + + for (size_t i = 0; i < corank; i++) { + auto index = builder.createIntegerConstant(loc, builder.getIndexType(), i); + // Lower cobounds + auto lcovalue = builder.createIntegerConstant(loc, i64Ty, lcbsAttr[i]); + auto lcoaddr = + fir::CoordinateOp::create(builder, loc, addrType, lcobounds, index); + fir::StoreOp::create(builder, loc, lcovalue, lcoaddr); + + // Upper cobounds + auto ucovalue = builder.createIntegerConstant(loc, i64Ty, ucbsAttr[i]); + auto ucoaddr = + fir::CoordinateOp::create(builder, loc, addrType, ucobounds, index); + fir::StoreOp::create(builder, loc, ucovalue, ucoaddr); + } + + lcobounds = builder.createBox(loc, lcobounds); + ucobounds = builder.createBox(loc, ucobounds); + + // Computing last ucobound + mlir::func::FuncOp func = + fir::runtime::getRuntimeFunc(loc, builder); + mlir::Value numImages = getNumImages(builder, loc); + llvm::SmallVector args = fir::runtime::createArguments( + builder, loc, func.getFunctionType(), numImages, lcobounds, ucobounds); + fir::CallOp::create(builder, loc, func, args); + + return {lcobounds, ucobounds}; +} + +// Storing the coarray descriptor as a global variable +void storeCoarrayHandle(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value coarrayHandle, std::string uniqName) { + std::string globalName = uniqName + coarrayHandleSuffix.str(); + fir::GlobalOp global = builder.getNamedGlobal(globalName); + if (!global) { + global = builder.createGlobal(loc, coarrayHandle.getType(), globalName, + builder.createLinkOnceLinkage()); + mlir::Region ®ion = global.getRegion(); + region.push_back(new mlir::Block); + mlir::Block &block = region.back(); + auto insertPt = builder.saveInsertionPoint(); + builder.setInsertionPointToStart(&block); + auto box = fir::factory::createUnallocatedBox(builder, loc, + coarrayHandle.getType(), {}); + fir::HasValueOp::create(builder, loc, box); + builder.restoreInsertionPoint(insertPt); + } + + mlir::SymbolRefAttr symAttr = + mlir::SymbolRefAttr::get(builder.getContext(), globalName); + auto addrOf = fir::AddrOfOp::create( + builder, loc, builder.getRefType(coarrayHandle.getType()), symAttr); + fir::StoreOp::create(builder, loc, coarrayHandle, addrOf); +} + +static int computeElementByteSize(mlir::Location loc, mlir::Type type, + fir::KindMapping &kindMap, + bool emitErrorOnFailure = true) { + auto eleTy = fir::unwrapSequenceType(type); + if (auto t{mlir::dyn_cast(eleTy)}) + return t.getWidth() / 8; + if (auto t{mlir::dyn_cast(eleTy)}) + return t.getWidth() / 8; + if (auto t{mlir::dyn_cast(eleTy)}) + return kindMap.getLogicalBitsize(t.getFKind()) / 8; + if (auto t{mlir::dyn_cast(eleTy)}) { + int elemSize = + mlir::cast(t.getElementType()).getWidth() / 8; + return 2 * elemSize; + } + if (auto t{mlir::dyn_cast(eleTy)}) + return kindMap.getCharacterBitsize(t.getFKind()) / 8; + if (emitErrorOnFailure) + mlir::emitError(loc, "unsupported type"); + return 0; +} + +// Function used to compute the size in bytes of an entity. This function +// is used during an allocation of a coarray (or a component of a coarray), +// as it's a required argument in some PRIF procedures. +static mlir::Value getSizeInBytes(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::ModuleOp module, + mlir::DataLayout *dl, + const fir::LLVMTypeConverter *typeConverter, + mlir::Value box) { + fir::KindMapping kindMap{fir::getKindMapping(module)}; + mlir::Type baseTy = fir::unwrapPassByRefType(box.getType()); + + mlir::Value sizeInBytes = builder.createTemporary(loc, builder.getI64Type()); + mlir::Value bytes; + if (!mlir::dyn_cast_or_null(baseTy)) { + if (fir::isa_trivial(baseTy)) { + int width = computeElementByteSize(loc, baseTy, kindMap); + bytes = builder.createIntegerConstant(loc, builder.getI64Type(), width); + } else if (auto seqTy = mlir::dyn_cast_or_null(baseTy)) { + std::size_t size = 0; + if (fir::isa_derived(seqTy.getEleTy())) { + mlir::Type structTy = typeConverter->convertType(seqTy.getEleTy()); + size = dl->getTypeSizeInBits(structTy) / 8; + } else { + size = computeElementByteSize(loc, seqTy.getEleTy(), kindMap); + } + mlir::Value width = + builder.createIntegerConstant(loc, builder.getI64Type(), size); + mlir::Value nbElem; + if (fir::sequenceWithNonConstantShape(seqTy)) { + // TODO: Not handle for now, but will be do it later. + mlir::emitError(loc, + "unsupported sequence type with non constant shape"); + } else { + nbElem = builder.createIntegerConstant(loc, builder.getI64Type(), + seqTy.getConstantArraySize()); + } + bytes = mlir::arith::MulIOp::create(builder, loc, nbElem, width); + } else if (fir::isa_derived(baseTy)) { + mlir::Type structTy = typeConverter->convertType(baseTy); + std::size_t structSize = dl->getTypeSizeInBits(structTy) / 8; + bytes = + builder.createIntegerConstant(loc, builder.getI64Type(), structSize); + } else if (fir::isa_char(baseTy)) { + mlir::Type charTy = typeConverter->convertType(baseTy); + std::size_t charSize = dl->getTypeSizeInBits(charTy) / 8; + bytes = + builder.createIntegerConstant(loc, builder.getI64Type(), charSize); + } else { + mlir::emitError(loc, "unsupported type in mif allocation\n"); + } + } else { + if (fir::isa_ref_type(box.getType())) + box = fir::LoadOp::create(builder, loc, box); + bytes = fir::BoxEleSizeOp::create(builder, loc, builder.getI64Type(), box); + auto boxTy = mlir::dyn_cast_or_null(baseTy); + if (fir::extractSequenceType(boxTy)) { + mlir::Value extent = builder.createConvert( + loc, builder.getI64Type(), fir::runtime::genSize(builder, loc, box)); + bytes = mlir::arith::MulIOp::create(builder, loc, bytes, extent); + } + } + fir::StoreOp::create(builder, loc, bytes, sizeInBytes); + return sizeInBytes; +} + // Most PRIF functions take `errmsg` and `errmsg_alloc` as two optional // arguments of intent (out). One is allocatable, the other is not. // It is the responsibility of the compiler to ensure that the appropriate @@ -251,27 +500,72 @@ struct MIFThisImageOpConversion fir::FirOpBuilder builder(rewriter, mod); mlir::Location loc = op.getLoc(); - if (op.getCoarray()) - TODO(loc, "mif.this_image op with coarray argument."); - else { - mlir::Type i32Ty = builder.getI32Type(); - mlir::Type boxTy = fir::BoxType::get(rewriter.getNoneType()); + mlir::Type i64Ty = builder.getI64Type(); + mlir::Type i32Ty = builder.getI32Type(); + mlir::Type boxTy = fir::BoxType::get(rewriter.getNoneType()); + + mlir::Value teamArg = op.getTeam(); + if (!op.getTeam()) + teamArg = fir::AbsentOp::create(builder, loc, boxTy); + + if (op.getCoarray()) { + llvm::SmallVector args; + mlir::FunctionType ftype; + mlir::func::FuncOp funcOp; + mlir::Value result; + mlir::Value coarrayHandle = + getCoarrayHandle(builder, loc, op.getCoarray()); + if (mlir::Value d = op.getDim()) { + mlir::Value dim = builder.createTemporary(loc, i32Ty); + if (d.getType() != i32Ty) + d = fir::ConvertOp::create(builder, loc, i32Ty, d); + fir::StoreOp::create(builder, loc, d, dim); + result = builder.createTemporary(loc, i64Ty); + ftype = mlir::FunctionType::get(builder.getContext(), + /*inputs*/ + {boxTy, builder.getRefType(i32Ty), + boxTy, builder.getRefType(i64Ty)}, + /*results*/ {}); + funcOp = builder.createFunction( + loc, getPRIFProcName("this_image_with_dim"), ftype); + args = fir::runtime::createArguments(builder, loc, ftype, coarrayHandle, + dim, teamArg, result); + fir::CallOp::create(builder, loc, funcOp, args); + result = fir::LoadOp::create(builder, loc, result).getResult(); + if (result.getType() != op.getType()) + result = builder.createConvert(loc, op.getType(), result); + } else { + std::int64_t corank = getCorankFromAttr(builder, loc, op.getCoarray()); + mlir::Type resTy = fir::SequenceType::get({corank}, i64Ty); + // Need to embox the array + result = builder.createBox(loc, builder.createTemporary(loc, resTy)); + ftype = mlir::FunctionType::get( + builder.getContext(), + /*inputs*/ {boxTy, boxTy, fir::BoxType::get(resTy)}, + /*results*/ {}); + funcOp = builder.createFunction( + loc, getPRIFProcName("this_image_with_coarray"), ftype); + args = fir::runtime::createArguments(builder, loc, ftype, coarrayHandle, + teamArg, result); + fir::CallOp::create(builder, loc, funcOp, args); + result = fir::ConvertOp::create(builder, loc, + genBoxedSequenceType(i64Ty), result); + } + rewriter.replaceOp(op, result); + } else { mlir::Value result = builder.createTemporary(loc, i32Ty); mlir::FunctionType ftype = mlir::FunctionType::get( builder.getContext(), /*inputs*/ {boxTy, builder.getRefType(i32Ty)}, /*results*/ {}); - mlir::Value teamArg = op.getTeam(); - if (!op.getTeam()) - teamArg = fir::AbsentOp::create(builder, loc, boxTy); - mlir::func::FuncOp funcOp = builder.createFunction( loc, getPRIFProcName("this_image_no_coarray"), ftype); + llvm::SmallVector args = fir::runtime::createArguments(builder, loc, ftype, teamArg, result); fir::CallOp::create(builder, loc, funcOp, args); rewriter.replaceOpWithNewOp(op, result); - return mlir::success(); } + return mlir::success(); } }; @@ -288,21 +582,18 @@ struct MIFNumImagesOpConversion fir::FirOpBuilder builder(rewriter, mod); mlir::Location loc = op.getLoc(); - mlir::Type i32Ty = builder.getI32Type(); - mlir::Type i64Ty = builder.getI64Type(); - mlir::Type boxTy = fir::BoxType::get(rewriter.getNoneType()); - mlir::Value result = builder.createTemporary(loc, i32Ty); - - mlir::func::FuncOp funcOp; - llvm::SmallVector args; if (!op.getTeam() && !op.getTeamNumber()) { - mlir::FunctionType ftype = mlir::FunctionType::get( - builder.getContext(), - /*inputs*/ {builder.getRefType(i32Ty)}, /*results*/ {}); - funcOp = - builder.createFunction(loc, getPRIFProcName("num_images"), ftype); - args = fir::runtime::createArguments(builder, loc, ftype, result); + mlir::Value numImages = getNumImages(builder, loc); + rewriter.replaceOp(op, numImages); + return mlir::success(); } else { + mlir::Type i32Ty = builder.getI32Type(); + mlir::Type i64Ty = builder.getI64Type(); + mlir::Type boxTy = fir::BoxType::get(rewriter.getNoneType()); + mlir::Value result = builder.createTemporary(loc, i32Ty); + + mlir::func::FuncOp funcOp; + llvm::SmallVector args; if (op.getTeam()) { mlir::FunctionType ftype = mlir::FunctionType::get(builder.getContext(), @@ -328,10 +619,10 @@ struct MIFNumImagesOpConversion args = fir::runtime::createArguments(builder, loc, ftype, teamNumber, result); } + fir::CallOp::create(builder, loc, funcOp, args); + rewriter.replaceOpWithNewOp(op, result); + return mlir::success(); } - fir::CallOp::create(builder, loc, funcOp, args); - rewriter.replaceOpWithNewOp(op, result); - return mlir::success(); } }; @@ -805,6 +1096,298 @@ struct MIFTeamNumberOpConversion } }; +/// Convert mif.alloca_coarray operation to runtime call of +/// 'prif_allocate_coarray' +struct MIFAllocCoarrayOpConversion + : public mlir::OpRewritePattern { + using OpRewritePattern::OpRewritePattern; + + MIFAllocCoarrayOpConversion(mlir::MLIRContext *context, mlir::DataLayout *dl, + const fir::LLVMTypeConverter *typeConverter) + : OpRewritePattern(context), dl{dl}, typeConverter{typeConverter} {} + + mlir::LogicalResult + matchAndRewrite(mif::AllocCoarrayOp op, + mlir::PatternRewriter &rewriter) const override { + auto mod = op->template getParentOfType(); + fir::FirOpBuilder builder(rewriter, mod); + mlir::Location loc = op.getLoc(); + + mlir::Type i64Ty = builder.getI64Type(); + mlir::Type ptrTy = fir::PointerType::get(builder.getNoneType()); + mlir::Type boxTy = fir::BoxType::get(builder.getNoneType()); + mlir::Type errmsgTy = getPRIFErrmsgType(builder); + mlir::Type coboundsTy = genBoxedSequenceType(i64Ty); + // Type of the procedure pointed by final_func will be the following : + mlir::Type procTypePtr = fir::BoxProcType::get( + builder.getContext(), + mlir::FunctionType::get(builder.getContext(), + {boxTy, getPRIFStatType(builder), errmsgTy}, + {})); + mlir::FunctionType ftype = mlir::FunctionType::get( + builder.getContext(), + /*inputs*/ + {coboundsTy, coboundsTy, builder.getRefType(i64Ty), + builder.getRefType(builder.getNoneType()), boxTy, ptrTy, + getPRIFStatType(builder), errmsgTy, errmsgTy}, + /*results*/ {}); + mlir::func::FuncOp funcOp = + builder.createFunction(loc, getPRIFProcName("allocate_coarray"), ftype); + + // TODO: Handle final_func if needed + mlir::Value finalFunc = builder.createTemporary(loc, procTypePtr); + mlir::Value nullBoxProc = + fir::factory::createNullBoxProc(builder, loc, procTypePtr); + fir::StoreOp::create(builder, loc, nullBoxProc, finalFunc); + // Allocate instance of prif_coarray_handle type based on the PRIF + // specification. + mlir::Type handleTy = getCoarrayHandleType(builder, loc); + mlir::Value coarrayHandle = + builder.createBox(loc, builder.createTemporary(loc, handleTy)); + + mlir::Value allocMem = builder.createTemporary(loc, ptrTy); + mlir::Value addrCvt = + fir::ConvertOp::create(builder, loc, ptrTy, op.getBox()); + fir::StoreOp::create(builder, loc, addrCvt, allocMem); + + mlir::Value sizeInBytes = + getSizeInBytes(builder, loc, mod, dl, typeConverter, op.getBox()); + auto [lcobounds, ucobounds] = genCoBounds(builder, loc, op); + mlir::Value stat = op.getStat(); + if (!stat) + stat = fir::AbsentOp::create(builder, loc, getPRIFStatType(builder)); + auto [errmsgArg, errmsgAllocArg] = + genErrmsgPRIF(builder, loc, op.getErrmsg()); + + llvm::SmallVector args = fir::runtime::createArguments( + builder, loc, ftype, lcobounds, ucobounds, sizeInBytes, finalFunc, + coarrayHandle, allocMem, stat, errmsgArg, errmsgAllocArg); + fir::CallOp callOp = fir::CallOp::create(builder, loc, funcOp, args); + + storeCoarrayHandle(builder, loc, coarrayHandle, op.getUniqName().str()); + + rewriter.replaceOp(op, callOp); + return mlir::success(); + } + +private: + mlir::DataLayout *dl; + const fir::LLVMTypeConverter *typeConverter; +}; + +/// Convert mif.dealloca_coarray operation to runtime call of +/// 'prif_deallocate_coarray' +struct MIFDeallocCoarrayOpConversion + : public mlir::OpRewritePattern { + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(mif::DeallocCoarrayOp op, + mlir::PatternRewriter &rewriter) const override { + auto mod = op->template getParentOfType(); + fir::FirOpBuilder builder(rewriter, mod); + mlir::Location loc = op.getLoc(); + + mlir::Type errmsgTy = getPRIFErrmsgType(builder); + mlir::Type boxTy = fir::BoxType::get(builder.getNoneType()); + mlir::FunctionType ftype = mlir::FunctionType::get( + builder.getContext(), + /*inputs*/ + {boxTy, getPRIFStatType(builder), errmsgTy, errmsgTy}, + /*results*/ {}); + mlir::func::FuncOp funcOp = builder.createFunction( + loc, getPRIFProcName("deallocate_coarray"), ftype); + + mlir::Value coarrayHandle = getCoarrayHandle(builder, loc, op.getCoarray()); + mlir::Value stat = op.getStat(); + if (!stat) + stat = fir::AbsentOp::create(builder, loc, getPRIFStatType(builder)); + auto [errmsgArg, errmsgAllocArg] = + genErrmsgPRIF(builder, loc, op.getErrmsg()); + llvm::SmallVector args = fir::runtime::createArguments( + builder, loc, ftype, coarrayHandle, stat, errmsgArg, errmsgAllocArg); + fir::CallOp callOp = fir::CallOp::create(builder, loc, funcOp, args); + rewriter.replaceOp(op, callOp); + return mlir::success(); + } +}; + +/// Convert mif.coshape operation to runtime call of 'prif_coshape' +struct MIFCoshapeOpConversion : public mlir::OpRewritePattern { + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(mif::CoshapeOp op, + mlir::PatternRewriter &rewriter) const override { + auto mod = op->template getParentOfType(); + fir::FirOpBuilder builder(rewriter, mod); + mlir::Location loc = op.getLoc(); + mlir::Type i64Ty = builder.getI64Type(); + mlir::Type boxTy = fir::BoxType::get(builder.getNoneType()); + + mlir::FunctionType ftype = + mlir::FunctionType::get(builder.getContext(), + /*inputs*/ {boxTy, genBoxedSequenceType(i64Ty)}, + /*results*/ {}); + mlir::func::FuncOp funcOp = + builder.createFunction(loc, getPRIFProcName("coshape"), ftype); + + mlir::Value coarrayHandle = getCoarrayHandle(builder, loc, op.getCoarray()); + std::int64_t corank = getCorankFromAttr(builder, loc, op.getCoarray()); + mlir::Type resultType = fir::SequenceType::get( + static_cast(corank), i64Ty); + mlir::Value result = + builder.createBox(loc, builder.createTemporary(loc, resultType)); + + llvm::SmallVector args = fir::runtime::createArguments( + builder, loc, ftype, coarrayHandle, result); + fir::CallOp::create(builder, loc, funcOp, args); + result = fir::ConvertOp::create(builder, loc, genBoxedSequenceType(i64Ty), + result); + rewriter.replaceOp(op, result); + return mlir::success(); + } +}; + +template +mlir::LogicalResult CoboundOpConversion(T op, mlir::PatternRewriter &rewriter, + const std::string &prefix) { + auto mod = op->template getParentOfType(); + fir::FirOpBuilder builder(rewriter, mod); + mlir::Location loc = op.getLoc(); + mlir::Type i64Ty = builder.getI64Type(); + mlir::Type boxTy = fir::BoxType::get(builder.getNoneType()); + + mlir::Value coarrayHandle = getCoarrayHandle(builder, loc, op.getCoarray()); + if (mlir::Value d = op.getDim()) { + mlir::Type i32Ty = builder.getI32Type(); + mlir::FunctionType ftype = mlir::FunctionType::get( + builder.getContext(), + /*inputs*/ + {boxTy, builder.getRefType(i32Ty), builder.getRefType(i64Ty)}, + /*results*/ {}); + mlir::func::FuncOp funcOp = builder.createFunction( + loc, getPRIFProcName(prefix + "_with_dim"), ftype); + + mlir::Value result = builder.createTemporary(loc, i64Ty); + mlir::Value dim = builder.createTemporary(loc, i32Ty); + if (d.getType() != i32Ty) + d = fir::ConvertOp::create(builder, loc, i32Ty, d); + fir::StoreOp::create(builder, loc, d, dim); + + llvm::SmallVector args = fir::runtime::createArguments( + builder, loc, ftype, coarrayHandle, dim, result); + fir::CallOp::create(builder, loc, funcOp, args); + result = fir::LoadOp::create(builder, loc, result).getResult(); + if (result.getType() != op.getType()) + result = builder.createConvert(loc, op.getType(), result); + rewriter.replaceOp(op, result); + } else { + mlir::FunctionType ftype = + mlir::FunctionType::get(builder.getContext(), + /*inputs*/ {boxTy, genBoxedSequenceType(i64Ty)}, + /*results*/ {}); + mlir::func::FuncOp funcOp = + builder.createFunction(loc, getPRIFProcName(prefix + "_no_dim"), ftype); + + std::int64_t corank = getCorankFromAttr(builder, loc, op.getCoarray()); + mlir::Type resultType = fir::SequenceType::get( + static_cast(corank), i64Ty); + mlir::Value result = + builder.createBox(loc, builder.createTemporary(loc, resultType)); + llvm::SmallVector args = fir::runtime::createArguments( + builder, loc, ftype, coarrayHandle, result); + fir::CallOp::create(builder, loc, funcOp, args); + result = fir::ConvertOp::create(builder, loc, genBoxedSequenceType(i64Ty), + result); + rewriter.replaceOp(op, result); + } + return mlir::success(); +} + +/// Convert mif.lcobound operation to runtime call of +/// 'prif_lcobound_{with|no}_dim' +struct MIFLcoboundOpConversion + : public mlir::OpRewritePattern { + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(mif::LcoboundOp op, + mlir::PatternRewriter &rewriter) const override { + return CoboundOpConversion(op, rewriter, "lcobound"); + } +}; + +/// Convert mif.ucobound operation to runtime call of +/// 'prif_ucobound_{with|no}_dim' +struct MIFUcoboundOpConversion + : public mlir::OpRewritePattern { + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(mif::UcoboundOp op, + mlir::PatternRewriter &rewriter) const override { + return CoboundOpConversion(op, rewriter, "ucobound"); + } +}; + +/// Convert mif.image_index operation to runtime call of +/// 'prif_image_index[_with_team[_number]]' +struct MIFImageIndexOpConversion + : public mlir::OpRewritePattern { + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(mif::ImageIndexOp op, + mlir::PatternRewriter &rewriter) const override { + auto mod = op->template getParentOfType(); + fir::FirOpBuilder builder(rewriter, mod); + mlir::Location loc = op.getLoc(); + mlir::Type i64Ty = builder.getI64Type(); + mlir::Type i32Ty = builder.getI32Type(); + mlir::Type resTy = builder.getRefType(i32Ty); + mlir::Type boxTy = fir::BoxType::get(builder.getNoneType()); + mlir::Value result = builder.createTemporary(loc, i32Ty); + + mlir::func::FuncOp funcOp; + mlir::FunctionType ftype; + llvm::SmallVector args; + mlir::Value coarrayHandle = getCoarrayHandle(builder, loc, op.getCoarray()); + if (!op.getTeam()) { + mlir::FunctionType ftype = mlir::FunctionType::get( + builder.getContext(), + /*inputs*/ {boxTy, genBoxedSequenceType(i64Ty), resTy}, + /*results*/ {}); + funcOp = + builder.createFunction(loc, getPRIFProcName("image_index"), ftype); + args = fir::runtime::createArguments(builder, loc, ftype, coarrayHandle, + op.getSub(), result); + } else { + mlir::Value team = op.getTeam(); + std::string imageIndexName = + fir::unwrapPassByRefType(team.getType()).isInteger() + ? getPRIFProcName("image_index_with_team") + : getPRIFProcName("image_index_with_team_number"); + mlir::Type teamTy = fir::unwrapPassByRefType(team.getType()).isInteger() + ? builder.getRefType(i64Ty) + : boxTy; + mlir::FunctionType ftype = mlir::FunctionType::get( + builder.getContext(), + /*inputs*/ {boxTy, genBoxedSequenceType(i64Ty), teamTy, resTy}, + /*results*/ {}); + funcOp = builder.createFunction(loc, imageIndexName, ftype); + + if (fir::isa_ref_type(team.getType())) + team = builder.createBox(loc, team); + args = fir::runtime::createArguments(builder, loc, ftype, coarrayHandle, + op.getSub(), team, result); + } + fir::CallOp::create(builder, loc, funcOp, args); + rewriter.replaceOpWithNewOp(op, result); + return mlir::success(); + } +}; + class MIFOpConversion : public fir::impl::MIFOpConversionBase { public: void runOnOperation() override { @@ -812,7 +1395,24 @@ class MIFOpConversion : public fir::impl::MIFOpConversionBase { mlir::RewritePatternSet patterns(ctx); mlir::ConversionTarget target(*ctx); - mif::populateMIFOpConversionPatterns(patterns); + mlir::Operation *op = getOperation(); + mlir::ModuleOp module = mlir::dyn_cast(op); + if (!module) + return signalPassFailure(); + mlir::SymbolTable symtab(module); + + std::optional dl = fir::support::getOrSetMLIRDataLayout( + module, /*allowDefaultLayout=*/false); + if (!dl.has_value()) { + mlir::emitError( + module.getLoc(), + "data layout attribute is required to perform MIFOpConversion pass"); + return signalPassFailure(); + } + + fir::LLVMTypeConverter typeConverter(module, /*applyTBAA=*/false, + /*forceUnifiedTBAATree=*/false, *dl); + mif::populateMIFOpConversionPatterns(typeConverter, *dl, patterns); target.addLegalDialect(); target.addLegalOp(); @@ -827,14 +1427,19 @@ class MIFOpConversion : public fir::impl::MIFOpConversionBase { }; } // namespace -void mif::populateMIFOpConversionPatterns(mlir::RewritePatternSet &patterns) { - patterns.insert( - patterns.getContext()); +void mif::populateMIFOpConversionPatterns( + const fir::LLVMTypeConverter &converter, mlir::DataLayout &dl, + mlir::RewritePatternSet &patterns) { + patterns.insert(patterns.getContext(), &dl, + &converter); + patterns.insert< + MIFInitOpConversion, MIFThisImageOpConversion, MIFNumImagesOpConversion, + MIFSyncAllOpConversion, MIFSyncImagesOpConversion, + MIFSyncMemoryOpConversion, MIFSyncTeamOpConversion, + MIFCoBroadcastOpConversion, MIFCoMaxOpConversion, MIFCoMinOpConversion, + MIFCoSumOpConversion, MIFFormTeamOpConversion, MIFChangeTeamOpConversion, + MIFEndTeamOpConversion, MIFGetTeamOpConversion, MIFTeamNumberOpConversion, + MIFDeallocCoarrayOpConversion, MIFCoshapeOpConversion, + MIFLcoboundOpConversion, MIFUcoboundOpConversion, + MIFImageIndexOpConversion>(patterns.getContext()); } diff --git a/flang/test/Fir/MIF/change_team.mlir b/flang/test/Fir/MIF/change_team.mlir index 1dbfee574cc51..2d7f4c682944d 100644 --- a/flang/test/Fir/MIF/change_team.mlir +++ b/flang/test/Fir/MIF/change_team.mlir @@ -1,32 +1,34 @@ // RUN: fir-opt --mif-convert %s | FileCheck %s -func.func @_QQmain() attributes {fir.bindc_name = "TEST_CHANGE_TEAM"} { - %0 = fir.dummy_scope : !fir.dscope - %c10 = arith.constant 10 : index - %1 = fir.alloca !fir.char<1,10> {bindc_name = "err", uniq_name = "_QFEerr"} - %2:2 = hlfir.declare %1 typeparams %c10 {uniq_name = "_QFEerr"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) - %3 = fir.alloca i32 {bindc_name = "i", uniq_name = "_QFEi"} - %4:2 = hlfir.declare %3 {uniq_name = "_QFEi"} : (!fir.ref) -> (!fir.ref, !fir.ref) - %5 = fir.alloca i32 {bindc_name = "stat", uniq_name = "_QFEstat"} - %6:2 = hlfir.declare %5 {uniq_name = "_QFEstat"} : (!fir.ref) -> (!fir.ref, !fir.ref) - %7 = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}> {bindc_name = "team", uniq_name = "_QFEteam"} - %8:2 = hlfir.declare %7 {uniq_name = "_QFEteam"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) - %9 = fir.address_of(@_QQ_QM__fortran_builtinsT__builtin_team_type.DerivedInit) : !fir.ref> - fir.copy %9 to %8#0 no_overlap : !fir.ref>, !fir.ref> - %10 = fir.embox %8#0 : (!fir.ref>) -> !fir.box> - mif.change_team %10 : (!fir.box>) { - %13 = fir.load %4#0 : !fir.ref - %c1_i32 = arith.constant 1 : i32 - %14 = arith.addi %13, %c1_i32 : i32 - hlfir.assign %14 to %4#0 : i32, !fir.ref - mif.end_team : () -> () +module attributes {dlti.dl_spec = #dlti.dl_spec = dense<32> : vector<4xi64>, !llvm.ptr<271> = dense<32> : vector<4xi64>, !llvm.ptr<272> = dense<64> : vector<4xi64>, i64 = dense<64> : vector<2xi64>, i128 = dense<128> : vector<2xi64>, f80 = dense<128> : vector<2xi64>, !llvm.ptr = dense<64> : vector<4xi64>, i1 = dense<8> : vector<2xi64>, i8 = dense<8> : vector<2xi64>, i16 = dense<16> : vector<2xi64>, i32 = dense<32> : vector<2xi64>, f16 = dense<16> : vector<2xi64>, f64 = dense<64> : vector<2xi64>, f128 = dense<128> : vector<2xi64>, "dlti.endianness" = "little", "dlti.mangling_mode" = "e", "dlti.legal_int_widths" = array, "dlti.stack_alignment" = 128 : i64>, fir.defaultkind = "a1c4d8i4l4r4", fir.kindmap = "", llvm.data_layout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-i128:128-f80:128-n8:16:32:64-S128", llvm.ident = "flang version 22.0.0 (git@github.com:SiPearl/llvm-project.git 666e4313ebc03587f27774139ad8f780bac15c3e)", llvm.target_triple = "x86_64-unknown-linux-gnu"} { + func.func @_QQmain() attributes {fir.bindc_name = "TEST_CHANGE_TEAM"} { + %0 = fir.dummy_scope : !fir.dscope + %c10 = arith.constant 10 : index + %1 = fir.alloca !fir.char<1,10> {bindc_name = "err", uniq_name = "_QFEerr"} + %2:2 = hlfir.declare %1 typeparams %c10 {uniq_name = "_QFEerr"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) + %3 = fir.alloca i32 {bindc_name = "i", uniq_name = "_QFEi"} + %4:2 = hlfir.declare %3 {uniq_name = "_QFEi"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %5 = fir.alloca i32 {bindc_name = "stat", uniq_name = "_QFEstat"} + %6:2 = hlfir.declare %5 {uniq_name = "_QFEstat"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %7 = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}> {bindc_name = "team", uniq_name = "_QFEteam"} + %8:2 = hlfir.declare %7 {uniq_name = "_QFEteam"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) + %9 = fir.address_of(@_QQ_QM__fortran_builtinsT__builtin_team_type.DerivedInit) : !fir.ref> + fir.copy %9 to %8#0 no_overlap : !fir.ref>, !fir.ref> + %10 = fir.embox %8#0 : (!fir.ref>) -> !fir.box> + mif.change_team %10 : (!fir.box>) { + %13 = fir.load %4#0 : !fir.ref + %c1_i32 = arith.constant 1 : i32 + %14 = arith.addi %13, %c1_i32 : i32 + hlfir.assign %14 to %4#0 : i32, !fir.ref + mif.end_team : () -> () + } + %11 = fir.embox %2#0 : (!fir.ref>) -> !fir.box> + %12 = fir.embox %8#0 : (!fir.ref>) -> !fir.box> + mif.change_team %12 stat %6#0 errmsg %11 : (!fir.box>, !fir.ref, !fir.box>) { + mif.end_team : () -> () + } + return } - %11 = fir.embox %2#0 : (!fir.ref>) -> !fir.box> - %12 = fir.embox %8#0 : (!fir.ref>) -> !fir.box> - mif.change_team %12 stat %6#0 errmsg %11 : (!fir.box>, !fir.ref, !fir.box>) { - mif.end_team : () -> () - } - return } // CHECK: %[[VAL_1:.*]] = fir.absent !fir.ref diff --git a/flang/test/Fir/MIF/coarray-alloc.mlir b/flang/test/Fir/MIF/coarray-alloc.mlir new file mode 100644 index 0000000000000..7995a1bdcaf11 --- /dev/null +++ b/flang/test/Fir/MIF/coarray-alloc.mlir @@ -0,0 +1,154 @@ +// RUN: fir-opt --mif-convert %s | FileCheck %s + +module attributes {dlti.dl_spec = #dlti.dl_spec = dense<32> : vector<4xi64>, !llvm.ptr<271> = dense<32> : vector<4xi64>, !llvm.ptr<272> = dense<64> : vector<4xi64>, i64 = dense<64> : vector<2xi64>, i128 = dense<128> : vector<2xi64>, f80 = dense<128> : vector<2xi64>, !llvm.ptr = dense<64> : vector<4xi64>, i1 = dense<8> : vector<2xi64>, i8 = dense<8> : vector<2xi64>, i16 = dense<16> : vector<2xi64>, i32 = dense<32> : vector<2xi64>, f16 = dense<16> : vector<2xi64>, f64 = dense<64> : vector<2xi64>, f128 = dense<128> : vector<2xi64>, "dlti.endianness" = "little", "dlti.mangling_mode" = "e", "dlti.legal_int_widths" = array, "dlti.stack_alignment" = 128 : i64>, fir.defaultkind = "a1c4d8i4l4r4", fir.kindmap = "", llvm.data_layout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-i128:128-f80:128-n8:16:32:64-S128", llvm.ident = "flang version 23.0.0 (git@github.com:SiPearl/llvm-project.git 19de25e93ebb883ee9ea006994d81c61a4817131)", llvm.target_triple = "x86_64-unknown-linux-gnu"} { +// CHECK-LABEL: func.func @_QQmain + func.func @_QQmain() attributes {fir.bindc_name = "ALLOC_TEST"} { + %0 = fir.alloca i32 + %1 = fir.alloca i32 + %2 = fir.alloca i32 + %3 = fir.alloca i32 + %4 = fir.alloca i32 + %5 = fir.alloca i32 + %6 = fir.dummy_scope : !fir.dscope + %7 = fir.address_of(@_QFE.n.my_type2) : !fir.ref> + %c8 = arith.constant 8 : index + %8:2 = hlfir.declare %7 typeparams %c8 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFE.n.my_type2"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) + %9 = fir.address_of(@_QFE.n.co) : !fir.ref> + %c2 = arith.constant 2 : index + %10:2 = hlfir.declare %9 typeparams %c2 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFE.n.co"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) + %11 = fir.address_of(@_QFE.n.x) : !fir.ref> + %c1 = arith.constant 1 : index + %12:2 = hlfir.declare %11 typeparams %c1 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFE.n.x"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) + %13 = fir.address_of(@_QFE.n.y) : !fir.ref> + %c1_0 = arith.constant 1 : index + %14:2 = hlfir.declare %13 typeparams %c1_0 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFE.n.y"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) + %15 = fir.address_of(@_QFE.n.z) : !fir.ref> + %c1_1 = arith.constant 1 : index + %16:2 = hlfir.declare %15 typeparams %c1_1 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFE.n.z"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) + %17 = fir.address_of(@_QFE.n.w) : !fir.ref> + %c1_2 = arith.constant 1 : index + %18:2 = hlfir.declare %17 typeparams %c1_2 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFE.n.w"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) + %19 = fir.address_of(@_QFE.n.my_type) : !fir.ref> + %c7 = arith.constant 7 : index + %20:2 = hlfir.declare %19 typeparams %c7 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFE.n.my_type"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) + %21 = fir.address_of(@_QFE.n.my_type3) : !fir.ref> + %c8_3 = arith.constant 8 : index + %22:2 = hlfir.declare %21 typeparams %c8_3 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFE.n.my_type3"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) + %23 = fir.address_of(@_QFEa) : !fir.ref + +// CHECK: fir.call @_QMprifPprif_allocate_coarray({{.*}}) : (!fir.box>, !fir.box>, !fir.ref, !fir.ref, !fir.box, !fir.ptr, !fir.ref, !fir.box>, !fir.box>) -> () + mif.alloc_coarray %23 {lcobounds = array, ucobounds = array, uniq_name = "_QFEa"} : (!fir.ref) -> () + %24:2 = hlfir.declare %23 {uniq_name = "_QFEa"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %25 = fir.address_of(@_QFEa2) : !fir.ref>> + %26:2 = hlfir.declare %25 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFEa2"} : (!fir.ref>>) -> (!fir.ref>>, !fir.ref>>) + %27 = fir.address_of(@_QFEb) : !fir.ref + +// CHECK: fir.call @_QMprifPprif_allocate_coarray({{.*}}) : (!fir.box>, !fir.box>, !fir.ref, !fir.ref, !fir.box, !fir.ptr, !fir.ref, !fir.box>, !fir.box>) -> () + mif.alloc_coarray %27 {lcobounds = array, ucobounds = array, uniq_name = "_QFEb"} : (!fir.ref) -> () + %28:2 = hlfir.declare %27 {uniq_name = "_QFEb"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %29 = fir.address_of(@_QFEb2) : !fir.ref>> + %30:2 = hlfir.declare %29 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFEb2"} : (!fir.ref>>) -> (!fir.ref>>, !fir.ref>>) + %31 = fir.address_of(@_QFEc) : !fir.ref> + %c10 = arith.constant 10 : index + +// CHECK: fir.call @_QMprifPprif_allocate_coarray({{.*}}) : (!fir.box>, !fir.box>, !fir.ref, !fir.ref, !fir.box, !fir.ptr, !fir.ref, !fir.box>, !fir.box>) -> () + mif.alloc_coarray %31 {lcobounds = array, ucobounds = array, uniq_name = "_QFEc"} : (!fir.ref>) -> () + %32:2 = hlfir.declare %31 typeparams %c10 {uniq_name = "_QFEc"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) + %33 = fir.address_of(@_QFEc2) : !fir.ref>>>> + %34:2 = hlfir.declare %33 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFEc2"} : (!fir.ref>>>>) -> (!fir.ref>>>>, !fir.ref>>>>) + %35 = fir.address_of(@_QFEd) : !fir.ref>>,z:!fir.type<_QFTmy_type2{co:!fir.box>}>}>> + %36:2 = hlfir.declare %35 {uniq_name = "_QFEd"} : (!fir.ref>>,z:!fir.type<_QFTmy_type2{co:!fir.box>}>}>>) -> (!fir.ref>>,z:!fir.type<_QFTmy_type2{co:!fir.box>}>}>>, !fir.ref>>,z:!fir.type<_QFTmy_type2{co:!fir.box>}>}>>) + %37 = fir.address_of(@_QFEd2) : !fir.ref>>}>> + + %38:2 = hlfir.declare %37 {uniq_name = "_QFEd2"} : (!fir.ref>>}>>) -> (!fir.ref>>}>>, !fir.ref>>}>>) + %39 = fir.address_of(@_QFE.c.my_type2) : !fir.ref>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>> + %c0 = arith.constant 0 : index + %c1_4 = arith.constant 1 : index + %40 = fir.shape_shift %c0, %c1_4 : (index, index) -> !fir.shapeshift<1> + %41:2 = hlfir.declare %39(%40) {fortran_attrs = #fir.var_attrs, uniq_name = "_QFE.c.my_type2"} : (!fir.ref>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>, !fir.shapeshift<1>) -> (!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>, !fir.ref>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>) + %42 = fir.address_of(@_QFE.c.my_type3) : !fir.ref>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>> + %c0_5 = arith.constant 0 : index + %c1_6 = arith.constant 1 : index + %43 = fir.shape_shift %c0_5, %c1_6 : (index, index) -> !fir.shapeshift<1> + %44:2 = hlfir.declare %42(%43) {fortran_attrs = #fir.var_attrs, uniq_name = "_QFE.c.my_type3"} : (!fir.ref>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>, !fir.shapeshift<1>) -> (!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>, !fir.ref>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>) + %45 = fir.address_of(@_QFE.dt.my_type) : !fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>> + %46:2 = hlfir.declare %45 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFE.dt.my_type"} : (!fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>) -> (!fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>, !fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>) + %47 = fir.address_of(@_QFE.dt.my_type3) : !fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>> + %48:2 = hlfir.declare %47 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFE.dt.my_type3"} : (!fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>) -> (!fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>, !fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>) + %49 = fir.address_of(@_QFE.dt.my_type2) : !fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>> + %50:2 = hlfir.declare %49 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFE.dt.my_type2"} : (!fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>) -> (!fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>, !fir.ref,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>) + %51 = fir.address_of(@_QFE.c.my_type) : !fir.ref>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>> + %c0_7 = arith.constant 0 : index + %c3 = arith.constant 3 : index + %52 = fir.shape_shift %c0_7, %c3 : (index, index) -> !fir.shapeshift<1> + %53:2 = hlfir.declare %51(%52) {fortran_attrs = #fir.var_attrs, uniq_name = "_QFE.c.my_type"} : (!fir.ref>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>, !fir.shapeshift<1>) -> (!fir.box>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>, !fir.ref>>,genre:i8,category:i8,kind:i8,rank:i8,memoryspace:i8,__padding0:!fir.array<3xi8>,offset:i64,characterlen:!fir.type<_QM__fortran_type_infoTvalue{genre:i8,__padding0:!fir.array<7xi8>,value:i64}>,derived:!fir.box,name:!fir.box>>}>>>>,name:!fir.box>>,sizeinbytes:i64,uninstantiated:!fir.box>>,kindparameter:!fir.box>>,lenparameterkind:!fir.box>>,component:!fir.box>>>,procptr:!fir.box>>,offset:i64,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,special:!fir.box,proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>}>>>>,specialbitset:i32,hasparent:i8,noinitializationneeded:i8,nodestructionneeded:i8,nofinalizationneeded:i8,nodefinedassignment:i8,__padding0:!fir.array<3xi8>}>>>,lenvalue:!fir.box,value:i64}>>>>,bounds:!fir.box,value:i64}>>>>,initialization:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>>) + %54 = fir.absent !fir.box + +// CHECK: fir.call @_QMprifPprif_allocate_coarray({{.*}}) : (!fir.box>, !fir.box>, !fir.ref, !fir.ref, !fir.box, !fir.ptr, !fir.ref, !fir.box>, !fir.box>) -> () + mif.alloc_coarray %26#0 errmsg %54 {lcobounds = array, ucobounds = array, uniq_name = "_QFEa2"} : (!fir.ref>>, !fir.box) -> () + %55 = fir.absent !fir.box + +// CHECK: fir.call @_QMprifPprif_allocate_coarray({{.*}}) : (!fir.box>, !fir.box>, !fir.ref, !fir.ref, !fir.box, !fir.ptr, !fir.ref, !fir.box>, !fir.box>) -> () + mif.alloc_coarray %30#0 errmsg %55 {lcobounds = array, ucobounds = array, uniq_name = "_QFEb2"} : (!fir.ref>>, !fir.box) -> () + %c100_i32 = arith.constant 100 : i32 + %56 = fir.absent !fir.box + %c1_i32 = arith.constant 1 : i32 + %c1_i32_8 = arith.constant 1 : i32 + %c0_i32 = arith.constant 0 : i32 + %57 = fir.convert %34#0 : (!fir.ref>>>>) -> !fir.ref> + %58 = fir.convert %c100_i32 : (i32) -> i64 + fir.call @_FortranAAllocatableInitCharacterForAllocate(%57, %58, %c1_i32, %c1_i32_8, %c0_i32) fastmath : (!fir.ref>, i64, i32, i32, i32) -> () + %c1_9 = arith.constant 1 : index + %c5_i32 = arith.constant 5 : i32 + %c0_i32_10 = arith.constant 0 : i32 + %59 = fir.convert %34#0 : (!fir.ref>>>>) -> !fir.ref> + %60 = fir.convert %c1_9 : (index) -> i64 + %61 = fir.convert %c5_i32 : (i32) -> i64 + fir.call @_FortranAAllocatableSetBounds(%59, %c0_i32_10, %60, %61) fastmath : (!fir.ref>, i32, i64, i64) -> () + + %62 = fir.absent !fir.box + %63 = hlfir.designate %36#0{"z"} : (!fir.ref>>,z:!fir.type<_QFTmy_type2{co:!fir.box>}>}>>) -> !fir.ref>}>> + %64 = hlfir.designate %63{"co"} {fortran_attrs = #fir.var_attrs} : (!fir.ref>}>>) -> !fir.ref>> + +// CHECK: fir.call @_QMprifPprif_allocate_coarray({{.*}}) : (!fir.box>, !fir.box>, !fir.ref, !fir.ref, !fir.box, !fir.ptr, !fir.ref, !fir.box>, !fir.box>) -> () + mif.alloc_coarray %64 errmsg %62 {lcobounds = array, ucobounds = array, uniq_name = "_QFEd.z.co"} : (!fir.ref>>, !fir.box) -> () + %65 = fir.absent !fir.box + %66 = hlfir.designate %38#0{"w"} {fortran_attrs = #fir.var_attrs} : (!fir.ref>>}>>) -> !fir.ref>>> + %c1_11 = arith.constant 1 : index + %c100_i32_12 = arith.constant 100 : i32 + %c0_i32_13 = arith.constant 0 : i32 + %67 = fir.convert %66 : (!fir.ref>>>) -> !fir.ref> + %68 = fir.convert %c1_11 : (index) -> i64 + %69 = fir.convert %c100_i32_12 : (i32) -> i64 + fir.call @_FortranAAllocatableSetBounds(%67, %c0_i32_13, %68, %69) fastmath : (!fir.ref>, i32, i64, i64) -> () + + %70 = fir.absent !fir.box +// CHECK: fir.call @_QMprifPprif_deallocate_coarray({{.*}}) : (!fir.box, !fir.ref, !fir.box>, !fir.box>) -> () + mif.dealloc_coarray %26#0 stat %4 errmsg %70 : (!fir.ref>>, !fir.ref, !fir.box) -> () + +// CHECK: fir.call @_QMprifPprif_deallocate_coarray({{.*}}) : (!fir.box, !fir.ref, !fir.box>, !fir.box>) -> () + mif.dealloc_coarray %30#0 stat %3 errmsg %70 : (!fir.ref>>, !fir.ref, !fir.box) -> () + +// CHECK: fir.call @_QMprifPprif_deallocate_coarray({{.*}}) : (!fir.box, !fir.ref, !fir.box>, !fir.box>) -> () + mif.dealloc_coarray %34#0 stat %2 errmsg %70 : (!fir.ref>>>>, !fir.ref, !fir.box) -> () + %71 = fir.absent !fir.box + %72 = hlfir.designate %36#0{"z"} : (!fir.ref>>,z:!fir.type<_QFTmy_type2{co:!fir.box>}>}>>) -> !fir.ref>}>> + %73 = hlfir.designate %72{"co"} {fortran_attrs = #fir.var_attrs} : (!fir.ref>}>>) -> !fir.ref>> + +// CHECK: fir.call @_QMprifPprif_deallocate_coarray({{.*}}) : (!fir.box, !fir.ref, !fir.box>, !fir.box>) -> () + mif.dealloc_coarray %73 stat %1 errmsg %71 : (!fir.ref>>, !fir.ref, !fir.box) -> () + %74 = fir.absent !fir.box + %75 = hlfir.designate %38#0{"w"} {fortran_attrs = #fir.var_attrs} : (!fir.ref>>}>>) -> !fir.ref>>> + return + } +} + + +// CHECK: fir.global linkonce_odr @_QMprifE.dt.prif_coarray_handle : !fir.type<_QMprifTprif_coarray_handle{info:!fir.box>}> +// CHECK: fir.global linkonce @_QFEa_coarray_handle : !fir.box>}>> +// CHECK: fir.global linkonce @_QFEb_coarray_handle : !fir.box>}>> +// CHECK: fir.global linkonce @_QFEc_coarray_handle : !fir.box>}>> +// CHECK: fir.global linkonce @_QFEa2_coarray_handle : !fir.box>}>> +// CHECK: fir.global linkonce @_QFEb2_coarray_handle : !fir.box>}>> +// CHECK: fir.global linkonce @_QFEd.z.co_coarray_handle : !fir.box>}>> + diff --git a/flang/test/Fir/MIF/cobound.mlir b/flang/test/Fir/MIF/cobound.mlir new file mode 100644 index 0000000000000..fd99a8dfe2d14 --- /dev/null +++ b/flang/test/Fir/MIF/cobound.mlir @@ -0,0 +1,69 @@ +// RUN: fir-opt --mif-convert %s | FileCheck %s + +module attributes {dlti.dl_spec = #dlti.dl_spec = dense<32> : vector<4xi64>, !llvm.ptr<271> = dense<32> : vector<4xi64>, !llvm.ptr<272> = dense<64> : vector<4xi64>, i64 = dense<64> : vector<2xi64>, i128 = dense<128> : vector<2xi64>, f80 = dense<128> : vector<2xi64>, !llvm.ptr = dense<64> : vector<4xi64>, i1 = dense<8> : vector<2xi64>, i8 = dense<8> : vector<2xi64>, i16 = dense<16> : vector<2xi64>, i32 = dense<32> : vector<2xi64>, f16 = dense<16> : vector<2xi64>, f64 = dense<64> : vector<2xi64>, f128 = dense<128> : vector<2xi64>, "dlti.endianness" = "little", "dlti.mangling_mode" = "e", "dlti.legal_int_widths" = array, "dlti.stack_alignment" = 128 : i64>, fir.defaultkind = "a1c4d8i4l4r4", fir.kindmap = "", llvm.data_layout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-i128:128-f80:128-n8:16:32:64-S128", llvm.ident = "flang version 23.0.0 (git@github.com:SiPearl/llvm-project.git d31a4730513391710d91c5ad33bb8ea3d68db3cb)", llvm.target_triple = "x86_64-unknown-linux-gnu"} { +// CHECK-LABEL: func.func @_QQmain + func.func @_QQmain() attributes {fir.bindc_name = "TEST"} { + %0 = fir.dummy_scope : !fir.dscope + %1 = fir.address_of(@_QFEa) : !fir.ref>> + %2:2 = hlfir.declare %1 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFEa"} : (!fir.ref>>) -> (!fir.ref>>, !fir.ref>>) + %c3 = arith.constant 3 : index + %3 = fir.alloca !fir.array<3xi32> {bindc_name = "res1", uniq_name = "_QFEres1"} + %4 = fir.shape %c3 : (index) -> !fir.shape<1> + %5:2 = hlfir.declare %3(%4) {uniq_name = "_QFEres1"} : (!fir.ref>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>) + %6 = fir.alloca i32 {bindc_name = "res2", uniq_name = "_QFEres2"} + %7:2 = hlfir.declare %6 {uniq_name = "_QFEres2"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %8 = fir.absent !fir.box + mif.alloc_coarray %2#0 errmsg %8 {lcobounds = array, ucobounds = array, uniq_name = "_QFEa"} : (!fir.ref>>, !fir.box) -> () + %9 = fir.load %2#0 : !fir.ref>> + %10 = fir.box_addr %9 {fir.corank = 3 : i32} : (!fir.box>) -> !fir.heap +// CHECK: fir.call @_QMprifPprif_lcobound_no_dim + %11 = mif.lcobound coarray %10 : (!fir.heap) -> !fir.box> + %12:2 = hlfir.declare %11 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box>) -> (!fir.box>, !fir.box>) + %false = arith.constant false + %13 = hlfir.as_expr %12#0 move %false : (!fir.box>, i1) -> !hlfir.expr + %c0 = arith.constant 0 : index + %14:3 = fir.box_dims %12#0, %c0 : (!fir.box>, index) -> (index, index, index) + %15 = fir.shape %14#1 : (index) -> !fir.shape<1> + %16 = hlfir.elemental %15 unordered : (!fir.shape<1>) -> !hlfir.expr { + ^bb0(%arg0: index): + %31 = hlfir.apply %13, %arg0 : (!hlfir.expr, index) -> i64 + %32 = fir.convert %31 : (i64) -> i32 + hlfir.yield_element %32 : i32 + } + hlfir.assign %16 to %5#0 : !hlfir.expr, !fir.ref> + hlfir.destroy %16 : !hlfir.expr + hlfir.destroy %13 : !hlfir.expr + %c2_i32 = arith.constant 2 : i32 + %17 = fir.load %2#0 : !fir.ref>> + %18 = fir.box_addr %17 {fir.corank = 3 : i32} : (!fir.box>) -> !fir.heap +// CHECK: fir.call @_QMprifPprif_lcobound_with_dim + %19 = mif.lcobound coarray %18 dim %c2_i32 : (!fir.heap, i32) -> i32 + hlfir.assign %19 to %7#0 : i32, !fir.ref + %20 = fir.load %2#0 : !fir.ref>> + %21 = fir.box_addr %20 {fir.corank = 3 : i32} : (!fir.box>) -> !fir.heap +// CHECK: fir.call @_QMprifPprif_ucobound_no_dim + %22 = mif.ucobound coarray %21 : (!fir.heap) -> !fir.box> + %23:2 = hlfir.declare %22 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box>) -> (!fir.box>, !fir.box>) + %false_0 = arith.constant false + %24 = hlfir.as_expr %23#0 move %false_0 : (!fir.box>, i1) -> !hlfir.expr + %c0_1 = arith.constant 0 : index + %25:3 = fir.box_dims %23#0, %c0_1 : (!fir.box>, index) -> (index, index, index) + %26 = fir.shape %25#1 : (index) -> !fir.shape<1> + %27 = hlfir.elemental %26 unordered : (!fir.shape<1>) -> !hlfir.expr { + ^bb0(%arg0: index): + %31 = hlfir.apply %24, %arg0 : (!hlfir.expr, index) -> i64 + %32 = fir.convert %31 : (i64) -> i32 + hlfir.yield_element %32 : i32 + } + hlfir.assign %27 to %5#0 : !hlfir.expr, !fir.ref> + hlfir.destroy %27 : !hlfir.expr + hlfir.destroy %24 : !hlfir.expr + %c2_i32_2 = arith.constant 2 : i32 + %28 = fir.load %2#0 : !fir.ref>> + %29 = fir.box_addr %28 {fir.corank = 3 : i32} : (!fir.box>) -> !fir.heap +// CHECK: fir.call @_QMprifPprif_ucobound_with_dim + %30 = mif.ucobound coarray %29 dim %c2_i32_2 : (!fir.heap, i32) -> i32 + hlfir.assign %30 to %7#0 : i32, !fir.ref + return + } +} diff --git a/flang/test/Fir/MIF/coshape.mlir b/flang/test/Fir/MIF/coshape.mlir new file mode 100644 index 0000000000000..55ca015eb537f --- /dev/null +++ b/flang/test/Fir/MIF/coshape.mlir @@ -0,0 +1,54 @@ +// RUN: fir-opt --mif-convert %s | FileCheck %s + +module attributes {dlti.dl_spec = #dlti.dl_spec = dense<32> : vector<4xi64>, !llvm.ptr<271> = dense<32> : vector<4xi64>, !llvm.ptr<272> = dense<64> : vector<4xi64>, i64 = dense<64> : vector<2xi64>, i128 = dense<128> : vector<2xi64>, f80 = dense<128> : vector<2xi64>, !llvm.ptr = dense<64> : vector<4xi64>, i1 = dense<8> : vector<2xi64>, i8 = dense<8> : vector<2xi64>, i16 = dense<16> : vector<2xi64>, i32 = dense<32> : vector<2xi64>, f16 = dense<16> : vector<2xi64>, f64 = dense<64> : vector<2xi64>, f128 = dense<128> : vector<2xi64>, "dlti.endianness" = "little", "dlti.mangling_mode" = "e", "dlti.legal_int_widths" = array, "dlti.stack_alignment" = 128 : i64>, fir.defaultkind = "a1c4d8i4l4r4", fir.kindmap = "", llvm.data_layout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-i128:128-f80:128-n8:16:32:64-S128", llvm.ident = "flang version 23.0.0 (git@github.com:SiPearl/llvm-project.git d31a4730513391710d91c5ad33bb8ea3d68db3cb)", llvm.target_triple = "x86_64-unknown-linux-gnu"} { + func.func @_QQmain() attributes {fir.bindc_name = "TEST"} { + %0 = fir.dummy_scope : !fir.dscope + %1 = fir.address_of(@_QFEa) : !fir.ref + mif.alloc_coarray %1 {lcobounds = array, ucobounds = array, uniq_name = "_QFEa"} : (!fir.ref) -> () + %2:2 = hlfir.declare %1 {fir.corank = 3 : i32, uniq_name = "_QFEa"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %c3 = arith.constant 3 : index + %3 = fir.alloca !fir.array<3xi32> {bindc_name = "res", uniq_name = "_QFEres"} + %4 = fir.shape %c3 : (index) -> !fir.shape<1> + %5:2 = hlfir.declare %3(%4) {uniq_name = "_QFEres"} : (!fir.ref>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>) + %c3_0 = arith.constant 3 : index + %6 = fir.alloca !fir.array<3xi64> {bindc_name = "res2", uniq_name = "_QFEres2"} + %7 = fir.shape %c3_0 : (index) -> !fir.shape<1> + %8:2 = hlfir.declare %6(%7) {uniq_name = "_QFEres2"} : (!fir.ref>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>) + %9 = mif.coshape coarray %2#0 : (!fir.ref) -> !fir.box> + %10:2 = hlfir.declare %9 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box>) -> (!fir.box>, !fir.box>) + %false = arith.constant false + %11 = hlfir.as_expr %10#0 move %false : (!fir.box>, i1) -> !hlfir.expr + %c0 = arith.constant 0 : index + %12:3 = fir.box_dims %10#0, %c0 : (!fir.box>, index) -> (index, index, index) + %13 = fir.shape %12#1 : (index) -> !fir.shape<1> + %14 = hlfir.elemental %13 unordered : (!fir.shape<1>) -> !hlfir.expr { + ^bb0(%arg0: index): + %21 = hlfir.apply %11, %arg0 : (!hlfir.expr, index) -> i64 + %22 = fir.convert %21 : (i64) -> i32 + hlfir.yield_element %22 : i32 + } + hlfir.assign %14 to %5#0 : !hlfir.expr, !fir.ref> + hlfir.destroy %14 : !hlfir.expr + hlfir.destroy %11 : !hlfir.expr + %15 = mif.coshape coarray %2#0 : (!fir.ref) -> !fir.box> + %16:2 = hlfir.declare %15 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box>) -> (!fir.box>, !fir.box>) + %false_1 = arith.constant false + %17 = hlfir.as_expr %16#0 move %false_1 : (!fir.box>, i1) -> !hlfir.expr + %c0_2 = arith.constant 0 : index + %18:3 = fir.box_dims %16#0, %c0_2 : (!fir.box>, index) -> (index, index, index) + %19 = fir.shape %18#1 : (index) -> !fir.shape<1> + %20 = hlfir.elemental %19 unordered : (!fir.shape<1>) -> !hlfir.expr { + ^bb0(%arg0: index): + %21 = hlfir.apply %17, %arg0 : (!hlfir.expr, index) -> i64 + hlfir.yield_element %21 : i64 + } + hlfir.assign %20 to %8#0 : !hlfir.expr, !fir.ref> + hlfir.destroy %20 : !hlfir.expr + hlfir.destroy %17 : !hlfir.expr + return + } +} + +// CHECK-LABEL: func.func @_QQmain +// CHECK: fir.call @_QMprifPprif_coshape +// CHECK: fir.call @_QMprifPprif_coshape diff --git a/flang/test/Fir/MIF/form_team.mlir b/flang/test/Fir/MIF/form_team.mlir index f7f957afb7cc0..6b170876d29f3 100644 --- a/flang/test/Fir/MIF/form_team.mlir +++ b/flang/test/Fir/MIF/form_team.mlir @@ -1,36 +1,39 @@ // RUN: fir-opt --mif-convert %s | FileCheck %s -func.func @_QQmain() attributes {fir.bindc_name = "TEST_FORM_TEAM"} { - %0 = fir.dummy_scope : !fir.dscope - %c10 = arith.constant 10 : index - %1 = fir.alloca !fir.char<1,10> {bindc_name = "err", uniq_name = "_QFEerr"} - %2:2 = hlfir.declare %1 typeparams %c10 {uniq_name = "_QFEerr"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) - %3 = fir.alloca i32 {bindc_name = "stat", uniq_name = "_QFEstat"} - %4:2 = hlfir.declare %3 {uniq_name = "_QFEstat"} : (!fir.ref) -> (!fir.ref, !fir.ref) - %5 = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}> {bindc_name = "team", uniq_name = "_QFEteam"} - %6:2 = hlfir.declare %5 {uniq_name = "_QFEteam"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) - %7 = fir.address_of(@_QQ_QM__fortran_builtinsT__builtin_team_type.DerivedInit) : !fir.ref> - fir.copy %7 to %6#0 no_overlap : !fir.ref>, !fir.ref> - %8 = fir.alloca i32 {bindc_name = "team_index", uniq_name = "_QFEteam_index"} - %9:2 = hlfir.declare %8 {uniq_name = "_QFEteam_index"} : (!fir.ref) -> (!fir.ref, !fir.ref) - %10 = fir.alloca i32 {bindc_name = "team_number", uniq_name = "_QFEteam_number"} - %11:2 = hlfir.declare %10 {uniq_name = "_QFEteam_number"} : (!fir.ref) -> (!fir.ref, !fir.ref) - %12 = fir.load %11#0 : !fir.ref - %13 = fir.embox %6#0 : (!fir.ref>) -> !fir.box> - mif.form_team team_number %12 team_var %13 : (i32, !fir.box>) -> () - %14 = fir.load %9#0 : !fir.ref - %15 = fir.load %11#0 : !fir.ref - %16 = fir.embox %6#0 : (!fir.ref>) -> !fir.box> - mif.form_team team_number %15 team_var %16 new_index %14 : (i32, !fir.box>, i32) -> () - %17 = fir.load %11#0 : !fir.ref - %18 = fir.embox %6#0 : (!fir.ref>) -> !fir.box> - mif.form_team team_number %17 team_var %18 stat %4#0 : (i32, !fir.box>, !fir.ref) -> () - %19 = fir.embox %2#0 : (!fir.ref>) -> !fir.box> - %20 = fir.load %11#0 : !fir.ref - %21 = fir.embox %6#0 : (!fir.ref>) -> !fir.box> - mif.form_team team_number %20 team_var %21 errmsg %19 : (i32, !fir.box>, !fir.box>) -> () - return +module attributes {dlti.dl_spec = #dlti.dl_spec = dense<32> : vector<4xi64>, !llvm.ptr<271> = dense<32> : vector<4xi64>, !llvm.ptr<272> = dense<64> : vector<4xi64>, i64 = dense<64> : vector<2xi64>, i128 = dense<128> : vector<2xi64>, f80 = dense<128> : vector<2xi64>, !llvm.ptr = dense<64> : vector<4xi64>, i1 = dense<8> : vector<2xi64>, i8 = dense<8> : vector<2xi64>, i16 = dense<16> : vector<2xi64>, i32 = dense<32> : vector<2xi64>, f16 = dense<16> : vector<2xi64>, f64 = dense<64> : vector<2xi64>, f128 = dense<128> : vector<2xi64>, "dlti.endianness" = "little", "dlti.mangling_mode" = "e", "dlti.legal_int_widths" = array, "dlti.stack_alignment" = 128 : i64>, fir.defaultkind = "a1c4d8i4l4r4", fir.kindmap = "", llvm.data_layout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-i128:128-f80:128-n8:16:32:64-S128", llvm.ident = "flang version 22.0.0 (git@github.com:SiPearl/llvm-project.git 666e4313ebc03587f27774139ad8f780bac15c3e)", llvm.target_triple = "x86_64-unknown-linux-gnu"} { + func.func @_QQmain() attributes {fir.bindc_name = "TEST_FORM_TEAM"} { + %0 = fir.dummy_scope : !fir.dscope + %c10 = arith.constant 10 : index + %1 = fir.alloca !fir.char<1,10> {bindc_name = "err", uniq_name = "_QFEerr"} + %2:2 = hlfir.declare %1 typeparams %c10 {uniq_name = "_QFEerr"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) + %3 = fir.alloca i32 {bindc_name = "stat", uniq_name = "_QFEstat"} + %4:2 = hlfir.declare %3 {uniq_name = "_QFEstat"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %5 = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}> {bindc_name = "team", uniq_name = "_QFEteam"} + %6:2 = hlfir.declare %5 {uniq_name = "_QFEteam"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) + %7 = fir.address_of(@_QQ_QM__fortran_builtinsT__builtin_team_type.DerivedInit) : !fir.ref> + fir.copy %7 to %6#0 no_overlap : !fir.ref>, !fir.ref> + %8 = fir.alloca i32 {bindc_name = "team_index", uniq_name = "_QFEteam_index"} + %9:2 = hlfir.declare %8 {uniq_name = "_QFEteam_index"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %10 = fir.alloca i32 {bindc_name = "team_number", uniq_name = "_QFEteam_number"} + %11:2 = hlfir.declare %10 {uniq_name = "_QFEteam_number"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %12 = fir.load %11#0 : !fir.ref + %13 = fir.embox %6#0 : (!fir.ref>) -> !fir.box> + mif.form_team team_number %12 team_var %13 : (i32, !fir.box>) -> () + %14 = fir.load %9#0 : !fir.ref + %15 = fir.load %11#0 : !fir.ref + %16 = fir.embox %6#0 : (!fir.ref>) -> !fir.box> + mif.form_team team_number %15 team_var %16 new_index %14 : (i32, !fir.box>, i32) -> () + %17 = fir.load %11#0 : !fir.ref + %18 = fir.embox %6#0 : (!fir.ref>) -> !fir.box> + mif.form_team team_number %17 team_var %18 stat %4#0 : (i32, !fir.box>, !fir.ref) -> () + %19 = fir.embox %2#0 : (!fir.ref>) -> !fir.box> + %20 = fir.load %11#0 : !fir.ref + %21 = fir.embox %6#0 : (!fir.ref>) -> !fir.box> + mif.form_team team_number %20 team_var %21 errmsg %19 : (i32, !fir.box>, !fir.box>) -> () + return + } } + // CHECK: %[[VAL_1:.*]] = fir.absent !fir.ref // CHECK: %[[VAL_2:.*]] = fir.absent !fir.ref // CHECK: %[[VAL_3:.*]] = fir.absent !fir.box> diff --git a/flang/test/Fir/MIF/get_team.mlir b/flang/test/Fir/MIF/get_team.mlir index 10799fa2292b6..80e84412e47a8 100644 --- a/flang/test/Fir/MIF/get_team.mlir +++ b/flang/test/Fir/MIF/get_team.mlir @@ -1,54 +1,56 @@ // RUN: fir-opt --mif-convert %s | FileCheck %s -func.func @_QQmain() attributes {fir.bindc_name = "TEST_FORM_TEAM"} { - %0 = fir.dummy_scope : !fir.dscope - %1 = fir.address_of(@_QMiso_fortran_envECcurrent_team) : !fir.ref - %2:2 = hlfir.declare %1 {fortran_attrs = #fir.var_attrs, uniq_name = "_QMiso_fortran_envECcurrent_team"} : (!fir.ref) -> (!fir.ref, !fir.ref) - %3 = fir.address_of(@_QMiso_fortran_envECinitial_team) : !fir.ref - %4:2 = hlfir.declare %3 {fortran_attrs = #fir.var_attrs, uniq_name = "_QMiso_fortran_envECinitial_team"} : (!fir.ref) -> (!fir.ref, !fir.ref) - %5 = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFEn"} - %6:2 = hlfir.declare %5 {uniq_name = "_QFEn"} : (!fir.ref) -> (!fir.ref, !fir.ref) - %7 = fir.address_of(@_QMiso_fortran_envECparent_team) : !fir.ref - %8:2 = hlfir.declare %7 {fortran_attrs = #fir.var_attrs, uniq_name = "_QMiso_fortran_envECparent_team"} : (!fir.ref) -> (!fir.ref, !fir.ref) - %9 = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}> {bindc_name = "result_team", uniq_name = "_QFEresult_team"} - %10:2 = hlfir.declare %9 {uniq_name = "_QFEresult_team"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) - %11 = fir.address_of(@_QQ_QM__fortran_builtinsT__builtin_team_type.DerivedInit) : !fir.ref> - fir.copy %11 to %10#0 no_overlap : !fir.ref>, !fir.ref> - %12 = mif.get_team : () -> !fir.box> - %13:2 = hlfir.declare %12 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box>) -> (!fir.box>, !fir.box>) - %false = arith.constant false - %14 = hlfir.as_expr %13#0 move %false : (!fir.box>, i1) -> !hlfir.expr> - hlfir.assign %14 to %10#0 : !hlfir.expr>, !fir.ref> - hlfir.destroy %14 : !hlfir.expr> - %c-2_i32 = arith.constant -2 : i32 - %15 = mif.get_team level %c-2_i32 : (i32) -> !fir.box> - %16:2 = hlfir.declare %15 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box>) -> (!fir.box>, !fir.box>) - %false_0 = arith.constant false - %17 = hlfir.as_expr %16#0 move %false_0 : (!fir.box>, i1) -> !hlfir.expr> - hlfir.assign %17 to %10#0 : !hlfir.expr>, !fir.ref> - hlfir.destroy %17 : !hlfir.expr> - %c-1_i32 = arith.constant -1 : i32 - %18 = mif.get_team level %c-1_i32 : (i32) -> !fir.box> - %19:2 = hlfir.declare %18 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box>) -> (!fir.box>, !fir.box>) - %false_1 = arith.constant false - %20 = hlfir.as_expr %19#0 move %false_1 : (!fir.box>, i1) -> !hlfir.expr> - hlfir.assign %20 to %10#0 : !hlfir.expr>, !fir.ref> - hlfir.destroy %20 : !hlfir.expr> - %c-3_i32 = arith.constant -3 : i32 - %21 = mif.get_team level %c-3_i32 : (i32) -> !fir.box> - %22:2 = hlfir.declare %21 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box>) -> (!fir.box>, !fir.box>) - %false_2 = arith.constant false - %23 = hlfir.as_expr %22#0 move %false_2 : (!fir.box>, i1) -> !hlfir.expr> - hlfir.assign %23 to %10#0 : !hlfir.expr>, !fir.ref> - hlfir.destroy %23 : !hlfir.expr> - %24 = fir.load %6#0 : !fir.ref - %25 = mif.get_team level %24 : (i32) -> !fir.box> - %26:2 = hlfir.declare %25 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box>) -> (!fir.box>, !fir.box>) - %false_3 = arith.constant false - %27 = hlfir.as_expr %26#0 move %false_3 : (!fir.box>, i1) -> !hlfir.expr> - hlfir.assign %27 to %10#0 : !hlfir.expr>, !fir.ref> - hlfir.destroy %27 : !hlfir.expr> - return +module attributes {dlti.dl_spec = #dlti.dl_spec = dense<32> : vector<4xi64>, !llvm.ptr<271> = dense<32> : vector<4xi64>, !llvm.ptr<272> = dense<64> : vector<4xi64>, i64 = dense<64> : vector<2xi64>, i128 = dense<128> : vector<2xi64>, f80 = dense<128> : vector<2xi64>, !llvm.ptr = dense<64> : vector<4xi64>, i1 = dense<8> : vector<2xi64>, i8 = dense<8> : vector<2xi64>, i16 = dense<16> : vector<2xi64>, i32 = dense<32> : vector<2xi64>, f16 = dense<16> : vector<2xi64>, f64 = dense<64> : vector<2xi64>, f128 = dense<128> : vector<2xi64>, "dlti.endianness" = "little", "dlti.mangling_mode" = "e", "dlti.legal_int_widths" = array, "dlti.stack_alignment" = 128 : i64>, fir.defaultkind = "a1c4d8i4l4r4", fir.kindmap = "", llvm.data_layout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-i128:128-f80:128-n8:16:32:64-S128", llvm.ident = "flang version 22.0.0 (git@github.com:SiPearl/llvm-project.git 666e4313ebc03587f27774139ad8f780bac15c3e)", llvm.target_triple = "x86_64-unknown-linux-gnu"} { + func.func @_QQmain() attributes {fir.bindc_name = "TEST_FORM_TEAM"} { + %0 = fir.dummy_scope : !fir.dscope + %1 = fir.address_of(@_QMiso_fortran_envECcurrent_team) : !fir.ref + %2:2 = hlfir.declare %1 {fortran_attrs = #fir.var_attrs, uniq_name = "_QMiso_fortran_envECcurrent_team"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %3 = fir.address_of(@_QMiso_fortran_envECinitial_team) : !fir.ref + %4:2 = hlfir.declare %3 {fortran_attrs = #fir.var_attrs, uniq_name = "_QMiso_fortran_envECinitial_team"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %5 = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFEn"} + %6:2 = hlfir.declare %5 {uniq_name = "_QFEn"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %7 = fir.address_of(@_QMiso_fortran_envECparent_team) : !fir.ref + %8:2 = hlfir.declare %7 {fortran_attrs = #fir.var_attrs, uniq_name = "_QMiso_fortran_envECparent_team"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %9 = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}> {bindc_name = "result_team", uniq_name = "_QFEresult_team"} + %10:2 = hlfir.declare %9 {uniq_name = "_QFEresult_team"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) + %11 = fir.address_of(@_QQ_QM__fortran_builtinsT__builtin_team_type.DerivedInit) : !fir.ref> + fir.copy %11 to %10#0 no_overlap : !fir.ref>, !fir.ref> + %12 = mif.get_team : () -> !fir.box> + %13:2 = hlfir.declare %12 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box>) -> (!fir.box>, !fir.box>) + %false = arith.constant false + %14 = hlfir.as_expr %13#0 move %false : (!fir.box>, i1) -> !hlfir.expr> + hlfir.assign %14 to %10#0 : !hlfir.expr>, !fir.ref> + hlfir.destroy %14 : !hlfir.expr> + %c-2_i32 = arith.constant -2 : i32 + %15 = mif.get_team level %c-2_i32 : (i32) -> !fir.box> + %16:2 = hlfir.declare %15 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box>) -> (!fir.box>, !fir.box>) + %false_0 = arith.constant false + %17 = hlfir.as_expr %16#0 move %false_0 : (!fir.box>, i1) -> !hlfir.expr> + hlfir.assign %17 to %10#0 : !hlfir.expr>, !fir.ref> + hlfir.destroy %17 : !hlfir.expr> + %c-1_i32 = arith.constant -1 : i32 + %18 = mif.get_team level %c-1_i32 : (i32) -> !fir.box> + %19:2 = hlfir.declare %18 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box>) -> (!fir.box>, !fir.box>) + %false_1 = arith.constant false + %20 = hlfir.as_expr %19#0 move %false_1 : (!fir.box>, i1) -> !hlfir.expr> + hlfir.assign %20 to %10#0 : !hlfir.expr>, !fir.ref> + hlfir.destroy %20 : !hlfir.expr> + %c-3_i32 = arith.constant -3 : i32 + %21 = mif.get_team level %c-3_i32 : (i32) -> !fir.box> + %22:2 = hlfir.declare %21 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box>) -> (!fir.box>, !fir.box>) + %false_2 = arith.constant false + %23 = hlfir.as_expr %22#0 move %false_2 : (!fir.box>, i1) -> !hlfir.expr> + hlfir.assign %23 to %10#0 : !hlfir.expr>, !fir.ref> + hlfir.destroy %23 : !hlfir.expr> + %24 = fir.load %6#0 : !fir.ref + %25 = mif.get_team level %24 : (i32) -> !fir.box> + %26:2 = hlfir.declare %25 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box>) -> (!fir.box>, !fir.box>) + %false_3 = arith.constant false + %27 = hlfir.as_expr %26#0 move %false_3 : (!fir.box>, i1) -> !hlfir.expr> + hlfir.assign %27 to %10#0 : !hlfir.expr>, !fir.ref> + hlfir.destroy %27 : !hlfir.expr> + return + } } // CHECK: %[[VAL_1:.*]] = fir.absent !fir.ref diff --git a/flang/test/Fir/MIF/image_index.mlir b/flang/test/Fir/MIF/image_index.mlir new file mode 100644 index 0000000000000..860c5b15ce630 --- /dev/null +++ b/flang/test/Fir/MIF/image_index.mlir @@ -0,0 +1,48 @@ +// RUN: fir-opt --mif-convert %s | FileCheck %s + +module attributes {dlti.dl_spec = #dlti.dl_spec = dense<32> : vector<4xi64>, !llvm.ptr<271> = dense<32> : vector<4xi64>, !llvm.ptr<272> = dense<64> : vector<4xi64>, i64 = dense<64> : vector<2xi64>, i128 = dense<128> : vector<2xi64>, f80 = dense<128> : vector<2xi64>, !llvm.ptr = dense<64> : vector<4xi64>, i1 = dense<8> : vector<2xi64>, i8 = dense<8> : vector<2xi64>, i16 = dense<16> : vector<2xi64>, i32 = dense<32> : vector<2xi64>, f16 = dense<16> : vector<2xi64>, f64 = dense<64> : vector<2xi64>, f128 = dense<128> : vector<2xi64>, "dlti.endianness" = "little", "dlti.mangling_mode" = "e", "dlti.legal_int_widths" = array, "dlti.stack_alignment" = 128 : i64>, fir.defaultkind = "a1c4d8i4l4r4", fir.kindmap = "", llvm.data_layout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-i128:128-f80:128-n8:16:32:64-S128", llvm.ident = "flang version 23.0.0 (git@github.com:SiPearl/llvm-project.git d31a4730513391710d91c5ad33bb8ea3d68db3cb)", llvm.target_triple = "x86_64-unknown-linux-gnu"} { +// CHECK-LABEL: func.func @_QQmain + func.func @_QQmain() attributes {fir.bindc_name = "TEST"} { + %0 = fir.dummy_scope : !fir.dscope + %1 = fir.address_of(@_QFEa) : !fir.ref + mif.alloc_coarray %1 {lcobounds = array, ucobounds = array, uniq_name = "_QFEa"} : (!fir.ref) -> () + %2:2 = hlfir.declare %1 {fir.corank = 2 : i32, uniq_name = "_QFEa"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %3 = fir.address_of(@_QM__fortran_builtinsEC__builtin_atomic_int_kind) : !fir.ref + %4:2 = hlfir.declare %3 {fortran_attrs = #fir.var_attrs, uniq_name = "_QM__fortran_builtinsEC__builtin_atomic_int_kind"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %5 = fir.address_of(@_QM__fortran_builtinsEC__builtin_atomic_logical_kind) : !fir.ref + %6:2 = hlfir.declare %5 {fortran_attrs = #fir.var_attrs, uniq_name = "_QM__fortran_builtinsEC__builtin_atomic_logical_kind"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %20 = fir.alloca i32 {bindc_name = "idx", uniq_name = "_QFEidx"} + %21:2 = hlfir.declare %20 {uniq_name = "_QFEidx"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %157 = fir.address_of(@_QFEsub) : !fir.ref> + %c3_1 = arith.constant 3 : index + %158 = fir.shape %c3_1 : (index) -> !fir.shape<1> + %159:2 = hlfir.declare %157(%158) {uniq_name = "_QFEsub"} : (!fir.ref>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>) + %160 = fir.address_of(@_QFEsub2) : !fir.ref> + %c3_2 = arith.constant 3 : index + %161 = fir.shape %c3_2 : (index) -> !fir.shape<1> + %162:2 = hlfir.declare %160(%161) {uniq_name = "_QFEsub2"} : (!fir.ref>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>) + %163 = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}> {bindc_name = "team", uniq_name = "_QFEteam"} + %164:2 = hlfir.declare %163 {uniq_name = "_QFEteam"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) + %165 = fir.address_of(@_QQ_QM__fortran_builtinsT__builtin_team_type.DerivedInit) : !fir.ref> + fir.copy %165 to %164#0 no_overlap : !fir.ref>, !fir.ref> + %178 = fir.shape %c3_1 : (index) -> !fir.shape<1> + %179 = fir.embox %159#0(%178) : (!fir.ref>, !fir.shape<1>) -> !fir.box> + +// CHECK: fir.call @_QMprifPprif_image_index + %180 = mif.image_index coarray %2#0 sub %179 : (!fir.ref, !fir.box>) -> i32 + hlfir.assign %180 to %21#0 : i32, !fir.ref + %181 = fir.shape %c3_2 : (index) -> !fir.shape<1> + %182 = fir.embox %162#0(%181) : (!fir.ref>, !fir.shape<1>) -> !fir.box> + +// CHECK: fir.call @_QMprifPprif_image_index + %183 = mif.image_index coarray %2#0 sub %182 : (!fir.ref, !fir.box>) -> i32 + hlfir.assign %183 to %21#0 : i32, !fir.ref + %184 = fir.shape %c3_1 : (index) -> !fir.shape<1> + %185 = fir.embox %159#0(%184) : (!fir.ref>, !fir.shape<1>) -> !fir.box> + +// CHECK: fir.call @_QMprifPprif_image_index_with_team + %186 = mif.image_index coarray %2#0 sub %185 team %164#0 : (!fir.ref, !fir.box>, !fir.ref>) -> i32 + hlfir.assign %186 to %21#0 : i32, !fir.ref + return + } +} diff --git a/flang/test/Fir/MIF/sync_team.mlir b/flang/test/Fir/MIF/sync_team.mlir index d7db171546fb5..c7e2c2c169694 100644 --- a/flang/test/Fir/MIF/sync_team.mlir +++ b/flang/test/Fir/MIF/sync_team.mlir @@ -1,31 +1,33 @@ // RUN: fir-opt --mif-convert %s | FileCheck %s -func.func @_QQmain() attributes {fir.bindc_name = "TEST_SYNC_TEAM"} { - %0 = fir.dummy_scope : !fir.dscope - %1 = fir.address_of(@_QFEerror_message) : !fir.ref> - %c128 = arith.constant 128 : index - %2:2 = hlfir.declare %1 typeparams %c128 {uniq_name = "_QFEerror_message"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) - %3 = fir.alloca i32 {bindc_name = "sync_status", uniq_name = "_QFEsync_status"} - %4:2 = hlfir.declare %3 {uniq_name = "_QFEsync_status"} : (!fir.ref) -> (!fir.ref, !fir.ref) - %5 = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}> {bindc_name = "team", uniq_name = "_QFEteam"} - %6:2 = hlfir.declare %5 {uniq_name = "_QFEteam"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) - %7 = fir.address_of(@_QQ_QM__fortran_builtinsT__builtin_team_type.DerivedInit) : !fir.ref> - fir.copy %7 to %6#0 no_overlap : !fir.ref>, !fir.ref> - %8 = fir.embox %6#0 : (!fir.ref>) -> !fir.box> - mif.sync_team %8 : (!fir.box>) -> () - %9 = fir.embox %6#0 : (!fir.ref>) -> !fir.box> - mif.sync_team %9 stat %4#0 : (!fir.box>, !fir.ref) -> () - %10 = fir.embox %6#0 : (!fir.ref>) -> !fir.box> - %11 = fir.embox %2#0 : (!fir.ref>) -> !fir.box> - mif.sync_team %10 errmsg %11 : (!fir.box>, !fir.box>) -> () - %12 = fir.embox %6#0 : (!fir.ref>) -> !fir.box> - %13 = fir.embox %2#0 : (!fir.ref>) -> !fir.box> - mif.sync_team %12 stat %4#0 errmsg %13 : (!fir.box>, !fir.ref, !fir.box>) -> () - return -} -fir.global internal @_QFEerror_message : !fir.char<1,128> { - %0 = fir.zero_bits !fir.char<1,128> - fir.has_value %0 : !fir.char<1,128> +module attributes {dlti.dl_spec = #dlti.dl_spec = dense<32> : vector<4xi64>, !llvm.ptr<271> = dense<32> : vector<4xi64>, !llvm.ptr<272> = dense<64> : vector<4xi64>, i64 = dense<64> : vector<2xi64>, i128 = dense<128> : vector<2xi64>, f80 = dense<128> : vector<2xi64>, !llvm.ptr = dense<64> : vector<4xi64>, i1 = dense<8> : vector<2xi64>, i8 = dense<8> : vector<2xi64>, i16 = dense<16> : vector<2xi64>, i32 = dense<32> : vector<2xi64>, f16 = dense<16> : vector<2xi64>, f64 = dense<64> : vector<2xi64>, f128 = dense<128> : vector<2xi64>, "dlti.endianness" = "little", "dlti.mangling_mode" = "e", "dlti.legal_int_widths" = array, "dlti.stack_alignment" = 128 : i64>, fir.defaultkind = "a1c4d8i4l4r4", fir.kindmap = "", llvm.data_layout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-i128:128-f80:128-n8:16:32:64-S128", llvm.ident = "flang version 22.0.0 (git@github.com:SiPearl/llvm-project.git 666e4313ebc03587f27774139ad8f780bac15c3e)", llvm.target_triple = "x86_64-unknown-linux-gnu"} { + func.func @_QQmain() attributes {fir.bindc_name = "TEST_SYNC_TEAM"} { + %0 = fir.dummy_scope : !fir.dscope + %1 = fir.address_of(@_QFEerror_message) : !fir.ref> + %c128 = arith.constant 128 : index + %2:2 = hlfir.declare %1 typeparams %c128 {uniq_name = "_QFEerror_message"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) + %3 = fir.alloca i32 {bindc_name = "sync_status", uniq_name = "_QFEsync_status"} + %4:2 = hlfir.declare %3 {uniq_name = "_QFEsync_status"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %5 = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}> {bindc_name = "team", uniq_name = "_QFEteam"} + %6:2 = hlfir.declare %5 {uniq_name = "_QFEteam"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) + %7 = fir.address_of(@_QQ_QM__fortran_builtinsT__builtin_team_type.DerivedInit) : !fir.ref> + fir.copy %7 to %6#0 no_overlap : !fir.ref>, !fir.ref> + %8 = fir.embox %6#0 : (!fir.ref>) -> !fir.box> + mif.sync_team %8 : (!fir.box>) -> () + %9 = fir.embox %6#0 : (!fir.ref>) -> !fir.box> + mif.sync_team %9 stat %4#0 : (!fir.box>, !fir.ref) -> () + %10 = fir.embox %6#0 : (!fir.ref>) -> !fir.box> + %11 = fir.embox %2#0 : (!fir.ref>) -> !fir.box> + mif.sync_team %10 errmsg %11 : (!fir.box>, !fir.box>) -> () + %12 = fir.embox %6#0 : (!fir.ref>) -> !fir.box> + %13 = fir.embox %2#0 : (!fir.ref>) -> !fir.box> + mif.sync_team %12 stat %4#0 errmsg %13 : (!fir.box>, !fir.ref, !fir.box>) -> () + return + } + fir.global internal @_QFEerror_message : !fir.char<1,128> { + %0 = fir.zero_bits !fir.char<1,128> + fir.has_value %0 : !fir.char<1,128> + } } // CHECK: %[[ERRMSG:.*]]:2 = hlfir.declare %[[E:.*]] typeparams %[[C_128:.*]] {uniq_name = "_QFEerror_message"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) diff --git a/flang/test/Fir/MIF/team_number.mlir b/flang/test/Fir/MIF/team_number.mlir index 4dc766d2a9ff4..55e10448d2003 100644 --- a/flang/test/Fir/MIF/team_number.mlir +++ b/flang/test/Fir/MIF/team_number.mlir @@ -1,22 +1,24 @@ // RUN: fir-opt --mif-convert %s | FileCheck %s -func.func @_QQmain() attributes {fir.bindc_name = "TEST_TEAM_NUMBER"} { - %0 = fir.dummy_scope : !fir.dscope - %1 = fir.alloca i32 {bindc_name = "t", uniq_name = "_QFEt"} - %2:2 = hlfir.declare %1 {uniq_name = "_QFEt"} : (!fir.ref) -> (!fir.ref, !fir.ref) - %3 = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}> {bindc_name = "team", uniq_name = "_QFEteam"} - %4:2 = hlfir.declare %3 {uniq_name = "_QFEteam"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) - %5 = fir.address_of(@_QQ_QM__fortran_builtinsT__builtin_team_type.DerivedInit) : !fir.ref> - fir.copy %5 to %4#0 no_overlap : !fir.ref>, !fir.ref> - %6 = fir.embox %4#0 : (!fir.ref>) -> !fir.box> - %7 = mif.team_number team %6 : (!fir.box>) -> i64 - %8 = fir.convert %7 : (i64) -> i32 - hlfir.assign %8 to %2#0 : i32, !fir.ref - %9 = mif.team_number : () -> i64 - %10 = fir.convert %9 : (i64) -> i32 - hlfir.assign %10 to %2#0 : i32, !fir.ref - return -} +module attributes {dlti.dl_spec = #dlti.dl_spec = dense<32> : vector<4xi64>, !llvm.ptr<271> = dense<32> : vector<4xi64>, !llvm.ptr<272> = dense<64> : vector<4xi64>, i64 = dense<64> : vector<2xi64>, i128 = dense<128> : vector<2xi64>, f80 = dense<128> : vector<2xi64>, !llvm.ptr = dense<64> : vector<4xi64>, i1 = dense<8> : vector<2xi64>, i8 = dense<8> : vector<2xi64>, i16 = dense<16> : vector<2xi64>, i32 = dense<32> : vector<2xi64>, f16 = dense<16> : vector<2xi64>, f64 = dense<64> : vector<2xi64>, f128 = dense<128> : vector<2xi64>, "dlti.endianness" = "little", "dlti.mangling_mode" = "e", "dlti.legal_int_widths" = array, "dlti.stack_alignment" = 128 : i64>, fir.defaultkind = "a1c4d8i4l4r4", fir.kindmap = "", llvm.data_layout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-i128:128-f80:128-n8:16:32:64-S128", llvm.ident = "flang version 22.0.0 (git@github.com:SiPearl/llvm-project.git 666e4313ebc03587f27774139ad8f780bac15c3e)", llvm.target_triple = "x86_64-unknown-linux-gnu"} { + func.func @_QQmain() attributes {fir.bindc_name = "TEST_TEAM_NUMBER"} { + %0 = fir.dummy_scope : !fir.dscope + %1 = fir.alloca i32 {bindc_name = "t", uniq_name = "_QFEt"} + %2:2 = hlfir.declare %1 {uniq_name = "_QFEt"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %3 = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}> {bindc_name = "team", uniq_name = "_QFEteam"} + %4:2 = hlfir.declare %3 {uniq_name = "_QFEteam"} : (!fir.ref>) -> (!fir.ref>, !fir.ref>) + %5 = fir.address_of(@_QQ_QM__fortran_builtinsT__builtin_team_type.DerivedInit) : !fir.ref> + fir.copy %5 to %4#0 no_overlap : !fir.ref>, !fir.ref> + %6 = fir.embox %4#0 : (!fir.ref>) -> !fir.box> + %7 = mif.team_number team %6 : (!fir.box>) -> i64 + %8 = fir.convert %7 : (i64) -> i32 + hlfir.assign %8 to %2#0 : i32, !fir.ref + %9 = mif.team_number : () -> i64 + %10 = fir.convert %9 : (i64) -> i32 + hlfir.assign %10 to %2#0 : i32, !fir.ref + return + } + } // CHECK: %[[VAL_1:.*]] = fir.convert %[[TEAM:.*]] : ({{.*}}) -> !fir.box // CHECK: fir.call @_QMprifPprif_team_number(%[[VAL_1]], %[[RESULT:.*]]) : (!fir.box, !fir.ref) -> () diff --git a/flang/test/Fir/MIF/this_image.mlir b/flang/test/Fir/MIF/this_image.mlir index 25eafc09ef58c..d1a4bd6329e50 100644 --- a/flang/test/Fir/MIF/this_image.mlir +++ b/flang/test/Fir/MIF/this_image.mlir @@ -3,14 +3,41 @@ module attributes {dlti.dl_spec = #dlti.dl_spec = dense<32> : vector<4xi64>, !llvm.ptr<271> = dense<32> : vector<4xi64>, !llvm.ptr<272> = dense<64> : vector<4xi64>, i64 = dense<64> : vector<2xi64>, i128 = dense<128> : vector<2xi64>, f80 = dense<128> : vector<2xi64>, !llvm.ptr = dense<64> : vector<4xi64>, i1 = dense<8> : vector<2xi64>, i8 = dense<8> : vector<2xi64>, i16 = dense<16> : vector<2xi64>, i32 = dense<32> : vector<2xi64>, f16 = dense<16> : vector<2xi64>, f64 = dense<64> : vector<2xi64>, f128 = dense<128> : vector<2xi64>, "dlti.endianness" = "little", "dlti.mangling_mode" = "e", "dlti.legal_int_widths" = array, "dlti.stack_alignment" = 128 : i64>, fir.defaultkind = "a1c4d8i4l4r4", fir.kindmap = "", llvm.data_layout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-i128:128-f80:128-n8:16:32:64-S128", llvm.ident = "flang version 22.0.0 (git@github.com:SiPearl/llvm-project.git 666e4313ebc03587f27774139ad8f780bac15c3e)", llvm.target_triple = "x86_64-unknown-linux-gnu"} { func.func @_QQmain() attributes {fir.bindc_name = "TEST"} { %0 = fir.dummy_scope : !fir.dscope - %1 = fir.alloca i32 {bindc_name = "i", uniq_name = "_QFEi"} - %2:2 = hlfir.declare %1 {uniq_name = "_QFEi"} : (!fir.ref) -> (!fir.ref, !fir.ref) - %3 = mif.this_image : () -> i32 - hlfir.assign %3 to %2#0 : i32, !fir.ref + %1 = fir.address_of(@_QFEa) : !fir.ref + mif.alloc_coarray %1 {lcobounds = array, ucobounds = array, uniq_name = "_QFEa"} : (!fir.ref) -> () + %2:2 = hlfir.declare %1 {fir.corank = 2 : i32, uniq_name = "_QFEa"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %3 = fir.alloca i32 {bindc_name = "i", uniq_name = "_QFEi"} + %4:2 = hlfir.declare %3 {uniq_name = "_QFEi"} : (!fir.ref) -> (!fir.ref, !fir.ref) + %c2 = arith.constant 2 : index + %5 = fir.alloca !fir.array<2xi32> {bindc_name = "j", uniq_name = "_QFEj"} + %6 = fir.shape %c2 : (index) -> !fir.shape<1> + %7:2 = hlfir.declare %5(%6) {uniq_name = "_QFEj"} : (!fir.ref>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>) + %8 = mif.this_image : () -> i32 + hlfir.assign %8 to %4#0 : i32, !fir.ref + %9 = mif.this_image coarray %2#0 : (!fir.ref) -> !fir.box> + %10:2 = hlfir.declare %9 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box>) -> (!fir.box>, !fir.box>) + %false = arith.constant false + %11 = hlfir.as_expr %10#0 move %false : (!fir.box>, i1) -> !hlfir.expr + %c0 = arith.constant 0 : index + %12:3 = fir.box_dims %10#0, %c0 : (!fir.box>, index) -> (index, index, index) + %13 = fir.shape %12#1 : (index) -> !fir.shape<1> + %14 = hlfir.elemental %13 unordered : (!fir.shape<1>) -> !hlfir.expr { + ^bb0(%arg0: index): + %16 = hlfir.apply %11, %arg0 : (!hlfir.expr, index) -> i64 + %17 = fir.convert %16 : (i64) -> i32 + hlfir.yield_element %17 : i32 + } + hlfir.assign %14 to %7#0 : !hlfir.expr, !fir.ref> + hlfir.destroy %14 : !hlfir.expr + hlfir.destroy %11 : !hlfir.expr + %c1_i32 = arith.constant 1 : i32 + %15 = mif.this_image coarray %2#0 dim %c1_i32 : (!fir.ref, i32) -> i32 + hlfir.assign %15 to %7#0 : i32, !fir.ref> return } } - // CHECK-LABEL: func.func @_QQmain -// CHECK: fir.call @_QMprifPprif_this_image_no_coarray( +// CHECK: fir.call @_QMprifPprif_this_image_no_coarray +// CHECK: fir.call @_QMprifPprif_this_image_with_coarray +// CHECK: fir.call @_QMprifPprif_this_image_with_dim diff --git a/flang/test/Lower/MIF/coarray_allocation.f90 b/flang/test/Lower/MIF/coarray_allocation.f90 new file mode 100644 index 0000000000000..4a449c3bf1292 --- /dev/null +++ b/flang/test/Lower/MIF/coarray_allocation.f90 @@ -0,0 +1,63 @@ +! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s + +program alloc_test + type :: my_type2 + integer, allocatable :: co[:] + end type + + type :: my_type + integer :: x + integer, allocatable :: y(:) + type(my_type2) :: z + end type + + ! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QFEa) : !fir.ref + ! CHECK: mif.alloc_coarray %[[VAL_1]] {lcobounds = array, ucobounds = array, uniq_name = "_QFEa"} : (!fir.ref) -> () + + ! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[ADDR_1:.*]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFEa2"} : (!fir.ref>>) -> (!fir.ref>>, !fir.ref>>) + + integer :: a[2, *] + ! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QFEb) : !fir.ref + ! CHECK: mif.alloc_coarray %[[VAL_2]] {lcobounds = array, ucobounds = array, uniq_name = "_QFEb"} : (!fir.ref) -> () + + ! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[ADDR_2:.*]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFEb2"} : (!fir.ref>>) -> (!fir.ref>>, !fir.ref>>) + + real :: b[3:4, 5, *] + ! CHECK: %[[VAL_3:.*]] = fir.address_of(@_QFEc) : !fir.ref> + ! CHECK: mif.alloc_coarray %[[VAL_3]] {lcobounds = array, ucobounds = array, uniq_name = "_QFEc"} : (!fir.ref>) -> () + + ! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[ADDR_3:.*]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFEc2"} : (!fir.ref>>>>) -> (!fir.ref>>>>, !fir.ref>>>>) + character(len=10) :: c[*] + type(my_type) :: d + + real, allocatable :: b2[:,:,:] + character(len=:), allocatable :: c2(:)[:] + integer, allocatable :: a2[:,:] + + ! CHECK: %[[VAL_7:.*]] = fir.absent !fir.box + ! CHECK: mif.alloc_coarray %[[VAL_4]]#0 errmsg %[[VAL_7]] {lcobounds = array, ucobounds = array, uniq_name = "_QFEa2"} : (!fir.ref>>, !fir.box) -> () + allocate(a2[2,*]) + + ! CHECK: %[[VAL_8:.*]] = fir.absent !fir.box + ! CHECK: mif.alloc_coarray %[[VAL_5]]#0 errmsg %[[VAL_8]] {lcobounds = array, ucobounds = array, uniq_name = "_QFEb2"} : (!fir.ref>>, !fir.box) -> () + allocate(b2[3:4, 5, *]) + + ! CHECK: %[[VAL_9:.*]] = fir.absent !fir.box + ! CHECK: mif.alloc_coarray %[[VAL_6]]#0 errmsg %[[VAL_9]] {lcobounds = array, ucobounds = array, uniq_name = "_QFEc2"} : (!fir.ref>>>>, !fir.box) -> () + allocate(character(100) :: c2(5)[*]) + + ! CHECK: %[[VAL_10:.*]] = fir.absent !fir.box + ! CHECK: %[[VAL_12:.*]] = hlfir.designate %[[VAL_11:.*]]{"co"} + ! CHECK: mif.alloc_coarray %[[VAL_12]] errmsg %[[VAL_10]] {lcobounds = array, ucobounds = array, uniq_name = "_QFEd.z.co"} : (!fir.ref>>, !fir.box) -> () + allocate(d%z%co[*]) + + ! CHECK: mif.dealloc_coarray %[[VAL_4]]#0 stat %[[STAT:.*]] errmsg %[[ERRMSG:.*]] : (!fir.ref>>, !fir.ref, !fir.box) -> () + ! CHECK: mif.dealloc_coarray %[[VAL_5]]#0 stat %[[STAT:.*]] errmsg %[[ERRMSG:.*]] : (!fir.ref>>, !fir.ref, !fir.box) -> () + ! CHECK: mif.dealloc_coarray %[[VAL_6]]#0 stat %[[STAT:.*]] errmsg %[[ERRMSG:.*]] : (!fir.ref>>>>, !fir.ref, !fir.box) -> () + deallocate(a2, b2, c2) + + ! CHECK: %[[VAL_14:.*]] = hlfir.designate %[[VAL_13:.*]]{"co"} {{.*}} + ! CHECK: mif.dealloc_coarray %[[VAL_14]] stat %[[STAT:.*]] errmsg %[[ERRMSG:.*]] : (!fir.ref>>, !fir.ref, !fir.box) -> () + deallocate(d%z%co) + +end program diff --git a/flang/test/Lower/MIF/cobound.f90 b/flang/test/Lower/MIF/cobound.f90 new file mode 100644 index 0000000000000..e5ad3f94d4beb --- /dev/null +++ b/flang/test/Lower/MIF/cobound.f90 @@ -0,0 +1,21 @@ +! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s + +program test + integer :: res1(3), res2 + integer, allocatable :: a[:,:,:] + + allocate(a[2,3:5,*]) + + ! CHECK: mif.lcobound coarray %[[COARRAY:.*]] : (!fir.heap) -> !fir.box> + res1 = lcobound(a) + + ! CHECK: mif.lcobound coarray %[[COARRAY:.*]] dim %[[C2:.*]] : (!fir.heap, i32) -> i32 + res2 = lcobound(a, DIM=2) + + ! CHECK: mif.ucobound coarray %[[COARRAY:.*]] : (!fir.heap) -> !fir.box> + res1 = ucobound(a) + + ! CHECK: mif.ucobound coarray %[[COARRAY:.*]] dim %[[C2:.*]] : (!fir.heap, i32) -> i32 + res2 = ucobound(a, DIM=2) + +end program diff --git a/flang/test/Lower/MIF/coshape.f90 b/flang/test/Lower/MIF/coshape.f90 new file mode 100644 index 0000000000000..da1360d26b3a6 --- /dev/null +++ b/flang/test/Lower/MIF/coshape.f90 @@ -0,0 +1,14 @@ +! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s + +program test + integer :: res(3) + integer(kind=8) :: res2(3) + integer :: a[2,3:5,*] + + ! CHECK: mif.coshape coarray %[[COARRAY:.*]]#0 : (!fir.ref) -> !fir.box> + res = coshape(a) + + ! CHECK: mif.coshape coarray %[[COARRAY:.*]]#0 : (!fir.ref) -> !fir.box> + res2 = coshape(a) + +end program diff --git a/flang/test/Lower/MIF/image_index.f90 b/flang/test/Lower/MIF/image_index.f90 new file mode 100644 index 0000000000000..247159ef7af9e --- /dev/null +++ b/flang/test/Lower/MIF/image_index.f90 @@ -0,0 +1,20 @@ +! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s + +program test + use iso_fortran_env + integer(kind=4) :: sub(3) = (/1, 4, 2/) + integer(kind=8) :: sub2(3) = (/1, 4, 2/) + integer(kind=4) :: a[2,3:5,*], idx + type(team_type) :: team + integer :: team_number + + ! CHECK: mif.image_index coarray %[[COARRAY:.*]]#0 sub %[[SUB:.*]] : (!fir.ref, !fir.box>) -> i32 + idx = image_index(a, SUB=sub) + + ! CHECK: mif.image_index coarray %[[COARRAY:.*]]#0 sub %[[SUB2:.*]] : (!fir.ref, !fir.box>) -> i32 + idx = image_index(a, SUB=sub2) + + ! CHECK: mif.image_index coarray %[[COARRAY:.*]]#0 sub %[[SUB2:.*]] team %[[TEAM:.*]]#0 : (!fir.ref, !fir.box>, !fir.ref>) + idx = image_index(a, SUB=sub, TEAM=team) + +end program diff --git a/flang/test/Lower/MIF/this_image.f90 b/flang/test/Lower/MIF/this_image.f90 index c6674c309f3f4..968c582a48476 100644 --- a/flang/test/Lower/MIF/this_image.f90 +++ b/flang/test/Lower/MIF/this_image.f90 @@ -2,8 +2,9 @@ program test use iso_fortran_env - integer :: i + integer :: i, j(2) type(team_type) :: team + integer :: a[2,*] ! CHECK: mif.this_image : () -> i32 i = this_image() @@ -11,4 +12,9 @@ program test ! CHECK: mif.this_image team %[[TEAM:.*]] : ({{.*}}) -> i32 i = this_image(TEAM=team) + ! CHECK: mif.this_image coarray %[[A:.*]] : ({{.*}}) -> !fir.box> + j = this_image(COARRAY=a) + + ! CHECK: mif.this_image coarray %[[A:.*]]#0 dim %[[DIM:.*]] : ({{.*}}) -> i32 + j = this_image(COARRAY=a, DIM=1) end program