https://github.com/SergeyShch01 updated https://github.com/llvm/llvm-project/pull/236384
>From a3abe49b2d3b156953cb787c0ea940148ce0531b Mon Sep 17 00:00:00 2001 From: Sergey Shcherbinin <[email protected]> Date: Wed, 28 Oct 2026 15:36:14 +0400 Subject: [PATCH 1/2] [flang][OpenMP] Globalize MAIN scalars used in parallel regions Place eligible fixed-size intrinsic MAIN scalars of up to 32 bytes with implicit SAVE semantics in static storage when directly used in explicit host OpenMP PARALLEL regions. This covers direct references and simple expressions in standalone, combined and nested constructs, including regions in MAIN's internal procedures. These scalars would otherwise use stack storage. Selection is limited to parallel regions rather than all procedure uses. Ordinary procedures may inline, exposing captured scalars to register promotion and making the benefit of globalization less clear. OpenMP parallel regions are outlined and invoked through the runtime. Direct global references preserve object identity and storage properties across this boundary, providing more precise information for alias analysis and enabling optimizations such as LICM. To limit compilation overhead: - Memoize USE/host-association resolution during selection and binding preparation. - Reuse cached scope-variable lists for promoted MAIN hosts and their own lowering. - Preselect ordered global bindings and required aggregate backing stores once per host, then reuse them across internal procedures. An internal frontend option allows disabling the new selection. The miniWeather mini-app (Fortran/OpenMP) shows a 28% performance improvement on NVIDIA Grace with 64 OpenMP threads. --- clang/include/clang/Options/FlangOptions.td | 5 + flang/docs/ReleaseNotes.md | 3 + flang/include/flang/Evaluate/tools.h | 3 + flang/include/flang/Lower/HostAssociations.h | 22 +- flang/include/flang/Lower/LoweringOptions.def | 4 + flang/include/flang/Lower/PFTBuilder.h | 13 +- flang/include/flang/Semantics/symbol.h | 5 +- flang/lib/Evaluate/tools.cpp | 7 +- flang/lib/Frontend/CompilerInvocation.cpp | 12 + flang/lib/Frontend/ParserActions.cpp | 4 +- flang/lib/Lower/Bridge.cpp | 13 +- flang/lib/Lower/HostAssociations.cpp | 89 ++++- flang/lib/Lower/PFTBuilder.cpp | 348 ++++++++++++++++- .../Driver/openmp-main-program-globals.f90 | 11 + .../Lower/OpenMP/default-clause-byref.f90 | 8 +- flang/test/Lower/OpenMP/default-clause.f90 | 8 +- .../OpenMP/main-program-globals-cost.f90 | 126 ++++++ .../OpenMP/main-program-globals-fallback.f90 | 115 ++++++ .../Lower/OpenMP/main-program-globals.f90 | 367 ++++++++++++++++++ flang/test/Lower/volatile-openmp1.f90 | 6 +- flang/tools/bbc/bbc.cpp | 16 +- .../Frontend/CompilerInstanceTest.cpp | 32 ++ 22 files changed, 1174 insertions(+), 43 deletions(-) create mode 100644 flang/test/Driver/openmp-main-program-globals.f90 create mode 100644 flang/test/Lower/OpenMP/main-program-globals-cost.f90 create mode 100644 flang/test/Lower/OpenMP/main-program-globals-fallback.f90 create mode 100644 flang/test/Lower/OpenMP/main-program-globals.f90 diff --git a/clang/include/clang/Options/FlangOptions.td b/clang/include/clang/Options/FlangOptions.td index b07a6bdd1e606a..d672380260a3f8 100644 --- a/clang/include/clang/Options/FlangOptions.td +++ b/clang/include/clang/Options/FlangOptions.td @@ -438,6 +438,11 @@ def fcoarray : Flag<["-"], "fcoarray">, let Visibility = [FC1Option] in { +def fno_openmp_main_program_globals : Flag<["-"], "fno-openmp-main-program-globals">, + Group<f_Group>, + HelpText<"Disable static storage selection for small main program scalars " + "used in explicit host OpenMP PARALLEL regions">; + def ffp_maxmin_behavior_EQ : Joined<["-"], "ffp-maxmin-behavior=">, Flags<[HelpHidden]>, diff --git a/flang/docs/ReleaseNotes.md b/flang/docs/ReleaseNotes.md index 147b15106b9146..ec37f823409589 100644 --- a/flang/docs/ReleaseNotes.md +++ b/flang/docs/ReleaseNotes.md @@ -87,6 +87,9 @@ page](https://llvm.org/releases/). ## Non-comprehensive list of changes in this release +- With OpenMP enabled, eligible small main-program scalars used in explicit + host `PARALLEL` regions now use static storage by default. + - Added support for the OpenMP implementation-defined extension sentinels (OpenMP 5.2, section 3.1): `!$omx`, `c$omx` and `*$omx` in fixed source form and `!$ompx` in free source form. These sentinels are recognized like their diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index b82e6a6f4add19..ed60aedd225f94 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -1769,6 +1769,9 @@ bool IsObjectPointer(const Symbol *); bool IsAllocatableOrObjectPointer(const Symbol *); bool IsAutomatic(const Symbol &); bool IsSaved(const Symbol &); // saved implicitly or explicitly +// Test the size boundary used by main-program storage policies. The argument +// must already be an association root; this does not test SAVE or object kind. +bool IsSmallMainProgramVariable(const Symbol &); bool IsDummy(const Symbol &); bool IsAssumedRank(const Symbol &); diff --git a/flang/include/flang/Lower/HostAssociations.h b/flang/include/flang/Lower/HostAssociations.h index ee9136d80ea946..73e644160368a0 100644 --- a/flang/include/flang/Lower/HostAssociations.h +++ b/flang/include/flang/Lower/HostAssociations.h @@ -10,7 +10,10 @@ #define FORTRAN_LOWER_HOSTASSOCIATIONS_H #include "mlir/IR/Types.h" +#include "llvm/ADT/STLFunctionalExtras.h" #include "llvm/ADT/SetVector.h" +#include "llvm/ADT/SmallVector.h" +#include <vector> namespace Fortran { namespace semantics { @@ -21,6 +24,9 @@ class Scope; namespace lower { class AbstractConverter; class SymMap; +namespace pft { +struct Variable; +} /// Internal procedures in Fortran may access variables declared in the host /// procedure directly. We bundle these variables together in a tuple and pass @@ -35,10 +41,14 @@ class HostAssociations { bool hasTupleAssociations() const { return !tupleSymbols.empty(); } /// Adds a set of Symbols that will be the host associated bindings for this - /// host procedure. + /// host procedure. getVariables is invoked synchronously only for newly + /// promoted globals and must return Program's finalized, stable records. void addSymbolsToBind( const llvm::SetVector<const Fortran::semantics::Symbol *> &symbols, - const Fortran::semantics::Scope &hostScope); + const Fortran::semantics::Scope &hostScope, + llvm::function_ref<const std::vector<pft::Variable> &()> getVariables); + + const std::vector<pft::Variable> *getVariables() const { return variables; } /// Code gen the FIR for the local bindings for the host associated symbols /// for the host (parent) procedure using `builder`. @@ -68,6 +78,14 @@ class HostAssociations { /// Canonical vector of host associated global symbols. llvm::SetVector<const Fortran::semantics::Symbol *> globalSymbols; + /// Ordered bindings selected once when newly promoted globals occur. + /// These records borrow Program's cached variable list; std::map nodes and + /// finalized variable lists remain stable through all child bindings. + llvm::SmallVector<const pft::Variable *> globalBindings; + /// Whole-scope records reused by the host's own lowering as well. A null + /// pointer preserves the legacy path when no newly promoted globals occur. + const std::vector<pft::Variable> *variables = nullptr; + /// The type of the extra argument to be added to each internal procedure. mlir::Type argType; diff --git a/flang/include/flang/Lower/LoweringOptions.def b/flang/include/flang/Lower/LoweringOptions.def index 4590df1c8a6f8a..f4a0d15c0bb42c 100644 --- a/flang/include/flang/Lower/LoweringOptions.def +++ b/flang/include/flang/Lower/LoweringOptions.def @@ -49,6 +49,10 @@ ENUM_LOWERINGOPT(IntegerWrapAround, unsigned, 1, 0) /// If false, assume that the shapes/types/allocation-status match. ENUM_LOWERINGOPT(ReallocateLHS, unsigned, 1, 1) +/// If true, place eligible small main program scalars used directly by explicit +/// host OpenMP PARALLEL regions in static memory. On by default. +ENUM_LOWERINGOPT(OpenMPMainProgramGlobals, unsigned, 1, 1) + /// If true, initialize globals without initialization to zero. /// On by default. ENUM_LOWERINGOPT(InitGlobalZero, unsigned, 1, 1) diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index 981a78068c6589..dfa56ab3cddd5f 100644 --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -667,6 +667,10 @@ VariableList getScopeVariableList(const Fortran::semantics::Scope &scope); /// depends on. \p symbol itself will be the last variable in the list. VariableList getDependentVariableList(const Fortran::semantics::Symbol &); +/// Return the enclosing Program's stable variable-list cache. +template <typename A> +ScopeVariableListMap &getScopeVariableListMap(A &node); + struct FunctionLikeUnit; /// Create an ordered list of equivalence sets and variables from host /// [sub]module scopes of \p funit that are referenced in \p funit. This is @@ -750,7 +754,11 @@ struct FunctionLikeUnit : public ProgramUnit { void setHostAssociatedSymbols( const llvm::SetVector<const semantics::Symbol *> &symbols) { - hostAssociations.addSymbolsToBind(symbols, getScope()); + hostAssociations.addSymbolsToBind( + symbols, getScope(), [&]() -> const VariableList & { + return getScopeVariableList(getScope(), + getScopeVariableListMap(*this)); + }); } /// Return the host associations, if any, from the parent (host) procedure. @@ -900,7 +908,8 @@ struct Program { private: std::list<Units> units; semantics::CommonBlockList commonBlocks; - ScopeVariableListMap scopeVariableListMap; // module and submodule scopes + /// Module/submodule scopes and MAIN hosts with newly promoted globals. + ScopeVariableListMap scopeVariableListMap; }; /// Helper to get location from FunctionLikeUnit/ModuleLikeUnit begin/end diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h index cf102af95d03f9..046460c659db70 100644 --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -971,7 +971,10 @@ class Symbol { OmpThreadprivate, OmpDeclareReduction, OmpFlushed, OmpCriticalLock, OmpIfSpecified, OmpNone, OmpPreDetermined, OmpExplicit, OmpImplicit, OmpDependObject, OmpInclusiveScan, OmpExclusiveScan, OmpInScanReduction, - OmpUniform, OmpAssumesNoOpenmp); + OmpUniform, OmpAssumesNoOpenmp, + // Main-program storage needed by a host OpenMP outlined region. Set by + // lowering after semantic analysis, without changing data-sharing rules. + OmpMainGlobal); using Flags = common::EnumSet<Flag, Flag_enumSize>; const Scope &owner() const { return *owner_; } diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp index b06bca4930c103..daed2d87ae580c 100644 --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -2858,6 +2858,11 @@ bool IsAutomatic(const Symbol &original) { return false; } +bool IsSmallMainProgramVariable(const Symbol &symbol) { + return symbol.owner().kind() == Scope::Kind::MainProgram && + symbol.size() <= 32; +} + bool IsSaved(const Symbol &original) { const Symbol &symbol{GetAssociationRoot(original)}; const Scope &scope{symbol.owner()}; @@ -2888,7 +2893,7 @@ bool IsSaved(const Symbol &original) { (features.IsEnabled(common::LanguageFeature::SaveMainProgram) || (features.IsEnabled( common::LanguageFeature::SaveBigMainProgramVariables) && - symbol.size() > 32))) { + !IsSmallMainProgramVariable(symbol)))) { // With SaveBigMainProgramVariables, keeping all unsaved main program // variables of 32 bytes or less on the stack allows keeping numerical and // logical scalars, small scalar characters or derived, small arrays, and diff --git a/flang/lib/Frontend/CompilerInvocation.cpp b/flang/lib/Frontend/CompilerInvocation.cpp index 107fdd37dbd3e9..705b475350b73f 100644 --- a/flang/lib/Frontend/CompilerInvocation.cpp +++ b/flang/lib/Frontend/CompilerInvocation.cpp @@ -1891,6 +1891,12 @@ bool CompilerInvocation::createFromArgs( parsePreprocessorArgs(invoc.getPreprocessorOpts(), args); parseCodeGenArgs(invoc.getCodeGenOpts(), args, diags); success &= parseDoConcurrentMapping(invoc.getCodeGenOpts(), args, diags); + // Device DO CONCURRENT targets are generated after PFT construction. Keep + // host and device capture layouts identical when these targets are enabled. + invoc.loweringOpts.setOpenMPMainProgramGlobals( + !args.hasArg(clang::options::OPT_fno_openmp_main_program_globals) && + invoc.getCodeGenOpts().getDoConcurrentMapping() != + CodeGenOptions::DoConcurrentMappingKind::DCMK_Device); success &= parseDebugArgs(invoc.getCodeGenOpts(), args, diags); // Enable USE statement preservation for debug info if debug level is above @@ -2162,6 +2168,12 @@ CompilerInvocation::getSemanticsCtx( void CompilerInvocation::setLoweringOptions() { const CodeGenOptions &codegenOpts = getCodeGenOpts(); + // API clients may change the mapping after argument parsing. Reapply the + // device capture-layout restriction before constructing the PFT. + if (codegenOpts.getDoConcurrentMapping() == + CodeGenOptions::DoConcurrentMappingKind::DCMK_Device) + loweringOpts.setOpenMPMainProgramGlobals(false); + // Lower TRANSPOSE as a runtime call under -O0. loweringOpts.setOptimizeTranspose(codegenOpts.OptimizationLevel > 0); loweringOpts.setUnderscoring(codegenOpts.Underscoring); diff --git a/flang/lib/Frontend/ParserActions.cpp b/flang/lib/Frontend/ParserActions.cpp index 95f3ec7d5b9834..cc54f565e9516b 100644 --- a/flang/lib/Frontend/ParserActions.cpp +++ b/flang/lib/Frontend/ParserActions.cpp @@ -48,8 +48,10 @@ void dumpProvenance(CompilerInstance &ci) { void dumpPreFIRTree(CompilerInstance &ci) { auto &parseTree{*ci.getParsing().parseTree()}; - // Use default lowering options for PFT dump + // Use default lowering options, preserving the main-program globals setting. lower::LoweringOptions loweringOptions{}; + loweringOptions.setOpenMPMainProgramGlobals( + ci.getInvocation().getLoweringOpts().getOpenMPMainProgramGlobals()); if (auto ast{lower::createPFT(parseTree, ci.getSemanticsContext(), loweringOptions)}) { lower::dumpPFT(llvm::outs(), *ast); diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index f7c3796c266d9a..d6810f77d35248 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -6614,10 +6614,17 @@ class FirConverter : public Fortran::lower::AbstractConverter { Fortran::lower::pft::getHostModuleVariableList(funit)) instantiateVar(var, storeMap); + // New global host associations already borrow a stable scope-variable plan. + // Reuse those records rather than recomputing them for the host itself. + const auto *variables = funit.hostAssociations.getVariables(); + std::optional<Fortran::lower::pft::VariableList> localVariables; + if (!variables) { + variables = &localVariables.emplace( + Fortran::lower::pft::getScopeVariableList(scope)); + } // Map function equivalences and variables. mlir::Value primaryFuncResultStorage; - for (const Fortran::lower::pft::Variable &var : - Fortran::lower::pft::getScopeVariableList(scope)) { + for (const Fortran::lower::pft::Variable &var : *variables) { // Always instantiate aggregate storage blocks. if (var.isAggregateStore()) { instantiateVar(var, storeMap); @@ -6644,6 +6651,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { } } + // Preserve the legacy temporary's lifetime when no cached plan exists. + localVariables.reset(); // TODO: should use same mechanism as equivalence? // One blocking point is character entry returns that need special handling // since they are not locally allocated but come as argument. CHARACTER(*) diff --git a/flang/lib/Lower/HostAssociations.cpp b/flang/lib/Lower/HostAssociations.cpp index 496ff4bb5d7ccc..01e5371adf362f 100644 --- a/flang/lib/Lower/HostAssociations.cpp +++ b/flang/lib/Lower/HostAssociations.cpp @@ -22,6 +22,10 @@ #include "flang/Optimizer/Builder/Todo.h" #include "flang/Optimizer/Support/FatalError.h" #include "flang/Semantics/tools.h" +#include "llvm/ADT/DenseMap.h" +#include "llvm/ADT/DenseSet.h" +#include "llvm/Support/Debug.h" +#include <algorithm> #include <optional> #define DEBUG_TYPE "flang-host-assoc" @@ -540,10 +544,12 @@ static mlir::Value genTupleCoor(fir::FirOpBuilder &builder, mlir::Location loc, void Fortran::lower::HostAssociations::addSymbolsToBind( const llvm::SetVector<const Fortran::semantics::Symbol *> &symbols, - const Fortran::semantics::Scope &hostScope) { + const Fortran::semantics::Scope &hostScope, + llvm::function_ref<const std::vector<pft::Variable> &()> getVariables) { assert(tupleSymbols.empty() && globalSymbols.empty() && "must be initially empty"); this->hostScope = &hostScope; + bool hasNewGlobals = false; for (const auto *s : symbols) // GlobalOp are created for non-global threadprivate variable, // so considering them as globals. @@ -551,10 +557,59 @@ void Fortran::lower::HostAssociations::addSymbolsToBind( (*s).test(Fortran::semantics::Symbol::Flag::OmpThreadprivate)) { // The ultimate symbol is stored here so that global symbols from the // host scope can later be searched in this set. - globalSymbols.insert(&s->GetUltimate()); + const auto &ultimate = s->GetUltimate(); + globalSymbols.insert(&ultimate); + hasNewGlobals |= ultimate.test(semantics::Symbol::Flag::OmpMainGlobal); } else { tupleSymbols.insert(s); } + if (hasNewGlobals) { + variables = &getVariables(); + // Aggregate stores precede their aliases. Select backwards so each chosen + // alias requests its backing store using the already computed storage key. + // Resolve each USE/host association tail once, including rejected records. + // Direct objects require no cache lookup or allocation. + llvm::DenseMap<const semantics::Symbol *, const semantics::Symbol *> roots; + auto root = [&](const semantics::Symbol &symbol) { + const auto *original = &symbol; + llvm::SmallVector<const semantics::Symbol *> path; + while (true) { + const semantics::Symbol *next; + if (const auto *details = original->detailsIf<semantics::UseDetails>()) + next = &details->symbol(); + else if (const auto *details = + original->detailsIf<semantics::HostAssocDetails>()) + next = &details->symbol(); + else + break; + if (auto it = roots.find(original); it != roots.end()) { + original = it->second; + break; + } + path.push_back(original); + LLVM_DEBUG(llvm::dbgs() << "main-global binding association\n"); + original = next; + } + for (const auto *entry : path) + roots.try_emplace(entry, original); + return original; + }; + llvm::DenseSet<AggregateStoreKey> stores; + for (const auto &variable : llvm::reverse(*variables)) { + const auto *original = + variable.hasSymbol() ? root(variable.getSymbol()) : nullptr; + if (original && globalSymbols.contains(original)) { + globalBindings.push_back(&variable); + if (variable.isAlias()) + stores.insert({&original->owner(), variable.getAliasOffset()}); + } else if (variable.isAggregateStore() && variable.isGlobal() && + stores.contains({variable.getOwningScope(), + variable.getAggregateStore().getOffset()})) { + globalBindings.push_back(&variable); + } + } + std::reverse(globalBindings.begin(), globalBindings.end()); + } } void Fortran::lower::HostAssociations::hostProcedureBindings( @@ -593,18 +648,24 @@ void Fortran::lower::HostAssociations::internalProcedureBindings( // The host scope variable list is required to deal with host variables // that are equivalenced and requires instantiating the right global // AggregateStore. - for (auto &hostVariable : pft::getScopeVariableList(*hostScope)) - if ((hostVariable.isAggregateStore() && hostVariable.isGlobal()) || - (hostVariable.hasSymbol() && - globalSymbols.contains(&hostVariable.getSymbol().GetUltimate()))) { - Fortran::lower::instantiateVariable(converter, hostVariable, symMap, - storeMap); - // Generate threadprivate Op for host associated variables. - if (hostVariable.hasSymbol() && - hostVariable.getSymbol().test( - Fortran::semantics::Symbol::Flag::OmpThreadprivate)) - Fortran::lower::genThreadprivateOp(converter, hostVariable); - } + auto bind = [&](const pft::Variable &hostVariable) { + Fortran::lower::instantiateVariable(converter, hostVariable, symMap, + storeMap); + if (hostVariable.hasSymbol() && + hostVariable.getSymbol().test( + Fortran::semantics::Symbol::Flag::OmpThreadprivate)) + Fortran::lower::genThreadprivateOp(converter, hostVariable); + }; + if (variables) { + for (const auto *variable : globalBindings) + bind(*variable); + } else { + for (const auto &variable : pft::getScopeVariableList(*hostScope)) + if ((variable.isAggregateStore() && variable.isGlobal()) || + (variable.hasSymbol() && + globalSymbols.contains(&variable.getSymbol().GetUltimate()))) + bind(variable); + } } if (tupleSymbols.empty()) return; diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp index 1ecce4b82d2a46..f36f2bd2865977 100644 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -7,15 +7,18 @@ //===----------------------------------------------------------------------===// #include "flang/Lower/PFTBuilder.h" +#include "flang/Evaluate/traverse.h" #include "flang/Lower/LoweringOptions.h" #include "flang/Lower/Support/Utils.h" #include "flang/Parser/dump-parse-tree.h" +#include "flang/Parser/openmp-utils.h" #include "flang/Parser/parse-tree-visitor.h" #include "flang/Semantics/openmp-utils.h" #include "flang/Semantics/semantics.h" #include "flang/Semantics/tools.h" #include "llvm/ADT/DenseSet.h" #include "llvm/ADT/IntervalMap.h" +#include "llvm/ADT/STLFunctionalExtras.h" #include "llvm/Support/CommandLine.h" #include "llvm/Support/Debug.h" #include <algorithm> @@ -83,6 +86,293 @@ struct UnwrapStmt<parser::UnlabeledStatement<A>> { void dumpScope(const semantics::Scope *scope, int depth = -1); #endif +/// Collect direct storage uses while retaining complex expressions on the +/// existing storage path. Skipped nodes do not seed selection from their +/// children. +struct MainSymbolVisitor + : public evaluate::AllTraverse<MainSymbolVisitor, true, false> { + using Base = evaluate::AllTraverse<MainSymbolVisitor, true, false>; + /// Borrow the callback for one synchronous expression walk. + explicit MainSymbolVisitor( + llvm::function_ref<void(const semantics::Symbol &)> callback) + : Base{*this}, callback{callback} {} + using Base::operator(); + /// Stream each direct symbol occurrence without building subtree sets. + bool operator()(const semantics::Symbol &symbol) const { + LLVM_DEBUG(llvm::dbgs() << "main-global symbol\n"); + callback(symbol); + return true; + } + /// TODO: Collect runtime dependencies of calls, constructors, PDT parameters + /// and coarray references, excluding metadata and folded payloads and + /// avoiding copies of selector expressions. + bool operator()(const semantics::DerivedTypeSpec &) const { return true; } + /// Computed derived constants cannot add direct storage uses. + bool operator()(const evaluate::Constant<evaluate::SomeDerived> &) const { + return true; + } + bool operator()(const evaluate::CoarrayRef &) const { return true; } + bool operator()(const evaluate::ProcedureRef &) const { return true; } + /// Defined assignment is a call; ordinary assignment retains both operands. + bool operator()(const evaluate::Assignment &assignment) const { + if (std::holds_alternative<evaluate::ProcedureRef>(assignment.u)) + return true; + return Base::operator()(assignment); + } + bool operator()(const evaluate::StructureConstructor &) const { return true; } + template <typename A> + bool operator()(const evaluate::ArrayConstructor<A> &) const { + return true; + } + /// Avoid syntax collection after deliberately skipping resolved calls. + bool Pre(const parser::CallStmt &) { return false; } + /// SHARED names are metadata rather than accesses to object storage. + bool Pre(const parser::LocalitySpec::Shared &) { return false; } + template <typename A> + bool Pre(const A &node) { + if constexpr (parser::HasTypedExpr<A>::value) { + if (const auto *expr = semantics::GetExpr(nullptr, node)) { + collect(*expr); + return false; + } + } else if constexpr (parser::HasTypedAssignment<A>::value) { + if (node.typedAssignment && node.typedAssignment->v) { + collect(*node.typedAssignment->v); + return false; + } + } + return true; + } + bool Pre(const parser::Name &name) { + if (name.symbol) + callback(*name.symbol); + return false; + } + template <typename A> + void Post(const A &) {} + +private: + /// Traverse the outer typed expression once before returning to parser Walk. + template <typename A> + void collect(const A &expr) { + LLVM_DEBUG(llvm::dbgs() << "main-global expression\n"); + (*this)(expr); + } + llvm::function_ref<void(const semantics::Symbol &)> callback; +}; + +/// Select small MAIN scalars directly used inside explicit host PARALLEL +/// regions during PFT construction, before host associations are classified. +/// Unsupported contexts retain the existing storage policy for the whole MAIN. +class MainGlobalAnalysis { +public: + /// Disabled analyses do not walk statements or semantic scopes. + explicit MainGlobalAnalysis(bool enabled) : enabled{enabled} {} + /// Determine membership once per procedure, including serially called + /// internal procedures that contain their own PARALLEL regions. + void enterFunction(const lower::pft::FunctionLikeUnit &unit) { + if (!enabled) + return; + const auto &scope = unit.getScope(); + relevant = unit.isMainProgram(); + if (relevant) { + mainScope = &scope; + // Bare MAIN SAVE already gives every eligible object global storage. + if (scope.hasSAVE()) { + enabled = false; + relevant = false; + return; + } + } + // Internal subprograms cannot themselves contain internal subprograms. + // Check only the immediate PFT parent, without semantic submodule ancestry. + if (!relevant && mainScope) + if (const auto *host = + unit.parent.getIf<lower::pft::FunctionLikeUnit>()) { + LLVM_DEBUG(llvm::dbgs() << "main-global function parent\n"); + relevant = host->isMainProgram(); + } + if (relevant && scope.symbol()) { + const auto &symbol = *scope.symbol(); + if (symbol.test(semantics::Symbol::Flag::OmpDeclareTarget)) + unsupported = true; + } + } + /// Observe directive headers before their bodies for the whole-MAIN fallback. + /// TARGET leaves of combined constructs are checked by enterOpenMP(). + void directive(llvm::omp::Directive id) { + if (!relevant || unsupported) + return; + switch (id) { + case llvm::omp::Directive::OMPD_metadirective: + case llvm::omp::Directive::OMPD_declare_target: + case llvm::omp::Directive::OMPD_target_data: + case llvm::omp::Directive::OMPD_target_enter_data: + case llvm::omp::Directive::OMPD_target_exit_data: + case llvm::omp::Directive::OMPD_target_update: + unsupported = true; + return; + default: + return; + } + } + /// Track nesting independently of fallback state, keeping entry and exit + /// balanced when an unsupported context is encountered inside PARALLEL. + void enterOpenMP(const parser::OpenMPConstruct &construct) { + if (!relevant) + return; + bool parallel = false; + for (auto leaf : llvm::omp::getLeafConstructsOrSelf( + parser::omp::GetOmpDirectiveName(construct).v)) { + parallel |= leaf == llvm::omp::Directive::OMPD_parallel; + unsupported |= leaf == llvm::omp::Directive::OMPD_target; + } + parallels.push_back(parallel); + parallelDepth += parallel; + } + /// Restore the enclosing PARALLEL nesting after its PFT construct. + void exitOpenMP() { + if (relevant) { + parallelDepth -= parallels.back(); + parallels.pop_back(); + } + } + /// Visit executable leaves in PARALLEL, including WHERE/FORALL statements + /// without PFT evaluations. Clauses do not seed selection; an IF action has + /// its own evaluation and must not be visited a second time. + template <typename A> + void collect(const A &node) { + if (!relevant || unsupported || !parallelDepth) + return; + auto collectSymbol = [&](const semantics::Symbol &symbol) { + const auto *original = root(symbol); + if (&original->owner() == mainScope) + objects.insert(original); + }; + MainSymbolVisitor visitor{collectSymbol}; + if constexpr (std::is_same_v<A, lower::pft::Evaluation>) { + node.visit([&](const auto &stmt) { + if constexpr (std::is_same_v<std::decay_t<decltype(stmt)>, + parser::IfStmt>) + parser::Walk(std::get<parser::ScalarLogicalExpr>(stmt.t), visitor); + else if constexpr (lower::pft::isActionStmt< + std::decay_t<decltype(stmt)>> || + lower::pft::isConstructStmt< + std::decay_t<decltype(stmt)>>) + parser::Walk(stmt, visitor); + }); + } else { + parser::Walk(node, visitor); + } + } + /// Filter whole original objects, then set storage flags. Set iteration + /// order cannot affect these independent decisions or generated declarations. + void finalize() { + if (unsupported || objects.empty()) + return; + objects.remove_if( + [](const semantics::Symbol *symbol) { return !canUseGlobal(*symbol); }); + if (objects.empty()) + return; + for (const auto &set : mainScope->equivalenceSets()) + for (const auto &object : set) + if (objects.erase(&object.symbol) && objects.empty()) + return; + // Retain legacy storage for the privatization/locality flags below and for + // NAMELIST members throughout MAIN, including unused internal procedures. + // This deliberately avoids analyzing individual copy bindings. + // LocalityReduce uses the original accumulator, so it remains eligible. + const semantics::Symbol::Flags excluded{ + semantics::Symbol::Flag::OmpPrivate, + semantics::Symbol::Flag::OmpFirstPrivate, + semantics::Symbol::Flag::OmpLastPrivate, + semantics::Symbol::Flag::OmpLinear, + semantics::Symbol::Flag::OmpReduction, + semantics::Symbol::Flag::OmpInReduction, + semantics::Symbol::Flag::OmpGroupPrivate, + semantics::Symbol::Flag::OmpCopyPrivate, + semantics::Symbol::Flag::OmpPreDetermined, + semantics::Symbol::Flag::LocalityLocal, + semantics::Symbol::Flag::LocalityLocalInit, + semantics::Symbol::Flag::InNamelist}; + llvm::SmallVector<const semantics::Scope *> scopes{mainScope}; + while (!scopes.empty()) { + const auto *scope = scopes.pop_back_val(); + LLVM_DEBUG(llvm::dbgs() << "main-global scope\n"); + // This sweep only removes candidates; stop resolving after exhaustion. + for (const auto &[name, symbol] : *scope) + if ((symbol->flags() & excluded).any() && + objects.erase(root(*symbol)) && objects.empty()) + return; + for (const auto &child : scope->children()) + scopes.push_back(&child); + } + for (const auto *symbol : objects) + const_cast<semantics::Symbol *>(symbol)->set( + semantics::Symbol::Flag::OmpMainGlobal); + } + +private: + /// Memoize every USE/host association tail across collection and filtering. + /// ASSOCIATE entities deliberately retain their own identity. + const semantics::Symbol *root(const semantics::Symbol &symbol) { + const auto *original = &symbol; + llvm::SmallVector<const semantics::Symbol *> path; + while (true) { + if (auto it = roots.find(original); it != roots.end()) { + original = it->second; + break; + } + path.push_back(original); + LLVM_DEBUG(llvm::dbgs() << "main-global association\n"); + if (const auto *details = + original->detailsIf<semantics::HostAssocDetails>()) + original = &details->symbol(); + else if (const auto *details = + original->detailsIf<semantics::UseDetails>()) + original = &details->symbol(); + else + break; + } + for (const auto *entry : path) + roots.try_emplace(entry, original); + LLVM_DEBUG(llvm::dbgs() << "main-global reference: " + << toStringRef(original->name()) << '\n'); + return original; + } + /// Leave arrays, descriptors, derived types, automatic objects and special + /// runtime/device storage on their existing lowering paths. + static bool canUseGlobal(const semantics::Symbol &symbol) { + // Privatizers and MIF coarray handles append these fragments to object + // names. Leave potential collisions on their existing local-storage path. + const auto name = toStringRef(symbol.name()); + if (name.contains("_private_") || name.contains("_firstprivate_") || + name.ends_with("_coarray_handle")) + return false; + const auto *object = symbol.detailsIf<semantics::ObjectEntityDetails>(); + const auto *type = symbol.GetType(); + return object && !object->IsArray() && type && type->AsIntrinsic() && + semantics::IsSmallMainProgramVariable(symbol) && symbol.size() && + !semantics::IsAllocatableOrPointer(symbol) && + !semantics::IsAutomatic(symbol) && !lower::symbolIsGlobal(symbol) && + !symbol.test(semantics::Symbol::Flag::OmpThreadprivate) && + !symbol.test(semantics::Symbol::Flag::CrayPointer) && + !symbol.test(semantics::Symbol::Flag::CrayPointee) && + !symbol.test( + semantics::Symbol::Flag::OmpDeclarativeAllocateDirective) && + !symbol.test( + semantics::Symbol::Flag::OmpExecutableAllocateDirective); + } + bool enabled; + bool relevant = false; + bool unsupported = false; + const semantics::Scope *mainScope = nullptr; + unsigned parallelDepth = 0; + llvm::SmallVector<bool> parallels; + llvm::DenseMap<const semantics::Symbol *, const semantics::Symbol *> roots; + llvm::DenseSet<const semantics::Symbol *> objects; +}; + /// The instantiation of a parse tree visitor (Pre and Post) is extremely /// expensive in terms of compile and link time. So one goal here is to /// limit the bridge to one such instantiation. @@ -92,17 +382,39 @@ class PFTBuilder { const lower::LoweringOptions &loweringOptions) : pgm{std::make_unique<lower::pft::Program>( semanticsContext.GetCommonBlocks())}, - semanticsContext{semanticsContext}, loweringOptions{loweringOptions} { + semanticsContext{semanticsContext}, loweringOptions{loweringOptions}, + mainGlobals{loweringOptions.getOpenMPMainProgramGlobals() && + semanticsContext.languageFeatures().IsEnabled( + common::LanguageFeature::OpenMP) && + !semanticsContext.langOptions().OpenMPSimd && + !semanticsContext.langOptions().OpenMPIsTargetDevice && + // TODO: Support host regions in OpenACC/CUDA units once + // late routine targets and device captures are resolved. + !semanticsContext.languageFeatures().IsEnabled( + common::LanguageFeature::OpenACC) && + !semanticsContext.languageFeatures().IsEnabled( + common::LanguageFeature::CUDA) && + !semanticsContext.languageFeatures().IsEnabled( + common::LanguageFeature::SaveMainProgram) && + !semanticsContext.languageFeatures().IsEnabled( + common::LanguageFeature::DefaultSave)} { lower::pft::PftNode pftRoot{*pgm.get()}; pftParentStack.push_back(pftRoot); } /// Get the result - std::unique_ptr<lower::pft::Program> result() { return std::move(pgm); } + std::unique_ptr<lower::pft::Program> result() { + mainGlobals.finalize(); + return std::move(pgm); + } template <typename A> constexpr bool Pre(const A &a) { - if constexpr (lower::pft::isFunctionLike<A>) { + if constexpr (std::is_base_of_v<parser::OmpDirectiveSpecification, A>) { + if (currentFunctionUnit && !interfaceBodyLevel) + mainGlobals.directive(a.DirId()); + return true; + } else if constexpr (lower::pft::isFunctionLike<A>) { return enterFunction(a, semanticsContext); } else if constexpr (lower::pft::isConstruct<A> || lower::pft::isDirective<A>) { @@ -140,6 +452,11 @@ class PFTBuilder { }, }, stmt.unwrapped.u); + } else if constexpr (std::is_same_v<T, parser::WhereStmt> || + std::is_same_v<T, parser::ForallStmt>) { + // Nested single statements have no PFT evaluation. Keep PFT + // construction unchanged and collect their expressions here instead. + mainGlobals.collect(stmt.unwrapped); } else if constexpr (std::is_same_v<T, parser::UseStmt>) { // Process USE statement for debug info generation processUseStmt(stmt.unwrapped); @@ -523,6 +840,7 @@ class PFTBuilder { pushEvaluationList(&unit.evaluationList); pftParentStack.emplace_back(unit); currentFunctionUnit = &unit; + mainGlobals.enterFunction(unit); LLVM_DEBUG(dumpScope(&unit.getScope())); return true; } @@ -581,6 +899,8 @@ class PFTBuilder { bool enterConstructOrDirective(const A &constructOrDirective) { lower::pft::Evaluation &eval = addEvaluation( lower::pft::Evaluation{constructOrDirective, pftParentStack.back()}); + if constexpr (std::is_same_v<A, parser::OpenMPConstruct>) + mainGlobals.enterOpenMP(constructOrDirective); eval.evaluationList.reset(new lower::pft::EvaluationList); pushEvaluationList(eval.evaluationList.get()); pftParentStack.emplace_back(eval); @@ -600,6 +920,8 @@ class PFTBuilder { rewriteIfGotos(); rewriteTrailingCycle(); auto *eval = constructAndDirectiveStack.back(); + if (eval->isA<parser::OpenMPConstruct>()) + mainGlobals.exitOpenMP(); if (eval->isExecutableDirective() && !isOpenMPLoopConstruct(eval)) { // A construct at the end of an (unstructured) OpenACC or OpenMP // construct region must have an exit target inside the region. @@ -673,8 +995,10 @@ class PFTBuilder { lower::pft::FunctionLikeUnit *owningProcedure = eval.getOwningProcedure(); evaluationListStack.back()->emplace_back(std::move(eval)); lower::pft::Evaluation *p = &evaluationListStack.back()->back(); - if (p->isActionStmt() || p->isConstructStmt() || p->isEndStmt() || - p->isExecutableDirective()) { + const bool isActionOrConstruct = p->isActionStmt() || p->isConstructStmt(); + if (owningProcedure && isActionOrConstruct) + mainGlobals.collect(*p); + if (isActionOrConstruct || p->isEndStmt() || p->isExecutableDirective()) { if (lastLexicalEvaluation) { lastLexicalEvaluation->lexicalSuccessor = p; p->printIndex = lastLexicalEvaluation->printIndex + 1; @@ -1396,6 +1720,7 @@ class PFTBuilder { std::vector<lower::pft::PftNode> pftParentStack; const semantics::SemanticsContext &semanticsContext; const lower::LoweringOptions &loweringOptions; + MainGlobalAnalysis mainGlobals; llvm::SmallVector<bool> containsStmtStack{}; lower::pft::ContainedUnitList *containedUnitList{}; @@ -1778,7 +2103,10 @@ bool Fortran::lower::definedInCommonBlock(const semantics::Symbol &sym) { /// Is the symbol `sym` a global? bool Fortran::lower::symbolIsGlobal(const semantics::Symbol &sym) { - return (semantics::IsSaved(sym) && semantics::CanCUDASymbolBeGlobal(sym)) || + const auto &ultimate = sym.GetUltimate(); + return ((semantics::IsSaved(ultimate) || + ultimate.test(semantics::Symbol::Flag::OmpMainGlobal)) && + semantics::CanCUDASymbolBeGlobal(sym)) || lower::definedInCommonBlock(sym) || semantics::IsNamedConstant(sym); } @@ -2299,8 +2627,12 @@ void Fortran::lower::pft::BlockDataUnit::dump() const { const lower::pft::VariableList & lower::pft::getScopeVariableList(const semantics::Scope &scope, ScopeVariableListMap &map) { - LLVM_DEBUG(llvm::dbgs() << "\ngetScopeVariableList of [sub]module scope <" - << &scope << "> " << scope.GetName() << "\n"); + LLVM_DEBUG( + llvm::dbgs() << "\ngetScopeVariableList of " + << (scope.kind() == semantics::Scope::Kind::MainProgram + ? "main program" + : "[sub]module") + << " scope <" << &scope << "> " << scope.GetName() << "\n"); auto iter = map.find(&scope); if (iter == map.end()) { SymbolDependenceAnalysis sda(scope); diff --git a/flang/test/Driver/openmp-main-program-globals.f90 b/flang/test/Driver/openmp-main-program-globals.f90 new file mode 100644 index 00000000000000..251dc34343013f --- /dev/null +++ b/flang/test/Driver/openmp-main-program-globals.f90 @@ -0,0 +1,11 @@ +! The opt-out is FC1-only: -Xflang forwards it, direct driver use is rejected, +! and driver --help omits it. +! REQUIRES: module-independent +! RUN: %flang -### -fopenmp -Xflang -fno-openmp-main-program-globals -S %s 2>&1 | FileCheck %s --check-prefix=FORWARD +! RUN: not %flang -### -fopenmp -fno-openmp-main-program-globals -S %s 2>&1 | FileCheck %s --check-prefix=DRIVER +! RUN: %flang --help | FileCheck %s --check-prefix=HELP --implicit-check-not='-fno-openmp-main-program-globals' +! FORWARD: "-fc1"{{.*}} "-fno-openmp-main-program-globals" +! DRIVER: error: unknown argument '-fno-openmp-main-program-globals'; +! DRIVER-SAME: did you mean '-Xflang -fno-openmp-main-program-globals'? +! HELP: OPTIONS: +end diff --git a/flang/test/Lower/OpenMP/default-clause-byref.f90 b/flang/test/Lower/OpenMP/default-clause-byref.f90 index 87fca12c33b229..dc78d6b4c10f94 100644 --- a/flang/test/Lower/OpenMP/default-clause-byref.f90 +++ b/flang/test/Lower/OpenMP/default-clause-byref.f90 @@ -1,11 +1,12 @@ +! RUN: %flang_fc1 -emit-hlfir -fopenmp -fno-openmp-main-program-globals -mmlir --force-byref-reduction %s -o - | FileCheck %s --check-prefixes=CHECK,OFF --implicit-check-not='fir.global internal @_QFEz{{[[:space:]]}}' ! This test checks lowering of OpenMP parallel directive ! with `DEFAULT` clause present. ! RUN: %flang_fc1 -emit-hlfir -fopenmp -mmlir --force-byref-reduction %s -o - \ -! RUN: | FileCheck %s +! RUN: | FileCheck %s --check-prefixes=CHECK,ON ! RUN: bbc -fopenmp -emit-hlfir --force-byref-reduction %s -o - \ -! RUN: | FileCheck %s +! RUN: | FileCheck %s --check-prefixes=CHECK,ON !CHECK: omp.private {type = firstprivate} @[[W_FIRSTPRIVATIZER:_QFEw_firstprivate_i32]] : i32 copy { !CHECK: ^bb0(%[[ORIG_W:.*]]: !fir.ref<i32>, %[[PRIV_W:.*]]: !fir.ref<i32>): @@ -41,7 +42,8 @@ !CHECK: %[[X_DECL:.*]]:2 = hlfir.declare %[[X]] uniq_name("_QFEx") : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) !CHECK: %[[Y:.*]] = fir.alloca i32 <{bindc_name = "y", uniq_name = "_QFEy"}> !CHECK: %[[Y_DECL:.*]]:2 = hlfir.declare %[[Y]] uniq_name("_QFEy") : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) -!CHECK: %[[Z:.*]] = fir.alloca i32 <{bindc_name = "z", uniq_name = "_QFEz"}> +!ON: %[[Z:.*]] = fir.address_of(@_QFEz) : !fir.ref<i32> +!OFF: %[[Z:.*]] = fir.alloca i32 <{bindc_name = "z", uniq_name = "_QFEz"}> !CHECK: %[[Z_DECL:.*]]:2 = hlfir.declare %[[Z]] uniq_name("_QFEz") : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) !CHECK: omp.parallel private( !CHECK-SAME: @[[X_FIRSTPRIVATIZER]] %[[X_DECL]]#0 -> %[[PRIVATE_X:.*]], @[[Y_PRIVATIZER]] %[[Y_DECL]]#0 -> %[[PRIVATE_Y:.*]], @[[W_PRIVATIZER]] %[[W_DECL]]#0 -> %[[PRIVATE_W:.*]] : {{.*}}) { diff --git a/flang/test/Lower/OpenMP/default-clause.f90 b/flang/test/Lower/OpenMP/default-clause.f90 index 456330c3314eeb..d8eaf01a6afdde 100644 --- a/flang/test/Lower/OpenMP/default-clause.f90 +++ b/flang/test/Lower/OpenMP/default-clause.f90 @@ -1,11 +1,12 @@ +! RUN: %flang_fc1 -emit-hlfir -fopenmp -fno-openmp-main-program-globals %s -o - | FileCheck %s --check-prefixes=CHECK,OFF --implicit-check-not='fir.global internal @_QFEz{{[[:space:]]}}' ! This test checks lowering of OpenMP parallel directive ! with `DEFAULT` clause present. ! RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - \ -! RUN: | FileCheck %s +! RUN: | FileCheck %s --check-prefixes=CHECK,ON ! RUN: bbc -fopenmp -emit-hlfir %s -o - \ -! RUN: | FileCheck %s +! RUN: | FileCheck %s --check-prefixes=CHECK,ON !CHECK: func @_QQmain() attributes {fir.bindc_name = "DEFAULT_CLAUSE_LOWERING"} { @@ -15,7 +16,8 @@ !CHECK: %[[X_DECL:.*]]:2 = hlfir.declare %[[X]] uniq_name("_QFEx") : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) !CHECK: %[[Y:.*]] = fir.alloca i32 <{bindc_name = "y", uniq_name = "_QFEy"}> !CHECK: %[[Y_DECL:.*]]:2 = hlfir.declare %[[Y]] uniq_name("_QFEy") : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) -!CHECK: %[[Z:.*]] = fir.alloca i32 <{bindc_name = "z", uniq_name = "_QFEz"}> +!ON: %[[Z:.*]] = fir.address_of(@_QFEz) : !fir.ref<i32> +!OFF: %[[Z:.*]] = fir.alloca i32 <{bindc_name = "z", uniq_name = "_QFEz"}> !CHECK: %[[Z_DECL:.*]]:2 = hlfir.declare %[[Z]] uniq_name("_QFEz") : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) !CHECK: omp.parallel private({{.*firstprivate.*}} {{.*}}#0 -> %[[PRIVATE_X:.*]], {{.*}} {{.*}}#0 -> %[[PRIVATE_Y:.*]], {{.*}} {{.*}}#0 -> %[[PRIVATE_W:.*]] : {{.*}}) { !CHECK: %[[PRIVATE_X_DECL:.*]]:2 = hlfir.declare %[[PRIVATE_X]] uniq_name("_QFEx") : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) diff --git a/flang/test/Lower/OpenMP/main-program-globals-cost.f90 b/flang/test/Lower/OpenMP/main-program-globals-cost.f90 new file mode 100644 index 00000000000000..f91cbe05344865 --- /dev/null +++ b/flang/test/Lower/OpenMP/main-program-globals-cost.f90 @@ -0,0 +1,126 @@ +! Check reuse of storage-selection and host-binding analysis results. Trace +! checks require assertions; the IR checks also run without the asserts feature. +! REQUIRES: module-independent +! RUN: split-file %s %t +! RUN: %if asserts %{ bbc -fopenmp -pft-test -debug-only=flang-pft %t/saved.f90 2>&1 | FileCheck %s --check-prefix=OFF %} +! RUN: %flang_fc1 -fopenmp -fno-automatic -emit-hlfir %if asserts %{ -mllvm -debug-only=flang-pft %} %t/nested.f90 -o %t.auto > %t.auto-trace 2>&1 +! RUN: %if asserts %{ FileCheck %s --check-prefix=OFF --allow-empty < %t.auto-trace %} +! RUN: FileCheck %s --check-prefix=SAVED < %t.auto +! RUN: %if asserts %{ bbc -fopenmp -pft-test -debug-only=flang-pft %t/pruned.f90 2>&1 | FileCheck %s --check-prefix=PRUNED %} +! RUN: %if asserts %{ bbc -fopenmp -pft-test -debug-only=flang-pft %t/nested.f90 2>&1 | FileCheck %s --check-prefix=EXPR %} +! RUN: %if asserts %{ bbc -fopenmp -fno-openmp-main-program-globals -pft-test -debug-only=flang-pft %t/nested.f90 2>&1 | FileCheck %s --check-prefix=OFF %} +! RUN: %flang_fc1 -fopenmp -emit-hlfir -module-dir %t %if asserts %{ -mllvm -debug-only=flang-lower-bridge,flang-lower-variable,flang-pft,flang-host-assoc %} %t/owner.f90 -o %t.owner > %t.trace 2>&1 +! RUN: FileCheck %s --check-prefix=IR < %t.owner +! RUN: FileCheck %s --check-prefix=UNUSED < %t.owner +! RUN: %if asserts %{ FileCheck %s --check-prefix=STORE < %t.trace %} +! RUN: %if asserts %{ FileCheck %s --check-prefix=CACHE < %t.trace %} +! RUN: %if asserts %{ FileCheck %s --check-prefix=ROOTS < %t.trace %} +! RUN: %if asserts %{ FileCheck %s --check-prefix=TAILS < %t.trace %} +! RUN: %flang_fc1 -fopenmp -fsave-main-program -emit-hlfir %if asserts %{ -mllvm -debug-only=flang-pft %} %t/nested.f90 -o %t.saved > %t.save-trace 2>&1 +! RUN: %if asserts %{ FileCheck %s --check-prefix=OFF --allow-empty < %t.save-trace %} +! RUN: FileCheck %s --check-prefix=SAVED < %t.saved +! SAVED-DAG: fir.global internal @_QFEsink : i32 +! SAVED-DAG: fir.global internal @_QFEx1 : i32 +! EXPR-COUNT-18: main-global symbol +! EXPR-NOT: main-global symbol +! EXPR: Program +! EXPR-NOT: main-global symbol +! OFF-NOT: {{^main-global }} +! CACHE-NOT: getScopeVariableList of [sub]program|block scope {{.*}} P{{$}} +! CACHE-NOT: getScopeVariableList of main program scope +! CACHE: getScopeVariableList of main program scope +! CACHE-NOT: getScopeVariableList of main program scope +! CACHE-NOT: getScopeVariableList of [sub]program|block scope {{.*}} P{{$}} +! STORE: [bridge - startNewFunction] worker +! STORE-NOT: instantiateVariable: interval{{.*}} c, +! STORE-DAG: instantiateVariable: interval{{.*}} a, global +! STORE-DAG: instantiateVariable: interval{{.*}} alias, global +! STORE-NOT: instantiateVariable: interval +! STORE: [bridge - endNewFunction +! STORE: [bridge - startNewFunction] other +! STORE-NOT: instantiateVariable: interval{{.*}} c, +! STORE-DAG: instantiateVariable: interval{{.*}} a, global +! STORE-DAG: instantiateVariable: interval{{.*}} alias, global +! STORE-NOT: instantiateVariable: interval +! STORE: [bridge - endNewFunction +! IR-LABEL: func.func private @_QFPworker() +! IR-DAG: fir.address_of(@_QFEalias) +! IR-DAG: fir.address_of(@_QFEx) +! IR: omp.parallel +! IR: return +! IR-LABEL: func.func private @_QFPother() +! IR-DAG: %[[MODULE:[^ ]+]] = fir.address_of(@_QMneededEa) +! IR-DAG: %[[COMMON:[^ ]+]] = fir.address_of(@block_) +! IR-DAG: %[[USED:[^ ]+]]:2 = hlfir.declare {{.*}} storage(%[[MODULE]][0]) uniq_name("_QMneededEb") +! IR-DAG: %[[SHARED:[^ ]+]]:2 = hlfir.declare {{.*}} storage(%[[COMMON]][0]) uniq_name("_QFEshared") +! IR: omp.parallel +! IR-DAG: fir.load %[[USED]]#0 : +! IR-DAG: fir.load %[[SHARED]]#0 : +! IR: return +! UNUSED-LABEL: func.func private @_QFPworker() +! UNUSED-NOT: fir.address_of(@_QM{{(neededEc|tail0E)}} +! UNUSED: return +! UNUSED-LABEL: func.func private @_QFPother() +!--- nested.f90 +! Visit nested operands once; SAVE policies and the opt-out bypass selection. +program p +integer :: x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,sink +!$omp parallel +if (x1>0) sink=x1+(x2+(x3+(x4+(x5+(x6+(x7+(x8+( & + x9+(x10+(x11+(x12+(x13+(x14+(x15+x16)))))))))))))) +!$omp end parallel +end program +!--- owner.f90 +! Reuse the MAIN variable list and shared USE tails. Bind only the required +! globals and EQUIVALENCE/COMMON stores in each internal procedure. +module needed + integer :: a,b,c,d; equivalence(a,b),(c,d) +end module +module tail0; integer :: v; end module; module tail1; use tail0, only: v; end module +module tail2; use tail1, only: v; end module; module tail3; use tail2, only: v; end module +program p + use needed, only: unused=>a,used=>b + use tail3, only: a1=>v,a2=>v,a3=>v,a4=>v + integer,save :: backing(2),alias; equivalence(backing(1),alias) + integer :: x,shared; common /block/ shared + alias=3; x=7; used=11; shared=13; call worker(); call other() +contains + subroutine worker() +!$omp parallel num_threads(1) + print *,x,alias +!$omp end parallel + end subroutine; subroutine other() +!$omp parallel num_threads(1) + print *,x,alias,used,shared +!$omp end parallel + end subroutine; end program +! Four MAIN entities, one module object and six OpenMP proxies are resolved once. +! ROOTS-COUNT-11: main-global association +! ROOTS-NOT: main-global association +! Four renames share three USE edges; two needed aliases add two links. +! TAILS-COUNT-9: main-global binding association +! TAILS-NOT: main-global binding association +! PRUNED-NOT: main-global reference: image +! PRUNED: main-global reference: direct +! PRUNED-NOT: main-global reference: image +! PRUNED: Program +! PRUNED-NOT: main-global reference: image +!--- pruned.f90 +! Do not select the coarray image selector; direct remains a candidate. +program p; type t(k) + integer,kind :: k=4; integer :: payload=1 + end type; type(t),parameter :: c=t() + integer :: direct,image,co[*] +!$omp parallel + print *,direct,co[image],c +!$omp end parallel +end program +!--- saved.f90 +! A bare SAVE makes the new storage-selection analysis unnecessary. +program p + integer :: x + save +!$omp parallel + x=1 +!$omp end parallel +end program diff --git a/flang/test/Lower/OpenMP/main-program-globals-fallback.f90 b/flang/test/Lower/OpenMP/main-program-globals-fallback.f90 new file mode 100644 index 00000000000000..7e4d0b40651750 --- /dev/null +++ b/flang/test/Lower/OpenMP/main-program-globals-fallback.f90 @@ -0,0 +1,115 @@ +! REQUIRES: module-independent +! RUN: split-file %s %t +! RUN: %flang_fc1 -fopenmp -fopenmp-version=52 -cpp -DREGION '-DDIRECTIVE=target map(tofrom:x)' '-DEND_DIRECTIVE=end target' -emit-hlfir %t/internal.f90 -o - | FileCheck %s --check-prefix=KEEP --implicit-check-not='fir.global internal @_QFEx{{[[:space:]]}}' +! RUN: %flang_fc1 -fopenmp -fopenmp-version=52 -cpp -DREGION '-DDIRECTIVE=target parallel map(tofrom:x)' '-DEND_DIRECTIVE=end target parallel' -emit-hlfir %t/internal.f90 -o - | FileCheck %s --check-prefix=KEEP --implicit-check-not='fir.global internal @_QFEx{{[[:space:]]}}' +! RUN: %flang_fc1 -fopenmp -fopenmp-version=52 -cpp -DREGION '-DDIRECTIVE=target data map(tofrom:x)' '-DEND_DIRECTIVE=end target data' -emit-hlfir %t/internal.f90 -o - | FileCheck %s --check-prefix=KEEP --implicit-check-not='fir.global internal @_QFEx{{[[:space:]]}}' +! RUN: %flang_fc1 -fopenmp -fopenmp-version=52 -cpp '-DDIRECTIVE=target enter data map(to:x)' -emit-hlfir %t/internal.f90 -o - | FileCheck %s --check-prefix=KEEP --implicit-check-not='fir.global internal @_QFEx{{[[:space:]]}}' +! RUN: %flang_fc1 -fopenmp -fopenmp-version=52 -cpp '-DDIRECTIVE=target exit data map(delete:x)' -emit-hlfir %t/internal.f90 -o - | FileCheck %s --check-prefix=KEEP --implicit-check-not='fir.global internal @_QFEx{{[[:space:]]}}' +! RUN: %flang_fc1 -fopenmp -fopenmp-version=52 -cpp '-DDIRECTIVE=target update to(x)' -emit-hlfir %t/internal.f90 -o - | FileCheck %s --check-prefix=KEEP --implicit-check-not='fir.global internal @_QFEx{{[[:space:]]}}' +! RUN: %flang_fc1 -fopenmp -fopenmp-version=52 -cpp '-DDIRECTIVE=declare target' -emit-hlfir %t/internal.f90 -o - | FileCheck %s --check-prefix=KEEP --implicit-check-not='fir.global internal @_QFEx{{[[:space:]]}}' +! RUN: %flang_fc1 -fopenmp -fopenmp-version=52 -emit-hlfir %t/meta.f90 -o - | FileCheck %s --check-prefix=KEEP --implicit-check-not='fir.global internal @_QFEx{{[[:space:]]}}' +! RUN: %flang_fc1 -fopenmp -cpp -DDIRECTIVE=barrier -emit-hlfir %t/internal.f90 -o - | FileCheck %s --check-prefix=GLOBAL +! RUN: %flang_fc1 -fopenmp -emit-hlfir %t/external.f90 -o - | FileCheck %s --check-prefixes=EXTERNAL,GLOBAL +! RUN: %flang_fc1 -fopenmp -fdo-concurrent-to-openmp=device -fopenmp-targets=nvptx64-nvidia-cuda -emit-fir %t/generated-target.f90 -o - | FileCheck %s --check-prefix=DEVICE --implicit-check-not='fir.global internal @_QFEx{{[[:space:]]}}' +! RUN: %flang_fc1 -fopenmp -fdo-concurrent-to-openmp=device -fopenmp-is-target-device -fopenmp-targets=nvptx64-nvidia-cuda -emit-fir %t/generated-target.f90 -o - | FileCheck %s --check-prefix=DEVICE --implicit-check-not='fir.global internal @_QFEx{{[[:space:]]}}' +! RUN: bbc -fopenmp -fdo-concurrent-to-openmp=device -emit-fir %t/generated-target.f90 -o - | FileCheck %s --check-prefix=DEVICE --implicit-check-not='fir.global internal @_QFEx{{[[:space:]]}}' +! RUN: %flang_fc1 -fopenmp -fdo-concurrent-to-openmp=host -emit-fir %t/generated-target.f90 -o - | FileCheck %s --check-prefix=HOST +! KEEP: fir.alloca i32 {{.*}}bindc_name = "x" +! EXTERNAL-LABEL: func.func @_QQmain() +! EXTERNAL: fir.address_of(@_QFEx) +! EXTERNAL-LABEL: func.func @_QPoutside() +! EXTERNAL: omp.target_data +! GLOBAL: fir.global internal @_QFEx : i32 +!--- internal.f90 +! Each CPP offload variant independently preserves MAIN storage when the +! directive is in an internal procedure. BARRIER is the host-only control. +program p + integer :: x +!$omp parallel + print *,x +!$omp end parallel + call worker() +contains + subroutine worker() +!$omp DIRECTIVE +#ifdef REGION + x=1 +!$omp END_DIRECTIVE +#endif + end subroutine +end program +!--- meta.f90 +! Even a metadirective selecting NOTHING currently preserves MAIN storage. +program p + integer :: x +!$omp parallel + print *,x +!$omp end parallel +!$omp metadirective when(user={condition(.true.)}: nothing) + x=1 +end program +!--- external.f90 +! Offload in another external procedure or an interface body must not disable +! global storage selection in MAIN. +program p + integer :: x + interface + subroutine declared() +!$omp declare target + end subroutine + end interface +!$omp parallel + print *,x +!$omp end parallel +end program +subroutine outside() + integer :: a(4) +!$omp target data map(tofrom:a) + a=1 +!$omp end target data +end subroutine +! Device DO CONCURRENT keeps the host tuple and maps it into the target. Host +! mapping still permits globals and removes the unused tuple argument from f. +! DEVICE-LABEL: func.func @_QQmain() +! DEVICE: fir.alloca i32 {{.*}}bindc_name = "x" +! DEVICE: %[[HOST_TUPLE:[^ ]+]] = fir.alloca tuple<!fir.ref<i32>> +! DEVICE: %[[TUPLE_MAP:[^ ]+]] = omp.map.info var_ptr(%[[HOST_TUPLE]] : !fir.ref<tuple<!fir.ref<i32>>> +! DEVICE: omp.target +! DEVICE-SAME: map_entries({{.*}}%[[TUPLE_MAP]] -> %[[MAPPED_TUPLE:[^, ]+]]{{.*}} : !fir.ref<index>, !fir.ref<index>, !fir.ref<index>, !fir.ref<i32>, !fir.ref<tuple<!fir.ref<i32>>>, !fir.ref<!fir.array<4xi32>>, !fir.ref<index>) +! DEVICE: %[[TUPLE:[^ ]+]] = fir.declare %[[MAPPED_TUPLE]] uniq_name("") : (!fir.ref<tuple<!fir.ref<i32>>>) +! DEVICE: fir.call @_QFPf({{[^,]*}}, %[[TUPLE]]) +! DEVICE-LABEL: func.func private @_QFPf( +! DEVICE-SAME: !fir.ref<tuple<!fir.ref<i32>>> +! HOST-LABEL: func.func @_QQmain() +! HOST: fir.address_of(@_QFEx) +! HOST: fir.call @_QFPf({{[^,]*}}) +! HOST-LABEL: func.func private @_QFPf( +! HOST-SAME: !fir.ref<i32> {{.*}}) -> i32 +! HOST: fir.global internal @_QFEx +!--- generated-target.f90 +program p + implicit none + integer :: x,i,a(4) + x=7 + a=0 +!$omp parallel num_threads(1) + print *,x +!$omp end parallel + do concurrent(i=1:4) + block + integer :: v + v=f(i) + a(i)=v + end block + end do + if(any(a/=[2,3,4,5])) stop 1 + call host_use() +contains + pure integer function f(j) + integer,intent(in) :: j + f=j+1 + end function + subroutine host_use() + print *,x + end subroutine +end program diff --git a/flang/test/Lower/OpenMP/main-program-globals.f90 b/flang/test/Lower/OpenMP/main-program-globals.f90 new file mode 100644 index 00000000000000..5216061533fd87 --- /dev/null +++ b/flang/test/Lower/OpenMP/main-program-globals.f90 @@ -0,0 +1,367 @@ +! REQUIRES: module-independent +! RUN: split-file %s %t +! RUN: %flang_fc1 -fopenmp -emit-hlfir %t/miniweather.f90 -o %t.on +! RUN: FileCheck %s --check-prefix=ON < %t.on +! RUN: FileCheck %s --check-prefix=MODULE --implicit-check-not='fir.alloca tuple' < %t.on +! RUN: bbc -fopenmp -emit-hlfir %t/miniweather.f90 -o - | FileCheck %s --check-prefix=ON +! RUN: bbc -fopenmp -fno-openmp-main-program-globals -emit-hlfir %t/miniweather.f90 -o - | FileCheck %s --check-prefix=OFF --implicit-check-not='fir.global internal @_QFE' +! RUN: %flang_fc1 -fopenmp -fno-openmp-main-program-globals -emit-hlfir %t/miniweather.f90 -o - | FileCheck %s --check-prefix=OFF --implicit-check-not='fir.global internal @_QFE' +! RUN: %flang_fc1 -fopenmp -fopenmp-is-target-device -emit-hlfir %t/miniweather.f90 -o - | FileCheck %s --check-prefix=MODULE --implicit-check-not='fir.global internal @_QFE' +! RUN: %flang_fc1 -fopenmp-simd -emit-hlfir %t/miniweather.f90 -o - | FileCheck %s --check-prefix=MODULE --implicit-check-not='fir.global internal @_QFE' +! RUN: %flang_fc1 -fopenmp -fopenacc -emit-hlfir %t/miniweather.f90 -o - | FileCheck %s --check-prefix=OFF --implicit-check-not='fir.global internal @_QFE' +! RUN: %flang_fc1 -fopenmp -x cuda -emit-hlfir %t/miniweather.f90 -o - | FileCheck %s --check-prefix=OFF --implicit-check-not='fir.global internal @_QFE' +! RUN: bbc -fopenmp -fopenacc -emit-hlfir %t/miniweather.f90 -o - | FileCheck %s --check-prefix=OFF --implicit-check-not='fir.global internal @_QFE' +! RUN: bbc -fopenmp -fcuda -emit-hlfir %t/miniweather.f90 -o - | FileCheck %s --check-prefix=OFF --implicit-check-not='fir.global internal @_QFE' +! RUN: %if aarch64-registered-target %{ %flang_fc1 -triple aarch64-unknown-linux-gnu -O3 -ffast-math -fopenmp -emit-llvm %t/miniweather.f90 -o - | FileCheck %s --check-prefix=OPT %} +! RUN: %if asserts %{ %flang_fc1 -fopenmp -fdebug-dump-pft -mllvm -debug-only=flang-pft %t/miniweather.f90 2>&1 | FileCheck %s --check-prefix=PFT_ON %} +! RUN: %if asserts %{ %flang_fc1 -fopenmp -fno-openmp-main-program-globals -fdebug-dump-pft -mllvm -debug-only=flang-pft %t/miniweather.f90 2>&1 | FileCheck %s --check-prefix=PFT_OFF %} +! RUN: %flang_fc1 -fopenmp -emit-hlfir %t/objects.f90 -o %t.objects +! RUN: FileCheck %s --check-prefix=OBJECTS < %t.objects +! RUN: FileCheck %s --check-prefix=MODULE --implicit-check-not='fir.global internal @_QFE{{(array|matrix|storage|i|j|ap|ptr|record|private_value|listed|eq1|eq2|x|y|serial_only|x_private_i32|y_firstprivate_i32|allocated|address|pointee|actual|element|extent|rhs|field)[[:space:]]}}' < %t.objects +! RUN: %flang_fc1 -fopenmp -fno-openmp-main-program-globals -emit-hlfir %t/objects.f90 -o %t.off +! RUN: FileCheck %s --check-prefix=BOUNDARY < %t.off +! RUN: FileCheck %s --check-prefix=MODULE --implicit-check-not='fir.global internal @_QFE{{(text|if_condition|if_action|where_value|forall_value)[[:space:]]}}' < %t.off +! RUN: FileCheck %s --check-prefix=EXPRESSIONS < %t.objects +! RUN: FileCheck %s --check-prefix=MODULE --implicit-check-not='fir.global internal @_QFE{{(actual|element|extent|rhs|field)[[:space:]]}}' < %t.objects +! RUN: %flang_fc1 -emit-hlfir %t/objects.f90 -o %t.serial +! RUN: FileCheck %s --check-prefix=BOUNDARY < %t.serial +! RUN: FileCheck %s --check-prefix=MODULE --implicit-check-not='fir.global internal @_QFE{{(integer_value|real_value|complex_value|logical_value|text|if_condition|if_action|where_value|forall_value|direct)[[:space:]]}}' < %t.serial +! RUN: %flang_fc1 -fopenmp -mllvm -strict-fir-volatile-verifier -emit-hlfir %t/mixed.f90 -o %t.mixed +! RUN: FileCheck %s --check-prefix=MIXED < %t.mixed +! RUN: FileCheck %s --check-prefix=PROPERTIES < %t.mixed +! RUN: %flang_fc1 -fopenmp -emit-hlfir %t/callbacks.f90 -o %t.callbacks +! RUN: FileCheck %s --check-prefix=CALLBACK < %t.callbacks +! RUN: FileCheck %s --check-prefix=MODULE --implicit-check-not='fir.alloca tuple' --implicit-check-not='fir.host_assoc' < %t.callbacks +! RUN: %flang_fc1 -fopenmp -fno-openmp-main-program-globals -emit-hlfir %t/callbacks.f90 -o - | FileCheck %s --check-prefix=BOX_OFF --implicit-check-not='fir.global internal @_QFEx{{[[:space:]]}}' +! RUN: %flang_fc1 -fopenmp -emit-fir %t/callbacks.f90 -o - | fir-opt --flang-licm | FileCheck %s --check-prefix=LICM +! RUN: %flang_fc1 -fopenmp -fcoarray -emit-hlfir %t/coarray.f90 -o %t.on +! RUN: FileCheck %s --check-prefix=COARRAY < %t.on +! RUN: FileCheck %s --check-prefix=MODULE --implicit-check-not='fir.global internal @_QFEa_coarray_handle{{[[:space:]]}}' < %t.on +! RUN: %flang_fc1 -fopenmp -fcoarray -emit-llvm %t/coarray.f90 -o - | FileCheck %s --check-prefix=LLVM +! MODULE: module + +! Check globals and removal of the host tuple for MAIN scalars referenced in an +! internal procedure's PARALLEL region. Disabled modes retain legacy storage; +! OPT checks reciprocal computation before the outlined loop. +! ON-LABEL: func.func @_QQmain() +! ON: fir.call @_QFPworker() +! ON-LABEL: func.func private @_QFPworker() +! ON-DAG: fir.address_of(@_QFEdx) +! ON-DAG: fir.address_of(@_QFEdz) +! ON: omp.parallel +! ON-DAG: fir.global internal @_QFEdx : f64 +! ON-DAG: fir.global internal @_QFEdz : f64 +! OFF-LABEL: func.func @_QQmain() +! OFF-DAG: fir.alloca f64 {{.*}}bindc_name = "dx" +! OFF-DAG: fir.alloca f64 {{.*}}bindc_name = "dz" +! OFF: fir.alloca tuple +! OFF-LABEL: func.func private @_QFPworker( +! OFF-SAME: fir.host_assoc +! OPT-LABEL: define internal void @_QFPworker..omp_par( +! OPT: omp_collapsed.body.lr.ph: +! OPT-DAG: %[[DX:[^ ]+]] = load double, ptr @_QFEdx +! OPT-DAG: %[[DZ:[^ ]+]] = load double, ptr @_QFEdz +! OPT-DAG: %[[RX:[^ ]+]] = fdiv fast double 1.000000e+00, %[[DX]] +! OPT-DAG: %[[RZ:[^ ]+]] = fdiv fast double 1.000000e+00, %[[DZ]] +! OPT: br label %[[BODY:omp_collapsed.body]] +! OPT: [[BODY]]: +! OPT-NOT: fdiv +! OPT: fmul fast double {{.*}}, %[[RX]] +! OPT-NOT: fdiv +! OPT: fmul fast double {{.*}}, %[[RZ]] +! OPT-NOT: fdiv +! OPT: br i1 +! PFT_ON: {{^main-global symbol$}} +! PFT_OFF-NOT: {{^main-global }} +! PFT_OFF: Program +! PFT_OFF-NOT: {{^main-global }} +!--- miniweather.f90 +program p +integer :: nx,nz,i_beg,k_beg +real(8) :: dx,dz +nx=4 +nz=3 +i_beg=1 +k_beg=1 +read *,dx +read *,dz +call worker() +contains +subroutine worker() +integer :: i,k +real(8) :: a(4,3) +!$omp parallel do simd collapse(2) private(i,k) +do k=1,nz + do i=1,nx + a(i,k)=(i+i_beg)/dx+(k+k_beg)/dz + end do +end do +!$omp end parallel do simd +print *,a +end subroutine +end program + +! Select intrinsic scalars in nested regions and statement expressions while +! preserving excluded objects and private copies. Calls and constructors do not +! seed selection. The 32/33-byte CHARACTER cases distinguish new selection from +! existing static storage. serial_only checks collection stops at END PARALLEL. +! OBJECTS-LABEL: func.func @_QQmain() +! OBJECTS: fir.alloca i32 {{.*}}bindc_name = "serial_only" +! OBJECTS: omp.parallel +! OBJECTS-DAG: fir.global internal @_QFEif_condition : i32 +! OBJECTS-DAG: fir.global internal @_QFEif_action : i32 +! OBJECTS-DAG: fir.global internal @_QFEwhere_value : i32 +! OBJECTS-DAG: fir.global internal @_QFEforall_value : i32 +! OBJECTS-DAG: fir.global internal @_QFEinteger_value : i64 +! OBJECTS-DAG: fir.global internal @_QFEreal_value : f64 +! OBJECTS-DAG: fir.global internal @_QFEcomplex_value : complex<f64> +! OBJECTS-DAG: fir.global internal @_QFElogical_value : !fir.logical<4> +! OBJECTS-DAG: fir.global internal @_QFEtext : !fir.char<1,32> +! OBJECTS-DAG: fir.global internal @_QFElarge : !fir.char<1,33> +! OBJECTS-DAG: fir.global internal @_QFEsaved : i32 +! BOUNDARY-DAG: fir.alloca i32 {{.*}}bindc_name = "direct" +! BOUNDARY-DAG: fir.alloca !fir.char<1,32> {{.*}}bindc_name = "text" +! BOUNDARY-DAG: fir.global internal @_QFElarge : !fir.char<1,33> +! EXPRESSIONS-LABEL: func.func @_QQmain() +! EXPRESSIONS: omp.parallel +! EXPRESSIONS: fir.call @_QFPsink( +! EXPRESSIONS: fir.call @_QFPassign( +! EXPRESSIONS: fir.global internal @_QFEdirect : i32 +! BOUNDARY-DAG: fir.global internal @_QFEsaved : i32 +!--- objects.f90 +program p + integer(8) :: integer_value + real(8) :: real_value + complex(8) :: complex_value + logical :: logical_value + integer, save :: saved + character(32) :: text + character(33) :: large + type t + integer :: n + end type + type(t) :: record,value + interface assignment(=) + procedure assign + end interface + integer :: direct,actual,element,extent,rhs,field + integer :: array(2),matrix(2,2),private_value,listed,eq1,eq2,x,y + integer :: if_condition,if_action,serial_only,where_value,forall_value,i,j + integer :: x_private_i32,y_firstprivate_i32,allocated,pointee,storage(1) + integer(8) :: address + pointer(address,pointee) +!$omp allocate(allocated) + integer, allocatable :: ap + integer, pointer :: ptr + equivalence(eq1,eq2) + namelist /group/ listed + direct=1; actual=2; element=3 + extent=4; rhs=5; field=6 + saved=1; storage=1; address=loc(storage); if_condition=1 + array=1; matrix=0; where_value=2; forall_value=3 +!$omp parallel + print *,array,ap,ptr,record,private_value,listed,eq1,eq2 + print *,x_private_i32,y_firstprivate_i32,allocated,address,pointee,saved + print *,direct,abs(actual),[element],[character(extent)::] + print *,t(field) + call sink(actual) + value=rhs + where(array>0) + where(array<3) array=where_value + end where + forall(i=1:2) + forall(j=1:2) matrix(i,j)=forall_value + end forall +!$omp single +!$omp parallel if(.false.) + print *,integer_value,real_value,complex_value,logical_value,text,large +!$omp end parallel +!$omp end single + if (if_condition>0) if_action=1 +!$omp end parallel +!$omp parallel private(private_value,x) firstprivate(y) + private_value=x+y +!$omp end parallel + serial_only=1 +contains + subroutine sink(n) + integer :: n + print *,n + end subroutine + subroutine assign(to,from) + type(t),intent(out) :: to + integer,intent(in) :: from + to%n=from + end subroutine +end program + +! Keep the array in the host tuple while promoted scalars use globals. Preserve +! EQUIVALENCE offsets and DATA initialization, threadprivate bindings, and +! VOLATILE/ASYNCHRONOUS attributes. +! MIXED-LABEL: func.func @_QQmain() +! MIXED: %[[A:[^: ]+]]:2 = hlfir.declare {{.*}}uniq_name("_QFEa") +! MIXED: %[[T:[^ ]+]] = fir.alloca tuple<!fir.box<!fir.array<2xi32>>> +! MIXED: %[[S:[^ ]+]] = fir.coordinate_of %[[T]], +! MIXED: %[[B:[^ ]+]] = fir.embox %[[A]]#0 +! MIXED: fir.store %[[B]] to %[[S]] +! MIXED: fir.call @_QFPworker(%[[T]]) +! MIXED-LABEL: func.func private @_QFPworker( +! MIXED-SAME: %[[H:[^: ]+]]: +! MIXED: %[[G:[^ ]+]] = fir.address_of(@_QFEalias) +! MIXED: %[[BYTES:[^ ]+]] = fir.convert %[[G]] : (!fir.ref<!fir.array<2xi32>>) -> !fir.ref<!fir.array<8xi8>> +! MIXED: %[[FOUR:[^ ]+]] = arith.constant 4 : index +! MIXED: %[[OFFSET:[^ ]+]] = fir.coordinate_of %[[BYTES]], %[[FOUR]] +! MIXED: %[[PTR:[^ ]+]] = fir.convert %[[OFFSET]] +! MIXED: %[[ALIAS:[^: ]+]]:2 = hlfir.declare %[[PTR]] storage(%[[BYTES]][4]) uniq_name("_QFEalias") +! MIXED: %[[TLS:[^: ]+]]:2 = hlfir.declare {{.*}}uniq_name("_QFEtls") +! MIXED: %[[ADDR:[^ ]+]] = omp.threadprivate %[[TLS]]#0 +! MIXED: %[[LOCAL:[^: ]+]]:2 = hlfir.declare %[[ADDR]] uniq_name("_QFEtls") +! MIXED: %[[C:[^ ]+]] = fir.coordinate_of %[[H]], +! MIXED: %[[BOX:[^ ]+]] = fir.load %[[C]] +! MIXED: %[[ARRAY:[^ ]+]] = fir.box_addr %[[BOX]] +! MIXED: hlfir.declare %[[ARRAY]]({{.*}}) uniq_name("_QFEa") fortran_attrs<host_assoc> +! MIXED: fir.load %[[LOCAL]]#0 +! MIXED: hlfir.assign {{.*}} to %[[LOCAL]]#0 +! MIXED: omp.parallel +! MIXED: %[[THREAD:[^ ]+]] = omp.threadprivate %[[TLS]]#0 +! MIXED: %[[PRIVATE:[^: ]+]]:2 = hlfir.declare %[[THREAD]] uniq_name("_QFEtls") +! MIXED: fir.load %[[ALIAS]]#0 +! MIXED: fir.load %[[PRIVATE]]#0 +! MIXED: fir.global internal @_QFEalias +! MIXED: %[[INIT:[^ ]+]] = fir.undefined !fir.array<2xi32> +! MIXED: %[[ELEVEN:[^ ]+]] = arith.constant 11 : i32 +! MIXED: %[[FIRST:[^ ]+]] = fir.insert_value %[[INIT]], %[[ELEVEN]], [0 : index] +! MIXED: %[[TWENTYTWO:[^ ]+]] = arith.constant 22 : i32 +! MIXED: %[[SECOND:[^ ]+]] = fir.insert_value %[[FIRST]], %[[TWENTYTWO]], [1 : index] +! MIXED: fir.has_value %[[SECOND]] +! PROPERTIES-LABEL: func.func private @_QFPworker( +! PROPERTIES-DAG: hlfir.declare {{.*}}uniq_name("_QFEav") fortran_attrs<asynchronous, internal_assoc> +! PROPERTIES-DAG: hlfir.declare {{.*}}uniq_name("_QFEv") fortran_attrs<volatile, internal_assoc> +!--- mixed.f90 +program p + integer :: x,a(2) + integer,volatile :: v + integer,asynchronous :: av + integer, save :: backing(2),alias,tls + equivalence(backing(2),alias) + data backing /11,22/ +!$omp threadprivate(tls) + x=7; v=1; av=2 + a=1; alias=2; tls=3 + call worker() +contains + subroutine worker() + tls=tls+1 +!$omp parallel + print *,x,a,alias,tls,v,av +!$omp end parallel + end subroutine +end program + +! Removing the last host capture also updates procedure boxes and direct and +! indirect calls. Loads must stay in loops that call a modifying sibling. +! CALLBACK-LABEL: func.func @_QQmain() +! CALLBACK: %[[P:[^: ]+]]:2 = hlfir.declare {{.*}}uniq_name("_QFEcallback") +! CALLBACK: %[[WORKER:[^ ]+]] = fir.address_of(@_QFPworker) : () -> () +! CALLBACK: %[[BOX:[^ ]+]] = fir.emboxproc %[[WORKER]] : +! CALLBACK: fir.store %[[BOX]] to %[[P]]#0 +! CALLBACK: %[[ACTUAL:[^ ]+]] = fir.address_of(@_QFPworker) +! CALLBACK: %[[ARG:[^ ]+]] = fir.emboxproc %[[ACTUAL]] : +! CALLBACK: fir.call @_QPinvoke(%[[ARG]]) +! CALLBACK: omp.parallel +! CALLBACK: fir.call @_QFPworker() +! CALLBACK: %[[LOADED:[^ ]+]] = fir.load %[[P]]#0 +! CALLBACK: %[[CODE:[^ ]+]] = fir.box_addr %[[LOADED]] +! CALLBACK: fir.call %[[CODE]]() +! BOX_OFF: %[[HOST:[^ ]+]] = fir.alloca tuple<!fir.ref<i32>> +! BOX_OFF: %[[PTR:[^ ]+]] = fir.address_of(@_QFPworker) +! BOX_OFF: %[[BOX:[^ ]+]] = fir.emboxproc %[[PTR]], %[[HOST]] +! BOX_OFF: fir.store %[[BOX]] +! BOX_OFF: %[[ACTUAL:[^ ]+]] = fir.address_of(@_QFPworker) +! BOX_OFF: %[[ARG:[^ ]+]] = fir.emboxproc %[[ACTUAL]], %[[HOST]] +! BOX_OFF: fir.call @_QPinvoke(%[[ARG]]) +! BOX_OFF: func.func private @_QFPworker({{.*}}fir.host_assoc +! LICM-LABEL: func.func @_QQmain() +! LICM: %[[MAIN_X:[^ ]+]] = fir.declare {{.*}}uniq_name("_QFEx") fortran_attrs<internal_assoc> +! LICM: fir.do_loop +! LICM-NOT: {{^ *[}]}} +! LICM: fir.call @_QFPbump( +! LICM-NOT: {{^ *[}]}} +! LICM: fir.load %[[MAIN_X]] : +! LICM: {{^ *[}]}} +! LICM-LABEL: func.func private @_QFPaccumulate( +! LICM: %[[X:[^ ]+]] = fir.declare {{.*}}uniq_name("_QFEx") fortran_attrs<internal_assoc> +! LICM: fir.do_loop +! LICM-NOT: {{^ *[}]}} +! LICM: fir.call @_QFPbump( +! LICM-NOT: {{^ *[}]}} +! LICM: fir.load %[[X]] : +! LICM: {{^ *[}]}} +!--- callbacks.f90 +program p + interface + subroutine invoke(proc) + external :: proc + end subroutine + end interface + procedure(), pointer :: callback + integer :: x,i,s + x=7 + callback=>worker + call invoke(worker) +!$omp parallel num_threads(1) + print *,x + call worker() + call callback() +!$omp end parallel + x=0 + call accumulate() + x=0 + s=0 + do i=1,3 + call bump() + s=s+x + end do + print *,s +contains + subroutine worker() + print *,x + end subroutine + subroutine accumulate() + integer :: i,s + s=0 + do i=1,3 + call bump() + s=s+x + end do + print *,s + end subroutine + subroutine bump() + x=x+1 + end subroutine +end program +subroutine invoke(proc) + external :: proc + call proc() +end subroutine + +! Preserve the scalar whose name would collide with a coarray handle; a longer +! suffix and an ordinary scalar remain eligible for global storage. +! COARRAY: fir.alloca i32 {{.*}}bindc_name = "a_coarray_handle" +! COARRAY-DAG: fir.global internal @_QFEa_coarray_handle_extra : i32 +! COARRAY-DAG: fir.global internal @_QFEordinary : i32 +! LLVM: @_QFEa_coarray_handle = linkonce global %{{[^ ]*prif_coarray_handle_type}} +! LLVM: call void @llvm.memmove{{.*}}(ptr @_QFEa_coarray_handle, ptr {{.*}}, i64 8, i1 false) +!--- coarray.f90 +program p + integer,allocatable :: a[:] + integer :: a_coarray_handle,a_coarray_handle_extra,ordinary + a_coarray_handle=17 + a_coarray_handle_extra=19 + ordinary=23 + allocate(a[*]) +!$omp parallel num_threads(1) + print *,a_coarray_handle,a_coarray_handle_extra,ordinary +!$omp end parallel + deallocate(a) +end program diff --git a/flang/test/Lower/volatile-openmp1.f90 b/flang/test/Lower/volatile-openmp1.f90 index 8852437cc51614..f7b961b0694757 100644 --- a/flang/test/Lower/volatile-openmp1.f90 +++ b/flang/test/Lower/volatile-openmp1.f90 @@ -1,4 +1,5 @@ -! RUN: bbc --strict-fir-volatile-verifier -fopenmp %s -o - | FileCheck %s +! RUN: bbc --strict-fir-volatile-verifier -fopenmp -fno-openmp-main-program-globals %s -o - | FileCheck %s --check-prefixes=CHECK,OFF --implicit-check-not='fir.global internal @_QFEn{{[[:space:]]}}' +! RUN: bbc --strict-fir-volatile-verifier -fopenmp %s -o - | FileCheck %s --check-prefixes=CHECK,ON program main implicit none integer,volatile::a @@ -23,7 +24,8 @@ program main ! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_5]] uniq_name("_QFEa") fortran_attrs<volatile> : (!fir.ref<i32, volatile>) -> (!fir.ref<i32, volatile>, !fir.ref<i32, volatile>) ! CHECK: %[[VAL_7:.*]] = fir.alloca i32 <{bindc_name = "i", uniq_name = "_QFEi"}> ! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_7]] uniq_name("_QFEi") : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) -! CHECK: %[[VAL_9:.*]] = fir.alloca i32 <{bindc_name = "n", uniq_name = "_QFEn"}> +! ON: %[[VAL_9:.*]] = fir.address_of(@_QFEn) : !fir.ref<i32> +! OFF: %[[VAL_9:.*]] = fir.alloca i32 <{bindc_name = "n", uniq_name = "_QFEn"}> ! CHECK: %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_9]] uniq_name("_QFEn") : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) ! CHECK: hlfir.assign %[[VAL_2]] to %[[VAL_6]]#0 : i32, !fir.ref<i32, volatile> ! CHECK: hlfir.assign %[[VAL_1]] to %[[VAL_10]]#0 : i32, !fir.ref<i32> diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp index c7904ba3560c28..9bbdb4306012f8 100644 --- a/flang/tools/bbc/bbc.cpp +++ b/flang/tools/bbc/bbc.cpp @@ -148,6 +148,12 @@ static llvm::cl::opt<bool> enableOpenMP("fopenmp", llvm::cl::desc("enable openmp"), llvm::cl::init(false)); +static llvm::cl::opt<bool> disableOpenMPMainProgramGlobals( + "fno-openmp-main-program-globals", + llvm::cl::desc("Disable static storage selection for small main program " + "scalars used by explicit host OpenMP PARALLEL regions"), + llvm::cl::init(false)); + static llvm::cl::opt<bool> enableOpenMPDevice("fopenmp-is-target-device", llvm::cl::desc("enable openmp device compilation"), @@ -499,9 +505,13 @@ static llvm::LogicalResult convertFortranSourceToMLIR( return mlir::success(); } + // Generated device targets require the same capture layout on host and + // device. + Fortran::lower::LoweringOptions loweringOptions{}; + loweringOptions.setOpenMPMainProgramGlobals( + !disableOpenMPMainProgramGlobals && + enableDoConcurrentToOpenMPConversion.getValue() != "device"); if (pftDumpTest) { - // Use default lowering options for PFT dump test - Fortran::lower::LoweringOptions loweringOptions{}; if (auto ast = Fortran::lower::createPFT(parseTree, semanticsContext, loweringOptions)) { Fortran::lower::dumpPFT(llvm::outs(), *ast); @@ -521,8 +531,6 @@ static llvm::LogicalResult convertFortranSourceToMLIR( fir::KindMapping kindMap( &ctx, llvm::ArrayRef<fir::KindTy>{fir::fromDefaultKinds(defKinds)}); std::string targetTriple = targetMachine.getTargetTriple().normalize(); - // Use default lowering options for bbc. - Fortran::lower::LoweringOptions loweringOptions{}; loweringOptions.setNoPPCNativeVecElemOrder(enableNoPPCNativeVecElemOrder); loweringOptions.setIntegerWrapAround(integerWrapAround); loweringOptions.setInitGlobalZero(initGlobalZero); diff --git a/flang/unittests/Frontend/CompilerInstanceTest.cpp b/flang/unittests/Frontend/CompilerInstanceTest.cpp index 5f95d2f3edeb7f..ba31bf79df8bb4 100644 --- a/flang/unittests/Frontend/CompilerInstanceTest.cpp +++ b/flang/unittests/Frontend/CompilerInstanceTest.cpp @@ -118,4 +118,36 @@ TEST(CompilerInstance, clang::options::OPT_fno_openacc_default_none_scalars_strict) .str()); } + +TEST(CompilerInvocation, MainProgramGlobalsRespectLateDeviceMapping) { + CompilerInstance compInst; + compInst.createDiagnostics(); + auto &invocation = compInst.getInvocation(); + const char *args[] = {"-fopenmp"}; + ASSERT_TRUE(CompilerInvocation::createFromArgs( + invocation, args, compInst.getDiagnostics())); + + using Mapping = CodeGenOptions::DoConcurrentMappingKind; + invocation.getCodeGenOpts().setDoConcurrentMapping(Mapping::DCMK_Host); + invocation.setLoweringOptions(); + EXPECT_TRUE(invocation.getLoweringOpts().getOpenMPMainProgramGlobals()); + + invocation.getCodeGenOpts().setDoConcurrentMapping(Mapping::DCMK_Device); + invocation.setLoweringOptions(); + EXPECT_FALSE(invocation.getLoweringOpts().getOpenMPMainProgramGlobals()); +} + +TEST(CompilerInvocation, MainProgramGlobalsPreserveExplicitDisable) { + CompilerInstance compInst; + compInst.createDiagnostics(); + auto &invocation = compInst.getInvocation(); + const char *args[] = {"-fopenmp", "-fno-openmp-main-program-globals"}; + ASSERT_TRUE(CompilerInvocation::createFromArgs( + invocation, args, compInst.getDiagnostics())); + + invocation.getCodeGenOpts().setDoConcurrentMapping( + CodeGenOptions::DoConcurrentMappingKind::DCMK_Host); + invocation.setLoweringOptions(); + EXPECT_FALSE(invocation.getLoweringOpts().getOpenMPMainProgramGlobals()); +} } // namespace >From 5685c887d2938705b8ea3294f21160e155258f4f Mon Sep 17 00:00:00 2001 From: Sergey Shcherbinin <[email protected]> Date: Thu, 29 Oct 2026 15:46:40 +0400 Subject: [PATCH 2/2] Comment removed Co-authored-by: Tarun Prabhu <[email protected]> --- flang/include/flang/Semantics/symbol.h | 2 -- 1 file changed, 2 deletions(-) diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h index 046460c659db70..1de5a7b74a42ec 100644 --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -972,8 +972,6 @@ class Symbol { OmpIfSpecified, OmpNone, OmpPreDetermined, OmpExplicit, OmpImplicit, OmpDependObject, OmpInclusiveScan, OmpExclusiveScan, OmpInScanReduction, OmpUniform, OmpAssumesNoOpenmp, - // Main-program storage needed by a host OpenMP outlined region. Set by - // lowering after semantic analysis, without changing data-sharing rules. OmpMainGlobal); using Flags = common::EnumSet<Flag, Flag_enumSize>; _______________________________________________ cfe-commits mailing list [email protected] https://lists.llvm.org/cgi-bin/mailman/listinfo/cfe-commits
