From b2d9c2b8e971a63de1a5be36e01068f3bc03f054 Mon Sep 17 00:00:00 2001 From: tomsmeding Date: Sat, 11 May 2019 22:49:50 +0200 Subject: Liveness analysis --- DataFlow.hs | 54 +++++++++++++++++++++++++++++-------- Lattice.hs | 9 +++++++ LivenessAnalysis.hs | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++++ Lower.hs | 4 +-- lisphs.cabal | 2 ++ 5 files changed, 133 insertions(+), 13 deletions(-) create mode 100644 Lattice.hs create mode 100644 LivenessAnalysis.hs diff --git a/DataFlow.hs b/DataFlow.hs index 78ec018..98cf65d 100644 --- a/DataFlow.hs +++ b/DataFlow.hs @@ -1,30 +1,53 @@ -module DataFlow(dataFlowAnalysis, Direction(..)) where +{-# LANGUAGE ScopedTypeVariables, TupleSections #-} +module DataFlow(dataFlowAnalysis, Direction(..), module Lattice) where import Data.Function import Data.List import qualified Data.Map.Strict as Map +import qualified Data.Set as Set +import Lattice data Direction = Forwards | Backwards deriving (Show, Eq) dataFlowAnalysis - :: Ord id + :: forall id state. (Ord id, Lattice state) -- | The direction of the dataflow analysis - => Direction + => Direction -- | The control flow graph of basic blocks - -> Map.Map id [id] - -- | The initial values - -> (id -> state) + -> Map.Map id [id] + -- | The initial nodes in the analysis (i.e. either the initial + -- node or the final nodes) + -> [id] + -- | The initial value for sources in the analysis + -> state -- | The transfer function; note that the meaning of the states -- depends on the direction - -> (state -> id -> state) - -- | For each block, the incoming state and the outgoing state + -> (state -> id -> state) + -- | For each block that is reachable from 'entryNodes', the + -- incoming state and the outgoing state (in CFG order, not + -- analysis order) -> Map.Map id (state, state) -dataFlowAnalysis Backwards cfg initF transF = +dataFlowAnalysis Backwards cfg entryNodes initValue transF = Map.map (\(a, b) -> (b, a)) $ - dataFlowAnalysis Forwards (reverseGraph cfg) initF transF -dataFlowAnalysis Forwards cfg initF transF = undefined + dataFlowAnalysis Forwards (reverseGraph cfg) entryNodes initValue transF +dataFlowAnalysis Forwards cfg entryNodes initValue transF = + let initWorklist = [(from, to) | (from, tos) <- Map.assocs cfg, to <- tos] + reachable = floodFill entryNodes cfg + initStates = Map.fromList + [(lab, if lab `elem` entryNodes then initValue else bottom) + | lab <- reachable] + in Map.mapWithKey (\k s -> (s, transF s k)) $ flowFixpoint initWorklist initStates + where + flowFixpoint :: [(id, id)] -> Map.Map id state -> Map.Map id state + flowFixpoint [] stateMap = stateMap + flowFixpoint ((from, to) : worklist) stateMap = + let after = transF (stateMap Map.! from) from `join` (stateMap Map.! to) + in if after /= stateMap Map.! to + then flowFixpoint (map (to,) (cfg Map.! to) ++ worklist) + (Map.insert to after stateMap) + else flowFixpoint worklist stateMap reverseGraph :: Ord a => Map.Map a [a] -> Map.Map a [a] @@ -36,3 +59,12 @@ reverseGraph graph = $ [(to, from) | (from, tos) <- Map.assocs graph , to <- tos] + +floodFill :: Ord a => [a] -> Map.Map a [a] -> [a] +floodFill startNodes graph = Set.toList $ go $ Set.fromList startNodes + where + go seen = + let front = Set.fromList (concatMap (graph Map.!) seen) Set.\\ seen + in if Set.size front > 0 + then go (Set.union seen front) + else seen diff --git a/Lattice.hs b/Lattice.hs new file mode 100644 index 0000000..574c123 --- /dev/null +++ b/Lattice.hs @@ -0,0 +1,9 @@ +module Lattice where + + +class Eq a => Lattice a where + join :: a -> a -> a + bottom :: a + + joinList :: [a] -> a + joinList = foldl join bottom diff --git a/LivenessAnalysis.hs b/LivenessAnalysis.hs new file mode 100644 index 0000000..fbb3a19 --- /dev/null +++ b/LivenessAnalysis.hs @@ -0,0 +1,77 @@ +module LivenessAnalysis(livenessAnalysis) where + +import Data.List +import qualified Data.Map.Strict as Map +import DataFlow + + +livenessAnalysis :: (Ord id, Ord var) + -- | The basic blocks, containing a list of statements and + -- a list of possible subsequent blocks + => Map.Map id ([stmt], [id]) + -- | The blocks that can exit the program + -> [id] + -- | The gen set for a statement: the variables required + -- to be live right before the statement + -> (stmt -> [var]) + -- | The kill set for a statement: the variables that are + -- assigned a new value in the statement; note that + -- a variable may be in both the gen and kill sets, in + -- which case the kill entry is ignored + -> (stmt -> [var]) + -- | The list of live variables before and after each + -- statement; if a block contains n statements, then its + -- entry in the returned map contains (n+1) lists of + -- variables. These lists are to be placed in between the + -- n statements. + -> Map.Map id [[var]] +livenessAnalysis cfg exitNodes genF killF = + let cfg' = Map.map snd cfg + stmtTransF lives stmt = (lives \\ nub (killF stmt)) `union` nub (genF stmt) + gkMap = Map.fromList + [(i, (g, k)) + | (i, (stmts, _)) <- Map.assocs cfg + , let (g, k) = foldl' (\(g1, k1) stmt -> + let (g2, k2) = (genF stmt, killF stmt) + in (k1 `union` k2, (g1 \\ k1) `union` g2)) + ([], []) + (reverse stmts)] + genF' = fst . (gkMap Map.!) + killF' = snd . (gkMap Map.!) + blockEnds = liveness cfg' exitNodes genF' killF' + in Map.mapWithKey (\i endLives -> + scanl stmtTransF + endLives + (fst $ cfg Map.! i)) + blockEnds + +data LivenessLattice var = Lives { getLives :: [var] } + +instance Ord var => Eq (LivenessLattice var) where + Lives v1 == Lives v2 = sort v1 == sort v2 + +instance Ord var => Lattice (LivenessLattice var) where + bottom = Lives [] + Lives v1 `join` Lives v2 = Lives (union v1 v2) + +liveness :: (Ord id, Ord var) + -- | The control flow graph of basic blocks + => Map.Map id [id] + -- | The blocks that can exit the program + -> [id] + -- | The gen set for a basic block + -> (id -> [var]) + -- | The kill set for a basic block + -> (id -> [var]) + -- | The list of live variables at the end of the blocks + -> Map.Map id [var] +liveness cfg exitNodes genF killF = + -- Nothing is considered to be live at the end of the program, so + -- exitValue is bottom + let exitValue = bottom + genMap = Map.mapWithKey (\k _ -> nub (genF k)) cfg + killMap = Map.mapWithKey (\k _ -> nub (killF k)) cfg + transF (Lives vars) i = + Lives $ (vars \\ (killMap Map.! i)) `union` (genMap Map.! i) + in Map.map (getLives . snd) $ + dataFlowAnalysis Backwards cfg exitNodes exitValue transF diff --git a/Lower.hs b/Lower.hs index 8fbe0da..44369b3 100644 --- a/Lower.hs +++ b/Lower.hs @@ -1,5 +1,6 @@ {-# LANGUAGE TupleSections, MultiWayIf, GeneralizedNewtypeDeriving #-} -module Lower(lowerIR) where +module Lower(lowerIR, + AsmProgram'(..), AsmInstr'(..), ARef(..), Immediate(..), Label(..), CCond(..)) where import AST (Name) import Control.Monad.State.Strict @@ -152,7 +153,6 @@ genTemp = liftM AReg genId -- - R15 = stack pointer -- - R14 = link register -- - R13 = return register --- - R12 = administration-temporary (TODO can this be eliminated) -- - Further registers: available for allocation -- R13 and R14 can also be used as administration-temporary if they are not -- otherwise occupied. diff --git a/lisphs.cabal b/lisphs.cabal index 66dc3c8..75738c2 100644 --- a/lisphs.cabal +++ b/lisphs.cabal @@ -18,6 +18,8 @@ executable lisp Compiler DataFlow Intermediate + Lattice + LivenessAnalysis Lower Optimiser Parser -- cgit v1.2.3