%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgClosure.lhs,v 1.28 1999/04/23 09:51:24 simonm Exp $
+% $Id: CgClosure.lhs,v 1.33 1999/06/24 13:04:17 simonmar Exp $
%
\section[CgClosure]{Code generation for closures}
import CgMonad
import AbsCSyn
import StgSyn
-import BasicTypes ( TopLevelFlag(..) )
import AbsCUtils ( mkAbstractCs, getAmodeRep )
import CgBindery ( getCAddrMode, getArgAmodes,
fetchAndReschedule, yield, -- HWL
fastEntryChecks, thunkChecks
)
-import CgStackery ( adjustRealSp, mkTaggedVirtStkOffsets, freeStackSlots )
-import CgUsages ( setRealAndVirtualSp, getVirtSp,
+import CgStackery ( mkTaggedVirtStkOffsets, freeStackSlots )
+import CgUsages ( adjustSpAndHp, setRealAndVirtualSp, getVirtSp,
getSpRelOffset, getHpRelOffset
)
import CLabel ( CLabel, mkClosureLabel, mkFastEntryLabel,
- mkRednCountsLabel, mkStdEntryLabel
+ mkRednCountsLabel, mkInfoTableLabel
)
import ClosureInfo -- lots and lots of stuff
-import CmdLineOpts ( opt_GranMacros, opt_SccProfilingOn )
+import CmdLineOpts ( opt_GranMacros, opt_SccProfilingOn, opt_DoTickyProfiling )
import CostCentre
import Id ( Id, idName, idType, idPrimRep )
import Name ( Name )
import CmdLineOpts ( opt_SccProfilingOn )
import Outputable
+import Name ( nameOccName )
+import OccName ( occNameFS )
+
getWrapperArgTypeCategories = panic "CgClosure.getWrapperArgTypeCategories (ToDo)"
\end{code}
absC (mkAbstractCs (zipWith assign_to_reg arg_regs stk_amodes))
`thenC`
- -- Now adjust real stack pointers
- adjustRealSp sp_stk_args `thenC`
+ -- Now adjust real stack pointers (no need to adjust Hp,
+ -- but call this function for convenience).
+ adjustSpAndHp sp_stk_args `thenC`
absC (CFallThrough (CLbl fast_label CodePtrRep))
fast_entry_code
= profCtrC SLIT("TICK_ENT_FUN_DIRECT") [
- mkIntCLit stg_arity -- total # of args
-
- {- CLbl (mkRednCountsLabel name) PtrRep,
- CString (_PK_ (showSDoc (ppr name))),
+ CLbl (mkRednCountsLabel name) PtrRep,
+ mkCString (_PK_ (showSDoc (ppr name))),
mkIntCLit stg_arity, -- total # of args
mkIntCLit sp_stk_args, -- # passed on stk
- CString (_PK_ (map (showTypeCategory . idType) all_args)),
- CString SLIT(""), CString SLIT("")
- -}
+ mkCString (_PK_ (map (showTypeCategory . idType) all_args))
+ ] `thenC`
-- Nuked for now; see comment at end of file
-- CString (_PK_ (show_wrapper_name wrapper_maybe)),
-- CString (_PK_ (show_wrapper_arg_kinds wrapper_maybe))
- ] `thenC`
-- Bind args to regs/stack as appropriate, and
-- record expected position of sps.
enterCostCentreCode closure_info cc IsFunction False `thenC`
-- Do the business
- funWrapper closure_info arg_regs stk_tags slow_label (cgExpr body)
+ funWrapper closure_info arg_regs stk_tags info_label (cgExpr body)
in
-- Make a labelled code-block for the slow and fast entry code
forkAbsC (if slow_code_needed then slow_entry_code else absC AbsCNop)
-- Manufacture labels
name = closureName closure_info
fast_label = mkFastEntryLabel name stg_arity
- slow_label = mkStdEntryLabel name
+ info_label = mkInfoTableLabel name
\end{code}
For lexically scoped profiling we have to load the cost centre from
funWrapper :: ClosureInfo -- Closure whose code body this is
-> [MagicId] -- List of argument registers (if any)
-> [(VirtualSpOffset,Int)] -- tagged stack slots
- -> CLabel -- slow entry point for heap check ret.
+ -> CLabel -- info table for heap check ret.
-> Code -- Body of function being compiled
-> Code
-funWrapper closure_info arg_regs stk_tags slow_label fun_body
+funWrapper closure_info arg_regs stk_tags info_label fun_body
= -- Stack overflow check
nodeMustPointToIt (closureLFInfo closure_info) `thenFC` \ node_points ->
let
else absC AbsCNop) `thenC`
-- heap and/or stack checks
- fastEntryChecks arg_regs stk_tags slow_label node_points (
+ fastEntryChecks arg_regs stk_tags info_label node_points (
-- Finally, do the business
fun_body
\begin{code}
-blackHoleIt :: ClosureInfo -> Bool -> Code -- Only called for thunks
+blackHoleIt :: ClosureInfo -> Bool -> Code -- Only called for closures with no args
+
blackHoleIt closure_info node_points
= if blackHoleOnEntry closure_info && node_points
then
\end{code}
\begin{code}
-setupUpdate :: ClosureInfo -> Code -> Code -- Only called for thunks
+setupUpdate :: ClosureInfo -> Code -> Code -- Only called for closures with no args
-- Nota Bene: this function does not change Node (even if it's a CAF),
-- so that the cost centre in the original closure can still be
-- extracted by a subsequent ENTER_CC_TCL
+-- I've tidied up the code for this function, but it should still do the same as
+-- it did before (modulo ticky stuff). KSW 1999-04.
setupUpdate closure_info code
- = if (closureUpdReqd closure_info) then
- link_caf_if_needed `thenFC` \ update_closure ->
- pushUpdateFrame update_closure code
+ = if closureReEntrant closure_info
+ then
+ code
else
- profCtrC SLIT("TICK_UPDF_OMITTED") [] `thenC`
- code
+ case (closureUpdReqd closure_info, isStaticClosure closure_info) of
+ (False,False) -> profCtrC SLIT("TICK_UPDF_OMITTED") [] `thenC`
+ code
+ (False,True ) -> (if opt_DoTickyProfiling
+ then
+ -- blackhole the SE CAF
+ link_caf seCafBlackHoleClosureInfo `thenFC` \ _ -> nopC
+ else
+ nopC) `thenC`
+ profCtrC SLIT("TICK_UPD_CAF_BH_SINGLE_ENTRY") [mkCString cl_name] `thenC`
+ profCtrC SLIT("TICK_UPDF_OMITTED") [] `thenC`
+ code
+ (True ,False) -> pushUpdateFrame (CReg node) code
+ (True ,True ) -> -- blackhole the (updatable) CAF:
+ link_caf cafBlackHoleClosureInfo `thenFC` \ update_closure ->
+ profCtrC SLIT("TICK_UPD_CAF_BH_UPDATABLE") [mkCString cl_name] `thenC`
+ pushUpdateFrame update_closure code
where
- link_caf_if_needed :: FCode CAddrMode -- Returns amode for closure to be updated
- link_caf_if_needed
- = if not (isStaticClosure closure_info) then
- returnFC (CReg node)
- else
-
- -- First we must allocate a black hole, and link the
- -- CAF onto the CAF list
-
- -- Alloc black hole specifying CC_HDR(Node) as the cost centre
- -- Hack Warning: Using a CLitLit to get CAddrMode !
- let
- use_cc = CLitLit SLIT("CCS_HDR(R1.p)") PtrRep
- blame_cc = use_cc
- in
- allocDynClosure (blackHoleClosureInfo 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
+ cl_name :: FAST_STRING
+ 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
+ -- Hack Warning: Using a CLitLit to get CAddrMode !
+ let
+ use_cc = CLitLit SLIT("CCS_HDR(R1.p)") PtrRep
+ 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
\end{code}
%************************************************************************