%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgClosure.lhs,v 1.45 2001/03/06 10:13:35 simonmar Exp $
+% $Id: CgClosure.lhs,v 1.49 2001/09/26 15:11:50 simonpj Exp $
%
\section[CgClosure]{Code generation for closures}
cgTopRhsClosure :: Id
-> CostCentreStack -- Optional cost centre annotation
-> StgBinderInfo
+ -> SRT
-> [Id] -- Args
-> StgExpr
-> LambdaFormInfo
-> FCode (Id, CgIdInfo)
-cgTopRhsClosure id ccs binder_info args body lf_info
+cgTopRhsClosure id ccs binder_info srt args body lf_info
=
-- LAY OUT THE OBJECT
+ getSRTInfo srt `thenFC` \ srt_info ->
let
name = idName id
- closure_info = layOutStaticNoFVClosure name lf_info
+ closure_info = layOutStaticNoFVClosure name lf_info srt_info
closure_label = mkClosureLabel name
cg_id_info = stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info
in
getArgAmodes payload `thenFC` \ amodes ->
let
(closure_info, amodes_w_offsets)
- = layOutDynClosure (idName binder) getAmodeRep amodes lf_info
+ = layOutDynClosure (idName binder) getAmodeRep amodes lf_info NoC_SRT
+ -- No SRT for a standard-form closure
(use_cc, blame_cc) = chooseDynCostCentres cc args fvs body
in
cgRhsClosure :: Id
-> CostCentreStack -- Optional cost centre annotation
-> StgBinderInfo
+ -> SRT
-> [Id] -- Free vars
-> [Id] -- Args
-> StgExpr
-> LambdaFormInfo
-> FCode (Id, CgIdInfo)
-cgRhsClosure binder cc binder_info fvs args body lf_info
+cgRhsClosure binder cc binder_info srt fvs args body lf_info
= (
-- LAY OUT THE OBJECT
--
else fvs
in
mapFCs getCAddrModeAndInfo reduced_fvs `thenFC` \ fvs_w_amodes_and_info ->
+ getSRTInfo srt `thenFC` \ srt_info ->
let
closure_info :: ClosureInfo
bind_details :: [((Id, CAddrMode, LambdaFormInfo), VirtualHeapOffset)]
(closure_info, bind_details)
- = layOutDynClosure (idName binder) get_kind fvs_w_amodes_and_info lf_info
+ = layOutDynClosure (idName binder) get_kind
+ fvs_w_amodes_and_info lf_info srt_info
bind_fv ((id, _, lf_info), offset) = bindNewToNode id offset lf_info
--
arg_regs = case entry_conv of
DirectEntry lbl arity regs -> regs
- other -> trace ("*** closureCodeBody:arg_regs " ++ (pprHWL entry_conv) ++ "(HWL ignored; no args passed in regs)") []
-
- pprHWL :: EntryConvention -> String
- pprHWL (ViaNode) = "ViaNode"
- pprHWL (StdEntry cl) = "StdEntry"
- pprHWL (DirectEntry cl i l) = "DirectEntry"
+ other -> [] -- "(HWL ignored; no args passed in regs)"
num_arg_regs = length arg_regs
-- see argSatisfactionCheck for new version
-- fast_entry_code = forceHeapCheck [] True fast_entry_code'
- fast_entry_code
- = moduleName `thenFC` \ mod_name ->
- profCtrC SLIT("TICK_CTR") [
- CLbl ticky_ctr_label DataPtrRep,
- mkCString (_PK_ (ppr_for_ticky_name mod_name name)),
- mkIntCLit stg_arity, -- total # of args
- mkIntCLit sp_stk_args, -- # passed on stk
- mkCString (_PK_ (map (showTypeCategory . idType) all_args))
- ] `thenC`
-
- profCtrC SLIT("TICK_ENT_FUN_DIRECT") [
- CLbl ticky_ctr_label DataPtrRep
- ] `thenC`
+ fast_entry_code = do
+ mod_name <- moduleName
+ profCtrC SLIT("TICK_CTR") [
+ CLbl ticky_ctr_label DataPtrRep,
+ mkCString (_PK_ (ppr_for_ticky_name mod_name name)),
+ mkIntCLit stg_arity, -- total # of args
+ mkIntCLit sp_stk_args, -- # passed on stk
+ mkCString (_PK_ (map (showTypeCategory . idType) all_args))
+ ]
+ let prof =
+ profCtrC SLIT("TICK_ENT_FUN_DIRECT") [
+ CLbl ticky_ctr_label DataPtrRep
+ ]
-- Nuked for now; see comment at end of file
-- CString (_PK_ (show_wrapper_name wrapper_maybe)),
-- Bind args to regs/stack as appropriate, and
-- record expected position of sps.
- bindArgsToRegs reg_args arg_regs `thenC`
- mapCs bindNewToStack stk_offsets `thenC`
- setRealAndVirtualSp sp_stk_args `thenC`
+ bindArgsToRegs reg_args arg_regs
+ mapCs bindNewToStack stk_offsets
+ setRealAndVirtualSp sp_stk_args
-- free up the stack slots containing tags
- freeStackSlots (map fst stk_tags) `thenC`
+ freeStackSlots (map fst stk_tags)
-- Enter the closures cc, if required
- enterCostCentreCode closure_info cc IsFunction False `thenC`
+ enterCostCentreCode closure_info cc IsFunction False
-- Do the business
- funWrapper closure_info arg_regs stk_tags info_label (cgExpr body)
+ funWrapper closure_info arg_regs stk_tags info_label
+ (prof >> cgExpr body)
in
setTickyCtrLabel ticky_ctr_label (
forkAbsC (if slow_code_needed then slow_entry_code else absC AbsCNop)
`thenFC` \ slow_abs_c ->
forkAbsC fast_entry_code `thenFC` \ fast_abs_c ->
- moduleName `thenFC` \ mod_name ->
+ moduleName `thenFC` \ mod_name ->
-- Now either construct the info table, or put the fast code in alone
-- (We never have slow code without an info table)