Permalink
Browse files

???

  • Loading branch information...
1 parent 97137d0 commit dd55b153c594b231bb5a7cc4ee0bb001f983e559 @dvorak42 dvorak42 committed May 13, 2012
Showing with 34 additions and 29 deletions.
  1. +8 −7 src/Dataflow.hs
  2. +25 −18 src/Dataflow/CondElim.hs
  3. +1 −4 src/Dataflow/DeadCodeAsm.hs
View
@@ -11,6 +11,7 @@ import Dataflow.Tailcall
import Dataflow.LICM
import Dataflow.Dominator
import Dataflow.OptSupport
+--import Dataflow.CondElim
--import Dataflow.NZP
import LoopAnalysis
@@ -59,7 +60,7 @@ dataflows
--, DFA optLICM performLICMPass
, DFA optCommonSubElim performCSEPass
, DFA optCopyProp performCopyPropPass
- , DFA optCondElim performCondElimPass
+ -- , DFA optCondElim performCondElimPass
-- doing constprop after flatten/cse does great good! see tests/codegen/fig18.6.dcf
, DFA optConstProp performConstPropPass
, DFA optDeadCode performDeadCodePass
@@ -99,7 +100,7 @@ performDataflowAnalysis opts midir
performConstPropPass midir = performFwdPass constPropPass midir emptyFact
performCopyPropPass midir = performFwdPass copyPropPass midir emptyCopyFact
performDeadCodePass midir = performBwdPass deadCodePass midir S.empty
-performCondElimPass midir = performBwdPass condElimPass midir emptyCEFact
+-- performCondElimPass midir = performBwdPass condElimPass midir emptyCEFact
performBlockElimPass midir = performBwdPass blockElimPass midir Nothing
performFlattenPass midir = performFwdPass flattenPass midir ()
--performNZPPass midir = performFwdPass nzpPass midir emptyNZPFact
@@ -178,11 +179,11 @@ copyPropPass = FwdPass
, fp_transfer = varIsCopy
, fp_rewrite = copyProp }
-condElimPass :: (CheckpointMonad m, FuelMonad m) => BwdPass m MidIRInst AssignMap
-condElimPass = BwdPass
- { bp_lattice = condAssignLattice
- , bp_transfer = condAssignness
- , bp_rewrite = condElim }
+--condElimPass :: (CheckpointMonad m, FuelMonad m) => BwdPass m MidIRInst AssignMap
+--condElimPass = BwdPass
+-- { bp_lattice = condAssignLattice
+-- , bp_transfer = condAssignness
+-- , bp_rewrite = condElim }
deadCodePass :: (CheckpointMonad m, FuelMonad m) => BwdPass m MidIRInst Live
deadCodePass = BwdPass
View
@@ -9,37 +9,39 @@ import IR
import Control.Monad
import Data.Maybe
import Debug.Trace
+import Data.Int
+import Text.ParserCombinators.Parsec (SourcePos)
-data Assignable = AssignVar (Var SourcePos VarName)
- | AssignCon (Lit SourcePos Int64)
+data Assignable = AssignVar SourcePos VarName
+ | AssignCon SourcePos Int64
data Assigned = InVar VarName
| InRet String
-data AssignMap = AssignMap (Maybe (M.Map Assigned Assignable)) (Maybe (M.Map Assigned Assignable))
+data AssignMap = AssignMap (Maybe (M.Map Assigned Assignable)) (Maybe (M.Map Assigned Assignable)) (Maybe Label)
condAssignLattice :: DataflowLattice AssignMap
condAssignLattice = DataflowLattice { fact_name = "Branch Assignments"
- , fact_bot = AssignMap (Just M.empty) (Just M.empty)
+ , fact_bot = AssignMap (Just M.empty) (Just M.empty) Nothing
, fact_join = add
}
- where add _ (OldFact o@(AssignMap ol or)) (NewFact n@(AssignMap nl nr)) = (c, n')
+ where add _ (OldFact o@(AssignMap ol or fl)) (NewFact n@(AssignMap nl nr ll)) = (c, n')
where c = n /= n'
n'
- | M.null or && M.null nr = AssignMap ol nl
- | otherwise = AssignMap Nothing Nothing
+ | M.null or && M.null nr && fl == ll = AssignMap ol nl fl
+ | otherwise = AssignMap Nothing Nothing Nothing
emptyCEFact :: AssignMap
emptyCEFact = fact_bot condAssignLattice
condAssignness :: BwdTransfer MidIRInst AssignMap
condAssignness = mkBTransfer f
where f :: MidIRInst e x -> Fact x AssignMap -> AssignMap
- f (Store v (Lit _ v')) k@(AssignMap (Just kr) kl) = AssignMap (combineMaps (M.singleton (InVar v) AssignCon v') kr) kl
- f (Store v (Var _ v')) k@(AssignMap (Just kr) kl) = AssignMap (combineMaps (M.singleton (InVar v) AssignVar v') kr) kl
- f (Return _ rx (Just (Lit _ v'))) k@(AssignMap (Just kr) kl) = AssignMap (combineMaps (M.singleton (InRet rx) AssignCon v') kr) kl
- f (Return _ rx (Just (Var _ v'))) k@(AssignMap (Just kr) kl) = AssignMap (combineMaps (M.singleton (InRet rx) AssignVar v') kr) kl
- f (Branch _ lbl) kl = AssignMap (Just M.empty) (Just M.empty)
+ f (Store v (Lit p v')) k@(AssignMap (Just kr) kl lbl) = AssignMap (combineMaps (M.singleton (InVar v) AssignCon p v') kr) kl lbl
+ f (Store v (Var p v')) k@(AssignMap (Just kr) kl lbl) = AssignMap (combineMaps (M.singleton (InVar v) AssignVar p v') kr) kl lbl
+ f (Return _ rx (Just (Lit p v'))) k@(AssignMap (Just kr) kl lbl) = AssignMap (combineMaps (M.singleton (InRet rx) AssignCon p v') kr) kl lbl
+ f (Return _ rx (Just (Var p v'))) k@(AssignMap (Just kr) kl lbl) = AssignMap (combineMaps (M.singleton (InRet rx) AssignVar p v') kr) kl lbl
+ f (Branch _ lbl) kl = AssignMap (Just M.empty) (Just M.empty) lbl
f _ k = AssignMap Nothing Nothing
combineMaps :: (M.Map Assigned Assignable) -> (M.Map Assigned Assignable) -> Maybe (M.Map Assigned Assignable)
@@ -51,10 +53,15 @@ condElim :: forall m . FuelMonad m => BwdRewrite m MidIRInst AssignMap
condElim = deepBwdRw ll
where
ll :: MidIRInst e x -> Fact x AssignMap -> m (Maybe (Graph MidIRInst e x))
- ll (CondBranch p ce tl fl) f@(AssignMap a b)
- | M.size (M.intersection a b) == 1 && M.size a == 1 && M.size b == 1 =
- case first (M.keys $ M.intersection a b) of
- InRet r -> return $ mkLast $ Return p r (Just (Cond p ce (first $ M.elems a) (first $ M.elems b)))
- InVar v -> return $ mkLast $ Store p v (Cond p ce (first $ M.elems a) (first $ M.elems b))
- | otherwise = return Nothing
+-- ll (CondBranch p ce tl fl) f@(AssignMap (Just a) (Just b) lbl')
+-- | M.size (M.intersection a b) == 1 && M.size a == 1 && M.size b == 1 =
+-- case head (M.keys $ M.intersection a b) of
+-- InRet r -> return Just $ mkLast $ Return p r (Just (Cond p ce (assignment (head $ M.elems a)) (assignment (head $ M.elems b))))
+-- InVar v -> case lbl' of
+-- Just lbl -> return Just $ (mkMiddle $ Store p v (Cond p ce (assignment (head $ M.elems a)) (assignment (head $ M.elems b)))) <*> (mkLast $ Branch p lbl)
+-- _ -> return Nothing
+-- | otherwise = return Nothing
ll _ f = return Nothing
+ assignment :: Assignable -> Expr VarName
+ assignment (AssignVar p x) = Var p x
+ assignment (AssignCon p x) = Lit p x
@@ -41,11 +41,8 @@ type Live = (S.Set Reg, S.Set SpillLoc)
liveLattice :: DataflowLattice Live
liveLattice = DataflowLattice { fact_name = "Live registers"
, fact_bot = (S.empty, S.empty)
- , fact_join = joinProd add add
+ , fact_join = joinProd joinSets joinSets
}
- where add _ (OldFact old) (NewFact new) = (ch, j)
- where j = new `S.union` old
- ch = changeIf (S.size j > S.size old)
liveness :: BwdTransfer Asm Live
liveness = mkBTransfer3 livee livem livex

0 comments on commit dd55b15

Please sign in to comment.