summaryrefslogtreecommitdiff
path: root/compiler/GHC/Cmm
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Cmm')
-rw-r--r--compiler/GHC/Cmm/CLabel.hs42
-rw-r--r--compiler/GHC/Cmm/Liveness.hs2
-rw-r--r--compiler/GHC/Cmm/Utils.hs7
3 files changed, 41 insertions, 10 deletions
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index 3acace8be2..dd7e1f14f5 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -25,6 +25,7 @@ module GHC.Cmm.CLabel (
mkInfoTableLabel,
mkEntryLabel,
mkRednCountsLabel,
+ mkTagHitLabel,
mkConInfoTableLabel,
mkApEntryLabel,
mkApInfoTableLabel,
@@ -301,7 +302,7 @@ isIdLabel _ = False
-- Used in SRT analysis. See Note [Ticky labels in SRT analysis] in
-- GHC.Cmm.Info.Build.
isTickyLabel :: CLabel -> Bool
-isTickyLabel (IdLabel _ _ RednCounts) = True
+isTickyLabel (IdLabel _ _ IdTickyInfo{}) = True
isTickyLabel _ = False
-- | Indicate if "GHC.CmmToC" has to generate an extern declaration for the
@@ -447,6 +448,26 @@ pprDebugCLabel platform lbl = pprCLabel platform AsmStyle lbl <> parens extra
_ -> text "other CLabel"
+-- Dynamic ticky info for the id.
+data TickyIdInfo
+ = TickyRednCounts -- ^ Used for dynamic allocations
+ | TickyInferedTag !Unique -- ^ Used to track dynamic hits of tag inference.
+ deriving (Eq,Show)
+
+instance Outputable TickyIdInfo where
+ ppr TickyRednCounts = text "ct_rdn"
+ ppr (TickyInferedTag unique) = text "ct_tag[" <> ppr unique <> char ']'
+
+-- | Don't depend on this if you need determinism.
+-- No determinism in the ncg backend, so we use the unique for Ord.
+-- Even if it pains me slightly.
+instance Ord TickyIdInfo where
+ compare TickyRednCounts TickyRednCounts = EQ
+ compare TickyRednCounts _ = LT
+ compare _ TickyRednCounts = GT
+ compare (TickyInferedTag unique1) (TickyInferedTag unique2) =
+ nonDetCmpUnique unique1 unique2
+
data IdLabelInfo
= Closure -- ^ Label for closure
@@ -457,7 +478,7 @@ data IdLabelInfo
| LocalInfoTable -- ^ Like InfoTable but not externally visible
| LocalEntry -- ^ Like Entry but not externally visible
- | RednCounts -- ^ Label of place to keep Ticky-ticky info for this Id
+ | IdTickyInfo !TickyIdInfo -- ^ Label of place to keep Ticky-ticky hit info for this Id
| ConEntry ConInfoTableLocation
-- ^ Constructor entry point, when `-fdistinct-info-tables` is enabled then
@@ -504,12 +525,12 @@ instance Outputable IdLabelInfo where
ppr LocalInfoTable = text "LocalInfoTable"
ppr LocalEntry = text "LocalEntry"
- ppr RednCounts = text "RednCounts"
ppr (ConEntry mn) = text "ConEntry" <+> ppr mn
ppr (ConInfoTable mn) = text "ConInfoTable" <+> ppr mn
ppr ClosureTable = text "ClosureTable"
ppr Bytes = text "Bytes"
ppr BlockInfoTable = text "BlockInfoTable"
+ ppr (IdTickyInfo info) = text "IdTickyInfo" <+> ppr info
data RtsLabelInfo
@@ -559,8 +580,12 @@ data DynamicLinkerLabelInfo
mkSRTLabel :: Unique -> CLabel
mkSRTLabel u = SRTLabel u
+-- See Note [ticky for LNE]
mkRednCountsLabel :: Name -> CLabel
-mkRednCountsLabel name = IdLabel name NoCafRefs RednCounts -- Note [ticky for LNE]
+mkRednCountsLabel name = IdLabel name NoCafRefs (IdTickyInfo TickyRednCounts)
+
+mkTagHitLabel :: Name -> Unique -> CLabel
+mkTagHitLabel name !uniq = IdLabel name NoCafRefs (IdTickyInfo (TickyInferedTag uniq))
-- These have local & (possibly) external variants:
mkLocalClosureLabel :: Name -> CafInfo -> CLabel
@@ -892,7 +917,7 @@ hasIdLabelInfo _ = Nothing
-- -----------------------------------------------------------------------------
-- Does a CLabel's referent itself refer to a CAF?
hasCAF :: CLabel -> Bool
-hasCAF (IdLabel _ _ RednCounts) = False -- Note [ticky for LNE]
+hasCAF (IdLabel _ _ (IdTickyInfo TickyRednCounts)) = False -- See Note [ticky for LNE]
hasCAF (IdLabel _ MayHaveCafRefs _) = True
hasCAF _ = False
@@ -1146,7 +1171,7 @@ idInfoLabelType info =
Closure -> GcPtrLabel
ConInfoTable {} -> DataLabel
ClosureTable -> DataLabel
- RednCounts -> DataLabel
+ IdTickyInfo{} -> DataLabel
Bytes -> DataLabel
_ -> CodeLabel
@@ -1503,7 +1528,10 @@ ppIdFlavor x = pp_cSEP <> case x of
Entry -> text "entry"
LocalEntry -> text "entry"
Slow -> text "slow"
- RednCounts -> text "ct"
+ IdTickyInfo TickyRednCounts
+ -> text "ct"
+ IdTickyInfo (TickyInferedTag unique)
+ -> text "ct_inf_tag" <> char '_' <> ppr unique
ConEntry loc ->
case loc of
DefinitionSite -> text "con_entry"
diff --git a/compiler/GHC/Cmm/Liveness.hs b/compiler/GHC/Cmm/Liveness.hs
index f047ea4367..a1526be099 100644
--- a/compiler/GHC/Cmm/Liveness.hs
+++ b/compiler/GHC/Cmm/Liveness.hs
@@ -71,6 +71,8 @@ cmmGlobalLiveness platform graph =
analyzeCmmBwd liveLattice (xferLive platform) graph mapEmpty
-- | On entry to the procedure, there had better not be any LocalReg's live-in.
+-- If you see this error it most likely means you are trying to use a variable
+-- without it being defined in the given scope.
noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a
noLiveOnEntry bid in_fact x =
if nullRegSet in_fact then x
diff --git a/compiler/GHC/Cmm/Utils.hs b/compiler/GHC/Cmm/Utils.hs
index 9e9566b334..2060be5bda 100644
--- a/compiler/GHC/Cmm/Utils.hs
+++ b/compiler/GHC/Cmm/Utils.hs
@@ -48,7 +48,7 @@ module GHC.Cmm.Utils(
currentTSOExpr, currentNurseryExpr, cccsExpr,
-- Tagging
- cmmTagMask, cmmPointerMask, cmmUntag, cmmIsTagged,
+ cmmTagMask, cmmPointerMask, cmmUntag, cmmIsTagged, cmmIsNotTagged,
cmmConstrTag1, mAX_PTR_TAG, tAG_MASK,
-- Overlap and usage
@@ -447,13 +447,14 @@ cmmPointerMask platform = mkIntExpr platform (complement (tAG_MASK platform))
-- Used to untag a possibly tagged pointer
-- A static label need not be untagged
-cmmUntag, cmmIsTagged, cmmConstrTag1 :: Platform -> CmmExpr -> CmmExpr
+cmmUntag, cmmIsTagged, cmmIsNotTagged, cmmConstrTag1 :: Platform -> CmmExpr -> CmmExpr
cmmUntag _ e@(CmmLit (CmmLabel _)) = e
-- Default case
cmmUntag platform e = cmmAndWord platform e (cmmPointerMask platform)
--- Test if a closure pointer is untagged
+-- Test if a closure pointer is untagged/tagged.
cmmIsTagged platform e = cmmNeWord platform (cmmAndWord platform e (cmmTagMask platform)) (zeroExpr platform)
+cmmIsNotTagged platform e = cmmEqWord platform (cmmAndWord platform e (cmmTagMask platform)) (zeroExpr platform)
-- Get constructor tag, but one based.
cmmConstrTag1 platform e = cmmAndWord platform e (cmmTagMask platform)