-getEndOfBlockInfo (MkCgInfoDown c_info statics eob_info) state
- = (eob_info, state)
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[CgMonad-bindery]{Monad things for fiddling with @CgBindings@}
-%* *
-%************************************************************************
-
-There are three basic routines, for adding (@addBindC@), modifying
-(@modifyBindC@) and looking up (@lookupBindC@) bindings. Each routine
-is just a wrapper for its lower-level @Bind@ routine (drop the \tr{C}
-on the end of each function name).
-
-A @Id@ is bound to a @(VolatileLoc, StableLoc)@ triple.
-The name should not already be bound. (nice ASSERT, eh?)
-\begin{code}
-addBindC :: Id -> CgIdInfo -> Code
-addBindC name stuff_to_bind info_down (MkCgState absC binds usage)
- = MkCgState absC (addOneToIdEnv binds name stuff_to_bind) usage
-\end{code}
-
-\begin{code}
-addBindsC :: [(Id, CgIdInfo)] -> Code
-addBindsC new_bindings info_down (MkCgState absC binds usage)
- = MkCgState absC new_binds usage
- where
- new_binds = foldl (\ binds (name,info) -> addOneToIdEnv binds name info)
- binds
- new_bindings
-\end{code}
-
-\begin{code}
-modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> Code
-modifyBindC name mangle_fn info_down (MkCgState absC binds usage)
- = MkCgState absC (modifyIdEnv binds mangle_fn name) usage
-\end{code}
-
-Lookup is expected to find a binding for the @Id@.
-\begin{code}
-lookupBindC :: Id -> FCode CgIdInfo
-lookupBindC name info_down@(MkCgInfoDown _ static_binds _)
- state@(MkCgState absC local_binds usage)
- = (val, state)
- where
- val = case (lookupIdEnv local_binds name) of
- Nothing -> try_static
- Just this -> this
-
- try_static = case (lookupIdEnv static_binds name) of
- Just this -> this
- Nothing
- -> pprPanic "lookupBindC:no info!\n"
- (ppAboves [
- ppCat [ppStr "for:", ppr PprShowAll name],
- ppStr "(probably: data dependencies broken by an optimisation pass)",
- ppStr "static binds for:",
- ppAboves [ ppr PprDebug i | (MkCgIdInfo i _ _ _) <- rngIdEnv static_binds ],
- ppStr "local binds for:",
- ppAboves [ ppr PprDebug i | (MkCgIdInfo i _ _ _) <- rngIdEnv local_binds ]
- ])
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[CgStackery-deadslots]{Finding dead stack slots}
-%* *
-%************************************************************************
-
-@nukeDeadBindings@ does the following:
-\begin{itemize}
-\item Removes all bindings from the environment other than those
- for variables in the argument to @nukeDeadBindings@.
-\item Collects any stack slots so freed, and returns them to the appropriate
- stack free list.
-\item Moves the virtual stack pointers to point to the topmost used
- stack locations.
-\end{itemize}
-
-Find dead slots on the stacks *and* remove bindings for dead variables
-from the bindings.
-
-You can have multi-word slots on the B stack; if dead, such a slot
-will be reported as {\em several} offsets (one per word).
-
-NOT YET: It returns empty lists if the -fno-stack-stubbing flag is
-set, so that no stack-stubbing will take place.
-
-Probably *naughty* to look inside monad...
-
-\begin{code}
-nukeDeadBindings :: StgLiveVars -- All the *live* variables
- -> Code
-nukeDeadBindings
- live_vars
- info_down
- state@(MkCgState abs_c binds ((vsp_a, free_a, real_a, hw_a),
- (vsp_b, free_b, real_b, hw_b),
- heap_usage))
- = MkCgState abs_c (mkIdEnv bs') new_usage
- where
- new_usage = ((new_vsp_a, new_free_a, real_a, hw_a),
- (new_vsp_b, new_free_b, real_b, hw_b),
- heap_usage)
-
- (dead_a_slots, dead_b_slots, bs')
- = dead_slots live_vars
- [] [] []
- [ (i, b) | b@(MkCgIdInfo i _ _ _) <- rngIdEnv binds ]
-
- extra_free_a = (sortLt (<) dead_a_slots) `zip` (repeat NotStubbed)
- extra_free_b = sortLt (<) dead_b_slots
-
- (new_vsp_a, new_free_a) = trim fst vsp_a (addFreeASlots free_a extra_free_a)
- (new_vsp_b, new_free_b) = trim id vsp_b (addFreeBSlots free_b extra_free_b)
-
-getUnstubbedAStackSlots
- :: VirtualSpAOffset -- Ignore slots bigger than this
- -> FCode [VirtualSpAOffset] -- Return the list of slots found
-
-getUnstubbedAStackSlots tail_spa
- info_down state@(MkCgState _ _ ((_, free_a, _, _), _, _))
- = ([ slot | (slot, NotStubbed) <- free_a, slot <= tail_spa ], state)
-\end{code}
-
-Several boring auxiliary functions to do the dirty work.
-
-\begin{code}
-dead_slots :: StgLiveVars
- -> [(Id,CgIdInfo)] -> [VirtualSpAOffset] -> [VirtualSpBOffset]
- -> [(Id,CgIdInfo)]
- -> ([VirtualSpAOffset], [VirtualSpBOffset], [(Id,CgIdInfo)])
-
--- dead_slots carries accumulating parameters for
--- filtered bindings, dead a and b slots
-dead_slots live_vars fbs das dbs []
- = (nub das, nub dbs, reverse fbs) -- Finished; rm the dups, if any
-
-dead_slots live_vars fbs das dbs ((v,i):bs)
- | v `elementOfUniqSet` live_vars
- = dead_slots live_vars ((v,i):fbs) das dbs bs
- -- Live, so don't record it in dead slots
- -- Instead keep it in the filtered bindings
-
- | otherwise
- = case i of
- MkCgIdInfo _ _ stable_loc _
- | is_Astk_loc ->
- dead_slots live_vars fbs (offsetA : das) dbs bs
-
- | is_Bstk_loc ->
- dead_slots live_vars fbs das ([offsetB .. (offsetB + size - 1)] ++ dbs) bs
- where
- maybe_Astk_loc = maybeAStkLoc stable_loc
- is_Astk_loc = maybeToBool maybe_Astk_loc
- (Just offsetA) = maybe_Astk_loc
-
- maybe_Bstk_loc = maybeBStkLoc stable_loc
- is_Bstk_loc = maybeToBool maybe_Bstk_loc
- (Just offsetB) = maybe_Bstk_loc
-
- _ -> dead_slots live_vars fbs das dbs bs
- where
- size :: Int
- size = (getPrimRepSize . typePrimRep . idType) v
-
--- addFreeSlots expects *both* args to be in increasing order
-addFreeASlots :: [(Int,StubFlag)] -> [(Int,StubFlag)] -> [(Int,StubFlag)]
-addFreeASlots = addFreeSlots fst
-
-addFreeBSlots :: [Int] -> [Int] -> [Int]
-addFreeBSlots = addFreeSlots id
-
-addFreeSlots :: (slot -> Int{-offset-}) -> [slot] -> [slot] -> [slot]
-
-addFreeSlots get_offset cs [] = cs
-addFreeSlots get_offset [] ns = ns
-addFreeSlots get_offset (c:cs) (n:ns)
- = if off_c < off_n then
- (c : addFreeSlots get_offset cs (n:ns))
- else if off_c > off_n then
- (n : addFreeSlots get_offset (c:cs) ns)
- else
- panic ("addFreeSlots: equal slots: ")-- ++ show (c:cs) ++ show (n:ns))
- where
- off_c = get_offset c
- off_n = get_offset n
-
-trim :: (slot -> Int{-offset-}) -> Int{-offset-} -> [slot] -> (Int{-offset-}, [slot])
-
-trim get_offset current_sp free_slots
- = try current_sp (reverse free_slots)
- where
- try csp [] = (csp, [])
- try csp (slot:slots)
- = if csp < slot_off then
- try csp slots -- Free slot off top of stk; ignore
-
- else if csp == slot_off then
- try (csp-1) slots -- Free slot at top of stk; trim
-
- else
- (csp, reverse (slot:slots)) -- Otherwise gap; give up
- where
- slot_off = get_offset slot