-----------------------------------------------------------------------------
--
-- Argument representations used in StgCmmLayout.
--
-- (c) The University of Glasgow 2013
--
-----------------------------------------------------------------------------

module StgCmmArgRep (
        ArgRep(..), toArgRep, argRepSizeW,

        argRepString, isNonV, idArgRep,

        slowCallPattern,

        ) where

import GhcPrelude

import StgCmmClosure    ( idPrimRep )

import SMRep            ( WordOff )
import Id               ( Id )
import TyCon            ( PrimRep(..), primElemRepSizeB )
import BasicTypes       ( RepArity )
import Constants        ( wORD64_SIZE )
import DynFlags

import Outputable
import FastString

-- I extricated this code as this new module in order to avoid a
-- cyclic dependency between StgCmmLayout and StgCmmTicky.
--
-- NSF 18 Feb 2013

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

-- ArgRep is re-exported by StgCmmLayout, 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.
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 P = "P"
argRepString N = "N"
argRepString L = "L"
argRepString V = "V"
argRepString F = "F"
argRepString D = "D"
argRepString V16 = "V16"
argRepString V32 = "V32"
argRepString V64 = "V64"

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

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

argRepSizeW :: DynFlags -> ArgRep -> WordOff                -- Size in words
argRepSizeW :: DynFlags -> ArgRep -> Int
argRepSizeW _      N   = 1
argRepSizeW _      P   = 1
argRepSizeW _      F   = 1
argRepSizeW dflags :: DynFlags
dflags L   = Int
wORD64_SIZE        Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` DynFlags -> Int
wORD_SIZE DynFlags
dflags
argRepSizeW dflags :: DynFlags
dflags D   = DynFlags -> Int
dOUBLE_SIZE DynFlags
dflags Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` DynFlags -> Int
wORD_SIZE DynFlags
dflags
argRepSizeW _      V   = 0
argRepSizeW dflags :: DynFlags
dflags V16 = 16                 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` DynFlags -> Int
wORD_SIZE DynFlags
dflags
argRepSizeW dflags :: DynFlags
dflags V32 = 32                 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` DynFlags -> Int
wORD_SIZE DynFlags
dflags
argRepSizeW dflags :: DynFlags
dflags V64 = 64                 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` DynFlags -> Int
wORD_SIZE DynFlags
dflags

idArgRep :: Id -> ArgRep
idArgRep :: Id -> ArgRep
idArgRep = PrimRep -> ArgRep
toArgRep (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:
--
--  * StgCmmLayout.stdPattern maybe to some degree?
--
--  * the RTS_RET(stg_ap_*) and RTS_FUN_DECL(stg_ap_*_fast)
--  declarations in includes/stg/MiscClosures.h
--
--  * the SLOW_CALL_*_ctr declarations in includes/stg/Ticky.h,
--
--  * the TICK_SLOW_CALL_*() #defines in includes/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, Int)
slowCallPattern (P: P: P: P: P: P: _) = (String -> FastString
fsLit "stg_ap_pppppp", 6)
slowCallPattern (P: P: P: P: P: _)    = (String -> FastString
fsLit "stg_ap_ppppp", 5)
slowCallPattern (P: P: P: P: _)       = (String -> FastString
fsLit "stg_ap_pppp", 4)
slowCallPattern (P: P: P: V: _)       = (String -> FastString
fsLit "stg_ap_pppv", 4)
slowCallPattern (P: P: P: _)          = (String -> FastString
fsLit "stg_ap_ppp", 3)
slowCallPattern (P: P: V: _)          = (String -> FastString
fsLit "stg_ap_ppv", 3)
slowCallPattern (P: P: _)             = (String -> FastString
fsLit "stg_ap_pp", 2)
slowCallPattern (P: V: _)             = (String -> FastString
fsLit "stg_ap_pv", 2)
slowCallPattern (P: _)                = (String -> FastString
fsLit "stg_ap_p", 1)
slowCallPattern (V: _)                = (String -> FastString
fsLit "stg_ap_v", 1)
slowCallPattern (N: _)                = (String -> FastString
fsLit "stg_ap_n", 1)
slowCallPattern (F: _)                = (String -> FastString
fsLit "stg_ap_f", 1)
slowCallPattern (D: _)                = (String -> FastString
fsLit "stg_ap_d", 1)
slowCallPattern (L: _)                = (String -> FastString
fsLit "stg_ap_l", 1)
slowCallPattern (V16: _)              = (String -> FastString
fsLit "stg_ap_v16", 1)
slowCallPattern (V32: _)              = (String -> FastString
fsLit "stg_ap_v32", 1)
slowCallPattern (V64: _)              = (String -> FastString
fsLit "stg_ap_v64", 1)
slowCallPattern []                    = (String -> FastString
fsLit "stg_ap_0", 0)