diff options
Diffstat (limited to 'compiler/codeGen')
| -rw-r--r-- | compiler/codeGen/StgCmmBind.hs | 22 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmClosure.hs | 19 |
2 files changed, 23 insertions, 18 deletions
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index b29394da6f..aa2b954a95 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -95,19 +95,17 @@ cgTopRhsClosure dflags rec id ccs _ upd_flag args body = emitDataLits closure_label closure_rep return () - gen_code dflags lf_info closure_label - = do { -- LAY OUT THE OBJECT - let name = idName id + gen_code dflags lf_info _closure_label + = do { let name = idName id ; mod_name <- getModuleName ; let descr = closureDescription dflags mod_name name closure_info = mkClosureInfo dflags True id lf_info 0 0 descr - caffy = idCafInfo id - info_tbl = mkCmmInfo closure_info -- XXX short-cut - closure_rep = mkStaticClosureFields dflags info_tbl ccs caffy [] + -- We don't generate the static closure here, because we might + -- want to add references to static closures to it later. The + -- static closure is generated by CmmBuildInfoTables.updInfoSRTs, + -- See Note [SRTs], specifically the [FUN] optimisation. - -- BUILD THE OBJECT, AND GENERATE INFO TABLE (IF NECESSARY) - ; emitDataLits closure_label closure_rep ; let fv_details :: [(NonVoid Id, ByteOff)] header = if isLFThunk lf_info then ThunkHeader else StdHeader (_, _, fv_details) = mkVirtHeapOffsets dflags header [] @@ -367,7 +365,7 @@ mkRhsClosure dflags bndr cc _ fvs upd_flag args body ; let use_cc = cccsExpr; blame_cc = cccsExpr ; emit (mkComment $ mkFastString "calling allocDynClosure") ; let toVarArg (NonVoid a, off) = (NonVoid (StgVarArg a), off) - ; let info_tbl = mkCmmInfo closure_info + ; let info_tbl = mkCmmInfo closure_info bndr currentCCS ; hp_plus_n <- allocDynClosure (Just bndr) info_tbl lf_info use_cc blame_cc (map toVarArg fv_details) @@ -407,7 +405,7 @@ cgRhsStdThunk bndr lf_info payload -- BUILD THE OBJECT - ; let info_tbl = mkCmmInfo closure_info + ; let info_tbl = mkCmmInfo closure_info bndr currentCCS ; hp_plus_n <- allocDynClosure (Just bndr) info_tbl lf_info use_cc blame_cc payload_w_offsets @@ -463,7 +461,7 @@ closureCodeBody top_lvl bndr cl_info cc _args arity body fv_details \(_, node, _) -> thunkCode cl_info fv_details cc node arity body where lf_info = closureLFInfo cl_info - info_tbl = mkCmmInfo cl_info + info_tbl = mkCmmInfo cl_info bndr cc closureCodeBody top_lvl bndr cl_info cc args arity body fv_details = -- Note: args may be [], if all args are Void @@ -474,7 +472,7 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details ; let lf_info = closureLFInfo cl_info - info_tbl = mkCmmInfo cl_info + info_tbl = mkCmmInfo cl_info bndr cc -- Emit the main entry code ; emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl args $ diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index d58e9f6f88..e0306eeba3 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -73,6 +73,7 @@ import SMRep import Cmm import PprCmmExpr() +import CostCentre import BlockId import CLabel import Id @@ -750,12 +751,15 @@ data ClosureInfo } -- | Convert from 'ClosureInfo' to 'CmmInfoTable'. -mkCmmInfo :: ClosureInfo -> CmmInfoTable -mkCmmInfo ClosureInfo {..} +mkCmmInfo :: ClosureInfo -> Id -> CostCentreStack -> CmmInfoTable +mkCmmInfo ClosureInfo {..} id ccs = CmmInfoTable { cit_lbl = closureInfoLabel , cit_rep = closureSMRep , cit_prof = closureProf - , cit_srt = Nothing } + , cit_srt = Nothing + , cit_clo = if isStaticRep closureSMRep + then Just (id,ccs) + else Nothing } -------------------------------------- -- Building ClosureInfos @@ -1040,7 +1044,8 @@ mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds = CmmInfoTable { cit_lbl = info_lbl , cit_rep = sm_rep , cit_prof = prof - , cit_srt = Nothing } + , cit_srt = Nothing + , cit_clo = Nothing } where name = dataConName data_con info_lbl = mkConInfoTableLabel name NoCafRefs @@ -1063,14 +1068,16 @@ cafBlackHoleInfoTable = CmmInfoTable { cit_lbl = mkCAFBlackHoleInfoTableLabel , cit_rep = blackHoleRep , cit_prof = NoProfilingInfo - , cit_srt = Nothing } + , cit_srt = Nothing + , cit_clo = Nothing } indStaticInfoTable :: CmmInfoTable indStaticInfoTable = CmmInfoTable { cit_lbl = mkIndStaticInfoLabel , cit_rep = indStaticRep , cit_prof = NoProfilingInfo - , cit_srt = Nothing } + , cit_srt = Nothing + , cit_clo = Nothing } staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool -- A static closure needs a link field to aid the GC when traversing |