+{-# 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(..),
#include "HsVersions.h"
+import BlockId
import Cmm
import CmmUtils
import CLabel
}
-- | 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
+ CmmFormalsWithoutKinds -- ^ Aguments to function
+ -- Only the formal parameters are live
| ContinuationEntry -- ^ Return point of a function call
- CmmFormals -- ^ return values (argument to continuation)
+ CmmFormalsWithoutKinds -- ^ 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)
+ CmmFormals -- ^ return values (argument to continuation)
C_SRT -- ^ SRT for the continuation's info table
Bool -- ^ True <=> GC block so ignore stack size
deriving (Eq)
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')
CmmCallTarget -- ^ The function to call
- CmmHintFormals -- ^ Results from call
+ CmmFormals -- ^ 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'
-- 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]
-- 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]
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)]
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)
+ (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
(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.
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