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