Remove code that is dead now that we need >= 6.12 to build
[ghc-hetmet.git] / compiler / cmm / CmmBrokenBlock.hs
index 2d2f820..17b8178 100644 (file)
@@ -1,9 +1,3 @@
-{-# 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 CmmBrokenBlock (
   BrokenBlock(..),
@@ -15,25 +9,23 @@ module CmmBrokenBlock (
   adaptBlockToFormat,
   selectContinuations,
   ContFormat,
-  makeContinuationEntries,
+  makeContinuationEntries
   ) where
 
 #include "HsVersions.h"
 
+import BlockId
 import Cmm
 import CmmUtils
 import CLabel
-import MachOp (MachHint(..))
 
 import CgUtils (callerSaveVolatileRegs)
 import ClosureInfo
 
 import Maybes
-import List
+import Data.List
 import Panic
-import UniqSupply
 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.
@@ -68,21 +60,23 @@ data BrokenBlock
 -- | How a block could be entered
 -- See Note [An example of CPS conversion]
 data BlockEntryInfo
-  = FunctionEntry              -- ^ Block is the beginning of a function
-      CmmInfo                   -- ^ Function header info
-      CLabel                    -- ^ The function name
-      CmmFormals                -- ^ Aguments to function
-               -- Only the formal parameters are live 
-
-  | ContinuationEntry          -- ^ Return point of a function call
-      CmmFormals                -- ^ return values (argument to continuation)
-      C_SRT                     -- ^ SRT for the continuation's info table
-      Bool                      -- ^ True <=> GC block so ignore stack size
-               -- Live variables, other than 
-               -- the return values, are on the stack
-
-  | ControlEntry               -- ^ Any other kind of block.
-                                -- Only entered due to control flow.
+  = FunctionEntry CmmInfo CLabel CmmFormals
+      -- ^ Block is the beginning of a function, parameters are:
+      --   1. Function header info
+      --   2. The function name
+      --   3. Aguments to function
+      -- Only the formal parameters are live
+
+  | ContinuationEntry CmmFormals C_SRT Bool
+      -- ^ Return point of a function call, parameters are:
+      --   1. return values (argument to continuation)
+      --   2. SRT for the continuation's info table
+      --   3. True <=> GC block so ignore stack size
+      -- Live variables, other than
+      -- the return values, are on the stack
+
+  | ControlEntry
+      -- ^ Any other kind of block.  Only entered due to control flow.
 
   -- TODO: Consider adding ProcPointEntry
   -- no return values, but some live might end up as
@@ -121,41 +115,43 @@ f2(x, y) { // ProcPointEntry
 
 -}
 
-data ContFormat = ContFormat
-      CmmHintFormals            -- ^ return values (argument to continuation)
-      C_SRT                     -- ^ SRT for the continuation's info table
-      Bool                      -- ^ True <=> GC block so ignore stack size
+data ContFormat = ContFormat HintedCmmFormals C_SRT Bool
+      -- ^ Arguments
+      --   1. return values (argument to continuation)
+      --   2. SRT for the continuation's info table
+      --   3. True <=> GC block so ignore stack size
   deriving (Eq)
 
 -- | Final statement in a 'BlokenBlock'.
 -- Constructors and arguments match those in 'Cmm',
 -- but are restricted to branches, returns, jumps, calls and switches
 data FinalStmt
-  = FinalBranch                 -- ^ Same as 'CmmBranch'
-      BlockId                   -- ^ Target must be a ControlEntry
-
-  | FinalReturn                 -- ^ Same as 'CmmReturn'
-      CmmActuals                -- ^ Return values
-
-  | FinalJump                   -- ^ Same as 'CmmJump'
-      CmmExpr                   -- ^ The function to call
-      CmmActuals                -- ^ Arguments of the call
-
-  | FinalCall                   -- ^ Same as 'CmmCallee'
-                                -- followed by 'CmmGoto'
-      BlockId                   -- ^ Target of the 'CmmGoto'
-                                -- (must be a 'ContinuationEntry')
-      CmmCallTarget             -- ^ The function to call
-      CmmHintFormals                -- ^ Results from call
-                                -- (redundant with ContinuationEntry)
-      CmmActuals                -- ^ Arguments to call
-      C_SRT                     -- ^ SRT for the continuation's info table
-      CmmReturnInfo             -- ^ Does the function return?
-      Bool                      -- ^ True <=> GC block so ignore stack size
-
-  | FinalSwitch                 -- ^ Same as a 'CmmSwitch'
-      CmmExpr                   -- ^ Scrutinee (zero based)
-      [Maybe BlockId]           -- ^ Targets
+  = FinalBranch BlockId
+    -- ^ Same as 'CmmBranch'.  Target must be a ControlEntry
+
+  | FinalReturn HintedCmmActuals
+    -- ^ Same as 'CmmReturn'. Parameter is the return values.
+
+  | FinalJump CmmExpr HintedCmmActuals
+    -- ^ Same as 'CmmJump'.  Parameters:
+    --   1. The function to call,
+    --   2. Arguments of the call
+
+  | FinalCall BlockId CmmCallTarget HintedCmmFormals HintedCmmActuals
+              C_SRT   CmmReturnInfo Bool
+      -- ^ Same as 'CmmCallee' followed by 'CmmGoto'.  Parameters:
+      --   1. Target of the 'CmmGoto' (must be a 'ContinuationEntry')
+      --   2. The function to call
+      --   3. Results from call (redundant with ContinuationEntry)
+      --   4. Arguments to call
+      --   5. SRT for the continuation's info table
+      --   6. Does the function return?
+      --   7. True <=> GC block so ignore stack size
+
+  | FinalSwitch CmmExpr [Maybe BlockId]
+      -- ^ Same as a 'CmmSwitch'.  Paremeters:
+      --   1. Scrutinee (zero based)
+      --   2. Targets
 
 -----------------------------------------------------------------------------
 -- Operations for broken blocks
@@ -184,6 +180,9 @@ data FinalStmt
 -- the 'adaptBlockToFormat' function.
 -- could be 
 
+{-
+UNUSED: 2008-12-29
+
 breakProc ::
     [BlockId]                   -- ^ Any GC blocks that should be special
     -> [[Unique]]               -- ^ An infinite list of uniques
@@ -216,6 +215,7 @@ breakProc gc_block_idents uniques info ident params blocks =
        zipWith (adaptBlockToFormat selected)
                adaptor_uniques
                (snd broken_blocks)
+-}
 
 -----------------------------------------------------------------------------
 -- | Takes a 'CmmBasicBlock' and breaks it up into a list of 'BrokenBlock'
@@ -343,12 +343,14 @@ selectContinuations needed_continuations = formats
               -- sort so the most votes goes *first*
               -- (thus the order of x and y is reversed)
 
+makeContinuationEntries :: [(BlockId, ContFormat)]
+                        -> BrokenBlock -> BrokenBlock
 makeContinuationEntries formats
-                        block@(BrokenBlock ident entry stmts targets exit) =
+                        block@(BrokenBlock ident _entry stmts targets exit) =
     case lookup ident formats of
       Nothing -> block
       Just (ContFormat formals srt is_gc) ->
-          BrokenBlock ident (ContinuationEntry (map fst formals) srt is_gc)
+          BrokenBlock ident (ContinuationEntry (map hintlessCmm formals) srt is_gc)
                       stmts targets exit
 
 adaptBlockToFormat :: [(BlockId, ContFormat)]
@@ -357,8 +359,8 @@ adaptBlockToFormat :: [(BlockId, ContFormat)]
                    -> [BrokenBlock]
 adaptBlockToFormat formats unique
                    block@(BrokenBlock ident entry stmts targets
-                                      exit@(FinalCall next target formals
-                                                      actuals srt ret is_gc)) =
+                                      (FinalCall next target formals
+                                                 actuals srt ret is_gc)) =
     if format_formals == formals &&
        format_srt == srt &&
        format_is_gc == is_gc
