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