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