2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: CgHeapery.lhs,v 1.39 2003/07/28 16:05:35 simonmar Exp $
6 \section[CgHeapery]{Heap management functions}
10 funEntryChecks, altHeapCheck, unbxTupleHeapCheck, thunkChecks,
13 -- new functions, basically inserting macro calls into Code -- HWL
14 ,fetchAndReschedule, yield
17 #include "HsVersions.h"
20 import StgSyn ( AltType(..) )
23 import CgStackery ( getFinalStackHW )
24 import AbsCUtils ( mkAbstractCs, getAmodeRep )
25 import CgUsages ( getVirtAndRealHp, getRealSp, setVirtHp, setRealHp,
28 import CgRetConv ( dataReturnConvPrim )
29 import ClosureInfo ( closureSize, closureGoodStuffSize,
30 slopSize, allocProfilingMsg, ClosureInfo
32 import TyCon ( tyConPrimRep )
33 import PrimRep ( PrimRep(..), isFollowableRep )
34 import CmdLineOpts ( opt_GranMacros )
37 import PprAbsC ( pprMagicId )
43 %************************************************************************
45 \subsection[CgHeapery-heap-overflow]{Heap overflow checking}
47 %************************************************************************
49 The new code for heapChecks. For GrAnSim the code for doing a heap check
50 and doing a context switch has been separated. Especially, the HEAP_CHK
51 macro only performs a heap check. THREAD_CONTEXT_SWITCH should be used for
52 doing a context switch. GRAN_FETCH_AND_RESCHEDULE must be put at the
53 beginning of every slow entry code in order to simulate the fetching of
54 closures. If fetching is necessary (i.e. current closure is not local) then
55 an automatic context switch is done.
57 -----------------------------------------------------------------------------
58 A heap/stack check at a function or thunk entry point.
61 funEntryChecks :: Maybe CLabel -> AbstractC -> Code -> Code
62 funEntryChecks closure_lbl reg_save_code code
63 = hpStkCheck closure_lbl True reg_save_code code
65 thunkChecks :: Maybe CLabel -> Code -> Code
66 thunkChecks closure_lbl code
67 = hpStkCheck closure_lbl False AbsCNop code
70 :: Maybe CLabel -- function closure
71 -> Bool -- is a function? (not a thunk)
72 -> AbstractC -- register saves
76 hpStkCheck closure_lbl is_fun reg_save_code code
77 = getFinalStackHW (\ spHw ->
78 getRealSp `thenFC` \ sp ->
79 let stk_words = spHw - sp in
80 initHeapUsage (\ hHw ->
82 getTickyCtrLabel `thenFC` \ ticky_ctr ->
84 absC (checking_code stk_words hHw ticky_ctr) `thenC`
91 | Just lbl <- closure_lbl = CAssign nodeReg (CLbl lbl PtrRep)
94 save_code = mkAbstractCs [node_asst, reg_save_code]
96 checking_code stk hp ctr
99 then do_checks_fun stk hp save_code
100 else do_checks_np stk hp save_code,
103 else profCtrAbsC FSLIT("TICK_ALLOC_HEAP")
104 [ mkIntCLit hp, CLbl ctr DataPtrRep ]
111 :: Int -- stack headroom
112 -> Int -- heap headroom
113 -> AbstractC -- assignments to perform on failure
115 do_checks_fun 0 0 _ = AbsCNop
116 do_checks_fun 0 hp_words assts =
117 CCheck HP_CHK_FUN [ mkIntCLit hp_words ] assts
118 do_checks_fun stk_words 0 assts =
119 CCheck STK_CHK_FUN [ mkIntCLit stk_words ] assts
120 do_checks_fun stk_words hp_words assts =
121 CCheck HP_STK_CHK_FUN [ mkIntCLit stk_words, mkIntCLit hp_words ] assts
126 :: Int -- stack headroom
127 -> Int -- heap headroom
128 -> AbstractC -- assignments to perform on failure
130 do_checks_np 0 0 _ = AbsCNop
131 do_checks_np 0 hp_words assts =
132 CCheck HP_CHK_NP [ mkIntCLit hp_words ] assts
133 do_checks_np stk_words 0 assts =
134 CCheck STK_CHK_NP [ mkIntCLit stk_words ] assts
135 do_checks_np stk_words hp_words assts =
136 CCheck HP_STK_CHK_NP [ mkIntCLit stk_words, mkIntCLit hp_words ] assts
139 Heap checks in a case alternative are nice and easy, provided this is
140 a bog-standard algebraic case. We have in our hand:
142 * one return address, on the stack,
143 * one return value, in Node.
145 the canned code for this heap check failure just pushes Node on the
146 stack, saying 'EnterGHC' to return. The scheduler will return by
147 entering the top value on the stack, which in turn will return through
148 the return address, getting us back to where we were. This is
149 therefore only valid if the return value is *lifted* (just being
150 boxed isn't good enough).
152 For primitive returns, we have an unlifted value in some register
153 (either R1 or FloatReg1 or DblReg1). This means using specialised
154 heap-check code for these cases.
156 For unboxed tuple returns, there are an arbitrary number of possibly
157 unboxed return values, some of which will be in registers, and the
158 others will be on the stack. We always organise the stack-resident
159 fields into pointers & non-pointers, and pass the number of each to
164 :: AltType -- PolyAlt, PrimAlt, AlgAlt, but *not* UbxTupAlt
165 -- (Unboxed tuples are dealt with by ubxTupleHeapCheck)
166 -> Code -- Continuation
168 altHeapCheck alt_type code
169 = initHeapUsage (\ hHw ->
170 do_heap_chk hHw `thenC`
171 setRealHp hHw `thenC`
174 do_heap_chk :: HeapOffset -> Code
175 do_heap_chk words_required
176 = getTickyCtrLabel `thenFC` \ ctr ->
177 absC ( -- NB The conditional is inside the absC,
178 -- so the monadic stuff doesn't depend on
179 -- the value of words_required!
180 if words_required == 0
183 [ CCheck (checking_code alt_type)
184 [mkIntCLit words_required] AbsCNop,
185 profCtrAbsC FSLIT("TICK_ALLOC_HEAP")
186 [ mkIntCLit words_required, CLbl ctr DataPtrRep ]
189 checking_code PolyAlt
190 = HP_CHK_UNPT_R1 -- Do *not* enter R1 after a heap check in
191 -- a polymorphic case. It might be a function
192 -- and the entry code for a function (currently)
195 -- However R1 is guaranteed to be a pointer
197 checking_code (AlgAlt tc)
198 = HP_CHK_NP -- Enter R1 after the heap check; it's a pointer
199 -- The "NP" is short for "Node (R1) Points to it"
201 checking_code (PrimAlt tc)
202 = case dataReturnConvPrim (tyConPrimRep tc) of
203 VoidReg -> HP_CHK_NOREGS
204 FloatReg 1# -> HP_CHK_F1
205 DoubleReg 1# -> HP_CHK_D1
206 LongReg _ 1# -> HP_CHK_L1
208 | isFollowableRep rep -> HP_CHK_UNPT_R1 -- R1 is boxed but unlifted:
209 | otherwise -> HP_CHK_UNBX_R1 -- R1 is unboxed
211 other_reg -> pprPanic "CgHeapery.altHeapCheck" (ppr tc <+> pprMagicId other_reg)
214 -- Unboxed tuple alternatives and let-no-escapes (the two most annoying
215 -- constructs to generate code for!):
218 :: [MagicId] -- live registers
219 -> Int -- no. of stack slots containing ptrs
220 -> Int -- no. of stack slots containing nonptrs
221 -> AbstractC -- code to insert in the failure path
225 unbxTupleHeapCheck regs ptrs nptrs fail_code code
226 -- we can't manage more than 255 pointers/non-pointers in a generic
228 | ptrs > 255 || nptrs > 255 = panic "altHeapCheck"
229 | otherwise = initHeapUsage (\ hHw -> do_heap_chk hHw `thenC` code)
231 do_heap_chk words_required
232 = getTickyCtrLabel `thenFC` \ ctr ->
233 absC ( if words_required == 0
236 [ checking_code words_required,
237 profCtrAbsC FSLIT("TICK_ALLOC_HEAP")
238 [ mkIntCLit words_required, CLbl ctr DataPtrRep ]
241 setRealHp words_required
243 liveness = I# (word2Int# (mkRegLiveness regs ptrs nptrs))
244 checking_code words_required = CCheck HP_CHK_UNBX_TUPLE
245 [mkIntCLit words_required,
249 -- build up a bitmap of the live pointer registers
251 #if __GLASGOW_HASKELL__ >= 503
252 shiftL = uncheckedShiftL#
257 mkRegLiveness :: [MagicId] -> Int -> Int -> Word#
258 mkRegLiveness [] (I# ptrs) (I# nptrs) =
259 (int2Word# nptrs `shiftL` 16#) `or#` (int2Word# ptrs `shiftL` 24#)
260 mkRegLiveness (VanillaReg rep i : regs) ptrs nptrs | isFollowableRep rep
261 = ((int2Word# 1#) `shiftL` (i -# 1#)) `or#` mkRegLiveness regs ptrs nptrs
262 mkRegLiveness (_ : regs) ptrs nptrs = mkRegLiveness regs ptrs nptrs
264 -- The two functions below are only used in a GranSim setup
265 -- Emit macro for simulating a fetch and then reschedule
267 fetchAndReschedule :: [MagicId] -- Live registers
268 -> Bool -- Node reqd?
271 fetchAndReschedule regs node_reqd =
272 if (node `elem` regs || node_reqd)
273 then fetch_code `thenC` reschedule_code
276 liveness_mask = mkRegLiveness regs 0 0
277 reschedule_code = absC (CMacroStmt GRAN_RESCHEDULE [
278 mkIntCLit (I# (word2Int# liveness_mask)),
279 mkIntCLit (if node_reqd then 1 else 0)])
281 --HWL: generate GRAN_FETCH macro for GrAnSim
282 -- currently GRAN_FETCH and GRAN_FETCH_AND_RESCHEDULE are miai
283 fetch_code = absC (CMacroStmt GRAN_FETCH [])
286 The @GRAN_YIELD@ macro is taken from JSM's code for Concurrent Haskell. It
287 allows to context-switch at places where @node@ is not alive (it uses the
288 @Continue@ rather than the @EnterNodeCode@ function in the RTS). We emit
289 this kind of macro at the beginning of the following kinds of basic bocks:
291 \item Slow entry code where node is not alive (see @CgClosure.lhs@). Normally
292 we use @fetchAndReschedule@ at a slow entry code.
293 \item Fast entry code (see @CgClosure.lhs@).
294 \item Alternatives in case expressions (@CLabelledCode@ structures), provided
295 that they are not inlined (see @CgCases.lhs@). These alternatives will
296 be turned into separate functions.
300 yield :: [MagicId] -- Live registers
301 -> Bool -- Node reqd?
304 yield regs node_reqd =
305 if opt_GranMacros && node_reqd
309 liveness_mask = mkRegLiveness regs 0 0
311 absC (CMacroStmt GRAN_YIELD
312 [mkIntCLit (I# (word2Int# liveness_mask))])
315 %************************************************************************
317 \subsection[initClosure]{Initialise a dynamic closure}
319 %************************************************************************
321 @allocDynClosure@ puts the thing in the heap, and modifies the virtual Hp
327 -> CAddrMode -- Cost Centre to stick in the object
328 -> CAddrMode -- Cost Centre to blame for this alloc
329 -- (usually the same; sometimes "OVERHEAD")
331 -> [(CAddrMode, VirtualHeapOffset)] -- Offsets from start of the object
332 -- ie Info ptr has offset zero.
333 -> FCode VirtualHeapOffset -- Returns virt offset of object
335 allocDynClosure closure_info use_cc blame_cc amodes_with_offsets
336 = getVirtAndRealHp `thenFC` \ (virtHp, realHp) ->
338 -- FIND THE OFFSET OF THE INFO-PTR WORD
339 -- virtHp points to last allocated word, ie 1 *before* the
340 -- info-ptr word of new object.
341 let info_offset = virtHp + 1
343 -- do_move IS THE ASSIGNMENT FUNCTION
344 do_move (amode, offset_from_start)
345 = CAssign (CVal (hpRel realHp
346 (info_offset + offset_from_start))
350 -- SAY WHAT WE ARE ABOUT TO DO
351 profCtrC (allocProfilingMsg closure_info)
352 [mkIntCLit (closureGoodStuffSize closure_info),
353 mkIntCLit slop_size] `thenC`
356 absC ( mkAbstractCs (
357 [ CInitHdr closure_info
358 (CAddr (hpRel realHp info_offset))
359 use_cc closure_size ]
360 ++ (map do_move amodes_with_offsets))) `thenC`
362 -- BUMP THE VIRTUAL HEAP POINTER
363 setVirtHp (virtHp + closure_size) `thenC`
365 -- RETURN PTR TO START OF OBJECT
368 closure_size = closureSize closure_info
369 slop_size = slopSize closure_info