X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegisterAlloc.hs;fp=compiler%2FnativeGen%2FRegisterAlloc.hs;h=0a732fbfd996e4742f197310a5ea3847525632fc;hb=7979153412d385545e9a43e1bb65419028cfec88;hp=2031fa723c2b10510d8c99b1456895c528375371;hpb=5b8241166c9a6cfc57d7e91677331d334caed89d;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegisterAlloc.hs b/compiler/nativeGen/RegisterAlloc.hs
index 2031fa7..0a732fb 100644
--- a/compiler/nativeGen/RegisterAlloc.hs
+++ b/compiler/nativeGen/RegisterAlloc.hs
@@ -353,7 +353,10 @@ computeLiveness sccs
 
   liveness liveregs blockmap done []  = (liveregs, done)
   liveness liveregs blockmap done (instr:instrs) 
- 	= liveness liveregs2 blockmap ((instr,r_dying,w_dying):done) instrs
+        | not_a_branch = liveness liveregs1 blockmap 
+                                ((instr,r_dying,w_dying):done) instrs
+        | otherwise = liveness liveregs_br blockmap
+                                ((instr,r_dying_br,w_dying):done) instrs
 	where 
 	      RU read written = regUsage instr
 
@@ -362,24 +365,32 @@ computeLiveness sccs
 	      liveregs1 = (liveregs `delListFromUniqSet` written)
 				    `addListToUniqSet` read
 
+	      -- registers that are not live beyond this point, are recorded
+	      --  as dying here.
+	      r_dying  = [ reg | reg <- read, reg `notElem` written,
+			         not (elementOfUniqSet reg liveregs) ]
+
+	      w_dying = [ reg | reg <- written,
+			        not (elementOfUniqSet reg liveregs) ]
+
 	      -- union in the live regs from all the jump destinations of this
 	      -- instruction.
 	      targets = jumpDests instr [] -- where we go from here
-	      liveregs2 = unionManyUniqSets
-			    (liveregs1 : map targetLiveRegs targets)
+              not_a_branch = null targets
 
               targetLiveRegs target = case lookupUFM blockmap target of
                                         Just ra -> ra
                                         Nothing -> emptyBlockMap
 
-	      -- registers that are not live beyond this point, are recorded
-	      --  as dying here.
-	      r_dying  = [ reg | reg <- read, reg `notElem` written,
-			         not (elementOfUniqSet reg liveregs) ]
+              live_from_branch = unionManyUniqSets (map targetLiveRegs targets)
 
-	      w_dying = [ reg | reg <- written,
-			        not (elementOfUniqSet reg liveregs) ]
+	      liveregs_br = liveregs1 `unionUniqSets` live_from_branch
 
+              -- registers that are live only in the branch targets should
+              -- be listed as dying here.
+              live_branch_only = live_from_branch `minusUniqSet` liveregs
+              r_dying_br = uniqSetToList (mkUniqSet r_dying `unionUniqSets`
+                                          live_branch_only)
 
 -- -----------------------------------------------------------------------------
 -- Linear sweep to allocate registers