diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2020-03-25 20:06:19 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-04-03 06:26:54 -0400 |
commit | a485c3c4049fff09e989bfd7d2ba47035c92a69b (patch) | |
tree | b1b87b24afa4b175ec4c74165d168783fcac7d32 /compiler/GHC/StgToCmm.hs | |
parent | f7597aa0c028ced898ac97e344754dd961b70c57 (diff) | |
download | haskell-a485c3c4049fff09e989bfd7d2ba47035c92a69b.tar.gz |
Move blob handling into StgToCmm
Move handling of big literal strings from CmmToAsm to StgToCmm. It
avoids the use of `sdocWithDynFlags` (cf #10143). We might need to move
this handling even higher in the pipeline in the future (cf #17960):
this patch will make it easier.
Diffstat (limited to 'compiler/GHC/StgToCmm.hs')
-rw-r--r-- | compiler/GHC/StgToCmm.hs | 27 |
1 files changed, 21 insertions, 6 deletions
diff --git a/compiler/GHC/StgToCmm.hs b/compiler/GHC/StgToCmm.hs index 4c4b5b5a9e..0e6013d712 100644 --- a/compiler/GHC/StgToCmm.hs +++ b/compiler/GHC/StgToCmm.hs @@ -45,6 +45,7 @@ import Outputable import Stream import GHC.Types.Basic import GHC.Types.Var.Set ( isEmptyDVarSet ) +import FileCleanup import OrdList import GHC.Cmm.Graph @@ -52,6 +53,8 @@ import GHC.Cmm.Graph import Data.IORef import Control.Monad (when,void) import Util +import System.IO.Unsafe +import qualified Data.ByteString as BS codeGen :: DynFlags -> Module @@ -133,12 +136,24 @@ cgTopBinding dflags (StgTopLifted (StgRec pairs)) ; sequence_ fcodes } -cgTopBinding dflags (StgTopStringLit id str) - = do { let label = mkBytesLabel (idName id) - ; let (lit, decl) = mkByteStringCLit label str - ; emitDecl decl - ; addBindC (litIdInfo dflags id mkLFStringLit lit) - } +cgTopBinding dflags (StgTopStringLit id str) = do + let label = mkBytesLabel (idName id) + -- 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 isNCG = platformMisc_ghcWithNativeCodeGen $ platformMisc dflags + isSmall = fromIntegral (BS.length str) <= binBlobThreshold dflags + asString = binBlobThreshold dflags == 0 || isSmall + + (lit,decl) = if not isNCG || asString + then mkByteStringCLit label str + else mkFileEmbedLit label $ unsafePerformIO $ do + bFile <- newTempName dflags TFL_CurrentModule ".dat" + BS.writeFile bFile str + return bFile + emitDecl decl + addBindC (litIdInfo dflags id mkLFStringLit lit) + cgTopRhs :: DynFlags -> RecFlag -> Id -> CgStgRhs -> (CgIdInfo, FCode ()) -- The Id is passed along for setting up a binding... |