X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegisterAlloc.hs;h=20f7b61284f4d7af1043851c32ef20d8e4d9e592;hb=f83010b119096699d1efef2f7bb45460719c48f9;hp=2031fa723c2b10510d8c99b1456895c528375371;hpb=a93bbc4a03ae34d6ef36e4576799d2152c25989b;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegisterAlloc.hs b/compiler/nativeGen/RegisterAlloc.hs
index 2031fa7..20f7b61 100644
--- a/compiler/nativeGen/RegisterAlloc.hs
+++ b/compiler/nativeGen/RegisterAlloc.hs
@@ -102,7 +102,6 @@ import Outputable
 #ifndef DEBUG
 import Data.Maybe	( fromJust )
 #endif
-import Data.Maybe	( fromMaybe )
 import Data.List	( nub, partition, mapAccumL, groupBy )
 import Control.Monad	( when )
 import Data.Word
@@ -353,7 +352,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 +364,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
@@ -442,7 +452,7 @@ linearRegAlloc block_live sccs = linearRA_SCCs emptyBlockMap emptyStackMap sccs
 	(CyclicSCC blocks : sccs) 
 	= getUs `thenUs` \us ->
 	  let
-            ((block_assig', stack', us'), blocks') = mapAccumL processBlock
+            ((block_assig', stack', _), blocks') = mapAccumL processBlock
                                                        (block_assig, stack, us)
                                                        ({-reverse-} blocks)
           in
@@ -957,7 +967,7 @@ spillR reg temp = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack} ->
   (# s{ra_stack=stack'}, (instr,slot) #)
 
 loadR :: Reg -> Int -> RegM Instr
-loadR reg slot = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack} ->
+loadR reg slot = RegM $ \ s@RA_State{ra_delta=delta} ->
   (# s, mkLoadInstr reg delta slot #)
 
 getFreeRegsR :: RegM FreeRegs
@@ -976,14 +986,6 @@ setAssigR :: RegMap Loc -> RegM ()
 setAssigR assig = RegM $ \ s ->
   (# s{ra_assig=assig}, () #)
 
-getStackR :: RegM StackMap
-getStackR = RegM $ \ s@RA_State{ra_stack = stack} ->
-  (# s, stack #)
-
-setStackR :: StackMap -> RegM ()
-setStackR stack = RegM $ \ s ->
-  (# s{ra_stack=stack}, () #)
-
 getBlockAssigR :: RegM BlockAssignment
 getBlockAssigR = RegM $ \ s@RA_State{ra_blockassig = assig} ->
   (# s, assig #)