Index: flang/include/flang/Lower/Mangler.h =================================================================== --- /dev/null +++ flang/include/flang/Lower/Mangler.h @@ -0,0 +1,44 @@ +//===-- Lower/Mangler.h -- name mangling ------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_MANGLER_H_ +#define FORTRAN_LOWER_MANGLER_H_ + +#include + +namespace fir { +struct NameUniquer; +} + +namespace llvm { +class StringRef; +} + +namespace Fortran { +namespace common { +template +class Reference; +} + +namespace semantics { +class Symbol; +} + +namespace lower { +namespace mangle { + +/// Convert a front-end Symbol to an internal name +std::string mangleName(fir::NameUniquer &uniquer, const semantics::Symbol &); + +std::string demangleName(llvm::StringRef name); + +} // namespace mangle +} // namespace lower +} // namespace Fortran + +#endif // FORTRAN_LOWER_MANGLER_H_ Index: flang/include/flang/Optimizer/Support/InternalNames.h =================================================================== --- flang/include/flang/Optimizer/Support/InternalNames.h +++ flang/include/flang/Optimizer/Support/InternalNames.h @@ -65,6 +65,7 @@ /// Unique a (global) constant name std::string doConstant(llvm::ArrayRef modules, + llvm::Optional host, llvm::StringRef name); /// Unique a dispatch table name Index: flang/lib/Lower/CMakeLists.txt =================================================================== --- flang/lib/Lower/CMakeLists.txt +++ flang/lib/Lower/CMakeLists.txt @@ -3,6 +3,7 @@ add_flang_library(FortranLower ConvertType.cpp ComplexExpr.cpp + Mangler.cpp OpenMP.cpp PFTBuilder.cpp Index: flang/lib/Lower/Mangler.cpp =================================================================== --- /dev/null +++ flang/lib/Lower/Mangler.cpp @@ -0,0 +1,120 @@ +//===-- Mangler.cpp -------------------------------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/Mangler.h" +#include "flang/Common/reference.h" +#include "flang/Lower/Utils.h" +#include "flang/Optimizer/Support/InternalNames.h" +#include "flang/Semantics/tools.h" +#include "llvm/ADT/ArrayRef.h" +#include "llvm/ADT/Optional.h" +#include "llvm/ADT/SmallVector.h" +#include "llvm/ADT/Twine.h" + +// recursively build the vector of module scopes +static void moduleNames(const Fortran::semantics::Scope &scope, + llvm::SmallVector &result) { + if (scope.kind() == Fortran::semantics::Scope::Kind::Global) { + return; + } + moduleNames(scope.parent(), result); + if (scope.kind() == Fortran::semantics::Scope::Kind::Module) + if (auto *symbol = scope.symbol()) + result.emplace_back(toStringRef(symbol->name())); +} + +static llvm::SmallVector +moduleNames(const Fortran::semantics::Symbol &symbol) { + const auto &scope = symbol.owner(); + llvm::SmallVector result; + moduleNames(scope, result); + return result; +} + +static llvm::Optional +hostName(const Fortran::semantics::Symbol &symbol) { + const auto &scope = symbol.owner(); + if (scope.kind() == Fortran::semantics::Scope::Kind::Subprogram) { + assert(scope.symbol() && "subprogram scope must have a symbol"); + return {toStringRef(scope.symbol()->name())}; + } + return {}; +} + +static const Fortran::semantics::Symbol * +findInterfaceIfSeperateMP(const Fortran::semantics::Symbol &symbol) { + const auto &scope = symbol.owner(); + if (symbol.attrs().test(Fortran::semantics::Attr::MODULE) && + scope.IsSubmodule()) { + // FIXME symbol from MpSubprogramStmt do not seem to have + // Attr::MODULE set. + const auto *iface = scope.parent().FindSymbol(symbol.name()); + assert(iface && "Separate module proc must be declared"); + return iface; + } + return nullptr; +} + +// Mangle the name of `symbol` to make it unique within FIR's symbol table using +// the FIR name mangler, `mangler` +std::string +Fortran::lower::mangle::mangleName(fir::NameUniquer &uniquer, + const Fortran::semantics::Symbol &symbol) { + // Resolve host and module association before mangling + const auto &ultimateSymbol = symbol.GetUltimate(); + auto symbolName = toStringRef(ultimateSymbol.name()); + + return std::visit( + Fortran::common::visitors{ + [&](const Fortran::semantics::MainProgramDetails &) { + return uniquer.doProgramEntry().str(); + }, + [&](const Fortran::semantics::SubprogramDetails &) { + // Mangle external procedure without any scope prefix. + if (Fortran::semantics::IsExternal(ultimateSymbol)) + return uniquer.doProcedure(llvm::None, llvm::None, symbolName); + // Separate module subprograms must be mangled according to the + // scope where they were declared (the symbol we have is the + // definition). + const auto *interface = &ultimateSymbol; + if (const auto *mpIface = findInterfaceIfSeperateMP(ultimateSymbol)) + interface = mpIface; + auto modNames = moduleNames(*interface); + return uniquer.doProcedure(modNames, hostName(*interface), + symbolName); + }, + [&](const Fortran::semantics::ProcEntityDetails &) { + // Mangle procedure pointers and dummy procedures as variables + if (Fortran::semantics::IsPointer(ultimateSymbol) || + Fortran::semantics::IsDummy(ultimateSymbol)) + return uniquer.doVariable(moduleNames(ultimateSymbol), + hostName(ultimateSymbol), symbolName); + // Otherwise, this is an external procedure, even if it does not + // have an explicit EXTERNAL attribute. Mangle it without any + // prefix. + return uniquer.doProcedure(llvm::None, llvm::None, symbolName); + }, + [&](const Fortran::semantics::ObjectEntityDetails &) { + auto modNames = moduleNames(ultimateSymbol); + auto optHost = hostName(ultimateSymbol); + if (Fortran::semantics::IsNamedConstant(ultimateSymbol)) + return uniquer.doConstant(modNames, optHost, symbolName); + return uniquer.doVariable(modNames, optHost, symbolName); + }, + [](const auto &) -> std::string { + assert(false); + return {}; + }, + }, + ultimateSymbol.details()); +} + +std::string Fortran::lower::mangle::demangleName(llvm::StringRef name) { + auto result = fir::NameUniquer::deconstruct(name); + return result.second.name; +} Index: flang/lib/Optimizer/Support/InternalNames.cpp =================================================================== --- flang/lib/Optimizer/Support/InternalNames.cpp +++ flang/lib/Optimizer/Support/InternalNames.cpp @@ -23,7 +23,7 @@ std::string result; auto *token = "M"; for (auto mod : mods) { - result.append(token).append(mod); + result.append(token).append(mod.lower()); token = "S"; } return result; @@ -33,7 +33,7 @@ llvm::Optional host) { std::string result = doModules(mods); if (host.hasValue()) - result.append("F").append(*host); + result.append("F").append(host->lower()); return result; } @@ -52,10 +52,10 @@ static std::string readName(llvm::StringRef uniq, std::size_t &i, std::size_t init, std::size_t end) { - for (i = init; i < end && uniq[i] >= 'a' && uniq[i] <= 'z'; ++i) { + for (i = init; i < end && (uniq[i] < 'A' || uniq[i] > 'Z'); ++i) { // do nothing } - return uniq.substr(init, i).str(); + return uniq.substr(init, (i - init)).str(); } static std::int64_t readInt(llvm::StringRef uniq, std::size_t &i, @@ -64,7 +64,7 @@ // do nothing } std::int64_t result = BAD_VALUE; - if (uniq.substr(init, i).getAsInteger(10, result)) + if (uniq.substr(init, i - init).getAsInteger(10, result)) return BAD_VALUE; return result; } @@ -99,9 +99,11 @@ std::string fir::NameUniquer::doConstant(llvm::ArrayRef modules, + llvm::Optional host, llvm::StringRef name) { std::string result = prefix(); - return result.append(doModules(modules)).append("EC").append(toLower(name)); + result.append(doModulesHost(modules, host)).append("EC"); + return result.append(toLower(name)); } std::string