X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmBrokenBlock.hs;h=aa8dbf8ac6e299e09b966936b2477328ada7c7e3;hb=5a82864902fc01cf8eee847fcf4ee88e74aa535d;hp=14259c662665e90f5ab75c9327d84e3de7959ebd;hpb=a2d5d3c9677a740ace920a976d03dfbd82f7697b;p=ghc-hetmet.git diff --git a/compiler/cmm/CmmBrokenBlock.hs b/compiler/cmm/CmmBrokenBlock.hs index 14259c6..aa8dbf8 100644 --- a/compiler/cmm/CmmBrokenBlock.hs +++ b/compiler/cmm/CmmBrokenBlock.hs @@ -1,3 +1,10 @@ +{-# 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(..), @@ -13,10 +20,13 @@ module CmmBrokenBlock ( #include "HsVersions.h" +import BlockId import Cmm +import CmmUtils import CLabel import MachOp (MachHint(..)) +import CgUtils (callerSaveVolatileRegs) import ClosureInfo import Maybes @@ -57,58 +67,100 @@ 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 - - | 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 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 -- 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 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 '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 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 @@ -143,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] @@ -219,7 +271,7 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry = -- 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 @@ -227,33 +279,52 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry = 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 ret : stmts) -> + breakBlock' remaining_uniques current_id entry exits + (accum_stmts ++ + arg_stmts ++ + caller_save ++ + [CmmCall target results new_args CmmUnsafe ret] ++ + caller_load) + stmts + where + (remaining_uniques, arg_stmts, new_args) = + loadArgsIntoTemps uniques arguments + (caller_save, caller_load) = callerSaveVolatileRegs (Just []) + -- Default case. Just keep accumulating statements -- and branch targets. - (s:stmts) -> + (s : stmts) -> breakBlock' uniques current_id entry (cond_branch_target s++exits) (accum_stmts++[s]) 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] @@ -282,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)] @@ -292,7 +363,7 @@ 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 @@ -308,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 - 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) + (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 @@ -324,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. @@ -343,8 +415,8 @@ cmmBlockFromBrokenBlock (BrokenBlock ident _ stmts _ exit) = 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] -----------------------------------------------------------------------------