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.

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...