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.
10 #include "HsVersions.h"
13 CtrlReturnConvention(..), DataReturnConvention(..),
20 assignPrimOpResultRegs,
24 -- and to make the interface self-sufficient...
28 import AbsCLoop -- paranoia checking
30 import AbsCSyn -- quite a few things
31 import AbsCUtils ( mkAbstractCs, getAmodeRep,
34 import CgCompInfo ( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
35 mAX_Vanilla_REG, mAX_Float_REG,
38 import CmdLineOpts ( opt_ReturnInRegsThreshold )
39 import Id ( isDataCon, dataConSig,
40 DataCon(..), GenId{-instance Eq-}
42 import Maybes ( catMaybes )
43 import PprStyle ( PprStyle(..) )
44 import PprType ( TyCon{-instance Outputable-} )
45 import PrelInfo ( integerDataCon )
46 import PrimOp ( primOpCanTriggerGC,
47 getPrimOpResultInfo, PrimOpResultInfo(..),
48 PrimOp{-instance Outputable-}
50 import PrimRep ( isFloatingRep, PrimRep(..) )
51 import TyCon ( tyConDataCons, tyConFamilySize )
52 import Type ( typePrimRep )
53 import Util ( zipWithEqual, mapAccumL, isn'tIn,
54 pprError, pprTrace, panic, assertPanic
58 %************************************************************************
60 \subsection[CgRetConv-possibilities]{Data types that encode possible return conventions}
62 %************************************************************************
64 A @CtrlReturnConvention@ says how {\em control} is returned.
66 data CtrlReturnConvention
67 = VectoredReturn Int -- size of the vector table (family size)
68 | UnvectoredReturn Int -- family size
71 A @DataReturnConvention@ says how the data for a particular
72 data-constructor is returned.
74 data DataReturnConvention
76 | ReturnInRegs [MagicId]
78 The register assignment given by a @ReturnInRegs@ obeys three rules:
81 \item R2 points to the info table for the phantom constructor
82 \item The list of @MagicId@ is in the same order as the arguments
87 %************************************************************************
89 \subsection[CgRetConv-algebraic]{Return conventions for algebraic datatypes}
91 %************************************************************************
94 ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
96 ctrlReturnConvAlg tycon
97 = case (tyConFamilySize tycon) of
98 0 -> pprTrace "ctrlReturnConvAlg:" (ppr PprDebug tycon) $
99 UnvectoredReturn 0 -- e.g., w/ "data Bin"
101 size -> -- we're supposed to know...
102 if (size > (1::Int) && size <= mAX_FAMILY_SIZE_FOR_VEC_RETURNS) then
105 UnvectoredReturn size
108 @dataReturnConvAlg@ determines the return conventions from the
109 (possibly specialised) data constructor.
111 (See also @getDataConReturnConv@ (in @Id@).) We grab the types
112 of the data constructor's arguments. We feed them and a list of
113 available registers into @assign_reg@, which sequentially assigns
114 registers of the appropriate types to the arguments, based on the
115 types. If @assign_reg@ runs out of a particular kind of register,
116 then it gives up, returning @ReturnInHeap@.
119 dataReturnConvAlg :: DataCon -> DataReturnConvention
121 dataReturnConvAlg data_con
122 = ASSERT(isDataCon data_con)
123 case leftover_kinds of
124 [] -> ReturnInRegs reg_assignment
125 other -> ReturnInHeap -- Didn't fit in registers
127 (_, _, arg_tys, _) = dataConSig data_con
129 (reg_assignment, leftover_kinds)
130 = assignRegs [node, infoptr] -- taken...
131 (map typePrimRep arg_tys)
133 is_prim_result_ty = data_con == integerDataCon -- ***HACK***! (WDP 95/11)
136 %************************************************************************
138 \subsection[CgRetConv-prim]{Return conventions for primitive datatypes}
140 %************************************************************************
142 WARNING! If you add a return convention which can return a pointer,
143 make sure you alter CgCase (cgPrimDefault) to generate the right sort
146 dataReturnConvPrim :: PrimRep -> MagicId
148 dataReturnConvPrim IntRep = VanillaReg IntRep ILIT(1)
149 dataReturnConvPrim WordRep = VanillaReg WordRep ILIT(1)
150 dataReturnConvPrim AddrRep = VanillaReg AddrRep ILIT(1)
151 dataReturnConvPrim CharRep = VanillaReg CharRep ILIT(1)
152 dataReturnConvPrim FloatRep = FloatReg ILIT(1)
153 dataReturnConvPrim DoubleRep = DoubleReg ILIT(1)
154 dataReturnConvPrim VoidRep = VoidReg
156 -- Return a primitive-array pointer in the usual register:
157 dataReturnConvPrim ArrayRep = VanillaReg ArrayRep ILIT(1)
158 dataReturnConvPrim ByteArrayRep = VanillaReg ByteArrayRep ILIT(1)
160 dataReturnConvPrim StablePtrRep = VanillaReg StablePtrRep ILIT(1)
161 dataReturnConvPrim MallocPtrRep = VanillaReg MallocPtrRep ILIT(1)
164 dataReturnConvPrim PtrRep = panic "dataReturnConvPrim: PtrRep"
165 dataReturnConvPrim _ = panic "dataReturnConvPrim: other"
169 %********************************************************
171 \subsection[primop-stuff]{Argument and return conventions for Prim Ops}
173 %********************************************************
176 assignPrimOpResultRegs
177 :: PrimOp -- The constructors in canonical order
178 -> [MagicId] -- The return regs all concatenated to together,
179 -- (*including* one for the tag if necy)
181 assignPrimOpResultRegs op
182 = case (getPrimOpResultInfo op) of
184 ReturnsPrim kind -> [dataReturnConvPrim kind]
188 cons = tyConDataCons tycon
189 result_regs = concat (map get_return_regs cons)
191 -- As R1 is dead, it can hold the tag if necessary
194 other -> (VanillaReg IntRep ILIT(1)) : result_regs
197 = case (dataReturnConvAlg con) of
198 ReturnInRegs regs -> regs
199 ReturnInHeap -> panic "getPrimOpAlgResultRegs"
202 @assignPrimOpArgsRobust@ is used only for primitive ops which may
203 trigger GC. [MAYBE (WDP 94/05)] For these, we pass all (nonRobust)
204 arguments in registers. This function assigns them and tells us which
205 of those registers are now live (because we've shoved a followable
208 Bug: it is assumed that robust amodes cannot contain pointers. This
209 seems reasonable but isn't true. For example, \tr{Array#}'s
210 \tr{MallocPtr#}'s are pointers. (This is only known to bite on
211 \tr{_ccall_GC_} with a MallocPtr argument.)
213 See after for some ADR comments...
218 -> [CAddrMode] -- Arguments
219 -> ([CAddrMode], -- Arg registers
220 Int, -- Liveness mask
221 AbstractC) -- Simultaneous assignments to assign args to regs
223 makePrimOpArgsRobust op arg_amodes
224 = ASSERT (primOpCanTriggerGC op)
226 non_robust_amodes = filter (not . amodeCanSurviveGC) arg_amodes
227 arg_kinds = map getAmodeRep non_robust_amodes
229 (arg_regs, extra_args)
230 = assignRegs [{-nothing live-}] arg_kinds
232 -- Check that all the args fit before returning arg_regs
233 final_arg_regs = case extra_args of
235 other -> pprError "Cannot allocate enough registers for primop (try rearranging code or reducing number of arguments?)" (ppr PprDebug op)
238 = mkAbstractCs (zipWithEqual "assign_to_reg" assign_to_reg final_arg_regs non_robust_amodes)
240 assign_to_reg reg_id amode = CAssign (CReg reg_id) amode
243 | amodeCanSurviveGC arg = (regs, arg)
244 | otherwise = (tail regs, CReg (head regs))
245 safe_amodes = snd (mapAccumL safe_arg final_arg_regs arg_amodes)
247 liveness_mask = mkLiveRegsMask final_arg_regs
249 (safe_amodes, liveness_mask, arg_assts)
252 %************************************************************************
254 \subsubsection[CgRetConv-regs]{Register assignment}
256 %************************************************************************
258 How to assign registers.
259 Registers are assigned in order.
261 If we run out, we don't attempt to assign
262 any further registers (even though we might have run out of only one kind of
263 register); we just return immediately with the left-overs specified.
266 assignRegs :: [MagicId] -- Unavailable registers
267 -> [PrimRep] -- Arg or result kinds to assign
268 -> ([MagicId], -- Register assignment in same order
269 -- for *initial segment of* input list
270 [PrimRep])-- leftover kinds
272 assignRegs regs_in_use kinds
273 = assign_reg kinds [] (mkRegTbl regs_in_use)
276 assign_reg :: [PrimRep] -- arg kinds being scrutinized
277 -> [MagicId] -- accum. regs assigned so far (reversed)
278 -> ([Int], [Int], [Int])
279 -- regs still avail: Vanilla, Float, Double
280 -> ([MagicId], [PrimRep])
282 assign_reg (VoidRep:ks) acc supply
283 = assign_reg ks (VoidReg:acc) supply -- one VoidReg is enough for everybody!
285 assign_reg (FloatRep:ks) acc (vanilla_rs, IBOX(f):float_rs, double_rs)
286 = assign_reg ks (FloatReg f:acc) (vanilla_rs, float_rs, double_rs)
288 assign_reg (DoubleRep:ks) acc (vanilla_rs, float_rs, IBOX(d):double_rs)
289 = assign_reg ks (DoubleReg d:acc) (vanilla_rs, float_rs, double_rs)
291 assign_reg (k:ks) acc (IBOX(v):vanilla_rs, float_rs, double_rs)
292 | not (isFloatingRep k)
293 = assign_reg ks (VanillaReg k v:acc) (vanilla_rs, float_rs, double_rs)
295 -- The catch-all. It can happen because either
296 -- (a) we've assigned all the regs so leftover_ks is []
297 -- (b) we couldn't find a spare register in the appropriate supply
299 -- (c) we came across a Kind we couldn't handle (this one shouldn't happen)
300 assign_reg leftover_ks acc _ = (reverse acc, leftover_ks)
303 Register supplies. Vanilla registers can contain pointers, Ints, Chars.
306 vanillaRegNos :: [Int]
307 vanillaRegNos = [1 .. mAX_Vanilla_REG]
310 Floats and doubles have separate register supplies.
313 floatRegNos, doubleRegNos :: [Int]
314 floatRegNos = [1 .. mAX_Float_REG]
315 doubleRegNos = [1 .. mAX_Double_REG]
317 mkRegTbl :: [MagicId] -> ([Int], [Int], [Int])
320 = (ok_vanilla, ok_float, ok_double)
322 ok_vanilla = catMaybes (map (select (VanillaReg VoidRep)) (taker vanillaRegNos))
323 ok_float = catMaybes (map (select FloatReg) floatRegNos)
324 ok_double = catMaybes (map (select DoubleReg) doubleRegNos)
326 taker :: [Int] -> [Int]
328 = case (opt_ReturnInRegsThreshold) of
329 Nothing -> rs -- no flag set; use all of them
332 select :: (FAST_INT -> MagicId) -> Int{-cand-} -> Maybe Int
333 -- one we've unboxed the Int, we make a MagicId
334 -- and see if it is already in use; if not, return its number.
336 select mk_reg_fun cand@IBOX(i)
340 if reg `not_elem` regs_in_use
344 not_elem = isn'tIn "mkRegTbl"