-{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
module CmmExpr
( CmmExpr(..), cmmExprRep, maybeInvertCmmExpr
, CmmLit(..), cmmLitRep
, LocalReg(..), localRegRep, localRegGCFollow, GCKind(..)
, GlobalReg(..), globalRegRep, spReg, hpReg, spLimReg, nodeReg, node
- , UserOfLocalRegs, foldRegsUsed
+ , DefinerOfLocalRegs, UserOfLocalRegs, foldRegsDefd, foldRegsUsed, filterRegsUsed
, RegSet, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
- , plusRegSet, minusRegSet
- )
-where
+ , plusRegSet, minusRegSet, timesRegSet
+ , Area(..), StackSlotMap, getSlot, mkCallArea, outgoingSlot, areaId, areaSize
+ ) where
+import BlockId
import CLabel
+import FiniteMap
import MachOp
+import Maybes
+import Monad
+import Panic
import Unique
import UniqSet
-- ** is shorthand only, meaning **
-- CmmMachOp (MO_S_Add rep (CmmReg reg) (CmmLit (CmmInt i rep)))
-- where rep = cmmRegRep reg
+ | CmmStackSlot Area Int
deriving Eq
data CmmReg
= CmmLocal LocalReg
| CmmGlobal GlobalReg
- deriving( Eq )
+ deriving( Eq, Ord )
+
+-- | A stack area is either the stack slot where a variable is spilled
+-- or the stack space where function arguments and results are passed.
+data Area
+ = RegSlot LocalReg
+ | CallArea BlockId Int Int
+ deriving (Eq, Ord)
data CmmLit
= CmmInt Integer MachRep
instance Eq LocalReg where
(LocalReg u1 _ _) == (LocalReg u2 _ _) = u1 == u2
+instance Ord LocalReg where
+ compare (LocalReg u1 _ _) (LocalReg u2 _ _) = compare u1 u2
+
instance Uniquable LocalReg where
getUnique (LocalReg uniq _ _) = uniq
data GCKind = GCKindPtr | GCKindNonPtr deriving (Eq)
data LocalReg
- = LocalReg
- !Unique -- ^ Identifier
- MachRep -- ^ Type
- GCKind -- ^ Should the GC follow as a pointer
-
--- | Sets of local registers
+ = LocalReg !Unique MachRep GCKind
+ -- ^ Parameters:
+ -- 1. Identifier
+ -- 2. Type
+ -- 3. Should the GC follow as a pointer
+-- Sets of local registers
type RegSet = UniqSet LocalReg
emptyRegSet :: RegSet
elemRegSet :: LocalReg -> RegSet -> Bool
extendRegSet :: RegSet -> LocalReg -> RegSet
deleteFromRegSet :: RegSet -> LocalReg -> RegSet
mkRegSet :: [LocalReg] -> RegSet
-minusRegSet, plusRegSet :: RegSet -> RegSet -> RegSet
+minusRegSet, plusRegSet, timesRegSet :: RegSet -> RegSet -> RegSet
emptyRegSet = emptyUniqSet
elemRegSet = elementOfUniqSet
mkRegSet = mkUniqSet
minusRegSet = minusUniqSet
plusRegSet = unionUniqSets
+timesRegSet = intersectUniqSets
+
+-----------------------------------------------------------------------------
+-- Stack slots
+-----------------------------------------------------------------------------
+
+mkVarSlot :: LocalReg -> CmmExpr
+mkVarSlot r = CmmStackSlot (RegSlot r) 0
+
+-- Usually, we either want to lookup a variable's spill slot in an environment
+-- or else allocate it and add it to the environment.
+-- For a variable, we just need a single area of the appropriate size.
+type StackSlotMap = FiniteMap LocalReg CmmExpr
+getSlot :: StackSlotMap -> LocalReg -> (StackSlotMap, CmmExpr)
+getSlot map r = case lookupFM map r of
+ Just s -> (map, s)
+ Nothing -> (addToFM map r s, s) where s = mkVarSlot r
+
+-- Eventually, we'll want something proper that takes arguments and formals
+-- and gives you back the calling convention code, as well as the stack area.
+mkCallArea :: BlockId -> [a] -> Maybe [b] -> Area
+mkCallArea id as fs = CallArea id (length as) (liftM length fs `orElse` 0)
+
+-- Return the last slot in the outgoing parameter area.
+outgoingSlot :: Area -> CmmExpr
+outgoingSlot a@(RegSlot _) = CmmStackSlot a 0
+outgoingSlot a@(CallArea _ outN _) = CmmStackSlot a outN
+
+areaId :: Area -> BlockId
+areaId (RegSlot _) = panic "Register stack slots don't have IDs!"
+areaId (CallArea id _ _) = id
+
+areaSize :: Area -> Int
+areaSize (RegSlot _) = 1
+areaSize (CallArea _ outN inN) = max outN inN
+
-----------------------------------------------------------------------------
-- Register-use information for expressions and other types
class UserOfLocalRegs a where
foldRegsUsed :: (b -> LocalReg -> b) -> b -> a -> b
+class DefinerOfLocalRegs a where
+ foldRegsDefd :: (b -> LocalReg -> b) -> b -> a -> b
+
+filterRegsUsed :: UserOfLocalRegs e => (LocalReg -> Bool) -> e -> RegSet
+filterRegsUsed p e =
+ foldRegsUsed (\regs r -> if p r then extendRegSet regs r else regs)
+ emptyRegSet e
+
instance UserOfLocalRegs CmmReg where
foldRegsUsed f z (CmmLocal reg) = f z reg
foldRegsUsed _ z (CmmGlobal _) = z
+instance DefinerOfLocalRegs CmmReg where
+ foldRegsDefd f z (CmmLocal reg) = f z reg
+ foldRegsDefd _ z (CmmGlobal _) = z
+
instance UserOfLocalRegs LocalReg where
foldRegsUsed f z r = f z r
+instance DefinerOfLocalRegs LocalReg where
+ foldRegsDefd f z r = f z r
+
+instance UserOfLocalRegs RegSet where
+ foldRegsUsed f = foldUniqSet (flip f)
+
instance UserOfLocalRegs CmmExpr where
foldRegsUsed f z e = expr z e
where expr z (CmmLit _) = z
expr z (CmmReg r) = foldRegsUsed f z r
expr z (CmmMachOp _ exprs) = foldRegsUsed f z exprs
expr z (CmmRegOff r _) = foldRegsUsed f z r
+ expr z (CmmStackSlot _ _) = z
instance UserOfLocalRegs a => UserOfLocalRegs [a] where
foldRegsUsed _ set [] = set
foldRegsUsed f set (x:xs) = foldRegsUsed f (foldRegsUsed f set x) xs
+instance DefinerOfLocalRegs a => DefinerOfLocalRegs [a] where
+ foldRegsDefd _ set [] = set
+ foldRegsDefd f set (x:xs) = foldRegsDefd f (foldRegsDefd f set x) xs
+
-----------------------------------------------------------------------------
-- MachRep
-----------------------------------------------------------------------------
cmmExprRep (CmmReg reg) = cmmRegRep reg
cmmExprRep (CmmMachOp op _) = resultRepOfMachOp op
cmmExprRep (CmmRegOff reg _) = cmmRegRep reg
+cmmExprRep (CmmStackSlot _ _) = wordRep
cmmRegRep :: CmmReg -> MachRep
-cmmRegRep (CmmLocal reg) = localRegRep reg
+cmmRegRep (CmmLocal reg) = localRegRep reg
cmmRegRep (CmmGlobal reg) = globalRegRep reg
localRegRep :: LocalReg -> MachRep
-- from platform to platform (see module PositionIndependentCode).
| PicBaseReg
- deriving( Eq , Show )
+ deriving( Eq, Ord, Show )
-- convenient aliases
spReg, hpReg, spLimReg, nodeReg :: CmmReg
projects / ghc-hetmet.git / blobdiff