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 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
27 IMPORT_DELOOPER(AbsCLoop) -- paranoia checking
30 import AbsCSyn -- quite a few things
31 import AbsCUtils ( mkAbstractCs, getAmodeRep,
34 import Constants ( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
35 mAX_Vanilla_REG, mAX_Float_REG,
38 import CmdLineOpts ( opt_ReturnInRegsThreshold )
39 import Id ( isDataCon, dataConRawArgTys,
40 SYN_IE(DataCon), GenId{-instance Eq-},
43 import Maybes ( catMaybes )
44 import Outputable ( PprStyle(..), Outputable(..) )
45 import PprType ( TyCon{-instance Outputable-} )
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 )
54 import Util ( zipWithEqual, mapAccumL, isn'tIn,
55 pprError, pprTrace, panic, assertPanic, assertPprPanic
59 %************************************************************************
61 \subsection[CgRetConv-possibilities]{Data types that encode possible return conventions}
63 %************************************************************************
65 A @CtrlReturnConvention@ says how {\em control} is returned.
67 data CtrlReturnConvention
68 = VectoredReturn Int -- size of the vector table (family size)
69 | UnvectoredReturn Int -- family size
72 A @DataReturnConvention@ says how the data for a particular
73 data-constructor is returned.
75 data DataReturnConvention
77 | ReturnInRegs [MagicId]
79 The register assignment given by a @ReturnInRegs@ obeys three rules:
82 \item R2 points to the info table for the phantom constructor
83 \item The list of @MagicId@ is in the same order as the arguments
88 %************************************************************************
90 \subsection[CgRetConv-algebraic]{Return conventions for algebraic datatypes}
92 %************************************************************************
95 ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
97 ctrlReturnConvAlg tycon
98 = case (tyConFamilySize tycon) of
99 0 -> pprTrace "ctrlReturnConvAlg:" (ppr PprDebug tycon) $
100 UnvectoredReturn 0 -- e.g., w/ "data Bin"
102 size -> -- we're supposed to know...
103 if (size > (1::Int) && size <= mAX_FAMILY_SIZE_FOR_VEC_RETURNS) then
106 UnvectoredReturn size
109 @dataReturnConvAlg@ determines the return conventions from the
110 (possibly specialised) data constructor.
112 (See also @getDataConReturnConv@ (in @Id@).) We grab the types
113 of the data constructor's arguments. We feed them and a list of
114 available registers into @assign_reg@, which sequentially assigns
115 registers of the appropriate types to the arguments, based on the
116 types. If @assign_reg@ runs out of a particular kind of register,
117 then it gives up, returning @ReturnInHeap@.
120 dataReturnConvAlg :: DataCon -> DataReturnConvention
122 dataReturnConvAlg data_con
123 = ASSERT2(isDataCon data_con, (ppr PprDebug data_con))
124 case leftover_kinds of
125 [] -> ReturnInRegs reg_assignment
126 other -> ReturnInHeap -- Didn't fit in registers
128 arg_tys = dataConRawArgTys data_con
130 (reg_assignment, leftover_kinds)
131 = assignRegs [node, infoptr] -- taken...
132 (map typePrimRep arg_tys)
135 %************************************************************************
137 \subsection[CgRetConv-prim]{Return conventions for primitive datatypes}
139 %************************************************************************
141 WARNING! If you add a return convention which can return a pointer,
142 make sure you alter CgCase (cgPrimDefault) to generate the right sort
145 dataReturnConvPrim :: PrimRep -> MagicId
147 dataReturnConvPrim IntRep = VanillaReg IntRep ILIT(1)
148 dataReturnConvPrim WordRep = VanillaReg WordRep ILIT(1)
149 dataReturnConvPrim AddrRep = VanillaReg AddrRep ILIT(1)
150 dataReturnConvPrim CharRep = VanillaReg CharRep ILIT(1)
151 dataReturnConvPrim FloatRep = FloatReg ILIT(1)
152 dataReturnConvPrim DoubleRep = DoubleReg ILIT(1)
153 dataReturnConvPrim VoidRep = VoidReg
155 -- Return a primitive-array pointer in the usual register:
156 dataReturnConvPrim ArrayRep = VanillaReg ArrayRep ILIT(1)
157 dataReturnConvPrim ByteArrayRep = VanillaReg ByteArrayRep ILIT(1)
159 dataReturnConvPrim StablePtrRep = VanillaReg StablePtrRep ILIT(1)
160 dataReturnConvPrim ForeignObjRep = VanillaReg ForeignObjRep ILIT(1)
163 dataReturnConvPrim PtrRep = panic "dataReturnConvPrim: PtrRep"
164 dataReturnConvPrim _ = panic "dataReturnConvPrim: other"
168 %********************************************************
170 \subsection[primop-stuff]{Argument and return conventions for Prim Ops}
172 %********************************************************
175 assignPrimOpResultRegs
176 :: PrimOp -- The constructors in canonical order
177 -> [MagicId] -- The return regs all concatenated to together,
178 -- (*including* one for the tag if necy)
180 assignPrimOpResultRegs op
181 = case (getPrimOpResultInfo op) of
183 ReturnsPrim kind -> [dataReturnConvPrim kind]
187 cons = tyConDataCons tycon
188 result_regs = concat (map get_return_regs cons)
190 -- As R1 is dead, it can hold the tag if necessary
193 other -> (VanillaReg IntRep ILIT(1)) : result_regs
196 = case (dataReturnConvAlg con) of
197 ReturnInRegs regs -> regs
198 ReturnInHeap -> panic "getPrimOpAlgResultRegs"
201 @assignPrimOpArgsRobust@ is used only for primitive ops which may
202 trigger GC. [MAYBE (WDP 94/05)] For these, we pass all (nonRobust)
203 arguments in registers. This function assigns them and tells us which
204 of those registers are now live (because we've shoved a followable
207 Bug: it is assumed that robust amodes cannot contain pointers. This
208 seems reasonable but isn't true. For example, \tr{Array#}'s
209 \tr{ForeignObj#}'s are pointers. (This is only known to bite on
210 \tr{_ccall_GC_} with a ForeignObj argument.)
212 See after for some ADR comments...
217 -> [CAddrMode] -- Arguments
218 -> ([CAddrMode], -- Arg registers
219 Int, -- Liveness mask
220 AbstractC) -- Simultaneous assignments to assign args to regs
222 makePrimOpArgsRobust op arg_amodes
223 = ASSERT (primOpCanTriggerGC op)
225 non_robust_amodes = filter (not . amodeCanSurviveGC) arg_amodes
226 arg_kinds = map getAmodeRep non_robust_amodes
228 (arg_regs, extra_args)
229 = assignRegs [{-nothing live-}] arg_kinds
231 -- Check that all the args fit before returning arg_regs
232 final_arg_regs = case extra_args of
234 other -> pprError "Cannot allocate enough registers for primop (try rearranging code or reducing number of arguments?)" (ppr PprDebug op)
237 = mkAbstractCs (zipWithEqual "assign_to_reg" assign_to_reg final_arg_regs non_robust_amodes)
239 assign_to_reg reg_id amode = CAssign (CReg reg_id) amode
242 | amodeCanSurviveGC arg = (regs, arg)
243 | otherwise = (tail regs, CReg (head regs))
244 safe_amodes = snd (mapAccumL safe_arg final_arg_regs arg_amodes)
246 liveness_mask = mkLiveRegsMask final_arg_regs
248 (safe_amodes, liveness_mask, arg_assts)
251 %************************************************************************
253 \subsubsection[CgRetConv-regs]{Register assignment}
255 %************************************************************************
257 How to assign registers.
258 Registers are assigned in order.
260 If we run out, we don't attempt to assign
261 any further registers (even though we might have run out of only one kind of
262 register); we just return immediately with the left-overs specified.
265 assignRegs :: [MagicId] -- Unavailable registers
266 -> [PrimRep] -- Arg or result kinds to assign
267 -> ([MagicId], -- Register assignment in same order
268 -- for *initial segment of* input list
269 [PrimRep])-- leftover kinds
271 assignRegs regs_in_use kinds
272 = assign_reg kinds [] (mkRegTbl regs_in_use)
275 assign_reg :: [PrimRep] -- arg kinds being scrutinized
276 -> [MagicId] -- accum. regs assigned so far (reversed)
277 -> ([Int], [Int], [Int])
278 -- regs still avail: Vanilla, Float, Double
279 -> ([MagicId], [PrimRep])
281 assign_reg (VoidRep:ks) acc supply
282 = assign_reg ks (VoidReg:acc) supply -- one VoidReg is enough for everybody!
284 assign_reg (FloatRep:ks) acc (vanilla_rs, IBOX(f):float_rs, double_rs)
285 = assign_reg ks (FloatReg f:acc) (vanilla_rs, float_rs, double_rs)
287 assign_reg (DoubleRep:ks) acc (vanilla_rs, float_rs, IBOX(d):double_rs)
288 = assign_reg ks (DoubleReg d:acc) (vanilla_rs, float_rs, double_rs)
290 assign_reg (k:ks) acc (IBOX(v):vanilla_rs, float_rs, double_rs)
291 | not (isFloatingRep k)
292 = assign_reg ks (VanillaReg k v:acc) (vanilla_rs, float_rs, double_rs)
294 -- The catch-all. It can happen because either
295 -- (a) we've assigned all the regs so leftover_ks is []
296 -- (b) we couldn't find a spare register in the appropriate supply
298 -- (c) we came across a Kind we couldn't handle (this one shouldn't happen)
299 assign_reg leftover_ks acc _ = (reverse acc, leftover_ks)
302 Register supplies. Vanilla registers can contain pointers, Ints, Chars.
305 vanillaRegNos :: [Int]
306 vanillaRegNos = [1 .. mAX_Vanilla_REG]
309 Floats and doubles have separate register supplies.
312 floatRegNos, doubleRegNos :: [Int]
313 floatRegNos = [1 .. mAX_Float_REG]
314 doubleRegNos = [1 .. mAX_Double_REG]
316 mkRegTbl :: [MagicId] -> ([Int], [Int], [Int])
319 = (ok_vanilla, ok_float, ok_double)
321 ok_vanilla = catMaybes (map (select (VanillaReg VoidRep)) (taker vanillaRegNos))
322 ok_float = catMaybes (map (select FloatReg) floatRegNos)
323 ok_double = catMaybes (map (select DoubleReg) doubleRegNos)
325 taker :: [Int] -> [Int]
327 = case (opt_ReturnInRegsThreshold) of
328 Nothing -> rs -- no flag set; use all of them
331 select :: (FAST_INT -> MagicId) -> Int{-cand-} -> Maybe Int
332 -- one we've unboxed the Int, we make a MagicId
333 -- and see if it is already in use; if not, return its number.
335 select mk_reg_fun cand@IBOX(i)
339 if reg `not_elem` regs_in_use
343 not_elem = isn'tIn "mkRegTbl"