diff --git a/flang/include/flang/Lower/Mangler.h b/flang/include/flang/Lower/Mangler.h new file mode 100644 --- /dev/null +++ b/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_ diff --git a/flang/include/flang/Optimizer/Support/InternalNames.h b/flang/include/flang/Optimizer/Support/InternalNames.h --- a/flang/include/flang/Optimizer/Support/InternalNames.h +++ b/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 diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt --- a/flang/lib/Lower/CMakeLists.txt +++ b/flang/lib/Lower/CMakeLists.txt @@ -4,6 +4,7 @@ ComplexExpr.cpp ConvertType.cpp DoLoopHelper.cpp + Mangler.cpp OpenMP.cpp PFTBuilder.cpp diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp new file mode 100644 --- /dev/null +++ b/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 procedure 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; +} diff --git a/flang/lib/Optimizer/Support/InternalNames.cpp b/flang/lib/Optimizer/Support/InternalNames.cpp --- a/flang/lib/Optimizer/Support/InternalNames.cpp +++ b/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 diff --git a/flang/unittests/Optimizer/InternalNamesTest.cpp b/flang/unittests/Optimizer/InternalNamesTest.cpp --- a/flang/unittests/Optimizer/InternalNamesTest.cpp +++ b/flang/unittests/Optimizer/InternalNamesTest.cpp @@ -1,4 +1,4 @@ -//===- InternalNames.cpp - InternalNames unit tests ---------------===// +//===- InternalNamesTest.cpp -- InternalNames unit tests ------------------===// // // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. // See https://llvm.org/LICENSE.txt for license information. @@ -8,13 +8,202 @@ #include "flang/Optimizer/Support/InternalNames.h" #include "gtest/gtest.h" +#include using namespace fir; -using namespace llvm; +using llvm::SmallVector; +using llvm::StringRef; -TEST(genericName, MyTest) { +struct DeconstructedName { + DeconstructedName(llvm::ArrayRef modules, + llvm::Optional host, llvm::StringRef name, + llvm::ArrayRef kinds) + : modules{modules.begin(), modules.end()}, host{host}, name{name}, + kinds{kinds.begin(), kinds.end()} {} + + bool isObjEqual(const NameUniquer::DeconstructedName &actualObj) { + if ((actualObj.name == name) && (actualObj.modules == modules) && + (actualObj.host == host) && (actualObj.kinds == kinds)) { + return true; + } + return false; + } + +private: + llvm::SmallVector modules; + llvm::Optional host; + std::string name; + llvm::SmallVector kinds; +}; + +void validateDeconstructedName( + std::pair &actual, + NameUniquer::NameKind &expectedNameKind, + struct DeconstructedName &components) { + EXPECT_EQ(actual.first, expectedNameKind) + << "Possible error: NameKind mismatch"; + ASSERT_TRUE(components.isObjEqual(actual.second)) + << "Possible error: DeconstructedName mismatch"; +} + +TEST(InternalNamesTest, doCommonBlockTest) { + NameUniquer obj; + std::string actual = obj.doCommonBlock("hello"); + std::string actualBlank = obj.doCommonBlock(""); + std::string expectedMangledName = "_QBhello"; + std::string expectedMangledNameBlank = "_QB"; + ASSERT_EQ(actual, expectedMangledName); + ASSERT_EQ(actualBlank, expectedMangledNameBlank); +} + +TEST(InternalNamesTest, doGeneratedTest) { NameUniquer obj; - std::string val = obj.doCommonBlock("hello"); - std::string val2 = "_QBhello"; - EXPECT_EQ(val, val2); + std::string actual = obj.doGenerated("@MAIN"); + std::string expectedMangledName = "_QQ@MAIN"; + ASSERT_EQ(actual, expectedMangledName); + + std::string actual1 = obj.doGenerated("@_ZNSt8ios_base4InitC1Ev"); + std::string expectedMangledName1 = "_QQ@_ZNSt8ios_base4InitC1Ev"; + ASSERT_EQ(actual1, expectedMangledName1); + + std::string actual2 = obj.doGenerated("_QQ@MAIN"); + std::string expectedMangledName2 = "_QQ_QQ@MAIN"; + ASSERT_EQ(actual2, expectedMangledName2); +} + +TEST(InternalNamesTest, doConstantTest) { + NameUniquer obj; + std::string actual = obj.doConstant({"mod1", "mod2"}, {"foo"}, "Hello"); + std::string expectedMangledName = "_QMmod1Smod2FfooEChello"; + ASSERT_EQ(actual, expectedMangledName); +} + +TEST(InternalNamesTest, doProcedureTest) { + NameUniquer obj; + std::string actual = obj.doProcedure({"mod1", "mod2"}, {}, "HeLLo"); + std::string expectedMangledName = "_QMmod1Smod2Phello"; + ASSERT_EQ(actual, expectedMangledName); +} + +TEST(InternalNamesTest, doTypeTest) { + NameUniquer obj; + std::string actual = obj.doType({}, {}, "mytype", {4, -1}); + std::string expectedMangledName = "_QTmytypeK4KN1"; + ASSERT_EQ(actual, expectedMangledName); +} + +TEST(InternalNamesTest, doIntrinsicTypeDescriptorTest) { + using IntrinsicType = fir::NameUniquer::IntrinsicType; + NameUniquer obj; + std::string actual = + obj.doIntrinsicTypeDescriptor({}, {}, IntrinsicType::REAL, 42); + std::string expectedMangledName = "_QCrealK42"; + ASSERT_EQ(actual, expectedMangledName); + + actual = obj.doIntrinsicTypeDescriptor({}, {}, IntrinsicType::REAL, {}); + expectedMangledName = "_QCrealK0"; + ASSERT_EQ(actual, expectedMangledName); + + actual = obj.doIntrinsicTypeDescriptor({}, {}, IntrinsicType::INTEGER, 3); + expectedMangledName = "_QCintegerK3"; + ASSERT_EQ(actual, expectedMangledName); + + actual = obj.doIntrinsicTypeDescriptor({}, {}, IntrinsicType::LOGICAL, 2); + expectedMangledName = "_QClogicalK2"; + ASSERT_EQ(actual, expectedMangledName); + + actual = obj.doIntrinsicTypeDescriptor({}, {}, IntrinsicType::CHARACTER, 4); + expectedMangledName = "_QCcharacterK4"; + ASSERT_EQ(actual, expectedMangledName); + + actual = obj.doIntrinsicTypeDescriptor({}, {}, IntrinsicType::COMPLEX, 4); + expectedMangledName = "_QCcomplexK4"; + ASSERT_EQ(actual, expectedMangledName); } + +TEST(InternalNamesTest, doDispatchTableTest) { + NameUniquer obj; + std::string actual = obj.doDispatchTable({}, {}, "MyTYPE", {2, 8, 18}); + std::string expectedMangledName = "_QDTmytypeK2K8K18"; + ASSERT_EQ(actual, expectedMangledName); +} + +TEST(InternalNamesTest, doTypeDescriptorTest) { + NameUniquer obj; + std::string actual = obj.doTypeDescriptor( + {StringRef("moD1")}, {StringRef("foo")}, "MyTYPE", {2, 8}); + std::string expectedMangledName = "_QMmod1FfooCTmytypeK2K8"; + ASSERT_EQ(actual, expectedMangledName); +} + +TEST(InternalNamesTest, doVariableTest) { + NameUniquer obj; + std::string actual = obj.doVariable( + {"mod1", "mod2"}, {""}, "intvar"); // Function is present and is blank. + std::string expectedMangledName = "_QMmod1Smod2FEintvar"; + ASSERT_EQ(actual, expectedMangledName); + + std::string actual2 = obj.doVariable( + {"mod1", "mod2"}, {}, "intVariable"); // Function is not present. + std::string expectedMangledName2 = "_QMmod1Smod2Eintvariable"; + ASSERT_EQ(actual2, expectedMangledName2); +} + +TEST(InternalNamesTest, doProgramEntry) { + NameUniquer obj; + llvm::StringRef actual = obj.doProgramEntry(); + std::string expectedMangledName = "_QQmain"; + ASSERT_EQ(actual.str(), expectedMangledName); +} + +TEST(InternalNamesTest, deconstructTest) { + NameUniquer obj; + std::pair actual = obj.deconstruct("_QBhello"); + auto expectedNameKind = NameUniquer::NameKind::COMMON; + struct DeconstructedName expectedComponents { + {}, {}, "hello", {} + }; + validateDeconstructedName(actual, expectedNameKind, expectedComponents); +} + +TEST(InternalNamesTest, complexdeconstructTest) { + using NameKind = fir::NameUniquer::NameKind; + NameUniquer obj; + std::pair actual = obj.deconstruct("_QMmodSs1modSs2modFsubPfun"); + auto expectedNameKind = NameKind::PROCEDURE; + struct DeconstructedName expectedComponents = { + {"mod", "s1mod", "s2mod"}, {"sub"}, "fun", {}}; + validateDeconstructedName(actual, expectedNameKind, expectedComponents); + + actual = obj.deconstruct("_QPsub"); + expectedNameKind = NameKind::PROCEDURE; + expectedComponents = {{}, {}, "sub", {}}; + validateDeconstructedName(actual, expectedNameKind, expectedComponents); + + actual = obj.deconstruct("_QBvariables"); + expectedNameKind = NameKind::COMMON; + expectedComponents = {{}, {}, "variables", {}}; + validateDeconstructedName(actual, expectedNameKind, expectedComponents); + + actual = obj.deconstruct("_QMmodEintvar"); + expectedNameKind = NameKind::VARIABLE; + expectedComponents = {{"mod"}, {}, "intvar", {}}; + validateDeconstructedName(actual, expectedNameKind, expectedComponents); + + actual = obj.deconstruct("_QMmodECpi"); + expectedNameKind = NameKind::CONSTANT; + expectedComponents = {{"mod"}, {}, "pi", {}}; + validateDeconstructedName(actual, expectedNameKind, expectedComponents); + + actual = obj.deconstruct("_QTyourtypeK4KN6"); + expectedNameKind = NameKind::DERIVED_TYPE; + expectedComponents = {{}, {}, "yourtype", {4, -6}}; + validateDeconstructedName(actual, expectedNameKind, expectedComponents); + + actual = obj.deconstruct("_QDTt"); + expectedNameKind = NameKind::DISPATCH_TABLE; + expectedComponents = {{}, {}, "t", {}}; + validateDeconstructedName(actual, expectedNameKind, expectedComponents); +} + +// main() from gtest_main