+{-# 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/Commentary/CodingStyle#Warnings
+-- for details
+
module CmmBrokenBlock (
BrokenBlock(..),
BlockEntryInfo(..),
import CLabel
import MachOp (MachHint(..))
+import CgUtils (callerSaveVolatileRegs)
import ClosureInfo
import Maybes
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.
-- It also collects information about the block for later use
}
-- | 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.
-- no return values, but some live might end up as
-- params or possibly in the frame
+{- 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
CmmHintFormals -- ^ return values (argument to continuation)
C_SRT -- ^ SRT for the continuation's info table
CmmExpr -- ^ The function to call
CmmActuals -- ^ Arguments of the call
- | FinalCall -- ^ Same as 'CmmForeignCall'
+ | FinalCall -- ^ Same as 'CmmCallee'
-- followed by 'CmmGoto'
BlockId -- ^ Target of the 'CmmGoto'
-- (must be a 'ContinuationEntry')
-- (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'
-- 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]
adaptBlockToFormat formats unique
block@(BrokenBlock ident entry stmts targets
exit@(FinalCall next target formals
- actuals srt is_gc)) =
+ actuals srt ret is_gc)) =
if format_formals == formals &&
format_srt == srt &&
format_is_gc == is_gc
revised_targets = adaptor_ident : delete next targets
revised_exit = FinalCall
adaptor_ident -- ^ The only part that changed
- target formals actuals srt is_gc
+ target formals actuals srt ret is_gc
adaptor_block = mk_adaptor_block adaptor_ident
(ContinuationEntry (map fst formals) srt is_gc)
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]
-----------------------------------------------------------------------------
projects / ghc-hetmet.git / blobdiff