never executed always true always false
    1 module GHC.Cmm.Type
    2     ( CmmType   -- Abstract
    3     , b8, b16, b32, b64, b128, b256, b512, f32, f64, bWord, bHalfWord, gcWord
    4     , cInt
    5     , cmmBits, cmmFloat
    6     , typeWidth, cmmEqType, cmmEqType_ignoring_ptrhood
    7     , isFloatType, isGcPtrType, isBitsType
    8     , isWordAny, isWord32, isWord64
    9     , isFloat64, isFloat32
   10 
   11     , Width(..)
   12     , widthInBits, widthInBytes, widthInLog, widthFromBytes
   13     , wordWidth, halfWordWidth, cIntWidth
   14     , halfWordMask
   15     , narrowU, narrowS
   16     , rEP_CostCentreStack_mem_alloc
   17     , rEP_CostCentreStack_scc_count
   18     , rEP_StgEntCounter_allocs
   19     , rEP_StgEntCounter_allocd
   20 
   21     , ForeignHint(..)
   22 
   23     , Length
   24     , vec, vec2, vec4, vec8, vec16
   25     , vec2f64, vec2b64, vec4f32, vec4b32, vec8b16, vec16b8
   26     , cmmVec
   27     , vecLength, vecElemType
   28     , isVecType
   29    )
   30 where
   31 
   32 
   33 import GHC.Prelude
   34 
   35 import GHC.Platform
   36 import GHC.Utils.Outputable
   37 import GHC.Utils.Panic
   38 
   39 import Data.Word
   40 import Data.Int
   41 
   42 -----------------------------------------------------------------------------
   43 --              CmmType
   44 -----------------------------------------------------------------------------
   45 
   46   -- NOTE: CmmType is an abstract type, not exported from this
   47   --       module so you can easily change its representation
   48   --
   49   -- However Width is exported in a concrete way,
   50   -- and is used extensively in pattern-matching
   51 
   52 data CmmType    -- The important one!
   53   = CmmType CmmCat !Width
   54   deriving Show
   55 
   56 data CmmCat                -- "Category" (not exported)
   57    = GcPtrCat              -- GC pointer
   58    | BitsCat               -- Non-pointer
   59    | FloatCat              -- Float
   60    | VecCat Length CmmCat  -- Vector
   61    deriving( Eq, Show )
   62         -- See Note [Signed vs unsigned] at the end
   63 
   64 instance Outputable CmmType where
   65   ppr (CmmType cat wid) = ppr cat <> ppr (widthInBits wid)
   66 
   67 instance Outputable CmmCat where
   68   ppr FloatCat       = text "F"
   69   ppr GcPtrCat       = text "P"
   70   ppr BitsCat        = text "I"
   71   ppr (VecCat n cat) = ppr cat <> text "x" <> ppr n <> text "V"
   72 
   73 -- Why is CmmType stratified?  For native code generation,
   74 -- most of the time you just want to know what sort of register
   75 -- to put the thing in, and for this you need to know how
   76 -- many bits thing has, and whether it goes in a floating-point
   77 -- register.  By contrast, the distinction between GcPtr and
   78 -- GcNonPtr is of interest to only a few parts of the code generator.
   79 
   80 -------- Equality on CmmType --------------
   81 -- CmmType is *not* an instance of Eq; sometimes we care about the
   82 -- Gc/NonGc distinction, and sometimes we don't
   83 -- So we use an explicit function to force you to think about it
   84 cmmEqType :: CmmType -> CmmType -> Bool -- Exact equality
   85 cmmEqType (CmmType c1 w1) (CmmType c2 w2) = c1==c2 && w1==w2
   86 
   87 cmmEqType_ignoring_ptrhood :: CmmType -> CmmType -> Bool
   88   -- This equality is temporary; used in CmmLint
   89   -- but the RTS files are not yet well-typed wrt pointers
   90 cmmEqType_ignoring_ptrhood (CmmType c1 w1) (CmmType c2 w2)
   91    = c1 `weak_eq` c2 && w1==w2
   92    where
   93      weak_eq :: CmmCat -> CmmCat -> Bool
   94      FloatCat         `weak_eq` FloatCat         = True
   95      FloatCat         `weak_eq` _other           = False
   96      _other           `weak_eq` FloatCat         = False
   97      (VecCat l1 cat1) `weak_eq` (VecCat l2 cat2) = l1 == l2
   98                                                    && cat1 `weak_eq` cat2
   99      (VecCat {})      `weak_eq` _other           = False
  100      _other           `weak_eq` (VecCat {})      = False
  101      _word1           `weak_eq` _word2           = True        -- Ignores GcPtr
  102 
  103 --- Simple operations on CmmType -----
  104 typeWidth :: CmmType -> Width
  105 typeWidth (CmmType _ w) = w
  106 
  107 cmmBits, cmmFloat :: Width -> CmmType
  108 cmmBits  = CmmType BitsCat
  109 cmmFloat = CmmType FloatCat
  110 
  111 -------- Common CmmTypes ------------
  112 -- Floats and words of specific widths
  113 b8, b16, b32, b64, b128, b256, b512, f32, f64 :: CmmType
  114 b8     = cmmBits W8
  115 b16    = cmmBits W16
  116 b32    = cmmBits W32
  117 b64    = cmmBits W64
  118 b128   = cmmBits W128
  119 b256   = cmmBits W256
  120 b512   = cmmBits W512
  121 f32    = cmmFloat W32
  122 f64    = cmmFloat W64
  123 
  124 -- CmmTypes of native word widths
  125 bWord :: Platform -> CmmType
  126 bWord platform = cmmBits (wordWidth platform)
  127 
  128 bHalfWord :: Platform -> CmmType
  129 bHalfWord platform = cmmBits (halfWordWidth platform)
  130 
  131 gcWord :: Platform -> CmmType
  132 gcWord platform = CmmType GcPtrCat (wordWidth platform)
  133 
  134 cInt :: Platform -> CmmType
  135 cInt platform = cmmBits (cIntWidth platform)
  136 
  137 ------------ Predicates ----------------
  138 isFloatType, isGcPtrType, isBitsType :: CmmType -> Bool
  139 isFloatType (CmmType FloatCat    _) = True
  140 isFloatType _other                  = False
  141 
  142 isGcPtrType (CmmType GcPtrCat _) = True
  143 isGcPtrType _other               = False
  144 
  145 isBitsType (CmmType BitsCat _) = True
  146 isBitsType _                   = False
  147 
  148 isWordAny, isWord32, isWord64,
  149   isFloat32, isFloat64 :: CmmType -> Bool
  150 -- isWord64 is true of 64-bit non-floats (both gc-ptrs and otherwise)
  151 -- isFloat32 and 64 are obvious
  152 
  153 isWordAny (CmmType BitsCat  _) = True
  154 isWordAny (CmmType GcPtrCat _) = True
  155 isWordAny _other               = False
  156 
  157 isWord64 (CmmType BitsCat  W64) = True
  158 isWord64 (CmmType GcPtrCat W64) = True
  159 isWord64 _other                 = False
  160 
  161 isWord32 (CmmType BitsCat  W32) = True
  162 isWord32 (CmmType GcPtrCat W32) = True
  163 isWord32 _other                 = False
  164 
  165 isFloat32 (CmmType FloatCat W32) = True
  166 isFloat32 _other                 = False
  167 
  168 isFloat64 (CmmType FloatCat W64) = True
  169 isFloat64 _other                 = False
  170 
  171 -----------------------------------------------------------------------------
  172 --              Width
  173 -----------------------------------------------------------------------------
  174 
  175 data Width
  176   = W8
  177   | W16
  178   | W32
  179   | W64
  180   | W128
  181   | W256
  182   | W512
  183   deriving (Eq, Ord, Show)
  184 
  185 instance Outputable Width where
  186    ppr rep = text (show rep)
  187 
  188 -------- Common Widths  ------------
  189 wordWidth :: Platform -> Width
  190 wordWidth platform = case platformWordSize platform of
  191  PW4 -> W32
  192  PW8 -> W64
  193 
  194 halfWordWidth :: Platform -> Width
  195 halfWordWidth platform = case platformWordSize platform of
  196  PW4 -> W16
  197  PW8 -> W32
  198 
  199 halfWordMask :: Platform -> Integer
  200 halfWordMask platform = case platformWordSize platform of
  201  PW4 -> 0xFFFF
  202  PW8 -> 0xFFFFFFFF
  203 
  204 -- cIntRep is the Width for a C-language 'int'
  205 cIntWidth :: Platform -> Width
  206 cIntWidth platform = case pc_CINT_SIZE (platformConstants platform) of
  207                    4 -> W32
  208                    8 -> W64
  209                    s -> panic ("cIntWidth: Unknown cINT_SIZE: " ++ show s)
  210 
  211 widthInBits :: Width -> Int
  212 widthInBits W8   = 8
  213 widthInBits W16  = 16
  214 widthInBits W32  = 32
  215 widthInBits W64  = 64
  216 widthInBits W128 = 128
  217 widthInBits W256 = 256
  218 widthInBits W512 = 512
  219 
  220 
  221 widthInBytes :: Width -> Int
  222 widthInBytes W8   = 1
  223 widthInBytes W16  = 2
  224 widthInBytes W32  = 4
  225 widthInBytes W64  = 8
  226 widthInBytes W128 = 16
  227 widthInBytes W256 = 32
  228 widthInBytes W512 = 64
  229 
  230 
  231 widthFromBytes :: Int -> Width
  232 widthFromBytes 1  = W8
  233 widthFromBytes 2  = W16
  234 widthFromBytes 4  = W32
  235 widthFromBytes 8  = W64
  236 widthFromBytes 16 = W128
  237 widthFromBytes 32 = W256
  238 widthFromBytes 64 = W512
  239 
  240 widthFromBytes n  = pprPanic "no width for given number of bytes" (ppr n)
  241 
  242 -- log_2 of the width in bytes, useful for generating shifts.
  243 widthInLog :: Width -> Int
  244 widthInLog W8   = 0
  245 widthInLog W16  = 1
  246 widthInLog W32  = 2
  247 widthInLog W64  = 3
  248 widthInLog W128 = 4
  249 widthInLog W256 = 5
  250 widthInLog W512 = 6
  251 
  252 
  253 -- widening / narrowing
  254 
  255 narrowU :: Width -> Integer -> Integer
  256 narrowU W8  x = fromIntegral (fromIntegral x :: Word8)
  257 narrowU W16 x = fromIntegral (fromIntegral x :: Word16)
  258 narrowU W32 x = fromIntegral (fromIntegral x :: Word32)
  259 narrowU W64 x = fromIntegral (fromIntegral x :: Word64)
  260 narrowU _ _ = panic "narrowTo"
  261 
  262 narrowS :: Width -> Integer -> Integer
  263 narrowS W8  x = fromIntegral (fromIntegral x :: Int8)
  264 narrowS W16 x = fromIntegral (fromIntegral x :: Int16)
  265 narrowS W32 x = fromIntegral (fromIntegral x :: Int32)
  266 narrowS W64 x = fromIntegral (fromIntegral x :: Int64)
  267 narrowS _ _ = panic "narrowTo"
  268 
  269 -----------------------------------------------------------------------------
  270 --              SIMD
  271 -----------------------------------------------------------------------------
  272 
  273 type Length = Int
  274 
  275 vec :: Length -> CmmType -> CmmType
  276 vec l (CmmType cat w) = CmmType (VecCat l cat) vecw
  277   where
  278     vecw :: Width
  279     vecw = widthFromBytes (l*widthInBytes w)
  280 
  281 vec2, vec4, vec8, vec16 :: CmmType -> CmmType
  282 vec2  = vec 2
  283 vec4  = vec 4
  284 vec8  = vec 8
  285 vec16 = vec 16
  286 
  287 vec2f64, vec2b64, vec4f32, vec4b32, vec8b16, vec16b8 :: CmmType
  288 vec2f64 = vec 2 f64
  289 vec2b64 = vec 2 b64
  290 vec4f32 = vec 4 f32
  291 vec4b32 = vec 4 b32
  292 vec8b16 = vec 8 b16
  293 vec16b8 = vec 16 b8
  294 
  295 cmmVec :: Int -> CmmType -> CmmType
  296 cmmVec n (CmmType cat w) =
  297     CmmType (VecCat n cat) (widthFromBytes (n*widthInBytes w))
  298 
  299 vecLength :: CmmType -> Length
  300 vecLength (CmmType (VecCat l _) _) = l
  301 vecLength _                        = panic "vecLength: not a vector"
  302 
  303 vecElemType :: CmmType -> CmmType
  304 vecElemType (CmmType (VecCat l cat) w) = CmmType cat scalw
  305   where
  306     scalw :: Width
  307     scalw = widthFromBytes (widthInBytes w `div` l)
  308 vecElemType _ = panic "vecElemType: not a vector"
  309 
  310 isVecType :: CmmType -> Bool
  311 isVecType (CmmType (VecCat {}) _) = True
  312 isVecType _                       = False
  313 
  314 -------------------------------------------------------------------------
  315 -- Hints
  316 
  317 -- Hints are extra type information we attach to the arguments and
  318 -- results of a foreign call, where more type information is sometimes
  319 -- needed by the ABI to make the correct kind of call.
  320 --
  321 -- See Note [Signed vs unsigned] for one case where this is used.
  322 
  323 data ForeignHint
  324   = NoHint | AddrHint | SignedHint
  325   deriving( Eq )
  326         -- Used to give extra per-argument or per-result
  327         -- information needed by foreign calling conventions
  328 
  329 -------------------------------------------------------------------------
  330 
  331 -- These don't really belong here, but I don't know where is best to
  332 -- put them.
  333 
  334 rEP_CostCentreStack_mem_alloc :: Platform -> CmmType
  335 rEP_CostCentreStack_mem_alloc platform
  336     = cmmBits (widthFromBytes (pc_REP_CostCentreStack_mem_alloc pc))
  337     where pc = platformConstants platform
  338 
  339 rEP_CostCentreStack_scc_count :: Platform -> CmmType
  340 rEP_CostCentreStack_scc_count platform
  341     = cmmBits (widthFromBytes (pc_REP_CostCentreStack_scc_count pc))
  342     where pc = platformConstants platform
  343 
  344 rEP_StgEntCounter_allocs :: Platform -> CmmType
  345 rEP_StgEntCounter_allocs platform
  346     = cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocs pc))
  347     where pc = platformConstants platform
  348 
  349 rEP_StgEntCounter_allocd :: Platform -> CmmType
  350 rEP_StgEntCounter_allocd platform
  351     = cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocd pc))
  352     where pc = platformConstants platform
  353 
  354 -------------------------------------------------------------------------
  355 {-      Note [Signed vs unsigned]
  356         ~~~~~~~~~~~~~~~~~~~~~~~~~
  357 Should a CmmType include a signed vs. unsigned distinction?
  358 
  359 This is very much like a "hint" in C-- terminology: it isn't necessary
  360 in order to generate correct code, but it might be useful in that the
  361 compiler can generate better code if it has access to higher-level
  362 hints about data.  This is important at call boundaries, because the
  363 definition of a function is not visible at all of its call sites, so
  364 the compiler cannot infer the hints.
  365 
  366 Here in Cmm, we're taking a slightly different approach.  We include
  367 the int vs. float hint in the CmmType, because (a) the majority of
  368 platforms have a strong distinction between float and int registers,
  369 and (b) we don't want to do any heavyweight hint-inference in the
  370 native code backend in order to get good code.  We're treating the
  371 hint more like a type: our Cmm is always completely consistent with
  372 respect to hints.  All coercions between float and int are explicit.
  373 
  374 What about the signed vs. unsigned hint?  This information might be
  375 useful if we want to keep sub-word-sized values in word-size
  376 registers, which we must do if we only have word-sized registers.
  377 
  378 On such a system, there are two straightforward conventions for
  379 representing sub-word-sized values:
  380 
  381 (a) Leave the upper bits undefined.  Comparison operations must
  382     sign- or zero-extend both operands before comparing them,
  383     depending on whether the comparison is signed or unsigned.
  384 
  385 (b) Always keep the values sign- or zero-extended as appropriate.
  386     Arithmetic operations must narrow the result to the appropriate
  387     size.
  388 
  389 A clever compiler might not use either (a) or (b) exclusively, instead
  390 it would attempt to minimize the coercions by analysis: the same kind
  391 of analysis that propagates hints around.  In Cmm we don't want to
  392 have to do this, so we plump for having richer types and keeping the
  393 type information consistent.
  394 
  395 If signed/unsigned hints are missing from CmmType, then the only
  396 choice we have is (a), because we don't know whether the result of an
  397 operation should be sign- or zero-extended.
  398 
  399 Many architectures have extending load operations, which work well
  400 with (b).  To make use of them with (a), you need to know whether the
  401 value is going to be sign- or zero-extended by an enclosing comparison
  402 (for example), which involves knowing above the context.  This is
  403 doable but more complex.
  404 
  405 Further complicating the issue is foreign calls: a foreign calling
  406 convention can specify that signed 8-bit quantities are passed as
  407 sign-extended 32 bit quantities, for example (this is the case on the
  408 PowerPC).  So we *do* need sign information on foreign call arguments.
  409 
  410 Pros for adding signed vs. unsigned to CmmType:
  411 
  412   - It would let us use convention (b) above, and get easier
  413     code generation for extending loads.
  414 
  415   - Less information required on foreign calls.
  416 
  417   - MachOp type would be simpler
  418 
  419 Cons:
  420 
  421   - More complexity
  422 
  423   - What is the CmmType for a VanillaReg?  Currently it is
  424     always wordRep, but now we have to decide whether it is
  425     signed or unsigned.  The same VanillaReg can thus have
  426     different CmmType in different parts of the program.
  427 
  428   - Extra coercions cluttering up expressions.
  429 
  430 Currently for GHC, the foreign call point is moot, because we do our
  431 own promotion of sub-word-sized values to word-sized values.  The Int8
  432 type is represented by an Int# which is kept sign-extended at all times
  433 (this is slightly naughty, because we're making assumptions about the
  434 C calling convention rather early on in the compiler).  However, given
  435 this, the cons outweigh the pros.
  436 
  437 -}