summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2020-03-18 13:36:55 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-01-22 14:58:14 -0500
commitb4b2be610654d0b6a9bcdaa956261655eadd6b4d (patch)
treec169e2ef6ee9e5615df56ee1067fde3dc4cf345a
parent2ed96c68becbb913d9c0a002872fb4cba1877458 (diff)
downloadhaskell-b4b2be610654d0b6a9bcdaa956261655eadd6b4d.tar.gz
dataToTag#: Avoid unnecessary entry
When the pointer is already tagged we can avoid entering the closure.
-rw-r--r--compiler/GHC/StgToCmm/Expr.hs39
1 files changed, 21 insertions, 18 deletions
diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs
index aa10815330..0048a4c9a2 100644
--- a/compiler/GHC/StgToCmm/Expr.hs
+++ b/compiler/GHC/StgToCmm/Expr.hs
@@ -36,7 +36,7 @@ import GHC.Cmm.Graph
import GHC.Cmm.BlockId
import GHC.Cmm hiding ( succ )
import GHC.Cmm.Info
-import GHC.Cmm.Utils ( zeroExpr, cmmTagMask, mAX_PTR_TAG )
+import GHC.Cmm.Utils ( zeroExpr, cmmTagMask, mkWordCLit, mAX_PTR_TAG )
import GHC.Core
import GHC.Core.DataCon
import GHC.Types.ForeignCall
@@ -75,9 +75,12 @@ cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do
platform <- getPlatform
emitComment (mkFastString "dataToTag#")
info <- getCgIdInfo a
- tag_reg <- assignTemp $ cmmConstrTag1 dflags (idInfoToAmode info)
- result_reg <- newTemp (bWord dflags)
+ let amode = idInfoToAmode info
+ tag_reg <- assignTemp $ cmmConstrTag1 platform amode
+ result_reg <- newTemp (bWord platform)
let tag = CmmReg $ CmmLocal tag_reg
+ is_tagged = cmmNeWord platform tag (zeroExpr platform)
+ is_too_big_tag = cmmEqWord platform tag (cmmTagMask platform)
-- 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
@@ -87,24 +90,24 @@ cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do
slow_path <- getCode $ do
tmp <- newTemp (bWord platform)
_ <- withSequel (AssignTo [tmp] False) (cgIdApp a [])
- -- TODO: For small types look at the tag bits instead of reading info table
+ ptr_opts <- getPtrOpts
emitAssign (CmmLocal result_reg)
- $ getConstrTag dflags (cmmUntag platform (CmmReg (CmmLocal tmp)))
+ $ getConstrTag ptr_opts (cmmUntag platform (CmmReg (CmmLocal tmp)))
fast_path <- getCode $ do
- emitAssign (CmmLocal result_reg)
- $ cmmSubWord dflags tag (CmmLit $ mkWordCLit platform 1)
-
- let zero = zeroExpr platform
- too_big_tag = cmmTagMask platform
- is_tagged =
- cmmNeWord platform
- (cmmOrWord platform
- (cmmEqWord platform tag zero) -- not evaluated
- (cmmEqWord platform tag too_big_tag)) -- tag too big
- zero
-
- emit =<< mkCmmIfThenElse' is_tagged slow_path fast_path (Just False)
+ -- Return the constructor index from the pointer tag
+ return_ptr_tag <- getCode $ do
+ emitAssign (CmmLocal result_reg)
+ $ cmmSubWord platform tag (CmmLit $ mkWordCLit platform 1)
+ -- Return the constructor index recorded in the info table
+ return_info_tag <- getCode $ do
+ ptr_opts <- getPtrOpts
+ emitAssign (CmmLocal result_reg)
+ $ getConstrTag ptr_opts (cmmUntag platform amode)
+
+ emit =<< mkCmmIfThenElse' is_too_big_tag return_info_tag return_ptr_tag (Just False)
+
+ emit =<< mkCmmIfThenElse' is_tagged fast_path slow_path (Just True)
emitReturn [CmmReg $ CmmLocal result_reg]