[Git][ghc/ghc][wip/dataToTag-opt] Use pointer tag in dataToTag#

[Ben Gamari]

Ben Gamari pushed to branch wip/dataToTag-opt at Glasgow Haskell Compiler / GHC


Commits:
da41a337 by Ben Gamari at 2020-03-18T13:38:44Z
Use pointer tag in dataToTag#

While looking at !2873 I noticed that dataToTag# previously didn't look
at a pointer's tag to determine its constructor. To be fair, there is a
bit of a trade-off here: using the pointer tag requires a bit more code
and another branch. On the other hand, it allows us to eliminate looking
at the info table in many cases (especially now since we tag large
constructor families; see #14373).

- - - - -


1 changed file:

- compiler/GHC/StgToCmm/Expr.hs


Changes:

=====================================
compiler/GHC/StgToCmm/Expr.hs
=====================================
@@ -35,6 +35,7 @@ import GHC.Stg.Syntax
 import GHC.Cmm.Graph
 import GHC.Cmm.BlockId
 import GHC.Cmm hiding ( succ )
+import GHC.Cmm.Utils ( zeroExpr, cmmTagMask )
 import GHC.Cmm.Info
 import GHC.Core
 import DataCon
@@ -69,14 +70,43 @@ cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) =
   cgIdApp a []
 
 -- dataToTag# :: a -> Int#
--- See Note [dataToTag#] in primops.txt.pp
+-- See Note [dataToTag# magic] in PrelRules.
 cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do
   dflags <- getDynFlags
   emitComment (mkFastString "dataToTag#")
-  tmp <- newTemp (bWord dflags)
-  _ <- withSequel (AssignTo [tmp] False) (cgIdApp a [])
-  -- TODO: For small types look at the tag bits instead of reading info table
-  emitReturn [getConstrTag dflags (cmmUntag dflags (CmmReg (CmmLocal tmp)))]
+  info <- getCgIdInfo a
+  tag_reg <- assignTemp $ cmmConstrTag1 dflags (idInfoToAmode info)
+  result_reg <- newTemp (bWord dflags)
+  let tag = CmmReg $ CmmLocal tag_reg
+  -- Here we will first check the tag bits of the pointer we were given;
+  -- if this doesn't work then enter the closure and use the info table
+  -- to determine the constructor. Note that all tag bits set means that
+  -- the constructor index is too large to fit in the pointer and therefore
+  -- we must look in the info table. See Note [Tagging big families].
+
+  slow_path <- getCode $ do
+      tmp <- newTemp (bWord dflags)
+      _ <- withSequel (AssignTo [tmp] False) (cgIdApp a [])
+      -- TODO: For small types look at the tag bits instead of reading info table
+      emitAssign (CmmLocal result_reg)
+        $ getConstrTag dflags (cmmUntag dflags (CmmReg (CmmLocal tmp)))
+
+  fast_path <- getCode $ do
+      emitAssign (CmmLocal result_reg)
+        $ cmmSubWord dflags tag (CmmLit $ mkWordCLit dflags 1)
+
+  let zero = zeroExpr dflags
+      too_big_tag = cmmTagMask dflags
+      is_tagged =
+        cmmNeWord dflags
+          (cmmOrWord dflags
+            (cmmEqWord dflags tag zero)         -- not evaluated
+            (cmmEqWord dflags tag too_big_tag)) -- tag too big
+          zero
+
+  emit =<< mkCmmIfThenElse' is_tagged slow_path fast_path (Just False)
+  emitReturn [CmmReg $ CmmLocal result_reg]
+
 
 cgExpr (StgOpApp op args ty) = cgOpApp op args ty
 cgExpr (StgConApp con args _)= cgConApp con args



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/da41a337971df016e789cf78346013f3461d7289

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/da41a337971df016e789cf78346013f3461d7289
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200318/252a1d4a/attachment-0001.html>