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 cat :: CmmCat
cat wid :: 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 FloatCat = String -> SDoc
text "F"
ppr GcPtrCat = String -> SDoc
text "P"
ppr BitsCat = String -> SDoc
text "I"
ppr (VecCat n :: Int
n cat :: CmmCat
cat) = CmmCat -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmCat
cat SDoc -> SDoc -> SDoc
<> String -> SDoc
text "x" SDoc -> SDoc -> SDoc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n SDoc -> SDoc -> SDoc
<> String -> SDoc
text "V"
cmmEqType :: CmmType -> CmmType -> Bool
cmmEqType :: CmmType -> CmmType -> Bool
cmmEqType (CmmType c1 :: CmmCat
c1 w1 :: Width
w1) (CmmType c2 :: CmmCat
c2 w2 :: 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 c1 :: CmmCat
c1 w1 :: Width
w1) (CmmType c2 :: CmmCat
c2 w2 :: 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
FloatCat weak_eq :: CmmCat -> CmmCat -> Bool
`weak_eq` FloatCat = Bool
True
FloatCat `weak_eq` _other :: CmmCat
_other = Bool
False
_other :: CmmCat
_other `weak_eq` FloatCat = Bool
False
(VecCat l1 :: Int
l1 cat1 :: CmmCat
cat1) `weak_eq` (VecCat l2 :: Int
l2 cat2 :: 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` _other :: CmmCat
_other = Bool
False
_other :: CmmCat
_other `weak_eq` (VecCat {}) = Bool
False
_word1 :: CmmCat
_word1 `weak_eq` _word2 :: CmmCat
_word2 = Bool
True
typeWidth :: CmmType -> Width
typeWidth :: CmmType -> Width
typeWidth (CmmType _ w :: 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 dflags :: DynFlags
dflags = Width -> CmmType
cmmBits (DynFlags -> Width
wordWidth DynFlags
dflags)
bHalfWord :: DynFlags -> CmmType
bHalfWord :: DynFlags -> CmmType
bHalfWord dflags :: DynFlags
dflags = Width -> CmmType
cmmBits (DynFlags -> Width
halfWordWidth DynFlags
dflags)
gcWord :: DynFlags -> CmmType
gcWord :: DynFlags -> CmmType
gcWord dflags :: DynFlags
dflags = CmmCat -> Width -> CmmType
CmmType CmmCat
GcPtrCat (DynFlags -> Width
wordWidth DynFlags
dflags)
cInt :: DynFlags -> CmmType
cInt :: DynFlags -> CmmType
cInt dflags :: DynFlags
dflags = Width -> CmmType
cmmBits (DynFlags -> Width
cIntWidth DynFlags
dflags)
isFloatType, isGcPtrType, isBitsType :: CmmType -> Bool
isFloatType :: CmmType -> Bool
isFloatType (CmmType FloatCat _) = Bool
True
isFloatType _other :: CmmType
_other = Bool
False
isGcPtrType :: CmmType -> Bool
isGcPtrType (CmmType GcPtrCat _) = Bool
True
isGcPtrType _other :: CmmType
_other = Bool
False
isBitsType :: CmmType -> Bool
isBitsType (CmmType BitsCat _) = Bool
True
isBitsType _ = Bool
False
isWord32, isWord64, isFloat32, isFloat64 :: CmmType -> Bool
isWord64 :: CmmType -> Bool
isWord64 (CmmType BitsCat W64) = Bool
True
isWord64 (CmmType GcPtrCat W64) = Bool
True
isWord64 _other :: CmmType
_other = Bool
False
isWord32 :: CmmType -> Bool
isWord32 (CmmType BitsCat W32) = Bool
True
isWord32 (CmmType GcPtrCat W32) = Bool
True
isWord32 _other :: CmmType
_other = Bool
False
isFloat32 :: CmmType -> Bool
isFloat32 (CmmType FloatCat W32) = Bool
True
isFloat32 _other :: CmmType
_other = Bool
False
isFloat64 :: CmmType -> Bool
isFloat64 (CmmType FloatCat W64) = Bool
True
isFloat64 _other :: CmmType
_other = Bool
False
data Width = W8 | W16 | W32 | W64
| W80
| 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 rep :: Width
rep = PtrString -> SDoc
ptext (Width -> PtrString
mrStr Width
rep)
mrStr :: Width -> PtrString
mrStr :: Width -> PtrString
mrStr W8 = String -> PtrString
sLit("W8")
mrStr W16 = String -> PtrString
sLit("W16")
mrStr W32 = String -> PtrString
sLit("W32")
mrStr W64 = String -> PtrString
sLit("W64")
mrStr W128 = String -> PtrString
sLit("W128")
mrStr W256 = String -> PtrString
sLit("W256")
mrStr W512 = String -> PtrString
sLit("W512")
mrStr W80 = String -> PtrString
sLit("W80")
wordWidth :: DynFlags -> Width
wordWidth :: DynFlags -> Width
wordWidth dflags :: DynFlags
dflags
| DynFlags -> Int
wORD_SIZE DynFlags
dflags Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 4 = Width
W32
| DynFlags -> Int
wORD_SIZE DynFlags
dflags Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 8 = Width
W64
| Bool
otherwise = String -> Width
forall a. String -> a
panic "MachOp.wordRep: Unknown word size"
halfWordWidth :: DynFlags -> Width
halfWordWidth :: DynFlags -> Width
halfWordWidth dflags :: DynFlags
dflags
| DynFlags -> Int
wORD_SIZE DynFlags
dflags Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 4 = Width
W16
| DynFlags -> Int
wORD_SIZE DynFlags
dflags Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 8 = Width
W32
| Bool
otherwise = String -> Width
forall a. String -> a
panic "MachOp.halfWordRep: Unknown word size"
halfWordMask :: DynFlags -> Integer
halfWordMask :: DynFlags -> Integer
halfWordMask dflags :: DynFlags
dflags
| DynFlags -> Int
wORD_SIZE DynFlags
dflags Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 4 = 0xFFFF
| DynFlags -> Int
wORD_SIZE DynFlags
dflags Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 8 = 0xFFFFFFFF
| Bool
otherwise = String -> Integer
forall a. String -> a
panic "MachOp.halfWordMask: Unknown word size"
cIntWidth :: DynFlags -> Width
cIntWidth :: DynFlags -> Width
cIntWidth dflags :: DynFlags
dflags = case DynFlags -> Int
cINT_SIZE DynFlags
dflags of
4 -> Width
W32
8 -> Width
W64
s :: Int
s -> String -> Width
forall a. String -> a
panic ("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 W8 = 8
widthInBits W16 = 16
widthInBits W32 = 32
widthInBits W64 = 64
widthInBits W128 = 128
widthInBits W256 = 256
widthInBits W512 = 512
widthInBits W80 = 80
widthInBytes :: Width -> Int
widthInBytes :: Width -> Int
widthInBytes W8 = 1
widthInBytes W16 = 2
widthInBytes W32 = 4
widthInBytes W64 = 8
widthInBytes W128 = 16
widthInBytes W256 = 32
widthInBytes W512 = 64
widthInBytes W80 = 10
widthFromBytes :: Int -> Width
widthFromBytes :: Int -> Width
widthFromBytes 1 = Width
W8
widthFromBytes 2 = Width
W16
widthFromBytes 4 = Width
W32
widthFromBytes 8 = Width
W64
widthFromBytes 16 = Width
W128
widthFromBytes 32 = Width
W256
widthFromBytes 64 = Width
W512
widthFromBytes 10 = Width
W80
widthFromBytes n :: Int
n = String -> SDoc -> Width
forall a. HasCallStack => String -> SDoc -> a
pprPanic "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 W8 = 0
widthInLog W16 = 1
widthInLog W32 = 2
widthInLog W64 = 3
widthInLog W128 = 4
widthInLog W256 = 5
widthInLog W512 = 6
widthInLog W80 = String -> Int
forall a. String -> a
panic "widthInLog: F80"
narrowU :: Width -> Integer -> Integer
narrowU :: Width -> Integer -> Integer
narrowU W8 x :: 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 W16 x :: 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 W32 x :: 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 W64 x :: 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 _ _ = String -> Integer
forall a. String -> a
panic "narrowTo"
narrowS :: Width -> Integer -> Integer
narrowS :: Width -> Integer -> Integer
narrowS W8 x :: 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 W16 x :: 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 W32 x :: 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 W64 x :: 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 _ _ = String -> Integer
forall a. String -> a
panic "narrowTo"
type Length = Int
vec :: Length -> CmmType -> CmmType
vec :: Int -> CmmType -> CmmType
vec l :: Int
l (CmmType cat :: CmmCat
cat w :: 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 2
vec4 :: CmmType -> CmmType
vec4 = Int -> CmmType -> CmmType
vec 4
vec8 :: CmmType -> CmmType
vec8 = Int -> CmmType -> CmmType
vec 8
vec16 :: CmmType -> CmmType
vec16 = Int -> CmmType -> CmmType
vec 16
vec2f64, vec2b64, vec4f32, vec4b32, vec8b16, vec16b8 :: CmmType
vec2f64 :: CmmType
vec2f64 = Int -> CmmType -> CmmType
vec 2 CmmType
f64
vec2b64 :: CmmType
vec2b64 = Int -> CmmType -> CmmType
vec 2 CmmType
b64
vec4f32 :: CmmType
vec4f32 = Int -> CmmType -> CmmType
vec 4 CmmType
f32
vec4b32 :: CmmType
vec4b32 = Int -> CmmType -> CmmType
vec 4 CmmType
b32
vec8b16 :: CmmType
vec8b16 = Int -> CmmType -> CmmType
vec 8 CmmType
b16
vec16b8 :: CmmType
vec16b8 = Int -> CmmType -> CmmType
vec 16 CmmType
b8
cmmVec :: Int -> CmmType -> CmmType
cmmVec :: Int -> CmmType -> CmmType
cmmVec n :: Int
n (CmmType cat :: CmmCat
cat w :: 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 l :: Int
l _) _) = Int
l
vecLength _ = String -> Int
forall a. String -> a
panic "vecLength: not a vector"
vecElemType :: CmmType -> CmmType
vecElemType :: CmmType -> CmmType
vecElemType (CmmType (VecCat l :: Int
l cat :: CmmCat
cat) w :: 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 _ = String -> CmmType
forall a. String -> a
panic "vecElemType: not a vector"
isVecType :: CmmType -> Bool
isVecType :: CmmType -> Bool
isVecType (CmmType (VecCat {}) _) = Bool
True
isVecType _ = 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 dflags :: DynFlags
dflags
= Width -> CmmType
cmmBits (Int -> Width
widthFromBytes (PlatformConstants -> Int
pc_REP_CostCentreStack_mem_alloc PlatformConstants
pc))
where pc :: PlatformConstants
pc = Settings -> PlatformConstants
sPlatformConstants (DynFlags -> Settings
settings DynFlags
dflags)
rEP_CostCentreStack_scc_count :: DynFlags -> CmmType
rEP_CostCentreStack_scc_count :: DynFlags -> CmmType
rEP_CostCentreStack_scc_count dflags :: DynFlags
dflags
= Width -> CmmType
cmmBits (Int -> Width
widthFromBytes (PlatformConstants -> Int
pc_REP_CostCentreStack_scc_count PlatformConstants
pc))
where pc :: PlatformConstants
pc = Settings -> PlatformConstants
sPlatformConstants (DynFlags -> Settings
settings DynFlags
dflags)
rEP_StgEntCounter_allocs :: DynFlags -> CmmType
rEP_StgEntCounter_allocs :: DynFlags -> CmmType
rEP_StgEntCounter_allocs dflags :: DynFlags
dflags
= Width -> CmmType
cmmBits (Int -> Width
widthFromBytes (PlatformConstants -> Int
pc_REP_StgEntCounter_allocs PlatformConstants
pc))
where pc :: PlatformConstants
pc = Settings -> PlatformConstants
sPlatformConstants (DynFlags -> Settings
settings DynFlags
dflags)
rEP_StgEntCounter_allocd :: DynFlags -> CmmType
rEP_StgEntCounter_allocd :: DynFlags -> CmmType
rEP_StgEntCounter_allocd dflags :: DynFlags
dflags
= Width -> CmmType
cmmBits (Int -> Width
widthFromBytes (PlatformConstants -> Int
pc_REP_StgEntCounter_allocd PlatformConstants
pc))
where pc :: PlatformConstants
pc = Settings -> PlatformConstants
sPlatformConstants (DynFlags -> Settings
settings DynFlags
dflags)