diff options
| -rw-r--r-- | CodeGen.hs | 6 | ||||
| -rw-r--r-- | LifetimeAnalysis.hs | 17 | ||||
| -rw-r--r-- | LifetimeAnalysis2.hs | 104 | ||||
| -rw-r--r-- | LifetimeAnalysisOld.hs | 60 | ||||
| -rw-r--r-- | README.md | 1 |
5 files changed, 178 insertions, 10 deletions
@@ -16,6 +16,7 @@ import AST import Defs import Intermediate import qualified LifetimeAnalysis as LA +import qualified LifetimeAnalysisOld as LAO import RegAlloc import ReplaceRefs import Utils @@ -106,7 +107,10 @@ codegenFunc (IRFunc _ name al bbs sid) = do alltemprefs = uniq $ sort $ map LA.unAccess $ concat $ concat $ map fst temprefsperbb lifespans = map (\r -> (findLifeSpan r, r)) alltemprefs where findLifeSpan ref = - fromJust $ findFirstLast id $ concat $ LA.lifetimeAnalysis ref temprefsperbb + let la = LA.lifetimeAnalysis ref temprefsperbb + lao = LAO.lifetimeAnalysis ref temprefsperbb + in (if la == lao then id else traceShow (ref,bbs,la,lao)) $ + fromJust $ findFirstLast id $ concat $ LA.lifetimeAnalysis ref temprefsperbb aliascandidates = findAliasCandidates bbs :: [(Ref, Ref)] diff --git a/LifetimeAnalysis.hs b/LifetimeAnalysis.hs index aaf0c30..a421383 100644 --- a/LifetimeAnalysis.hs +++ b/LifetimeAnalysis.hs @@ -1,6 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-} -module LifetimeAnalysis(fullLifetimeAnalysis, lifetimeAnalysis, Access(..), unAccess) where +module LifetimeAnalysis(fullLifetimeAnalysis, lifetimeAnalysis, Access(..), unAccess, BB) where import Data.List import Data.Maybe @@ -36,20 +36,19 @@ markLive :: forall a. (Eq a, Ord a) => (BB a, DUIO a) -> [[a]] markLive ((inaccs, _), duio) = init $ go fullaccs 0 (ins duio) where fullaccs = inaccs ++ [map Read (outs duio)] - allvars = nub $ concatMap (map unAccess) fullaccs - lastreads = Map.fromList $ map (\v -> (v, lastReadOf v)) allvars - lastReadOf v = fromMaybe (-1) $ fmap ((length fullaccs - 1) -) $ - findIndex (Read v `elem`) (reverse fullaccs) + hasReadBeforeWrite _ [] = False + hasReadBeforeWrite t (acl : rest) + | Read t `elem` acl = True + | Write t `elem` acl = False + | otherwise = hasReadBeforeWrite t rest go :: (Eq a, Ord a) => [[Access a]] -> Int -> [a] -> [[a]] go [] _ _ = [] go (acl : rest) i lives = let (ws, rs) = partitionAccess acl - newlives = union rs $ flip filter (union ws lives) $ \v -> case Map.lookup v lastreads of - Nothing -> False - Just j -> j > i - in lives : go rest (i+1) newlives + newlives = union rs $ flip filter (union ws lives) $ \v -> hasReadBeforeWrite v rest + in newlives : go rest (i+1) newlives analysisIterator :: (Eq a, Ord a) => [(DUIO a, [Int])] -> [(DUIO a, [Int])] analysisIterator toplist = map updateIns $ map updateOuts (zip toplist [0..]) diff --git a/LifetimeAnalysis2.hs b/LifetimeAnalysis2.hs new file mode 100644 index 0000000..a7bc4c5 --- /dev/null +++ b/LifetimeAnalysis2.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE RankNTypes #-} + +module LifetimeAnalysis(lifetimeAnalysis, Access(..), unAccess) where + +import Control.Monad +import Control.Monad.Primitive +import Control.Monad.ST +import Data.Maybe +import Data.Vector ((!)) +import qualified Data.Vector as V +import qualified Data.Vector.Mutable as MV + +import Utils + + +data Access a = Write a | Read a + deriving (Show, Eq) + +unAccess :: Access a -> a +unAccess (Write x) = x +unAccess (Read x) = x + +type BB a = ([[Access a]], [Int]) + +type Mark = V.Vector (V.Vector Bool) +type MutMark s = MV.MVector s (MV.MVector s Bool) + +lifetimeAnalysis :: Eq a => a -> [BB a] -> [[Bool]] +lifetimeAnalysis target bbs = V.toList $ V.map V.toList $ + foldOr2 $ map (\p -> markAliveFrom bbs target p (emptyMark bbs)) occurrences + where + occurrences :: [(Int, Int)] + occurrences = do + (i, bb) <- zip [0..] bbs + (j, ins) <- zip [0..] (fst bb) + if ins `contains` Write target || ins `contains` Read target + then [(i, j)] + else [] + +emptyMark :: [BB a] -> Mark +emptyMark bbs = V.fromList $ flip map bbs $ \(inss, _) -> V.replicate (length inss) False + +-- Assumes `target` is known to be alive at `pos`. +markAliveFrom :: Eq a => [BB a] -> a -> (Int, Int) -> Mark -> Mark +markAliveFrom bbs target pos topmark = runST $ do + maybem <- goNoCheck pos topmark + m <- case maybem of + Nothing -> thaw2 topmark + Just m' -> return m' + setAt2 m pos True + freeze2 m + where + goNoCheck :: (Int, Int) -> MutMark s -> ST s (Maybe (MutMark s)) + goNoCheck (i, j) mark = do + let suc = flip filter (successors bbs (i, j)) $ \(i', j') -> + not $ mark ! i' ! j' + setAt2 mark (i, j) True + res <- mapM (\s -> go s mark) suc + case catMaybes res of + [] -> return Nothing + mutmarks -> Just <$> mvFoldOr2 mutmarks + + go :: (Int, Int) -> MutMark s -> ST s (Maybe (MutMark s)) + go (i, j) mark + | fst (bbs !! i) !! j `contains` Write target = return Nothing + | fst (bbs !! i) !! j `contains` Read target = Just $ setAt2 mark (i, j) True + | otherwise = goNoCheck (i, j) mark + +successors :: [BB a] -> (Int, Int) -> [(Int, Int)] +successors bbs (i, j) = + let (inss, nexts) = bbs !! i + in if j < length inss - 1 + then [(i, j + 1)] + else [(n, 0) | n <- nexts] + +setAt2 :: MutMark s -> (Int, Int) -> Bool -> ST s () +setAt2 l (i, j) v = do + row <- MV.read l i + MV.write row j v + +foldOr2 :: [Mark] -> Mark +foldOr2 marks = + let (dim1, dim2) = (V.length (head marks), V.length (head marks ! 0)) + in V.generate dim1 $ \i -> V.generate dim2 $ \j -> + foldl1 (||) $ map (\m -> m ! i ! j) marks + +mvFoldOr2 :: [MutMark s] -> ST s (MutMark s) +mvFoldOr2 marks = do + let dim1 = MV.length (head marks) + dim2 <- liftM MV.length $ MV.read (head marks) 0 + mvGenerate dim1 $ \i -> mvGenerate dim2 $ \j -> + foldl1 (||) <$> mapM (\m -> MV.read m i >>= \row -> MV.read row j) marks + +thaw2 :: Mark -> ST s (MutMark s) +thaw2 = join . fmap V.thaw . V.mapM V.thaw + +freeze2 :: MutMark s -> ST s Mark +freeze2 = join . fmap (V.mapM V.freeze) . V.freeze + +mvGenerate :: Int -> (Int -> ST s a) -> ST s (MV.MVector s a) +mvGenerate sz f = do + v <- MV.new sz + mapM_ (\i -> f i >>= \value -> MV.write v i value) [0..sz-1] + return v diff --git a/LifetimeAnalysisOld.hs b/LifetimeAnalysisOld.hs new file mode 100644 index 0000000..f7635ad --- /dev/null +++ b/LifetimeAnalysisOld.hs @@ -0,0 +1,60 @@ +module LifetimeAnalysisOld(lifetimeAnalysis) where + +import Data.Maybe + +import LifetimeAnalysis (Access(..), unAccess, BB) +import Utils + + +lifetimeAnalysis :: Eq a => a -> [BB a] -> [[Bool]] +lifetimeAnalysis target bbs = + foldOr2 $ map (\p -> markAliveFrom bbs target p (emptyMark bbs)) occurrences + where + occurrences :: [(Int, Int)] + occurrences = do + (i, bb) <- zip [0..] bbs + (j, ins) <- zip [0..] (fst bb) + if ins `contains` Write target || ins `contains` Read target + then [(i, j)] + else [] + +emptyMark :: [BB a] -> [[Bool]] +emptyMark bbs = flip map bbs $ \(inss, _) -> map (const False) inss + +-- Assumes `target` is known to be alive at `pos`. +markAliveFrom :: Eq a => [BB a] -> a -> (Int, Int) -> [[Bool]] -> [[Bool]] +markAliveFrom bbs target pos topmark = setAt2 (maybe topmark id $ goNoCheck pos topmark) pos True + where + goNoCheck :: (Int, Int) -> [[Bool]] -> Maybe [[Bool]] + goNoCheck (i, j) mark = + let suc = flip filter (successors bbs (i, j)) $ \(i', j') -> + not $ mark !! i' !! j' + markset = setAt2 mark (i, j) True + in case catMaybes [go s markset | s <- suc] of + [] -> Nothing + l -> Just $ foldOr2 l + + go :: (Int, Int) -> [[Bool]] -> Maybe [[Bool]] + go (i, j) mark + | fst (bbs !! i) !! j `contains` Write target = Nothing + | fst (bbs !! i) !! j `contains` Read target = Just $ setAt2 mark (i, j) True + | otherwise = goNoCheck (i, j) mark + +successors :: [BB a] -> (Int, Int) -> [(Int, Int)] +successors bbs (i, j) = + let (inss, nexts) = bbs !! i + in if j < length inss - 1 + then [(i, j + 1)] + else [(n, 0) | n <- nexts] + +modifyAt2 :: [[a]] -> (Int, Int) -> (a -> a) -> [[a]] +modifyAt2 l (i, j) f = modifyAt l i $ \li -> modifyAt li j f + +modifyAt :: [a] -> Int -> (a -> a) -> [a] +modifyAt l i f = let (pre, v : post) = splitAt i l in pre ++ f v : post + +setAt2 :: [[a]] -> (Int, Int) -> a -> [[a]] +setAt2 l p v = modifyAt2 l p (const v) + +foldOr2 :: [[[Bool]]] -> [[Bool]] +foldOr2 = foldl1 (\m1 m2 -> map (map (uncurry (||)) . uncurry zip) (zip m1 m2)) diff --git a/README.md b/README.md new file mode 100644 index 0000000..2fdac90 --- /dev/null +++ b/README.md @@ -0,0 +1 @@ +Please note that this project is not done. There is unfinished code, the lifetime analysis module is not working completely correctly at the time of writing, and in general there are features not implemented. This git repo is not meant to show off a finished product! |