Reduce the size of string literals in binaries.
authorThijs Alkemade <me@thijsalkema.de>
Tue, 6 Dec 2016 22:12:17 +0000 (17:12 -0500)
committerBen Gamari <ben@smart-cactus.org>
Tue, 6 Dec 2016 23:44:43 +0000 (18:44 -0500)
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

13 files changed:
compiler/cmm/CLabel.hs
compiler/cmm/Cmm.hs
compiler/cmm/CmmUtils.hs
compiler/cmm/PprCmmDecl.hs
compiler/llvmGen/LlvmCodeGen/Data.hs
compiler/nativeGen/PPC/Ppr.hs
compiler/nativeGen/PprBase.hs
compiler/nativeGen/SPARC/Ppr.hs
compiler/nativeGen/X86/Ppr.hs
testsuite/tests/codeGen/should_run/T9577.hs [new file with mode: 0644]
testsuite/tests/codeGen/should_run/T9577.stdout [new file with mode: 0644]
testsuite/tests/codeGen/should_run/T9577_A.hs [new file with mode: 0644]
testsuite/tests/codeGen/should_run/all.T

index 960220f..7317ea4 100644 (file)
@@ -1088,6 +1088,10 @@ pprCLabel platform (DeadStripPreventer lbl)
  | cGhcWithNativeCodeGen == "YES"
    = pprCLabel platform lbl <> text "_dsp"
 
+pprCLabel _ (StringLitLabel u)
+ | cGhcWithNativeCodeGen == "YES"
+  = pprUnique u <> ptext (sLit "_str")
+
 pprCLabel platform lbl
    = getPprStyle $ \ sty ->
      if cGhcWithNativeCodeGen == "YES" && asmStyle sty
@@ -1109,8 +1113,8 @@ pprAsmCLbl _ lbl
    = pprCLbl lbl
 
 pprCLbl :: CLabel -> SDoc
-pprCLbl (StringLitLabel u)
-  = pprUnique u <> text "_str"
+pprCLbl (StringLitLabel _)
+  = panic "pprCLbl StringLitLabel"
 
 pprCLbl (CaseLabel u CaseReturnPt)
   = hcat [pprUnique u, text "_ret"]
index ea9fe93..3195935 100644 (file)
@@ -172,6 +172,7 @@ data SectionType
   | RelocatableReadOnlyData
   | UninitialisedData
   | ReadOnlyData16      -- .rodata.cst16 on x86_64, 16-byte aligned
+  | CString
   | OtherSection String
   deriving (Show)
 
index 241c269..89d824e 100644 (file)
@@ -171,10 +171,13 @@ mkByteStringCLit :: Unique -> [Word8] -> (CmmLit, GenCmmDecl CmmStatics info stm
 -- We have to make a top-level decl for the string,
 -- and return a literal pointing to it
 mkByteStringCLit uniq bytes
-  = (CmmLabel lbl, CmmData sec $ Statics lbl [CmmString bytes])
+  = (CmmLabel lbl, CmmData (Section sec lbl)  $ Statics lbl [CmmString bytes])
   where
     lbl = mkStringLitLabel uniq
-    sec = Section ReadOnlyData lbl
+    -- This can not happen for String literals (as there \NUL is replaced by
+    -- C0 80). However, it can happen with Addr# literals.
+    sec = if 0 `elem` bytes then ReadOnlyData else CString
+
 mkDataLits :: Section -> CLabel -> [CmmLit] -> GenCmmDecl CmmStatics info stmt
 -- Build a data-segment data block
 mkDataLits section lbl lits
index 9364d2b..ce8fb0d 100644 (file)
@@ -170,4 +170,5 @@ pprSectionType s = doubleQuotes (ptext t)
     RelocatableReadOnlyData
                       -> sLit "relreadonly"
     UninitialisedData -> sLit "uninitialised"
+    CString           -> sLit "cstring"
     OtherSection s'   -> sLit s' -- Not actually a literal though.
index 3c1af4f..0f0ca6e 100644 (file)
@@ -59,6 +59,7 @@ isSecConstant (Section t _) = case t of
     ReadOnlyData            -> True
     RelocatableReadOnlyData -> True
     ReadOnlyData16          -> True
+    CString                 -> True
     Data                    -> False
     UninitialisedData       -> False
     (OtherSection _)        -> False
@@ -72,6 +73,7 @@ llvmSectionType t = case t of
     ReadOnlyData16          -> fsLit ".rodata.cst16"
     Data                    -> fsLit ".data"
     UninitialisedData       -> fsLit ".bss"
+    CString                 -> fsLit ".cstring"
     (OtherSection _)        -> panic "llvmSectionType: unknown section type"
 
 -- | Format a Cmm Section into a LLVM section name
index 3dbb76d..f0dd73e 100644 (file)
@@ -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
index 859f68d..e7feb8a 100644 (file)
@@ -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"
index 4eba1c4..35d18b1 100644 (file)
@@ -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.
index e70aa63..6261aad 100644 (file)
@@ -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
diff --git a/testsuite/tests/codeGen/should_run/T9577.hs b/testsuite/tests/codeGen/should_run/T9577.hs
new file mode 100644 (file)
index 0000000..3e90d28
--- /dev/null
@@ -0,0 +1,7 @@
+{-# LANGUAGE MagicHash #-}
+
+import T9577_A
+
+import GHC.Exts (Ptr(..), Addr#)
+
+main = print (foo == Ptr "foo"#)
diff --git a/testsuite/tests/codeGen/should_run/T9577.stdout b/testsuite/tests/codeGen/should_run/T9577.stdout
new file mode 100644 (file)
index 0000000..0ca9514
--- /dev/null
@@ -0,0 +1 @@
+True
diff --git a/testsuite/tests/codeGen/should_run/T9577_A.hs b/testsuite/tests/codeGen/should_run/T9577_A.hs
new file mode 100644 (file)
index 0000000..b4a254f
--- /dev/null
@@ -0,0 +1,8 @@
+{-# LANGUAGE MagicHash #-}
+
+
+module T9577_A where
+
+import GHC.Exts (Ptr(..), Addr#)
+
+foo = Ptr "foo"#
index 8d58222..fb7bdc2 100644 (file)
@@ -148,3 +148,4 @@ test('T12059', normal, compile_and_run, [''])
 test('T12433', normal, compile_and_run, [''])
 test('T12757', normal, compile_and_run, [''])
 test('T12855', normal, compile_and_run, [''])
+test('T9577', [ unless(arch('x86_64') or arch('i386'),skip), only_ways(['normal']) ], compile_and_run, [''])