module GHC.Cmm.Expr
( CmmExpr(..), cmmExprType, cmmExprWidth, cmmExprAlignment, maybeInvertCmmExpr
, CmmReg(..), cmmRegType, cmmRegWidth
, CmmLit(..), cmmLitType
, LocalReg(..), localRegType
, GlobalReg(..), isArgReg, globalRegType
, spReg, hpReg, spLimReg, hpLimReg, nodeReg
, currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg
, node, baseReg
, VGcPtr(..)
, DefinerOfRegs, UserOfRegs
, foldRegsDefd, foldRegsUsed
, foldLocalRegsDefd, foldLocalRegsUsed
, RegSet, LocalRegSet, GlobalRegSet
, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
, plusRegSet, minusRegSet, timesRegSet, sizeRegSet, nullRegSet
, regSetToList
, Area(..)
, module GHC.Cmm.MachOp
, module GHC.Cmm.Type
)
where
import GHC.Prelude
import GHC.Platform
import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
import GHC.Cmm.MachOp
import GHC.Cmm.Type
import GHC.Driver.Session
import GHC.Utils.Outputable (panic)
import GHC.Types.Unique
import Data.Set (Set)
import qualified Data.Set as Set
import GHC.Types.Basic (Alignment, mkAlignment, alignmentOf)
data CmmExpr
= CmmLit CmmLit
| CmmLoad !CmmExpr !CmmType
| CmmReg !CmmReg
| CmmMachOp MachOp [CmmExpr]
| CmmStackSlot Area !Int
| CmmRegOff !CmmReg Int
instance Eq CmmExpr where
CmmLit l1 == CmmLit l2 = l1==l2
CmmLoad e1 _ == CmmLoad e2 _ = e1==e2
CmmReg r1 == CmmReg r2 = r1==r2
CmmRegOff r1 i1 == CmmRegOff r2 i2 = r1==r2 && i1==i2
CmmMachOp op1 es1 == CmmMachOp op2 es2 = op1==op2 && es1==es2
CmmStackSlot a1 i1 == CmmStackSlot a2 i2 = a1==a2 && i1==i2
_e1 == _e2 = False
data CmmReg
= CmmLocal !LocalReg
| CmmGlobal GlobalReg
deriving( Eq, Ord )
data Area
= Old
| Young !BlockId
deriving (Eq, Ord)
data CmmLit
= CmmInt !Integer Width
| CmmFloat Rational Width
| CmmVec [CmmLit]
| CmmLabel CLabel
| CmmLabelOff CLabel Int
| CmmLabelDiffOff CLabel CLabel Int Width
| CmmBlock !BlockId
| CmmHighStackMark
deriving Eq
cmmExprType :: Platform -> CmmExpr -> CmmType
cmmExprType platform = \case
(CmmLit lit) -> cmmLitType platform lit
(CmmLoad _ rep) -> rep
(CmmReg reg) -> cmmRegType platform reg
(CmmMachOp op args) -> machOpResultType platform op (map (cmmExprType platform) args)
(CmmRegOff reg _) -> cmmRegType platform reg
(CmmStackSlot _ _) -> bWord platform
cmmLitType :: Platform -> CmmLit -> CmmType
cmmLitType platform = \case
(CmmInt _ width) -> cmmBits width
(CmmFloat _ width) -> cmmFloat width
(CmmVec []) -> panic "cmmLitType: CmmVec []"
(CmmVec (l:ls)) -> let ty = cmmLitType platform l
in if all (`cmmEqType` ty) (map (cmmLitType platform) ls)
then cmmVec (1+length ls) ty
else panic "cmmLitType: CmmVec"
(CmmLabel lbl) -> cmmLabelType platform lbl
(CmmLabelOff lbl _) -> cmmLabelType platform lbl
(CmmLabelDiffOff _ _ _ width) -> cmmBits width
(CmmBlock _) -> bWord platform
(CmmHighStackMark) -> bWord platform
cmmLabelType :: Platform -> CLabel -> CmmType
cmmLabelType platform lbl
| isGcPtrLabel lbl = gcWord platform
| otherwise = bWord platform
cmmExprWidth :: Platform -> CmmExpr -> Width
cmmExprWidth platform e = typeWidth (cmmExprType platform e)
cmmExprAlignment :: CmmExpr -> Alignment
cmmExprAlignment (CmmLit (CmmInt intOff _)) = alignmentOf (fromInteger intOff)
cmmExprAlignment _ = mkAlignment 1
maybeInvertCmmExpr :: CmmExpr -> Maybe CmmExpr
maybeInvertCmmExpr (CmmMachOp op args) = do op' <- maybeInvertComparison op
return (CmmMachOp op' args)
maybeInvertCmmExpr _ = Nothing
data LocalReg
= LocalReg !Unique CmmType
instance Eq LocalReg where
(LocalReg u1 _) == (LocalReg u2 _) = u1 == u2
instance Ord LocalReg where
compare (LocalReg u1 _) (LocalReg u2 _) = nonDetCmpUnique u1 u2
instance Uniquable LocalReg where
getUnique (LocalReg uniq _) = uniq
cmmRegType :: Platform -> CmmReg -> CmmType
cmmRegType _ (CmmLocal reg) = localRegType reg
cmmRegType platform (CmmGlobal reg) = globalRegType platform reg
cmmRegWidth :: Platform -> CmmReg -> Width
cmmRegWidth platform = typeWidth . cmmRegType platform
localRegType :: LocalReg -> CmmType
localRegType (LocalReg _ rep) = rep
type RegSet r = Set r
type LocalRegSet = RegSet LocalReg
type GlobalRegSet = RegSet GlobalReg
emptyRegSet :: RegSet r
nullRegSet :: RegSet r -> Bool
elemRegSet :: Ord r => r -> RegSet r -> Bool
extendRegSet :: Ord r => RegSet r -> r -> RegSet r
deleteFromRegSet :: Ord r => RegSet r -> r -> RegSet r
mkRegSet :: Ord r => [r] -> RegSet r
minusRegSet, plusRegSet, timesRegSet :: Ord r => RegSet r -> RegSet r -> RegSet r
sizeRegSet :: RegSet r -> Int
regSetToList :: RegSet r -> [r]
emptyRegSet = Set.empty
nullRegSet = Set.null
elemRegSet = Set.member
extendRegSet = flip Set.insert
deleteFromRegSet = flip Set.delete
mkRegSet = Set.fromList
minusRegSet = Set.difference
plusRegSet = Set.union
timesRegSet = Set.intersection
sizeRegSet = Set.size
regSetToList = Set.toList
class Ord r => UserOfRegs r a where
foldRegsUsed :: DynFlags -> (b -> r -> b) -> b -> a -> b
foldLocalRegsUsed :: UserOfRegs LocalReg a
=> DynFlags -> (b -> LocalReg -> b) -> b -> a -> b
foldLocalRegsUsed = foldRegsUsed
class Ord r => DefinerOfRegs r a where
foldRegsDefd :: DynFlags -> (b -> r -> b) -> b -> a -> b
foldLocalRegsDefd :: DefinerOfRegs LocalReg a
=> DynFlags -> (b -> LocalReg -> b) -> b -> a -> b
foldLocalRegsDefd = foldRegsDefd
instance UserOfRegs LocalReg CmmReg where
foldRegsUsed _ f z (CmmLocal reg) = f z reg
foldRegsUsed _ _ z (CmmGlobal _) = z
instance DefinerOfRegs LocalReg CmmReg where
foldRegsDefd _ f z (CmmLocal reg) = f z reg
foldRegsDefd _ _ z (CmmGlobal _) = z
instance UserOfRegs GlobalReg CmmReg where
foldRegsUsed _ _ z (CmmLocal _) = z
foldRegsUsed _ f z (CmmGlobal reg) = f z reg
instance DefinerOfRegs GlobalReg CmmReg where
foldRegsDefd _ _ z (CmmLocal _) = z
foldRegsDefd _ f z (CmmGlobal reg) = f z reg
instance Ord r => UserOfRegs r r where
foldRegsUsed _ f z r = f z r
instance Ord r => DefinerOfRegs r r where
foldRegsDefd _ f z r = f z r
instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where
foldRegsUsed dflags f !z e = expr z e
where expr z (CmmLit _) = z
expr z (CmmLoad addr _) = foldRegsUsed dflags f z addr
expr z (CmmReg r) = foldRegsUsed dflags f z r
expr z (CmmMachOp _ exprs) = foldRegsUsed dflags f z exprs
expr z (CmmRegOff r _) = foldRegsUsed dflags f z r
expr z (CmmStackSlot _ _) = z
instance UserOfRegs r a => UserOfRegs r [a] where
foldRegsUsed dflags f set as = foldl' (foldRegsUsed dflags f) set as
instance DefinerOfRegs r a => DefinerOfRegs r [a] where
foldRegsDefd dflags f set as = foldl' (foldRegsDefd dflags f) set as
data VGcPtr = VGcPtr | VNonGcPtr deriving( Eq, Show )
data GlobalReg
= VanillaReg
!Int
VGcPtr
| FloatReg
!Int
| DoubleReg
!Int
| LongReg
!Int
| XmmReg
!Int
| YmmReg
!Int
| ZmmReg
!Int
| Sp
| SpLim
| Hp
| HpLim
| CCCS
| CurrentTSO
| CurrentNursery
| HpAlloc
| EagerBlackholeInfo
| GCEnter1
| GCFun
| BaseReg
| MachSp
| UnwindReturnReg
| PicBaseReg
deriving( Show )
instance Eq GlobalReg where
VanillaReg i _ == VanillaReg j _ = i==j
FloatReg i == FloatReg j = i==j
DoubleReg i == DoubleReg j = i==j
LongReg i == LongReg j = i==j
XmmReg i == XmmReg j = i==j
YmmReg i == YmmReg j = i==j
ZmmReg i == ZmmReg j = i==j
Sp == Sp = True
SpLim == SpLim = True
Hp == Hp = True
HpLim == HpLim = True
CCCS == CCCS = True
CurrentTSO == CurrentTSO = True
CurrentNursery == CurrentNursery = True
HpAlloc == HpAlloc = True
EagerBlackholeInfo == EagerBlackholeInfo = True
GCEnter1 == GCEnter1 = True
GCFun == GCFun = True
BaseReg == BaseReg = True
MachSp == MachSp = True
UnwindReturnReg == UnwindReturnReg = True
PicBaseReg == PicBaseReg = True
_r1 == _r2 = False
instance Ord GlobalReg where
compare (VanillaReg i _) (VanillaReg j _) = compare i j
compare (FloatReg i) (FloatReg j) = compare i j
compare (DoubleReg i) (DoubleReg j) = compare i j
compare (LongReg i) (LongReg j) = compare i j
compare (XmmReg i) (XmmReg j) = compare i j
compare (YmmReg i) (YmmReg j) = compare i j
compare (ZmmReg i) (ZmmReg j) = compare i j
compare Sp Sp = EQ
compare SpLim SpLim = EQ
compare Hp Hp = EQ
compare HpLim HpLim = EQ
compare CCCS CCCS = EQ
compare CurrentTSO CurrentTSO = EQ
compare CurrentNursery CurrentNursery = EQ
compare HpAlloc HpAlloc = EQ
compare EagerBlackholeInfo EagerBlackholeInfo = EQ
compare GCEnter1 GCEnter1 = EQ
compare GCFun GCFun = EQ
compare BaseReg BaseReg = EQ
compare MachSp MachSp = EQ
compare UnwindReturnReg UnwindReturnReg = EQ
compare PicBaseReg PicBaseReg = EQ
compare (VanillaReg _ _) _ = LT
compare _ (VanillaReg _ _) = GT
compare (FloatReg _) _ = LT
compare _ (FloatReg _) = GT
compare (DoubleReg _) _ = LT
compare _ (DoubleReg _) = GT
compare (LongReg _) _ = LT
compare _ (LongReg _) = GT
compare (XmmReg _) _ = LT
compare _ (XmmReg _) = GT
compare (YmmReg _) _ = LT
compare _ (YmmReg _) = GT
compare (ZmmReg _) _ = LT
compare _ (ZmmReg _) = GT
compare Sp _ = LT
compare _ Sp = GT
compare SpLim _ = LT
compare _ SpLim = GT
compare Hp _ = LT
compare _ Hp = GT
compare HpLim _ = LT
compare _ HpLim = GT
compare CCCS _ = LT
compare _ CCCS = GT
compare CurrentTSO _ = LT
compare _ CurrentTSO = GT
compare CurrentNursery _ = LT
compare _ CurrentNursery = GT
compare HpAlloc _ = LT
compare _ HpAlloc = GT
compare GCEnter1 _ = LT
compare _ GCEnter1 = GT
compare GCFun _ = LT
compare _ GCFun = GT
compare BaseReg _ = LT
compare _ BaseReg = GT
compare MachSp _ = LT
compare _ MachSp = GT
compare UnwindReturnReg _ = LT
compare _ UnwindReturnReg = GT
compare EagerBlackholeInfo _ = LT
compare _ EagerBlackholeInfo = GT
baseReg, spReg, hpReg, spLimReg, hpLimReg, nodeReg,
currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg :: CmmReg
baseReg = CmmGlobal BaseReg
spReg = CmmGlobal Sp
hpReg = CmmGlobal Hp
hpLimReg = CmmGlobal HpLim
spLimReg = CmmGlobal SpLim
nodeReg = CmmGlobal node
currentTSOReg = CmmGlobal CurrentTSO
currentNurseryReg = CmmGlobal CurrentNursery
hpAllocReg = CmmGlobal HpAlloc
cccsReg = CmmGlobal CCCS
node :: GlobalReg
node = VanillaReg 1 VGcPtr
globalRegType :: Platform -> GlobalReg -> CmmType
globalRegType platform = \case
(VanillaReg _ VGcPtr) -> gcWord platform
(VanillaReg _ VNonGcPtr) -> bWord platform
(FloatReg _) -> cmmFloat W32
(DoubleReg _) -> cmmFloat W64
(LongReg _) -> cmmBits W64
(XmmReg _) -> cmmVec 4 (cmmBits W32)
(YmmReg _) -> cmmVec 8 (cmmBits W32)
(ZmmReg _) -> cmmVec 16 (cmmBits W32)
Hp -> gcWord platform
_ -> bWord platform
isArgReg :: GlobalReg -> Bool
isArgReg (VanillaReg {}) = True
isArgReg (FloatReg {}) = True
isArgReg (DoubleReg {}) = True
isArgReg (LongReg {}) = True
isArgReg (XmmReg {}) = True
isArgReg (YmmReg {}) = True
isArgReg (ZmmReg {}) = True
isArgReg _ = False