1 -----------------------------------------------------------------------------
3 -- Stg to C--: heap management functions
5 -- (c) The University of Glasgow 2004-2006
7 -----------------------------------------------------------------------------
10 getVirtHp, setVirtHp, setRealHp,
11 getHpRelOffset, hpRel,
13 entryHeapCheck, altHeapCheck,
15 layOutDynConstr, layOutStaticConstr,
16 mkVirtHeapOffsets, mkStaticClosureFields, mkStaticClosure,
18 allocDynClosure, emitSetDynHdr
21 #include "HsVersions.h"
43 import FastString( LitString, mkFastString, sLit )
48 -----------------------------------------------------------
49 -- Layout of heap objects
50 -----------------------------------------------------------
52 layOutDynConstr, layOutStaticConstr
53 :: DataCon -> [(PrimRep, a)]
54 -> (ClosureInfo, [(NonVoid a, VirtualHpOffset)])
55 -- No Void arguments in result
57 layOutDynConstr = layOutConstr False
58 layOutStaticConstr = layOutConstr True
60 layOutConstr :: Bool -> DataCon -> [(PrimRep, a)]
61 -> (ClosureInfo, [(NonVoid a, VirtualHpOffset)])
62 layOutConstr is_static data_con args
63 = (mkConInfo is_static data_con tot_wds ptr_wds,
66 (tot_wds, -- #ptr_wds + #nonptr_wds
68 things_w_offsets) = mkVirtHeapOffsets False{-not a thunk-} args
71 -----------------------------------------------------------
72 -- Initialise dynamic heap objects
73 -----------------------------------------------------------
77 -> CmmExpr -- Cost Centre to stick in the object
78 -> CmmExpr -- Cost Centre to blame for this alloc
79 -- (usually the same; sometimes "OVERHEAD")
81 -> [(NonVoid StgArg, VirtualHpOffset)] -- Offsets from start of the object
82 -- ie Info ptr has offset zero.
83 -- No void args in here
84 -> FCode (LocalReg, CmmAGraph)
86 -- allocDynClosure allocates the thing in the heap,
87 -- and modifies the virtual Hp to account for this.
88 -- The second return value is the graph that sets the value of the
89 -- returned LocalReg, which should point to the closure after executing
92 -- Note [Return a LocalReg]
93 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
94 -- allocDynClosure returns a LocalReg, not a (Hp+8) CmmExpr.
96 -- ...allocate object...
99 -- ...here obj is still valid,
100 -- but Hp+8 means something quite different...
103 allocDynClosure cl_info use_cc _blame_cc args_w_offsets
104 = do { virt_hp <- getVirtHp
106 -- SAY WHAT WE ARE ABOUT TO DO
107 ; tickyDynAlloc cl_info
108 ; profDynAlloc cl_info use_cc
109 -- ToDo: This is almost certainly wrong
110 -- We're ignoring blame_cc. But until we've
111 -- fixed the boxing hack in chooseDynCostCentres etc,
112 -- we're worried about making things worse by "fixing"
113 -- this part to use blame_cc!
115 -- FIND THE OFFSET OF THE INFO-PTR WORD
116 ; let info_offset = virt_hp + 1
117 -- info_offset is the VirtualHpOffset of the first
118 -- word of the new object
119 -- Remember, virtHp points to last allocated word,
120 -- ie 1 *before* the info-ptr word of new object.
122 info_ptr = CmmLit (CmmLabel (infoTableLabelFromCI cl_info))
124 -- ALLOCATE THE OBJECT
125 ; base <- getHpRelOffset info_offset
126 ; emit (mkComment $ mkFastString "allocDynClosure")
127 ; emitSetDynHdr base info_ptr use_cc
128 ; let (args, offsets) = unzip args_w_offsets
129 ; cmm_args <- mapM getArgAmode args -- No void args
130 ; hpStore base cmm_args offsets
132 -- BUMP THE VIRTUAL HEAP POINTER
133 ; setVirtHp (virt_hp + closureSize cl_info)
135 -- Assign to a temporary and return
136 -- Note [Return a LocalReg]
137 ; hp_rel <- getHpRelOffset info_offset
138 ; getCodeR $ assignTemp hp_rel }
140 emitSetDynHdr :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
141 emitSetDynHdr base info_ptr ccs
142 = hpStore base header [0..]
145 header = [info_ptr] ++ dynProfHdr ccs
146 -- ToDo: Gransim stuff
147 -- ToDo: Parallel stuff
150 hpStore :: CmmExpr -> [CmmExpr] -> [VirtualHpOffset] -> FCode ()
151 -- Store the item (expr,off) in base[off]
152 hpStore base vals offs
153 = emit (catAGraphs (zipWith mk_store vals offs))
155 mk_store val off = mkStore (cmmOffsetW base off) val
158 -----------------------------------------------------------
159 -- Layout of static closures
160 -----------------------------------------------------------
162 -- Make a static closure, adding on any extra padding needed for CAFs,
163 -- and adding a static link field if necessary.
165 mkStaticClosureFields
168 -> Bool -- Has CAF refs
169 -> [CmmLit] -- Payload
170 -> [CmmLit] -- The full closure
171 mkStaticClosureFields cl_info ccs caf_refs payload
172 = mkStaticClosure info_lbl ccs payload padding_wds
173 static_link_field saved_info_field
175 info_lbl = infoTableLabelFromCI cl_info
177 -- CAFs must have consistent layout, regardless of whether they
178 -- are actually updatable or not. The layout of a CAF is:
185 -- the static_link and saved_info fields must always be in the same
186 -- place. So we use closureNeedsUpdSpace rather than
187 -- closureUpdReqd here:
189 is_caf = closureNeedsUpdSpace cl_info
193 | otherwise = ASSERT(null payload) [mkIntCLit 0]
196 | is_caf || staticClosureNeedsLink cl_info = [static_link_value]
200 | is_caf = [mkIntCLit 0]
203 -- for a static constructor which has NoCafRefs, we set the
204 -- static link field to a non-zero value so the garbage
205 -- collector will ignore it.
207 | caf_refs = mkIntCLit 0
208 | otherwise = mkIntCLit 1
211 mkStaticClosure :: CLabel -> CostCentreStack -> [CmmLit]
212 -> [CmmLit] -> [CmmLit] -> [CmmLit] -> [CmmLit]
213 mkStaticClosure info_lbl ccs payload padding_wds static_link_field saved_info_field
214 = [CmmLabel info_lbl]
215 ++ variable_header_words
216 ++ concatMap padLitToWord payload
221 variable_header_words
227 -- JD: Simon had ellided this padding, but without it the C back end asserts failure.
228 -- Maybe it's a bad assertion, and this padding is indeed unnecessary?
229 padLitToWord :: CmmLit -> [CmmLit]
230 padLitToWord lit = lit : padding pad_length
231 where width = typeWidth (cmmLitType lit)
232 pad_length = wORD_SIZE - widthInBytes width :: Int
234 padding n | n <= 0 = []
235 | n `rem` 2 /= 0 = CmmInt 0 W8 : padding (n-1)
236 | n `rem` 4 /= 0 = CmmInt 0 W16 : padding (n-2)
237 | n `rem` 8 /= 0 = CmmInt 0 W32 : padding (n-4)
238 | otherwise = CmmInt 0 W64 : padding (n-8)
240 -----------------------------------------------------------
241 -- Heap overflow checking
242 -----------------------------------------------------------
244 {- Note [Heap checks]
246 Heap checks come in various forms. We provide the following entry
247 points to the runtime system, all of which use the native C-- entry
250 * gc() performs garbage collection and returns
251 nothing to its caller
253 * A series of canned entry points like
255 where r is a pointer. This performs gc, and
256 then returns its argument r to its caller.
258 * A series of canned entry points like
260 where f is a function closure of arity 2
261 This performs garbage collection, keeping alive the
262 three argument ptrs, and then tail-calls f(x,y)
264 These are used in the following circumstances
266 * entryHeapCheck: Function entry
267 (a) With a canned GC entry sequence
268 f( f_clo, x:ptr, y:ptr ) {
273 jump gcfun_2p( f_clo, x, y ) }
274 Note the tail call to the garbage collector;
275 it should do no register shuffling
277 (b) No canned sequence
278 f( f_clo, x:ptr, y:ptr, ...etc... ) {
283 call gc() -- Needs an info table
286 * altHeapCheck: Immediately following an eval
288 case f x y of r { (p,q) -> rhs }
289 (a) With a canned sequence for the results of f
290 (which is the very common case since
291 all boxed cases return just one pointer
294 K: -- K needs an info table
302 Here, the info table needed by the call
303 to gc_1p should be the *same* as the
304 one for the call to f; the C-- optimiser
305 spots this sharing opportunity)
307 (b) No canned sequence for results of f
308 Note second info table
310 (r1,r2,r3) = call f( x, y )
316 L: call gc() -- Extra info table here
319 * generalHeapCheck: Anywhere else
321 case branch *not* following eval,
323 Exactly the same as the previous case:
325 K: -- K needs an info table
334 --------------------------------------------------------------
335 -- A heap/stack check at a function or thunk entry point.
337 entryHeapCheck :: LocalReg -- Function (closure environment)
338 -> Int -- Arity -- not same as length args b/c of voids
339 -> [LocalReg] -- Non-void args (empty for thunk)
343 entryHeapCheck fun arity args code
344 = do updfr_sz <- getUpdFrameOff
345 heapCheck True (gc_call updfr_sz) code -- The 'fun' keeps relevant CAFs alive
347 fun_expr = CmmReg (CmmLocal fun)
348 -- JD: ugh... we should only do the following for dynamic closures
349 args' = fun_expr : map (CmmReg . CmmLocal) args
351 | arity == 0 = mkJumpGC (CmmReg (CmmGlobal GCEnter1)) args' updfr_sz
352 | otherwise = case gc_lbl (fun : args) of
353 Just lbl -> mkJumpGC (CmmLit (CmmLabel (mkRtsCodeLabel lbl)))
355 Nothing -> mkCall generic_gc GC [] [] updfr_sz
357 gc_lbl :: [LocalReg] -> Maybe LitString
360 | isGcPtrType ty = Just (sLit "stg_gc_unpt_r1") -- "stg_gc_fun_1p"
361 | isFloatType ty = case width of
362 W32 -> Just (sLit "stg_gc_f1") -- "stg_gc_fun_f1"
363 W64 -> Just (sLit "stg_gc_d1") -- "stg_gc_fun_d1"
365 | otherwise = case width of
366 W32 -> Just (sLit "stg_gc_unbx_r1") -- "stg_gc_fun_unbx_r1"
367 W64 -> Just (sLit "stg_gc_l1") -- "stg_gc_fun_unbx_l1"
368 _other -> Nothing -- Narrow cases
370 ty = localRegType reg
374 gc_lbl regs = gc_lbl_ptrs (map (isGcPtrType . localRegType) regs)
376 gc_lbl_ptrs :: [Bool] -> Maybe LitString
377 -- JD: TEMPORARY -- UNTIL THOSE FUNCTIONS EXIST...
378 --gc_lbl_ptrs [True,True] = Just (sLit "stg_gc_fun_2p")
379 --gc_lbl_ptrs [True,True,True] = Just (sLit "stg_gc_fun_3p")
380 gc_lbl_ptrs _ = Nothing
383 altHeapCheck :: [LocalReg] -> FCode a -> FCode a
384 altHeapCheck regs code
385 = do updfr_sz <- getUpdFrameOff
386 heapCheck False (gc_call updfr_sz) code
389 | null regs = mkCall generic_gc GC [] [] updfr_sz
391 | Just gc_lbl <- rts_label regs -- Canned call
392 = mkCall (CmmLit (CmmLabel (mkRtsCodeLabel gc_lbl))) GC
393 regs (map (CmmReg . CmmLocal) regs) updfr_sz
394 | otherwise -- No canned call, and non-empty live vars
395 = mkCall generic_gc GC [] [] updfr_sz
399 | isGcPtrType ty = Just (sLit "stg_gc_unpt_r1")
400 | isFloatType ty = case width of
401 W32 -> Just (sLit "stg_gc_f1")
402 W64 -> Just (sLit "stg_gc_d1")
404 | otherwise = case width of
405 W32 -> Just (sLit "stg_gc_unbx_r1")
406 W64 -> Just (sLit "stg_gc_l1") -- "stg_gc_fun_unbx_l1"
407 _other -> Nothing -- Narrow cases
409 ty = localRegType reg
413 rts_label _ = Nothing
416 generic_gc :: CmmExpr -- The generic GC procedure; no params, no resuls
417 generic_gc = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_noregs")))
418 -- JD: TEMPORARY -- UNTIL THOSE FUNCTIONS EXIST...
419 -- generic_gc = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_fun")))
421 -------------------------------
422 heapCheck :: Bool -> CmmAGraph -> FCode a -> FCode a
423 heapCheck checkStack do_gc code
424 = getHeapUsage $ \ hpHw ->
425 do { emit $ do_checks checkStack hpHw do_gc
426 -- Emit heap checks, but be sure to do it lazily so
427 -- that the conditionals on hpHw don't cause a black hole
428 ; tickyAllocHeap hpHw
429 ; doGranAllocate hpHw
433 do_checks :: Bool -- Should we check the stack?
434 -> WordOff -- Heap headroom
435 -> CmmAGraph -- What to do on failure
437 do_checks checkStack alloc do_gc
438 = withFreshLabel "gc" $ \ loop_id ->
439 withFreshLabel "gc" $ \ gc_id ->
441 <*> (let hpCheck = if alloc == 0 then mkNop
442 else mkAssign hpReg bump_hp <*>
443 mkCmmIfThen hp_oflo (save_alloc <*> mkBranch gc_id)
444 in if checkStack then
445 mkCmmIfThenElse sp_oflo (mkBranch gc_id) hpCheck
447 <*> mkComment (mkFastString "outOfLine should follow:")
448 <*> outOfLine (mkLabel gc_id
449 <*> mkComment (mkFastString "outOfLine here")
451 <*> mkBranch loop_id)
452 -- Test for stack pointer exhaustion, then
453 -- bump heap pointer, and test for heap exhaustion
454 -- Note that we don't move the heap pointer unless the
455 -- stack check succeeds. Otherwise we might end up
456 -- with slop at the end of the current block, which can
457 -- confuse the LDV profiler.
459 alloc_lit = CmmLit (mkIntCLit (alloc*wORD_SIZE)) -- Bytes
460 bump_hp = cmmOffsetExprB (CmmReg hpReg) alloc_lit
462 -- Sp overflow if (Sp - CmmHighStack < SpLim)
463 sp_oflo = CmmMachOp mo_wordULt
464 [CmmMachOp (MO_Sub (typeWidth (cmmRegType spReg)))
465 [CmmReg spReg, CmmLit CmmHighStackMark],
467 -- Hp overflow if (Hp > HpLim)
468 -- (Hp has been incremented by now)
469 -- HpLim points to the LAST WORD of valid allocation space.
470 hp_oflo = CmmMachOp mo_wordUGt
471 [CmmReg hpReg, CmmReg (CmmGlobal HpLim)]
473 save_alloc = mkAssign (CmmGlobal HpAlloc) alloc_lit
477 {- Unboxed tuple alternatives and let-no-escapes (the two most annoying
478 constructs to generate code for!) For unboxed tuple returns, there
479 are an arbitrary number of possibly unboxed return values, some of
480 which will be in registers, and the others will be on the stack. We
481 always organise the stack-resident fields into pointers &
482 non-pointers, and pass the number of each to the heap check code. -}
485 :: [(Id, GlobalReg)] -- Live registers
486 -> WordOff -- no. of stack slots containing ptrs
487 -> WordOff -- no. of stack slots containing nonptrs
488 -> CmmAGraph -- code to insert in the failure path
492 unbxTupleHeapCheck regs ptrs nptrs fail_code code
493 -- We can't manage more than 255 pointers/non-pointers
494 -- in a generic heap check.
495 | ptrs > 255 || nptrs > 255 = panic "altHeapCheck"
497 = initHeapUsage $ \ hpHw -> do
498 { codeOnly $ do { do_checks 0 {- no stack check -} hpHw
499 full_fail_code rts_label
500 ; tickyAllocHeap hpHw }
504 full_fail_code = fail_code `plusStmts` oneStmt assign_liveness
505 assign_liveness = CmmAssign (CmmGlobal (VanillaReg 9)) -- Ho ho ho!
506 (CmmLit (mkWordCLit liveness))
507 liveness = mkRegLiveness regs ptrs nptrs
508 rts_label = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_ut")))
511 {- Old Gransim comment -- I have no idea whether it still makes sense (SLPJ Sep07)
512 For GrAnSim the code for doing a heap check and doing a context switch
513 has been separated. Especially, the HEAP_CHK macro only performs a
514 heap check. THREAD_CONTEXT_SWITCH should be used for doing a context
515 switch. GRAN_FETCH_AND_RESCHEDULE must be put at the beginning of
516 every slow entry code in order to simulate the fetching of
517 closures. If fetching is necessary (i.e. current closure is not local)
518 then an automatic context switch is done. -}
521 When failing a check, we save a return address on the stack and
522 jump to a pre-compiled code fragment that saves the live registers
523 and returns to the scheduler.
525 The return address in most cases will be the beginning of the basic
526 block in which the check resides, since we need to perform the check
527 again on re-entry because someone else might have stolen the resource
530 %************************************************************************
532 Generic Heap/Stack Checks - used in the RTS
534 %************************************************************************
537 hpChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
538 hpChkGen bytes liveness reentry
539 = do_checks' bytes True assigns stg_gc_gen
542 CmmAssign (CmmGlobal (VanillaReg 9)) liveness,
543 CmmAssign (CmmGlobal (VanillaReg 10)) reentry
546 -- a heap check where R1 points to the closure to enter on return, and
547 -- we want to assign to Sp[0] on failure (used in AutoApply.cmm:BUILD_PAP).
548 hpChkNodePointsAssignSp0 :: CmmExpr -> CmmExpr -> FCode ()
549 hpChkNodePointsAssignSp0 bytes sp0
550 = do_checks' bytes True assign stg_gc_enter1
551 where assign = oneStmt (CmmStore (CmmReg spReg) sp0)
553 stg_gc_gen = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_gen")))