module CmmExpr
( CmmType
, b8, b16, b32, b64, f32, f64, bWord, bHalfWord, gcWord
, cInt, cLong
, cmmBits, cmmFloat
, typeWidth, cmmEqType, cmmEqType_ignoring_ptrhood
, isFloatType, isGcPtrType, isWord32, isWord64, isFloat64, isFloat32
, Width(..)
, widthInBits, widthInBytes, widthInLog, widthFromBytes
, wordWidth, halfWordWidth, cIntWidth, cLongWidth
, narrowU, narrowS
, CmmExpr(..), cmmExprType, cmmExprWidth, maybeInvertCmmExpr
, CmmReg(..), cmmRegType
, CmmLit(..), cmmLitType
, LocalReg(..), localRegType
, GlobalReg(..), globalRegType, spReg, hpReg, spLimReg, nodeReg, node
, VGcPtr(..), vgcFlag
, DefinerOfLocalRegs, UserOfLocalRegs, foldRegsDefd, foldRegsUsed, filterRegsUsed
, DefinerOfSlots, UserOfSlots, foldSlotsDefd, foldSlotsUsed
, RegSet, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
, plusRegSet, minusRegSet, timesRegSet
, regUsedIn
, Area(..), AreaId(..), SubArea, SubAreaSet, AreaMap, isStackSlotOf
, MachOp(..)
, pprMachOp, isCommutableMachOp, isAssociativeMachOp
, isComparisonMachOp, machOpResultType
, machOpArgReps, maybeInvertComparison
, mo_wordAdd, mo_wordSub, mo_wordEq, mo_wordNe,mo_wordMul, mo_wordSQuot
, mo_wordSRem, mo_wordSNeg, mo_wordUQuot, mo_wordURem
, mo_wordSGe, mo_wordSLe, mo_wordSGt, mo_wordSLt, mo_wordUGe
, mo_wordULe, mo_wordUGt, mo_wordULt
, mo_wordAnd, mo_wordOr, mo_wordXor, mo_wordNot, mo_wordShl, mo_wordSShr, mo_wordUShr
, mo_u_8To32, mo_s_8To32, mo_u_16To32, mo_s_16To32
, mo_u_8ToWord, mo_s_8ToWord, mo_u_16ToWord, mo_s_16ToWord, mo_u_32ToWord, mo_s_32ToWord
, mo_32To8, mo_32To16, mo_WordTo8, mo_WordTo16, mo_WordTo32
)
where
#include "HsVersions.h"
import BlockId
import CLabel
import Constants
import FastString
import Outputable
import Unique
import UniqSet
import Data.Word
import Data.Int
import Data.Map (Map)
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
= RegSlot LocalReg
| CallArea AreaId
deriving (Eq, Ord)
data AreaId
= Old
| Young BlockId
deriving (Eq, Ord)
type SubArea = (Area, Int, Int)
type SubAreaSet = Map Area [SubArea]
type AreaMap = Map Area Int
data CmmLit
= CmmInt Integer Width
| CmmFloat Rational Width
| CmmLabel CLabel
| CmmLabelOff CLabel Int
| CmmLabelDiffOff CLabel CLabel Int
| CmmBlock BlockId
| CmmHighStackMark
deriving Eq
cmmExprType :: CmmExpr -> CmmType
cmmExprType (CmmLit lit) = cmmLitType lit
cmmExprType (CmmLoad _ rep) = rep
cmmExprType (CmmReg reg) = cmmRegType reg
cmmExprType (CmmMachOp op args) = machOpResultType op (map cmmExprType args)
cmmExprType (CmmRegOff reg _) = cmmRegType reg
cmmExprType (CmmStackSlot _ _) = bWord
cmmLitType :: CmmLit -> CmmType
cmmLitType (CmmInt _ width) = cmmBits width
cmmLitType (CmmFloat _ width) = cmmFloat width
cmmLitType (CmmLabel lbl) = cmmLabelType lbl
cmmLitType (CmmLabelOff lbl _) = cmmLabelType lbl
cmmLitType (CmmLabelDiffOff {}) = bWord
cmmLitType (CmmBlock _) = bWord
cmmLitType (CmmHighStackMark) = bWord
cmmLabelType :: CLabel -> CmmType
cmmLabelType lbl | isGcPtrLabel lbl = gcWord
| otherwise = bWord
cmmExprWidth :: CmmExpr -> Width
cmmExprWidth e = typeWidth (cmmExprType e)
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 _) = compare u1 u2
instance Uniquable LocalReg where
getUnique (LocalReg uniq _) = uniq
cmmRegType :: CmmReg -> CmmType
cmmRegType (CmmLocal reg) = localRegType reg
cmmRegType (CmmGlobal reg) = globalRegType reg
localRegType :: LocalReg -> CmmType
localRegType (LocalReg _ rep) = rep
type RegSet = UniqSet LocalReg
emptyRegSet :: RegSet
elemRegSet :: LocalReg -> RegSet -> Bool
extendRegSet :: RegSet -> LocalReg -> RegSet
deleteFromRegSet :: RegSet -> LocalReg -> RegSet
mkRegSet :: [LocalReg] -> RegSet
minusRegSet, plusRegSet, timesRegSet :: RegSet -> RegSet -> RegSet
emptyRegSet = emptyUniqSet
elemRegSet = elementOfUniqSet
extendRegSet = addOneToUniqSet
deleteFromRegSet = delOneFromUniqSet
mkRegSet = mkUniqSet
minusRegSet = minusUniqSet
plusRegSet = unionUniqSets
timesRegSet = intersectUniqSets
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 (CmmLoad addr _) = foldRegsUsed f z addr
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
instance DefinerOfLocalRegs a => DefinerOfLocalRegs (Maybe a) where
foldRegsDefd _ set Nothing = set
foldRegsDefd f set (Just x) = foldRegsDefd f set x
regUsedIn :: CmmReg -> CmmExpr -> Bool
_ `regUsedIn` CmmLit _ = False
reg `regUsedIn` CmmLoad e _ = reg `regUsedIn` e
reg `regUsedIn` CmmReg reg' = reg == reg'
reg `regUsedIn` CmmRegOff reg' _ = reg == reg'
reg `regUsedIn` CmmMachOp _ es = any (reg `regUsedIn`) es
_ `regUsedIn` CmmStackSlot _ _ = False
isStackSlotOf :: CmmExpr -> LocalReg -> Bool
isStackSlotOf (CmmStackSlot (RegSlot r) _) r' = r == r'
isStackSlotOf _ _ = False
class UserOfSlots a where
foldSlotsUsed :: (b -> SubArea -> b) -> b -> a -> b
class DefinerOfSlots a where
foldSlotsDefd :: (b -> SubArea -> b) -> b -> a -> b
instance UserOfSlots CmmExpr where
foldSlotsUsed f z e = expr z e
where expr z (CmmLit _) = z
expr z (CmmLoad (CmmStackSlot a i) ty) = f z (a, i, widthInBytes $ typeWidth ty)
expr z (CmmLoad addr _) = foldSlotsUsed f z addr
expr z (CmmReg _) = z
expr z (CmmMachOp _ exprs) = foldSlotsUsed f z exprs
expr z (CmmRegOff _ _) = z
expr z (CmmStackSlot _ _) = z
instance UserOfSlots a => UserOfSlots [a] where
foldSlotsUsed _ set [] = set
foldSlotsUsed f set (x:xs) = foldSlotsUsed f (foldSlotsUsed f set x) xs
data VGcPtr = VGcPtr | VNonGcPtr deriving( Eq, Show )
vgcFlag :: CmmType -> VGcPtr
vgcFlag ty | isGcPtrType ty = VGcPtr
| otherwise = VNonGcPtr
data GlobalReg
= VanillaReg
!Int
VGcPtr
| FloatReg
!Int
| DoubleReg
!Int
| LongReg
!Int
| Sp
| SpLim
| Hp
| HpLim
| CurrentTSO
| CurrentNursery
| HpAlloc
| EagerBlackholeInfo
| GCEnter1
| GCFun
| BaseReg
| 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
Sp == Sp = True
SpLim == SpLim = True
Hp == Hp = True
HpLim == HpLim = True
CurrentTSO == CurrentTSO = True
CurrentNursery == CurrentNursery = True
HpAlloc == HpAlloc = True
GCEnter1 == GCEnter1 = True
GCFun == GCFun = True
BaseReg == BaseReg = 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 Sp Sp = EQ
compare SpLim SpLim = EQ
compare Hp Hp = EQ
compare HpLim HpLim = 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 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 Sp _ = LT
compare _ Sp = GT
compare SpLim _ = LT
compare _ SpLim = GT
compare Hp _ = LT
compare _ Hp = GT
compare HpLim _ = LT
compare _ HpLim = 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 EagerBlackholeInfo _ = LT
compare _ EagerBlackholeInfo = GT
spReg, hpReg, spLimReg, nodeReg :: CmmReg
spReg = CmmGlobal Sp
hpReg = CmmGlobal Hp
spLimReg = CmmGlobal SpLim
nodeReg = CmmGlobal node
node :: GlobalReg
node = VanillaReg 1 VGcPtr
globalRegType :: GlobalReg -> CmmType
globalRegType (VanillaReg _ VGcPtr) = gcWord
globalRegType (VanillaReg _ VNonGcPtr) = bWord
globalRegType (FloatReg _) = cmmFloat W32
globalRegType (DoubleReg _) = cmmFloat W64
globalRegType (LongReg _) = cmmBits W64
globalRegType Hp = gcWord
globalRegType _ = bWord
data CmmType
= CmmType CmmCat Width
data CmmCat
= GcPtrCat
| BitsCat
| FloatCat
deriving( Eq )
instance Outputable CmmType where
ppr (CmmType cat wid) = ppr cat <> ppr (widthInBits wid)
instance Outputable CmmCat where
ppr FloatCat = ptext $ sLit("F")
ppr _ = ptext $ sLit("I")
cmmEqType :: CmmType -> CmmType -> Bool
cmmEqType (CmmType c1 w1) (CmmType c2 w2) = c1==c2 && w1==w2
cmmEqType_ignoring_ptrhood :: CmmType -> CmmType -> Bool
cmmEqType_ignoring_ptrhood (CmmType c1 w1) (CmmType c2 w2)
= c1 `weak_eq` c2 && w1==w2
where
FloatCat `weak_eq` FloatCat = True
FloatCat `weak_eq` _other = False
_other `weak_eq` FloatCat = False
_word1 `weak_eq` _word2 = True
typeWidth :: CmmType -> Width
typeWidth (CmmType _ w) = w
cmmBits, cmmFloat :: Width -> CmmType
cmmBits = CmmType BitsCat
cmmFloat = CmmType FloatCat
b8, b16, b32, b64, f32, f64 :: CmmType
b8 = cmmBits W8
b16 = cmmBits W16
b32 = cmmBits W32
b64 = cmmBits W64
f32 = cmmFloat W32
f64 = cmmFloat W64
bWord, bHalfWord, gcWord :: CmmType
bWord = cmmBits wordWidth
bHalfWord = cmmBits halfWordWidth
gcWord = CmmType GcPtrCat wordWidth
cInt, cLong :: CmmType
cInt = cmmBits cIntWidth
cLong = cmmBits cLongWidth
isFloatType, isGcPtrType :: CmmType -> Bool
isFloatType (CmmType FloatCat _) = True
isFloatType _other = False
isGcPtrType (CmmType GcPtrCat _) = True
isGcPtrType _other = False
isWord32, isWord64, isFloat32, isFloat64 :: CmmType -> Bool
isWord64 (CmmType BitsCat W64) = True
isWord64 (CmmType GcPtrCat W64) = True
isWord64 _other = False
isWord32 (CmmType BitsCat W32) = True
isWord32 (CmmType GcPtrCat W32) = True
isWord32 _other = False
isFloat32 (CmmType FloatCat W32) = True
isFloat32 _other = False
isFloat64 (CmmType FloatCat W64) = True
isFloat64 _other = False
data Width = W8 | W16 | W32 | W64
| W80
| W128
deriving (Eq, Ord, Show)
instance Outputable Width where
ppr rep = ptext (mrStr rep)
mrStr :: Width -> LitString
mrStr W8 = sLit("W8")
mrStr W16 = sLit("W16")
mrStr W32 = sLit("W32")
mrStr W64 = sLit("W64")
mrStr W128 = sLit("W128")
mrStr W80 = sLit("W80")
wordWidth, halfWordWidth :: Width
wordWidth | wORD_SIZE == 4 = W32
| wORD_SIZE == 8 = W64
| otherwise = panic "MachOp.wordRep: Unknown word size"
halfWordWidth | wORD_SIZE == 4 = W16
| wORD_SIZE == 8 = W32
| otherwise = panic "MachOp.halfWordRep: Unknown word size"
cIntWidth, cLongWidth :: Width
#if SIZEOF_INT == 4
cIntWidth = W32
#elif SIZEOF_INT == 8
cIntWidth = W64
#endif
#if SIZEOF_LONG == 4
cLongWidth = W32
#elif SIZEOF_LONG == 8
cLongWidth = W64
#endif
widthInBits :: Width -> Int
widthInBits W8 = 8
widthInBits W16 = 16
widthInBits W32 = 32
widthInBits W64 = 64
widthInBits W128 = 128
widthInBits W80 = 80
widthInBytes :: Width -> Int
widthInBytes W8 = 1
widthInBytes W16 = 2
widthInBytes W32 = 4
widthInBytes W64 = 8
widthInBytes W128 = 16
widthInBytes W80 = 10
widthFromBytes :: Int -> Width
widthFromBytes 1 = W8
widthFromBytes 2 = W16
widthFromBytes 4 = W32
widthFromBytes 8 = W64
widthFromBytes 16 = W128
widthFromBytes 10 = W80
widthFromBytes n = pprPanic "no width for given number of bytes" (ppr n)
widthInLog :: Width -> Int
widthInLog W8 = 0
widthInLog W16 = 1
widthInLog W32 = 2
widthInLog W64 = 3
widthInLog W128 = 4
widthInLog W80 = panic "widthInLog: F80"
narrowU :: Width -> Integer -> Integer
narrowU W8 x = fromIntegral (fromIntegral x :: Word8)
narrowU W16 x = fromIntegral (fromIntegral x :: Word16)
narrowU W32 x = fromIntegral (fromIntegral x :: Word32)
narrowU W64 x = fromIntegral (fromIntegral x :: Word64)
narrowU _ _ = panic "narrowTo"
narrowS :: Width -> Integer -> Integer
narrowS W8 x = fromIntegral (fromIntegral x :: Int8)
narrowS W16 x = fromIntegral (fromIntegral x :: Int16)
narrowS W32 x = fromIntegral (fromIntegral x :: Int32)
narrowS W64 x = fromIntegral (fromIntegral x :: Int64)
narrowS _ _ = panic "narrowTo"
data MachOp
= MO_Add Width
| MO_Sub Width
| MO_Eq Width
| MO_Ne Width
| MO_Mul Width
| MO_S_MulMayOflo Width
| MO_S_Quot Width
| MO_S_Rem Width
| MO_S_Neg Width
| MO_U_MulMayOflo Width
| MO_U_Quot Width
| MO_U_Rem Width
| MO_S_Ge Width
| MO_S_Le Width
| MO_S_Gt Width
| MO_S_Lt Width
| MO_U_Ge Width
| MO_U_Le Width
| MO_U_Gt Width
| MO_U_Lt Width
| MO_F_Add Width
| MO_F_Sub Width
| MO_F_Neg Width
| MO_F_Mul Width
| MO_F_Quot Width
| MO_F_Eq Width
| MO_F_Ne Width
| MO_F_Ge Width
| MO_F_Le Width
| MO_F_Gt Width
| MO_F_Lt Width
| MO_And Width
| MO_Or Width
| MO_Xor Width
| MO_Not Width
| MO_Shl Width
| MO_U_Shr Width
| MO_S_Shr Width
| MO_SF_Conv Width Width
| MO_FS_Conv Width Width
| MO_SS_Conv Width Width
| MO_UU_Conv Width Width
| MO_FF_Conv Width Width
deriving (Eq, Show)
pprMachOp :: MachOp -> SDoc
pprMachOp mo = text (show mo)
mo_wordAdd, mo_wordSub, mo_wordEq, mo_wordNe,mo_wordMul, mo_wordSQuot
, mo_wordSRem, mo_wordSNeg, mo_wordUQuot, mo_wordURem
, mo_wordSGe, mo_wordSLe, mo_wordSGt, mo_wordSLt, mo_wordUGe
, mo_wordULe, mo_wordUGt, mo_wordULt
, mo_wordAnd, mo_wordOr, mo_wordXor, mo_wordNot, mo_wordShl, mo_wordSShr, mo_wordUShr
, mo_u_8To32, mo_s_8To32, mo_u_16To32, mo_s_16To32
, mo_u_8ToWord, mo_s_8ToWord, mo_u_16ToWord, mo_s_16ToWord, mo_u_32ToWord, mo_s_32ToWord
, mo_32To8, mo_32To16, mo_WordTo8, mo_WordTo16, mo_WordTo32
:: MachOp
mo_wordAdd = MO_Add wordWidth
mo_wordSub = MO_Sub wordWidth
mo_wordEq = MO_Eq wordWidth
mo_wordNe = MO_Ne wordWidth
mo_wordMul = MO_Mul wordWidth
mo_wordSQuot = MO_S_Quot wordWidth
mo_wordSRem = MO_S_Rem wordWidth
mo_wordSNeg = MO_S_Neg wordWidth
mo_wordUQuot = MO_U_Quot wordWidth
mo_wordURem = MO_U_Rem wordWidth
mo_wordSGe = MO_S_Ge wordWidth
mo_wordSLe = MO_S_Le wordWidth
mo_wordSGt = MO_S_Gt wordWidth
mo_wordSLt = MO_S_Lt wordWidth
mo_wordUGe = MO_U_Ge wordWidth
mo_wordULe = MO_U_Le wordWidth
mo_wordUGt = MO_U_Gt wordWidth
mo_wordULt = MO_U_Lt wordWidth
mo_wordAnd = MO_And wordWidth
mo_wordOr = MO_Or wordWidth
mo_wordXor = MO_Xor wordWidth
mo_wordNot = MO_Not wordWidth
mo_wordShl = MO_Shl wordWidth
mo_wordSShr = MO_S_Shr wordWidth
mo_wordUShr = MO_U_Shr wordWidth
mo_u_8To32 = MO_UU_Conv W8 W32
mo_s_8To32 = MO_SS_Conv W8 W32
mo_u_16To32 = MO_UU_Conv W16 W32
mo_s_16To32 = MO_SS_Conv W16 W32
mo_u_8ToWord = MO_UU_Conv W8 wordWidth
mo_s_8ToWord = MO_SS_Conv W8 wordWidth
mo_u_16ToWord = MO_UU_Conv W16 wordWidth
mo_s_16ToWord = MO_SS_Conv W16 wordWidth
mo_s_32ToWord = MO_SS_Conv W32 wordWidth
mo_u_32ToWord = MO_UU_Conv W32 wordWidth
mo_WordTo8 = MO_UU_Conv wordWidth W8
mo_WordTo16 = MO_UU_Conv wordWidth W16
mo_WordTo32 = MO_UU_Conv wordWidth W32
mo_32To8 = MO_UU_Conv W32 W8
mo_32To16 = MO_UU_Conv W32 W16
isCommutableMachOp :: MachOp -> Bool
isCommutableMachOp mop =
case mop of
MO_Add _ -> True
MO_Eq _ -> True
MO_Ne _ -> True
MO_Mul _ -> True
MO_S_MulMayOflo _ -> True
MO_U_MulMayOflo _ -> True
MO_And _ -> True
MO_Or _ -> True
MO_Xor _ -> True
_other -> False
isAssociativeMachOp :: MachOp -> Bool
isAssociativeMachOp mop =
case mop of
MO_Add {} -> True
MO_Mul {} -> True
MO_And {} -> True
MO_Or {} -> True
MO_Xor {} -> True
_other -> False
isComparisonMachOp :: MachOp -> Bool
isComparisonMachOp mop =
case mop of
MO_Eq _ -> True
MO_Ne _ -> True
MO_S_Ge _ -> True
MO_S_Le _ -> True
MO_S_Gt _ -> True
MO_S_Lt _ -> True
MO_U_Ge _ -> True
MO_U_Le _ -> True
MO_U_Gt _ -> True
MO_U_Lt _ -> True
MO_F_Eq {} -> True
MO_F_Ne {} -> True
MO_F_Ge {} -> True
MO_F_Le {} -> True
MO_F_Gt {} -> True
MO_F_Lt {} -> True
_other -> False
maybeInvertComparison :: MachOp -> Maybe MachOp
maybeInvertComparison op
= case op of
MO_Eq r -> Just (MO_Ne r)
MO_Ne r -> Just (MO_Eq r)
MO_U_Lt r -> Just (MO_U_Ge r)
MO_U_Gt r -> Just (MO_U_Le r)
MO_U_Le r -> Just (MO_U_Gt r)
MO_U_Ge r -> Just (MO_U_Lt r)
MO_S_Lt r -> Just (MO_S_Ge r)
MO_S_Gt r -> Just (MO_S_Le r)
MO_S_Le r -> Just (MO_S_Gt r)
MO_S_Ge r -> Just (MO_S_Lt r)
MO_F_Eq r -> Just (MO_F_Ne r)
MO_F_Ne r -> Just (MO_F_Eq r)
MO_F_Ge r -> Just (MO_F_Le r)
MO_F_Le r -> Just (MO_F_Ge r)
MO_F_Gt r -> Just (MO_F_Lt r)
MO_F_Lt r -> Just (MO_F_Gt r)
_other -> Nothing
machOpResultType :: MachOp -> [CmmType] -> CmmType
machOpResultType mop tys =
case mop of
MO_Add {} -> ty1
MO_Sub {} -> ty1
MO_Mul r -> cmmBits r
MO_S_MulMayOflo r -> cmmBits r
MO_S_Quot r -> cmmBits r
MO_S_Rem r -> cmmBits r
MO_S_Neg r -> cmmBits r
MO_U_MulMayOflo r -> cmmBits r
MO_U_Quot r -> cmmBits r
MO_U_Rem r -> cmmBits r
MO_Eq {} -> comparisonResultRep
MO_Ne {} -> comparisonResultRep
MO_S_Ge {} -> comparisonResultRep
MO_S_Le {} -> comparisonResultRep
MO_S_Gt {} -> comparisonResultRep
MO_S_Lt {} -> comparisonResultRep
MO_U_Ge {} -> comparisonResultRep
MO_U_Le {} -> comparisonResultRep
MO_U_Gt {} -> comparisonResultRep
MO_U_Lt {} -> comparisonResultRep
MO_F_Add r -> cmmFloat r
MO_F_Sub r -> cmmFloat r
MO_F_Mul r -> cmmFloat r
MO_F_Quot r -> cmmFloat r
MO_F_Neg r -> cmmFloat r
MO_F_Eq {} -> comparisonResultRep
MO_F_Ne {} -> comparisonResultRep
MO_F_Ge {} -> comparisonResultRep
MO_F_Le {} -> comparisonResultRep
MO_F_Gt {} -> comparisonResultRep
MO_F_Lt {} -> comparisonResultRep
MO_And {} -> ty1
MO_Or {} -> ty1
MO_Xor {} -> ty1
MO_Not r -> cmmBits r
MO_Shl r -> cmmBits r
MO_U_Shr r -> cmmBits r
MO_S_Shr r -> cmmBits r
MO_SS_Conv _ to -> cmmBits to
MO_UU_Conv _ to -> cmmBits to
MO_FS_Conv _ to -> cmmBits to
MO_SF_Conv _ to -> cmmFloat to
MO_FF_Conv _ to -> cmmFloat to
where
(ty1:_) = tys
comparisonResultRep :: CmmType
comparisonResultRep = bWord
machOpArgReps :: MachOp -> [Width]
machOpArgReps op =
case op of
MO_Add r -> [r,r]
MO_Sub r -> [r,r]
MO_Eq r -> [r,r]
MO_Ne r -> [r,r]
MO_Mul r -> [r,r]
MO_S_MulMayOflo r -> [r,r]
MO_S_Quot r -> [r,r]
MO_S_Rem r -> [r,r]
MO_S_Neg r -> [r]
MO_U_MulMayOflo r -> [r,r]
MO_U_Quot r -> [r,r]
MO_U_Rem r -> [r,r]
MO_S_Ge r -> [r,r]
MO_S_Le r -> [r,r]
MO_S_Gt r -> [r,r]
MO_S_Lt r -> [r,r]
MO_U_Ge r -> [r,r]
MO_U_Le r -> [r,r]
MO_U_Gt r -> [r,r]
MO_U_Lt r -> [r,r]
MO_F_Add r -> [r,r]
MO_F_Sub r -> [r,r]
MO_F_Mul r -> [r,r]
MO_F_Quot r -> [r,r]
MO_F_Neg r -> [r]
MO_F_Eq r -> [r,r]
MO_F_Ne r -> [r,r]
MO_F_Ge r -> [r,r]
MO_F_Le r -> [r,r]
MO_F_Gt r -> [r,r]
MO_F_Lt r -> [r,r]
MO_And r -> [r,r]
MO_Or r -> [r,r]
MO_Xor r -> [r,r]
MO_Not r -> [r]
MO_Shl r -> [r,wordWidth]
MO_U_Shr r -> [r,wordWidth]
MO_S_Shr r -> [r,wordWidth]
MO_SS_Conv from _ -> [from]
MO_UU_Conv from _ -> [from]
MO_SF_Conv from _ -> [from]
MO_FS_Conv from _ -> [from]
MO_FF_Conv from _ -> [from]