1889 lines · cpp
1//===-- lib/Semantics/mod-file.cpp ----------------------------------------===//2//3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4// See https://llvm.org/LICENSE.txt for license information.5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6//7//===----------------------------------------------------------------------===//8 9#include "mod-file.h"10#include "resolve-names.h"11#include "flang/Common/restorer.h"12#include "flang/Evaluate/tools.h"13#include "flang/Parser/message.h"14#include "flang/Parser/parsing.h"15#include "flang/Parser/unparse.h"16#include "flang/Semantics/scope.h"17#include "flang/Semantics/semantics.h"18#include "flang/Semantics/symbol.h"19#include "flang/Semantics/tools.h"20#include "llvm/Frontend/OpenMP/OMP.h"21#include "llvm/Support/FileSystem.h"22#include "llvm/Support/MemoryBuffer.h"23#include "llvm/Support/raw_ostream.h"24#include <algorithm>25#include <fstream>26#include <set>27#include <string_view>28#include <type_traits>29#include <variant>30#include <vector>31 32namespace Fortran::semantics {33 34using namespace parser::literals;35 36// The first line of a file that identifies it as a .mod file.37// The first three bytes are a Unicode byte order mark that ensures38// that the module file is decoded as UTF-8 even if source files39// are using another encoding.40struct ModHeader {41 static constexpr const char bom[3 + 1]{"\xef\xbb\xbf"};42 static constexpr int magicLen{13};43 static constexpr int sumLen{16};44 static constexpr const char magic[magicLen + 1]{"!mod$ v1 sum:"};45 static constexpr char terminator{'\n'};46 static constexpr int len{magicLen + 1 + sumLen};47 static constexpr int needLen{7};48 static constexpr const char need[needLen + 1]{"!need$ "};49};50 51static std::optional<SourceName> GetSubmoduleParent(const parser::Program &);52static void CollectSymbols(53 const Scope &, SymbolVector &, SymbolVector &, SourceOrderedSymbolSet &);54static void PutPassName(llvm::raw_ostream &, const std::optional<SourceName> &);55static void PutInit(llvm::raw_ostream &, const Symbol &, const MaybeExpr &,56 const parser::Expr *, SemanticsContext &);57static void PutInit(llvm::raw_ostream &, const MaybeIntExpr &);58static void PutBound(llvm::raw_ostream &, const Bound &);59static void PutShapeSpec(llvm::raw_ostream &, const ShapeSpec &);60static void PutShape(61 llvm::raw_ostream &, const ArraySpec &, char open, char close);62static void PutMapper(llvm::raw_ostream &, const Symbol &, SemanticsContext &);63 64static llvm::raw_ostream &PutAttr(llvm::raw_ostream &, Attr);65static llvm::raw_ostream &PutType(llvm::raw_ostream &, const DeclTypeSpec &);66static llvm::raw_ostream &PutLower(llvm::raw_ostream &, std::string_view);67static std::error_code WriteFile(const std::string &, const std::string &,68 ModuleCheckSumType &, bool debug = true);69static bool FileContentsMatch(70 const std::string &, const std::string &, const std::string &);71static ModuleCheckSumType ComputeCheckSum(const std::string_view &);72static std::string CheckSumString(ModuleCheckSumType);73 74// Collect symbols needed for a subprogram interface75class SubprogramSymbolCollector {76public:77 SubprogramSymbolCollector(const Symbol &symbol, const Scope &scope)78 : symbol_{symbol}, scope_{scope} {}79 const SymbolVector &symbols() const { return need_; }80 const std::set<SourceName> &imports() const { return imports_; }81 void Collect();82 83private:84 const Symbol &symbol_;85 const Scope &scope_;86 bool isInterface_{false};87 SymbolVector need_; // symbols that are needed88 UnorderedSymbolSet needSet_; // symbols already in need_89 UnorderedSymbolSet useSet_; // use-associations that might be needed90 std::set<SourceName> imports_; // imports from host that are needed91 92 void DoSymbol(const Symbol &);93 void DoSymbol(const SourceName &, const Symbol &);94 void DoType(const DeclTypeSpec *);95 void DoBound(const Bound &);96 void DoParamValue(const ParamValue &);97 bool NeedImport(const SourceName &, const Symbol &);98 99 template <typename T> void DoExpr(evaluate::Expr<T> expr) {100 for (const Symbol &symbol : evaluate::CollectSymbols(expr)) {101 DoSymbol(symbol);102 }103 }104};105 106bool ModFileWriter::WriteAll() {107 // this flag affects character literals: force it to be consistent108 auto restorer{109 common::ScopedSet(parser::useHexadecimalEscapeSequences, false)};110 WriteAll(context_.globalScope());111 return !context_.AnyFatalError();112}113 114void ModFileWriter::WriteAll(const Scope &scope) {115 for (const Scope &child : scope.children()) {116 WriteOne(child);117 }118}119 120void ModFileWriter::WriteOne(const Scope &scope) {121 if (scope.kind() == Scope::Kind::Module) {122 if (const auto *symbol{scope.symbol()}) {123 Write(*symbol);124 }125 WriteAll(scope); // write out submodules126 }127}128 129// Construct the name of a module file. Non-empty ancestorName means submodule.130static std::string ModFileName(const SourceName &name,131 const std::string &ancestorName, const std::string &suffix) {132 std::string result{name.ToString() + suffix};133 return ancestorName.empty() ? result : ancestorName + '-' + result;134}135 136// Write the module file for symbol, which must be a module or submodule.137void ModFileWriter::Write(const Symbol &symbol) {138 const auto &module{symbol.get<ModuleDetails>()};139 if (symbol.test(Symbol::Flag::ModFile) || module.moduleFileHash()) {140 return; // already written141 }142 const auto *ancestor{module.ancestor()};143 isSubmodule_ = ancestor != nullptr;144 auto ancestorName{ancestor ? ancestor->GetName().value().ToString() : ""s};145 std::string path{context_.moduleDirectory() + '/' +146 ModFileName(symbol.name(), ancestorName, context_.moduleFileSuffix())};147 148 std::set<std::string> hermeticModuleNames;149 hermeticModuleNames.insert(symbol.name().ToString());150 UnorderedSymbolSet additionalModules;151 PutSymbols(DEREF(symbol.scope()),152 hermeticModuleFileOutput_ ? &additionalModules : nullptr);153 auto asStr{GetAsString(symbol)};154 while (!additionalModules.empty()) {155 UnorderedSymbolSet nextPass{std::move(additionalModules)};156 additionalModules.clear();157 for (const Symbol &modSym : nextPass) {158 if (!modSym.owner().IsIntrinsicModules() &&159 hermeticModuleNames.find(modSym.name().ToString()) ==160 hermeticModuleNames.end()) {161 hermeticModuleNames.insert(modSym.name().ToString());162 PutSymbols(DEREF(modSym.scope()), &additionalModules);163 asStr += GetAsString(modSym);164 }165 }166 }167 168 ModuleCheckSumType checkSum;169 if (std::error_code error{170 WriteFile(path, asStr, checkSum, context_.debugModuleWriter())}) {171 context_.Say(172 symbol.name(), "Error writing %s: %s"_err_en_US, path, error.message());173 }174 const_cast<ModuleDetails &>(module).set_moduleFileHash(checkSum);175}176 177void ModFileWriter::WriteClosure(llvm::raw_ostream &out, const Symbol &symbol,178 UnorderedSymbolSet &nonIntrinsicModulesWritten) {179 if (!symbol.has<ModuleDetails>() || symbol.owner().IsIntrinsicModules() ||180 !nonIntrinsicModulesWritten.insert(symbol).second) {181 return;182 }183 PutSymbols(DEREF(symbol.scope()), /*hermeticModules=*/nullptr);184 needsBuf_.clear(); // omit module checksums185 auto str{GetAsString(symbol)};186 for (auto depRef : std::move(usedNonIntrinsicModules_)) {187 WriteClosure(out, *depRef, nonIntrinsicModulesWritten);188 }189 out << std::move(str);190}191 192// Return the entire body of the module file193// and clear saved uses, decls, and contains.194std::string ModFileWriter::GetAsString(const Symbol &symbol) {195 std::string buf;196 llvm::raw_string_ostream all{buf};197 all << needs_.str();198 needs_.str().clear();199 auto &details{symbol.get<ModuleDetails>()};200 if (!details.isSubmodule()) {201 all << "module " << symbol.name();202 } else {203 auto *parent{details.parent()->symbol()};204 auto *ancestor{details.ancestor()->symbol()};205 all << "submodule(" << ancestor->name();206 if (parent != ancestor) {207 all << ':' << parent->name();208 }209 all << ") " << symbol.name();210 }211 all << '\n' << uses_.str();212 uses_.str().clear();213 all << useExtraAttrs_.str();214 useExtraAttrs_.str().clear();215 all << decls_.str();216 decls_.str().clear();217 auto str{contains_.str()};218 contains_.str().clear();219 if (!str.empty()) {220 all << "contains\n" << str;221 }222 all << "end\n";223 return all.str();224}225 226// Collect symbols from constant and specification expressions that are being227// referenced directly from other modules; they may require new USE228// associations.229static void HarvestSymbolsNeededFromOtherModules(230 SourceOrderedSymbolSet &, const Scope &);231static void HarvestSymbolsNeededFromOtherModules(232 SourceOrderedSymbolSet &set, const Symbol &symbol, const Scope &scope) {233 auto HarvestBound{[&](const Bound &bound) {234 if (const auto &expr{bound.GetExplicit()}) {235 for (SymbolRef ref : evaluate::CollectSymbols(*expr)) {236 set.emplace(*ref);237 }238 }239 }};240 auto HarvestShapeSpec{[&](const ShapeSpec &shapeSpec) {241 HarvestBound(shapeSpec.lbound());242 HarvestBound(shapeSpec.ubound());243 }};244 auto HarvestArraySpec{[&](const ArraySpec &arraySpec) {245 for (const auto &shapeSpec : arraySpec) {246 HarvestShapeSpec(shapeSpec);247 }248 }};249 250 if (symbol.has<DerivedTypeDetails>()) {251 if (symbol.scope()) {252 HarvestSymbolsNeededFromOtherModules(set, *symbol.scope());253 }254 } else if (const auto &generic{symbol.detailsIf<GenericDetails>()};255 generic && generic->derivedType()) {256 const Symbol &dtSym{*generic->derivedType()};257 if (dtSym.has<DerivedTypeDetails>()) {258 if (dtSym.scope()) {259 HarvestSymbolsNeededFromOtherModules(set, *dtSym.scope());260 }261 } else {262 CHECK(dtSym.has<UseDetails>() || dtSym.has<UseErrorDetails>());263 }264 } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {265 HarvestArraySpec(object->shape());266 HarvestArraySpec(object->coshape());267 if (IsNamedConstant(symbol) || scope.IsDerivedType()) {268 if (object->init()) {269 for (SymbolRef ref : evaluate::CollectSymbols(*object->init())) {270 set.emplace(*ref);271 }272 }273 }274 } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {275 if (proc->init() && *proc->init() && scope.IsDerivedType()) {276 set.emplace(**proc->init());277 }278 } else if (const auto *subp{symbol.detailsIf<SubprogramDetails>()}) {279 for (const Symbol *dummy : subp->dummyArgs()) {280 if (dummy) {281 HarvestSymbolsNeededFromOtherModules(set, *dummy, scope);282 }283 }284 if (subp->isFunction()) {285 HarvestSymbolsNeededFromOtherModules(set, subp->result(), scope);286 }287 }288}289 290static void HarvestSymbolsNeededFromOtherModules(291 SourceOrderedSymbolSet &set, const Scope &scope) {292 for (const auto &[_, symbol] : scope) {293 HarvestSymbolsNeededFromOtherModules(set, *symbol, scope);294 }295}296 297void ModFileWriter::PrepareRenamings(const Scope &scope) {298 // Identify use-associated symbols already in scope under some name299 std::map<const Symbol *, const Symbol *> useMap;300 for (const auto &[name, symbolRef] : scope) {301 const Symbol *symbol{&*symbolRef};302 while (const auto *hostAssoc{symbol->detailsIf<HostAssocDetails>()}) {303 symbol = &hostAssoc->symbol();304 }305 if (const auto *use{symbol->detailsIf<UseDetails>()}) {306 useMap.emplace(&use->symbol(), symbol);307 }308 }309 // Collect symbols needed from other modules310 SourceOrderedSymbolSet symbolsNeeded;311 HarvestSymbolsNeededFromOtherModules(symbolsNeeded, scope);312 // Establish any necessary renamings of symbols in other modules313 // to their names in this scope, creating those new names when needed.314 auto &renamings{context_.moduleFileOutputRenamings()};315 for (SymbolRef s : symbolsNeeded) {316 if (s->owner().kind() != Scope::Kind::Module) {317 // Not a USE'able name from a module's top scope;318 // component, binding, dummy argument, &c.319 continue;320 }321 const Scope *sMod{FindModuleContaining(s->owner())};322 if (!sMod || sMod == &scope) {323 continue;324 }325 if (auto iter{useMap.find(&*s)}; iter != useMap.end()) {326 renamings.emplace(&*s, iter->second->name());327 continue;328 }329 SourceName rename{s->name()};330 if (const Symbol * found{scope.FindSymbol(s->name())}) {331 if (found == &*s) {332 continue; // available in scope333 }334 if (const auto *generic{found->detailsIf<GenericDetails>()}) {335 if (generic->derivedType() == &*s || generic->specific() == &*s) {336 continue;337 }338 } else if (found->has<UseDetails>()) {339 if (&found->GetUltimate() == &*s) {340 continue; // already use-associated with same name341 }342 }343 if (&s->owner() != &found->owner()) { // Symbol needs renaming344 rename = scope.context().SaveTempName(345 DEREF(sMod->symbol()).name().ToString() + "$" +346 s->name().ToString());347 }348 }349 // Symbol is used in this scope but not visible under its name350 if (sMod->parent().IsIntrinsicModules()) {351 uses_ << "use,intrinsic::";352 } else {353 uses_ << "use ";354 }355 uses_ << DEREF(sMod->symbol()).name() << ",only:";356 if (rename != s->name()) {357 uses_ << rename << "=>";358 renamings.emplace(&s->GetUltimate(), rename);359 }360 uses_ << s->name() << '\n';361 useExtraAttrs_ << "private::" << rename << '\n';362 }363}364 365static void PutOpenMPRequirements(llvm::raw_ostream &os, const Symbol &symbol) {366 using RequiresClauses = WithOmpDeclarative::RequiresClauses;367 using OmpMemoryOrderType = common::OmpMemoryOrderType;368 369 const auto [reqs, order]{common::visit(370 [&](auto &&details)371 -> std::pair<const RequiresClauses *, const OmpMemoryOrderType *> {372 if constexpr (std::is_convertible_v<decltype(details),373 const WithOmpDeclarative &>) {374 return {details.ompRequires(), details.ompAtomicDefaultMemOrder()};375 } else {376 return {nullptr, nullptr};377 }378 },379 symbol.details())};380 381 if (order) {382 llvm::omp::Clause admo{llvm::omp::Clause::OMPC_atomic_default_mem_order};383 os << "!$omp requires "384 << parser::ToLowerCaseLetters(llvm::omp::getOpenMPClauseName(admo))385 << '(' << parser::ToLowerCaseLetters(EnumToString(*order)) << ")\n";386 }387 if (reqs) {388 os << "!$omp requires";389 reqs->IterateOverMembers([&](llvm::omp::Clause f) {390 if (f != llvm::omp::Clause::OMPC_atomic_default_mem_order) {391 os << ' '392 << parser::ToLowerCaseLetters(llvm::omp::getOpenMPClauseName(f));393 }394 });395 os << "\n";396 }397}398 399// Put out the visible symbols from scope.400void ModFileWriter::PutSymbols(401 const Scope &scope, UnorderedSymbolSet *hermeticModules) {402 SymbolVector sorted;403 SymbolVector uses;404 auto &renamings{context_.moduleFileOutputRenamings()};405 auto previousRenamings{std::move(renamings)};406 PrepareRenamings(scope);407 SourceOrderedSymbolSet modules;408 CollectSymbols(scope, sorted, uses, modules);409 // Write module files for dependencies first so that their410 // hashes are known.411 for (const Symbol &mod : modules) {412 if (hermeticModules) {413 hermeticModules->insert(mod);414 } else {415 Write(mod);416 // It's possible that the module's file already existed and417 // without its own hash due to being embedded in a hermetic418 // module file.419 if (auto hash{mod.get<ModuleDetails>().moduleFileHash()}) {420 needs_ << ModHeader::need << CheckSumString(*hash)421 << (mod.owner().IsIntrinsicModules() ? " i " : " n ")422 << mod.name().ToString() << '\n';423 }424 }425 }426 std::string buf; // stuff after CONTAINS in derived type427 llvm::raw_string_ostream typeBindings{buf};428 for (const Symbol &symbol : sorted) {429 if (!symbol.test(Symbol::Flag::CompilerCreated)) {430 PutSymbol(typeBindings, symbol);431 }432 }433 for (const Symbol &symbol : uses) {434 PutUse(symbol);435 }436 PutOpenMPRequirements(decls_, DEREF(scope.symbol()));437 for (const auto &set : scope.equivalenceSets()) {438 if (!set.empty() &&439 !set.front().symbol.test(Symbol::Flag::CompilerCreated)) {440 char punctuation{'('};441 decls_ << "equivalence";442 for (const auto &object : set) {443 decls_ << punctuation << object.AsFortran();444 punctuation = ',';445 }446 decls_ << ")\n";447 }448 }449 CHECK(typeBindings.str().empty());450 renamings = std::move(previousRenamings);451}452 453// Emit components in order454bool ModFileWriter::PutComponents(const Symbol &typeSymbol) {455 const auto &scope{DEREF(typeSymbol.scope())};456 std::string buf; // stuff after CONTAINS in derived type457 llvm::raw_string_ostream typeBindings{buf};458 UnorderedSymbolSet emitted;459 SymbolVector symbols{scope.GetSymbols()};460 // Emit type parameter declarations first, in order461 const auto &details{typeSymbol.get<DerivedTypeDetails>()};462 for (const Symbol &symbol : details.paramDeclOrder()) {463 CHECK(symbol.has<TypeParamDetails>());464 PutSymbol(typeBindings, symbol);465 emitted.emplace(symbol);466 }467 // Emit actual components in component order.468 for (SourceName name : details.componentNames()) {469 auto iter{scope.find(name)};470 if (iter != scope.end()) {471 const Symbol &component{*iter->second};472 if (!component.test(Symbol::Flag::ParentComp)) {473 PutSymbol(typeBindings, component);474 }475 emitted.emplace(component);476 }477 }478 // Emit remaining symbols from the type's scope479 for (const Symbol &symbol : symbols) {480 if (emitted.find(symbol) == emitted.end()) {481 PutSymbol(typeBindings, symbol);482 }483 }484 if (auto str{typeBindings.str()}; !str.empty()) {485 CHECK(scope.IsDerivedType());486 decls_ << "contains\n" << str;487 return true;488 } else {489 return false;490 }491}492 493// Return the symbol's attributes that should be written494// into the mod file.495static Attrs getSymbolAttrsToWrite(const Symbol &symbol) {496 // Is SAVE attribute is implicit, it should be omitted497 // to not violate F202x C862 for a common block member.498 return symbol.attrs() & ~(symbol.implicitAttrs() & Attrs{Attr::SAVE});499}500 501static llvm::raw_ostream &PutGenericName(502 llvm::raw_ostream &os, const Symbol &symbol) {503 if (IsGenericDefinedOp(symbol)) {504 return os << "operator(" << symbol.name() << ')';505 } else {506 return os << symbol.name();507 }508}509 510// Emit a symbol to decls_, except for bindings in a derived type (type-bound511// procedures, type-bound generics, final procedures) which go to typeBindings.512void ModFileWriter::PutSymbol(513 llvm::raw_ostream &typeBindings, const Symbol &symbol) {514 common::visit(515 common::visitors{516 [&](const ModuleDetails &) { /* should be current module */ },517 [&](const DerivedTypeDetails &) { PutDerivedType(symbol); },518 [&](const SubprogramDetails &) { PutSubprogram(symbol); },519 [&](const GenericDetails &x) {520 if (symbol.owner().IsDerivedType()) {521 // generic binding522 for (const Symbol &proc : x.specificProcs()) {523 PutGenericName(typeBindings << "generic::", symbol)524 << "=>" << proc.name() << '\n';525 }526 } else {527 PutGeneric(symbol);528 }529 },530 [&](const UseDetails &) { PutUse(symbol); },531 [](const UseErrorDetails &) {},532 [&](const ProcBindingDetails &x) {533 bool deferred{symbol.attrs().test(Attr::DEFERRED)};534 typeBindings << "procedure";535 if (deferred) {536 typeBindings << '(' << x.symbol().name() << ')';537 }538 PutPassName(typeBindings, x.passName());539 auto attrs{symbol.attrs()};540 if (x.passName()) {541 attrs.reset(Attr::PASS);542 }543 PutAttrs(typeBindings, attrs);544 typeBindings << "::" << symbol.name();545 if (!deferred && x.symbol().name() != symbol.name()) {546 typeBindings << "=>" << x.symbol().name();547 }548 typeBindings << '\n';549 },550 [&](const NamelistDetails &x) {551 decls_ << "namelist/" << symbol.name();552 char sep{'/'};553 for (const Symbol &object : x.objects()) {554 decls_ << sep << object.name();555 sep = ',';556 }557 decls_ << '\n';558 if (!isSubmodule_ && symbol.attrs().test(Attr::PRIVATE)) {559 decls_ << "private::" << symbol.name() << '\n';560 }561 },562 [&](const CommonBlockDetails &x) {563 decls_ << "common/" << symbol.name();564 char sep = '/';565 for (const auto &object : x.objects()) {566 decls_ << sep << object->name();567 sep = ',';568 }569 decls_ << '\n';570 if (symbol.attrs().test(Attr::BIND_C)) {571 PutAttrs(decls_, getSymbolAttrsToWrite(symbol), x.bindName(),572 x.isExplicitBindName(), ""s);573 decls_ << "::/" << symbol.name() << "/\n";574 }575 },576 [](const HostAssocDetails &) {},577 [](const MiscDetails &) {},578 [&](const auto &) {579 PutEntity(decls_, symbol);580 PutDirective(decls_, symbol);581 },582 },583 symbol.details());584}585 586void ModFileWriter::PutDerivedType(587 const Symbol &typeSymbol, const Scope *scope) {588 auto &details{typeSymbol.get<DerivedTypeDetails>()};589 if (details.isDECStructure()) {590 PutDECStructure(typeSymbol, scope);591 return;592 }593 PutAttrs(decls_ << "type", typeSymbol.attrs());594 if (const DerivedTypeSpec * extends{typeSymbol.GetParentTypeSpec()}) {595 decls_ << ",extends(" << extends->name() << ')';596 }597 decls_ << "::" << typeSymbol.name();598 if (!details.paramNameOrder().empty()) {599 char sep{'('};600 for (const SymbolRef &ref : details.paramNameOrder()) {601 decls_ << sep << ref->name();602 sep = ',';603 }604 decls_ << ')';605 }606 decls_ << '\n';607 if (details.sequence()) {608 decls_ << "sequence\n";609 }610 bool contains{PutComponents(typeSymbol)};611 if (!details.finals().empty()) {612 const char *sep{contains ? "final::" : "contains\nfinal::"};613 for (const auto &pair : details.finals()) {614 decls_ << sep << pair.second->name();615 sep = ",";616 }617 if (*sep == ',') {618 decls_ << '\n';619 }620 }621 decls_ << "end type\n";622}623 624void ModFileWriter::PutDECStructure(625 const Symbol &typeSymbol, const Scope *scope) {626 if (emittedDECStructures_.find(typeSymbol) != emittedDECStructures_.end()) {627 return;628 }629 if (!scope && context_.IsTempName(typeSymbol.name().ToString())) {630 return; // defer until used631 }632 emittedDECStructures_.insert(typeSymbol);633 decls_ << "structure ";634 if (!context_.IsTempName(typeSymbol.name().ToString())) {635 decls_ << typeSymbol.name();636 }637 if (scope && scope->kind() == Scope::Kind::DerivedType) {638 // Nested STRUCTURE: emit entity declarations right now639 // on the STRUCTURE statement.640 bool any{false};641 for (const auto &ref : scope->GetSymbols()) {642 const auto *object{ref->detailsIf<ObjectEntityDetails>()};643 if (object && object->type() &&644 object->type()->category() == DeclTypeSpec::TypeDerived &&645 &object->type()->derivedTypeSpec().typeSymbol() == &typeSymbol) {646 if (any) {647 decls_ << ',';648 } else {649 any = true;650 }651 decls_ << ref->name();652 PutShape(decls_, object->shape(), '(', ')');653 PutInit(decls_, *ref, object->init(), nullptr, context_);654 emittedDECFields_.insert(*ref);655 } else if (any) {656 break; // any later use of this structure will use RECORD/str/657 }658 }659 }660 decls_ << '\n';661 PutComponents(typeSymbol);662 decls_ << "end structure\n";663}664 665// Attributes that may be in a subprogram prefix666static const Attrs subprogramPrefixAttrs{Attr::ELEMENTAL, Attr::IMPURE,667 Attr::MODULE, Attr::NON_RECURSIVE, Attr::PURE, Attr::RECURSIVE};668 669static void PutOpenACCDeviceTypeRoutineInfo(670 llvm::raw_ostream &os, const OpenACCRoutineDeviceTypeInfo &info) {671 if (info.isSeq()) {672 os << " seq";673 }674 if (info.isGang()) {675 os << " gang";676 if (info.gangDim() > 0) {677 os << "(dim: " << info.gangDim() << ")";678 }679 }680 if (info.isVector()) {681 os << " vector";682 }683 if (info.isWorker()) {684 os << " worker";685 }686 if (const std::variant<std::string, SymbolRef> *bindName{info.bindName()}) {687 os << " bind(";688 if (std::holds_alternative<std::string>(*bindName)) {689 os << "\"" << std::get<std::string>(*bindName) << "\"";690 } else {691 os << std::get<SymbolRef>(*bindName)->name();692 }693 os << ")";694 }695}696 697static void PutOpenACCRoutineInfo(698 llvm::raw_ostream &os, const SubprogramDetails &details) {699 for (auto info : details.openACCRoutineInfos()) {700 os << "!$acc routine";701 702 PutOpenACCDeviceTypeRoutineInfo(os, info);703 704 if (info.isNohost()) {705 os << " nohost";706 }707 708 for (auto dtype : info.deviceTypeInfos()) {709 os << " device_type(";710 if (dtype.dType() == common::OpenACCDeviceType::Star) {711 os << "*";712 } else {713 os << parser::ToLowerCaseLetters(common::EnumToString(dtype.dType()));714 }715 os << ")";716 717 PutOpenACCDeviceTypeRoutineInfo(os, dtype);718 }719 720 os << "\n";721 }722}723 724void ModFileWriter::PutSubprogram(const Symbol &symbol) {725 auto &details{symbol.get<SubprogramDetails>()};726 if (const Symbol * interface{details.moduleInterface()}) {727 const Scope *module{FindModuleContaining(interface->owner())};728 if (module && module != &symbol.owner()) {729 // Interface is in ancestor module730 } else {731 PutSubprogram(*interface);732 }733 }734 auto attrs{symbol.attrs()};735 Attrs bindAttrs{};736 if (attrs.test(Attr::BIND_C)) {737 // bind(c) is a suffix, not prefix738 bindAttrs.set(Attr::BIND_C, true);739 attrs.set(Attr::BIND_C, false);740 }741 bool isAbstract{attrs.test(Attr::ABSTRACT)};742 if (isAbstract) {743 attrs.set(Attr::ABSTRACT, false);744 }745 Attrs prefixAttrs{subprogramPrefixAttrs & attrs};746 // emit any non-prefix attributes in an attribute statement747 attrs &= ~subprogramPrefixAttrs;748 std::string ssBuf;749 llvm::raw_string_ostream ss{ssBuf};750 PutAttrs(ss, attrs);751 if (!ss.str().empty()) {752 decls_ << ss.str().substr(1) << "::" << symbol.name() << '\n';753 }754 bool isInterface{details.isInterface()};755 llvm::raw_ostream &os{isInterface ? decls_ : contains_};756 if (isInterface) {757 os << (isAbstract ? "abstract " : "") << "interface\n";758 }759 PutAttrs(os, prefixAttrs, nullptr, false, ""s, " "s);760 if (auto attrs{details.cudaSubprogramAttrs()}) {761 if (*attrs == common::CUDASubprogramAttrs::HostDevice) {762 os << "attributes(host,device) ";763 } else {764 PutLower(os << "attributes(", common::EnumToString(*attrs)) << ") ";765 }766 if (!details.cudaLaunchBounds().empty()) {767 os << "launch_bounds";768 char sep{'('};769 for (auto x : details.cudaLaunchBounds()) {770 os << sep << x;771 sep = ',';772 }773 os << ") ";774 }775 if (!details.cudaClusterDims().empty()) {776 os << "cluster_dims";777 char sep{'('};778 for (auto x : details.cudaClusterDims()) {779 os << sep << x;780 sep = ',';781 }782 os << ") ";783 }784 }785 os << (details.isFunction() ? "function " : "subroutine ");786 os << symbol.name() << '(';787 int n = 0;788 for (const auto &dummy : details.dummyArgs()) {789 if (n++ > 0) {790 os << ',';791 }792 if (dummy) {793 os << dummy->name();794 } else {795 os << "*";796 }797 }798 os << ')';799 PutAttrs(os, bindAttrs, details.bindName(), details.isExplicitBindName(),800 " "s, ""s);801 if (details.isFunction()) {802 const Symbol &result{details.result()};803 if (result.name() != symbol.name()) {804 os << " result(" << result.name() << ')';805 }806 }807 os << '\n';808 // walk symbols, collect ones needed for interface809 const Scope &scope{810 details.entryScope() ? *details.entryScope() : DEREF(symbol.scope())};811 SubprogramSymbolCollector collector{symbol, scope};812 collector.Collect();813 std::string typeBindingsBuf;814 llvm::raw_string_ostream typeBindings{typeBindingsBuf};815 ModFileWriter writer{context_};816 for (const Symbol &need : collector.symbols()) {817 writer.PutSymbol(typeBindings, need);818 }819 CHECK(typeBindings.str().empty());820 os << writer.uses_.str();821 for (const SourceName &import : collector.imports()) {822 decls_ << "import::" << import << "\n";823 }824 os << writer.decls_.str();825 PutOpenACCRoutineInfo(os, details);826 os << "end\n";827 if (isInterface) {828 os << "end interface\n";829 }830}831 832static bool IsIntrinsicOp(const Symbol &symbol) {833 if (const auto *details{symbol.GetUltimate().detailsIf<GenericDetails>()}) {834 return details->kind().IsIntrinsicOperator();835 } else {836 return false;837 }838}839 840void ModFileWriter::PutGeneric(const Symbol &symbol) {841 const auto &genericOwner{symbol.owner()};842 auto &details{symbol.get<GenericDetails>()};843 PutGenericName(decls_ << "interface ", symbol) << '\n';844 for (const Symbol &specific : details.specificProcs()) {845 if (specific.owner() == genericOwner) {846 decls_ << "procedure::" << specific.name() << '\n';847 }848 }849 decls_ << "end interface\n";850 if (!isSubmodule_ && symbol.attrs().test(Attr::PRIVATE)) {851 PutGenericName(decls_ << "private::", symbol) << '\n';852 }853}854 855void ModFileWriter::PutUse(const Symbol &symbol) {856 auto &details{symbol.get<UseDetails>()};857 auto &use{details.symbol()};858 const Symbol &module{GetUsedModule(details)};859 if (use.owner().parent().IsIntrinsicModules()) {860 uses_ << "use,intrinsic::";861 } else {862 uses_ << "use ";863 usedNonIntrinsicModules_.insert(module);864 }865 uses_ << module.name() << ",only:";866 PutGenericName(uses_, symbol);867 // Can have intrinsic op with different local-name and use-name868 // (e.g. `operator(<)` and `operator(.lt.)`) but rename is not allowed869 if (!IsIntrinsicOp(symbol) && use.name() != symbol.name()) {870 PutGenericName(uses_ << "=>", use);871 }872 uses_ << '\n';873 PutUseExtraAttr(Attr::VOLATILE, symbol, use);874 PutUseExtraAttr(Attr::ASYNCHRONOUS, symbol, use);875 if (!isSubmodule_ && symbol.attrs().test(Attr::PRIVATE)) {876 PutGenericName(useExtraAttrs_ << "private::", symbol) << '\n';877 }878}879 880// We have "USE local => use" in this module. If attr was added locally881// (i.e. on local but not on use), also write it out in the mod file.882void ModFileWriter::PutUseExtraAttr(883 Attr attr, const Symbol &local, const Symbol &use) {884 if (local.attrs().test(attr) && !use.attrs().test(attr)) {885 PutAttr(useExtraAttrs_, attr) << "::";886 useExtraAttrs_ << local.name() << '\n';887 }888}889 890// Collect the symbols of this scope sorted by their original order, not name.891// Generics and namelists are exceptions: they are sorted after other symbols.892void CollectSymbols(const Scope &scope, SymbolVector &sorted,893 SymbolVector &uses, SourceOrderedSymbolSet &modules) {894 SymbolVector namelist, generics;895 auto symbols{scope.GetSymbols()};896 std::size_t commonSize{scope.commonBlocks().size()};897 sorted.reserve(symbols.size() + commonSize);898 for (const Symbol &symbol : symbols) {899 const auto *generic{symbol.detailsIf<GenericDetails>()};900 if (generic) {901 uses.insert(uses.end(), generic->uses().begin(), generic->uses().end());902 for (const Symbol &used : generic->uses()) {903 modules.insert(GetUsedModule(used.get<UseDetails>()));904 }905 } else if (const auto *use{symbol.detailsIf<UseDetails>()}) {906 modules.insert(GetUsedModule(*use));907 }908 if (symbol.test(Symbol::Flag::ParentComp)) {909 } else if (symbol.has<NamelistDetails>()) {910 namelist.push_back(symbol);911 } else if (generic) {912 if (generic->specific() &&913 &generic->specific()->owner() == &symbol.owner()) {914 sorted.push_back(*generic->specific());915 } else if (generic->derivedType() &&916 &generic->derivedType()->owner() == &symbol.owner()) {917 sorted.push_back(*generic->derivedType());918 }919 generics.push_back(symbol);920 } else {921 sorted.push_back(symbol);922 }923 }924 std::sort(sorted.begin(), sorted.end(), SymbolSourcePositionCompare{});925 std::sort(generics.begin(), generics.end(), SymbolSourcePositionCompare{});926 sorted.insert(sorted.end(), generics.begin(), generics.end());927 sorted.insert(sorted.end(), namelist.begin(), namelist.end());928 for (const auto &pair : scope.commonBlocks()) {929 sorted.push_back(*pair.second);930 }931 std::sort(932 sorted.end() - commonSize, sorted.end(), SymbolSourcePositionCompare{});933}934 935void ModFileWriter::PutEntity(llvm::raw_ostream &os, const Symbol &symbol) {936 common::visit(937 common::visitors{938 [&](const ObjectEntityDetails &) { PutObjectEntity(os, symbol); },939 [&](const ProcEntityDetails &) { PutProcEntity(os, symbol); },940 [&](const TypeParamDetails &) { PutTypeParam(os, symbol); },941 [&](const UserReductionDetails &) { PutUserReduction(os, symbol); },942 [&](const MapperDetails &) { PutMapper(decls_, symbol, context_); },943 [&](const auto &) {944 common::die("PutEntity: unexpected details: %s",945 DetailsToString(symbol.details()).c_str());946 },947 },948 symbol.details());949}950 951void PutShapeSpec(llvm::raw_ostream &os, const ShapeSpec &x) {952 if (x.lbound().isStar()) {953 CHECK(x.ubound().isStar());954 os << ".."; // assumed rank955 } else {956 if (!x.lbound().isColon()) {957 PutBound(os, x.lbound());958 }959 os << ':';960 if (!x.ubound().isColon()) {961 PutBound(os, x.ubound());962 }963 }964}965void PutShape(966 llvm::raw_ostream &os, const ArraySpec &shape, char open, char close) {967 if (!shape.empty()) {968 os << open;969 bool first{true};970 for (const auto &shapeSpec : shape) {971 if (first) {972 first = false;973 } else {974 os << ',';975 }976 PutShapeSpec(os, shapeSpec);977 }978 os << close;979 }980}981 982void ModFileWriter::PutObjectEntity(983 llvm::raw_ostream &os, const Symbol &symbol) {984 auto &details{symbol.get<ObjectEntityDetails>()};985 if (details.type() &&986 details.type()->category() == DeclTypeSpec::TypeDerived) {987 const Symbol &typeSymbol{details.type()->derivedTypeSpec().typeSymbol()};988 if (typeSymbol.get<DerivedTypeDetails>().isDECStructure()) {989 PutDerivedType(typeSymbol, &symbol.owner());990 if (emittedDECFields_.find(symbol) != emittedDECFields_.end()) {991 return; // symbol was emitted on STRUCTURE statement992 }993 }994 }995 PutEntity(996 os, symbol, [&]() { PutType(os, DEREF(symbol.GetType())); },997 getSymbolAttrsToWrite(symbol));998 PutShape(os, details.shape(), '(', ')');999 PutShape(os, details.coshape(), '[', ']');1000 PutInit(os, symbol, details.init(), details.unanalyzedPDTComponentInit(),1001 context_);1002 os << '\n';1003 if (auto tkr{GetIgnoreTKR(symbol)}; !tkr.empty()) {1004 os << "!dir$ ignore_tkr(";1005 tkr.IterateOverMembers([&](common::IgnoreTKR tkr) {1006 switch (tkr) {1007 SWITCH_COVERS_ALL_CASES1008 case common::IgnoreTKR::Type:1009 os << 't';1010 break;1011 case common::IgnoreTKR::Kind:1012 os << 'k';1013 break;1014 case common::IgnoreTKR::Rank:1015 os << 'r';1016 break;1017 case common::IgnoreTKR::Device:1018 os << 'd';1019 break;1020 case common::IgnoreTKR::Managed:1021 os << 'm';1022 break;1023 case common::IgnoreTKR::Contiguous:1024 os << 'c';1025 break;1026 case common::IgnoreTKR::Pointer:1027 os << 'p';1028 break;1029 }1030 });1031 os << ") " << symbol.name() << '\n';1032 }1033 if (auto attr{details.cudaDataAttr()}) {1034 PutLower(os << "attributes(", common::EnumToString(*attr))1035 << ") " << symbol.name() << '\n';1036 }1037 if (symbol.test(Fortran::semantics::Symbol::Flag::CrayPointer)) {1038 for (const auto &[pointee, pointer] : symbol.owner().crayPointers()) {1039 if (pointer == symbol) {1040 os << "pointer(" << symbol.name() << "," << pointee << ")\n";1041 }1042 }1043 }1044}1045 1046void ModFileWriter::PutProcEntity(llvm::raw_ostream &os, const Symbol &symbol) {1047 if (symbol.attrs().test(Attr::INTRINSIC)) {1048 os << "intrinsic::" << symbol.name() << '\n';1049 if (!isSubmodule_ && symbol.attrs().test(Attr::PRIVATE)) {1050 os << "private::" << symbol.name() << '\n';1051 }1052 return;1053 }1054 const auto &details{symbol.get<ProcEntityDetails>()};1055 Attrs attrs{symbol.attrs()};1056 if (details.passName()) {1057 attrs.reset(Attr::PASS);1058 }1059 PutEntity(1060 os, symbol,1061 [&]() {1062 os << "procedure(";1063 if (details.rawProcInterface()) {1064 os << details.rawProcInterface()->name();1065 } else if (details.type()) {1066 PutType(os, *details.type());1067 }1068 os << ')';1069 PutPassName(os, details.passName());1070 },1071 attrs);1072 os << '\n';1073}1074 1075void PutPassName(1076 llvm::raw_ostream &os, const std::optional<SourceName> &passName) {1077 if (passName) {1078 os << ",pass(" << *passName << ')';1079 }1080}1081 1082void ModFileWriter::PutTypeParam(llvm::raw_ostream &os, const Symbol &symbol) {1083 auto &details{symbol.get<TypeParamDetails>()};1084 PutEntity(1085 os, symbol,1086 [&]() {1087 PutType(os, DEREF(symbol.GetType()));1088 PutLower(os << ',', common::EnumToString(details.attr().value()));1089 },1090 symbol.attrs());1091 PutInit(os, details.init());1092 os << '\n';1093}1094 1095void ModFileWriter::PutUserReduction(1096 llvm::raw_ostream &os, const Symbol &symbol) {1097 const auto &details{symbol.get<UserReductionDetails>()};1098 // The module content for a OpenMP Declare Reduction is the OpenMP1099 // declaration. There may be multiple declarations.1100 // Decls are pointers, so do not use a reference.1101 for (const auto *decl : details.GetDeclList()) {1102 Unparse(os, *decl, context_.langOptions());1103 }1104}1105 1106static void PutMapper(1107 llvm::raw_ostream &os, const Symbol &symbol, SemanticsContext &context) {1108 const auto &details{symbol.get<MapperDetails>()};1109 // Emit each saved DECLARE MAPPER construct as-is, so that consumers of the1110 // module can reparse it and recreate the mapper symbol and semantics state.1111 for (const auto *decl : details.GetDeclList()) {1112 Unparse(os, *decl, context.langOptions());1113 }1114}1115 1116void PutInit(llvm::raw_ostream &os, const Symbol &symbol, const MaybeExpr &init,1117 const parser::Expr *unanalyzed, SemanticsContext &context) {1118 if (IsNamedConstant(symbol) || symbol.owner().IsDerivedType()) {1119 const char *assign{symbol.attrs().test(Attr::POINTER) ? "=>" : "="};1120 if (unanalyzed) {1121 parser::Unparse(os << assign, *unanalyzed, context.langOptions());1122 } else if (init) {1123 init->AsFortran(os << assign);1124 }1125 }1126}1127 1128void PutInit(llvm::raw_ostream &os, const MaybeIntExpr &init) {1129 if (init) {1130 init->AsFortran(os << '=');1131 }1132}1133 1134void PutBound(llvm::raw_ostream &os, const Bound &x) {1135 if (x.isStar()) {1136 os << '*';1137 } else if (x.isColon()) {1138 os << ':';1139 } else {1140 x.GetExplicit()->AsFortran(os);1141 }1142}1143 1144// Write an entity (object or procedure) declaration.1145// writeType is called to write out the type.1146void ModFileWriter::PutEntity(llvm::raw_ostream &os, const Symbol &symbol,1147 std::function<void()> writeType, Attrs attrs) {1148 writeType();1149 PutAttrs(os, attrs, symbol.GetBindName(), symbol.GetIsExplicitBindName());1150 if (symbol.owner().kind() == Scope::Kind::DerivedType &&1151 context_.IsTempName(symbol.name().ToString())) {1152 os << "::%FILL";1153 } else {1154 os << "::" << symbol.name();1155 }1156}1157 1158// Put out each attribute to os, surrounded by `before` and `after` and1159// mapped to lower case.1160llvm::raw_ostream &ModFileWriter::PutAttrs(llvm::raw_ostream &os, Attrs attrs,1161 const std::string *bindName, bool isExplicitBindName, std::string before,1162 std::string after) const {1163 attrs.set(Attr::PUBLIC, false); // no need to write PUBLIC1164 attrs.set(Attr::EXTERNAL, false); // no need to write EXTERNAL1165 if (isSubmodule_) {1166 attrs.set(Attr::PRIVATE, false);1167 }1168 if (bindName || isExplicitBindName) {1169 os << before << "bind(c";1170 if (isExplicitBindName) {1171 os << ",name=\"" << (bindName ? *bindName : ""s) << '"';1172 }1173 os << ')' << after;1174 attrs.set(Attr::BIND_C, false);1175 }1176 for (std::size_t i{0}; i < Attr_enumSize; ++i) {1177 Attr attr{static_cast<Attr>(i)};1178 if (attrs.test(attr)) {1179 PutAttr(os << before, attr) << after;1180 }1181 }1182 return os;1183}1184 1185llvm::raw_ostream &PutAttr(llvm::raw_ostream &os, Attr attr) {1186 return PutLower(os, AttrToString(attr));1187}1188 1189llvm::raw_ostream &PutType(llvm::raw_ostream &os, const DeclTypeSpec &type) {1190 return PutLower(os, type.AsFortran());1191}1192 1193llvm::raw_ostream &PutLower(llvm::raw_ostream &os, std::string_view str) {1194 for (char c : str) {1195 os << parser::ToLowerCaseLetter(c);1196 }1197 return os;1198}1199 1200void PutOpenACCDirective(llvm::raw_ostream &os, const Symbol &symbol) {1201 if (symbol.test(Symbol::Flag::AccDeclare)) {1202 os << "!$acc declare ";1203 if (symbol.test(Symbol::Flag::AccCopy)) {1204 os << "copy";1205 } else if (symbol.test(Symbol::Flag::AccCopyIn) ||1206 symbol.test(Symbol::Flag::AccCopyInReadOnly)) {1207 os << "copyin";1208 } else if (symbol.test(Symbol::Flag::AccCopyOut)) {1209 os << "copyout";1210 } else if (symbol.test(Symbol::Flag::AccCreate)) {1211 os << "create";1212 } else if (symbol.test(Symbol::Flag::AccPresent)) {1213 os << "present";1214 } else if (symbol.test(Symbol::Flag::AccDevicePtr)) {1215 os << "deviceptr";1216 } else if (symbol.test(Symbol::Flag::AccDeviceResident)) {1217 os << "device_resident";1218 } else if (symbol.test(Symbol::Flag::AccLink)) {1219 os << "link";1220 }1221 os << "(";1222 if (symbol.test(Symbol::Flag::AccCopyInReadOnly)) {1223 os << "readonly: ";1224 }1225 os << symbol.name() << ")\n";1226 }1227}1228 1229void PutOpenMPDirective(llvm::raw_ostream &os, const Symbol &symbol) {1230 if (symbol.test(Symbol::Flag::OmpThreadprivate)) {1231 os << "!$omp threadprivate(" << symbol.name() << ")\n";1232 }1233}1234 1235void ModFileWriter::PutDirective(llvm::raw_ostream &os, const Symbol &symbol) {1236 PutOpenACCDirective(os, symbol);1237 PutOpenMPDirective(os, symbol);1238}1239 1240struct Temp {1241 Temp(int fd, std::string path) : fd{fd}, path{path} {}1242 Temp(Temp &&t) : fd{std::exchange(t.fd, -1)}, path{std::move(t.path)} {}1243 ~Temp() {1244 if (fd >= 0) {1245 llvm::sys::fs::file_t native{llvm::sys::fs::convertFDToNativeFile(fd)};1246 llvm::sys::fs::closeFile(native);1247 llvm::sys::fs::remove(path.c_str());1248 }1249 }1250 int fd;1251 std::string path;1252};1253 1254// Create a temp file in the same directory and with the same suffix as path.1255// Return an open file descriptor and its path.1256static llvm::ErrorOr<Temp> MkTemp(const std::string &path) {1257 auto length{path.length()};1258 auto dot{path.find_last_of("./")};1259 std::string suffix{1260 dot < length && path[dot] == '.' ? path.substr(dot + 1) : ""};1261 CHECK(length > suffix.length() &&1262 path.substr(length - suffix.length()) == suffix);1263 auto prefix{path.substr(0, length - suffix.length())};1264 int fd;1265 llvm::SmallString<16> tempPath;1266 if (std::error_code err{llvm::sys::fs::createUniqueFile(1267 prefix + "%%%%%%" + suffix, fd, tempPath)}) {1268 return err;1269 }1270 return Temp{fd, tempPath.c_str()};1271}1272 1273// Write the module file at path, prepending header. If an error occurs,1274// return errno, otherwise 0.1275static std::error_code WriteFile(const std::string &path,1276 const std::string &contents, ModuleCheckSumType &checkSum, bool debug) {1277 checkSum = ComputeCheckSum(contents);1278 auto header{std::string{ModHeader::bom} + ModHeader::magic +1279 CheckSumString(checkSum) + ModHeader::terminator};1280 if (debug) {1281 llvm::dbgs() << "Processing module " << path << ": ";1282 }1283 if (FileContentsMatch(path, header, contents)) {1284 if (debug) {1285 llvm::dbgs() << "module unchanged, not writing\n";1286 }1287 return {};1288 }1289 llvm::ErrorOr<Temp> temp{MkTemp(path)};1290 if (!temp) {1291 return temp.getError();1292 }1293 llvm::raw_fd_ostream writer(temp->fd, /*shouldClose=*/false);1294 writer << header;1295 writer << contents;1296 writer.flush();1297 if (writer.has_error()) {1298 return writer.error();1299 }1300 if (debug) {1301 llvm::dbgs() << "module written\n";1302 }1303 return llvm::sys::fs::rename(temp->path, path);1304}1305 1306// Return true if the stream matches what we would write for the mod file.1307static bool FileContentsMatch(const std::string &path,1308 const std::string &header, const std::string &contents) {1309 std::size_t hsize{header.size()};1310 std::size_t csize{contents.size()};1311 auto buf_or{llvm::MemoryBuffer::getFile(path)};1312 if (!buf_or) {1313 return false;1314 }1315 auto buf = std::move(buf_or.get());1316 if (buf->getBufferSize() != hsize + csize) {1317 return false;1318 }1319 if (!std::equal(header.begin(), header.end(), buf->getBufferStart(),1320 buf->getBufferStart() + hsize)) {1321 return false;1322 }1323 1324 return std::equal(contents.begin(), contents.end(),1325 buf->getBufferStart() + hsize, buf->getBufferEnd());1326}1327 1328// Compute a simple hash of the contents of a module file and1329// return it as a string of hex digits.1330// This uses the Fowler-Noll-Vo hash function.1331static ModuleCheckSumType ComputeCheckSum(const std::string_view &contents) {1332 ModuleCheckSumType hash{0xcbf29ce484222325ull};1333 for (char c : contents) {1334 hash ^= c & 0xff;1335 hash *= 0x100000001b3;1336 }1337 return hash;1338}1339 1340static std::string CheckSumString(ModuleCheckSumType hash) {1341 static const char *digits = "0123456789abcdef";1342 std::string result(ModHeader::sumLen, '0');1343 for (size_t i{ModHeader::sumLen}; hash != 0; hash >>= 4) {1344 result[--i] = digits[hash & 0xf];1345 }1346 return result;1347}1348 1349std::optional<ModuleCheckSumType> ExtractCheckSum(const std::string_view &str) {1350 if (str.size() == ModHeader::sumLen) {1351 ModuleCheckSumType hash{0};1352 for (size_t j{0}; j < ModHeader::sumLen; ++j) {1353 hash <<= 4;1354 char ch{str.at(j)};1355 if (ch >= '0' && ch <= '9') {1356 hash += ch - '0';1357 } else if (ch >= 'a' && ch <= 'f') {1358 hash += ch - 'a' + 10;1359 } else {1360 return std::nullopt;1361 }1362 }1363 return hash;1364 }1365 return std::nullopt;1366}1367 1368static std::optional<ModuleCheckSumType> VerifyHeader(1369 llvm::ArrayRef<char> content) {1370 std::string_view sv{content.data(), content.size()};1371 if (sv.substr(0, ModHeader::magicLen) != ModHeader::magic) {1372 return std::nullopt;1373 }1374 ModuleCheckSumType checkSum{ComputeCheckSum(sv.substr(ModHeader::len))};1375 std::string_view expectSum{sv.substr(ModHeader::magicLen, ModHeader::sumLen)};1376 if (auto extracted{ExtractCheckSum(expectSum)};1377 extracted && *extracted == checkSum) {1378 return checkSum;1379 } else {1380 return std::nullopt;1381 }1382}1383 1384static void GetModuleDependences(1385 ModuleDependences &dependences, llvm::ArrayRef<char> content) {1386 std::size_t limit{content.size()};1387 std::string_view str{content.data(), limit};1388 for (std::size_t j{ModHeader::len};1389 str.substr(j, ModHeader::needLen) == ModHeader::need; ++j) {1390 j += 7;1391 auto checkSum{ExtractCheckSum(str.substr(j, ModHeader::sumLen))};1392 if (!checkSum) {1393 break;1394 }1395 j += ModHeader::sumLen;1396 bool intrinsic{false};1397 if (str.substr(j, 3) == " i ") {1398 intrinsic = true;1399 } else if (str.substr(j, 3) != " n ") {1400 break;1401 }1402 j += 3;1403 std::size_t start{j};1404 for (; j < limit && str.at(j) != '\n'; ++j) {1405 }1406 if (j > start && j < limit && str.at(j) == '\n') {1407 std::string depModName{str.substr(start, j - start)};1408 dependences.AddDependence(std::move(depModName), intrinsic, *checkSum);1409 } else {1410 break;1411 }1412 }1413}1414 1415Scope *ModFileReader::Read(SourceName name, std::optional<bool> isIntrinsic,1416 Scope *ancestor, bool silent) {1417 std::string ancestorName; // empty for module1418 const Symbol *notAModule{nullptr};1419 bool fatalError{false};1420 if (ancestor) {1421 if (auto *scope{ancestor->FindSubmodule(name)}) {1422 return scope;1423 }1424 ancestorName = ancestor->GetName().value().ToString();1425 }1426 auto requiredHash{context_.moduleDependences().GetRequiredHash(1427 name.ToString(), isIntrinsic.value_or(false))};1428 if (!isIntrinsic.value_or(false) && !ancestor) {1429 // Already present in the symbol table as a usable non-intrinsic module?1430 if (Scope * hermeticScope{context_.currentHermeticModuleFileScope()}) {1431 auto it{hermeticScope->find(name)};1432 if (it != hermeticScope->end()) {1433 return it->second->scope();1434 }1435 }1436 auto it{context_.globalScope().find(name)};1437 if (it != context_.globalScope().end()) {1438 Scope *scope{it->second->scope()};1439 if (scope->kind() == Scope::Kind::Module) {1440 for (const Symbol *found{scope->symbol()}; found;) {1441 if (const auto *module{found->detailsIf<ModuleDetails>()}) {1442 if (!requiredHash ||1443 *requiredHash ==1444 module->moduleFileHash().value_or(*requiredHash)) {1445 return const_cast<Scope *>(found->scope());1446 }1447 found = module->previous(); // same name, distinct hash1448 } else {1449 notAModule = found;1450 break;1451 }1452 }1453 } else {1454 notAModule = scope->symbol();1455 }1456 }1457 }1458 if (notAModule) {1459 // USE, NON_INTRINSIC global name isn't a module?1460 fatalError = isIntrinsic.has_value();1461 }1462 std::string path{1463 ModFileName(name, ancestorName, context_.moduleFileSuffix())};1464 parser::Parsing parsing{context_.allCookedSources()};1465 parser::Options options;1466 options.isModuleFile = true;1467 options.features.Enable(common::LanguageFeature::BackslashEscapes);1468 if (context_.languageFeatures().IsEnabled(common::LanguageFeature::OpenACC)) {1469 options.features.Enable(common::LanguageFeature::OpenACC);1470 }1471 options.features.Enable(common::LanguageFeature::OpenMP);1472 options.features.Enable(common::LanguageFeature::CUDA);1473 if (!isIntrinsic.value_or(false) && !notAModule) {1474 // The search for this module file will scan non-intrinsic module1475 // directories. If a directory is in both the intrinsic and non-intrinsic1476 // directory lists, the intrinsic module directory takes precedence.1477 options.searchDirectories = context_.searchDirectories();1478 for (const auto &dir : context_.intrinsicModuleDirectories()) {1479 options.searchDirectories.erase(1480 std::remove(options.searchDirectories.begin(),1481 options.searchDirectories.end(), dir),1482 options.searchDirectories.end());1483 }1484 options.searchDirectories.insert(options.searchDirectories.begin(), "."s);1485 }1486 bool foundNonIntrinsicModuleFile{false};1487 if (!isIntrinsic) {1488 std::list<std::string> searchDirs;1489 for (const auto &d : options.searchDirectories) {1490 searchDirs.push_back(d);1491 }1492 foundNonIntrinsicModuleFile =1493 parser::LocateSourceFile(path, searchDirs).has_value();1494 }1495 if (isIntrinsic.value_or(!foundNonIntrinsicModuleFile)) {1496 // Explicitly intrinsic, or not specified and not found in the search1497 // path; see whether it's already in the symbol table as an intrinsic1498 // module.1499 auto it{context_.intrinsicModulesScope().find(name)};1500 if (it != context_.intrinsicModulesScope().end()) {1501 return it->second->scope();1502 }1503 }1504 // We don't have this module in the symbol table yet.1505 // Find its module file and parse it. Define or extend the search1506 // path with intrinsic module directories, if appropriate.1507 if (isIntrinsic.value_or(true)) {1508 for (const auto &dir : context_.intrinsicModuleDirectories()) {1509 options.searchDirectories.push_back(dir);1510 }1511 if (!requiredHash) {1512 requiredHash =1513 context_.moduleDependences().GetRequiredHash(name.ToString(), true);1514 }1515 }1516 1517 // Look for the right module file if its hash is known1518 if (requiredHash && !fatalError) {1519 for (const std::string &maybe :1520 parser::LocateSourceFileAll(path, options.searchDirectories)) {1521 if (const auto *srcFile{context_.allCookedSources().allSources().OpenPath(1522 maybe, llvm::errs())}) {1523 if (auto checkSum{VerifyHeader(srcFile->content())};1524 checkSum && *checkSum == *requiredHash) {1525 path = maybe;1526 break;1527 }1528 }1529 }1530 }1531 const auto *sourceFile{fatalError ? nullptr : parsing.Prescan(path, options)};1532 if (fatalError || parsing.messages().AnyFatalError()) {1533 if (!silent) {1534 if (notAModule) {1535 // Module is not explicitly INTRINSIC, and there's already a global1536 // symbol of the same name that is not a module.1537 context_.SayWithDecl(1538 *notAModule, name, "'%s' is not a module"_err_en_US, name);1539 } else {1540 for (auto &msg : parsing.messages().messages()) {1541 std::string str{msg.ToString()};1542 Say("parse", name, ancestorName,1543 parser::MessageFixedText{str.c_str(), str.size(), msg.severity()},1544 path);1545 }1546 }1547 }1548 return nullptr;1549 }1550 CHECK(sourceFile);1551 std::optional<ModuleCheckSumType> checkSum{1552 VerifyHeader(sourceFile->content())};1553 if (!checkSum) {1554 Say("use", name, ancestorName, "File has invalid checksum: %s"_err_en_US,1555 sourceFile->path());1556 return nullptr;1557 } else if (requiredHash && *requiredHash != *checkSum) {1558 Say("use", name, ancestorName,1559 "File is not the right module file for %s"_err_en_US,1560 "'"s + name.ToString() + "': "s + sourceFile->path());1561 return nullptr;1562 }1563 llvm::raw_null_ostream NullStream;1564 parsing.Parse(NullStream);1565 std::optional<parser::Program> &parsedProgram{parsing.parseTree()};1566 if (!parsing.messages().empty() || !parsing.consumedWholeFile() ||1567 !parsedProgram) {1568 Say("parse", name, ancestorName, "Module file is corrupt: %s"_err_en_US,1569 sourceFile->path());1570 return nullptr;1571 }1572 parser::Program &parseTree{context_.SaveParseTree(std::move(*parsedProgram))};1573 Scope *parentScope; // the scope this module/submodule goes into1574 if (!isIntrinsic.has_value()) {1575 for (const auto &dir : context_.intrinsicModuleDirectories()) {1576 if (sourceFile->path().size() > dir.size() &&1577 sourceFile->path().find(dir) == 0) {1578 isIntrinsic = true;1579 break;1580 }1581 }1582 }1583 Scope &topScope{isIntrinsic.value_or(false) ? context_.intrinsicModulesScope()1584 : context_.globalScope()};1585 Symbol *moduleSymbol{nullptr};1586 const Symbol *previousModuleSymbol{nullptr};1587 if (!ancestor) { // module, not submodule1588 parentScope = &topScope;1589 auto pair{parentScope->try_emplace(name, UnknownDetails{})};1590 if (!pair.second) {1591 // There is already a global symbol or intrinsic module of the same name.1592 previousModuleSymbol = &*pair.first->second;1593 if (const auto *details{1594 previousModuleSymbol->detailsIf<ModuleDetails>()}) {1595 if (!details->moduleFileHash().has_value()) {1596 return nullptr;1597 }1598 } else {1599 return nullptr;1600 }1601 CHECK(parentScope->erase(name) != 0);1602 pair = parentScope->try_emplace(name, UnknownDetails{});1603 CHECK(pair.second);1604 }1605 moduleSymbol = &*pair.first->second;1606 moduleSymbol->set(Symbol::Flag::ModFile);1607 } else if (std::optional<SourceName> parent{GetSubmoduleParent(parseTree)}) {1608 // submodule with submodule parent1609 parentScope = Read(*parent, false /*not intrinsic*/, ancestor, silent);1610 } else {1611 // submodule with module parent1612 parentScope = ancestor;1613 }1614 // Process declarations from the module file1615 auto wasModuleFileName{context_.foldingContext().moduleFileName()};1616 context_.foldingContext().set_moduleFileName(name);1617 // Are there multiple modules in the module file due to it having been1618 // created under -fhermetic-module-files? If so, process them first in1619 // their own nested scope that will be visible only to USE statements1620 // within the module file.1621 Scope *previousHermetic{context_.currentHermeticModuleFileScope()};1622 if (parseTree.v.size() > 1) {1623 parser::Program hermeticModules{std::move(parseTree.v)};1624 parseTree.v.emplace_back(std::move(hermeticModules.v.front()));1625 hermeticModules.v.pop_front();1626 Scope &hermeticScope{topScope.MakeScope(Scope::Kind::Global)};1627 context_.set_currentHermeticModuleFileScope(&hermeticScope);1628 ResolveNames(context_, hermeticModules, hermeticScope);1629 for (auto &[_, ref] : hermeticScope) {1630 CHECK(ref->has<ModuleDetails>());1631 ref->set(Symbol::Flag::ModFile);1632 }1633 }1634 GetModuleDependences(context_.moduleDependences(), sourceFile->content());1635 ResolveNames(context_, parseTree, topScope);1636 context_.foldingContext().set_moduleFileName(wasModuleFileName);1637 context_.set_currentHermeticModuleFileScope(previousHermetic);1638 if (!moduleSymbol) {1639 // Submodule symbols' storage are owned by their parents' scopes,1640 // but their names are not in their parents' dictionaries -- we1641 // don't want to report bogus errors about clashes between submodule1642 // names and other objects in the parent scopes.1643 if (Scope * submoduleScope{ancestor->FindSubmodule(name)}) {1644 moduleSymbol = submoduleScope->symbol();1645 if (moduleSymbol) {1646 moduleSymbol->set(Symbol::Flag::ModFile);1647 }1648 }1649 }1650 if (moduleSymbol) {1651 CHECK(moduleSymbol->test(Symbol::Flag::ModFile));1652 auto &details{moduleSymbol->get<ModuleDetails>()};1653 details.set_moduleFileHash(checkSum.value());1654 details.set_previous(previousModuleSymbol);1655 if (isIntrinsic.value_or(false)) {1656 moduleSymbol->attrs().set(Attr::INTRINSIC);1657 }1658 return moduleSymbol->scope();1659 } else {1660 return nullptr;1661 }1662}1663 1664parser::Message &ModFileReader::Say(const char *verb, SourceName name,1665 const std::string &ancestor, parser::MessageFixedText &&msg,1666 const std::string &arg) {1667 return context_.Say(name, "Cannot %s module file for %s: %s"_err_en_US, verb,1668 parser::MessageFormattedText{ancestor.empty()1669 ? "module '%s'"_en_US1670 : "submodule '%s' of module '%s'"_en_US,1671 name, ancestor}1672 .MoveString(),1673 parser::MessageFormattedText{std::move(msg), arg}.MoveString());1674}1675 1676// program was read from a .mod file for a submodule; return the name of the1677// submodule's parent submodule, nullptr if none.1678static std::optional<SourceName> GetSubmoduleParent(1679 const parser::Program &program) {1680 CHECK(program.v.size() == 1);1681 auto &unit{program.v.front()};1682 auto &submod{std::get<common::Indirection<parser::Submodule>>(unit.u)};1683 auto &stmt{1684 std::get<parser::Statement<parser::SubmoduleStmt>>(submod.value().t)};1685 auto &parentId{std::get<parser::ParentIdentifier>(stmt.statement.t)};1686 if (auto &parent{std::get<std::optional<parser::Name>>(parentId.t)}) {1687 return parent->source;1688 } else {1689 return std::nullopt;1690 }1691}1692 1693void SubprogramSymbolCollector::Collect() {1694 const auto &details{symbol_.get<SubprogramDetails>()};1695 isInterface_ = details.isInterface();1696 for (const Symbol *dummyArg : details.dummyArgs()) {1697 if (dummyArg) {1698 DoSymbol(*dummyArg);1699 }1700 }1701 if (details.isFunction()) {1702 DoSymbol(details.result());1703 }1704 for (const auto &pair : scope_) {1705 const Symbol &symbol{*pair.second};1706 if (const auto *useDetails{symbol.detailsIf<UseDetails>()}) {1707 const Symbol &ultimate{useDetails->symbol().GetUltimate()};1708 bool needed{useSet_.count(ultimate) > 0};1709 if (const auto *generic{ultimate.detailsIf<GenericDetails>()}) {1710 // The generic may not be needed itself, but the specific procedure1711 // &/or derived type that it shadows may be needed.1712 const Symbol *spec{generic->specific()};1713 const Symbol *dt{generic->derivedType()};1714 needed = needed || (spec && useSet_.count(spec->GetUltimate()) > 0) ||1715 (dt && useSet_.count(dt->GetUltimate()) > 0);1716 } else if (const auto *subp{ultimate.detailsIf<SubprogramDetails>()}) {1717 const Symbol *interface { subp->moduleInterface() };1718 needed = needed || (interface && useSet_.count(*interface) > 0);1719 }1720 if (needed) {1721 need_.push_back(symbol);1722 }1723 } else if (symbol.has<SubprogramDetails>()) {1724 // An internal subprogram is needed if it is used as interface1725 // for a dummy or return value procedure.1726 bool needed{false};1727 const auto hasInterface{[&symbol](const Symbol *s) -> bool {1728 // Is 's' a procedure with interface 'symbol'?1729 if (s) {1730 if (const auto *sDetails{s->detailsIf<ProcEntityDetails>()}) {1731 if (sDetails->procInterface() == &symbol) {1732 return true;1733 }1734 }1735 }1736 return false;1737 }};1738 for (const Symbol *dummyArg : details.dummyArgs()) {1739 needed = needed || hasInterface(dummyArg);1740 }1741 needed =1742 needed || (details.isFunction() && hasInterface(&details.result()));1743 if (needed && needSet_.insert(symbol).second) {1744 need_.push_back(symbol);1745 }1746 }1747 }1748}1749 1750void SubprogramSymbolCollector::DoSymbol(const Symbol &symbol) {1751 DoSymbol(symbol.name(), symbol);1752}1753 1754// Do symbols this one depends on; then add to need_1755void SubprogramSymbolCollector::DoSymbol(1756 const SourceName &name, const Symbol &symbol) {1757 const auto &scope{symbol.owner()};1758 if (scope != scope_ && !scope.IsDerivedType()) {1759 if (scope != scope_.parent()) {1760 useSet_.insert(symbol);1761 }1762 if (NeedImport(name, symbol)) {1763 imports_.insert(name);1764 }1765 return;1766 }1767 if (!needSet_.insert(symbol).second) {1768 return; // already done1769 }1770 common::visit(common::visitors{1771 [this](const ObjectEntityDetails &details) {1772 for (const ShapeSpec &spec : details.shape()) {1773 DoBound(spec.lbound());1774 DoBound(spec.ubound());1775 }1776 for (const ShapeSpec &spec : details.coshape()) {1777 DoBound(spec.lbound());1778 DoBound(spec.ubound());1779 }1780 if (const Symbol * commonBlock{details.commonBlock()}) {1781 DoSymbol(*commonBlock);1782 }1783 },1784 [this](const CommonBlockDetails &details) {1785 for (const auto &object : details.objects()) {1786 DoSymbol(*object);1787 }1788 },1789 [this](const ProcEntityDetails &details) {1790 if (details.rawProcInterface()) {1791 DoSymbol(*details.rawProcInterface());1792 } else {1793 DoType(details.type());1794 }1795 },1796 [this](const ProcBindingDetails &details) {1797 DoSymbol(details.symbol());1798 },1799 [](const auto &) {},1800 },1801 symbol.details());1802 if (!symbol.has<UseDetails>()) {1803 DoType(symbol.GetType());1804 }1805 if (!scope.IsDerivedType()) {1806 need_.push_back(symbol);1807 }1808 if (symbol.test(Fortran::semantics::Symbol::Flag::CrayPointer)) {1809 for (const auto &[pointee, pointer] : symbol.owner().crayPointers()) {1810 if (&*pointer == &symbol) {1811 auto iter{symbol.owner().find(pointee)};1812 CHECK(iter != symbol.owner().end());1813 DoSymbol(*iter->second);1814 }1815 }1816 } else if (symbol.test(Fortran::semantics::Symbol::Flag::CrayPointee)) {1817 DoSymbol(GetCrayPointer(symbol));1818 }1819}1820 1821void SubprogramSymbolCollector::DoType(const DeclTypeSpec *type) {1822 if (!type) {1823 return;1824 }1825 switch (type->category()) {1826 case DeclTypeSpec::Numeric:1827 case DeclTypeSpec::Logical:1828 break; // nothing to do1829 case DeclTypeSpec::Character:1830 DoParamValue(type->characterTypeSpec().length());1831 break;1832 default:1833 if (const DerivedTypeSpec * derived{type->AsDerived()}) {1834 const auto &typeSymbol{derived->typeSymbol()};1835 for (const auto &pair : derived->parameters()) {1836 DoParamValue(pair.second);1837 }1838 // The components of the type (including its parent component, if1839 // any) matter to IMPORT symbol collection only for derived types1840 // defined in the subprogram.1841 if (typeSymbol.owner() == scope_) {1842 if (const DerivedTypeSpec * extends{typeSymbol.GetParentTypeSpec()}) {1843 DoSymbol(extends->name(), extends->typeSymbol());1844 }1845 for (const auto &pair : *typeSymbol.scope()) {1846 DoSymbol(*pair.second);1847 }1848 }1849 DoSymbol(derived->name(), typeSymbol);1850 }1851 }1852}1853 1854void SubprogramSymbolCollector::DoBound(const Bound &bound) {1855 if (const MaybeSubscriptIntExpr & expr{bound.GetExplicit()}) {1856 DoExpr(*expr);1857 }1858}1859void SubprogramSymbolCollector::DoParamValue(const ParamValue ¶mValue) {1860 if (const auto &expr{paramValue.GetExplicit()}) {1861 DoExpr(*expr);1862 }1863}1864 1865// Do we need a IMPORT of this symbol into an interface block?1866bool SubprogramSymbolCollector::NeedImport(1867 const SourceName &name, const Symbol &symbol) {1868 if (!isInterface_) {1869 return false;1870 } else if (IsSeparateModuleProcedureInterface(&symbol_)) {1871 return false; // IMPORT needed only for external and dummy procedure1872 // interfaces1873 } else if (&symbol == scope_.symbol()) {1874 return false;1875 } else if (symbol.owner().Contains(scope_)) {1876 return true;1877 } else if (const Symbol *found{scope_.FindSymbol(name)}) {1878 // detect import from ancestor of use-associated symbol1879 return found->has<UseDetails>() && found->owner() != scope_;1880 } else {1881 // "found" can be null in the case of a use-associated derived type's1882 // parent type, and also in the case of an object (like a dummy argument)1883 // used to define a length or bound of a nested interface.1884 return false;1885 }1886}1887 1888} // namespace Fortran::semantics1889