//===-- OpenMP.cpp -- Open MP directive lowering --------------------------===// // // 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 // //===----------------------------------------------------------------------===// // // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ // //===----------------------------------------------------------------------===// #include "flang/Lower/OpenMP.h" #include "DirectivesCommon.h" #include "flang/Common/idioms.h" #include "flang/Lower/Bridge.h" #include "flang/Lower/ConvertExpr.h" #include "flang/Lower/ConvertVariable.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/StatementContext.h" #include "flang/Lower/SymbolMap.h" #include "flang/Optimizer/Builder/BoxValue.h" #include "flang/Optimizer/Builder/FIRBuilder.h" #include "flang/Optimizer/Builder/Todo.h" #include "flang/Optimizer/HLFIR/HLFIROps.h" #include "flang/Parser/dump-parse-tree.h" #include "flang/Parser/parse-tree.h" #include "flang/Semantics/openmp-directive-sets.h" #include "flang/Semantics/tools.h" #include "mlir/Dialect/ControlFlow/IR/ControlFlowOps.h" #include "mlir/Dialect/OpenMP/OpenMPDialect.h" #include "mlir/Dialect/SCF/IR/SCF.h" #include "mlir/Transforms/RegionUtils.h" #include "llvm/ADT/STLExtras.h" #include "llvm/Frontend/OpenMP/OMPConstants.h" #include "llvm/Support/CommandLine.h" static llvm::cl::opt treatIndexAsSection( "openmp-treat-index-as-section", llvm::cl::desc("In the OpenMP data clauses treat `a(N)` as `a(N:N)`."), llvm::cl::init(true)); using DeclareTargetCapturePair = std::pair; //===----------------------------------------------------------------------===// // Common helper functions //===----------------------------------------------------------------------===// static Fortran::semantics::Symbol * getOmpObjectSymbol(const Fortran::parser::OmpObject &ompObject) { Fortran::semantics::Symbol *sym = nullptr; std::visit( Fortran::common::visitors{ [&](const Fortran::parser::Designator &designator) { if (auto *arrayEle = Fortran::parser::Unwrap( designator)) { sym = GetFirstName(arrayEle->base).symbol; } else if (const Fortran::parser::Name *name = Fortran::semantics::getDesignatorNameIfDataRef( designator)) { sym = name->symbol; } }, [&](const Fortran::parser::Name &name) { sym = name.symbol; }}, ompObject.u); return sym; } static void genObjectList(const Fortran::parser::OmpObjectList &objectList, Fortran::lower::AbstractConverter &converter, llvm::SmallVectorImpl &operands) { auto addOperands = [&](Fortran::lower::SymbolRef sym) { const mlir::Value variable = converter.getSymbolAddress(sym); if (variable) { operands.push_back(variable); } else { if (const auto *details = sym->detailsIf()) { operands.push_back(converter.getSymbolAddress(details->symbol())); converter.copySymbolBinding(details->symbol(), sym); } } }; for (const Fortran::parser::OmpObject &ompObject : objectList.v) { Fortran::semantics::Symbol *sym = getOmpObjectSymbol(ompObject); addOperands(*sym); } } static void gatherFuncAndVarSyms( const Fortran::parser::OmpObjectList &objList, mlir::omp::DeclareTargetCaptureClause clause, llvm::SmallVectorImpl &symbolAndClause) { for (const Fortran::parser::OmpObject &ompObject : objList.v) { Fortran::common::visit( Fortran::common::visitors{ [&](const Fortran::parser::Designator &designator) { if (const Fortran::parser::Name *name = Fortran::semantics::getDesignatorNameIfDataRef( designator)) { symbolAndClause.emplace_back(clause, *name->symbol); } }, [&](const Fortran::parser::Name &name) { symbolAndClause.emplace_back(clause, *name.symbol); }}, ompObject.u); } } static Fortran::lower::pft::Evaluation * getCollapsedLoopEval(Fortran::lower::pft::Evaluation &eval, int collapseValue) { // Return the Evaluation of the innermost collapsed loop, or the current one // if there was no COLLAPSE. if (collapseValue == 0) return &eval; Fortran::lower::pft::Evaluation *curEval = &eval.getFirstNestedEvaluation(); for (int i = 1; i < collapseValue; i++) { // The nested evaluations should be DoConstructs (i.e. they should form // a loop nest). Each DoConstruct is a tuple . assert(curEval->isA()); curEval = &*std::next(curEval->getNestedEvaluations().begin()); } return curEval; } static void genNestedEvaluations(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, int collapseValue = 0) { Fortran::lower::pft::Evaluation *curEval = getCollapsedLoopEval(eval, collapseValue); for (Fortran::lower::pft::Evaluation &e : curEval->getNestedEvaluations()) converter.genEval(e); } //===----------------------------------------------------------------------===// // DataSharingProcessor //===----------------------------------------------------------------------===// class DataSharingProcessor { bool hasLastPrivateOp; mlir::OpBuilder::InsertPoint lastPrivIP; mlir::OpBuilder::InsertPoint insPt; mlir::Value loopIV; // Symbols in private, firstprivate, and/or lastprivate clauses. llvm::SetVector privatizedSymbols; llvm::SetVector defaultSymbols; llvm::SetVector symbolsInNestedRegions; llvm::SetVector symbolsInParentRegions; Fortran::lower::AbstractConverter &converter; fir::FirOpBuilder &firOpBuilder; const Fortran::parser::OmpClauseList &opClauseList; Fortran::lower::pft::Evaluation &eval; bool needBarrier(); void collectSymbols(Fortran::semantics::Symbol::Flag flag); void collectOmpObjectListSymbol( const Fortran::parser::OmpObjectList &ompObjectList, llvm::SetVector &symbolSet); void collectSymbolsForPrivatization(); void insertBarrier(); void collectDefaultSymbols(); void privatize(); void defaultPrivatize(); void copyLastPrivatize(mlir::Operation *op); void insertLastPrivateCompare(mlir::Operation *op); void cloneSymbol(const Fortran::semantics::Symbol *sym); void copyFirstPrivateSymbol(const Fortran::semantics::Symbol *sym); void copyLastPrivateSymbol(const Fortran::semantics::Symbol *sym, mlir::OpBuilder::InsertPoint *lastPrivIP); void insertDeallocs(); public: DataSharingProcessor(Fortran::lower::AbstractConverter &converter, const Fortran::parser::OmpClauseList &opClauseList, Fortran::lower::pft::Evaluation &eval) : hasLastPrivateOp(false), converter(converter), firOpBuilder(converter.getFirOpBuilder()), opClauseList(opClauseList), eval(eval) {} // Privatisation is split into two steps. // Step1 performs cloning of all privatisation clauses and copying for // firstprivates. Step1 is performed at the place where process/processStep1 // is called. This is usually inside the Operation corresponding to the OpenMP // construct, for looping constructs this is just before the Operation. The // split into two steps was performed basically to be able to call // privatisation for looping constructs before the operation is created since // the bounds of the MLIR OpenMP operation can be privatised. // Step2 performs the copying for lastprivates and requires knowledge of the // MLIR operation to insert the last private update. Step2 adds // dealocation code as well. void processStep1(); void processStep2(mlir::Operation *op, bool isLoop); void setLoopIV(mlir::Value iv) { assert(!loopIV && "Loop iteration variable already set"); loopIV = iv; } }; void DataSharingProcessor::processStep1() { collectSymbolsForPrivatization(); collectDefaultSymbols(); privatize(); defaultPrivatize(); insertBarrier(); } void DataSharingProcessor::processStep2(mlir::Operation *op, bool isLoop) { insPt = firOpBuilder.saveInsertionPoint(); copyLastPrivatize(op); firOpBuilder.restoreInsertionPoint(insPt); if (isLoop) { // push deallocs out of the loop firOpBuilder.setInsertionPointAfter(op); insertDeallocs(); } else { // insert dummy instruction to mark the insertion position mlir::Value undefMarker = firOpBuilder.create( op->getLoc(), firOpBuilder.getIndexType()); insertDeallocs(); firOpBuilder.setInsertionPointAfter(undefMarker.getDefiningOp()); } } void DataSharingProcessor::insertDeallocs() { for (const Fortran::semantics::Symbol *sym : privatizedSymbols) if (Fortran::semantics::IsAllocatable(sym->GetUltimate())) { converter.createHostAssociateVarCloneDealloc(*sym); } } void DataSharingProcessor::cloneSymbol(const Fortran::semantics::Symbol *sym) { // Privatization for symbols which are pre-determined (like loop index // variables) happen separately, for everything else privatize here. if (sym->test(Fortran::semantics::Symbol::Flag::OmpPreDetermined)) return; bool success = converter.createHostAssociateVarClone(*sym); (void)success; assert(success && "Privatization failed due to existing binding"); } void DataSharingProcessor::copyFirstPrivateSymbol( const Fortran::semantics::Symbol *sym) { if (sym->test(Fortran::semantics::Symbol::Flag::OmpFirstPrivate)) converter.copyHostAssociateVar(*sym); } void DataSharingProcessor::copyLastPrivateSymbol( const Fortran::semantics::Symbol *sym, [[maybe_unused]] mlir::OpBuilder::InsertPoint *lastPrivIP) { if (sym->test(Fortran::semantics::Symbol::Flag::OmpLastPrivate)) converter.copyHostAssociateVar(*sym, lastPrivIP); } void DataSharingProcessor::collectOmpObjectListSymbol( const Fortran::parser::OmpObjectList &ompObjectList, llvm::SetVector &symbolSet) { for (const Fortran::parser::OmpObject &ompObject : ompObjectList.v) { Fortran::semantics::Symbol *sym = getOmpObjectSymbol(ompObject); symbolSet.insert(sym); } } void DataSharingProcessor::collectSymbolsForPrivatization() { bool hasCollapse = false; for (const Fortran::parser::OmpClause &clause : opClauseList.v) { if (const auto &privateClause = std::get_if(&clause.u)) { collectOmpObjectListSymbol(privateClause->v, privatizedSymbols); } else if (const auto &firstPrivateClause = std::get_if( &clause.u)) { collectOmpObjectListSymbol(firstPrivateClause->v, privatizedSymbols); } else if (const auto &lastPrivateClause = std::get_if( &clause.u)) { collectOmpObjectListSymbol(lastPrivateClause->v, privatizedSymbols); hasLastPrivateOp = true; } else if (std::get_if(&clause.u)) { hasCollapse = true; } } if (hasCollapse && hasLastPrivateOp) TODO(converter.getCurrentLocation(), "Collapse clause with lastprivate"); } bool DataSharingProcessor::needBarrier() { for (const Fortran::semantics::Symbol *sym : privatizedSymbols) { if (sym->test(Fortran::semantics::Symbol::Flag::OmpFirstPrivate) && sym->test(Fortran::semantics::Symbol::Flag::OmpLastPrivate)) return true; } return false; } void DataSharingProcessor::insertBarrier() { // Emit implicit barrier to synchronize threads and avoid data races on // initialization of firstprivate variables and post-update of lastprivate // variables. // FIXME: Emit barrier for lastprivate clause when 'sections' directive has // 'nowait' clause. Otherwise, emit barrier when 'sections' directive has // both firstprivate and lastprivate clause. // Emit implicit barrier for linear clause. Maybe on somewhere else. if (needBarrier()) firOpBuilder.create(converter.getCurrentLocation()); } void DataSharingProcessor::insertLastPrivateCompare(mlir::Operation *op) { bool cmpCreated = false; mlir::OpBuilder::InsertPoint localInsPt = firOpBuilder.saveInsertionPoint(); for (const Fortran::parser::OmpClause &clause : opClauseList.v) { if (std::get_if(&clause.u)) { // TODO: Add lastprivate support for simd construct if (mlir::isa(op)) { if (&eval == &eval.parentConstruct->getLastNestedEvaluation()) { // For `omp.sections`, lastprivatized variables occur in // lexically final `omp.section` operation. The following FIR // shall be generated for the same: // // omp.sections lastprivate(...) { // omp.section {...} // omp.section {...} // omp.section { // fir.allocate for `private`/`firstprivate` // // fir.if %true { // ^%lpv_update_blk // } // } // } // // To keep code consistency while handling privatization // through this control flow, add a `fir.if` operation // that always evaluates to true, in order to create // a dedicated sub-region in `omp.section` where // lastprivate FIR can reside. Later canonicalizations // will optimize away this operation. if (!eval.lowerAsUnstructured()) { auto ifOp = firOpBuilder.create( op->getLoc(), firOpBuilder.createIntegerConstant( op->getLoc(), firOpBuilder.getIntegerType(1), 0x1), /*else*/ false); firOpBuilder.setInsertionPointToStart( &ifOp.getThenRegion().front()); const Fortran::parser::OpenMPConstruct *parentOmpConstruct = eval.parentConstruct->getIf(); assert(parentOmpConstruct && "Expected a valid enclosing OpenMP construct"); const Fortran::parser::OpenMPSectionsConstruct *sectionsConstruct = std::get_if( &parentOmpConstruct->u); assert(sectionsConstruct && "Expected an enclosing omp.sections construct"); const Fortran::parser::OmpClauseList §ionsEndClauseList = std::get( std::get( sectionsConstruct->t) .t); for (const Fortran::parser::OmpClause &otherClause : sectionsEndClauseList.v) if (std::get_if( &otherClause.u)) // Emit implicit barrier to synchronize threads and avoid data // races on post-update of lastprivate variables when `nowait` // clause is present. firOpBuilder.create( converter.getCurrentLocation()); firOpBuilder.setInsertionPointToStart( &ifOp.getThenRegion().front()); lastPrivIP = firOpBuilder.saveInsertionPoint(); firOpBuilder.setInsertionPoint(ifOp); insPt = firOpBuilder.saveInsertionPoint(); } else { // Lastprivate operation is inserted at the end // of the lexically last section in the sections // construct mlir::OpBuilder::InsertPoint unstructuredSectionsIP = firOpBuilder.saveInsertionPoint(); mlir::Operation *lastOper = op->getRegion(0).back().getTerminator(); firOpBuilder.setInsertionPoint(lastOper); lastPrivIP = firOpBuilder.saveInsertionPoint(); firOpBuilder.restoreInsertionPoint(unstructuredSectionsIP); } } } else if (mlir::isa(op)) { // Update the original variable just before exiting the worksharing // loop. Conversion as follows: // // omp.wsloop { // omp.wsloop { ... // ... store // store ===> %v = arith.addi %iv, %step // omp.yield %cmp = %step < 0 ? %v < %ub : %v > %ub // } fir.if %cmp { // fir.store %v to %loopIV // ^%lpv_update_blk: // } // omp.yield // } // // Only generate the compare once in presence of multiple LastPrivate // clauses. if (cmpCreated) continue; cmpCreated = true; mlir::Location loc = op->getLoc(); mlir::Operation *lastOper = op->getRegion(0).back().getTerminator(); firOpBuilder.setInsertionPoint(lastOper); mlir::Value iv = op->getRegion(0).front().getArguments()[0]; mlir::Value ub = mlir::dyn_cast(op).getUpperBound()[0]; mlir::Value step = mlir::dyn_cast(op).getStep()[0]; // v = iv + step // cmp = step < 0 ? v < ub : v > ub mlir::Value v = firOpBuilder.create(loc, iv, step); mlir::Value zero = firOpBuilder.createIntegerConstant(loc, step.getType(), 0); mlir::Value negativeStep = firOpBuilder.create( loc, mlir::arith::CmpIPredicate::slt, step, zero); mlir::Value vLT = firOpBuilder.create( loc, mlir::arith::CmpIPredicate::slt, v, ub); mlir::Value vGT = firOpBuilder.create( loc, mlir::arith::CmpIPredicate::sgt, v, ub); mlir::Value cmpOp = firOpBuilder.create( loc, negativeStep, vLT, vGT); auto ifOp = firOpBuilder.create(loc, cmpOp, /*else*/ false); firOpBuilder.setInsertionPointToStart(&ifOp.getThenRegion().front()); assert(loopIV && "loopIV was not set"); firOpBuilder.create(op->getLoc(), v, loopIV); lastPrivIP = firOpBuilder.saveInsertionPoint(); } else { TODO(converter.getCurrentLocation(), "lastprivate clause in constructs other than " "simd/worksharing-loop"); } } } firOpBuilder.restoreInsertionPoint(localInsPt); } void DataSharingProcessor::collectSymbols( Fortran::semantics::Symbol::Flag flag) { converter.collectSymbolSet(eval, defaultSymbols, flag, /*collectSymbols=*/true, /*collectHostAssociatedSymbols=*/true); for (Fortran::lower::pft::Evaluation &e : eval.getNestedEvaluations()) { if (e.hasNestedEvaluations()) converter.collectSymbolSet(e, symbolsInNestedRegions, flag, /*collectSymbols=*/true, /*collectHostAssociatedSymbols=*/false); else converter.collectSymbolSet(e, symbolsInParentRegions, flag, /*collectSymbols=*/false, /*collectHostAssociatedSymbols=*/true); } } void DataSharingProcessor::collectDefaultSymbols() { for (const Fortran::parser::OmpClause &clause : opClauseList.v) { if (const auto &defaultClause = std::get_if(&clause.u)) { if (defaultClause->v.v == Fortran::parser::OmpDefaultClause::Type::Private) collectSymbols(Fortran::semantics::Symbol::Flag::OmpPrivate); else if (defaultClause->v.v == Fortran::parser::OmpDefaultClause::Type::Firstprivate) collectSymbols(Fortran::semantics::Symbol::Flag::OmpFirstPrivate); } } } void DataSharingProcessor::privatize() { for (const Fortran::semantics::Symbol *sym : privatizedSymbols) { if (const auto *commonDet = sym->detailsIf()) { for (const auto &mem : commonDet->objects()) { cloneSymbol(&*mem); copyFirstPrivateSymbol(&*mem); } } else { cloneSymbol(sym); copyFirstPrivateSymbol(sym); } } } void DataSharingProcessor::copyLastPrivatize(mlir::Operation *op) { insertLastPrivateCompare(op); for (const Fortran::semantics::Symbol *sym : privatizedSymbols) if (const auto *commonDet = sym->detailsIf()) { for (const auto &mem : commonDet->objects()) { copyLastPrivateSymbol(&*mem, &lastPrivIP); } } else { copyLastPrivateSymbol(sym, &lastPrivIP); } } void DataSharingProcessor::defaultPrivatize() { for (const Fortran::semantics::Symbol *sym : defaultSymbols) { if (!Fortran::semantics::IsProcedure(*sym) && !sym->GetUltimate().has() && !sym->GetUltimate().has() && !symbolsInNestedRegions.contains(sym) && !symbolsInParentRegions.contains(sym) && !privatizedSymbols.contains(sym)) { cloneSymbol(sym); copyFirstPrivateSymbol(sym); } } } //===----------------------------------------------------------------------===// // ClauseProcessor //===----------------------------------------------------------------------===// /// Class that handles the processing of OpenMP clauses. /// /// Its `process()` methods perform MLIR code generation for their /// corresponding clause if it is present in the clause list. Otherwise, they /// will return `false` to signal that the clause was not found. /// /// The intended use is of this class is to move clause processing outside of /// construct processing, since the same clauses can appear attached to /// different constructs and constructs can be combined, so that code /// duplication is minimized. /// /// Each construct-lowering function only calls the `process()` /// methods that relate to clauses that can impact the lowering of that /// construct. class ClauseProcessor { using ClauseTy = Fortran::parser::OmpClause; public: ClauseProcessor(Fortran::lower::AbstractConverter &converter, const Fortran::parser::OmpClauseList &clauses) : converter(converter), clauses(clauses) {} // 'Unique' clauses: They can appear at most once in the clause list. bool processCollapse(mlir::Location currentLocation, Fortran::lower::pft::Evaluation &eval, llvm::SmallVectorImpl &lowerBound, llvm::SmallVectorImpl &upperBound, llvm::SmallVectorImpl &step, llvm::SmallVectorImpl &iv, std::size_t &loopVarTypeSize) const; bool processDefault() const; bool processDevice(Fortran::lower::StatementContext &stmtCtx, mlir::Value &result) const; bool processDeviceType(mlir::omp::DeclareTargetDeviceType &result) const; bool processFinal(Fortran::lower::StatementContext &stmtCtx, mlir::Value &result) const; bool processHint(mlir::IntegerAttr &result) const; bool processMergeable(mlir::UnitAttr &result) const; bool processNowait(mlir::UnitAttr &result) const; bool processNumTeams(Fortran::lower::StatementContext &stmtCtx, mlir::Value &result) const; bool processNumThreads(Fortran::lower::StatementContext &stmtCtx, mlir::Value &result) const; bool processOrdered(mlir::IntegerAttr &result) const; bool processPriority(Fortran::lower::StatementContext &stmtCtx, mlir::Value &result) const; bool processProcBind(mlir::omp::ClauseProcBindKindAttr &result) const; bool processSafelen(mlir::IntegerAttr &result) const; bool processSchedule(mlir::omp::ClauseScheduleKindAttr &valAttr, mlir::omp::ScheduleModifierAttr &modifierAttr, mlir::UnitAttr &simdModifierAttr) const; bool processScheduleChunk(Fortran::lower::StatementContext &stmtCtx, mlir::Value &result) const; bool processSimdlen(mlir::IntegerAttr &result) const; bool processThreadLimit(Fortran::lower::StatementContext &stmtCtx, mlir::Value &result) const; bool processUntied(mlir::UnitAttr &result) const; // 'Repeatable' clauses: They can appear multiple times in the clause list. bool processAllocate(llvm::SmallVectorImpl &allocatorOperands, llvm::SmallVectorImpl &allocateOperands) const; bool processCopyin() const; bool processDepend(llvm::SmallVectorImpl &dependTypeOperands, llvm::SmallVectorImpl &dependOperands) const; bool processEnter(llvm::SmallVectorImpl &result) const; bool processIf(Fortran::parser::OmpIfClause::DirectiveNameModifier directiveName, mlir::Value &result) const; bool processLink(llvm::SmallVectorImpl &result) const; // This method is used to process a map clause. // The optional parameters - mapSymTypes, mapSymLocs & mapSymbols are used to // store the original type, location and Fortran symbol for the map operands. // They may be used later on to create the block_arguments for some of the // target directives that require it. bool processMap(mlir::Location currentLocation, const llvm::omp::Directive &directive, Fortran::semantics::SemanticsContext &semanticsContext, Fortran::lower::StatementContext &stmtCtx, llvm::SmallVectorImpl &mapOperands, llvm::SmallVectorImpl *mapSymTypes = nullptr, llvm::SmallVectorImpl *mapSymLocs = nullptr, llvm::SmallVectorImpl *mapSymbols = nullptr) const; bool processReduction( mlir::Location currentLocation, llvm::SmallVectorImpl &reductionVars, llvm::SmallVectorImpl &reductionDeclSymbols) const; bool processSectionsReduction(mlir::Location currentLocation) const; bool processTo(llvm::SmallVectorImpl &result) const; bool processUseDeviceAddr(llvm::SmallVectorImpl &operands, llvm::SmallVectorImpl &useDeviceTypes, llvm::SmallVectorImpl &useDeviceLocs, llvm::SmallVectorImpl &useDeviceSymbols) const; bool processUseDevicePtr(llvm::SmallVectorImpl &operands, llvm::SmallVectorImpl &useDeviceTypes, llvm::SmallVectorImpl &useDeviceLocs, llvm::SmallVectorImpl &useDeviceSymbols) const; template bool processMotionClauses(Fortran::semantics::SemanticsContext &semanticsContext, Fortran::lower::StatementContext &stmtCtx, llvm::SmallVectorImpl &mapOperands); // Call this method for these clauses that should be supported but are not // implemented yet. It triggers a compilation error if any of the given // clauses is found. template void processTODO(mlir::Location currentLocation, llvm::omp::Directive directive) const; private: using ClauseIterator = std::list::const_iterator; /// Utility to find a clause within a range in the clause list. template static ClauseIterator findClause(ClauseIterator begin, ClauseIterator end) { for (ClauseIterator it = begin; it != end; ++it) { if (std::get_if(&it->u)) return it; } return end; } /// Return the first instance of the given clause found in the clause list or /// `nullptr` if not present. If more than one instance is expected, use /// `findRepeatableClause` instead. template const T * findUniqueClause(const Fortran::parser::CharBlock **source = nullptr) const { ClauseIterator it = findClause(clauses.v.begin(), clauses.v.end()); if (it != clauses.v.end()) { if (source) *source = &it->source; return &std::get(it->u); } return nullptr; } /// Call `callbackFn` for each occurrence of the given clause. Return `true` /// if at least one instance was found. template bool findRepeatableClause( std::function callbackFn) const { bool found = false; ClauseIterator nextIt, endIt = clauses.v.end(); for (ClauseIterator it = clauses.v.begin(); it != endIt; it = nextIt) { nextIt = findClause(it, endIt); if (nextIt != endIt) { callbackFn(&std::get(nextIt->u), nextIt->source); found = true; ++nextIt; } } return found; } /// Set the `result` to a new `mlir::UnitAttr` if the clause is present. template bool markClauseOccurrence(mlir::UnitAttr &result) const { if (findUniqueClause()) { result = converter.getFirOpBuilder().getUnitAttr(); return true; } return false; } Fortran::lower::AbstractConverter &converter; const Fortran::parser::OmpClauseList &clauses; }; //===----------------------------------------------------------------------===// // ClauseProcessor helper functions //===----------------------------------------------------------------------===// /// Check for unsupported map operand types. static void checkMapType(mlir::Location location, mlir::Type type) { if (auto refType = type.dyn_cast()) type = refType.getElementType(); if (auto boxType = type.dyn_cast_or_null()) if (!boxType.getElementType().isa()) TODO(location, "OMPD_target_data MapOperand BoxType"); } class ReductionProcessor { public: enum IntrinsicProc { MAX, MIN, IAND, IOR, IEOR }; static IntrinsicProc getReductionType(const Fortran::parser::ProcedureDesignator &pd) { auto redType = llvm::StringSwitch>( getRealName(pd).ToString()) .Case("max", IntrinsicProc::MAX) .Case("min", IntrinsicProc::MIN) .Case("iand", IntrinsicProc::IAND) .Case("ior", IntrinsicProc::IOR) .Case("ieor", IntrinsicProc::IEOR) .Default(std::nullopt); assert(redType && "Invalid Reduction"); return *redType; } static bool supportedIntrinsicProcReduction( const Fortran::parser::ProcedureDesignator &pd) { const auto *name{Fortran::parser::Unwrap(pd)}; assert(name && "Invalid Reduction Intrinsic."); if (!name->symbol->GetUltimate().attrs().test( Fortran::semantics::Attr::INTRINSIC)) return false; auto redType = llvm::StringSwitch>( getRealName(name).ToString()) .Case("max", IntrinsicProc::MAX) .Case("min", IntrinsicProc::MIN) .Case("iand", IntrinsicProc::IAND) .Case("ior", IntrinsicProc::IOR) .Case("ieor", IntrinsicProc::IEOR) .Default(std::nullopt); if (redType) return true; return false; } static const Fortran::semantics::SourceName getRealName(const Fortran::parser::Name *name) { return name->symbol->GetUltimate().name(); } static const Fortran::semantics::SourceName getRealName(const Fortran::parser::ProcedureDesignator &pd) { const auto *name{Fortran::parser::Unwrap(pd)}; assert(name && "Invalid Reduction Intrinsic."); return getRealName(name); } static std::string getReductionName(llvm::StringRef name, mlir::Type ty) { return (llvm::Twine(name) + (ty.isIntOrIndex() ? llvm::Twine("_i_") : llvm::Twine("_f_")) + llvm::Twine(ty.getIntOrFloatBitWidth())) .str(); } static std::string getReductionName( Fortran::parser::DefinedOperator::IntrinsicOperator intrinsicOp, mlir::Type ty) { std::string reductionName; switch (intrinsicOp) { case Fortran::parser::DefinedOperator::IntrinsicOperator::Add: reductionName = "add_reduction"; break; case Fortran::parser::DefinedOperator::IntrinsicOperator::Multiply: reductionName = "multiply_reduction"; break; case Fortran::parser::DefinedOperator::IntrinsicOperator::AND: return "and_reduction"; case Fortran::parser::DefinedOperator::IntrinsicOperator::EQV: return "eqv_reduction"; case Fortran::parser::DefinedOperator::IntrinsicOperator::OR: return "or_reduction"; case Fortran::parser::DefinedOperator::IntrinsicOperator::NEQV: return "neqv_reduction"; default: reductionName = "other_reduction"; break; } return getReductionName(reductionName, ty); } /// This function returns the identity value of the operator \p /// reductionOpName. For example: /// 0 + x = x, /// 1 * x = x static int getOperationIdentity( Fortran::parser::DefinedOperator::IntrinsicOperator intrinsicOp, mlir::Location loc) { switch (intrinsicOp) { case Fortran::parser::DefinedOperator::IntrinsicOperator::Add: case Fortran::parser::DefinedOperator::IntrinsicOperator::OR: case Fortran::parser::DefinedOperator::IntrinsicOperator::NEQV: return 0; case Fortran::parser::DefinedOperator::IntrinsicOperator::Multiply: case Fortran::parser::DefinedOperator::IntrinsicOperator::AND: case Fortran::parser::DefinedOperator::IntrinsicOperator::EQV: return 1; default: TODO(loc, "Reduction of some intrinsic operators is not supported"); } } static mlir::Value getIntrinsicProcInitValue( mlir::Location loc, mlir::Type type, const Fortran::parser::ProcedureDesignator &procDesignator, fir::FirOpBuilder &builder) { assert((fir::isa_integer(type) || fir::isa_real(type) || type.isa()) && "only integer, logical and real types are currently supported"); switch (getReductionType(procDesignator)) { case IntrinsicProc::MAX: { if (auto ty = type.dyn_cast()) { const llvm::fltSemantics &sem = ty.getFloatSemantics(); return builder.createRealConstant( loc, type, llvm::APFloat::getLargest(sem, /*Negative=*/true)); } unsigned bits = type.getIntOrFloatBitWidth(); int64_t minInt = llvm::APInt::getSignedMinValue(bits).getSExtValue(); return builder.createIntegerConstant(loc, type, minInt); } case IntrinsicProc::MIN: { if (auto ty = type.dyn_cast()) { const llvm::fltSemantics &sem = ty.getFloatSemantics(); return builder.createRealConstant( loc, type, llvm::APFloat::getLargest(sem, /*Negative=*/false)); } unsigned bits = type.getIntOrFloatBitWidth(); int64_t maxInt = llvm::APInt::getSignedMaxValue(bits).getSExtValue(); return builder.createIntegerConstant(loc, type, maxInt); } case IntrinsicProc::IOR: { unsigned bits = type.getIntOrFloatBitWidth(); int64_t zeroInt = llvm::APInt::getZero(bits).getSExtValue(); return builder.createIntegerConstant(loc, type, zeroInt); } case IntrinsicProc::IEOR: { unsigned bits = type.getIntOrFloatBitWidth(); int64_t zeroInt = llvm::APInt::getZero(bits).getSExtValue(); return builder.createIntegerConstant(loc, type, zeroInt); } case IntrinsicProc::IAND: { unsigned bits = type.getIntOrFloatBitWidth(); int64_t allOnInt = llvm::APInt::getAllOnes(bits).getSExtValue(); return builder.createIntegerConstant(loc, type, allOnInt); } } llvm_unreachable("Unknown Reduction Intrinsic"); } static mlir::Value getIntrinsicOpInitValue( mlir::Location loc, mlir::Type type, Fortran::parser::DefinedOperator::IntrinsicOperator intrinsicOp, fir::FirOpBuilder &builder) { if (type.isa()) return builder.create( loc, type, builder.getFloatAttr(type, (double)getOperationIdentity(intrinsicOp, loc))); if (type.isa()) { mlir::Value intConst = builder.create( loc, builder.getI1Type(), builder.getIntegerAttr(builder.getI1Type(), getOperationIdentity(intrinsicOp, loc))); return builder.createConvert(loc, type, intConst); } return builder.create( loc, type, builder.getIntegerAttr(type, getOperationIdentity(intrinsicOp, loc))); } template static mlir::Value getReductionOperation(fir::FirOpBuilder &builder, mlir::Type type, mlir::Location loc, mlir::Value op1, mlir::Value op2) { assert(type.isIntOrIndexOrFloat() && "only integer and float types are currently supported"); if (type.isIntOrIndex()) return builder.create(loc, op1, op2); return builder.create(loc, op1, op2); } /// Creates an OpenMP reduction declaration and inserts it into the provided /// symbol table. The declaration has a constant initializer with the neutral /// value `initValue`, and the reduction combiner carried over from `reduce`. /// TODO: Generalize this for non-integer types, add atomic region. static mlir::omp::ReductionDeclareOp createReductionDecl( fir::FirOpBuilder &builder, llvm::StringRef reductionOpName, const Fortran::parser::ProcedureDesignator &procDesignator, mlir::Type type, mlir::Location loc) { mlir::OpBuilder::InsertionGuard guard(builder); mlir::ModuleOp module = builder.getModule(); auto decl = module.lookupSymbol(reductionOpName); if (decl) return decl; mlir::OpBuilder modBuilder(module.getBodyRegion()); decl = modBuilder.create( loc, reductionOpName, type); builder.createBlock(&decl.getInitializerRegion(), decl.getInitializerRegion().end(), {type}, {loc}); builder.setInsertionPointToEnd(&decl.getInitializerRegion().back()); mlir::Value init = getIntrinsicProcInitValue(loc, type, procDesignator, builder); builder.create(loc, init); builder.createBlock(&decl.getReductionRegion(), decl.getReductionRegion().end(), {type, type}, {loc, loc}); builder.setInsertionPointToEnd(&decl.getReductionRegion().back()); mlir::Value op1 = decl.getReductionRegion().front().getArgument(0); mlir::Value op2 = decl.getReductionRegion().front().getArgument(1); mlir::Value reductionOp; switch (getReductionType(procDesignator)) { case IntrinsicProc::MAX: reductionOp = getReductionOperation( builder, type, loc, op1, op2); break; case IntrinsicProc::MIN: reductionOp = getReductionOperation( builder, type, loc, op1, op2); break; case IntrinsicProc::IOR: assert((type.isIntOrIndex()) && "only integer is expected"); reductionOp = builder.create(loc, op1, op2); break; case IntrinsicProc::IEOR: assert((type.isIntOrIndex()) && "only integer is expected"); reductionOp = builder.create(loc, op1, op2); break; case IntrinsicProc::IAND: assert((type.isIntOrIndex()) && "only integer is expected"); reductionOp = builder.create(loc, op1, op2); break; } builder.create(loc, reductionOp); return decl; } /// Creates an OpenMP reduction declaration and inserts it into the provided /// symbol table. The declaration has a constant initializer with the neutral /// value `initValue`, and the reduction combiner carried over from `reduce`. /// TODO: Generalize this for non-integer types, add atomic region. static mlir::omp::ReductionDeclareOp createReductionDecl( fir::FirOpBuilder &builder, llvm::StringRef reductionOpName, Fortran::parser::DefinedOperator::IntrinsicOperator intrinsicOp, mlir::Type type, mlir::Location loc) { mlir::OpBuilder::InsertionGuard guard(builder); mlir::ModuleOp module = builder.getModule(); auto decl = module.lookupSymbol(reductionOpName); if (decl) return decl; mlir::OpBuilder modBuilder(module.getBodyRegion()); decl = modBuilder.create( loc, reductionOpName, type); builder.createBlock(&decl.getInitializerRegion(), decl.getInitializerRegion().end(), {type}, {loc}); builder.setInsertionPointToEnd(&decl.getInitializerRegion().back()); mlir::Value init = getIntrinsicOpInitValue(loc, type, intrinsicOp, builder); builder.create(loc, init); builder.createBlock(&decl.getReductionRegion(), decl.getReductionRegion().end(), {type, type}, {loc, loc}); builder.setInsertionPointToEnd(&decl.getReductionRegion().back()); mlir::Value op1 = decl.getReductionRegion().front().getArgument(0); mlir::Value op2 = decl.getReductionRegion().front().getArgument(1); mlir::Value reductionOp; switch (intrinsicOp) { case Fortran::parser::DefinedOperator::IntrinsicOperator::Add: reductionOp = getReductionOperation( builder, type, loc, op1, op2); break; case Fortran::parser::DefinedOperator::IntrinsicOperator::Multiply: reductionOp = getReductionOperation( builder, type, loc, op1, op2); break; case Fortran::parser::DefinedOperator::IntrinsicOperator::AND: { mlir::Value op1I1 = builder.createConvert(loc, builder.getI1Type(), op1); mlir::Value op2I1 = builder.createConvert(loc, builder.getI1Type(), op2); mlir::Value andiOp = builder.create(loc, op1I1, op2I1); reductionOp = builder.createConvert(loc, type, andiOp); break; } case Fortran::parser::DefinedOperator::IntrinsicOperator::OR: { mlir::Value op1I1 = builder.createConvert(loc, builder.getI1Type(), op1); mlir::Value op2I1 = builder.createConvert(loc, builder.getI1Type(), op2); mlir::Value oriOp = builder.create(loc, op1I1, op2I1); reductionOp = builder.createConvert(loc, type, oriOp); break; } case Fortran::parser::DefinedOperator::IntrinsicOperator::EQV: { mlir::Value op1I1 = builder.createConvert(loc, builder.getI1Type(), op1); mlir::Value op2I1 = builder.createConvert(loc, builder.getI1Type(), op2); mlir::Value cmpiOp = builder.create( loc, mlir::arith::CmpIPredicate::eq, op1I1, op2I1); reductionOp = builder.createConvert(loc, type, cmpiOp); break; } case Fortran::parser::DefinedOperator::IntrinsicOperator::NEQV: { mlir::Value op1I1 = builder.createConvert(loc, builder.getI1Type(), op1); mlir::Value op2I1 = builder.createConvert(loc, builder.getI1Type(), op2); mlir::Value cmpiOp = builder.create( loc, mlir::arith::CmpIPredicate::ne, op1I1, op2I1); reductionOp = builder.createConvert(loc, type, cmpiOp); break; } default: TODO(loc, "Reduction of some intrinsic operators is not supported"); } builder.create(loc, reductionOp); return decl; } /// Creates a reduction declaration and associates it with an OpenMP block /// directive. static void addReductionDecl( mlir::Location currentLocation, Fortran::lower::AbstractConverter &converter, const Fortran::parser::OmpReductionClause &reduction, llvm::SmallVectorImpl &reductionVars, llvm::SmallVectorImpl &reductionDeclSymbols) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); mlir::omp::ReductionDeclareOp decl; const auto &redOperator{ std::get(reduction.t)}; const auto &objectList{ std::get(reduction.t)}; if (const auto &redDefinedOp = std::get_if(&redOperator.u)) { const auto &intrinsicOp{ std::get( redDefinedOp->u)}; switch (intrinsicOp) { case Fortran::parser::DefinedOperator::IntrinsicOperator::Add: case Fortran::parser::DefinedOperator::IntrinsicOperator::Multiply: case Fortran::parser::DefinedOperator::IntrinsicOperator::AND: case Fortran::parser::DefinedOperator::IntrinsicOperator::EQV: case Fortran::parser::DefinedOperator::IntrinsicOperator::OR: case Fortran::parser::DefinedOperator::IntrinsicOperator::NEQV: break; default: TODO(currentLocation, "Reduction of some intrinsic operators is not supported"); break; } for (const Fortran::parser::OmpObject &ompObject : objectList.v) { if (const auto *name{ Fortran::parser::Unwrap(ompObject)}) { if (const Fortran::semantics::Symbol * symbol{name->symbol}) { mlir::Value symVal = converter.getSymbolAddress(*symbol); if (auto declOp = symVal.getDefiningOp()) symVal = declOp.getBase(); mlir::Type redType = symVal.getType().cast().getEleTy(); reductionVars.push_back(symVal); if (redType.isa()) decl = createReductionDecl( firOpBuilder, getReductionName(intrinsicOp, firOpBuilder.getI1Type()), intrinsicOp, redType, currentLocation); else if (redType.isIntOrIndexOrFloat()) { decl = createReductionDecl(firOpBuilder, getReductionName(intrinsicOp, redType), intrinsicOp, redType, currentLocation); } else { TODO(currentLocation, "Reduction of some types is not supported"); } reductionDeclSymbols.push_back(mlir::SymbolRefAttr::get( firOpBuilder.getContext(), decl.getSymName())); } } } } else if (const auto *reductionIntrinsic = std::get_if( &redOperator.u)) { if (ReductionProcessor::supportedIntrinsicProcReduction( *reductionIntrinsic)) { for (const Fortran::parser::OmpObject &ompObject : objectList.v) { if (const auto *name{ Fortran::parser::Unwrap(ompObject)}) { if (const Fortran::semantics::Symbol * symbol{name->symbol}) { mlir::Value symVal = converter.getSymbolAddress(*symbol); if (auto declOp = symVal.getDefiningOp()) symVal = declOp.getBase(); mlir::Type redType = symVal.getType().cast().getEleTy(); reductionVars.push_back(symVal); assert(redType.isIntOrIndexOrFloat() && "Unsupported reduction type"); decl = createReductionDecl( firOpBuilder, getReductionName(getRealName(*reductionIntrinsic).ToString(), redType), *reductionIntrinsic, redType, currentLocation); reductionDeclSymbols.push_back(mlir::SymbolRefAttr::get( firOpBuilder.getContext(), decl.getSymName())); } } } } } } }; static mlir::omp::ScheduleModifier translateScheduleModifier(const Fortran::parser::OmpScheduleModifierType &m) { switch (m.v) { case Fortran::parser::OmpScheduleModifierType::ModType::Monotonic: return mlir::omp::ScheduleModifier::monotonic; case Fortran::parser::OmpScheduleModifierType::ModType::Nonmonotonic: return mlir::omp::ScheduleModifier::nonmonotonic; case Fortran::parser::OmpScheduleModifierType::ModType::Simd: return mlir::omp::ScheduleModifier::simd; } return mlir::omp::ScheduleModifier::none; } static mlir::omp::ScheduleModifier getScheduleModifier(const Fortran::parser::OmpScheduleClause &x) { const auto &modifier = std::get>(x.t); // The input may have the modifier any order, so we look for one that isn't // SIMD. If modifier is not set at all, fall down to the bottom and return // "none". if (modifier) { const auto &modType1 = std::get(modifier->t); if (modType1.v.v == Fortran::parser::OmpScheduleModifierType::ModType::Simd) { const auto &modType2 = std::get< std::optional>( modifier->t); if (modType2 && modType2->v.v != Fortran::parser::OmpScheduleModifierType::ModType::Simd) return translateScheduleModifier(modType2->v); return mlir::omp::ScheduleModifier::none; } return translateScheduleModifier(modType1.v); } return mlir::omp::ScheduleModifier::none; } static mlir::omp::ScheduleModifier getSimdModifier(const Fortran::parser::OmpScheduleClause &x) { const auto &modifier = std::get>(x.t); // Either of the two possible modifiers in the input can be the SIMD modifier, // so look in either one, and return simd if we find one. Not found = return // "none". if (modifier) { const auto &modType1 = std::get(modifier->t); if (modType1.v.v == Fortran::parser::OmpScheduleModifierType::ModType::Simd) return mlir::omp::ScheduleModifier::simd; const auto &modType2 = std::get< std::optional>( modifier->t); if (modType2 && modType2->v.v == Fortran::parser::OmpScheduleModifierType::ModType::Simd) return mlir::omp::ScheduleModifier::simd; } return mlir::omp::ScheduleModifier::none; } static void genAllocateClause(Fortran::lower::AbstractConverter &converter, const Fortran::parser::OmpAllocateClause &ompAllocateClause, llvm::SmallVectorImpl &allocatorOperands, llvm::SmallVectorImpl &allocateOperands) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); mlir::Location currentLocation = converter.getCurrentLocation(); Fortran::lower::StatementContext stmtCtx; mlir::Value allocatorOperand; const Fortran::parser::OmpObjectList &ompObjectList = std::get(ompAllocateClause.t); const auto &allocateModifier = std::get< std::optional>( ompAllocateClause.t); // If the allocate modifier is present, check if we only use the allocator // submodifier. ALIGN in this context is unimplemented const bool onlyAllocator = allocateModifier && std::holds_alternative< Fortran::parser::OmpAllocateClause::AllocateModifier::Allocator>( allocateModifier->u); if (allocateModifier && !onlyAllocator) { TODO(currentLocation, "OmpAllocateClause ALIGN modifier"); } // Check if allocate clause has allocator specified. If so, add it // to list of allocators, otherwise, add default allocator to // list of allocators. if (onlyAllocator) { const auto &allocatorValue = std::get< Fortran::parser::OmpAllocateClause::AllocateModifier::Allocator>( allocateModifier->u); allocatorOperand = fir::getBase(converter.genExprValue( *Fortran::semantics::GetExpr(allocatorValue.v), stmtCtx)); allocatorOperands.insert(allocatorOperands.end(), ompObjectList.v.size(), allocatorOperand); } else { allocatorOperand = firOpBuilder.createIntegerConstant( currentLocation, firOpBuilder.getI32Type(), 1); allocatorOperands.insert(allocatorOperands.end(), ompObjectList.v.size(), allocatorOperand); } genObjectList(ompObjectList, converter, allocateOperands); } static mlir::omp::ClauseProcBindKindAttr genProcBindKindAttr( fir::FirOpBuilder &firOpBuilder, const Fortran::parser::OmpClause::ProcBind *procBindClause) { mlir::omp::ClauseProcBindKind procBindKind; switch (procBindClause->v.v) { case Fortran::parser::OmpProcBindClause::Type::Master: procBindKind = mlir::omp::ClauseProcBindKind::Master; break; case Fortran::parser::OmpProcBindClause::Type::Close: procBindKind = mlir::omp::ClauseProcBindKind::Close; break; case Fortran::parser::OmpProcBindClause::Type::Spread: procBindKind = mlir::omp::ClauseProcBindKind::Spread; break; case Fortran::parser::OmpProcBindClause::Type::Primary: procBindKind = mlir::omp::ClauseProcBindKind::Primary; break; } return mlir::omp::ClauseProcBindKindAttr::get(firOpBuilder.getContext(), procBindKind); } static mlir::omp::ClauseTaskDependAttr genDependKindAttr(fir::FirOpBuilder &firOpBuilder, const Fortran::parser::OmpClause::Depend *dependClause) { mlir::omp::ClauseTaskDepend pbKind; switch ( std::get( std::get(dependClause->v.u) .t) .v) { case Fortran::parser::OmpDependenceType::Type::In: pbKind = mlir::omp::ClauseTaskDepend::taskdependin; break; case Fortran::parser::OmpDependenceType::Type::Out: pbKind = mlir::omp::ClauseTaskDepend::taskdependout; break; case Fortran::parser::OmpDependenceType::Type::Inout: pbKind = mlir::omp::ClauseTaskDepend::taskdependinout; break; default: llvm_unreachable("unknown parser task dependence type"); break; } return mlir::omp::ClauseTaskDependAttr::get(firOpBuilder.getContext(), pbKind); } static mlir::Value getIfClauseOperand( Fortran::lower::AbstractConverter &converter, const Fortran::parser::OmpClause::If *ifClause, Fortran::parser::OmpIfClause::DirectiveNameModifier directiveName, mlir::Location clauseLocation) { // Only consider the clause if it's intended for the given directive. auto &directive = std::get< std::optional>( ifClause->v.t); if (directive && directive.value() != directiveName) return nullptr; Fortran::lower::StatementContext stmtCtx; fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); auto &expr = std::get(ifClause->v.t); mlir::Value ifVal = fir::getBase( converter.genExprValue(*Fortran::semantics::GetExpr(expr), stmtCtx)); return firOpBuilder.createConvert(clauseLocation, firOpBuilder.getI1Type(), ifVal); } static void addUseDeviceClause(Fortran::lower::AbstractConverter &converter, const Fortran::parser::OmpObjectList &useDeviceClause, llvm::SmallVectorImpl &operands, llvm::SmallVectorImpl &useDeviceTypes, llvm::SmallVectorImpl &useDeviceLocs, llvm::SmallVectorImpl &useDeviceSymbols) { genObjectList(useDeviceClause, converter, operands); for (mlir::Value &operand : operands) { checkMapType(operand.getLoc(), operand.getType()); useDeviceTypes.push_back(operand.getType()); useDeviceLocs.push_back(operand.getLoc()); } for (const Fortran::parser::OmpObject &ompObject : useDeviceClause.v) { Fortran::semantics::Symbol *sym = getOmpObjectSymbol(ompObject); useDeviceSymbols.push_back(sym); } } //===----------------------------------------------------------------------===// // ClauseProcessor unique clauses //===----------------------------------------------------------------------===// bool ClauseProcessor::processCollapse( mlir::Location currentLocation, Fortran::lower::pft::Evaluation &eval, llvm::SmallVectorImpl &lowerBound, llvm::SmallVectorImpl &upperBound, llvm::SmallVectorImpl &step, llvm::SmallVectorImpl &iv, std::size_t &loopVarTypeSize) const { bool found = false; fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); // Collect the loops to collapse. Fortran::lower::pft::Evaluation *doConstructEval = &eval.getFirstNestedEvaluation(); if (doConstructEval->getIf() ->IsDoConcurrent()) { TODO(currentLocation, "Do Concurrent in Worksharing loop construct"); } std::int64_t collapseValue = 1l; if (auto *collapseClause = findUniqueClause()) { const auto *expr = Fortran::semantics::GetExpr(collapseClause->v); collapseValue = Fortran::evaluate::ToInt64(*expr).value(); found = true; } loopVarTypeSize = 0; do { Fortran::lower::pft::Evaluation *doLoop = &doConstructEval->getFirstNestedEvaluation(); auto *doStmt = doLoop->getIf(); assert(doStmt && "Expected do loop to be in the nested evaluation"); const auto &loopControl = std::get>(doStmt->t); const Fortran::parser::LoopControl::Bounds *bounds = std::get_if(&loopControl->u); assert(bounds && "Expected bounds for worksharing do loop"); Fortran::lower::StatementContext stmtCtx; lowerBound.push_back(fir::getBase(converter.genExprValue( *Fortran::semantics::GetExpr(bounds->lower), stmtCtx))); upperBound.push_back(fir::getBase(converter.genExprValue( *Fortran::semantics::GetExpr(bounds->upper), stmtCtx))); if (bounds->step) { step.push_back(fir::getBase(converter.genExprValue( *Fortran::semantics::GetExpr(bounds->step), stmtCtx))); } else { // If `step` is not present, assume it as `1`. step.push_back(firOpBuilder.createIntegerConstant( currentLocation, firOpBuilder.getIntegerType(32), 1)); } iv.push_back(bounds->name.thing.symbol); loopVarTypeSize = std::max(loopVarTypeSize, bounds->name.thing.symbol->GetUltimate().size()); collapseValue--; doConstructEval = &*std::next(doConstructEval->getNestedEvaluations().begin()); } while (collapseValue > 0); return found; } bool ClauseProcessor::processDefault() const { if (auto *defaultClause = findUniqueClause()) { // Private, Firstprivate, Shared, None switch (defaultClause->v.v) { case Fortran::parser::OmpDefaultClause::Type::Shared: case Fortran::parser::OmpDefaultClause::Type::None: // Default clause with shared or none do not require any handling since // Shared is the default behavior in the IR and None is only required // for semantic checks. break; case Fortran::parser::OmpDefaultClause::Type::Private: // TODO Support default(private) break; case Fortran::parser::OmpDefaultClause::Type::Firstprivate: // TODO Support default(firstprivate) break; } return true; } return false; } bool ClauseProcessor::processDevice(Fortran::lower::StatementContext &stmtCtx, mlir::Value &result) const { const Fortran::parser::CharBlock *source = nullptr; if (auto *deviceClause = findUniqueClause(&source)) { mlir::Location clauseLocation = converter.genLocation(*source); if (auto deviceModifier = std::get< std::optional>( deviceClause->v.t)) { if (deviceModifier == Fortran::parser::OmpDeviceClause::DeviceModifier::Ancestor) { TODO(clauseLocation, "OMPD_target Device Modifier Ancestor"); } } if (const auto *deviceExpr = Fortran::semantics::GetExpr( std::get(deviceClause->v.t))) { result = fir::getBase(converter.genExprValue(*deviceExpr, stmtCtx)); } return true; } return false; } bool ClauseProcessor::processDeviceType( mlir::omp::DeclareTargetDeviceType &result) const { if (auto *deviceTypeClause = findUniqueClause()) { // Case: declare target ... device_type(any | host | nohost) switch (deviceTypeClause->v.v) { case Fortran::parser::OmpDeviceTypeClause::Type::Nohost: result = mlir::omp::DeclareTargetDeviceType::nohost; break; case Fortran::parser::OmpDeviceTypeClause::Type::Host: result = mlir::omp::DeclareTargetDeviceType::host; break; case Fortran::parser::OmpDeviceTypeClause::Type::Any: result = mlir::omp::DeclareTargetDeviceType::any; break; } return true; } return false; } bool ClauseProcessor::processFinal(Fortran::lower::StatementContext &stmtCtx, mlir::Value &result) const { const Fortran::parser::CharBlock *source = nullptr; if (auto *finalClause = findUniqueClause(&source)) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); mlir::Location clauseLocation = converter.genLocation(*source); mlir::Value finalVal = fir::getBase(converter.genExprValue( *Fortran::semantics::GetExpr(finalClause->v), stmtCtx)); result = firOpBuilder.createConvert(clauseLocation, firOpBuilder.getI1Type(), finalVal); return true; } return false; } bool ClauseProcessor::processHint(mlir::IntegerAttr &result) const { if (auto *hintClause = findUniqueClause()) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); const auto *expr = Fortran::semantics::GetExpr(hintClause->v); int64_t hintValue = *Fortran::evaluate::ToInt64(*expr); result = firOpBuilder.getI64IntegerAttr(hintValue); return true; } return false; } bool ClauseProcessor::processMergeable(mlir::UnitAttr &result) const { return markClauseOccurrence(result); } bool ClauseProcessor::processNowait(mlir::UnitAttr &result) const { return markClauseOccurrence(result); } bool ClauseProcessor::processNumTeams(Fortran::lower::StatementContext &stmtCtx, mlir::Value &result) const { // TODO Get lower and upper bounds for num_teams when parser is updated to // accept both. if (auto *numTeamsClause = findUniqueClause()) { result = fir::getBase(converter.genExprValue( *Fortran::semantics::GetExpr(numTeamsClause->v), stmtCtx)); return true; } return false; } bool ClauseProcessor::processNumThreads( Fortran::lower::StatementContext &stmtCtx, mlir::Value &result) const { if (auto *numThreadsClause = findUniqueClause()) { // OMPIRBuilder expects `NUM_THREADS` clause as a `Value`. result = fir::getBase(converter.genExprValue( *Fortran::semantics::GetExpr(numThreadsClause->v), stmtCtx)); return true; } return false; } bool ClauseProcessor::processOrdered(mlir::IntegerAttr &result) const { if (auto *orderedClause = findUniqueClause()) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); int64_t orderedClauseValue = 0l; if (orderedClause->v.has_value()) { const auto *expr = Fortran::semantics::GetExpr(orderedClause->v); orderedClauseValue = *Fortran::evaluate::ToInt64(*expr); } result = firOpBuilder.getI64IntegerAttr(orderedClauseValue); return true; } return false; } bool ClauseProcessor::processPriority(Fortran::lower::StatementContext &stmtCtx, mlir::Value &result) const { if (auto *priorityClause = findUniqueClause()) { result = fir::getBase(converter.genExprValue( *Fortran::semantics::GetExpr(priorityClause->v), stmtCtx)); return true; } return false; } bool ClauseProcessor::processProcBind( mlir::omp::ClauseProcBindKindAttr &result) const { if (auto *procBindClause = findUniqueClause()) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); result = genProcBindKindAttr(firOpBuilder, procBindClause); return true; } return false; } bool ClauseProcessor::processSafelen(mlir::IntegerAttr &result) const { if (auto *safelenClause = findUniqueClause()) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); const auto *expr = Fortran::semantics::GetExpr(safelenClause->v); const std::optional safelenVal = Fortran::evaluate::ToInt64(*expr); result = firOpBuilder.getI64IntegerAttr(*safelenVal); return true; } return false; } bool ClauseProcessor::processSchedule( mlir::omp::ClauseScheduleKindAttr &valAttr, mlir::omp::ScheduleModifierAttr &modifierAttr, mlir::UnitAttr &simdModifierAttr) const { if (auto *scheduleClause = findUniqueClause()) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); mlir::MLIRContext *context = firOpBuilder.getContext(); const Fortran::parser::OmpScheduleClause &scheduleType = scheduleClause->v; const auto &scheduleClauseKind = std::get( scheduleType.t); mlir::omp::ClauseScheduleKind scheduleKind; switch (scheduleClauseKind) { case Fortran::parser::OmpScheduleClause::ScheduleType::Static: scheduleKind = mlir::omp::ClauseScheduleKind::Static; break; case Fortran::parser::OmpScheduleClause::ScheduleType::Dynamic: scheduleKind = mlir::omp::ClauseScheduleKind::Dynamic; break; case Fortran::parser::OmpScheduleClause::ScheduleType::Guided: scheduleKind = mlir::omp::ClauseScheduleKind::Guided; break; case Fortran::parser::OmpScheduleClause::ScheduleType::Auto: scheduleKind = mlir::omp::ClauseScheduleKind::Auto; break; case Fortran::parser::OmpScheduleClause::ScheduleType::Runtime: scheduleKind = mlir::omp::ClauseScheduleKind::Runtime; break; } mlir::omp::ScheduleModifier scheduleModifier = getScheduleModifier(scheduleClause->v); if (scheduleModifier != mlir::omp::ScheduleModifier::none) modifierAttr = mlir::omp::ScheduleModifierAttr::get(context, scheduleModifier); if (getSimdModifier(scheduleClause->v) != mlir::omp::ScheduleModifier::none) simdModifierAttr = firOpBuilder.getUnitAttr(); valAttr = mlir::omp::ClauseScheduleKindAttr::get(context, scheduleKind); return true; } return false; } bool ClauseProcessor::processScheduleChunk( Fortran::lower::StatementContext &stmtCtx, mlir::Value &result) const { if (auto *scheduleClause = findUniqueClause()) { if (const auto &chunkExpr = std::get>( scheduleClause->v.t)) { if (const auto *expr = Fortran::semantics::GetExpr(*chunkExpr)) { result = fir::getBase(converter.genExprValue(*expr, stmtCtx)); } } return true; } return false; } bool ClauseProcessor::processSimdlen(mlir::IntegerAttr &result) const { if (auto *simdlenClause = findUniqueClause()) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); const auto *expr = Fortran::semantics::GetExpr(simdlenClause->v); const std::optional simdlenVal = Fortran::evaluate::ToInt64(*expr); result = firOpBuilder.getI64IntegerAttr(*simdlenVal); return true; } return false; } bool ClauseProcessor::processThreadLimit( Fortran::lower::StatementContext &stmtCtx, mlir::Value &result) const { if (auto *threadLmtClause = findUniqueClause()) { result = fir::getBase(converter.genExprValue( *Fortran::semantics::GetExpr(threadLmtClause->v), stmtCtx)); return true; } return false; } bool ClauseProcessor::processUntied(mlir::UnitAttr &result) const { return markClauseOccurrence(result); } //===----------------------------------------------------------------------===// // ClauseProcessor repeatable clauses //===----------------------------------------------------------------------===// bool ClauseProcessor::processAllocate( llvm::SmallVectorImpl &allocatorOperands, llvm::SmallVectorImpl &allocateOperands) const { return findRepeatableClause( [&](const ClauseTy::Allocate *allocateClause, const Fortran::parser::CharBlock &) { genAllocateClause(converter, allocateClause->v, allocatorOperands, allocateOperands); }); } bool ClauseProcessor::processCopyin() const { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); mlir::OpBuilder::InsertPoint insPt = firOpBuilder.saveInsertionPoint(); firOpBuilder.setInsertionPointToStart(firOpBuilder.getAllocaBlock()); auto checkAndCopyHostAssociateVar = [&](Fortran::semantics::Symbol *sym, mlir::OpBuilder::InsertPoint *copyAssignIP = nullptr) { assert(sym->has() && "No host-association found"); if (converter.isPresentShallowLookup(*sym)) converter.copyHostAssociateVar(*sym, copyAssignIP); }; bool hasCopyin = findRepeatableClause( [&](const ClauseTy::Copyin *copyinClause, const Fortran::parser::CharBlock &) { const Fortran::parser::OmpObjectList &ompObjectList = copyinClause->v; for (const Fortran::parser::OmpObject &ompObject : ompObjectList.v) { Fortran::semantics::Symbol *sym = getOmpObjectSymbol(ompObject); if (const auto *commonDetails = sym->detailsIf()) { for (const auto &mem : commonDetails->objects()) checkAndCopyHostAssociateVar(&*mem, &insPt); break; } if (Fortran::semantics::IsAllocatableOrObjectPointer( &sym->GetUltimate())) TODO(converter.getCurrentLocation(), "pointer or allocatable variables in Copyin clause"); assert(sym->has() && "No host-association found"); checkAndCopyHostAssociateVar(sym); } }); // [OMP 5.0, 2.19.6.1] The copy is done after the team is formed and prior to // the execution of the associated structured block. Emit implicit barrier to // synchronize threads and avoid data races on propagation master's thread // values of threadprivate variables to local instances of that variables of // all other implicit threads. if (hasCopyin) firOpBuilder.create(converter.getCurrentLocation()); firOpBuilder.restoreInsertionPoint(insPt); return hasCopyin; } bool ClauseProcessor::processDepend( llvm::SmallVectorImpl &dependTypeOperands, llvm::SmallVectorImpl &dependOperands) const { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); return findRepeatableClause( [&](const ClauseTy::Depend *dependClause, const Fortran::parser::CharBlock &) { const std::list &depVal = std::get>( std::get( dependClause->v.u) .t); mlir::omp::ClauseTaskDependAttr dependTypeOperand = genDependKindAttr(firOpBuilder, dependClause); dependTypeOperands.insert(dependTypeOperands.end(), depVal.size(), dependTypeOperand); for (const Fortran::parser::Designator &ompObject : depVal) { Fortran::semantics::Symbol *sym = nullptr; std::visit( Fortran::common::visitors{ [&](const Fortran::parser::DataRef &designator) { if (const Fortran::parser::Name *name = std::get_if(&designator.u)) { sym = name->symbol; } else if (std::get_if>( &designator.u)) { TODO(converter.getCurrentLocation(), "array sections not supported for task depend"); } }, [&](const Fortran::parser::Substring &designator) { TODO(converter.getCurrentLocation(), "substring not supported for task depend"); }}, (ompObject).u); const mlir::Value variable = converter.getSymbolAddress(*sym); dependOperands.push_back(variable); } }); } bool ClauseProcessor::processIf( Fortran::parser::OmpIfClause::DirectiveNameModifier directiveName, mlir::Value &result) const { bool found = false; findRepeatableClause( [&](const ClauseTy::If *ifClause, const Fortran::parser::CharBlock &source) { mlir::Location clauseLocation = converter.genLocation(source); mlir::Value operand = getIfClauseOperand(converter, ifClause, directiveName, clauseLocation); // Assume that, at most, a single 'if' clause will be applicable to the // given directive. if (operand) { result = operand; found = true; } }); return found; } bool ClauseProcessor::processLink( llvm::SmallVectorImpl &result) const { return findRepeatableClause( [&](const ClauseTy::Link *linkClause, const Fortran::parser::CharBlock &) { // Case: declare target link(var1, var2)... gatherFuncAndVarSyms( linkClause->v, mlir::omp::DeclareTargetCaptureClause::link, result); }); } static mlir::omp::MapInfoOp createMapInfoOp(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value baseAddr, std::stringstream &name, mlir::SmallVector bounds, uint64_t mapType, mlir::omp::VariableCaptureKind mapCaptureType, mlir::Type retTy) { mlir::Value varPtr, varPtrPtr; mlir::TypeAttr varType; if (auto boxTy = baseAddr.getType().dyn_cast()) { baseAddr = builder.create(loc, baseAddr); retTy = baseAddr.getType(); } varPtr = baseAddr; varType = mlir::TypeAttr::get( llvm::cast(retTy).getElementType()); mlir::omp::MapInfoOp op = builder.create( loc, retTy, varPtr, varType, varPtrPtr, bounds, builder.getIntegerAttr(builder.getIntegerType(64, false), mapType), builder.getAttr(mapCaptureType), builder.getStringAttr(name.str())); return op; } bool ClauseProcessor::processMap( mlir::Location currentLocation, const llvm::omp::Directive &directive, Fortran::semantics::SemanticsContext &semanticsContext, Fortran::lower::StatementContext &stmtCtx, llvm::SmallVectorImpl &mapOperands, llvm::SmallVectorImpl *mapSymTypes, llvm::SmallVectorImpl *mapSymLocs, llvm::SmallVectorImpl *mapSymbols) const { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); return findRepeatableClause( [&](const ClauseTy::Map *mapClause, const Fortran::parser::CharBlock &source) { mlir::Location clauseLocation = converter.genLocation(source); const auto &oMapType = std::get>( mapClause->v.t); llvm::omp::OpenMPOffloadMappingFlags mapTypeBits = llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_NONE; // If the map type is specified, then process it else Tofrom is the // default. if (oMapType) { const Fortran::parser::OmpMapType::Type &mapType = std::get(oMapType->t); switch (mapType) { case Fortran::parser::OmpMapType::Type::To: mapTypeBits |= llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_TO; break; case Fortran::parser::OmpMapType::Type::From: mapTypeBits |= llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_FROM; break; case Fortran::parser::OmpMapType::Type::Tofrom: mapTypeBits |= llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_TO | llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_FROM; break; case Fortran::parser::OmpMapType::Type::Alloc: case Fortran::parser::OmpMapType::Type::Release: // alloc and release is the default map_type for the Target Data // Ops, i.e. if no bits for map_type is supplied then alloc/release // is implicitly assumed based on the target directive. Default // value for Target Data and Enter Data is alloc and for Exit Data // it is release. break; case Fortran::parser::OmpMapType::Type::Delete: mapTypeBits |= llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_DELETE; } if (std::get>( oMapType->t)) mapTypeBits |= llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_ALWAYS; } else { mapTypeBits |= llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_TO | llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_FROM; } for (const Fortran::parser::OmpObject &ompObject : std::get(mapClause->v.t).v) { llvm::SmallVector bounds; std::stringstream asFortran; Fortran::lower::AddrAndBoundsInfo info = Fortran::lower::gatherDataOperandAddrAndBounds< Fortran::parser::OmpObject, mlir::omp::DataBoundsOp, mlir::omp::DataBoundsType>( converter, firOpBuilder, semanticsContext, stmtCtx, ompObject, clauseLocation, asFortran, bounds, treatIndexAsSection); // Explicit map captures are captured ByRef by default, // optimisation passes may alter this to ByCopy or other capture // types to optimise mlir::Value mapOp = createMapInfoOp( firOpBuilder, clauseLocation, info.addr, asFortran, bounds, static_cast< std::underlying_type_t>( mapTypeBits), mlir::omp::VariableCaptureKind::ByRef, info.addr.getType()); mapOperands.push_back(mapOp); if (mapSymTypes) mapSymTypes->push_back(info.addr.getType()); if (mapSymLocs) mapSymLocs->push_back(info.addr.getLoc()); if (mapSymbols) mapSymbols->push_back(getOmpObjectSymbol(ompObject)); } }); } bool ClauseProcessor::processReduction( mlir::Location currentLocation, llvm::SmallVectorImpl &reductionVars, llvm::SmallVectorImpl &reductionDeclSymbols) const { return findRepeatableClause( [&](const ClauseTy::Reduction *reductionClause, const Fortran::parser::CharBlock &) { ReductionProcessor rp; rp.addReductionDecl(currentLocation, converter, reductionClause->v, reductionVars, reductionDeclSymbols); }); } bool ClauseProcessor::processSectionsReduction( mlir::Location currentLocation) const { return findRepeatableClause( [&](const ClauseTy::Reduction *, const Fortran::parser::CharBlock &) { TODO(currentLocation, "OMPC_Reduction"); }); } bool ClauseProcessor::processTo( llvm::SmallVectorImpl &result) const { return findRepeatableClause( [&](const ClauseTy::To *toClause, const Fortran::parser::CharBlock &) { // Case: declare target to(func, var1, var2)... gatherFuncAndVarSyms(toClause->v, mlir::omp::DeclareTargetCaptureClause::to, result); }); } bool ClauseProcessor::processEnter( llvm::SmallVectorImpl &result) const { return findRepeatableClause( [&](const ClauseTy::Enter *enterClause, const Fortran::parser::CharBlock &) { // Case: declare target enter(func, var1, var2)... gatherFuncAndVarSyms(enterClause->v, mlir::omp::DeclareTargetCaptureClause::enter, result); }); } bool ClauseProcessor::processUseDeviceAddr( llvm::SmallVectorImpl &operands, llvm::SmallVectorImpl &useDeviceTypes, llvm::SmallVectorImpl &useDeviceLocs, llvm::SmallVectorImpl &useDeviceSymbols) const { return findRepeatableClause( [&](const ClauseTy::UseDeviceAddr *devAddrClause, const Fortran::parser::CharBlock &) { addUseDeviceClause(converter, devAddrClause->v, operands, useDeviceTypes, useDeviceLocs, useDeviceSymbols); }); } bool ClauseProcessor::processUseDevicePtr( llvm::SmallVectorImpl &operands, llvm::SmallVectorImpl &useDeviceTypes, llvm::SmallVectorImpl &useDeviceLocs, llvm::SmallVectorImpl &useDeviceSymbols) const { return findRepeatableClause( [&](const ClauseTy::UseDevicePtr *devPtrClause, const Fortran::parser::CharBlock &) { addUseDeviceClause(converter, devPtrClause->v, operands, useDeviceTypes, useDeviceLocs, useDeviceSymbols); }); } template bool ClauseProcessor::processMotionClauses( Fortran::semantics::SemanticsContext &semanticsContext, Fortran::lower::StatementContext &stmtCtx, llvm::SmallVectorImpl &mapOperands) { return findRepeatableClause( [&](const T *motionClause, const Fortran::parser::CharBlock &source) { mlir::Location clauseLocation = converter.genLocation(source); fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); static_assert(std::is_same_v || std::is_same_v); // TODO Support motion modifiers: present, mapper, iterator. constexpr llvm::omp::OpenMPOffloadMappingFlags mapTypeBits = std::is_same_v ? llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_TO : llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_FROM; for (const Fortran::parser::OmpObject &ompObject : motionClause->v.v) { llvm::SmallVector bounds; std::stringstream asFortran; Fortran::lower::AddrAndBoundsInfo info = Fortran::lower::gatherDataOperandAddrAndBounds< Fortran::parser::OmpObject, mlir::omp::DataBoundsOp, mlir::omp::DataBoundsType>( converter, firOpBuilder, semanticsContext, stmtCtx, ompObject, clauseLocation, asFortran, bounds, treatIndexAsSection); mlir::Value mapOp = createMapInfoOp( firOpBuilder, clauseLocation, info.addr, asFortran, bounds, static_cast< std::underlying_type_t>( mapTypeBits), mlir::omp::VariableCaptureKind::ByRef, info.addr.getType()); mapOperands.push_back(mapOp); } }); } template void ClauseProcessor::processTODO(mlir::Location currentLocation, llvm::omp::Directive directive) const { auto checkUnhandledClause = [&](const auto *x) { if (!x) return; TODO(currentLocation, "Unhandled clause " + llvm::StringRef(Fortran::parser::ParseTreeDumper::GetNodeName(*x)) .upper() + " in " + llvm::omp::getOpenMPDirectiveName(directive).upper() + " construct"); }; for (ClauseIterator it = clauses.v.begin(); it != clauses.v.end(); ++it) (checkUnhandledClause(std::get_if(&it->u)), ...); } //===----------------------------------------------------------------------===// // Code generation helper functions //===----------------------------------------------------------------------===// static fir::GlobalOp globalInitialization( Fortran::lower::AbstractConverter &converter, fir::FirOpBuilder &firOpBuilder, const Fortran::semantics::Symbol &sym, const Fortran::lower::pft::Variable &var, mlir::Location currentLocation) { mlir::Type ty = converter.genType(sym); std::string globalName = converter.mangleName(sym); mlir::StringAttr linkage = firOpBuilder.createInternalLinkage(); fir::GlobalOp global = firOpBuilder.createGlobal(currentLocation, ty, globalName, linkage); // Create default initialization for non-character scalar. if (Fortran::semantics::IsAllocatableOrObjectPointer(&sym)) { mlir::Type baseAddrType = ty.dyn_cast().getEleTy(); Fortran::lower::createGlobalInitialization( firOpBuilder, global, [&](fir::FirOpBuilder &b) { mlir::Value nullAddr = b.createNullConstant(currentLocation, baseAddrType); mlir::Value box = b.create(currentLocation, ty, nullAddr); b.create(currentLocation, box); }); } else { Fortran::lower::createGlobalInitialization( firOpBuilder, global, [&](fir::FirOpBuilder &b) { mlir::Value undef = b.create(currentLocation, ty); b.create(currentLocation, undef); }); } return global; } static mlir::Operation *getCompareFromReductionOp(mlir::Operation *reductionOp, mlir::Value loadVal) { for (mlir::Value reductionOperand : reductionOp->getOperands()) { if (mlir::Operation *compareOp = reductionOperand.getDefiningOp()) { if (compareOp->getOperand(0) == loadVal || compareOp->getOperand(1) == loadVal) assert((mlir::isa(compareOp) || mlir::isa(compareOp)) && "Expected comparison not found in reduction intrinsic"); return compareOp; } } return nullptr; } // Get the extended value for \p val by extracting additional variable // information from \p base. static fir::ExtendedValue getExtendedValue(fir::ExtendedValue base, mlir::Value val) { return base.match( [&](const fir::MutableBoxValue &box) -> fir::ExtendedValue { return fir::MutableBoxValue(val, box.nonDeferredLenParams(), {}); }, [&](const auto &) -> fir::ExtendedValue { return fir::substBase(base, val); }); } static void threadPrivatizeVars(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); mlir::Location currentLocation = converter.getCurrentLocation(); mlir::OpBuilder::InsertPoint insPt = firOpBuilder.saveInsertionPoint(); firOpBuilder.setInsertionPointToStart(firOpBuilder.getAllocaBlock()); // Get the original ThreadprivateOp corresponding to the symbol and use the // symbol value from that operation to create one ThreadprivateOp copy // operation inside the parallel region. auto genThreadprivateOp = [&](Fortran::lower::SymbolRef sym) -> mlir::Value { mlir::Value symOriThreadprivateValue = converter.getSymbolAddress(sym); mlir::Operation *op = symOriThreadprivateValue.getDefiningOp(); if (auto declOp = mlir::dyn_cast(op)) op = declOp.getMemref().getDefiningOp(); assert(mlir::isa(op) && "Threadprivate operation not created"); mlir::Value symValue = mlir::dyn_cast(op).getSymAddr(); return firOpBuilder.create( currentLocation, symValue.getType(), symValue); }; llvm::SetVector threadprivateSyms; converter.collectSymbolSet( eval, threadprivateSyms, Fortran::semantics::Symbol::Flag::OmpThreadprivate); std::set threadprivateSymNames; // For a COMMON block, the ThreadprivateOp is generated for itself instead of // its members, so only bind the value of the new copied ThreadprivateOp // inside the parallel region to the common block symbol only once for // multiple members in one COMMON block. llvm::SetVector commonSyms; for (std::size_t i = 0; i < threadprivateSyms.size(); i++) { const Fortran::semantics::Symbol *sym = threadprivateSyms[i]; mlir::Value symThreadprivateValue; // The variable may be used more than once, and each reference has one // symbol with the same name. Only do once for references of one variable. if (threadprivateSymNames.find(sym->name()) != threadprivateSymNames.end()) continue; threadprivateSymNames.insert(sym->name()); if (const Fortran::semantics::Symbol *common = Fortran::semantics::FindCommonBlockContaining(sym->GetUltimate())) { mlir::Value commonThreadprivateValue; if (commonSyms.contains(common)) { commonThreadprivateValue = converter.getSymbolAddress(*common); } else { commonThreadprivateValue = genThreadprivateOp(*common); converter.bindSymbol(*common, commonThreadprivateValue); commonSyms.insert(common); } symThreadprivateValue = Fortran::lower::genCommonBlockMember( converter, currentLocation, *sym, commonThreadprivateValue); } else { symThreadprivateValue = genThreadprivateOp(*sym); } fir::ExtendedValue sexv = converter.getSymbolExtendedValue(*sym); fir::ExtendedValue symThreadprivateExv = getExtendedValue(sexv, symThreadprivateValue); converter.bindSymbol(*sym, symThreadprivateExv); } firOpBuilder.restoreInsertionPoint(insPt); } static mlir::Type getLoopVarType(Fortran::lower::AbstractConverter &converter, std::size_t loopVarTypeSize) { // OpenMP runtime requires 32-bit or 64-bit loop variables. loopVarTypeSize = loopVarTypeSize * 8; if (loopVarTypeSize < 32) { loopVarTypeSize = 32; } else if (loopVarTypeSize > 64) { loopVarTypeSize = 64; mlir::emitWarning(converter.getCurrentLocation(), "OpenMP loop iteration variable cannot have more than 64 " "bits size and will be narrowed into 64 bits."); } assert((loopVarTypeSize == 32 || loopVarTypeSize == 64) && "OpenMP loop iteration variable size must be transformed into 32-bit " "or 64-bit"); return converter.getFirOpBuilder().getIntegerType(loopVarTypeSize); } static mlir::Operation * createAndSetPrivatizedLoopVar(Fortran::lower::AbstractConverter &converter, mlir::Location loc, mlir::Value indexVal, const Fortran::semantics::Symbol *sym) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); mlir::OpBuilder::InsertPoint insPt = firOpBuilder.saveInsertionPoint(); firOpBuilder.setInsertionPointToStart(firOpBuilder.getAllocaBlock()); mlir::Type tempTy = converter.genType(*sym); mlir::Value temp = firOpBuilder.create( loc, tempTy, /*pinned=*/true, /*lengthParams=*/mlir::ValueRange{}, /*shapeParams*/ mlir::ValueRange{}, llvm::ArrayRef{ fir::getAdaptToByRefAttr(firOpBuilder)}); converter.bindSymbol(*sym, temp); firOpBuilder.restoreInsertionPoint(insPt); mlir::Value cvtVal = firOpBuilder.createConvert(loc, tempTy, indexVal); mlir::Operation *storeOp = firOpBuilder.create( loc, cvtVal, converter.getSymbolAddress(*sym)); return storeOp; } /// Create the body (block) for an OpenMP Operation. /// /// \param [in] op - the operation the body belongs to. /// \param [inout] converter - converter to use for the clauses. /// \param [in] loc - location in source code. /// \param [in] eval - current PFT node/evaluation. /// \param [in] genNested - whether to generate FIR for nested evaluations /// \oaran [in] clauses - list of clauses to process. /// \param [in] args - block arguments (induction variable[s]) for the //// region. /// \param [in] outerCombined - is this an outer operation - prevents /// privatization. template static void createBodyOfOp( Op &op, Fortran::lower::AbstractConverter &converter, mlir::Location &loc, Fortran::lower::pft::Evaluation &eval, bool genNested, const Fortran::parser::OmpClauseList *clauses = nullptr, const llvm::SmallVector &args = {}, bool outerCombined = false, DataSharingProcessor *dsp = nullptr) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); auto insertMarker = [](fir::FirOpBuilder &builder) { mlir::Value undef = builder.create(builder.getUnknownLoc(), builder.getIndexType()); return undef.getDefiningOp(); }; // If an argument for the region is provided then create the block with that // argument. Also update the symbol's address with the mlir argument value. // e.g. For loops the argument is the induction variable. And all further // uses of the induction variable should use this mlir value. if (args.size()) { std::size_t loopVarTypeSize = 0; for (const Fortran::semantics::Symbol *arg : args) loopVarTypeSize = std::max(loopVarTypeSize, arg->GetUltimate().size()); mlir::Type loopVarType = getLoopVarType(converter, loopVarTypeSize); llvm::SmallVector tiv(args.size(), loopVarType); llvm::SmallVector locs(args.size(), loc); firOpBuilder.createBlock(&op.getRegion(), {}, tiv, locs); // The argument is not currently in memory, so make a temporary for the // argument, and store it there, then bind that location to the argument. mlir::Operation *storeOp = nullptr; for (auto [argIndex, argSymbol] : llvm::enumerate(args)) { mlir::Value indexVal = fir::getBase(op.getRegion().front().getArgument(argIndex)); storeOp = createAndSetPrivatizedLoopVar(converter, loc, indexVal, argSymbol); } firOpBuilder.setInsertionPointAfter(storeOp); } else { firOpBuilder.createBlock(&op.getRegion()); } // Mark the earliest insertion point. mlir::Operation *marker = insertMarker(firOpBuilder); // If it is an unstructured region and is not the outer region of a combined // construct, create empty blocks for all evaluations. if (eval.lowerAsUnstructured() && !outerCombined) Fortran::lower::createEmptyRegionBlocks( firOpBuilder, eval.getNestedEvaluations()); // Start with privatization, so that the lowering of the nested // code will use the right symbols. constexpr bool isLoop = std::is_same_v || std::is_same_v; bool privatize = clauses && !outerCombined; firOpBuilder.setInsertionPoint(marker); std::optional tempDsp; if (privatize) { if (!dsp) { tempDsp.emplace(converter, *clauses, eval); tempDsp->processStep1(); } } if constexpr (std::is_same_v) { threadPrivatizeVars(converter, eval); if (clauses) { firOpBuilder.setInsertionPoint(marker); ClauseProcessor(converter, *clauses).processCopyin(); } } if (genNested) { // genFIR(Evaluation&) tries to patch up unterminated blocks, causing // a lot of complications for our approach if the terminator generation // is delayed past this point. Insert a temporary terminator here, then // delete it. firOpBuilder.setInsertionPointToEnd(&op.getRegion().back()); auto *temp = Fortran::lower::genOpenMPTerminator(firOpBuilder, op.getOperation(), loc); firOpBuilder.setInsertionPointAfter(marker); genNestedEvaluations(converter, eval); temp->erase(); } // Get or create a unique exiting block from the given region, or // return nullptr if there is no exiting block. auto getUniqueExit = [&](mlir::Region ®ion) -> mlir::Block * { // Find the blocks where the OMP terminator should go. In simple cases // it is the single block in the operation's region. When the region // is more complicated, especially with unstructured control flow, there // may be multiple blocks, and some of them may have non-OMP terminators // resulting from lowering of the code contained within the operation. // All the remaining blocks are potential exit points from the op's region. // // Explicit control flow cannot exit any OpenMP region (other than via // STOP), and that is enforced by semantic checks prior to lowering. STOP // statements are lowered to a function call. // Collect unterminated blocks. llvm::SmallVector exits; for (mlir::Block &b : region) { if (b.empty() || !b.back().hasTrait()) exits.push_back(&b); } if (exits.empty()) return nullptr; // If there already is a unique exiting block, do not create another one. // Additionally, some ops (e.g. omp.sections) require only 1 block in // its region. if (exits.size() == 1) return exits[0]; mlir::Block *exit = firOpBuilder.createBlock(®ion); for (mlir::Block *b : exits) { firOpBuilder.setInsertionPointToEnd(b); firOpBuilder.create(loc, exit); } return exit; }; if (auto *exitBlock = getUniqueExit(op.getRegion())) { firOpBuilder.setInsertionPointToEnd(exitBlock); auto *term = Fortran::lower::genOpenMPTerminator(firOpBuilder, op.getOperation(), loc); // Only insert lastprivate code when there actually is an exit block. // Such a block may not exist if the nested code produced an infinite // loop (this may not make sense in production code, but a user could // write that and we should handle it). firOpBuilder.setInsertionPoint(term); if (privatize) { if (!dsp) { assert(tempDsp.has_value()); tempDsp->processStep2(op, isLoop); } else { if (isLoop && args.size() > 0) dsp->setLoopIV(converter.getSymbolAddress(*args[0])); dsp->processStep2(op, isLoop); } } } firOpBuilder.setInsertionPointAfter(marker); marker->erase(); } static void genBodyOfTargetDataOp( Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, bool genNested, mlir::omp::DataOp &dataOp, const llvm::SmallVector &useDeviceTypes, const llvm::SmallVector &useDeviceLocs, const llvm::SmallVector &useDeviceSymbols, const mlir::Location ¤tLocation) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); mlir::Region ®ion = dataOp.getRegion(); firOpBuilder.createBlock(®ion, {}, useDeviceTypes, useDeviceLocs); for (auto [argIndex, argSymbol] : llvm::enumerate(useDeviceSymbols)) { const mlir::BlockArgument &arg = region.front().getArgument(argIndex); fir::ExtendedValue extVal = converter.getSymbolExtendedValue(*argSymbol); if (auto refType = arg.getType().dyn_cast()) { if (fir::isa_builtin_cptr_type(refType.getElementType())) { converter.bindSymbol(*argSymbol, arg); } else { // Avoid capture of a reference to a structured binding. const Fortran::semantics::Symbol *sym = argSymbol; extVal.match( [&](const fir::MutableBoxValue &mbv) { converter.bindSymbol( *sym, fir::MutableBoxValue( arg, fir::factory::getNonDeferredLenParams(extVal), {})); }, [&](const auto &) { TODO(converter.getCurrentLocation(), "use_device clause operand unsupported type"); }); } } else { TODO(converter.getCurrentLocation(), "use_device clause operand unsupported type"); } } // Insert dummy instruction to remember the insertion position. The // marker will be deleted by clean up passes since there are no uses. // Remembering the position for further insertion is important since // there are hlfir.declares inserted above while setting block arguments // and new code from the body should be inserted after that. mlir::Value undefMarker = firOpBuilder.create( dataOp.getOperation()->getLoc(), firOpBuilder.getIndexType()); // Create blocks for unstructured regions. This has to be done since // blocks are initially allocated with the function as the parent region. if (eval.lowerAsUnstructured()) { Fortran::lower::createEmptyRegionBlocks( firOpBuilder, eval.getNestedEvaluations()); } firOpBuilder.create(currentLocation); // Set the insertion point after the marker. firOpBuilder.setInsertionPointAfter(undefMarker.getDefiningOp()); if (genNested) genNestedEvaluations(converter, eval); } template static OpTy genOpWithBody(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, bool genNested, mlir::Location currentLocation, bool outerCombined, const Fortran::parser::OmpClauseList *clauseList, Args &&...args) { auto op = converter.getFirOpBuilder().create( currentLocation, std::forward(args)...); createBodyOfOp(op, converter, currentLocation, eval, genNested, clauseList, /*args=*/{}, outerCombined); return op; } static mlir::omp::MasterOp genMasterOp(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, bool genNested, mlir::Location currentLocation) { return genOpWithBody(converter, eval, genNested, currentLocation, /*outerCombined=*/false, /*clauseList=*/nullptr, /*resultTypes=*/mlir::TypeRange()); } static mlir::omp::OrderedRegionOp genOrderedRegionOp(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, bool genNested, mlir::Location currentLocation) { return genOpWithBody( converter, eval, genNested, currentLocation, /*outerCombined=*/false, /*clauseList=*/nullptr, /*simd=*/false); } static mlir::omp::ParallelOp genParallelOp(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, bool genNested, mlir::Location currentLocation, const Fortran::parser::OmpClauseList &clauseList, bool outerCombined = false) { Fortran::lower::StatementContext stmtCtx; mlir::Value ifClauseOperand, numThreadsClauseOperand; mlir::omp::ClauseProcBindKindAttr procBindKindAttr; llvm::SmallVector allocateOperands, allocatorOperands, reductionVars; llvm::SmallVector reductionDeclSymbols; ClauseProcessor cp(converter, clauseList); cp.processIf(Fortran::parser::OmpIfClause::DirectiveNameModifier::Parallel, ifClauseOperand); cp.processNumThreads(stmtCtx, numThreadsClauseOperand); cp.processProcBind(procBindKindAttr); cp.processDefault(); cp.processAllocate(allocatorOperands, allocateOperands); if (!outerCombined) cp.processReduction(currentLocation, reductionVars, reductionDeclSymbols); return genOpWithBody( converter, eval, genNested, currentLocation, outerCombined, &clauseList, /*resultTypes=*/mlir::TypeRange(), ifClauseOperand, numThreadsClauseOperand, allocateOperands, allocatorOperands, reductionVars, reductionDeclSymbols.empty() ? nullptr : mlir::ArrayAttr::get(converter.getFirOpBuilder().getContext(), reductionDeclSymbols), procBindKindAttr); } static mlir::omp::SectionOp genSectionOp(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, bool genNested, mlir::Location currentLocation, const Fortran::parser::OmpClauseList §ionsClauseList) { // Currently only private/firstprivate clause is handled, and // all privatization is done within `omp.section` operations. return genOpWithBody( converter, eval, genNested, currentLocation, /*outerCombined=*/false, §ionsClauseList); } static mlir::omp::SingleOp genSingleOp(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, bool genNested, mlir::Location currentLocation, const Fortran::parser::OmpClauseList &beginClauseList, const Fortran::parser::OmpClauseList &endClauseList) { llvm::SmallVector allocateOperands, allocatorOperands; mlir::UnitAttr nowaitAttr; ClauseProcessor cp(converter, beginClauseList); cp.processAllocate(allocatorOperands, allocateOperands); cp.processTODO( currentLocation, llvm::omp::Directive::OMPD_single); ClauseProcessor(converter, endClauseList).processNowait(nowaitAttr); return genOpWithBody( converter, eval, genNested, currentLocation, /*outerCombined=*/false, &beginClauseList, allocateOperands, allocatorOperands, nowaitAttr); } static mlir::omp::TaskOp genTaskOp(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, bool genNested, mlir::Location currentLocation, const Fortran::parser::OmpClauseList &clauseList) { Fortran::lower::StatementContext stmtCtx; mlir::Value ifClauseOperand, finalClauseOperand, priorityClauseOperand; mlir::UnitAttr untiedAttr, mergeableAttr; llvm::SmallVector dependTypeOperands; llvm::SmallVector allocateOperands, allocatorOperands, dependOperands; ClauseProcessor cp(converter, clauseList); cp.processIf(Fortran::parser::OmpIfClause::DirectiveNameModifier::Task, ifClauseOperand); cp.processAllocate(allocatorOperands, allocateOperands); cp.processDefault(); cp.processFinal(stmtCtx, finalClauseOperand); cp.processUntied(untiedAttr); cp.processMergeable(mergeableAttr); cp.processPriority(stmtCtx, priorityClauseOperand); cp.processDepend(dependTypeOperands, dependOperands); cp.processTODO( currentLocation, llvm::omp::Directive::OMPD_task); return genOpWithBody( converter, eval, genNested, currentLocation, /*outerCombined=*/false, &clauseList, ifClauseOperand, finalClauseOperand, untiedAttr, mergeableAttr, /*in_reduction_vars=*/mlir::ValueRange(), /*in_reductions=*/nullptr, priorityClauseOperand, dependTypeOperands.empty() ? nullptr : mlir::ArrayAttr::get(converter.getFirOpBuilder().getContext(), dependTypeOperands), dependOperands, allocateOperands, allocatorOperands); } static mlir::omp::TaskGroupOp genTaskGroupOp(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, bool genNested, mlir::Location currentLocation, const Fortran::parser::OmpClauseList &clauseList) { llvm::SmallVector allocateOperands, allocatorOperands; ClauseProcessor cp(converter, clauseList); cp.processAllocate(allocatorOperands, allocateOperands); cp.processTODO( currentLocation, llvm::omp::Directive::OMPD_taskgroup); return genOpWithBody( converter, eval, genNested, currentLocation, /*outerCombined=*/false, &clauseList, /*task_reduction_vars=*/mlir::ValueRange(), /*task_reductions=*/nullptr, allocateOperands, allocatorOperands); } static mlir::omp::DataOp genDataOp(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, Fortran::semantics::SemanticsContext &semanticsContext, bool genNested, mlir::Location currentLocation, const Fortran::parser::OmpClauseList &clauseList) { Fortran::lower::StatementContext stmtCtx; mlir::Value ifClauseOperand, deviceOperand; llvm::SmallVector mapOperands, devicePtrOperands, deviceAddrOperands; llvm::SmallVector useDeviceTypes; llvm::SmallVector useDeviceLocs; llvm::SmallVector useDeviceSymbols; ClauseProcessor cp(converter, clauseList); cp.processIf(Fortran::parser::OmpIfClause::DirectiveNameModifier::TargetData, ifClauseOperand); cp.processDevice(stmtCtx, deviceOperand); cp.processUseDevicePtr(devicePtrOperands, useDeviceTypes, useDeviceLocs, useDeviceSymbols); cp.processUseDeviceAddr(deviceAddrOperands, useDeviceTypes, useDeviceLocs, useDeviceSymbols); cp.processMap(currentLocation, llvm::omp::Directive::OMPD_target_data, semanticsContext, stmtCtx, mapOperands); auto dataOp = converter.getFirOpBuilder().create( currentLocation, ifClauseOperand, deviceOperand, devicePtrOperands, deviceAddrOperands, mapOperands); genBodyOfTargetDataOp(converter, eval, genNested, dataOp, useDeviceTypes, useDeviceLocs, useDeviceSymbols, currentLocation); return dataOp; } template static OpTy genEnterExitUpdateDataOp(Fortran::lower::AbstractConverter &converter, Fortran::semantics::SemanticsContext &semanticsContext, mlir::Location currentLocation, const Fortran::parser::OmpClauseList &clauseList) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); Fortran::lower::StatementContext stmtCtx; mlir::Value ifClauseOperand, deviceOperand; mlir::UnitAttr nowaitAttr; llvm::SmallVector mapOperands; Fortran::parser::OmpIfClause::DirectiveNameModifier directiveName; llvm::omp::Directive directive; if constexpr (std::is_same_v) { directiveName = Fortran::parser::OmpIfClause::DirectiveNameModifier::TargetEnterData; directive = llvm::omp::Directive::OMPD_target_enter_data; } else if constexpr (std::is_same_v) { directiveName = Fortran::parser::OmpIfClause::DirectiveNameModifier::TargetExitData; directive = llvm::omp::Directive::OMPD_target_exit_data; } else if constexpr (std::is_same_v) { directiveName = Fortran::parser::OmpIfClause::DirectiveNameModifier::TargetUpdate; directive = llvm::omp::Directive::OMPD_target_update; } else { return nullptr; } ClauseProcessor cp(converter, clauseList); cp.processIf(directiveName, ifClauseOperand); cp.processDevice(stmtCtx, deviceOperand); cp.processNowait(nowaitAttr); if constexpr (std::is_same_v) { cp.processMotionClauses( semanticsContext, stmtCtx, mapOperands); cp.processMotionClauses( semanticsContext, stmtCtx, mapOperands); } else { cp.processMap(currentLocation, directive, semanticsContext, stmtCtx, mapOperands); } cp.processTODO(currentLocation, directive); return firOpBuilder.create(currentLocation, ifClauseOperand, deviceOperand, nowaitAttr, mapOperands); } // This functions creates a block for the body of the targetOp's region. It adds // all the symbols present in mapSymbols as block arguments to this block. static void genBodyOfTargetOp( Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, bool genNested, mlir::omp::TargetOp &targetOp, const llvm::SmallVector &mapSymTypes, const llvm::SmallVector &mapSymLocs, const llvm::SmallVector &mapSymbols, const mlir::Location ¤tLocation) { assert(mapSymTypes.size() == mapSymLocs.size()); fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); mlir::Region ®ion = targetOp.getRegion(); auto *regionBlock = firOpBuilder.createBlock(®ion, {}, mapSymTypes, mapSymLocs); // Clones the `bounds` placing them inside the target region and returns them. auto cloneBound = [&](mlir::Value bound) { if (mlir::isMemoryEffectFree(bound.getDefiningOp())) { mlir::Operation *clonedOp = bound.getDefiningOp()->clone(); regionBlock->push_back(clonedOp); return clonedOp->getResult(0); } TODO(converter.getCurrentLocation(), "target map clause operand unsupported bound type"); }; auto cloneBounds = [cloneBound](llvm::ArrayRef bounds) { llvm::SmallVector clonedBounds; for (mlir::Value bound : bounds) clonedBounds.emplace_back(cloneBound(bound)); return clonedBounds; }; // Bind the symbols to their corresponding block arguments. for (auto [argIndex, argSymbol] : llvm::enumerate(mapSymbols)) { const mlir::BlockArgument &arg = region.getArgument(argIndex); // Avoid capture of a reference to a structured binding. const Fortran::semantics::Symbol *sym = argSymbol; fir::ExtendedValue extVal = converter.getSymbolExtendedValue(*sym); extVal.match( [&](const fir::BoxValue &v) { converter.bindSymbol(*sym, fir::BoxValue(arg, cloneBounds(v.getLBounds()), v.getExplicitParameters(), v.getExplicitExtents())); }, [&](const fir::MutableBoxValue &v) { converter.bindSymbol( *sym, fir::MutableBoxValue(arg, cloneBounds(v.getLBounds()), v.getMutableProperties())); }, [&](const fir::ArrayBoxValue &v) { converter.bindSymbol( *sym, fir::ArrayBoxValue(arg, cloneBounds(v.getExtents()), cloneBounds(v.getLBounds()), v.getSourceBox())); }, [&](const fir::CharArrayBoxValue &v) { converter.bindSymbol( *sym, fir::CharArrayBoxValue(arg, cloneBound(v.getLen()), cloneBounds(v.getExtents()), cloneBounds(v.getLBounds()))); }, [&](const fir::CharBoxValue &v) { converter.bindSymbol(*sym, fir::CharBoxValue(arg, cloneBound(v.getLen()))); }, [&](const fir::UnboxedValue &v) { converter.bindSymbol(*sym, arg); }, [&](const auto &) { TODO(converter.getCurrentLocation(), "target map clause operand unsupported type"); }); } // Check if cloning the bounds introduced any dependency on the outer region. // If so, then either clone them as well if they are MemoryEffectFree, or else // copy them to a new temporary and add them to the map and block_argument // lists and replace their uses with the new temporary. llvm::SetVector valuesDefinedAbove; mlir::getUsedValuesDefinedAbove(region, valuesDefinedAbove); while (!valuesDefinedAbove.empty()) { for (mlir::Value val : valuesDefinedAbove) { mlir::Operation *valOp = val.getDefiningOp(); if (mlir::isMemoryEffectFree(valOp)) { mlir::Operation *clonedOp = valOp->clone(); regionBlock->push_front(clonedOp); val.replaceUsesWithIf( clonedOp->getResult(0), [regionBlock](mlir::OpOperand &use) { return use.getOwner()->getBlock() == regionBlock; }); } else { auto savedIP = firOpBuilder.getInsertionPoint(); firOpBuilder.setInsertionPointAfter(valOp); auto copyVal = firOpBuilder.createTemporary(val.getLoc(), val.getType()); firOpBuilder.createStoreWithConvert(copyVal.getLoc(), val, copyVal); llvm::SmallVector bounds; std::stringstream name; firOpBuilder.setInsertionPoint(targetOp); mlir::Value mapOp = createMapInfoOp( firOpBuilder, copyVal.getLoc(), copyVal, name, bounds, static_cast< std::underlying_type_t>( llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_IMPLICIT), mlir::omp::VariableCaptureKind::ByCopy, copyVal.getType()); targetOp.getMapOperandsMutable().append(mapOp); mlir::Value clonedValArg = region.addArgument(copyVal.getType(), copyVal.getLoc()); firOpBuilder.setInsertionPointToStart(regionBlock); auto loadOp = firOpBuilder.create(clonedValArg.getLoc(), clonedValArg); val.replaceUsesWithIf( loadOp->getResult(0), [regionBlock](mlir::OpOperand &use) { return use.getOwner()->getBlock() == regionBlock; }); firOpBuilder.setInsertionPoint(regionBlock, savedIP); } } valuesDefinedAbove.clear(); mlir::getUsedValuesDefinedAbove(region, valuesDefinedAbove); } // Insert dummy instruction to remember the insertion position. The // marker will be deleted since there are not uses. // In the HLFIR flow there are hlfir.declares inserted above while // setting block arguments. mlir::Value undefMarker = firOpBuilder.create( targetOp.getOperation()->getLoc(), firOpBuilder.getIndexType()); // Create blocks for unstructured regions. This has to be done since // blocks are initially allocated with the function as the parent region. if (eval.lowerAsUnstructured()) { Fortran::lower::createEmptyRegionBlocks( firOpBuilder, eval.getNestedEvaluations()); } firOpBuilder.create(currentLocation); // Create the insertion point after the marker. firOpBuilder.setInsertionPointAfter(undefMarker.getDefiningOp()); if (genNested) genNestedEvaluations(converter, eval); } static mlir::omp::TargetOp genTargetOp(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, Fortran::semantics::SemanticsContext &semanticsContext, bool genNested, mlir::Location currentLocation, const Fortran::parser::OmpClauseList &clauseList, llvm::omp::Directive directive, bool outerCombined = false) { Fortran::lower::StatementContext stmtCtx; mlir::Value ifClauseOperand, deviceOperand, threadLimitOperand; mlir::UnitAttr nowaitAttr; llvm::SmallVector mapOperands; llvm::SmallVector mapSymTypes; llvm::SmallVector mapSymLocs; llvm::SmallVector mapSymbols; ClauseProcessor cp(converter, clauseList); cp.processIf(Fortran::parser::OmpIfClause::DirectiveNameModifier::Target, ifClauseOperand); cp.processDevice(stmtCtx, deviceOperand); cp.processThreadLimit(stmtCtx, threadLimitOperand); cp.processNowait(nowaitAttr); cp.processMap(currentLocation, directive, semanticsContext, stmtCtx, mapOperands, &mapSymTypes, &mapSymLocs, &mapSymbols); cp.processTODO( currentLocation, llvm::omp::Directive::OMPD_target); // 5.8.1 Implicit Data-Mapping Attribute Rules // The following code follows the implicit data-mapping rules to map all the // symbols used inside the region that have not been explicitly mapped using // the map clause. auto captureImplicitMap = [&](const Fortran::semantics::Symbol &sym) { if (llvm::find(mapSymbols, &sym) == mapSymbols.end()) { mlir::Value baseOp = converter.getSymbolAddress(sym); if (!baseOp) if (const auto *details = sym.template detailsIf< Fortran::semantics::HostAssocDetails>()) { baseOp = converter.getSymbolAddress(details->symbol()); converter.copySymbolBinding(details->symbol(), sym); } if (baseOp) { llvm::SmallVector bounds; std::stringstream name; fir::ExtendedValue dataExv = converter.getSymbolExtendedValue(sym); name << sym.name().ToString(); Fortran::lower::AddrAndBoundsInfo info = getDataOperandBaseAddr(converter, converter.getFirOpBuilder(), sym, converter.getCurrentLocation()); if (fir::unwrapRefType(info.addr.getType()).isa()) bounds = Fortran::lower::genBoundsOpsFromBox( converter.getFirOpBuilder(), converter.getCurrentLocation(), converter, dataExv, info); if (fir::unwrapRefType(info.addr.getType()).isa()) bounds = Fortran::lower::genBaseBoundsOps( converter.getFirOpBuilder(), converter.getCurrentLocation(), converter, dataExv); llvm::omp::OpenMPOffloadMappingFlags mapFlag = llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_IMPLICIT; mlir::omp::VariableCaptureKind captureKind = mlir::omp::VariableCaptureKind::ByRef; if (auto refType = baseOp.getType().dyn_cast()) { auto eleType = refType.getElementType(); if (fir::isa_trivial(eleType) || fir::isa_char(eleType)) { captureKind = mlir::omp::VariableCaptureKind::ByCopy; } else if (!fir::isa_builtin_cptr_type(eleType)) { mapFlag |= llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_TO; mapFlag |= llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_FROM; } } mlir::Value mapOp = createMapInfoOp( converter.getFirOpBuilder(), baseOp.getLoc(), baseOp, name, bounds, static_cast< std::underlying_type_t>( mapFlag), captureKind, baseOp.getType()); mapOperands.push_back(mapOp); mapSymTypes.push_back(baseOp.getType()); mapSymLocs.push_back(baseOp.getLoc()); mapSymbols.push_back(&sym); } } }; Fortran::lower::pft::visitAllSymbols(eval, captureImplicitMap); auto targetOp = converter.getFirOpBuilder().create( currentLocation, ifClauseOperand, deviceOperand, threadLimitOperand, nowaitAttr, mapOperands); genBodyOfTargetOp(converter, eval, genNested, targetOp, mapSymTypes, mapSymLocs, mapSymbols, currentLocation); return targetOp; } static mlir::omp::TeamsOp genTeamsOp(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, bool genNested, mlir::Location currentLocation, const Fortran::parser::OmpClauseList &clauseList, bool outerCombined = false) { Fortran::lower::StatementContext stmtCtx; mlir::Value numTeamsClauseOperand, ifClauseOperand, threadLimitClauseOperand; llvm::SmallVector allocateOperands, allocatorOperands, reductionVars; llvm::SmallVector reductionDeclSymbols; ClauseProcessor cp(converter, clauseList); cp.processIf(Fortran::parser::OmpIfClause::DirectiveNameModifier::Teams, ifClauseOperand); cp.processAllocate(allocatorOperands, allocateOperands); cp.processDefault(); cp.processNumTeams(stmtCtx, numTeamsClauseOperand); cp.processThreadLimit(stmtCtx, threadLimitClauseOperand); cp.processTODO( currentLocation, llvm::omp::Directive::OMPD_teams); return genOpWithBody( converter, eval, genNested, currentLocation, outerCombined, &clauseList, /*num_teams_lower=*/nullptr, numTeamsClauseOperand, ifClauseOperand, threadLimitClauseOperand, allocateOperands, allocatorOperands, reductionVars, reductionDeclSymbols.empty() ? nullptr : mlir::ArrayAttr::get(converter.getFirOpBuilder().getContext(), reductionDeclSymbols)); } /// Extract the list of function and variable symbols affected by the given /// 'declare target' directive and return the intended device type for them. static mlir::omp::DeclareTargetDeviceType getDeclareTargetInfo( Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenMPDeclareTargetConstruct &declareTargetConstruct, llvm::SmallVectorImpl &symbolAndClause) { // The default capture type mlir::omp::DeclareTargetDeviceType deviceType = mlir::omp::DeclareTargetDeviceType::any; const auto &spec = std::get( declareTargetConstruct.t); if (const auto *objectList{ Fortran::parser::Unwrap(spec.u)}) { // Case: declare target(func, var1, var2) gatherFuncAndVarSyms(*objectList, mlir::omp::DeclareTargetCaptureClause::to, symbolAndClause); } else if (const auto *clauseList{ Fortran::parser::Unwrap( spec.u)}) { if (clauseList->v.empty()) { // Case: declare target, implicit capture of function symbolAndClause.emplace_back( mlir::omp::DeclareTargetCaptureClause::to, eval.getOwningProcedure()->getSubprogramSymbol()); } ClauseProcessor cp(converter, *clauseList); cp.processTo(symbolAndClause); cp.processEnter(symbolAndClause); cp.processLink(symbolAndClause); cp.processDeviceType(deviceType); cp.processTODO( converter.getCurrentLocation(), llvm::omp::Directive::OMPD_declare_target); } return deviceType; } static std::optional getDeclareTargetFunctionDevice( Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenMPDeclareTargetConstruct &declareTargetConstruct) { llvm::SmallVector symbolAndClause; mlir::omp::DeclareTargetDeviceType deviceType = getDeclareTargetInfo( converter, eval, declareTargetConstruct, symbolAndClause); // Return the device type only if at least one of the targets for the // directive is a function or subroutine mlir::ModuleOp mod = converter.getFirOpBuilder().getModule(); for (const DeclareTargetCapturePair &symClause : symbolAndClause) { mlir::Operation *op = mod.lookupSymbol( converter.mangleName(std::get(symClause))); if (mlir::isa(op)) return deviceType; } return std::nullopt; } //===----------------------------------------------------------------------===// // genOMP() Code generation helper functions //===----------------------------------------------------------------------===// static void genOmpSimpleStandalone(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, Fortran::semantics::SemanticsContext &semanticsContext, bool genNested, const Fortran::parser::OpenMPSimpleStandaloneConstruct &simpleStandaloneConstruct) { const auto &directive = std::get( simpleStandaloneConstruct.t); fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); const auto &opClauseList = std::get(simpleStandaloneConstruct.t); mlir::Location currentLocation = converter.genLocation(directive.source); switch (directive.v) { default: break; case llvm::omp::Directive::OMPD_barrier: firOpBuilder.create(currentLocation); break; case llvm::omp::Directive::OMPD_taskwait: ClauseProcessor(converter, opClauseList) .processTODO( currentLocation, llvm::omp::Directive::OMPD_taskwait); firOpBuilder.create(currentLocation); break; case llvm::omp::Directive::OMPD_taskyield: firOpBuilder.create(currentLocation); break; case llvm::omp::Directive::OMPD_target_data: genDataOp(converter, eval, semanticsContext, genNested, currentLocation, opClauseList); break; case llvm::omp::Directive::OMPD_target_enter_data: genEnterExitUpdateDataOp( converter, semanticsContext, currentLocation, opClauseList); break; case llvm::omp::Directive::OMPD_target_exit_data: genEnterExitUpdateDataOp( converter, semanticsContext, currentLocation, opClauseList); break; case llvm::omp::Directive::OMPD_target_update: genEnterExitUpdateDataOp( converter, semanticsContext, currentLocation, opClauseList); break; case llvm::omp::Directive::OMPD_ordered: TODO(currentLocation, "OMPD_ordered"); } } static void genOmpFlush(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenMPFlushConstruct &flushConstruct) { llvm::SmallVector operandRange; if (const auto &ompObjectList = std::get>( flushConstruct.t)) genObjectList(*ompObjectList, converter, operandRange); const auto &memOrderClause = std::get>>( flushConstruct.t); if (memOrderClause && memOrderClause->size() > 0) TODO(converter.getCurrentLocation(), "Handle OmpMemoryOrderClause"); converter.getFirOpBuilder().create( converter.getCurrentLocation(), operandRange); } static void genOMP(Fortran::lower::AbstractConverter &converter, Fortran::lower::SymMap &symTable, Fortran::semantics::SemanticsContext &semanticsContext, Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenMPStandaloneConstruct &standaloneConstruct) { std::visit( Fortran::common::visitors{ [&](const Fortran::parser::OpenMPSimpleStandaloneConstruct &simpleStandaloneConstruct) { genOmpSimpleStandalone(converter, eval, semanticsContext, /*genNested=*/true, simpleStandaloneConstruct); }, [&](const Fortran::parser::OpenMPFlushConstruct &flushConstruct) { genOmpFlush(converter, eval, flushConstruct); }, [&](const Fortran::parser::OpenMPCancelConstruct &cancelConstruct) { TODO(converter.getCurrentLocation(), "OpenMPCancelConstruct"); }, [&](const Fortran::parser::OpenMPCancellationPointConstruct &cancellationPointConstruct) { TODO(converter.getCurrentLocation(), "OpenMPCancelConstruct"); }, }, standaloneConstruct.u); } static void convertLoopBounds(Fortran::lower::AbstractConverter &converter, mlir::Location loc, llvm::SmallVectorImpl &lowerBound, llvm::SmallVectorImpl &upperBound, llvm::SmallVectorImpl &step, std::size_t loopVarTypeSize) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); // The types of lower bound, upper bound, and step are converted into the // type of the loop variable if necessary. mlir::Type loopVarType = getLoopVarType(converter, loopVarTypeSize); for (unsigned it = 0; it < (unsigned)lowerBound.size(); it++) { lowerBound[it] = firOpBuilder.createConvert(loc, loopVarType, lowerBound[it]); upperBound[it] = firOpBuilder.createConvert(loc, loopVarType, upperBound[it]); step[it] = firOpBuilder.createConvert(loc, loopVarType, step[it]); } } static void createSimdLoop(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, llvm::omp::Directive ompDirective, const Fortran::parser::OmpClauseList &loopOpClauseList, mlir::Location loc) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); DataSharingProcessor dsp(converter, loopOpClauseList, eval); dsp.processStep1(); Fortran::lower::StatementContext stmtCtx; mlir::Value scheduleChunkClauseOperand, ifClauseOperand; llvm::SmallVector lowerBound, upperBound, step, reductionVars; llvm::SmallVector alignedVars, nontemporalVars; llvm::SmallVector iv; llvm::SmallVector reductionDeclSymbols; mlir::omp::ClauseOrderKindAttr orderClauseOperand; mlir::IntegerAttr simdlenClauseOperand, safelenClauseOperand; std::size_t loopVarTypeSize; ClauseProcessor cp(converter, loopOpClauseList); cp.processCollapse(loc, eval, lowerBound, upperBound, step, iv, loopVarTypeSize); cp.processScheduleChunk(stmtCtx, scheduleChunkClauseOperand); cp.processReduction(loc, reductionVars, reductionDeclSymbols); cp.processIf(Fortran::parser::OmpIfClause::DirectiveNameModifier::Simd, ifClauseOperand); cp.processSimdlen(simdlenClauseOperand); cp.processSafelen(safelenClauseOperand); cp.processTODO(loc, ompDirective); convertLoopBounds(converter, loc, lowerBound, upperBound, step, loopVarTypeSize); mlir::TypeRange resultType; auto simdLoopOp = firOpBuilder.create( loc, resultType, lowerBound, upperBound, step, alignedVars, /*alignment_values=*/nullptr, ifClauseOperand, nontemporalVars, orderClauseOperand, simdlenClauseOperand, safelenClauseOperand, /*inclusive=*/firOpBuilder.getUnitAttr()); auto *nestedEval = getCollapsedLoopEval( eval, Fortran::lower::getCollapseValue(loopOpClauseList)); createBodyOfOp(simdLoopOp, converter, loc, *nestedEval, /*genNested=*/true, &loopOpClauseList, iv, /*outer=*/false, &dsp); } static void createWsLoop(Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, llvm::omp::Directive ompDirective, const Fortran::parser::OmpClauseList &beginClauseList, const Fortran::parser::OmpClauseList *endClauseList, mlir::Location loc) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); DataSharingProcessor dsp(converter, beginClauseList, eval); dsp.processStep1(); Fortran::lower::StatementContext stmtCtx; mlir::Value scheduleChunkClauseOperand; llvm::SmallVector lowerBound, upperBound, step, reductionVars; llvm::SmallVector linearVars, linearStepVars; llvm::SmallVector iv; llvm::SmallVector reductionDeclSymbols; mlir::omp::ClauseOrderKindAttr orderClauseOperand; mlir::omp::ClauseScheduleKindAttr scheduleValClauseOperand; mlir::UnitAttr nowaitClauseOperand, scheduleSimdClauseOperand; mlir::IntegerAttr orderedClauseOperand; mlir::omp::ScheduleModifierAttr scheduleModClauseOperand; std::size_t loopVarTypeSize; ClauseProcessor cp(converter, beginClauseList); cp.processCollapse(loc, eval, lowerBound, upperBound, step, iv, loopVarTypeSize); cp.processScheduleChunk(stmtCtx, scheduleChunkClauseOperand); cp.processReduction(loc, reductionVars, reductionDeclSymbols); cp.processTODO(loc, ompDirective); convertLoopBounds(converter, loc, lowerBound, upperBound, step, loopVarTypeSize); auto wsLoopOp = firOpBuilder.create( loc, lowerBound, upperBound, step, linearVars, linearStepVars, reductionVars, reductionDeclSymbols.empty() ? nullptr : mlir::ArrayAttr::get(firOpBuilder.getContext(), reductionDeclSymbols), scheduleValClauseOperand, scheduleChunkClauseOperand, /*schedule_modifiers=*/nullptr, /*simd_modifier=*/nullptr, nowaitClauseOperand, orderedClauseOperand, orderClauseOperand, /*inclusive=*/firOpBuilder.getUnitAttr()); // Handle attribute based clauses. if (cp.processOrdered(orderedClauseOperand)) wsLoopOp.setOrderedValAttr(orderedClauseOperand); if (cp.processSchedule(scheduleValClauseOperand, scheduleModClauseOperand, scheduleSimdClauseOperand)) { wsLoopOp.setScheduleValAttr(scheduleValClauseOperand); wsLoopOp.setScheduleModifierAttr(scheduleModClauseOperand); wsLoopOp.setSimdModifierAttr(scheduleSimdClauseOperand); } // In FORTRAN `nowait` clause occur at the end of `omp do` directive. // i.e // !$omp do // <...> // !$omp end do nowait if (endClauseList) { if (ClauseProcessor(converter, *endClauseList) .processNowait(nowaitClauseOperand)) wsLoopOp.setNowaitAttr(nowaitClauseOperand); } auto *nestedEval = getCollapsedLoopEval( eval, Fortran::lower::getCollapseValue(beginClauseList)); createBodyOfOp(wsLoopOp, converter, loc, *nestedEval, /*genNested=*/true, &beginClauseList, iv, /*outer=*/false, &dsp); } static void genOMP(Fortran::lower::AbstractConverter &converter, Fortran::lower::SymMap &symTable, Fortran::semantics::SemanticsContext &semanticsContext, Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenMPLoopConstruct &loopConstruct) { const auto &beginLoopDirective = std::get(loopConstruct.t); const auto &loopOpClauseList = std::get(beginLoopDirective.t); mlir::Location currentLocation = converter.genLocation(beginLoopDirective.source); const auto ompDirective = std::get(beginLoopDirective.t).v; const auto *endClauseList = [&]() { using RetTy = const Fortran::parser::OmpClauseList *; if (auto &endLoopDirective = std::get>( loopConstruct.t)) { return RetTy( &std::get((*endLoopDirective).t)); } return RetTy(); }(); bool validDirective = false; if (llvm::omp::topTaskloopSet.test(ompDirective)) { validDirective = true; TODO(currentLocation, "Taskloop construct"); } else { // Create omp.{target, teams, distribute, parallel} nested operations if ((llvm::omp::allTargetSet & llvm::omp::loopConstructSet) .test(ompDirective)) { validDirective = true; genTargetOp(converter, eval, semanticsContext, /*genNested=*/false, currentLocation, loopOpClauseList, ompDirective, /*outerCombined=*/true); } if ((llvm::omp::allTeamsSet & llvm::omp::loopConstructSet) .test(ompDirective)) { validDirective = true; genTeamsOp(converter, eval, /*genNested=*/false, currentLocation, loopOpClauseList, /*outerCombined=*/true); } if (llvm::omp::allDistributeSet.test(ompDirective)) { validDirective = true; TODO(currentLocation, "Distribute construct"); } if ((llvm::omp::allParallelSet & llvm::omp::loopConstructSet) .test(ompDirective)) { validDirective = true; genParallelOp(converter, eval, /*genNested=*/false, currentLocation, loopOpClauseList, /*outerCombined=*/true); } } if ((llvm::omp::allDoSet | llvm::omp::allSimdSet).test(ompDirective)) validDirective = true; if (!validDirective) { TODO(currentLocation, "Unhandled loop directive (" + llvm::omp::getOpenMPDirectiveName(ompDirective) + ")"); } // 2.9.3.1 SIMD construct if (llvm::omp::allSimdSet.test(ompDirective)) { createSimdLoop(converter, eval, ompDirective, loopOpClauseList, currentLocation); } else { createWsLoop(converter, eval, ompDirective, loopOpClauseList, endClauseList, currentLocation); } genOpenMPReduction(converter, loopOpClauseList); } static void genOMP(Fortran::lower::AbstractConverter &converter, Fortran::lower::SymMap &symTable, Fortran::semantics::SemanticsContext &semanticsContext, Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenMPBlockConstruct &blockConstruct) { const auto &beginBlockDirective = std::get(blockConstruct.t); const auto &endBlockDirective = std::get(blockConstruct.t); const auto &directive = std::get(beginBlockDirective.t); const auto &beginClauseList = std::get(beginBlockDirective.t); const auto &endClauseList = std::get(endBlockDirective.t); for (const Fortran::parser::OmpClause &clause : beginClauseList.v) { mlir::Location clauseLocation = converter.genLocation(clause.source); if (!std::get_if(&clause.u) && !std::get_if(&clause.u) && !std::get_if(&clause.u) && !std::get_if(&clause.u) && !std::get_if(&clause.u) && !std::get_if(&clause.u) && !std::get_if(&clause.u) && !std::get_if(&clause.u) && !std::get_if(&clause.u) && !std::get_if(&clause.u) && !std::get_if(&clause.u) && !std::get_if(&clause.u) && !std::get_if(&clause.u) && !std::get_if(&clause.u) && !std::get_if(&clause.u) && !std::get_if(&clause.u) && !std::get_if(&clause.u) && !std::get_if(&clause.u) && !std::get_if(&clause.u)) { TODO(clauseLocation, "OpenMP Block construct clause"); } } for (const auto &clause : endClauseList.v) { mlir::Location clauseLocation = converter.genLocation(clause.source); if (!std::get_if(&clause.u)) TODO(clauseLocation, "OpenMP Block construct clause"); } bool singleDirective = true; mlir::Location currentLocation = converter.genLocation(directive.source); switch (directive.v) { case llvm::omp::Directive::OMPD_master: genMasterOp(converter, eval, /*genNested=*/true, currentLocation); break; case llvm::omp::Directive::OMPD_ordered: genOrderedRegionOp(converter, eval, /*genNested=*/true, currentLocation); break; case llvm::omp::Directive::OMPD_parallel: genParallelOp(converter, eval, /*genNested=*/true, currentLocation, beginClauseList); break; case llvm::omp::Directive::OMPD_single: genSingleOp(converter, eval, /*genNested=*/true, currentLocation, beginClauseList, endClauseList); break; case llvm::omp::Directive::OMPD_target: genTargetOp(converter, eval, semanticsContext, /*genNested=*/true, currentLocation, beginClauseList, directive.v); break; case llvm::omp::Directive::OMPD_target_data: genDataOp(converter, eval, semanticsContext, /*genNested=*/true, currentLocation, beginClauseList); break; case llvm::omp::Directive::OMPD_task: genTaskOp(converter, eval, /*genNested=*/true, currentLocation, beginClauseList); break; case llvm::omp::Directive::OMPD_taskgroup: genTaskGroupOp(converter, eval, /*genNested=*/true, currentLocation, beginClauseList); break; case llvm::omp::Directive::OMPD_teams: genTeamsOp(converter, eval, /*genNested=*/true, currentLocation, beginClauseList, /*outerCombined=*/false); break; case llvm::omp::Directive::OMPD_workshare: TODO(currentLocation, "Workshare construct"); break; default: singleDirective = false; break; } if (singleDirective) { genOpenMPReduction(converter, beginClauseList); return; } // Codegen for combined directives bool combinedDirective = false; if ((llvm::omp::allTargetSet & llvm::omp::blockConstructSet) .test(directive.v)) { genTargetOp(converter, eval, semanticsContext, /*genNested=*/false, currentLocation, beginClauseList, directive.v, /*outerCombined=*/true); combinedDirective = true; } if ((llvm::omp::allTeamsSet & llvm::omp::blockConstructSet) .test(directive.v)) { genTeamsOp(converter, eval, /*genNested=*/false, currentLocation, beginClauseList); combinedDirective = true; } if ((llvm::omp::allParallelSet & llvm::omp::blockConstructSet) .test(directive.v)) { bool outerCombined = directive.v != llvm::omp::Directive::OMPD_target_parallel; genParallelOp(converter, eval, /*genNested=*/false, currentLocation, beginClauseList, outerCombined); combinedDirective = true; } if ((llvm::omp::workShareSet & llvm::omp::blockConstructSet) .test(directive.v)) { TODO(currentLocation, "Workshare construct"); combinedDirective = true; } if (!combinedDirective) TODO(currentLocation, "Unhandled block directive (" + llvm::omp::getOpenMPDirectiveName(directive.v) + ")"); genNestedEvaluations(converter, eval); genOpenMPReduction(converter, beginClauseList); } static void genOMP(Fortran::lower::AbstractConverter &converter, Fortran::lower::SymMap &symTable, Fortran::semantics::SemanticsContext &semanticsContext, Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenMPCriticalConstruct &criticalConstruct) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); mlir::Location currentLocation = converter.getCurrentLocation(); mlir::IntegerAttr hintClauseOp; std::string name; const Fortran::parser::OmpCriticalDirective &cd = std::get(criticalConstruct.t); if (std::get>(cd.t).has_value()) { name = std::get>(cd.t).value().ToString(); } const auto &clauseList = std::get(cd.t); ClauseProcessor(converter, clauseList).processHint(hintClauseOp); mlir::omp::CriticalOp criticalOp = [&]() { if (name.empty()) { return firOpBuilder.create( currentLocation, mlir::FlatSymbolRefAttr()); } mlir::ModuleOp module = firOpBuilder.getModule(); mlir::OpBuilder modBuilder(module.getBodyRegion()); auto global = module.lookupSymbol(name); if (!global) global = modBuilder.create( currentLocation, mlir::StringAttr::get(firOpBuilder.getContext(), name), hintClauseOp); return firOpBuilder.create( currentLocation, mlir::FlatSymbolRefAttr::get(firOpBuilder.getContext(), global.getSymName())); }(); createBodyOfOp(criticalOp, converter, currentLocation, eval, /*genNested=*/true); } static void genOMP(Fortran::lower::AbstractConverter &converter, Fortran::lower::SymMap &symTable, Fortran::semantics::SemanticsContext &semanticsContext, Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenMPSectionsConstruct §ionsConstruct) { mlir::Location currentLocation = converter.getCurrentLocation(); llvm::SmallVector allocateOperands, allocatorOperands; mlir::UnitAttr nowaitClauseOperand; const auto &beginSectionsDirective = std::get(sectionsConstruct.t); const auto §ionsClauseList = std::get(beginSectionsDirective.t); // Process clauses before optional omp.parallel, so that new variables are // allocated outside of the parallel region ClauseProcessor cp(converter, sectionsClauseList); cp.processSectionsReduction(currentLocation); cp.processAllocate(allocatorOperands, allocateOperands); llvm::omp::Directive dir = std::get(beginSectionsDirective.t) .v; // Parallel wrapper of PARALLEL SECTIONS construct if (dir == llvm::omp::Directive::OMPD_parallel_sections) { genParallelOp(converter, eval, /*genNested=*/false, currentLocation, sectionsClauseList, /*outerCombined=*/true); } else { const auto &endSectionsDirective = std::get(sectionsConstruct.t); const auto &endSectionsClauseList = std::get(endSectionsDirective.t); ClauseProcessor(converter, endSectionsClauseList) .processNowait(nowaitClauseOperand); } // SECTIONS construct genOpWithBody(converter, eval, /*genNested=*/false, currentLocation, /*outerCombined=*/false, /*clauseList=*/nullptr, /*reduction_vars=*/mlir::ValueRange(), /*reductions=*/nullptr, allocateOperands, allocatorOperands, nowaitClauseOperand); const auto §ionBlocks = std::get(sectionsConstruct.t); auto &firOpBuilder = converter.getFirOpBuilder(); auto ip = firOpBuilder.saveInsertionPoint(); for (const auto &[nblock, neval] : llvm::zip(sectionBlocks.v, eval.getNestedEvaluations())) { symTable.pushScope(); genSectionOp(converter, neval, /*genNested=*/true, currentLocation, sectionsClauseList); symTable.popScope(); firOpBuilder.restoreInsertionPoint(ip); } } static void genOMP(Fortran::lower::AbstractConverter &converter, Fortran::lower::SymMap &symTable, Fortran::semantics::SemanticsContext &semanticsContext, Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenMPAtomicConstruct &atomicConstruct) { std::visit( Fortran::common::visitors{ [&](const Fortran::parser::OmpAtomicRead &atomicRead) { mlir::Location loc = converter.genLocation(atomicRead.source); Fortran::lower::genOmpAccAtomicRead< Fortran::parser::OmpAtomicRead, Fortran::parser::OmpAtomicClauseList>(converter, atomicRead, loc); }, [&](const Fortran::parser::OmpAtomicWrite &atomicWrite) { mlir::Location loc = converter.genLocation(atomicWrite.source); Fortran::lower::genOmpAccAtomicWrite< Fortran::parser::OmpAtomicWrite, Fortran::parser::OmpAtomicClauseList>(converter, atomicWrite, loc); }, [&](const Fortran::parser::OmpAtomic &atomicConstruct) { mlir::Location loc = converter.genLocation(atomicConstruct.source); Fortran::lower::genOmpAtomic( converter, atomicConstruct, loc); }, [&](const Fortran::parser::OmpAtomicUpdate &atomicUpdate) { mlir::Location loc = converter.genLocation(atomicUpdate.source); Fortran::lower::genOmpAccAtomicUpdate< Fortran::parser::OmpAtomicUpdate, Fortran::parser::OmpAtomicClauseList>(converter, atomicUpdate, loc); }, [&](const Fortran::parser::OmpAtomicCapture &atomicCapture) { mlir::Location loc = converter.genLocation(atomicCapture.source); Fortran::lower::genOmpAccAtomicCapture< Fortran::parser::OmpAtomicCapture, Fortran::parser::OmpAtomicClauseList>(converter, atomicCapture, loc); }, }, atomicConstruct.u); } static void genOMP(Fortran::lower::AbstractConverter &converter, Fortran::lower::SymMap &symTable, Fortran::semantics::SemanticsContext &semanticsContext, Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenMPDeclareTargetConstruct &declareTargetConstruct) { llvm::SmallVector symbolAndClause; mlir::ModuleOp mod = converter.getFirOpBuilder().getModule(); mlir::omp::DeclareTargetDeviceType deviceType = getDeclareTargetInfo( converter, eval, declareTargetConstruct, symbolAndClause); for (const DeclareTargetCapturePair &symClause : symbolAndClause) { mlir::Operation *op = mod.lookupSymbol( converter.mangleName(std::get(symClause))); // There's several cases this can currently be triggered and it could be // one of the following: // 1) Invalid argument passed to a declare target that currently isn't // captured by a frontend semantic check // 2) The symbol of a valid argument is not correctly updated by one of // the prior passes, resulting in missing symbol information // 3) It's a variable internal to a module or program, that is legal by // Fortran OpenMP standards, but is currently unhandled as they do not // appear in the symbol table as they are represented as allocas if (!op) TODO(converter.getCurrentLocation(), "Missing symbol, possible case of currently unsupported use of " "a program local variable in declare target or erroneous symbol " "information "); auto declareTargetOp = llvm::dyn_cast(op); if (!declareTargetOp) fir::emitFatalError( converter.getCurrentLocation(), "Attempt to apply declare target on unsupported operation"); // The function or global already has a declare target applied to it, very // likely through implicit capture (usage in another declare target // function/subroutine). It should be marked as any if it has been assigned // both host and nohost, else we skip, as there is no change if (declareTargetOp.isDeclareTarget()) { if (declareTargetOp.getDeclareTargetDeviceType() != deviceType) declareTargetOp.setDeclareTarget( mlir::omp::DeclareTargetDeviceType::any, std::get(symClause)); continue; } declareTargetOp.setDeclareTarget( deviceType, std::get(symClause)); } } static void genOMP(Fortran::lower::AbstractConverter &converter, Fortran::lower::SymMap &symTable, Fortran::semantics::SemanticsContext &semanticsContext, Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenMPConstruct &ompConstruct) { std::visit( Fortran::common::visitors{ [&](const Fortran::parser::OpenMPStandaloneConstruct &standaloneConstruct) { genOMP(converter, symTable, semanticsContext, eval, standaloneConstruct); }, [&](const Fortran::parser::OpenMPSectionsConstruct §ionsConstruct) { genOMP(converter, symTable, semanticsContext, eval, sectionsConstruct); }, [&](const Fortran::parser::OpenMPSectionConstruct §ionConstruct) { // SECTION constructs are handled as a part of SECTIONS. llvm_unreachable("Unexpected standalone OMP SECTION"); }, [&](const Fortran::parser::OpenMPLoopConstruct &loopConstruct) { genOMP(converter, symTable, semanticsContext, eval, loopConstruct); }, [&](const Fortran::parser::OpenMPDeclarativeAllocate &execAllocConstruct) { TODO(converter.getCurrentLocation(), "OpenMPDeclarativeAllocate"); }, [&](const Fortran::parser::OpenMPExecutableAllocate &execAllocConstruct) { TODO(converter.getCurrentLocation(), "OpenMPExecutableAllocate"); }, [&](const Fortran::parser::OpenMPAllocatorsConstruct &allocsConstruct) { TODO(converter.getCurrentLocation(), "OpenMPAllocatorsConstruct"); }, [&](const Fortran::parser::OpenMPBlockConstruct &blockConstruct) { genOMP(converter, symTable, semanticsContext, eval, blockConstruct); }, [&](const Fortran::parser::OpenMPAtomicConstruct &atomicConstruct) { genOMP(converter, symTable, semanticsContext, eval, atomicConstruct); }, [&](const Fortran::parser::OpenMPCriticalConstruct &criticalConstruct) { genOMP(converter, symTable, semanticsContext, eval, criticalConstruct); }, }, ompConstruct.u); } static void genOMP(Fortran::lower::AbstractConverter &converter, Fortran::lower::SymMap &symTable, Fortran::semantics::SemanticsContext &semanticsContext, Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenMPDeclarativeConstruct &ompDeclConstruct) { std::visit( Fortran::common::visitors{ [&](const Fortran::parser::OpenMPDeclarativeAllocate &declarativeAllocate) { TODO(converter.getCurrentLocation(), "OpenMPDeclarativeAllocate"); }, [&](const Fortran::parser::OpenMPDeclareReductionConstruct &declareReductionConstruct) { TODO(converter.getCurrentLocation(), "OpenMPDeclareReductionConstruct"); }, [&](const Fortran::parser::OpenMPDeclareSimdConstruct &declareSimdConstruct) { TODO(converter.getCurrentLocation(), "OpenMPDeclareSimdConstruct"); }, [&](const Fortran::parser::OpenMPDeclareTargetConstruct &declareTargetConstruct) { genOMP(converter, symTable, semanticsContext, eval, declareTargetConstruct); }, [&](const Fortran::parser::OpenMPRequiresConstruct &requiresConstruct) { // Requires directives are gathered and processed in semantics and // then combined in the lowering bridge before triggering codegen // just once. Hence, there is no need to lower each individual // occurrence here. }, [&](const Fortran::parser::OpenMPThreadprivate &threadprivate) { // The directive is lowered when instantiating the variable to // support the case of threadprivate variable declared in module. }, }, ompDeclConstruct.u); } //===----------------------------------------------------------------------===// // Public functions //===----------------------------------------------------------------------===// mlir::Operation *Fortran::lower::genOpenMPTerminator(fir::FirOpBuilder &builder, mlir::Operation *op, mlir::Location loc) { if (mlir::isa(op)) return builder.create(loc); else return builder.create(loc); } void Fortran::lower::genOpenMPConstruct( Fortran::lower::AbstractConverter &converter, Fortran::lower::SymMap &symTable, Fortran::semantics::SemanticsContext &semanticsContext, Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenMPConstruct &omp) { symTable.pushScope(); genOMP(converter, symTable, semanticsContext, eval, omp); symTable.popScope(); } void Fortran::lower::genOpenMPDeclarativeConstruct( Fortran::lower::AbstractConverter &converter, Fortran::lower::SymMap &symTable, Fortran::semantics::SemanticsContext &semanticsContext, Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenMPDeclarativeConstruct &omp) { genOMP(converter, symTable, semanticsContext, eval, omp); genNestedEvaluations(converter, eval); } void Fortran::lower::genOpenMPSymbolProperties( Fortran::lower::AbstractConverter &converter, const Fortran::lower::pft::Variable &var) { assert(var.hasSymbol() && "Expecting Symbol"); const Fortran::semantics::Symbol &sym = var.getSymbol(); if (sym.test(Fortran::semantics::Symbol::Flag::OmpThreadprivate)) Fortran::lower::genThreadprivateOp(converter, var); if (sym.test(Fortran::semantics::Symbol::Flag::OmpDeclareTarget)) Fortran::lower::genDeclareTargetIntGlobal(converter, var); } int64_t Fortran::lower::getCollapseValue( const Fortran::parser::OmpClauseList &clauseList) { for (const Fortran::parser::OmpClause &clause : clauseList.v) { if (const auto &collapseClause = std::get_if(&clause.u)) { const auto *expr = Fortran::semantics::GetExpr(collapseClause->v); return Fortran::evaluate::ToInt64(*expr).value(); } } return 1; } void Fortran::lower::genThreadprivateOp( Fortran::lower::AbstractConverter &converter, const Fortran::lower::pft::Variable &var) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); mlir::Location currentLocation = converter.getCurrentLocation(); const Fortran::semantics::Symbol &sym = var.getSymbol(); mlir::Value symThreadprivateValue; if (const Fortran::semantics::Symbol *common = Fortran::semantics::FindCommonBlockContaining(sym.GetUltimate())) { mlir::Value commonValue = converter.getSymbolAddress(*common); if (mlir::isa(commonValue.getDefiningOp())) { // Generate ThreadprivateOp for a common block instead of its members and // only do it once for a common block. return; } // Generate ThreadprivateOp and rebind the common block. mlir::Value commonThreadprivateValue = firOpBuilder.create( currentLocation, commonValue.getType(), commonValue); converter.bindSymbol(*common, commonThreadprivateValue); // Generate the threadprivate value for the common block member. symThreadprivateValue = genCommonBlockMember(converter, currentLocation, sym, commonThreadprivateValue); } else if (!var.isGlobal()) { // Non-global variable which can be in threadprivate directive must be one // variable in main program, and it has implicit SAVE attribute. Take it as // with SAVE attribute, so to create GlobalOp for it to simplify the // translation to LLVM IR. fir::GlobalOp global = globalInitialization(converter, firOpBuilder, sym, var, currentLocation); mlir::Value symValue = firOpBuilder.create( currentLocation, global.resultType(), global.getSymbol()); symThreadprivateValue = firOpBuilder.create( currentLocation, symValue.getType(), symValue); } else { mlir::Value symValue = converter.getSymbolAddress(sym); // The symbol may be use-associated multiple times, and nothing needs to be // done after the original symbol is mapped to the threadprivatized value // for the first time. Use the threadprivatized value directly. mlir::Operation *op; if (auto declOp = symValue.getDefiningOp()) op = declOp.getMemref().getDefiningOp(); else op = symValue.getDefiningOp(); if (mlir::isa(op)) return; symThreadprivateValue = firOpBuilder.create( currentLocation, symValue.getType(), symValue); } fir::ExtendedValue sexv = converter.getSymbolExtendedValue(sym); fir::ExtendedValue symThreadprivateExv = getExtendedValue(sexv, symThreadprivateValue); converter.bindSymbol(sym, symThreadprivateExv); } // This function replicates threadprivate's behaviour of generating // an internal fir.GlobalOp for non-global variables in the main program // that have the implicit SAVE attribute, to simplifiy LLVM-IR and MLIR // generation. void Fortran::lower::genDeclareTargetIntGlobal( Fortran::lower::AbstractConverter &converter, const Fortran::lower::pft::Variable &var) { if (!var.isGlobal()) { // A non-global variable which can be in a declare target directive must // be a variable in the main program, and it has the implicit SAVE // attribute. We create a GlobalOp for it to simplify the translation to // LLVM IR. globalInitialization(converter, converter.getFirOpBuilder(), var.getSymbol(), var, converter.getCurrentLocation()); } } // Generate an OpenMP reduction operation. // TODO: Currently assumes it is either an integer addition/multiplication // reduction, or a logical and reduction. Generalize this for various reduction // operation types. // TODO: Generate the reduction operation during lowering instead of creating // and removing operations since this is not a robust approach. Also, removing // ops in the builder (instead of a rewriter) is probably not the best approach. void Fortran::lower::genOpenMPReduction( Fortran::lower::AbstractConverter &converter, const Fortran::parser::OmpClauseList &clauseList) { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); for (const Fortran::parser::OmpClause &clause : clauseList.v) { if (const auto &reductionClause = std::get_if(&clause.u)) { const auto &redOperator{std::get( reductionClause->v.t)}; const auto &objectList{ std::get(reductionClause->v.t)}; if (const auto *reductionOp = std::get_if(&redOperator.u)) { const auto &intrinsicOp{ std::get( reductionOp->u)}; switch (intrinsicOp) { case Fortran::parser::DefinedOperator::IntrinsicOperator::Add: case Fortran::parser::DefinedOperator::IntrinsicOperator::Multiply: case Fortran::parser::DefinedOperator::IntrinsicOperator::AND: case Fortran::parser::DefinedOperator::IntrinsicOperator::EQV: case Fortran::parser::DefinedOperator::IntrinsicOperator::OR: case Fortran::parser::DefinedOperator::IntrinsicOperator::NEQV: break; default: continue; } for (const Fortran::parser::OmpObject &ompObject : objectList.v) { if (const auto *name{ Fortran::parser::Unwrap(ompObject)}) { if (const Fortran::semantics::Symbol * symbol{name->symbol}) { mlir::Value reductionVal = converter.getSymbolAddress(*symbol); if (auto declOp = reductionVal.getDefiningOp()) reductionVal = declOp.getBase(); mlir::Type reductionType = reductionVal.getType().cast().getEleTy(); if (!reductionType.isa()) { if (!reductionType.isIntOrIndexOrFloat()) continue; } for (mlir::OpOperand &reductionValUse : reductionVal.getUses()) { if (auto loadOp = mlir::dyn_cast( reductionValUse.getOwner())) { mlir::Value loadVal = loadOp.getRes(); if (reductionType.isa()) { mlir::Operation *reductionOp = findReductionChain(loadVal); fir::ConvertOp convertOp = getConvertFromReductionOp(reductionOp, loadVal); updateReduction(reductionOp, firOpBuilder, loadVal, reductionVal, &convertOp); removeStoreOp(reductionOp, reductionVal); } else if (mlir::Operation *reductionOp = findReductionChain(loadVal, &reductionVal)) { updateReduction(reductionOp, firOpBuilder, loadVal, reductionVal); } } } } } } } else if (const auto *reductionIntrinsic = std::get_if( &redOperator.u)) { if (!ReductionProcessor::supportedIntrinsicProcReduction( *reductionIntrinsic)) continue; ReductionProcessor::IntrinsicProc redIntrinsicProc = ReductionProcessor::getReductionType(*reductionIntrinsic); for (const Fortran::parser::OmpObject &ompObject : objectList.v) { if (const auto *name{ Fortran::parser::Unwrap(ompObject)}) { if (const Fortran::semantics::Symbol * symbol{name->symbol}) { mlir::Value reductionVal = converter.getSymbolAddress(*symbol); if (auto declOp = reductionVal.getDefiningOp()) reductionVal = declOp.getBase(); for (const mlir::OpOperand &reductionValUse : reductionVal.getUses()) { if (auto loadOp = mlir::dyn_cast( reductionValUse.getOwner())) { mlir::Value loadVal = loadOp.getRes(); // Max is lowered as a compare -> select. // Match the pattern here. mlir::Operation *reductionOp = findReductionChain(loadVal, &reductionVal); if (reductionOp == nullptr) continue; if (redIntrinsicProc == ReductionProcessor::IntrinsicProc::MAX || redIntrinsicProc == ReductionProcessor::IntrinsicProc::MIN) { assert(mlir::isa(reductionOp) && "Selection Op not found in reduction intrinsic"); mlir::Operation *compareOp = getCompareFromReductionOp(reductionOp, loadVal); updateReduction(compareOp, firOpBuilder, loadVal, reductionVal); } if (redIntrinsicProc == ReductionProcessor::IntrinsicProc::IOR || redIntrinsicProc == ReductionProcessor::IntrinsicProc::IEOR || redIntrinsicProc == ReductionProcessor::IntrinsicProc::IAND) { updateReduction(reductionOp, firOpBuilder, loadVal, reductionVal); } } } } } } } } } } mlir::Operation *Fortran::lower::findReductionChain(mlir::Value loadVal, mlir::Value *reductionVal) { for (mlir::OpOperand &loadOperand : loadVal.getUses()) { if (mlir::Operation *reductionOp = loadOperand.getOwner()) { if (auto convertOp = mlir::dyn_cast(reductionOp)) { for (mlir::OpOperand &convertOperand : convertOp.getRes().getUses()) { if (mlir::Operation *reductionOp = convertOperand.getOwner()) return reductionOp; } } for (mlir::OpOperand &reductionOperand : reductionOp->getUses()) { if (auto store = mlir::dyn_cast(reductionOperand.getOwner())) { if (store.getMemref() == *reductionVal) { store.erase(); return reductionOp; } } if (auto assign = mlir::dyn_cast(reductionOperand.getOwner())) { if (assign.getLhs() == *reductionVal) { assign.erase(); return reductionOp; } } } } } return nullptr; } // for a logical operator 'op' reduction X = X op Y // This function returns the operation responsible for converting Y from // fir.logical<4> to i1 fir::ConvertOp Fortran::lower::getConvertFromReductionOp(mlir::Operation *reductionOp, mlir::Value loadVal) { for (mlir::Value reductionOperand : reductionOp->getOperands()) { if (auto convertOp = mlir::dyn_cast(reductionOperand.getDefiningOp())) { if (convertOp.getOperand() == loadVal) continue; return convertOp; } } return nullptr; } void Fortran::lower::updateReduction(mlir::Operation *op, fir::FirOpBuilder &firOpBuilder, mlir::Value loadVal, mlir::Value reductionVal, fir::ConvertOp *convertOp) { mlir::OpBuilder::InsertPoint insertPtDel = firOpBuilder.saveInsertionPoint(); firOpBuilder.setInsertionPoint(op); mlir::Value reductionOp; if (convertOp) reductionOp = convertOp->getOperand(); else if (op->getOperand(0) == loadVal) reductionOp = op->getOperand(1); else reductionOp = op->getOperand(0); firOpBuilder.create(op->getLoc(), reductionOp, reductionVal); firOpBuilder.restoreInsertionPoint(insertPtDel); } void Fortran::lower::removeStoreOp(mlir::Operation *reductionOp, mlir::Value symVal) { for (mlir::Operation *reductionOpUse : reductionOp->getUsers()) { if (auto convertReduction = mlir::dyn_cast(reductionOpUse)) { for (mlir::Operation *convertReductionUse : convertReduction.getRes().getUsers()) { if (auto storeOp = mlir::dyn_cast(convertReductionUse)) { if (storeOp.getMemref() == symVal) storeOp.erase(); } if (auto assignOp = mlir::dyn_cast(convertReductionUse)) { if (assignOp.getLhs() == symVal) assignOp.erase(); } } } } } bool Fortran::lower::isOpenMPTargetConstruct( const Fortran::parser::OpenMPConstruct &omp) { llvm::omp::Directive dir = llvm::omp::Directive::OMPD_unknown; if (const auto *block = std::get_if(&omp.u)) { const auto &begin = std::get(block->t); dir = std::get(begin.t).v; } else if (const auto *loop = std::get_if(&omp.u)) { const auto &begin = std::get(loop->t); dir = std::get(begin.t).v; } return llvm::omp::allTargetSet.test(dir); } bool Fortran::lower::isOpenMPDeviceDeclareTarget( Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, const Fortran::parser::OpenMPDeclarativeConstruct &ompDecl) { return std::visit( Fortran::common::visitors{ [&](const Fortran::parser::OpenMPDeclareTargetConstruct &ompReq) { mlir::omp::DeclareTargetDeviceType targetType = getDeclareTargetFunctionDevice(converter, eval, ompReq) .value_or(mlir::omp::DeclareTargetDeviceType::host); return targetType != mlir::omp::DeclareTargetDeviceType::host; }, [&](const auto &) { return false; }, }, ompDecl.u); } void Fortran::lower::genOpenMPRequires( mlir::Operation *mod, const Fortran::semantics::Symbol *symbol) { using MlirRequires = mlir::omp::ClauseRequires; using SemaRequires = Fortran::semantics::WithOmpDeclarative::RequiresFlag; if (auto offloadMod = llvm::dyn_cast(mod)) { Fortran::semantics::WithOmpDeclarative::RequiresFlags semaFlags; if (symbol) { Fortran::common::visit( [&](const auto &details) { if constexpr (std::is_base_of_v< Fortran::semantics::WithOmpDeclarative, std::decay_t>) { if (details.has_ompRequires()) semaFlags = *details.ompRequires(); } }, symbol->details()); } MlirRequires mlirFlags = MlirRequires::none; if (semaFlags.test(SemaRequires::ReverseOffload)) mlirFlags = mlirFlags | MlirRequires::reverse_offload; if (semaFlags.test(SemaRequires::UnifiedAddress)) mlirFlags = mlirFlags | MlirRequires::unified_address; if (semaFlags.test(SemaRequires::UnifiedSharedMemory)) mlirFlags = mlirFlags | MlirRequires::unified_shared_memory; if (semaFlags.test(SemaRequires::DynamicAllocators)) mlirFlags = mlirFlags | MlirRequires::dynamic_allocators; offloadMod.setRequires(mlirFlags); } }