@@ -374,23 +376,23 @@ adaptBlockToFormat formats unique
       revised_block = BrokenBlock ident entry stmts revised_targets revised_exit
       revised_targets = adaptor_ident : delete next targets
       revised_exit = FinalCall
-                       adaptor_ident -- ^ The only part that changed
+                       adaptor_ident -- The only part that changed
                        target formals actuals srt ret is_gc
 
       adaptor_block = mk_adaptor_block adaptor_ident
-                  (ContinuationEntry (map fst formals) srt is_gc)
-                  next format_formals
+                  (ContinuationEntry (map hintlessCmm formals) srt is_gc) next
       adaptor_ident = BlockId unique
 
-      mk_adaptor_block :: BlockId -> BlockEntryInfo -> BlockId -> CmmHintFormals -> BrokenBlock
-      mk_adaptor_block ident entry next formals =
+      mk_adaptor_block :: BlockId -> BlockEntryInfo -> BlockId -> BrokenBlock
+      mk_adaptor_block ident entry next =
           BrokenBlock ident entry [] [next] exit
               where
                 exit = FinalJump
                          (CmmLit (CmmLabel (mkReturnPtLabel (getUnique next))))
                          (map formal_to_actual format_formals)
 
-                formal_to_actual (reg, hint) = ((CmmReg (CmmLocal reg)), hint)
+                formal_to_actual (CmmHinted reg hint)
+                     = (CmmHinted (CmmReg (CmmLocal reg)) hint)
                 -- TODO: Check if NoHint is right.  We're
                 -- jumping to a C-- function not a foreign one
                 -- so it might always be right.
@@ -416,4 +418,4 @@ cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) =
 -----------------------------------------------------------------------------
 -- | Build a mapping so we can lookup a 'BrokenBlock' by its 'BlockId'
 blocksToBlockEnv :: [BrokenBlock] -> BlockEnv BrokenBlock
-blocksToBlockEnv blocks = listToUFM $ map (\b -> (brokenBlockId b, b)) blocks
+blocksToBlockEnv blocks = mkBlockEnv $ map (\b -> (brokenBlockId b, b)) blocks