+
module CmmBrokenBlock (
BrokenBlock(..),
BlockEntryInfo(..),
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
-
-import MachRegs (callerSaveVolatileRegs)
- -- HACK: this is part of the NCG so we shouldn't use this, but we need
- -- it for now to eliminate the need for saved regs to be in CmmCall.
- -- The long term solution is to factor callerSaveVolatileRegs
- -- from nativeGen into codeGen
-- This module takes a 'CmmBasicBlock' which might have 'CmmCall'
-- statements in it with 'CmmSafe' set and breaks it up at each such call.
}
-- | 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
-
- | 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
-
- | 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
-- params or possibly in the frame
-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
+{- Note [An example of CPS conversion]
+
+This is NR's and SLPJ's guess about how things might work;
+it may not be consistent with the actual code (particularly
+in the matter of what's in parameters and what's on the stack).
+
+f(x,y) {
+ if x>2 then goto L
+ x = x+1
+L: if x>1 then y = g(y)
+ else x = x+1 ;
+ return( x+y )
+}
+ BECOMES
+
+f(x,y) { // FunctionEntry
+ if x>2 then goto L
+ x = x+1
+L: // ControlEntry
+ if x>1 then push x; push f1; jump g(y)
+ else x=x+1; jump f2(x, y)
+}
+
+f1(y) { // ContinuationEntry
+ pop x; jump f2(x, y);
+}
+
+f2(x, y) { // ProcPointEntry
+ return (z+y);
+}
+
+-}
+
+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 'CmmForeignCall'
- -- 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
- 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
-- the 'adaptBlockToFormat' function.
-- could be
+{-
+UNUSED: 2008-12-29
+
breakProc ::
[BlockId] -- ^ Any GC blocks that should be special
-> [[Unique]] -- ^ An infinite list of uniques
zipWith (adaptBlockToFormat selected)
adaptor_uniques
(snd broken_blocks)
+-}
-----------------------------------------------------------------------------
-- | Takes a 'CmmBasicBlock' and breaks it up into a list of 'BrokenBlock'
-- Detect this special case to remain an inverse of
-- 'cmmBlockFromBrokenBlock'
- [CmmCall target results arguments (CmmSafe srt),
+ [CmmCall target results arguments (CmmSafe srt) ret,
CmmBranch next_id] ->
([cont_info], [block])
where
ContFormat results srt
(ident `elem` gc_block_idents))
block = do_call current_id entry accum_stmts exits next_id
- target results arguments srt
+ target results arguments srt ret
-- Break the block on safe calls (the main job of this function)
- (CmmCall target results arguments (CmmSafe srt) : stmts) ->
+ (CmmCall target results arguments (CmmSafe srt) ret : stmts) ->
(cont_info : cont_infos, block : blocks)
where
next_id = BlockId $ head uniques
block = do_call current_id entry accum_stmts exits next_id
- target results arguments srt
- cont_info = (next_id,
+ target results arguments srt ret
+
+ cont_info = (next_id, -- Entry convention for the
+ -- continuation of the call
ContFormat results srt
(ident `elem` gc_block_idents))
+
+ -- Break up the part after the call
(cont_infos, blocks) = breakBlock' (tail uniques) next_id
ControlEntry [] [] stmts
-- Unsafe calls don't need a continuation
-- but they do need to be expanded
- (CmmCall target results arguments CmmUnsafe : stmts) ->
+ (CmmCall target results arguments CmmUnsafe ret : stmts) ->
breakBlock' remaining_uniques current_id entry exits
(accum_stmts ++
arg_stmts ++
caller_save ++
- [CmmCall target results new_args CmmUnsafe] ++
+ [CmmCall target results new_args CmmUnsafe ret] ++
caller_load)
stmts
where
stmts
do_call current_id entry accum_stmts exits next_id
- target results arguments srt =
+ target results arguments srt ret =
BrokenBlock current_id entry accum_stmts (next_id:exits)
- (FinalCall next_id target results arguments srt
+ (FinalCall next_id target results arguments srt ret
(current_id `elem` gc_block_idents))
cond_branch_target (CmmCondBranch _ target) = [target]
-- 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)]
-> [BrokenBlock]
adaptBlockToFormat formats unique
block@(BrokenBlock ident entry stmts targets
- exit@(FinalCall next target formals
- actuals srt is_gc)) =
+ (FinalCall next target formals
+ actuals srt ret is_gc)) =
if format_formals == formals &&
format_srt == srt &&
format_is_gc == is_gc
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
- target formals actuals srt is_gc
+ 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.
FinalReturn arguments -> [CmmReturn arguments]
FinalJump target arguments -> [CmmJump target arguments]
FinalSwitch expr targets -> [CmmSwitch expr targets]
- FinalCall branch_target call_target results arguments srt _ ->
- [CmmCall call_target results arguments (CmmSafe srt),
+ FinalCall branch_target call_target results arguments srt ret _ ->
+ [CmmCall call_target results arguments (CmmSafe srt) ret,
CmmBranch branch_target]
-----------------------------------------------------------------------------
-- | 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