Commit b8e0ce7b authored by Edward Z. Yang's avatar Edward Z. Yang

Port MachOp folding to new code generator.

    * Rewrote cmmMachOpFold to cmmMachOpFoldM, which returns
      Nothing if no folding took place.
    * Wrote some generic mapping functions which take functions
      of form 'a -> Maybe a' and are smart about sharing.
    * Split up optimizations from PIC and PPC work in the native
      codegen, so they'll be easier to turn off later
      (they are not currently being turned off, however.)
    * Whitespace fixes!

ToDo: Turn off MachOp folding when new codegenerator is being used.
Signed-off-by: Edward Z. Yang's avatarEdward Z. Yang <ezyang@mit.edu>
parent 1687dab3
......@@ -11,6 +11,7 @@ module CmmNode
( CmmNode(..)
, UpdFrameOffset, Convention(..), ForeignConvention(..), ForeignTarget(..)
, mapExp, mapExpDeep, wrapRecExp, foldExp, foldExpDeep, wrapRecExpf
, mapExpM, mapExpDeepM, wrapRecExpM
)
where
......@@ -22,6 +23,7 @@ import SMRep
import Compiler.Hoopl
import Data.Maybe
import Data.List (tails)
import Prelude hiding (succ)
......@@ -323,6 +325,54 @@ mapExp f (CmmForeignCall tgt fs as succ updfr intrbl) = CmmForeignCall (mapFor
mapExpDeep :: (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
mapExpDeep f = mapExp $ wrapRecExp f
------------------------------------------------------------------------
-- mapping Expr in CmmNode, but not performing allocation if no changes
mapForeignTargetM :: (CmmExpr -> Maybe CmmExpr) -> ForeignTarget -> Maybe ForeignTarget
mapForeignTargetM f (ForeignTarget e c) = (\x -> ForeignTarget x c) `fmap` f e
mapForeignTargetM _ (PrimTarget _) = Nothing
wrapRecExpM :: (CmmExpr -> Maybe CmmExpr) -> (CmmExpr -> Maybe CmmExpr)
wrapRecExpM f n@(CmmMachOp op es) = maybe (f n) (f . CmmMachOp op) (mapListM (wrapRecExpM f) es)
wrapRecExpM f n@(CmmLoad addr ty) = maybe (f n) (f . flip CmmLoad ty) (wrapRecExpM f addr)
wrapRecExpM f e = f e
mapExpM :: (CmmExpr -> Maybe CmmExpr) -> CmmNode e x -> Maybe (CmmNode e x)
mapExpM _ (CmmEntry _) = Nothing
mapExpM _ (CmmComment _) = Nothing
mapExpM f (CmmAssign r e) = CmmAssign r `fmap` f e
mapExpM f (CmmStore addr e) = (\[addr', e'] -> CmmStore addr' e') `fmap` mapListM f [addr, e]
mapExpM _ (CmmBranch _) = Nothing
mapExpM f (CmmCondBranch e ti fi) = (\x -> CmmCondBranch x ti fi) `fmap` f e
mapExpM f (CmmSwitch e tbl) = (\x -> CmmSwitch x tbl) `fmap` f e
mapExpM f (CmmCall tgt mb_id o i s) = (\x -> CmmCall x mb_id o i s) `fmap` f tgt
mapExpM f (CmmUnsafeForeignCall tgt fs as)
= case mapForeignTargetM f tgt of
Just tgt' -> Just (CmmUnsafeForeignCall tgt' fs (mapListJ f as))
Nothing -> (\xs -> CmmUnsafeForeignCall tgt fs xs) `fmap` mapListM f as
mapExpM f (CmmForeignCall tgt fs as succ updfr intrbl)
= case mapForeignTargetM f tgt of
Just tgt' -> Just (CmmForeignCall tgt' fs (mapListJ f as) succ updfr intrbl)
Nothing -> (\xs -> CmmForeignCall tgt fs xs succ updfr intrbl) `fmap` mapListM f as
-- share as much as possible
mapListM :: (a -> Maybe a) -> [a] -> Maybe [a]
mapListM f xs = let (b, r) = mapListT f xs
in if b then Just r else Nothing
mapListJ :: (a -> Maybe a) -> [a] -> [a]
mapListJ f xs = snd (mapListT f xs)
mapListT :: (a -> Maybe a) -> [a] -> (Bool, [a])
mapListT f xs = foldr g (False, []) (zip3 (tails xs) xs (map f xs))
where g (_, y, Nothing) (True, ys) = (True, y:ys)
g (_, _, Just y) (True, ys) = (True, y:ys)
g (ys', _, Nothing) (False, _) = (False, ys')
g (_, _, Just y) (False, ys) = (True, y:ys)
mapExpDeepM :: (CmmExpr -> Maybe CmmExpr) -> CmmNode e x -> Maybe (CmmNode e x)
mapExpDeepM f = mapExpM $ wrapRecExpM f
-----------------------------------
-- folding Expr in CmmNode
......
This diff is collapsed.
......@@ -18,6 +18,7 @@ module CmmRewriteAssignments
import Cmm
import CmmExpr
import CmmOpt
import OptimizationFuel
import StgCmmUtils
......@@ -41,7 +42,9 @@ rewriteAssignments g = do
-- to actually perform inlining and sinking.
g' <- annotateUsage g
g'' <- liftM fst $ dataflowPassFwd g' [(g_entry g, fact_bot assignmentLattice)] $
analRewFwd assignmentLattice assignmentTransfer assignmentRewrite
analRewFwd assignmentLattice
assignmentTransfer
(assignmentRewrite `thenFwdRw` machOpFoldRewrite)
return (modifyGraph eraseRegUsage g'')
----------------------------------------------------------------
......@@ -605,4 +608,22 @@ assignmentRewrite = mkFRewrite3 first middle last
inlinable (CmmUnsafeForeignCall{}) = False
inlinable _ = True
-- Need to interleave this with inlining, because machop folding results
-- in literals, which we can inline more aggressively, and inlining
-- gives us opportunities for more folding. However, we don't need any
-- facts to do MachOp folding.
machOpFoldRewrite :: FwdRewrite FuelUniqSM (WithRegUsage CmmNode) a
machOpFoldRewrite = mkFRewrite3 first middle last
where first _ _ = return Nothing
middle :: WithRegUsage CmmNode O O -> a -> GenCmmReplGraph (WithRegUsage CmmNode) O O
middle (Plain m) _ = return (fmap (mkMiddle . Plain) (foldNode m))
middle (AssignLocal l e r) _ = return (fmap f (wrapRecExpM foldExp e))
where f e' = mkMiddle (AssignLocal l e' r)
last :: WithRegUsage CmmNode O C -> a -> GenCmmReplGraph (WithRegUsage CmmNode) O C
last (Plain l) _ = return (fmap (mkLast . Plain) (foldNode l))
foldNode :: CmmNode e x -> Maybe (CmmNode e x)
foldNode n = mapExpDeepM foldExp n
foldExp (CmmMachOp op args) = cmmMachOpFoldM op args
foldExp _ = Nothing
-- ToDo: Outputable instance for UsageMap and AssignmentMap
......@@ -789,8 +789,13 @@ Here we do:
(i) introduce the appropriate indirections
and position independent refs
(ii) compile a list of imported symbols
(d) Some arch-specific optimizations
Ideas for other things we could do:
(a) and (b) will be moving to the new Hoopl pipeline, however, (c) and
(d) are only needed by the native backend and will continue to live
here.
Ideas for other things we could do (put these in Hoopl please!):
- shortcut jumps-to-jumps
- simple CSE: if an expr is assigned to a temp, then replace later occs of
......@@ -830,6 +835,15 @@ cmmBlockConFold (BasicBlock id stmts) = do
stmts' <- mapM cmmStmtConFold stmts
return $ BasicBlock id stmts'
-- This does three optimizations, but they're very quick to check, so we don't
-- bother turning them off even when the Hoopl code is active. Since
-- this is on the old Cmm representation, we can't reuse the code either:
-- * reg = reg --> nop
-- * if 0 then jump --> nop
-- * if 1 then jump --> jump
-- We might be tempted to skip this step entirely of not opt_PIC, but
-- there is some PowerPC code for the non-PIC case, which would also
-- have to be separated.
cmmStmtConFold :: CmmStmt -> CmmOptM CmmStmt
cmmStmtConFold stmt
= case stmt of
......@@ -876,28 +890,37 @@ cmmStmtConFold stmt
other
-> return other
cmmExprConFold :: ReferenceKind -> CmmExpr -> CmmOptM CmmExpr
cmmExprConFold referenceKind expr = do
-- ToDo: Allow for a flag to turn off invocation of cmmExprCon -- EZY
cmmExprConFold referenceKind expr = cmmExprNative referenceKind (cmmExprCon expr)
cmmExprCon :: CmmExpr -> CmmExpr
cmmExprCon (CmmLoad addr rep) = CmmLoad (cmmExprCon addr) rep
cmmExprCon (CmmMachOp mop args) = cmmMachOpFold mop (map cmmExprCon args)
cmmExprCon other = other
-- handles both PIC and non-PIC cases... a very strange mixture
-- of things to do.
cmmExprNative :: ReferenceKind -> CmmExpr -> CmmOptM CmmExpr
cmmExprNative referenceKind expr = do
dflags <- getDynFlagsCmmOpt
let arch = platformArch (targetPlatform dflags)
case expr of
CmmLoad addr rep
-> do addr' <- cmmExprConFold DataReference addr
-> do addr' <- cmmExprNative DataReference addr
return $ CmmLoad addr' rep
CmmMachOp mop args
-- For MachOps, we first optimize the children, and then we try
-- our hand at some constant-folding.
-> do args' <- mapM (cmmExprConFold DataReference) args
return $ cmmMachOpFold mop args'
-> do args' <- mapM (cmmExprNative DataReference) args
return $ CmmMachOp mop args'
CmmLit (CmmLabel lbl)
-> do
cmmMakeDynamicReference dflags addImportCmmOpt referenceKind lbl
cmmMakeDynamicReference dflags addImportCmmOpt referenceKind lbl
CmmLit (CmmLabelOff lbl off)
-> do
dynRef <- cmmMakeDynamicReference dflags addImportCmmOpt referenceKind lbl
dynRef <- cmmMakeDynamicReference dflags addImportCmmOpt referenceKind lbl
-- need to optimize here, since it's late
return $ cmmMachOpFold (MO_Add wordWidth) [
dynRef,
(CmmLit $ CmmInt (fromIntegral off) wordWidth)
......@@ -908,15 +931,15 @@ cmmExprConFold referenceKind expr = do
-- with the corresponding labels:
CmmReg (CmmGlobal EagerBlackholeInfo)
| arch == ArchPPC && not opt_PIC
-> cmmExprConFold referenceKind $
-> cmmExprNative referenceKind $
CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "__stg_EAGER_BLACKHOLE_info")))
CmmReg (CmmGlobal GCEnter1)
| arch == ArchPPC && not opt_PIC
-> cmmExprConFold referenceKind $
-> cmmExprNative referenceKind $
CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "__stg_gc_enter_1")))
CmmReg (CmmGlobal GCFun)
| arch == ArchPPC && not opt_PIC
-> cmmExprConFold referenceKind $
-> cmmExprNative referenceKind $
CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "__stg_gc_fun")))
other
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment