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, addFreeSlots )
  36 import CLabel           ( mkStaticClosureLabel, 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 )
  43 import Type             ( typePrimRep )
  44 import VarEnv
  45 import VarSet           ( varSetElems )
  46 import Const            ( Con(..), Literal )
  47 import Maybes           ( catMaybes, maybeToBool )
  48 import Name             ( isLocallyDefined, isWiredInName, NamedThing(..) )
  49 #ifdef DEBUG
  50 import PprAbsC          ( pprAmode )
  51 #endif
  52 import PrimRep          ( PrimRep(..) )
  53 import StgSyn           ( StgArg, StgLiveVars, GenStgArg(..) )
  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) || isWiredInName name
 256     {- Why the "isWiredInName"?
 257         Imagine you are compiling PrelBase.hs (a module that
 258         supplies some of the wired-in values).  What can
 259         happen is that the compiler will inject calls to
 260         (e.g.) GHCbase.unpackPS, where-ever it likes -- it
 261         assumes those values are ubiquitously available.
 262         The main point is: it may inject calls to them earlier
 263         in GHCbase.hs than the actual definition...
 264     -}
 265   = returnFC (global_amode, mkLFImported id)
 266
 267   | otherwise = -- *might* be a nested defn: in any case, it's something whose
 268                 -- definition we will know about...
 269     lookupBindC id `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
 270     idInfoPiecesToAmode kind volatile_loc stable_loc `thenFC` \ amode ->
 271     returnFC (amode, lf_info)
 272   where
 273     name = getName id
 274     global_amode = CLbl (mkClosureLabel name) kind
 275     kind = idPrimRep id
 276
 277 getCAddrMode :: Id -> FCode CAddrMode
 278 getCAddrMode name
 279   = getCAddrModeAndInfo name `thenFC` \ (amode, _) ->
 280     returnFC amode
 281 \end{code}
 282
 283 \begin{code}
 284 getCAddrModeIfVolatile :: Id -> FCode (Maybe CAddrMode)
 285 getCAddrModeIfVolatile name
 286 --  | toplevelishId name = returnFC Nothing
 287 --  | otherwise
 288   = lookupBindC name `thenFC` \ ~(MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
 289     case stable_loc of
 290         NoStableLoc ->  -- Aha!  So it is volatile!
 291             idInfoPiecesToAmode (idPrimRep name) volatile_loc NoStableLoc `thenFC` \ amode ->
 292             returnFC (Just amode)
 293
 294         a_stable_loc -> returnFC Nothing
 295 \end{code}
 296
 297 @getVolatileRegs@ gets a set of live variables, and returns a list of
 298 all registers on which these variables depend.  These are the regs
 299 which must be saved and restored across any C calls.  If a variable is
 300 both in a volatile location (depending on a register) {\em and} a
 301 stable one (notably, on the stack), we modify the current bindings to
 302 forget the volatile one.
 303
 304 \begin{code}
 305 getVolatileRegs :: StgLiveVars -> FCode [MagicId]
 306
 307 getVolatileRegs vars
 308   = mapFCs snaffle_it (varSetElems vars) `thenFC` \ stuff ->
 309     returnFC (catMaybes stuff)
 310   where
 311     snaffle_it var
 312       = lookupBindC var `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
 313         let
 314             -- commoned-up code...
 315             consider_reg reg
 316               = if not (isVolatileReg reg) then
 317                         -- Potentially dies across C calls
 318                         -- For now, that's everything; we leave
 319                         -- it to the save-macros to decide which
 320                         -- regs *really* need to be saved.
 321                     returnFC Nothing
 322                 else
 323                     case stable_loc of
 324                       NoStableLoc -> returnFC (Just reg) -- got one!
 325                       is_a_stable_loc ->
 326                         -- has both volatile & stable locations;
 327                         -- force it to rely on the stable location
 328                         modifyBindC var nuke_vol_bind `thenC`
 329                         returnFC Nothing
 330         in
 331         case volatile_loc of
 332           RegLoc reg   -> consider_reg reg
 333           VirHpLoc _   -> consider_reg Hp
 334           VirNodeLoc _ -> consider_reg node
 335           non_reg_loc  -> returnFC Nothing
 336
 337     nuke_vol_bind (MkCgIdInfo i _ stable_loc lf_info)
 338       = MkCgIdInfo i NoVolatileLoc stable_loc lf_info
 339 \end{code}
 340
 341 \begin{code}
 342 getArgAmodes :: [StgArg] -> FCode [CAddrMode]
 343 getArgAmodes [] = returnFC []
 344 getArgAmodes (atom:atoms)
 345   = getArgAmode  atom  `thenFC` \ amode ->
 346     getArgAmodes atoms `thenFC` \ amodes ->
 347     returnFC ( amode : amodes )
 348
 349 getArgAmode :: StgArg -> FCode CAddrMode
 350
 351 getArgAmode (StgVarArg var) = getCAddrMode var          -- The common case
 352
 353 getArgAmode (StgConArg (DataCon con))
 354      {- Why does this case differ from StgVarArg?
 355         Because the program might look like this:
 356                 data Foo a = Empty | Baz a
 357                 f a x = let c = Empty! a
 358                         in h c
 359         Now, when we go Core->Stg, we drop the type applications,
 360         so we can inline c, giving
 361                 f x = h Empty
 362         Now we are referring to Empty as an argument (rather than in an STGCon),
 363         so we'll look it up with getCAddrMode.  We want to return an amode for
 364         the static closure that we make for nullary constructors.  But if we blindly
 365         go ahead with getCAddrMode we end up looking in the environment, and it ain't there!
 366
 367         This special case used to be in getCAddrModeAndInfo, but it doesn't work there.
 368         Consider:
 369                 f a x = Baz a x
 370         If the constructor Baz isn't inlined we simply want to treat it like any other
 371         identifier, with a top level definition.  We don't want to spot that it's a constructor.
 372
 373         In short
 374                 StgApp con args
 375         and
 376                 StgCon con args
 377         are treated differently; the former is a call to a bog standard function while the
 378         latter uses the specially-labelled, pre-defined info tables etc for the constructor.
 379
 380         The way to think of this case in getArgAmode is that
 381                 SApp f Empty
 382         is really
 383                 App f (StgCon Empty [])
 384      -}
 385   = returnFC (CLbl (mkStaticClosureLabel (dataConName con)) PtrRep)
 386
 387
 388 getArgAmode (StgConArg (Literal lit)) = returnFC (CLit lit)
 389 \end{code}
 390
 391 %************************************************************************
 392 %*                                                                      *
 393 \subsection[binding-and-rebinding-interface]{Interface functions for binding and re-binding names}
 394 %*                                                                      *
 395 %************************************************************************
 396
 397 \begin{code}
 398 bindNewToStack :: (Id, VirtualSpOffset) -> Code
 399 bindNewToStack (name, offset)
 400   = addBindC name info
 401   where
 402     info = MkCgIdInfo name NoVolatileLoc (VirStkLoc offset) mkLFArgument
 403
 404 bindNewToNode :: Id -> VirtualHeapOffset -> LambdaFormInfo -> Code
 405 bindNewToNode name offset lf_info
 406   = addBindC name info
 407   where
 408     info = MkCgIdInfo name (VirNodeLoc offset) NoStableLoc lf_info
 409
 410 -- Create a new temporary whose unique is that in the id,
 411 -- bind the id to it, and return the addressing mode for the
 412 -- temporary.
 413 bindNewToTemp :: Id -> FCode CAddrMode
 414 bindNewToTemp name
 415   = let (temp_amode, id_info) = newTempAmodeAndIdInfo name mkLFArgument
 416                 -- This is used only for things we don't know
 417                 -- anything about; values returned by a case statement,
 418                 -- for example.
 419     in
 420     addBindC name id_info       `thenC`
 421     returnFC temp_amode
 422
 423 bindNewToReg :: Id -> MagicId -> LambdaFormInfo -> Code
 424 bindNewToReg name magic_id lf_info
 425   = addBindC name info
 426   where
 427     info = MkCgIdInfo name (RegLoc magic_id) NoStableLoc lf_info
 428
 429 bindNewToLit name lit
 430   = addBindC name info
 431   where
 432     info = MkCgIdInfo name NoVolatileLoc (LitLoc lit) (error "bindNewToLit")
 433
 434 bindArgsToRegs :: [Id] -> [MagicId] -> Code
 435 bindArgsToRegs args regs
 436   = listCs (zipWithEqual "bindArgsToRegs" bind args regs)
 437   where
 438     arg `bind` reg = bindNewToReg arg reg mkLFArgument
 439 \end{code}
 440
 441 @bindNewPrimToAmode@ works only for certain addressing modes.  Making
 442 this work for stack offsets is non-trivial (virt vs. real stack offset
 443 difficulties).
 444
 445 \begin{code}
 446 bindNewPrimToAmode :: Id -> CAddrMode -> Code
 447 bindNewPrimToAmode name (CReg reg)
 448   = bindNewToReg name reg (panic "bindNewPrimToAmode")
 449
 450 bindNewPrimToAmode name (CTemp uniq kind)
 451   = addBindC name (tempIdInfo name uniq (panic "bindNewPrimToAmode"))
 452
 453 #ifdef DEBUG
 454 bindNewPrimToAmode name amode
 455   = pprPanic "bindNew...:" (pprAmode amode)
 456 #endif
 457 \end{code}
 458
 459 \begin{code}
 460 rebindToStack :: Id -> VirtualSpOffset -> Code
 461 rebindToStack name offset
 462   = modifyBindC name replace_stable_fn
 463   where
 464     replace_stable_fn (MkCgIdInfo i vol stab einfo)
 465       = MkCgIdInfo i vol (VirStkLoc offset) einfo
 466 \end{code}
 467
 468 %************************************************************************
 469 %*                                                                      *
 470 \subsection[CgBindery-liveness]{Build a liveness mask for the current stack}
 471 %*                                                                      *
 472 %************************************************************************
 473
 474 ToDo: remove the dependency on 32-bit words.
 475
 476 There are four kinds of things on the stack:
 477
 478         - pointer variables (bound in the environment)
 479         - non-pointer variables (boudn in the environment)
 480         - free slots (recorded in the stack free list)
 481         - non-pointer data slots (recorded in the stack free list)
 482
 483 We build up a bitmap of non-pointer slots by looking down the
 484 environment for all the non-pointer variables, and merging this with
 485 the slots recorded in the stack free list.
 486
 487 There's a bit of a hack here to do with update frames: since nothing
 488 is recorded in either the environment or the stack free list for an
 489 update frame, the code below defaults to assuming the slots taken up
 490 by an update frame contain pointers.  Furthermore, update frames are
 491 always in slots 0-2 at the bottom of the stack.  The bitmap will
 492 therefore end at slot 3, which is what we want (the update frame info
 493 pointer has its own bitmap to describe the update frame).
 494
 495 \begin{code}
 496 buildLivenessMask
 497         :: Unique               -- unique for for large bitmap label
 498         -> VirtualSpOffset      -- offset from which the bitmap should start
 499         -> FCode Liveness       -- mask for free/unlifted slots
 500
 501 buildLivenessMask uniq sp info_down
 502         state@(MkCgState abs_c binds ((vsp, free, _, _), heap_usage))
 503   = ASSERT(all (>=0) rel_slots)
 504     livenessToAbsC uniq liveness_mask info_down state
 505   where
 506         -- find all unboxed stack-resident ids
 507         unboxed_slots =
 508           [ (ofs, size) |
 509                      (MkCgIdInfo id _ (VirStkLoc ofs) _) <- rngVarEnv binds,
 510                 let rep = idPrimRep id; size = getPrimRepSize rep,
 511                 not (isFollowableRep rep),
 512                 size > 0
 513           ]
 514
 515         -- flatten this list into a list of unboxed stack slots
 516         flatten_slots = sortLt (<)
 517                 (foldr (\(ofs,size) r -> [ofs-size+1 .. ofs] ++ r) []
 518                       unboxed_slots)
 519
 520         -- merge in the free slots
 521         all_slots = mergeSlots flatten_slots (map fst free) ++
 522                     if vsp < sp then [vsp+1 .. sp] else []
 523
 524         -- recalibrate the list to be sp-relative
 525         rel_slots = reverse (map (sp-) all_slots)
 526
 527         -- build the bitmap
 528         liveness_mask = listToLivenessMask rel_slots
 529
 530 mergeSlots :: [Int] -> [Int] -> [Int]
 531 mergeSlots cs [] = cs
 532 mergeSlots [] ns = ns
 533 mergeSlots (c:cs) (n:ns)
 534  = if c < n then
 535         c : mergeSlots cs (n:ns)
 536    else if c > n then
 537         n : mergeSlots (c:cs) ns
 538    else
 539         panic ("mergeSlots: equal slots: " ++ show (c:cs) ++ show (n:ns))
 540
 541 listToLivenessMask :: [Int] -> LivenessMask
 542 listToLivenessMask []    = []
 543 listToLivenessMask slots =
 544    mkBS this : listToLivenessMask (map (\x -> x-32) rest)
 545    where (this,rest) = span (<32) slots
 546
 547 livenessToAbsC :: Unique -> LivenessMask -> FCode Liveness
 548 livenessToAbsC uniq []    = returnFC (LvSmall emptyBS)
 549 livenessToAbsC uniq [one] = returnFC (LvSmall one)
 550 livenessToAbsC uniq many  =
 551         absC (CBitmap lbl many) `thenC`
 552         returnFC (LvLarge lbl)
 553   where lbl = mkBitmapLabel uniq
 554 \end{code}
 555
 556 In a continuation, we want a liveness mask that starts from just after
 557 the return address, which is on the stack at realSp.
 558
 559 \begin{code}
 560 buildContLivenessMask
 561         :: Unique
 562         -> FCode Liveness
 563 buildContLivenessMask uniq
 564   = getRealSp  `thenFC` \ realSp ->
 565     buildLivenessMask uniq (realSp-1)
 566 \end{code}
 567
 568 %************************************************************************
 569 %*                                                                      *
 570 \subsection[CgMonad-deadslots]{Finding dead stack slots}
 571 %*                                                                      *
 572 %************************************************************************
 573
 574 nukeDeadBindings does the following:
 575
 576       - Removes all bindings from the environment other than those
 577         for variables in the argument to nukeDeadBindings.
 578       - Collects any stack slots so freed, and returns them to the  stack free
 579         list.
 580       - Moves the virtual stack pointer to point to the topmost used
 581         stack locations.
 582
 583 You can have multi-word slots on the stack (where a Double# used to
 584 be, for instance); if dead, such a slot will be reported as *several*
 585 offsets (one per word).
 586
 587 Probably *naughty* to look inside monad...
 588
 589 \begin{code}
 590 nukeDeadBindings :: StgLiveVars  -- All the *live* variables
 591                  -> Code
 592
 593 nukeDeadBindings live_vars info_down (MkCgState abs_c binds usage)
 594   = freeStackSlots extra_free info_down (MkCgState abs_c (mkVarEnv bs') usage)
 595   where
 596     (dead_stk_slots, bs')
 597       = dead_slots live_vars
 598                    [] []
 599                    [ (i, b) | b@(MkCgIdInfo i _ _ _) <- rngVarEnv binds ]
 600
 601     extra_free = sortLt (<) dead_stk_slots
 602 \end{code}
 603
 604 Several boring auxiliary functions to do the dirty work.
 605
 606 \begin{code}
 607 dead_slots :: StgLiveVars
 608            -> [(Id,CgIdInfo)]
 609            -> [VirtualSpOffset]
 610            -> [(Id,CgIdInfo)]
 611            -> ([VirtualSpOffset], [(Id,CgIdInfo)])
 612
 613 -- dead_slots carries accumulating parameters for
 614 --      filtered bindings, dead slots
 615 dead_slots live_vars fbs ds []
 616   = (ds, reverse fbs) -- Finished; rm the dups, if any
 617
 618 dead_slots live_vars fbs ds ((v,i):bs)
 619   | v `elementOfUniqSet` live_vars
 620     = dead_slots live_vars ((v,i):fbs) ds bs
 621           -- Live, so don't record it in dead slots
 622           -- Instead keep it in the filtered bindings
 623
 624   | otherwise
 625     = case i of
 626         MkCgIdInfo _ _ stable_loc _
 627          | is_stk_loc && size > 0 ->
 628            dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
 629          where
 630           maybe_stk_loc = maybeStkLoc stable_loc
 631           is_stk_loc    = maybeToBool maybe_stk_loc
 632           (Just offset) = maybe_stk_loc
 633
 634         _ -> dead_slots live_vars fbs ds bs
 635   where
 636
 637     size :: Int
 638     size = (getPrimRepSize . typePrimRep . idType) v
 639
 640 \end{code}