[commit: ghc] wip/T14373: Implement pointer tagging for 'big' families #14373 (b723ca6)

git at git.haskell.org git at git.haskell.org
Mon Oct 30 23:24:41 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T14373
Link       : http://ghc.haskell.org/trac/ghc/changeset/b723ca6cd9b369fb2ebd46894c2c0384be95d9eb/ghc

>---------------------------------------------------------------

commit b723ca6cd9b369fb2ebd46894c2c0384be95d9eb
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.


>---------------------------------------------------------------

b723ca6cd9b369fb2ebd46894c2c0384be95d9eb
 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