NCG: Refactor representation of code with liveness info

 * I've pushed the SPILL and RELOAD instrs down into the
   LiveInstr type to make them easier to work with.

 * When the graph allocator does a spill cycle it now just
   re-annotates the LiveCmmTops instead of converting them
   to NatCmmTops and back.

 * This saves working out the SCCS again, and avoids rewriting
   the SPILL and RELOAD meta instructions into real machine
   instructions.

diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index d73cb89..79d55f0 100644 (file)
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -304,7 +304,9 @@ cmmNativeGen dflags us cmm count
        -- tag instructions with register liveness information
        let (withLiveness, usLive) =
                {-# SCC "regLiveness" #-}
-               initUs usGen $ mapUs regLiveness native
+               initUs usGen 
+                       $ mapUs regLiveness 
+                       $ map natCmmTopToLive native
 
        dumpIfSet_dyn dflags
                Opt_D_dump_asm_liveness "Liveness annotations added"

diff --git a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
index a5d95a3..e0fad17 100644 (file)
--- a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
@@ -73,8 +73,8 @@ slurpJoinMovs live
        slurpCmm   rs (CmmProc _ _ _ sccs)      = foldl' slurpBlock rs (flattenSCCs sccs)
         slurpBlock rs (BasicBlock _ instrs)    = foldl' slurpLI    rs instrs
                 
-        slurpLI    rs (Instr _ Nothing)                 = rs
-       slurpLI    rs (Instr instr (Just live))
+        slurpLI    rs (LiveInstr _     Nothing) = rs
+       slurpLI    rs (LiveInstr instr (Just live))
                | Just (r1, r2) <- takeRegRegMoveInstr instr
                , elementOfUniqSet r1 $ liveDieRead live
                , elementOfUniqSet r2 $ liveBorn live
@@ -86,8 +86,5 @@ slurpJoinMovs live
                
                | otherwise
                = rs
-       
-       slurpLI    rs SPILL{}   = rs
-       slurpLI    rs RELOAD{}  = rs
                
        

diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs
index 40c3c00..093c211 100644 (file)
--- a/compiler/nativeGen/RegAlloc/Graph/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs
@@ -211,8 +211,8 @@ regAlloc_spin
                        <- regSpill code_coalesced slotsFree rsSpill
 
                -- recalculate liveness
-               let code_nat    = map stripLive code_spilled
-               code_relive     <- mapM regLiveness code_nat
+--             let code_nat    = map stripLive code_spilled
+               code_relive     <- mapM regLiveness code_spilled
 
                -- record what happened in this stage for debugging
                let stat        =

diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
index f9a2586..10bd669 100644 (file)
--- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
@@ -80,19 +80,11 @@ regSpill_instr
        => UniqFM Int 
        -> LiveInstr instr -> SpillM [LiveInstr instr]
 
--- | The thing we're spilling shouldn't already have spill or reloads in it
-regSpill_instr _ SPILL{}
-       = panic "regSpill_instr: unexpected SPILL"
-
-regSpill_instr _ RELOAD{}
-       = panic "regSpill_instr: unexpected RELOAD"
-
-
-regSpill_instr _       li@(Instr _ Nothing)
+regSpill_instr _ li@(LiveInstr _ Nothing)
  = do  return [li]
 
 regSpill_instr regSlotMap
-       (Instr instr (Just _))
+       (LiveInstr instr (Just _))
  = do
        -- work out which regs are read and written in this instr
        let RU rlRead rlWritten = regUsageOfInstr instr
@@ -123,7 +115,7 @@ regSpill_instr regSlotMap
 
        -- final code
        let instrs'     =  prefixes
-                       ++ [Instr instr3 Nothing]
+                       ++ [LiveInstr instr3 Nothing]
                        ++ postfixes
 
        return
@@ -147,7 +139,7 @@ spillRead regSlotMap instr reg
                        { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
 
                return  ( instr'
-                       , ( [RELOAD slot nReg]
+                       , ( [LiveInstr (RELOAD slot nReg) Nothing]
                          , []) )
 
        | otherwise     = panic "RegSpill.spillRead: no slot defined for spilled reg"
@@ -162,7 +154,7 @@ spillWrite regSlotMap instr reg
 
                return  ( instr'
                        , ( []
-                         , [SPILL nReg slot]))
+                         , [LiveInstr (SPILL nReg slot) Nothing]))
 
        | otherwise     = panic "RegSpill.spillWrite: no slot defined for spilled reg"
 
@@ -175,8 +167,8 @@ spillModify regSlotMap instr reg
                        { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
 
                return  ( instr'
-                       , ( [RELOAD slot nReg]
-                         , [SPILL nReg slot]))
+                       , ( [LiveInstr (RELOAD slot nReg) Nothing]
+                         , [LiveInstr (SPILL nReg slot) Nothing]))
 
        | otherwise     = panic "RegSpill.spillModify: no slot defined for spilled reg"
 

diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
index 15fbb59..11e3cef 100644 (file)
--- a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
@@ -158,16 +158,16 @@ cleanForward _ _ acc []
 --
 cleanForward blockId assoc acc (li1 : li2 : instrs)
 
-       | SPILL  reg1  slot1    <- li1
-       , RELOAD slot2 reg2     <- li2
+       | LiveInstr (SPILL  reg1  slot1) _      <- li1
+       , LiveInstr (RELOAD slot2 reg2)  _      <- li2
        , slot1 == slot2
        = do
                modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
                cleanForward blockId assoc acc
-                       (li1 : Instr (mkRegRegMoveInstr reg1 reg2) Nothing : instrs)
+                       (li1 : LiveInstr (mkRegRegMoveInstr reg1 reg2) Nothing : instrs)
 
 
-cleanForward blockId assoc acc (li@(Instr i1 _) : instrs)
+cleanForward blockId assoc acc (li@(LiveInstr i1 _) : instrs)
        | Just (r1, r2) <- takeRegRegMoveInstr i1
        = if r1 == r2
                -- erase any left over nop reg reg moves while we're here
@@ -187,35 +187,32 @@ cleanForward blockId assoc acc (li@(Instr i1 _) : instrs)
 cleanForward blockId assoc acc (li : instrs)
 
        -- update association due to the spill
-       | SPILL reg slot        <- li
+       | LiveInstr (SPILL reg slot) _  <- li
        = let   assoc'  = addAssoc (SReg reg)  (SSlot slot)
                        $ delAssoc (SSlot slot)
                        $ assoc
          in    cleanForward blockId assoc' (li : acc) instrs
 
        -- clean a reload instr
-       | RELOAD{}              <- li
+       | LiveInstr (RELOAD{}) _        <- li
        = do    (assoc', mli)   <- cleanReload blockId assoc li
                case mli of
                 Nothing        -> cleanForward blockId assoc' acc              instrs
                 Just li'       -> cleanForward blockId assoc' (li' : acc)      instrs
 
        -- remember the association over a jump
-       | Instr instr _         <- li
+       | LiveInstr instr _     <- li
        , targets               <- jumpDestsOfInstr instr
        , not $ null targets
        = do    mapM_ (accJumpValid assoc) targets
                cleanForward blockId assoc (li : acc) instrs
 
        -- writing to a reg changes its value.
-       | Instr instr _         <- li
+       | LiveInstr instr _     <- li
        , RU _ written          <- regUsageOfInstr instr
        = let assoc'    = foldr delAssoc assoc (map SReg $ nub written)
          in  cleanForward blockId assoc' (li : acc) instrs
 
--- bogus, to stop pattern match warning
-cleanForward _ _ _ _ 
-       = panic "RegAlloc.Graph.SpillClean.cleanForward: no match"
 
 
 -- | Try and rewrite a reload instruction to something more pleasing
@@ -227,7 +224,7 @@ cleanReload
        -> LiveInstr instr
        -> CleanM (Assoc Store, Maybe (LiveInstr instr))
 
-cleanReload blockId assoc li@(RELOAD slot reg)
+cleanReload blockId assoc li@(LiveInstr (RELOAD slot reg) _)
 
        -- if the reg we're reloading already has the same value as the slot
        --      then we can erase the instruction outright
@@ -244,7 +241,7 @@ cleanReload blockId assoc li@(RELOAD slot reg)
                                $ delAssoc (SReg reg)
                                $ assoc
 
-               return  (assoc', Just $ Instr (mkRegRegMoveInstr reg2 reg) Nothing)
+               return  (assoc', Just $ LiveInstr (mkRegRegMoveInstr reg2 reg) Nothing)
 
        -- gotta keep this instr
        | otherwise
@@ -306,12 +303,12 @@ cleanBackward' _ _      acc []
 cleanBackward' reloadedBy noReloads acc (li : instrs)
 
        -- if nothing ever reloads from this slot then we don't need the spill
-       | SPILL _ slot  <- li
+       | LiveInstr (SPILL _ slot) _    <- li
        , Nothing       <- lookupUFM reloadedBy (SSlot slot)
        = do    modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
                cleanBackward noReloads acc instrs
 
-       | SPILL _ slot  <- li
+       | LiveInstr (SPILL _ slot) _    <- li
        = if elementOfUniqSet slot noReloads
 
           -- we can erase this spill because the slot won't be read until after the next one
@@ -325,7 +322,7 @@ cleanBackward' reloadedBy noReloads acc (li : instrs)
                cleanBackward noReloads' (li : acc) instrs
 
        -- if we reload from a slot then it's no longer unused
-       | RELOAD slot _         <- li
+       | LiveInstr (RELOAD slot _) _   <- li
        , noReloads'            <- delOneFromUniqSet noReloads slot
        = cleanBackward noReloads' (li : acc) instrs
 

diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
index 5932d31..9799587 100644 (file)
--- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
@@ -93,13 +93,7 @@ slurpSpillCostInfo cmm
                = return ()
 
        -- skip over comment and delta pseudo instrs
-       countLIs rsLive (SPILL{} : lis)
-               = countLIs rsLive lis
-               
-       countLIs rsLive (RELOAD{} : lis)
-               = countLIs rsLive lis
-
-       countLIs rsLive (Instr instr Nothing : lis)
+       countLIs rsLive (LiveInstr instr Nothing : lis)
                | isMetaInstr instr
                = countLIs rsLive lis
 
@@ -107,7 +101,7 @@ slurpSpillCostInfo cmm
                = pprPanic "RegSpillCost.slurpSpillCostInfo"
                        (text "no liveness information on instruction " <> ppr instr)
 
-       countLIs rsLiveEntry (Instr instr (Just live) : lis)
+       countLIs rsLiveEntry (LiveInstr instr (Just live) : lis)
         = do
                -- increment the lifetime counts for regs live on entry to this instr
                mapM_ incLifetime $ uniqSetToList rsLiveEntry

diff --git a/compiler/nativeGen/RegAlloc/Graph/Stats.hs b/compiler/nativeGen/RegAlloc/Graph/Stats.hs
index 339bd41..cdce1b6 100644 (file)
--- a/compiler/nativeGen/RegAlloc/Graph/Stats.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Stats.hs
@@ -258,15 +258,15 @@ countSRM_block (BasicBlock i instrs)
        return  $ BasicBlock i instrs'
 
 countSRM_instr li
-       | SPILL _ _     <- li
-       = do    modify  $ \(s, r, m)    -> (s + 1, r, m)
+       | LiveInstr SPILL{} _    <- li
+       = do    modify  $ \(s, r, m)    -> (s + 1, r, m)
                return li
 
-       | RELOAD _ _    <- li
-       = do    modify  $ \(s, r, m)    -> (s, r + 1, m)
+       | LiveInstr RELOAD{} _  <- li
+       = do    modify  $ \(s, r, m)    -> (s, r + 1, m)
                return li
-
-       | Instr instr _ <- li
+       
+       | LiveInstr instr _     <- li
        , Just _        <- takeRegRegMoveInstr instr
        = do    modify  $ \(s, r, m)    -> (s, r, m + 1)
                return li

diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index 0014eec..29cc0e5 100644 (file)
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -292,7 +292,7 @@ linearRA _          accInstr accFixup _ []
 
 linearRA block_live accInstr accFixups id (instr:instrs)
  = do
-       (accInstr', new_fixups) 
+       (accInstr', new_fixups) 
                <- raInsn block_live accInstr id instr
 
        linearRA block_live accInstr' (new_fixups ++ accFixups) id instrs
@@ -309,17 +309,17 @@ raInsn
                ( [instr]                       -- new instructions
                , [NatBasicBlock instr])        -- extra fixup blocks
 
-raInsn _     new_instrs _ (Instr ii Nothing)  
+raInsn _     new_instrs _ (LiveInstr ii Nothing)  
        | Just n        <- takeDeltaInstr ii
        = do    setDeltaR n
                return (new_instrs, [])
 
-raInsn _     new_instrs _ (Instr ii Nothing)
+raInsn _     new_instrs _ (LiveInstr ii Nothing)
        | isMetaInstr ii
        = return (new_instrs, [])
 
 
-raInsn block_live new_instrs id (Instr instr (Just live))
+raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))
  = do
     assig    <- getAssigR
 
@@ -380,9 +380,9 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying =
     clobber_saves      <- saveClobberedTemps real_written r_dying
 
     -- debugging
-{-  freeregs <- getFreeRegsR
+    freeregs <- getFreeRegsR
     assig    <- getAssigR
-    pprTrace "genRaInsn" 
+{-    pprTrace "genRaInsn" 
        (ppr instr 
                $$ text "r_dying      = " <+> ppr r_dying 
                $$ text "w_dying      = " <+> ppr w_dying 

diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index e4481b5..69ec7ae 100644 (file)
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -12,6 +12,7 @@ module RegAlloc.Liveness (
        RegMap, emptyRegMap,
        BlockMap, emptyBlockMap,
        LiveCmmTop,
+       InstrSR   (..),
        LiveInstr (..),
        Liveness (..),
        LiveInfo (..),
@@ -26,8 +27,8 @@ module RegAlloc.Liveness (
        eraseDeltasLive,
        patchEraseLive,
        patchRegsLiveInstr,
-       regLiveness
-
+       regLiveness,
+       natCmmTopToLive
   ) where
 
 
@@ -73,17 +74,76 @@ type LiveCmmTop instr
                [SCC (LiveBasicBlock instr)]
 
 
--- | An instruction with liveness information.
-data LiveInstr instr
-       = Instr instr (Maybe Liveness)
+-- | The register allocator also wants to use SPILL/RELOAD meta instructions,
+--     so we'll keep those here.
+data InstrSR instr
+       -- | A real machine instruction
+       = Instr  instr
 
        -- | spill this reg to a stack slot
-       | SPILL Reg Int
+       | SPILL  Reg Int
 
        -- | reload this reg from a stack slot
        | RELOAD Int Reg
+
+instance Instruction instr => Instruction (InstrSR instr) where
+       regUsageOfInstr i
+        = case i of
+               Instr  instr    -> regUsageOfInstr instr
+               SPILL  reg _    -> RU [reg] []
+               RELOAD _ reg    -> RU [] [reg]
+
+       patchRegsOfInstr i f
+        = case i of
+               Instr instr     -> Instr (patchRegsOfInstr instr f)
+               SPILL  reg slot -> SPILL (f reg) slot
+               RELOAD slot reg -> RELOAD slot (f reg)
+
+       isJumpishInstr i
+        = case i of
+               Instr instr     -> isJumpishInstr instr
+               _               -> False
+
+       jumpDestsOfInstr i
+        = case i of
+               Instr instr     -> jumpDestsOfInstr instr 
+               _               -> []
+
+       patchJumpInstr i f
+        = case i of
+               Instr instr     -> Instr (patchJumpInstr instr f)
+               _               -> i
+
+       mkSpillInstr            = error "mkSpillInstr[InstrSR]: Not making SPILL meta-instr"
+       mkLoadInstr             = error "mkLoadInstr[InstrSR]: Not making LOAD meta-instr"
+
+       takeDeltaInstr i
+        = case i of
+               Instr instr     -> takeDeltaInstr instr
+               _               -> Nothing
+
+       isMetaInstr i
+        = case i of
+               Instr instr     -> isMetaInstr instr
+               _               -> False
+
+       mkRegRegMoveInstr r1 r2 = Instr (mkRegRegMoveInstr r1 r2)
+
+       takeRegRegMoveInstr i
+        = case i of
+               Instr instr     -> takeRegRegMoveInstr instr
+               _               -> Nothing
+
+       mkJumpInstr target      = map Instr (mkJumpInstr target)
+               
+
+
+-- | An instruction with liveness information.
+data LiveInstr instr
+       = LiveInstr (InstrSR instr) (Maybe Liveness)
        
 
+
 -- | Liveness information.
 --     The regs which die are ones which are no longer live in the *next* instruction
 --     in this sequence.
@@ -110,8 +170,12 @@ type LiveBasicBlock instr
        = GenBasicBlock (LiveInstr instr)
 
 
-instance Outputable instr 
-      => Outputable (LiveInstr instr) where
+instance Outputable instr
+      => Outputable (InstrSR instr) where
+
+       ppr (Instr realInstr)
+          = ppr realInstr
+
        ppr (SPILL reg slot)
           = hcat [
                ptext (sLit "\tSPILL"),
@@ -128,10 +192,13 @@ instance Outputable instr
                comma,
                ppr reg]
 
-       ppr (Instr instr Nothing)
+instance Outputable instr 
+      => Outputable (LiveInstr instr) where
+
+       ppr (LiveInstr instr Nothing)
         = ppr instr
 
-       ppr (Instr instr (Just live))
+       ppr (LiveInstr instr (Just live))
         =  ppr instr
                $$ (nest 8
                        $ vcat
@@ -186,12 +253,6 @@ mapSCCM f (CyclicSCC xs)
  = do  xs'     <- mapM f xs
        return  $ CyclicSCC xs'
 
-{-
-mapBlockCompM :: Monad m => (a -> m a') -> (GenBasicBlock a) -> m (GenBasicBlock a')
-mapBlockCompM f (BasicBlock i blocks)
- = do  blocks' <- mapM f blocks
-       return  $ BasicBlock i blocks'
--}
 
 -- map a function across all the basic blocks in this code
 mapGenBlockTop
@@ -250,17 +311,10 @@ slurpConflicts live
        slurpLIs rsLive (conflicts, moves) []
                = (consBag rsLive conflicts, moves)
 
-       slurpLIs rsLive rs (Instr _ Nothing     : lis)  
+       slurpLIs rsLive rs (LiveInstr _ Nothing     : lis)      
                = slurpLIs rsLive rs lis
-
-       -- we're not expecting to be slurping conflicts from spilled code
-       slurpLIs _ _ (SPILL _ _ : _)
-               = panic "Liveness.slurpConflicts: unexpected SPILL"
-
-       slurpLIs _ _ (RELOAD _ _ : _)
-               = panic "Liveness.slurpConflicts: unexpected RELOAD"
                
-       slurpLIs rsLiveEntry (conflicts, moves) (Instr instr (Just live) : lis)
+       slurpLIs rsLiveEntry (conflicts, moves) (LiveInstr instr (Just live) : lis)
         = let
                -- regs that die because they are read for the last time at the start of an instruction
                --      are not live across it.
@@ -349,12 +403,12 @@ slurpReloadCoalesce live
        slurpLI slotMap li
 
                -- remember what reg was stored into the slot
-               | SPILL reg slot        <- li
-               , slotMap'              <- addToUFM slotMap slot reg
+               | LiveInstr (SPILL reg slot) _  <- li
+               , slotMap'                      <- addToUFM slotMap slot reg
                = return (slotMap', Nothing)
 
                -- add an edge betwen the this reg and the last one stored into the slot
-               | RELOAD slot reg       <- li
+               | LiveInstr (RELOAD slot reg) _ <- li
                = case lookupUFM slotMap slot of
                        Just reg2
                         | reg /= reg2  -> return (slotMap, Just (reg, reg2))
@@ -363,8 +417,8 @@ slurpReloadCoalesce live
                        Nothing         -> return (slotMap, Nothing)
 
                -- if we hit a jump, remember the current slotMap
-               | Instr instr _         <- li
-               , targets               <- jumpDestsOfInstr instr
+               | LiveInstr (Instr instr) _     <- li
+               , targets                       <- jumpDestsOfInstr instr
                , not $ null targets
                = do    mapM_   (accSlotMap slotMap) targets
                        return  (slotMap, Nothing)
@@ -425,20 +479,20 @@ stripLiveBlock (BasicBlock i lis)
        spillNat acc []
         =      return (reverse acc)
 
-       spillNat acc (SPILL reg slot : instrs)
+       spillNat acc (LiveInstr (SPILL reg slot) _ : instrs)
         = do   delta   <- get
                spillNat (mkSpillInstr reg delta slot : acc) instrs
 
-       spillNat acc (RELOAD slot reg : instrs)
+       spillNat acc (LiveInstr (RELOAD slot reg) _ : instrs)
         = do   delta   <- get
                spillNat (mkLoadInstr reg delta slot : acc) instrs
 
-       spillNat acc (Instr instr _ : instrs)
+       spillNat acc (LiveInstr (Instr instr) _ : instrs)
         | Just i <- takeDeltaInstr instr
         = do   put i
                spillNat acc instrs
 
-       spillNat acc (Instr instr _ : instrs)
+       spillNat acc (LiveInstr (Instr instr) _ : instrs)
         =      spillNat (instr : acc) instrs
 
 
@@ -454,7 +508,7 @@ eraseDeltasLive cmm
  where
        eraseBlock (BasicBlock id lis)
                = BasicBlock id
-               $ filter (\(Instr i _) -> not $ isJust $ takeDeltaInstr i)
+               $ filter (\(LiveInstr i _) -> not $ isJust $ takeDeltaInstr i)
                $ lis
 
 
@@ -493,7 +547,7 @@ patchEraseLive patchF cmm
        patchInstrs []          = []
        patchInstrs (li : lis)
 
-               | Instr i (Just live)   <- li'
+               | LiveInstr i (Just live)       <- li'
                , Just (r1, r2) <- takeRegRegMoveInstr i
                , eatMe r1 r2 live
                = patchInstrs lis
@@ -524,11 +578,11 @@ patchRegsLiveInstr
 
 patchRegsLiveInstr patchF li
  = case li of
-       Instr instr Nothing
-        -> Instr (patchRegsOfInstr instr patchF) Nothing
+       LiveInstr instr Nothing
+        -> LiveInstr (patchRegsOfInstr instr patchF) Nothing
 
-       Instr instr (Just live)
-        -> Instr
+       LiveInstr instr (Just live)
+        -> LiveInstr
                (patchRegsOfInstr instr patchF)
                (Just live
                        { -- WARNING: have to go via lists here because patchF changes the uniq in the Reg
@@ -536,87 +590,79 @@ patchRegsLiveInstr patchF li
                        , liveDieRead   = mkUniqSet $ map patchF $ uniqSetToList $ liveDieRead live
                        , liveDieWrite  = mkUniqSet $ map patchF $ uniqSetToList $ liveDieWrite live })
 
-       SPILL reg slot
-        -> SPILL (patchF reg) slot
-               
-       RELOAD slot reg
-        -> RELOAD slot (patchF reg)
-
 
 --------------------------------------------------------------------------------
 -- | Convert a NatCmmTop to a LiveCmmTop, with empty liveness information
-{-
+
 natCmmTopToLive 
-       :: NatCmmTop instr
+       :: Instruction instr
+       => NatCmmTop instr
        -> LiveCmmTop instr
 
-natCmmTopToLive cmm@(CmmData _ _)
-       = cmm
+natCmmTopToLive (CmmData i d)
+       = CmmData i d
 
 natCmmTopToLive (CmmProc info lbl params (ListGraph []))
-       = CmmProc (LiveInfo info Nothing emptyBlockEnv)
-               lbl params (ListGraph []))
+       = CmmProc (LiveInfo info Nothing Nothing)
+                 lbl params []
+
+natCmmTopToLive (CmmProc info lbl params (ListGraph blocks@(first : _)))
+ = let first_id        = blockId first
+       sccs            = sccBlocks blocks
+       sccsLive        = map (fmap (\(BasicBlock l instrs) -> 
+                                       BasicBlock l (map (\i -> LiveInstr (Instr i) Nothing) instrs)))
+                       $ sccs
+                               
+   in  CmmProc (LiveInfo info (Just first_id) Nothing)
+               lbl params sccsLive
+
 
-natCmmTopToLive (CmmProc info lbl params (ListGraph blocks))
- = let first_id                = blockId first
-       sccs                    = sccBlocks blocks
+sccBlocks 
+       :: Instruction instr
+       => [NatBasicBlock instr] 
+       -> [SCC (NatBasicBlock instr)]
+
+sccBlocks blocks = stronglyConnCompFromEdgedVertices graph
+  where
+       getOutEdges :: Instruction instr => [instr] -> [BlockId]
+       getOutEdges instrs = concat $ map jumpDestsOfInstr instrs
 
-       liveBlocks
-        = map (\scc -> case scc of
-                       AcyclicSCC  b@(BasicBlock l _)          -> BasicBlock l [cmmBlockToLive b]      
-                       CyclicSCC  bs@(BasicBlock l _ : _)      -> BasicBlock l (map cmmBlockToLive bs)
-                       CyclicSCC  []   
-                        -> panic "RegLiveNess.natCmmTopToLive: no blocks in scc list")
-               sccs
+       graph = [ (block, getUnique id, map getUnique (getOutEdges instrs))
+               | block@(BasicBlock id instrs) <- blocks ]
 
-   in  CmmProc (LiveInfo info (Just first_id) ???
--}
 
 ---------------------------------------------------------------------------------
 -- Annotate code with register liveness information
 --
 regLiveness
        :: Instruction instr
-       => NatCmmTop instr
+       => LiveCmmTop instr
        -> UniqSM (LiveCmmTop instr)
 
 regLiveness (CmmData i d)
        = returnUs $ CmmData i d
 
-regLiveness (CmmProc info lbl params (ListGraph []))
+regLiveness (CmmProc info lbl params [])
+       | LiveInfo static mFirst _      <- info
        = returnUs $ CmmProc
-                       (LiveInfo info Nothing (Just emptyBlockEnv))
+                       (LiveInfo static mFirst (Just emptyBlockEnv))
                        lbl params []
 
-regLiveness (CmmProc info lbl params (ListGraph blocks@(first : _)))
- = let         first_id                = blockId first
-       sccs                    = sccBlocks blocks
-       (ann_sccs, block_live)  = computeLiveness sccs
+regLiveness (CmmProc info lbl params sccs)
+       | LiveInfo static mFirst _      <- info
+       = let   (ann_sccs, block_live)  = computeLiveness sccs
 
-   in  returnUs $ CmmProc (LiveInfo info (Just first_id) (Just block_live))
+         in    returnUs $ CmmProc (LiveInfo static mFirst (Just block_live))
                           lbl params ann_sccs
 
 
-sccBlocks 
-       :: Instruction instr
-       => [NatBasicBlock instr] 
-       -> [SCC (NatBasicBlock instr)]
-
-sccBlocks blocks = stronglyConnCompFromEdgedVertices graph
-  where
-       getOutEdges :: Instruction instr => [instr] -> [BlockId]
-       getOutEdges instrs = concat $ map jumpDestsOfInstr instrs
-
-       graph = [ (block, getUnique id, map getUnique (getOutEdges instrs))
-               | block@(BasicBlock id instrs) <- blocks ]
-
 
 -- -----------------------------------------------------------------------------
 -- Computing liveness
 
 computeLiveness
        :: Instruction instr
-       => [SCC (NatBasicBlock instr)]
+       => [SCC (LiveBasicBlock instr)]
        -> ([SCC (LiveBasicBlock instr)],       -- instructions annotated with list of registers
                                                -- which are "dead after this instruction".
               BlockMap RegSet)                 -- blocks annontated with set of live registers
@@ -634,11 +680,12 @@ livenessSCCs
        :: Instruction instr
        => BlockMap RegSet
        -> [SCC (LiveBasicBlock instr)]         -- accum
-       -> [SCC (NatBasicBlock instr)]
+       -> [SCC (LiveBasicBlock instr)]
        -> ( [SCC (LiveBasicBlock instr)]
                  , BlockMap RegSet)
 
-livenessSCCs blockmap done [] = (done, blockmap)
+livenessSCCs blockmap done [] 
+       = (done, blockmap)
 
 livenessSCCs blockmap done (AcyclicSCC block : sccs)
  = let (blockmap', block')     = livenessBlock blockmap block
@@ -666,7 +713,7 @@ livenessSCCs blockmap done
 
             linearLiveness 
                :: Instruction instr
-               => BlockMap RegSet -> [NatBasicBlock instr]
+               => BlockMap RegSet -> [LiveBasicBlock instr]
                -> (BlockMap RegSet, [LiveBasicBlock instr])
 
             linearLiveness = mapAccumL livenessBlock
@@ -686,7 +733,7 @@ livenessSCCs blockmap done
 livenessBlock
        :: Instruction instr
        => BlockMap RegSet
-       -> NatBasicBlock instr
+       -> LiveBasicBlock instr
        -> (BlockMap RegSet, LiveBasicBlock instr)
 
 livenessBlock blockmap (BasicBlock block_id instrs)
@@ -710,7 +757,7 @@ livenessForward
        -> [LiveInstr instr] -> [LiveInstr instr]
 
 livenessForward _           [] = []
-livenessForward rsLiveEntry (li@(Instr instr mLive) : lis)
+livenessForward rsLiveEntry (li@(LiveInstr instr mLive) : lis)
        | Nothing               <- mLive
        = li : livenessForward rsLiveEntry lis
 
@@ -726,7 +773,7 @@ livenessForward rsLiveEntry (li@(Instr instr mLive) : lis)
                                        `minusUniqSet` (liveDieRead live)
                                        `minusUniqSet` (liveDieWrite live)
 
-       in Instr instr (Just live { liveBorn = rsBorn })
+       in LiveInstr instr (Just live { liveBorn = rsBorn })
                : livenessForward rsLiveNext lis
 
 livenessForward _ _            = panic "RegLiveness.livenessForward: no match"
@@ -740,7 +787,7 @@ livenessBack
        => RegSet                       -- regs live on this instr
        -> BlockMap RegSet              -- regs live on entry to other BBs
        -> [LiveInstr instr]            -- instructions (accum)
-       -> [instr]                      -- instructions
+       -> [LiveInstr instr]            -- instructions
        -> (RegSet, [LiveInstr instr])
 
 livenessBack liveregs _        done []  = (liveregs, done)
@@ -755,24 +802,24 @@ liveness1
        :: Instruction instr
        => RegSet 
        -> BlockMap RegSet 
-       -> instr
+       -> LiveInstr instr
        -> (RegSet, LiveInstr instr)
 
-liveness1 liveregs _ instr
+liveness1 liveregs _ (LiveInstr instr _)
        | isMetaInstr instr
-       = (liveregs, Instr instr Nothing)
+       = (liveregs, LiveInstr instr Nothing)
 
-liveness1 liveregs blockmap instr
+liveness1 liveregs blockmap (LiveInstr instr _)
 
        | not_a_branch
-       = (liveregs1, Instr instr
+       = (liveregs1, LiveInstr instr
                        (Just $ Liveness
                        { liveBorn      = emptyUniqSet
                        , liveDieRead   = mkUniqSet r_dying
                        , liveDieWrite  = mkUniqSet w_dying }))
 
        | otherwise
-       = (liveregs_br, Instr instr
+       = (liveregs_br, LiveInstr instr
                        (Just $ Liveness
                        { liveBorn      = emptyUniqSet
                        , liveDieRead   = mkUniqSet r_dying_br