diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h index f8322a50effc4..195f80bdc0842 100644 --- a/flang/include/flang/Lower/AbstractConverter.h +++ b/flang/include/flang/Lower/AbstractConverter.h @@ -351,6 +351,11 @@ class AbstractConverter { virtual Fortran::lower::StatementContext &getFctCtx() = 0; + /// Generate STAT and ERRMSG from a list of StatOrErrmsg + virtual std::pair + genStatAndErrmsg(mlir::Location loc, + const std::list &) = 0; + AbstractConverter(const Fortran::lower::LoweringOptions &loweringOptions) : loweringOptions(loweringOptions) {} virtual ~AbstractConverter() = default; diff --git a/flang/include/flang/Lower/Coarray.h b/flang/include/flang/Lower/MultiImageFortran.h similarity index 76% rename from flang/include/flang/Lower/Coarray.h rename to flang/include/flang/Lower/MultiImageFortran.h index 76d6a37b0bd61..d9dc9cf051f4c 100644 --- a/flang/include/flang/Lower/Coarray.h +++ b/flang/include/flang/Lower/MultiImageFortran.h @@ -1,4 +1,4 @@ -//===-- Lower/Coarray.h -- image related lowering ---------------*- C++ -*-===// +//===-- Lower/MultiImageFortran.h -- image related lowering -----*- C++ -*-===// // // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. // See https://llvm.org/LICENSE.txt for license information. @@ -6,8 +6,8 @@ // //===----------------------------------------------------------------------===// -#ifndef FORTRAN_LOWER_COARRAY_H -#define FORTRAN_LOWER_COARRAY_H +#ifndef FORTRAN_LOWER_MULTIIMAGEFORTRAN_H +#define FORTRAN_LOWER_MULTIIMAGEFORTRAN_H #include "flang/Lower/AbstractConverter.h" #include "flang/Optimizer/Builder/BoxValue.h" @@ -33,6 +33,18 @@ namespace pft { struct Evaluation; } // namespace pft +//===----------------------------------------------------------------------===// +// Synchronization statements +//===----------------------------------------------------------------------===// + +void genSyncAllStatement(AbstractConverter &, const parser::SyncAllStmt &); + +void genSyncImagesStatement(AbstractConverter &, + const parser::SyncImagesStmt &); +void genSyncMemoryStatement(AbstractConverter &, + const parser::SyncMemoryStmt &); +void genSyncTeamStatement(AbstractConverter &, const parser::SyncTeamStmt &); + //===----------------------------------------------------------------------===// // TEAM constructs //===----------------------------------------------------------------------===// @@ -75,4 +87,4 @@ class CoarrayExprHelper { } // namespace lower } // namespace Fortran -#endif // FORTRAN_LOWER_COARRAY_H +#endif // FORTRAN_LOWER_MULTIIMAGEFORTRAN_H diff --git a/flang/include/flang/Lower/Runtime.h b/flang/include/flang/Lower/Runtime.h index f76f398569b54..204093f9a766a 100644 --- a/flang/include/flang/Lower/Runtime.h +++ b/flang/include/flang/Lower/Runtime.h @@ -57,12 +57,6 @@ void genEventWaitStatement(AbstractConverter &, const parser::EventWaitStmt &); void genLockStatement(AbstractConverter &, const parser::LockStmt &); void genFailImageStatement(AbstractConverter &); void genStopStatement(AbstractConverter &, const parser::StopStmt &); -void genSyncAllStatement(AbstractConverter &, const parser::SyncAllStmt &); -void genSyncImagesStatement(AbstractConverter &, - const parser::SyncImagesStmt &); -void genSyncMemoryStatement(AbstractConverter &, - const parser::SyncMemoryStmt &); -void genSyncTeamStatement(AbstractConverter &, const parser::SyncTeamStmt &); void genUnlockStatement(AbstractConverter &, const parser::UnlockStmt &); void genPauseStatement(AbstractConverter &, const parser::PauseStmt &); diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h index 01d27fd5fc399..ce0b26c868701 100644 --- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h +++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h @@ -270,6 +270,7 @@ struct IntrinsicLibrary { void genGetEnvironmentVariable(llvm::ArrayRef); mlir::Value genGetGID(mlir::Type resultType, llvm::ArrayRef args); + mlir::Value genGetTeam(mlir::Type, llvm::ArrayRef); mlir::Value genGetUID(mlir::Type resultType, llvm::ArrayRef args); fir::ExtendedValue genHostnm(std::optional resultType, @@ -425,6 +426,8 @@ struct IntrinsicLibrary { void genSystemClock(llvm::ArrayRef); mlir::Value genTand(mlir::Type, llvm::ArrayRef); mlir::Value genTanpi(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genTeamNumber(mlir::Type, + llvm::ArrayRef); mlir::Value genTime(mlir::Type, llvm::ArrayRef); mlir::Value genTrailz(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genTransfer(mlir::Type, diff --git a/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td b/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td index 52471d3702b76..a6c7d0a07b019 100644 --- a/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td +++ b/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td @@ -21,6 +21,10 @@ include "flang/Optimizer/Dialect/FIRAttr.td" class mif_Op traits> : Op; +class region_Op traits = []> + : mif_Op {} + //===----------------------------------------------------------------------===// // Initialization and Finalization //===----------------------------------------------------------------------===// @@ -174,6 +178,18 @@ def mif_SyncMemoryOp : mif_Op<"sync_memory", [AttrSizedOperandSegments]> { }]; } +def mif_SyncTeamOp : mif_Op<"sync_team", [AttrSizedOperandSegments]> { + let summary = "Performs a synchronization of the team, identified by `team`"; + + let arguments = (ins AnyRefOrBoxType:$team, Optional:$stat, + Optional:$errmsg); + let assemblyFormat = [{ + $team (`stat` $stat^ )? + (`errmsg` $errmsg^ )? + attr-dict `:` functional-type(operands, results) + }]; +} + //===----------------------------------------------------------------------===// // Collective Operations //===----------------------------------------------------------------------===// @@ -265,4 +281,148 @@ def mif_CoSumOp }]; } +//===----------------------------------------------------------------------===// +// Teams +//===----------------------------------------------------------------------===// + +def mif_FormTeamOp : mif_Op<"form_team", [AttrSizedOperandSegments]> { + let summary = + "Create a set of sibling teams whose parent team is the current team."; + let description = [{ + Create a new team for each unique `team_number` value specified. + Each executing image will belong to the team whose `team_number` is equal + to the value of team-number on that image, and `team_var` becomes defined + with a value that identifies that team. + + If `new_index` is specified, the image index of the executing image will take + this index in its new team. Otherwise, the new image index is processor + dependent. + + Arguments: + - `team_number`: Shall be a positive integer. + - `team_var` : Shall be a variable of type TEAM_TYPE from the intrinsic + module ISO_FORTRAN_ENV. + - `new_index`(optional): Shall be an integer that correspond to the index that + the calling image will have in the new team. + }]; + + let arguments = (ins AnyIntegerType:$team_number, + Arg:$team_var, + Optional:$new_index, + Arg, "", [MemWrite]>:$stat, + Arg, "", [MemWrite]>:$errmsg); + + let assemblyFormat = [{ + `team_number` $team_number `team_var` $team_var + (`new_index` $new_index^ )? + (`stat` $stat^ )? + (`errmsg` $errmsg^ )? + attr-dict `:` functional-type(operands, results) + }]; +} + +def mif_EndTeamOp : mif_Op<"end_team", [AttrSizedOperandSegments, Terminator, + ParentOneOf<["ChangeTeamOp"]>]> { + let summary = "Changes the current team to the parent team."; + let description = [{ + The END TEAM operation completes the CHANGE TEAM construct and + restores the current team to the team that was current before + the CHANGE TEAM construct. + }]; + + let arguments = (ins Arg, "", [MemWrite]>:$stat, + Arg, "", [MemWrite]>:$errmsg); + let builders = [OpBuilder<(ins), [{ /* do nothing */ }]>]; + + let assemblyFormat = [{ + (`stat` $stat^ )? (`errmsg` $errmsg^ )? + attr-dict `:` functional-type(operands, results) + }]; +} + +//===----------------------------------------------------------------------===// +// NOTE: The CHANGE TEAM region will take a coarray association list in +// argument. However, coarray management and coarray alias creation are not +// yet supported by the dialect. The argument is therefore not yet supported by +// this operation and will be added later. +//===----------------------------------------------------------------------===// +def mif_ChangeTeamOp + : region_Op<"change_team", [AttrSizedOperandSegments, + SingleBlockImplicitTerminator<"EndTeamOp">]> { + let summary = "Changes the current team."; + let description = [{ + The CHANGE TEAM construct changes the current team to the specified new + team, which must be a child team of the current team. + + ``` + mif.change_team %team { + %x = fir.convert %i : (index) -> i32 + ... + mif.end_team + } + }]; + + let arguments = (ins AnyRefOrBoxType:$team, + Arg, "", [MemWrite]>:$stat, + Arg, "", [MemWrite]>:$errmsg); + let regions = (region SizedRegion<1>:$region); + + let skipDefaultBuilders = 1; + let builders = + [OpBuilder<(ins "mlir::Value":$team, + CArg<"bool", "true">:$ensureTermination, + CArg<"llvm::ArrayRef", "{}">:$attributes)>, + OpBuilder<(ins "mlir::Value":$team, "mlir::Value":$stat, + "mlir::Value":$errmsg, CArg<"bool", "true">:$ensureTermination, + CArg<"llvm::ArrayRef", "{}">:$attributes)>]; + + let extraClassDeclaration = [{ + /// Get the body of the CHANGE TEAM construct + mlir::Block *getBody() { return &getRegion().front(); } + }]; + + let assemblyFormat = [{ + $team (`stat` $stat^)? + (`errmsg` $errmsg^)? + attr-dict `:` `(` type(operands) `)` + custom($region) + }]; +} + +def mif_GetTeamOp : mif_Op<"get_team", []> { + let summary = "Get the team value for the current or ancestor team."; + let description = [{ + This operation gets the team value for the current or an ancestor team. + `level`(optional): If provided, must equal one of the following constants : + `INITIAL_TEAM`, `PARENT_TEAM` or `CURRENT_TEAM` from the module ISO_FORTRAN_ENV. + If `level` isn't present or has the value `CURRENT_TEAM` the returned + value is the current team. + }]; + + let arguments = (ins Optional:$level); + let results = (outs fir_BoxType:$team); + + let assemblyFormat = [{ + (`level` $level^ )? + attr-dict `:` functional-type(operands, results) + }]; +} + +def mif_TeamNumberOp : mif_Op<"team_number", []> { + let summary = "Get the team number"; + let description = [{ + Argument: `team` is optional and shall be a scalar of type TEAM_TYPE from + module ISO_FORTRAN_ENV and the value identifies the current or an ancestor team. + If `team` is absent, the team specified is the current team. + }]; + + let arguments = (ins Optional:$team); + let results = (outs I64); + + let assemblyFormat = [{ + (`team` $team^ )? + attr-dict `:` functional-type(operands, results) + }]; +} + #endif // FORTRAN_DIALECT_MIF_MIF_OPS diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 0f4b39a07c5da..88229a083ce10 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -15,7 +15,6 @@ #include "flang/Lower/Allocatable.h" #include "flang/Lower/CUDA.h" #include "flang/Lower/CallInterface.h" -#include "flang/Lower/Coarray.h" #include "flang/Lower/ConvertCall.h" #include "flang/Lower/ConvertExpr.h" #include "flang/Lower/ConvertExprToHLFIR.h" @@ -26,6 +25,7 @@ #include "flang/Lower/IO.h" #include "flang/Lower/IterationSpace.h" #include "flang/Lower/Mangler.h" +#include "flang/Lower/MultiImageFortran.h" #include "flang/Lower/OpenACC.h" #include "flang/Lower/OpenMP.h" #include "flang/Lower/PFTBuilder.h" @@ -1111,6 +1111,34 @@ class FirConverter : public Fortran::lower::AbstractConverter { return bridge.fctCtx(); } + /// Initializes values for STAT and ERRMSG + std::pair + genStatAndErrmsg(mlir::Location loc, + const std::list + &statOrErrList) override final { + Fortran::lower::StatementContext stmtCtx; + + mlir::Value errMsgExpr, statExpr; + for (const Fortran::parser::StatOrErrmsg &statOrErr : statOrErrList) { + std::visit(Fortran::common::visitors{ + [&](const Fortran::parser::StatVariable &statVar) { + const Fortran::semantics::SomeExpr *expr = + Fortran::semantics::GetExpr(statVar); + statExpr = + fir::getBase(genExprAddr(*expr, stmtCtx, &loc)); + }, + [&](const Fortran::parser::MsgVariable &errMsgVar) { + const Fortran::semantics::SomeExpr *expr = + Fortran::semantics::GetExpr(errMsgVar); + errMsgExpr = + fir::getBase(genExprBox(loc, *expr, stmtCtx)); + }}, + statOrErr.u); + } + + return {statExpr, errMsgExpr}; + } + mlir::Value hostAssocTupleValue() override final { return hostAssocTuple; } /// Record a binding for the ssa-value of the tuple for this function. @@ -3950,13 +3978,30 @@ class FirConverter : public Fortran::lower::AbstractConverter { } void genFIR(const Fortran::parser::ChangeTeamConstruct &construct) { - TODO(toLocation(), "coarray: ChangeTeamConstruct"); + Fortran::lower::StatementContext stmtCtx; + pushActiveConstruct(getEval(), stmtCtx); + + for (Fortran::lower::pft::Evaluation &e : + getEval().getNestedEvaluations()) { + if (e.getIf()) { + maybeStartBlock(e.block); + setCurrentPosition(e.position); + genFIR(e); + } else if (e.getIf()) { + maybeStartBlock(e.block); + setCurrentPosition(e.position); + genFIR(e); + } else { + genFIR(e); + } + } + popActiveConstruct(); } void genFIR(const Fortran::parser::ChangeTeamStmt &stmt) { - TODO(toLocation(), "coarray: ChangeTeamStmt"); + genChangeTeamStmt(*this, getEval(), stmt); } void genFIR(const Fortran::parser::EndChangeTeamStmt &stmt) { - TODO(toLocation(), "coarray: EndChangeTeamStmt"); + genEndChangeTeamStmt(*this, getEval(), stmt); } void genFIR(const Fortran::parser::CriticalConstruct &criticalConstruct) { diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt index 3d0b4e4cd82eb..230a56ab66ec5 100644 --- a/flang/lib/Lower/CMakeLists.txt +++ b/flang/lib/Lower/CMakeLists.txt @@ -5,7 +5,6 @@ add_flang_library(FortranLower Allocatable.cpp Bridge.cpp CallInterface.cpp - Coarray.cpp ComponentPath.cpp ConvertArrayConstructor.cpp ConvertCall.cpp @@ -23,6 +22,7 @@ add_flang_library(FortranLower IterationSpace.cpp LoweringOptions.cpp Mangler.cpp + MultiImageFortran.cpp OpenACC.cpp OpenMP/Atomic.cpp OpenMP/ClauseProcessor.cpp diff --git a/flang/lib/Lower/Coarray.cpp b/flang/lib/Lower/Coarray.cpp deleted file mode 100644 index a84f65a5c49e8..0000000000000 --- a/flang/lib/Lower/Coarray.cpp +++ /dev/null @@ -1,66 +0,0 @@ -//===-- 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 -// -//===----------------------------------------------------------------------===// -/// -/// Implementation of the lowering of image related constructs and expressions. -/// Fortran images can form teams, communicate via coarrays, etc. -/// -//===----------------------------------------------------------------------===// - -#include "flang/Lower/Coarray.h" -#include "flang/Lower/AbstractConverter.h" -#include "flang/Lower/SymbolMap.h" -#include "flang/Optimizer/Builder/FIRBuilder.h" -#include "flang/Optimizer/Builder/Todo.h" -#include "flang/Parser/parse-tree.h" -#include "flang/Semantics/expression.h" - -//===----------------------------------------------------------------------===// -// TEAM statements and constructs -//===----------------------------------------------------------------------===// - -void Fortran::lower::genChangeTeamConstruct( - Fortran::lower::AbstractConverter &converter, - Fortran::lower::pft::Evaluation &, - const Fortran::parser::ChangeTeamConstruct &) { - TODO(converter.getCurrentLocation(), "coarray: CHANGE TEAM construct"); -} - -void Fortran::lower::genChangeTeamStmt( - Fortran::lower::AbstractConverter &converter, - Fortran::lower::pft::Evaluation &, - const Fortran::parser::ChangeTeamStmt &) { - TODO(converter.getCurrentLocation(), "coarray: CHANGE TEAM statement"); -} - -void Fortran::lower::genEndChangeTeamStmt( - Fortran::lower::AbstractConverter &converter, - Fortran::lower::pft::Evaluation &, - const Fortran::parser::EndChangeTeamStmt &) { - TODO(converter.getCurrentLocation(), "coarray: END CHANGE TEAM statement"); -} - -void Fortran::lower::genFormTeamStatement( - Fortran::lower::AbstractConverter &converter, - Fortran::lower::pft::Evaluation &, const Fortran::parser::FormTeamStmt &) { - TODO(converter.getCurrentLocation(), "coarray: FORM TEAM statement"); -} - -//===----------------------------------------------------------------------===// -// COARRAY expressions -//===----------------------------------------------------------------------===// - -fir::ExtendedValue Fortran::lower::CoarrayExprHelper::genAddr( - const Fortran::evaluate::CoarrayRef &expr) { - (void)symMap; - TODO(converter.getCurrentLocation(), "co-array address"); -} - -fir::ExtendedValue Fortran::lower::CoarrayExprHelper::genValue( - const Fortran::evaluate::CoarrayRef &expr) { - TODO(converter.getCurrentLocation(), "co-array value"); -} diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index a46d219ba4b2c..b2910a0fc58e0 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -19,7 +19,6 @@ #include "flang/Lower/Bridge.h" #include "flang/Lower/BuiltinModules.h" #include "flang/Lower/CallInterface.h" -#include "flang/Lower/Coarray.h" #include "flang/Lower/ComponentPath.h" #include "flang/Lower/ConvertCall.h" #include "flang/Lower/ConvertConstant.h" @@ -28,6 +27,7 @@ #include "flang/Lower/ConvertVariable.h" #include "flang/Lower/CustomIntrinsicCall.h" #include "flang/Lower/Mangler.h" +#include "flang/Lower/MultiImageFortran.h" #include "flang/Lower/Runtime.h" #include "flang/Lower/Support/Utils.h" #include "flang/Optimizer/Builder/Character.h" diff --git a/flang/lib/Lower/MultiImageFortran.cpp b/flang/lib/Lower/MultiImageFortran.cpp new file mode 100644 index 0000000000000..745ca2494708c --- /dev/null +++ b/flang/lib/Lower/MultiImageFortran.cpp @@ -0,0 +1,278 @@ +//===-- MultiImageFortran.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 +// +//===----------------------------------------------------------------------===// +/// +/// Implementation of the lowering of image related constructs and expressions. +/// Fortran images can form teams, communicate via coarrays, etc. +/// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/MultiImageFortran.h" +#include "flang/Lower/AbstractConverter.h" +#include "flang/Lower/SymbolMap.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Optimizer/Builder/Todo.h" +#include "flang/Optimizer/Dialect/MIF/MIFOps.h" +#include "flang/Parser/parse-tree.h" +#include "flang/Semantics/expression.h" + +//===----------------------------------------------------------------------===// +// Synchronization statements +//===----------------------------------------------------------------------===// + +void Fortran::lower::genSyncAllStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::SyncAllStmt &stmt) { + mlir::Location loc = converter.getCurrentLocation(); + converter.checkCoarrayEnabled(); + + // Handle STAT and ERRMSG values + const std::list &statOrErrList = stmt.v; + auto [statAddr, errMsgAddr] = converter.genStatAndErrmsg(loc, statOrErrList); + + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + mif::SyncAllOp::create(builder, loc, statAddr, errMsgAddr); +} + +void Fortran::lower::genSyncImagesStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::SyncImagesStmt &stmt) { + mlir::Location loc = converter.getCurrentLocation(); + converter.checkCoarrayEnabled(); + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + + // Handle STAT and ERRMSG values + const std::list &statOrErrList = + std::get>(stmt.t); + auto [statAddr, errMsgAddr] = converter.genStatAndErrmsg(loc, statOrErrList); + + // SYNC_IMAGES(*) is passed as count == -1 while SYNC IMAGES([]) has count + // == 0. Note further that SYNC IMAGES(*) is not semantically equivalent to + // SYNC ALL. + Fortran::lower::StatementContext stmtCtx; + mlir::Value imageSet; + const Fortran::parser::SyncImagesStmt::ImageSet &imgSet = + std::get(stmt.t); + std::visit(Fortran::common::visitors{ + [&](const Fortran::parser::IntExpr &intExpr) { + const SomeExpr *expr = Fortran::semantics::GetExpr(intExpr); + imageSet = + fir::getBase(converter.genExprBox(loc, *expr, stmtCtx)); + }, + [&](const Fortran::parser::Star &) { + // Image set is not set. + imageSet = mlir::Value{}; + }}, + imgSet.u); + + mif::SyncImagesOp::create(builder, loc, imageSet, statAddr, errMsgAddr); +} + +void Fortran::lower::genSyncMemoryStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::SyncMemoryStmt &stmt) { + mlir::Location loc = converter.getCurrentLocation(); + converter.checkCoarrayEnabled(); + + // Handle STAT and ERRMSG values + const std::list &statOrErrList = stmt.v; + auto [statAddr, errMsgAddr] = converter.genStatAndErrmsg(loc, statOrErrList); + + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + mif::SyncMemoryOp::create(builder, loc, statAddr, errMsgAddr); +} + +void Fortran::lower::genSyncTeamStatement( + Fortran::lower::AbstractConverter &converter, + const Fortran::parser::SyncTeamStmt &stmt) { + mlir::Location loc = converter.getCurrentLocation(); + converter.checkCoarrayEnabled(); + + // Handle TEAM + Fortran::lower::StatementContext stmtCtx; + const Fortran::parser::TeamValue &teamValue = + std::get(stmt.t); + const SomeExpr *teamExpr = Fortran::semantics::GetExpr(teamValue); + mlir::Value team = + fir::getBase(converter.genExprBox(loc, *teamExpr, stmtCtx)); + + // Handle STAT and ERRMSG values + const std::list &statOrErrList = + std::get>(stmt.t); + auto [statAddr, errMsgAddr] = converter.genStatAndErrmsg(loc, statOrErrList); + + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + mif::SyncTeamOp::create(builder, loc, team, statAddr, errMsgAddr); +} + +//===----------------------------------------------------------------------===// +// TEAM statements and constructs +//===----------------------------------------------------------------------===// + +void Fortran::lower::genChangeTeamConstruct( + Fortran::lower::AbstractConverter &converter, + Fortran::lower::pft::Evaluation &, + const Fortran::parser::ChangeTeamConstruct &) { + TODO(converter.getCurrentLocation(), "coarray: CHANGE TEAM construct"); +} + +void Fortran::lower::genChangeTeamStmt( + Fortran::lower::AbstractConverter &converter, + Fortran::lower::pft::Evaluation &, + const Fortran::parser::ChangeTeamStmt &stmt) { + mlir::Location loc = converter.getCurrentLocation(); + converter.checkCoarrayEnabled(); + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + + mlir::Value errMsgAddr, statAddr, team; + // Handle STAT and ERRMSG values + Fortran::lower::StatementContext stmtCtx; + const std::list &statOrErrList = + std::get>(stmt.t); + for (const Fortran::parser::StatOrErrmsg &statOrErr : statOrErrList) { + std::visit(Fortran::common::visitors{ + [&](const Fortran::parser::StatVariable &statVar) { + const auto *expr = Fortran::semantics::GetExpr(statVar); + statAddr = fir::getBase( + converter.genExprAddr(loc, *expr, stmtCtx)); + }, + [&](const Fortran::parser::MsgVariable &errMsgVar) { + const auto *expr = Fortran::semantics::GetExpr(errMsgVar); + errMsgAddr = fir::getBase( + converter.genExprBox(loc, *expr, stmtCtx)); + }, + }, + statOrErr.u); + } + + // TODO: Manage the list of coarrays associated in + // `std::list`. According to the PRIF specification, it is + // necessary to call `prif_alias_{create|destroy}` for each coarray defined in + // this list. Support will be added once lowering to this procedure is + // possible. + const std::list &coarrayAssocList = + std::get>(stmt.t); + if (coarrayAssocList.size()) + TODO(loc, "Coarrays provided in the association list."); + + // Handle TEAM-VALUE + const auto *teamExpr = + Fortran::semantics::GetExpr(std::get(stmt.t)); + team = fir::getBase(converter.genExprBox(loc, *teamExpr, stmtCtx)); + + mif::ChangeTeamOp changeOp = mif::ChangeTeamOp::create( + builder, loc, team, statAddr, errMsgAddr, /*terminator*/ false); + builder.setInsertionPointToStart(changeOp.getBody()); +} + +void Fortran::lower::genEndChangeTeamStmt( + Fortran::lower::AbstractConverter &converter, + Fortran::lower::pft::Evaluation &, + const Fortran::parser::EndChangeTeamStmt &stmt) { + converter.checkCoarrayEnabled(); + mlir::Location loc = converter.getCurrentLocation(); + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + + mlir::Value errMsgAddr, statAddr; + // Handle STAT and ERRMSG values + Fortran::lower::StatementContext stmtCtx; + const std::list &statOrErrList = + std::get>(stmt.t); + for (const Fortran::parser::StatOrErrmsg &statOrErr : statOrErrList) { + std::visit(Fortran::common::visitors{ + [&](const Fortran::parser::StatVariable &statVar) { + const auto *expr = Fortran::semantics::GetExpr(statVar); + statAddr = fir::getBase( + converter.genExprAddr(loc, *expr, stmtCtx)); + }, + [&](const Fortran::parser::MsgVariable &errMsgVar) { + const auto *expr = Fortran::semantics::GetExpr(errMsgVar); + errMsgAddr = fir::getBase( + converter.genExprBox(loc, *expr, stmtCtx)); + }, + }, + statOrErr.u); + } + + mif::EndTeamOp endOp = + mif::EndTeamOp::create(builder, loc, statAddr, errMsgAddr); + builder.setInsertionPointAfter(endOp.getParentOp()); +} + +void Fortran::lower::genFormTeamStatement( + Fortran::lower::AbstractConverter &converter, + Fortran::lower::pft::Evaluation &, + const Fortran::parser::FormTeamStmt &stmt) { + converter.checkCoarrayEnabled(); + mlir::Location loc = converter.getCurrentLocation(); + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + + mlir::Value errMsgAddr, statAddr, newIndex, teamNumber, team; + // Handle NEW_INDEX, STAT and ERRMSG + std::list statOrErrList{}; + Fortran::lower::StatementContext stmtCtx; + const auto &formSpecList = + std::get>(stmt.t); + for (const Fortran::parser::FormTeamStmt::FormTeamSpec &formSpec : + formSpecList) { + std::visit( + Fortran::common::visitors{ + [&](const Fortran::parser::StatOrErrmsg &statOrErr) { + std::visit( + Fortran::common::visitors{ + [&](const Fortran::parser::StatVariable &statVar) { + const auto *expr = Fortran::semantics::GetExpr(statVar); + statAddr = fir::getBase( + converter.genExprAddr(loc, *expr, stmtCtx)); + }, + [&](const Fortran::parser::MsgVariable &errMsgVar) { + const auto *expr = + Fortran::semantics::GetExpr(errMsgVar); + errMsgAddr = fir::getBase( + converter.genExprBox(loc, *expr, stmtCtx)); + }, + }, + statOrErr.u); + }, + [&](const Fortran::parser::ScalarIntExpr &intExpr) { + fir::ExtendedValue newIndexExpr = converter.genExprValue( + loc, Fortran::semantics::GetExpr(intExpr), stmtCtx); + newIndex = fir::getBase(newIndexExpr); + }, + }, + formSpec.u); + } + + // Handle TEAM-NUMBER + const auto *teamNumberExpr = Fortran::semantics::GetExpr( + std::get(stmt.t)); + teamNumber = + fir::getBase(converter.genExprValue(loc, *teamNumberExpr, stmtCtx)); + + // Handle TEAM-VARIABLE + const auto *teamExpr = Fortran::semantics::GetExpr( + std::get(stmt.t)); + team = fir::getBase(converter.genExprBox(loc, *teamExpr, stmtCtx)); + + mif::FormTeamOp::create(builder, loc, teamNumber, team, newIndex, statAddr, + errMsgAddr); +} + +//===----------------------------------------------------------------------===// +// COARRAY expressions +//===----------------------------------------------------------------------===// + +fir::ExtendedValue Fortran::lower::CoarrayExprHelper::genAddr( + const Fortran::evaluate::CoarrayRef &expr) { + (void)symMap; + TODO(converter.getCurrentLocation(), "co-array address"); +} + +fir::ExtendedValue Fortran::lower::CoarrayExprHelper::genValue( + const Fortran::evaluate::CoarrayRef &expr) { + TODO(converter.getCurrentLocation(), "co-array value"); +} diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp index cb555249125f6..d5b8045d91992 100644 --- a/flang/lib/Lower/Runtime.cpp +++ b/flang/lib/Lower/Runtime.cpp @@ -48,31 +48,6 @@ static void genUnreachable(fir::FirOpBuilder &builder, mlir::Location loc) { builder.setInsertionPointToStart(newBlock); } -/// Initializes values for STAT and ERRMSG -static std::pair getStatAndErrmsg( - Fortran::lower::AbstractConverter &converter, mlir::Location loc, - const std::list &statOrErrList) { - Fortran::lower::StatementContext stmtCtx; - - mlir::Value errMsgExpr, statExpr; - for (const Fortran::parser::StatOrErrmsg &statOrErr : statOrErrList) { - std::visit(Fortran::common::visitors{ - [&](const Fortran::parser::StatVariable &statVar) { - statExpr = fir::getBase(converter.genExprAddr( - loc, Fortran::semantics::GetExpr(statVar), stmtCtx)); - }, - [&](const Fortran::parser::MsgVariable &errMsgVar) { - const Fortran::semantics::SomeExpr *expr = - Fortran::semantics::GetExpr(errMsgVar); - errMsgExpr = fir::getBase( - converter.genExprBox(loc, *expr, stmtCtx)); - }}, - statOrErr.u); - } - - return {statExpr, errMsgExpr}; -} - //===----------------------------------------------------------------------===// // Misc. Fortran statements that lower to runtime calls //===----------------------------------------------------------------------===// @@ -193,74 +168,6 @@ void Fortran::lower::genUnlockStatement( TODO(converter.getCurrentLocation(), "coarray: UNLOCK runtime"); } -void Fortran::lower::genSyncAllStatement( - Fortran::lower::AbstractConverter &converter, - const Fortran::parser::SyncAllStmt &stmt) { - mlir::Location loc = converter.getCurrentLocation(); - converter.checkCoarrayEnabled(); - - // Handle STAT and ERRMSG values - const std::list &statOrErrList = stmt.v; - auto [statAddr, errMsgAddr] = getStatAndErrmsg(converter, loc, statOrErrList); - - fir::FirOpBuilder &builder = converter.getFirOpBuilder(); - mif::SyncAllOp::create(builder, loc, statAddr, errMsgAddr); -} - -void Fortran::lower::genSyncImagesStatement( - Fortran::lower::AbstractConverter &converter, - const Fortran::parser::SyncImagesStmt &stmt) { - mlir::Location loc = converter.getCurrentLocation(); - converter.checkCoarrayEnabled(); - fir::FirOpBuilder &builder = converter.getFirOpBuilder(); - - // Handle STAT and ERRMSG values - const std::list &statOrErrList = - std::get>(stmt.t); - auto [statAddr, errMsgAddr] = getStatAndErrmsg(converter, loc, statOrErrList); - - // SYNC_IMAGES(*) is passed as count == -1 while SYNC IMAGES([]) has count - // == 0. Note further that SYNC IMAGES(*) is not semantically equivalent to - // SYNC ALL. - Fortran::lower::StatementContext stmtCtx; - mlir::Value imageSet; - const Fortran::parser::SyncImagesStmt::ImageSet &imgSet = - std::get(stmt.t); - std::visit(Fortran::common::visitors{ - [&](const Fortran::parser::IntExpr &intExpr) { - const SomeExpr *expr = Fortran::semantics::GetExpr(intExpr); - imageSet = - fir::getBase(converter.genExprBox(loc, *expr, stmtCtx)); - }, - [&](const Fortran::parser::Star &) { - // Image set is not set. - imageSet = mlir::Value{}; - }}, - imgSet.u); - - mif::SyncImagesOp::create(builder, loc, imageSet, statAddr, errMsgAddr); -} - -void Fortran::lower::genSyncMemoryStatement( - Fortran::lower::AbstractConverter &converter, - const Fortran::parser::SyncMemoryStmt &stmt) { - mlir::Location loc = converter.getCurrentLocation(); - converter.checkCoarrayEnabled(); - - // Handle STAT and ERRMSG values - const std::list &statOrErrList = stmt.v; - auto [statAddr, errMsgAddr] = getStatAndErrmsg(converter, loc, statOrErrList); - - fir::FirOpBuilder &builder = converter.getFirOpBuilder(); - mif::SyncMemoryOp::create(builder, loc, statAddr, errMsgAddr); -} - -void Fortran::lower::genSyncTeamStatement( - Fortran::lower::AbstractConverter &converter, - const Fortran::parser::SyncTeamStmt &) { - TODO(converter.getCurrentLocation(), "coarray: SYNC TEAM runtime"); -} - void Fortran::lower::genPauseStatement( Fortran::lower::AbstractConverter &converter, const Fortran::parser::PauseStmt &) { diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index 3eb60448fae38..60dc02474faf6 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -340,6 +340,10 @@ static constexpr IntrinsicHandler handlers[]{ {"trim_name", asAddr, handleDynamicOptional}, {"errmsg", asBox, handleDynamicOptional}}}, /*isElemental=*/false}, + {"get_team", + &I::genGetTeam, + {{{"level", asValue, handleDynamicOptional}}}, + /*isElemental=*/false}, {"getcwd", &I::genGetCwd, {{{"c", asBox}, {"status", asAddr, handleDynamicOptional}}}, @@ -749,6 +753,10 @@ static constexpr IntrinsicHandler handlers[]{ /*isElemental=*/false}, {"tand", &I::genTand}, {"tanpi", &I::genTanpi}, + {"team_number", + &I::genTeamNumber, + {{{"team", asBox, handleDynamicOptional}}}, + /*isElemental=*/false}, {"this_image", &I::genThisImage, {{{"coarray", asBox}, @@ -4013,6 +4021,15 @@ IntrinsicLibrary::genFtell(std::optional resultType, } } +// GET_TEAM +mlir::Value IntrinsicLibrary::genGetTeam(mlir::Type resultType, + llvm::ArrayRef args) { + converter->checkCoarrayEnabled(); + assert(args.size() == 1); + return mif::GetTeamOp::create(builder, loc, fir::BoxType::get(resultType), + /*level*/ args[0]); +} + // GETCWD fir::ExtendedValue IntrinsicLibrary::genGetCwd(std::optional resultType, @@ -7953,6 +7970,16 @@ mlir::Value IntrinsicLibrary::genTanpi(mlir::Type resultType, return getRuntimeCallGenerator("tan", ftype)(builder, loc, {arg}); } +// TEAM_NUMBER +fir::ExtendedValue +IntrinsicLibrary::genTeamNumber(mlir::Type, + llvm::ArrayRef args) { + converter->checkCoarrayEnabled(); + assert(args.size() == 1); + return mif::TeamNumberOp::create(builder, loc, + /*team*/ fir::getBase(args[0])); +} + // THIS_IMAGE fir::ExtendedValue IntrinsicLibrary::genThisImage(mlir::Type resultType, diff --git a/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp b/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp index c6cc2e855ff35..5f68f3dda54a7 100644 --- a/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp +++ b/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp @@ -15,9 +15,6 @@ #include "mlir/IR/PatternMatch.h" #include "llvm/ADT/SmallVector.h" -#define GET_OP_CLASSES -#include "flang/Optimizer/Dialect/MIF/MIFOps.cpp.inc" - //===----------------------------------------------------------------------===// // NumImagesOp //===----------------------------------------------------------------------===// @@ -151,3 +148,60 @@ llvm::LogicalResult mif::CoSumOp::verify() { return emitOpError("`A` shall be of numeric type."); return mlir::success(); } + +//===----------------------------------------------------------------------===// +// ChangeTeamOp +//===----------------------------------------------------------------------===// + +void mif::ChangeTeamOp::build(mlir::OpBuilder &builder, + mlir::OperationState &result, mlir::Value team, + bool ensureTerminator, + llvm::ArrayRef attributes) { + build(builder, result, team, /*stat*/ mlir::Value{}, /*errmsg*/ mlir::Value{}, + ensureTerminator, attributes); +} + +void mif::ChangeTeamOp::build(mlir::OpBuilder &builder, + mlir::OperationState &result, mlir::Value team, + mlir::Value stat, mlir::Value errmsg, + bool ensureTerminator, + llvm::ArrayRef attributes) { + std::int32_t argStat = 0, argErrmsg = 0; + result.addOperands(team); + if (stat) { + result.addOperands(stat); + argStat++; + } + if (errmsg) { + result.addOperands(errmsg); + argErrmsg++; + } + + mlir::Region *bodyRegion = result.addRegion(); + bodyRegion->push_back(new mlir::Block{}); + if (ensureTerminator) + ChangeTeamOp::ensureTerminator(*bodyRegion, builder, result.location); + + result.addAttribute(getOperandSegmentSizeAttr(), + builder.getDenseI32ArrayAttr({1, argStat, argErrmsg})); + result.addAttributes(attributes); +} + +static mlir::ParseResult parseChangeTeamOpBody(mlir::OpAsmParser &parser, + mlir::Region &body) { + if (parser.parseRegion(body)) + return mlir::failure(); + + auto &builder = parser.getBuilder(); + mif::ChangeTeamOp::ensureTerminator(body, builder, builder.getUnknownLoc()); + return mlir::success(); +} + +static void printChangeTeamOpBody(mlir::OpAsmPrinter &p, mif::ChangeTeamOp op, + mlir::Region &body) { + p.printRegion(op.getRegion(), /*printEntryBlockArgs=*/true, + /*printBlockTerminators=*/true); +} + +#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 206cb9be0574f..0d3d2f6c144ff 100644 --- a/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp +++ b/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp @@ -67,6 +67,13 @@ genErrmsgPRIF(fir::FirOpBuilder &builder, mlir::Location loc, return {errMsg, errMsgAlloc}; } +static mlir::Value genStatPRIF(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value stat) { + if (!stat) + return fir::AbsentOp::create(builder, loc, getPRIFStatType(builder)); + return stat; +} + /// Convert mif.init operation to runtime call of 'prif_init' struct MIFInitOpConversion : public mlir::OpRewritePattern { using OpRewritePattern::OpRewritePattern; @@ -210,9 +217,7 @@ struct MIFSyncAllOpConversion : public mlir::OpRewritePattern { auto [errmsgArg, errmsgAllocArg] = genErrmsgPRIF(builder, loc, op.getErrmsg()); - mlir::Value stat = op.getStat(); - if (!stat) - stat = fir::AbsentOp::create(builder, loc, getPRIFStatType(builder)); + mlir::Value stat = genStatPRIF(builder, loc, op.getStat()); llvm::SmallVector args = fir::runtime::createArguments( builder, loc, ftype, stat, errmsgArg, errmsgAllocArg); rewriter.replaceOpWithNewOp(op, funcOp, args); @@ -261,9 +266,7 @@ struct MIFSyncImagesOpConversion } auto [errmsgArg, errmsgAllocArg] = genErrmsgPRIF(builder, loc, op.getErrmsg()); - mlir::Value stat = op.getStat(); - if (!stat) - stat = fir::AbsentOp::create(builder, loc, getPRIFStatType(builder)); + mlir::Value stat = genStatPRIF(builder, loc, op.getStat()); llvm::SmallVector args = fir::runtime::createArguments( builder, loc, ftype, imageSet, stat, errmsgArg, errmsgAllocArg); rewriter.replaceOpWithNewOp(op, funcOp, args); @@ -293,9 +296,7 @@ struct MIFSyncMemoryOpConversion auto [errmsgArg, errmsgAllocArg] = genErrmsgPRIF(builder, loc, op.getErrmsg()); - mlir::Value stat = op.getStat(); - if (!stat) - stat = fir::AbsentOp::create(builder, loc, getPRIFStatType(builder)); + mlir::Value stat = genStatPRIF(builder, loc, op.getStat()); llvm::SmallVector args = fir::runtime::createArguments( builder, loc, ftype, stat, errmsgArg, errmsgAllocArg); rewriter.replaceOpWithNewOp(op, funcOp, args); @@ -303,6 +304,37 @@ struct MIFSyncMemoryOpConversion } }; +/// Convert mif.sync_team operation to runtime call of 'prif_sync_team' +struct MIFSyncTeamOpConversion + : public mlir::OpRewritePattern { + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(mif::SyncTeamOp op, + mlir::PatternRewriter &rewriter) const override { + auto mod = op->template getParentOfType(); + fir::FirOpBuilder builder(rewriter, mod); + mlir::Location loc = op.getLoc(); + + mlir::Type boxTy = fir::BoxType::get(builder.getNoneType()); + mlir::Type errmsgTy = getPRIFErrmsgType(builder); + mlir::FunctionType ftype = mlir::FunctionType::get( + builder.getContext(), + /*inputs*/ {boxTy, getPRIFStatType(builder), errmsgTy, errmsgTy}, + /*results*/ {}); + mlir::func::FuncOp funcOp = + builder.createFunction(loc, getPRIFProcName("sync_team"), ftype); + + auto [errmsgArg, errmsgAllocArg] = + genErrmsgPRIF(builder, loc, op.getErrmsg()); + mlir::Value stat = genStatPRIF(builder, loc, op.getStat()); + llvm::SmallVector args = fir::runtime::createArguments( + builder, loc, ftype, op.getTeam(), stat, errmsgArg, errmsgAllocArg); + rewriter.replaceOpWithNewOp(op, funcOp, args); + return mlir::success(); + } +}; + /// Generate call to collective subroutines except co_reduce /// A must be lowered as a box static fir::CallOp genCollectiveSubroutine(fir::FirOpBuilder &builder, @@ -432,6 +464,208 @@ struct MIFCoSumOpConversion : public mlir::OpRewritePattern { } }; +/// Convert mif.form_team operation to runtime call of 'prif_form_team' +struct MIFFormTeamOpConversion + : public mlir::OpRewritePattern { + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(mif::FormTeamOp 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*/ + {builder.getRefType(builder.getI64Type()), boxTy, + builder.getRefType(builder.getI32Type()), getPRIFStatType(builder), + errmsgTy, errmsgTy}, + /*results*/ {}); + mlir::func::FuncOp funcOp = + builder.createFunction(loc, getPRIFProcName("form_team"), ftype); + + mlir::Type i64Ty = builder.getI64Type(); + mlir::Value teamNumber = builder.createTemporary(loc, i64Ty); + mlir::Value t = + (op.getTeamNumber().getType() == i64Ty) + ? op.getTeamNumber() + : fir::ConvertOp::create(builder, loc, i64Ty, op.getTeamNumber()); + fir::StoreOp::create(builder, loc, t, teamNumber); + + mlir::Type i32Ty = builder.getI32Type(); + mlir::Value newIndex; + if (op.getNewIndex()) { + newIndex = builder.createTemporary(loc, i32Ty); + mlir::Value ni = + (op.getNewIndex().getType() == i32Ty) + ? op.getNewIndex() + : fir::ConvertOp::create(builder, loc, i32Ty, op.getNewIndex()); + fir::StoreOp::create(builder, loc, ni, newIndex); + } else + newIndex = fir::AbsentOp::create(builder, loc, builder.getRefType(i32Ty)); + + mlir::Value stat = genStatPRIF(builder, loc, op.getStat()); + auto [errmsgArg, errmsgAllocArg] = + genErrmsgPRIF(builder, loc, op.getErrmsg()); + llvm::SmallVector args = fir::runtime::createArguments( + builder, loc, ftype, teamNumber, op.getTeamVar(), newIndex, stat, + errmsgArg, errmsgAllocArg); + fir::CallOp callOp = fir::CallOp::create(builder, loc, funcOp, args); + rewriter.replaceOp(op, callOp); + return mlir::success(); + } +}; + +/// Convert mif.change_team operation to runtime call of 'prif_change_team' +struct MIFChangeTeamOpConversion + : public mlir::OpRewritePattern { + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(mif::ChangeTeamOp op, + mlir::PatternRewriter &rewriter) const override { + auto mod = op->template getParentOfType(); + fir::FirOpBuilder builder(rewriter, mod); + builder.setInsertionPoint(op); + + 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("change_team"), ftype); + + mlir::Value stat = genStatPRIF(builder, loc, op.getStat()); + auto [errmsgArg, errmsgAllocArg] = + genErrmsgPRIF(builder, loc, op.getErrmsg()); + llvm::SmallVector args = fir::runtime::createArguments( + builder, loc, ftype, op.getTeam(), stat, errmsgArg, errmsgAllocArg); + fir::CallOp::create(builder, loc, funcOp, args); + + mlir::Operation *changeOp = op.getOperation(); + auto &bodyRegion = op.getRegion(); + mlir::Block &bodyBlock = bodyRegion.front(); + + rewriter.inlineBlockBefore(&bodyBlock, changeOp); + rewriter.eraseOp(op); + return mlir::success(); + } +}; + +/// Convert mif.end_team operation to runtime call of 'prif_end_team' +struct MIFEndTeamOpConversion : public mlir::OpRewritePattern { + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(mif::EndTeamOp 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::FunctionType ftype = mlir::FunctionType::get( + builder.getContext(), + /*inputs*/ {getPRIFStatType(builder), errmsgTy, errmsgTy}, + /*results*/ {}); + mlir::func::FuncOp funcOp = + builder.createFunction(loc, getPRIFProcName("end_team"), ftype); + + mlir::Value stat = genStatPRIF(builder, loc, op.getStat()); + auto [errmsgArg, errmsgAllocArg] = + genErrmsgPRIF(builder, loc, op.getErrmsg()); + llvm::SmallVector args = fir::runtime::createArguments( + builder, loc, ftype, stat, errmsgArg, errmsgAllocArg); + fir::CallOp callOp = fir::CallOp::create(builder, loc, funcOp, args); + rewriter.replaceOp(op, callOp); + return mlir::success(); + } +}; + +/// Convert mif.get_team operation to runtime call of 'prif_get_team' +struct MIFGetTeamOpConversion : public mlir::OpRewritePattern { + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(mif::GetTeamOp op, + mlir::PatternRewriter &rewriter) const override { + auto mod = op->template getParentOfType(); + fir::FirOpBuilder builder(rewriter, mod); + mlir::Location loc = op.getLoc(); + + mlir::Type boxTy = fir::BoxType::get(builder.getNoneType()); + mlir::Type lvlTy = builder.getRefType(builder.getI32Type()); + mlir::FunctionType ftype = + mlir::FunctionType::get(builder.getContext(), + /*inputs*/ {lvlTy, boxTy}, + /*results*/ {}); + mlir::func::FuncOp funcOp = + builder.createFunction(loc, getPRIFProcName("get_team"), ftype); + + mlir::Value level = op.getLevel(); + if (!level) + level = fir::AbsentOp::create(builder, loc, lvlTy); + else { + mlir::Value cst = op.getLevel(); + mlir::Type i32Ty = builder.getI32Type(); + level = builder.createTemporary(loc, i32Ty); + if (cst.getType() != i32Ty) + cst = builder.createConvert(loc, i32Ty, cst); + fir::StoreOp::create(builder, loc, cst, level); + } + mlir::Type resultType = op.getResult().getType(); + mlir::Type baseTy = fir::unwrapRefType(resultType); + mlir::Value team = builder.createTemporary(loc, baseTy); + fir::EmboxOp box = fir::EmboxOp::create(builder, loc, resultType, team); + + llvm::SmallVector args = + fir::runtime::createArguments(builder, loc, ftype, level, box); + fir::CallOp::create(builder, loc, funcOp, args); + + rewriter.replaceOp(op, box); + return mlir::success(); + } +}; + +/// Convert mif.team_number operation to runtime call of 'prif_team_number' +struct MIFTeamNumberOpConversion + : public mlir::OpRewritePattern { + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(mif::TeamNumberOp 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, builder.getRefType(i64Ty)}, + /*results*/ {}); + mlir::func::FuncOp funcOp = + builder.createFunction(loc, getPRIFProcName("team_number"), ftype); + + mlir::Value team = op.getTeam(); + if (!team) + team = fir::AbsentOp::create(builder, loc, boxTy); + + mlir::Value result = builder.createTemporary(loc, i64Ty); + llvm::SmallVector args = + fir::runtime::createArguments(builder, loc, ftype, team, result); + fir::CallOp::create(builder, loc, funcOp, args); + fir::LoadOp load = fir::LoadOp::create(builder, loc, result); + rewriter.replaceOp(op, load); + return mlir::success(); + } +}; + class MIFOpConversion : public fir::impl::MIFOpConversionBase { public: void runOnOperation() override { @@ -458,7 +692,10 @@ void mif::populateMIFOpConversionPatterns(mlir::RewritePatternSet &patterns) { patterns.insert( + MIFSyncTeamOpConversion, MIFCoBroadcastOpConversion, + MIFCoMaxOpConversion, MIFCoMinOpConversion, + MIFCoSumOpConversion, MIFFormTeamOpConversion, + MIFChangeTeamOpConversion, MIFEndTeamOpConversion, + MIFGetTeamOpConversion, MIFTeamNumberOpConversion>( patterns.getContext()); } diff --git a/flang/test/Fir/MIF/change_team.mlir b/flang/test/Fir/MIF/change_team.mlir new file mode 100644 index 0000000000000..1dbfee574cc51 --- /dev/null +++ b/flang/test/Fir/MIF/change_team.mlir @@ -0,0 +1,51 @@ +// 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 : () -> () + } + %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 +// CHECK: %[[VAL_2:.*]] = fir.absent !fir.box> +// CHECK: %[[VAL_3:.*]] = fir.convert %[[TEAM:.*]] : ({{.*}}) -> !fir.box +// CHECK: fir.call @_QMprifPprif_change_team(%[[VAL_3]], %[[VAL_1]], %[[VAL_2]], %[[VAL_2]]) : (!fir.box, !fir.ref, !fir.box>, !fir.box>) -> () +// CHECK: %[[VAL_4:.*]] = fir.load %[[VAR_1:.*]]#0 : !fir.ref +// CHECK: %[[C1:.*]] = arith.constant 1 : i32 +// CHECK: %[[VAL_5:.*]] = arith.addi %[[VAL_4]], %[[C1]] : i32 +// CHECK: hlfir.assign %[[VAL_5]] to %[[VAR_1]]#0 : i32, !fir.ref +// CHECK: %[[VAL_6:.*]] = fir.absent !fir.ref +// CHECK: %[[VAL_7:.*]] = fir.absent !fir.box> +// CHECK: fir.call @_QMprifPprif_end_team(%[[VAL_6]], %[[VAL_7]], %[[VAL_7]]) : (!fir.ref, !fir.box>, !fir.box>) -> () + +// CHECK: %[[VAL_8:.*]] = fir.embox %[[ERRMSG:.*]]#0 : (!fir.ref>) -> !fir.box +// CHECK: %[[VAL_9:.*]] = fir.absent !fir.box> +// CHECK: %[[TEAM_2:.*]] = fir.convert %[[TEAM:.*]] : ({{.*}}) -> !fir.box +// CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_8]] : (!fir.box>) -> !fir.box> +// CHECK: fir.call @_QMprifPprif_change_team(%[[TEAM_2]], %[[STAT:.*]]#0, %[[VAL_10]], %[[VAL_9]]) : (!fir.box, !fir.ref, !fir.box>, !fir.box>) -> () +// CHECK: %[[VAL_11:.*]] = fir.absent !fir.ref +// CHECK: %[[VAL_12:.*]] = fir.absent !fir.box> +// CHECK: fir.call @_QMprifPprif_end_team(%[[VAL_11]], %[[VAL_12]], %[[VAL_12]]) : (!fir.ref, !fir.box>, !fir.box>) -> () diff --git a/flang/test/Fir/MIF/form_team.mlir b/flang/test/Fir/MIF/form_team.mlir new file mode 100644 index 0000000000000..f7f957afb7cc0 --- /dev/null +++ b/flang/test/Fir/MIF/form_team.mlir @@ -0,0 +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 + %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> +// CHECK: %[[VAL_4:.*]] = fir.convert %[[TEAM:.*]] : ({{.*}}) -> !fir.box +// CHECK: fir.call @_QMprifPprif_form_team(%[[TEAM_NUMBER:.*]], %[[VAL_4]], %[[VAL_1]], %[[VAL_2]], %[[VAL_3]], %[[VAL_3]]) : (!fir.ref, !fir.box, !fir.ref, !fir.ref, !fir.box>, !fir.box>) -> () + +// CHECK: %[[VAL_5:.*]] = fir.absent !fir.ref +// CHECK: %[[VAL_6:.*]] = fir.absent !fir.box> +// CHECK: %[[VAL_7:.*]] = fir.convert %[[TEAM:.*]] : ({{.*}}) -> !fir.box +// CHECK: fir.call @_QMprifPprif_form_team(%[[TEAM_NUMBER:.*]], %[[VAL_7]], %[[NEW_INDEX:.*]], %[[VAL_5]], %[[VAL_6]], %[[VAL_6]]) : (!fir.ref, !fir.box, !fir.ref, !fir.ref, !fir.box>, !fir.box>) -> () + +// CHECK: %[[VAL_8:.*]] = fir.absent !fir.ref +// CHECK: %[[VAL_9:.*]] = fir.absent !fir.box> +// CHECK: %[[VAL_10:.*]] = fir.convert %[[TEAM:.*]] : ({{.*}}) -> !fir.box +// CHECK: fir.call @_QMprifPprif_form_team(%[[TEAM_NUMBER:.*]], %[[VAL_10]], %[[VAL_8]], %[[START:.*]]#0, %[[VAL_9]], %[[VAL_9]]) : (!fir.ref, !fir.box, !fir.ref, !fir.ref, !fir.box>, !fir.box>) -> () + +// CHECK: %[[VAL_11:.*]] = fir.embox %[[ERRMSG:.*]]#0 : (!fir.ref>) -> !fir.box> +// CHECK: %[[VAL_12:.*]] = fir.absent !fir.ref +// CHECK: %[[VAL_13:.*]] = fir.absent !fir.ref +// CHECK: %[[VAL_14:.*]] = fir.absent !fir.box> +// CHECK: %[[VAL_15:.*]] = fir.convert %[[TEAM:.*]] : ({{.*}}) -> !fir.box +// CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_11]] : (!fir.box>) -> !fir.box> +// CHECK: fir.call @_QMprifPprif_form_team(%[[TEAM_NUMBER:.*]], %[[VAL_15]], %[[VAL_12]], %[[VAL_13]], %[[VAL_16]], %[[VAL_14]]) : (!fir.ref, !fir.box, !fir.ref, !fir.ref, !fir.box>, !fir.box>) -> () diff --git a/flang/test/Fir/MIF/get_team.mlir b/flang/test/Fir/MIF/get_team.mlir new file mode 100644 index 0000000000000..10799fa2292b6 --- /dev/null +++ b/flang/test/Fir/MIF/get_team.mlir @@ -0,0 +1,68 @@ +// 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 +} + +// CHECK: %[[VAL_1:.*]] = fir.absent !fir.ref +// CHECK: %[[RESULT:.*]] = fir.convert %[[TEAM:.*]] : ({{.*}}) -> !fir.box +// CHECK: fir.call @_QMprifPprif_get_team(%[[VAL_1]], %[[RESULT]]) : (!fir.ref, !fir.box) -> () + +// CHECK: %[[RESULT:.*]] = fir.convert %[[TEAM:.*]] : ({{.*}}) -> !fir.box +// CHECK: fir.call @_QMprifPprif_get_team(%[[INIT:.*]], %[[RESULT]]) : (!fir.ref, !fir.box) -> () + +// CHECK: %[[RESULT:.*]] = fir.convert %[[TEAM:.*]] : ({{.*}}) -> !fir.box +// CHECK: fir.call @_QMprifPprif_get_team(%[[CURRENT:.*]], %[[RESULT]]) : (!fir.ref, !fir.box) -> () + +// CHECK: %[[RESULT:.*]] = fir.convert %[[TEAM:.*]] : ({{.*}}) -> !fir.box +// CHECK: fir.call @_QMprifPprif_get_team(%[[PARENT:.*]], %[[RESULT]]) : (!fir.ref, !fir.box) -> () + +// CHECK: %[[RESULT:.*]] = fir.convert %[[TEAM:.*]] : ({{.*}}) -> !fir.box +// CHECK: fir.call @_QMprifPprif_get_team(%[[VAL_N:.*]], %[[RESULT]]) : (!fir.ref, !fir.box) -> () diff --git a/flang/test/Fir/MIF/sync_team.mlir b/flang/test/Fir/MIF/sync_team.mlir new file mode 100644 index 0000000000000..d7db171546fb5 --- /dev/null +++ b/flang/test/Fir/MIF/sync_team.mlir @@ -0,0 +1,54 @@ +// 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> +} + +// CHECK: %[[ERRMSG:.*]]:2 = hlfir.declare %[[E:.*]] typeparams %[[C_128:.*]] {uniq_name = "_QFEerror_message"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) +// CHECK: %[[STAT:.*]]:2 = hlfir.declare %[[S:.*]] {uniq_name = "_QFEsync_status"} : (!fir.ref) -> (!fir.ref, !fir.ref) + +// CHECK: %[[VAL_1:.*]] = fir.absent !fir.box> +// CHECK: %[[VAL_2:.*]] = fir.absent !fir.ref +// CHECK: %[[TEAM_2:.*]] = fir.convert %[[TEAM:.*]] : ({{.*}}) -> !fir.box +// CHECK: fir.call @_QMprifPprif_sync_team(%[[TEAM_2]], %[[VAL_2]], %[[VAL_1]], %[[VAL_1]]) : (!fir.box, !fir.ref, !fir.box>, !fir.box>) -> () + +// CHECK: %[[VAL_3:.*]] = fir.absent !fir.box> +// CHECK: %[[TEAM_2:.*]] = fir.convert %[[TEAM:.*]] : ({{.*}}) -> !fir.box +// CHECK: fir.call @_QMprifPprif_sync_team(%[[TEAM_2]], %[[STAT]]#0, %[[VAL_3]], %[[VAL_3]]) : (!fir.box, !fir.ref, !fir.box>, !fir.box>) -> () + +// CHECK: %[[VAL_4:.*]] = fir.embox %[[ERRMSG]]#0 : (!fir.ref>) -> !fir.box> +// CHECK: %[[VAL_5:.*]] = fir.absent !fir.box> +// CHECK: %[[VAL_6:.*]] = fir.absent !fir.ref +// CHECK: %[[TEAM_2:.*]] = fir.convert %[[TEAM:.*]] : ({{.*}}) -> !fir.box +// CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_4]] : (!fir.box>) -> !fir.box> +// CHECK: fir.call @_QMprifPprif_sync_team(%[[TEAM_2]], %[[VAL_6]], %[[VAL_7]], %[[VAL_5]]) : (!fir.box, !fir.ref, !fir.box>, !fir.box>) -> () + +// CHECK: %[[VAL_8:.*]] = fir.embox %[[ERRMSG]]#0 : (!fir.ref>) -> !fir.box> +// CHECK: %[[VAL_9:.*]] = fir.absent !fir.box> +// CHECK: %[[TEAM_2:.*]] = fir.convert %[[TEAM:.*]] : ({{.*}}) -> !fir.box +// CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_8]] : (!fir.box>) -> !fir.box> +// CHECK: fir.call @_QMprifPprif_sync_team(%[[TEAM_2]], %[[STAT]]#0, %[[VAL_10]], %[[VAL_9]]) : (!fir.box, !fir.ref, !fir.box>, !fir.box>) -> () diff --git a/flang/test/Fir/MIF/team_number.mlir b/flang/test/Fir/MIF/team_number.mlir new file mode 100644 index 0000000000000..4dc766d2a9ff4 --- /dev/null +++ b/flang/test/Fir/MIF/team_number.mlir @@ -0,0 +1,27 @@ +// 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 +} + +// CHECK: %[[VAL_1:.*]] = fir.convert %[[TEAM:.*]] : ({{.*}}) -> !fir.box +// CHECK: fir.call @_QMprifPprif_team_number(%[[VAL_1]], %[[RESULT:.*]]) : (!fir.box, !fir.ref) -> () +// CHECK: %[[VAL_2:.*]] = fir.load %[[RESULT]] : !fir.ref + +// CHECK: %[[VAL_3:.*]] = fir.absent !fir.box +// CHECK: fir.call @_QMprifPprif_team_number(%[[VAL_3]], %[[RESULT:.*]]) : (!fir.box, !fir.ref) -> () +// CHECK: %[[VAL_4:.*]] = fir.load %[[RESULT]] : !fir.ref diff --git a/flang/test/Lower/MIF/change_team.f90 b/flang/test/Lower/MIF/change_team.f90 new file mode 100644 index 0000000000000..7fb31aa99812b --- /dev/null +++ b/flang/test/Lower/MIF/change_team.f90 @@ -0,0 +1,27 @@ +! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s --check-prefixes=COARRAY +! RUN: not %flang_fc1 -emit-hlfir %s 2>&1 | FileCheck %s --check-prefixes=NOCOARRAY + +program test_change_team + use, intrinsic :: iso_fortran_env, only: team_type + implicit none + ! NOCOARRAY: Not yet implemented: Multi-image features are experimental and are disabled by default, use '-fcoarray' to enable. + + type(team_type) :: team + integer :: stat, i + character(len=10) :: err + + ! COARRAY: mif.change_team %[[TEAM:.*]] : ({{.*}}) { + change team (team) + i = i +1 + end team + ! COARRAY: mif.end_team + ! COARRAY: } + + ! COARRAY: mif.change_team %[[TEAM:.*]] stat %[[STAT:.*]]#0 errmsg %[[ERR:.*]] : ({{.*}}, !fir.ref, !fir.box>) { + change team (team, STAT=stat, ERRMSG=err) + end team + ! COARRAY: mif.end_team + ! COARRAY: } + +end program test_change_team + diff --git a/flang/test/Lower/MIF/form_team.f90 b/flang/test/Lower/MIF/form_team.f90 new file mode 100644 index 0000000000000..4f44b23b3ceed --- /dev/null +++ b/flang/test/Lower/MIF/form_team.f90 @@ -0,0 +1,29 @@ +! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s --check-prefixes=COARRAY +! RUN: not %flang_fc1 -emit-hlfir %s 2>&1 | FileCheck %s --check-prefixes=NOCOARRAY + +program test_form_team + use, intrinsic :: iso_fortran_env, only: team_type + implicit none + ! NOCOARRAY: Not yet implemented: Multi-image features are experimental and are disabled by default, use '-fcoarray' to enable. + + type(team_type) :: team + integer :: team_number + integer :: team_index + integer :: stat + character(len=10) :: err + + form team (team_number, team) + ! COARRAY: mif.form_team team_number %[[ARG1:.*]] team_var %[[ARG2:.*]] : (i32, {{.*}}) -> () + + form team (team_number, team, NEW_INDEX=team_index) + ! COARRAY: mif.form_team team_number %[[ARG1:.*]] team_var %[[ARG2:.*]] new_index %[[NI:.*]] : (i32, {{.*}}, i32) -> () + + form team (team_number, team, STAT=stat) + ! COARRAY: mif.form_team team_number %[[ARG1:.*]] team_var %[[ARG2:.*]] stat %[[STAT:.*]] : (i32, {{.*}}, !fir.ref) -> () + + form team (team_number, team, ERRMSG=err) + ! COARRAY: mif.form_team team_number %[[ARG1:.*]] team_var %[[ARG2:.*]] errmsg %[[ERR:.*]] : (i32, {{.*}}, !fir.box>) -> () + +end program test_form_team + + diff --git a/flang/test/Lower/MIF/get_team.f90 b/flang/test/Lower/MIF/get_team.f90 new file mode 100644 index 0000000000000..f27b70efafc20 --- /dev/null +++ b/flang/test/Lower/MIF/get_team.f90 @@ -0,0 +1,28 @@ +! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s --check-prefixes=COARRAY +! RUN: not %flang_fc1 -emit-hlfir %s 2>&1 | FileCheck %s --check-prefixes=NOCOARRAY + +program test_get_team + use, intrinsic :: iso_fortran_env, only: team_type, initial_team, current_team, parent_team + implicit none + ! NOCOARRAY: Not yet implemented: Multi-image features are experimental and are disabled by default, use '-fcoarray' to enable. + + type(team_type) :: result_team + integer :: n + + ! COARRAY: %[[RES:.*]] = mif.get_team : () -> {{.*}} + result_team = get_team() + + ! COARRAY: %[[RES:.*]] = mif.get_team level %[[INIT:.*]] : (i32) -> {{.*}} + result_team = get_team(initial_team) + + ! COARRAY: %[[RES:.*]] = mif.get_team level %[[CURRENT:.*]] : (i32) -> {{.*}} + result_team = get_team(current_team) + + ! COARRAY: %[[RES:.*]] = mif.get_team level %[[PARENT:.*]] : (i32) -> {{.*}} + result_team = get_team(parent_team) + + ! COARRAY: %[[RES:.*]] = mif.get_team level %[[VAL_N:.*]] : (i32) -> {{.*}} + result_team = get_team(n) + +end program test_get_team + diff --git a/flang/test/Lower/MIF/sync_team.f90 b/flang/test/Lower/MIF/sync_team.f90 new file mode 100644 index 0000000000000..923bfbc327951 --- /dev/null +++ b/flang/test/Lower/MIF/sync_team.f90 @@ -0,0 +1,25 @@ +! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s --check-prefixes=COARRAY +! RUN2: not %flang_fc1 -emit-hlfir %s -o - | FileCheck %s --check-prefixes=NOCOARRAY + +program test_sync_team + use, intrinsic :: iso_fortran_env, only: team_type + implicit none + ! NOCOARRAY: Not yet implemented: Multi-image features are experimental and are disabled by default, use '-fcoarray' to enable. + + integer sync_status + character(len=128) :: error_message + type(team_type) :: team + + ! COARRAY: mif.sync_team %[[TEAM:.*]] : ({{.*}}) -> () + sync team(team) + + ! COARRAY: mif.sync_team %[[TEAM:.*]] stat %[[STAT:.*]]#0 : ({{.*}}, !fir.ref) -> () + sync team(team, stat=sync_status) + + ! COARRAY: mif.sync_team %[[TEAM:.*]] errmsg %[[ERR:.*]] : ({{.*}}, !fir.box>) -> () + sync team(team, errmsg=error_message) + + ! COARRAY: mif.sync_team %[[TEAM:.*]] stat %[[STAT:.*]]#0 errmsg %[[ERR:.*]] : ({{.*}}, !fir.ref, !fir.box>) -> () + sync team(team, stat=sync_status, errmsg=error_message) + +end program test_sync_team diff --git a/flang/test/Lower/MIF/team_number.f90 b/flang/test/Lower/MIF/team_number.f90 new file mode 100644 index 0000000000000..48a5f5b3d37d4 --- /dev/null +++ b/flang/test/Lower/MIF/team_number.f90 @@ -0,0 +1,19 @@ +! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s --check-prefixes=COARRAY +! RUN: not %flang_fc1 -emit-hlfir %s 2>&1 | FileCheck %s --check-prefixes=NOCOARRAY + +program test_team_number + use, intrinsic :: iso_fortran_env, only: team_type + implicit none + ! NOCOARRAY: Not yet implemented: Multi-image features are experimental and are disabled by default, use '-fcoarray' to enable. + + type(team_type) :: team + integer :: t + + ! COARRAY: %[[RES:.*]] = mif.team_number team %[[TEAM:.*]] : ({{.*}}) -> i64 + t = team_number(team) + + ! COARRAY: %[[RES:.*]] = mif.team_number : () -> i64 + t = team_number() + +end program test_team_number +