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