Add an option to control this heuristic tweak so I can test it.
[oota-llvm.git] / lib / CodeGen / SimpleRegisterCoalescing.cpp
1 //===-- SimpleRegisterCoalescing.cpp - Register Coalescing ----------------===//
2 //
3 //                     The LLVM Compiler Infrastructure
4 //
5 // This file was developed by the LLVM research group and is distributed under
6 // the University of Illinois Open Source License. See LICENSE.TXT for details.
7 //
8 //===----------------------------------------------------------------------===//
9 //
10 // This file implements a simple register coalescing pass that attempts to
11 // aggressively coalesce every register copy that it can.
12 //
13 //===----------------------------------------------------------------------===//
14
15 #define DEBUG_TYPE "regcoalescing"
16 #include "SimpleRegisterCoalescing.h"
17 #include "VirtRegMap.h"
18 #include "llvm/CodeGen/LiveIntervalAnalysis.h"
19 #include "llvm/Value.h"
20 #include "llvm/Analysis/LoopInfo.h"
21 #include "llvm/CodeGen/LiveVariables.h"
22 #include "llvm/CodeGen/MachineFrameInfo.h"
23 #include "llvm/CodeGen/MachineInstr.h"
24 #include "llvm/CodeGen/Passes.h"
25 #include "llvm/CodeGen/SSARegMap.h"
26 #include "llvm/CodeGen/RegisterCoalescer.h"
27 #include "llvm/Target/MRegisterInfo.h"
28 #include "llvm/Target/TargetInstrInfo.h"
29 #include "llvm/Target/TargetMachine.h"
30 #include "llvm/Support/CommandLine.h"
31 #include "llvm/Support/Debug.h"
32 #include "llvm/ADT/SmallSet.h"
33 #include "llvm/ADT/Statistic.h"
34 #include "llvm/ADT/STLExtras.h"
35 #include <algorithm>
36 #include <cmath>
37 using namespace llvm;
38
39 STATISTIC(numJoins    , "Number of interval joins performed");
40 STATISTIC(numPeep     , "Number of identity moves eliminated after coalescing");
41 STATISTIC(numAborts   , "Number of times interval joining aborted");
42
43 char SimpleRegisterCoalescing::ID = 0;
44 namespace {
45   static cl::opt<bool>
46   EnableJoining("join-liveintervals",
47                 cl::desc("Coalesce copies (default=true)"),
48                 cl::init(true));
49
50   static cl::opt<bool>
51   NewHeuristic("new-coalescer-heuristic",
52                 cl::desc("Use new coalescer heuristic"),
53                 cl::init(false));
54
55   static cl::opt<bool>
56   ReMatSpillWeight("tweak-remat-spill-weight",
57                    cl::desc("Tweak spill weight of re-materializable intervals"),
58                    cl::init(true));
59
60   RegisterPass<SimpleRegisterCoalescing> 
61   X("simple-register-coalescing", "Simple Register Coalescing");
62
63   // Declare that we implement the RegisterCoalescer interface
64   RegisterAnalysisGroup<RegisterCoalescer, true/*The Default*/> V(X);
65 }
66
67 const PassInfo *llvm::SimpleRegisterCoalescingID = X.getPassInfo();
68
69 void SimpleRegisterCoalescing::getAnalysisUsage(AnalysisUsage &AU) const {
70   AU.addPreserved<LiveIntervals>();
71   AU.addPreservedID(PHIEliminationID);
72   AU.addPreservedID(TwoAddressInstructionPassID);
73   AU.addRequired<LiveVariables>();
74   AU.addRequired<LiveIntervals>();
75   AU.addRequired<LoopInfo>();
76   MachineFunctionPass::getAnalysisUsage(AU);
77 }
78
79 /// AdjustCopiesBackFrom - We found a non-trivially-coalescable copy with IntA
80 /// being the source and IntB being the dest, thus this defines a value number
81 /// in IntB.  If the source value number (in IntA) is defined by a copy from B,
82 /// see if we can merge these two pieces of B into a single value number,
83 /// eliminating a copy.  For example:
84 ///
85 ///  A3 = B0
86 ///    ...
87 ///  B1 = A3      <- this copy
88 ///
89 /// In this case, B0 can be extended to where the B1 copy lives, allowing the B1
90 /// value number to be replaced with B0 (which simplifies the B liveinterval).
91 ///
92 /// This returns true if an interval was modified.
93 ///
94 bool SimpleRegisterCoalescing::AdjustCopiesBackFrom(LiveInterval &IntA, LiveInterval &IntB,
95                                          MachineInstr *CopyMI) {
96   unsigned CopyIdx = li_->getDefIndex(li_->getInstructionIndex(CopyMI));
97
98   // BValNo is a value number in B that is defined by a copy from A.  'B3' in
99   // the example above.
100   LiveInterval::iterator BLR = IntB.FindLiveRangeContaining(CopyIdx);
101   VNInfo *BValNo = BLR->valno;
102   
103   // Get the location that B is defined at.  Two options: either this value has
104   // an unknown definition point or it is defined at CopyIdx.  If unknown, we 
105   // can't process it.
106   if (!BValNo->reg) return false;
107   assert(BValNo->def == CopyIdx &&
108          "Copy doesn't define the value?");
109   
110   // AValNo is the value number in A that defines the copy, A0 in the example.
111   LiveInterval::iterator AValLR = IntA.FindLiveRangeContaining(CopyIdx-1);
112   VNInfo *AValNo = AValLR->valno;
113   
114   // If AValNo is defined as a copy from IntB, we can potentially process this.
115   
116   // Get the instruction that defines this value number.
117   unsigned SrcReg = AValNo->reg;
118   if (!SrcReg) return false;  // Not defined by a copy.
119     
120   // If the value number is not defined by a copy instruction, ignore it.
121     
122   // If the source register comes from an interval other than IntB, we can't
123   // handle this.
124   if (rep(SrcReg) != IntB.reg) return false;
125   
126   // Get the LiveRange in IntB that this value number starts with.
127   LiveInterval::iterator ValLR = IntB.FindLiveRangeContaining(AValNo->def-1);
128   
129   // Make sure that the end of the live range is inside the same block as
130   // CopyMI.
131   MachineInstr *ValLREndInst = li_->getInstructionFromIndex(ValLR->end-1);
132   if (!ValLREndInst || 
133       ValLREndInst->getParent() != CopyMI->getParent()) return false;
134
135   // Okay, we now know that ValLR ends in the same block that the CopyMI
136   // live-range starts.  If there are no intervening live ranges between them in
137   // IntB, we can merge them.
138   if (ValLR+1 != BLR) return false;
139
140   // If a live interval is a physical register, conservatively check if any
141   // of its sub-registers is overlapping the live interval of the virtual
142   // register. If so, do not coalesce.
143   if (MRegisterInfo::isPhysicalRegister(IntB.reg) &&
144       *mri_->getSubRegisters(IntB.reg)) {
145     for (const unsigned* SR = mri_->getSubRegisters(IntB.reg); *SR; ++SR)
146       if (li_->hasInterval(*SR) && IntA.overlaps(li_->getInterval(*SR))) {
147         DOUT << "Interfere with sub-register ";
148         DEBUG(li_->getInterval(*SR).print(DOUT, mri_));
149         return false;
150       }
151   }
152   
153   DOUT << "\nExtending: "; IntB.print(DOUT, mri_);
154   
155   unsigned FillerStart = ValLR->end, FillerEnd = BLR->start;
156   // We are about to delete CopyMI, so need to remove it as the 'instruction
157   // that defines this value #'. Update the the valnum with the new defining
158   // instruction #.
159   BValNo->def = FillerStart;
160   BValNo->reg = 0;
161   
162   // Okay, we can merge them.  We need to insert a new liverange:
163   // [ValLR.end, BLR.begin) of either value number, then we merge the
164   // two value numbers.
165   IntB.addRange(LiveRange(FillerStart, FillerEnd, BValNo));
166
167   // If the IntB live range is assigned to a physical register, and if that
168   // physreg has aliases, 
169   if (MRegisterInfo::isPhysicalRegister(IntB.reg)) {
170     // Update the liveintervals of sub-registers.
171     for (const unsigned *AS = mri_->getSubRegisters(IntB.reg); *AS; ++AS) {
172       LiveInterval &AliasLI = li_->getInterval(*AS);
173       AliasLI.addRange(LiveRange(FillerStart, FillerEnd,
174               AliasLI.getNextValue(FillerStart, 0, li_->getVNInfoAllocator())));
175     }
176   }
177
178   // Okay, merge "B1" into the same value number as "B0".
179   if (BValNo != ValLR->valno)
180     IntB.MergeValueNumberInto(BValNo, ValLR->valno);
181   DOUT << "   result = "; IntB.print(DOUT, mri_);
182   DOUT << "\n";
183
184   // If the source instruction was killing the source register before the
185   // merge, unset the isKill marker given the live range has been extended.
186   int UIdx = ValLREndInst->findRegisterUseOperandIdx(IntB.reg, true);
187   if (UIdx != -1)
188     ValLREndInst->getOperand(UIdx).unsetIsKill();
189   
190   ++numPeep;
191   return true;
192 }
193
194 /// AddSubRegIdxPairs - Recursively mark all the registers represented by the
195 /// specified register as sub-registers. The recursion level is expected to be
196 /// shallow.
197 void SimpleRegisterCoalescing::AddSubRegIdxPairs(unsigned Reg, unsigned SubIdx) {
198   std::vector<unsigned> &JoinedRegs = r2rRevMap_[Reg];
199   for (unsigned i = 0, e = JoinedRegs.size(); i != e; ++i) {
200     SubRegIdxes.push_back(std::make_pair(JoinedRegs[i], SubIdx));
201     AddSubRegIdxPairs(JoinedRegs[i], SubIdx);
202   }
203 }
204
205 /// isBackEdgeCopy - Returns true if CopyMI is a back edge copy.
206 ///
207 bool SimpleRegisterCoalescing::isBackEdgeCopy(MachineInstr *CopyMI,
208                                               unsigned DstReg) {
209   MachineBasicBlock *MBB = CopyMI->getParent();
210   const BasicBlock *BB = MBB->getBasicBlock();
211   const Loop *L = loopInfo->getLoopFor(BB);
212   if (!L)
213     return false;
214   if (BB != L->getLoopLatch())
215     return false;
216
217   DstReg = rep(DstReg);
218   LiveInterval &LI = li_->getInterval(DstReg);
219   unsigned DefIdx = li_->getInstructionIndex(CopyMI);
220   LiveInterval::const_iterator DstLR =
221     LI.FindLiveRangeContaining(li_->getDefIndex(DefIdx));
222   if (DstLR == LI.end())
223     return false;
224   unsigned KillIdx = li_->getInstructionIndex(&MBB->back()) + InstrSlots::NUM-1;
225   if (DstLR->valno->kills.size() == 1 && DstLR->valno->kills[0] == KillIdx)
226     return true;
227   return false;
228 }
229
230 /// JoinCopy - Attempt to join intervals corresponding to SrcReg/DstReg,
231 /// which are the src/dst of the copy instruction CopyMI.  This returns true
232 /// if the copy was successfully coalesced away. If it is not currently
233 /// possible to coalesce this interval, but it may be possible if other
234 /// things get coalesced, then it returns true by reference in 'Again'.
235 bool SimpleRegisterCoalescing::JoinCopy(CopyRec TheCopy, bool &Again) {
236   MachineInstr *CopyMI = TheCopy.MI;
237
238   Again = false;
239   if (JoinedCopies.count(CopyMI))
240     return false; // Already done.
241
242   DOUT << li_->getInstructionIndex(CopyMI) << '\t' << *CopyMI;
243
244   // Get representative registers.
245   unsigned SrcReg = TheCopy.SrcReg;
246   unsigned DstReg = TheCopy.DstReg;
247   unsigned repSrcReg = rep(SrcReg);
248   unsigned repDstReg = rep(DstReg);
249   
250   // If they are already joined we continue.
251   if (repSrcReg == repDstReg) {
252     DOUT << "\tCopy already coalesced.\n";
253     return false;  // Not coalescable.
254   }
255   
256   bool SrcIsPhys = MRegisterInfo::isPhysicalRegister(repSrcReg);
257   bool DstIsPhys = MRegisterInfo::isPhysicalRegister(repDstReg);
258
259   // If they are both physical registers, we cannot join them.
260   if (SrcIsPhys && DstIsPhys) {
261     DOUT << "\tCan not coalesce physregs.\n";
262     return false;  // Not coalescable.
263   }
264   
265   // We only join virtual registers with allocatable physical registers.
266   if (SrcIsPhys && !allocatableRegs_[repSrcReg]) {
267     DOUT << "\tSrc reg is unallocatable physreg.\n";
268     return false;  // Not coalescable.
269   }
270   if (DstIsPhys && !allocatableRegs_[repDstReg]) {
271     DOUT << "\tDst reg is unallocatable physreg.\n";
272     return false;  // Not coalescable.
273   }
274
275   bool isExtSubReg = CopyMI->getOpcode() == TargetInstrInfo::EXTRACT_SUBREG;
276   unsigned RealDstReg = 0;
277   if (isExtSubReg) {
278     unsigned SubIdx = CopyMI->getOperand(2).getImm();
279     if (SrcIsPhys)
280       // r1024 = EXTRACT_SUBREG EAX, 0 then r1024 is really going to be
281       // coalesced with AX.
282       repSrcReg = mri_->getSubReg(repSrcReg, SubIdx);
283     else if (DstIsPhys) {
284       // If this is a extract_subreg where dst is a physical register, e.g.
285       // cl = EXTRACT_SUBREG reg1024, 1
286       // then create and update the actual physical register allocated to RHS.
287       const TargetRegisterClass *RC=mf_->getSSARegMap()->getRegClass(repSrcReg);
288       for (const unsigned *SRs = mri_->getSuperRegisters(repDstReg);
289            unsigned SR = *SRs; ++SRs) {
290         if (repDstReg == mri_->getSubReg(SR, SubIdx) &&
291             RC->contains(SR)) {
292           RealDstReg = SR;
293           break;
294         }
295       }
296       assert(RealDstReg && "Invalid extra_subreg instruction!");
297
298       // For this type of EXTRACT_SUBREG, conservatively
299       // check if the live interval of the source register interfere with the
300       // actual super physical register we are trying to coalesce with.
301       LiveInterval &RHS = li_->getInterval(repSrcReg);
302       if (li_->hasInterval(RealDstReg) &&
303           RHS.overlaps(li_->getInterval(RealDstReg))) {
304         DOUT << "Interfere with register ";
305         DEBUG(li_->getInterval(RealDstReg).print(DOUT, mri_));
306         return false; // Not coalescable
307       }
308       for (const unsigned* SR = mri_->getSubRegisters(RealDstReg); *SR; ++SR)
309         if (li_->hasInterval(*SR) && RHS.overlaps(li_->getInterval(*SR))) {
310           DOUT << "Interfere with sub-register ";
311           DEBUG(li_->getInterval(*SR).print(DOUT, mri_));
312           return false; // Not coalescable
313         }
314     } else {
315       unsigned SrcSize= li_->getInterval(repSrcReg).getSize() / InstrSlots::NUM;
316       unsigned DstSize= li_->getInterval(repDstReg).getSize() / InstrSlots::NUM;
317       const TargetRegisterClass *RC=mf_->getSSARegMap()->getRegClass(repDstReg);
318       unsigned Threshold = allocatableRCRegs_[RC].count();
319       // Be conservative. If both sides are virtual registers, do not coalesce
320       // if this will cause a high use density interval to target a smaller set
321       // of registers.
322       if (DstSize > Threshold || SrcSize > Threshold) {
323         LiveVariables::VarInfo &svi = lv_->getVarInfo(repSrcReg);
324         LiveVariables::VarInfo &dvi = lv_->getVarInfo(repDstReg);
325         if ((float)dvi.NumUses / DstSize < (float)svi.NumUses / SrcSize) {
326           Again = true;  // May be possible to coalesce later.
327           return false;
328         }
329       }
330     }
331   } else if (differingRegisterClasses(repSrcReg, repDstReg)) {
332     // If they are not of the same register class, we cannot join them.
333     DOUT << "\tSrc/Dest are different register classes.\n";
334     // Allow the coalescer to try again in case either side gets coalesced to
335     // a physical register that's compatible with the other side. e.g.
336     // r1024 = MOV32to32_ r1025
337     // but later r1024 is assigned EAX then r1025 may be coalesced with EAX.
338     Again = true;  // May be possible to coalesce later.
339     return false;
340   }
341   
342   LiveInterval &SrcInt = li_->getInterval(repSrcReg);
343   LiveInterval &DstInt = li_->getInterval(repDstReg);
344   assert(SrcInt.reg == repSrcReg && DstInt.reg == repDstReg &&
345          "Register mapping is horribly broken!");
346
347   DOUT << "\t\tInspecting "; SrcInt.print(DOUT, mri_);
348   DOUT << " and "; DstInt.print(DOUT, mri_);
349   DOUT << ": ";
350
351   // Check if it is necessary to propagate "isDead" property before intervals
352   // are joined.
353   MachineOperand *mopd = CopyMI->findRegisterDefOperand(DstReg);
354   bool isDead = mopd->isDead();
355   bool isShorten = false;
356   unsigned SrcStart = 0, RemoveStart = 0;
357   unsigned SrcEnd = 0, RemoveEnd = 0;
358   if (isDead) {
359     unsigned CopyIdx = li_->getInstructionIndex(CopyMI);
360     LiveInterval::iterator SrcLR =
361       SrcInt.FindLiveRangeContaining(li_->getUseIndex(CopyIdx));
362     RemoveStart = SrcStart = SrcLR->start;
363     RemoveEnd   = SrcEnd   = SrcLR->end;
364     // The instruction which defines the src is only truly dead if there are
365     // no intermediate uses and there isn't a use beyond the copy.
366     // FIXME: find the last use, mark is kill and shorten the live range.
367     if (SrcEnd > li_->getDefIndex(CopyIdx)) {
368       isDead = false;
369     } else {
370       MachineOperand *MOU;
371       MachineInstr *LastUse= lastRegisterUse(SrcStart, CopyIdx, repSrcReg, MOU);
372       if (LastUse) {
373         // Shorten the liveinterval to the end of last use.
374         MOU->setIsKill();
375         isDead = false;
376         isShorten = true;
377         RemoveStart = li_->getDefIndex(li_->getInstructionIndex(LastUse));
378         RemoveEnd   = SrcEnd;
379       } else {
380         MachineInstr *SrcMI = li_->getInstructionFromIndex(SrcStart);
381         if (SrcMI) {
382           MachineOperand *mops = findDefOperand(SrcMI, repSrcReg);
383           if (mops)
384             // A dead def should have a single cycle interval.
385             ++RemoveStart;
386         }
387       }
388     }
389   }
390
391   // We need to be careful about coalescing a source physical register with a
392   // virtual register. Once the coalescing is done, it cannot be broken and
393   // these are not spillable! If the destination interval uses are far away,
394   // think twice about coalescing them!
395   if (!mopd->isDead() && (SrcIsPhys || DstIsPhys) && !isExtSubReg) {
396     LiveInterval &JoinVInt = SrcIsPhys ? DstInt : SrcInt;
397     unsigned JoinVReg = SrcIsPhys ? repDstReg : repSrcReg;
398     unsigned JoinPReg = SrcIsPhys ? repSrcReg : repDstReg;
399     const TargetRegisterClass *RC = mf_->getSSARegMap()->getRegClass(JoinVReg);
400     unsigned Threshold = allocatableRCRegs_[RC].count();
401     if (TheCopy.isBackEdge)
402       Threshold *= 2; // Favors back edge copies.
403
404     // If the virtual register live interval is long but it has low use desity,
405     // do not join them, instead mark the physical register as its allocation
406     // preference.
407     unsigned Length = JoinVInt.getSize() / InstrSlots::NUM;
408     LiveVariables::VarInfo &vi = lv_->getVarInfo(JoinVReg);
409     if (Length > Threshold &&
410         (((float)vi.NumUses / Length) < (1.0 / Threshold))) {
411       JoinVInt.preference = JoinPReg;
412       ++numAborts;
413       DOUT << "\tMay tie down a physical register, abort!\n";
414       Again = true;  // May be possible to coalesce later.
415       return false;
416     }
417   }
418
419   // Okay, attempt to join these two intervals.  On failure, this returns false.
420   // Otherwise, if one of the intervals being joined is a physreg, this method
421   // always canonicalizes DstInt to be it.  The output "SrcInt" will not have
422   // been modified, so we can use this information below to update aliases.
423   bool Swapped = false;
424   if (JoinIntervals(DstInt, SrcInt, Swapped)) {
425     if (isDead) {
426       // Result of the copy is dead. Propagate this property.
427       if (SrcStart == 0) {
428         assert(MRegisterInfo::isPhysicalRegister(repSrcReg) &&
429                "Live-in must be a physical register!");
430         // Live-in to the function but dead. Remove it from entry live-in set.
431         // JoinIntervals may end up swapping the two intervals.
432         mf_->begin()->removeLiveIn(repSrcReg);
433       } else {
434         MachineInstr *SrcMI = li_->getInstructionFromIndex(SrcStart);
435         if (SrcMI) {
436           MachineOperand *mops = findDefOperand(SrcMI, repSrcReg);
437           if (mops)
438             mops->setIsDead();
439         }
440       }
441     }
442
443     if (isShorten || isDead) {
444       // Shorten the destination live interval.
445       if (Swapped)
446         SrcInt.removeRange(RemoveStart, RemoveEnd);
447     }
448   } else {
449     // Coalescing failed.
450     
451     // If we can eliminate the copy without merging the live ranges, do so now.
452     if (!isExtSubReg && AdjustCopiesBackFrom(SrcInt, DstInt, CopyMI)) {
453       JoinedCopies.insert(CopyMI);
454       return true;
455     }
456
457     // Otherwise, we are unable to join the intervals.
458     DOUT << "Interference!\n";
459     Again = true;  // May be possible to coalesce later.
460     return false;
461   }
462
463   LiveInterval *ResSrcInt = &SrcInt;
464   LiveInterval *ResDstInt = &DstInt;
465   if (Swapped) {
466     std::swap(repSrcReg, repDstReg);
467     std::swap(ResSrcInt, ResDstInt);
468   }
469   assert(MRegisterInfo::isVirtualRegister(repSrcReg) &&
470          "LiveInterval::join didn't work right!");
471                                
472   // If we're about to merge live ranges into a physical register live range,
473   // we have to update any aliased register's live ranges to indicate that they
474   // have clobbered values for this range.
475   if (MRegisterInfo::isPhysicalRegister(repDstReg)) {
476     // Unset unnecessary kills.
477     if (!ResDstInt->containsOneValue()) {
478       for (LiveInterval::Ranges::const_iterator I = ResSrcInt->begin(),
479              E = ResSrcInt->end(); I != E; ++I)
480         unsetRegisterKills(I->start, I->end, repDstReg);
481     }
482
483     // If this is a extract_subreg where dst is a physical register, e.g.
484     // cl = EXTRACT_SUBREG reg1024, 1
485     // then create and update the actual physical register allocated to RHS.
486     if (RealDstReg) {
487       LiveInterval &RealDstInt = li_->getOrCreateInterval(RealDstReg);
488       SmallSet<const VNInfo*, 4> CopiedValNos;
489       for (LiveInterval::Ranges::const_iterator I = ResSrcInt->ranges.begin(),
490              E = ResSrcInt->ranges.end(); I != E; ++I) {
491         LiveInterval::const_iterator DstLR =
492           ResDstInt->FindLiveRangeContaining(I->start);
493         assert(DstLR != ResDstInt->end() && "Invalid joined interval!");
494         const VNInfo *DstValNo = DstLR->valno;
495         if (CopiedValNos.insert(DstValNo)) {
496           VNInfo *ValNo = RealDstInt.getNextValue(DstValNo->def, DstValNo->reg,
497                                                   li_->getVNInfoAllocator());
498           ValNo->hasPHIKill = DstValNo->hasPHIKill;
499           RealDstInt.addKills(ValNo, DstValNo->kills);
500           RealDstInt.MergeValueInAsValue(*ResDstInt, DstValNo, ValNo);
501         }
502       }
503       repDstReg = RealDstReg;
504     }
505
506     // Update the liveintervals of sub-registers.
507     for (const unsigned *AS = mri_->getSubRegisters(repDstReg); *AS; ++AS)
508       li_->getOrCreateInterval(*AS).MergeInClobberRanges(*ResSrcInt,
509                                                  li_->getVNInfoAllocator());
510   } else {
511     // Merge use info if the destination is a virtual register.
512     LiveVariables::VarInfo& dVI = lv_->getVarInfo(repDstReg);
513     LiveVariables::VarInfo& sVI = lv_->getVarInfo(repSrcReg);
514     dVI.NumUses += sVI.NumUses;
515   }
516
517   // Remember these liveintervals have been joined.
518   JoinedLIs.set(repSrcReg - MRegisterInfo::FirstVirtualRegister);
519   if (MRegisterInfo::isVirtualRegister(repDstReg))
520     JoinedLIs.set(repDstReg - MRegisterInfo::FirstVirtualRegister);
521
522   if (isExtSubReg && !SrcIsPhys && !DstIsPhys) {
523     if (!Swapped) {
524       // Make sure we allocate the larger super-register.
525       ResSrcInt->Copy(*ResDstInt, li_->getVNInfoAllocator());
526       std::swap(repSrcReg, repDstReg);
527       std::swap(ResSrcInt, ResDstInt);
528     }
529     unsigned SubIdx = CopyMI->getOperand(2).getImm();
530     SubRegIdxes.push_back(std::make_pair(repSrcReg, SubIdx));
531     AddSubRegIdxPairs(repSrcReg, SubIdx);
532   }
533
534   if (NewHeuristic) {
535     for (LiveInterval::const_vni_iterator i = ResSrcInt->vni_begin(),
536            e = ResSrcInt->vni_end(); i != e; ++i) {
537       const VNInfo *vni = *i;
538       if (vni->def && vni->def != ~1U && vni->def != ~0U) {
539         MachineInstr *CopyMI = li_->getInstructionFromIndex(vni->def);
540         unsigned SrcReg, DstReg;
541         if (CopyMI && tii_->isMoveInstr(*CopyMI, SrcReg, DstReg) &&
542             JoinedCopies.count(CopyMI) == 0) {
543           unsigned LoopDepth =
544             loopInfo->getLoopDepth(CopyMI->getParent()->getBasicBlock());
545           JoinQueue->push(CopyRec(CopyMI, SrcReg, DstReg, LoopDepth,
546                                   isBackEdgeCopy(CopyMI, DstReg)));
547         }
548       }
549     }
550   }
551
552   DOUT << "\n\t\tJoined.  Result = "; ResDstInt->print(DOUT, mri_);
553   DOUT << "\n";
554
555   // repSrcReg is guarateed to be the register whose live interval that is
556   // being merged.
557   li_->removeInterval(repSrcReg);
558   r2rMap_[repSrcReg] = repDstReg;
559   r2rRevMap_[repDstReg].push_back(repSrcReg);
560
561   // Finally, delete the copy instruction.
562   JoinedCopies.insert(CopyMI);
563   ++numPeep;
564   ++numJoins;
565   return true;
566 }
567
568 /// ComputeUltimateVN - Assuming we are going to join two live intervals,
569 /// compute what the resultant value numbers for each value in the input two
570 /// ranges will be.  This is complicated by copies between the two which can
571 /// and will commonly cause multiple value numbers to be merged into one.
572 ///
573 /// VN is the value number that we're trying to resolve.  InstDefiningValue
574 /// keeps track of the new InstDefiningValue assignment for the result
575 /// LiveInterval.  ThisFromOther/OtherFromThis are sets that keep track of
576 /// whether a value in this or other is a copy from the opposite set.
577 /// ThisValNoAssignments/OtherValNoAssignments keep track of value #'s that have
578 /// already been assigned.
579 ///
580 /// ThisFromOther[x] - If x is defined as a copy from the other interval, this
581 /// contains the value number the copy is from.
582 ///
583 static unsigned ComputeUltimateVN(VNInfo *VNI,
584                                   SmallVector<VNInfo*, 16> &NewVNInfo,
585                                   DenseMap<VNInfo*, VNInfo*> &ThisFromOther,
586                                   DenseMap<VNInfo*, VNInfo*> &OtherFromThis,
587                                   SmallVector<int, 16> &ThisValNoAssignments,
588                                   SmallVector<int, 16> &OtherValNoAssignments) {
589   unsigned VN = VNI->id;
590
591   // If the VN has already been computed, just return it.
592   if (ThisValNoAssignments[VN] >= 0)
593     return ThisValNoAssignments[VN];
594 //  assert(ThisValNoAssignments[VN] != -2 && "Cyclic case?");
595
596   // If this val is not a copy from the other val, then it must be a new value
597   // number in the destination.
598   DenseMap<VNInfo*, VNInfo*>::iterator I = ThisFromOther.find(VNI);
599   if (I == ThisFromOther.end()) {
600     NewVNInfo.push_back(VNI);
601     return ThisValNoAssignments[VN] = NewVNInfo.size()-1;
602   }
603   VNInfo *OtherValNo = I->second;
604
605   // Otherwise, this *is* a copy from the RHS.  If the other side has already
606   // been computed, return it.
607   if (OtherValNoAssignments[OtherValNo->id] >= 0)
608     return ThisValNoAssignments[VN] = OtherValNoAssignments[OtherValNo->id];
609   
610   // Mark this value number as currently being computed, then ask what the
611   // ultimate value # of the other value is.
612   ThisValNoAssignments[VN] = -2;
613   unsigned UltimateVN =
614     ComputeUltimateVN(OtherValNo, NewVNInfo, OtherFromThis, ThisFromOther,
615                       OtherValNoAssignments, ThisValNoAssignments);
616   return ThisValNoAssignments[VN] = UltimateVN;
617 }
618
619 static bool InVector(VNInfo *Val, const SmallVector<VNInfo*, 8> &V) {
620   return std::find(V.begin(), V.end(), Val) != V.end();
621 }
622
623 /// SimpleJoin - Attempt to joint the specified interval into this one. The
624 /// caller of this method must guarantee that the RHS only contains a single
625 /// value number and that the RHS is not defined by a copy from this
626 /// interval.  This returns false if the intervals are not joinable, or it
627 /// joins them and returns true.
628 bool SimpleRegisterCoalescing::SimpleJoin(LiveInterval &LHS, LiveInterval &RHS) {
629   assert(RHS.containsOneValue());
630   
631   // Some number (potentially more than one) value numbers in the current
632   // interval may be defined as copies from the RHS.  Scan the overlapping
633   // portions of the LHS and RHS, keeping track of this and looking for
634   // overlapping live ranges that are NOT defined as copies.  If these exist, we
635   // cannot coalesce.
636   
637   LiveInterval::iterator LHSIt = LHS.begin(), LHSEnd = LHS.end();
638   LiveInterval::iterator RHSIt = RHS.begin(), RHSEnd = RHS.end();
639   
640   if (LHSIt->start < RHSIt->start) {
641     LHSIt = std::upper_bound(LHSIt, LHSEnd, RHSIt->start);
642     if (LHSIt != LHS.begin()) --LHSIt;
643   } else if (RHSIt->start < LHSIt->start) {
644     RHSIt = std::upper_bound(RHSIt, RHSEnd, LHSIt->start);
645     if (RHSIt != RHS.begin()) --RHSIt;
646   }
647   
648   SmallVector<VNInfo*, 8> EliminatedLHSVals;
649   
650   while (1) {
651     // Determine if these live intervals overlap.
652     bool Overlaps = false;
653     if (LHSIt->start <= RHSIt->start)
654       Overlaps = LHSIt->end > RHSIt->start;
655     else
656       Overlaps = RHSIt->end > LHSIt->start;
657     
658     // If the live intervals overlap, there are two interesting cases: if the
659     // LHS interval is defined by a copy from the RHS, it's ok and we record
660     // that the LHS value # is the same as the RHS.  If it's not, then we cannot
661     // coalesce these live ranges and we bail out.
662     if (Overlaps) {
663       // If we haven't already recorded that this value # is safe, check it.
664       if (!InVector(LHSIt->valno, EliminatedLHSVals)) {
665         // Copy from the RHS?
666         unsigned SrcReg = LHSIt->valno->reg;
667         if (rep(SrcReg) != RHS.reg)
668           return false;    // Nope, bail out.
669         
670         EliminatedLHSVals.push_back(LHSIt->valno);
671       }
672       
673       // We know this entire LHS live range is okay, so skip it now.
674       if (++LHSIt == LHSEnd) break;
675       continue;
676     }
677     
678     if (LHSIt->end < RHSIt->end) {
679       if (++LHSIt == LHSEnd) break;
680     } else {
681       // One interesting case to check here.  It's possible that we have
682       // something like "X3 = Y" which defines a new value number in the LHS,
683       // and is the last use of this liverange of the RHS.  In this case, we
684       // want to notice this copy (so that it gets coalesced away) even though
685       // the live ranges don't actually overlap.
686       if (LHSIt->start == RHSIt->end) {
687         if (InVector(LHSIt->valno, EliminatedLHSVals)) {
688           // We already know that this value number is going to be merged in
689           // if coalescing succeeds.  Just skip the liverange.
690           if (++LHSIt == LHSEnd) break;
691         } else {
692           // Otherwise, if this is a copy from the RHS, mark it as being merged
693           // in.
694           if (rep(LHSIt->valno->reg) == RHS.reg) {
695             EliminatedLHSVals.push_back(LHSIt->valno);
696
697             // We know this entire LHS live range is okay, so skip it now.
698             if (++LHSIt == LHSEnd) break;
699           }
700         }
701       }
702       
703       if (++RHSIt == RHSEnd) break;
704     }
705   }
706   
707   // If we got here, we know that the coalescing will be successful and that
708   // the value numbers in EliminatedLHSVals will all be merged together.  Since
709   // the most common case is that EliminatedLHSVals has a single number, we
710   // optimize for it: if there is more than one value, we merge them all into
711   // the lowest numbered one, then handle the interval as if we were merging
712   // with one value number.
713   VNInfo *LHSValNo;
714   if (EliminatedLHSVals.size() > 1) {
715     // Loop through all the equal value numbers merging them into the smallest
716     // one.
717     VNInfo *Smallest = EliminatedLHSVals[0];
718     for (unsigned i = 1, e = EliminatedLHSVals.size(); i != e; ++i) {
719       if (EliminatedLHSVals[i]->id < Smallest->id) {
720         // Merge the current notion of the smallest into the smaller one.
721         LHS.MergeValueNumberInto(Smallest, EliminatedLHSVals[i]);
722         Smallest = EliminatedLHSVals[i];
723       } else {
724         // Merge into the smallest.
725         LHS.MergeValueNumberInto(EliminatedLHSVals[i], Smallest);
726       }
727     }
728     LHSValNo = Smallest;
729   } else {
730     assert(!EliminatedLHSVals.empty() && "No copies from the RHS?");
731     LHSValNo = EliminatedLHSVals[0];
732   }
733   
734   // Okay, now that there is a single LHS value number that we're merging the
735   // RHS into, update the value number info for the LHS to indicate that the
736   // value number is defined where the RHS value number was.
737   const VNInfo *VNI = RHS.getValNumInfo(0);
738   LHSValNo->def = VNI->def;
739   LHSValNo->reg = VNI->reg;
740   
741   // Okay, the final step is to loop over the RHS live intervals, adding them to
742   // the LHS.
743   LHSValNo->hasPHIKill |= VNI->hasPHIKill;
744   LHS.addKills(LHSValNo, VNI->kills);
745   LHS.MergeRangesInAsValue(RHS, LHSValNo);
746   LHS.weight += RHS.weight;
747   if (RHS.preference && !LHS.preference)
748     LHS.preference = RHS.preference;
749   
750   return true;
751 }
752
753 /// JoinIntervals - Attempt to join these two intervals.  On failure, this
754 /// returns false.  Otherwise, if one of the intervals being joined is a
755 /// physreg, this method always canonicalizes LHS to be it.  The output
756 /// "RHS" will not have been modified, so we can use this information
757 /// below to update aliases.
758 bool SimpleRegisterCoalescing::JoinIntervals(LiveInterval &LHS,
759                                              LiveInterval &RHS, bool &Swapped) {
760   // Compute the final value assignment, assuming that the live ranges can be
761   // coalesced.
762   SmallVector<int, 16> LHSValNoAssignments;
763   SmallVector<int, 16> RHSValNoAssignments;
764   DenseMap<VNInfo*, VNInfo*> LHSValsDefinedFromRHS;
765   DenseMap<VNInfo*, VNInfo*> RHSValsDefinedFromLHS;
766   SmallVector<VNInfo*, 16> NewVNInfo;
767                           
768   // If a live interval is a physical register, conservatively check if any
769   // of its sub-registers is overlapping the live interval of the virtual
770   // register. If so, do not coalesce.
771   if (MRegisterInfo::isPhysicalRegister(LHS.reg) &&
772       *mri_->getSubRegisters(LHS.reg)) {
773     for (const unsigned* SR = mri_->getSubRegisters(LHS.reg); *SR; ++SR)
774       if (li_->hasInterval(*SR) && RHS.overlaps(li_->getInterval(*SR))) {
775         DOUT << "Interfere with sub-register ";
776         DEBUG(li_->getInterval(*SR).print(DOUT, mri_));
777         return false;
778       }
779   } else if (MRegisterInfo::isPhysicalRegister(RHS.reg) &&
780              *mri_->getSubRegisters(RHS.reg)) {
781     for (const unsigned* SR = mri_->getSubRegisters(RHS.reg); *SR; ++SR)
782       if (li_->hasInterval(*SR) && LHS.overlaps(li_->getInterval(*SR))) {
783         DOUT << "Interfere with sub-register ";
784         DEBUG(li_->getInterval(*SR).print(DOUT, mri_));
785         return false;
786       }
787   }
788                           
789   // Compute ultimate value numbers for the LHS and RHS values.
790   if (RHS.containsOneValue()) {
791     // Copies from a liveinterval with a single value are simple to handle and
792     // very common, handle the special case here.  This is important, because
793     // often RHS is small and LHS is large (e.g. a physreg).
794     
795     // Find out if the RHS is defined as a copy from some value in the LHS.
796     int RHSVal0DefinedFromLHS = -1;
797     int RHSValID = -1;
798     VNInfo *RHSValNoInfo = NULL;
799     VNInfo *RHSValNoInfo0 = RHS.getValNumInfo(0);
800     unsigned RHSSrcReg = RHSValNoInfo0->reg;
801     if ((RHSSrcReg == 0 || rep(RHSSrcReg) != LHS.reg)) {
802       // If RHS is not defined as a copy from the LHS, we can use simpler and
803       // faster checks to see if the live ranges are coalescable.  This joiner
804       // can't swap the LHS/RHS intervals though.
805       if (!MRegisterInfo::isPhysicalRegister(RHS.reg)) {
806         return SimpleJoin(LHS, RHS);
807       } else {
808         RHSValNoInfo = RHSValNoInfo0;
809       }
810     } else {
811       // It was defined as a copy from the LHS, find out what value # it is.
812       RHSValNoInfo = LHS.getLiveRangeContaining(RHSValNoInfo0->def-1)->valno;
813       RHSValID = RHSValNoInfo->id;
814       RHSVal0DefinedFromLHS = RHSValID;
815     }
816     
817     LHSValNoAssignments.resize(LHS.getNumValNums(), -1);
818     RHSValNoAssignments.resize(RHS.getNumValNums(), -1);
819     NewVNInfo.resize(LHS.getNumValNums(), NULL);
820     
821     // Okay, *all* of the values in LHS that are defined as a copy from RHS
822     // should now get updated.
823     for (LiveInterval::vni_iterator i = LHS.vni_begin(), e = LHS.vni_end();
824          i != e; ++i) {
825       VNInfo *VNI = *i;
826       unsigned VN = VNI->id;
827       if (unsigned LHSSrcReg = VNI->reg) {
828         if (rep(LHSSrcReg) != RHS.reg) {
829           // If this is not a copy from the RHS, its value number will be
830           // unmodified by the coalescing.
831           NewVNInfo[VN] = VNI;
832           LHSValNoAssignments[VN] = VN;
833         } else if (RHSValID == -1) {
834           // Otherwise, it is a copy from the RHS, and we don't already have a
835           // value# for it.  Keep the current value number, but remember it.
836           LHSValNoAssignments[VN] = RHSValID = VN;
837           NewVNInfo[VN] = RHSValNoInfo;
838           LHSValsDefinedFromRHS[VNI] = RHSValNoInfo0;
839         } else {
840           // Otherwise, use the specified value #.
841           LHSValNoAssignments[VN] = RHSValID;
842           if (VN == (unsigned)RHSValID) {  // Else this val# is dead.
843             NewVNInfo[VN] = RHSValNoInfo;
844             LHSValsDefinedFromRHS[VNI] = RHSValNoInfo0;
845           }
846         }
847       } else {
848         NewVNInfo[VN] = VNI;
849         LHSValNoAssignments[VN] = VN;
850       }
851     }
852     
853     assert(RHSValID != -1 && "Didn't find value #?");
854     RHSValNoAssignments[0] = RHSValID;
855     if (RHSVal0DefinedFromLHS != -1) {
856       // This path doesn't go through ComputeUltimateVN so just set
857       // it to anything.
858       RHSValsDefinedFromLHS[RHSValNoInfo0] = (VNInfo*)1;
859     }
860   } else {
861     // Loop over the value numbers of the LHS, seeing if any are defined from
862     // the RHS.
863     for (LiveInterval::vni_iterator i = LHS.vni_begin(), e = LHS.vni_end();
864          i != e; ++i) {
865       VNInfo *VNI = *i;
866       unsigned ValSrcReg = VNI->reg;
867       if (VNI->def == ~1U ||ValSrcReg == 0)  // Src not defined by a copy?
868         continue;
869       
870       // DstReg is known to be a register in the LHS interval.  If the src is
871       // from the RHS interval, we can use its value #.
872       if (rep(ValSrcReg) != RHS.reg)
873         continue;
874       
875       // Figure out the value # from the RHS.
876       LHSValsDefinedFromRHS[VNI] = RHS.getLiveRangeContaining(VNI->def-1)->valno;
877     }
878     
879     // Loop over the value numbers of the RHS, seeing if any are defined from
880     // the LHS.
881     for (LiveInterval::vni_iterator i = RHS.vni_begin(), e = RHS.vni_end();
882          i != e; ++i) {
883       VNInfo *VNI = *i;
884       unsigned ValSrcReg = VNI->reg;
885       if (VNI->def == ~1U || ValSrcReg == 0)  // Src not defined by a copy?
886         continue;
887       
888       // DstReg is known to be a register in the RHS interval.  If the src is
889       // from the LHS interval, we can use its value #.
890       if (rep(ValSrcReg) != LHS.reg)
891         continue;
892       
893       // Figure out the value # from the LHS.
894       RHSValsDefinedFromLHS[VNI]= LHS.getLiveRangeContaining(VNI->def-1)->valno;
895     }
896     
897     LHSValNoAssignments.resize(LHS.getNumValNums(), -1);
898     RHSValNoAssignments.resize(RHS.getNumValNums(), -1);
899     NewVNInfo.reserve(LHS.getNumValNums() + RHS.getNumValNums());
900     
901     for (LiveInterval::vni_iterator i = LHS.vni_begin(), e = LHS.vni_end();
902          i != e; ++i) {
903       VNInfo *VNI = *i;
904       unsigned VN = VNI->id;
905       if (LHSValNoAssignments[VN] >= 0 || VNI->def == ~1U) 
906         continue;
907       ComputeUltimateVN(VNI, NewVNInfo,
908                         LHSValsDefinedFromRHS, RHSValsDefinedFromLHS,
909                         LHSValNoAssignments, RHSValNoAssignments);
910     }
911     for (LiveInterval::vni_iterator i = RHS.vni_begin(), e = RHS.vni_end();
912          i != e; ++i) {
913       VNInfo *VNI = *i;
914       unsigned VN = VNI->id;
915       if (RHSValNoAssignments[VN] >= 0 || VNI->def == ~1U)
916         continue;
917       // If this value number isn't a copy from the LHS, it's a new number.
918       if (RHSValsDefinedFromLHS.find(VNI) == RHSValsDefinedFromLHS.end()) {
919         NewVNInfo.push_back(VNI);
920         RHSValNoAssignments[VN] = NewVNInfo.size()-1;
921         continue;
922       }
923       
924       ComputeUltimateVN(VNI, NewVNInfo,
925                         RHSValsDefinedFromLHS, LHSValsDefinedFromRHS,
926                         RHSValNoAssignments, LHSValNoAssignments);
927     }
928   }
929   
930   // Armed with the mappings of LHS/RHS values to ultimate values, walk the
931   // interval lists to see if these intervals are coalescable.
932   LiveInterval::const_iterator I = LHS.begin();
933   LiveInterval::const_iterator IE = LHS.end();
934   LiveInterval::const_iterator J = RHS.begin();
935   LiveInterval::const_iterator JE = RHS.end();
936   
937   // Skip ahead until the first place of potential sharing.
938   if (I->start < J->start) {
939     I = std::upper_bound(I, IE, J->start);
940     if (I != LHS.begin()) --I;
941   } else if (J->start < I->start) {
942     J = std::upper_bound(J, JE, I->start);
943     if (J != RHS.begin()) --J;
944   }
945   
946   while (1) {
947     // Determine if these two live ranges overlap.
948     bool Overlaps;
949     if (I->start < J->start) {
950       Overlaps = I->end > J->start;
951     } else {
952       Overlaps = J->end > I->start;
953     }
954
955     // If so, check value # info to determine if they are really different.
956     if (Overlaps) {
957       // If the live range overlap will map to the same value number in the
958       // result liverange, we can still coalesce them.  If not, we can't.
959       if (LHSValNoAssignments[I->valno->id] !=
960           RHSValNoAssignments[J->valno->id])
961         return false;
962     }
963     
964     if (I->end < J->end) {
965       ++I;
966       if (I == IE) break;
967     } else {
968       ++J;
969       if (J == JE) break;
970     }
971   }
972
973   // Update kill info. Some live ranges are extended due to copy coalescing.
974   for (DenseMap<VNInfo*, VNInfo*>::iterator I = LHSValsDefinedFromRHS.begin(),
975          E = LHSValsDefinedFromRHS.end(); I != E; ++I) {
976     VNInfo *VNI = I->first;
977     unsigned LHSValID = LHSValNoAssignments[VNI->id];
978     LiveInterval::removeKill(NewVNInfo[LHSValID], VNI->def);
979     NewVNInfo[LHSValID]->hasPHIKill |= VNI->hasPHIKill;
980     RHS.addKills(NewVNInfo[LHSValID], VNI->kills);
981   }
982
983   // Update kill info. Some live ranges are extended due to copy coalescing.
984   for (DenseMap<VNInfo*, VNInfo*>::iterator I = RHSValsDefinedFromLHS.begin(),
985          E = RHSValsDefinedFromLHS.end(); I != E; ++I) {
986     VNInfo *VNI = I->first;
987     unsigned RHSValID = RHSValNoAssignments[VNI->id];
988     LiveInterval::removeKill(NewVNInfo[RHSValID], VNI->def);
989     NewVNInfo[RHSValID]->hasPHIKill |= VNI->hasPHIKill;
990     LHS.addKills(NewVNInfo[RHSValID], VNI->kills);
991   }
992
993   // If we get here, we know that we can coalesce the live ranges.  Ask the
994   // intervals to coalesce themselves now.
995   if ((RHS.ranges.size() > LHS.ranges.size() &&
996       MRegisterInfo::isVirtualRegister(LHS.reg)) ||
997       MRegisterInfo::isPhysicalRegister(RHS.reg)) {
998     RHS.join(LHS, &RHSValNoAssignments[0], &LHSValNoAssignments[0], NewVNInfo);
999     Swapped = true;
1000   } else {
1001     LHS.join(RHS, &LHSValNoAssignments[0], &RHSValNoAssignments[0], NewVNInfo);
1002     Swapped = false;
1003   }
1004   return true;
1005 }
1006
1007 namespace {
1008   // DepthMBBCompare - Comparison predicate that sort first based on the loop
1009   // depth of the basic block (the unsigned), and then on the MBB number.
1010   struct DepthMBBCompare {
1011     typedef std::pair<unsigned, MachineBasicBlock*> DepthMBBPair;
1012     bool operator()(const DepthMBBPair &LHS, const DepthMBBPair &RHS) const {
1013       if (LHS.first > RHS.first) return true;   // Deeper loops first
1014       return LHS.first == RHS.first &&
1015         LHS.second->getNumber() < RHS.second->getNumber();
1016     }
1017   };
1018 }
1019
1020 /// getRepIntervalSize - Returns the size of the interval that represents the
1021 /// specified register.
1022 template<class SF>
1023 unsigned JoinPriorityQueue<SF>::getRepIntervalSize(unsigned Reg) {
1024   return Rc->getRepIntervalSize(Reg);
1025 }
1026
1027 /// CopyRecSort::operator - Join priority queue sorting function.
1028 ///
1029 bool CopyRecSort::operator()(CopyRec left, CopyRec right) const {
1030   // Inner loops first.
1031   if (left.LoopDepth > right.LoopDepth)
1032     return false;
1033   else if (left.LoopDepth == right.LoopDepth) {
1034     if (left.isBackEdge && !right.isBackEdge)
1035       return false;
1036     else if (left.isBackEdge == right.isBackEdge) {
1037       // Join virtuals to physical registers first.
1038       bool LDstIsPhys = MRegisterInfo::isPhysicalRegister(left.DstReg);
1039       bool LSrcIsPhys = MRegisterInfo::isPhysicalRegister(left.SrcReg);
1040       bool LIsPhys = LDstIsPhys || LSrcIsPhys;
1041       bool RDstIsPhys = MRegisterInfo::isPhysicalRegister(right.DstReg);
1042       bool RSrcIsPhys = MRegisterInfo::isPhysicalRegister(right.SrcReg);
1043       bool RIsPhys = RDstIsPhys || RSrcIsPhys;
1044       if (LIsPhys && !RIsPhys)
1045         return false;
1046       else if (LIsPhys == RIsPhys) {
1047         // Join shorter intervals first.
1048         unsigned LSize = 0;
1049         unsigned RSize = 0;
1050         if (LIsPhys) {
1051           LSize =  LDstIsPhys ? 0 : JPQ->getRepIntervalSize(left.DstReg);
1052           LSize += LSrcIsPhys ? 0 : JPQ->getRepIntervalSize(left.SrcReg);
1053           RSize =  RDstIsPhys ? 0 : JPQ->getRepIntervalSize(right.DstReg);
1054           RSize += RSrcIsPhys ? 0 : JPQ->getRepIntervalSize(right.SrcReg);
1055         } else {
1056           LSize =  std::min(JPQ->getRepIntervalSize(left.DstReg),
1057                             JPQ->getRepIntervalSize(left.SrcReg));
1058           RSize =  std::min(JPQ->getRepIntervalSize(right.DstReg),
1059                             JPQ->getRepIntervalSize(right.SrcReg));
1060         }
1061         if (LSize < RSize)
1062           return false;
1063       }
1064     }
1065   }
1066   return true;
1067 }
1068
1069 void SimpleRegisterCoalescing::CopyCoalesceInMBB(MachineBasicBlock *MBB,
1070                                                std::vector<CopyRec> &TryAgain) {
1071   DOUT << ((Value*)MBB->getBasicBlock())->getName() << ":\n";
1072
1073   std::vector<CopyRec> VirtCopies;
1074   std::vector<CopyRec> PhysCopies;
1075   unsigned LoopDepth = loopInfo->getLoopDepth(MBB->getBasicBlock());
1076   for (MachineBasicBlock::iterator MII = MBB->begin(), E = MBB->end();
1077        MII != E;) {
1078     MachineInstr *Inst = MII++;
1079     
1080     // If this isn't a copy nor a extract_subreg, we can't join intervals.
1081     unsigned SrcReg, DstReg;
1082     if (Inst->getOpcode() == TargetInstrInfo::EXTRACT_SUBREG) {
1083       DstReg = Inst->getOperand(0).getReg();
1084       SrcReg = Inst->getOperand(1).getReg();
1085     } else if (!tii_->isMoveInstr(*Inst, SrcReg, DstReg))
1086       continue;
1087
1088     unsigned repSrcReg = rep(SrcReg);
1089     unsigned repDstReg = rep(DstReg);
1090     bool SrcIsPhys = MRegisterInfo::isPhysicalRegister(repSrcReg);
1091     bool DstIsPhys = MRegisterInfo::isPhysicalRegister(repDstReg);
1092     if (NewHeuristic) {
1093       JoinQueue->push(CopyRec(Inst, SrcReg, DstReg, LoopDepth,
1094                               isBackEdgeCopy(Inst, DstReg)));
1095     } else {
1096       if (SrcIsPhys || DstIsPhys)
1097         PhysCopies.push_back(CopyRec(Inst, SrcReg, DstReg, 0, false));
1098       else
1099         VirtCopies.push_back(CopyRec(Inst, SrcReg, DstReg, 0, false));
1100     }
1101   }
1102
1103   if (NewHeuristic)
1104     return;
1105
1106   // Try coalescing physical register + virtual register first.
1107   for (unsigned i = 0, e = PhysCopies.size(); i != e; ++i) {
1108     CopyRec &TheCopy = PhysCopies[i];
1109     bool Again = false;
1110     if (!JoinCopy(TheCopy, Again))
1111       if (Again)
1112         TryAgain.push_back(TheCopy);
1113   }
1114   for (unsigned i = 0, e = VirtCopies.size(); i != e; ++i) {
1115     CopyRec &TheCopy = VirtCopies[i];
1116     bool Again = false;
1117     if (!JoinCopy(TheCopy, Again))
1118       if (Again)
1119         TryAgain.push_back(TheCopy);
1120   }
1121 }
1122
1123 void SimpleRegisterCoalescing::joinIntervals() {
1124   DOUT << "********** JOINING INTERVALS ***********\n";
1125
1126   if (NewHeuristic)
1127     JoinQueue = new JoinPriorityQueue<CopyRecSort>(this);
1128
1129   JoinedLIs.resize(li_->getNumIntervals());
1130   JoinedLIs.reset();
1131
1132   std::vector<CopyRec> TryAgainList;
1133   if (loopInfo->begin() == loopInfo->end()) {
1134     // If there are no loops in the function, join intervals in function order.
1135     for (MachineFunction::iterator I = mf_->begin(), E = mf_->end();
1136          I != E; ++I)
1137       CopyCoalesceInMBB(I, TryAgainList);
1138   } else {
1139     // Otherwise, join intervals in inner loops before other intervals.
1140     // Unfortunately we can't just iterate over loop hierarchy here because
1141     // there may be more MBB's than BB's.  Collect MBB's for sorting.
1142
1143     // Join intervals in the function prolog first. We want to join physical
1144     // registers with virtual registers before the intervals got too long.
1145     std::vector<std::pair<unsigned, MachineBasicBlock*> > MBBs;
1146     for (MachineFunction::iterator I = mf_->begin(), E = mf_->end(); I != E;++I)
1147       MBBs.push_back(std::make_pair(loopInfo->
1148                                     getLoopDepth(I->getBasicBlock()), I));
1149
1150     // Sort by loop depth.
1151     std::sort(MBBs.begin(), MBBs.end(), DepthMBBCompare());
1152
1153     // Finally, join intervals in loop nest order.
1154     for (unsigned i = 0, e = MBBs.size(); i != e; ++i)
1155       CopyCoalesceInMBB(MBBs[i].second, TryAgainList);
1156   }
1157   
1158   // Joining intervals can allow other intervals to be joined.  Iteratively join
1159   // until we make no progress.
1160   if (NewHeuristic) {
1161     SmallVector<CopyRec, 16> TryAgain;
1162     bool ProgressMade = true;
1163     while (ProgressMade) {
1164       ProgressMade = false;
1165       while (!JoinQueue->empty()) {
1166         CopyRec R = JoinQueue->pop();
1167         bool Again = false;
1168         bool Success = JoinCopy(R, Again);
1169         if (Success)
1170           ProgressMade = true;
1171         else if (Again)
1172           TryAgain.push_back(R);
1173       }
1174
1175       if (ProgressMade) {
1176         while (!TryAgain.empty()) {
1177           JoinQueue->push(TryAgain.back());
1178           TryAgain.pop_back();
1179         }
1180       }
1181     }
1182   } else {
1183     bool ProgressMade = true;
1184     while (ProgressMade) {
1185       ProgressMade = false;
1186
1187       for (unsigned i = 0, e = TryAgainList.size(); i != e; ++i) {
1188         CopyRec &TheCopy = TryAgainList[i];
1189         if (TheCopy.MI) {
1190           bool Again = false;
1191           bool Success = JoinCopy(TheCopy, Again);
1192           if (Success || !Again) {
1193             TheCopy.MI = 0;   // Mark this one as done.
1194             ProgressMade = true;
1195           }
1196         }
1197       }
1198     }
1199   }
1200
1201   // Some live range has been lengthened due to colaescing, eliminate the
1202   // unnecessary kills.
1203   int RegNum = JoinedLIs.find_first();
1204   while (RegNum != -1) {
1205     unsigned Reg = RegNum + MRegisterInfo::FirstVirtualRegister;
1206     unsigned repReg = rep(Reg);
1207     LiveInterval &LI = li_->getInterval(repReg);
1208     LiveVariables::VarInfo& svi = lv_->getVarInfo(Reg);
1209     for (unsigned i = 0, e = svi.Kills.size(); i != e; ++i) {
1210       MachineInstr *Kill = svi.Kills[i];
1211       // Suppose vr1 = op vr2, x
1212       // and vr1 and vr2 are coalesced. vr2 should still be marked kill
1213       // unless it is a two-address operand.
1214       if (li_->isRemoved(Kill) || hasRegisterDef(Kill, repReg))
1215         continue;
1216       if (LI.liveAt(li_->getInstructionIndex(Kill) + InstrSlots::NUM))
1217         unsetRegisterKill(Kill, repReg);
1218     }
1219     RegNum = JoinedLIs.find_next(RegNum);
1220   }
1221
1222   if (NewHeuristic)
1223     delete JoinQueue;
1224   
1225   DOUT << "*** Register mapping ***\n";
1226   for (unsigned i = 0, e = r2rMap_.size(); i != e; ++i)
1227     if (r2rMap_[i]) {
1228       DOUT << "  reg " << i << " -> ";
1229       DEBUG(printRegName(r2rMap_[i]));
1230       DOUT << "\n";
1231     }
1232 }
1233
1234 /// Return true if the two specified registers belong to different register
1235 /// classes.  The registers may be either phys or virt regs.
1236 bool SimpleRegisterCoalescing::differingRegisterClasses(unsigned RegA,
1237                                                         unsigned RegB) const {
1238
1239   // Get the register classes for the first reg.
1240   if (MRegisterInfo::isPhysicalRegister(RegA)) {
1241     assert(MRegisterInfo::isVirtualRegister(RegB) &&
1242            "Shouldn't consider two physregs!");
1243     return !mf_->getSSARegMap()->getRegClass(RegB)->contains(RegA);
1244   }
1245
1246   // Compare against the regclass for the second reg.
1247   const TargetRegisterClass *RegClass = mf_->getSSARegMap()->getRegClass(RegA);
1248   if (MRegisterInfo::isVirtualRegister(RegB))
1249     return RegClass != mf_->getSSARegMap()->getRegClass(RegB);
1250   else
1251     return !RegClass->contains(RegB);
1252 }
1253
1254 /// lastRegisterUse - Returns the last use of the specific register between
1255 /// cycles Start and End. It also returns the use operand by reference. It
1256 /// returns NULL if there are no uses.
1257 MachineInstr *
1258 SimpleRegisterCoalescing::lastRegisterUse(unsigned Start, unsigned End, unsigned Reg,
1259                                MachineOperand *&MOU) {
1260   int e = (End-1) / InstrSlots::NUM * InstrSlots::NUM;
1261   int s = Start;
1262   while (e >= s) {
1263     // Skip deleted instructions
1264     MachineInstr *MI = li_->getInstructionFromIndex(e);
1265     while ((e - InstrSlots::NUM) >= s && !MI) {
1266       e -= InstrSlots::NUM;
1267       MI = li_->getInstructionFromIndex(e);
1268     }
1269     if (e < s || MI == NULL)
1270       return NULL;
1271
1272     for (unsigned i = 0, NumOps = MI->getNumOperands(); i != NumOps; ++i) {
1273       MachineOperand &MO = MI->getOperand(i);
1274       if (MO.isRegister() && MO.isUse() && MO.getReg() &&
1275           mri_->regsOverlap(rep(MO.getReg()), Reg)) {
1276         MOU = &MO;
1277         return MI;
1278       }
1279     }
1280
1281     e -= InstrSlots::NUM;
1282   }
1283
1284   return NULL;
1285 }
1286
1287
1288 /// findDefOperand - Returns the MachineOperand that is a def of the specific
1289 /// register. It returns NULL if the def is not found.
1290 MachineOperand *SimpleRegisterCoalescing::findDefOperand(MachineInstr *MI, unsigned Reg) {
1291   for (unsigned i = 0, e = MI->getNumOperands(); i != e; ++i) {
1292     MachineOperand &MO = MI->getOperand(i);
1293     if (MO.isRegister() && MO.isDef() &&
1294         mri_->regsOverlap(rep(MO.getReg()), Reg))
1295       return &MO;
1296   }
1297   return NULL;
1298 }
1299
1300 /// unsetRegisterKill - Unset IsKill property of all uses of specific register
1301 /// of the specific instruction.
1302 void SimpleRegisterCoalescing::unsetRegisterKill(MachineInstr *MI, unsigned Reg) {
1303   for (unsigned i = 0, e = MI->getNumOperands(); i != e; ++i) {
1304     MachineOperand &MO = MI->getOperand(i);
1305     if (MO.isRegister() && MO.isKill() && MO.getReg() &&
1306         mri_->regsOverlap(rep(MO.getReg()), Reg))
1307       MO.unsetIsKill();
1308   }
1309 }
1310
1311 /// unsetRegisterKills - Unset IsKill property of all uses of specific register
1312 /// between cycles Start and End.
1313 void SimpleRegisterCoalescing::unsetRegisterKills(unsigned Start, unsigned End,
1314                                        unsigned Reg) {
1315   int e = (End-1) / InstrSlots::NUM * InstrSlots::NUM;
1316   int s = Start;
1317   while (e >= s) {
1318     // Skip deleted instructions
1319     MachineInstr *MI = li_->getInstructionFromIndex(e);
1320     while ((e - InstrSlots::NUM) >= s && !MI) {
1321       e -= InstrSlots::NUM;
1322       MI = li_->getInstructionFromIndex(e);
1323     }
1324     if (e < s || MI == NULL)
1325       return;
1326
1327     for (unsigned i = 0, NumOps = MI->getNumOperands(); i != NumOps; ++i) {
1328       MachineOperand &MO = MI->getOperand(i);
1329       if (MO.isRegister() && MO.isKill() && MO.getReg() &&
1330           mri_->regsOverlap(rep(MO.getReg()), Reg)) {
1331         MO.unsetIsKill();
1332       }
1333     }
1334
1335     e -= InstrSlots::NUM;
1336   }
1337 }
1338
1339 /// hasRegisterDef - True if the instruction defines the specific register.
1340 ///
1341 bool SimpleRegisterCoalescing::hasRegisterDef(MachineInstr *MI, unsigned Reg) {
1342   for (unsigned i = 0, e = MI->getNumOperands(); i != e; ++i) {
1343     MachineOperand &MO = MI->getOperand(i);
1344     if (MO.isRegister() && MO.isDef() &&
1345         mri_->regsOverlap(rep(MO.getReg()), Reg))
1346       return true;
1347   }
1348   return false;
1349 }
1350
1351 void SimpleRegisterCoalescing::printRegName(unsigned reg) const {
1352   if (MRegisterInfo::isPhysicalRegister(reg))
1353     cerr << mri_->getName(reg);
1354   else
1355     cerr << "%reg" << reg;
1356 }
1357
1358 void SimpleRegisterCoalescing::releaseMemory() {
1359   for (unsigned i = 0, e = r2rMap_.size(); i != e; ++i)
1360     r2rRevMap_[i].clear();
1361   r2rRevMap_.clear();
1362   r2rMap_.clear();
1363   JoinedLIs.clear();
1364   SubRegIdxes.clear();
1365   JoinedCopies.clear();
1366 }
1367
1368 static bool isZeroLengthInterval(LiveInterval *li) {
1369   for (LiveInterval::Ranges::const_iterator
1370          i = li->ranges.begin(), e = li->ranges.end(); i != e; ++i)
1371     if (i->end - i->start > LiveIntervals::InstrSlots::NUM)
1372       return false;
1373   return true;
1374 }
1375
1376 bool SimpleRegisterCoalescing::runOnMachineFunction(MachineFunction &fn) {
1377   mf_ = &fn;
1378   tm_ = &fn.getTarget();
1379   mri_ = tm_->getRegisterInfo();
1380   tii_ = tm_->getInstrInfo();
1381   li_ = &getAnalysis<LiveIntervals>();
1382   lv_ = &getAnalysis<LiveVariables>();
1383   loopInfo = &getAnalysis<LoopInfo>();
1384
1385   DOUT << "********** SIMPLE REGISTER COALESCING **********\n"
1386        << "********** Function: "
1387        << ((Value*)mf_->getFunction())->getName() << '\n';
1388
1389   allocatableRegs_ = mri_->getAllocatableSet(fn);
1390   for (MRegisterInfo::regclass_iterator I = mri_->regclass_begin(),
1391          E = mri_->regclass_end(); I != E; ++I)
1392     allocatableRCRegs_.insert(std::make_pair(*I,mri_->getAllocatableSet(fn, *I)));
1393
1394   SSARegMap *RegMap = mf_->getSSARegMap();
1395   r2rMap_.grow(RegMap->getLastVirtReg());
1396   r2rRevMap_.grow(RegMap->getLastVirtReg());
1397
1398   // Join (coalesce) intervals if requested.
1399   IndexedMap<unsigned, VirtReg2IndexFunctor> RegSubIdxMap;
1400   if (EnableJoining) {
1401     joinIntervals();
1402     DOUT << "********** INTERVALS POST JOINING **********\n";
1403     for (LiveIntervals::iterator I = li_->begin(), E = li_->end(); I != E; ++I) {
1404       I->second.print(DOUT, mri_);
1405       DOUT << "\n";
1406     }
1407
1408     // Delete all coalesced copies.
1409     for (SmallPtrSet<MachineInstr*,32>::iterator I = JoinedCopies.begin(),
1410            E = JoinedCopies.end(); I != E; ++I) {
1411       li_->RemoveMachineInstrFromMaps(*I);
1412       (*I)->eraseFromParent();
1413     }
1414
1415     // Transfer sub-registers info to SSARegMap now that coalescing information
1416     // is complete.
1417     RegSubIdxMap.grow(mf_->getSSARegMap()->getLastVirtReg()+1);
1418     while (!SubRegIdxes.empty()) {
1419       std::pair<unsigned, unsigned> RI = SubRegIdxes.back();
1420       SubRegIdxes.pop_back();
1421       RegSubIdxMap[RI.first] = RI.second;
1422     }
1423   }
1424
1425   // perform a final pass over the instructions and compute spill
1426   // weights, coalesce virtual registers and remove identity moves.
1427   for (MachineFunction::iterator mbbi = mf_->begin(), mbbe = mf_->end();
1428        mbbi != mbbe; ++mbbi) {
1429     MachineBasicBlock* mbb = mbbi;
1430     unsigned loopDepth = loopInfo->getLoopDepth(mbb->getBasicBlock());
1431
1432     for (MachineBasicBlock::iterator mii = mbb->begin(), mie = mbb->end();
1433          mii != mie; ) {
1434       // if the move will be an identity move delete it
1435       unsigned srcReg, dstReg, RegRep;
1436       if (tii_->isMoveInstr(*mii, srcReg, dstReg) &&
1437           (RegRep = rep(srcReg)) == rep(dstReg)) {
1438         // remove from def list
1439         LiveInterval &RegInt = li_->getOrCreateInterval(RegRep);
1440         MachineOperand *MO = mii->findRegisterDefOperand(dstReg);
1441         // If def of this move instruction is dead, remove its live range from
1442         // the dstination register's live interval.
1443         if (MO->isDead()) {
1444           unsigned MoveIdx = li_->getDefIndex(li_->getInstructionIndex(mii));
1445           LiveInterval::iterator MLR = RegInt.FindLiveRangeContaining(MoveIdx);
1446           RegInt.removeRange(MLR->start, MoveIdx+1);
1447           if (RegInt.empty())
1448             li_->removeInterval(RegRep);
1449         }
1450         li_->RemoveMachineInstrFromMaps(mii);
1451         mii = mbbi->erase(mii);
1452         ++numPeep;
1453       } else {
1454         SmallSet<unsigned, 4> UniqueUses;
1455         for (unsigned i = 0, e = mii->getNumOperands(); i != e; ++i) {
1456           const MachineOperand &mop = mii->getOperand(i);
1457           if (mop.isRegister() && mop.getReg() &&
1458               MRegisterInfo::isVirtualRegister(mop.getReg())) {
1459             // replace register with representative register
1460             unsigned OrigReg = mop.getReg();
1461             unsigned reg = rep(OrigReg);
1462             unsigned SubIdx = RegSubIdxMap[OrigReg];
1463             if (SubIdx && MRegisterInfo::isPhysicalRegister(reg))
1464               mii->getOperand(i).setReg(mri_->getSubReg(reg, SubIdx));
1465             else {
1466               mii->getOperand(i).setReg(reg);
1467               mii->getOperand(i).setSubReg(SubIdx);
1468             }
1469
1470             // Multiple uses of reg by the same instruction. It should not
1471             // contribute to spill weight again.
1472             if (UniqueUses.count(reg) != 0)
1473               continue;
1474             LiveInterval &RegInt = li_->getInterval(reg);
1475             RegInt.weight +=
1476               li_->getSpillWeight(mop.isDef(), mop.isUse(), loopDepth);
1477             UniqueUses.insert(reg);
1478           }
1479         }
1480         ++mii;
1481       }
1482     }
1483   }
1484
1485   for (LiveIntervals::iterator I = li_->begin(), E = li_->end(); I != E; ++I) {
1486     LiveInterval &LI = I->second;
1487     if (MRegisterInfo::isVirtualRegister(LI.reg)) {
1488       // If the live interval length is essentially zero, i.e. in every live
1489       // range the use follows def immediately, it doesn't make sense to spill
1490       // it and hope it will be easier to allocate for this li.
1491       if (isZeroLengthInterval(&LI))
1492         LI.weight = HUGE_VALF;
1493       else {
1494         bool isLoad = false;
1495         if (ReMatSpillWeight && li_->isReMaterializable(LI, isLoad)) {
1496           // If all of the definitions of the interval are re-materializable,
1497           // it is a preferred candidate for spilling. If non of the defs are
1498           // loads, then it's potentially very cheap to re-materialize.
1499           // FIXME: this gets much more complicated once we support non-trivial
1500           // re-materialization.
1501           if (isLoad)
1502             LI.weight *= 0.9F;
1503           else
1504             LI.weight *= 0.5F;
1505         }
1506       }
1507
1508       // Slightly prefer live interval that has been assigned a preferred reg.
1509       if (LI.preference)
1510         LI.weight *= 1.01F;
1511
1512       // Divide the weight of the interval by its size.  This encourages 
1513       // spilling of intervals that are large and have few uses, and
1514       // discourages spilling of small intervals with many uses.
1515       LI.weight /= LI.getSize();
1516     }
1517   }
1518
1519   DEBUG(dump());
1520   return true;
1521 }
1522
1523 /// print - Implement the dump method.
1524 void SimpleRegisterCoalescing::print(std::ostream &O, const Module* m) const {
1525    li_->print(O, m);
1526 }
1527
1528 RegisterCoalescer* llvm::createSimpleRegisterCoalescer() {
1529   return new SimpleRegisterCoalescing();
1530 }
1531
1532 // Make sure that anything that uses RegisterCoalescer pulls in this file...
1533 DEFINING_FILE_FOR(SimpleRegisterCoalescing)