2 % (c) The GRASP Project, Glasgow University, 1992-1995
4 \section[CgRetConv]{Return conventions for the code generator}
6 The datatypes and functions here encapsulate what there is to know
7 about return conventions.
11 CtrlReturnConvention(..), DataReturnConvention(..),
18 assignPrimOpResultRegs,
23 #include "HsVersions.h"
25 import AbsCSyn -- quite a few things
26 import AbsCUtils ( mkAbstractCs, getAmodeRep,
29 import Constants ( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
30 mAX_Vanilla_REG, mAX_Float_REG,
33 import CmdLineOpts ( opt_ReturnInRegsThreshold )
34 import Id ( isDataCon, dataConRawArgTys,
35 DataCon, GenId{-instance Eq-},
38 import Maybes ( catMaybes )
39 import PprType ( TyCon{-instance Outputable-} )
40 import PrimOp ( primOpCanTriggerGC,
41 getPrimOpResultInfo, PrimOpResultInfo(..),
42 PrimOp{-instance Outputable-}
44 import PrimRep ( isFloatingRep, PrimRep(..) )
45 import TyCon ( tyConDataCons, tyConFamilySize )
46 import Type ( typePrimRep )
47 import Util ( zipWithEqual, mapAccumL, isn'tIn )
51 %************************************************************************
53 \subsection[CgRetConv-possibilities]{Data types that encode possible return conventions}
55 %************************************************************************
57 A @CtrlReturnConvention@ says how {\em control} is returned.
59 data CtrlReturnConvention
60 = VectoredReturn Int -- size of the vector table (family size)
61 | UnvectoredReturn Int -- family size
64 A @DataReturnConvention@ says how the data for a particular
65 data-constructor is returned.
67 data DataReturnConvention
69 | ReturnInRegs [MagicId]
71 The register assignment given by a @ReturnInRegs@ obeys three rules:
74 \item R2 points to the info table for the phantom constructor
75 \item The list of @MagicId@ is in the same order as the arguments
80 %************************************************************************
82 \subsection[CgRetConv-algebraic]{Return conventions for algebraic datatypes}
84 %************************************************************************
87 ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
89 ctrlReturnConvAlg tycon
90 = case (tyConFamilySize tycon) of
91 0 -> pprTrace "ctrlReturnConvAlg:" (ppr tycon) $
92 UnvectoredReturn 0 -- e.g., w/ "data Bin"
94 size -> -- we're supposed to know...
95 if (size > (1::Int) && size <= mAX_FAMILY_SIZE_FOR_VEC_RETURNS) then
101 @dataReturnConvAlg@ determines the return conventions from the
102 (possibly specialised) data constructor.
104 (See also @getDataConReturnConv@ (in @Id@).) We grab the types
105 of the data constructor's arguments. We feed them and a list of
106 available registers into @assign_reg@, which sequentially assigns
107 registers of the appropriate types to the arguments, based on the
108 types. If @assign_reg@ runs out of a particular kind of register,
109 then it gives up, returning @ReturnInHeap@.
112 dataReturnConvAlg :: DataCon -> DataReturnConvention
114 dataReturnConvAlg data_con
115 = ASSERT2(isDataCon data_con, (ppr data_con))
116 case leftover_kinds of
117 [] -> ReturnInRegs reg_assignment
118 other -> ReturnInHeap -- Didn't fit in registers
120 arg_tys = dataConRawArgTys data_con
122 (reg_assignment, leftover_kinds)
123 = assignRegs [node, infoptr] -- taken...
124 (map typePrimRep arg_tys)
127 %************************************************************************
129 \subsection[CgRetConv-prim]{Return conventions for primitive datatypes}
131 %************************************************************************
133 WARNING! If you add a return convention which can return a pointer,
134 make sure you alter CgCase (cgPrimDefault) to generate the right sort
137 dataReturnConvPrim :: PrimRep -> MagicId
139 dataReturnConvPrim IntRep = VanillaReg IntRep ILIT(1)
140 dataReturnConvPrim WordRep = VanillaReg WordRep ILIT(1)
141 dataReturnConvPrim AddrRep = VanillaReg AddrRep ILIT(1)
142 dataReturnConvPrim CharRep = VanillaReg CharRep ILIT(1)
143 dataReturnConvPrim FloatRep = FloatReg ILIT(1)
144 dataReturnConvPrim DoubleRep = DoubleReg ILIT(1)
145 dataReturnConvPrim VoidRep = VoidReg
147 -- Return a primitive-array pointer in the usual register:
148 dataReturnConvPrim ArrayRep = VanillaReg ArrayRep ILIT(1)
149 dataReturnConvPrim ByteArrayRep = VanillaReg ByteArrayRep ILIT(1)
151 dataReturnConvPrim StablePtrRep = VanillaReg StablePtrRep ILIT(1)
152 dataReturnConvPrim ForeignObjRep = VanillaReg ForeignObjRep ILIT(1)
155 dataReturnConvPrim PtrRep = panic "dataReturnConvPrim: PtrRep"
156 dataReturnConvPrim _ = panic "dataReturnConvPrim: other"
160 %********************************************************
162 \subsection[primop-stuff]{Argument and return conventions for Prim Ops}
164 %********************************************************
167 assignPrimOpResultRegs
168 :: PrimOp -- The constructors in canonical order
169 -> [MagicId] -- The return regs all concatenated to together,
170 -- (*including* one for the tag if necy)
172 assignPrimOpResultRegs op
173 = case (getPrimOpResultInfo op) of
175 ReturnsPrim kind -> [dataReturnConvPrim kind]
179 cons = tyConDataCons tycon
180 result_regs = concat (map get_return_regs cons)
182 -- As R1 is dead, it can hold the tag if necessary
185 other -> (VanillaReg IntRep ILIT(1)) : result_regs
188 = case (dataReturnConvAlg con) of
189 ReturnInRegs regs -> regs
190 ReturnInHeap -> panic "getPrimOpAlgResultRegs"
193 @assignPrimOpArgsRobust@ is used only for primitive ops which may
194 trigger GC. [MAYBE (WDP 94/05)] For these, we pass all (nonRobust)
195 arguments in registers. This function assigns them and tells us which
196 of those registers are now live (because we've shoved a followable
199 Bug: it is assumed that robust amodes cannot contain pointers. This
200 seems reasonable but isn't true. For example, \tr{Array#}'s
201 \tr{ForeignObj#}'s are pointers. (This is only known to bite on
202 \tr{_ccall_GC_} with a ForeignObj argument.)
204 See after for some ADR comments...
209 -> [CAddrMode] -- Arguments
210 -> ([CAddrMode], -- Arg registers
211 Int, -- Liveness mask
212 AbstractC) -- Simultaneous assignments to assign args to regs
214 makePrimOpArgsRobust op arg_amodes
215 = ASSERT (primOpCanTriggerGC op)
217 non_robust_amodes = filter (not . amodeCanSurviveGC) arg_amodes
218 arg_kinds = map getAmodeRep non_robust_amodes
220 (arg_regs, extra_args)
221 = assignRegs [{-nothing live-}] arg_kinds
223 -- Check that all the args fit before returning arg_regs
224 final_arg_regs = case extra_args of
226 other -> pprPanic "Cannot allocate enough registers for primop (try rearranging code or reducing number of arguments?)" (ppr op)
229 = mkAbstractCs (zipWithEqual "assign_to_reg" assign_to_reg final_arg_regs non_robust_amodes)
231 assign_to_reg reg_id amode = CAssign (CReg reg_id) amode
234 | amodeCanSurviveGC arg = (regs, arg)
235 | otherwise = (tail regs, CReg (head regs))
236 safe_amodes = snd (mapAccumL safe_arg final_arg_regs arg_amodes)
238 liveness_mask = mkLiveRegsMask final_arg_regs
240 (safe_amodes, liveness_mask, arg_assts)
243 %************************************************************************
245 \subsubsection[CgRetConv-regs]{Register assignment}
247 %************************************************************************
249 How to assign registers.
250 Registers are assigned in order.
252 If we run out, we don't attempt to assign
253 any further registers (even though we might have run out of only one kind of
254 register); we just return immediately with the left-overs specified.
257 assignRegs :: [MagicId] -- Unavailable registers
258 -> [PrimRep] -- Arg or result kinds to assign
259 -> ([MagicId], -- Register assignment in same order
260 -- for *initial segment of* input list
261 [PrimRep])-- leftover kinds
263 assignRegs regs_in_use kinds
264 = assign_reg kinds [] (mkRegTbl regs_in_use)
267 assign_reg :: [PrimRep] -- arg kinds being scrutinized
268 -> [MagicId] -- accum. regs assigned so far (reversed)
269 -> ([Int], [Int], [Int])
270 -- regs still avail: Vanilla, Float, Double
271 -> ([MagicId], [PrimRep])
273 assign_reg (VoidRep:ks) acc supply
274 = assign_reg ks (VoidReg:acc) supply -- one VoidReg is enough for everybody!
276 assign_reg (FloatRep:ks) acc (vanilla_rs, IBOX(f):float_rs, double_rs)
277 = assign_reg ks (FloatReg f:acc) (vanilla_rs, float_rs, double_rs)
279 assign_reg (DoubleRep:ks) acc (vanilla_rs, float_rs, IBOX(d):double_rs)
280 = assign_reg ks (DoubleReg d:acc) (vanilla_rs, float_rs, double_rs)
282 assign_reg (k:ks) acc (IBOX(v):vanilla_rs, float_rs, double_rs)
283 | not (isFloatingRep k)
284 = assign_reg ks (VanillaReg k v:acc) (vanilla_rs, float_rs, double_rs)
286 -- The catch-all. It can happen because either
287 -- (a) we've assigned all the regs so leftover_ks is []
288 -- (b) we couldn't find a spare register in the appropriate supply
290 -- (c) we came across a Kind we couldn't handle (this one shouldn't happen)
291 assign_reg leftover_ks acc _ = (reverse acc, leftover_ks)
294 Register supplies. Vanilla registers can contain pointers, Ints, Chars.
297 vanillaRegNos :: [Int]
298 vanillaRegNos = [1 .. mAX_Vanilla_REG]
301 Floats and doubles have separate register supplies.
304 floatRegNos, doubleRegNos :: [Int]
305 floatRegNos = [1 .. mAX_Float_REG]
306 doubleRegNos = [1 .. mAX_Double_REG]
308 mkRegTbl :: [MagicId] -> ([Int], [Int], [Int])
311 = (ok_vanilla, ok_float, ok_double)
313 ok_vanilla = catMaybes (map (select (VanillaReg VoidRep)) (taker vanillaRegNos))
314 ok_float = catMaybes (map (select FloatReg) floatRegNos)
315 ok_double = catMaybes (map (select DoubleReg) doubleRegNos)
317 taker :: [Int] -> [Int]
319 = case (opt_ReturnInRegsThreshold) of
320 Nothing -> rs -- no flag set; use all of them
323 select :: (FAST_INT -> MagicId) -> Int{-cand-} -> Maybe Int
324 -- one we've unboxed the Int, we make a MagicId
325 -- and see if it is already in use; if not, return its number.
327 select mk_reg_fun cand@IBOX(i)
331 if reg `not_elem` regs_in_use
335 not_elem = isn'tIn "mkRegTbl"