Split Reg into vreg/hreg and add register pairs

[ghc-hetmet.git] / compiler / nativeGen / RegAlloc / Graph / SpillCost.hs

diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
index 1d37cf7..ff3f76a 100644 (file)
--- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
@@ -16,14 +16,16 @@ module RegAlloc.Graph.SpillCost (
 
 where
 
-import GraphBase
 import RegAlloc.Liveness
-import RegAllocInfo
-import Instrs
-import Regs
+import Instruction
+import RegClass
+import Reg
+
+import GraphBase
+
+
 import BlockId
 import Cmm
-
 import UniqFM
 import UniqSet
 import Outputable
@@ -34,10 +36,10 @@ import Data.Maybe
 import Control.Monad
 
 type SpillCostRecord
- =     ( Reg   -- register name
-       , Int   -- number of writes to this reg
-       , Int   -- number of reads from this reg
-       , Int)  -- number of instrs this reg was live on entry to
+ =     ( VirtualReg    -- register name
+       , Int           -- number of writes to this reg
+       , Int           -- number of reads from this reg
+       , Int)          -- number of instrs this reg was live on entry to
 
 type SpillCostInfo
        = UniqFM SpillCostRecord
@@ -62,7 +64,8 @@ plusSpillCostRecord (r1, a1, b1, c1) (r2, a2, b2, c2)
 --     and the number of instructions it was live on entry to (lifetime)
 --
 slurpSpillCostInfo
-       :: LiveCmmTop
+       :: (Outputable instr, Instruction instr)
+       => LiveCmmTop instr
        -> SpillCostInfo
 
 slurpSpillCostInfo cmm
@@ -80,7 +83,11 @@ slurpSpillCostInfo cmm
        countBlock info (BasicBlock blockId instrs)
                | LiveInfo _ _ blockLive        <- info
                , Just rsLiveEntry              <- lookupBlockEnv blockLive blockId
-               = countLIs rsLiveEntry instrs
+
+               , rsLiveEntry_virt      <- mapUniqSet (\(RegVirtual vr) -> vr) 
+                                       $  filterUniqSet isVirtualReg rsLiveEntry
+                                               
+               = countLIs rsLiveEntry_virt instrs
 
                | otherwise
                = error "RegAlloc.SpillCost.slurpSpillCostInfo: bad block"
@@ -89,11 +96,14 @@ slurpSpillCostInfo cmm
                = return ()
 
        -- skip over comment and delta pseudo instrs
-       countLIs rsLive (Instr instr Nothing : lis)
-               | COMMENT{}     <- instr
+       countLIs rsLive (SPILL{} : lis)
+               = countLIs rsLive lis
+               
+       countLIs rsLive (RELOAD{} : lis)
                = countLIs rsLive lis
 
-               | DELTA{}       <- instr
+       countLIs rsLive (Instr instr Nothing : lis)
+               | isMetaInstr instr
                = countLIs rsLive lis
 
                | otherwise
@@ -106,17 +116,25 @@ slurpSpillCostInfo cmm
                mapM_ incLifetime $ uniqSetToList rsLiveEntry
 
                -- increment counts for what regs were read/written from
-               let (RU read written)   = regUsage instr
-               mapM_ incUses   $ filter (not . isRealReg) $ nub read
-               mapM_ incDefs   $ filter (not . isRealReg) $ nub written
+               let (RU read written)   = regUsageOfInstr instr
+               mapM_ incUses   $ catMaybes $ map takeVirtualReg $ nub read
+               mapM_ incDefs   $ catMaybes $ map takeVirtualReg $ nub written
 
                -- compute liveness for entry to next instruction.
+               let takeVirtuals set
+                       = mapUniqSet (\(RegVirtual vr) -> vr)
+                       $ filterUniqSet isVirtualReg set
+
+               let liveDieRead_virt    = takeVirtuals (liveDieRead  live)
+               let liveDieWrite_virt   = takeVirtuals (liveDieWrite live)
+               let liveBorn_virt       = takeVirtuals (liveBorn     live)
+
                let rsLiveAcross
-                       = rsLiveEntry `minusUniqSet` (liveDieRead live)
+                       = rsLiveEntry `minusUniqSet` liveDieRead_virt
 
                let rsLiveNext
-                       = (rsLiveAcross `unionUniqSets` (liveBorn     live))
-                                       `minusUniqSet` (liveDieWrite live)
+                       = (rsLiveAcross `unionUniqSets` liveBorn_virt)
+                                       `minusUniqSet`  liveDieWrite_virt
 
                countLIs rsLiveNext lis
 
@@ -129,8 +147,8 @@ slurpSpillCostInfo cmm
 
 chooseSpill
        :: SpillCostInfo
-       -> Graph Reg RegClass Reg
-       -> Reg
+       -> Graph VirtualReg RegClass RealReg
+       -> VirtualReg
 
 chooseSpill info graph
  = let cost    = spillCost_length info graph
@@ -206,19 +224,20 @@ spillCost_chaitin info graph reg
 -- Just spill the longest live range.
 spillCost_length
        :: SpillCostInfo
-       -> Graph Reg RegClass Reg
-       -> Reg
+       -> Graph VirtualReg RegClass RealReg
+       -> VirtualReg
        -> Float
 
 spillCost_length info _ reg
        | lifetime <= 1         = 1/0
        | otherwise             = 1 / fromIntegral lifetime
        where (_, _, _, lifetime)
-               = fromMaybe (reg, 0, 0, 0) $ lookupUFM info reg
+               = fromMaybe (reg, 0, 0, 0) 
+               $ lookupUFM info reg
 
 
 
-lifeMapFromSpillCostInfo :: SpillCostInfo -> UniqFM (Reg, Int)
+lifeMapFromSpillCostInfo :: SpillCostInfo -> UniqFM (VirtualReg, Int)
 lifeMapFromSpillCostInfo info
        = listToUFM
        $ map (\(r, _, _, life) -> (r, (r, life)))
@@ -226,11 +245,20 @@ lifeMapFromSpillCostInfo info
 
 
 -- | Work out the degree (number of neighbors) of this node which have the same class.
-nodeDegree :: Graph Reg RegClass Reg -> Reg -> Int
-nodeDegree graph reg
+nodeDegree 
+       :: (VirtualReg -> RegClass)
+       -> Graph VirtualReg RegClass RealReg 
+       -> VirtualReg 
+       -> Int
+
+nodeDegree classOfVirtualReg graph reg
        | Just node     <- lookupUFM (graphMap graph) reg
-       , virtConflicts <- length       $ filter (\r -> regClass r == regClass reg)
-                                       $ uniqSetToList $ nodeConflicts node
+
+       , virtConflicts <- length       
+                       $ filter (\r -> classOfVirtualReg r == classOfVirtualReg reg)
+                       $ uniqSetToList 
+                       $ nodeConflicts node
+
        = virtConflicts + sizeUniqSet (nodeExclusions node)
 
        | otherwise
@@ -238,12 +266,21 @@ nodeDegree graph reg
 
 
 -- | Show a spill cost record, including the degree from the graph and final calulated spill cos
-pprSpillCostRecord :: Graph Reg RegClass Reg -> SpillCostRecord -> SDoc
-pprSpillCostRecord graph (reg, uses, defs, life)
+pprSpillCostRecord 
+       :: (VirtualReg -> RegClass)
+       -> (Reg -> SDoc)
+       -> Graph VirtualReg RegClass RealReg 
+       -> SpillCostRecord 
+       -> SDoc
+
+pprSpillCostRecord regClass pprReg graph (reg, uses, defs, life)
        =  hsep
-       [ ppr reg
+       [ pprReg (RegVirtual reg)
        , ppr uses
        , ppr defs
        , ppr life
-       , ppr $ nodeDegree graph reg
-       , text $ show $ (fromIntegral (uses + defs) / fromIntegral (nodeDegree graph reg) :: Float) ]
+       , ppr $ nodeDegree regClass graph reg
+       , text $ show $ (fromIntegral (uses + defs) 
+                       / fromIntegral (nodeDegree regClass graph reg) :: Float) ]
+
+