X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmmLive.hs;h=3797220a225571ffd09d20d1d90fd128a74240e0;hp=771d4760d42358dad2d8126388e86705f12bc48f;hb=ad94d40948668032189ad22a0ad741ac1f645f50;hpb=53a82428d5e18a016dbc6b604d88577e7dc916e5

diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs
index 771d476..3797220 100644
--- a/compiler/cmm/CmmLive.hs
+++ b/compiler/cmm/CmmLive.hs
@@ -1,9 +1,19 @@
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
+-- for details
+
 module CmmLive (
-        CmmLive, BlockEntryLiveness,
+        CmmLive,
+        BlockEntryLiveness,
         cmmLiveness,
-        cmmFormalsToLiveLocals
+        cmmHintFormalsToLiveLocals,
   ) where
 
+#include "HsVersions.h"
+
 import Cmm
 import Dataflow
 
@@ -12,20 +22,24 @@ import Panic
 import UniqFM
 import UniqSet
 
-import Data.List
-
 -----------------------------------------------------------------------------
 -- Calculating what variables are live on entry to a basic block
 -----------------------------------------------------------------------------
 
--- The variables live on entry to a block
+-- | The variables live on entry to a block
 type CmmLive = UniqSet LocalReg
 
--- A mapping from block labels to the variables live on entry
+-- | A mapping from block labels to the variables live on entry
 type BlockEntryLiveness = BlockEnv CmmLive
 
+-- | A mapping from block labels to the blocks that target it
+type BlockSources = BlockEnv (UniqSet BlockId)
+
+-- | A mapping from block labels to the statements in the block
+type BlockStmts = BlockEnv [CmmStmt]
+
 -----------------------------------------------------------------------------
--- cmmLiveness and helpers
+-- | Calculated liveness info for a list of 'CmmBasicBlock'
 -----------------------------------------------------------------------------
 cmmLiveness :: [CmmBasicBlock] -> BlockEntryLiveness
 cmmLiveness blocks =
@@ -34,8 +48,14 @@ cmmLiveness blocks =
                (map blockId blocks)
                (listToUFM [(blockId b, emptyUniqSet) | b <- blocks])
     where
+      sources :: BlockSources
       sources = cmmBlockSources blocks
-      blocks' = cmmBlockNames blocks
+
+      blocks' :: BlockStmts
+      blocks' = listToUFM $ map block_name blocks
+
+      block_name :: CmmBasicBlock -> (BlockId, [CmmStmt])
+      block_name b = (blockId b, blockStmts b)
 
 {-
 -- For debugging, annotate each block with a comment indicating
@@ -49,27 +69,24 @@ cmmLivenessComment live (BasicBlock ident stmts) =
 -}
 
 
---------------------------------
--- cmmBlockSources
---
--- Calculates a table of blocks
--- that might need updating after
--- a given block is updated
---------------------------------
-cmmBlockSources :: [CmmBasicBlock] -> BlockEnv (UniqSet BlockId)
+-----------------------------------------------------------------------------
+-- | Calculates a table of where one can lookup the blocks that might
+-- need updating after a given block is updated in the liveness analysis
+-----------------------------------------------------------------------------
+cmmBlockSources :: [CmmBasicBlock] -> BlockSources
 cmmBlockSources blocks = foldr aux emptyUFM blocks
     where
       aux :: CmmBasicBlock
-          -> BlockEnv (UniqSet BlockId)
-          -> BlockEnv (UniqSet BlockId)
+          -> BlockSources
+          -> BlockSources
       aux block sourcesUFM =
           foldUniqSet (add_source_edges $ blockId block)
                       sourcesUFM
                       (branch_targets $ blockStmts block)
 
       add_source_edges :: BlockId -> BlockId
-                       -> BlockEnv (UniqSet BlockId)
-                       -> BlockEnv (UniqSet BlockId)
+                       -> BlockSources
+                       -> BlockSources
       add_source_edges source target ufm =
           addToUFM_Acc (flip addOneToUniqSet) unitUniqSet ufm target source
 
@@ -81,40 +98,22 @@ cmmBlockSources blocks = foldr aux emptyUFM blocks
               target (CmmSwitch _ blocks) = mapMaybe id blocks
               target _ = []
 
