DebugInfo: Assert that DbgVariables have associated DIEs
[oota-llvm.git] / lib / CodeGen / AsmPrinter / DwarfDebug.cpp
1 //===-- llvm/CodeGen/DwarfDebug.cpp - Dwarf Debug Framework ---------------===//
2 //
3 //                     The LLVM Compiler Infrastructure
4 //
5 // This file is distributed under the University of Illinois Open Source
6 // License. See LICENSE.TXT for details.
7 //
8 //===----------------------------------------------------------------------===//
9 //
10 // This file contains support for writing dwarf debug info into asm files.
11 //
12 //===----------------------------------------------------------------------===//
13
14 #include "ByteStreamer.h"
15 #include "DwarfDebug.h"
16 #include "DIE.h"
17 #include "DIEHash.h"
18 #include "DwarfUnit.h"
19 #include "llvm/ADT/STLExtras.h"
20 #include "llvm/ADT/Statistic.h"
21 #include "llvm/ADT/StringExtras.h"
22 #include "llvm/ADT/Triple.h"
23 #include "llvm/CodeGen/MachineFunction.h"
24 #include "llvm/CodeGen/MachineModuleInfo.h"
25 #include "llvm/IR/Constants.h"
26 #include "llvm/IR/DIBuilder.h"
27 #include "llvm/IR/DataLayout.h"
28 #include "llvm/IR/DebugInfo.h"
29 #include "llvm/IR/Instructions.h"
30 #include "llvm/IR/Module.h"
31 #include "llvm/IR/ValueHandle.h"
32 #include "llvm/MC/MCAsmInfo.h"
33 #include "llvm/MC/MCSection.h"
34 #include "llvm/MC/MCStreamer.h"
35 #include "llvm/MC/MCSymbol.h"
36 #include "llvm/Support/CommandLine.h"
37 #include "llvm/Support/Debug.h"
38 #include "llvm/Support/Dwarf.h"
39 #include "llvm/Support/ErrorHandling.h"
40 #include "llvm/Support/FormattedStream.h"
41 #include "llvm/Support/LEB128.h"
42 #include "llvm/Support/MD5.h"
43 #include "llvm/Support/Path.h"
44 #include "llvm/Support/Timer.h"
45 #include "llvm/Target/TargetFrameLowering.h"
46 #include "llvm/Target/TargetLoweringObjectFile.h"
47 #include "llvm/Target/TargetMachine.h"
48 #include "llvm/Target/TargetOptions.h"
49 #include "llvm/Target/TargetRegisterInfo.h"
50 using namespace llvm;
51
52 #define DEBUG_TYPE "dwarfdebug"
53
54 static cl::opt<bool>
55 DisableDebugInfoPrinting("disable-debug-info-print", cl::Hidden,
56                          cl::desc("Disable debug info printing"));
57
58 static cl::opt<bool> UnknownLocations(
59     "use-unknown-locations", cl::Hidden,
60     cl::desc("Make an absence of debug location information explicit."),
61     cl::init(false));
62
63 static cl::opt<bool>
64 GenerateGnuPubSections("generate-gnu-dwarf-pub-sections", cl::Hidden,
65                        cl::desc("Generate GNU-style pubnames and pubtypes"),
66                        cl::init(false));
67
68 static cl::opt<bool> GenerateARangeSection("generate-arange-section",
69                                            cl::Hidden,
70                                            cl::desc("Generate dwarf aranges"),
71                                            cl::init(false));
72
73 namespace {
74 enum DefaultOnOff { Default, Enable, Disable };
75 }
76
77 static cl::opt<DefaultOnOff>
78 DwarfAccelTables("dwarf-accel-tables", cl::Hidden,
79                  cl::desc("Output prototype dwarf accelerator tables."),
80                  cl::values(clEnumVal(Default, "Default for platform"),
81                             clEnumVal(Enable, "Enabled"),
82                             clEnumVal(Disable, "Disabled"), clEnumValEnd),
83                  cl::init(Default));
84
85 static cl::opt<DefaultOnOff>
86 SplitDwarf("split-dwarf", cl::Hidden,
87            cl::desc("Output DWARF5 split debug info."),
88            cl::values(clEnumVal(Default, "Default for platform"),
89                       clEnumVal(Enable, "Enabled"),
90                       clEnumVal(Disable, "Disabled"), clEnumValEnd),
91            cl::init(Default));
92
93 static cl::opt<DefaultOnOff>
94 DwarfPubSections("generate-dwarf-pub-sections", cl::Hidden,
95                  cl::desc("Generate DWARF pubnames and pubtypes sections"),
96                  cl::values(clEnumVal(Default, "Default for platform"),
97                             clEnumVal(Enable, "Enabled"),
98                             clEnumVal(Disable, "Disabled"), clEnumValEnd),
99                  cl::init(Default));
100
101 static cl::opt<unsigned>
102 DwarfVersionNumber("dwarf-version", cl::Hidden,
103                    cl::desc("Generate DWARF for dwarf version."), cl::init(0));
104
105 static const char *const DWARFGroupName = "DWARF Emission";
106 static const char *const DbgTimerName = "DWARF Debug Writer";
107
108 //===----------------------------------------------------------------------===//
109
110 /// resolve - Look in the DwarfDebug map for the MDNode that
111 /// corresponds to the reference.
112 template <typename T> T DbgVariable::resolve(DIRef<T> Ref) const {
113   return DD->resolve(Ref);
114 }
115
116 bool DbgVariable::isBlockByrefVariable() const {
117   assert(Var.isVariable() && "Invalid complex DbgVariable!");
118   return Var.isBlockByrefVariable(DD->getTypeIdentifierMap());
119 }
120
121 DIType DbgVariable::getType() const {
122   DIType Ty = Var.getType().resolve(DD->getTypeIdentifierMap());
123   // FIXME: isBlockByrefVariable should be reformulated in terms of complex
124   // addresses instead.
125   if (Var.isBlockByrefVariable(DD->getTypeIdentifierMap())) {
126     /* Byref variables, in Blocks, are declared by the programmer as
127        "SomeType VarName;", but the compiler creates a
128        __Block_byref_x_VarName struct, and gives the variable VarName
129        either the struct, or a pointer to the struct, as its type.  This
130        is necessary for various behind-the-scenes things the compiler
131        needs to do with by-reference variables in blocks.
132
133        However, as far as the original *programmer* is concerned, the
134        variable should still have type 'SomeType', as originally declared.
135
136        The following function dives into the __Block_byref_x_VarName
137        struct to find the original type of the variable.  This will be
138        passed back to the code generating the type for the Debug
139        Information Entry for the variable 'VarName'.  'VarName' will then
140        have the original type 'SomeType' in its debug information.
141
142        The original type 'SomeType' will be the type of the field named
143        'VarName' inside the __Block_byref_x_VarName struct.
144
145        NOTE: In order for this to not completely fail on the debugger
146        side, the Debug Information Entry for the variable VarName needs to
147        have a DW_AT_location that tells the debugger how to unwind through
148        the pointers and __Block_byref_x_VarName struct to find the actual
149        value of the variable.  The function addBlockByrefType does this.  */
150     DIType subType = Ty;
151     uint16_t tag = Ty.getTag();
152
153     if (tag == dwarf::DW_TAG_pointer_type)
154       subType = resolve(DIDerivedType(Ty).getTypeDerivedFrom());
155
156     DIArray Elements = DICompositeType(subType).getTypeArray();
157     for (unsigned i = 0, N = Elements.getNumElements(); i < N; ++i) {
158       DIDerivedType DT(Elements.getElement(i));
159       if (getName() == DT.getName())
160         return (resolve(DT.getTypeDerivedFrom()));
161     }
162   }
163   return Ty;
164 }
165
166 static LLVM_CONSTEXPR DwarfAccelTable::Atom TypeAtoms[] = {
167     DwarfAccelTable::Atom(dwarf::DW_ATOM_die_offset, dwarf::DW_FORM_data4),
168     DwarfAccelTable::Atom(dwarf::DW_ATOM_die_tag, dwarf::DW_FORM_data2),
169     DwarfAccelTable::Atom(dwarf::DW_ATOM_type_flags, dwarf::DW_FORM_data1)};
170
171 DwarfDebug::DwarfDebug(AsmPrinter *A, Module *M)
172     : Asm(A), MMI(Asm->MMI), FirstCU(nullptr), PrevLabel(nullptr),
173       GlobalRangeCount(0), InfoHolder(A, "info_string", DIEValueAllocator),
174       UsedNonDefaultText(false),
175       SkeletonHolder(A, "skel_string", DIEValueAllocator),
176       AccelNames(DwarfAccelTable::Atom(dwarf::DW_ATOM_die_offset,
177                                        dwarf::DW_FORM_data4)),
178       AccelObjC(DwarfAccelTable::Atom(dwarf::DW_ATOM_die_offset,
179                                       dwarf::DW_FORM_data4)),
180       AccelNamespace(DwarfAccelTable::Atom(dwarf::DW_ATOM_die_offset,
181                                            dwarf::DW_FORM_data4)),
182       AccelTypes(TypeAtoms) {
183
184   DwarfInfoSectionSym = DwarfAbbrevSectionSym = DwarfStrSectionSym = nullptr;
185   DwarfDebugRangeSectionSym = DwarfDebugLocSectionSym = nullptr;
186   DwarfLineSectionSym = nullptr;
187   DwarfAddrSectionSym = nullptr;
188   DwarfAbbrevDWOSectionSym = DwarfStrDWOSectionSym = nullptr;
189   FunctionBeginSym = FunctionEndSym = nullptr;
190   CurFn = nullptr;
191   CurMI = nullptr;
192
193   // Turn on accelerator tables for Darwin by default, pubnames by
194   // default for non-Darwin, and handle split dwarf.
195   bool IsDarwin = Triple(A->getTargetTriple()).isOSDarwin();
196
197   if (DwarfAccelTables == Default)
198     HasDwarfAccelTables = IsDarwin;
199   else
200     HasDwarfAccelTables = DwarfAccelTables == Enable;
201
202   if (SplitDwarf == Default)
203     HasSplitDwarf = false;
204   else
205     HasSplitDwarf = SplitDwarf == Enable;
206
207   if (DwarfPubSections == Default)
208     HasDwarfPubSections = !IsDarwin;
209   else
210     HasDwarfPubSections = DwarfPubSections == Enable;
211
212   DwarfVersion = DwarfVersionNumber ? DwarfVersionNumber
213                                     : MMI->getModule()->getDwarfVersion();
214
215   {
216     NamedRegionTimer T(DbgTimerName, DWARFGroupName, TimePassesIsEnabled);
217     beginModule();
218   }
219 }
220
221 // Define out of line so we don't have to include DwarfUnit.h in DwarfDebug.h.
222 DwarfDebug::~DwarfDebug() { }
223
224 // Switch to the specified MCSection and emit an assembler
225 // temporary label to it if SymbolStem is specified.
226 static MCSymbol *emitSectionSym(AsmPrinter *Asm, const MCSection *Section,
227                                 const char *SymbolStem = nullptr) {
228   Asm->OutStreamer.SwitchSection(Section);
229   if (!SymbolStem)
230     return nullptr;
231
232   MCSymbol *TmpSym = Asm->GetTempSymbol(SymbolStem);
233   Asm->OutStreamer.EmitLabel(TmpSym);
234   return TmpSym;
235 }
236
237 static bool isObjCClass(StringRef Name) {
238   return Name.startswith("+") || Name.startswith("-");
239 }
240
241 static bool hasObjCCategory(StringRef Name) {
242   if (!isObjCClass(Name))
243     return false;
244
245   return Name.find(") ") != StringRef::npos;
246 }
247
248 static void getObjCClassCategory(StringRef In, StringRef &Class,
249                                  StringRef &Category) {
250   if (!hasObjCCategory(In)) {
251     Class = In.slice(In.find('[') + 1, In.find(' '));
252     Category = "";
253     return;
254   }
255
256   Class = In.slice(In.find('[') + 1, In.find('('));
257   Category = In.slice(In.find('[') + 1, In.find(' '));
258   return;
259 }
260
261 static StringRef getObjCMethodName(StringRef In) {
262   return In.slice(In.find(' ') + 1, In.find(']'));
263 }
264
265 // Helper for sorting sections into a stable output order.
266 static bool SectionSort(const MCSection *A, const MCSection *B) {
267   std::string LA = (A ? A->getLabelBeginName() : "");
268   std::string LB = (B ? B->getLabelBeginName() : "");
269   return LA < LB;
270 }
271
272 // Add the various names to the Dwarf accelerator table names.
273 // TODO: Determine whether or not we should add names for programs
274 // that do not have a DW_AT_name or DW_AT_linkage_name field - this
275 // is only slightly different than the lookup of non-standard ObjC names.
276 void DwarfDebug::addSubprogramNames(DISubprogram SP, DIE &Die) {
277   if (!SP.isDefinition())
278     return;
279   addAccelName(SP.getName(), Die);
280
281   // If the linkage name is different than the name, go ahead and output
282   // that as well into the name table.
283   if (SP.getLinkageName() != "" && SP.getName() != SP.getLinkageName())
284     addAccelName(SP.getLinkageName(), Die);
285
286   // If this is an Objective-C selector name add it to the ObjC accelerator
287   // too.
288   if (isObjCClass(SP.getName())) {
289     StringRef Class, Category;
290     getObjCClassCategory(SP.getName(), Class, Category);
291     addAccelObjC(Class, Die);
292     if (Category != "")
293       addAccelObjC(Category, Die);
294     // Also add the base method name to the name table.
295     addAccelName(getObjCMethodName(SP.getName()), Die);
296   }
297 }
298
299 /// isSubprogramContext - Return true if Context is either a subprogram
300 /// or another context nested inside a subprogram.
301 bool DwarfDebug::isSubprogramContext(const MDNode *Context) {
302   if (!Context)
303     return false;
304   DIDescriptor D(Context);
305   if (D.isSubprogram())
306     return true;
307   if (D.isType())
308     return isSubprogramContext(resolve(DIType(Context).getContext()));
309   return false;
310 }
311
312 // Find DIE for the given subprogram and attach appropriate DW_AT_low_pc
313 // and DW_AT_high_pc attributes. If there are global variables in this
314 // scope then create and insert DIEs for these variables.
315 DIE &DwarfDebug::updateSubprogramScopeDIE(DwarfCompileUnit &SPCU,
316                                           DISubprogram SP) {
317   DIE *SPDie = SPCU.getOrCreateSubprogramDIE(SP);
318
319   attachLowHighPC(SPCU, *SPDie, FunctionBeginSym, FunctionEndSym);
320
321   const TargetRegisterInfo *RI = Asm->TM.getRegisterInfo();
322   MachineLocation Location(RI->getFrameRegister(*Asm->MF));
323   SPCU.addAddress(*SPDie, dwarf::DW_AT_frame_base, Location);
324
325   // Add name to the name table, we do this here because we're guaranteed
326   // to have concrete versions of our DW_TAG_subprogram nodes.
327   addSubprogramNames(SP, *SPDie);
328
329   return *SPDie;
330 }
331
332 /// Check whether we should create a DIE for the given Scope, return true
333 /// if we don't create a DIE (the corresponding DIE is null).
334 bool DwarfDebug::isLexicalScopeDIENull(LexicalScope *Scope) {
335   if (Scope->isAbstractScope())
336     return false;
337
338   // We don't create a DIE if there is no Range.
339   const SmallVectorImpl<InsnRange> &Ranges = Scope->getRanges();
340   if (Ranges.empty())
341     return true;
342
343   if (Ranges.size() > 1)
344     return false;
345
346   // We don't create a DIE if we have a single Range and the end label
347   // is null.
348   SmallVectorImpl<InsnRange>::const_iterator RI = Ranges.begin();
349   MCSymbol *End = getLabelAfterInsn(RI->second);
350   return !End;
351 }
352
353 static void addSectionLabel(AsmPrinter &Asm, DwarfUnit &U, DIE &D,
354                             dwarf::Attribute A, const MCSymbol *L,
355                             const MCSymbol *Sec) {
356   if (Asm.MAI->doesDwarfUseRelocationsAcrossSections())
357     U.addSectionLabel(D, A, L);
358   else
359     U.addSectionDelta(D, A, L, Sec);
360 }
361
362 void DwarfDebug::addScopeRangeList(DwarfCompileUnit &TheCU, DIE &ScopeDIE,
363                                    const SmallVectorImpl<InsnRange> &Range) {
364   // Emit offset in .debug_range as a relocatable label. emitDIE will handle
365   // emitting it appropriately.
366   MCSymbol *RangeSym = Asm->GetTempSymbol("debug_ranges", GlobalRangeCount++);
367
368   // Under fission, ranges are specified by constant offsets relative to the
369   // CU's DW_AT_GNU_ranges_base.
370   if (useSplitDwarf())
371     TheCU.addSectionDelta(ScopeDIE, dwarf::DW_AT_ranges, RangeSym,
372                           DwarfDebugRangeSectionSym);
373   else
374     addSectionLabel(*Asm, TheCU, ScopeDIE, dwarf::DW_AT_ranges, RangeSym,
375                     DwarfDebugRangeSectionSym);
376
377   RangeSpanList List(RangeSym);
378   for (const InsnRange &R : Range) {
379     RangeSpan Span(getLabelBeforeInsn(R.first), getLabelAfterInsn(R.second));
380     List.addRange(std::move(Span));
381   }
382
383   // Add the range list to the set of ranges to be emitted.
384   TheCU.addRangeList(std::move(List));
385 }
386
387 void DwarfDebug::attachRangesOrLowHighPC(DwarfCompileUnit &TheCU, DIE &Die,
388                                     const SmallVectorImpl<InsnRange> &Ranges) {
389   assert(!Ranges.empty());
390   if (Ranges.size() == 1)
391     attachLowHighPC(TheCU, Die, getLabelBeforeInsn(Ranges.front().first),
392                     getLabelAfterInsn(Ranges.front().second));
393   else
394     addScopeRangeList(TheCU, Die, Ranges);
395 }
396
397 // Construct new DW_TAG_lexical_block for this scope and attach
398 // DW_AT_low_pc/DW_AT_high_pc labels.
399 std::unique_ptr<DIE>
400 DwarfDebug::constructLexicalScopeDIE(DwarfCompileUnit &TheCU,
401                                      LexicalScope *Scope) {
402   if (isLexicalScopeDIENull(Scope))
403     return nullptr;
404
405   auto ScopeDIE = make_unique<DIE>(dwarf::DW_TAG_lexical_block);
406   if (Scope->isAbstractScope())
407     return ScopeDIE;
408
409   attachRangesOrLowHighPC(TheCU, *ScopeDIE, Scope->getRanges());
410
411   return ScopeDIE;
412 }
413
414 // This scope represents inlined body of a function. Construct DIE to
415 // represent this concrete inlined copy of the function.
416 std::unique_ptr<DIE>
417 DwarfDebug::constructInlinedScopeDIE(DwarfCompileUnit &TheCU,
418                                      LexicalScope *Scope) {
419   assert(Scope->getScopeNode());
420   DIScope DS(Scope->getScopeNode());
421   DISubprogram InlinedSP = getDISubprogram(DS);
422   // Find the subprogram's DwarfCompileUnit in the SPMap in case the subprogram
423   // was inlined from another compile unit.
424   DIE *OriginDIE = AbstractSPDies[InlinedSP];
425   assert(OriginDIE && "Unable to find original DIE for an inlined subprogram.");
426
427   auto ScopeDIE = make_unique<DIE>(dwarf::DW_TAG_inlined_subroutine);
428   TheCU.addDIEEntry(*ScopeDIE, dwarf::DW_AT_abstract_origin, *OriginDIE);
429
430   attachRangesOrLowHighPC(TheCU, *ScopeDIE, Scope->getRanges());
431
432   InlinedSubprogramDIEs.insert(OriginDIE);
433
434   // Add the call site information to the DIE.
435   DILocation DL(Scope->getInlinedAt());
436   TheCU.addUInt(*ScopeDIE, dwarf::DW_AT_call_file, None,
437                 TheCU.getOrCreateSourceID(DL.getFilename(), DL.getDirectory()));
438   TheCU.addUInt(*ScopeDIE, dwarf::DW_AT_call_line, None, DL.getLineNumber());
439
440   // Add name to the name table, we do this here because we're guaranteed
441   // to have concrete versions of our DW_TAG_inlined_subprogram nodes.
442   addSubprogramNames(InlinedSP, *ScopeDIE);
443
444   return ScopeDIE;
445 }
446
447 static std::unique_ptr<DIE> constructVariableDIE(DwarfCompileUnit &TheCU,
448                                                  DbgVariable &DV,
449                                                  const LexicalScope &Scope,
450                                                  DIE *&ObjectPointer) {
451   auto Var = TheCU.constructVariableDIE(DV, Scope.isAbstractScope());
452   if (DV.isObjectPointer())
453     ObjectPointer = Var.get();
454   return Var;
455 }
456
457 DIE *DwarfDebug::createScopeChildrenDIE(
458     DwarfCompileUnit &TheCU, LexicalScope *Scope,
459     SmallVectorImpl<std::unique_ptr<DIE>> &Children) {
460   DIE *ObjectPointer = nullptr;
461
462   // Collect arguments for current function.
463   if (LScopes.isCurrentFunctionScope(Scope)) {
464     for (DbgVariable *ArgDV : CurrentFnArguments)
465       if (ArgDV)
466         Children.push_back(
467             constructVariableDIE(TheCU, *ArgDV, *Scope, ObjectPointer));
468
469     // If this is a variadic function, add an unspecified parameter.
470     DISubprogram SP(Scope->getScopeNode());
471     DIArray FnArgs = SP.getType().getTypeArray();
472     if (FnArgs.getElement(FnArgs.getNumElements() - 1)
473             .isUnspecifiedParameter()) {
474       Children.push_back(
475           make_unique<DIE>(dwarf::DW_TAG_unspecified_parameters));
476     }
477   }
478
479   // Collect lexical scope children first.
480   for (DbgVariable *DV : ScopeVariables.lookup(Scope))
481     Children.push_back(constructVariableDIE(TheCU, *DV, *Scope, ObjectPointer));
482
483   for (LexicalScope *LS : Scope->getChildren())
484     if (std::unique_ptr<DIE> Nested = constructScopeDIE(TheCU, LS))
485       Children.push_back(std::move(Nested));
486   return ObjectPointer;
487 }
488
489 void DwarfDebug::createAndAddScopeChildren(DwarfCompileUnit &TheCU,
490                                            LexicalScope *Scope, DIE &ScopeDIE) {
491   // We create children when the scope DIE is not null.
492   SmallVector<std::unique_ptr<DIE>, 8> Children;
493   if (DIE *ObjectPointer = createScopeChildrenDIE(TheCU, Scope, Children))
494     TheCU.addDIEEntry(ScopeDIE, dwarf::DW_AT_object_pointer, *ObjectPointer);
495
496   // Add children
497   for (auto &I : Children)
498     ScopeDIE.addChild(std::move(I));
499 }
500
501 void DwarfDebug::constructAbstractSubprogramScopeDIE(DwarfCompileUnit &TheCU,
502                                                      LexicalScope *Scope) {
503   assert(Scope && Scope->getScopeNode());
504   assert(Scope->isAbstractScope());
505   assert(!Scope->getInlinedAt());
506
507   DISubprogram SP(Scope->getScopeNode());
508
509   ProcessedSPNodes.insert(SP);
510
511   DIE *&AbsDef = AbstractSPDies[SP];
512   if (AbsDef)
513     return;
514
515   // Find the subprogram's DwarfCompileUnit in the SPMap in case the subprogram
516   // was inlined from another compile unit.
517   DwarfCompileUnit &SPCU = *SPMap[SP];
518   DIE *ContextDIE;
519
520   // Some of this is duplicated from DwarfUnit::getOrCreateSubprogramDIE, with
521   // the important distinction that the DIDescriptor is not associated with the
522   // DIE (since the DIDescriptor will be associated with the concrete DIE, if
523   // any). It could be refactored to some common utility function.
524   if (DISubprogram SPDecl = SP.getFunctionDeclaration()) {
525     ContextDIE = &SPCU.getUnitDie();
526     SPCU.getOrCreateSubprogramDIE(SPDecl);
527   } else
528     ContextDIE = SPCU.getOrCreateContextDIE(resolve(SP.getContext()));
529
530   // Passing null as the associated DIDescriptor because the abstract definition
531   // shouldn't be found by lookup.
532   AbsDef = &SPCU.createAndAddDIE(dwarf::DW_TAG_subprogram, *ContextDIE,
533                                  DIDescriptor());
534   SPCU.applySubprogramAttributes(SP, *AbsDef);
535   SPCU.addGlobalName(SP.getName(), *AbsDef, resolve(SP.getContext()));
536
537   SPCU.addUInt(*AbsDef, dwarf::DW_AT_inline, None, dwarf::DW_INL_inlined);
538   createAndAddScopeChildren(SPCU, Scope, *AbsDef);
539 }
540
541 DIE &DwarfDebug::constructSubprogramScopeDIE(DwarfCompileUnit &TheCU,
542                                              LexicalScope *Scope) {
543   assert(Scope && Scope->getScopeNode());
544   assert(!Scope->getInlinedAt());
545   assert(!Scope->isAbstractScope());
546   DISubprogram Sub(Scope->getScopeNode());
547
548   assert(Sub.isSubprogram());
549
550   ProcessedSPNodes.insert(Sub);
551
552   DIE &ScopeDIE = updateSubprogramScopeDIE(TheCU, Sub);
553
554   createAndAddScopeChildren(TheCU, Scope, ScopeDIE);
555
556   return ScopeDIE;
557 }
558
559 // Construct a DIE for this scope.
560 std::unique_ptr<DIE> DwarfDebug::constructScopeDIE(DwarfCompileUnit &TheCU,
561                                                    LexicalScope *Scope) {
562   if (!Scope || !Scope->getScopeNode())
563     return nullptr;
564
565   DIScope DS(Scope->getScopeNode());
566
567   assert((Scope->getInlinedAt() || !DS.isSubprogram()) &&
568          "Only handle inlined subprograms here, use "
569          "constructSubprogramScopeDIE for non-inlined "
570          "subprograms");
571
572   SmallVector<std::unique_ptr<DIE>, 8> Children;
573
574   // We try to create the scope DIE first, then the children DIEs. This will
575   // avoid creating un-used children then removing them later when we find out
576   // the scope DIE is null.
577   std::unique_ptr<DIE> ScopeDIE;
578   if (Scope->getParent() && DS.isSubprogram()) {
579     ScopeDIE = constructInlinedScopeDIE(TheCU, Scope);
580     if (!ScopeDIE)
581       return nullptr;
582     // We create children when the scope DIE is not null.
583     createScopeChildrenDIE(TheCU, Scope, Children);
584   } else {
585     // Early exit when we know the scope DIE is going to be null.
586     if (isLexicalScopeDIENull(Scope))
587       return nullptr;
588
589     // We create children here when we know the scope DIE is not going to be
590     // null and the children will be added to the scope DIE.
591     createScopeChildrenDIE(TheCU, Scope, Children);
592
593     // There is no need to emit empty lexical block DIE.
594     std::pair<ImportedEntityMap::const_iterator,
595               ImportedEntityMap::const_iterator> Range =
596         std::equal_range(ScopesWithImportedEntities.begin(),
597                          ScopesWithImportedEntities.end(),
598                          std::pair<const MDNode *, const MDNode *>(DS, nullptr),
599                          less_first());
600     if (Children.empty() && Range.first == Range.second)
601       return nullptr;
602     ScopeDIE = constructLexicalScopeDIE(TheCU, Scope);
603     assert(ScopeDIE && "Scope DIE should not be null.");
604     for (ImportedEntityMap::const_iterator i = Range.first; i != Range.second;
605          ++i)
606       constructImportedEntityDIE(TheCU, i->second, *ScopeDIE);
607   }
608
609   // Add children
610   for (auto &I : Children)
611     ScopeDIE->addChild(std::move(I));
612
613   return ScopeDIE;
614 }
615
616 void DwarfDebug::addGnuPubAttributes(DwarfUnit &U, DIE &D) const {
617   if (!GenerateGnuPubSections)
618     return;
619
620   U.addFlag(D, dwarf::DW_AT_GNU_pubnames);
621 }
622
623 // Create new DwarfCompileUnit for the given metadata node with tag
624 // DW_TAG_compile_unit.
625 DwarfCompileUnit &DwarfDebug::constructDwarfCompileUnit(DICompileUnit DIUnit) {
626   StringRef FN = DIUnit.getFilename();
627   CompilationDir = DIUnit.getDirectory();
628
629   auto OwnedUnit = make_unique<DwarfCompileUnit>(
630       InfoHolder.getUnits().size(), DIUnit, Asm, this, &InfoHolder);
631   DwarfCompileUnit &NewCU = *OwnedUnit;
632   DIE &Die = NewCU.getUnitDie();
633   InfoHolder.addUnit(std::move(OwnedUnit));
634
635   // LTO with assembly output shares a single line table amongst multiple CUs.
636   // To avoid the compilation directory being ambiguous, let the line table
637   // explicitly describe the directory of all files, never relying on the
638   // compilation directory.
639   if (!Asm->OutStreamer.hasRawTextSupport() || SingleCU)
640     Asm->OutStreamer.getContext().setMCLineTableCompilationDir(
641         NewCU.getUniqueID(), CompilationDir);
642
643   NewCU.addString(Die, dwarf::DW_AT_producer, DIUnit.getProducer());
644   NewCU.addUInt(Die, dwarf::DW_AT_language, dwarf::DW_FORM_data2,
645                 DIUnit.getLanguage());
646   NewCU.addString(Die, dwarf::DW_AT_name, FN);
647
648   if (!useSplitDwarf()) {
649     NewCU.initStmtList(DwarfLineSectionSym);
650
651     // If we're using split dwarf the compilation dir is going to be in the
652     // skeleton CU and so we don't need to duplicate it here.
653     if (!CompilationDir.empty())
654       NewCU.addString(Die, dwarf::DW_AT_comp_dir, CompilationDir);
655
656     addGnuPubAttributes(NewCU, Die);
657   }
658
659   if (DIUnit.isOptimized())
660     NewCU.addFlag(Die, dwarf::DW_AT_APPLE_optimized);
661
662   StringRef Flags = DIUnit.getFlags();
663   if (!Flags.empty())
664     NewCU.addString(Die, dwarf::DW_AT_APPLE_flags, Flags);
665
666   if (unsigned RVer = DIUnit.getRunTimeVersion())
667     NewCU.addUInt(Die, dwarf::DW_AT_APPLE_major_runtime_vers,
668                   dwarf::DW_FORM_data1, RVer);
669
670   if (!FirstCU)
671     FirstCU = &NewCU;
672
673   if (useSplitDwarf()) {
674     NewCU.initSection(Asm->getObjFileLowering().getDwarfInfoDWOSection(),
675                       DwarfInfoDWOSectionSym);
676     NewCU.setSkeleton(constructSkeletonCU(NewCU));
677   } else
678     NewCU.initSection(Asm->getObjFileLowering().getDwarfInfoSection(),
679                       DwarfInfoSectionSym);
680
681   CUMap.insert(std::make_pair(DIUnit, &NewCU));
682   CUDieMap.insert(std::make_pair(&Die, &NewCU));
683   return NewCU;
684 }
685
686 void DwarfDebug::constructImportedEntityDIE(DwarfCompileUnit &TheCU,
687                                             const MDNode *N) {
688   DIImportedEntity Module(N);
689   assert(Module.Verify());
690   if (DIE *D = TheCU.getOrCreateContextDIE(Module.getContext()))
691     constructImportedEntityDIE(TheCU, Module, *D);
692 }
693
694 void DwarfDebug::constructImportedEntityDIE(DwarfCompileUnit &TheCU,
695                                             const MDNode *N, DIE &Context) {
696   DIImportedEntity Module(N);
697   assert(Module.Verify());
698   return constructImportedEntityDIE(TheCU, Module, Context);
699 }
700
701 void DwarfDebug::constructImportedEntityDIE(DwarfCompileUnit &TheCU,
702                                             const DIImportedEntity &Module,
703                                             DIE &Context) {
704   assert(Module.Verify() &&
705          "Use one of the MDNode * overloads to handle invalid metadata");
706   DIE &IMDie = TheCU.createAndAddDIE(Module.getTag(), Context, Module);
707   DIE *EntityDie;
708   DIDescriptor Entity = resolve(Module.getEntity());
709   if (Entity.isNameSpace())
710     EntityDie = TheCU.getOrCreateNameSpace(DINameSpace(Entity));
711   else if (Entity.isSubprogram())
712     EntityDie = TheCU.getOrCreateSubprogramDIE(DISubprogram(Entity));
713   else if (Entity.isType())
714     EntityDie = TheCU.getOrCreateTypeDIE(DIType(Entity));
715   else
716     EntityDie = TheCU.getDIE(Entity);
717   TheCU.addSourceLine(IMDie, Module.getLineNumber(),
718                       Module.getContext().getFilename(),
719                       Module.getContext().getDirectory());
720   TheCU.addDIEEntry(IMDie, dwarf::DW_AT_import, *EntityDie);
721   StringRef Name = Module.getName();
722   if (!Name.empty())
723     TheCU.addString(IMDie, dwarf::DW_AT_name, Name);
724 }
725
726 // Emit all Dwarf sections that should come prior to the content. Create
727 // global DIEs and emit initial debug info sections. This is invoked by
728 // the target AsmPrinter.
729 void DwarfDebug::beginModule() {
730   if (DisableDebugInfoPrinting)
731     return;
732
733   const Module *M = MMI->getModule();
734
735   // If module has named metadata anchors then use them, otherwise scan the
736   // module using debug info finder to collect debug info.
737   NamedMDNode *CU_Nodes = M->getNamedMetadata("llvm.dbg.cu");
738   if (!CU_Nodes)
739     return;
740   TypeIdentifierMap = generateDITypeIdentifierMap(CU_Nodes);
741
742   // Emit initial sections so we can reference labels later.
743   emitSectionLabels();
744
745   SingleCU = CU_Nodes->getNumOperands() == 1;
746
747   for (MDNode *N : CU_Nodes->operands()) {
748     DICompileUnit CUNode(N);
749     DwarfCompileUnit &CU = constructDwarfCompileUnit(CUNode);
750     DIArray ImportedEntities = CUNode.getImportedEntities();
751     for (unsigned i = 0, e = ImportedEntities.getNumElements(); i != e; ++i)
752       ScopesWithImportedEntities.push_back(std::make_pair(
753           DIImportedEntity(ImportedEntities.getElement(i)).getContext(),
754           ImportedEntities.getElement(i)));
755     std::sort(ScopesWithImportedEntities.begin(),
756               ScopesWithImportedEntities.end(), less_first());
757     DIArray GVs = CUNode.getGlobalVariables();
758     for (unsigned i = 0, e = GVs.getNumElements(); i != e; ++i)
759       CU.createGlobalVariableDIE(DIGlobalVariable(GVs.getElement(i)));
760     DIArray SPs = CUNode.getSubprograms();
761     for (unsigned i = 0, e = SPs.getNumElements(); i != e; ++i)
762       SPMap.insert(std::make_pair(SPs.getElement(i), &CU));
763     DIArray EnumTypes = CUNode.getEnumTypes();
764     for (unsigned i = 0, e = EnumTypes.getNumElements(); i != e; ++i)
765       CU.getOrCreateTypeDIE(EnumTypes.getElement(i));
766     DIArray RetainedTypes = CUNode.getRetainedTypes();
767     for (unsigned i = 0, e = RetainedTypes.getNumElements(); i != e; ++i) {
768       DIType Ty(RetainedTypes.getElement(i));
769       // The retained types array by design contains pointers to
770       // MDNodes rather than DIRefs. Unique them here.
771       DIType UniqueTy(resolve(Ty.getRef()));
772       CU.getOrCreateTypeDIE(UniqueTy);
773     }
774     // Emit imported_modules last so that the relevant context is already
775     // available.
776     for (unsigned i = 0, e = ImportedEntities.getNumElements(); i != e; ++i)
777       constructImportedEntityDIE(CU, ImportedEntities.getElement(i));
778   }
779
780   // Tell MMI that we have debug info.
781   MMI->setDebugInfoAvailability(true);
782
783   // Prime section data.
784   SectionMap[Asm->getObjFileLowering().getTextSection()];
785 }
786
787 void DwarfDebug::finishSubprogramDefinitions() {
788   const Module *M = MMI->getModule();
789
790   NamedMDNode *CU_Nodes = M->getNamedMetadata("llvm.dbg.cu");
791   for (MDNode *N : CU_Nodes->operands()) {
792     DICompileUnit TheCU(N);
793     // Construct subprogram DIE and add variables DIEs.
794     DwarfCompileUnit *SPCU =
795         static_cast<DwarfCompileUnit *>(CUMap.lookup(TheCU));
796     DIArray Subprograms = TheCU.getSubprograms();
797     for (unsigned i = 0, e = Subprograms.getNumElements(); i != e; ++i) {
798       DISubprogram SP(Subprograms.getElement(i));
799       // Perhaps the subprogram is in another CU (such as due to comdat
800       // folding, etc), in which case ignore it here.
801       if (SPMap[SP] != SPCU)
802         continue;
803       DIE *D = SPCU->getDIE(SP);
804       if (DIE *AbsSPDIE = AbstractSPDies.lookup(SP)) {
805         if (D)
806           // If this subprogram has an abstract definition, reference that
807           SPCU->addDIEEntry(*D, dwarf::DW_AT_abstract_origin, *AbsSPDIE);
808       } else {
809         if (!D)
810           // Lazily construct the subprogram if we didn't see either concrete or
811           // inlined versions during codegen.
812           D = SPCU->getOrCreateSubprogramDIE(SP);
813         // And attach the attributes
814         SPCU->applySubprogramAttributes(SP, *D);
815         SPCU->addGlobalName(SP.getName(), *D, resolve(SP.getContext()));
816       }
817     }
818   }
819 }
820
821
822 // Collect info for variables that were optimized out.
823 void DwarfDebug::collectDeadVariables() {
824   const Module *M = MMI->getModule();
825
826   if (NamedMDNode *CU_Nodes = M->getNamedMetadata("llvm.dbg.cu")) {
827     for (MDNode *N : CU_Nodes->operands()) {
828       DICompileUnit TheCU(N);
829       // Construct subprogram DIE and add variables DIEs.
830       DwarfCompileUnit *SPCU =
831           static_cast<DwarfCompileUnit *>(CUMap.lookup(TheCU));
832       assert(SPCU && "Unable to find Compile Unit!");
833       DIArray Subprograms = TheCU.getSubprograms();
834       for (unsigned i = 0, e = Subprograms.getNumElements(); i != e; ++i) {
835         DISubprogram SP(Subprograms.getElement(i));
836         if (ProcessedSPNodes.count(SP) != 0)
837           continue;
838         assert(SP.isSubprogram() &&
839                "CU's subprogram list contains a non-subprogram");
840         assert(SP.isDefinition() &&
841                "CU's subprogram list contains a subprogram declaration");
842         DIArray Variables = SP.getVariables();
843         if (Variables.getNumElements() == 0)
844           continue;
845
846         DIE *SPDIE = AbstractSPDies.lookup(SP);
847         if (!SPDIE)
848           SPDIE = SPCU->getDIE(SP);
849         assert(SPDIE);
850         for (unsigned vi = 0, ve = Variables.getNumElements(); vi != ve; ++vi) {
851           DIVariable DV(Variables.getElement(vi));
852           assert(DV.isVariable());
853           DbgVariable NewVar(DV, nullptr, this);
854           SPDIE->addChild(SPCU->constructVariableDIE(NewVar));
855         }
856       }
857     }
858   }
859 }
860
861 void DwarfDebug::finalizeModuleInfo() {
862   finishSubprogramDefinitions();
863
864   // Collect info for variables that were optimized out.
865   collectDeadVariables();
866
867   // Handle anything that needs to be done on a per-unit basis after
868   // all other generation.
869   for (const auto &TheU : getUnits()) {
870     // Emit DW_AT_containing_type attribute to connect types with their
871     // vtable holding type.
872     TheU->constructContainingTypeDIEs();
873
874     // Add CU specific attributes if we need to add any.
875     if (TheU->getUnitDie().getTag() == dwarf::DW_TAG_compile_unit) {
876       // If we're splitting the dwarf out now that we've got the entire
877       // CU then add the dwo id to it.
878       DwarfCompileUnit *SkCU =
879           static_cast<DwarfCompileUnit *>(TheU->getSkeleton());
880       if (useSplitDwarf()) {
881         // Emit a unique identifier for this CU.
882         uint64_t ID = DIEHash(Asm).computeCUSignature(TheU->getUnitDie());
883         TheU->addUInt(TheU->getUnitDie(), dwarf::DW_AT_GNU_dwo_id,
884                       dwarf::DW_FORM_data8, ID);
885         SkCU->addUInt(SkCU->getUnitDie(), dwarf::DW_AT_GNU_dwo_id,
886                       dwarf::DW_FORM_data8, ID);
887
888         // We don't keep track of which addresses are used in which CU so this
889         // is a bit pessimistic under LTO.
890         if (!AddrPool.isEmpty())
891           addSectionLabel(*Asm, *SkCU, SkCU->getUnitDie(),
892                           dwarf::DW_AT_GNU_addr_base, DwarfAddrSectionSym,
893                           DwarfAddrSectionSym);
894         if (!TheU->getRangeLists().empty())
895           addSectionLabel(*Asm, *SkCU, SkCU->getUnitDie(),
896                           dwarf::DW_AT_GNU_ranges_base,
897                           DwarfDebugRangeSectionSym, DwarfDebugRangeSectionSym);
898       }
899
900       // If we have code split among multiple sections or non-contiguous
901       // ranges of code then emit a DW_AT_ranges attribute on the unit that will
902       // remain in the .o file, otherwise add a DW_AT_low_pc.
903       // FIXME: We should use ranges allow reordering of code ala
904       // .subsections_via_symbols in mach-o. This would mean turning on
905       // ranges for all subprogram DIEs for mach-o.
906       DwarfCompileUnit &U =
907           SkCU ? *SkCU : static_cast<DwarfCompileUnit &>(*TheU);
908       unsigned NumRanges = TheU->getRanges().size();
909       if (NumRanges) {
910         if (NumRanges > 1) {
911           addSectionLabel(*Asm, U, U.getUnitDie(), dwarf::DW_AT_ranges,
912                           Asm->GetTempSymbol("cu_ranges", U.getUniqueID()),
913                           DwarfDebugRangeSectionSym);
914
915           // A DW_AT_low_pc attribute may also be specified in combination with
916           // DW_AT_ranges to specify the default base address for use in
917           // location lists (see Section 2.6.2) and range lists (see Section
918           // 2.17.3).
919           U.addUInt(U.getUnitDie(), dwarf::DW_AT_low_pc, dwarf::DW_FORM_addr,
920                     0);
921         } else {
922           RangeSpan &Range = TheU->getRanges().back();
923           U.addLocalLabelAddress(U.getUnitDie(), dwarf::DW_AT_low_pc,
924                                  Range.getStart());
925           U.addLabelDelta(U.getUnitDie(), dwarf::DW_AT_high_pc, Range.getEnd(),
926                           Range.getStart());
927         }
928       }
929     }
930   }
931
932   // Compute DIE offsets and sizes.
933   InfoHolder.computeSizeAndOffsets();
934   if (useSplitDwarf())
935     SkeletonHolder.computeSizeAndOffsets();
936 }
937
938 void DwarfDebug::endSections() {
939   // Filter labels by section.
940   for (const SymbolCU &SCU : ArangeLabels) {
941     if (SCU.Sym->isInSection()) {
942       // Make a note of this symbol and it's section.
943       const MCSection *Section = &SCU.Sym->getSection();
944       if (!Section->getKind().isMetadata())
945         SectionMap[Section].push_back(SCU);
946     } else {
947       // Some symbols (e.g. common/bss on mach-o) can have no section but still
948       // appear in the output. This sucks as we rely on sections to build
949       // arange spans. We can do it without, but it's icky.
950       SectionMap[nullptr].push_back(SCU);
951     }
952   }
953
954   // Build a list of sections used.
955   std::vector<const MCSection *> Sections;
956   for (const auto &it : SectionMap) {
957     const MCSection *Section = it.first;
958     Sections.push_back(Section);
959   }
960
961   // Sort the sections into order.
962   // This is only done to ensure consistent output order across different runs.
963   std::sort(Sections.begin(), Sections.end(), SectionSort);
964
965   // Add terminating symbols for each section.
966   for (unsigned ID = 0, E = Sections.size(); ID != E; ID++) {
967     const MCSection *Section = Sections[ID];
968     MCSymbol *Sym = nullptr;
969
970     if (Section) {
971       // We can't call MCSection::getLabelEndName, as it's only safe to do so
972       // if we know the section name up-front. For user-created sections, the
973       // resulting label may not be valid to use as a label. (section names can
974       // use a greater set of characters on some systems)
975       Sym = Asm->GetTempSymbol("debug_end", ID);
976       Asm->OutStreamer.SwitchSection(Section);
977       Asm->OutStreamer.EmitLabel(Sym);
978     }
979
980     // Insert a final terminator.
981     SectionMap[Section].push_back(SymbolCU(nullptr, Sym));
982   }
983 }
984
985 // Emit all Dwarf sections that should come after the content.
986 void DwarfDebug::endModule() {
987   assert(CurFn == nullptr);
988   assert(CurMI == nullptr);
989
990   if (!FirstCU)
991     return;
992
993   // End any existing sections.
994   // TODO: Does this need to happen?
995   endSections();
996
997   // Finalize the debug info for the module.
998   finalizeModuleInfo();
999
1000   emitDebugStr();
1001
1002   // Emit all the DIEs into a debug info section.
1003   emitDebugInfo();
1004
1005   // Corresponding abbreviations into a abbrev section.
1006   emitAbbreviations();
1007
1008   // Emit info into a debug aranges section.
1009   if (GenerateARangeSection)
1010     emitDebugARanges();
1011
1012   // Emit info into a debug ranges section.
1013   emitDebugRanges();
1014
1015   if (useSplitDwarf()) {
1016     emitDebugStrDWO();
1017     emitDebugInfoDWO();
1018     emitDebugAbbrevDWO();
1019     emitDebugLineDWO();
1020     // Emit DWO addresses.
1021     AddrPool.emit(*Asm, Asm->getObjFileLowering().getDwarfAddrSection());
1022     emitDebugLocDWO();
1023   } else
1024     // Emit info into a debug loc section.
1025     emitDebugLoc();
1026
1027   // Emit info into the dwarf accelerator table sections.
1028   if (useDwarfAccelTables()) {
1029     emitAccelNames();
1030     emitAccelObjC();
1031     emitAccelNamespaces();
1032     emitAccelTypes();
1033   }
1034
1035   // Emit the pubnames and pubtypes sections if requested.
1036   if (HasDwarfPubSections) {
1037     emitDebugPubNames(GenerateGnuPubSections);
1038     emitDebugPubTypes(GenerateGnuPubSections);
1039   }
1040
1041   // clean up.
1042   SPMap.clear();
1043   AbstractVariables.clear();
1044
1045   // Reset these for the next Module if we have one.
1046   FirstCU = nullptr;
1047 }
1048
1049 // Find abstract variable, if any, associated with Var.
1050 DbgVariable *DwarfDebug::findAbstractVariable(DIVariable &DV,
1051                                               DebugLoc ScopeLoc) {
1052   return findAbstractVariable(DV, ScopeLoc.getScope(DV->getContext()));
1053 }
1054
1055 DbgVariable *DwarfDebug::findAbstractVariable(DIVariable &DV,
1056                                               const MDNode *ScopeNode) {
1057   LLVMContext &Ctx = DV->getContext();
1058   // More then one inlined variable corresponds to one abstract variable.
1059   DIVariable Var = cleanseInlinedVariable(DV, Ctx);
1060   auto I = AbstractVariables.find(Var);
1061   if (I != AbstractVariables.end())
1062     return I->second.get();
1063
1064   LexicalScope *Scope = LScopes.findAbstractScope(ScopeNode);
1065   if (!Scope)
1066     return nullptr;
1067
1068   auto AbsDbgVariable = make_unique<DbgVariable>(Var, nullptr, this);
1069   addScopeVariable(Scope, AbsDbgVariable.get());
1070   return (AbstractVariables[Var] = std::move(AbsDbgVariable)).get();
1071 }
1072
1073 // If Var is a current function argument then add it to CurrentFnArguments list.
1074 bool DwarfDebug::addCurrentFnArgument(DbgVariable *Var, LexicalScope *Scope) {
1075   if (!LScopes.isCurrentFunctionScope(Scope))
1076     return false;
1077   DIVariable DV = Var->getVariable();
1078   if (DV.getTag() != dwarf::DW_TAG_arg_variable)
1079     return false;
1080   unsigned ArgNo = DV.getArgNumber();
1081   if (ArgNo == 0)
1082     return false;
1083
1084   size_t Size = CurrentFnArguments.size();
1085   if (Size == 0)
1086     CurrentFnArguments.resize(CurFn->getFunction()->arg_size());
1087   // llvm::Function argument size is not good indicator of how many
1088   // arguments does the function have at source level.
1089   if (ArgNo > Size)
1090     CurrentFnArguments.resize(ArgNo * 2);
1091   CurrentFnArguments[ArgNo - 1] = Var;
1092   return true;
1093 }
1094
1095 // Collect variable information from side table maintained by MMI.
1096 void DwarfDebug::collectVariableInfoFromMMITable(
1097     SmallPtrSet<const MDNode *, 16> &Processed) {
1098   for (const auto &VI : MMI->getVariableDbgInfo()) {
1099     if (!VI.Var)
1100       continue;
1101     Processed.insert(VI.Var);
1102     DIVariable DV(VI.Var);
1103     LexicalScope *Scope = LScopes.findLexicalScope(VI.Loc);
1104
1105     // If variable scope is not found then skip this variable.
1106     if (!Scope)
1107       continue;
1108
1109     DbgVariable *AbsDbgVariable = findAbstractVariable(DV, VI.Loc);
1110     DbgVariable *RegVar = new DbgVariable(DV, AbsDbgVariable, this);
1111     RegVar->setFrameIndex(VI.Slot);
1112     if (!addCurrentFnArgument(RegVar, Scope))
1113       addScopeVariable(Scope, RegVar);
1114   }
1115 }
1116
1117 // Get .debug_loc entry for the instruction range starting at MI.
1118 static DebugLocEntry::Value getDebugLocValue(const MachineInstr *MI) {
1119   const MDNode *Var = MI->getDebugVariable();
1120
1121   assert(MI->getNumOperands() == 3);
1122   if (MI->getOperand(0).isReg()) {
1123     MachineLocation MLoc;
1124     // If the second operand is an immediate, this is a
1125     // register-indirect address.
1126     if (!MI->getOperand(1).isImm())
1127       MLoc.set(MI->getOperand(0).getReg());
1128     else
1129       MLoc.set(MI->getOperand(0).getReg(), MI->getOperand(1).getImm());
1130     return DebugLocEntry::Value(Var, MLoc);
1131   }
1132   if (MI->getOperand(0).isImm())
1133     return DebugLocEntry::Value(Var, MI->getOperand(0).getImm());
1134   if (MI->getOperand(0).isFPImm())
1135     return DebugLocEntry::Value(Var, MI->getOperand(0).getFPImm());
1136   if (MI->getOperand(0).isCImm())
1137     return DebugLocEntry::Value(Var, MI->getOperand(0).getCImm());
1138
1139   llvm_unreachable("Unexpected 3 operand DBG_VALUE instruction!");
1140 }
1141
1142 // Find variables for each lexical scope.
1143 void
1144 DwarfDebug::collectVariableInfo(SmallPtrSet<const MDNode *, 16> &Processed) {
1145   LexicalScope *FnScope = LScopes.getCurrentFunctionScope();
1146   DwarfCompileUnit *TheCU = SPMap.lookup(FnScope->getScopeNode());
1147
1148   // Grab the variable info that was squirreled away in the MMI side-table.
1149   collectVariableInfoFromMMITable(Processed);
1150
1151   for (const auto &I : DbgValues) {
1152     DIVariable DV(I.first);
1153     if (Processed.count(DV))
1154       continue;
1155
1156     // Instruction ranges, specifying where DV is accessible.
1157     const auto &Ranges = I.second;
1158     if (Ranges.empty())
1159       continue;
1160
1161     LexicalScope *Scope = nullptr;
1162     if (DV.getTag() == dwarf::DW_TAG_arg_variable &&
1163         DISubprogram(DV.getContext()).describes(CurFn->getFunction()))
1164       Scope = LScopes.getCurrentFunctionScope();
1165     else if (MDNode *IA = DV.getInlinedAt()) {
1166       DebugLoc DL = DebugLoc::getFromDILocation(IA);
1167       Scope = LScopes.findInlinedScope(DebugLoc::get(
1168           DL.getLine(), DL.getCol(), DV.getContext(), IA));
1169     } else
1170       Scope = LScopes.findLexicalScope(DV.getContext());
1171     // If variable scope is not found then skip this variable.
1172     if (!Scope)
1173       continue;
1174
1175     Processed.insert(DV);
1176     const MachineInstr *MInsn = Ranges.front().first;
1177     assert(MInsn->isDebugValue() && "History must begin with debug value");
1178     DbgVariable *AbsVar = findAbstractVariable(DV, Scope->getScopeNode());
1179     DbgVariable *RegVar = new DbgVariable(MInsn, AbsVar, this);
1180     if (!addCurrentFnArgument(RegVar, Scope))
1181       addScopeVariable(Scope, RegVar);
1182
1183     // Check if the first DBG_VALUE is valid for the rest of the function.
1184     if (Ranges.size() == 1 && Ranges.front().second == nullptr)
1185       continue;
1186
1187     // Handle multiple DBG_VALUE instructions describing one variable.
1188     RegVar->setDotDebugLocOffset(DotDebugLocEntries.size());
1189
1190     DotDebugLocEntries.resize(DotDebugLocEntries.size() + 1);
1191     DebugLocList &LocList = DotDebugLocEntries.back();
1192     LocList.Label =
1193         Asm->GetTempSymbol("debug_loc", DotDebugLocEntries.size() - 1);
1194     SmallVector<DebugLocEntry, 4> &DebugLoc = LocList.List;
1195     for (auto I = Ranges.begin(), E = Ranges.end(); I != E; ++I) {
1196       const MachineInstr *Begin = I->first;
1197       const MachineInstr *End = I->second;
1198       assert(Begin->isDebugValue() && "Invalid History entry");
1199
1200       // Check if a variable is unaccessible in this range.
1201       if (Begin->getNumOperands() > 1 && Begin->getOperand(0).isReg() &&
1202           !Begin->getOperand(0).getReg())
1203         continue;
1204
1205       const MCSymbol *StartLabel = getLabelBeforeInsn(Begin);
1206       assert(StartLabel && "Forgot label before DBG_VALUE starting a range!");
1207
1208       const MCSymbol *EndLabel;
1209       if (End != nullptr)
1210         EndLabel = getLabelAfterInsn(End);
1211       else if (std::next(I) == Ranges.end())
1212         EndLabel = FunctionEndSym;
1213       else
1214         EndLabel = getLabelBeforeInsn(std::next(I)->first);
1215       assert(EndLabel && "Forgot label after instruction ending a range!");
1216
1217       DEBUG(dbgs() << "DotDebugLoc Pair:\n"
1218                    << "\t" << *Begin << "\t" << *End << "\n");
1219       DebugLocEntry Loc(StartLabel, EndLabel, getDebugLocValue(Begin), TheCU);
1220       if (DebugLoc.empty() || !DebugLoc.back().Merge(Loc))
1221         DebugLoc.push_back(std::move(Loc));
1222     }
1223   }
1224
1225   // Collect info for variables that were optimized out.
1226   DIArray Variables = DISubprogram(FnScope->getScopeNode()).getVariables();
1227   for (unsigned i = 0, e = Variables.getNumElements(); i != e; ++i) {
1228     DIVariable DV(Variables.getElement(i));
1229     assert(DV.isVariable());
1230     if (!Processed.insert(DV))
1231       continue;
1232     if (LexicalScope *Scope = LScopes.findLexicalScope(DV.getContext()))
1233       addScopeVariable(
1234           Scope,
1235           new DbgVariable(DV, findAbstractVariable(DV, Scope->getScopeNode()),
1236                           this));
1237   }
1238 }
1239
1240 // Return Label preceding the instruction.
1241 MCSymbol *DwarfDebug::getLabelBeforeInsn(const MachineInstr *MI) {
1242   MCSymbol *Label = LabelsBeforeInsn.lookup(MI);
1243   assert(Label && "Didn't insert label before instruction");
1244   return Label;
1245 }
1246
1247 // Return Label immediately following the instruction.
1248 MCSymbol *DwarfDebug::getLabelAfterInsn(const MachineInstr *MI) {
1249   return LabelsAfterInsn.lookup(MI);
1250 }
1251
1252 // Process beginning of an instruction.
1253 void DwarfDebug::beginInstruction(const MachineInstr *MI) {
1254   assert(CurMI == nullptr);
1255   CurMI = MI;
1256   // Check if source location changes, but ignore DBG_VALUE locations.
1257   if (!MI->isDebugValue()) {
1258     DebugLoc DL = MI->getDebugLoc();
1259     if (DL != PrevInstLoc && (!DL.isUnknown() || UnknownLocations)) {
1260       unsigned Flags = 0;
1261       PrevInstLoc = DL;
1262       if (DL == PrologEndLoc) {
1263         Flags |= DWARF2_FLAG_PROLOGUE_END;
1264         PrologEndLoc = DebugLoc();
1265       }
1266       if (PrologEndLoc.isUnknown())
1267         Flags |= DWARF2_FLAG_IS_STMT;
1268
1269       if (!DL.isUnknown()) {
1270         const MDNode *Scope = DL.getScope(Asm->MF->getFunction()->getContext());
1271         recordSourceLine(DL.getLine(), DL.getCol(), Scope, Flags);
1272       } else
1273         recordSourceLine(0, 0, nullptr, 0);
1274     }
1275   }
1276
1277   // Insert labels where requested.
1278   DenseMap<const MachineInstr *, MCSymbol *>::iterator I =
1279       LabelsBeforeInsn.find(MI);
1280
1281   // No label needed.
1282   if (I == LabelsBeforeInsn.end())
1283     return;
1284
1285   // Label already assigned.
1286   if (I->second)
1287     return;
1288
1289   if (!PrevLabel) {
1290     PrevLabel = MMI->getContext().CreateTempSymbol();
1291     Asm->OutStreamer.EmitLabel(PrevLabel);
1292   }
1293   I->second = PrevLabel;
1294 }
1295
1296 // Process end of an instruction.
1297 void DwarfDebug::endInstruction() {
1298   assert(CurMI != nullptr);
1299   // Don't create a new label after DBG_VALUE instructions.
1300   // They don't generate code.
1301   if (!CurMI->isDebugValue())
1302     PrevLabel = nullptr;
1303
1304   DenseMap<const MachineInstr *, MCSymbol *>::iterator I =
1305       LabelsAfterInsn.find(CurMI);
1306   CurMI = nullptr;
1307
1308   // No label needed.
1309   if (I == LabelsAfterInsn.end())
1310     return;
1311
1312   // Label already assigned.
1313   if (I->second)
1314     return;
1315
1316   // We need a label after this instruction.
1317   if (!PrevLabel) {
1318     PrevLabel = MMI->getContext().CreateTempSymbol();
1319     Asm->OutStreamer.EmitLabel(PrevLabel);
1320   }
1321   I->second = PrevLabel;
1322 }
1323
1324 // Each LexicalScope has first instruction and last instruction to mark
1325 // beginning and end of a scope respectively. Create an inverse map that list
1326 // scopes starts (and ends) with an instruction. One instruction may start (or
1327 // end) multiple scopes. Ignore scopes that are not reachable.
1328 void DwarfDebug::identifyScopeMarkers() {
1329   SmallVector<LexicalScope *, 4> WorkList;
1330   WorkList.push_back(LScopes.getCurrentFunctionScope());
1331   while (!WorkList.empty()) {
1332     LexicalScope *S = WorkList.pop_back_val();
1333
1334     const SmallVectorImpl<LexicalScope *> &Children = S->getChildren();
1335     if (!Children.empty())
1336       WorkList.append(Children.begin(), Children.end());
1337
1338     if (S->isAbstractScope())
1339       continue;
1340
1341     for (const InsnRange &R : S->getRanges()) {
1342       assert(R.first && "InsnRange does not have first instruction!");
1343       assert(R.second && "InsnRange does not have second instruction!");
1344       requestLabelBeforeInsn(R.first);
1345       requestLabelAfterInsn(R.second);
1346     }
1347   }
1348 }
1349
1350 static DebugLoc findPrologueEndLoc(const MachineFunction *MF) {
1351   // First known non-DBG_VALUE and non-frame setup location marks
1352   // the beginning of the function body.
1353   for (const auto &MBB : *MF)
1354     for (const auto &MI : MBB)
1355       if (!MI.isDebugValue() && !MI.getFlag(MachineInstr::FrameSetup) &&
1356           !MI.getDebugLoc().isUnknown())
1357         return MI.getDebugLoc();
1358   return DebugLoc();
1359 }
1360
1361 // Gather pre-function debug information.  Assumes being called immediately
1362 // after the function entry point has been emitted.
1363 void DwarfDebug::beginFunction(const MachineFunction *MF) {
1364   CurFn = MF;
1365
1366   // If there's no debug info for the function we're not going to do anything.
1367   if (!MMI->hasDebugInfo())
1368     return;
1369
1370   // Grab the lexical scopes for the function, if we don't have any of those
1371   // then we're not going to be able to do anything.
1372   LScopes.initialize(*MF);
1373   if (LScopes.empty())
1374     return;
1375
1376   assert(DbgValues.empty() && "DbgValues map wasn't cleaned!");
1377
1378   // Make sure that each lexical scope will have a begin/end label.
1379   identifyScopeMarkers();
1380
1381   // Set DwarfDwarfCompileUnitID in MCContext to the Compile Unit this function
1382   // belongs to so that we add to the correct per-cu line table in the
1383   // non-asm case.
1384   LexicalScope *FnScope = LScopes.getCurrentFunctionScope();
1385   DwarfCompileUnit *TheCU = SPMap.lookup(FnScope->getScopeNode());
1386   assert(TheCU && "Unable to find compile unit!");
1387   if (Asm->OutStreamer.hasRawTextSupport())
1388     // Use a single line table if we are generating assembly.
1389     Asm->OutStreamer.getContext().setDwarfCompileUnitID(0);
1390   else
1391     Asm->OutStreamer.getContext().setDwarfCompileUnitID(TheCU->getUniqueID());
1392
1393   // Emit a label for the function so that we have a beginning address.
1394   FunctionBeginSym = Asm->GetTempSymbol("func_begin", Asm->getFunctionNumber());
1395   // Assumes in correct section after the entry point.
1396   Asm->OutStreamer.EmitLabel(FunctionBeginSym);
1397
1398   // Calculate history for local variables.
1399   calculateDbgValueHistory(MF, Asm->TM.getRegisterInfo(), DbgValues);
1400
1401   // Request labels for the full history.
1402   for (const auto &I : DbgValues) {
1403     const auto &Ranges = I.second;
1404     if (Ranges.empty())
1405       continue;
1406
1407     // The first mention of a function argument gets the FunctionBeginSym
1408     // label, so arguments are visible when breaking at function entry.
1409     DIVariable DV(I.first);
1410     if (DV.isVariable() && DV.getTag() == dwarf::DW_TAG_arg_variable &&
1411         getDISubprogram(DV.getContext()).describes(MF->getFunction()))
1412       LabelsBeforeInsn[Ranges.front().first] = FunctionBeginSym;
1413
1414     for (const auto &Range : Ranges) {
1415       requestLabelBeforeInsn(Range.first);
1416       if (Range.second)
1417         requestLabelAfterInsn(Range.second);
1418     }
1419   }
1420
1421   PrevInstLoc = DebugLoc();
1422   PrevLabel = FunctionBeginSym;
1423
1424   // Record beginning of function.
1425   PrologEndLoc = findPrologueEndLoc(MF);
1426   if (!PrologEndLoc.isUnknown()) {
1427     DebugLoc FnStartDL =
1428         PrologEndLoc.getFnDebugLoc(MF->getFunction()->getContext());
1429     recordSourceLine(
1430         FnStartDL.getLine(), FnStartDL.getCol(),
1431         FnStartDL.getScope(MF->getFunction()->getContext()),
1432         // We'd like to list the prologue as "not statements" but GDB behaves
1433         // poorly if we do that. Revisit this with caution/GDB (7.5+) testing.
1434         DWARF2_FLAG_IS_STMT);
1435   }
1436 }
1437
1438 void DwarfDebug::addScopeVariable(LexicalScope *LS, DbgVariable *Var) {
1439   SmallVectorImpl<DbgVariable *> &Vars = ScopeVariables[LS];
1440   DIVariable DV = Var->getVariable();
1441   // Variables with positive arg numbers are parameters.
1442   if (unsigned ArgNum = DV.getArgNumber()) {
1443     // Keep all parameters in order at the start of the variable list to ensure
1444     // function types are correct (no out-of-order parameters)
1445     //
1446     // This could be improved by only doing it for optimized builds (unoptimized
1447     // builds have the right order to begin with), searching from the back (this
1448     // would catch the unoptimized case quickly), or doing a binary search
1449     // rather than linear search.
1450     SmallVectorImpl<DbgVariable *>::iterator I = Vars.begin();
1451     while (I != Vars.end()) {
1452       unsigned CurNum = (*I)->getVariable().getArgNumber();
1453       // A local (non-parameter) variable has been found, insert immediately
1454       // before it.
1455       if (CurNum == 0)
1456         break;
1457       // A later indexed parameter has been found, insert immediately before it.
1458       if (CurNum > ArgNum)
1459         break;
1460       ++I;
1461     }
1462     Vars.insert(I, Var);
1463     return;
1464   }
1465
1466   Vars.push_back(Var);
1467 }
1468
1469 // Gather and emit post-function debug information.
1470 void DwarfDebug::endFunction(const MachineFunction *MF) {
1471   // Every beginFunction(MF) call should be followed by an endFunction(MF) call,
1472   // though the beginFunction may not be called at all.
1473   // We should handle both cases.
1474   if (!CurFn)
1475     CurFn = MF;
1476   else
1477     assert(CurFn == MF);
1478   assert(CurFn != nullptr);
1479
1480   if (!MMI->hasDebugInfo() || LScopes.empty()) {
1481     // If we don't have a lexical scope for this function then there will
1482     // be a hole in the range information. Keep note of this by setting the
1483     // previously used section to nullptr.
1484     PrevSection = nullptr;
1485     PrevCU = nullptr;
1486     CurFn = nullptr;
1487     return;
1488   }
1489
1490   // Define end label for subprogram.
1491   FunctionEndSym = Asm->GetTempSymbol("func_end", Asm->getFunctionNumber());
1492   // Assumes in correct section after the entry point.
1493   Asm->OutStreamer.EmitLabel(FunctionEndSym);
1494
1495   // Set DwarfDwarfCompileUnitID in MCContext to default value.
1496   Asm->OutStreamer.getContext().setDwarfCompileUnitID(0);
1497
1498   SmallPtrSet<const MDNode *, 16> ProcessedVars;
1499   collectVariableInfo(ProcessedVars);
1500
1501   LexicalScope *FnScope = LScopes.getCurrentFunctionScope();
1502   DwarfCompileUnit &TheCU = *SPMap.lookup(FnScope->getScopeNode());
1503
1504   // Construct abstract scopes.
1505   for (LexicalScope *AScope : LScopes.getAbstractScopesList()) {
1506     DISubprogram SP(AScope->getScopeNode());
1507     if (!SP.isSubprogram())
1508       continue;
1509     // Collect info for variables that were optimized out.
1510     DIArray Variables = SP.getVariables();
1511     for (unsigned i = 0, e = Variables.getNumElements(); i != e; ++i) {
1512       DIVariable DV(Variables.getElement(i));
1513       assert(DV && DV.isVariable());
1514       if (!ProcessedVars.insert(DV))
1515         continue;
1516       findAbstractVariable(DV, DV.getContext());
1517     }
1518     constructAbstractSubprogramScopeDIE(TheCU, AScope);
1519   }
1520
1521   DIE &CurFnDIE = constructSubprogramScopeDIE(TheCU, FnScope);
1522   if (!CurFn->getTarget().Options.DisableFramePointerElim(*CurFn))
1523     TheCU.addFlag(CurFnDIE, dwarf::DW_AT_APPLE_omit_frame_ptr);
1524
1525   // Add the range of this function to the list of ranges for the CU.
1526   RangeSpan Span(FunctionBeginSym, FunctionEndSym);
1527   TheCU.addRange(std::move(Span));
1528   PrevSection = Asm->getCurrentSection();
1529   PrevCU = &TheCU;
1530
1531   // Clear debug info
1532   // Ownership of DbgVariables is a bit subtle - ScopeVariables owns all the
1533   // DbgVariables except those that are also in AbstractVariables (since they
1534   // can be used cross-function)
1535   for (const auto &I : ScopeVariables)
1536     for (const auto *Var : I.second)
1537       if (!AbstractVariables.count(Var->getVariable()) || Var->getAbstractVariable())
1538         delete Var;
1539   ScopeVariables.clear();
1540   DeleteContainerPointers(CurrentFnArguments);
1541   DbgValues.clear();
1542   LabelsBeforeInsn.clear();
1543   LabelsAfterInsn.clear();
1544   PrevLabel = nullptr;
1545   CurFn = nullptr;
1546 }
1547
1548 // Register a source line with debug info. Returns the  unique label that was
1549 // emitted and which provides correspondence to the source line list.
1550 void DwarfDebug::recordSourceLine(unsigned Line, unsigned Col, const MDNode *S,
1551                                   unsigned Flags) {
1552   StringRef Fn;
1553   StringRef Dir;
1554   unsigned Src = 1;
1555   unsigned Discriminator = 0;
1556   if (DIScope Scope = DIScope(S)) {
1557     assert(Scope.isScope());
1558     Fn = Scope.getFilename();
1559     Dir = Scope.getDirectory();
1560     if (Scope.isLexicalBlock())
1561       Discriminator = DILexicalBlock(S).getDiscriminator();
1562
1563     unsigned CUID = Asm->OutStreamer.getContext().getDwarfCompileUnitID();
1564     Src = static_cast<DwarfCompileUnit &>(*InfoHolder.getUnits()[CUID])
1565               .getOrCreateSourceID(Fn, Dir);
1566   }
1567   Asm->OutStreamer.EmitDwarfLocDirective(Src, Line, Col, Flags, 0,
1568                                          Discriminator, Fn);
1569 }
1570
1571 //===----------------------------------------------------------------------===//
1572 // Emit Methods
1573 //===----------------------------------------------------------------------===//
1574
1575 // Emit initial Dwarf sections with a label at the start of each one.
1576 void DwarfDebug::emitSectionLabels() {
1577   const TargetLoweringObjectFile &TLOF = Asm->getObjFileLowering();
1578
1579   // Dwarf sections base addresses.
1580   DwarfInfoSectionSym =
1581       emitSectionSym(Asm, TLOF.getDwarfInfoSection(), "section_info");
1582   if (useSplitDwarf())
1583     DwarfInfoDWOSectionSym =
1584         emitSectionSym(Asm, TLOF.getDwarfInfoDWOSection(), "section_info_dwo");
1585   DwarfAbbrevSectionSym =
1586       emitSectionSym(Asm, TLOF.getDwarfAbbrevSection(), "section_abbrev");
1587   if (useSplitDwarf())
1588     DwarfAbbrevDWOSectionSym = emitSectionSym(
1589         Asm, TLOF.getDwarfAbbrevDWOSection(), "section_abbrev_dwo");
1590   if (GenerateARangeSection)
1591     emitSectionSym(Asm, TLOF.getDwarfARangesSection());
1592
1593   DwarfLineSectionSym =
1594       emitSectionSym(Asm, TLOF.getDwarfLineSection(), "section_line");
1595   if (GenerateGnuPubSections) {
1596     DwarfGnuPubNamesSectionSym =
1597         emitSectionSym(Asm, TLOF.getDwarfGnuPubNamesSection());
1598     DwarfGnuPubTypesSectionSym =
1599         emitSectionSym(Asm, TLOF.getDwarfGnuPubTypesSection());
1600   } else if (HasDwarfPubSections) {
1601     emitSectionSym(Asm, TLOF.getDwarfPubNamesSection());
1602     emitSectionSym(Asm, TLOF.getDwarfPubTypesSection());
1603   }
1604
1605   DwarfStrSectionSym =
1606       emitSectionSym(Asm, TLOF.getDwarfStrSection(), "info_string");
1607   if (useSplitDwarf()) {
1608     DwarfStrDWOSectionSym =
1609         emitSectionSym(Asm, TLOF.getDwarfStrDWOSection(), "skel_string");
1610     DwarfAddrSectionSym =
1611         emitSectionSym(Asm, TLOF.getDwarfAddrSection(), "addr_sec");
1612     DwarfDebugLocSectionSym =
1613         emitSectionSym(Asm, TLOF.getDwarfLocDWOSection(), "skel_loc");
1614   } else
1615     DwarfDebugLocSectionSym =
1616         emitSectionSym(Asm, TLOF.getDwarfLocSection(), "section_debug_loc");
1617   DwarfDebugRangeSectionSym =
1618       emitSectionSym(Asm, TLOF.getDwarfRangesSection(), "debug_range");
1619 }
1620
1621 // Recursively emits a debug information entry.
1622 void DwarfDebug::emitDIE(DIE &Die) {
1623   // Get the abbreviation for this DIE.
1624   const DIEAbbrev &Abbrev = Die.getAbbrev();
1625
1626   // Emit the code (index) for the abbreviation.
1627   if (Asm->isVerbose())
1628     Asm->OutStreamer.AddComment("Abbrev [" + Twine(Abbrev.getNumber()) +
1629                                 "] 0x" + Twine::utohexstr(Die.getOffset()) +
1630                                 ":0x" + Twine::utohexstr(Die.getSize()) + " " +
1631                                 dwarf::TagString(Abbrev.getTag()));
1632   Asm->EmitULEB128(Abbrev.getNumber());
1633
1634   const SmallVectorImpl<DIEValue *> &Values = Die.getValues();
1635   const SmallVectorImpl<DIEAbbrevData> &AbbrevData = Abbrev.getData();
1636
1637   // Emit the DIE attribute values.
1638   for (unsigned i = 0, N = Values.size(); i < N; ++i) {
1639     dwarf::Attribute Attr = AbbrevData[i].getAttribute();
1640     dwarf::Form Form = AbbrevData[i].getForm();
1641     assert(Form && "Too many attributes for DIE (check abbreviation)");
1642
1643     if (Asm->isVerbose()) {
1644       Asm->OutStreamer.AddComment(dwarf::AttributeString(Attr));
1645       if (Attr == dwarf::DW_AT_accessibility)
1646         Asm->OutStreamer.AddComment(dwarf::AccessibilityString(
1647             cast<DIEInteger>(Values[i])->getValue()));
1648     }
1649
1650     // Emit an attribute using the defined form.
1651     Values[i]->EmitValue(Asm, Form);
1652   }
1653
1654   // Emit the DIE children if any.
1655   if (Abbrev.hasChildren()) {
1656     for (auto &Child : Die.getChildren())
1657       emitDIE(*Child);
1658
1659     Asm->OutStreamer.AddComment("End Of Children Mark");
1660     Asm->EmitInt8(0);
1661   }
1662 }
1663
1664 // Emit the debug info section.
1665 void DwarfDebug::emitDebugInfo() {
1666   DwarfFile &Holder = useSplitDwarf() ? SkeletonHolder : InfoHolder;
1667
1668   Holder.emitUnits(this, DwarfAbbrevSectionSym);
1669 }
1670
1671 // Emit the abbreviation section.
1672 void DwarfDebug::emitAbbreviations() {
1673   DwarfFile &Holder = useSplitDwarf() ? SkeletonHolder : InfoHolder;
1674
1675   Holder.emitAbbrevs(Asm->getObjFileLowering().getDwarfAbbrevSection());
1676 }
1677
1678 // Emit the last address of the section and the end of the line matrix.
1679 void DwarfDebug::emitEndOfLineMatrix(unsigned SectionEnd) {
1680   // Define last address of section.
1681   Asm->OutStreamer.AddComment("Extended Op");
1682   Asm->EmitInt8(0);
1683
1684   Asm->OutStreamer.AddComment("Op size");
1685   Asm->EmitInt8(Asm->getDataLayout().getPointerSize() + 1);
1686   Asm->OutStreamer.AddComment("DW_LNE_set_address");
1687   Asm->EmitInt8(dwarf::DW_LNE_set_address);
1688
1689   Asm->OutStreamer.AddComment("Section end label");
1690
1691   Asm->OutStreamer.EmitSymbolValue(
1692       Asm->GetTempSymbol("section_end", SectionEnd),
1693       Asm->getDataLayout().getPointerSize());
1694
1695   // Mark end of matrix.
1696   Asm->OutStreamer.AddComment("DW_LNE_end_sequence");
1697   Asm->EmitInt8(0);
1698   Asm->EmitInt8(1);
1699   Asm->EmitInt8(1);
1700 }
1701
1702 // Emit visible names into a hashed accelerator table section.
1703 void DwarfDebug::emitAccelNames() {
1704   AccelNames.FinalizeTable(Asm, "Names");
1705   Asm->OutStreamer.SwitchSection(
1706       Asm->getObjFileLowering().getDwarfAccelNamesSection());
1707   MCSymbol *SectionBegin = Asm->GetTempSymbol("names_begin");
1708   Asm->OutStreamer.EmitLabel(SectionBegin);
1709
1710   // Emit the full data.
1711   AccelNames.Emit(Asm, SectionBegin, &InfoHolder);
1712 }
1713
1714 // Emit objective C classes and categories into a hashed accelerator table
1715 // section.
1716 void DwarfDebug::emitAccelObjC() {
1717   AccelObjC.FinalizeTable(Asm, "ObjC");
1718   Asm->OutStreamer.SwitchSection(
1719       Asm->getObjFileLowering().getDwarfAccelObjCSection());
1720   MCSymbol *SectionBegin = Asm->GetTempSymbol("objc_begin");
1721   Asm->OutStreamer.EmitLabel(SectionBegin);
1722
1723   // Emit the full data.
1724   AccelObjC.Emit(Asm, SectionBegin, &InfoHolder);
1725 }
1726
1727 // Emit namespace dies into a hashed accelerator table.
1728 void DwarfDebug::emitAccelNamespaces() {
1729   AccelNamespace.FinalizeTable(Asm, "namespac");
1730   Asm->OutStreamer.SwitchSection(
1731       Asm->getObjFileLowering().getDwarfAccelNamespaceSection());
1732   MCSymbol *SectionBegin = Asm->GetTempSymbol("namespac_begin");
1733   Asm->OutStreamer.EmitLabel(SectionBegin);
1734
1735   // Emit the full data.
1736   AccelNamespace.Emit(Asm, SectionBegin, &InfoHolder);
1737 }
1738
1739 // Emit type dies into a hashed accelerator table.
1740 void DwarfDebug::emitAccelTypes() {
1741
1742   AccelTypes.FinalizeTable(Asm, "types");
1743   Asm->OutStreamer.SwitchSection(
1744       Asm->getObjFileLowering().getDwarfAccelTypesSection());
1745   MCSymbol *SectionBegin = Asm->GetTempSymbol("types_begin");
1746   Asm->OutStreamer.EmitLabel(SectionBegin);
1747
1748   // Emit the full data.
1749   AccelTypes.Emit(Asm, SectionBegin, &InfoHolder);
1750 }
1751
1752 // Public name handling.
1753 // The format for the various pubnames:
1754 //
1755 // dwarf pubnames - offset/name pairs where the offset is the offset into the CU
1756 // for the DIE that is named.
1757 //
1758 // gnu pubnames - offset/index value/name tuples where the offset is the offset
1759 // into the CU and the index value is computed according to the type of value
1760 // for the DIE that is named.
1761 //
1762 // For type units the offset is the offset of the skeleton DIE. For split dwarf
1763 // it's the offset within the debug_info/debug_types dwo section, however, the
1764 // reference in the pubname header doesn't change.
1765
1766 /// computeIndexValue - Compute the gdb index value for the DIE and CU.
1767 static dwarf::PubIndexEntryDescriptor computeIndexValue(DwarfUnit *CU,
1768                                                         const DIE *Die) {
1769   dwarf::GDBIndexEntryLinkage Linkage = dwarf::GIEL_STATIC;
1770
1771   // We could have a specification DIE that has our most of our knowledge,
1772   // look for that now.
1773   DIEValue *SpecVal = Die->findAttribute(dwarf::DW_AT_specification);
1774   if (SpecVal) {
1775     DIE &SpecDIE = cast<DIEEntry>(SpecVal)->getEntry();
1776     if (SpecDIE.findAttribute(dwarf::DW_AT_external))
1777       Linkage = dwarf::GIEL_EXTERNAL;
1778   } else if (Die->findAttribute(dwarf::DW_AT_external))
1779     Linkage = dwarf::GIEL_EXTERNAL;
1780
1781   switch (Die->getTag()) {
1782   case dwarf::DW_TAG_class_type:
1783   case dwarf::DW_TAG_structure_type:
1784   case dwarf::DW_TAG_union_type:
1785   case dwarf::DW_TAG_enumeration_type:
1786     return dwarf::PubIndexEntryDescriptor(
1787         dwarf::GIEK_TYPE, CU->getLanguage() != dwarf::DW_LANG_C_plus_plus
1788                               ? dwarf::GIEL_STATIC
1789                               : dwarf::GIEL_EXTERNAL);
1790   case dwarf::DW_TAG_typedef:
1791   case dwarf::DW_TAG_base_type:
1792   case dwarf::DW_TAG_subrange_type:
1793     return dwarf::PubIndexEntryDescriptor(dwarf::GIEK_TYPE, dwarf::GIEL_STATIC);
1794   case dwarf::DW_TAG_namespace:
1795     return dwarf::GIEK_TYPE;
1796   case dwarf::DW_TAG_subprogram:
1797     return dwarf::PubIndexEntryDescriptor(dwarf::GIEK_FUNCTION, Linkage);
1798   case dwarf::DW_TAG_constant:
1799   case dwarf::DW_TAG_variable:
1800     return dwarf::PubIndexEntryDescriptor(dwarf::GIEK_VARIABLE, Linkage);
1801   case dwarf::DW_TAG_enumerator:
1802     return dwarf::PubIndexEntryDescriptor(dwarf::GIEK_VARIABLE,
1803                                           dwarf::GIEL_STATIC);
1804   default:
1805     return dwarf::GIEK_NONE;
1806   }
1807 }
1808
1809 /// emitDebugPubNames - Emit visible names into a debug pubnames section.
1810 ///
1811 void DwarfDebug::emitDebugPubNames(bool GnuStyle) {
1812   const MCSection *PSec =
1813       GnuStyle ? Asm->getObjFileLowering().getDwarfGnuPubNamesSection()
1814                : Asm->getObjFileLowering().getDwarfPubNamesSection();
1815
1816   emitDebugPubSection(GnuStyle, PSec, "Names", &DwarfUnit::getGlobalNames);
1817 }
1818
1819 void DwarfDebug::emitDebugPubSection(
1820     bool GnuStyle, const MCSection *PSec, StringRef Name,
1821     const StringMap<const DIE *> &(DwarfUnit::*Accessor)() const) {
1822   for (const auto &NU : CUMap) {
1823     DwarfCompileUnit *TheU = NU.second;
1824
1825     const auto &Globals = (TheU->*Accessor)();
1826
1827     if (Globals.empty())
1828       continue;
1829
1830     if (auto Skeleton = static_cast<DwarfCompileUnit *>(TheU->getSkeleton()))
1831       TheU = Skeleton;
1832     unsigned ID = TheU->getUniqueID();
1833
1834     // Start the dwarf pubnames section.
1835     Asm->OutStreamer.SwitchSection(PSec);
1836
1837     // Emit the header.
1838     Asm->OutStreamer.AddComment("Length of Public " + Name + " Info");
1839     MCSymbol *BeginLabel = Asm->GetTempSymbol("pub" + Name + "_begin", ID);
1840     MCSymbol *EndLabel = Asm->GetTempSymbol("pub" + Name + "_end", ID);
1841     Asm->EmitLabelDifference(EndLabel, BeginLabel, 4);
1842
1843     Asm->OutStreamer.EmitLabel(BeginLabel);
1844
1845     Asm->OutStreamer.AddComment("DWARF Version");
1846     Asm->EmitInt16(dwarf::DW_PUBNAMES_VERSION);
1847
1848     Asm->OutStreamer.AddComment("Offset of Compilation Unit Info");
1849     Asm->EmitSectionOffset(TheU->getLabelBegin(), TheU->getSectionSym());
1850
1851     Asm->OutStreamer.AddComment("Compilation Unit Length");
1852     Asm->EmitLabelDifference(TheU->getLabelEnd(), TheU->getLabelBegin(), 4);
1853
1854     // Emit the pubnames for this compilation unit.
1855     for (const auto &GI : Globals) {
1856       const char *Name = GI.getKeyData();
1857       const DIE *Entity = GI.second;
1858
1859       Asm->OutStreamer.AddComment("DIE offset");
1860       Asm->EmitInt32(Entity->getOffset());
1861
1862       if (GnuStyle) {
1863         dwarf::PubIndexEntryDescriptor Desc = computeIndexValue(TheU, Entity);
1864         Asm->OutStreamer.AddComment(
1865             Twine("Kind: ") + dwarf::GDBIndexEntryKindString(Desc.Kind) + ", " +
1866             dwarf::GDBIndexEntryLinkageString(Desc.Linkage));
1867         Asm->EmitInt8(Desc.toBits());
1868       }
1869
1870       Asm->OutStreamer.AddComment("External Name");
1871       Asm->OutStreamer.EmitBytes(StringRef(Name, GI.getKeyLength() + 1));
1872     }
1873
1874     Asm->OutStreamer.AddComment("End Mark");
1875     Asm->EmitInt32(0);
1876     Asm->OutStreamer.EmitLabel(EndLabel);
1877   }
1878 }
1879
1880 void DwarfDebug::emitDebugPubTypes(bool GnuStyle) {
1881   const MCSection *PSec =
1882       GnuStyle ? Asm->getObjFileLowering().getDwarfGnuPubTypesSection()
1883                : Asm->getObjFileLowering().getDwarfPubTypesSection();
1884
1885   emitDebugPubSection(GnuStyle, PSec, "Types", &DwarfUnit::getGlobalTypes);
1886 }
1887
1888 // Emit visible names into a debug str section.
1889 void DwarfDebug::emitDebugStr() {
1890   DwarfFile &Holder = useSplitDwarf() ? SkeletonHolder : InfoHolder;
1891   Holder.emitStrings(Asm->getObjFileLowering().getDwarfStrSection());
1892 }
1893
1894 void DwarfDebug::emitDebugLocEntry(ByteStreamer &Streamer,
1895                                    const DebugLocEntry &Entry) {
1896   assert(Entry.getValues().size() == 1 &&
1897          "multi-value entries are not supported yet.");
1898   const DebugLocEntry::Value Value = Entry.getValues()[0];
1899   DIVariable DV(Value.getVariable());
1900   if (Value.isInt()) {
1901     DIBasicType BTy(resolve(DV.getType()));
1902     if (BTy.Verify() && (BTy.getEncoding() == dwarf::DW_ATE_signed ||
1903                          BTy.getEncoding() == dwarf::DW_ATE_signed_char)) {
1904       Streamer.EmitInt8(dwarf::DW_OP_consts, "DW_OP_consts");
1905       Streamer.EmitSLEB128(Value.getInt());
1906     } else {
1907       Streamer.EmitInt8(dwarf::DW_OP_constu, "DW_OP_constu");
1908       Streamer.EmitULEB128(Value.getInt());
1909     }
1910   } else if (Value.isLocation()) {
1911     MachineLocation Loc = Value.getLoc();
1912     if (!DV.hasComplexAddress())
1913       // Regular entry.
1914       Asm->EmitDwarfRegOp(Streamer, Loc, DV.isIndirect());
1915     else {
1916       // Complex address entry.
1917       unsigned N = DV.getNumAddrElements();
1918       unsigned i = 0;
1919       if (N >= 2 && DV.getAddrElement(0) == DIBuilder::OpPlus) {
1920         if (Loc.getOffset()) {
1921           i = 2;
1922           Asm->EmitDwarfRegOp(Streamer, Loc, DV.isIndirect());
1923           Streamer.EmitInt8(dwarf::DW_OP_deref, "DW_OP_deref");
1924           Streamer.EmitInt8(dwarf::DW_OP_plus_uconst, "DW_OP_plus_uconst");
1925           Streamer.EmitSLEB128(DV.getAddrElement(1));
1926         } else {
1927           // If first address element is OpPlus then emit
1928           // DW_OP_breg + Offset instead of DW_OP_reg + Offset.
1929           MachineLocation TLoc(Loc.getReg(), DV.getAddrElement(1));
1930           Asm->EmitDwarfRegOp(Streamer, TLoc, DV.isIndirect());
1931           i = 2;
1932         }
1933       } else {
1934         Asm->EmitDwarfRegOp(Streamer, Loc, DV.isIndirect());
1935       }
1936
1937       // Emit remaining complex address elements.
1938       for (; i < N; ++i) {
1939         uint64_t Element = DV.getAddrElement(i);
1940         if (Element == DIBuilder::OpPlus) {
1941           Streamer.EmitInt8(dwarf::DW_OP_plus_uconst, "DW_OP_plus_uconst");
1942           Streamer.EmitULEB128(DV.getAddrElement(++i));
1943         } else if (Element == DIBuilder::OpDeref) {
1944           if (!Loc.isReg())
1945             Streamer.EmitInt8(dwarf::DW_OP_deref, "DW_OP_deref");
1946         } else
1947           llvm_unreachable("unknown Opcode found in complex address");
1948       }
1949     }
1950   }
1951   // else ... ignore constant fp. There is not any good way to
1952   // to represent them here in dwarf.
1953   // FIXME: ^
1954 }
1955
1956 void DwarfDebug::emitDebugLocEntryLocation(const DebugLocEntry &Entry) {
1957   Asm->OutStreamer.AddComment("Loc expr size");
1958   MCSymbol *begin = Asm->OutStreamer.getContext().CreateTempSymbol();
1959   MCSymbol *end = Asm->OutStreamer.getContext().CreateTempSymbol();
1960   Asm->EmitLabelDifference(end, begin, 2);
1961   Asm->OutStreamer.EmitLabel(begin);
1962   // Emit the entry.
1963   APByteStreamer Streamer(*Asm);
1964   emitDebugLocEntry(Streamer, Entry);
1965   // Close the range.
1966   Asm->OutStreamer.EmitLabel(end);
1967 }
1968
1969 // Emit locations into the debug loc section.
1970 void DwarfDebug::emitDebugLoc() {
1971   // Start the dwarf loc section.
1972   Asm->OutStreamer.SwitchSection(
1973       Asm->getObjFileLowering().getDwarfLocSection());
1974   unsigned char Size = Asm->getDataLayout().getPointerSize();
1975   for (const auto &DebugLoc : DotDebugLocEntries) {
1976     Asm->OutStreamer.EmitLabel(DebugLoc.Label);
1977     for (const auto &Entry : DebugLoc.List) {
1978       // Set up the range. This range is relative to the entry point of the
1979       // compile unit. This is a hard coded 0 for low_pc when we're emitting
1980       // ranges, or the DW_AT_low_pc on the compile unit otherwise.
1981       const DwarfCompileUnit *CU = Entry.getCU();
1982       if (CU->getRanges().size() == 1) {
1983         // Grab the begin symbol from the first range as our base.
1984         const MCSymbol *Base = CU->getRanges()[0].getStart();
1985         Asm->EmitLabelDifference(Entry.getBeginSym(), Base, Size);
1986         Asm->EmitLabelDifference(Entry.getEndSym(), Base, Size);
1987       } else {
1988         Asm->OutStreamer.EmitSymbolValue(Entry.getBeginSym(), Size);
1989         Asm->OutStreamer.EmitSymbolValue(Entry.getEndSym(), Size);
1990       }
1991
1992       emitDebugLocEntryLocation(Entry);
1993     }
1994     Asm->OutStreamer.EmitIntValue(0, Size);
1995     Asm->OutStreamer.EmitIntValue(0, Size);
1996   }
1997 }
1998
1999 void DwarfDebug::emitDebugLocDWO() {
2000   Asm->OutStreamer.SwitchSection(
2001       Asm->getObjFileLowering().getDwarfLocDWOSection());
2002   for (const auto &DebugLoc : DotDebugLocEntries) {
2003     Asm->OutStreamer.EmitLabel(DebugLoc.Label);
2004     for (const auto &Entry : DebugLoc.List) {
2005       // Just always use start_length for now - at least that's one address
2006       // rather than two. We could get fancier and try to, say, reuse an
2007       // address we know we've emitted elsewhere (the start of the function?
2008       // The start of the CU or CU subrange that encloses this range?)
2009       Asm->EmitInt8(dwarf::DW_LLE_start_length_entry);
2010       unsigned idx = AddrPool.getIndex(Entry.getBeginSym());
2011       Asm->EmitULEB128(idx);
2012       Asm->EmitLabelDifference(Entry.getEndSym(), Entry.getBeginSym(), 4);
2013
2014       emitDebugLocEntryLocation(Entry);
2015     }
2016     Asm->EmitInt8(dwarf::DW_LLE_end_of_list_entry);
2017   }
2018 }
2019
2020 struct ArangeSpan {
2021   const MCSymbol *Start, *End;
2022 };
2023
2024 // Emit a debug aranges section, containing a CU lookup for any
2025 // address we can tie back to a CU.
2026 void DwarfDebug::emitDebugARanges() {
2027   // Start the dwarf aranges section.
2028   Asm->OutStreamer.SwitchSection(
2029       Asm->getObjFileLowering().getDwarfARangesSection());
2030
2031   typedef DenseMap<DwarfCompileUnit *, std::vector<ArangeSpan>> SpansType;
2032
2033   SpansType Spans;
2034
2035   // Build a list of sections used.
2036   std::vector<const MCSection *> Sections;
2037   for (const auto &it : SectionMap) {
2038     const MCSection *Section = it.first;
2039     Sections.push_back(Section);
2040   }
2041
2042   // Sort the sections into order.
2043   // This is only done to ensure consistent output order across different runs.
2044   std::sort(Sections.begin(), Sections.end(), SectionSort);
2045
2046   // Build a set of address spans, sorted by CU.
2047   for (const MCSection *Section : Sections) {
2048     SmallVector<SymbolCU, 8> &List = SectionMap[Section];
2049     if (List.size() < 2)
2050       continue;
2051
2052     // Sort the symbols by offset within the section.
2053     std::sort(List.begin(), List.end(),
2054               [&](const SymbolCU &A, const SymbolCU &B) {
2055       unsigned IA = A.Sym ? Asm->OutStreamer.GetSymbolOrder(A.Sym) : 0;
2056       unsigned IB = B.Sym ? Asm->OutStreamer.GetSymbolOrder(B.Sym) : 0;
2057
2058       // Symbols with no order assigned should be placed at the end.
2059       // (e.g. section end labels)
2060       if (IA == 0)
2061         return false;
2062       if (IB == 0)
2063         return true;
2064       return IA < IB;
2065     });
2066
2067     // If we have no section (e.g. common), just write out
2068     // individual spans for each symbol.
2069     if (!Section) {
2070       for (const SymbolCU &Cur : List) {
2071         ArangeSpan Span;
2072         Span.Start = Cur.Sym;
2073         Span.End = nullptr;
2074         if (Cur.CU)
2075           Spans[Cur.CU].push_back(Span);
2076       }
2077     } else {
2078       // Build spans between each label.
2079       const MCSymbol *StartSym = List[0].Sym;
2080       for (size_t n = 1, e = List.size(); n < e; n++) {
2081         const SymbolCU &Prev = List[n - 1];
2082         const SymbolCU &Cur = List[n];
2083
2084         // Try and build the longest span we can within the same CU.
2085         if (Cur.CU != Prev.CU) {
2086           ArangeSpan Span;
2087           Span.Start = StartSym;
2088           Span.End = Cur.Sym;
2089           Spans[Prev.CU].push_back(Span);
2090           StartSym = Cur.Sym;
2091         }
2092       }
2093     }
2094   }
2095
2096   unsigned PtrSize = Asm->getDataLayout().getPointerSize();
2097
2098   // Build a list of CUs used.
2099   std::vector<DwarfCompileUnit *> CUs;
2100   for (const auto &it : Spans) {
2101     DwarfCompileUnit *CU = it.first;
2102     CUs.push_back(CU);
2103   }
2104
2105   // Sort the CU list (again, to ensure consistent output order).
2106   std::sort(CUs.begin(), CUs.end(), [](const DwarfUnit *A, const DwarfUnit *B) {
2107     return A->getUniqueID() < B->getUniqueID();
2108   });
2109
2110   // Emit an arange table for each CU we used.
2111   for (DwarfCompileUnit *CU : CUs) {
2112     std::vector<ArangeSpan> &List = Spans[CU];
2113
2114     // Emit size of content not including length itself.
2115     unsigned ContentSize =
2116         sizeof(int16_t) + // DWARF ARange version number
2117         sizeof(int32_t) + // Offset of CU in the .debug_info section
2118         sizeof(int8_t) +  // Pointer Size (in bytes)
2119         sizeof(int8_t);   // Segment Size (in bytes)
2120
2121     unsigned TupleSize = PtrSize * 2;
2122
2123     // 7.20 in the Dwarf specs requires the table to be aligned to a tuple.
2124     unsigned Padding =
2125         OffsetToAlignment(sizeof(int32_t) + ContentSize, TupleSize);
2126
2127     ContentSize += Padding;
2128     ContentSize += (List.size() + 1) * TupleSize;
2129
2130     // For each compile unit, write the list of spans it covers.
2131     Asm->OutStreamer.AddComment("Length of ARange Set");
2132     Asm->EmitInt32(ContentSize);
2133     Asm->OutStreamer.AddComment("DWARF Arange version number");
2134     Asm->EmitInt16(dwarf::DW_ARANGES_VERSION);
2135     Asm->OutStreamer.AddComment("Offset Into Debug Info Section");
2136     Asm->EmitSectionOffset(CU->getLocalLabelBegin(), CU->getLocalSectionSym());
2137     Asm->OutStreamer.AddComment("Address Size (in bytes)");
2138     Asm->EmitInt8(PtrSize);
2139     Asm->OutStreamer.AddComment("Segment Size (in bytes)");
2140     Asm->EmitInt8(0);
2141
2142     Asm->OutStreamer.EmitFill(Padding, 0xff);
2143
2144     for (const ArangeSpan &Span : List) {
2145       Asm->EmitLabelReference(Span.Start, PtrSize);
2146
2147       // Calculate the size as being from the span start to it's end.
2148       if (Span.End) {
2149         Asm->EmitLabelDifference(Span.End, Span.Start, PtrSize);
2150       } else {
2151         // For symbols without an end marker (e.g. common), we
2152         // write a single arange entry containing just that one symbol.
2153         uint64_t Size = SymSize[Span.Start];
2154         if (Size == 0)
2155           Size = 1;
2156
2157         Asm->OutStreamer.EmitIntValue(Size, PtrSize);
2158       }
2159     }
2160
2161     Asm->OutStreamer.AddComment("ARange terminator");
2162     Asm->OutStreamer.EmitIntValue(0, PtrSize);
2163     Asm->OutStreamer.EmitIntValue(0, PtrSize);
2164   }
2165 }
2166
2167 // Emit visible names into a debug ranges section.
2168 void DwarfDebug::emitDebugRanges() {
2169   // Start the dwarf ranges section.
2170   Asm->OutStreamer.SwitchSection(
2171       Asm->getObjFileLowering().getDwarfRangesSection());
2172
2173   // Size for our labels.
2174   unsigned char Size = Asm->getDataLayout().getPointerSize();
2175
2176   // Grab the specific ranges for the compile units in the module.
2177   for (const auto &I : CUMap) {
2178     DwarfCompileUnit *TheCU = I.second;
2179
2180     // Iterate over the misc ranges for the compile units in the module.
2181     for (const RangeSpanList &List : TheCU->getRangeLists()) {
2182       // Emit our symbol so we can find the beginning of the range.
2183       Asm->OutStreamer.EmitLabel(List.getSym());
2184
2185       for (const RangeSpan &Range : List.getRanges()) {
2186         const MCSymbol *Begin = Range.getStart();
2187         const MCSymbol *End = Range.getEnd();
2188         assert(Begin && "Range without a begin symbol?");
2189         assert(End && "Range without an end symbol?");
2190         if (TheCU->getRanges().size() == 1) {
2191           // Grab the begin symbol from the first range as our base.
2192           const MCSymbol *Base = TheCU->getRanges()[0].getStart();
2193           Asm->EmitLabelDifference(Begin, Base, Size);
2194           Asm->EmitLabelDifference(End, Base, Size);
2195         } else {
2196           Asm->OutStreamer.EmitSymbolValue(Begin, Size);
2197           Asm->OutStreamer.EmitSymbolValue(End, Size);
2198         }
2199       }
2200
2201       // And terminate the list with two 0 values.
2202       Asm->OutStreamer.EmitIntValue(0, Size);
2203       Asm->OutStreamer.EmitIntValue(0, Size);
2204     }
2205
2206     // Now emit a range for the CU itself.
2207     if (TheCU->getRanges().size() > 1) {
2208       Asm->OutStreamer.EmitLabel(
2209           Asm->GetTempSymbol("cu_ranges", TheCU->getUniqueID()));
2210       for (const RangeSpan &Range : TheCU->getRanges()) {
2211         const MCSymbol *Begin = Range.getStart();
2212         const MCSymbol *End = Range.getEnd();
2213         assert(Begin && "Range without a begin symbol?");
2214         assert(End && "Range without an end symbol?");
2215         Asm->OutStreamer.EmitSymbolValue(Begin, Size);
2216         Asm->OutStreamer.EmitSymbolValue(End, Size);
2217       }
2218       // And terminate the list with two 0 values.
2219       Asm->OutStreamer.EmitIntValue(0, Size);
2220       Asm->OutStreamer.EmitIntValue(0, Size);
2221     }
2222   }
2223 }
2224
2225 // DWARF5 Experimental Separate Dwarf emitters.
2226
2227 void DwarfDebug::initSkeletonUnit(const DwarfUnit &U, DIE &Die,
2228                                   std::unique_ptr<DwarfUnit> NewU) {
2229   NewU->addLocalString(Die, dwarf::DW_AT_GNU_dwo_name,
2230                        U.getCUNode().getSplitDebugFilename());
2231
2232   if (!CompilationDir.empty())
2233     NewU->addLocalString(Die, dwarf::DW_AT_comp_dir, CompilationDir);
2234
2235   addGnuPubAttributes(*NewU, Die);
2236
2237   SkeletonHolder.addUnit(std::move(NewU));
2238 }
2239
2240 // This DIE has the following attributes: DW_AT_comp_dir, DW_AT_stmt_list,
2241 // DW_AT_low_pc, DW_AT_high_pc, DW_AT_ranges, DW_AT_dwo_name, DW_AT_dwo_id,
2242 // DW_AT_addr_base, DW_AT_ranges_base.
2243 DwarfCompileUnit &DwarfDebug::constructSkeletonCU(const DwarfCompileUnit &CU) {
2244
2245   auto OwnedUnit = make_unique<DwarfCompileUnit>(
2246       CU.getUniqueID(), CU.getCUNode(), Asm, this, &SkeletonHolder);
2247   DwarfCompileUnit &NewCU = *OwnedUnit;
2248   NewCU.initSection(Asm->getObjFileLowering().getDwarfInfoSection(),
2249                     DwarfInfoSectionSym);
2250
2251   NewCU.initStmtList(DwarfLineSectionSym);
2252
2253   initSkeletonUnit(CU, NewCU.getUnitDie(), std::move(OwnedUnit));
2254
2255   return NewCU;
2256 }
2257
2258 // This DIE has the following attributes: DW_AT_comp_dir, DW_AT_dwo_name,
2259 // DW_AT_addr_base.
2260 DwarfTypeUnit &DwarfDebug::constructSkeletonTU(DwarfTypeUnit &TU) {
2261   DwarfCompileUnit &CU = static_cast<DwarfCompileUnit &>(
2262       *SkeletonHolder.getUnits()[TU.getCU().getUniqueID()]);
2263
2264   auto OwnedUnit = make_unique<DwarfTypeUnit>(TU.getUniqueID(), CU, Asm, this,
2265                                               &SkeletonHolder);
2266   DwarfTypeUnit &NewTU = *OwnedUnit;
2267   NewTU.setTypeSignature(TU.getTypeSignature());
2268   NewTU.setType(nullptr);
2269   NewTU.initSection(
2270       Asm->getObjFileLowering().getDwarfTypesSection(TU.getTypeSignature()));
2271
2272   initSkeletonUnit(TU, NewTU.getUnitDie(), std::move(OwnedUnit));
2273   return NewTU;
2274 }
2275
2276 // Emit the .debug_info.dwo section for separated dwarf. This contains the
2277 // compile units that would normally be in debug_info.
2278 void DwarfDebug::emitDebugInfoDWO() {
2279   assert(useSplitDwarf() && "No split dwarf debug info?");
2280   // Don't pass an abbrev symbol, using a constant zero instead so as not to
2281   // emit relocations into the dwo file.
2282   InfoHolder.emitUnits(this, /* AbbrevSymbol */ nullptr);
2283 }
2284
2285 // Emit the .debug_abbrev.dwo section for separated dwarf. This contains the
2286 // abbreviations for the .debug_info.dwo section.
2287 void DwarfDebug::emitDebugAbbrevDWO() {
2288   assert(useSplitDwarf() && "No split dwarf?");
2289   InfoHolder.emitAbbrevs(Asm->getObjFileLowering().getDwarfAbbrevDWOSection());
2290 }
2291
2292 void DwarfDebug::emitDebugLineDWO() {
2293   assert(useSplitDwarf() && "No split dwarf?");
2294   Asm->OutStreamer.SwitchSection(
2295       Asm->getObjFileLowering().getDwarfLineDWOSection());
2296   SplitTypeUnitFileTable.Emit(Asm->OutStreamer);
2297 }
2298
2299 // Emit the .debug_str.dwo section for separated dwarf. This contains the
2300 // string section and is identical in format to traditional .debug_str
2301 // sections.
2302 void DwarfDebug::emitDebugStrDWO() {
2303   assert(useSplitDwarf() && "No split dwarf?");
2304   const MCSection *OffSec =
2305       Asm->getObjFileLowering().getDwarfStrOffDWOSection();
2306   const MCSymbol *StrSym = DwarfStrSectionSym;
2307   InfoHolder.emitStrings(Asm->getObjFileLowering().getDwarfStrDWOSection(),
2308                          OffSec, StrSym);
2309 }
2310
2311 MCDwarfDwoLineTable *DwarfDebug::getDwoLineTable(const DwarfCompileUnit &CU) {
2312   if (!useSplitDwarf())
2313     return nullptr;
2314   if (SingleCU)
2315     SplitTypeUnitFileTable.setCompilationDir(CU.getCUNode().getDirectory());
2316   return &SplitTypeUnitFileTable;
2317 }
2318
2319 static uint64_t makeTypeSignature(StringRef Identifier) {
2320   MD5 Hash;
2321   Hash.update(Identifier);
2322   // ... take the least significant 8 bytes and return those. Our MD5
2323   // implementation always returns its results in little endian, swap bytes
2324   // appropriately.
2325   MD5::MD5Result Result;
2326   Hash.final(Result);
2327   return *reinterpret_cast<support::ulittle64_t *>(Result + 8);
2328 }
2329
2330 void DwarfDebug::addDwarfTypeUnitType(DwarfCompileUnit &CU,
2331                                       StringRef Identifier, DIE &RefDie,
2332                                       DICompositeType CTy) {
2333   // Fast path if we're building some type units and one has already used the
2334   // address pool we know we're going to throw away all this work anyway, so
2335   // don't bother building dependent types.
2336   if (!TypeUnitsUnderConstruction.empty() && AddrPool.hasBeenUsed())
2337     return;
2338
2339   const DwarfTypeUnit *&TU = DwarfTypeUnits[CTy];
2340   if (TU) {
2341     CU.addDIETypeSignature(RefDie, *TU);
2342     return;
2343   }
2344
2345   bool TopLevelType = TypeUnitsUnderConstruction.empty();
2346   AddrPool.resetUsedFlag();
2347
2348   auto OwnedUnit =
2349       make_unique<DwarfTypeUnit>(InfoHolder.getUnits().size(), CU, Asm, this,
2350                                  &InfoHolder, getDwoLineTable(CU));
2351   DwarfTypeUnit &NewTU = *OwnedUnit;
2352   DIE &UnitDie = NewTU.getUnitDie();
2353   TU = &NewTU;
2354   TypeUnitsUnderConstruction.push_back(
2355       std::make_pair(std::move(OwnedUnit), CTy));
2356
2357   NewTU.addUInt(UnitDie, dwarf::DW_AT_language, dwarf::DW_FORM_data2,
2358                 CU.getLanguage());
2359
2360   uint64_t Signature = makeTypeSignature(Identifier);
2361   NewTU.setTypeSignature(Signature);
2362
2363   if (!useSplitDwarf())
2364     CU.applyStmtList(UnitDie);
2365
2366   // FIXME: Skip using COMDAT groups for type units in the .dwo file once tools
2367   // such as DWP ( http://gcc.gnu.org/wiki/DebugFissionDWP ) can cope with it.
2368   NewTU.initSection(
2369       useSplitDwarf()
2370           ? Asm->getObjFileLowering().getDwarfTypesDWOSection(Signature)
2371           : Asm->getObjFileLowering().getDwarfTypesSection(Signature));
2372
2373   NewTU.setType(NewTU.createTypeDIE(CTy));
2374
2375   if (TopLevelType) {
2376     auto TypeUnitsToAdd = std::move(TypeUnitsUnderConstruction);
2377     TypeUnitsUnderConstruction.clear();
2378
2379     // Types referencing entries in the address table cannot be placed in type
2380     // units.
2381     if (AddrPool.hasBeenUsed()) {
2382
2383       // Remove all the types built while building this type.
2384       // This is pessimistic as some of these types might not be dependent on
2385       // the type that used an address.
2386       for (const auto &TU : TypeUnitsToAdd)
2387         DwarfTypeUnits.erase(TU.second);
2388
2389       // Construct this type in the CU directly.
2390       // This is inefficient because all the dependent types will be rebuilt
2391       // from scratch, including building them in type units, discovering that
2392       // they depend on addresses, throwing them out and rebuilding them.
2393       CU.constructTypeDIE(RefDie, CTy);
2394       return;
2395     }
2396
2397     // If the type wasn't dependent on fission addresses, finish adding the type
2398     // and all its dependent types.
2399     for (auto &TU : TypeUnitsToAdd) {
2400       if (useSplitDwarf())
2401         TU.first->setSkeleton(constructSkeletonTU(*TU.first));
2402       InfoHolder.addUnit(std::move(TU.first));
2403     }
2404   }
2405   CU.addDIETypeSignature(RefDie, NewTU);
2406 }
2407
2408 void DwarfDebug::attachLowHighPC(DwarfCompileUnit &Unit, DIE &D,
2409                                  MCSymbol *Begin, MCSymbol *End) {
2410   assert(Begin && "Begin label should not be null!");
2411   assert(End && "End label should not be null!");
2412   assert(Begin->isDefined() && "Invalid starting label");
2413   assert(End->isDefined() && "Invalid end label");
2414
2415   Unit.addLabelAddress(D, dwarf::DW_AT_low_pc, Begin);
2416   if (DwarfVersion < 4)
2417     Unit.addLabelAddress(D, dwarf::DW_AT_high_pc, End);
2418   else
2419     Unit.addLabelDelta(D, dwarf::DW_AT_high_pc, End, Begin);
2420 }
2421
2422 // Accelerator table mutators - add each name along with its companion
2423 // DIE to the proper table while ensuring that the name that we're going
2424 // to reference is in the string table. We do this since the names we
2425 // add may not only be identical to the names in the DIE.
2426 void DwarfDebug::addAccelName(StringRef Name, const DIE &Die) {
2427   if (!useDwarfAccelTables())
2428     return;
2429   AccelNames.AddName(Name, InfoHolder.getStringPool().getSymbol(*Asm, Name),
2430                      &Die);
2431 }
2432
2433 void DwarfDebug::addAccelObjC(StringRef Name, const DIE &Die) {
2434   if (!useDwarfAccelTables())
2435     return;
2436   AccelObjC.AddName(Name, InfoHolder.getStringPool().getSymbol(*Asm, Name),
2437                     &Die);
2438 }
2439
2440 void DwarfDebug::addAccelNamespace(StringRef Name, const DIE &Die) {
2441   if (!useDwarfAccelTables())
2442     return;
2443   AccelNamespace.AddName(Name, InfoHolder.getStringPool().getSymbol(*Asm, Name),
2444                          &Die);
2445 }
2446
2447 void DwarfDebug::addAccelType(StringRef Name, const DIE &Die, char Flags) {
2448   if (!useDwarfAccelTables())
2449     return;
2450   AccelTypes.AddName(Name, InfoHolder.getStringPool().getSymbol(*Asm, Name),
2451                      &Die);
2452 }