Merge branch 'master' of ssh://darcs.haskell.org/srv/darcs/ghc

18 files changed, 136 insertions, 149 deletions

diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index ef61adfbec..23aca9293c 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -290,7 +290,7 @@ nativeCodeGen' dflags ncgImpl h us cmms
                 | gopt Opt_SplitObjs dflags = split_marker : tops
                 | otherwise                 = tops
 
-        split_marker = CmmProc mapEmpty mkSplitMarkerLabel (ListGraph [])
+        split_marker = CmmProc mapEmpty mkSplitMarkerLabel [] (ListGraph [])
 
 
 cmmNativeGenStream :: (Outputable statics, Outputable instr, Instruction instr)
@@ -550,8 +550,8 @@ cmmNativeGen dflags ncgImpl us cmm count
 
 x86fp_kludge :: NatCmmDecl (Alignment, CmmStatics) X86.Instr.Instr -> NatCmmDecl (Alignment, CmmStatics) X86.Instr.Instr
 x86fp_kludge top@(CmmData _ _) = top
-x86fp_kludge (CmmProc info lbl (ListGraph code)) =
-        CmmProc info lbl (ListGraph $ X86.Instr.i386_insert_ffrees code)
+x86fp_kludge (CmmProc info lbl live (ListGraph code)) =
+        CmmProc info lbl live (ListGraph $ X86.Instr.i386_insert_ffrees code)
 
 
 -- | Build a doc for all the imports.
@@ -627,8 +627,8 @@ sequenceTop
     => NcgImpl statics instr jumpDest -> NatCmmDecl statics instr -> NatCmmDecl statics instr
 
 sequenceTop _       top@(CmmData _ _) = top
-sequenceTop ncgImpl (CmmProc info lbl (ListGraph blocks)) =
-  CmmProc info lbl (ListGraph $ ncgMakeFarBranches ncgImpl $ sequenceBlocks info blocks)
+sequenceTop ncgImpl (CmmProc info lbl live (ListGraph blocks)) =
+  CmmProc info lbl live (ListGraph $ ncgMakeFarBranches ncgImpl $ sequenceBlocks info blocks)
 
 -- The algorithm is very simple (and stupid): we make a graph out of
 -- the blocks where there is an edge from one block to another iff the
@@ -744,7 +744,7 @@ generateJumpTables
         :: NcgImpl statics instr jumpDest
         -> [NatCmmDecl statics instr] -> [NatCmmDecl statics instr]
 generateJumpTables ncgImpl xs = concatMap f xs
-    where f p@(CmmProc _ _ (ListGraph xs)) = p : concatMap g xs
+    where f p@(CmmProc _ _ _ (ListGraph xs)) = p : concatMap g xs
           f p = [p]
           g (BasicBlock _ xs) = catMaybes (map (generateJumpTableForInstr ncgImpl) xs)
 
@@ -768,10 +768,10 @@ build_mapping :: NcgImpl statics instr jumpDest
               -> GenCmmDecl d (BlockEnv t) (ListGraph instr)
               -> (GenCmmDecl d (BlockEnv t) (ListGraph instr), UniqFM jumpDest)
 build_mapping _ top@(CmmData _ _) = (top, emptyUFM)
-build_mapping _ (CmmProc info lbl (ListGraph []))
-  = (CmmProc info lbl (ListGraph []), emptyUFM)
-build_mapping ncgImpl (CmmProc info lbl (ListGraph (head:blocks)))
-  = (CmmProc info lbl (ListGraph (head:others)), mapping)
+build_mapping _ (CmmProc info lbl live (ListGraph []))
+  = (CmmProc info lbl live (ListGraph []), emptyUFM)
+build_mapping ncgImpl (CmmProc info lbl live (ListGraph (head:blocks)))
+  = (CmmProc info lbl live (ListGraph (head:others)), mapping)
         -- drop the shorted blocks, but don't ever drop the first one,
         -- because it is pointed to by a global label.
   where
@@ -804,8 +804,8 @@ apply_mapping :: NcgImpl statics instr jumpDest
               -> GenCmmDecl statics h (ListGraph instr)
 apply_mapping ncgImpl ufm (CmmData sec statics)
   = CmmData sec (shortcutStatics ncgImpl (lookupUFM ufm) statics)
