2 -- The above warning supression flag is a temporary kludge.
3 -- While working on this module you are encouraged to remove it and fix
4 -- any warnings in the module. See
5 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
8 -----------------------------------------------------------------------------
10 -- (c) The University of Glasgow 2004-2006
14 -- The datatypes and functions here encapsulate the
15 -- calling and return conventions used by the code generator.
17 -----------------------------------------------------------------------------
20 -- Argument descriptors
21 mkArgDescr, argDescrType,
24 isBigLiveness, mkRegLiveness,
25 smallLiveness, mkLivenessCLit,
27 -- Register assignment
28 assignCallRegs, assignReturnRegs, assignPrimOpCallRegs,
31 constructSlowCall, slowArgs, slowCallPattern,
62 -------------------------------------------------------------------------
64 -- Making argument descriptors
66 -- An argument descriptor describes the layout of args on the stack,
67 -- both for * GC (stack-layout) purposes, and
68 -- * saving/restoring registers when a heap-check fails
70 -- Void arguments aren't important, therefore (contrast constructSlowCall)
72 -------------------------------------------------------------------------
74 -- bring in ARG_P, ARG_N, etc.
75 #include "../includes/StgFun.h"
77 -------------------------
78 argDescrType :: ArgDescr -> StgHalfWord
79 -- The "argument type" RTS field type
80 argDescrType (ArgSpec n) = n
81 argDescrType (ArgGen liveness)
82 | isBigLiveness liveness = ARG_GEN_BIG
86 mkArgDescr :: Name -> [Id] -> FCode ArgDescr
88 = case stdPattern arg_reps of
89 Just spec_id -> return (ArgSpec spec_id)
90 Nothing -> do { liveness <- mkLiveness nm size bitmap
91 ; return (ArgGen liveness) }
93 arg_reps = filter nonVoidArg (map idCgRep args)
94 -- Getting rid of voids eases matching of standard patterns
96 bitmap = mkBitmap arg_bits
97 arg_bits = argBits arg_reps
98 size = length arg_bits
100 argBits :: [CgRep] -> [Bool] -- True for non-ptr, False for ptr
102 argBits (PtrArg : args) = False : argBits args
103 argBits (arg : args) = take (cgRepSizeW arg) (repeat True) ++ argBits args
105 stdPattern :: [CgRep] -> Maybe StgHalfWord
106 stdPattern [] = Just ARG_NONE -- just void args, probably
108 stdPattern [PtrArg] = Just ARG_P
109 stdPattern [FloatArg] = Just ARG_F
110 stdPattern [DoubleArg] = Just ARG_D
111 stdPattern [LongArg] = Just ARG_L
112 stdPattern [NonPtrArg] = Just ARG_N
114 stdPattern [NonPtrArg,NonPtrArg] = Just ARG_NN
115 stdPattern [NonPtrArg,PtrArg] = Just ARG_NP
116 stdPattern [PtrArg,NonPtrArg] = Just ARG_PN
117 stdPattern [PtrArg,PtrArg] = Just ARG_PP
119 stdPattern [NonPtrArg,NonPtrArg,NonPtrArg] = Just ARG_NNN
120 stdPattern [NonPtrArg,NonPtrArg,PtrArg] = Just ARG_NNP
121 stdPattern [NonPtrArg,PtrArg,NonPtrArg] = Just ARG_NPN
122 stdPattern [NonPtrArg,PtrArg,PtrArg] = Just ARG_NPP
123 stdPattern [PtrArg,NonPtrArg,NonPtrArg] = Just ARG_PNN
124 stdPattern [PtrArg,NonPtrArg,PtrArg] = Just ARG_PNP
125 stdPattern [PtrArg,PtrArg,NonPtrArg] = Just ARG_PPN
126 stdPattern [PtrArg,PtrArg,PtrArg] = Just ARG_PPP
128 stdPattern [PtrArg,PtrArg,PtrArg,PtrArg] = Just ARG_PPPP
129 stdPattern [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg] = Just ARG_PPPPP
130 stdPattern [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg,PtrArg] = Just ARG_PPPPPP
131 stdPattern other = Nothing
134 -------------------------------------------------------------------------
138 -------------------------------------------------------------------------
140 -- TODO: This along with 'mkArgDescr' should be unified
141 -- with 'CmmInfo.mkLiveness'. However that would require
142 -- potentially invasive changes to the 'ClosureInfo' type.
143 -- For now, 'CmmInfo.mkLiveness' handles only continuations and
144 -- this one handles liveness everything else. Another distinction
145 -- between these two is that 'CmmInfo.mkLiveness' information
146 -- about the stack layout, and this one is information about
147 -- the heap layout of PAPs.
148 mkLiveness :: Name -> Int -> Bitmap -> FCode Liveness
149 mkLiveness name size bits
150 | size > mAX_SMALL_BITMAP_SIZE -- Bitmap does not fit in one word
151 = do { let lbl = mkBitmapLabel (getUnique name)
152 ; emitRODataLits lbl ( mkWordCLit (fromIntegral size)
153 : map mkWordCLit bits)
154 ; return (BigLiveness lbl) }
156 | otherwise -- Bitmap fits in one word
158 small_bits = case bits of
160 [b] -> fromIntegral b
161 _ -> panic "livenessToAddrMode"
163 return (smallLiveness size small_bits)
165 smallLiveness :: Int -> StgWord -> Liveness
166 smallLiveness size small_bits = SmallLiveness bits
167 where bits = fromIntegral size .|. (small_bits `shiftL` bITMAP_BITS_SHIFT)
170 isBigLiveness :: Liveness -> Bool
171 isBigLiveness (BigLiveness _) = True
172 isBigLiveness (SmallLiveness _) = False
175 mkLivenessCLit :: Liveness -> CmmLit
176 mkLivenessCLit (BigLiveness lbl) = CmmLabel lbl
177 mkLivenessCLit (SmallLiveness bits) = mkWordCLit bits
180 -------------------------------------------------------------------------
182 -- Bitmap describing register liveness
183 -- across GC when doing a "generic" heap check
184 -- (a RET_DYN stack frame).
186 -- NB. Must agree with these macros (currently in StgMacros.h):
187 -- GET_NON_PTRS(), GET_PTRS(), GET_LIVENESS().
188 -------------------------------------------------------------------------
190 mkRegLiveness :: [(Id, GlobalReg)] -> Int -> Int -> StgWord
191 mkRegLiveness regs ptrs nptrs
192 = (fromIntegral nptrs `shiftL` 16) .|.
193 (fromIntegral ptrs `shiftL` 24) .|.
194 all_non_ptrs `xor` reg_bits regs
199 reg_bits ((id, VanillaReg i) : regs) | isFollowableArg (idCgRep id)
200 = (1 `shiftL` (i - 1)) .|. reg_bits regs
204 -------------------------------------------------------------------------
206 -- Pushing the arguments for a slow call
208 -------------------------------------------------------------------------
210 -- For a slow call, we must take a bunch of arguments and intersperse
211 -- some stg_ap_<pattern>_ret_info return addresses.
214 -> (CLabel, -- RTS entry point for call
215 [(CgRep,CmmExpr)], -- args to pass to the entry point
216 [(CgRep,CmmExpr)]) -- stuff to save on the stack
218 -- don't forget the zero case
220 = (mkRtsApFastLabel (sLit "stg_ap_0"), [], [])
222 constructSlowCall amodes
223 = (stg_ap_pat, these, rest)
225 stg_ap_pat = mkRtsApFastLabel arg_pat
226 (arg_pat, these, rest) = matchSlowPattern amodes
228 -- | 'slowArgs' takes a list of function arguments and prepares them for
229 -- pushing on the stack for "extra" arguments to a function which requires
230 -- fewer arguments than we currently have.
231 slowArgs :: [(CgRep,CmmExpr)] -> [(CgRep,CmmExpr)]
233 slowArgs amodes = (NonPtrArg, mkLblExpr stg_ap_pat) : args ++ slowArgs rest
234 where (arg_pat, args, rest) = matchSlowPattern amodes
235 stg_ap_pat = mkRtsRetInfoLabel arg_pat
237 matchSlowPattern :: [(CgRep,CmmExpr)]
238 -> (LitString, [(CgRep,CmmExpr)], [(CgRep,CmmExpr)])
239 matchSlowPattern amodes = (arg_pat, these, rest)
240 where (arg_pat, n) = slowCallPattern (map fst amodes)
241 (these, rest) = splitAt n amodes
243 -- These cases were found to cover about 99% of all slow calls:
244 slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (sLit "stg_ap_pppppp", 6)
245 slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (sLit "stg_ap_ppppp", 5)
246 slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: _) = (sLit "stg_ap_pppp", 4)
247 slowCallPattern (PtrArg: PtrArg: PtrArg: VoidArg: _) = (sLit "stg_ap_pppv", 4)
248 slowCallPattern (PtrArg: PtrArg: PtrArg: _) = (sLit "stg_ap_ppp", 3)
249 slowCallPattern (PtrArg: PtrArg: VoidArg: _) = (sLit "stg_ap_ppv", 3)
250 slowCallPattern (PtrArg: PtrArg: _) = (sLit "stg_ap_pp", 2)
251 slowCallPattern (PtrArg: VoidArg: _) = (sLit "stg_ap_pv", 2)
252 slowCallPattern (PtrArg: _) = (sLit "stg_ap_p", 1)
253 slowCallPattern (VoidArg: _) = (sLit "stg_ap_v", 1)
254 slowCallPattern (NonPtrArg: _) = (sLit "stg_ap_n", 1)
255 slowCallPattern (FloatArg: _) = (sLit "stg_ap_f", 1)
256 slowCallPattern (DoubleArg: _) = (sLit "stg_ap_d", 1)
257 slowCallPattern (LongArg: _) = (sLit "stg_ap_l", 1)
258 slowCallPattern _ = panic "CgStackery.slowCallPattern"
260 -------------------------------------------------------------------------
262 -- Return conventions
264 -------------------------------------------------------------------------
266 dataReturnConvPrim :: CgRep -> CmmReg
267 dataReturnConvPrim PtrArg = CmmGlobal (VanillaReg 1)
268 dataReturnConvPrim NonPtrArg = CmmGlobal (VanillaReg 1)
269 dataReturnConvPrim LongArg = CmmGlobal (LongReg 1)
270 dataReturnConvPrim FloatArg = CmmGlobal (FloatReg 1)
271 dataReturnConvPrim DoubleArg = CmmGlobal (DoubleReg 1)
272 dataReturnConvPrim VoidArg = panic "dataReturnConvPrim: void"
275 -- getSequelAmode returns an amode which refers to an info table. The info
276 -- table will always be of the RET_(BIG|SMALL) kind. We're careful
277 -- not to handle real code pointers, just in case we're compiling for
278 -- an unregisterised/untailcallish architecture, where info pointers and
279 -- code pointers aren't the same.
281 -- The OnStack case of sequelToAmode delivers an Amode which is only
282 -- valid just before the final control transfer, because it assumes
283 -- that Sp is pointing to the top word of the return address. This
284 -- seems unclean but there you go.
286 getSequelAmode :: FCode CmmExpr
288 = do { EndOfBlockInfo virt_sp sequel <- getEndOfBlockInfo
290 OnStack -> do { sp_rel <- getSpRelOffset virt_sp
291 ; returnFC (CmmLoad sp_rel wordRep) }
293 UpdateCode -> returnFC (CmmLit (CmmLabel mkUpdInfoLabel))
294 CaseAlts lbl _ _ -> returnFC (CmmLit (CmmLabel lbl))
297 -------------------------------------------------------------------------
299 -- Register assignment
301 -------------------------------------------------------------------------
303 -- How to assign registers for
305 -- 1) Calling a fast entry point.
306 -- 2) Returning an unboxed tuple.
307 -- 3) Invoking an out-of-line PrimOp.
309 -- Registers are assigned in order.
311 -- If we run out, we don't attempt to assign any further registers (even
312 -- though we might have run out of only one kind of register); we just
313 -- return immediately with the left-overs specified.
315 -- The alternative version @assignAllRegs@ uses the complete set of
316 -- registers, including those that aren't mapped to real machine
317 -- registers. This is used for calling special RTS functions and PrimOps
318 -- which expect their arguments to always be in the same registers.
320 assignCallRegs, assignPrimOpCallRegs, assignReturnRegs
321 :: [(CgRep,a)] -- Arg or result values to assign
322 -> ([(a, GlobalReg)], -- Register assignment in same order
323 -- for *initial segment of* input list
324 -- (but reversed; doesn't matter)
325 -- VoidRep args do not appear here
326 [(CgRep,a)]) -- Leftover arg or result values
329 = assign_regs args (mkRegTbl [node])
330 -- The entry convention for a function closure
331 -- never uses Node for argument passing; instead
332 -- Node points to the function closure itself
334 assignPrimOpCallRegs args
335 = assign_regs args (mkRegTbl_allRegs [])
336 -- For primops, *all* arguments must be passed in registers
338 assignReturnRegs args
339 = assign_regs args (mkRegTbl [])
340 -- For returning unboxed tuples etc,
343 assign_regs :: [(CgRep,a)] -- Arg or result values to assign
344 -> AvailRegs -- Regs still avail: Vanilla, Float, Double, Longs
345 -> ([(a, GlobalReg)], [(CgRep, a)])
346 assign_regs args supply
349 go [] acc supply = (acc, []) -- Return the results reversed (doesn't matter)
350 go ((VoidArg,_) : args) acc supply -- Skip void arguments; they aren't passed, and
351 = go args acc supply -- there's nothign to bind them to
352 go ((rep,arg) : args) acc supply
353 = case assign_reg rep supply of
354 Just (reg, supply') -> go args ((arg,reg):acc) supply'
355 Nothing -> (acc, (rep,arg):args) -- No more regs
357 assign_reg :: CgRep -> AvailRegs -> Maybe (GlobalReg, AvailRegs)
358 assign_reg FloatArg (vs, f:fs, ds, ls) = Just (FloatReg f, (vs, fs, ds, ls))
359 assign_reg DoubleArg (vs, fs, d:ds, ls) = Just (DoubleReg d, (vs, fs, ds, ls))
360 assign_reg LongArg (vs, fs, ds, l:ls) = Just (LongReg l, (vs, fs, ds, ls))
361 assign_reg PtrArg (v:vs, fs, ds, ls) = Just (VanillaReg v, (vs, fs, ds, ls))
362 assign_reg NonPtrArg (v:vs, fs, ds, ls) = Just (VanillaReg v, (vs, fs, ds, ls))
363 -- PtrArg and NonPtrArg both go in a vanilla register
364 assign_reg other not_enough_regs = Nothing
367 -------------------------------------------------------------------------
371 -------------------------------------------------------------------------
373 -- Vanilla registers can contain pointers, Ints, Chars.
374 -- Floats and doubles have separate register supplies.
376 -- We take these register supplies from the *real* registers, i.e. those
377 -- that are guaranteed to map to machine registers.
379 useVanillaRegs | opt_Unregisterised = 0
380 | otherwise = mAX_Real_Vanilla_REG
381 useFloatRegs | opt_Unregisterised = 0
382 | otherwise = mAX_Real_Float_REG
383 useDoubleRegs | opt_Unregisterised = 0
384 | otherwise = mAX_Real_Double_REG
385 useLongRegs | opt_Unregisterised = 0
386 | otherwise = mAX_Real_Long_REG
388 vanillaRegNos, floatRegNos, doubleRegNos, longRegNos :: [Int]
389 vanillaRegNos = regList useVanillaRegs
390 floatRegNos = regList useFloatRegs
391 doubleRegNos = regList useDoubleRegs
392 longRegNos = regList useLongRegs
394 allVanillaRegNos, allFloatRegNos, allDoubleRegNos, allLongRegNos :: [Int]
395 allVanillaRegNos = regList mAX_Vanilla_REG
396 allFloatRegNos = regList mAX_Float_REG
397 allDoubleRegNos = regList mAX_Double_REG
398 allLongRegNos = regList mAX_Long_REG
403 type AvailRegs = ( [Int] -- available vanilla regs.
406 , [Int] -- longs (int64 and word64)
409 mkRegTbl :: [GlobalReg] -> AvailRegs
411 = mkRegTbl' regs_in_use vanillaRegNos floatRegNos doubleRegNos longRegNos
413 mkRegTbl_allRegs :: [GlobalReg] -> AvailRegs
414 mkRegTbl_allRegs regs_in_use
415 = mkRegTbl' regs_in_use allVanillaRegNos allFloatRegNos allDoubleRegNos allLongRegNos
417 mkRegTbl' regs_in_use vanillas floats doubles longs
418 = (ok_vanilla, ok_float, ok_double, ok_long)
420 ok_vanilla = mapCatMaybes (select VanillaReg) vanillas
421 ok_float = mapCatMaybes (select FloatReg) floats
422 ok_double = mapCatMaybes (select DoubleReg) doubles
423 ok_long = mapCatMaybes (select LongReg) longs
424 -- rep isn't looked at, hence we can use any old rep.
426 select :: (Int -> GlobalReg) -> Int{-cand-} -> Maybe Int
427 -- one we've unboxed the Int, we make a GlobalReg
428 -- and see if it is already in use; if not, return its number.
430 select mk_reg_fun cand
432 reg = mk_reg_fun cand
434 if reg `not_elem` regs_in_use
438 not_elem = isn'tIn "mkRegTbl"