Implement function-sections for Haskell code, #8405

This adds a flag -split-sections that does similar things to
-split-objs, but using sections in single object files instead of
relying on the Satanic Splitter and other abominations. This is very
similar to the GCC flags -ffunction-sections and -fdata-sections.

The --gc-sections linker flag, which allows unused sections to actually
be removed, is added to all link commands (if the linker supports it) so
that space savings from having base compiled with sections can be
realized.

Supported both in LLVM and the native code-gen, in theory for all
architectures, but really tested on x86 only.

In the GHC build, a new SplitSections variable enables -split-sections
for relevant parts of the build.

Test Plan: validate with both settings of SplitSections

Reviewers: dterei, Phyx, austin, simonmar, thomie, bgamari

Reviewed By: simonmar, thomie, bgamari

Subscribers: hsyl20, erikd, kgardas, thomie

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

GHC Trac Issues: #8405

3 files changed, 35 insertions, 31 deletions

diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index 330d4fae10..a6d3f9484e 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -342,8 +342,8 @@ genSwitch dflags expr targets
 generateJumpTableForInstr :: DynFlags -> Instr
                           -> Maybe (NatCmmDecl CmmStatics Instr)
 generateJumpTableForInstr dflags (JMP_TBL _ ids label) =
-        let jumpTable = map (jumpTableEntry dflags) ids
-        in Just (CmmData ReadOnlyData (Statics label jumpTable))
+  let jumpTable = map (jumpTableEntry dflags) ids
+  in Just (CmmData (Section ReadOnlyData label) (Statics label jumpTable))
 generateJumpTableForInstr _ _ = Nothing
 
 
diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs
index 566cc337b7..a7085588e9 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs
@@ -86,7 +86,7 @@ getRegister (CmmLit (CmmFloat f W32)) = do
 
     let code dst = toOL [
             -- the data area
-            LDATA ReadOnlyData $ Statics lbl
+            LDATA (Section ReadOnlyData lbl) $ Statics lbl
                          [CmmStaticLit (CmmFloat f W32)],
 
             -- load the literal
@@ -99,7 +99,7 @@ getRegister (CmmLit (CmmFloat d W64)) = do
     lbl <- getNewLabelNat
     tmp <- getNewRegNat II32
     let code dst = toOL [
-            LDATA ReadOnlyData $ Statics lbl
+            LDATA (Section ReadOnlyData lbl) $ Statics lbl
                          [CmmStaticLit (CmmFloat d W64)],
             SETHI (HI (ImmCLbl lbl)) tmp,
             LD II64 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs
index b9462dfa19..93beabef10 100644
--- a/compiler/nativeGen/SPARC/Ppr.hs
+++ b/compiler/nativeGen/SPARC/Ppr.hs
@@ -13,7 +13,6 @@
 module SPARC.Ppr (
         pprNatCmmDecl,
         pprBasicBlock,
-        pprSectionHeader,
         pprData,
         pprInstr,
         pprFormat,
@@ -53,7 +52,7 @@ import Data.Word
 
 pprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc
 pprNatCmmDecl (CmmData section dats) =
-  pprSectionHeader section $$ pprDatas dats
+  pprSectionAlign section $$ pprDatas dats
 
 pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
   case topInfoTable proc of
@@ -62,28 +61,31 @@ pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
          []     -> -- special case for split markers:
            pprLabel lbl
          blocks -> -- special case for code without info table:
-           pprSectionHeader Text $$
+           pprSectionAlign (Section Text lbl) $$
            pprLabel lbl $$ -- blocks guaranteed not null, so label needed
            vcat (map (pprBasicBlock top_info) blocks)
 
     Just (Statics info_lbl _) ->
       sdocWithPlatform $ \platform ->
       (if platformHasSubsectionsViaSymbols platform
-          then pprSectionHeader Text $$
+          then pprSectionAlign dspSection $$
                ppr (mkDeadStripPreventer info_lbl) <> char ':'
           else empty) $$
       vcat (map (pprBasicBlock top_info) blocks) $$
-         -- above: Even the first block gets a label, because with branch-chain
-         -- elimination, it might be the target of a goto.
-            (if platformHasSubsectionsViaSymbols platform
-             then
-             -- See Note [Subsections Via Symbols]
-                      text "\t.long "
-                  <+> ppr info_lbl
-                  <+> char '-'
-                  <+> ppr (mkDeadStripPreventer info_lbl)
-             else empty)
-
+      -- above: Even the first block gets a label, because with branch-chain
+      -- elimination, it might be the target of a goto.
+      (if platformHasSubsectionsViaSymbols platform
+       then
+       -- See Note [Subsections Via Symbols]
+                text "\t.long "
+            <+> ppr info_lbl
+            <+> char '-'
+            <+> ppr (mkDeadStripPreventer info_lbl)
+       else empty)
+
+dspSection :: Section
+dspSection = Section Text $
+    panic "subsections-via-symbols doesn't combine with split-sections"
 
 pprBasicBlock :: BlockEnv CmmStatics -> NatBasicBlock Instr -> SDoc
 pprBasicBlock info_env (BasicBlock blockid instrs)
@@ -94,7 +96,7 @@ pprBasicBlock info_env (BasicBlock blockid instrs)
     maybe_infotable = case mapLookup blockid info_env of
        Nothing   -> empty
        Just (Statics info_lbl info) ->
-           pprSectionHeader Text $$
+           pprSectionAlign (Section Text info_lbl) $$
            vcat (map pprData info) $$
            pprLabel info_lbl
 
@@ -320,17 +322,19 @@ pprImm imm
 --      On SPARC all the data sections must be at least 8 byte aligned
 --      incase we store doubles in them.
 --
-pprSectionHeader :: Section -> SDoc
-pprSectionHeader seg = case seg of
-  Text              -> text ".text\n\t.align 4"
-  Data              -> text ".data\n\t.align 8"
-  ReadOnlyData      -> text ".text\n\t.align 8"
-  RelocatableReadOnlyData
-                    -> text ".text\n\t.align 8"
-  UninitialisedData -> text ".bss\n\t.align 8"
-  ReadOnlyData16    -> text ".data\n\t.align 16"
-  OtherSection _    -> panic "PprMach.pprSectionHeader: unknown section"
-
+pprSectionAlign :: Section -> SDoc
+pprSectionAlign sec@(Section seg _) =
+  sdocWithPlatform $ \platform ->
+    pprSectionHeader platform sec $$
+    ptext (case seg of
+      Text              -> sLit ".align 4"
+      Data              -> sLit ".align 8"
+      ReadOnlyData      -> sLit ".align 8"
+      RelocatableReadOnlyData
+                        -> sLit ".align 8"
+      UninitialisedData -> sLit ".align 8"
+      ReadOnlyData16    -> sLit ".align 16"
+      OtherSection _    -> panic "PprMach.pprSectionHeader: unknown section")
 
 -- | Pretty print a data item.
 pprDataItem :: CmmLit -> SDoc