Reduce the size of string literals in binaries.

Removed the alignment for strings and mark then as cstring sections in
the generated asm so the linker can merge duplicate sections.

Reviewers: rwbarton, trofi, austin, trommler, simonmar, hvr, bgamari

Reviewed By: hvr, bgamari

Subscribers: simonpj, hvr, thomie

Differential Revision: https://phabricator.haskell.org/D1290

GHC Trac Issues: #9577

4 files changed, 33 insertions, 5 deletions

diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index 3dbb76d273..f0dd73e7a1 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -348,6 +348,12 @@ pprAlignForSection seg =
        ReadOnlyData16
         | osDarwin       -> sLit ".align 4"
         | otherwise      -> sLit ".align 4"
+       -- TODO: This is copied from the ReadOnlyData case, but it can likely be
+       -- made more efficient.
+       CString
+        | osDarwin       -> sLit ".align 2"
+        | ppc64          -> sLit ".align 3"
+        | otherwise      -> sLit ".align 2"
        OtherSection _    -> panic "PprMach.pprSectionAlign: unknown section"
 
 pprDataItem :: CmmLit -> SDoc
diff --git a/compiler/nativeGen/PprBase.hs b/compiler/nativeGen/PprBase.hs
index 859f68dac0..e7feb8a977 100644
--- a/compiler/nativeGen/PprBase.hs
+++ b/compiler/nativeGen/PprBase.hs
@@ -107,6 +107,7 @@ pprGNUSectionHeader t suffix = sdocWithDynFlags $ \dflags ->
       RelocatableReadOnlyData -> sLit ".data.rel.ro"
       UninitialisedData -> sLit ".bss"
       ReadOnlyData16 -> sLit ".rodata.cst16"
+      CString -> sLit ".rodata.str1.1,\"aMS\",@progbits,1"
       OtherSection _ ->
         panic "PprBase.pprGNUSectionHeader: unknown section type"
 
@@ -119,6 +120,7 @@ pprXcoffSectionHeader t = text $ case t of
      ReadOnlyData            -> ".csect .text[PR] # ReadOnlyData"
      RelocatableReadOnlyData -> ".csect .text[PR] # RelocatableReadOnlyData"
      ReadOnlyData16          -> ".csect .text[PR] # ReadOnlyData16"
+     CString                 -> ".csect .text[PR] # CString"
      UninitialisedData       -> ".csect .data[BS]"
      OtherSection _          ->
        panic "PprBase.pprXcoffSectionHeader: unknown section type"
@@ -132,5 +134,6 @@ pprDarwinSectionHeader t =
      RelocatableReadOnlyData -> sLit ".const_data"
      UninitialisedData -> sLit ".data"
      ReadOnlyData16 -> sLit ".const"
+     CString -> sLit ".section\t__TEXT,__cstring,cstring_literals"
      OtherSection _ ->
        panic "PprBase.pprDarwinSectionHeader: unknown section type"
diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs
index 4eba1c411e..35d18b1e90 100644
--- a/compiler/nativeGen/SPARC/Ppr.hs
+++ b/compiler/nativeGen/SPARC/Ppr.hs
@@ -339,6 +339,9 @@ pprAlignForSection seg =
                         -> sLit ".align 8"
       UninitialisedData -> sLit ".align 8"
       ReadOnlyData16    -> sLit ".align 16"
+      -- TODO: This is copied from the ReadOnlyData case, but it can likely be
+      -- made more efficient.
+      CString           -> sLit ".align 8"
       OtherSection _    -> panic "PprMach.pprSectionHeader: unknown section")
 
 -- | Pretty print a data item.
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index e70aa63c0b..6261aad5ca 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -44,6 +44,8 @@ import Outputable
 
 import Data.Word
 
+import Data.Char
+
 import Data.Bits
 
 -- -----------------------------------------------------------------------------
@@ -140,10 +142,10 @@ pprBasicBlock info_env (BasicBlock blockid instrs)
 pprDatas :: (Alignment, CmmStatics) -> SDoc
 pprDatas (align, (Statics lbl dats))
  = vcat (pprAlign align : pprLabel lbl : map pprData dats)
- -- TODO: could remove if align == 1
 
 pprData :: CmmStatic -> SDoc
-pprData (CmmString str) = pprASCII str
+pprData (CmmString str)
+ = ptext (sLit "\t.asciz ") <> doubleQuotes (pprASCII str)
 
 pprData (CmmUninitialised bytes)
  = sdocWithPlatform $ \platform ->
@@ -172,10 +174,20 @@ pprLabel lbl = pprGloblDecl lbl
 
 pprASCII :: [Word8] -> SDoc
 pprASCII str
-  = vcat (map do1 str) $$ do1 0
+  = hcat (map (do1 . fromIntegral) str)
     where
-       do1 :: Word8 -> SDoc
-       do1 w = text "\t.byte\t" <> int (fromIntegral w)
+       do1 :: Int -> SDoc
+       do1 w | '\t' <- chr w = ptext (sLit "\\t")
+       do1 w | '\n' <- chr w = ptext (sLit "\\n")
+       do1 w | '"'  <- chr w = ptext (sLit "\\\"")
+       do1 w | '\\' <- chr w = ptext (sLit "\\\\")
+       do1 w | isPrint (chr w) = char (chr w)
+       do1 w | otherwise = char '\\' <> octal w
+
+       octal :: Int -> SDoc
+       octal w = int ((w `div` 64) `mod` 8)
+                  <> int ((w `div` 8) `mod` 8)
+                  <> int (w `mod` 8)
 
 pprAlign :: Int -> SDoc
 pprAlign bytes
@@ -418,10 +430,12 @@ pprAlignForSection seg =
        | target32Bit platform ->
           case seg of
            ReadOnlyData16    -> int 4
+           CString           -> int 1
            _                 -> int 2
        | otherwise ->
           case seg of
            ReadOnlyData16    -> int 4
+           CString           -> int 1
            _                 -> int 3
       -- Other: alignments are given as bytes.
       _
@@ -429,10 +443,12 @@ pprAlignForSection seg =
           case seg of
            Text              -> text "4,0x90"
            ReadOnlyData16    -> int 16
+           CString           -> int 1
            _                 -> int 4
        | otherwise ->
           case seg of
            ReadOnlyData16    -> int 16
+           CString           -> int 1
            _                 -> int 8
 
 pprDataItem :: CmmLit -> SDoc