Attach global register liveness info to Cmm procedures.

All Cmm procedures now include the set of global registers that are live on
procedure entry, i.e., the global registers used to pass arguments to the
procedure. Only global registers that are use to pass arguments are included in
this list.

39 files changed, 145 insertions, 130 deletions

diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index 8409f0dbeb..e1701bd4c5 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -71,6 +71,14 @@ data GenCmmDecl d h g
   = CmmProc     -- A procedure
      h                 -- Extra header such as the info table
      CLabel            -- Entry label
+     [GlobalReg]       -- Registers live on entry. Note that the set of live
+                       -- registers will be correct in generated C-- code, but
+                       -- not in hand-written C-- code. However,
+                       -- splitAtProcPoints calculates correct liveness
+                       -- information for CmmProc's. Right now only the LLVM
+                       -- back-end relies on correct liveness information and
+                       -- for that back-end we always call splitAtProcPoints, so
+                       -- all is good.
      g                 -- Control-flow graph for the procedure's code
 
   | CmmData     -- Static data
@@ -100,8 +108,8 @@ data CmmTopInfo   = TopInfo { info_tbls  :: BlockEnv CmmInfoTable
                             , stack_info :: CmmStackInfo }
 
 topInfoTable :: GenCmmDecl a CmmTopInfo (GenCmmGraph n) -> Maybe CmmInfoTable
-topInfoTable (CmmProc infos _ g) = mapLookup (g_entry g) (info_tbls infos)
-topInfoTable _                   = Nothing
+topInfoTable (CmmProc infos _ _ g) = mapLookup (g_entry g) (info_tbls infos)
+topInfoTable _                     = Nothing
 
 data CmmStackInfo
    = StackInfo {
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index 304f4c2170..af78b40e0f 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -250,7 +250,7 @@ to_SRT dflags top_srt off len bmp
 -- any CAF that is reachable from c.
 localCAFInfo :: CAFEnv -> CmmDecl -> (CAFSet, Maybe CLabel)
 localCAFInfo _      (CmmData _ _) = (Set.empty, Nothing)
-localCAFInfo cafEnv proc@(CmmProc _ top_l (CmmGraph {g_entry=entry})) =
+localCAFInfo cafEnv proc@(CmmProc _ top_l _ (CmmGraph {g_entry=entry})) =
   case topInfoTable proc of
     Just (CmmInfoTable { cit_rep = rep })
       | not (isStaticRep rep) && not (isStackRep rep)
@@ -295,7 +295,7 @@ bundle :: Map CLabel CAFSet
        -> (CAFEnv, CmmDecl)
        -> (CAFSet, Maybe CLabel)
        -> (BlockEnv CAFSet, CmmDecl)
-bundle flatmap (env, decl@(CmmProc infos lbl g)) (closure_cafs, mb_lbl)
+bundle flatmap (env, decl@(CmmProc infos lbl _ g)) (closure_cafs, mb_lbl)
   = ( mapMapWithKey get_cafs (info_tbls infos), decl )
  where
   entry = g_entry g
@@ -371,8 +371,8 @@ buildSRTs dflags top_srt caf_map
 -}
 
 updInfoSRTs :: BlockEnv C_SRT -> CmmDecl -> CmmDecl
-updInfoSRTs srt_env (CmmProc top_info top_l g) =
-  CmmProc (top_info {info_tbls = mapMapWithKey updInfoTbl (info_tbls top_info)}) top_l g
+updInfoSRTs srt_env (CmmProc top_info top_l live g) =
+  CmmProc (top_info {info_tbls = mapMapWithKey updInfoTbl (info_tbls top_info)}) top_l live g
   where updInfoTbl l info_tbl
              = info_tbl { cit_srt = expectJust "updInfo" $ mapLookup l srt_env }
 updInfoSRTs _ t = t
diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs
index 4028efddf6..82f7243e73 100644
--- a/compiler/cmm/CmmContFlowOpt.hs
+++ b/compiler/cmm/CmmContFlowOpt.hs
@@ -28,7 +28,7 @@ cmmCfgOpts :: Bool -> CmmGraph -> CmmGraph
 cmmCfgOpts split g = fst (blockConcat split g)
 
 cmmCfgOptsProc :: Bool -> CmmDecl -> CmmDecl
-cmmCfgOptsProc split (CmmProc info lbl g) = CmmProc info' lbl g'
+cmmCfgOptsProc split (CmmProc info lbl live g) = CmmProc info' lbl live g'
     where (g', env) = blockConcat split g
           info' = info{ info_tbls = new_info_tbls }
           new_info_tbls = mapFromList (map upd_info (mapToList (info_tbls info)))
diff --git a/compiler/cmm/CmmCvt.hs b/compiler/cmm/CmmCvt.hs
index 4830691a22..39f0b86ec8 100644
--- a/compiler/cmm/CmmCvt.hs
+++ b/compiler/cmm/CmmCvt.hs
@@ -19,7 +19,7 @@ import Outputable
 
 cmmOfZgraph :: CmmGroup -> Old.CmmGroup
 cmmOfZgraph tops = map mapTop tops
-  where mapTop (CmmProc h l g) = CmmProc (info_tbls h) l (ofZgraph g)
+  where mapTop (CmmProc h l v g) = CmmProc (info_tbls h) l v (ofZgraph g)
         mapTop (CmmData s ds) = CmmData s ds
 
 add_hints :: [a] -> [ForeignHint] -> [Old.CmmHinted a]
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index e952c831ff..699469c116 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -90,7 +90,7 @@ mkInfoTable :: DynFlags -> CmmDecl -> UniqSM [RawCmmDecl]
 mkInfoTable _ (CmmData sec dat)
   = return [CmmData sec dat]
 
-mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks)
+mkInfoTable dflags proc@(CmmProc infos entry_lbl live blocks)
   --
   -- in the non-tables-next-to-code case, procs can have at most a
   -- single info table associated with the entry label of the proc.
@@ -99,7 +99,7 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks)
   = case topInfoTable proc of   --  must be at most one
       -- no info table
       Nothing ->
-         return [CmmProc mapEmpty entry_lbl blocks]
+         return [CmmProc mapEmpty entry_lbl live blocks]
 
       Just info@CmmInfoTable { cit_lbl = info_lbl } -> do
         (top_decls, (std_info, extra_bits)) <-
@@ -120,7 +120,7 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks)
              -- Separately emit info table (with the function entry
              -- point as first entry) and the entry code
              return (top_decls ++
-                     [CmmProc mapEmpty entry_lbl blocks,
+                     [CmmProc mapEmpty entry_lbl live blocks,
                       mkDataLits Data info_lbl
                          (CmmLabel entry_lbl : rel_std_info ++ rel_extra_bits)])
 
@@ -134,7 +134,7 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks)
   = do
     (top_declss, raw_infos) <- unzip `fmap` mapM do_one_info (mapToList infos)
     return (concat top_declss ++
-            [CmmProc (mapFromList raw_infos) entry_lbl blocks])
+            [CmmProc (mapFromList raw_infos) entry_lbl live blocks])
 
   where
    do_one_info (lbl,itbl) = do
diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs
index c7e6e3ae6e..78bef17a42 100644
--- a/compiler/cmm/CmmLayoutStack.hs
+++ b/compiler/cmm/CmmLayoutStack.hs
@@ -847,8 +847,8 @@ elimStackStores stackmap stackmaps area_off nodes
 
 
 setInfoTableStackMap :: DynFlags -> BlockEnv StackMap -> CmmDecl -> CmmDecl
