diff options
Diffstat (limited to 'compiler/codeGen')
| -rw-r--r-- | compiler/codeGen/CgHeapery.lhs | 7 | ||||
| -rw-r--r-- | compiler/codeGen/CgInfoTbls.hs | 4 | ||||
| -rw-r--r-- | compiler/codeGen/CgUtils.hs | 8 | ||||
| -rw-r--r-- | compiler/codeGen/ClosureInfo.lhs | 33 |
4 files changed, 25 insertions, 27 deletions
diff --git a/compiler/codeGen/CgHeapery.lhs b/compiler/codeGen/CgHeapery.lhs index 3ff646ca07..ebdde2d31a 100644 --- a/compiler/codeGen/CgHeapery.lhs +++ b/compiler/codeGen/CgHeapery.lhs @@ -185,7 +185,7 @@ mkStaticClosureFields cl_info ccs caf_refs payload = mkStaticClosure info_lbl ccs payload padding_wds static_link_field saved_info_field where - info_lbl = infoTableLabelFromCI cl_info $ clHasCafRefs cl_info + info_lbl = infoTableLabelFromCI cl_info -- CAFs must have consistent layout, regardless of whether they -- are actually updatable or not. The layout of a CAF is: @@ -302,7 +302,7 @@ hpStkCheck cl_info is_fun reg_save_code code -- Strictly speaking, we should tag node here. But if -- node doesn't point to the closure, the code for the closure -- cannot depend on the value of R1 anyway, so we're safe. - closure_lbl = closureLabelFromCI cl_info (clHasCafRefs cl_info) + closure_lbl = closureLabelFromCI cl_info full_save_code = node_asst `plusStmts` reg_save_code @@ -570,8 +570,7 @@ allocDynClosure cl_info use_cc _blame_cc amodes_with_offsets -- Remember, virtHp points to last allocated word, -- ie 1 *before* the info-ptr word of new object. - info_ptr = CmmLit (CmmLabel (infoTableLabelFromCI cl_info - (clHasCafRefs cl_info))) + info_ptr = CmmLit (CmmLabel (infoTableLabelFromCI cl_info)) hdr_w_offsets = initDynHdr info_ptr use_cc `zip` [0..] -- SAY WHAT WE ARE ABOUT TO DO diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs index 093b9ffaab..76a433b48e 100644 --- a/compiler/codeGen/CgInfoTbls.hs +++ b/compiler/codeGen/CgInfoTbls.hs @@ -59,7 +59,7 @@ emitClosureCodeAndInfoTable cl_info args body ; info <- mkCmmInfo cl_info ; emitInfoTableAndCode (infoLblToEntryLbl info_lbl) info args blks } where - info_lbl = infoTableLabelFromCI cl_info $ clHasCafRefs cl_info + info_lbl = infoTableLabelFromCI cl_info -- We keep the *zero-indexed* tag in the srt_len field of the info -- table of a data constructor. @@ -105,7 +105,7 @@ mkCmmInfo cl_info = do ThunkInfo (ptrs, nptrs) srt _ -> panic "unexpected lambda form in mkCmmInfo" where - info_lbl = infoTableLabelFromCI cl_info has_caf_refs + info_lbl = infoTableLabelFromCI cl_info has_caf_refs = clHasCafRefs cl_info cl_type = smRepClosureTypeInt (closureSMRep cl_info) diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs index effa7a42d6..1d2902188c 100644 --- a/compiler/codeGen/CgUtils.hs +++ b/compiler/codeGen/CgUtils.hs @@ -47,7 +47,7 @@ module CgUtils ( packHalfWordsCLit, blankWord, - getSRTInfo, clHasCafRefs + getSRTInfo ) where #include "HsVersions.h" @@ -995,12 +995,6 @@ getSRTInfo = do srt_escape = (-1) :: StgHalfWord -clHasCafRefs :: ClosureInfo -> CafInfo -clHasCafRefs (ClosureInfo {closureSRT = srt}) = - case srt of NoC_SRT -> NoCafRefs - _ -> MayHaveCafRefs -clHasCafRefs (ConInfo {}) = NoCafRefs - -- ----------------------------------------------------------------------------- -- -- STG/Cmm GlobalReg diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs index daf476adfc..ad2ea4fddd 100644 --- a/compiler/codeGen/ClosureInfo.lhs +++ b/compiler/codeGen/ClosureInfo.lhs @@ -35,7 +35,7 @@ module ClosureInfo ( closureNeedsUpdSpace, closureIsThunk, closureSingleEntry, closureReEntrant, isConstrClosure_maybe, closureFunInfo, isStandardFormThunk, isKnownFun, - funTag, funTagLFInfo, tagForArity, + funTag, funTagLFInfo, tagForArity, clHasCafRefs, enterIdLabel, enterLocalIdLabel, enterReturnPtLabel, @@ -59,7 +59,6 @@ module ClosureInfo ( #include "../includes/MachDeps.h" #include "HsVersions.h" ---import CgUtils import StgSyn import SMRep @@ -909,6 +908,12 @@ funTagLFInfo lf tagForArity :: Int -> Maybe Int tagForArity i | i <= mAX_PTR_TAG = Just i | otherwise = Nothing + +clHasCafRefs :: ClosureInfo -> CafInfo +clHasCafRefs (ClosureInfo {closureSRT = srt}) = + case srt of NoC_SRT -> NoCafRefs + _ -> MayHaveCafRefs +clHasCafRefs (ConInfo {}) = NoCafRefs \end{code} \begin{code} @@ -924,9 +929,9 @@ isToplevClosure _ = False Label generation. \begin{code} -infoTableLabelFromCI :: ClosureInfo -> CafInfo -> CLabel -infoTableLabelFromCI (ClosureInfo { closureName = name, - closureLFInfo = lf_info }) caf +infoTableLabelFromCI :: ClosureInfo -> CLabel +infoTableLabelFromCI cl@(ClosureInfo { closureName = name, + closureLFInfo = lf_info }) = case lf_info of LFBlackHole info -> info @@ -936,23 +941,23 @@ infoTableLabelFromCI (ClosureInfo { closureName = name, LFThunk _ _ upd_flag (ApThunk arity) _ -> mkApInfoTableLabel upd_flag arity - LFThunk{} -> mkInfoTableLabel name caf + LFThunk{} -> mkInfoTableLabel name $ clHasCafRefs cl - LFReEntrant _ _ _ _ -> mkInfoTableLabel name caf + LFReEntrant _ _ _ _ -> mkInfoTableLabel name $ clHasCafRefs cl _ -> panic "infoTableLabelFromCI" -infoTableLabelFromCI (ConInfo { closureCon = con, - closureSMRep = rep }) caf - | isStaticRep rep = mkStaticInfoTableLabel name caf - | otherwise = mkConInfoTableLabel name caf +infoTableLabelFromCI cl@(ConInfo { closureCon = con, + closureSMRep = rep }) + | isStaticRep rep = mkStaticInfoTableLabel name $ clHasCafRefs cl + | otherwise = mkConInfoTableLabel name $ clHasCafRefs cl where name = dataConName con -- ClosureInfo for a closure (as opposed to a constructor) is always local -closureLabelFromCI :: ClosureInfo -> CafInfo -> CLabel -closureLabelFromCI (ClosureInfo { closureName = nm }) caf = mkLocalClosureLabel nm caf -closureLabelFromCI _ _ = panic "closureLabelFromCI" +closureLabelFromCI :: ClosureInfo -> CLabel +closureLabelFromCI cl@(ClosureInfo { closureName = nm }) = mkLocalClosureLabel nm $ clHasCafRefs cl +closureLabelFromCI _ = panic "closureLabelFromCI" -- thunkEntryLabel is a local help function, not exported. It's used from both -- entryLabelFromCI and getCallMethod. |