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

diff --git a/compiler/cmm/CmmBrokenBlock.hs b/compiler/cmm/CmmBrokenBlock.hs
index b367216..60cb3e5 100644
--- a/compiler/cmm/CmmBrokenBlock.hs
+++ b/compiler/cmm/CmmBrokenBlock.hs
@@ -12,6 +12,8 @@ module CmmBrokenBlock (
 import Cmm
 import CLabel
 
+import ClosureInfo
+
 import Maybes
 import Panic
 import Unique
@@ -50,6 +52,7 @@ data BlockEntryInfo
 
   | ContinuationEntry 		-- ^ Return point of a function call
       CmmFormals                -- ^ return values (argument to continuation)
+      C_SRT                     -- ^ SRT for the continuation's info table
 
   | ControlEntry		-- ^ Any other kind of block.
                                 -- Only entered due to control flow.
@@ -78,7 +81,7 @@ data FinalStmt
       BlockId                   -- ^ Target of the 'CmmGoto'
                                 -- (must be a 'ContinuationEntry')
       CmmCallTarget             -- ^ The function to call
-      CmmFormals                -- ^ Results from call
+      CmmHintFormals                -- ^ Results from call
                                 -- (redundant with ContinuationEntry)
       CmmActuals                -- ^ Arguments to call
 
@@ -129,18 +132,20 @@ breakBlock uniques (BasicBlock ident stmts) entry =
 
             -- Detect this special case to remain an inverse of
             -- 'cmmBlockFromBrokenBlock'
+            {- TODO: Interferes with proc point detection
             [CmmCall target results arguments,
              CmmBranch next_id] -> [block]
               where
                 block = do_call current_id entry accum_stmts exits next_id
                                 target results arguments
-            (CmmCall target results arguments:stmts) -> block : rest
+             -}
+            (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 results) [] [] stmts
+                                   (ContinuationEntry (map fst results) srt) [] [] stmts
             (s:stmts) ->
                 breakBlock' uniques current_id entry
                             (cond_branch_target s++exits)
@@ -169,7 +174,7 @@ cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) =
             FinalJump target arguments -> [CmmJump target arguments]
             FinalSwitch expr targets -> [CmmSwitch expr targets]
             FinalCall branch_target call_target results arguments ->
-                [CmmCall call_target results arguments,
+                [CmmCall call_target results arguments (panic "needed SRT from cmmBlockFromBrokenBlock"),
                  CmmBranch branch_target]
 
 -----------------------------------------------------------------------------