2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
5 \section[CgClosure]{Code generation for closures}
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.
12 module CgClosure ( cgTopRhsClosure,
18 #include "HsVersions.h"
20 import {-# SOURCE #-} CgExpr ( cgExpr )
53 %********************************************************
55 \subsection[closures-no-free-vars]{Top-level closures}
57 %********************************************************
59 For closures bound at top level, allocate in static space.
60 They should have no free variables.
64 -> CostCentreStack -- Optional cost centre annotation
69 -> FCode (Id, CgIdInfo)
71 cgTopRhsClosure id ccs binder_info upd_flag args body = do
72 { -- LAY OUT THE OBJECT
74 ; lf_info <- mkClosureLFInfo id TopLevel [] upd_flag args
75 ; srt_info <- getSRTInfo
76 ; mod_name <- getModuleName
77 ; let descr = closureDescription mod_name name
78 closure_info = mkClosureInfo True id lf_info 0 0 srt_info descr
79 closure_label = mkLocalClosureLabel name
80 cg_id_info = stableIdInfo id (mkLblExpr closure_label) lf_info
81 closure_rep = mkStaticClosureFields closure_info ccs True []
83 -- BUILD THE OBJECT, AND GENERATE INFO TABLE (IF NECESSARY)
84 ; emitDataLits closure_label closure_rep
85 ; forkClosureBody (closureCodeBody binder_info closure_info
88 ; returnFC (id, cg_id_info) }
91 %********************************************************
93 \subsection[non-top-level-closures]{Non top-level closures}
95 %********************************************************
97 For closures with free vars, allocate in heap.
102 -> CostCentreStack -- Optional cost centre annotation
108 -> [StgArg] -- payload
109 -> FCode (Id, CgIdInfo)
111 cgStdRhsClosure bndr cc bndr_info fvs args body lf_info payload
112 = do -- AHA! A STANDARD-FORM THUNK
113 { -- LAY OUT THE OBJECT
114 amodes <- getArgAmodes payload
115 ; mod_name <- getModuleName
116 ; let (tot_wds, ptr_wds, amodes_w_offsets)
117 = mkVirtHeapOffsets (isLFThunk lf_info) amodes
119 descr = closureDescription mod_name (idName bndr)
120 closure_info = mkClosureInfo False -- Not static
121 bndr lf_info tot_wds ptr_wds
122 NoC_SRT -- No SRT for a std-form closure
125 ; (use_cc, blame_cc) <- chooseDynCostCentres cc args body
128 ; heap_offset <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
131 ; returnFC (bndr, heapIdInfo bndr heap_offset lf_info) }
134 Here's the general case.
138 -> CostCentreStack -- Optional cost centre annotation
144 -> FCode (Id, CgIdInfo)
146 cgRhsClosure bndr cc bndr_info fvs upd_flag args body = do
147 { -- LAY OUT THE OBJECT
148 -- If the binder is itself a free variable, then don't store
149 -- it in the closure. Instead, just bind it to Node on entry.
150 -- NB we can be sure that Node will point to it, because we
151 -- havn't told mkClosureLFInfo about this; so if the binder
152 -- _was_ a free var of its RHS, mkClosureLFInfo thinks it *is*
153 -- stored in the closure itself, so it will make sure that
154 -- Node points to it...
157 is_elem = isIn "cgRhsClosure"
158 bndr_is_a_fv = bndr `is_elem` fvs
159 reduced_fvs | bndr_is_a_fv = fvs `minusList` [bndr]
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)
170 add_rep info = (cgIdInfoArgRep info, info)
172 descr = closureDescription mod_name name
173 closure_info = mkClosureInfo False -- Not static
174 bndr lf_info tot_wds ptr_wds
177 -- BUILD ITS INFO TABLE AND CODE
178 ; forkClosureBody (do
180 let bind_fv (info, offset)
181 = bindNewToNode (cgIdInfoId info) offset (cgIdInfoLF info)
182 ; mapCs bind_fv bind_details
184 -- Bind the binder itself, if it is a free var
185 ; whenC bndr_is_a_fv (bindNewToReg bndr nodeReg lf_info)
188 ; closureCodeBody bndr_info closure_info cc args body })
192 to_amode (info, offset) = do { amode <- idInfoToAmode info
193 ; return (amode, offset) }
194 ; (use_cc, blame_cc) <- chooseDynCostCentres cc args body
195 ; amodes_w_offsets <- mapFCs to_amode bind_details
196 ; heap_offset <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
199 ; returnFC (bndr, heapIdInfo bndr heap_offset lf_info) }
202 mkClosureLFInfo :: Id -- The binder
203 -> TopLevelFlag -- True of top level
205 -> UpdateFlag -- Update flag
207 -> FCode LambdaFormInfo
208 mkClosureLFInfo bndr top fvs upd_flag args
209 | null args = return (mkLFThunk (idType bndr) top fvs upd_flag)
210 | otherwise = do { arg_descr <- mkArgDescr (idName bndr) args
211 ; return (mkLFReEntrant top fvs args arg_descr) }
215 %************************************************************************
217 \subsection[code-for-closures]{The code for closures}
219 %************************************************************************
222 closureCodeBody :: StgBinderInfo
223 -> ClosureInfo -- Lots of information about this closure
224 -> CostCentreStack -- Optional cost centre attached to closure
230 There are two main cases for the code for closures. If there are {\em
231 no arguments}, then the closure is a thunk, and not in normal form.
232 So it should set up an update frame (if it is shared).
233 NB: Thunks cannot have a primitive type!
236 closureCodeBody binder_info cl_info cc [{- No args i.e. thunk -}] body = do
237 { body_absC <- getCgStmts $ do
238 { tickyEnterThunk cl_info
239 ; ldvEnter (CmmReg nodeReg) -- NB: Node always points when profiling
240 ; thunkWrapper cl_info $ do
241 -- We only enter cc after setting up update so
242 -- that cc of enclosing scope will be recorded
243 -- in update frame CAF/DICT functions will be
244 -- subsumed by this enclosing cc
245 { enterCostCentre cl_info cc body
249 ; emitClosureCodeAndInfoTable cl_info [] body_absC }
252 If there is /at least one argument/, then this closure is in
253 normal form, so there is no need to set up an update frame.
255 The Macros for GrAnSim are produced at the beginning of the
256 argSatisfactionCheck (by calling fetchAndReschedule). There info if
257 Node points to closure is available. -- HWL
260 closureCodeBody binder_info cl_info cc args body
261 = ASSERT( length args > 0 )
262 do { -- Get the current virtual Sp (it might not be zero,
263 -- eg. if we're compiling a let-no-escape).
265 ; let (reg_args, other_args) = assignCallRegs (addIdReps args)
266 (sp_top, stk_args) = mkVirtStkOffsets vSp other_args
268 -- Allocate the global ticky counter
269 ; let ticky_ctr_lbl = mkRednCountsLabel (closureName cl_info)
270 ; emitTickyCounter cl_info args sp_top
272 -- ...and establish the ticky-counter
273 -- label for this block
274 ; setTickyCtrLabel ticky_ctr_lbl $ do
276 -- Emit the slow-entry code
277 { reg_save_code <- mkSlowEntryCode cl_info reg_args
279 -- Emit the main entry code
281 mkFunEntryCode cl_info cc reg_args stk_args
282 sp_top reg_save_code body
283 ; emitClosureCodeAndInfoTable cl_info [] blks
288 mkFunEntryCode :: ClosureInfo
290 -> [(Id,GlobalReg)] -- Args in regs
291 -> [(Id,VirtualSpOffset)] -- Args on stack
292 -> VirtualSpOffset -- Last allocated word on stack
293 -> CmmStmts -- Register-save code in case of GC
296 -- The main entry code for the closure
297 mkFunEntryCode cl_info cc reg_args stk_args sp_top reg_save_code body = do
298 { -- Bind args to regs/stack as appropriate,
299 -- and record expected position of sps
300 ; bindArgsToRegs reg_args
301 ; bindArgsToStack stk_args
302 ; setRealAndVirtualSp sp_top
304 -- Enter the cost-centre, if required
305 -- ToDo: It's not clear why this is outside the funWrapper,
306 -- but the tickyEnterFun is inside. Perhaps we can put
308 ; enterCostCentre cl_info cc body
311 ; funWrapper cl_info reg_args reg_save_code $ do
312 { tickyEnterFun cl_info
317 The "slow entry" code for a function. This entry point takes its
318 arguments on the stack. It loads the arguments into registers
319 according to the calling convention, and jumps to the function's
320 normal entry point. The function's closure is assumed to be in
323 The slow entry point is used in two places:
325 (a) unknown calls: eg. stg_PAP_entry
326 (b) returning from a heap-check failure
329 mkSlowEntryCode :: ClosureInfo -> [(Id,GlobalReg)] -> FCode CmmStmts
330 -- If this function doesn't have a specialised ArgDescr, we need
331 -- to generate the function's arg bitmap, slow-entry code, and
332 -- register-save code for the heap-check failure
333 -- Here, we emit the slow-entry code, and
334 -- return the register-save assignments
335 mkSlowEntryCode cl_info reg_args
336 | Just (_, ArgGen _) <- closureFunInfo cl_info
337 = do { emitSimpleProc slow_lbl (emitStmts load_stmts)
338 ; return save_stmts }
339 | otherwise = return noStmts
341 name = closureName cl_info
342 slow_lbl = mkSlowEntryLabel name
344 load_stmts = mkStmts load_assts `plusStmts` mkStmts [stk_adj_pop, jump_to_entry]
345 save_stmts = oneStmt stk_adj_push `plusStmts` mkStmts save_assts
347 reps_w_regs :: [(CgRep,GlobalReg)]
348 reps_w_regs = [(idCgRep id, reg) | (id,reg) <- reverse reg_args]
349 (final_stk_offset, stk_offsets)
350 = mapAccumL (\off (rep,_) -> (off + cgRepSizeW rep, off))
353 load_assts = zipWithEqual "mk_load" mk_load reps_w_regs stk_offsets
354 mk_load (rep,reg) offset = CmmAssign (CmmGlobal reg)
355 (CmmLoad (cmmRegOffW spReg offset)
358 save_assts = zipWithEqual "mk_save" mk_save reps_w_regs stk_offsets
359 mk_save (rep,reg) offset = ASSERT( argMachRep rep == globalRegRep reg )
360 CmmStore (cmmRegOffW spReg offset)
361 (CmmReg (CmmGlobal reg))
363 stk_adj_pop = CmmAssign spReg (cmmRegOffW spReg final_stk_offset)
364 stk_adj_push = CmmAssign spReg (cmmRegOffW spReg (- final_stk_offset))
365 jump_to_entry = CmmJump (mkLblExpr (enterLocalIdLabel name)) []
369 %************************************************************************
371 \subsubsection[closure-code-wrappers]{Wrappers around closure code}
373 %************************************************************************
376 thunkWrapper:: ClosureInfo -> Code -> Code
377 thunkWrapper closure_info thunk_code = do
378 { let node_points = nodeMustPointToIt (closureLFInfo closure_info)
380 -- HWL: insert macros for GrAnSim; 2 versions depending on liveness of node
381 -- (we prefer fetchAndReschedule-style context switches to yield ones)
383 then granFetchAndReschedule [] node_points
384 else granYield [] node_points
386 -- Stack and/or heap checks
387 ; thunkEntryChecks closure_info $ do
388 { -- Overwrite with black hole if necessary
389 whenC (blackHoleOnEntry closure_info && node_points)
390 (blackHoleIt closure_info)
391 ; setupUpdate closure_info thunk_code }
392 -- setupUpdate *encloses* the thunk_code
395 funWrapper :: ClosureInfo -- Closure whose code body this is
396 -> [(Id,GlobalReg)] -- List of argument registers (if any)
397 -> CmmStmts -- reg saves for the heap check failure
398 -> Code -- Body of function being compiled
400 funWrapper closure_info arg_regs reg_save_code fun_body = do
401 { let node_points = nodeMustPointToIt (closureLFInfo closure_info)
403 -- Enter for Ldv profiling
404 ; whenC node_points (ldvEnter (CmmReg nodeReg))
406 -- GranSim yeild poin
407 ; granYield arg_regs node_points
409 -- Heap and/or stack checks wrap the function body
410 ; funEntryChecks closure_info reg_save_code
416 %************************************************************************
418 \subsubsubsection[update-and-BHs]{Update and black-hole wrappers}
420 %************************************************************************
424 blackHoleIt :: ClosureInfo -> Code
425 -- Only called for closures with no args
426 -- Node points to the closure
427 blackHoleIt closure_info = emitBlackHoleCode (closureSingleEntry closure_info)
429 emitBlackHoleCode :: Bool -> Code
430 emitBlackHoleCode is_single_entry
431 | eager_blackholing = do
432 tickyBlackHole (not is_single_entry)
433 stmtC (CmmStore (CmmReg nodeReg) (CmmLit (CmmLabel bh_lbl)))
437 bh_lbl | is_single_entry = mkRtsDataLabel SLIT("stg_SE_BLACKHOLE_info")
438 | otherwise = mkRtsDataLabel SLIT("stg_BLACKHOLE_info")
440 -- If we wanted to do eager blackholing with slop filling,
441 -- we'd need to do it at the *end* of a basic block, otherwise
442 -- we overwrite the free variables in the thunk that we still
443 -- need. We have a patch for this from Andy Cheadle, but not
444 -- incorporated yet. --SDM [6/2004]
446 -- Profiling needs slop filling (to support LDV profiling), so
447 -- currently eager blackholing doesn't work with profiling.
449 -- Previously, eager blackholing was enabled when ticky-ticky
450 -- was on. But it didn't work, and it wasn't strictly necessary
451 -- to bring back minimal ticky-ticky, so now EAGER_BLACKHOLING
452 -- is unconditionally disabled. -- krc 1/2007
454 eager_blackholing = False
458 setupUpdate :: ClosureInfo -> Code -> Code -- Only called for closures with no args
459 -- Nota Bene: this function does not change Node (even if it's a CAF),
460 -- so that the cost centre in the original closure can still be
461 -- extracted by a subsequent enterCostCentre
462 setupUpdate closure_info code
463 | closureReEntrant closure_info
466 | not (isStaticClosure closure_info)
467 = if closureUpdReqd closure_info
468 then do { tickyPushUpdateFrame; pushUpdateFrame (CmmReg nodeReg) code }
469 else do { tickyUpdateFrameOmitted; code }
471 | otherwise -- A static closure
472 = do { tickyUpdateBhCaf closure_info
474 ; if closureUpdReqd closure_info
475 then do -- Blackhole the (updatable) CAF:
476 { upd_closure <- link_caf closure_info True
477 ; pushUpdateFrame upd_closure code }
479 { -- krc: removed some ticky-related code here.
480 ; tickyUpdateFrameOmitted
485 -----------------------------------------------------------------------------
488 -- When a CAF is first entered, it creates a black hole in the heap,
489 -- and updates itself with an indirection to this new black hole.
491 -- We update the CAF with an indirection to a newly-allocated black
492 -- hole in the heap. We also set the blocking queue on the newly
493 -- allocated black hole to be empty.
495 -- Why do we make a black hole in the heap when we enter a CAF?
497 -- - for a generational garbage collector, which needs a fast
498 -- test for whether an updatee is in an old generation or not
500 -- - for the parallel system, which can implement updates more
501 -- easily if the updatee is always in the heap. (allegedly).
503 -- When debugging, we maintain a separate CAF list so we can tell when
504 -- a CAF has been garbage collected.
506 -- newCAF must be called before the itbl ptr is overwritten, since
507 -- newCAF records the old itbl ptr in order to do CAF reverting
508 -- (which Hugs needs to do in order that combined mode works right.)
511 -- ToDo [Feb 04] This entire link_caf nonsense could all be moved
512 -- into the "newCAF" RTS procedure, which we call anyway, including
513 -- the allocation of the black-hole indirection closure.
514 -- That way, code size would fall, the CAF-handling code would
515 -- be closer together, and the compiler wouldn't need to know
516 -- about off_indirectee etc.
518 link_caf :: ClosureInfo
519 -> Bool -- True <=> updatable, False <=> single-entry
520 -> FCode CmmExpr -- Returns amode for closure to be updated
521 -- To update a CAF we must allocate a black hole, link the CAF onto the
522 -- CAF list, then update the CAF to point to the fresh black hole.
523 -- This function returns the address of the black hole, so it can be
524 -- updated with the new value when available. The reason for all of this
525 -- is that we only want to update dynamic heap objects, not static ones,
526 -- so that generational GC is easier.
527 link_caf cl_info is_upd = do
528 { -- Alloc black hole specifying CC_HDR(Node) as the cost centre
529 ; let use_cc = costCentreFrom (CmmReg nodeReg)
531 ; hp_offset <- allocDynClosure bh_cl_info use_cc blame_cc []
532 ; hp_rel <- getHpRelOffset hp_offset
534 -- Call the RTS function newCAF to add the CAF to the CafList
535 -- so that the garbage collector can find them
536 -- This must be done *before* the info table pointer is overwritten,
537 -- because the old info table ptr is needed for reversion
538 ; emitRtsCallWithVols SLIT("newCAF") [(CmmReg nodeReg,PtrHint)] [node] False
539 -- node is live, so save it.
541 -- Overwrite the closure with a (static) indirection
542 -- to the newly-allocated black hole
543 ; stmtsC [ CmmStore (cmmRegOffW nodeReg off_indirectee) hp_rel
544 , CmmStore (CmmReg nodeReg) ind_static_info ]
548 bh_cl_info :: ClosureInfo
549 bh_cl_info | is_upd = cafBlackHoleClosureInfo cl_info
550 | otherwise = seCafBlackHoleClosureInfo cl_info
552 ind_static_info :: CmmExpr
553 ind_static_info = mkLblExpr mkIndStaticInfoLabel
555 off_indirectee :: WordOff
556 off_indirectee = fixedHdrSize + oFFSET_StgInd_indirectee*wORD_SIZE
560 %************************************************************************
562 \subsection[CgClosure-Description]{Profiling Closure Description.}
564 %************************************************************************
566 For "global" data constructors the description is simply occurrence
567 name of the data constructor itself. Otherwise it is determined by
568 @closureDescription@ from the let binding information.
571 closureDescription :: Module -- Module
572 -> Name -- Id of closure binding
574 -- Not called for StgRhsCon which have global info tables built in
575 -- CgConTbls.lhs with a description generated from the data constructor
576 closureDescription mod_name name
577 = showSDocDump (char '<' <>
578 (if isExternalName name
579 then ppr name -- ppr will include the module name prefix
580 else pprModule mod_name <> char '.' <> ppr name) <>
582 -- showSDocDump, because we want to see the unique on the Name.