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"
44 import FastString( mkFastString, FastString, fsLit )
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 :: Maybe 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 args' = case fun of Just f -> f : args
349 arg_exprs = map (CmmReg . CmmLocal) args'
351 | arity == 0 = mkJumpGC (CmmReg (CmmGlobal GCEnter1)) arg_exprs updfr_sz
352 | otherwise = case gc_lbl args' of
353 Just _lbl -> panic "StgCmmHeap.entryHeapCheck: gc_lbl not finished"
354 -- mkJumpGC (CmmLit (CmmLabel (mkRtsCodeLabel lbl)))
355 -- arg_exprs updfr_sz
356 Nothing -> mkCall generic_gc (GC, GC) [] [] updfr_sz
358 gc_lbl :: [LocalReg] -> Maybe FastString
361 | isGcPtrType ty = Just (sLit "stg_gc_unpt_r1") -- "stg_gc_fun_1p"
362 | isFloatType ty = case width of
363 W32 -> Just (sLit "stg_gc_f1") -- "stg_gc_fun_f1"
364 W64 -> Just (sLit "stg_gc_d1") -- "stg_gc_fun_d1"
366 | otherwise = case width of
367 W32 -> Just (sLit "stg_gc_unbx_r1") -- "stg_gc_fun_unbx_r1"
368 W64 -> Just (sLit "stg_gc_l1") -- "stg_gc_fun_unbx_l1"
369 _other -> Nothing -- Narrow cases
371 ty = localRegType reg
375 gc_lbl regs = gc_lbl_ptrs (map (isGcPtrType . localRegType) regs)
377 gc_lbl_ptrs :: [Bool] -> Maybe FastString
378 -- JD: TEMPORARY -- UNTIL THOSE FUNCTIONS EXIST...
379 --gc_lbl_ptrs [True,True] = Just (sLit "stg_gc_fun_2p")
380 --gc_lbl_ptrs [True,True,True] = Just (sLit "stg_gc_fun_3p")
381 gc_lbl_ptrs _ = Nothing
384 altHeapCheck :: [LocalReg] -> FCode a -> FCode a
385 altHeapCheck regs code
386 = do updfr_sz <- getUpdFrameOff
387 heapCheck False (gc_call updfr_sz) code
390 | null regs = mkCall generic_gc (GC, GC) [] [] updfr_sz
392 | Just _gc_lbl <- rts_label regs -- Canned call
393 = panic "StgCmmHeap.altHeapCheck: rts_label not finished"
394 -- mkCall (CmmLit (CmmLabel (mkRtsCodeLabel gc_lbl))) (GC, GC)
395 -- regs (map (CmmReg . CmmLocal) regs) updfr_sz
396 | otherwise -- No canned call, and non-empty live vars
397 = mkCall generic_gc (GC, GC) [] [] updfr_sz
401 | isGcPtrType ty = Just (sLit "stg_gc_unpt_r1")
402 | isFloatType ty = case width of
403 W32 -> Just (sLit "stg_gc_f1")
404 W64 -> Just (sLit "stg_gc_d1")
406 | otherwise = case width of
407 W32 -> Just (sLit "stg_gc_unbx_r1")
408 W64 -> Just (sLit "stg_gc_l1") -- "stg_gc_fun_unbx_l1"
409 _other -> Nothing -- Narrow cases
411 ty = localRegType reg
415 rts_label _ = Nothing
418 generic_gc :: CmmExpr -- The generic GC procedure; no params, no resuls
419 generic_gc = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_noregs")))
420 -- JD: TEMPORARY -- UNTIL THOSE FUNCTIONS EXIST...
421 -- generic_gc = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_fun")))
423 -------------------------------
424 heapCheck :: Bool -> CmmAGraph -> FCode a -> FCode a
425 heapCheck checkStack do_gc code
426 = getHeapUsage $ \ hpHw ->
427 do { emit $ do_checks checkStack hpHw do_gc
428 -- Emit heap checks, but be sure to do it lazily so
429 -- that the conditionals on hpHw don't cause a black hole
430 ; tickyAllocHeap hpHw
431 ; doGranAllocate hpHw
435 do_checks :: Bool -- Should we check the stack?
436 -> WordOff -- Heap headroom
437 -> CmmAGraph -- What to do on failure
439 do_checks checkStack alloc do_gc
440 = withFreshLabel "gc" $ \ loop_id ->
441 withFreshLabel "gc" $ \ gc_id ->
443 <*> (let hpCheck = if alloc == 0 then mkNop
444 else mkAssign hpReg bump_hp <*>
445 mkCmmIfThen hp_oflo (save_alloc <*> mkBranch gc_id)
446 in if checkStack then
447 mkCmmIfThenElse sp_oflo (mkBranch gc_id) hpCheck
449 <*> mkComment (mkFastString "outOfLine should follow:")
450 <*> outOfLine (mkLabel gc_id
451 <*> mkComment (mkFastString "outOfLine here")
453 <*> mkBranch loop_id)
454 -- Test for stack pointer exhaustion, then
455 -- bump heap pointer, and test for heap exhaustion
456 -- Note that we don't move the heap pointer unless the
457 -- stack check succeeds. Otherwise we might end up
458 -- with slop at the end of the current block, which can
459 -- confuse the LDV profiler.
461 alloc_lit = CmmLit (mkIntCLit (alloc*wORD_SIZE)) -- Bytes
462 bump_hp = cmmOffsetExprB (CmmReg hpReg) alloc_lit
464 -- Sp overflow if (Sp - CmmHighStack < SpLim)
465 sp_oflo = CmmMachOp mo_wordULt
466 [CmmMachOp (MO_Sub (typeWidth (cmmRegType spReg)))
467 [CmmReg spReg, CmmLit CmmHighStackMark],
469 -- Hp overflow if (Hp > HpLim)
470 -- (Hp has been incremented by now)
471 -- HpLim points to the LAST WORD of valid allocation space.
472 hp_oflo = CmmMachOp mo_wordUGt
473 [CmmReg hpReg, CmmReg (CmmGlobal HpLim)]
475 save_alloc = mkAssign (CmmGlobal HpAlloc) alloc_lit
479 {- Unboxed tuple alternatives and let-no-escapes (the two most annoying
480 constructs to generate code for!) For unboxed tuple returns, there
481 are an arbitrary number of possibly unboxed return values, some of
482 which will be in registers, and the others will be on the stack. We
483 always organise the stack-resident fields into pointers &
484 non-pointers, and pass the number of each to the heap check code. -}
487 :: [(Id, GlobalReg)] -- Live registers
488 -> WordOff -- no. of stack slots containing ptrs
489 -> WordOff -- no. of stack slots containing nonptrs
490 -> CmmAGraph -- code to insert in the failure path
494 unbxTupleHeapCheck regs ptrs nptrs fail_code code
495 -- We can't manage more than 255 pointers/non-pointers
496 -- in a generic heap check.
497 | ptrs > 255 || nptrs > 255 = panic "altHeapCheck"
499 = initHeapUsage $ \ hpHw -> do
500 { codeOnly $ do { do_checks 0 {- no stack check -} hpHw
501 full_fail_code rts_label
502 ; tickyAllocHeap hpHw }
506 full_fail_code = fail_code `plusStmts` oneStmt assign_liveness
507 assign_liveness = CmmAssign (CmmGlobal (VanillaReg 9)) -- Ho ho ho!
508 (CmmLit (mkWordCLit liveness))
509 liveness = mkRegLiveness regs ptrs nptrs
510 rts_label = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_ut")))
513 {- Old Gransim comment -- I have no idea whether it still makes sense (SLPJ Sep07)
514 For GrAnSim the code for doing a heap check and doing a context switch
515 has been separated. Especially, the HEAP_CHK macro only performs a
516 heap check. THREAD_CONTEXT_SWITCH should be used for doing a context
517 switch. GRAN_FETCH_AND_RESCHEDULE must be put at the beginning of
518 every slow entry code in order to simulate the fetching of
519 closures. If fetching is necessary (i.e. current closure is not local)
520 then an automatic context switch is done. -}
523 When failing a check, we save a return address on the stack and
524 jump to a pre-compiled code fragment that saves the live registers
525 and returns to the scheduler.
527 The return address in most cases will be the beginning of the basic
528 block in which the check resides, since we need to perform the check
529 again on re-entry because someone else might have stolen the resource
532 %************************************************************************
534 Generic Heap/Stack Checks - used in the RTS
536 %************************************************************************
539 hpChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
540 hpChkGen bytes liveness reentry
541 = do_checks' bytes True assigns stg_gc_gen
544 CmmAssign (CmmGlobal (VanillaReg 9)) liveness,
545 CmmAssign (CmmGlobal (VanillaReg 10)) reentry
548 -- a heap check where R1 points to the closure to enter on return, and
549 -- we want to assign to Sp[0] on failure (used in AutoApply.cmm:BUILD_PAP).
550 hpChkNodePointsAssignSp0 :: CmmExpr -> CmmExpr -> FCode ()
551 hpChkNodePointsAssignSp0 bytes sp0
552 = do_checks' bytes True assign stg_gc_enter1
553 where assign = oneStmt (CmmStore (CmmReg spReg) sp0)
555 stg_gc_gen = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "stg_gc_gen")))