X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmBrokenBlock.hs;h=af47e8d559ae6881327de66cf14949860002401c;hb=81285ec475e94ef93d2ac59386d48cb333da2c96;hp=60cb3e5ae77396dbfe6210730dfc8eb8777b2eb4;hpb=affbe8dae5d7eb350686b42ddbd4f3561b7bd0ec;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmBrokenBlock.hs b/compiler/cmm/CmmBrokenBlock.hs
index 60cb3e5..af47e8d 100644
--- a/compiler/cmm/CmmBrokenBlock.hs
+++ b/compiler/cmm/CmmBrokenBlock.hs
@@ -19,6 +19,11 @@ import Panic
 import Unique
 import UniqFM
 
+-- This module takes a 'CmmBasicBlock' which might have 'CmmCall'
+-- statements in it with 'CmmSafe' set and breaks it up at each such call.
+-- It also collects information about the block for later use
+-- by the CPS algorithm.
+
 -----------------------------------------------------------------------------
 -- Data structures
 -----------------------------------------------------------------------------
@@ -37,7 +42,7 @@ data BrokenBlock
 
       brokenBlockTargets :: [BlockId],
                                 -- ^ Blocks that this block could
-                                -- branch to one either by conditional
+                                -- branch to either by conditional
                                 -- branches or via the last statement
 
       brokenBlockExit :: FinalStmt
@@ -47,6 +52,7 @@ data BrokenBlock
 -- | How a block could be entered
 data BlockEntryInfo
   = FunctionEntry		-- ^ Block is the beginning of a function
+      CmmInfo                   -- ^ Function header info
       CLabel                    -- ^ The function name
       CmmFormals                -- ^ Aguments to function
 
@@ -109,6 +115,8 @@ breakBlock uniques (BasicBlock ident stmts) entry =
       breakBlock' uniques current_id entry exits accum_stmts stmts =
           case stmts of
             [] -> panic "block doesn't end in jump, goto, return or switch"
+
+            -- Last statement.  Make the 'BrokenBlock'
             [CmmJump target arguments] ->
                 [BrokenBlock current_id entry accum_stmts
                              exits
@@ -125,6 +133,9 @@ breakBlock uniques (BasicBlock ident stmts) entry =
                 [BrokenBlock current_id entry accum_stmts
                              (mapMaybe id targets ++ exits)
                              (FinalSwitch expr targets)]
+
+            -- These shouldn't happen in the middle of a block.
+            -- They would cause dead code.
             (CmmJump _ _:_) -> panic "jump in middle of block"
             (CmmReturn _:_) -> panic "return in middle of block"
             (CmmBranch _:_) -> panic "branch in middle of block"
@@ -139,13 +150,20 @@ breakBlock uniques (BasicBlock ident stmts) entry =
                 block = do_call current_id entry accum_stmts exits next_id
                                 target results arguments
              -}
-            (CmmCall target results arguments srt:stmts) -> block : rest
-              where
-                next_id = BlockId $ head uniques
-                block = do_call current_id entry accum_stmts exits next_id
-                                target results arguments
-                rest = breakBlock' (tail uniques) next_id
-                                   (ContinuationEntry (map fst results) srt) [] [] stmts
+
+            -- Break the block on safe calls (the main job of this function)
+            (CmmCall target results arguments (CmmSafe srt):stmts) ->
+                block : rest
+                where
+                  next_id = BlockId $ head uniques
+                  block = do_call current_id entry accum_stmts exits next_id
+                                  target results arguments
+                  rest = breakBlock' (tail uniques) next_id
+                                     (ContinuationEntry (map fst results) srt)
+                                     [] [] stmts
+
+            -- Default case.  Just keep accumulating statements
+            -- and branch targets.
             (s:stmts) ->
                 breakBlock' uniques current_id entry
                             (cond_branch_target s++exits)