ghc/compiler/codeGen/CgClosure.lhs

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