diff options
| -rw-r--r-- | compiler/GHC/Driver/Config/StgToCmm.hs | 3 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Session.hs | 12 | ||||
| -rw-r--r-- | compiler/GHC/StgToCmm.hs | 11 | ||||
| -rw-r--r-- | compiler/GHC/StgToCmm/Config.hs | 12 |
4 files changed, 22 insertions, 16 deletions
diff --git a/compiler/GHC/Driver/Config/StgToCmm.hs b/compiler/GHC/Driver/Config/StgToCmm.hs index 9896fed3bc..1b05884bb7 100644 --- a/compiler/GHC/Driver/Config/StgToCmm.hs +++ b/compiler/GHC/Driver/Config/StgToCmm.hs @@ -22,7 +22,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig , stgToCmmTmpDir = tmpDir dflags , stgToCmmContext = initSDocContext dflags defaultDumpStyle , stgToCmmDebugLevel = debugLevel dflags - , stgToCmmBinBlobThresh = binBlobThreshold dflags + , stgToCmmBinBlobThresh = b_blob , stgToCmmMaxInlAllocSize = maxInlineAllocSize dflags -- ticky options , stgToCmmDoTicky = gopt Opt_Ticky dflags @@ -63,6 +63,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig bk_end = backend dflags ncg = bk_end == NCG llvm = bk_end == LLVM + b_blob = if not ncg then Nothing else binBlobThreshold dflags x86ish = case platformArch platform of ArchX86 -> True ArchX86_64 -> True diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index d4d41accf6..f75a5e0d92 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -488,9 +488,10 @@ data DynFlags = DynFlags { specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function specConstrRecursive :: Int, -- ^ Max number of specialisations for recursive types -- Not optional; otherwise ForceSpecConstr can diverge. - binBlobThreshold :: Word, -- ^ Binary literals (e.g. strings) whose size is above + binBlobThreshold :: Maybe Word, -- ^ Binary literals (e.g. strings) whose size is above -- this threshold will be dumped in a binary file - -- by the assembler code generator (0 to disable) + -- by the assembler code generator. 0 and Nothing disables + -- this feature. See 'GHC.StgToCmm.Config'. liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating -- See 'GHC.Core.Opt.Monad.FloatOutSwitches' @@ -1122,7 +1123,7 @@ defaultDynFlags mySettings llvmConfig = simplPhases = 2, maxSimplIterations = 4, ruleCheck = Nothing, - binBlobThreshold = 500000, -- 500K is a good default (see #16190) + binBlobThreshold = Just 500000, -- 500K is a good default (see #16190) maxRelevantBinds = Just 6, maxValidHoleFits = Just 6, maxRefHoleFits = Just 6, @@ -2699,8 +2700,9 @@ dynamic_flags_deps = [ -- If the number is missing, use 1 , make_ord_flag defFlag "fbinary-blob-threshold" - (intSuffix (\n d -> d { binBlobThreshold = fromIntegral n })) - + (intSuffix (\n d -> d { binBlobThreshold = case fromIntegral n of + 0 -> Nothing + x -> Just x})) , make_ord_flag defFlag "fmax-relevant-binds" (intSuffix (\n d -> d { maxRelevantBinds = Just n })) , make_ord_flag defFlag "fno-max-relevant-binds" diff --git a/compiler/GHC/StgToCmm.hs b/compiler/GHC/StgToCmm.hs index 3075182af6..21a037aeee 100644 --- a/compiler/GHC/StgToCmm.hs +++ b/compiler/GHC/StgToCmm.hs @@ -15,8 +15,6 @@ module GHC.StgToCmm ( codeGen ) where import GHC.Prelude as Prelude -import GHC.Driver.Backend - import GHC.StgToCmm.Prof (initCostCentres, ldvEnter) import GHC.StgToCmm.Monad import GHC.StgToCmm.Env @@ -183,12 +181,11 @@ cgTopBinding logger tmpfs cfg = \case -- emit either a CmmString literal or dump the string in a file and emit a -- CmmFileEmbed literal. -- See Note [Embedding large binary blobs] in GHC.CmmToAsm.Ppr - let bin_blob_threshold = stgToCmmBinBlobThresh cfg - isNCG = platformDefaultBackend (stgToCmmPlatform cfg) == NCG - isSmall = fromIntegral (BS.length str) <= bin_blob_threshold - asString = bin_blob_threshold == 0 || isSmall + let asString = case stgToCmmBinBlobThresh cfg of + Just bin_blob_threshold -> fromIntegral (BS.length str) <= bin_blob_threshold + Nothing -> True - (lit,decl) = if not isNCG || asString + (lit,decl) = if asString then mkByteStringCLit label str else mkFileEmbedLit label $ unsafePerformIO $ do bFile <- newTempName logger tmpfs (stgToCmmTmpDir cfg) TFL_CurrentModule ".dat" diff --git a/compiler/GHC/StgToCmm/Config.hs b/compiler/GHC/StgToCmm/Config.hs index b3014fd302..d73dd753e6 100644 --- a/compiler/GHC/StgToCmm/Config.hs +++ b/compiler/GHC/StgToCmm/Config.hs @@ -23,9 +23,15 @@ data StgToCmmConfig = StgToCmmConfig , stgToCmmTmpDir :: !TempDir -- ^ Temp Dir for files used in compilation , stgToCmmContext :: !SDocContext -- ^ Context for StgToCmm phase , stgToCmmDebugLevel :: !Int -- ^ The verbosity of debug messages - , stgToCmmBinBlobThresh :: !Word -- ^ Binary literals (e.g. strings) whose size is above this - -- threshold will be dumped in a binary file by the assembler - -- code generator (0 to disable) + , stgToCmmBinBlobThresh :: !(Maybe Word) -- ^ Threshold at which Binary literals (e.g. strings) + -- are either dumped to a file and a CmmFileEmbed literal + -- is emitted (over threshold), or become a CmmString + -- Literal (under or at threshold). CmmFileEmbed is only supported + -- with the NCG, thus a Just means two things: We have a threshold, + -- and will be using the NCG. Conversely, a Nothing implies we are not + -- using NCG and disables CmmFileEmbed. See Note + -- [Embedding large binary blobs] in GHC.CmmToAsm.Ppr, and + -- @cgTopBinding@ in GHC.StgToCmm. , stgToCmmMaxInlAllocSize :: !Int -- ^ Max size, in bytes, of inline array allocations. ------------------------------ Ticky Options ---------------------------------- , stgToCmmDoTicky :: !Bool -- ^ Ticky profiling enabled (cf @-ticky@) |