X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmBrokenBlock.hs;h=aa8dbf8ac6e299e09b966936b2477328ada7c7e3;hb=b025092d120eb8799ba0408cf96fb7cacb55db76;hp=130e57809e3173632a1fc70ff522f3ba180af710;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf;p=ghc-hetmet.git diff --git a/compiler/cmm/CmmBrokenBlock.hs b/compiler/cmm/CmmBrokenBlock.hs index 130e578..aa8dbf8 100644 --- a/compiler/cmm/CmmBrokenBlock.hs +++ b/compiler/cmm/CmmBrokenBlock.hs @@ -1,8 +1,8 @@ -{-# OPTIONS_GHC -w #-} +{-# 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/WorkingConventions#Warnings +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings -- for details module CmmBrokenBlock ( @@ -20,6 +20,7 @@ module CmmBrokenBlock ( #include "HsVersions.h" +import BlockId import Cmm import CmmUtils import CLabel @@ -68,21 +69,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 CmmFormalsWithoutKinds + -- ^ 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 CmmFormalsWithoutKinds 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 +124,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 CmmFormals 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 CmmActuals + -- ^ Same as 'CmmReturn'. Parameter is the return values. + + | FinalJump CmmExpr CmmActuals + -- ^ Same as 'CmmJump'. Parameters: + -- 1. The function to call, + -- 2. Arguments of the call + + | FinalCall BlockId CmmCallTarget CmmFormals CmmActuals + 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 @@ -190,7 +195,7 @@ breakProc :: -- to create names of the new blocks with -> CmmInfo -- ^ Info table for the procedure -> CLabel -- ^ Name of the procedure - -> CmmFormals -- ^ Parameters of the procedure + -> CmmFormalsWithoutKinds -- ^ Parameters of the procedure -> [CmmBasicBlock] -- ^ Blocks of the procecure -- (First block is the entry block) -> [BrokenBlock] @@ -348,7 +353,7 @@ makeContinuationEntries formats 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 kindlessCmm formals) srt is_gc) stmts targets exit adaptBlockToFormat :: [(BlockId, ContFormat)] @@ -374,15 +379,15 @@ 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) + (ContinuationEntry (map kindlessCmm formals) srt is_gc) next format_formals adaptor_ident = BlockId unique - mk_adaptor_block :: BlockId -> BlockEntryInfo -> BlockId -> CmmHintFormals -> BrokenBlock + mk_adaptor_block :: BlockId -> BlockEntryInfo -> BlockId -> CmmFormals -> BrokenBlock mk_adaptor_block ident entry next formals = BrokenBlock ident entry [] [next] exit where @@ -390,7 +395,8 @@ adaptBlockToFormat formats unique (CmmLit (CmmLabel (mkReturnPtLabel (getUnique next)))) (map formal_to_actual format_formals) - formal_to_actual (reg, hint) = ((CmmReg (CmmLocal reg)), hint) + formal_to_actual (CmmKinded reg hint) + = (CmmKinded (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.