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