module CmmType
( CmmType
, b8, b16, b32, b64, b128, b256, b512, f32, f64, bWord, bHalfWord, gcWord
, cInt
, cmmBits, cmmFloat
, typeWidth, cmmEqType, cmmEqType_ignoring_ptrhood
, isFloatType, isGcPtrType, isBitsType
, isWord32, isWord64, isFloat64, isFloat32
, Width(..)
, widthInBits, widthInBytes, widthInLog, widthFromBytes
, wordWidth, halfWordWidth, cIntWidth
, halfWordMask
, narrowU, narrowS
, rEP_CostCentreStack_mem_alloc
, rEP_CostCentreStack_scc_count
, rEP_StgEntCounter_allocs
, rEP_StgEntCounter_allocd
, ForeignHint(..)
, Length
, vec, vec2, vec4, vec8, vec16
, vec2f64, vec2b64, vec4f32, vec4b32, vec8b16, vec16b8
, cmmVec
, vecLength, vecElemType
, isVecType
)
where
import GhcPrelude
import DynFlags
import FastString
import Outputable
import Data.Word
import Data.Int
data CmmType
= CmmType CmmCat Width
data CmmCat
= GcPtrCat
| BitsCat
| FloatCat
| VecCat Length CmmCat
deriving( CmmCat -> CmmCat -> Bool
(CmmCat -> CmmCat -> Bool)
-> (CmmCat -> CmmCat -> Bool) -> Eq CmmCat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmmCat -> CmmCat -> Bool
$c/= :: CmmCat -> CmmCat -> Bool
== :: CmmCat -> CmmCat -> Bool
$c== :: CmmCat -> CmmCat -> Bool
Eq )
instance Outputable CmmType where
ppr :: CmmType -> SDoc
ppr (CmmType CmmCat
cat Width
wid) = CmmCat -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmCat
cat SDoc -> SDoc -> SDoc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Width -> Int
widthInBits Width
wid)
instance Outputable CmmCat where
ppr :: CmmCat -> SDoc
ppr CmmCat
FloatCat = String -> SDoc
text String
"F"
ppr CmmCat
GcPtrCat = String -> SDoc
text String
"P"
ppr CmmCat
BitsCat = String -> SDoc
text String
"I"
ppr (VecCat Int
n CmmCat
cat) = CmmCat -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmCat
cat SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"x" SDoc -> SDoc -> SDoc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"V"
cmmEqType :: CmmType -> CmmType -> Bool
cmmEqType :: CmmType -> CmmType -> Bool
cmmEqType (CmmType CmmCat
c1 Width
w1) (CmmType CmmCat
c2 Width
w2) = CmmCat
c1CmmCat -> CmmCat -> Bool
forall a. Eq a => a -> a -> Bool
==CmmCat
c2 Bool -> Bool -> Bool
&& Width
w1Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
==Width
w2
cmmEqType_ignoring_ptrhood :: CmmType -> CmmType -> Bool
cmmEqType_ignoring_ptrhood :: CmmType -> CmmType -> Bool
cmmEqType_ignoring_ptrhood (CmmType CmmCat
c1 Width
w1) (CmmType CmmCat
c2 Width
w2)
= CmmCat
c1 CmmCat -> CmmCat -> Bool
`weak_eq` CmmCat
c2 Bool -> Bool -> Bool
&& Width
w1Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
==Width
w2
where
weak_eq :: CmmCat -> CmmCat -> Bool
CmmCat
FloatCat weak_eq :: CmmCat -> CmmCat -> Bool
`weak_eq` CmmCat
FloatCat = Bool
True
CmmCat
FloatCat `weak_eq` CmmCat
_other = Bool
False
CmmCat
_other `weak_eq` CmmCat
FloatCat = Bool
False
(VecCat Int
l1 CmmCat
cat1) `weak_eq` (VecCat Int
l2 CmmCat
cat2) = Int
l1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l2
Bool -> Bool -> Bool
&& CmmCat
cat1 CmmCat -> CmmCat -> Bool
`weak_eq` CmmCat
cat2
(VecCat {}) `weak_eq` CmmCat
_other = Bool
False
CmmCat
_other `weak_eq` (VecCat {}) = Bool
False
CmmCat
_word1 `weak_eq` CmmCat
_word2 = Bool
True
typeWidth :: CmmType -> Width
typeWidth :: CmmType -> Width
typeWidth (CmmType CmmCat
_ Width
w) = Width
w
cmmBits, cmmFloat :: Width -> CmmType
cmmBits :: Width -> CmmType
cmmBits = CmmCat -> Width -> CmmType
CmmType CmmCat
BitsCat
cmmFloat :: Width -> CmmType
cmmFloat = CmmCat -> Width -> CmmType
CmmType CmmCat
FloatCat
b8, b16, b32, b64, b128, b256, b512, f32, f64 :: CmmType
b8 :: CmmType
b8 = Width -> CmmType
cmmBits Width
W8
b16 :: CmmType
b16 = Width -> CmmType
cmmBits Width
W16
b32 :: CmmType
b32 = Width -> CmmType
cmmBits Width
W32
b64 :: CmmType
b64 = Width -> CmmType
cmmBits Width
W64
b128 :: CmmType
b128 = Width -> CmmType
cmmBits Width
W128
b256 :: CmmType
b256 = Width -> CmmType
cmmBits Width
W256
b512 :: CmmType
b512 = Width -> CmmType
cmmBits Width
W512
f32 :: CmmType
f32 = Width -> CmmType
cmmFloat Width
W32
f64 :: CmmType
f64 = Width -> CmmType
cmmFloat Width
W64
bWord :: DynFlags -> CmmType
bWord :: DynFlags -> CmmType
bWord DynFlags
dflags = Width -> CmmType
cmmBits (DynFlags -> Width
wordWidth DynFlags
dflags)
bHalfWord :: DynFlags -> CmmType
bHalfWord :: DynFlags -> CmmType
bHalfWord DynFlags
dflags = Width -> CmmType
cmmBits (DynFlags -> Width
halfWordWidth DynFlags
dflags)
gcWord :: DynFlags -> CmmType
gcWord :: DynFlags -> CmmType
gcWord DynFlags
dflags = CmmCat -> Width -> CmmType
CmmType CmmCat
GcPtrCat (DynFlags -> Width
wordWidth DynFlags
dflags)
cInt :: DynFlags -> CmmType
cInt :: DynFlags -> CmmType
cInt DynFlags
dflags = Width -> CmmType
cmmBits (DynFlags -> Width
cIntWidth DynFlags
dflags)
isFloatType, isGcPtrType, isBitsType :: CmmType -> Bool
isFloatType :: CmmType -> Bool
isFloatType (CmmType CmmCat
FloatCat Width
_) = Bool
True
isFloatType CmmType
_other = Bool
False
isGcPtrType :: CmmType -> Bool
isGcPtrType (CmmType CmmCat
GcPtrCat Width
_) = Bool
True
isGcPtrType CmmType
_other = Bool
False
isBitsType :: CmmType -> Bool
isBitsType (CmmType CmmCat
BitsCat Width
_) = Bool
True
isBitsType CmmType
_ = Bool
False
isWord32, isWord64, isFloat32, isFloat64 :: CmmType -> Bool
isWord64 :: CmmType -> Bool
isWord64 (CmmType CmmCat
BitsCat Width
W64) = Bool
True
isWord64 (CmmType CmmCat
GcPtrCat Width
W64) = Bool
True
isWord64 CmmType
_other = Bool
False
isWord32 :: CmmType -> Bool
isWord32 (CmmType CmmCat
BitsCat Width
W32) = Bool
True
isWord32 (CmmType CmmCat
GcPtrCat Width
W32) = Bool
True
isWord32 CmmType
_other = Bool
False
isFloat32 :: CmmType -> Bool
isFloat32 (CmmType CmmCat
FloatCat Width
W32) = Bool
True
isFloat32 CmmType
_other = Bool
False
isFloat64 :: CmmType -> Bool
isFloat64 (CmmType CmmCat
FloatCat Width
W64) = Bool
True
isFloat64 CmmType
_other = Bool
False
data Width = W8 | W16 | W32 | W64
| W128
| W256
| W512
deriving (Width -> Width -> Bool
(Width -> Width -> Bool) -> (Width -> Width -> Bool) -> Eq Width
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Width -> Width -> Bool
$c/= :: Width -> Width -> Bool
== :: Width -> Width -> Bool
$c== :: Width -> Width -> Bool
Eq, Eq Width
Eq Width
-> (Width -> Width -> Ordering)
-> (Width -> Width -> Bool)
-> (Width -> Width -> Bool)
-> (Width -> Width -> Bool)
-> (Width -> Width -> Bool)
-> (Width -> Width -> Width)
-> (Width -> Width -> Width)
-> Ord Width
Width -> Width -> Bool
Width -> Width -> Ordering
Width -> Width -> Width
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Width -> Width -> Width
$cmin :: Width -> Width -> Width
max :: Width -> Width -> Width
$cmax :: Width -> Width -> Width
>= :: Width -> Width -> Bool
$c>= :: Width -> Width -> Bool
> :: Width -> Width -> Bool
$c> :: Width -> Width -> Bool
<= :: Width -> Width -> Bool
$c<= :: Width -> Width -> Bool
< :: Width -> Width -> Bool
$c< :: Width -> Width -> Bool
compare :: Width -> Width -> Ordering
$ccompare :: Width -> Width -> Ordering
$cp1Ord :: Eq Width
Ord, Int -> Width -> ShowS
[Width] -> ShowS
Width -> String
(Int -> Width -> ShowS)
-> (Width -> String) -> ([Width] -> ShowS) -> Show Width
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Width] -> ShowS
$cshowList :: [Width] -> ShowS
show :: Width -> String
$cshow :: Width -> String
showsPrec :: Int -> Width -> ShowS
$cshowsPrec :: Int -> Width -> ShowS
Show)
instance Outputable Width where
ppr :: Width -> SDoc
ppr Width
rep = PtrString -> SDoc
ptext (Width -> PtrString
mrStr Width
rep)
mrStr :: Width -> PtrString
mrStr :: Width -> PtrString
mrStr Width
W8 = String -> PtrString
sLit(String
"W8")
mrStr Width
W16 = String -> PtrString
sLit(String
"W16")
mrStr Width
W32 = String -> PtrString
sLit(String
"W32")
mrStr Width
W64 = String -> PtrString
sLit(String
"W64")
mrStr Width
W128 = String -> PtrString
sLit(String
"W128")
mrStr Width
W256 = String -> PtrString
sLit(String
"W256")
mrStr Width
W512 = String -> PtrString
sLit(String
"W512")
wordWidth :: DynFlags -> Width
wordWidth :: DynFlags -> Width
wordWidth DynFlags
dflags
| DynFlags -> Int
wORD_SIZE DynFlags
dflags Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = Width
W32
| DynFlags -> Int
wORD_SIZE DynFlags
dflags Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 = Width
W64
| Bool
otherwise = String -> Width
forall a. String -> a
panic String
"MachOp.wordRep: Unknown word size"
halfWordWidth :: DynFlags -> Width
halfWordWidth :: DynFlags -> Width
halfWordWidth DynFlags
dflags
| DynFlags -> Int
wORD_SIZE DynFlags
dflags Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = Width
W16
| DynFlags -> Int
wORD_SIZE DynFlags
dflags Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 = Width
W32
| Bool
otherwise = String -> Width
forall a. String -> a
panic String
"MachOp.halfWordRep: Unknown word size"
halfWordMask :: DynFlags -> Integer
halfWordMask :: DynFlags -> Integer
halfWordMask DynFlags
dflags
| DynFlags -> Int
wORD_SIZE DynFlags
dflags Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = Integer
0xFFFF
| DynFlags -> Int
wORD_SIZE DynFlags
dflags Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 = Integer
0xFFFFFFFF
| Bool
otherwise = String -> Integer
forall a. String -> a
panic String
"MachOp.halfWordMask: Unknown word size"
cIntWidth :: DynFlags -> Width
cIntWidth :: DynFlags -> Width
cIntWidth DynFlags
dflags = case DynFlags -> Int
cINT_SIZE DynFlags
dflags of
Int
4 -> Width
W32
Int
8 -> Width
W64
Int
s -> String -> Width
forall a. String -> a
panic (String
"cIntWidth: Unknown cINT_SIZE: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
s)
widthInBits :: Width -> Int
widthInBits :: Width -> Int
widthInBits Width
W8 = Int
8
widthInBits Width
W16 = Int
16
widthInBits Width
W32 = Int
32
widthInBits Width
W64 = Int
64
widthInBits Width
W128 = Int
128
widthInBits Width
W256 = Int
256
widthInBits Width
W512 = Int
512
widthInBytes :: Width -> Int
widthInBytes :: Width -> Int
widthInBytes Width
W8 = Int
1
widthInBytes Width
W16 = Int
2
widthInBytes Width
W32 = Int
4
widthInBytes Width
W64 = Int
8
widthInBytes Width
W128 = Int
16
widthInBytes Width
W256 = Int
32
widthInBytes Width
W512 = Int
64
widthFromBytes :: Int -> Width
widthFromBytes :: Int -> Width
widthFromBytes Int
1 = Width
W8
widthFromBytes Int
2 = Width
W16
widthFromBytes Int
4 = Width
W32
widthFromBytes Int
8 = Width
W64
widthFromBytes Int
16 = Width
W128
widthFromBytes Int
32 = Width
W256
widthFromBytes Int
64 = Width
W512
widthFromBytes Int
n = String -> SDoc -> Width
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"no width for given number of bytes" (Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n)
widthInLog :: Width -> Int
widthInLog :: Width -> Int
widthInLog Width
W8 = Int
0
widthInLog Width
W16 = Int
1
widthInLog Width
W32 = Int
2
widthInLog Width
W64 = Int
3
widthInLog Width
W128 = Int
4
widthInLog Width
W256 = Int
5
widthInLog Width
W512 = Int
6
narrowU :: Width -> Integer -> Integer
narrowU :: Width -> Integer -> Integer
narrowU Width
W8 Integer
x = Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Word8)
narrowU Width
W16 Integer
x = Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Word16)
narrowU Width
W32 Integer
x = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Word32)
narrowU Width
W64 Integer
x = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Word64)
narrowU Width
_ Integer
_ = String -> Integer
forall a. String -> a
panic String
"narrowTo"
narrowS :: Width -> Integer -> Integer
narrowS :: Width -> Integer -> Integer
narrowS Width
W8 Integer
x = Int8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Int8)
narrowS Width
W16 Integer
x = Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Int16)
narrowS Width
W32 Integer
x = Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Int32)
narrowS Width
W64 Integer
x = Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Int64)
narrowS Width
_ Integer
_ = String -> Integer
forall a. String -> a
panic String
"narrowTo"
type Length = Int
vec :: Length -> CmmType -> CmmType
vec :: Int -> CmmType -> CmmType
vec Int
l (CmmType CmmCat
cat Width
w) = CmmCat -> Width -> CmmType
CmmType (Int -> CmmCat -> CmmCat
VecCat Int
l CmmCat
cat) Width
vecw
where
vecw :: Width
vecw :: Width
vecw = Int -> Width
widthFromBytes (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
*Width -> Int
widthInBytes Width
w)
vec2, vec4, vec8, vec16 :: CmmType -> CmmType
vec2 :: CmmType -> CmmType
vec2 = Int -> CmmType -> CmmType
vec Int
2
vec4 :: CmmType -> CmmType
vec4 = Int -> CmmType -> CmmType
vec Int
4
vec8 :: CmmType -> CmmType
vec8 = Int -> CmmType -> CmmType
vec Int
8
vec16 :: CmmType -> CmmType
vec16 = Int -> CmmType -> CmmType
vec Int
16
vec2f64, vec2b64, vec4f32, vec4b32, vec8b16, vec16b8 :: CmmType
vec2f64 :: CmmType
vec2f64 = Int -> CmmType -> CmmType
vec Int
2 CmmType
f64
vec2b64 :: CmmType
vec2b64 = Int -> CmmType -> CmmType
vec Int
2 CmmType
b64
vec4f32 :: CmmType
vec4f32 = Int -> CmmType -> CmmType
vec Int
4 CmmType
f32
vec4b32 :: CmmType
vec4b32 = Int -> CmmType -> CmmType
vec Int
4 CmmType
b32
vec8b16 :: CmmType
vec8b16 = Int -> CmmType -> CmmType
vec Int
8 CmmType
b16
vec16b8 :: CmmType
vec16b8 = Int -> CmmType -> CmmType
vec Int
16 CmmType
b8
cmmVec :: Int -> CmmType -> CmmType
cmmVec :: Int -> CmmType -> CmmType
cmmVec Int
n (CmmType CmmCat
cat Width
w) =
CmmCat -> Width -> CmmType
CmmType (Int -> CmmCat -> CmmCat
VecCat Int
n CmmCat
cat) (Int -> Width
widthFromBytes (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Width -> Int
widthInBytes Width
w))
vecLength :: CmmType -> Length
vecLength :: CmmType -> Int
vecLength (CmmType (VecCat Int
l CmmCat
_) Width
_) = Int
l
vecLength CmmType
_ = String -> Int
forall a. String -> a
panic String
"vecLength: not a vector"
vecElemType :: CmmType -> CmmType
vecElemType :: CmmType -> CmmType
vecElemType (CmmType (VecCat Int
l CmmCat
cat) Width
w) = CmmCat -> Width -> CmmType
CmmType CmmCat
cat Width
scalw
where
scalw :: Width
scalw :: Width
scalw = Int -> Width
widthFromBytes (Width -> Int
widthInBytes Width
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
l)
vecElemType CmmType
_ = String -> CmmType
forall a. String -> a
panic String
"vecElemType: not a vector"
isVecType :: CmmType -> Bool
isVecType :: CmmType -> Bool
isVecType (CmmType (VecCat {}) Width
_) = Bool
True
isVecType CmmType
_ = Bool
False
data ForeignHint
= NoHint | AddrHint | SignedHint
deriving( ForeignHint -> ForeignHint -> Bool
(ForeignHint -> ForeignHint -> Bool)
-> (ForeignHint -> ForeignHint -> Bool) -> Eq ForeignHint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ForeignHint -> ForeignHint -> Bool
$c/= :: ForeignHint -> ForeignHint -> Bool
== :: ForeignHint -> ForeignHint -> Bool
$c== :: ForeignHint -> ForeignHint -> Bool
Eq )
rEP_CostCentreStack_mem_alloc :: DynFlags -> CmmType
rEP_CostCentreStack_mem_alloc :: DynFlags -> CmmType
rEP_CostCentreStack_mem_alloc DynFlags
dflags
= Width -> CmmType
cmmBits (Int -> Width
widthFromBytes (PlatformConstants -> Int
pc_REP_CostCentreStack_mem_alloc PlatformConstants
pc))
where pc :: PlatformConstants
pc = DynFlags -> PlatformConstants
platformConstants DynFlags
dflags
rEP_CostCentreStack_scc_count :: DynFlags -> CmmType
rEP_CostCentreStack_scc_count :: DynFlags -> CmmType
rEP_CostCentreStack_scc_count DynFlags
dflags
= Width -> CmmType
cmmBits (Int -> Width
widthFromBytes (PlatformConstants -> Int
pc_REP_CostCentreStack_scc_count PlatformConstants
pc))
where pc :: PlatformConstants
pc = DynFlags -> PlatformConstants
platformConstants DynFlags
dflags
rEP_StgEntCounter_allocs :: DynFlags -> CmmType
rEP_StgEntCounter_allocs :: DynFlags -> CmmType
rEP_StgEntCounter_allocs DynFlags
dflags
= Width -> CmmType
cmmBits (Int -> Width
widthFromBytes (PlatformConstants -> Int
pc_REP_StgEntCounter_allocs PlatformConstants
pc))
where pc :: PlatformConstants
pc = DynFlags -> PlatformConstants
platformConstants DynFlags
dflags
rEP_StgEntCounter_allocd :: DynFlags -> CmmType
rEP_StgEntCounter_allocd :: DynFlags -> CmmType
rEP_StgEntCounter_allocd DynFlags
dflags
= Width -> CmmType
cmmBits (Int -> Width
widthFromBytes (PlatformConstants -> Int
pc_REP_StgEntCounter_allocd PlatformConstants
pc))
where pc :: PlatformConstants
pc = DynFlags -> PlatformConstants
platformConstants DynFlags
dflags