X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmmBrokenBlock.hs;h=17b81783d6b3fb777cb70b5b9aed885a3afff711;hp=130e57809e3173632a1fc70ff522f3ba180af710;hb=edc0bafd3fcd01b85a2e8894e5dfe149eb0e0857;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf diff --git a/compiler/cmm/CmmBrokenBlock.hs b/compiler/cmm/CmmBrokenBlock.hs index 130e578..17b8178 100644 --- a/compiler/cmm/CmmBrokenBlock.hs +++ b/compiler/cmm/CmmBrokenBlock.hs @@ -1,9 +1,3 @@ -{-# OPTIONS_GHC -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/WorkingConventions#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