CLabel: Refactor pprDynamicLinkerAsmLabel
[ghc.git] / compiler / cmm / CmmType.hs
index b6deb01..cb15dc7 100644 (file)
@@ -1,22 +1,38 @@
+{-# LANGUAGE CPP #-}
 
 module CmmType
     ( CmmType   -- Abstract
-    , b8, b16, b32, b64, f32, f64, bWord, bHalfWord, gcWord
-    , cInt, cLong
+    , b8, b16, b32, b64, b128, b256, b512, f32, f64, bWord, bHalfWord, gcWord
+    , cInt
     , cmmBits, cmmFloat
     , typeWidth, cmmEqType, cmmEqType_ignoring_ptrhood
     , isFloatType, isGcPtrType, isWord32, isWord64, isFloat64, isFloat32
 
     , Width(..)
     , widthInBits, widthInBytes, widthInLog, widthFromBytes
-    , wordWidth, halfWordWidth, cIntWidth, cLongWidth
+    , 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
 
 #include "HsVersions.h"
 
+import GhcPrelude
+
 import DynFlags
 import FastString
 import Outputable
@@ -37,10 +53,11 @@ import Data.Int
 data CmmType    -- The important one!
   = CmmType CmmCat Width
 
-data CmmCat     -- "Category" (not exported)
-   = GcPtrCat   -- GC pointer
-   | BitsCat    -- Non-pointer
-   | FloatCat   -- Float
+data CmmCat                -- "Category" (not exported)
+   = GcPtrCat              -- GC pointer
+   | BitsCat               -- Non-pointer
+   | FloatCat              -- Float
+   | VecCat Length CmmCat  -- Vector
    deriving( Eq )
         -- See Note [Signed vs unsigned] at the end
 
@@ -48,8 +65,10 @@ 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")
+  ppr FloatCat       = text "F"
+  ppr GcPtrCat       = text "P"
+  ppr BitsCat        = text "I"
+  ppr (VecCat n cat) = ppr cat <> text "x" <> ppr n <> text "V"
 
 -- Why is CmmType stratified?  For native code generation,
 -- most of the time you just want to know what sort of register
@@ -71,10 +90,15 @@ 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        -- Ignores GcPtr
+     weak_eq :: CmmCat -> CmmCat -> Bool
+     FloatCat         `weak_eq` FloatCat         = True
+     FloatCat         `weak_eq` _other           = False
+     _other           `weak_eq` FloatCat         = False
+     (VecCat l1 cat1) `weak_eq` (VecCat l2 cat2) = l1 == l2
+                                                   && cat1 `weak_eq` cat2
+     (VecCat {})      `weak_eq` _other           = False
+     _other           `weak_eq` (VecCat {})      = False
+     _word1           `weak_eq` _word2           = True        -- Ignores GcPtr
 
 --- Simple operations on CmmType -----
 typeWidth :: CmmType -> Width
@@ -86,11 +110,14 @@ cmmFloat = CmmType FloatCat
 
 -------- Common CmmTypes ------------
 -- Floats and words of specific widths
-b8, b16, b32, b64, f32, f64 :: CmmType
+b8, b16, b32, b64, b128, b256, b512, f32, f64 :: CmmType
 b8     = cmmBits W8
 b16    = cmmBits W16
 b32    = cmmBits W32
 b64    = cmmBits W64
+b128   = cmmBits W128
+b256   = cmmBits W256
+b512   = cmmBits W512
 f32    = cmmFloat W32
 f64    = cmmFloat W64
 
@@ -104,10 +131,8 @@ bHalfWord dflags = cmmBits (halfWordWidth dflags)
 gcWord :: DynFlags -> CmmType
 gcWord dflags = CmmType GcPtrCat (wordWidth dflags)
 
-cInt, cLong :: DynFlags -> CmmType
-cInt  dflags = cmmBits (cIntWidth  dflags)
-cLong dflags = cmmBits (cLongWidth dflags)
-
+cInt :: DynFlags -> CmmType
+cInt dflags = cmmBits (cIntWidth  dflags)
 
 ------------ Predicates ----------------
 isFloatType, isGcPtrType :: CmmType -> Bool
@@ -144,6 +169,8 @@ data Width   = W8 | W16 | W32 | W64
                         -- used in x86 native codegen only.
                         -- (we use Ord, so it'd better be in this order)
              | W128
+             | W256
+             | W512
              deriving (Eq, Ord, Show)
 
 instance Outputable Width where
@@ -155,6 +182,8 @@ mrStr W16  = sLit("W16")
 mrStr W32  = sLit("W32")
 mrStr W64  = sLit("W64")
 mrStr W128 = sLit("W128")
+mrStr W256 = sLit("W256")
+mrStr W512 = sLit("W512")
 mrStr W80  = sLit("W80")
 
 
@@ -178,15 +207,11 @@ halfWordMask dflags
  | otherwise             = panic "MachOp.halfWordMask: Unknown word size"
 
 -- cIntRep is the Width for a C-language 'int'
-cIntWidth, cLongWidth :: DynFlags -> Width
+cIntWidth :: DynFlags -> Width
 cIntWidth dflags = case cINT_SIZE dflags of
                    4 -> W32
                    8 -> W64
                    s -> panic ("cIntWidth: Unknown cINT_SIZE: " ++ show s)
-cLongWidth dflags = case cLONG_SIZE dflags of
-                    4 -> W32
-                    8 -> W64
-                    s -> panic ("cIntWidth: Unknown cLONG_SIZE: " ++ show s)
 
 widthInBits :: Width -> Int
 widthInBits W8   = 8
@@ -194,6 +219,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
@@ -202,6 +229,8 @@ widthInBytes W16  = 2
 widthInBytes W32  = 4
 widthInBytes W64  = 8
 widthInBytes W128 = 16
+widthInBytes W256 = 32
+widthInBytes W512 = 64
 widthInBytes W80  = 10
 
 widthFromBytes :: Int -> Width
@@ -210,6 +239,8 @@ widthFromBytes 2  = W16
 widthFromBytes 4  = W32
 widthFromBytes 8  = W64
 widthFromBytes 16 = W128
+widthFromBytes 32 = W256
+widthFromBytes 64 = W512
 widthFromBytes 10 = W80
 widthFromBytes n  = pprPanic "no width for given number of bytes" (ppr n)
 
@@ -220,6 +251,8 @@ widthInLog W16  = 1
 widthInLog W32  = 2
 widthInLog W64  = 3
 widthInLog W128 = 4
+widthInLog W256 = 5
+widthInLog W512 = 6
 widthInLog W80  = panic "widthInLog: F80"
 
 -- widening / narrowing
@@ -238,6 +271,89 @@ narrowS W32 x = fromIntegral (fromIntegral x :: Int32)
 narrowS W64 x = fromIntegral (fromIntegral x :: Int64)
 narrowS _ _ = panic "narrowTo"
 
+-----------------------------------------------------------------------------
+--              SIMD
+-----------------------------------------------------------------------------
+
+type Length = Int
+
+vec :: Length -> CmmType -> CmmType
+vec l (CmmType cat w) = CmmType (VecCat l cat) vecw
+  where
+    vecw :: Width
+    vecw = widthFromBytes (l*widthInBytes w)
+
+vec2, vec4, vec8, vec16 :: CmmType -> CmmType
+vec2  = vec 2
+vec4  = vec 4
+vec8  = vec 8
+vec16 = vec 16
+
+vec2f64, vec2b64, vec4f32, vec4b32, vec8b16, vec16b8 :: CmmType
+vec2f64 = vec 2 f64
+vec2b64 = vec 2 b64
+vec4f32 = vec 4 f32
+vec4b32 = vec 4 b32
+vec8b16 = vec 8 b16
+vec16b8 = vec 16 b8
+
+cmmVec :: Int -> CmmType -> CmmType
+cmmVec n (CmmType cat w) =
+    CmmType (VecCat n cat) (widthFromBytes (n*widthInBytes w))
+
+vecLength :: CmmType -> Length
+vecLength (CmmType (VecCat l _) _) = l
+vecLength _                        = panic "vecLength: not a vector"
+
+vecElemType :: CmmType -> CmmType
+vecElemType (CmmType (VecCat l cat) w) = CmmType cat scalw
+  where
+    scalw :: Width
+    scalw = widthFromBytes (widthInBytes w `div` l)
+vecElemType _ = panic "vecElemType: not a vector"
+
+isVecType :: CmmType -> Bool
+isVecType (CmmType (VecCat {}) _) = True
+isVecType _                       = False
+
+-------------------------------------------------------------------------
+-- Hints
+
+-- Hints are extra type information we attach to the arguments and
+-- results of a foreign call, where more type information is sometimes
+-- needed by the ABI to make the correct kind of call.
+
+data ForeignHint
+  = NoHint | AddrHint | SignedHint
+  deriving( Eq )
+        -- Used to give extra per-argument or per-result
+        -- information needed by foreign calling conventions
+
+-------------------------------------------------------------------------
+
+-- These don't really belong here, but I don't know where is best to
+-- put them.
+
+rEP_CostCentreStack_mem_alloc :: DynFlags -> CmmType
+rEP_CostCentreStack_mem_alloc dflags
+    = cmmBits (widthFromBytes (pc_REP_CostCentreStack_mem_alloc pc))
+    where pc = sPlatformConstants (settings dflags)
+
+rEP_CostCentreStack_scc_count :: DynFlags -> CmmType
+rEP_CostCentreStack_scc_count dflags
+    = cmmBits (widthFromBytes (pc_REP_CostCentreStack_scc_count pc))
+    where pc = sPlatformConstants (settings dflags)
+
+rEP_StgEntCounter_allocs :: DynFlags -> CmmType
+rEP_StgEntCounter_allocs dflags
+    = cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocs pc))
+    where pc = sPlatformConstants (settings dflags)
+
+rEP_StgEntCounter_allocd :: DynFlags -> CmmType
+rEP_StgEntCounter_allocd dflags
+    = cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocd pc))
+    where pc = sPlatformConstants (settings dflags)
+
 -------------------------------------------------------------------------
 {-      Note [Signed vs unsigned]
         ~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -316,7 +432,7 @@ Cons:
 
 Currently for GHC, the foreign call point is moot, because we do our
 own promotion of sub-word-sized values to word-sized values.  The Int8
-type is represnted by an Int# which is kept sign-extended at all times
+type is represented by an Int# which is kept sign-extended at all times
 (this is slightly naughty, because we're making assumptions about the
 C calling convention rather early on in the compiler).  However, given
 this, the cons outweigh the pros.