- replace_stable_fn (MkCgIdInfo i vol stab einfo)
- = MkCgIdInfo i vol (VirStkLoc offset) einfo
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[CgBindery-liveness]{Build a liveness mask for the current stack}
-%* *
-%************************************************************************
-
-ToDo: remove the dependency on 32-bit words.
-
-There are four kinds of things on the stack:
-
- - pointer variables (bound in the environment)
- - non-pointer variables (boudn in the environment)
- - free slots (recorded in the stack free list)
- - non-pointer data slots (recorded in the stack free list)
-
-We build up a bitmap of non-pointer slots by looking down the
-environment for all the non-pointer variables, and merging this with
-the slots recorded in the stack free list.
-
-There's a bit of a hack here to do with update frames: since nothing
-is recorded in either the environment or the stack free list for an
-update frame, the code below defaults to assuming the slots taken up
-by an update frame contain pointers. Furthermore, update frames are
-always in slots 0-2 at the bottom of the stack. The bitmap will
-therefore end at slot 3, which is what we want (the update frame info
-pointer has its own bitmap to describe the update frame).
-
-\begin{code}
-buildLivenessMask
- :: Unique -- unique for for large bitmap label
- -> VirtualSpOffset -- offset from which the bitmap should start
- -> FCode Liveness -- mask for free/unlifted slots
-
-buildLivenessMask uniq sp info_down
- state@(MkCgState abs_c binds ((vsp, free, _, _), heap_usage))
- = ASSERT(all (>=0) rel_slots)
- livenessToAbsC uniq liveness_mask info_down state
- where
- -- find all unboxed stack-resident ids
- unboxed_slots =
- [ (ofs, size) |
- (MkCgIdInfo id _ (VirStkLoc ofs) _) <- rngVarEnv binds,
- let rep = idPrimRep id; size = getPrimRepSize rep,
- not (isFollowableRep rep),
- size > 0
- ]
-
- -- flatten this list into a list of unboxed stack slots
- flatten_slots = sortLt (<)
- (foldr (\(ofs,size) r -> [ofs-size+1 .. ofs] ++ r) []
- unboxed_slots)
-
- -- merge in the free slots
- all_slots = mergeSlots flatten_slots (map fst free) ++
- if vsp < sp then [vsp+1 .. sp] else []
-
- -- recalibrate the list to be sp-relative
- rel_slots = reverse (map (sp-) all_slots)
-
- -- build the bitmap
- liveness_mask = listToLivenessMask rel_slots
-
-mergeSlots :: [Int] -> [Int] -> [Int]
-mergeSlots cs [] = cs
-mergeSlots [] ns = ns
-mergeSlots (c:cs) (n:ns)
- = if c < n then
- c : mergeSlots cs (n:ns)
- else if c > n then
- n : mergeSlots (c:cs) ns
- else
- panic ("mergeSlots: equal slots: " ++ show (c:cs) ++ show (n:ns))
-
-listToLivenessMask :: [Int] -> LivenessMask
-listToLivenessMask [] = []
-listToLivenessMask slots =
- mkBS this : listToLivenessMask (map (\x -> x-32) rest)
- where (this,rest) = span (<32) slots
-
-livenessToAbsC :: Unique -> LivenessMask -> FCode Liveness
-livenessToAbsC uniq [] = returnFC (LvSmall emptyBS)
-livenessToAbsC uniq [one] = returnFC (LvSmall one)
-livenessToAbsC uniq many =
- absC (CBitmap lbl many) `thenC`
- returnFC (LvLarge lbl)
- where lbl = mkBitmapLabel uniq
-\end{code}
-
-In a continuation, we want a liveness mask that starts from just after
-the return address, which is on the stack at realSp.
-
-\begin{code}
-buildContLivenessMask
- :: Unique
- -> FCode Liveness
-buildContLivenessMask uniq
- = getRealSp `thenFC` \ realSp ->
- buildLivenessMask uniq (realSp-1)