Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : newcg
http://hackage.haskell.org/trac/ghc/changeset/1ca4986cb654a9b30028eeb2d08a37dd4491cc41 >--------------------------------------------------------------- commit 1ca4986cb654a9b30028eeb2d08a37dd4491cc41 Author: Simon Marlow <[email protected]> Date: Tue Mar 6 13:28:13 2012 +0000 Revert "Revert "Improvements to the mini-inliner"" This reverts commit 5ff03ca7f3b5b1abad64c039fa20165b4cf77360. >--------------------------------------------------------------- compiler/cmm/CmmOpt.hs | 81 +++++++++++++++++++++++------------------------ 1 files changed, 40 insertions(+), 41 deletions(-) diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs index ae715a9..105453e 100644 --- a/compiler/cmm/CmmOpt.hs +++ b/compiler/cmm/CmmOpt.hs @@ -158,22 +158,13 @@ cmmMiniInlineStmts platform uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr | Nothing <- lookupUFM uses u = cmmMiniInlineStmts platform uses stmts - -- used (literal): try to inline at all the use sites - | Just n <- lookupUFM uses u, isLit expr - = - ncgDebugTrace ("nativeGen: inlining " ++ showSDoc (pprStmt platform stmt)) $ - case lookForInlineLit u expr stmts of - (m, stmts') - | n == m -> cmmMiniInlineStmts platform (delFromUFM uses u) stmts' - | otherwise -> - stmt : cmmMiniInlineStmts platform (adjustUFM (\x -> x - m) uses u) stmts' - - -- used (foldable to literal): try to inline at all the use sites + -- used (foldable to small thing): try to inline at all the use sites | Just n <- lookupUFM uses u, - e@(CmmLit _) <- wrapRecExp foldExp expr + e <- wrapRecExp foldExp expr, + isTiny e = ncgDebugTrace ("nativeGen: inlining " ++ showSDoc (pprStmt platform stmt)) $ - case lookForInlineLit u e stmts of + case lookForInlineMany u e stmts of (m, stmts') | n == m -> cmmMiniInlineStmts platform (delFromUFM uses u) stmts' | otherwise -> @@ -186,6 +177,10 @@ cmmMiniInlineStmts platform uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr ncgDebugTrace ("nativeGen: inlining " ++ showSDoc (pprStmt platform stmt)) $ cmmMiniInlineStmts platform uses stmts' where + isTiny (CmmLit _) = True + isTiny (CmmReg _) = True + isTiny _ = False + foldExp (CmmMachOp op args) = cmmMachOpFold platform op args foldExp e = e @@ -198,26 +193,25 @@ cmmMiniInlineStmts platform uses (stmt:stmts) -- register, and a list of statements. Inlines the expression at all -- use sites of the register. Returns the number of substituations -- made and the, possibly modified, list of statements. -lookForInlineLit :: Unique -> CmmExpr -> [CmmStmt] -> (Int, [CmmStmt]) -lookForInlineLit _ _ [] = (0, []) -lookForInlineLit u expr stmts@(stmt : rest) +lookForInlineMany :: Unique -> CmmExpr -> [CmmStmt] -> (Int, [CmmStmt]) +lookForInlineMany u expr stmts = lookForInlineMany' u expr regset stmts + where regset = foldRegsUsed extendRegSet emptyRegSet expr + +lookForInlineMany' :: Unique -> CmmExpr -> RegSet -> [CmmStmt] -> (Int, [CmmStmt]) +lookForInlineMany' _ _ _ [] = (0, []) +lookForInlineMany' u expr regset stmts@(stmt : rest) | Just n <- lookupUFM (countUses stmt) u - = case lookForInlineLit u expr rest of + = case lookForInlineMany' u expr regset rest of (m, stmts) -> let z = n + m in z `seq` (z, inlineStmt u expr stmt : stmts) - | ok_to_skip - = case lookForInlineLit u expr rest of + | okToSkip stmt u expr regset + = case lookForInlineMany' u expr regset rest of (n, stmts) -> (n, stmt : stmts) | otherwise = (0, stmts) - where - -- We skip over assignments to registers, unless the register - -- being assigned to is the one we're inlining. - ok_to_skip = case stmt of - CmmAssign (CmmLocal (LocalReg u' _)) _ | u' == u -> False - _other -> True + lookForInline :: Unique -> CmmExpr -> [CmmStmt] -> Maybe [CmmStmt] lookForInline u expr stmts = lookForInline' u expr regset stmts @@ -229,7 +223,7 @@ lookForInline' u expr regset (stmt : rest) | Just 1 <- lookupUFM (countUses stmt) u, ok_to_inline = Just (inlineStmt u expr stmt : rest) - | ok_to_skip + | okToSkip stmt u expr regset = case lookForInline' u expr regset rest of Nothing -> Nothing Just stmts -> Just (stmt:stmts) @@ -247,21 +241,26 @@ lookForInline' u expr regset (stmt : rest) CmmCall{} -> hasNoGlobalRegs expr _ -> True - -- Expressions aren't side-effecting. Temporaries may or may not - -- be single-assignment depending on the source (the old code - -- generator creates single-assignment code, but hand-written Cmm - -- and Cmm from the new code generator is not single-assignment.) - -- So we do an extra check to make sure that the register being - -- changed is not one we were relying on. I don't know how much of a - -- performance hit this is (we have to create a regset for every - -- instruction.) -- EZY - ok_to_skip = case stmt of - CmmNop -> True - CmmComment{} -> True - CmmAssign (CmmLocal r@(LocalReg u' _)) _rhs | u' /= u && not (r `elemRegSet` regset) -> True - CmmAssign g@(CmmGlobal _) _rhs -> not (g `regUsedIn` expr) - _other -> False - +-- Expressions aren't side-effecting. Temporaries may or may not +-- be single-assignment depending on the source (the old code +-- generator creates single-assignment code, but hand-written Cmm +-- and Cmm from the new code generator is not single-assignment.) +-- So we do an extra check to make sure that the register being +-- changed is not one we were relying on. I don't know how much of a +-- performance hit this is (we have to create a regset for every +-- instruction.) -- EZY +okToSkip stmt u expr regset + = case stmt of + CmmNop -> True + CmmComment{} -> True + CmmAssign (CmmLocal r@(LocalReg u' _)) _rhs | u' /= u && not (r `elemRegSet` regset) -> True + CmmAssign g@(CmmGlobal _) _rhs -> not (g `regUsedIn` expr) + CmmStore _ _ -> not_a_load expr + _other -> False + where + not_a_load (CmmMachOp _ args) = all not_a_load args + not_a_load (CmmLoad _ _) = False + not_a_load _ = True inlineStmt :: Unique -> CmmExpr -> CmmStmt -> CmmStmt inlineStmt u a (CmmAssign r e) = CmmAssign r (inlineExpr u a e) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
