Commit 23ac7e91 authored by Simon Marlow's avatar Simon Marlow

implement RegSet by Set, not UniqSet

parent 6c969e22
...@@ -16,7 +16,8 @@ module CmmExpr ...@@ -16,7 +16,8 @@ module CmmExpr
, DefinerOfLocalRegs, UserOfLocalRegs, foldRegsDefd, foldRegsUsed, filterRegsUsed , DefinerOfLocalRegs, UserOfLocalRegs, foldRegsDefd, foldRegsUsed, filterRegsUsed
, DefinerOfSlots, UserOfSlots, foldSlotsDefd, foldSlotsUsed , DefinerOfSlots, UserOfSlots, foldSlotsDefd, foldSlotsUsed
, RegSet, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet , RegSet, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
, plusRegSet, minusRegSet, timesRegSet , plusRegSet, minusRegSet, timesRegSet, sizeRegSet, nullRegSet
, regSetToList
, regUsedIn, regSlot , regUsedIn, regSlot
, Area(..), AreaId(..), SubArea, SubAreaSet, AreaMap, isStackSlotOf , Area(..), AreaId(..), SubArea, SubAreaSet, AreaMap, isStackSlotOf
, module CmmMachOp , module CmmMachOp
...@@ -31,9 +32,10 @@ import CmmMachOp ...@@ -31,9 +32,10 @@ import CmmMachOp
import BlockId import BlockId
import CLabel import CLabel
import Unique import Unique
import UniqSet
import Data.Map (Map) import Data.Map (Map)
import Data.Set (Set)
import qualified Data.Set as Set
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- CmmExpr -- CmmExpr
...@@ -194,22 +196,35 @@ localRegType (LocalReg _ rep) = rep ...@@ -194,22 +196,35 @@ localRegType (LocalReg _ rep) = rep
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | Sets of local registers -- | Sets of local registers
type RegSet = UniqSet LocalReg
-- These are used for dataflow facts, and a common operation is taking
-- the union of two RegSets and then asking whether the union is the
-- same as one of the inputs. UniqSet isn't good here, because
-- sizeUniqSet is O(n) whereas Set.size is O(1), so we use ordinary
-- Sets.
type RegSet = Set LocalReg
emptyRegSet :: RegSet emptyRegSet :: RegSet
nullRegSet :: RegSet -> Bool
elemRegSet :: LocalReg -> RegSet -> Bool elemRegSet :: LocalReg -> RegSet -> Bool
extendRegSet :: RegSet -> LocalReg -> RegSet extendRegSet :: RegSet -> LocalReg -> RegSet
deleteFromRegSet :: RegSet -> LocalReg -> RegSet deleteFromRegSet :: RegSet -> LocalReg -> RegSet
mkRegSet :: [LocalReg] -> RegSet mkRegSet :: [LocalReg] -> RegSet
minusRegSet, plusRegSet, timesRegSet :: RegSet -> RegSet -> RegSet minusRegSet, plusRegSet, timesRegSet :: RegSet -> RegSet -> RegSet
sizeRegSet :: RegSet -> Int
emptyRegSet = emptyUniqSet regSetToList :: RegSet -> [LocalReg]
elemRegSet = elementOfUniqSet
extendRegSet = addOneToUniqSet emptyRegSet = Set.empty
deleteFromRegSet = delOneFromUniqSet nullRegSet = Set.null
mkRegSet = mkUniqSet elemRegSet = Set.member
minusRegSet = minusUniqSet extendRegSet = flip Set.insert
plusRegSet = unionUniqSets deleteFromRegSet = flip Set.delete
timesRegSet = intersectUniqSets mkRegSet = Set.fromList
minusRegSet = Set.difference
plusRegSet = Set.union
timesRegSet = Set.intersection
sizeRegSet = Set.size
regSetToList = Set.toList
class UserOfLocalRegs a where class UserOfLocalRegs a where
foldRegsUsed :: (b -> LocalReg -> b) -> b -> a -> b foldRegsUsed :: (b -> LocalReg -> b) -> b -> a -> b
...@@ -237,7 +252,7 @@ instance DefinerOfLocalRegs LocalReg where ...@@ -237,7 +252,7 @@ instance DefinerOfLocalRegs LocalReg where
foldRegsDefd f z r = f z r foldRegsDefd f z r = f z r
instance UserOfLocalRegs RegSet where instance UserOfLocalRegs RegSet where
foldRegsUsed f = foldUniqSet (flip f) foldRegsUsed f = Set.fold (flip f)
instance UserOfLocalRegs CmmExpr where instance UserOfLocalRegs CmmExpr where
foldRegsUsed f z e = expr z e foldRegsUsed f z e = expr z e
......
...@@ -33,8 +33,10 @@ type CmmLive = RegSet ...@@ -33,8 +33,10 @@ type CmmLive = RegSet
-- | The dataflow lattice -- | The dataflow lattice
liveLattice :: DataflowLattice CmmLive liveLattice :: DataflowLattice CmmLive
liveLattice = DataflowLattice "live LocalReg's" emptyRegSet add liveLattice = DataflowLattice "live LocalReg's" emptyRegSet add
where add _ (OldFact old) (NewFact new) = case unionUniqSets old new of where add _ (OldFact old) (NewFact new) =
join -> (changeIf $ sizeUniqSet join > sizeUniqSet old, join) (changeIf $ sizeRegSet join > sizeRegSet old, join)
where !join = plusRegSet old new
-- | A mapping from block labels to the variables live on entry -- | A mapping from block labels to the variables live on entry
type BlockEntryLiveness = BlockEnv CmmLive type BlockEntryLiveness = BlockEnv CmmLive
...@@ -52,7 +54,7 @@ cmmLiveness graph = ...@@ -52,7 +54,7 @@ cmmLiveness graph =
-- | On entry to the procedure, there had better not be any LocalReg's live-in. -- | On entry to the procedure, there had better not be any LocalReg's live-in.
noLiveOnEntry :: BlockId -> CmmLive -> a -> a noLiveOnEntry :: BlockId -> CmmLive -> a -> a
noLiveOnEntry bid in_fact x = noLiveOnEntry bid in_fact x =
if isEmptyUniqSet in_fact then x if nullRegSet in_fact then x
else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact) else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact)
-- | The transfer equations use the traditional 'gen' and 'kill' -- | The transfer equations use the traditional 'gen' and 'kill'
...@@ -60,7 +62,7 @@ noLiveOnEntry bid in_fact x = ...@@ -60,7 +62,7 @@ noLiveOnEntry bid in_fact x =
gen :: UserOfLocalRegs a => a -> RegSet -> RegSet gen :: UserOfLocalRegs a => a -> RegSet -> RegSet
gen a live = foldRegsUsed extendRegSet live a gen a live = foldRegsUsed extendRegSet live a
kill :: DefinerOfLocalRegs a => a -> RegSet -> RegSet kill :: DefinerOfLocalRegs a => a -> RegSet -> RegSet
kill a live = foldRegsDefd delOneFromUniqSet live a kill a live = foldRegsDefd deleteFromRegSet live a
gen_kill :: (DefinerOfLocalRegs a, UserOfLocalRegs a) => a -> CmmLive -> CmmLive gen_kill :: (DefinerOfLocalRegs a, UserOfLocalRegs a) => a -> CmmLive -> CmmLive
gen_kill a = gen a . kill a gen_kill a = gen a . kill a
......
...@@ -318,7 +318,7 @@ pass_live_vars_as_args _liveness procPoints protos = protos' ...@@ -318,7 +318,7 @@ pass_live_vars_as_args _liveness procPoints protos = protos'
Nothing -> let live = emptyRegSet Nothing -> let live = emptyRegSet
--lookupBlockEnv _liveness id `orElse` --lookupBlockEnv _liveness id `orElse`
--panic ("no liveness at block " ++ show id) --panic ("no liveness at block " ++ show id)
formals = uniqSetToList live formals = regSetToList live
prot = Protocol Private formals $ CallArea $ Young id prot = Protocol Private formals $ CallArea $ Young id
in mapInsert id prot protos in mapInsert id prot protos
......
...@@ -65,8 +65,8 @@ dualLiveLattice = DataflowLattice "variables live in registers and on stack" emp ...@@ -65,8 +65,8 @@ dualLiveLattice = DataflowLattice "variables live in registers and on stack" emp
add _ (OldFact old) (NewFact new) = (changeIf $ change1 || change2, DualLive stack regs) add _ (OldFact old) (NewFact new) = (changeIf $ change1 || change2, DualLive stack regs)
where (change1, stack) = add1 (on_stack old) (on_stack new) where (change1, stack) = add1 (on_stack old) (on_stack new)
(change2, regs) = add1 (in_regs old) (in_regs new) (change2, regs) = add1 (in_regs old) (in_regs new)
add1 old new = if sizeUniqSet join > sizeUniqSet old then (True, join) else (False, old) add1 old new = if sizeRegSet join > sizeRegSet old then (True, join) else (False, old)
where join = unionUniqSets old new where join = plusRegSet old new
dualLivenessWithInsertion :: BlockSet -> CmmGraph -> FuelUniqSM CmmGraph dualLivenessWithInsertion :: BlockSet -> CmmGraph -> FuelUniqSM CmmGraph
dualLivenessWithInsertion procPoints g = dualLivenessWithInsertion procPoints g =
...@@ -120,16 +120,16 @@ dualLiveTransfers entry procPoints = mkBTransfer3 first middle last ...@@ -120,16 +120,16 @@ dualLiveTransfers entry procPoints = mkBTransfer3 first middle last
keep_stack_only k = DualLive (on_stack (lkp k)) emptyRegSet keep_stack_only k = DualLive (on_stack (lkp k)) emptyRegSet
insertSpillsAndReloads :: CmmGraph -> BlockSet -> CmmBwdRewrite DualLive insertSpillsAndReloads :: CmmGraph -> BlockSet -> CmmBwdRewrite DualLive
insertSpillsAndReloads graph procPoints = deepBwdRw3 first middle nothing insertSpillsAndReloads graph procPoints = mkBRewrite3 first middle nothing
-- Beware: deepBwdRw with one polymorphic function seems more reasonable here, -- Beware: deepBwdRw with one polymorphic function seems more reasonable here,
-- but GHC miscompiles it, see bug #4044. -- but GHC miscompiles it, see bug #4044.
where first :: CmmNode C O -> Fact O DualLive -> CmmReplGraph C O where first :: CmmNode C O -> Fact O DualLive -> CmmReplGraph C O
first e@(CmmEntry id) live = return $ first e@(CmmEntry id) live =
if id /= (g_entry graph) && setMember id procPoints then if id /= (g_entry graph) && setMember id procPoints then
case map reload (uniqSetToList (in_regs live)) of case map reload (regSetToList (in_regs live)) of
[] -> Nothing [] -> return Nothing
is -> Just $ mkFirst e <*> mkMiddles is is -> return $ Just $ mkFirst e <*> mkMiddles is
else Nothing else return Nothing
-- EZY: There was some dead code for handling the case where -- EZY: There was some dead code for handling the case where
-- we were not splitting procedures. Check Git history if -- we were not splitting procedures. Check Git history if
-- you're interested (circa e26ea0f41). -- you're interested (circa e26ea0f41).
...@@ -152,15 +152,15 @@ reload r = CmmAssign (CmmLocal r) (CmmLoad (regSlot r) $ localRegType r) ...@@ -152,15 +152,15 @@ reload r = CmmAssign (CmmLocal r) (CmmLoad (regSlot r) $ localRegType r)
-- prettyprinting -- prettyprinting
ppr_regs :: String -> RegSet -> SDoc ppr_regs :: String -> RegSet -> SDoc
ppr_regs s regs = text s <+> commafy (map ppr $ uniqSetToList regs) ppr_regs s regs = text s <+> commafy (map ppr $ regSetToList regs)
where commafy xs = hsep $ punctuate comma xs where commafy xs = hsep $ punctuate comma xs
instance Outputable DualLive where instance Outputable DualLive where
ppr (DualLive {in_regs = regs, on_stack = stack}) = ppr (DualLive {in_regs = regs, on_stack = stack}) =
if isEmptyUniqSet regs && isEmptyUniqSet stack then if nullRegSet regs && nullRegSet stack then
text "<nothing-live>" text "<nothing-live>"
else else
nest 2 $ fsep [if isEmptyUniqSet regs then PP.empty nest 2 $ fsep [if nullRegSet regs then PP.empty
else (ppr_regs "live in regs =" regs), else (ppr_regs "live in regs =" regs),
if isEmptyUniqSet stack then PP.empty if nullRegSet stack then PP.empty
else (ppr_regs "live on stack =" stack)] else (ppr_regs "live on stack =" stack)]
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment