+%************************************************************************
+%* *
+\subsection[CgBindery-liveness]{Build a liveness mask for the current stack}
+%* *
+%************************************************************************
+
+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 = do
+
+ -- find all unboxed stack-resident ids
+ binds <- getBinds
+ ((vsp, free, _, _), heap_usage) <- getUsage
+
+ let 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
+ let flatten_slots = sortLt (<)
+ (foldr (\(ofs,size) r -> [ofs-size+1 .. ofs] ++ r) []
+ unboxed_slots)
+
+ -- merge in the free slots
+ let all_slots = mergeSlots flatten_slots (map fst free) ++
+ if vsp < sp then [vsp+1 .. sp] else []
+
+ -- recalibrate the list to be sp-relative
+ let rel_slots = reverse (map (sp-) all_slots)
+
+ -- build the bitmap
+ let liveness_mask
+ = ASSERT(all (>=0) rel_slots
+ && rel_slots == sortLt (<) rel_slots)
+ (listToLivenessMask rel_slots)
+
+ livenessToAbsC uniq liveness_mask
+
+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 mask =
+ absC (CBitmap lbl mask) `thenC`
+ returnFC (Liveness lbl mask)
+ where lbl = mkBitmapLabel uniq