[Git][ghc/ghc][master] asm-emit-time IND_STATIC elimination
Gabor Greif
gitlab at gitlab.haskell.org
Tue Apr 16 05:15:07 UTC 2019
Gabor Greif pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
be05bd81 by Gabor Greif at 2019-04-15T21:19:03Z
asm-emit-time IND_STATIC elimination
When a new closure identifier is being established to a
local or exported closure already emitted into the same
module, refrain from adding an IND_STATIC closure, and
instead emit an assembly-language alias.
Inter-module IND_STATIC objects still remain, and need to be
addressed by other measures.
Binary-size savings on nofib are around 0.1%.
- - - - -
14 changed files:
- compiler/cmm/CLabel.hs
- compiler/codeGen/StgCmmBind.hs
- compiler/llvmGen/Llvm/Types.hs
- compiler/llvmGen/LlvmCodeGen/Base.hs
- compiler/llvmGen/LlvmCodeGen/Data.hs
- compiler/llvmGen/LlvmCodeGen/Ppr.hs
- compiler/nativeGen/PPC/Ppr.hs
- compiler/nativeGen/SPARC/Ppr.hs
- compiler/nativeGen/X86/Ppr.hs
- testsuite/tests/codeGen/should_compile/Makefile
- + testsuite/tests/codeGen/should_compile/T15155.stdout
- + testsuite/tests/codeGen/should_compile/T15155l.hs
- + testsuite/tests/codeGen/should_compile/T15155l.stdout
- testsuite/tests/codeGen/should_compile/all.T
Changes:
=====================================
compiler/cmm/CLabel.hs
=====================================
@@ -98,7 +98,7 @@ module CLabel (
needsCDecl, maybeLocalBlockLabel, externallyVisibleCLabel,
isMathFun,
isCFunctionLabel, isGcPtrLabel, labelDynamic,
- isLocalCLabel,
+ isLocalCLabel, mayRedirectTo,
-- * Conversions
toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, hasHaskellName,
@@ -1432,3 +1432,139 @@ pprDynamicLinkerAsmLabel platform dllInfo lbl =
SymbolPtr -> text ".LC_" <> ppr lbl
GotSymbolPtr -> ppr lbl <> text "@got"
GotSymbolOffset -> ppr lbl <> text "@gotoff"
+
+-- Figure out whether `symbol` may serve as an alias
+-- to `target` within one compilation unit.
+--
+-- This is true if any of these holds:
+-- * `target` is a module-internal haskell name.
+-- * `target` is an exported name, but comes from the same
+-- module as `symbol`
+--
+-- These are sufficient conditions for establishing e.g. a
+-- GNU assembly alias ('.equiv' directive). Sadly, there is
+-- no such thing as an alias to an imported symbol (conf.
+-- http://blog.omega-prime.co.uk/2011/07/06/the-sad-state-of-symbol-aliases/)
+-- See note [emit-time elimination of static indirections].
+--
+-- Precondition is that both labels represent the
+-- same semantic value.
+
+mayRedirectTo :: CLabel -> CLabel -> Bool
+mayRedirectTo symbol target
+ | Just nam <- haskellName
+ , staticClosureLabel
+ , isExternalName nam
+ , Just mod <- nameModule_maybe nam
+ , Just anam <- hasHaskellName symbol
+ , Just amod <- nameModule_maybe anam
+ = amod == mod
+
+ | Just nam <- haskellName
+ , staticClosureLabel
+ , isInternalName nam
+ = True
+
+ | otherwise = False
+ where staticClosureLabel = isStaticClosureLabel target
+ haskellName = hasHaskellName target
+
+
+{-
+Note [emit-time elimination of static indirections]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+As described in #15155, certain static values are repesentationally
+equivalent, e.g. 'cast'ed values (when created by 'newtype' wrappers).
+
+ newtype A = A Int
+ {-# NOINLINE a #-}
+ a = A 42
+
+a1_rYB :: Int
+[GblId, Caf=NoCafRefs, Unf=OtherCon []]
+a1_rYB = GHC.Types.I# 42#
+
+a [InlPrag=NOINLINE] :: A
+[GblId, Unf=OtherCon []]
+a = a1_rYB `cast` (Sym (T15155.N:A[0]) :: Int ~R# A)
+
+Formerly we created static indirections for these (IND_STATIC), which
+consist of a statically allocated forwarding closure that contains
+the (possibly tagged) indirectee. (See CMM/assembly below.)
+This approach is suboptimal for two reasons:
+ (a) they occupy extra space,
+ (b) they need to be entered in order to obtain the indirectee,
+ thus they cannot be tagged.
+
+Fortunately there is a common case where static indirections can be
+eliminated while emitting assembly (native or LLVM), viz. when the
+indirectee is in the same module (object file) as the symbol that
+points to it. In this case an assembly-level identification can
+be created ('.equiv' directive), and as such the same object will
+be assigned two names in the symbol table. Any of the identified
+symbols can be referenced by a tagged pointer.
+
+Currently the 'mayRedirectTo' predicate will
+give a clue whether a label can be equated with another, already
+emitted, label (which can in turn be an alias). The general mechanics
+is that we identify data (IND_STATIC closures) that are amenable
+to aliasing while pretty-printing of assembly output, and emit the
+'.equiv' directive instead of static data in such a case.
+
+Here is a sketch how the output is massaged:
+
+ Consider
+newtype A = A Int
+{-# NOINLINE a #-}
+a = A 42 -- I# 42# is the indirectee
+ -- 'a' is exported
+
+ results in STG
+
+a1_rXq :: GHC.Types.Int
+[GblId, Caf=NoCafRefs, Unf=OtherCon []] =
+ CCS_DONT_CARE GHC.Types.I#! [42#];
+
+T15155.a [InlPrag=NOINLINE] :: T15155.A
+[GblId, Unf=OtherCon []] =
+ CAF_ccs \ u [] a1_rXq;
+
+ and CMM
+
+[section ""data" . a1_rXq_closure" {
+ a1_rXq_closure:
+ const GHC.Types.I#_con_info;
+ const 42;
+ }]
+
+[section ""data" . T15155.a_closure" {
+ T15155.a_closure:
+ const stg_IND_STATIC_info;
+ const a1_rXq_closure+1;
+ const 0;
+ const 0;
+ }]
+
+The emitted assembly is
+
+#### INDIRECTEE
+a1_rXq_closure: -- module local haskell value
+ .quad GHC.Types.I#_con_info -- an Int
+ .quad 42
+
+#### BEFORE
+.globl T15155.a_closure -- exported newtype wrapped value
+T15155.a_closure:
+ .quad stg_IND_STATIC_info -- the closure info
+ .quad a1_rXq_closure+1 -- indirectee ('+1' being the tag)
+ .quad 0
+ .quad 0
+
+#### AFTER
+.globl T15155.a_closure -- exported newtype wrapped value
+.equiv a1_rXq_closure,T15155.a_closure -- both are shared
+
+The transformation is performed because
+ T15155.a_closure `mayRedirectTo` a1_rXq_closure+1
+returns True.
+-}
=====================================
compiler/codeGen/StgCmmBind.hs
=====================================
@@ -78,7 +78,9 @@ cgTopRhsClosure dflags rec id ccs upd_flag args body =
-- closure pointing directly to the indirectee. This is exactly
-- what the CAF will eventually evaluate to anyway, we're just
-- shortcutting the whole process, and generating a lot less code
- -- (#7308)
+ -- (#7308). Eventually the IND_STATIC closure will be eliminated
+ -- by assembly '.equiv' directives, where possible (#15155).
+ -- See note [emit-time elimination of static indirections] in CLabel.
--
-- Note: we omit the optimisation when this binding is part of a
-- recursive group, because the optimisation would inhibit the black
=====================================
compiler/llvmGen/Llvm/Types.hs
=====================================
@@ -185,6 +185,7 @@ pprSpecialStatic :: LlvmStatic -> SDoc
pprSpecialStatic (LMBitc v t) =
ppr (pLower t) <> text ", bitcast (" <> ppr v <> text " to " <> ppr t
<> char ')'
+pprSpecialStatic v@(LMStaticPointer x) = ppr (pLower $ getVarType x) <> comma <+> ppr v
pprSpecialStatic stat = ppr stat
=====================================
compiler/llvmGen/LlvmCodeGen/Base.hs
=====================================
@@ -31,7 +31,7 @@ module LlvmCodeGen.Base (
strCLabel_llvm, strDisplayName_llvm, strProcedureName_llvm,
getGlobalPtr, generateExternDecls,
- aliasify,
+ aliasify, llvmDefLabel
) where
#include "HsVersions.h"
@@ -57,6 +57,7 @@ import UniqSupply
import ErrUtils
import qualified Stream
+import Data.Maybe (fromJust)
import Control.Monad (ap)
-- ----------------------------------------------------------------------------
@@ -376,7 +377,7 @@ ghcInternalFunctions = do
mk "newSpark" (llvmWord dflags) [i8Ptr, i8Ptr]
where
mk n ret args = do
- let n' = fsLit n `appendFS` fsLit "$def"
+ let n' = llvmDefLabel $ fsLit n
decl = LlvmFunctionDecl n' ExternallyVisible CC_Ccc ret
FixedArgs (tysToParams args) Nothing
renderLlvm $ ppLlvmFunctionDecl decl
@@ -436,12 +437,17 @@ getGlobalPtr llvmLbl = do
let mkGlbVar lbl ty = LMGlobalVar lbl (LMPointer ty) Private Nothing Nothing
case m_ty of
-- Directly reference if we have seen it already
- Just ty -> return $ mkGlbVar (llvmLbl `appendFS` fsLit "$def") ty Global
+ Just ty -> return $ mkGlbVar (llvmDefLabel llvmLbl) ty Global
-- Otherwise use a forward alias of it
Nothing -> do
saveAlias llvmLbl
return $ mkGlbVar llvmLbl i8 Alias
+-- | Derive the definition label. It has an identified
+-- structure type.
+llvmDefLabel :: LMString -> LMString
+llvmDefLabel = (`appendFS` fsLit "$def")
+
-- | Generate definitions for aliases forward-referenced by @getGlobalPtr at .
--
-- Must be called at a point where we are sure that no new global definitions
@@ -472,10 +478,28 @@ generateExternDecls = do
-- | Here we take a global variable definition, rename it with a
-- @$def@ suffix, and generate the appropriate alias.
aliasify :: LMGlobal -> LlvmM [LMGlobal]
+-- See note [emit-time elimination of static indirections] in CLabel.
+-- Here we obtain the indirectee's precise type and introduce
+-- fresh aliases to both the precise typed label (lbl$def) and the i8*
+-- typed (regular) label of it with the matching new names.
+aliasify (LMGlobal (LMGlobalVar lbl ty at LMAlias{} link sect align Alias)
+ (Just orig)) = do
+ let defLbl = llvmDefLabel lbl
+ LMStaticPointer (LMGlobalVar origLbl _ oLnk Nothing Nothing Alias) = orig
+ defOrigLbl = llvmDefLabel origLbl
+ orig' = LMStaticPointer (LMGlobalVar origLbl i8Ptr oLnk Nothing Nothing Alias)
+ origType <- funLookup origLbl
+ let defOrig = LMBitc (LMStaticPointer (LMGlobalVar defOrigLbl
+ (pLift $ fromJust origType) oLnk
+ Nothing Nothing Alias))
+ (pLift ty)
+ pure [ LMGlobal (LMGlobalVar defLbl ty link sect align Alias) (Just defOrig)
+ , LMGlobal (LMGlobalVar lbl i8Ptr link sect align Alias) (Just orig')
+ ]
aliasify (LMGlobal var val) = do
let LMGlobalVar lbl ty link sect align const = var
- defLbl = lbl `appendFS` fsLit "$def"
+ defLbl = llvmDefLabel lbl
defVar = LMGlobalVar defLbl ty Internal sect align const
defPtrVar = LMGlobalVar defLbl (LMPointer ty) link Nothing Nothing const
=====================================
compiler/llvmGen/LlvmCodeGen/Data.hs
=====================================
@@ -32,12 +32,41 @@ import qualified Data.ByteString as BS
structStr :: LMString
structStr = fsLit "_struct"
+-- | The LLVM visibility of the label
+linkage :: CLabel -> LlvmLinkageType
+linkage lbl = if externallyVisibleCLabel lbl
+ then ExternallyVisible else Internal
+
-- ----------------------------------------------------------------------------
-- * Top level
--
-- | Pass a CmmStatic section to an equivalent Llvm code.
genLlvmData :: (Section, CmmStatics) -> LlvmM LlvmData
+-- See note [emit-time elimination of static indirections] in CLabel.
+genLlvmData (_, Statics alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
+ | lbl == mkIndStaticInfoLabel
+ , let labelInd (CmmLabelOff l _) = Just l
+ labelInd (CmmLabel l) = Just l
+ labelInd _ = Nothing
+ , Just ind' <- labelInd ind
+ , alias `mayRedirectTo` ind' = do
+ label <- strCLabel_llvm alias
+ label' <- strCLabel_llvm ind'
+ let link = linkage alias
+ link' = linkage ind'
+ -- the LLVM type we give the alias is an empty struct type
+ -- but it doesn't really matter, as the pointer is only
+ -- used for (bit/int)casting.
+ tyAlias = LMAlias (label `appendFS` structStr, LMStructU [])
+
+ aliasDef = LMGlobalVar label tyAlias link Nothing Nothing Alias
+ -- we don't know the type of the indirectee here
+ indType = panic "will be filled by 'aliasify', later"
+ orig = LMStaticPointer $ LMGlobalVar label' indType link' Nothing Nothing Alias
+
+ pure ([LMGlobal aliasDef $ Just orig], [tyAlias])
+
genLlvmData (sec, Statics lbl xs) = do
label <- strCLabel_llvm lbl
static <- mapM genData xs
@@ -45,11 +74,10 @@ genLlvmData (sec, Statics lbl xs) = do
let types = map getStatType static
strucTy = LMStruct types
- tyAlias = LMAlias ((label `appendFS` structStr), strucTy)
+ tyAlias = LMAlias (label `appendFS` structStr, strucTy)
struct = Just $ LMStaticStruc static tyAlias
- link = if (externallyVisibleCLabel lbl)
- then ExternallyVisible else Internal
+ link = linkage lbl
align = case sec of
Section CString _ -> Just 1
_ -> Nothing
=====================================
compiler/llvmGen/LlvmCodeGen/Ppr.hs
=====================================
@@ -71,7 +71,7 @@ pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks))
let fun = LlvmFunction funDec funArgs llvmStdFunAttrs funSect
prefix lmblocks
name = decName $ funcDecl fun
- defName = name `appendFS` fsLit "$def"
+ defName = llvmDefLabel name
funcDecl' = (funcDecl fun) { decName = defName }
fun' = fun { funcDecl = funcDecl' }
funTy = LMFunction funcDecl'
=====================================
compiler/nativeGen/PPC/Ppr.hs
=====================================
@@ -27,6 +27,7 @@ import Hoopl.Label
import BlockId
import CLabel
+import PprCmmExpr ()
import Unique ( pprUniqueAlways, getUnique )
import Platform
@@ -119,6 +120,16 @@ pprBasicBlock info_env (BasicBlock blockid instrs)
pprDatas :: CmmStatics -> SDoc
+-- See note [emit-time elimination of static indirections] in CLabel.
+pprDatas (Statics alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
+ | lbl == mkIndStaticInfoLabel
+ , let labelInd (CmmLabelOff l _) = Just l
+ labelInd (CmmLabel l) = Just l
+ labelInd _ = Nothing
+ , Just ind' <- labelInd ind
+ , alias `mayRedirectTo` ind'
+ = pprGloblDecl alias
+ $$ text ".equiv" <+> ppr alias <> comma <> ppr (CmmLabel ind')
pprDatas (Statics lbl dats) = vcat (pprLabel lbl : map pprData dats)
pprData :: CmmStatic -> SDoc
=====================================
compiler/nativeGen/SPARC/Ppr.hs
=====================================
@@ -102,6 +102,16 @@ pprBasicBlock info_env (BasicBlock blockid instrs)
pprDatas :: CmmStatics -> SDoc
+-- See note [emit-time elimination of static indirections] in CLabel.
+pprDatas (Statics alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
+ | lbl == mkIndStaticInfoLabel
+ , let labelInd (CmmLabelOff l _) = Just l
+ labelInd (CmmLabel l) = Just l
+ labelInd _ = Nothing
+ , Just ind' <- labelInd ind
+ , alias `mayRedirectTo` ind'
+ = pprGloblDecl alias
+ $$ text ".equiv" <+> ppr alias <> comma <> ppr (CmmLabel ind')
pprDatas (Statics lbl dats) = vcat (pprLabel lbl : map pprData dats)
pprData :: CmmStatic -> SDoc
@@ -634,4 +644,3 @@ pp_comma_lbracket = text ",["
pp_comma_a :: SDoc
pp_comma_a = text ",a"
-
=====================================
compiler/nativeGen/X86/Ppr.hs
=====================================
@@ -145,7 +145,19 @@ pprBasicBlock info_env (BasicBlock blockid instrs)
(l at LOCATION{} : _) -> pprInstr l
_other -> empty
+
pprDatas :: (Alignment, CmmStatics) -> SDoc
+-- See note [emit-time elimination of static indirections] in CLabel.
+pprDatas (_, Statics alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
+ | lbl == mkIndStaticInfoLabel
+ , let labelInd (CmmLabelOff l _) = Just l
+ labelInd (CmmLabel l) = Just l
+ labelInd _ = Nothing
+ , Just ind' <- labelInd ind
+ , alias `mayRedirectTo` ind'
+ = pprGloblDecl alias
+ $$ text ".equiv" <+> ppr alias <> comma <> ppr (CmmLabel ind')
+
pprDatas (align, (Statics lbl dats))
= vcat (pprAlign align : pprLabel lbl : map pprData dats)
=====================================
testsuite/tests/codeGen/should_compile/Makefile
=====================================
@@ -43,3 +43,18 @@ T15723:
'$(TEST_HC)' $(TEST_HC_OPTS) -prof -fPIC -fexternal-dynamic-refs -fforce-recomp -O2 -c T15723A.hs -o T15723A.o
'$(TEST_HC)' $(TEST_HC_OPTS) -prof -fPIC -fexternal-dynamic-refs -fforce-recomp -O2 -c T15723B.hs -o T15723B.o
'$(TEST_HC)' $(TEST_HC_OPTS) -dynamic -shared T15723B.o -o T15723B.so
+
+## check that there are two assembly equates
+# mentioning T15155.a_closure (def and use)
+T15155:
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c -O0 -ddump-asm T15155l.hs | grep -F ".equiv " \
+ | grep -F "T15155.a_closure" | wc -l | sed -e 's/ *//g' | grep "2" ; echo $$?
+
+## check that there are two "$def" aliases:
+# - one that bitcasts to %T15155_a_closure_struct*
+# - and the other which bitcasts from %T15155_a_closure_struct*
+##
+T15155l:
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c -O0 -ddump-llvm T15155l.hs 2>/dev/null \
+ | grep -F "= alias %T15155_" | grep -E "@T15155_[ab]_closure.def = " | grep -F "%T15155_a_closure_struct*" \
+ | wc -l | sed -e 's/ *//g' | grep "2"; echo $$?
=====================================
testsuite/tests/codeGen/should_compile/T15155.stdout
=====================================
@@ -0,0 +1,2 @@
+2
+0
=====================================
testsuite/tests/codeGen/should_compile/T15155l.hs
=====================================
@@ -0,0 +1,8 @@
+module T15155 (a, B(..), b) where
+
+newtype A = A Int
+newtype B = B A
+
+{-# NOINLINE a #-}
+a = A 42
+b = B a
=====================================
testsuite/tests/codeGen/should_compile/T15155l.stdout
=====================================
@@ -0,0 +1,2 @@
+2
+0
=====================================
testsuite/tests/codeGen/should_compile/all.T
=====================================
@@ -44,7 +44,7 @@ test('T14999',
# Verify that we optimize away redundant jumps for unordered comparisons.
test('T15196',
- [ unless(arch('x86_64'),skip),
+ [ unless(arch('x86_64'), skip),
only_ways('normal'),
], makefile_test, [])
@@ -52,3 +52,10 @@ test('T15723',
[ unless(have_profiling(), skip),
unless(have_dynamic(), skip),
], makefile_test, [])
+
+test('T15155',
+ [ unless(have_ncg(), skip)
+ ], makefile_test, [])
+
+test('T15155l', when(unregisterised(), skip),
+ makefile_test, [])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/be05bd8168b0ea65d63dc0093a5c8781a2528500
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/be05bd8168b0ea65d63dc0093a5c8781a2528500
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/20190416/d576feb4/attachment-0001.html>
More information about the ghc-commits
mailing list