Attach global register liveness info to Cmm procedures.
authorGeoffrey Mainland <gmainlan@microsoft.com>
Wed, 17 Oct 2012 17:20:29 +0000 (18:20 +0100)
committerGeoffrey Mainland <gmainlan@microsoft.com>
Tue, 30 Oct 2012 20:50:48 +0000 (20:50 +0000)
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:
compiler/cmm/Cmm.hs
compiler/cmm/CmmBuildInfoTables.hs
compiler/cmm/CmmContFlowOpt.hs
compiler/cmm/CmmCvt.hs
compiler/cmm/CmmInfo.hs
compiler/cmm/CmmLayoutStack.hs
compiler/cmm/CmmOpt.hs
compiler/cmm/CmmPipeline.hs
compiler/cmm/CmmProcPoint.hs
compiler/cmm/MkGraph.hs
compiler/cmm/OldCmm.hs
compiler/cmm/OldCmmLint.hs
compiler/cmm/PprC.hs
compiler/cmm/PprCmmDecl.hs
compiler/codeGen/CgUtils.hs
compiler/codeGen/StgCmmExpr.hs
compiler/codeGen/StgCmmForeign.hs
compiler/codeGen/StgCmmHeap.hs
compiler/codeGen/StgCmmLayout.hs
compiler/codeGen/StgCmmMonad.hs
compiler/llvmGen/LlvmCodeGen.hs
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
compiler/llvmGen/LlvmCodeGen/Ppr.hs
compiler/nativeGen/AsmCodeGen.lhs
compiler/nativeGen/PIC.hs
compiler/nativeGen/PPC/CodeGen.hs
compiler/nativeGen/PPC/Ppr.hs
compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
compiler/nativeGen/RegAlloc/Graph/Spill.hs
compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
compiler/nativeGen/RegAlloc/Linear/Main.hs
compiler/nativeGen/RegAlloc/Liveness.hs
compiler/nativeGen/SPARC/CodeGen.hs
compiler/nativeGen/SPARC/CodeGen/Expand.hs
compiler/nativeGen/SPARC/Ppr.hs
compiler/nativeGen/X86/CodeGen.hs
compiler/nativeGen/X86/Instr.hs
compiler/nativeGen/X86/Ppr.hs

index 8409f0d..e1701bd 100644 (file)
@@ -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 {
index 304f4c2..af78b40 100644 (file)
@@ -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
index 4028efd..82f7243 100644 (file)
@@ -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)))
index 4830691..39f0b86 100644 (file)
@@ -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]
index e952c83..699469c 100644 (file)
@@ -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
index c7e6e3a..78bef17 100644 (file)
@@ -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 g)
+  = CmmProc top_info{ info_tbls = mapMapWithKey fix_info info_tbls } l g
   where
     fix_info lbl info_tbl@CmmInfoTable{ cit_rep = StackRep _ } =
        info_tbl { cit_rep = StackRep (get_liveness lbl) }
index dffd417..0d44f0f 100644 (file)
@@ -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 ]
 
index aa8fa2c..70ff754 100644 (file)
@@ -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 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 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 g)
 
             ------------- Populate info tables with stack info -----------------
             g <- {-# SCC "setInfoTableStackMap" #-}
index ddccf7b..02b232d 100644 (file)
@@ -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))
index 1e2ddfa..1536794 100644 (file)
@@ -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
 
index 8d5c039..fccdd81 100644 (file)
@@ -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
index f158369..9a4fb42 100644 (file)
@@ -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
index e07bd64..e0ff99c 100644 (file)
@@ -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 $$
index 2cb90e9..354a3d4 100644 (file)
@@ -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 ]
index 1f0b825..8ac0341 100644 (file)
@@ -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) =
index a085925..9176cb3 100644 (file)
@@ -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
index e792566..7612cd1 100644 (file)
@@ -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)))
index 7393faa..7805473 100644 (file)
@@ -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
index 3967663..bb0b8a7 100644 (file)
@@ -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)
         }
 
index b7797bd..7a0816f 100644 (file)
@@ -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)
 
index 211620a..9a5ac1f 100644 (file)
@@ -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
index f73552d..885d4aa 100644 (file)
@@ -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!"
index c791e85..781215a 100644 (file)
@@ -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)
index ef61adf..23aca92 100644 (file)
@@ -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] #))
 
index 1ea62da..69f3e29 100644 (file)
@@ -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
                      [] -> []
index 026e893..848c7f9 100644 (file)
@@ -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
index 576e19d..045ce8d 100644 (file)
@@ -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
index 0680bea..c4fb7ac 100644 (file)
@@ -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
index 6e11026..25bd313 100644 (file)
@@ -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,
index 9348dca..7f86b9a 100644 (file)
@@ -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 
index abcc6a6..879597f 100644 (file)
@@ -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
 
index 3f1efe5..fc5b992 100644 (file)
@@ -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"
 
 
index 608f0a4..12c1388 100644 (file)
@@ -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
index aeb6d10..c4efdf6 100644 (file)
@@ -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
index c468fcc..fa39777 100644 (file)
@@ -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
index 55afac0..9bfa314 100644 (file)
@@ -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
index 89e81b4..cfadd57 100644 (file)
@@ -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
 
index 7bd9b0c..d089fc3 100644 (file)
@@ -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
index 420da7c..76715f1 100644 (file)
@@ -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