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,
26 IMPORT_DELOOPER(AbsCLoop) -- paranoia checking
28 import AbsCSyn -- quite a few things
29 import AbsCUtils ( mkAbstractCs, getAmodeRep,
32 import Constants ( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
33 mAX_Vanilla_REG, mAX_Float_REG,
36 import CmdLineOpts ( opt_ReturnInRegsThreshold )
37 import Id ( isDataCon, dataConRawArgTys,
38 SYN_IE(DataCon), GenId{-instance Eq-},
41 import Maybes ( catMaybes )
42 import Outputable ( PprStyle(..), Outputable(..) )
43 import PprType ( TyCon{-instance Outputable-} )
44 import PrimOp ( primOpCanTriggerGC,
45 getPrimOpResultInfo, PrimOpResultInfo(..),
46 PrimOp{-instance Outputable-}
48 import PrimRep ( isFloatingRep, PrimRep(..) )
49 import TyCon ( tyConDataCons, tyConFamilySize )
50 import Type ( typePrimRep )
52 import Util ( zipWithEqual, mapAccumL, isn'tIn,
53 pprError, pprTrace, panic, assertPanic, assertPprPanic
57 %************************************************************************
59 \subsection[CgRetConv-possibilities]{Data types that encode possible return conventions}
61 %************************************************************************
63 A @CtrlReturnConvention@ says how {\em control} is returned.
65 data CtrlReturnConvention
66 = VectoredReturn Int -- size of the vector table (family size)
67 | UnvectoredReturn Int -- family size
70 A @DataReturnConvention@ says how the data for a particular
71 data-constructor is returned.
73 data DataReturnConvention
75 | ReturnInRegs [MagicId]
77 The register assignment given by a @ReturnInRegs@ obeys three rules:
80 \item R2 points to the info table for the phantom constructor
81 \item The list of @MagicId@ is in the same order as the arguments
86 %************************************************************************
88 \subsection[CgRetConv-algebraic]{Return conventions for algebraic datatypes}
90 %************************************************************************
93 ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
95 ctrlReturnConvAlg tycon
96 = case (tyConFamilySize tycon) of
97 0 -> pprTrace "ctrlReturnConvAlg:" (ppr PprDebug tycon) $
98 UnvectoredReturn 0 -- e.g., w/ "data Bin"
100 size -> -- we're supposed to know...
101 if (size > (1::Int) && size <= mAX_FAMILY_SIZE_FOR_VEC_RETURNS) then
104 UnvectoredReturn size
107 @dataReturnConvAlg@ determines the return conventions from the
108 (possibly specialised) data constructor.
110 (See also @getDataConReturnConv@ (in @Id@).) We grab the types
111 of the data constructor's arguments. We feed them and a list of
112 available registers into @assign_reg@, which sequentially assigns
113 registers of the appropriate types to the arguments, based on the
114 types. If @assign_reg@ runs out of a particular kind of register,
115 then it gives up, returning @ReturnInHeap@.
118 dataReturnConvAlg :: DataCon -> DataReturnConvention
120 dataReturnConvAlg data_con
121 = ASSERT2(isDataCon data_con, (ppr PprDebug data_con))
122 case leftover_kinds of
123 [] -> ReturnInRegs reg_assignment
124 other -> ReturnInHeap -- Didn't fit in registers
126 arg_tys = dataConRawArgTys data_con
128 (reg_assignment, leftover_kinds)
129 = assignRegs [node, infoptr] -- taken...
130 (map typePrimRep arg_tys)
133 %************************************************************************
135 \subsection[CgRetConv-prim]{Return conventions for primitive datatypes}
137 %************************************************************************
139 WARNING! If you add a return convention which can return a pointer,
140 make sure you alter CgCase (cgPrimDefault) to generate the right sort
143 dataReturnConvPrim :: PrimRep -> MagicId
145 dataReturnConvPrim IntRep = VanillaReg IntRep ILIT(1)
146 dataReturnConvPrim WordRep = VanillaReg WordRep ILIT(1)
147 dataReturnConvPrim AddrRep = VanillaReg AddrRep ILIT(1)
148 dataReturnConvPrim CharRep = VanillaReg CharRep ILIT(1)
149 dataReturnConvPrim FloatRep = FloatReg ILIT(1)
150 dataReturnConvPrim DoubleRep = DoubleReg ILIT(1)
151 dataReturnConvPrim VoidRep = VoidReg
153 -- Return a primitive-array pointer in the usual register:
154 dataReturnConvPrim ArrayRep = VanillaReg ArrayRep ILIT(1)
155 dataReturnConvPrim ByteArrayRep = VanillaReg ByteArrayRep ILIT(1)
157 dataReturnConvPrim StablePtrRep = VanillaReg StablePtrRep ILIT(1)
158 dataReturnConvPrim ForeignObjRep = VanillaReg ForeignObjRep ILIT(1)
161 dataReturnConvPrim PtrRep = panic "dataReturnConvPrim: PtrRep"
162 dataReturnConvPrim _ = panic "dataReturnConvPrim: other"
166 %********************************************************
168 \subsection[primop-stuff]{Argument and return conventions for Prim Ops}
170 %********************************************************
173 assignPrimOpResultRegs
174 :: PrimOp -- The constructors in canonical order
175 -> [MagicId] -- The return regs all concatenated to together,
176 -- (*including* one for the tag if necy)
178 assignPrimOpResultRegs op
179 = case (getPrimOpResultInfo op) of
181 ReturnsPrim kind -> [dataReturnConvPrim kind]
185 cons = tyConDataCons tycon
186 result_regs = concat (map get_return_regs cons)
188 -- As R1 is dead, it can hold the tag if necessary
191 other -> (VanillaReg IntRep ILIT(1)) : result_regs
194 = case (dataReturnConvAlg con) of
195 ReturnInRegs regs -> regs
196 ReturnInHeap -> panic "getPrimOpAlgResultRegs"
199 @assignPrimOpArgsRobust@ is used only for primitive ops which may
200 trigger GC. [MAYBE (WDP 94/05)] For these, we pass all (nonRobust)
201 arguments in registers. This function assigns them and tells us which
202 of those registers are now live (because we've shoved a followable
205 Bug: it is assumed that robust amodes cannot contain pointers. This
206 seems reasonable but isn't true. For example, \tr{Array#}'s
207 \tr{ForeignObj#}'s are pointers. (This is only known to bite on
208 \tr{_ccall_GC_} with a ForeignObj argument.)
210 See after for some ADR comments...
215 -> [CAddrMode] -- Arguments
216 -> ([CAddrMode], -- Arg registers
217 Int, -- Liveness mask
218 AbstractC) -- Simultaneous assignments to assign args to regs
220 makePrimOpArgsRobust op arg_amodes
221 = ASSERT (primOpCanTriggerGC op)
223 non_robust_amodes = filter (not . amodeCanSurviveGC) arg_amodes
224 arg_kinds = map getAmodeRep non_robust_amodes
226 (arg_regs, extra_args)
227 = assignRegs [{-nothing live-}] arg_kinds
229 -- Check that all the args fit before returning arg_regs
230 final_arg_regs = case extra_args of
232 other -> pprError "Cannot allocate enough registers for primop (try rearranging code or reducing number of arguments?)" (ppr PprDebug op)
235 = mkAbstractCs (zipWithEqual "assign_to_reg" assign_to_reg final_arg_regs non_robust_amodes)
237 assign_to_reg reg_id amode = CAssign (CReg reg_id) amode
240 | amodeCanSurviveGC arg = (regs, arg)
241 | otherwise = (tail regs, CReg (head regs))
242 safe_amodes = snd (mapAccumL safe_arg final_arg_regs arg_amodes)
244 liveness_mask = mkLiveRegsMask final_arg_regs
246 (safe_amodes, liveness_mask, arg_assts)
249 %************************************************************************
251 \subsubsection[CgRetConv-regs]{Register assignment}
253 %************************************************************************
255 How to assign registers.
256 Registers are assigned in order.
258 If we run out, we don't attempt to assign
259 any further registers (even though we might have run out of only one kind of
260 register); we just return immediately with the left-overs specified.
263 assignRegs :: [MagicId] -- Unavailable registers
264 -> [PrimRep] -- Arg or result kinds to assign
265 -> ([MagicId], -- Register assignment in same order
266 -- for *initial segment of* input list
267 [PrimRep])-- leftover kinds
269 assignRegs regs_in_use kinds
270 = assign_reg kinds [] (mkRegTbl regs_in_use)
273 assign_reg :: [PrimRep] -- arg kinds being scrutinized
274 -> [MagicId] -- accum. regs assigned so far (reversed)
275 -> ([Int], [Int], [Int])
276 -- regs still avail: Vanilla, Float, Double
277 -> ([MagicId], [PrimRep])
279 assign_reg (VoidRep:ks) acc supply
280 = assign_reg ks (VoidReg:acc) supply -- one VoidReg is enough for everybody!
282 assign_reg (FloatRep:ks) acc (vanilla_rs, IBOX(f):float_rs, double_rs)
283 = assign_reg ks (FloatReg f:acc) (vanilla_rs, float_rs, double_rs)
285 assign_reg (DoubleRep:ks) acc (vanilla_rs, float_rs, IBOX(d):double_rs)
286 = assign_reg ks (DoubleReg d:acc) (vanilla_rs, float_rs, double_rs)
288 assign_reg (k:ks) acc (IBOX(v):vanilla_rs, float_rs, double_rs)
289 | not (isFloatingRep k)
290 = assign_reg ks (VanillaReg k v:acc) (vanilla_rs, float_rs, double_rs)
292 -- The catch-all. It can happen because either
293 -- (a) we've assigned all the regs so leftover_ks is []
294 -- (b) we couldn't find a spare register in the appropriate supply
296 -- (c) we came across a Kind we couldn't handle (this one shouldn't happen)
297 assign_reg leftover_ks acc _ = (reverse acc, leftover_ks)
300 Register supplies. Vanilla registers can contain pointers, Ints, Chars.
303 vanillaRegNos :: [Int]
304 vanillaRegNos = [1 .. mAX_Vanilla_REG]
307 Floats and doubles have separate register supplies.
310 floatRegNos, doubleRegNos :: [Int]
311 floatRegNos = [1 .. mAX_Float_REG]
312 doubleRegNos = [1 .. mAX_Double_REG]
314 mkRegTbl :: [MagicId] -> ([Int], [Int], [Int])
317 = (ok_vanilla, ok_float, ok_double)
319 ok_vanilla = catMaybes (map (select (VanillaReg VoidRep)) (taker vanillaRegNos))
320 ok_float = catMaybes (map (select FloatReg) floatRegNos)
321 ok_double = catMaybes (map (select DoubleReg) doubleRegNos)
323 taker :: [Int] -> [Int]
325 = case (opt_ReturnInRegsThreshold) of
326 Nothing -> rs -- no flag set; use all of them
329 select :: (FAST_INT -> MagicId) -> Int{-cand-} -> Maybe Int
330 -- one we've unboxed the Int, we make a MagicId
331 -- and see if it is already in use; if not, return its number.
333 select mk_reg_fun cand@IBOX(i)
337 if reg `not_elem` regs_in_use
341 not_elem = isn'tIn "mkRegTbl"