CmmLive.hs 3.58 KB
Newer Older
1
{-# LANGUAGE BangPatterns #-}
2
{-# LANGUAGE FlexibleContexts #-}
3
{-# LANGUAGE GADTs #-}
4
{-# LANGUAGE ScopedTypeVariables #-}
5

Jan Stolarek's avatar
Jan Stolarek committed
6
-- See Note [Deprecations in Hoopl] in Hoopl module
7
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
8

9
module CmmLive
10 11 12
    ( CmmLocalLive
    , cmmLocalLiveness
    , cmmGlobalLiveness
13
    , liveLattice
14
    , gen_kill
15 16
    )
where
17

18
import DynFlags
19
import BlockId
20
import Cmm
21
import PprCmmExpr ()
22
import Hoopl.Dataflow
23 24

import Maybes
25
import Outputable
26 27 28 29 30

-----------------------------------------------------------------------------
-- Calculating what variables are live on entry to a basic block
-----------------------------------------------------------------------------

31
-- | The variables live on entry to a block
32 33
type CmmLive r = RegSet r
type CmmLocalLive = CmmLive LocalReg
34 35

-- | The dataflow lattice
36 37 38
liveLattice :: Ord r => DataflowLattice (CmmLive r)
{-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive LocalReg) #-}
{-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive GlobalReg) #-}
39
liveLattice = DataflowLattice "live LocalReg's" emptyRegSet add
40 41 42 43
    where add _ (OldFact old) (NewFact new) =
               (changeIf $ sizeRegSet join > sizeRegSet old, join)
              where !join = plusRegSet old new

44

45
-- | A mapping from block labels to the variables live on entry
46
type BlockEntryLiveness r = BlockEnv (CmmLive r)
47

48
-----------------------------------------------------------------------------
49
-- | Calculated liveness info for a CmmGraph
50
-----------------------------------------------------------------------------
51

52 53
cmmLocalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness LocalReg
cmmLocalLiveness dflags graph =
54
  check $ dataflowAnalBwd graph [] liveLattice (xferLive dflags)
55
  where entry = g_entry graph
56 57
        check facts = noLiveOnEntry entry
                        (expectJust "check" $ mapLookup entry facts) facts
58

59 60
cmmGlobalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness GlobalReg
cmmGlobalLiveness dflags graph =
61
  dataflowAnalBwd graph [] liveLattice (xferLive dflags)
62

63
-- | On entry to the procedure, there had better not be any LocalReg's live-in.
64
noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a
65
noLiveOnEntry bid in_fact x =
66
  if nullRegSet in_fact then x
67 68 69
  else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact)

-- | The transfer equations use the traditional 'gen' and 'kill'
70
-- notations, which should be familiar from the Dragon Book.
71 72 73 74 75 76 77
gen  :: UserOfRegs r a => DynFlags -> a -> RegSet r -> RegSet r
{-# INLINE gen #-}
gen dflags a live = foldRegsUsed dflags extendRegSet live a

kill :: DefinerOfRegs r a => DynFlags -> a -> RegSet r -> RegSet r
{-# INLINE kill #-}
kill dflags a live = foldRegsDefd dflags deleteFromRegSet live a
78

79 80 81 82
gen_kill :: (DefinerOfRegs r a, UserOfRegs r a)
          => DynFlags -> a -> CmmLive r -> CmmLive r
{-# INLINE gen_kill #-}
gen_kill dflags a = gen dflags a . kill dflags a
83 84

-- | The transfer function
85 86 87 88 89 90 91 92
xferLive :: forall r . ( UserOfRegs    r (CmmNode O O)
                       , DefinerOfRegs r (CmmNode O O)
                       , UserOfRegs    r (CmmNode O C)
                       , DefinerOfRegs r (CmmNode O C))
         => DynFlags -> BwdTransfer CmmNode (CmmLive r)
{-# SPECIALIZE xferLive :: DynFlags -> BwdTransfer CmmNode (CmmLive LocalReg) #-}
{-# SPECIALIZE xferLive :: DynFlags -> BwdTransfer CmmNode (CmmLive GlobalReg) #-}
xferLive dflags = mkBTransfer3 fst mid lst
93
  where fst _ f = f
94 95 96 97
        mid :: CmmNode O O -> CmmLive r -> CmmLive r
        mid n f = gen_kill dflags n f
        lst :: CmmNode O C -> FactBase (CmmLive r) -> CmmLive r
        lst n f = gen_kill dflags n $ joinOutFacts liveLattice n f