-setInfoTableStackMap dflags stackmaps (CmmProc top_info@TopInfo{..} l g)
-  = CmmProc top_info{ info_tbls = mapMapWithKey fix_info info_tbls } l g
+setInfoTableStackMap dflags stackmaps (CmmProc top_info@TopInfo{..} l v g)
+  = CmmProc top_info{ info_tbls = mapMapWithKey fix_info info_tbls } l v g
   where
     fix_info lbl info_tbl@CmmInfoTable{ cit_rep = StackRep _ } =
        info_tbl { cit_rep = StackRep (get_liveness lbl) }
diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index dffd417e07..0d44f0ffd5 100644
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -419,10 +419,10 @@ exactLog2 x_
 cmmLoopifyForC :: DynFlags -> RawCmmDecl -> RawCmmDecl
 -- XXX: revisit if we actually want to do this
 -- cmmLoopifyForC p@(CmmProc Nothing _ _) = p  -- only if there's an info table, ignore case alts
-cmmLoopifyForC dflags (CmmProc infos entry_lbl
+cmmLoopifyForC dflags (CmmProc infos entry_lbl live
                  (ListGraph blocks@(BasicBlock top_id _ : _))) =
 --  pprTrace "jump_lbl" (ppr jump_lbl <+> ppr entry_lbl) $
-  CmmProc infos entry_lbl (ListGraph blocks')
+  CmmProc infos entry_lbl live (ListGraph blocks')
   where blocks' = [ BasicBlock id (map do_stmt stmts)
                   | BasicBlock id stmts <- blocks ]
 
diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs
index aa8fa2c1f5..70ff754166 100644
--- a/compiler/cmm/CmmPipeline.hs
+++ b/compiler/cmm/CmmPipeline.hs
@@ -61,7 +61,7 @@ cpsTop hsc_env proc =
        -- later passes by removing lots of empty blocks, so we do it
        -- even when optimisation isn't turned on.
        --
-       CmmProc h l g <- {-# SCC "cmmCfgOpts(1)" #-}
+       CmmProc h l v g <- {-# SCC "cmmCfgOpts(1)" #-}
             return $ cmmCfgOptsProc splitting_proc_points proc
        dump Opt_D_dump_cmmz_cfg "Post control-flow optimsations" g
 
@@ -121,7 +121,7 @@ cpsTop hsc_env proc =
             dumpWith dflags Opt_D_dump_cmmz_procmap "procpoint map" pp_map
             gs <- {-# SCC "splitAtProcPoints" #-} runUniqSM $
                   splitAtProcPoints dflags l call_pps proc_points pp_map
-                                    (CmmProc h l g)
+                                    (CmmProc h l v g)
             dumps Opt_D_dump_cmmz_split "Post splitting" gs
      
             ------------- Populate info tables with stack info -----------------
@@ -140,7 +140,7 @@ cpsTop hsc_env proc =
 
           else do
             -- attach info tables to return points
-            g <- return $ attachContInfoTables call_pps (CmmProc h l g)
+            g <- return $ attachContInfoTables call_pps (CmmProc h l v g)
 
             ------------- Populate info tables with stack info -----------------
             g <- {-# SCC "setInfoTableStackMap" #-}
diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs
index ddccf7ba49..02b232d488 100644
--- a/compiler/cmm/CmmProcPoint.hs
+++ b/compiler/cmm/CmmProcPoint.hs
@@ -18,6 +18,7 @@ import Cmm
 import PprCmm ()
 import CmmUtils
 import CmmInfo
+import CmmLive (cmmGlobalLiveness)
 import Data.List (sortBy)
 import Maybes
 import Control.Monad
@@ -210,7 +211,7 @@ splitAtProcPoints :: DynFlags -> CLabel -> ProcPointSet-> ProcPointSet -> BlockE
                      CmmDecl -> UniqSM [CmmDecl]
 splitAtProcPoints dflags entry_label callPPs procPoints procMap
                   (CmmProc (TopInfo {info_tbls = info_tbls})
-                           top_l g@(CmmGraph {g_entry=entry})) =
+                           top_l _ g@(CmmGraph {g_entry=entry})) =
   do -- Build a map from procpoints to the blocks they reach
      let addBlock b graphEnv =
            case mapLookup bid procMap of
@@ -226,6 +227,11 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
                where graph  = mapLookup procId graphEnv `orElse` mapEmpty
                      graph' = mapInsert bid b graph
 
+     let liveness = cmmGlobalLiveness dflags g
+     let ppLiveness pp = filter isArgReg $
+                         regSetToList $
+                         expectJust "ppLiveness" $ mapLookup pp liveness
+
      graphEnv <- return $ foldGraphBlocks addBlock emptyBlockMap g
 
      -- Build a map from proc point BlockId to pairs of:
@@ -248,8 +254,8 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
      let add_jump_block (env, bs) (pp, l) =
            do bid <- liftM mkBlockId getUniqueM
               let b = blockJoin (CmmEntry bid) emptyBlock jump
-                  jump = CmmCall (CmmLit (CmmLabel l)) Nothing [{-XXX-}] 0 0 0
-                  -- XXX: No regs are live at the call
+                  live = ppLiveness pp
+                  jump = CmmCall (CmmLit (CmmLabel l)) Nothing live 0 0 0
               return (mapInsert pp bid env, b : bs)
 
          add_jumps newGraphEnv (ppId, blockEnv) =
@@ -293,17 +299,19 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
              | bid == entry
              =  CmmProc (TopInfo {info_tbls  = info_tbls,
                                   stack_info = stack_info})
-                        top_l (replacePPIds g)
+                        top_l live g'
              | otherwise
              = case expectJust "pp label" $ mapLookup bid procLabels of
                  (lbl, Just info_lbl)
                     -> CmmProc (TopInfo { info_tbls = mapSingleton (g_entry g) (mkEmptyContInfoTable info_lbl)
                                         , stack_info=stack_info})
-                               lbl (replacePPIds g)
+                               lbl live g'
                  (lbl, Nothing)
                     -> CmmProc (TopInfo {info_tbls = mapEmpty, stack_info=stack_info})
-                               lbl (replacePPIds g)
+                               lbl live g'
                 where
+                 g' = replacePPIds g
+                 live = ppLiveness (g_entry g')
                  stack_info = StackInfo { arg_space = 0
                                         , updfr_space =  Nothing
                                         , do_layout = True }
@@ -333,7 +341,6 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
             procs
 splitAtProcPoints _ _ _ _ _ t@(CmmData _ _) = return [t]
 
-
 -- Only called from CmmProcPoint.splitAtProcPoints. NB. does a
 -- recursive lookup, see comment below.
 replaceBranches :: BlockEnv BlockId -> CmmGraph -> CmmGraph
@@ -358,8 +365,8 @@ replaceBranches env cmmg
 -- Not splitting proc points: add info tables for continuations
 
 attachContInfoTables :: ProcPointSet -> CmmDecl -> CmmDecl
-attachContInfoTables call_proc_points (CmmProc top_info top_l g)
- = CmmProc top_info{info_tbls = info_tbls'} top_l g
+attachContInfoTables call_proc_points (CmmProc top_info top_l live g)
+ = CmmProc top_info{info_tbls = info_tbls'} top_l live g
  where
    info_tbls' = mapUnion (info_tbls top_info) $
                 mapFromList [ (l, mkEmptyContInfoTable (infoTblLbl l))
diff --git a/compiler/cmm/MkGraph.hs b/compiler/cmm/MkGraph.hs
index 1e2ddfadd1..1536794a70 100644
--- a/compiler/cmm/MkGraph.hs
+++ b/compiler/cmm/MkGraph.hs
@@ -304,20 +304,20 @@ stackStubExpr w = CmmLit (CmmInt 0 w)
 copyInOflow  :: DynFlags -> Convention -> Area
              -> [CmmFormal]
              -> [CmmFormal]
-             -> (Int, CmmAGraph)
+             -> (Int, [GlobalReg], CmmAGraph)
 
 copyInOflow dflags conv area formals extra_stk
-  = (offset, catAGraphs $ map mkMiddle nodes)
-  where (offset, nodes) = copyIn dflags conv area formals extra_stk
+  = (offset, gregs, catAGraphs $ map mkMiddle nodes)
+  where (offset, gregs, nodes) = copyIn dflags conv area formals extra_stk
 
 -- Return the number of bytes used for copying arguments, as well as the
 -- instructions to copy the arguments.
 copyIn :: DynFlags -> Convention -> Area
        -> [CmmFormal]
        -> [CmmFormal]
-       -> (ByteOff, [CmmNode O O])
+       -> (ByteOff, [GlobalReg], [CmmNode O O])
 copyIn dflags conv area formals extra_stk
-  = (stk_size, map ci (stk_args ++ args))
+  = (stk_size, [r | (_, RegisterParam r) <- args], map ci (stk_args ++ args))
   where
      ci (reg, RegisterParam r) =
           CmmAssign (CmmLocal reg) (CmmReg (CmmGlobal r))
@@ -386,7 +386,7 @@ copyOutOflow dflags conv transfer area actuals updfr_off extra_stack_stuff
 
 
 mkCallEntry :: DynFlags -> Convention -> [CmmFormal] -> [CmmFormal]
-            -> (Int, CmmAGraph)
+            -> (Int, [GlobalReg], CmmAGraph)
 mkCallEntry dflags conv formals extra_stk
   = copyInOflow dflags conv Old formals extra_stk
 
diff --git a/compiler/cmm/OldCmm.hs b/compiler/cmm/OldCmm.hs
index 8d5c0398cf..fccdd8137d 100644
--- a/compiler/cmm/OldCmm.hs
+++ b/compiler/cmm/OldCmm.hs
@@ -105,7 +105,7 @@ mapBlockStmts f (BasicBlock id bs) = BasicBlock id (map f bs)
 -- | Returns the info table associated with the CmmDecl's entry point,
 -- if any.
 topInfoTable :: GenCmmDecl a (BlockEnv i) (ListGraph b) -> Maybe i
-topInfoTable (CmmProc infos _ (ListGraph (b:_)))
+topInfoTable (CmmProc infos _ _ (ListGraph (b:_)))
   = mapLookup (blockId b) infos
 topInfoTable _
   = Nothing
@@ -118,8 +118,8 @@ cmmMapGraph    :: (g -> g') -> GenCmmGroup d h g -> GenCmmGroup d h g'
 cmmMapGraph f tops = map (cmmTopMapGraph f) tops
 
 cmmTopMapGraph :: (g -> g') -> GenCmmDecl d h g -> GenCmmDecl d h g'
-cmmTopMapGraph f (CmmProc h l g) = CmmProc h l (f g)
-cmmTopMapGraph _ (CmmData s ds)  = CmmData s ds
+cmmTopMapGraph f (CmmProc h l v g) = CmmProc h l v (f g)
+cmmTopMapGraph _ (CmmData s ds)    = CmmData s ds
 
 -----------------------------------------------------------------------------
 --              CmmStmt
diff --git a/compiler/cmm/OldCmmLint.hs b/compiler/cmm/OldCmmLint.hs
index f158369b13..9a4fb42bc5 100644
--- a/compiler/cmm/OldCmmLint.hs
+++ b/compiler/cmm/OldCmmLint.hs
@@ -48,7 +48,7 @@ runCmmLint _ l p =
    Right _  -> Nothing
 
 lintCmmDecl :: DynFlags -> (GenCmmDecl h i (ListGraph CmmStmt)) -> CmmLint ()
-lintCmmDecl dflags (CmmProc _ lbl (ListGraph blocks))
+lintCmmDecl dflags (CmmProc _ lbl _ (ListGraph blocks))
   = addLintInfo (text "in proc " <> ppr lbl) $
         let labels = foldl (\s b -> setInsert (blockId b) s) setEmpty blocks
         in  mapM_ (lintCmmBlock dflags labels) blocks
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index e07bd6459d..e0ff99cb29 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -81,7 +81,7 @@ pprC tops = vcat $ intersperse blankLine $ map pprTop tops
 -- top level procs
 --
 pprTop :: RawCmmDecl -> SDoc
-pprTop proc@(CmmProc _ clbl (ListGraph blocks)) =
+pprTop proc@(CmmProc _ clbl _ (ListGraph blocks)) =
     (case topInfoTable proc of
        Nothing -> empty
        Just (Statics info_clbl info_dat) -> pprDataExterns info_dat $$
diff --git a/compiler/cmm/PprCmmDecl.hs b/compiler/cmm/PprCmmDecl.hs
index 2cb90e9a22..354a3d4563 100644
--- a/compiler/cmm/PprCmmDecl.hs
+++ b/compiler/cmm/PprCmmDecl.hs
@@ -92,9 +92,9 @@ pprCmmGroup tops
 pprTop :: (Outputable d, Outputable info, Outputable i)
        => GenCmmDecl d info i -> SDoc
 
-pprTop (CmmProc info lbl graph)
+pprTop (CmmProc info lbl live graph)
 
-  = vcat [ ppr lbl <> lparen <> rparen
+  = vcat [ ppr lbl <> lparen <> rparen <+> ptext (sLit "// ") <+> ppr live
          , nest 8 $ lbrace <+> ppr info $$ rbrace
          , nest 4 $ ppr graph
          , rbrace ]
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 1f0b82532b..8ac0341666 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -90,9 +90,9 @@ get_Regtable_addr_from_offset dflags _ offset =
 fixStgRegisters :: DynFlags -> RawCmmDecl -> RawCmmDecl
 fixStgRegisters _ top@(CmmData _ _) = top
 
-fixStgRegisters dflags (CmmProc info lbl (ListGraph blocks)) =
+fixStgRegisters dflags (CmmProc info lbl live (ListGraph blocks)) =
   let blocks' = map (fixStgRegBlock dflags) blocks
-  in CmmProc info lbl $ ListGraph blocks'
+  in CmmProc info lbl live $ ListGraph blocks'
 
 fixStgRegBlock :: DynFlags -> CmmBasicBlock -> CmmBasicBlock
 fixStgRegBlock dflags (BasicBlock id stmts) =
diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index a0859252ff..9176cb330c 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -717,7 +717,7 @@ emitEnter fun = do
       --
       AssignTo res_regs _ -> do
        { lret <- newLabelC
-       ; let (off, copyin) = copyInOflow dflags NativeReturn (Young lret) res_regs []
+       ; let (off, _, copyin) = copyInOflow dflags NativeReturn (Young lret) res_regs []
        ; lcall <- newLabelC
        ; updfr_off <- getUpdFrameOff
        ; let area = Young lret
diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs
index e7925667a8..7612cd1a49 100644
--- a/compiler/codeGen/StgCmmForeign.hs
+++ b/compiler/codeGen/StgCmmForeign.hs
@@ -213,7 +213,7 @@ emitForeignCall safety results target args
     updfr_off <- getUpdFrameOff
     temp_target <- load_target_into_temp target
     k <- newLabelC
-    let (off, copyout) = copyInOflow dflags NativeReturn (Young k) results []
+    let (off, _, copyout) = copyInOflow dflags NativeReturn (Young k) results []
        -- see Note [safe foreign call convention]
     emit $
            (    mkStore (CmmStackSlot (Young k) (widthInBytes (wordWidth dflags)))
diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs
index 7393faac9f..7805473915 100644
--- a/compiler/codeGen/StgCmmHeap.hs
+++ b/compiler/codeGen/StgCmmHeap.hs
@@ -416,7 +416,7 @@ altOrNoEscapeHeapCheck checkYield regs code = do
       Nothing -> genericGC checkYield code
       Just gc -> do
         lret <- newLabelC
-        let (off, copyin) = copyInOflow dflags NativeReturn (Young lret) regs []
+        let (off, _, copyin) = copyInOflow dflags NativeReturn (Young lret) regs []
         lcont <- newLabelC
         emitOutOfLine lret (copyin <*> mkBranch lcont)
         emitLabel lcont
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index 39676635aa..bb0b8a78d0 100644
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -126,7 +126,7 @@ emitCallWithExtraStack (callConv, retConv) fun args extra_stack
             AssignTo res_regs _ -> do
               k <- newLabelC
               let area = Young k
-                  (off, copyin) = copyInOflow dflags retConv area res_regs []
+                  (off, _, copyin) = copyInOflow dflags retConv area res_regs []
                   copyout = mkCallReturnsTo dflags fun callConv args k off updfr_off
                                    extra_stack
               emit (copyout <*> mkLabel k <*> copyin)
@@ -521,7 +521,7 @@ emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl args body
         ; let args' = if node_points then (node : arg_regs) else arg_regs
               conv  = if nodeMustPointToIt dflags lf_info then NativeNodeCall
                                                           else NativeDirectCall
-              (offset, _) = mkCallEntry dflags conv args' []
+              (offset, _, _) = mkCallEntry dflags conv args' []
         ; emitClosureAndInfoTable info_tbl conv args' $ body (offset, node, arg_regs)
         }
 
diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs
index b7797bdae6..7a0816f041 100644
--- a/compiler/codeGen/StgCmmMonad.hs
+++ b/compiler/codeGen/StgCmmMonad.hs
@@ -713,12 +713,12 @@ emitProcWithStackFrame
 
 emitProcWithStackFrame _conv mb_info lbl _stk_args [] blocks False
   = do  { dflags <- getDynFlags
-        ; emitProc_ mb_info lbl blocks (widthInBytes (wordWidth dflags)) False
+        ; emitProc_ mb_info lbl [] blocks (widthInBytes (wordWidth dflags)) False
         }
 emitProcWithStackFrame conv mb_info lbl stk_args args blocks True -- do layout
   = do  { dflags <- getDynFlags
-        ; let (offset, entry) = mkCallEntry dflags conv args stk_args
-        ; emitProc_ mb_info lbl (entry <*> blocks) offset True
+        ; let (offset, live, entry) = mkCallEntry dflags conv args stk_args
+        ; emitProc_ mb_info lbl live (entry <*> blocks) offset True
         }
 emitProcWithStackFrame _ _ _ _ _ _ _ = panic "emitProcWithStackFrame"
 
@@ -729,13 +729,13 @@ emitProcWithConvention :: Convention -> Maybe CmmInfoTable -> CLabel
 emitProcWithConvention conv mb_info lbl args blocks
   = emitProcWithStackFrame conv mb_info lbl [] args blocks True
 
-emitProc :: Maybe CmmInfoTable -> CLabel -> CmmAGraph -> Int -> FCode ()
-emitProc  mb_info lbl blocks offset
- = emitProc_ mb_info lbl blocks offset True
+emitProc :: Maybe CmmInfoTable -> CLabel -> [GlobalReg] -> CmmAGraph -> Int -> FCode ()
+emitProc  mb_info lbl live blocks offset
+ = emitProc_ mb_info lbl live blocks offset True
 
-emitProc_ :: Maybe CmmInfoTable -> CLabel -> CmmAGraph -> Int -> Bool
+emitProc_ :: Maybe CmmInfoTable -> CLabel -> [GlobalReg] -> CmmAGraph -> Int -> Bool
           -> FCode ()
-emitProc_ mb_info lbl blocks offset do_layout
+emitProc_ mb_info lbl live blocks offset do_layout
   = do  { dflags <- getDynFlags
         ; l <- newLabelC
         ; let
@@ -751,7 +751,7 @@ emitProc_ mb_info lbl blocks offset do_layout
               tinfo = TopInfo { info_tbls = infos
                               , stack_info=sinfo}
 
-              proc_block = CmmProc tinfo lbl blks
+              proc_block = CmmProc tinfo lbl live blks
 
         ; state <- getState
         ; setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block } }
@@ -795,7 +795,7 @@ mkCall f (callConv, retConv) results actuals updfr_off extra_stack = do
   dflags <- getDynFlags
   k <- newLabelC
   let area = Young k
-      (off, copyin) = copyInOflow dflags retConv area results []
+      (off, _, copyin) = copyInOflow dflags retConv area results []
       copyout = mkCallReturnsTo dflags f callConv actuals k off updfr_off extra_stack
   return (copyout <*> mkLabel k <*> copyin)
 
diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs
index 211620ac42..9a5ac1f522 100644
--- a/compiler/llvmGen/LlvmCodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen.hs
@@ -41,7 +41,7 @@ llvmCodeGen dflags h us cmms
         (cdata,env) = {-# SCC "llvm_split" #-}
                       foldr split ([], initLlvmEnv dflags) cmm
         split (CmmData s d' ) (d,e) = ((s,d'):d,e)
-        split p@(CmmProc _ l _) (d,e) =
+        split p@(CmmProc _ l _ _) (d,e) =
             let lbl = strCLabel_llvm env $ case topInfoTable p of
                         Nothing                   -> l
                         Just (Statics info_lbl _) -> info_lbl
@@ -129,7 +129,7 @@ cmmProcLlvmGens dflags h _ _ [] _ ivars
 cmmProcLlvmGens dflags h us env ((CmmData _ _) : cmms) count ivars
  = cmmProcLlvmGens dflags h us env cmms count ivars
 
-cmmProcLlvmGens dflags h us env ((CmmProc _ _ (ListGraph [])) : cmms) count ivars
+cmmProcLlvmGens dflags h us env ((CmmProc _ _ _ (ListGraph [])) : cmms) count ivars
  = cmmProcLlvmGens dflags h us env cmms count ivars
 
 cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars = do
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index f73552dad8..885d4aa127 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -37,10 +37,10 @@ type LlvmStatements = OrdList LlvmStatement
 -- | Top-level of the LLVM proc Code generator
 --
 genLlvmProc :: LlvmEnv -> RawCmmDecl -> UniqSM (LlvmEnv, [LlvmCmmDecl])
-genLlvmProc env proc0@(CmmProc _ lbl (ListGraph blocks)) = do
+genLlvmProc env proc0@(CmmProc _ lbl live (ListGraph blocks)) = do
     (env', lmblocks, lmdata) <- basicBlocksCodeGen env blocks ([], [])
     let info = topInfoTable proc0
-        proc = CmmProc info lbl (ListGraph lmblocks)
+        proc = CmmProc info lbl live (ListGraph lmblocks)
     return (env', proc:lmdata)
 
 genLlvmProc _ _ = panic "genLlvmProc: case that shouldn't reach here!"
diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
index c791e85a52..781215adf4 100644
--- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
@@ -83,7 +83,7 @@ pprLlvmCmmDecl :: LlvmEnv -> Int -> LlvmCmmDecl -> (SDoc, [LlvmVar])
 pprLlvmCmmDecl _ _ (CmmData _ lmdata)
   = (vcat $ map pprLlvmData lmdata, [])
 
-pprLlvmCmmDecl env count (CmmProc mb_info entry_lbl (ListGraph blks))
+pprLlvmCmmDecl env count (CmmProc mb_info entry_lbl _ (ListGraph blks))
   = let (idoc, ivar) = case mb_info of
                         Nothing -> (empty, [])
                         Just (Statics info_lbl dat)
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/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/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 89e81b48c9..cfadd57869 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
 
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