-----------------------------------------------------------------------------
--
-- Argument representations used in GHC.StgToCmm.Layout.
--
-- (c) The University of Glasgow 2013
--
-----------------------------------------------------------------------------

{-# LANGUAGE LambdaCase #-}

module GHC.StgToCmm.ArgRep (
        ArgRep(..), toArgRep, argRepSizeW,

        argRepString, isNonV, idArgRep,

        slowCallPattern,

        ) where

import GHC.Prelude
import GHC.Platform

import GHC.StgToCmm.Closure    ( idPrimRep )
import GHC.Runtime.Heap.Layout ( WordOff )
import GHC.Types.Id            ( Id )
import GHC.Core.TyCon          ( PrimRep(..), primElemRepSizeB )
import GHC.Types.Basic         ( RepArity )
import GHC.Settings.Constants  ( wORD64_SIZE, dOUBLE_SIZE )

import GHC.Utils.Outputable
import GHC.Data.FastString

-- I extricated this code as this new module in order to avoid a
-- cyclic dependency between GHC.StgToCmm.Layout and GHC.StgToCmm.Ticky.
--
-- NSF 18 Feb 2013

-------------------------------------------------------------------------
--      Classifying arguments: ArgRep
-------------------------------------------------------------------------

-- ArgRep is re-exported by GHC.StgToCmm.Layout, but only for use in the
-- byte-code generator which also needs to know about the
-- classification of arguments.

data ArgRep = P   -- GC Ptr
            | N   -- Word-sized non-ptr
            | L   -- 64-bit non-ptr (long)
            | V   -- Void
            | F   -- Float
            | D   -- Double
            | V16 -- 16-byte (128-bit) vectors of Float/Double/Int8/Word32/etc.
            | V32 -- 32-byte (256-bit) vectors of Float/Double/Int8/Word32/etc.
            | V64 -- 64-byte (512-bit) vectors of Float/Double/Int8/Word32/etc.
            deriving ArgRep -> ArgRep -> Bool
(ArgRep -> ArgRep -> Bool)
-> (ArgRep -> ArgRep -> Bool) -> Eq ArgRep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArgRep -> ArgRep -> Bool
== :: ArgRep -> ArgRep -> Bool
$c/= :: ArgRep -> ArgRep -> Bool
/= :: ArgRep -> ArgRep -> Bool
Eq
instance Outputable ArgRep where ppr :: ArgRep -> SDoc
ppr = String -> SDoc
text (String -> SDoc) -> (ArgRep -> String) -> ArgRep -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArgRep -> String
argRepString

argRepString :: ArgRep -> String
argRepString :: ArgRep -> String
argRepString ArgRep
P = String
"P"
argRepString ArgRep
N = String
"N"
argRepString ArgRep
L = String
"L"
argRepString ArgRep
V = String
"V"
argRepString ArgRep
F = String
"F"
argRepString ArgRep
D = String
"D"
argRepString ArgRep
V16 = String
"V16"
argRepString ArgRep
V32 = String
"V32"
argRepString ArgRep
V64 = String
"V64"

toArgRep :: Platform -> PrimRep -> ArgRep
toArgRep :: Platform -> PrimRep -> ArgRep
toArgRep Platform
platform PrimRep
rep = case PrimRep
rep of
   PrimRep
VoidRep           -> ArgRep
V
   PrimRep
LiftedRep         -> ArgRep
P
   PrimRep
UnliftedRep       -> ArgRep
P
   PrimRep
IntRep            -> ArgRep
N
   PrimRep
WordRep           -> ArgRep
N
   PrimRep
Int8Rep           -> ArgRep
N  -- Gets widened to native word width for calls
   PrimRep
Word8Rep          -> ArgRep
N  -- Gets widened to native word width for calls
   PrimRep
Int16Rep          -> ArgRep
N  -- Gets widened to native word width for calls
   PrimRep
Word16Rep         -> ArgRep
N  -- Gets widened to native word width for calls
   PrimRep
Int32Rep          -> ArgRep
N  -- Gets widened to native word width for calls
   PrimRep
Word32Rep         -> ArgRep
N  -- Gets widened to native word width for calls
   PrimRep
AddrRep           -> ArgRep
N
   PrimRep
Int64Rep          -> case Platform -> PlatformWordSize
platformWordSize Platform
platform of
                           PlatformWordSize
PW4 -> ArgRep
L
                           PlatformWordSize
PW8 -> ArgRep
N
   PrimRep
Word64Rep         -> case Platform -> PlatformWordSize
platformWordSize Platform
platform of
                           PlatformWordSize
PW4 -> ArgRep
L
                           PlatformWordSize
PW8 -> ArgRep
N
   PrimRep
FloatRep          -> ArgRep
F
   PrimRep
DoubleRep         -> ArgRep
D
   (VecRep WordOff
len PrimElemRep
elem) -> case WordOff
lenWordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
*Platform -> PrimElemRep -> WordOff
primElemRepSizeB Platform
platform PrimElemRep
elem of
                           WordOff
16 -> ArgRep
V16
                           WordOff
32 -> ArgRep
V32
                           WordOff
64 -> ArgRep
V64
                           WordOff
_  -> String -> ArgRep
forall a. HasCallStack => String -> a
error String
"toArgRep: bad vector primrep"

isNonV :: ArgRep -> Bool
isNonV :: ArgRep -> Bool
isNonV ArgRep
V = Bool
False
isNonV ArgRep
_ = Bool
True

argRepSizeW :: Platform -> ArgRep -> WordOff -- Size in words
argRepSizeW :: Platform -> ArgRep -> WordOff
argRepSizeW Platform
platform = \case
   ArgRep
N   -> WordOff
1
   ArgRep
P   -> WordOff
1
   ArgRep
F   -> WordOff
1
   ArgRep
L   -> WordOff
wORD64_SIZE WordOff -> WordOff -> WordOff
forall a. Integral a => a -> a -> a
`quot` WordOff
ws
   ArgRep
D   -> WordOff
dOUBLE_SIZE WordOff -> WordOff -> WordOff
forall a. Integral a => a -> a -> a
`quot` WordOff
ws
   ArgRep
V   -> WordOff
0
   ArgRep
V16 -> WordOff
16          WordOff -> WordOff -> WordOff
forall a. Integral a => a -> a -> a
`quot` WordOff
ws
   ArgRep
V32 -> WordOff
32          WordOff -> WordOff -> WordOff
forall a. Integral a => a -> a -> a
`quot` WordOff
ws
   ArgRep
V64 -> WordOff
64          WordOff -> WordOff -> WordOff
forall a. Integral a => a -> a -> a
`quot` WordOff
ws
  where
   ws :: WordOff
ws       = Platform -> WordOff
platformWordSizeInBytes Platform
platform

idArgRep :: Platform -> Id -> ArgRep
idArgRep :: Platform -> Id -> ArgRep
idArgRep Platform
platform = Platform -> PrimRep -> ArgRep
toArgRep Platform
platform (PrimRep -> ArgRep) -> (Id -> PrimRep) -> Id -> ArgRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> PrimRep
idPrimRep

-- This list of argument patterns should be kept in sync with at least
-- the following:
--
--  * GHC.StgToCmm.Layout.stdPattern maybe to some degree?
--
--  * the RTS_RET(stg_ap_*) and RTS_FUN_DECL(stg_ap_*_fast)
--  declarations in rts/include/stg/MiscClosures.h
--
--  * the SLOW_CALL_*_ctr declarations in rts/include/stg/Ticky.h,
--
--  * the TICK_SLOW_CALL_*() #defines in rts/include/Cmm.h,
--
--  * the PR_CTR(SLOW_CALL_*_ctr) calls in rts/Ticky.c,
--
--  * and the SymI_HasProto(stg_ap_*_{ret,info,fast}) calls and
--  SymI_HasProto(SLOW_CALL_*_ctr) calls in rts/Linker.c
--
-- There may be more places that I haven't found; I merely igrep'd for
-- pppppp and excluded things that seemed ghci-specific.
--
-- Also, it seems at the moment that ticky counters with void
-- arguments will never be bumped, but I'm still declaring those
-- counters, defensively.
--
-- NSF 6 Mar 2013

slowCallPattern :: [ArgRep] -> (FastString, RepArity)
-- Returns the generic apply function and arity
--
-- The first batch of cases match (some) specialised entries
-- The last group deals exhaustively with the cases for the first argument
--   (and the zero-argument case)
--
-- In 99% of cases this function will match *all* the arguments in one batch

slowCallPattern :: [ArgRep] -> (FastString, WordOff)
slowCallPattern (ArgRep
P: ArgRep
P: ArgRep
P: ArgRep
P: ArgRep
P: ArgRep
P: [ArgRep]
_) = (String -> FastString
fsLit String
"stg_ap_pppppp", WordOff
6)
slowCallPattern (ArgRep
P: ArgRep
P: ArgRep
P: ArgRep
P: ArgRep
P: [ArgRep]
_)    = (String -> FastString
fsLit String
"stg_ap_ppppp", WordOff
5)
slowCallPattern (ArgRep
P: ArgRep
P: ArgRep
P: ArgRep
P: [ArgRep]
_)       = (String -> FastString
fsLit String
"stg_ap_pppp", WordOff
4)
slowCallPattern (ArgRep
P: ArgRep
P: ArgRep
P: ArgRep
V: [ArgRep]
_)       = (String -> FastString
fsLit String
"stg_ap_pppv", WordOff
4)
slowCallPattern (ArgRep
P: ArgRep
P: ArgRep
P: [ArgRep]
_)          = (String -> FastString
fsLit String
"stg_ap_ppp", WordOff
3)
slowCallPattern (ArgRep
P: ArgRep
P: ArgRep
V: [ArgRep]
_)          = (String -> FastString
fsLit String
"stg_ap_ppv", WordOff
3)
slowCallPattern (ArgRep
P: ArgRep
P: [ArgRep]
_)             = (String -> FastString
fsLit String
"stg_ap_pp", WordOff
2)
slowCallPattern (ArgRep
P: ArgRep
V: [ArgRep]
_)             = (String -> FastString
fsLit String
"stg_ap_pv", WordOff
2)
slowCallPattern (ArgRep
P: [ArgRep]
_)                = (String -> FastString
fsLit String
"stg_ap_p", WordOff
1)
slowCallPattern (ArgRep
V: [ArgRep]
_)                = (String -> FastString
fsLit String
"stg_ap_v", WordOff
1)
slowCallPattern (ArgRep
N: [ArgRep]
_)                = (String -> FastString
fsLit String
"stg_ap_n", WordOff
1)
slowCallPattern (ArgRep
F: [ArgRep]
_)                = (String -> FastString
fsLit String
"stg_ap_f", WordOff
1)
slowCallPattern (ArgRep
D: [ArgRep]
_)                = (String -> FastString
fsLit String
"stg_ap_d", WordOff
1)
slowCallPattern (ArgRep
L: [ArgRep]
_)                = (String -> FastString
fsLit String
"stg_ap_l", WordOff
1)
slowCallPattern (ArgRep
V16: [ArgRep]
_)              = (String -> FastString
fsLit String
"stg_ap_v16", WordOff
1)
slowCallPattern (ArgRep
V32: [ArgRep]
_)              = (String -> FastString
fsLit String
"stg_ap_v32", WordOff
1)
slowCallPattern (ArgRep
V64: [ArgRep]
_)              = (String -> FastString
fsLit String
"stg_ap_v64", WordOff
1)
slowCallPattern []                    = (String -> FastString
fsLit String
"stg_ap_0", WordOff
0)