2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: CgHeapery.lhs,v 1.46 2005/04/21 15:28:20 simonmar Exp $
6 \section[CgHeapery]{Heap management functions}
10 initHeapUsage, getVirtHp, setVirtHp, setRealHp,
11 getHpRelOffset, hpRel,
13 funEntryChecks, thunkEntryChecks,
14 altHeapCheck, unbxTupleHeapCheck,
15 hpChkGen, hpChkNodePointsAssignSp0,
16 stkChkGen, stkChkNodePoints,
18 layOutDynConstr, layOutStaticConstr,
19 mkVirtHeapOffsets, mkStaticClosureFields, mkStaticClosure,
21 allocDynClosure, emitSetDynHdr
24 #include "HsVersions.h"
26 import Constants ( mIN_UPD_SIZE )
27 import StgSyn ( AltType(..) )
28 import CLabel ( CLabel, mkRtsCodeLabel )
29 import CgUtils ( mkWordCLit, cmmRegOffW, cmmOffsetW,
32 import CgProf ( staticProfHdr, profDynAlloc, dynProfHdr )
33 import CgTicky ( staticTickyHdr, tickyDynAlloc, tickyAllocHeap )
34 import CgParallel ( staticGranHdr, staticParHdr, doGranAllocate )
35 import CgStackery ( getFinalStackHW, getRealSp )
36 import CgCallConv ( mkRegLiveness )
37 import ClosureInfo ( closureSize, staticClosureNeedsLink,
38 mkConInfo, closureNeedsUpdSpace,
39 infoTableLabelFromCI, closureLabelFromCI,
40 nodeMustPointToIt, closureLFInfo,
42 import SMRep ( CgRep(..), cgRepSizeW, separateByPtrFollowness,
43 WordOff, fixedHdrSize, thunkHdrSize,
44 isVoidArg, primRepToCgRep )
46 import Cmm ( CmmLit(..), CmmStmt(..), CmmExpr(..), GlobalReg(..),
47 CmmReg(..), hpReg, nodeReg, spReg )
48 import MachOp ( mo_wordULt, mo_wordUGt, mo_wordSub )
49 import CmmUtils ( mkIntCLit, CmmStmts, noStmts, oneStmt, plusStmts,
52 import DataCon ( DataCon )
53 import TyCon ( tyConPrimRep )
54 import CostCentre ( CostCentreStack )
55 import Util ( mapAccumL, filterOut )
56 import Constants ( wORD_SIZE )
57 import DynFlags ( DynFlags )
65 %************************************************************************
67 \subsection[CgUsages-heapery]{Monad things for fiddling with heap usage}
69 %************************************************************************
71 The heap always grows upwards, so hpRel is easy
74 hpRel :: VirtualHpOffset -- virtual offset of Hp
75 -> VirtualHpOffset -- virtual offset of The Thing
76 -> WordOff -- integer word offset
77 hpRel hp off = off - hp
80 @initHeapUsage@ applies a function to the amount of heap that it uses.
81 It initialises the heap usage to zeros, and passes on an unchanged
84 It is usually a prelude to performing a GC check, so everything must
85 be in a tidy and consistent state.
87 rje: Note the slightly suble fixed point behaviour needed here
90 initHeapUsage :: (VirtualHpOffset -> Code) -> Code
92 = do { orig_hp_usage <- getHpUsage
93 ; setHpUsage initHpUsage
94 ; fixC (\heap_usage2 -> do
95 { fcode (heapHWM heap_usage2)
97 ; setHpUsage orig_hp_usage }
99 setVirtHp :: VirtualHpOffset -> Code
101 = do { hp_usage <- getHpUsage
102 ; setHpUsage (hp_usage {virtHp = new_virtHp}) }
104 getVirtHp :: FCode VirtualHpOffset
106 = do { hp_usage <- getHpUsage
107 ; return (virtHp hp_usage) }
109 setRealHp :: VirtualHpOffset -> Code
111 = do { hp_usage <- getHpUsage
112 ; setHpUsage (hp_usage {realHp = new_realHp}) }
114 getHpRelOffset :: VirtualHpOffset -> FCode CmmExpr
115 getHpRelOffset virtual_offset
116 = do { hp_usg <- getHpUsage
117 ; return (cmmRegOffW hpReg (hpRel (realHp hp_usg) virtual_offset)) }
121 %************************************************************************
123 Layout of heap objects
125 %************************************************************************
128 layOutDynConstr, layOutStaticConstr
133 [(a,VirtualHpOffset)])
135 layOutDynConstr = layOutConstr False
136 layOutStaticConstr = layOutConstr True
138 layOutConstr is_static dflags data_con args
139 = (mkConInfo dflags is_static data_con tot_wds ptr_wds,
142 (tot_wds, -- #ptr_wds + #nonptr_wds
144 things_w_offsets) = mkVirtHeapOffsets False{-not a thunk-} args
147 @mkVirtHeapOffsets@ always returns boxed things with smaller offsets
148 than the unboxed things, and furthermore, the offsets in the result
153 :: Bool -- True <=> is a thunk
154 -> [(CgRep,a)] -- Things to make offsets for
155 -> (WordOff, -- _Total_ number of words allocated
156 WordOff, -- Number of words allocated for *pointers*
157 [(a, VirtualHpOffset)])
158 -- Things with their offsets from start of
159 -- object in order of increasing offset
161 -- First in list gets lowest offset, which is initial offset + 1.
163 mkVirtHeapOffsets is_thunk things
164 = let non_void_things = filterOut (isVoidArg . fst) things
165 (ptrs, non_ptrs) = separateByPtrFollowness non_void_things
166 (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
167 (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
169 (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
171 hdr_size | is_thunk = thunkHdrSize
172 | otherwise = fixedHdrSize
174 computeOffset wds_so_far (rep, thing)
175 = (wds_so_far + cgRepSizeW rep, (thing, hdr_size + wds_so_far))
179 %************************************************************************
181 Lay out a static closure
183 %************************************************************************
185 Make a static closure, adding on any extra padding needed for CAFs,
186 and adding a static link field if necessary.
189 mkStaticClosureFields
192 -> Bool -- Has CAF refs
193 -> [CmmLit] -- Payload
194 -> [CmmLit] -- The full closure
195 mkStaticClosureFields cl_info ccs caf_refs payload
196 = mkStaticClosure info_lbl ccs payload padding_wds
197 static_link_field saved_info_field
199 info_lbl = infoTableLabelFromCI cl_info
201 -- CAFs must have consistent layout, regardless of whether they
202 -- are actually updatable or not. The layout of a CAF is:
209 -- the static_link and saved_info fields must always be in the same
210 -- place. So we use closureNeedsUpdSpace rather than
211 -- closureUpdReqd here:
213 is_caf = closureNeedsUpdSpace cl_info
217 | otherwise = replicate n (mkIntCLit 0) -- a bunch of 0s
218 where n = max 0 (mIN_UPD_SIZE - length payload)
221 | is_caf || staticClosureNeedsLink cl_info = [static_link_value]
225 | is_caf = [mkIntCLit 0]
228 -- for a static constructor which has NoCafRefs, we set the
229 -- static link field to a non-zero value so the garbage
230 -- collector will ignore it.
232 | caf_refs = mkIntCLit 0
233 | otherwise = mkIntCLit 1
236 mkStaticClosure :: CLabel -> CostCentreStack -> [CmmLit]
237 -> [CmmLit] -> [CmmLit] -> [CmmLit] -> [CmmLit]
238 mkStaticClosure info_lbl ccs payload padding_wds static_link_field saved_info_field
239 = [CmmLabel info_lbl]
240 ++ variable_header_words
246 variable_header_words
253 %************************************************************************
255 \subsection[CgHeapery-heap-overflow]{Heap overflow checking}
257 %************************************************************************
259 The new code for heapChecks. For GrAnSim the code for doing a heap check
260 and doing a context switch has been separated. Especially, the HEAP_CHK
261 macro only performs a heap check. THREAD_CONTEXT_SWITCH should be used for
262 doing a context switch. GRAN_FETCH_AND_RESCHEDULE must be put at the
263 beginning of every slow entry code in order to simulate the fetching of
264 closures. If fetching is necessary (i.e. current closure is not local) then
265 an automatic context switch is done.
267 --------------------------------------------------------------
268 A heap/stack check at a function or thunk entry point.
271 funEntryChecks :: ClosureInfo -> CmmStmts -> Code -> Code
272 funEntryChecks cl_info reg_save_code code
273 = hpStkCheck cl_info True reg_save_code code
275 thunkEntryChecks :: ClosureInfo -> Code -> Code
276 thunkEntryChecks cl_info code
277 = hpStkCheck cl_info False noStmts code
279 hpStkCheck :: ClosureInfo -- Function closure
280 -> Bool -- Is a function? (not a thunk)
281 -> CmmStmts -- Register saves
285 hpStkCheck cl_info is_fun reg_save_code code
286 = getFinalStackHW $ \ spHw -> do
288 ; let stk_words = spHw - sp
289 ; initHeapUsage $ \ hpHw -> do
290 { -- Emit heap checks, but be sure to do it lazily so
291 -- that the conditionals on hpHw don't cause a black hole
293 { do_checks stk_words hpHw full_save_code rts_label
294 ; tickyAllocHeap hpHw }
300 | nodeMustPointToIt (closureLFInfo cl_info)
303 = oneStmt (CmmAssign nodeReg (CmmLit (CmmLabel closure_lbl)))
304 closure_lbl = closureLabelFromCI cl_info
306 full_save_code = node_asst `plusStmts` reg_save_code
308 rts_label | is_fun = CmmReg (CmmGlobal GCFun)
309 -- Function entry point
310 | otherwise = CmmReg (CmmGlobal GCEnter1)
311 -- Thunk or case return
312 -- In the thunk/case-return case, R1 points to a closure
313 -- which should be (re)-entered after GC
316 Heap checks in a case alternative are nice and easy, provided this is
317 a bog-standard algebraic case. We have in our hand:
319 * one return address, on the stack,
320 * one return value, in Node.
322 the canned code for this heap check failure just pushes Node on the
323 stack, saying 'EnterGHC' to return. The scheduler will return by
324 entering the top value on the stack, which in turn will return through
325 the return address, getting us back to where we were. This is
326 therefore only valid if the return value is *lifted* (just being
327 boxed isn't good enough).
329 For primitive returns, we have an unlifted value in some register
330 (either R1 or FloatReg1 or DblReg1). This means using specialised
331 heap-check code for these cases.
335 :: AltType -- PolyAlt, PrimAlt, AlgAlt, but *not* UbxTupAlt
336 -- (Unboxed tuples are dealt with by ubxTupleHeapCheck)
337 -> Code -- Continuation
339 altHeapCheck alt_type code
340 = initHeapUsage $ \ hpHw -> do
342 { do_checks 0 {- no stack chk -} hpHw
343 noStmts {- nothign to save -}
345 ; tickyAllocHeap hpHw }
349 rts_label PolyAlt = CmmLit (CmmLabel (mkRtsCodeLabel SLIT( "stg_gc_unpt_r1")))
350 -- Do *not* enter R1 after a heap check in
351 -- a polymorphic case. It might be a function
352 -- and the entry code for a function (currently)
355 -- However R1 is guaranteed to be a pointer
357 rts_label (AlgAlt tc) = stg_gc_enter1
358 -- Enter R1 after the heap check; it's a pointer
360 rts_label (PrimAlt tc)
361 = CmmLit $ CmmLabel $
362 case primRepToCgRep (tyConPrimRep tc) of
363 VoidArg -> mkRtsCodeLabel SLIT( "stg_gc_noregs")
364 FloatArg -> mkRtsCodeLabel SLIT( "stg_gc_f1")
365 DoubleArg -> mkRtsCodeLabel SLIT( "stg_gc_d1")
366 LongArg -> mkRtsCodeLabel SLIT( "stg_gc_l1")
367 -- R1 is boxed but unlifted:
368 PtrArg -> mkRtsCodeLabel SLIT( "stg_gc_unpt_r1")
370 NonPtrArg -> mkRtsCodeLabel SLIT( "stg_gc_unbx_r1")
372 rts_label (UbxTupAlt _) = panic "altHeapCheck"
376 Unboxed tuple alternatives and let-no-escapes (the two most annoying
377 constructs to generate code for!) For unboxed tuple returns, there
378 are an arbitrary number of possibly unboxed return values, some of
379 which will be in registers, and the others will be on the stack. We
380 always organise the stack-resident fields into pointers &
381 non-pointers, and pass the number of each to the heap check code.
385 :: [(Id, GlobalReg)] -- Live registers
386 -> WordOff -- no. of stack slots containing ptrs
387 -> WordOff -- no. of stack slots containing nonptrs
388 -> CmmStmts -- code to insert in the failure path
392 unbxTupleHeapCheck regs ptrs nptrs fail_code code
393 -- We can't manage more than 255 pointers/non-pointers
394 -- in a generic heap check.
395 | ptrs > 255 || nptrs > 255 = panic "altHeapCheck"
397 = initHeapUsage $ \ hpHw -> do
398 { codeOnly $ do { do_checks 0 {- no stack check -} hpHw
399 full_fail_code rts_label
400 ; tickyAllocHeap hpHw }
404 full_fail_code = fail_code `plusStmts` oneStmt assign_liveness
405 assign_liveness = CmmAssign (CmmGlobal (VanillaReg 9)) -- Ho ho ho!
406 (CmmLit (mkWordCLit liveness))
407 liveness = mkRegLiveness regs ptrs nptrs
408 rts_label = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("stg_gc_ut")))
413 %************************************************************************
417 %************************************************************************
419 When failing a check, we save a return address on the stack and
420 jump to a pre-compiled code fragment that saves the live registers
421 and returns to the scheduler.
423 The return address in most cases will be the beginning of the basic
424 block in which the check resides, since we need to perform the check
425 again on re-entry because someone else might have stolen the resource
429 do_checks :: WordOff -- Stack headroom
430 -> WordOff -- Heap headroom
431 -> CmmStmts -- Assignments to perform on failure
432 -> CmmExpr -- Rts address to jump to on failure
434 do_checks 0 0 _ _ = nopC
435 do_checks stk hp reg_save_code rts_lbl
436 = do_checks' (CmmLit (mkIntCLit (stk*wORD_SIZE)))
437 (CmmLit (mkIntCLit (hp*wORD_SIZE)))
438 (stk /= 0) (hp /= 0) reg_save_code rts_lbl
440 -- The offsets are now in *bytes*
441 do_checks' stk_expr hp_expr stk_nonzero hp_nonzero reg_save_code rts_lbl
442 = do { doGranAllocate hp_expr
444 -- Emit a block for the heap-check-failure code
445 ; blk_id <- forkLabelledCode $ do
447 stmtC (CmmAssign (CmmGlobal HpAlloc) hp_expr)
448 ; emitStmts reg_save_code
449 ; stmtC (CmmJump rts_lbl []) }
451 -- Check for stack overflow *FIRST*; otherwise
452 -- we might bumping Hp and then failing stack oflo
454 (stmtC (CmmCondBranch stk_oflo blk_id))
457 (stmtsC [CmmAssign hpReg
458 (cmmOffsetExprB (CmmReg hpReg) hp_expr),
459 CmmCondBranch hp_oflo blk_id])
460 -- Bump heap pointer, and test for heap exhaustion
461 -- Note that we don't move the heap pointer unless the
462 -- stack check succeeds. Otherwise we might end up
463 -- with slop at the end of the current block, which can
464 -- confuse the LDV profiler.
467 -- Stk overflow if (Sp - stk_bytes < SpLim)
468 stk_oflo = CmmMachOp mo_wordULt
469 [CmmMachOp mo_wordSub [CmmReg spReg, stk_expr],
470 CmmReg (CmmGlobal SpLim)]
472 -- Hp overflow if (Hpp > HpLim)
473 -- (Hp has been incremented by now)
474 -- HpLim points to the LAST WORD of valid allocation space.
475 hp_oflo = CmmMachOp mo_wordUGt
476 [CmmReg hpReg, CmmReg (CmmGlobal HpLim)]
479 %************************************************************************
481 Generic Heap/Stack Checks - used in the RTS
483 %************************************************************************
486 hpChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> Code
487 hpChkGen bytes liveness reentry
488 = do_checks' (CmmLit (mkIntCLit 0)) bytes False True assigns stg_gc_gen
491 CmmAssign (CmmGlobal (VanillaReg 9)) liveness,
492 CmmAssign (CmmGlobal (VanillaReg 10)) reentry
495 -- a heap check where R1 points to the closure to enter on return, and
496 -- we want to assign to Sp[0] on failure (used in AutoApply.cmm:BUILD_PAP).
497 hpChkNodePointsAssignSp0 :: CmmExpr -> CmmExpr -> Code
498 hpChkNodePointsAssignSp0 bytes sp0
499 = do_checks' (CmmLit (mkIntCLit 0)) bytes False True assign stg_gc_enter1
500 where assign = oneStmt (CmmStore (CmmReg spReg) sp0)
502 stkChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> Code
503 stkChkGen bytes liveness reentry
504 = do_checks' bytes (CmmLit (mkIntCLit 0)) True False assigns stg_gc_gen
507 CmmAssign (CmmGlobal (VanillaReg 9)) liveness,
508 CmmAssign (CmmGlobal (VanillaReg 10)) reentry
511 stkChkNodePoints :: CmmExpr -> Code
512 stkChkNodePoints bytes
513 = do_checks' bytes (CmmLit (mkIntCLit 0)) True False noStmts stg_gc_enter1
515 stg_gc_gen = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("stg_gc_gen")))
516 stg_gc_enter1 = CmmReg (CmmGlobal GCEnter1)
519 %************************************************************************
521 \subsection[initClosure]{Initialise a dynamic closure}
523 %************************************************************************
525 @allocDynClosure@ puts the thing in the heap, and modifies the virtual Hp
531 -> CmmExpr -- Cost Centre to stick in the object
532 -> CmmExpr -- Cost Centre to blame for this alloc
533 -- (usually the same; sometimes "OVERHEAD")
535 -> [(CmmExpr, VirtualHpOffset)] -- Offsets from start of the object
536 -- ie Info ptr has offset zero.
537 -> FCode VirtualHpOffset -- Returns virt offset of object
539 allocDynClosure cl_info use_cc blame_cc amodes_with_offsets
540 = do { virt_hp <- getVirtHp
542 -- FIND THE OFFSET OF THE INFO-PTR WORD
543 ; let info_offset = virt_hp + 1
544 -- info_offset is the VirtualHpOffset of the first
545 -- word of the new object
546 -- Remember, virtHp points to last allocated word,
547 -- ie 1 *before* the info-ptr word of new object.
549 info_ptr = CmmLit (CmmLabel (infoTableLabelFromCI cl_info))
550 hdr_w_offsets = initDynHdr info_ptr use_cc `zip` [0..]
552 -- SAY WHAT WE ARE ABOUT TO DO
553 ; profDynAlloc cl_info use_cc
554 -- ToDo: This is almost certainly wrong
555 -- We're ignoring blame_cc. But until we've
556 -- fixed the boxing hack in chooseDynCostCentres etc,
557 -- we're worried about making things worse by "fixing"
558 -- this part to use blame_cc!
560 ; tickyDynAlloc cl_info
562 -- ALLOCATE THE OBJECT
563 ; base <- getHpRelOffset info_offset
564 ; hpStore base (hdr_w_offsets ++ amodes_with_offsets)
566 -- BUMP THE VIRTUAL HEAP POINTER
567 ; setVirtHp (virt_hp + closureSize cl_info)
569 -- RETURN PTR TO START OF OBJECT
570 ; returnFC info_offset }
573 initDynHdr :: CmmExpr
574 -> CmmExpr -- Cost centre to put in object
576 initDynHdr info_ptr cc
578 -- ToDo: Gransim stuff
579 -- ToDo: Parallel stuff
583 hpStore :: CmmExpr -> [(CmmExpr, VirtualHpOffset)] -> Code
584 -- Store the item (expr,off) in base[off]
586 = stmtsC [ CmmStore (cmmOffsetW base off) val
589 emitSetDynHdr :: CmmExpr -> CmmExpr -> CmmExpr -> Code
590 emitSetDynHdr base info_ptr ccs
591 = hpStore base (zip (initDynHdr info_ptr ccs) [0..])