[commit: ghc] master: Disable the SRT offset optimisation on MachO platforms (bf10456)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/bf10456edaa03dc010821cd4c3d9f49cb11d89da/ghc

>---------------------------------------------------------------

commit bf10456edaa03dc010821cd4c3d9f49cb11d89da
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Tue May 22 09:36:35 2018 -0400

    Disable the SRT offset optimisation on MachO platforms
    
    Unfortunately, this optimisation is infeasible on MachO platforms (e.g.
    Darwin) due to an object format limitation. Specifically, linking fails
    with errors of the form:
    
         error: unsupported relocation with subtraction expression, symbol
         '_integerzmgmp_GHCziIntegerziType_quotInteger_closure' can not be
         undefined in a subtraction expression
    
    Apparently MachO does not permit relocations' subtraction expressions to
    refer to undefined symbols. As far as I can tell this means that it is
    essentially impossible to express an offset between symbols living in
    different compilation units. This means that we lively can't use this
    optimisation on MachO platforms.
    
    Test Plan: Validate on Darwin
    
    Reviewers: simonmar, erikd
    
    Subscribers: rwbarton, thomie, carter, angerman
    
    GHC Trac Issues: #15169
    
    Differential Revision: https://phabricator.haskell.org/D4715


>---------------------------------------------------------------

bf10456edaa03dc010821cd4c3d9f49cb11d89da
 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 3dfd7a7..8f614ab 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,
@@ -975,13 +977,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