- = if closureReEntrant closure_info
- then
- code
- else
- case (closureUpdReqd closure_info, isStaticClosure closure_info) of
- (False,False) -> profCtrC FSLIT("TICK_UPDF_OMITTED") [] `thenC`
- code
- (False,True ) -> (if opt_DoTickyProfiling
- then
- -- blackhole the SE CAF
- link_caf seCafBlackHoleClosureInfo `thenFC` \ _ -> nopC
- else
- nopC) `thenC`
- profCtrC FSLIT("TICK_UPD_CAF_BH_SINGLE_ENTRY") [mkCString cl_name] `thenC`
- profCtrC FSLIT("TICK_UPDF_OMITTED") [] `thenC`
- code
- (True ,False) -> pushUpdateFrame (CReg node) code
- (True ,True ) -> -- blackhole the (updatable) CAF:
- link_caf cafBlackHoleClosureInfo `thenFC` \ update_closure ->
- profCtrC FSLIT("TICK_UPD_CAF_BH_UPDATABLE") [mkCString cl_name] `thenC`
- pushUpdateFrame update_closure code
- where
- cl_name :: FastString
- cl_name = (occNameFS . nameOccName . closureName) closure_info
-
- link_caf :: (ClosureInfo -> ClosureInfo) -- function yielding BH closure_info
- -> FCode CAddrMode -- Returns amode for closure to be updated
- link_caf bhCI
- = -- To update a CAF we must allocate a black hole, link the CAF onto the
- -- CAF list, then update the CAF to point to the fresh black hole.
- -- This function returns the address of the black hole, so it can be
- -- updated with the new value when available.
-
- -- Alloc black hole specifying CC_HDR(Node) as the cost centre
- let
- use_cc = CMacroExpr PtrRep CCS_HDR [nodeReg]
- blame_cc = use_cc
- in
- allocDynClosure (bhCI closure_info) use_cc blame_cc [] `thenFC` \ heap_offset ->
- getHpRelOffset heap_offset `thenFC` \ hp_rel ->
- let amode = CAddr hp_rel
- in
- absC (CMacroStmt UPD_CAF [CReg node, amode]) `thenC`
- returnFC amode
+ | closureReEntrant closure_info
+ = code
+
+ | not (isStaticClosure closure_info)
+ = if closureUpdReqd closure_info
+ then do { tickyPushUpdateFrame; pushUpdateFrame (CmmReg nodeReg) code }
+ else do { tickyUpdateFrameOmitted; code }
+
+ | otherwise -- A static closure
+ = do { tickyUpdateBhCaf closure_info
+
+ ; if closureUpdReqd closure_info
+ then do -- Blackhole the (updatable) CAF:
+ { upd_closure <- link_caf closure_info True
+ ; pushUpdateFrame upd_closure code }
+ else do
+ { -- No update reqd, you'd think we don't need to
+ -- black-hole it. But when ticky-ticky is on, we
+ -- black-hole it regardless, to catch errors in which
+ -- an allegedly single-entry closure is entered twice
+ --
+ -- We discard the pointer returned by link_caf, because
+ -- we don't push an update frame
+ whenC opt_DoTickyProfiling -- Blackhole even a SE CAF
+ (link_caf closure_info False >> nopC)
+ ; tickyUpdateFrameOmitted
+ ; code }
+ }
+
+
+-----------------------------------------------------------------------------
+-- Entering a CAF
+--
+-- When a CAF is first entered, it creates a black hole in the heap,
+-- and updates itself with an indirection to this new black hole.
+--
+-- We update the CAF with an indirection to a newly-allocated black
+-- hole in the heap. We also set the blocking queue on the newly
+-- allocated black hole to be empty.
+--
+-- Why do we make a black hole in the heap when we enter a CAF?
+--
+-- - for a generational garbage collector, which needs a fast
+-- test for whether an updatee is in an old generation or not
+--
+-- - for the parallel system, which can implement updates more
+-- easily if the updatee is always in the heap. (allegedly).
+--
+-- When debugging, we maintain a separate CAF list so we can tell when
+-- a CAF has been garbage collected.
+
+-- newCAF must be called before the itbl ptr is overwritten, since
+-- newCAF records the old itbl ptr in order to do CAF reverting
+-- (which Hugs needs to do in order that combined mode works right.)
+--
+
+-- ToDo [Feb 04] This entire link_caf nonsense could all be moved
+-- into the "newCAF" RTS procedure, which we call anyway, including
+-- the allocation of the black-hole indirection closure.
+-- That way, code size would fall, the CAF-handling code would
+-- be closer together, and the compiler wouldn't need to know
+-- about off_indirectee etc.
+
+link_caf :: ClosureInfo
+ -> Bool -- True <=> updatable, False <=> single-entry
+ -> FCode CmmExpr -- Returns amode for closure to be updated
+-- To update a CAF we must allocate a black hole, link the CAF onto the
+-- CAF list, then update the CAF to point to the fresh black hole.
+-- This function returns the address of the black hole, so it can be
+-- updated with the new value when available. The reason for all of this
+-- is that we only want to update dynamic heap objects, not static ones,
+-- so that generational GC is easier.
+link_caf cl_info is_upd = do
+ { -- Alloc black hole specifying CC_HDR(Node) as the cost centre
+ ; let use_cc = costCentreFrom (CmmReg nodeReg)
+ blame_cc = use_cc
+ ; hp_offset <- allocDynClosure bh_cl_info use_cc blame_cc []
+ ; hp_rel <- getHpRelOffset hp_offset
+
+ -- Call the RTS function newCAF to add the CAF to the CafList
+ -- so that the garbage collector can find them
+ -- This must be done *before* the info table pointer is overwritten,
+ -- because the old info table ptr is needed for reversion
+ ; emitRtsCallWithVols SLIT("newCAF") [(CmmReg nodeReg,PtrHint)] [node]
+ -- node is live, so save it.
+
+ -- Overwrite the closure with a (static) indirection
+ -- to the newly-allocated black hole
+ ; stmtsC [ CmmStore (cmmRegOffW nodeReg off_indirectee) hp_rel
+ , CmmStore (CmmReg nodeReg) ind_static_info ]
+
+ ; returnFC hp_rel }
+ where
+ bh_cl_info :: ClosureInfo
+ bh_cl_info | is_upd = cafBlackHoleClosureInfo cl_info
+ | otherwise = seCafBlackHoleClosureInfo cl_info
+
+ ind_static_info :: CmmExpr
+ ind_static_info = mkLblExpr mkIndStaticInfoLabel
+
+ off_indirectee :: WordOff
+ off_indirectee = fixedHdrSize + oFFSET_StgInd_indirectee*wORD_SIZE