ghc/compiler/codeGen/CgBindery.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[CgBindery]{Utility functions related to doing @CgBindings@}
   5
   6 \begin{code}
   7 module CgBindery (
   8         CgBindings, CgIdInfo,
   9         StableLoc, VolatileLoc,
  10
  11         stableAmodeIdInfo, heapIdInfo, newTempAmodeAndIdInfo,
  12         letNoEscapeIdInfo, idInfoToAmode,
  13
  14         addBindC, addBindsC,
  15
  16         nukeVolatileBinds,
  17         nukeDeadBindings,
  18
  19         bindNewToStack,  rebindToStack,
  20         bindNewToNode, bindNewToReg, bindArgsToRegs,
  21         bindNewToTemp, bindNewPrimToAmode,
  22         getArgAmode, getArgAmodes,
  23         getCAddrModeAndInfo, getCAddrMode,
  24         getCAddrModeIfVolatile, getVolatileRegs,
  25
  26         buildLivenessMask, buildContLivenessMask
  27     ) where
  28
  29 #include "HsVersions.h"
  30
  31 import AbsCSyn
  32 import CgMonad
  33
  34 import CgUsages         ( getHpRelOffset, getSpRelOffset, getRealSp )
  35 import CgStackery       ( freeStackSlots )
  36 import CLabel           ( mkClosureLabel,
  37                           mkBitmapLabel, pprCLabel )
  38 import ClosureInfo      ( mkLFImported, mkLFArgument, LambdaFormInfo )
  39 import BitSet           ( mkBS, emptyBS )
  40 import PrimRep          ( isFollowableRep, getPrimRepSize )
  41 import DataCon          ( DataCon, dataConName )
  42 import Id               ( Id, idPrimRep, idType, isDataConWrapId )
  43 import Type             ( typePrimRep )
  44 import VarEnv
  45 import VarSet           ( varSetElems )
  46 import Literal          ( Literal )
  47 import Maybes           ( catMaybes, maybeToBool )
  48 import Name             ( isLocallyDefined, NamedThing(..) )
  49 #ifdef DEBUG
  50 import PprAbsC          ( pprAmode )
  51 #endif
  52 import PrimRep          ( PrimRep(..) )
  53 import StgSyn           ( StgArg, StgLiveVars, GenStgArg(..), isStgTypeArg )
  54 import Unique           ( Unique, Uniquable(..) )
  55 import UniqSet          ( elementOfUniqSet )
  56 import Util             ( zipWithEqual, sortLt )
  57 import Outputable
  58 \end{code}
  59
  60
  61 %************************************************************************
  62 %*                                                                      *
  63 \subsection[Bindery-datatypes]{Data types}
  64 %*                                                                      *
  65 %************************************************************************
  66
  67 @(CgBinding a b)@ is a type of finite maps from a to b.
  68
  69 The assumption used to be that @lookupCgBind@ must get exactly one
  70 match.  This is {\em completely wrong} in the case of compiling
  71 letrecs (where knot-tying is used).  An initial binding is fed in (and
  72 never evaluated); eventually, a correct binding is put into the
  73 environment.  So there can be two bindings for a given name.
  74
  75 \begin{code}
  76 type CgBindings = IdEnv CgIdInfo
  77
  78 data CgIdInfo
  79   = MkCgIdInfo  Id      -- Id that this is the info for
  80                 VolatileLoc
  81                 StableLoc
  82                 LambdaFormInfo
  83
  84 data VolatileLoc
  85   = NoVolatileLoc
  86   | TempVarLoc  Unique
  87
  88   | RegLoc      MagicId                 -- in one of the magic registers
  89                                         -- (probably {Int,Float,Char,etc}Reg
  90
  91   | VirHpLoc    VirtualHeapOffset       -- Hp+offset (address of closure)
  92
  93   | VirNodeLoc  VirtualHeapOffset       -- Cts of offset indirect from Node
  94                                         -- ie *(Node+offset)
  95 \end{code}
  96
  97 @StableLoc@ encodes where an Id can be found, used by
  98 the @CgBindings@ environment in @CgBindery@.
  99
 100 \begin{code}
 101 data StableLoc
 102   = NoStableLoc
 103   | VirStkLoc           VirtualSpOffset
 104   | LitLoc              Literal
 105   | StableAmodeLoc      CAddrMode
 106
 107 -- these are so StableLoc can be abstract:
 108
 109 maybeStkLoc (VirStkLoc offset) = Just offset
 110 maybeStkLoc _                  = Nothing
 111 \end{code}
 112
 113 %************************************************************************
 114 %*                                                                      *
 115 \subsection[Bindery-idInfo]{Manipulating IdInfo}
 116 %*                                                                      *
 117 %************************************************************************
 118
 119 \begin{code}
 120 stableAmodeIdInfo i amode lf_info = MkCgIdInfo i NoVolatileLoc (StableAmodeLoc amode) lf_info
 121 heapIdInfo i offset       lf_info = MkCgIdInfo i (VirHpLoc offset) NoStableLoc lf_info
 122 tempIdInfo i uniq         lf_info = MkCgIdInfo i (TempVarLoc uniq) NoStableLoc lf_info
 123
 124 letNoEscapeIdInfo i sp lf_info
 125   = MkCgIdInfo i NoVolatileLoc (StableAmodeLoc (CJoinPoint sp)) lf_info
 126
 127 newTempAmodeAndIdInfo :: Id -> LambdaFormInfo -> (CAddrMode, CgIdInfo)
 128
 129 newTempAmodeAndIdInfo name lf_info
 130   = (temp_amode, temp_idinfo)
 131   where
 132     uniq        = getUnique name
 133     temp_amode  = CTemp uniq (idPrimRep name)
 134     temp_idinfo = tempIdInfo name uniq lf_info
 135
 136 idInfoToAmode :: PrimRep -> CgIdInfo -> FCode CAddrMode
 137 idInfoToAmode kind (MkCgIdInfo _ vol stab _) = idInfoPiecesToAmode kind vol stab
 138
 139 idInfoPiecesToAmode :: PrimRep -> VolatileLoc -> StableLoc -> FCode CAddrMode
 140
 141 idInfoPiecesToAmode kind (TempVarLoc uniq) stable_loc   = returnFC (CTemp uniq kind)
 142 idInfoPiecesToAmode kind (RegLoc magic_id) stable_loc   = returnFC (CReg magic_id)
 143
 144 idInfoPiecesToAmode kind NoVolatileLoc (LitLoc lit)           = returnFC (CLit lit)
 145 idInfoPiecesToAmode kind NoVolatileLoc (StableAmodeLoc amode) = returnFC amode
 146
 147 idInfoPiecesToAmode kind (VirNodeLoc nd_off) stable_loc
 148   = returnFC (CVal (nodeRel nd_off) kind)
 149     -- Virtual offsets from Node increase into the closures,
 150     -- and so do Node-relative offsets (which we want in the CVal),
 151     -- so there is no mucking about to do to the offset.
 152
 153 idInfoPiecesToAmode kind (VirHpLoc hp_off) stable_loc
 154   = getHpRelOffset hp_off `thenFC` \ rel_hp ->
 155     returnFC (CAddr rel_hp)
 156
 157 idInfoPiecesToAmode kind NoVolatileLoc (VirStkLoc i)
 158   = getSpRelOffset i `thenFC` \ rel_sp ->
 159     returnFC (CVal rel_sp kind)
 160
 161 #ifdef DEBUG
 162 idInfoPiecesToAmode kind NoVolatileLoc NoStableLoc = panic "idInfoPiecesToAmode: no loc"
 163 #endif
 164 \end{code}
 165
 166 %************************************************************************
 167 %*                                                                      *
 168 \subsection[CgMonad-bindery]{Monad things for fiddling with @CgBindings@}
 169 %*                                                                      *
 170 %************************************************************************
 171
 172 There are three basic routines, for adding (@addBindC@), modifying
 173 (@modifyBindC@) and looking up (@lookupBindC@) bindings.
 174
 175 A @Id@ is bound to a @(VolatileLoc, StableLoc)@ triple.
 176 The name should not already be bound. (nice ASSERT, eh?)
 177
 178 \begin{code}
 179 addBindC :: Id -> CgIdInfo -> Code
 180 addBindC name stuff_to_bind info_down (MkCgState absC binds usage)
 181   = MkCgState absC (extendVarEnv binds name stuff_to_bind) usage
 182
 183 addBindsC :: [(Id, CgIdInfo)] -> Code
 184 addBindsC new_bindings info_down (MkCgState absC binds usage)
 185   = MkCgState absC new_binds usage
 186   where
 187     new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info)
 188                       binds
 189                       new_bindings
 190
 191 modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> Code
 192 modifyBindC name mangle_fn info_down (MkCgState absC binds usage)
 193   = MkCgState absC (modifyVarEnv mangle_fn binds name) usage
 194
 195 lookupBindC :: Id -> FCode CgIdInfo
 196 lookupBindC name info_down@(MkCgInfoDown _ static_binds srt ticky _)
 197                  state@(MkCgState absC local_binds usage)
 198   = (val, state)
 199   where
 200     val = case (lookupVarEnv local_binds name) of
 201             Nothing     -> try_static
 202             Just this   -> this
 203
 204     try_static =
 205       case (lookupVarEnv static_binds name) of
 206         Just this -> this
 207         Nothing
 208           -> cgPanic (text "lookupBindC: no info for" <+> ppr name) info_down state
 209
 210 cgPanic :: SDoc -> CgInfoDownwards -> CgState -> a
 211 cgPanic doc info_down@(MkCgInfoDown _ static_binds srt ticky _)
 212             state@(MkCgState absC local_binds usage)
 213   = pprPanic "cgPanic"
 214              (vcat [doc,
 215                 ptext SLIT("static binds for:"),
 216                 vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv static_binds ],
 217                 ptext SLIT("local binds for:"),
 218                 vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv local_binds ],
 219                 ptext SLIT("SRT label") <+> pprCLabel srt
 220               ])
 221 \end{code}
 222
 223 %************************************************************************
 224 %*                                                                      *
 225 \subsection[Bindery-nuke-volatile]{Nuking volatile bindings}
 226 %*                                                                      *
 227 %************************************************************************
 228
 229 We sometimes want to nuke all the volatile bindings; we must be sure
 230 we don't leave any (NoVolatile, NoStable) binds around...
 231
 232 \begin{code}
 233 nukeVolatileBinds :: CgBindings -> CgBindings
 234 nukeVolatileBinds binds
 235   = mkVarEnv (foldr keep_if_stable [] (rngVarEnv binds))
 236   where
 237     keep_if_stable (MkCgIdInfo i _ NoStableLoc entry_info) acc = acc
 238     keep_if_stable (MkCgIdInfo i _ stable_loc  entry_info) acc
 239       = (i, MkCgIdInfo i NoVolatileLoc stable_loc entry_info) : acc
 240 \end{code}
 241
 242
 243 %************************************************************************
 244 %*                                                                      *
 245 \subsection[lookup-interface]{Interface functions to looking up bindings}
 246 %*                                                                      *
 247 %************************************************************************
 248
 249 I {\em think} all looking-up is done through @getCAddrMode(s)@.
 250
 251 \begin{code}
 252 getCAddrModeAndInfo :: Id -> FCode (CAddrMode, LambdaFormInfo)
 253
 254 getCAddrModeAndInfo id
 255   | not (isLocallyDefined name) || isDataConWrapId id
 256         -- Why the isDataConWrapId?  Because CoreToStg changes a call to
 257         -- a nullary constructor worker fn to a call to its wrapper,
 258         -- which may not  be defined until later
 259
 260     {-          -- OLD: the unpack stuff isn't injected now Jan 2000
 261         Why the "isWiredInName"?
 262         Imagine you are compiling PrelBase.hs (a module that
 263         supplies some of the wired-in values).  What can
 264         happen is that the compiler will inject calls to
 265         (e.g.) GHCbase.unpackPS, where-ever it likes -- it
 266         assumes those values are ubiquitously available.
 267         The main point is: it may inject calls to them earlier
 268         in GHCbase.hs than the actual definition...
 269     -}
 270   = returnFC (global_amode, mkLFImported id)
 271
 272   | otherwise = -- *might* be a nested defn: in any case, it's something whose
 273                 -- definition we will know about...
 274     lookupBindC id `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
 275     idInfoPiecesToAmode kind volatile_loc stable_loc `thenFC` \ amode ->
 276     returnFC (amode, lf_info)
 277   where
 278     name = getName id
 279     global_amode = CLbl (mkClosureLabel name) kind
 280     kind = idPrimRep id
 281
 282 getCAddrMode :: Id -> FCode CAddrMode
 283 getCAddrMode name
 284   = getCAddrModeAndInfo name `thenFC` \ (amode, _) ->
 285     returnFC amode
 286 \end{code}
 287
 288 \begin{code}
 289 getCAddrModeIfVolatile :: Id -> FCode (Maybe CAddrMode)
 290 getCAddrModeIfVolatile name
 291 --  | toplevelishId name = returnFC Nothing
 292 --  | otherwise
 293   = lookupBindC name `thenFC` \ ~(MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
 294     case stable_loc of
 295         NoStableLoc ->  -- Aha!  So it is volatile!
 296             idInfoPiecesToAmode (idPrimRep name) volatile_loc NoStableLoc `thenFC` \ amode ->
 297             returnFC (Just amode)
 298
 299         a_stable_loc -> returnFC Nothing
 300 \end{code}
 301
 302 @getVolatileRegs@ gets a set of live variables, and returns a list of
 303 all registers on which these variables depend.  These are the regs
 304 which must be saved and restored across any C calls.  If a variable is
 305 both in a volatile location (depending on a register) {\em and} a
 306 stable one (notably, on the stack), we modify the current bindings to
 307 forget the volatile one.
 308
 309 \begin{code}
 310 getVolatileRegs :: StgLiveVars -> FCode [MagicId]
 311
 312 getVolatileRegs vars
 313   = mapFCs snaffle_it (varSetElems vars) `thenFC` \ stuff ->
 314     returnFC (catMaybes stuff)
 315   where
 316     snaffle_it var
 317       = lookupBindC var `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
 318         let
 319             -- commoned-up code...
 320             consider_reg reg
 321               = if not (isVolatileReg reg) then
 322                         -- Potentially dies across C calls
 323                         -- For now, that's everything; we leave
 324                         -- it to the save-macros to decide which
 325                         -- regs *really* need to be saved.
 326                     returnFC Nothing
 327                 else
 328                     case stable_loc of
 329                       NoStableLoc -> returnFC (Just reg) -- got one!
 330                       is_a_stable_loc ->
 331                         -- has both volatile & stable locations;
 332                         -- force it to rely on the stable location
 333                         modifyBindC var nuke_vol_bind `thenC`
 334                         returnFC Nothing
 335         in
 336         case volatile_loc of
 337           RegLoc reg   -> consider_reg reg
 338           VirHpLoc _   -> consider_reg Hp
 339           VirNodeLoc _ -> consider_reg node
 340           non_reg_loc  -> returnFC Nothing
 341
 342     nuke_vol_bind (MkCgIdInfo i _ stable_loc lf_info)
 343       = MkCgIdInfo i NoVolatileLoc stable_loc lf_info
 344 \end{code}
 345
 346 \begin{code}
 347 getArgAmodes :: [StgArg] -> FCode [CAddrMode]
 348 getArgAmodes [] = returnFC []
 349 getArgAmodes (atom:atoms)
 350   | isStgTypeArg atom
 351   = getArgAmodes atoms
 352   | otherwise
 353   = getArgAmode  atom  `thenFC` \ amode ->
 354     getArgAmodes atoms `thenFC` \ amodes ->
 355     returnFC ( amode : amodes )
 356
 357 getArgAmode :: StgArg -> FCode CAddrMode
 358
 359 getArgAmode (StgVarArg var) = getCAddrMode var          -- The common case
 360 getArgAmode (StgLitArg lit) = returnFC (CLit lit)
 361 \end{code}
 362
 363 %************************************************************************
 364 %*                                                                      *
 365 \subsection[binding-and-rebinding-interface]{Interface functions for binding and re-binding names}
 366 %*                                                                      *
 367 %************************************************************************
 368
 369 \begin{code}
 370 bindNewToStack :: (Id, VirtualSpOffset) -> Code
 371 bindNewToStack (name, offset)
 372   = addBindC name info
 373   where
 374     info = MkCgIdInfo name NoVolatileLoc (VirStkLoc offset) mkLFArgument
 375
 376 bindNewToNode :: Id -> VirtualHeapOffset -> LambdaFormInfo -> Code
 377 bindNewToNode name offset lf_info
 378   = addBindC name info
 379   where
 380     info = MkCgIdInfo name (VirNodeLoc offset) NoStableLoc lf_info
 381
 382 -- Create a new temporary whose unique is that in the id,
 383 -- bind the id to it, and return the addressing mode for the
 384 -- temporary.
 385 bindNewToTemp :: Id -> FCode CAddrMode
 386 bindNewToTemp name
 387   = let (temp_amode, id_info) = newTempAmodeAndIdInfo name mkLFArgument
 388                 -- This is used only for things we don't know
 389                 -- anything about; values returned by a case statement,
 390                 -- for example.
 391     in
 392     addBindC name id_info       `thenC`
 393     returnFC temp_amode
 394
 395 bindNewToReg :: Id -> MagicId -> LambdaFormInfo -> Code
 396 bindNewToReg name magic_id lf_info
 397   = addBindC name info
 398   where
 399     info = MkCgIdInfo name (RegLoc magic_id) NoStableLoc lf_info
 400
 401 bindNewToLit name lit
 402   = addBindC name info
 403   where
 404     info = MkCgIdInfo name NoVolatileLoc (LitLoc lit) (error "bindNewToLit")
 405
 406 bindArgsToRegs :: [Id] -> [MagicId] -> Code
 407 bindArgsToRegs args regs
 408   = listCs (zipWithEqual "bindArgsToRegs" bind args regs)
 409   where
 410     arg `bind` reg = bindNewToReg arg reg mkLFArgument
 411 \end{code}
 412
 413 @bindNewPrimToAmode@ works only for certain addressing modes.  Making
 414 this work for stack offsets is non-trivial (virt vs. real stack offset
 415 difficulties).
 416
 417 \begin{code}
 418 bindNewPrimToAmode :: Id -> CAddrMode -> Code
 419 bindNewPrimToAmode name (CReg reg)
 420   = bindNewToReg name reg (panic "bindNewPrimToAmode")
 421
 422 bindNewPrimToAmode name (CTemp uniq kind)
 423   = addBindC name (tempIdInfo name uniq (panic "bindNewPrimToAmode"))
 424
 425 #ifdef DEBUG
 426 bindNewPrimToAmode name amode
 427   = pprPanic "bindNew...:" (pprAmode amode)
 428 #endif
 429 \end{code}
 430
 431 \begin{code}
 432 rebindToStack :: Id -> VirtualSpOffset -> Code
 433 rebindToStack name offset
 434   = modifyBindC name replace_stable_fn
 435   where
 436     replace_stable_fn (MkCgIdInfo i vol stab einfo)
 437       = MkCgIdInfo i vol (VirStkLoc offset) einfo
 438 \end{code}
 439
 440 %************************************************************************
 441 %*                                                                      *
 442 \subsection[CgBindery-liveness]{Build a liveness mask for the current stack}
 443 %*                                                                      *
 444 %************************************************************************
 445
 446 ToDo: remove the dependency on 32-bit words.
 447
 448 There are four kinds of things on the stack:
 449
 450         - pointer variables (bound in the environment)
 451         - non-pointer variables (boudn in the environment)
 452         - free slots (recorded in the stack free list)
 453         - non-pointer data slots (recorded in the stack free list)
 454
 455 We build up a bitmap of non-pointer slots by looking down the
 456 environment for all the non-pointer variables, and merging this with
 457 the slots recorded in the stack free list.
 458
 459 There's a bit of a hack here to do with update frames: since nothing
 460 is recorded in either the environment or the stack free list for an
 461 update frame, the code below defaults to assuming the slots taken up
 462 by an update frame contain pointers.  Furthermore, update frames are
 463 always in slots 0-2 at the bottom of the stack.  The bitmap will
 464 therefore end at slot 3, which is what we want (the update frame info
 465 pointer has its own bitmap to describe the update frame).
 466
 467 \begin{code}
 468 buildLivenessMask
 469         :: Unique               -- unique for for large bitmap label
 470         -> VirtualSpOffset      -- offset from which the bitmap should start
 471         -> FCode Liveness       -- mask for free/unlifted slots
 472
 473 buildLivenessMask uniq sp info_down
 474         state@(MkCgState abs_c binds ((vsp, free, _, _), heap_usage))
 475   = ASSERT(all (>=0) rel_slots)
 476     livenessToAbsC uniq liveness_mask info_down state
 477   where
 478         -- find all unboxed stack-resident ids
 479         unboxed_slots =
 480           [ (ofs, size) |
 481                      (MkCgIdInfo id _ (VirStkLoc ofs) _) <- rngVarEnv binds,
 482                 let rep = idPrimRep id; size = getPrimRepSize rep,
 483                 not (isFollowableRep rep),
 484                 size > 0
 485           ]
 486
 487         -- flatten this list into a list of unboxed stack slots
 488         flatten_slots = sortLt (<)
 489                 (foldr (\(ofs,size) r -> [ofs-size+1 .. ofs] ++ r) []
 490                       unboxed_slots)
 491
 492         -- merge in the free slots
 493         all_slots = mergeSlots flatten_slots (map fst free) ++
 494                     if vsp < sp then [vsp+1 .. sp] else []
 495
 496         -- recalibrate the list to be sp-relative
 497         rel_slots = reverse (map (sp-) all_slots)
 498
 499         -- build the bitmap
 500         liveness_mask = listToLivenessMask rel_slots
 501
 502 mergeSlots :: [Int] -> [Int] -> [Int]
 503 mergeSlots cs [] = cs
 504 mergeSlots [] ns = ns
 505 mergeSlots (c:cs) (n:ns)
 506  = if c < n then
 507         c : mergeSlots cs (n:ns)
 508    else if c > n then
 509         n : mergeSlots (c:cs) ns
 510    else
 511         panic ("mergeSlots: equal slots: " ++ show (c:cs) ++ show (n:ns))
 512
 513 listToLivenessMask :: [Int] -> LivenessMask
 514 listToLivenessMask []    = []
 515 listToLivenessMask slots =
 516    mkBS this : listToLivenessMask (map (\x -> x-32) rest)
 517    where (this,rest) = span (<32) slots
 518
 519 livenessToAbsC :: Unique -> LivenessMask -> FCode Liveness
 520 livenessToAbsC uniq []    = returnFC (LvSmall emptyBS)
 521 livenessToAbsC uniq [one] = returnFC (LvSmall one)
 522 livenessToAbsC uniq many  =
 523         absC (CBitmap lbl many) `thenC`
 524         returnFC (LvLarge lbl)
 525   where lbl = mkBitmapLabel uniq
 526 \end{code}
 527
 528 In a continuation, we want a liveness mask that starts from just after
 529 the return address, which is on the stack at realSp.
 530
 531 \begin{code}
 532 buildContLivenessMask
 533         :: Unique
 534         -> FCode Liveness
 535 buildContLivenessMask uniq
 536   = getRealSp  `thenFC` \ realSp ->
 537     buildLivenessMask uniq (realSp-1)
 538 \end{code}
 539
 540 %************************************************************************
 541 %*                                                                      *
 542 \subsection[CgMonad-deadslots]{Finding dead stack slots}
 543 %*                                                                      *
 544 %************************************************************************
 545
 546 nukeDeadBindings does the following:
 547
 548       - Removes all bindings from the environment other than those
 549         for variables in the argument to nukeDeadBindings.
 550       - Collects any stack slots so freed, and returns them to the  stack free
 551         list.
 552       - Moves the virtual stack pointer to point to the topmost used
 553         stack locations.
 554
 555 You can have multi-word slots on the stack (where a Double# used to
 556 be, for instance); if dead, such a slot will be reported as *several*
 557 offsets (one per word).
 558
 559 Probably *naughty* to look inside monad...
 560
 561 \begin{code}
 562 nukeDeadBindings :: StgLiveVars  -- All the *live* variables
 563                  -> Code
 564
 565 nukeDeadBindings live_vars info_down (MkCgState abs_c binds usage)
 566   = freeStackSlots extra_free info_down (MkCgState abs_c (mkVarEnv bs') usage)
 567   where
 568     (dead_stk_slots, bs')
 569       = dead_slots live_vars
 570                    [] []
 571                    [ (i, b) | b@(MkCgIdInfo i _ _ _) <- rngVarEnv binds ]
 572
 573     extra_free = sortLt (<) dead_stk_slots
 574 \end{code}
 575
 576 Several boring auxiliary functions to do the dirty work.
 577
 578 \begin{code}
 579 dead_slots :: StgLiveVars
 580            -> [(Id,CgIdInfo)]
 581            -> [VirtualSpOffset]
 582            -> [(Id,CgIdInfo)]
 583            -> ([VirtualSpOffset], [(Id,CgIdInfo)])
 584
 585 -- dead_slots carries accumulating parameters for
 586 --      filtered bindings, dead slots
 587 dead_slots live_vars fbs ds []
 588   = (ds, reverse fbs) -- Finished; rm the dups, if any
 589
 590 dead_slots live_vars fbs ds ((v,i):bs)
 591   | v `elementOfUniqSet` live_vars
 592     = dead_slots live_vars ((v,i):fbs) ds bs
 593           -- Live, so don't record it in dead slots
 594           -- Instead keep it in the filtered bindings
 595
 596   | otherwise
 597     = case i of
 598         MkCgIdInfo _ _ stable_loc _
 599          | is_stk_loc && size > 0 ->
 600            dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
 601          where
 602           maybe_stk_loc = maybeStkLoc stable_loc
 603           is_stk_loc    = maybeToBool maybe_stk_loc
 604           (Just offset) = maybe_stk_loc
 605
 606         _ -> dead_slots live_vars fbs ds bs
 607   where
 608
 609     size :: Int
 610     size = (getPrimRepSize . typePrimRep . idType) v
 611
 612 \end{code}