Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/080dabd4d6a18926d9c040ae4712b1891a4bbf2d >--------------------------------------------------------------- commit 080dabd4d6a18926d9c040ae4712b1891a4bbf2d Author: Edward Z. Yang <[email protected]> Date: Sat May 14 12:49:08 2011 +0100 More aggressive CmmRegOff inlining, and fix failure to inline to assignments. Signed-off-by: Edward Z. Yang <[email protected]> >--------------------------------------------------------------- compiler/cmm/Cmm.hs | 5 ++- compiler/cmm/CmmNode.hs | 2 +- compiler/cmm/CmmSpillReload.hs | 42 +++++++++++++++++++++++++++------------ 3 files changed, 33 insertions(+), 16 deletions(-) diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs index 54b4b11..a6b215b 100644 --- a/compiler/cmm/Cmm.hs +++ b/compiler/cmm/Cmm.hs @@ -11,7 +11,7 @@ module Cmm ( CmmGraph, GenCmmGraph(..), CmmBlock , CmmStackInfo(..), CmmTopInfo(..), Cmm, CmmTop - , CmmReplGraph, CmmFwdRewrite, CmmBwdRewrite + , CmmReplGraph, GenCmmReplGraph, CmmFwdRewrite, CmmBwdRewrite , modifyGraph , lastNode, replaceLastNode, insertBetween @@ -46,7 +46,8 @@ type CmmGraph = GenCmmGraph CmmNode data GenCmmGraph n = CmmGraph { g_entry :: BlockId, g_graph :: Graph n C C } type CmmBlock = Block CmmNode C C -type CmmReplGraph e x = FuelUniqSM (Maybe (Graph CmmNode e x)) +type CmmReplGraph e x = GenCmmReplGraph CmmNode e x +type GenCmmReplGraph n e x = FuelUniqSM (Maybe (Graph n e x)) type CmmFwdRewrite f = FwdRewrite FuelUniqSM CmmNode f type CmmBwdRewrite f = BwdRewrite FuelUniqSM CmmNode f diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs index ee948fe..eedb74c 100644 --- a/compiler/cmm/CmmNode.hs +++ b/compiler/cmm/CmmNode.hs @@ -10,7 +10,7 @@ module CmmNode ( CmmNode(..) , UpdFrameOffset, Convention(..), ForeignConvention(..), ForeignTarget(..) - , mapExp, mapExpDeep, foldExp, foldExpDeep + , mapExp, mapExpDeep, wrapRecExp, foldExp, foldExpDeep, wrapRecExpf ) where diff --git a/compiler/cmm/CmmSpillReload.hs b/compiler/cmm/CmmSpillReload.hs index 814bef1..4679ecf 100644 --- a/compiler/cmm/CmmSpillReload.hs +++ b/compiler/cmm/CmmSpillReload.hs @@ -195,6 +195,7 @@ removeDeadAssignmentsAndReloads procPoints g = middle :: CmmNode O O -> Fact O DualLive -> CmmReplGraph O O middle (CmmAssign (CmmLocal reg') _) live | not (reg' `elemRegSet` in_regs live) = return $ Just emptyGraph -- XXX maybe this should be somewhere else... + middle (CmmAssign lhs (CmmReg rhs)) _ | lhs == rhs = return $ Just emptyGraph middle (CmmStore lhs (CmmLoad rhs _)) _ | lhs == rhs = return $ Just emptyGraph middle _ _ = return Nothing @@ -457,7 +458,10 @@ middleAssignment n@(AssignLocal r e usage) assign decide CmmLoad{} = AlwaysSink e decide CmmStackSlot{} = AlwaysSink e decide CmmMachOp{} = AlwaysSink e - decide CmmRegOff{} = AlwaysSink e + -- We'll always inline simple operations on the global + -- registers, to reduce register pressure: Sp - 4 or Hp - 8 + -- EZY: Justify this optimization more carefully. + decide CmmRegOff{} = AlwaysInline e -- Algorithm for unannotated assignments of global registers: -- 1. Delete any sinking assignments that were used by this instruction @@ -553,8 +557,9 @@ assignmentRewrite :: FwdRewrite FuelUniqSM (WithRegUsage CmmNode) AssignmentMap assignmentRewrite = mkFRewrite3 first middle last where first _ _ = return Nothing + middle :: WithRegUsage CmmNode O O -> AssignmentMap -> GenCmmReplGraph (WithRegUsage CmmNode) O O middle (Plain m) assign = return $ rewrite assign (precompute assign m) mkMiddle m - middle _ _ = return Nothing + middle (AssignLocal l e u) assign = return $ rewriteLocal assign (precompute assign (CmmAssign (CmmLocal l) e)) mkMiddle l e u last (Plain l) assign = return $ rewrite assign (precompute assign l) mkLast l -- Tuple is (inline?, reloads) precompute assign n = foldRegsUsed f (False, []) n -- duplicates are harmless @@ -580,20 +585,31 @@ assignmentRewrite = mkFRewrite3 first middle last rewrite _ (True, []) _ n | not (inlinable n) = Nothing -- see [CmmCall Inline Hack] rewrite assign (i, xs) mk n = Just $ mkMiddles xs <*> mk (Plain (inline i assign n)) + rewriteLocal _ (False, []) _ _ _ _ = Nothing + rewriteLocal assign (i, xs) mk l e u = Just $ mkMiddles xs <*> mk n' + where n' = AssignLocal l e' u + e' = if i then wrapRecExp (inlineExp assign) e else e + -- inlinable check omitted, since we can always inline into + -- assignments. + inline :: Bool -> AssignmentMap -> CmmNode e x -> CmmNode e x inline False _ n = n inline True _ n | not (inlinable n) = n -- see [CmmCall Inline Hack] - inline True assign n = mapExpDeep inlineExp n - where inlineExp old@(CmmReg (CmmLocal r)) - = case lookupUFM assign r of - Just (AlwaysInline x) -> x - _ -> old - inlineExp old@(CmmRegOff (CmmLocal r) i) - = case lookupUFM assign r of - Just (AlwaysInline x) -> CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt (fromIntegral i) rep)] - where rep = typeWidth (localRegType r) - _ -> old - inlineExp old = old + inline True assign n = mapExpDeep (inlineExp assign) n + + inlineExp assign old@(CmmReg (CmmLocal r)) + = case lookupUFM assign r of + Just (AlwaysInline x) -> x + _ -> old + inlineExp assign old@(CmmRegOff (CmmLocal r) i) + = case lookupUFM assign r of + Just (AlwaysInline x) -> + case x of + (CmmRegOff r' i') -> CmmRegOff r' (i + i') + _ -> CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt (fromIntegral i) rep)] + where rep = typeWidth (localRegType r) + _ -> old + inlineExp _ old = old inlinable :: CmmNode e x -> Bool inlinable (CmmCall{}) = False _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
