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