[commit: ghc] ghc-8.6: Revert "Revert "Disable the SRT offset optimisation on MachO platforms"" (f442bc6)
git at git.haskell.org
git at git.haskell.org
Wed Sep 19 18:26:06 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : ghc-8.6
Link : http://ghc.haskell.org/trac/ghc/changeset/f442bc6c966e85f845a8167ab97ab71d73cd8520/ghc
>---------------------------------------------------------------
commit f442bc6c966e85f845a8167ab97ab71d73cd8520
Author: Ben Gamari <ben at smart-cactus.org>
Date: Tue Sep 18 11:45:27 2018 -0400
Revert "Revert "Disable the SRT offset optimisation on MachO platforms""
This reverts commit c15d44f8b3f00bfe152c2f9d3c6f60efd204fb23.
>---------------------------------------------------------------
f442bc6c966e85f845a8167ab97ab71d73cd8520
compiler/cmm/CLabel.hs | 22 ++++++++++++++++++++--
compiler/cmm/CmmBuildInfoTables.hs | 18 ++++++++++++++++--
compiler/cmm/CmmInfo.hs | 5 ++++-
includes/rts/storage/InfoTables.h | 3 +++
4 files changed, 43 insertions(+), 5 deletions(-)
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 472bd3c..1a9bc73 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -94,10 +94,12 @@ module CLabel (
mkHpcTicksLabel,
+ -- * Predicates
hasCAF,
needsCDecl, maybeLocalBlockLabel, externallyVisibleCLabel,
isMathFun,
isCFunctionLabel, isGcPtrLabel, labelDynamic,
+ isLocalCLabel,
-- * Conversions
toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, hasHaskellName,
@@ -974,13 +976,29 @@ idInfoLabelType info =
-- -----------------------------------------------------------------------------
--- Does a CLabel need dynamic linkage?
+-- | Is a 'CLabel' defined in the current module being compiled?
+--
+-- Sometimes we can optimise references within a compilation unit in ways that
+-- we couldn't for inter-module references. This provides a conservative
+-- estimate of whether a 'CLabel' lives in the current module.
+isLocalCLabel :: Module -> CLabel -> Bool
+isLocalCLabel this_mod lbl =
+ case lbl of
+ IdLabel name _ _
+ | isInternalName name -> True
+ | otherwise -> nameModule name == this_mod
+ LocalBlockLabel _ -> True
+ _ -> False
+
+-- -----------------------------------------------------------------------------
+
+-- | Does a 'CLabel' need dynamic linkage?
+--
-- When referring to data in code, we need to know whether
-- that data resides in a DLL or not. [Win32 only.]
-- @labelDynamic@ returns @True@ if the label is located
-- in a DLL, be it a data reference or not.
-
labelDynamic :: DynFlags -> Module -> CLabel -> Bool
labelDynamic dflags this_mod lbl =
case lbl of
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index ecbe89d..3d13fc7 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -16,6 +16,7 @@ import Hoopl.Label
import Hoopl.Collections
import Hoopl.Dataflow
import Module
+import Platform
import Digraph
import CLabel
import PprCmmDecl ()
@@ -120,7 +121,7 @@ offset to the SRT can be stored in 32 bits (all code lives within a
the info table by storing the srt_offset in the srt field, which is
half a word.
-On x86_64 with TABLES_NEXT_TO_CODE:
+On x86_64 with TABLES_NEXT_TO_CODE (except on MachO, due to #15169):
- info->srt is zero if there's no SRT, otherwise:
- info->srt is an offset from the info pointer to the SRT object
@@ -636,14 +637,27 @@ oneSRT dflags staticFuns blockids lbls isCAF cafs = do
let newSRTMap = Map.fromList [(cafLbl, srtEntry) | cafLbl <- lbls]
put (Map.union newSRTMap srtMap)
+ this_mod = thisModule topSRT
+
case Set.toList filtered of
[] -> do
srtTrace "oneSRT: empty" (ppr lbls) $ return ()
updateSRTMap Nothing
return ([], [], [])
+ -- When we have only one entry there is no need to build a new SRT at all.
[one@(SRTEntry lbl)]
- | not (labelDynamic dflags (thisModule topSRT) lbl) -> do
+ | -- Info tables refer to SRTs by offset (as noted in the section
+ -- "Referring to an SRT from the info table" of Note [SRTs]). However,
+ -- when dynamic linking is used we cannot guarantee that the offset
+ -- between the SRT and the info table will fit in the offset field.
+ -- Consequently we build a singleton SRT in in this case.
+ not (labelDynamic dflags this_mod lbl)
+
+ -- MachO relocations can't express offsets between compilation units at
+ -- all, so we are always forced to build a singleton SRT in this case.
+ && (not (osMachOTarget $ platformOS $ targetPlatform dflags)
+ || isLocalCLabel this_mod lbl) -> do
updateSRTMap (Just one)
return ([], map (,lbl) blockids, [])
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index 3b2eea1..43cba25 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -271,7 +271,10 @@ mkSRTLit dflags _ Nothing = ([], CmmInt 0 (halfWordWidth dflags))
mkSRTLit dflags _ (Just lbl) = ([CmmLabel lbl], CmmInt 1 (halfWordWidth dflags))
--- | is the SRT offset field inline in the info table on this platform?
+-- | Is the SRT offset field inline in the info table on this platform?
+--
+-- See the section "Referring to an SRT from the info table" in
+-- Note [SRTs] in CmmBuildInfoTables.hs
inlineSRT :: DynFlags -> Bool
inlineSRT dflags = platformArch (targetPlatform dflags) == ArchX86_64
&& tablesNextToCode dflags
diff --git a/includes/rts/storage/InfoTables.h b/includes/rts/storage/InfoTables.h
index 137cfe2..db50d16 100644
--- a/includes/rts/storage/InfoTables.h
+++ b/includes/rts/storage/InfoTables.h
@@ -156,6 +156,9 @@ typedef union {
#if defined(x86_64_TARGET_ARCH) && defined(TABLES_NEXT_TO_CODE)
// On x86_64 we can fit a pointer offset in half a word, so put the SRT offset
// in the info->srt field directly.
+//
+// See the section "Referring to an SRT from the info table" in
+// Note [SRTs] in CmmBuildInfoTables.hs
#define USE_INLINE_SRT_FIELD
#endif
More information about the ghc-commits
mailing list