[commit: ghc] wip/T14373: Implement pointer tagging for 'big' families #14373 (72056b3)
git at git.haskell.org
git at git.haskell.org
Mon Dec 4 14:23:38 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/T14373
Link : http://ghc.haskell.org/trac/ghc/changeset/72056b3142d0fc364264d46a6c985789c9411bad/ghc
>---------------------------------------------------------------
commit 72056b3142d0fc364264d46a6c985789c9411bad
Author: Gabor Greif <ggreif at gmail.com>
Date: Fri Oct 20 15:45:37 2017 +0200
Implement pointer tagging for 'big' families #14373
Formerly we punted on these and evaluated constructors always
got a tag of 1.
We now cascade switches because we have to check the tag first
and when it is MAX_PTR_TAG then get the precise tag from the info
table and switch on that. The only technically tricky part is that the
default case needs (logical) duplication. To do this we emit an extra
label for it and branch to that from the second switch. This avoids
duplicated codegen.
>---------------------------------------------------------------
72056b3142d0fc364264d46a6c985789c9411bad
compiler/codeGen/StgCmmClosure.hs | 11 +++++--
compiler/codeGen/StgCmmExpr.hs | 67 ++++++++++++++++++++++++++++++---------
2 files changed, 60 insertions(+), 18 deletions(-)
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index 2501ec9..ce0f623 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -354,9 +354,12 @@ type DynTag = Int -- The tag on a *pointer*
-- * big, otherwise.
--
-- Small families can have the constructor tag in the tag bits.
--- Big families only use the tag value 1 to represent evaluatedness.
+-- Big families always use the tag values 1..mAX_PTR_TAG to represent
+-- evaluatedness, the last one lumping together all overflowing ones.
-- We don't have very many tag bits: for example, we have 2 bits on
-- x86-32 and 3 bits on x86-64.
+--
+-- Also see Note [tagging big families]
isSmallFamily :: DynFlags -> Int -> Bool
isSmallFamily dflags fam_size = fam_size <= mAX_PTR_TAG dflags
@@ -369,10 +372,12 @@ isSmallFamilyTyCon dflags tycon =
tagForCon :: DynFlags -> DataCon -> DynTag
tagForCon dflags con
| isSmallFamilyTyCon dflags tycon = con_tag
- | otherwise = 1
+ | con_tag <= max_tag = con_tag
+ | otherwise = max_tag
where
- con_tag = dataConTag con -- NB: 1-indexed
+ con_tag = dataConTag con -- NB: 1-indexed
tycon = dataConTyCon con
+ max_tag = mAX_PTR_TAG dflags
tagForArity :: DynFlags -> RepArity -> DynTag
tagForArity dflags arity
diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index 3fcc935..6c00cef 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -37,6 +37,7 @@ import Cmm
import CmmInfo
import CoreSyn
import DataCon
+import DynFlags ( mAX_PTR_TAG )
import ForeignCall
import Id
import PrimOp
@@ -49,9 +50,10 @@ import Util
import FastString
import Outputable
-import Control.Monad (unless,void)
-import Control.Arrow (first)
+import Control.Monad ( unless, void )
+import Control.Arrow ( first )
import Data.Function ( on )
+import Data.List ( partition )
------------------------------------------------------------------------
-- cgExpr: the main function
@@ -607,21 +609,36 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts
; let fam_sz = tyConFamilySize tycon
bndr_reg = CmmLocal (idToReg dflags bndr)
+ tag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg)
+ branches' = [(tag+1,branch) | (tag,branch) <- branches]
+ maxpt = mAX_PTR_TAG dflags
+ (ptr, info) = partition ((< maxpt) . fst) branches'
+ small = isSmallFamily dflags fam_sz
-- Is the constructor tag in the node reg?
- ; if isSmallFamily dflags fam_sz
- then do
- let -- Yes, bndr_reg has constr. tag in ls bits
- tag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg)
- branches' = [(tag+1,branch) | (tag,branch) <- branches]
- emitSwitch tag_expr branches' mb_deflt 1 fam_sz
-
- else -- No, get tag from info table
- let -- Note that ptr _always_ has tag 1
- -- when the family size is big enough
- untagged_ptr = cmmRegOffB bndr_reg (-1)
- tag_expr = getConstrTag dflags (untagged_ptr)
- in emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
+ -- See Note [tagging big families]
+ ; if small || null info
+ then -- Yes, bndr_reg has constr. tag in ls bits
+ emitSwitch tag_expr branches' mb_deflt 1 (if small then fam_sz else maxpt)
+
+ else -- No, get exact tag from info table when mAX_PTR_TAG
+ do
+ infos_lbl <- newBlockId -- branch destination for info pointer lookup
+ infos_scp <- getTickScope
+
+ let catchall = (maxpt, (mkBranch infos_lbl, infos_scp))
+ prelabel (Just (stmts, scp)) =
+ do lbl <- newBlockId
+ return (Just (mkLabel lbl scp <*> stmts, scp), Just (mkBranch lbl, scp))
+ prelabel _ = return (Nothing, Nothing)
+
+ (mb_deflt, mb_branch) <- prelabel mb_deflt
+ emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt
+ emitLabel infos_lbl
+ let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg)
+ tag_expr = getConstrTag dflags untagged_ptr
+ info0 = (\(tag,branch)->(tag-1,branch)) <$> info
+ emitSwitch tag_expr info0 mb_branch (maxpt - 1) (fam_sz - 1)
; return AssignedDirectly }
@@ -649,6 +666,26 @@ cgAlts _ _ _ _ = panic "cgAlts"
-- x = R1
-- goto L1
+
+-- Note [tagging big families]
+--
+-- Previousy, only the small constructor families were tagged.
+-- This penalized greater unions which overflow the tag space
+-- of TAG_BITS (i.e. 3 on 32 resp. 7 constructors on 64 bit).
+-- But there is a clever way of combining pointer and info-table
+-- tagging. We now use 1..{2,6} as pointer-resident tags while
+-- {3,7} signifies we have to fall back and get the tag from the
+-- info-table.
+-- Conseqently we now cascade switches because we have to check
+-- the tag first and when it is MAX_PTR_TAG then get the precise
+-- tag from the info table and switch on that. The only technically
+-- tricky part is that the default case needs (logical) duplication.
+-- To do this we emit an extra label for it and branch to that from
+-- the second switch. This avoids duplicated codegen.
+--
+-- Also see Note [Data constructor dynamic tags]
+
+
-------------------
cgAlgAltRhss :: (GcPlan,ReturnKind) -> NonVoid Id -> [StgAlt]
-> FCode ( Maybe CmmAGraphScoped
More information about the ghc-commits
mailing list