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/SmallVector.h" 18 #include "llvm/ADT/StringRef.h" 19 #include "llvm/Support/MD5.h" 20 21 /// Return all ancestor module and submodule scope names; all host procedure 22 /// and statement function scope names; and the innermost blockId containing 23 /// \p scope, including scope itself. 24 static std::tuple<llvm::SmallVector<llvm::StringRef>, 25 llvm::SmallVector<llvm::StringRef>, std::int64_t> 26 ancestors(const Fortran::semantics::Scope &scope, 27 Fortran::lower::mangle::ScopeBlockIdMap &scopeBlockIdMap) { 28 llvm::SmallVector<const Fortran::semantics::Scope *> scopes; 29 for (auto *scp = &scope; !scp->IsGlobal(); scp = &scp->parent()) 30 scopes.push_back(scp); 31 llvm::SmallVector<llvm::StringRef> modules; 32 llvm::SmallVector<llvm::StringRef> procs; 33 std::int64_t blockId = 0; 34 for (auto iter = scopes.rbegin(), rend = scopes.rend(); iter != rend; 35 ++iter) { 36 auto *scp = *iter; 37 switch (scp->kind()) { 38 case Fortran::semantics::Scope::Kind::Module: 39 modules.emplace_back(toStringRef(scp->symbol()->name())); 40 break; 41 case Fortran::semantics::Scope::Kind::Subprogram: 42 procs.emplace_back(toStringRef(scp->symbol()->name())); 43 break; 44 case Fortran::semantics::Scope::Kind::MainProgram: 45 // Do not use the main program name, if any, because it may collide 46 // with a procedure of the same name in another compilation unit. 47 // This is nonconformant, but universally allowed. 48 procs.emplace_back(llvm::StringRef("")); 49 break; 50 case Fortran::semantics::Scope::Kind::BlockConstruct: { 51 auto it = scopeBlockIdMap.find(scp); 52 assert(it != scopeBlockIdMap.end() && it->second && 53 "invalid block identifier"); 54 blockId = it->second; 55 } break; 56 default: 57 break; 58 } 59 } 60 return {modules, procs, blockId}; 61 } 62 63 /// Return all ancestor module and submodule scope names; all host procedure 64 /// and statement function scope names; and the innermost blockId containing 65 /// \p symbol. 66 static std::tuple<llvm::SmallVector<llvm::StringRef>, 67 llvm::SmallVector<llvm::StringRef>, std::int64_t> 68 ancestors(const Fortran::semantics::Symbol &symbol, 69 Fortran::lower::mangle::ScopeBlockIdMap &scopeBlockIdMap) { 70 return ancestors(symbol.owner(), scopeBlockIdMap); 71 } 72 73 /// Return a globally unique string for a compiler generated \p name. 74 std::string 75 Fortran::lower::mangle::mangleName(std::string &name, 76 const Fortran::semantics::Scope &scope, 77 ScopeBlockIdMap &scopeBlockIdMap) { 78 llvm::SmallVector<llvm::StringRef> modules; 79 llvm::SmallVector<llvm::StringRef> procs; 80 std::int64_t blockId; 81 std::tie(modules, procs, blockId) = ancestors(scope, scopeBlockIdMap); 82 return fir::NameUniquer::doGenerated(modules, procs, blockId, name); 83 } 84 85 // Mangle the name of \p symbol to make it globally unique. 86 std::string Fortran::lower::mangle::mangleName( 87 const Fortran::semantics::Symbol &symbol, ScopeBlockIdMap &scopeBlockIdMap, 88 bool keepExternalInScope, bool underscoring) { 89 // Resolve module and host associations before mangling. 90 const auto &ultimateSymbol = symbol.GetUltimate(); 91 92 // The Fortran and BIND(C) namespaces are counterintuitive. A BIND(C) name is 93 // substituted early, and has precedence over the Fortran name. This allows 94 // multiple procedures or objects with identical Fortran names to legally 95 // coexist. The BIND(C) name is unique. 96 if (auto *overrideName = ultimateSymbol.GetBindName()) 97 return *overrideName; 98 99 llvm::StringRef symbolName = toStringRef(ultimateSymbol.name()); 100 llvm::SmallVector<llvm::StringRef> modules; 101 llvm::SmallVector<llvm::StringRef> procs; 102 std::int64_t blockId; 103 104 // mangle ObjectEntityDetails or AssocEntityDetails symbols. 105 auto mangleObject = [&]() -> std::string { 106 std::tie(modules, procs, blockId) = 107 ancestors(ultimateSymbol, scopeBlockIdMap); 108 if (Fortran::semantics::IsNamedConstant(ultimateSymbol)) 109 return fir::NameUniquer::doConstant(modules, procs, blockId, symbolName); 110 return fir::NameUniquer::doVariable(modules, procs, blockId, symbolName); 111 }; 112 113 return Fortran::common::visit( 114 Fortran::common::visitors{ 115 [&](const Fortran::semantics::MainProgramDetails &) { 116 return fir::NameUniquer::doProgramEntry().str(); 117 }, 118 [&](const Fortran::semantics::SubprogramDetails &subpDetails) { 119 // Mangle external procedure without any scope prefix. 120 if (!keepExternalInScope && 121 Fortran::semantics::IsExternal(ultimateSymbol)) 122 return fir::NameUniquer::doProcedure(std::nullopt, std::nullopt, 123 symbolName); 124 // A separate module procedure must be mangled according to its 125 // declaration scope, not its definition scope. 126 const Fortran::semantics::Symbol *interface = &ultimateSymbol; 127 if (interface->attrs().test(Fortran::semantics::Attr::MODULE) && 128 interface->owner().IsSubmodule() && !subpDetails.isInterface()) 129 interface = subpDetails.moduleInterface(); 130 std::tie(modules, procs, blockId) = ancestors( 131 interface ? *interface : ultimateSymbol, scopeBlockIdMap); 132 return fir::NameUniquer::doProcedure(modules, procs, symbolName); 133 }, 134 [&](const Fortran::semantics::ProcEntityDetails &) { 135 // Mangle procedure pointers and dummy procedures as variables. 136 if (Fortran::semantics::IsPointer(ultimateSymbol) || 137 Fortran::semantics::IsDummy(ultimateSymbol)) { 138 std::tie(modules, procs, blockId) = 139 ancestors(ultimateSymbol, scopeBlockIdMap); 140 return fir::NameUniquer::doVariable(modules, procs, blockId, 141 symbolName); 142 } 143 // Otherwise, this is an external procedure, with or without an 144 // explicit EXTERNAL attribute. Mangle it without any prefix. 145 return fir::NameUniquer::doProcedure(std::nullopt, std::nullopt, 146 symbolName); 147 }, 148 [&](const Fortran::semantics::ObjectEntityDetails &) { 149 return mangleObject(); 150 }, 151 [&](const Fortran::semantics::AssocEntityDetails &) { 152 return mangleObject(); 153 }, 154 [&](const Fortran::semantics::NamelistDetails &) { 155 std::tie(modules, procs, blockId) = 156 ancestors(ultimateSymbol, scopeBlockIdMap); 157 return fir::NameUniquer::doNamelistGroup(modules, procs, 158 symbolName); 159 }, 160 [&](const Fortran::semantics::CommonBlockDetails &) { 161 return Fortran::semantics::GetCommonBlockObjectName(ultimateSymbol, 162 underscoring); 163 }, 164 [&](const Fortran::semantics::ProcBindingDetails &procBinding) { 165 return mangleName(procBinding.symbol(), scopeBlockIdMap, 166 keepExternalInScope, underscoring); 167 }, 168 [&](const Fortran::semantics::GenericDetails &generic) 169 -> std::string { 170 if (generic.specific()) 171 return mangleName(*generic.specific(), scopeBlockIdMap, 172 keepExternalInScope, underscoring); 173 else 174 llvm::report_fatal_error( 175 "attempt to mangle a generic name but " 176 "it has no specific procedure of the same name"); 177 }, 178 [&](const Fortran::semantics::DerivedTypeDetails &) -> std::string { 179 // Derived type mangling must use mangleName(DerivedTypeSpec) so 180 // that kind type parameter values can be mangled. 181 llvm::report_fatal_error( 182 "only derived type instances can be mangled"); 183 }, 184 [](const auto &) -> std::string { TODO_NOLOC("symbol mangling"); }, 185 }, 186 ultimateSymbol.details()); 187 } 188 189 std::string 190 Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol, 191 bool keepExternalInScope, 192 bool underscoring) { 193 assert((symbol.owner().kind() != 194 Fortran::semantics::Scope::Kind::BlockConstruct || 195 symbol.has<Fortran::semantics::SubprogramDetails>() || 196 Fortran::semantics::IsBindCProcedure(symbol)) && 197 "block object mangling must specify a scopeBlockIdMap"); 198 ScopeBlockIdMap scopeBlockIdMap; 199 return mangleName(symbol, scopeBlockIdMap, keepExternalInScope, underscoring); 200 } 201 202 std::string Fortran::lower::mangle::mangleName( 203 const Fortran::semantics::DerivedTypeSpec &derivedType, 204 ScopeBlockIdMap &scopeBlockIdMap) { 205 // Resolve module and host associations before mangling. 206 const Fortran::semantics::Symbol &ultimateSymbol = 207 derivedType.typeSymbol().GetUltimate(); 208 209 llvm::StringRef symbolName = toStringRef(ultimateSymbol.name()); 210 llvm::SmallVector<llvm::StringRef> modules; 211 llvm::SmallVector<llvm::StringRef> procs; 212 std::int64_t blockId; 213 std::tie(modules, procs, blockId) = 214 ancestors(ultimateSymbol, scopeBlockIdMap); 215 llvm::SmallVector<std::int64_t> kinds; 216 for (const auto ¶m : 217 Fortran::semantics::OrderParameterDeclarations(ultimateSymbol)) { 218 const auto ¶mDetails = 219 param->get<Fortran::semantics::TypeParamDetails>(); 220 if (paramDetails.attr() == Fortran::common::TypeParamAttr::Kind) { 221 const Fortran::semantics::ParamValue *paramValue = 222 derivedType.FindParameter(param->name()); 223 assert(paramValue && "derived type kind parameter value not found"); 224 const Fortran::semantics::MaybeIntExpr paramExpr = 225 paramValue->GetExplicit(); 226 assert(paramExpr && "derived type kind param not explicit"); 227 std::optional<int64_t> init = 228 Fortran::evaluate::ToInt64(paramValue->GetExplicit()); 229 assert(init && "derived type kind param is not constant"); 230 kinds.emplace_back(*init); 231 } 232 } 233 return fir::NameUniquer::doType(modules, procs, blockId, symbolName, kinds); 234 } 235 236 std::string Fortran::lower::mangle::getRecordTypeFieldName( 237 const Fortran::semantics::Symbol &component, 238 ScopeBlockIdMap &scopeBlockIdMap) { 239 if (!component.attrs().test(Fortran::semantics::Attr::PRIVATE)) 240 return component.name().ToString(); 241 const Fortran::semantics::DerivedTypeSpec *componentParentType = 242 component.owner().derivedTypeSpec(); 243 assert(componentParentType && 244 "failed to retrieve private component parent type"); 245 // Do not mangle Iso C C_PTR and C_FUNPTR components. This type cannot be 246 // extended as per Fortran 2018 7.5.7.1, mangling them makes the IR unreadable 247 // when using ISO C modules, and lowering needs to know the component way 248 // without access to semantics::Symbol. 249 if (Fortran::semantics::IsIsoCType(componentParentType)) 250 return component.name().ToString(); 251 return mangleName(*componentParentType, scopeBlockIdMap) + "." + 252 component.name().ToString(); 253 } 254 255 std::string Fortran::lower::mangle::demangleName(llvm::StringRef name) { 256 auto result = fir::NameUniquer::deconstruct(name); 257 return result.second.name; 258 } 259 260 //===----------------------------------------------------------------------===// 261 // Array Literals Mangling 262 //===----------------------------------------------------------------------===// 263 264 static std::string typeToString(Fortran::common::TypeCategory cat, int kind, 265 llvm::StringRef derivedName) { 266 switch (cat) { 267 case Fortran::common::TypeCategory::Integer: 268 return "i" + std::to_string(kind); 269 case Fortran::common::TypeCategory::Unsigned: 270 return "u" + std::to_string(kind); 271 case Fortran::common::TypeCategory::Real: 272 return "r" + std::to_string(kind); 273 case Fortran::common::TypeCategory::Complex: 274 return "z" + std::to_string(kind); 275 case Fortran::common::TypeCategory::Logical: 276 return "l" + std::to_string(kind); 277 case Fortran::common::TypeCategory::Character: 278 return "c" + std::to_string(kind); 279 case Fortran::common::TypeCategory::Derived: 280 return derivedName.str(); 281 } 282 llvm_unreachable("bad TypeCategory"); 283 } 284 285 std::string Fortran::lower::mangle::mangleArrayLiteral( 286 size_t size, const Fortran::evaluate::ConstantSubscripts &shape, 287 Fortran::common::TypeCategory cat, int kind, 288 Fortran::common::ConstantSubscript charLen, llvm::StringRef derivedName) { 289 std::string typeId; 290 for (Fortran::evaluate::ConstantSubscript extent : shape) 291 typeId.append(std::to_string(extent)).append("x"); 292 if (charLen >= 0) 293 typeId.append(std::to_string(charLen)).append("x"); 294 typeId.append(typeToString(cat, kind, derivedName)); 295 std::string name = 296 fir::NameUniquer::doGenerated("ro."s.append(typeId).append(".")); 297 if (!size) 298 name += "null."; 299 return name; 300 } 301 302 std::string Fortran::lower::mangle::globalNamelistDescriptorName( 303 const Fortran::semantics::Symbol &sym) { 304 std::string name = mangleName(sym); 305 return IsAllocatableOrObjectPointer(&sym) ? name : name + ".desc"s; 306 } 307