1-----------------------------------------------------------------------------
2--
3-- Argument representations used in GHC.StgToCmm.Layout.
4--
5-- (c) The University of Glasgow 2013
6--
7-----------------------------------------------------------------------------
8
9module GHC.StgToCmm.ArgRep (
10        ArgRep(..), toArgRep, argRepSizeW,
11
12        argRepString, isNonV, idArgRep,
13
14        slowCallPattern,
15
16        ) where
17
18import GhcPrelude
19
20import GHC.StgToCmm.Closure ( idPrimRep )
21
22import SMRep            ( WordOff )
23import Id               ( Id )
24import TyCon            ( PrimRep(..), primElemRepSizeB )
25import BasicTypes       ( RepArity )
26import Constants        ( wORD64_SIZE )
27import DynFlags
28
29import Outputable
30import FastString
31
32-- I extricated this code as this new module in order to avoid a
33-- cyclic dependency between GHC.StgToCmm.Layout and GHC.StgToCmm.Ticky.
34--
35-- NSF 18 Feb 2013
36
37-------------------------------------------------------------------------
38--      Classifying arguments: ArgRep
39-------------------------------------------------------------------------
40
41-- ArgRep is re-exported by GHC.StgToCmm.Layout, but only for use in the
42-- byte-code generator which also needs to know about the
43-- classification of arguments.
44
45data ArgRep = P   -- GC Ptr
46            | N   -- Word-sized non-ptr
47            | L   -- 64-bit non-ptr (long)
48            | V   -- Void
49            | F   -- Float
50            | D   -- Double
51            | V16 -- 16-byte (128-bit) vectors of Float/Double/Int8/Word32/etc.
52            | V32 -- 32-byte (256-bit) vectors of Float/Double/Int8/Word32/etc.
53            | V64 -- 64-byte (512-bit) vectors of Float/Double/Int8/Word32/etc.
54instance Outputable ArgRep where ppr = text . argRepString
55
56argRepString :: ArgRep -> String
57argRepString P = "P"
58argRepString N = "N"
59argRepString L = "L"
60argRepString V = "V"
61argRepString F = "F"
62argRepString D = "D"
63argRepString V16 = "V16"
64argRepString V32 = "V32"
65argRepString V64 = "V64"
66
67toArgRep :: PrimRep -> ArgRep
68toArgRep VoidRep           = V
69toArgRep LiftedRep         = P
70toArgRep UnliftedRep       = P
71toArgRep IntRep            = N
72toArgRep WordRep           = N
73toArgRep Int8Rep           = N  -- Gets widened to native word width for calls
74toArgRep Word8Rep          = N  -- Gets widened to native word width for calls
75toArgRep Int16Rep          = N  -- Gets widened to native word width for calls
76toArgRep Word16Rep         = N  -- Gets widened to native word width for calls
77toArgRep Int32Rep          = N  -- Gets widened to native word width for calls
78toArgRep Word32Rep         = N  -- Gets widened to native word width for calls
79toArgRep AddrRep           = N
80toArgRep Int64Rep          = L
81toArgRep Word64Rep         = L
82toArgRep FloatRep          = F
83toArgRep DoubleRep         = D
84toArgRep (VecRep len elem) = case len*primElemRepSizeB elem of
85                               16 -> V16
86                               32 -> V32
87                               64 -> V64
88                               _  -> error "toArgRep: bad vector primrep"
89
90isNonV :: ArgRep -> Bool
91isNonV V = False
92isNonV _ = True
93
94argRepSizeW :: DynFlags -> ArgRep -> WordOff                -- Size in words
95argRepSizeW _      N   = 1
96argRepSizeW _      P   = 1
97argRepSizeW _      F   = 1
98argRepSizeW dflags L   = wORD64_SIZE        `quot` wORD_SIZE dflags
99argRepSizeW dflags D   = dOUBLE_SIZE dflags `quot` wORD_SIZE dflags
100argRepSizeW _      V   = 0
101argRepSizeW dflags V16 = 16                 `quot` wORD_SIZE dflags
102argRepSizeW dflags V32 = 32                 `quot` wORD_SIZE dflags
103argRepSizeW dflags V64 = 64                 `quot` wORD_SIZE dflags
104
105idArgRep :: Id -> ArgRep
106idArgRep = toArgRep . idPrimRep
107
108-- This list of argument patterns should be kept in sync with at least
109-- the following:
110--
111--  * GHC.StgToCmm.Layout.stdPattern maybe to some degree?
112--
113--  * the RTS_RET(stg_ap_*) and RTS_FUN_DECL(stg_ap_*_fast)
114--  declarations in includes/stg/MiscClosures.h
115--
116--  * the SLOW_CALL_*_ctr declarations in includes/stg/Ticky.h,
117--
118--  * the TICK_SLOW_CALL_*() #defines in includes/Cmm.h,
119--
120--  * the PR_CTR(SLOW_CALL_*_ctr) calls in rts/Ticky.c,
121--
122--  * and the SymI_HasProto(stg_ap_*_{ret,info,fast}) calls and
123--  SymI_HasProto(SLOW_CALL_*_ctr) calls in rts/Linker.c
124--
125-- There may be more places that I haven't found; I merely igrep'd for
126-- pppppp and excluded things that seemed ghci-specific.
127--
128-- Also, it seems at the moment that ticky counters with void
129-- arguments will never be bumped, but I'm still declaring those
130-- counters, defensively.
131--
132-- NSF 6 Mar 2013
133
134slowCallPattern :: [ArgRep] -> (FastString, RepArity)
135-- Returns the generic apply function and arity
136--
137-- The first batch of cases match (some) specialised entries
138-- The last group deals exhaustively with the cases for the first argument
139--   (and the zero-argument case)
140--
141-- In 99% of cases this function will match *all* the arguments in one batch
142
143slowCallPattern (P: P: P: P: P: P: _) = (fsLit "stg_ap_pppppp", 6)
144slowCallPattern (P: P: P: P: P: _)    = (fsLit "stg_ap_ppppp", 5)
145slowCallPattern (P: P: P: P: _)       = (fsLit "stg_ap_pppp", 4)
146slowCallPattern (P: P: P: V: _)       = (fsLit "stg_ap_pppv", 4)
147slowCallPattern (P: P: P: _)          = (fsLit "stg_ap_ppp", 3)
148slowCallPattern (P: P: V: _)          = (fsLit "stg_ap_ppv", 3)
149slowCallPattern (P: P: _)             = (fsLit "stg_ap_pp", 2)
150slowCallPattern (P: V: _)             = (fsLit "stg_ap_pv", 2)
151slowCallPattern (P: _)                = (fsLit "stg_ap_p", 1)
152slowCallPattern (V: _)                = (fsLit "stg_ap_v", 1)
153slowCallPattern (N: _)                = (fsLit "stg_ap_n", 1)
154slowCallPattern (F: _)                = (fsLit "stg_ap_f", 1)
155slowCallPattern (D: _)                = (fsLit "stg_ap_d", 1)
156slowCallPattern (L: _)                = (fsLit "stg_ap_l", 1)
157slowCallPattern (V16: _)              = (fsLit "stg_ap_v16", 1)
158slowCallPattern (V32: _)              = (fsLit "stg_ap_v32", 1)
159slowCallPattern (V64: _)              = (fsLit "stg_ap_v64", 1)
160slowCallPattern []                    = (fsLit "stg_ap_0", 0)
161