---------------------------------
--- cmmBlockNames
---
--- Calculates a table that maps
--- block names to the list
--- of statements inside them
---------------------------------
-cmmBlockNames :: [CmmBasicBlock] -> BlockEnv [CmmStmt]
-cmmBlockNames blocks = listToUFM $ map block_name blocks where
-    block_name b = (blockId b, blockStmts b)
-
---------------------------------
--- cmmBlockDependants
+-----------------------------------------------------------------------------
+-- | Given the table calculated by 'cmmBlockSources', list all blocks
+-- that depend on the result of a particular block.
 --
--- Given the table calculated
--- by cmmBlockSources created,
--- list all blocks that depend
--- on the result of a particular
--- block.
---------------------------------
-cmmBlockDependants :: BlockEnv (UniqSet BlockId) -> BlockId -> [BlockId]
+-- Used by the call to 'fixedpoint'.
+-----------------------------------------------------------------------------
+cmmBlockDependants :: BlockSources -> BlockId -> [BlockId]
 cmmBlockDependants sources ident =
     uniqSetToList $ lookupWithDefaultUFM sources emptyUniqSet ident
 
---------------------------------
--- cmmBlockUpdate
---
--- Given the table from
--- cmmBlockNames and a block
--- that was updated, calculate
--- an updated BlockEntryLiveness
---------------------------------
+-----------------------------------------------------------------------------
+-- | Given the table of type 'BlockStmts' and a block that was updated,
+-- calculate an updated BlockEntryLiveness
+-----------------------------------------------------------------------------
 cmmBlockUpdate ::
-    BlockEnv [CmmStmt]
+    BlockStmts
     -> BlockId
     -> Maybe BlockId
     -> BlockEntryLiveness
@@ -124,13 +123,20 @@ cmmBlockUpdate blocks node _ state =
       then Nothing
       else Just $ addToUFM state node new_live
     where
-      new_live = cmmStmtListLive state block
+      new_live, old_live :: CmmLive
+      new_live = cmmStmtListLive state block_stmts
       old_live = lookupWithDefaultUFM state missing_live node
-      block = lookupWithDefaultUFM blocks missing_block node
+
+      block_stmts :: [CmmStmt]
+      block_stmts = lookupWithDefaultUFM blocks missing_block node
+
       missing_live = panic "unknown block id during liveness analysis"
       missing_block = panic "unknown block id during liveness analysis"
 
 -----------------------------------------------------------------------------
+-- Section: 
+-----------------------------------------------------------------------------
+-----------------------------------------------------------------------------
 -- CmmBlockLive, cmmStmtListLive and helpers
 -----------------------------------------------------------------------------
 
@@ -157,10 +163,8 @@ addKilled new_killed live = live `minusUniqSet` new_killed
 --------------------------------
 -- Liveness of a CmmStmt
 --------------------------------
-cmmFormalsToLiveLocals :: CmmFormals -> [LocalReg]
-cmmFormalsToLiveLocals [] = []
-cmmFormalsToLiveLocals ((CmmGlobal _,_):args) = cmmFormalsToLiveLocals args
-cmmFormalsToLiveLocals ((CmmLocal r,_):args) = r:cmmFormalsToLiveLocals args
+cmmHintFormalsToLiveLocals :: CmmHintFormals -> [LocalReg]
+cmmHintFormalsToLiveLocals formals = map fst formals
 
 cmmStmtLive :: BlockEntryLiveness -> CmmStmt -> CmmLivenessTransformer
 cmmStmtLive _ (CmmNop) = id
@@ -173,13 +177,13 @@ cmmStmtLive _ (CmmAssign reg expr) =
               (CmmGlobal _) -> id
 cmmStmtLive _ (CmmStore expr1 expr2) =
     cmmExprLive expr2 . cmmExprLive expr1
-cmmStmtLive _ (CmmCall target results arguments _) =
+cmmStmtLive _ (CmmCall target results arguments _ _) =
     target_liveness .
     foldr ((.) . cmmExprLive) id (map fst arguments) .
-    addKilled (mkUniqSet $ cmmFormalsToLiveLocals results) where
+    addKilled (mkUniqSet $ cmmHintFormalsToLiveLocals results) where
         target_liveness =
             case target of
-              (CmmForeignCall target _) -> cmmExprLive target
+              (CmmCallee target _) -> cmmExprLive target
               (CmmPrim _) -> id
 cmmStmtLive other_live (CmmBranch target) =
     addLive (lookupWithDefaultUFM other_live emptyUniqSet target)