-apply_mapping ncgImpl ufm (CmmProc info lbl (ListGraph blocks))
-  = CmmProc info lbl (ListGraph $ map short_bb blocks)
+apply_mapping ncgImpl ufm (CmmProc info lbl live (ListGraph blocks))
+  = CmmProc info lbl live (ListGraph $ map short_bb blocks)
   where
     short_bb (BasicBlock id insns) = BasicBlock id $! map short_insn insns
     short_insn i = shortcutJump ncgImpl (lookupUFM ufm) i
@@ -878,9 +878,9 @@ Ideas for other things we could do (put these in Hoopl please!):
 
 cmmToCmm :: DynFlags -> RawCmmDecl -> (RawCmmDecl, [CLabel])
 cmmToCmm _ top@(CmmData _ _) = (top, [])
-cmmToCmm dflags (CmmProc info lbl (ListGraph blocks)) = runCmmOpt dflags $ do
+cmmToCmm dflags (CmmProc info lbl live (ListGraph blocks)) = runCmmOpt dflags $ do
   blocks' <- mapM cmmBlockConFold blocks
-  return $ CmmProc info lbl (ListGraph blocks')
+  return $ CmmProc info lbl live (ListGraph blocks')
 
 newtype CmmOptM a = CmmOptM (([CLabel], DynFlags) -> (# a, [CLabel] #))
 
diff --git a/compiler/nativeGen/NCGMonad.hs b/compiler/nativeGen/NCGMonad.hs
index eb59d2b82a..619bf9a5fc 100644
--- a/compiler/nativeGen/NCGMonad.hs
+++ b/compiler/nativeGen/NCGMonad.hs
@@ -1,39 +1,32 @@
 -- -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow 1993-2004
--- 
+--
 -- The native code generator's monad.
 --
 -- -----------------------------------------------------------------------------
 
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module NCGMonad (
-	NatM_State(..), mkNatM_State,
-
-	NatM, -- instance Monad
-	initNat, 
-	addImportNat, 
-	getUniqueNat,
-	mapAccumLNat, 
-	setDeltaNat, 
-	getDeltaNat,
-	getBlockIdNat, 
-	getNewLabelNat, 
-	getNewRegNat, 
-	getNewRegPairNat,
-	getPicBaseMaybeNat, 
-	getPicBaseNat, 
-	getDynFlags
-) 
- 
+        NatM_State(..), mkNatM_State,
+
+        NatM, -- instance Monad
+        initNat,
+        addImportNat,
+        getUniqueNat,
+        mapAccumLNat,
+        setDeltaNat,
+        getDeltaNat,
+        getBlockIdNat,
+        getNewLabelNat,
+        getNewRegNat,
+        getNewRegPairNat,
+        getPicBaseMaybeNat,
+        getPicBaseNat,
+        getDynFlags
+)
+
 where
-  
+
 #include "HsVersions.h"
 
 import Reg
@@ -41,19 +34,19 @@ import Size
 import TargetReg
 
 import BlockId
-import CLabel		( CLabel, mkAsmTempLabel )
+import CLabel           ( CLabel, mkAsmTempLabel )
 import UniqSupply
-import Unique		( Unique )
+import Unique           ( Unique )
 import DynFlags
 
-data NatM_State 
-	= NatM_State {
-		natm_us      :: UniqSupply,
-		natm_delta   :: Int,
-		natm_imports :: [(CLabel)],
-		natm_pic     :: Maybe Reg,
-		natm_dflags  :: DynFlags
-	}
+data NatM_State
+        = NatM_State {
+                natm_us      :: UniqSupply,
+                natm_delta   :: Int,
+                natm_imports :: [(CLabel)],
+                natm_pic     :: Maybe Reg,
+                natm_dflags  :: DynFlags
+        }
 
 newtype NatM result = NatM (NatM_State -> (result, NatM_State))
 
@@ -61,12 +54,12 @@ unNat :: NatM a -> NatM_State -> (a, NatM_State)
 unNat (NatM a) = a
 
 mkNatM_State :: UniqSupply -> Int -> DynFlags -> NatM_State
-mkNatM_State us delta dflags 
-	= NatM_State us delta [] Nothing dflags
+mkNatM_State us delta dflags
+        = NatM_State us delta [] Nothing dflags
 
 initNat :: NatM_State -> NatM a -> (a, NatM_State)
-initNat init_st m 
-	= case unNat m init_st of { (r,st) -> (r,st) }
+initNat init_st m
+        = case unNat m init_st of { (r,st) -> (r,st) }
 
 
 instance Monad NatM where
@@ -76,17 +69,17 @@ instance Monad NatM where
 
 thenNat :: NatM a -> (a -> NatM b) -> NatM b
 thenNat expr cont
-	= NatM $ \st -> case unNat expr st of
-			(result, st') -> unNat (cont result) st'
+        = NatM $ \st -> case unNat expr st of
+                        (result, st') -> unNat (cont result) st'
 
 returnNat :: a -> NatM a
-returnNat result 
-	= NatM $ \st ->  (result, st)
+returnNat result
+        = NatM $ \st ->  (result, st)
 
 mapAccumLNat :: (acc -> x -> NatM (acc, y))
                 -> acc
-	        -> [x]
-	        -> NatM (acc, [y])
+                -> [x]
+                -> NatM (acc, [y])
 
 mapAccumLNat _ b []
   = return (b, [])
@@ -106,32 +99,32 @@ instance HasDynFlags NatM where
 
 
 getDeltaNat :: NatM Int
-getDeltaNat 
-	= NatM $ \ st -> (natm_delta st, st)
+getDeltaNat
+        = NatM $ \ st -> (natm_delta st, st)
 
 
 setDeltaNat :: Int -> NatM ()
-setDeltaNat delta 
-	= NatM $ \ (NatM_State us _ imports pic dflags) ->
-		   ((), NatM_State us delta imports pic dflags)
+setDeltaNat delta
+        = NatM $ \ (NatM_State us _ imports pic dflags) ->
+                   ((), NatM_State us delta imports pic dflags)
 
 
 addImportNat :: CLabel -> NatM ()
-addImportNat imp 
-	= NatM $ \ (NatM_State us delta imports pic dflags) ->
-		   ((), NatM_State us delta (imp:imports) pic dflags)
+addImportNat imp
+        = NatM $ \ (NatM_State us delta imports pic dflags) ->
+                   ((), NatM_State us delta (imp:imports) pic dflags)
 
 
 getBlockIdNat :: NatM BlockId
-getBlockIdNat 
- = do	u <- getUniqueNat
- 	return (mkBlockId u)
+getBlockIdNat
+ = do   u <- getUniqueNat
+        return (mkBlockId u)
 
 
 getNewLabelNat :: NatM CLabel
-getNewLabelNat 
- = do 	u <- getUniqueNat
- 	return (mkAsmTempLabel u)
+getNewLabelNat
+ = do   u <- getUniqueNat
+        return (mkAsmTempLabel u)
 
 
 getNewRegNat :: Size -> NatM Reg
@@ -152,16 +145,16 @@ getNewRegPairNat rep
 
 
 getPicBaseMaybeNat :: NatM (Maybe Reg)
-getPicBaseMaybeNat 
-	= NatM (\state -> (natm_pic state, state))
+getPicBaseMaybeNat
+        = NatM (\state -> (natm_pic state, state))
 
 
 getPicBaseNat :: Size -> NatM Reg
-getPicBaseNat rep 
- = do	mbPicBase <- getPicBaseMaybeNat
-	case mbPicBase of
-	        Just picBase -> return picBase
-	        Nothing 
-		 -> do
-			reg <- getNewRegNat rep
-			NatM (\state -> (reg, state { natm_pic = Just reg }))
+getPicBaseNat rep
+ = do   mbPicBase <- getPicBaseMaybeNat
+        case mbPicBase of
+                Just picBase -> return picBase
+                Nothing
+                 -> do
+                        reg <- getNewRegNat rep
+                        NatM (\state -> (reg, state { natm_pic = Just reg }))
diff --git a/compiler/nativeGen/PIC.hs b/compiler/nativeGen/PIC.hs
index 1ea62dad82..69f3e29add 100644
--- a/compiler/nativeGen/PIC.hs
+++ b/compiler/nativeGen/PIC.hs
@@ -693,7 +693,7 @@ initializePicBase_ppc
         -> NatM [NatCmmDecl CmmStatics PPC.Instr]
 
 initializePicBase_ppc ArchPPC os picReg
-    (CmmProc info lab (ListGraph blocks) : statics)
+    (CmmProc info lab live (ListGraph blocks) : statics)
     | osElfTarget os
     = do
         dflags <- getDynFlags
@@ -719,11 +719,11 @@ initializePicBase_ppc ArchPPC os picReg
                                : PPC.ADD picReg picReg (PPC.RIReg tmp)
                                : insns)
 
-        return (CmmProc info lab (ListGraph (b' : tail blocks)) : gotOffset : statics)
+        return (CmmProc info lab live (ListGraph (b' : tail blocks)) : gotOffset : statics)
 
 initializePicBase_ppc ArchPPC OSDarwin picReg
-        (CmmProc info lab (ListGraph blocks) : statics)
-        = return (CmmProc info lab (ListGraph (b':tail blocks)) : statics)
+        (CmmProc info lab live (ListGraph blocks) : statics)
+        = return (CmmProc info lab live (ListGraph (b':tail blocks)) : statics)
 
         where   BasicBlock bID insns = head blocks
                 b' = BasicBlock bID (PPC.FETCHPC picReg : insns)
@@ -746,9 +746,9 @@ initializePicBase_x86
         -> NatM [NatCmmDecl (Alignment, CmmStatics) X86.Instr]
 
 initializePicBase_x86 ArchX86 os picReg
-        (CmmProc info lab (ListGraph blocks) : statics)
+        (CmmProc info lab live (ListGraph blocks) : statics)
     | osElfTarget os
-    = return (CmmProc info lab (ListGraph blocks') : statics)
+    = return (CmmProc info lab live (ListGraph blocks') : statics)
     where blocks' = case blocks of
                      [] -> []
                      (b:bs) -> fetchGOT b : map maybeFetchGOT bs
@@ -764,8 +764,8 @@ initializePicBase_x86 ArchX86 os picReg
              BasicBlock bID (X86.FETCHGOT picReg : insns)
 
 initializePicBase_x86 ArchX86 OSDarwin picReg
-        (CmmProc info lab (ListGraph blocks) : statics)
-        = return (CmmProc info lab (ListGraph blocks') : statics)
+        (CmmProc info lab live (ListGraph blocks) : statics)
+        = return (CmmProc info lab live (ListGraph blocks') : statics)
 
     where blocks' = case blocks of
                      [] -> []
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 026e8933d7..848c7f933c 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -71,11 +71,11 @@ cmmTopCodeGen
         :: RawCmmDecl
         -> NatM [NatCmmDecl CmmStatics Instr]
 
-cmmTopCodeGen (CmmProc info lab (ListGraph blocks)) = do
+cmmTopCodeGen (CmmProc info lab live (ListGraph blocks)) = do
   (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
   picBaseMb <- getPicBaseMaybeNat
   dflags <- getDynFlags
-  let proc = CmmProc info lab (ListGraph $ concat nat_blocks)
+  let proc = CmmProc info lab live (ListGraph $ concat nat_blocks)
       tops = proc : concat statics
       os   = platformOS $ targetPlatform dflags
   case picBaseMb of
diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index 576e19db1a..045ce8d48e 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -51,7 +51,7 @@ pprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc
 pprNatCmmDecl (CmmData section dats) =
   pprSectionHeader section $$ pprDatas dats
 
-pprNatCmmDecl proc@(CmmProc top_info lbl (ListGraph blocks)) =
+pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
   case topInfoTable proc of
     Nothing ->
        case blocks of
diff --git a/compiler/nativeGen/PPC/RegInfo.hs b/compiler/nativeGen/PPC/RegInfo.hs
index 019cf82f6a..2b74d1daea 100644
--- a/compiler/nativeGen/PPC/RegInfo.hs
+++ b/compiler/nativeGen/PPC/RegInfo.hs
@@ -26,21 +26,18 @@ where
 #include "nativeGen/NCG.h"
 #include "HsVersions.h"
 
-import PPC.Regs
 import PPC.Instr
 
 import BlockId
 import OldCmm
 import CLabel
 
-import Outputable
 import Unique
 
-data JumpDest = DestBlockId BlockId | DestImm Imm
+data JumpDest = DestBlockId BlockId
 
 getJumpDestBlockId :: JumpDest -> Maybe BlockId
 getJumpDestBlockId (DestBlockId bid) = Just bid
-getJumpDestBlockId _                 = Nothing
 
 canShortcut :: Instr -> Maybe JumpDest
 canShortcut _ = Nothing
@@ -80,7 +77,5 @@ shortBlockId fn blockid =
    case fn blockid of
       Nothing -> mkAsmTempLabel uq
       Just (DestBlockId blockid')  -> shortBlockId fn blockid'
-      Just (DestImm (ImmCLbl lbl)) -> lbl
-      _other -> panic "shortBlockId"
    where uq = getUnique blockid
 
diff --git a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
index 0680beac00..c4fb7ac378 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
@@ -75,7 +75,7 @@ slurpJoinMovs live
 	= slurpCmm emptyBag live
  where	
   	slurpCmm   rs  CmmData{}		    = rs
-	slurpCmm   rs (CmmProc _ _ sccs) 	= foldl' slurpBlock rs (flattenSCCs sccs)
+	slurpCmm   rs (CmmProc _ _ _ sccs) 	= foldl' slurpBlock rs (flattenSCCs sccs)
 	slurpBlock rs (BasicBlock _ instrs)	= foldl' slurpLI    rs instrs
                 
 	slurpLI    rs (LiveInstr _	Nothing)    = rs
diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
index 6e110266d1..25bd313826 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
@@ -91,7 +91,7 @@ regSpill_top platform regSlotMap cmm
         CmmData{}
          -> return cmm
 
-        CmmProc info label sccs
+        CmmProc info label live sccs
          |  LiveInfo static firstId mLiveVRegsOnEntry liveSlotsOnEntry <- info
          -> do
                 -- We should only passed Cmms with the liveness maps filled in,  but we'll
@@ -115,7 +115,7 @@ regSpill_top platform regSlotMap cmm
                 -- Apply the spiller to all the basic blocks in the CmmProc.
                 sccs'           <- mapM (mapSCCM (regSpill_block platform regSlotMap)) sccs
 
-                return  $ CmmProc info' label sccs'
+                return  $ CmmProc info' label live sccs'
 
  where  -- | Given a BlockId and the set of registers live in it,
         --   if registers in this block are being spilled to stack slots,
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
index 9348dca936..7f86b9a884 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
@@ -301,10 +301,10 @@ cleanTopBackward cmm
 	CmmData{}
 	 -> return cmm
 	
-	CmmProc info label sccs
+	CmmProc info label live sccs
 	 | LiveInfo _ _ _ liveSlotsOnEntry <- info
 	 -> do	sccs'	<- mapM (mapSCCM (cleanBlockBackward liveSlotsOnEntry)) sccs
-		return	$ CmmProc info label sccs' 
+		return	$ CmmProc info label live sccs' 
 
 
 cleanBlockBackward 
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
index abcc6a69b6..879597fd88 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
@@ -79,7 +79,7 @@ slurpSpillCostInfo platform cmm
 	= execState (countCmm cmm) zeroSpillCostInfo
  where
 	countCmm CmmData{}		= return ()
-	countCmm (CmmProc info _ sccs)
+	countCmm (CmmProc info _ _ sccs)
 		= mapM_ (countBlock info)
 		$ flattenSCCs sccs
 
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index 3f1efe5824..fc5b992603 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -150,12 +150,12 @@ regAlloc _ (CmmData sec d)
                 , Nothing
                 , Nothing )
 
-regAlloc _ (CmmProc (LiveInfo info _ _ _) lbl [])
-        = return ( CmmProc info lbl (ListGraph [])
+regAlloc _ (CmmProc (LiveInfo info _ _ _) lbl live [])
+        = return ( CmmProc info lbl live (ListGraph [])
                  , Nothing
                  , Nothing )
 
-regAlloc dflags (CmmProc static lbl sccs)
+regAlloc dflags (CmmProc static lbl live sccs)
         | LiveInfo info (Just first_id) (Just block_live) _     <- static
         = do
                 -- do register allocation on each component.
@@ -174,12 +174,12 @@ regAlloc dflags (CmmProc static lbl sccs)
                       | otherwise
                       = Nothing
 
-                return  ( CmmProc info lbl (ListGraph (first' : rest'))
+                return  ( CmmProc info lbl live (ListGraph (first' : rest'))
                         , extra_stack
                         , Just stats)
 
 -- bogus. to make non-exhaustive match warning go away.
-regAlloc _ (CmmProc _ _ _)
+regAlloc _ (CmmProc _ _ _ _)
         = panic "RegAllocLinear.regAlloc: no match"
 
 
diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index 608f0a423b..12c138897c 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -246,9 +246,9 @@ mapBlockTopM
 mapBlockTopM _ cmm@(CmmData{})
         = return cmm
 
-mapBlockTopM f (CmmProc header label sccs)
+mapBlockTopM f (CmmProc header label live sccs)
  = do   sccs'   <- mapM (mapSCCM f) sccs
-        return  $ CmmProc header label sccs'
+        return  $ CmmProc header label live sccs'
 
 mapSCCM :: Monad m => (a -> m b) -> SCC a -> m (SCC b)
 mapSCCM f (AcyclicSCC x)
@@ -278,9 +278,9 @@ mapGenBlockTopM
 mapGenBlockTopM _ cmm@(CmmData{})
         = return cmm
 
-mapGenBlockTopM f (CmmProc header label (ListGraph blocks))
+mapGenBlockTopM f (CmmProc header label live (ListGraph blocks))
  = do   blocks' <- mapM f blocks
-        return  $ CmmProc header label (ListGraph blocks')
+        return  $ CmmProc header label live (ListGraph blocks')
 
 
 -- | Slurp out the list of register conflicts and reg-reg moves from this top level thing.
@@ -296,7 +296,7 @@ slurpConflicts live
         = slurpCmm (emptyBag, emptyBag) live
 
  where  slurpCmm   rs  CmmData{}                = rs
-        slurpCmm   rs (CmmProc info _ sccs)
+        slurpCmm   rs (CmmProc info _ _ sccs)
                 = foldl' (slurpSCC info) rs sccs
 
         slurpSCC  info rs (AcyclicSCC b)
@@ -375,7 +375,7 @@ slurpReloadCoalesce live
                  -> GenCmmDecl t t1 [SCC (LiveBasicBlock instr)]
                  -> Bag (Reg, Reg)
         slurpCmm cs CmmData{}   = cs
-        slurpCmm cs (CmmProc _ _ sccs)
+        slurpCmm cs (CmmProc _ _ _ sccs)
                 = slurpComp cs (flattenSCCs sccs)
 
         slurpComp :: Bag (Reg, Reg)
@@ -475,7 +475,7 @@ stripLive dflags live
  where  stripCmm :: (Outputable statics, Outputable instr, Instruction instr)
                  => LiveCmmDecl statics instr -> NatCmmDecl statics instr
         stripCmm (CmmData sec ds)       = CmmData sec ds
-        stripCmm (CmmProc (LiveInfo info (Just first_id) _ _) label sccs)
+        stripCmm (CmmProc (LiveInfo info (Just first_id) _ _) label live sccs)
          = let  final_blocks    = flattenSCCs sccs
 
                 -- make sure the block that was first in the input list
@@ -484,12 +484,12 @@ stripLive dflags live
                 ((first':_), rest')
                                 = partition ((== first_id) . blockId) final_blocks
 
-           in   CmmProc info label
+           in   CmmProc info label live
                           (ListGraph $ map (stripLiveBlock dflags) $ first' : rest')
 
         -- procs used for stg_split_markers don't contain any blocks, and have no first_id.
-        stripCmm (CmmProc (LiveInfo info Nothing _ _) label [])
-         =      CmmProc info label (ListGraph [])
+        stripCmm (CmmProc (LiveInfo info Nothing _ _) label live [])
+         =      CmmProc info label live (ListGraph [])
 
         -- If the proc has blocks but we don't know what the first one was, then we're dead.
         stripCmm proc
@@ -559,14 +559,14 @@ patchEraseLive patchF cmm
  where
         patchCmm cmm@CmmData{}  = cmm
 
-        patchCmm (CmmProc info label sccs)
+        patchCmm (CmmProc info label live sccs)
          | LiveInfo static id (Just blockMap) mLiveSlots <- info
          = let
                 patchRegSet set = mkUniqSet $ map patchF $ uniqSetToList set
                 blockMap'       = mapMap patchRegSet blockMap
 
                 info'           = LiveInfo static id (Just blockMap') mLiveSlots
-           in   CmmProc info' label $ map patchSCC sccs
+           in   CmmProc info' label live $ map patchSCC sccs
 
          | otherwise
          = panic "RegAlloc.Liveness.patchEraseLive: no blockMap"
@@ -635,17 +635,17 @@ natCmmTopToLive
 natCmmTopToLive (CmmData i d)
         = CmmData i d
 
-natCmmTopToLive (CmmProc info lbl (ListGraph []))
-        = CmmProc (LiveInfo info Nothing Nothing Map.empty) lbl []
+natCmmTopToLive (CmmProc info lbl live (ListGraph []))
+        = CmmProc (LiveInfo info Nothing Nothing Map.empty) lbl live []
 
-natCmmTopToLive (CmmProc info lbl (ListGraph blocks@(first : _)))
+natCmmTopToLive (CmmProc info lbl live (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 Map.empty) lbl sccsLive
+   in   CmmProc (LiveInfo info (Just first_id) Nothing Map.empty) lbl live sccsLive
 
 
 sccBlocks
@@ -674,18 +674,18 @@ regLiveness
 regLiveness _ (CmmData i d)
         = return $ CmmData i d
 
-regLiveness _ (CmmProc info lbl [])
+regLiveness _ (CmmProc info lbl live [])
         | LiveInfo static mFirst _ _    <- info
         = return $ CmmProc
                         (LiveInfo static mFirst (Just mapEmpty) Map.empty)
-                        lbl []
+                        lbl live []
 
-regLiveness platform (CmmProc info lbl sccs)
+regLiveness platform (CmmProc info lbl live sccs)
         | LiveInfo static mFirst _ liveSlotsOnEntry     <- info
         = let   (ann_sccs, block_live)  = computeLiveness platform sccs
 
           in    return $ CmmProc (LiveInfo static mFirst (Just block_live) liveSlotsOnEntry)
-                           lbl ann_sccs
+                           lbl live ann_sccs
 
 
 -- -----------------------------------------------------------------------------
@@ -734,7 +734,7 @@ reverseBlocksInTops :: LiveCmmDecl statics instr -> LiveCmmDecl statics instr
 reverseBlocksInTops top
  = case top of
         CmmData{}                       -> top
-        CmmProc info lbl sccs   -> CmmProc info lbl (reverse sccs)
+        CmmProc info lbl live sccs      -> CmmProc info lbl live (reverse sccs)
 
 
 -- | Computing liveness
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index aeb6d10acc..c4efdf677e 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -59,10 +59,10 @@ import Control.Monad    ( mapAndUnzipM )
 cmmTopCodeGen :: RawCmmDecl
               -> NatM [NatCmmDecl CmmStatics Instr]
 
-cmmTopCodeGen (CmmProc info lab (ListGraph blocks))
+cmmTopCodeGen (CmmProc info lab live (ListGraph blocks))
  = do (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
 
-      let proc = CmmProc info lab (ListGraph $ concat nat_blocks)
+      let proc = CmmProc info lab live (ListGraph $ concat nat_blocks)
       let tops = proc : concat statics
 
       return tops
diff --git a/compiler/nativeGen/SPARC/CodeGen/Expand.hs b/compiler/nativeGen/SPARC/CodeGen/Expand.hs
index c468fcc255..fa397771d7 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Expand.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Expand.hs
@@ -32,8 +32,8 @@ expandTop :: NatCmmDecl CmmStatics Instr -> NatCmmDecl CmmStatics Instr
 expandTop top@(CmmData{})
 	= top
 
-expandTop (CmmProc info lbl (ListGraph blocks))
-	= CmmProc info lbl (ListGraph $ map expandBlock blocks)
+expandTop (CmmProc info lbl live (ListGraph blocks))
+	= CmmProc info lbl live (ListGraph $ map expandBlock blocks)
 
 
 -- | Expand out synthetic instructions in this block
diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs
index 55afac0ee2..9bfa3141cc 100644
--- a/compiler/nativeGen/SPARC/Ppr.hs
+++ b/compiler/nativeGen/SPARC/Ppr.hs
@@ -53,7 +53,7 @@ pprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc
 pprNatCmmDecl (CmmData section dats) =
   pprSectionHeader section $$ pprDatas dats
 
-pprNatCmmDecl proc@(CmmProc top_info lbl (ListGraph blocks)) =
+pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
   case topInfoTable proc of
     Nothing ->
        case blocks of
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 7ab30bf922..b3160ed2ca 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -93,11 +93,11 @@ cmmTopCodeGen
         :: RawCmmDecl
         -> NatM [NatCmmDecl (Alignment, CmmStatics) Instr]
 
-cmmTopCodeGen (CmmProc info lab (ListGraph blocks)) = do
+cmmTopCodeGen (CmmProc info lab live (ListGraph blocks)) = do
   (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
   picBaseMb <- getPicBaseMaybeNat
   dflags <- getDynFlags
-  let proc = CmmProc info lab (ListGraph $ concat nat_blocks)
+  let proc = CmmProc info lab live (ListGraph $ concat nat_blocks)
       tops = proc : concat statics
       os   = platformOS $ targetPlatform dflags
 
@@ -173,9 +173,8 @@ stmtToInstrs stmt = do
       panic "stmtToInstrs: return statement should have been cps'd away"
 
 
-jumpRegs :: DynFlags -> Maybe [GlobalReg] -> [Reg]
-jumpRegs dflags Nothing      = allHaskellArgRegs dflags
-jumpRegs dflags (Just gregs) = [ RegReal r | Just r <- map (globalRegMaybe platform) gregs ]
+jumpRegs :: DynFlags -> [GlobalReg] -> [Reg]
+jumpRegs dflags gregs = [ RegReal r | Just r <- map (globalRegMaybe platform) gregs ]
     where platform = targetPlatform dflags
 
 --------------------------------------------------------------------------------
@@ -1775,7 +1774,7 @@ genCCall32' dflags target dest_regs args = do
         let
             -- Align stack to 16n for calls, assuming a starting stack
             -- alignment of 16n - word_size on procedure entry. Which we
-            -- maintiain. See Note [rts/StgCRun.c : Stack Alignment on X86]
+            -- maintain. See Note [rts/StgCRun.c : Stack Alignment on X86]
             sizes               = map (arg_size . cmmExprType dflags . hintlessCmm) (reverse args)
             raw_arg_size        = sum sizes + wORD_SIZE dflags
             arg_pad_size        = (roundTo 16 $ raw_arg_size) - raw_arg_size
@@ -2035,7 +2034,7 @@ genCCall64' dflags target dest_regs args = do
 
     -- Align stack to 16n for calls, assuming a starting stack
     -- alignment of 16n - word_size on procedure entry. Which we
-    -- maintiain. See Note [rts/StgCRun.c : Stack Alignment on X86]
+    -- maintain. See Note [rts/StgCRun.c : Stack Alignment on X86]
     (real_size, adjust_rsp) <-
         if (tot_arg_size + wORD_SIZE dflags) `rem` 16 == 0
             then return (tot_arg_size, nilOL)
diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs
index 7bd9b0cc9e..d089fc3ec2 100644
--- a/compiler/nativeGen/X86/Instr.hs
+++ b/compiler/nativeGen/X86/Instr.hs
@@ -828,8 +828,8 @@ allocMoreStack
   -> NatCmmDecl statics X86.Instr.Instr
 
 allocMoreStack _ _ top@(CmmData _ _) = top
-allocMoreStack platform amount (CmmProc info lbl (ListGraph code)) =
-        CmmProc info lbl (ListGraph (map insert_stack_insns code))
+allocMoreStack platform amount (CmmProc info lbl live (ListGraph code)) =
+        CmmProc info lbl live (ListGraph (map insert_stack_insns code))
   where
     alloc   = mkStackAllocInstr platform amount
     dealloc = mkStackDeallocInstr platform amount
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index 420da7cc3d..76715f1996 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -53,7 +53,7 @@ pprNatCmmDecl :: NatCmmDecl (Alignment, CmmStatics) Instr -> SDoc
 pprNatCmmDecl (CmmData section dats) =
   pprSectionHeader section $$ pprDatas dats
 
-pprNatCmmDecl proc@(CmmProc top_info lbl (ListGraph blocks)) =
+pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
   case topInfoTable proc of
     Nothing ->
        case blocks of