[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:
d39b8d9f by Ben Gamari at 2020-03-18T04:10:18Z
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 )
 import GHC.Cmm.Info
 import GHC.Core
 import DataCon
@@ -69,14 +70,39 @@ 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 not_evald_tag = zeroExpr dflags
+      too_big_tag = cmmTagMask dflags
+      is_tagged = cmmOrWord dflags
+        (cmmEqWord dflags tag not_evald_tag)
+        (cmmEqWord dflags tag too_big_tag)
+  emit =<< mkCmmIfThenElse' 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/d39b8d9f72b254d042fb16c00e78e23b35a6e879

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d39b8d9f72b254d042fb16c00e78e23b35a6e879
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/fabaf4c2/attachment-0001.html>