diff options
| -rw-r--r-- | compiler/cmm/CLabel.hs | 22 | ||||
| -rw-r--r-- | compiler/cmm/CmmBuildInfoTables.hs | 18 | ||||
| -rw-r--r-- | compiler/cmm/CmmInfo.hs | 5 | ||||
| -rw-r--r-- | 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 3dfd7a7d1d..8f614ab34f 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 ecbe89d8f0..3d13fc7873 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 3b2eea1a5e..43cba2526d 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 137cfe2a1e..db50d1613b 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 |