1 //===-- Mangler.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-exception
6 //
7 //===----------------------------------------------------------------------===//
8 
9 #include "flang/Lower/Mangler.h"
10 #include "flang/Common/reference.h"
11 #include "flang/Lower/Support/Utils.h"
12 #include "flang/Optimizer/Builder/Todo.h"
13 #include "flang/Optimizer/Dialect/FIRType.h"
14 #include "flang/Optimizer/Support/InternalNames.h"
15 #include "flang/Semantics/tools.h"
16 #include "llvm/ADT/ArrayRef.h"
17 #include "llvm/ADT/Optional.h"
18 #include "llvm/ADT/SmallVector.h"
19 #include "llvm/ADT/StringRef.h"
20 #include "llvm/ADT/Twine.h"
21 #include "llvm/Support/MD5.h"
22 
23 // recursively build the vector of module scopes
24 static void moduleNames(const Fortran::semantics::Scope &scope,
25                         llvm::SmallVector<llvm::StringRef> &result) {
26   if (scope.IsTopLevel())
27     return;
28   moduleNames(scope.parent(), result);
29   if (scope.kind() == Fortran::semantics::Scope::Kind::Module)
30     if (const Fortran::semantics::Symbol *symbol = scope.symbol())
31       result.emplace_back(toStringRef(symbol->name()));
32 }
33 
34 static llvm::SmallVector<llvm::StringRef>
35 moduleNames(const Fortran::semantics::Symbol &symbol) {
36   const Fortran::semantics::Scope &scope = symbol.owner();
37   llvm::SmallVector<llvm::StringRef> result;
38   moduleNames(scope, result);
39   return result;
40 }
41 
42 static llvm::Optional<llvm::StringRef>
43 hostName(const Fortran::semantics::Symbol &symbol) {
44   const Fortran::semantics::Scope &scope = symbol.owner();
45   if (scope.kind() == Fortran::semantics::Scope::Kind::Subprogram) {
46     assert(scope.symbol() && "subprogram scope must have a symbol");
47     return toStringRef(scope.symbol()->name());
48   }
49   if (scope.kind() == Fortran::semantics::Scope::Kind::MainProgram)
50     // Do not use the main program name, if any, because it may lead to name
51     // collision with procedures with the same name in other compilation units
52     // (technically illegal, but all compilers are able to compile and link
53     // properly these programs).
54     return llvm::StringRef("");
55   return {};
56 }
57 
58 static const Fortran::semantics::Symbol *
59 findInterfaceIfSeperateMP(const Fortran::semantics::Symbol &symbol) {
60   const auto &scope = symbol.owner();
61   if (symbol.attrs().test(Fortran::semantics::Attr::MODULE) &&
62       scope.IsSubmodule()) {
63     // FIXME symbol from MpSubprogramStmt do not seem to have
64     // Attr::MODULE set.
65     const auto *iface = scope.parent().FindSymbol(symbol.name());
66     assert(iface && "Separate module procedure must be declared");
67     return iface;
68   }
69   return nullptr;
70 }
71 
72 // Mangle the name of `symbol` to make it unique within FIR's symbol table using
73 // the FIR name mangler, `mangler`
74 std::string
75 Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,
76                                    bool keepExternalInScope) {
77   // Resolve host and module association before mangling
78   const auto &ultimateSymbol = symbol.GetUltimate();
79   auto symbolName = toStringRef(ultimateSymbol.name());
80 
81   return std::visit(
82       Fortran::common::visitors{
83           [&](const Fortran::semantics::MainProgramDetails &) {
84             return fir::NameUniquer::doProgramEntry().str();
85           },
86           [&](const Fortran::semantics::SubprogramDetails &) {
87             // Mangle external procedure without any scope prefix.
88             if (!keepExternalInScope &&
89                 Fortran::semantics::IsExternal(ultimateSymbol))
90               return fir::NameUniquer::doProcedure(llvm::None, llvm::None,
91                                                    symbolName);
92             // Separate module subprograms must be mangled according to the
93             // scope where they were declared (the symbol we have is the
94             // definition).
95             const auto *interface = &ultimateSymbol;
96             if (const auto *mpIface = findInterfaceIfSeperateMP(ultimateSymbol))
97               interface = mpIface;
98             auto modNames = moduleNames(*interface);
99             return fir::NameUniquer::doProcedure(modNames, hostName(*interface),
100                                                  symbolName);
101           },
102           [&](const Fortran::semantics::ProcEntityDetails &) {
103             // Mangle procedure pointers and dummy procedures as variables
104             if (Fortran::semantics::IsPointer(ultimateSymbol) ||
105                 Fortran::semantics::IsDummy(ultimateSymbol))
106               return fir::NameUniquer::doVariable(moduleNames(ultimateSymbol),
107                                                   hostName(ultimateSymbol),
108                                                   symbolName);
109             // Otherwise, this is an external procedure, even if it does not
110             // have an explicit EXTERNAL attribute. Mangle it without any
111             // prefix.
112             return fir::NameUniquer::doProcedure(llvm::None, llvm::None,
113                                                  symbolName);
114           },
115           [&](const Fortran::semantics::ObjectEntityDetails &) {
116             auto modNames = moduleNames(ultimateSymbol);
117             auto optHost = hostName(ultimateSymbol);
118             if (Fortran::semantics::IsNamedConstant(ultimateSymbol))
119               return fir::NameUniquer::doConstant(modNames, optHost,
120                                                   symbolName);
121             return fir::NameUniquer::doVariable(modNames, optHost, symbolName);
122           },
123           [&](const Fortran::semantics::NamelistDetails &) {
124             auto modNames = moduleNames(ultimateSymbol);
125             auto optHost = hostName(ultimateSymbol);
126             return fir::NameUniquer::doNamelistGroup(modNames, optHost,
127                                                      symbolName);
128           },
129           [&](const Fortran::semantics::CommonBlockDetails &) {
130             return fir::NameUniquer::doCommonBlock(symbolName);
131           },
132           [&](const Fortran::semantics::DerivedTypeDetails &) -> std::string {
133             // Derived type mangling must used mangleName(DerivedTypeSpec&) so
134             // that kind type parameter values can be mangled.
135             llvm::report_fatal_error(
136                 "only derived type instances can be mangled");
137           },
138           [](const auto &) -> std::string { TODO_NOLOC("symbol mangling"); },
139       },
140       ultimateSymbol.details());
141 }
142 
143 std::string Fortran::lower::mangle::mangleName(
144     const Fortran::semantics::DerivedTypeSpec &derivedType) {
145   // Resolve host and module association before mangling
146   const auto &ultimateSymbol = derivedType.typeSymbol().GetUltimate();
147   auto symbolName = toStringRef(ultimateSymbol.name());
148   auto modNames = moduleNames(ultimateSymbol);
149   auto optHost = hostName(ultimateSymbol);
150   llvm::SmallVector<std::int64_t> kinds;
151   for (const auto &param :
152        Fortran::semantics::OrderParameterDeclarations(ultimateSymbol)) {
153     const auto &paramDetails =
154         param->get<Fortran::semantics::TypeParamDetails>();
155     if (paramDetails.attr() == Fortran::common::TypeParamAttr::Kind) {
156       const auto *paramValue = derivedType.FindParameter(param->name());
157       assert(paramValue && "derived type kind parameter value not found");
158       auto paramExpr = paramValue->GetExplicit();
159       assert(paramExpr && "derived type kind param not explicit");
160       auto init = Fortran::evaluate::ToInt64(paramValue->GetExplicit());
161       assert(init && "derived type kind param is not constant");
162       kinds.emplace_back(*init);
163     }
164   }
165   return fir::NameUniquer::doType(modNames, optHost, symbolName, kinds);
166 }
167 
168 std::string Fortran::lower::mangle::demangleName(llvm::StringRef name) {
169   auto result = fir::NameUniquer::deconstruct(name);
170   return result.second.name;
171 }
172 
173 //===----------------------------------------------------------------------===//
174 // Array Literals Mangling
175 //===----------------------------------------------------------------------===//
176 
177 static std::string typeToString(Fortran::common::TypeCategory cat, int kind) {
178   switch (cat) {
179   case Fortran::common::TypeCategory::Integer:
180     return "i" + std::to_string(kind);
181   case Fortran::common::TypeCategory::Real:
182     return "r" + std::to_string(kind);
183   case Fortran::common::TypeCategory::Complex:
184     return "z" + std::to_string(kind);
185   case Fortran::common::TypeCategory::Logical:
186     return "l" + std::to_string(kind);
187   case Fortran::common::TypeCategory::Character:
188     return "c" + std::to_string(kind);
189   case Fortran::common::TypeCategory::Derived:
190     // FIXME: Replace "DT" with the (fully qualified) type name.
191     return "dt.DT";
192   }
193   llvm_unreachable("bad TypeCategory");
194 }
195 
196 std::string Fortran::lower::mangle::mangleArrayLiteral(
197     const uint8_t *addr, size_t size,
198     const Fortran::evaluate::ConstantSubscripts &shape,
199     Fortran::common::TypeCategory cat, int kind,
200     Fortran::common::ConstantSubscript charLen) {
201   std::string typeId = "";
202   for (Fortran::evaluate::ConstantSubscript extent : shape)
203     typeId.append(std::to_string(extent)).append("x");
204   if (charLen >= 0)
205     typeId.append(std::to_string(charLen)).append("x");
206   typeId.append(typeToString(cat, kind));
207   std::string name =
208       fir::NameUniquer::doGenerated("ro."s.append(typeId).append("."));
209   if (!size)
210     return name += "null";
211   llvm::MD5 hashValue{};
212   hashValue.update(llvm::ArrayRef<uint8_t>{addr, size});
213   llvm::MD5::MD5Result hashResult;
214   hashValue.final(hashResult);
215   llvm::SmallString<32> hashString;
216   llvm::MD5::stringifyResult(hashResult, hashString);
217   return name += hashString.c_str();
218 }
219 
220 //===----------------------------------------------------------------------===//
221 // Intrinsic Procedure Mangling
222 //===----------------------------------------------------------------------===//
223 
224 /// Helper to encode type into string for intrinsic procedure names.
225 /// Note: mlir has Type::dump(ostream) methods but it may add "!" that is not
226 /// suitable for function names.
227 static std::string typeToString(mlir::Type t) {
228   if (auto refT{t.dyn_cast<fir::ReferenceType>()})
229     return "ref_" + typeToString(refT.getEleTy());
230   if (auto i{t.dyn_cast<mlir::IntegerType>()}) {
231     return "i" + std::to_string(i.getWidth());
232   }
233   if (auto cplx{t.dyn_cast<fir::ComplexType>()}) {
234     return "z" + std::to_string(cplx.getFKind());
235   }
236   if (auto real{t.dyn_cast<fir::RealType>()}) {
237     return "r" + std::to_string(real.getFKind());
238   }
239   if (auto f{t.dyn_cast<mlir::FloatType>()}) {
240     return "f" + std::to_string(f.getWidth());
241   }
242   if (auto logical{t.dyn_cast<fir::LogicalType>()}) {
243     return "l" + std::to_string(logical.getFKind());
244   }
245   if (auto character{t.dyn_cast<fir::CharacterType>()}) {
246     return "c" + std::to_string(character.getFKind());
247   }
248   if (auto boxCharacter{t.dyn_cast<fir::BoxCharType>()}) {
249     return "bc" + std::to_string(boxCharacter.getEleTy().getFKind());
250   }
251   llvm_unreachable("no mangling for type");
252 }
253 
254 std::string fir::mangleIntrinsicProcedure(llvm::StringRef intrinsic,
255                                           mlir::FunctionType funTy) {
256   std::string name = "fir.";
257   name.append(intrinsic.str()).append(".");
258   assert(funTy.getNumResults() == 1 && "only function mangling supported");
259   name.append(typeToString(funTy.getResult(0)));
260   auto e = funTy.getNumInputs();
261   for (decltype(e) i = 0; i < e; ++i)
262     name.append(".").append(typeToString(funTy.getInput(i)));
263   return name;
264 }
265