Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : newcg
http://hackage.haskell.org/trac/ghc/changeset/5ff03ca7f3b5b1abad64c039fa20165b4cf77360 >--------------------------------------------------------------- commit 5ff03ca7f3b5b1abad64c039fa20165b4cf77360 Author: Simon Marlow <marlo...@gmail.com> Date: Fri Mar 2 13:12:53 2012 +0000 Revert "Improvements to the mini-inliner" This reverts commit 3d8ab554ced45c51f39951f29cc53277d5788c37. >--------------------------------------------------------------- compiler/cmm/CmmOpt.hs | 81 ++++++++++++++++++++++++----------------------- 1 files changed, 41 insertions(+), 40 deletions(-) diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs index 105453e..ae715a9 100644 --- a/compiler/cmm/CmmOpt.hs +++ b/compiler/cmm/CmmOpt.hs @@ -158,13 +158,22 @@ cmmMiniInlineStmts platform uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr | Nothing <- lookupUFM uses u = cmmMiniInlineStmts platform uses stmts - -- used (foldable to small thing): try to inline at all the use sites + -- 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 | Just n <- lookupUFM uses u, - e <- wrapRecExp foldExp expr, - isTiny e + e@(CmmLit _) <- wrapRecExp foldExp expr = ncgDebugTrace ("nativeGen: inlining " ++ showSDoc (pprStmt platform stmt)) $ - case lookForInlineMany u e stmts of + case lookForInlineLit u e stmts of (m, stmts') | n == m -> cmmMiniInlineStmts platform (delFromUFM uses u) stmts' | otherwise -> @@ -177,10 +186,6 @@ 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 @@ -193,25 +198,26 @@ 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. -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) +lookForInlineLit :: Unique -> CmmExpr -> [CmmStmt] -> (Int, [CmmStmt]) +lookForInlineLit _ _ [] = (0, []) +lookForInlineLit u expr stmts@(stmt : rest) | Just n <- lookupUFM (countUses stmt) u - = case lookForInlineMany' u expr regset rest of + = case lookForInlineLit u expr rest of (m, stmts) -> let z = n + m in z `seq` (z, inlineStmt u expr stmt : stmts) - | okToSkip stmt u expr regset - = case lookForInlineMany' u expr regset rest of + | ok_to_skip + = case lookForInlineLit u expr 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 @@ -223,7 +229,7 @@ lookForInline' u expr regset (stmt : rest) | Just 1 <- lookupUFM (countUses stmt) u, ok_to_inline = Just (inlineStmt u expr stmt : rest) - | okToSkip stmt u expr regset + | ok_to_skip = case lookForInline' u expr regset rest of Nothing -> Nothing Just stmts -> Just (stmt:stmts) @@ -241,26 +247,21 @@ 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 -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 + -- 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 + inlineStmt :: Unique -> CmmExpr -> CmmStmt -> CmmStmt inlineStmt u a (CmmAssign r e) = CmmAssign r (inlineExpr u a e) _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
