Implemented and fixed bugs in CmmInfo handling

[ghc-hetmet.git] / compiler / cmm / CmmBrokenBlock.hs

diff --git a/compiler/cmm/CmmBrokenBlock.hs b/compiler/cmm/CmmBrokenBlock.hs
index 49c41bb..a968484 100644 (file)
--- 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
@@ -35,7 +37,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
@@ -45,11 +47,13 @@ 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
 
   | 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 +82,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
 
@@ -136,13 +140,15 @@ breakBlock uniques (BasicBlock ident stmts) entry =
                 block = do_call current_id entry accum_stmts exits next_id
                                 target results arguments
              -}
-            (CmmCall target results arguments: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
+            (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
             (s:stmts) ->
                 breakBlock' uniques current_id entry
                             (cond_branch_target s++exits)
@@ -171,7 +177,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]
 
 -----------------------------------------------------------------------------