2 % (c) The GRASP Project, Glasgow University, 1992-1998
4 % $Id: CgRetConv.lhs,v 1.30 2001/08/17 17:18:52 apt Exp $
6 \section[CgRetConv]{Return conventions for the code generator}
8 The datatypes and functions here encapsulate what there is to know
9 about return conventions.
13 CtrlReturnConvention(..),
16 assignRegs, assignAllRegs
19 #include "HsVersions.h"
21 import AbsCSyn -- quite a few things
22 import Constants ( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
23 mAX_Vanilla_REG, mAX_Float_REG,
24 mAX_Double_REG, mAX_Long_REG,
25 mAX_Real_Vanilla_REG, mAX_Real_Float_REG,
26 mAX_Real_Double_REG, mAX_Real_Long_REG
28 import CmdLineOpts ( opt_Unregisterised )
29 import Maybes ( catMaybes )
30 import PrimRep ( isFloatingRep, PrimRep(..), is64BitRep )
31 import TyCon ( TyCon, tyConFamilySize )
32 import Util ( isn'tIn )
37 %************************************************************************
39 \subsection[CgRetConv-possibilities]{Data types that encode possible return conventions}
41 %************************************************************************
43 A @CtrlReturnConvention@ says how {\em control} is returned.
45 data CtrlReturnConvention
46 = VectoredReturn Int -- size of the vector table (family size)
47 | UnvectoredReturn Int -- family size
50 %************************************************************************
52 \subsection[CgRetConv-algebraic]{Return conventions for algebraic datatypes}
54 %************************************************************************
57 ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
59 ctrlReturnConvAlg tycon
60 = case (tyConFamilySize tycon) of
61 0 -> pprPanic "ctrlRetConvAlg" (ppr tycon)
62 size -> -- we're supposed to know...
63 if (size > (1::Int) && size <= mAX_FAMILY_SIZE_FOR_VEC_RETURNS) then
69 %************************************************************************
71 \subsection[CgRetConv-prim]{Return conventions for primitive datatypes}
73 %************************************************************************
76 dataReturnConvPrim :: PrimRep -> MagicId
78 dataReturnConvPrim IntRep = VanillaReg IntRep (_ILIT 1)
79 dataReturnConvPrim WordRep = VanillaReg WordRep (_ILIT 1)
80 dataReturnConvPrim Int32Rep = VanillaReg Int32Rep (_ILIT 1)
81 dataReturnConvPrim Word32Rep = VanillaReg Word32Rep (_ILIT 1)
82 dataReturnConvPrim Int64Rep = LongReg Int64Rep (_ILIT 1)
83 dataReturnConvPrim Word64Rep = LongReg Word64Rep (_ILIT 1)
84 dataReturnConvPrim AddrRep = VanillaReg AddrRep (_ILIT 1)
85 dataReturnConvPrim CharRep = VanillaReg CharRep (_ILIT 1)
86 dataReturnConvPrim Int8Rep = VanillaReg Int8Rep (_ILIT 1)
87 dataReturnConvPrim FloatRep = FloatReg (_ILIT 1)
88 dataReturnConvPrim DoubleRep = DoubleReg (_ILIT 1)
89 dataReturnConvPrim VoidRep = VoidReg
91 -- Return a primitive-array pointer in the usual register:
92 dataReturnConvPrim ArrayRep = VanillaReg ArrayRep (_ILIT 1)
93 dataReturnConvPrim ByteArrayRep = VanillaReg ByteArrayRep (_ILIT 1)
94 dataReturnConvPrim PrimPtrRep = VanillaReg PrimPtrRep (_ILIT 1)
95 dataReturnConvPrim ThreadIdRep = VanillaReg ThreadIdRep (_ILIT 1)
97 dataReturnConvPrim StablePtrRep = VanillaReg StablePtrRep (_ILIT 1)
98 dataReturnConvPrim ForeignObjRep = VanillaReg ForeignObjRep (_ILIT 1)
99 dataReturnConvPrim WeakPtrRep = VanillaReg WeakPtrRep (_ILIT 1)
102 dataReturnConvPrim rep = pprPanic "dataReturnConvPrim:" (ppr rep)
106 %************************************************************************
108 \subsubsection[CgRetConv-regs]{Register assignment}
110 %************************************************************************
112 How to assign registers for
114 1) Calling a fast entry point.
115 2) Returning an unboxed tuple.
116 3) Invoking an out-of-line PrimOp.
118 Registers are assigned in order.
120 If we run out, we don't attempt to assign any further registers (even
121 though we might have run out of only one kind of register); we just
122 return immediately with the left-overs specified.
124 The alternative version @assignAllRegs@ uses the complete set of
125 registers, including those that aren't mapped to real machine
126 registers. This is used for calling special RTS functions and PrimOps
127 which expect their arguments to always be in the same registers.
130 assignRegs, assignAllRegs
131 :: [MagicId] -- Unavailable registers
132 -> [PrimRep] -- Arg or result kinds to assign
133 -> ([MagicId], -- Register assignment in same order
134 -- for *initial segment of* input list
135 [PrimRep])-- leftover kinds
137 assignRegs regs_in_use kinds
138 = assign_reg kinds [] (mkRegTbl regs_in_use)
140 assignAllRegs regs_in_use kinds
141 = assign_reg kinds [] (mkRegTbl_allRegs regs_in_use)
144 :: [PrimRep] -- arg kinds being scrutinized
145 -> [MagicId] -- accum. regs assigned so far (reversed)
146 -> AvailRegs -- regs still avail: Vanilla, Float, Double, longs
147 -> ([MagicId], [PrimRep])
149 assign_reg (VoidRep:ks) acc supply
150 = assign_reg ks (VoidReg:acc) supply
151 -- one VoidReg is enough for everybody!
153 assign_reg (FloatRep:ks) acc (vanilla_rs, f:float_rs, double_rs, long_rs)
154 = assign_reg ks (FloatReg (iUnbox f):acc)
155 (vanilla_rs, float_rs, double_rs, long_rs)
157 assign_reg (DoubleRep:ks) acc (vanilla_rs, float_rs, d:double_rs, long_rs)
158 = assign_reg ks (DoubleReg (iUnbox d):acc)
159 (vanilla_rs, float_rs, double_rs, long_rs)
161 assign_reg (Word64Rep:ks) acc (vanilla_rs, float_rs, double_rs, u:long_rs)
162 = assign_reg ks (LongReg Word64Rep (iUnbox u):acc)
163 (vanilla_rs, float_rs, double_rs, long_rs)
165 assign_reg (Int64Rep:ks) acc (vanilla_rs, float_rs, double_rs, l:long_rs)
166 = assign_reg ks (LongReg Int64Rep (iUnbox l):acc)
167 (vanilla_rs, float_rs, double_rs, long_rs)
169 assign_reg (k:ks) acc (v:vanilla_rs, float_rs, double_rs, long_rs)
170 | not (isFloatingRep k || is64BitRep k)
171 = assign_reg ks (VanillaReg k (iUnbox v):acc)
172 (vanilla_rs, float_rs, double_rs, long_rs)
174 -- The catch-all. It can happen because either
175 -- (a) we've assigned all the regs so leftover_ks is []
176 -- (b) we couldn't find a spare register in the appropriate supply
178 -- (c) we came across a Kind we couldn't handle (this one shouldn't happen)
179 assign_reg leftover_ks acc _ = (reverse acc, leftover_ks)
183 Register supplies. Vanilla registers can contain pointers, Ints, Chars.
184 Floats and doubles have separate register supplies.
186 We take these register supplies from the *real* registers, i.e. those
187 that are guaranteed to map to machine registers.
190 useVanillaRegs | opt_Unregisterised = 0
191 | otherwise = mAX_Real_Vanilla_REG
192 useFloatRegs | opt_Unregisterised = 0
193 | otherwise = mAX_Real_Float_REG
194 useDoubleRegs | opt_Unregisterised = 0
195 | otherwise = mAX_Real_Double_REG
196 useLongRegs | opt_Unregisterised = 0
197 | otherwise = mAX_Real_Long_REG
199 vanillaRegNos, floatRegNos, doubleRegNos, longRegNos :: [Int]
200 vanillaRegNos = regList useVanillaRegs
201 floatRegNos = regList useFloatRegs
202 doubleRegNos = regList useDoubleRegs
203 longRegNos = regList useLongRegs
205 allVanillaRegNos, allFloatRegNos, allDoubleRegNos, allLongRegNos :: [Int]
206 allVanillaRegNos = regList mAX_Vanilla_REG
207 allFloatRegNos = regList mAX_Float_REG
208 allDoubleRegNos = regList mAX_Double_REG
209 allLongRegNos = regList mAX_Long_REG
214 type AvailRegs = ( [Int] -- available vanilla regs.
217 , [Int] -- longs (int64 and word64)
220 mkRegTbl :: [MagicId] -> AvailRegs
222 = mkRegTbl' regs_in_use vanillaRegNos floatRegNos doubleRegNos longRegNos
224 mkRegTbl_allRegs :: [MagicId] -> AvailRegs
225 mkRegTbl_allRegs regs_in_use
226 = mkRegTbl' regs_in_use allVanillaRegNos allFloatRegNos allDoubleRegNos allLongRegNos
228 mkRegTbl' regs_in_use vanillas floats doubles longs
229 = (ok_vanilla, ok_float, ok_double, ok_long)
231 ok_vanilla = catMaybes (map (select (VanillaReg VoidRep)) vanillas)
232 ok_float = catMaybes (map (select FloatReg) floats)
233 ok_double = catMaybes (map (select DoubleReg) doubles)
234 ok_long = catMaybes (map (select (LongReg Int64Rep)) longs)
235 -- rep isn't looked at, hence we can use any old rep.
237 select :: (FastInt -> MagicId) -> Int{-cand-} -> Maybe Int
238 -- one we've unboxed the Int, we make a MagicId
239 -- and see if it is already in use; if not, return its number.
241 select mk_reg_fun cand
243 reg = mk_reg_fun (iUnbox cand)
245 if reg `not_elem` regs_in_use
249 not_elem = isn'tIn "mkRegTbl"