diff options
Diffstat (limited to 'compiler/cmm/CLabel.hs')
| -rw-r--r-- | compiler/cmm/CLabel.hs | 51 |
1 files changed, 37 insertions, 14 deletions
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index ebc9e53c72..8fe8c3c874 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -61,7 +61,7 @@ module CLabel ( mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel, mkRtsPrimOpLabel, - mkRtsSlowTickyCtrLabel, + mkRtsSlowFastTickyCtrLabel, mkSelectorInfoLabel, mkSelectorEntryLabel, @@ -99,7 +99,7 @@ module CLabel ( isCFunctionLabel, isGcPtrLabel, labelDynamic, -- * Conversions - toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, toRednCountsLbl, + toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, toRednCountsLbl, hasHaskellName, pprCLabel ) where @@ -313,7 +313,7 @@ data RtsLabelInfo | RtsPrimOp PrimOp | RtsApFast FastString -- ^ _fast versions of generic apply - | RtsSlowTickyCtr String + | RtsSlowFastTickyCtr String deriving (Eq, Ord) -- NOTE: Eq on LitString compares the pointer only, so this isn't @@ -356,9 +356,10 @@ mkTopSRTLabel :: Unique -> CLabel mkTopSRTLabel u = SRTLabel u mkSRTLabel :: Name -> CafInfo -> CLabel -mkRednCountsLabel :: Name -> CafInfo -> CLabel +mkRednCountsLabel :: Name -> CLabel mkSRTLabel name c = IdLabel name c SRT -mkRednCountsLabel name c = IdLabel name c RednCounts +mkRednCountsLabel name = + IdLabel name NoCafRefs RednCounts -- Note [ticky for LNE] -- These have local & (possibly) external variants: mkLocalClosureLabel :: Name -> CafInfo -> CLabel @@ -503,8 +504,8 @@ mkCCSLabel ccs = CCS_Label ccs mkRtsApFastLabel :: FastString -> CLabel mkRtsApFastLabel str = RtsLabel (RtsApFast str) -mkRtsSlowTickyCtrLabel :: String -> CLabel -mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat) +mkRtsSlowFastTickyCtrLabel :: String -> CLabel +mkRtsSlowFastTickyCtrLabel pat = RtsLabel (RtsSlowFastTickyCtr pat) -- Constructing Code Coverage Labels @@ -549,10 +550,6 @@ toSlowEntryLbl :: CLabel -> CLabel toSlowEntryLbl (IdLabel n c _) = IdLabel n c Slow toSlowEntryLbl l = pprPanic "toSlowEntryLbl" (ppr l) -toRednCountsLbl :: CLabel -> CLabel -toRednCountsLbl (IdLabel n c _) = IdLabel n c RednCounts -toRednCountsLbl l = pprPanic "toRednCountsLbl" (ppr l) - toEntryLbl :: CLabel -> CLabel toEntryLbl (IdLabel n c LocalInfoTable) = IdLabel n c LocalEntry toEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry @@ -574,12 +571,38 @@ toInfoLbl (CmmLabel m str CmmEntry) = CmmLabel m str CmmInfo toInfoLbl (CmmLabel m str CmmRet) = CmmLabel m str CmmRetInfo toInfoLbl l = pprPanic "CLabel.toInfoLbl" (ppr l) +toRednCountsLbl :: CLabel -> Maybe CLabel +toRednCountsLbl = fmap mkRednCountsLabel . hasHaskellName + +hasHaskellName :: CLabel -> Maybe Name +hasHaskellName (IdLabel n _ _) = Just n +hasHaskellName _ = Nothing + -- ----------------------------------------------------------------------------- --- Does a CLabel refer to a CAF? +-- Does a CLabel's referent itself refer to a CAF? hasCAF :: CLabel -> Bool +hasCAF (IdLabel _ _ RednCounts) = False -- Note [ticky for LNE] hasCAF (IdLabel _ MayHaveCafRefs _) = True hasCAF _ = False +-- Note [ticky for LNE] +-- ~~~~~~~~~~~~~~~~~~~~~ + +-- Until 14 Feb 2013, every ticky counter was associated with a +-- closure. Thus, ticky labels used IdLabel. It is odd that +-- CmmBuildInfoTables.cafTransfers would consider such a ticky label +-- reason to add the name to the CAFEnv (and thus eventually the SRT), +-- but it was harmless because the ticky was only used if the closure +-- was also. +-- +-- Since we now have ticky counters for LNEs, it is no longer the case +-- that every ticky counter has an actual closure. So I changed the +-- generation of ticky counters' CLabels to not result in their +-- associated id ending up in the SRT. +-- +-- NB IdLabel is still appropriate for ticky ids (as opposed to +-- CmmLabel) because the LNE's counter is still related to an .hs Id, +-- that Id just isn't for a proper closure. -- ----------------------------------------------------------------------------- -- Does a CLabel need declaring before use or not? @@ -1051,8 +1074,8 @@ pprCLbl (CmmLabel _ fs CmmClosure) pprCLbl (RtsLabel (RtsPrimOp primop)) = ptext (sLit "stg_") <> ppr primop -pprCLbl (RtsLabel (RtsSlowTickyCtr pat)) - = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr") +pprCLbl (RtsLabel (RtsSlowFastTickyCtr pat)) + = ptext (sLit "SLOW_CALL_fast_") <> text pat <> ptext (sLit "_ctr") pprCLbl (ForeignLabel str _ _ _) = ftext str |