compiler/codeGen/CgClosure.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5 \section[CgClosure]{Code generation for closures}
   6
   7 This module provides the support code for @StgToAbstractC@ to deal
   8 with {\em closures} on the RHSs of let(rec)s.  See also
   9 @CgCon@, which deals with constructors.
  10
  11 \begin{code}
  12 module CgClosure ( cgTopRhsClosure,
  13                    cgStdRhsClosure,
  14                    cgRhsClosure,
  15                    emitBlackHoleCode,
  16                    ) where
  17
  18 #include "HsVersions.h"
  19
  20 import {-# SOURCE #-} CgExpr ( cgExpr )
  21
  22 import CgMonad
  23 import CgBindery
  24 import CgHeapery
  25 import CgStackery
  26 import CgProf
  27 import CgTicky
  28 import CgParallel
  29 import CgInfoTbls
  30 import CgCallConv
  31 import CgUtils
  32 import ClosureInfo
  33 import SMRep
  34 import OldCmm
  35 import OldCmmUtils
  36 import CLabel
  37 import StgSyn
  38 import CostCentre
  39 import Id
  40 import Name
  41 import Module
  42 import ListSetOps
  43 import Util
  44 import BasicTypes
  45 import StaticFlags
  46 import DynFlags
  47 import Constants
  48 import Outputable
  49 import FastString
  50
  51 import Data.List
  52 \end{code}
  53
  54 %********************************************************
  55 %*                                                      *
  56 \subsection[closures-no-free-vars]{Top-level closures}
  57 %*                                                      *
  58 %********************************************************
  59
  60 For closures bound at top level, allocate in static space.
  61 They should have no free variables.
  62
  63 \begin{code}
  64 cgTopRhsClosure :: Id
  65                 -> CostCentreStack      -- Optional cost centre annotation
  66                 -> StgBinderInfo
  67                 -> UpdateFlag
  68                 -> [Id]         -- Args
  69                 -> StgExpr
  70                 -> FCode (Id, CgIdInfo)
  71
  72 cgTopRhsClosure id ccs binder_info upd_flag args body = do
  73   {     -- LAY OUT THE OBJECT
  74     let name = idName id
  75   ; lf_info  <- mkClosureLFInfo id TopLevel [] upd_flag args
  76   ; srt_info <- getSRTInfo
  77   ; mod_name <- getModuleName
  78   ; let descr         = closureDescription mod_name name
  79         closure_info  = mkClosureInfo True id lf_info 0 0 srt_info descr
  80         closure_label = mkLocalClosureLabel name $ idCafInfo id
  81         cg_id_info    = stableIdInfo id (mkLblExpr closure_label) lf_info
  82         closure_rep   = mkStaticClosureFields closure_info ccs True []
  83
  84          -- BUILD THE OBJECT, AND GENERATE INFO TABLE (IF NECESSARY)
  85   ; emitDataLits closure_label closure_rep
  86   ; forkClosureBody (closureCodeBody binder_info closure_info
  87                                      ccs args body)
  88
  89   ; returnFC (id, cg_id_info) }
  90 \end{code}
  91
  92 %********************************************************
  93 %*                                                      *
  94 \subsection[non-top-level-closures]{Non top-level closures}
  95 %*                                                      *
  96 %********************************************************
  97
  98 For closures with free vars, allocate in heap.
  99
 100 \begin{code}
 101 cgStdRhsClosure
 102         :: Id
 103         -> CostCentreStack      -- Optional cost centre annotation
 104         -> StgBinderInfo
 105         -> [Id]                 -- Free vars
 106         -> [Id]                 -- Args
 107         -> StgExpr
 108         -> LambdaFormInfo
 109         -> [StgArg]             -- payload
 110         -> FCode (Id, CgIdInfo)
 111
 112 cgStdRhsClosure bndr cc _bndr_info _fvs args body lf_info payload
 113   = do  -- AHA!  A STANDARD-FORM THUNK
 114   {     -- LAY OUT THE OBJECT
 115     amodes <- getArgAmodes payload
 116   ; mod_name <- getModuleName
 117   ; let (tot_wds, ptr_wds, amodes_w_offsets)
 118             = mkVirtHeapOffsets (isLFThunk lf_info) amodes
 119
 120         descr        = closureDescription mod_name (idName bndr)
 121         closure_info = mkClosureInfo False      -- Not static
 122                                      bndr lf_info tot_wds ptr_wds
 123                                      NoC_SRT    -- No SRT for a std-form closure
 124                                      descr
 125
 126   ; (use_cc, blame_cc) <- chooseDynCostCentres cc args body
 127
 128         -- BUILD THE OBJECT
 129   ; heap_offset <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
 130
 131         -- RETURN
 132   ; returnFC (bndr, heapIdInfo bndr heap_offset lf_info) }
 133 \end{code}
 134
 135 Here's the general case.
 136
 137 \begin{code}
 138 cgRhsClosure    :: Id
 139                 -> CostCentreStack      -- Optional cost centre annotation
 140                 -> StgBinderInfo
 141                 -> [Id]                 -- Free vars
 142                 -> UpdateFlag
 143                 -> [Id]                 -- Args
 144                 -> StgExpr
 145                 -> FCode (Id, CgIdInfo)
 146
 147 cgRhsClosure bndr cc bndr_info fvs upd_flag args body = do
 148   {     -- LAY OUT THE OBJECT
 149         -- If the binder is itself a free variable, then don't store
 150         -- it in the closure.  Instead, just bind it to Node on entry.
 151         -- NB we can be sure that Node will point to it, because we
 152         -- havn't told mkClosureLFInfo about this; so if the binder
 153         -- _was_ a free var of its RHS, mkClosureLFInfo thinks it *is*
 154         -- stored in the closure itself, so it will make sure that
 155         -- Node points to it...
 156     let
 157         name         = idName bndr
 158         bndr_is_a_fv = bndr `elem` fvs
 159         reduced_fvs | bndr_is_a_fv = fvs `minusList` [bndr]
 160                     | otherwise    = fvs
 161
 162   ; lf_info <- mkClosureLFInfo bndr NotTopLevel fvs upd_flag args
 163   ; fv_infos <- mapFCs getCgIdInfo reduced_fvs
 164   ; srt_info <- getSRTInfo
 165   ; mod_name <- getModuleName
 166   ; let bind_details :: [(CgIdInfo, VirtualHpOffset)]
 167         (tot_wds, ptr_wds, bind_details)
 168            = mkVirtHeapOffsets (isLFThunk lf_info) (map add_rep fv_infos)
 169
 170         add_rep info = (cgIdInfoArgRep info, info)
 171
 172         descr        = closureDescription mod_name name
 173         closure_info = mkClosureInfo False      -- Not static
 174                                      bndr lf_info tot_wds ptr_wds
 175                                      srt_info descr
 176
 177         -- BUILD ITS INFO TABLE AND CODE
 178   ; forkClosureBody (do
 179         {       -- Bind the fvs
 180           let
 181               -- A function closure pointer may be tagged, so we
 182               -- must take it into account when accessing the free variables.
 183               mbtag       = tagForArity (length args)
 184               bind_fv (info, offset)
 185                 | Just tag <- mbtag
 186                 = bindNewToUntagNode (cgIdInfoId info) offset (cgIdInfoLF info) tag
 187                 | otherwise
 188                 = bindNewToNode (cgIdInfoId info) offset (cgIdInfoLF info)
 189         ; mapCs bind_fv bind_details
 190
 191                 -- Bind the binder itself, if it is a free var
 192         ; whenC bndr_is_a_fv (bindNewToReg bndr nodeReg lf_info)
 193
 194                 -- Compile the body
 195         ; closureCodeBody bndr_info closure_info cc args body })
 196
 197         -- BUILD THE OBJECT
 198   ; let
 199         to_amode (info, offset) = do { amode <- idInfoToAmode info
 200                                      ; return (amode, offset) }
 201   ; (use_cc, blame_cc) <- chooseDynCostCentres cc args body
 202   ; amodes_w_offsets <- mapFCs to_amode bind_details
 203   ; heap_offset <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
 204
 205         -- RETURN
 206   ; returnFC (bndr, heapIdInfo bndr heap_offset lf_info) }
 207
 208
 209 mkClosureLFInfo :: Id           -- The binder
 210                 -> TopLevelFlag -- True of top level
 211                 -> [Id]         -- Free vars
 212                 -> UpdateFlag   -- Update flag
 213                 -> [Id]         -- Args
 214                 -> FCode LambdaFormInfo
 215 mkClosureLFInfo bndr top fvs upd_flag args
 216   | null args = return (mkLFThunk (idType bndr) top fvs upd_flag)
 217   | otherwise = do { arg_descr <- mkArgDescr (idName bndr) args
 218                    ; return (mkLFReEntrant top fvs args arg_descr) }
 219 \end{code}
 220
 221
 222 %************************************************************************
 223 %*                                                                      *
 224 \subsection[code-for-closures]{The code for closures}
 225 %*                                                                      *
 226 %************************************************************************
 227
 228 \begin{code}
 229 closureCodeBody :: StgBinderInfo
 230                 -> ClosureInfo     -- Lots of information about this closure
 231                 -> CostCentreStack -- Optional cost centre attached to closure
 232                 -> [Id]
 233                 -> StgExpr
 234                 -> Code
 235 \end{code}
 236
 237 There are two main cases for the code for closures.  If there are {\em
 238 no arguments}, then the closure is a thunk, and not in normal form.
 239 So it should set up an update frame (if it is shared).
 240 NB: Thunks cannot have a primitive type!
 241
 242 \begin{code}
 243 closureCodeBody _binder_info cl_info cc [{- No args i.e. thunk -}] body = do
 244   { body_absC <- getCgStmts $ do
 245         { tickyEnterThunk cl_info
 246         ; ldvEnterClosure cl_info  -- NB: Node always points when profiling
 247         ; thunkWrapper cl_info $ do
 248                 -- We only enter cc after setting up update so
 249                 -- that cc of enclosing scope will be recorded
 250                 -- in update frame CAF/DICT functions will be
 251                 -- subsumed by this enclosing cc
 252             { enterCostCentre cl_info cc body
 253             ; cgExpr body }
 254         }
 255
 256   ; emitClosureCodeAndInfoTable cl_info [] body_absC }
 257 \end{code}
 258
 259 If there is /at least one argument/, then this closure is in
 260 normal form, so there is no need to set up an update frame.
 261
 262 The Macros for GrAnSim are produced at the beginning of the
 263 argSatisfactionCheck (by calling fetchAndReschedule).  There info if
 264 Node points to closure is available. -- HWL
 265
 266 \begin{code}
 267 closureCodeBody _binder_info cl_info cc args body
 268   = ASSERT( length args > 0 )
 269   do {  -- Get the current virtual Sp (it might not be zero,
 270         -- eg. if we're compiling a let-no-escape).
 271     vSp <- getVirtSp
 272   ; let (reg_args, other_args) = assignCallRegs (addIdReps args)
 273         (sp_top, stk_args)     = mkVirtStkOffsets vSp other_args
 274
 275         -- Allocate the global ticky counter
 276   ; let ticky_ctr_lbl = mkRednCountsLabel (closureName cl_info) (clHasCafRefs cl_info)
 277   ; emitTickyCounter cl_info args sp_top
 278
 279         -- ...and establish the ticky-counter
 280         -- label for this block
 281   ; setTickyCtrLabel ticky_ctr_lbl $ do
 282
 283         -- Emit the slow-entry code
 284   { reg_save_code <- mkSlowEntryCode cl_info reg_args
 285
 286         -- Emit the main entry code
 287   ; blks <- forkProc $
 288             mkFunEntryCode cl_info cc reg_args stk_args
 289                            sp_top reg_save_code body
 290   ; emitClosureCodeAndInfoTable cl_info [] blks
 291   }}
 292
 293
 294
 295 mkFunEntryCode :: ClosureInfo
 296                -> CostCentreStack
 297                -> [(Id,GlobalReg)]        -- Args in regs
 298                -> [(Id,VirtualSpOffset)]  -- Args on stack
 299                -> VirtualSpOffset         -- Last allocated word on stack
 300                -> CmmStmts                -- Register-save code in case of GC
 301                -> StgExpr
 302                -> Code
 303 -- The main entry code for the closure
 304 mkFunEntryCode cl_info cc reg_args stk_args sp_top reg_save_code body = do
 305   {     -- Bind args to regs/stack as appropriate,
 306         -- and record expected position of sps
 307   ; bindArgsToRegs  reg_args
 308   ; bindArgsToStack stk_args
 309   ; setRealAndVirtualSp sp_top
 310
 311         -- Enter the cost-centre, if required
 312         -- ToDo: It's not clear why this is outside the funWrapper,
 313         --       but the tickyEnterFun is inside. Perhaps we can put
 314         --       them together?
 315   ; enterCostCentre cl_info cc body
 316
 317         -- Do the business
 318   ; funWrapper cl_info reg_args reg_save_code $ do
 319         { tickyEnterFun cl_info
 320         ; cgExpr body }
 321   }
 322 \end{code}
 323
 324 The "slow entry" code for a function.  This entry point takes its
 325 arguments on the stack.  It loads the arguments into registers
 326 according to the calling convention, and jumps to the function's
 327 normal entry point.  The function's closure is assumed to be in
 328 R1/node.
 329
 330 The slow entry point is used in two places:
 331
 332  (a) unknown calls: eg. stg_PAP_entry
 333  (b) returning from a heap-check failure
 334
 335 \begin{code}
 336 mkSlowEntryCode :: ClosureInfo -> [(Id,GlobalReg)] -> FCode CmmStmts
 337 -- If this function doesn't have a specialised ArgDescr, we need
 338 -- to generate the function's arg bitmap, slow-entry code, and
 339 -- register-save code for the heap-check failure
 340 -- Here, we emit the slow-entry code, and
 341 -- return the register-save assignments
 342 mkSlowEntryCode cl_info reg_args
 343   | Just (_, ArgGen _) <- closureFunInfo cl_info
 344   = do  { emitSimpleProc slow_lbl (emitStmts load_stmts)
 345         ; return save_stmts }
 346   | otherwise = return noStmts
 347   where
 348      name = closureName cl_info
 349      has_caf_refs = clHasCafRefs cl_info
 350      slow_lbl = mkSlowEntryLabel name has_caf_refs
 351
 352      load_stmts = mkStmts load_assts `plusStmts` mkStmts [stk_adj_pop, jump_to_entry]
 353      save_stmts = oneStmt stk_adj_push `plusStmts`  mkStmts save_assts
 354
 355      reps_w_regs :: [(CgRep,GlobalReg)]
 356      reps_w_regs = [(idCgRep id, reg) | (id,reg) <- reverse reg_args]
 357      (final_stk_offset, stk_offsets)
 358         = mapAccumL (\off (rep,_) -> (off + cgRepSizeW rep, off))
 359                     0 reps_w_regs
 360
 361      load_assts = zipWithEqual "mk_load" mk_load reps_w_regs stk_offsets
 362      mk_load (rep,reg) offset = CmmAssign (CmmGlobal reg)
 363                                           (CmmLoad (cmmRegOffW spReg offset)
 364                                                    (argMachRep rep))
 365
 366      save_assts = zipWithEqual "mk_save" mk_save reps_w_regs stk_offsets
 367      mk_save (rep,reg) offset = ASSERT( argMachRep rep `cmmEqType` globalRegType reg )
 368                                 CmmStore (cmmRegOffW spReg offset)
 369                                          (CmmReg (CmmGlobal reg))
 370
 371      stk_adj_pop   = CmmAssign spReg (cmmRegOffW spReg final_stk_offset)
 372      stk_adj_push  = CmmAssign spReg (cmmRegOffW spReg (- final_stk_offset))
 373      jump_to_entry = CmmJump (mkLblExpr (enterLocalIdLabel name has_caf_refs)) []
 374 \end{code}
 375
 376
 377 %************************************************************************
 378 %*                                                                      *
 379 \subsubsection[closure-code-wrappers]{Wrappers around closure code}
 380 %*                                                                      *
 381 %************************************************************************
 382
 383 \begin{code}
 384 thunkWrapper:: ClosureInfo -> Code -> Code
 385 thunkWrapper closure_info thunk_code = do
 386   { let node_points = nodeMustPointToIt (closureLFInfo closure_info)
 387
 388     -- HWL: insert macros for GrAnSim; 2 versions depending on liveness of node
 389     -- (we prefer fetchAndReschedule-style context switches to yield ones)
 390   ; if node_points
 391     then granFetchAndReschedule [] node_points
 392     else granYield              [] node_points
 393
 394         -- Stack and/or heap checks
 395   ; thunkEntryChecks closure_info $ do
 396         {
 397           dflags <- getDynFlags
 398           -- Overwrite with black hole if necessary
 399         ; whenC (blackHoleOnEntry dflags closure_info && node_points)
 400                 (blackHoleIt closure_info)
 401         ; setupUpdate closure_info thunk_code }
 402                 -- setupUpdate *encloses* the thunk_code
 403   }
 404
 405 funWrapper :: ClosureInfo       -- Closure whose code body this is
 406            -> [(Id,GlobalReg)]  -- List of argument registers (if any)
 407            -> CmmStmts          -- reg saves for the heap check failure
 408            -> Code              -- Body of function being compiled
 409            -> Code
 410 funWrapper closure_info arg_regs reg_save_code fun_body = do
 411   { let node_points = nodeMustPointToIt (closureLFInfo closure_info)
 412
 413   {-
 414         -- Debugging: check that R1 has the correct tag
 415   ; let tag = funTag closure_info
 416   ; whenC (tag /= 0 && node_points) $ do
 417         l <- newLabelC
 418         stmtC (CmmCondBranch (CmmMachOp mo_wordEq [cmmGetTag (CmmReg nodeReg),
 419                                                    CmmLit (mkIntCLit tag)]) l)
 420         stmtC (CmmStore (CmmLit (mkWordCLit 0)) (CmmLit (mkWordCLit 0)))
 421         labelC l
 422   -}
 423
 424         -- Enter for Ldv profiling
 425   ; whenC node_points (ldvEnterClosure closure_info)
 426
 427         -- GranSim yeild poin
 428   ; granYield arg_regs node_points
 429
 430         -- Heap and/or stack checks wrap the function body
 431   ; funEntryChecks closure_info reg_save_code
 432                    fun_body
 433   }
 434 \end{code}
 435
 436
 437 %************************************************************************
 438 %*                                                                      *
 439 \subsubsubsection[update-and-BHs]{Update and black-hole wrappers}
 440 %*                                                                      *
 441 %************************************************************************
 442
 443
 444 \begin{code}
 445 blackHoleIt :: ClosureInfo -> Code
 446 -- Only called for closures with no args
 447 -- Node points to the closure
 448 blackHoleIt closure_info = emitBlackHoleCode (closureSingleEntry closure_info)
 449
 450 emitBlackHoleCode :: Bool -> Code
 451 emitBlackHoleCode is_single_entry = do
 452
 453   dflags <- getDynFlags
 454
 455         -- If we wanted to do eager blackholing with slop filling,
 456         -- we'd need to do it at the *end* of a basic block, otherwise
 457         -- we overwrite the free variables in the thunk that we still
 458         -- need.  We have a patch for this from Andy Cheadle, but not
 459         -- incorporated yet. --SDM [6/2004]
 460         --
 461         -- Profiling needs slop filling (to support LDV profiling), so
 462         -- currently eager blackholing doesn't work with profiling.
 463         --
 464         -- Previously, eager blackholing was enabled when ticky-ticky
 465         -- was on. But it didn't work, and it wasn't strictly necessary
 466         -- to bring back minimal ticky-ticky, so now EAGER_BLACKHOLING
 467         -- is unconditionally disabled. -- krc 1/2007
 468
 469   let eager_blackholing =  not opt_SccProfilingOn
 470                         && dopt Opt_EagerBlackHoling dflags
 471
 472   if eager_blackholing
 473      then do
 474           tickyBlackHole (not is_single_entry)
 475           let bh_info = CmmReg (CmmGlobal EagerBlackholeInfo)
 476           stmtsC [
 477               CmmStore (cmmOffsetW (CmmReg nodeReg) fixedHdrSize)
 478                        (CmmReg (CmmGlobal CurrentTSO)),
 479               CmmCall (CmmPrim MO_WriteBarrier) [] [] CmmUnsafe CmmMayReturn,
 480               CmmStore (CmmReg nodeReg) bh_info
 481             ]
 482      else
 483           nopC
 484 \end{code}
 485
 486 \begin{code}
 487 setupUpdate :: ClosureInfo -> Code -> Code      -- Only called for closures with no args
 488         -- Nota Bene: this function does not change Node (even if it's a CAF),
 489         -- so that the cost centre in the original closure can still be
 490         -- extracted by a subsequent enterCostCentre
 491 setupUpdate closure_info code
 492   | closureReEntrant closure_info
 493   = code
 494
 495   | not (isStaticClosure closure_info)
 496   = do
 497    if not (closureUpdReqd closure_info)
 498       then do tickyUpdateFrameOmitted; code
 499       else do
 500           tickyPushUpdateFrame
 501           dflags <- getDynFlags
 502           if not opt_SccProfilingOn && dopt Opt_EagerBlackHoling dflags
 503               then pushBHUpdateFrame (CmmReg nodeReg) code
 504               else pushUpdateFrame   (CmmReg nodeReg) code
 505
 506   | otherwise   -- A static closure
 507   = do  { tickyUpdateBhCaf closure_info
 508
 509         ; if closureUpdReqd closure_info
 510           then do       -- Blackhole the (updatable) CAF:
 511                 { upd_closure <- link_caf closure_info True
 512                 ; pushBHUpdateFrame upd_closure code }
 513           else do
 514                 { -- krc: removed some ticky-related code here.
 515                 ; tickyUpdateFrameOmitted
 516                 ; code }
 517     }
 518
 519
 520 -----------------------------------------------------------------------------
 521 -- Entering a CAF
 522 --
 523 -- When a CAF is first entered, it creates a black hole in the heap,
 524 -- and updates itself with an indirection to this new black hole.
 525 --
 526 -- We update the CAF with an indirection to a newly-allocated black
 527 -- hole in the heap.  We also set the blocking queue on the newly
 528 -- allocated black hole to be empty.
 529 --
 530 -- Why do we make a black hole in the heap when we enter a CAF?
 531 --
 532 --     - for a  generational garbage collector, which needs a fast
 533 --       test for whether an updatee is in an old generation or not
 534 --
 535 --     - for the parallel system, which can implement updates more
 536 --       easily if the updatee is always in the heap. (allegedly).
 537 --
 538 -- When debugging, we maintain a separate CAF list so we can tell when
 539 -- a CAF has been garbage collected.
 540
 541 -- newCAF must be called before the itbl ptr is overwritten, since
 542 -- newCAF records the old itbl ptr in order to do CAF reverting
 543 -- (which Hugs needs to do in order that combined mode works right.)
 544 --
 545
 546 -- ToDo [Feb 04]  This entire link_caf nonsense could all be moved
 547 -- into the "newCAF" RTS procedure, which we call anyway, including
 548 -- the allocation of the black-hole indirection closure.
 549 -- That way, code size would fall, the CAF-handling code would
 550 -- be closer together, and the compiler wouldn't need to know
 551 -- about off_indirectee etc.
 552
 553 link_caf :: ClosureInfo
 554          -> Bool                -- True <=> updatable, False <=> single-entry
 555          -> FCode CmmExpr       -- Returns amode for closure to be updated
 556 -- To update a CAF we must allocate a black hole, link the CAF onto the
 557 -- CAF list, then update the CAF to point to the fresh black hole.
 558 -- This function returns the address of the black hole, so it can be
 559 -- updated with the new value when available.  The reason for all of this
 560 -- is that we only want to update dynamic heap objects, not static ones,
 561 -- so that generational GC is easier.
 562 link_caf cl_info _is_upd = do
 563   {     -- Alloc black hole specifying CC_HDR(Node) as the cost centre
 564   ; let use_cc   = costCentreFrom (CmmReg nodeReg)
 565         blame_cc = use_cc
 566         tso      = CmmReg (CmmGlobal CurrentTSO)
 567   ; hp_offset <- allocDynClosure bh_cl_info use_cc blame_cc [(tso,fixedHdrSize)]
 568   ; hp_rel    <- getHpRelOffset hp_offset
 569
 570         -- Call the RTS function newCAF to add the CAF to the CafList
 571         -- so that the garbage collector can find them
 572         -- This must be done *before* the info table pointer is overwritten,
 573         -- because the old info table ptr is needed for reversion
 574   ; emitRtsCallWithVols rtsPackageId (fsLit "newCAF")
 575       [ CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint,
 576         CmmHinted (CmmReg nodeReg) AddrHint ]
 577       [node] False
 578         -- node is live, so save it.
 579
 580         -- Overwrite the closure with a (static) indirection
 581         -- to the newly-allocated black hole
 582   ; stmtsC [ CmmStore (cmmRegOffW nodeReg off_indirectee) hp_rel
 583            , CmmStore (CmmReg nodeReg) ind_static_info ]
 584
 585   ; returnFC hp_rel }
 586   where
 587     bh_cl_info :: ClosureInfo
 588     bh_cl_info = cafBlackHoleClosureInfo cl_info
 589
 590     ind_static_info :: CmmExpr
 591     ind_static_info = mkLblExpr mkIndStaticInfoLabel
 592
 593     off_indirectee :: WordOff
 594     off_indirectee = fixedHdrSize + oFFSET_StgInd_indirectee*wORD_SIZE
 595 \end{code}
 596
 597
 598 %************************************************************************
 599 %*                                                                      *
 600 \subsection[CgClosure-Description]{Profiling Closure Description.}
 601 %*                                                                      *
 602 %************************************************************************
 603
 604 For "global" data constructors the description is simply occurrence
 605 name of the data constructor itself.  Otherwise it is determined by
 606 @closureDescription@ from the let binding information.
 607
 608 \begin{code}
 609 closureDescription :: Module            -- Module
 610                    -> Name              -- Id of closure binding
 611                    -> String
 612         -- Not called for StgRhsCon which have global info tables built in
 613         -- CgConTbls.lhs with a description generated from the data constructor
 614 closureDescription mod_name name
 615   = showSDocDumpOneLine (char '<' <>
 616                     (if isExternalName name
 617                       then ppr name -- ppr will include the module name prefix
 618                       else pprModule mod_name <> char '.' <> ppr name) <>
 619                     char '>')
 620    -- showSDocDumpOneLine, because we want to see the unique on the Name.
 621 \end{code}
 622