NCG: fast compilation of very large strings (#16190)

This patch adds an optimization into the NCG: for large strings
(threshold configurable via -fbinary-blob-threshold=NNN flag), instead
of printing `.asciz "..."` in the generated ASM source, we print
`.incbin "tmpXXX.dat"` and we dump the contents of the string into a
temporary "tmpXXX.dat" file.

See the note for more details.

4 files changed, 51 insertions, 12 deletions

diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index 47ab07b633..c54d4430eb 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -125,8 +125,7 @@ pprDatas :: CmmStatics -> SDoc
 pprDatas (Statics lbl dats) = vcat (pprLabel lbl : map pprData dats)
 
 pprData :: CmmStatic -> SDoc
-pprData (CmmString str)
-  = text "\t.string" <+> doubleQuotes (pprASCII str)
+pprData (CmmString str)          = pprBytes str
 pprData (CmmUninitialised bytes) = text ".space " <> int bytes
 pprData (CmmStaticLit lit)       = pprDataItem lit
 
diff --git a/compiler/nativeGen/PprBase.hs b/compiler/nativeGen/PprBase.hs
index afd16f8178..1f068c261b 100644
--- a/compiler/nativeGen/PprBase.hs
+++ b/compiler/nativeGen/PprBase.hs
@@ -14,6 +14,7 @@ module PprBase (
         floatToBytes,
         doubleToBytes,
         pprASCII,
+        pprBytes,
         pprSectionHeader
 )
 
@@ -28,6 +29,7 @@ import DynFlags
 import FastString
 import Outputable
 import Platform
+import FileCleanup
 
 import qualified Data.Array.Unsafe as U ( castSTUArray )
 import Data.Array.ST
@@ -40,6 +42,7 @@ import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import GHC.Exts
 import GHC.Word
+import System.IO.Unsafe
 
 
 
@@ -125,6 +128,51 @@ 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]
+--
+-- 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 \"" <> text bFile <> text "\"\n\t.byte 0"
+
+{-
+Note [Embedding large binary blobs]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+To embed a blob of binary data (e.g. an UTF-8 encoded string) into the generated
+code object, we have several options:
+
+   1. Generate a ".byte" directive for each byte. This is what was done in the past
+      (see Note [Pretty print ASCII when AsmCodeGen]).
+
+   2. Generate a single ".string"/".asciz" directive for the whole sequence of
+      bytes. Bytes in the ASCII printable range are rendered as characters and
+      other values are escaped (e.g., "\t", "\077", etc.).
+
+   3. Create a temporary file into which we dump the binary data and generate a
+      single ".incbin" directive. The assembler will include the binary file for
+      us in the generated output object.
+
+Now the code generator uses either (2) or (3), depending on the binary blob
+size.  Using (3) for small blobs adds too much overhead (see benchmark results
+in #16190), so we only do it when the size is above a threshold (500K at the
+time of writing).
+
+The threshold is configurable via the `-fbinary-blob-threshold` flag.
+
+-}
+
+
 {-
 Note [Pretty print ASCII when AsmCodeGen]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs
index 705fc31153..42ba13def4 100644
--- a/compiler/nativeGen/SPARC/Ppr.hs
+++ b/compiler/nativeGen/SPARC/Ppr.hs
@@ -49,8 +49,6 @@ import Unique           ( pprUniqueAlways )
 import Outputable
 import Platform
 import FastString
-import Data.Word
-import qualified Data.ByteString as BS
 
 -- -----------------------------------------------------------------------------
 -- Printing this stuff out
@@ -110,11 +108,7 @@ pprDatas :: CmmStatics -> SDoc
 pprDatas (Statics lbl dats) = vcat (pprLabel lbl : map pprData dats)
 
 pprData :: CmmStatic -> SDoc
-pprData (CmmString str)
-  = vcat (map do1 (BS.unpack str)) $$ do1 0
-    where
-       do1 :: Word8 -> SDoc
-       do1 w = text "\t.byte\t" <> int (fromIntegral w)
+pprData (CmmString str)          = pprBytes str
 pprData (CmmUninitialised bytes) = text ".skip " <> int bytes
 pprData (CmmStaticLit lit)       = pprDataItem lit
 
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index 075bb26337..83356758af 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -47,7 +47,6 @@ import FastString
 import Outputable
 
 import Data.Word
-
 import Data.Bits
 
 -- -----------------------------------------------------------------------------
@@ -154,8 +153,7 @@ pprDatas (align, (Statics lbl dats))
  = vcat (pprAlign align : pprLabel lbl : map pprData dats)
 
 pprData :: CmmStatic -> SDoc
-pprData (CmmString str)
- = ptext (sLit "\t.asciz ") <> doubleQuotes (pprASCII str)
+pprData (CmmString str) = pprBytes str
 
 pprData (CmmUninitialised bytes)
  = sdocWithPlatform $ \platform ->