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.

4 files changed, 21 insertions, 25 deletions

diff --git a/compiler/GHC/CmmToAsm/PPC/Ppr.hs b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
index 90b85023a2..647f1ff1c9 100644
--- a/compiler/GHC/CmmToAsm/PPC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
@@ -135,7 +135,8 @@ pprDatas platform (RawCmmStatics lbl dats) = vcat (pprLabel platform lbl : map (
 
 pprData :: Platform -> CmmStatic -> SDoc
 pprData platform d = case d of
-   CmmString str          -> pprBytes str
+   CmmString str          -> pprString str
+   CmmFileEmbed path      -> pprFileEmbed path
    CmmUninitialised bytes -> text ".space " <> int bytes
    CmmStaticLit lit       -> pprDataItem platform lit
 
diff --git a/compiler/GHC/CmmToAsm/Ppr.hs b/compiler/GHC/CmmToAsm/Ppr.hs
index 324bad63c4..c0abb52ad3 100644
--- a/compiler/GHC/CmmToAsm/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/Ppr.hs
@@ -14,7 +14,8 @@ module GHC.CmmToAsm.Ppr (
         floatToBytes,
         doubleToBytes,
         pprASCII,
-        pprBytes,
+        pprString,
+        pprFileEmbed,
         pprSectionHeader
 )
 
@@ -26,11 +27,9 @@ import AsmUtils
 import GHC.Cmm.CLabel
 import GHC.Cmm
 import GHC.CmmToAsm.Config
-import GHC.Driver.Session
 import FastString
 import Outputable
 import GHC.Platform
-import FileCleanup
 
 import qualified Data.Array.Unsafe as U ( castSTUArray )
 import Data.Array.ST
@@ -43,7 +42,6 @@ import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import GHC.Exts
 import GHC.Word
-import System.IO.Unsafe
 
 
 
@@ -129,24 +127,18 @@ pprASCII str
                  ]
        ord0 = 0x30 -- = ord '0'
 
--- | Pretty print binary data.
---
--- Use either the ".string" directive or a ".incbin" directive.
--- See Note [Embedding large binary blobs]
+-- | Emit a ".string" directive
+pprString :: ByteString -> SDoc
+pprString bs = text "\t.string " <> doubleQuotes (pprASCII bs)
+
+-- | Emit a ".incbin" directive
 --
 -- A NULL byte is added after the binary data.
---
-pprBytes :: ByteString -> SDoc
-pprBytes bs = sdocWithDynFlags $ \dflags ->
-  if binBlobThreshold dflags == 0
-     || fromIntegral (BS.length bs) <= binBlobThreshold dflags
-    then text "\t.string " <> doubleQuotes (pprASCII bs)
-    else unsafePerformIO $ do
-      bFile <- newTempName dflags TFL_CurrentModule ".dat"
-      BS.writeFile bFile bs
-      return $ text "\t.incbin "
-         <> pprFilePathString bFile -- proper escape (see #16389)
-         <> text "\n\t.byte 0"
+pprFileEmbed :: FilePath -> SDoc
+pprFileEmbed path
+   = text "\t.incbin "
+     <> pprFilePathString path -- proper escape (see #16389)
+     <> text "\n\t.byte 0"
 
 {-
 Note [Embedding large binary blobs]
diff --git a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
index a65ac03458..7c6954c548 100644
--- a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
@@ -116,9 +116,11 @@ pprDatas _platform (RawCmmStatics alias [CmmStaticLit (CmmLabel lbl), CmmStaticL
 pprDatas platform (RawCmmStatics lbl dats) = vcat (pprLabel platform lbl : map (pprData platform) dats)
 
 pprData :: Platform -> CmmStatic -> SDoc
-pprData _ (CmmString str)           = pprBytes str
-pprData _ (CmmUninitialised bytes)  = text ".skip " <> int bytes
-pprData platform (CmmStaticLit lit) = pprDataItem platform lit
+pprData platform d = case d of
+   CmmString str          -> pprString str
+   CmmFileEmbed path      -> pprFileEmbed path
+   CmmUninitialised bytes -> text ".skip " <> int bytes
+   CmmStaticLit lit       -> pprDataItem platform lit
 
 pprGloblDecl :: CLabel -> SDoc
 pprGloblDecl lbl
diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs
index 357e24a9cc..9230550872 100644
--- a/compiler/GHC/CmmToAsm/X86/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs
@@ -167,7 +167,8 @@ pprDatas config (align, (RawCmmStatics lbl dats))
       platform = ncgPlatform config
 
 pprData :: NCGConfig -> CmmStatic -> SDoc
-pprData _config (CmmString str) = pprBytes str
+pprData _config (CmmString str) = pprString str
+pprData _config (CmmFileEmbed path) = pprFileEmbed path
 
 pprData config (CmmUninitialised bytes)
  = let platform = ncgPlatform config