X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmLive.hs;h=bee3c65b07b7a24945353effd8847e61a0f05a84;hb=8a2809c29de9f23eba7ca682b48390033a9d40f6;hp=0a4eb67ae373a9d44fd2a5044ef0f1ba00504971;hpb=3de1c72b6fdc52cd9c1938f21b8d284cc3cdbbc9;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs
index 0a4eb67..bee3c65 100644
--- a/compiler/cmm/CmmLive.hs
+++ b/compiler/cmm/CmmLive.hs
@@ -1,8 +1,12 @@
 module CmmLive (
-        CmmLive, BlockEntryLiveness,
-        cmmLiveness
+        CmmLive,
+        BlockEntryLiveness,
+        cmmLiveness,
+        cmmHintFormalsToLiveLocals,
   ) where
 
+#include "HsVersions.h"
+
 import Cmm
 import Dataflow
 
@@ -11,20 +15,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 =
@@ -33,8 +41,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
@@ -48,27 +62,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
 
@@ -80,40 +91,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
@@ -123,13 +116,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
 -----------------------------------------------------------------------------
 
@@ -156,6 +156,9 @@ addKilled new_killed live = live `minusUniqSet` new_killed
 --------------------------------
 -- Liveness of a CmmStmt
 --------------------------------
+cmmHintFormalsToLiveLocals :: CmmHintFormals -> [LocalReg]
+cmmHintFormalsToLiveLocals formals = map fst formals
+
 cmmStmtLive :: BlockEntryLiveness -> CmmStmt -> CmmLivenessTransformer
 cmmStmtLive _ (CmmNop) = id
 cmmStmtLive _ (CmmComment _) = id
@@ -170,10 +173,7 @@ cmmStmtLive _ (CmmStore expr1 expr2) =
 cmmStmtLive _ (CmmCall target results arguments _) =
     target_liveness .
     foldr ((.) . cmmExprLive) id (map fst arguments) .
-    addKilled (mkUniqSet $ only_local_regs results) where
-        only_local_regs [] = []
-        only_local_regs ((CmmGlobal _,_):args) = only_local_regs args
-        only_local_regs ((CmmLocal r,_):args) = r:only_local_regs args
+    addKilled (mkUniqSet $ cmmHintFormalsToLiveLocals results) where
         target_liveness =
             case target of
               (CmmForeignCall target _) -> cmmExprLive target