X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmBrokenBlock.hs;h=6ffe3d734fe14ce984fb6d0fdf819deeb16979b2;hb=0f5e104c36b1dc3d8deeec5fef3d65e7b3a1b5ad;hp=cc968f175897af67e93e4a16f187698483950c33;hpb=1c5499d4d5d506ce0cc971e98c09bfbf7bc290a1;p=ghc-hetmet.git diff --git a/compiler/cmm/CmmBrokenBlock.hs b/compiler/cmm/CmmBrokenBlock.hs index cc968f1..6ffe3d7 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,6 +20,7 @@ module CmmBrokenBlock ( #include "HsVersions.h" +import BlockId import Cmm import CmmUtils import CLabel @@ -64,11 +72,11 @@ 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 @@ -115,7 +123,7 @@ f2(x, y) { // ProcPointEntry -} 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) @@ -139,10 +147,11 @@ data FinalStmt 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' @@ -182,7 +191,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] @@ -258,7 +267,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 @@ -266,15 +275,15 @@ 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 + target results arguments srt ret cont_info = (next_id, -- Entry convention for the -- continuation of the call @@ -287,12 +296,12 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry = -- 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 @@ -309,9 +318,9 @@ breakBlock gc_block_idents uniques (BasicBlock ident stmts) entry = 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] @@ -340,7 +349,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)] @@ -350,7 +359,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 @@ -367,14 +376,14 @@ adaptBlockToFormat formats unique 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 @@ -382,7 +391,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. @@ -401,8 +411,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] -----------------------------------------------------------------------------