[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:
38db4a35 by Ben Gamari at 2020-03-18T01:08:21Z
Use pointer tag in dataToTag#

- - - - -


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
@@ -73,10 +74,26 @@ cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) =
 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
+
+  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
+  emit =<< mkCmmIfThenElse' (cmmEqWord dflags tag zero) 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/38db4a35dac7b250d3850c47bd06452f91f7a1f6

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/38db4a35dac7b250d3850c47bd06452f91f7a1f6
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/20200317/3956419c/attachment-0001.html>