Implement function-sections for Haskell code, #8405wip/D1242

Summary:
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: simonmar, austin, dterei, bgamari

Subscribers: erikd, kgardas, thomie

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

GHC Trac Issues: #8405

34 files changed, 381 insertions, 232 deletions

diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index 9e9bae93c6..d0564e6f68 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -8,7 +8,7 @@ module Cmm (
      CmmGraph, GenCmmGraph(..),
      CmmBlock,
      RawCmmDecl, RawCmmGroup,
-     Section(..), CmmStatics(..), CmmStatic(..),
+     Section(..), SectionType(..), CmmStatics(..), CmmStatic(..),
 
      -- ** Blocks containing lists
      GenBasicBlock(..), blockId,
@@ -48,8 +48,10 @@ import Data.Word        ( Word8 )
 -- A CmmProgram is a list of CmmGroups  
 -- A CmmGroup is a list of top-level declarations  
 
--- When object-splitting is on,each group is compiled into a separate
+-- When object-splitting is on, each group is compiled into a separate
 -- .o file. So typically we put closely related stuff in a CmmGroup.
+-- Section-splitting follows suit and makes one .text subsection for each
+-- CmmGroup.
 
 type CmmProgram = [CmmGroup]
 
@@ -163,7 +165,7 @@ needsSRT (C_SRT _ _ _) = True
 --              Static Data
 -----------------------------------------------------------------------------
 
-data Section
+data SectionType
   = Text
   | Data
   | ReadOnlyData
@@ -171,6 +173,9 @@ data Section
   | UninitialisedData
   | ReadOnlyData16      -- .rodata.cst16 on x86_64, 16-byte aligned
   | OtherSection String
+  deriving (Show)
+
+data Section = Section SectionType CLabel
 
 data CmmStatic
   = CmmStaticLit CmmLit
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index 3bbd06f5c6..dafaea3156 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -148,8 +148,9 @@ addCAF caf srt =
     where last  = next_elt srt
 
 srtToData :: TopSRT -> CmmGroup
-srtToData srt = [CmmData RelocatableReadOnlyData (Statics (lbl srt) tbl)]
+srtToData srt = [CmmData sec (Statics (lbl srt) tbl)]
     where tbl = map (CmmStaticLit . CmmLabel) (reverse (rev_elts srt))
+          sec = Section RelocatableReadOnlyData (lbl srt)
 
 -- Once we have found the CAFs, we need to do two things:
 -- 1. Build a table of all the CAFs used in the procedure.
@@ -223,7 +224,8 @@ to_SRT dflags top_srt off len bmp
   | len > maxBmpSize dflags || bmp == [toStgWord dflags (fromStgHalfWord (srtEscape dflags))]
   = do id <- getUniqueM
        let srt_desc_lbl = mkLargeSRTLabel id
-           tbl = CmmData RelocatableReadOnlyData $
+           section = Section RelocatableReadOnlyData srt_desc_lbl
+           tbl = CmmData section $
                    Statics srt_desc_lbl $ map CmmStaticLit
                      ( cmmLabelOffW dflags top_srt off
                      : mkWordCLit dflags (fromIntegral len)
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index ce8b9f8b6b..86133b662e 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -132,7 +132,7 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl live blocks)
         --
         return (top_decls ++
                 [CmmProc mapEmpty entry_lbl live blocks,
-                 mkDataLits Data info_lbl
+                 mkDataLits (Section Data info_lbl) info_lbl
                     (CmmLabel entry_lbl : rel_std_info ++ rel_extra_bits)])
 
   --
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index ea0f4a5a66..c39c3ecae8 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -382,7 +382,7 @@ cmmdata :: { CmmParse () }
         : 'section' STRING '{' data_label statics '}' 
                 { do lbl <- $4;
                      ss <- sequence $5;
-                     code (emitDecl (CmmData (section $2) (Statics lbl $ concat ss))) }
+                     code (emitDecl (CmmData (Section (section $2) lbl) (Statics lbl $ concat ss))) }
 
 data_label :: { CmmParse CLabel }
     : NAME ':'  
@@ -831,7 +831,7 @@ typenot8 :: { CmmType }
         | 'gcptr'               {% do dflags <- getDynFlags; return $ gcWord dflags }
 
 {
-section :: String -> Section
+section :: String -> SectionType
 section "text"      = Text
 section "data"      = Data
 section "rodata"    = ReadOnlyData
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index 904e19ad99..dca57dca01 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -162,9 +162,10 @@ 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 ReadOnlyData $ Statics lbl [CmmString bytes])
+  = (CmmLabel lbl, CmmData sec $ Statics lbl [CmmString bytes])
   where
     lbl = mkStringLitLabel uniq
+    sec = Section ReadOnlyData lbl
 mkDataLits :: Section -> CLabel -> [CmmLit] -> GenCmmDecl CmmStatics info stmt
 -- Build a data-segment data block
 mkDataLits section lbl lits
@@ -175,8 +176,8 @@ mkRODataLits :: CLabel -> [CmmLit] -> GenCmmDecl CmmStatics info stmt
 mkRODataLits lbl lits
   = mkDataLits section lbl lits
   where
-    section | any needsRelocation lits = RelocatableReadOnlyData
-            | otherwise                = ReadOnlyData
+    section | any needsRelocation lits = Section RelocatableReadOnlyData lbl
+            | otherwise                = Section ReadOnlyData lbl
     needsRelocation (CmmLabel _)      = True
     needsRelocation (CmmLabelOff _ _) = True
     needsRelocation _                 = False
diff --git a/compiler/cmm/PprCmmDecl.hs b/compiler/cmm/PprCmmDecl.hs
index 87cda6a9ad..bf6620f22c 100644
--- a/compiler/cmm/PprCmmDecl.hs
+++ b/compiler/cmm/PprCmmDecl.hs
@@ -154,14 +154,20 @@ pprStatic s = case s of
 -- data sections
 --
 pprSection :: Section -> SDoc
-pprSection s = case s of
-    Text              -> section <+> doubleQuotes (text "text")
-    Data              -> section <+> doubleQuotes (text "data")
-    ReadOnlyData      -> section <+> doubleQuotes (text "readonly")
-    ReadOnlyData16    -> section <+> doubleQuotes (text "readonly16")
-    RelocatableReadOnlyData
-                      -> section <+> doubleQuotes (text "relreadonly")
-    UninitialisedData -> section <+> doubleQuotes (text "uninitialised")
-    OtherSection s'   -> section <+> doubleQuotes (text s')
- where
+pprSection (Section t suffix) =
+  section <+> doubleQuotes (pprSectionType t <+> text "." <+> ppr suffix)
+  where
     section = ptext (sLit "section")
+
+pprSectionType :: SectionType -> SDoc
+pprSectionType s = doubleQuotes (text t)
+ where
+  t = case s of
+    Text              -> "text"
+    Data              -> "data"
+    ReadOnlyData      -> "readonly"
+    ReadOnlyData16    -> "readonly16"
+    RelocatableReadOnlyData
+                      -> "relreadonly"
+    UninitialisedData -> "uninitialised"
+    OtherSection s'   -> s'
diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs
index efc89fe04a..b0dd9b11b8 100644
--- a/compiler/codeGen/StgCmm.hs
+++ b/compiler/codeGen/StgCmm.hs
@@ -194,7 +194,8 @@ mkModuleInit cost_centre_info this_mod hpc_info
         ; initCostCentres cost_centre_info
             -- For backwards compatibility: user code may refer to this
             -- label for calling hs_add_root().
-        ; emitDecl (CmmData Data (Statics (mkPlainModuleInitLabel this_mod) []))
+        ; let lbl = mkPlainModuleInitLabel this_mod
+        ; emitDecl (CmmData (Section Data lbl) (Statics lbl []))
         }
 
 
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index db771c2f9a..c6d673978b 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -306,7 +306,7 @@ baseRegOffset _      reg            = pprPanic "baseRegOffset:" (ppr reg)
 
 emitDataLits :: CLabel -> [CmmLit] -> FCode ()
 -- Emit a data-segment data block
-emitDataLits lbl lits = emitDecl (mkDataLits Data lbl lits)
+emitDataLits lbl lits = emitDecl (mkDataLits (Section Data lbl) lbl lits)
 
 emitRODataLits :: CLabel -> [CmmLit] -> FCode ()
 -- Emit a read-only data block
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index c957fdc571..cbee508834 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -460,6 +460,9 @@ endif
 compiler_stage1_SplitObjs = NO
 compiler_stage2_SplitObjs = NO
 compiler_stage3_SplitObjs = NO
+compiler_stage1_SplitSections = NO
+compiler_stage2_SplitSections = NO
+compiler_stage3_SplitSections = NO
 
 # There are too many symbols in the ghc package for a Windows DLL.
 # We therefore need to split some of the modules off into a separate
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index 5ef0a4bbfa..0cd132ed7f 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -27,7 +27,7 @@ module LlvmCodeGen.Base (
 
         cmmToLlvmType, widthToLlvmFloat, widthToLlvmInt, llvmFunTy,
         llvmFunSig, llvmFunArgs, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign,
-        llvmPtrBits, tysToParams,
+        llvmPtrBits, tysToParams, llvmFunSection,
 
         strCLabel_llvm, strDisplayName_llvm, strProcedureName_llvm,
         getGlobalPtr, generateExternDecls,
@@ -140,6 +140,12 @@ llvmFunAlign dflags = Just (wORD_SIZE dflags)
 llvmInfAlign :: DynFlags -> LMAlign
 llvmInfAlign dflags = Just (wORD_SIZE dflags)
 
+-- | Section to use for a function
+llvmFunSection :: DynFlags -> LMString -> LMSection
+llvmFunSection dflags lbl
+    | gopt Opt_SplitSections dflags = Just (concatFS [fsLit ".text.", lbl])
+    | otherwise                     = Nothing
+
 -- | A Function's arguments
 llvmFunArgs :: DynFlags -> LiveGlobalRegs -> [LlvmVar]
 llvmFunArgs dflags live =
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index 9896c4040a..0a669fcb36 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -145,7 +145,9 @@ getInstrinct2 fname fty@(LMFunction funSig) = do
         return []
       Nothing -> do
         funInsert fname fty
-        return [CmmData Data [([],[fty])]]
+        un <- runUs getUniqueM
+        let lbl = mkAsmTempLabel un
+        return [CmmData (Section Data lbl) [([],[fty])]]
 
     return (fv, nilOL, tops)
 
diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs
index b306748d23..ac93415b06 100644
--- a/compiler/llvmGen/LlvmCodeGen/Data.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Data.hs
@@ -15,6 +15,7 @@ import LlvmCodeGen.Base
 import BlockId
 import CLabel
 import Cmm
+import DynFlags
 
 import FastString
 import Outputable
@@ -36,6 +37,7 @@ genLlvmData :: (Section, CmmStatics) -> LlvmM LlvmData
 genLlvmData (sec, Statics lbl xs) = do
     label <- strCLabel_llvm lbl
     static <- mapM genData xs
+    lmsec <- llvmSection sec
     let types   = map getStatType static
 
         strucTy = LMStruct types
@@ -45,21 +47,44 @@ genLlvmData (sec, Statics lbl xs) = do
         link           = if (externallyVisibleCLabel lbl)
                             then ExternallyVisible else Internal
         const          = if isSecConstant sec then Constant else Global
-        varDef         = LMGlobalVar label tyAlias link Nothing Nothing const
+        varDef         = LMGlobalVar label tyAlias link lmsec Nothing const
         globDef        = LMGlobal varDef struct
 
     return ([globDef], [tyAlias])
 
 -- | Should a data in this section be considered constant
 isSecConstant :: Section -> Bool
-isSecConstant Text                    = True
-isSecConstant ReadOnlyData            = True
-isSecConstant RelocatableReadOnlyData = True
-isSecConstant ReadOnlyData16          = True
-isSecConstant Data                    = False
-isSecConstant UninitialisedData       = False
-isSecConstant (OtherSection _)        = False
-
+isSecConstant (Section t _) = case t of
+    Text                    -> True
+    ReadOnlyData            -> True
+    RelocatableReadOnlyData -> True
+    ReadOnlyData16          -> True
+    Data                    -> False
+    UninitialisedData       -> False
+    (OtherSection _)        -> False
+
+-- Assumes that we only try to use section splitting on platforms with
+-- compatible section naming and toolchain :)
+llvmSectionType :: SectionType -> String
+llvmSectionType t = case t of
+    Text                    -> ".text"
+    ReadOnlyData            -> ".rodata"
+    RelocatableReadOnlyData -> ".data.rel.ro"
+    ReadOnlyData16          -> ".rodata.cst16"
+    Data                    -> ".data"
+    UninitialisedData       -> ".bss"
+    (OtherSection _)        -> panic "llvmSectionType: unknown section type"
+
+llvmSection :: Section -> LlvmM LMSection
+llvmSection (Section t suffix) = do
+  dflags <- getDynFlags
+  let splitSect = gopt Opt_SplitSections dflags
+  if not splitSect
+  then return Nothing
+  else do
+    lmsuffix <- strCLabel_llvm suffix
+    let sectype = llvmSectionType t
+    return (Just (concatFS [fsLit sectype, fsLit ".", lmsuffix]))
 
 -- ----------------------------------------------------------------------------
 -- * Generate static data
diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
index 1a9373bce2..75f841a260 100644
--- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
@@ -114,6 +114,7 @@ pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks))
        dflags <- getDynFlags
        let buildArg = fsLit . showSDoc dflags . ppPlainName
            funArgs = map buildArg (llvmFunArgs dflags live)
+           funSect = llvmFunSection dflags (decName funDec)
 
        -- generate the info table
        prefix <- case mb_info of
@@ -123,7 +124,8 @@ pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks))
                        let infoTy = LMStruct $ map getStatType infoStatics
                        return $ Just $ LMStaticStruc infoStatics infoTy
 
-       let fun = LlvmFunction funDec funArgs llvmStdFunAttrs Nothing
+
+       let fun = LlvmFunction funDec funArgs llvmStdFunAttrs funSect
                               prefix lmblocks
            name = decName $ funcDecl fun
            defName = name `appendFS` fsLit "$def"
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index f8b7c30300..8373f20c73 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1904,6 +1904,10 @@ linkBinary' staticLink dflags o_files dep_packages = do
                           then ["-Wl,-read_only_relocs,suppress"]
                           else [])
 
+                      ++ (if sLdIsGnuLd mySettings
+                          then ["-Wl,--gc-sections"]
+                          else [])
+
                       ++ o_files
                       ++ lib_path_opts)
                       ++ extra_ld_inputs
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 6b44e16c7a..0f07ddff33 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -398,6 +398,7 @@ data GeneralFlag
    | Opt_EagerBlackHoling
    | Opt_NoHsMain
    | Opt_SplitObjs
+   | Opt_SplitSections
    | Opt_StgStats
    | Opt_HideAllPackages
    | Opt_PrintBindResult
@@ -1312,7 +1313,10 @@ wayUnsetGeneralFlags _ WayDyn      = [-- There's no point splitting objects
                                       -- when we're going to be dynamically
                                       -- linking. Plus it breaks compilation
                                       -- on OSX x86.
-                                      Opt_SplitObjs]
+                                      Opt_SplitObjs,
+                                      -- If splitobjs wasn't useful for this,
+                                      -- assume sections aren't either.
+                                      Opt_SplitSections]
 wayUnsetGeneralFlags _ WayProf     = []
 wayUnsetGeneralFlags _ WayEventLog = []
 
@@ -2354,6 +2358,8 @@ dynamic_flags = [
                 then setGeneralFlag Opt_SplitObjs
                 else addWarn "ignoring -fsplit-objs"))
 
+  , defGhcFlag "split-sections"     (NoArg (setGeneralFlag Opt_SplitSections))
+
         -------- ghc -M -----------------------------------------------------
   , defGhcFlag "dep-suffix"               (hasArg addDepSuffix)
   , defGhcFlag "dep-makefile"             (hasArg setDepMakefile)
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index c7cabe6f9a..08e5235cc6 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -1333,7 +1333,7 @@ doCodeGen hsc_env this_mod data_tycons
     -- we generate one SRT for the whole module.
     let
      pipeline_stream
-      | gopt Opt_SplitObjs dflags
+      | gopt Opt_SplitObjs dflags || gopt Opt_SplitSections dflags
         = {-# SCC "cmmPipeline" #-}
           let run_pipeline us cmmgroup = do
                 let (topSRT', us') = initUs us emptySRT
diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs
index b624862191..9f9348aecc 100644
--- a/compiler/main/SysTools.hs
+++ b/compiler/main/SysTools.hs
@@ -796,6 +796,7 @@ getLinkerInfo' dflags = do
           -- GNU ld specifically needs to use less memory. This especially
           -- hurts on small object files. Trac #5240.
           -- Set DT_NEEDED for all shared libraries. Trac #10110.
+          -- TODO: Investigate if these help or hurt when using split sections.
           return (GnuLD $ map Option ["-Wl,--hash-size=31",
                                       "-Wl,--reduce-memory-overheads",
                                       -- ELF specific flag
diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs
index 44c57459a8..7eff740924 100644
--- a/compiler/nativeGen/AsmCodeGen.hs
+++ b/compiler/nativeGen/AsmCodeGen.hs
@@ -372,10 +372,10 @@ cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs
               dbgMap = debugToMap ndbgs
 
           -- Insert split marker, generate native code
-          let splitFlag = gopt Opt_SplitObjs dflags
+          let splitObjs = gopt Opt_SplitObjs dflags
               split_marker = CmmProc mapEmpty mkSplitMarkerLabel [] $
                              ofBlockList (panic "split_marker_entry") []
-              cmms' | splitFlag  = split_marker : cmms
+              cmms' | splitObjs  = split_marker : cmms
                     | otherwise  = cmms
           (ngs',us') <- cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap us
                                       cmms' ngs 0
@@ -385,10 +385,11 @@ cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs
           dumpIfSet_dyn dflags Opt_D_dump_debug "Debug Infos"
             (vcat $ map ppr ldbgs)
 
+          let splitSections = gopt Opt_SplitSections dflags
           -- Emit & clear DWARF information when generating split
           -- object files, as we need it to land in the same object file
           (ngs'', us'') <-
-            if debugFlag && splitFlag
+            if debugFlag && (splitObjs || splitSections)
             then do (dwarf, us'') <- dwarfGen dflags modLoc us ldbgs
                     emitNativeCode dflags h dwarf
                     return (ngs' { ngs_debug = []
diff --git a/compiler/nativeGen/Dwarf.hs b/compiler/nativeGen/Dwarf.hs
index 35ee9c90ab..116fc6e976 100644
--- a/compiler/nativeGen/Dwarf.hs
+++ b/compiler/nativeGen/Dwarf.hs
@@ -84,10 +84,20 @@ dwarfGen df modLoc us blocks = do
 
   -- .aranges section: Information about the bounds of compilation units
   let aranges = dwarfARangesSection $$
-                pprDwarfARange (DwarfARange lowLabel highLabel unitU)
+                pprDwarfARanges (map mkDwarfARange procs) unitU
 
   return (infoSct $$ abbrevSct $$ lineSct $$ frameSct $$ aranges, us'')
 
+-- | Build an address range entry for one proc.
+-- With split sections, each proc needs its own entry, since they may get
+-- scattered in the final binary. Without split sections, we could make a
+-- single arange based on the first/last proc.
+mkDwarfARange :: DebugBlock -> DwarfARange
+mkDwarfARange proc = DwarfARange start end
+  where
+    start = dblCLabel proc
+    end = mkAsmTempEndLabel start
+
 -- | Header for a compilation unit, establishing global format
 -- parameters
 compileUnitHeader :: Unique -> SDoc
diff --git a/compiler/nativeGen/Dwarf/Types.hs b/compiler/nativeGen/Dwarf/Types.hs
index 17fbf3bb95..5130968ca1 100644
--- a/compiler/nativeGen/Dwarf/Types.hs
+++ b/compiler/nativeGen/Dwarf/Types.hs
@@ -5,7 +5,7 @@ module Dwarf.Types
   , pprAbbrevDecls
     -- * Dwarf address range table
   , DwarfARange(..)
-  , pprDwarfARange
+  , pprDwarfARanges
     -- * Dwarf frame
   , DwarfFrame(..), DwarfFrameProc(..), DwarfFrameBlock(..)
   , pprDwarfFrame
@@ -159,14 +159,12 @@ data DwarfARange
   = DwarfARange
     { dwArngStartLabel :: CLabel
     , dwArngEndLabel   :: CLabel
-    , dwArngUnitUnique :: Unique
-      -- ^ from which the corresponding label in @.debug_info@ is derived
     }
 
 -- | Print assembler directives corresponding to a DWARF @.debug_aranges@
 -- address table entry.
-pprDwarfARange :: DwarfARange -> SDoc
-pprDwarfARange arng = sdocWithPlatform $ \plat ->
+pprDwarfARanges :: [DwarfARange] -> Unique -> SDoc
+pprDwarfARanges arngs unitU = sdocWithPlatform $ \plat ->
   let wordSize = platformWordSize plat
       paddingSize = 4 :: Int
       -- header is 12 bytes long.
@@ -174,22 +172,25 @@ pprDwarfARange arng = sdocWithPlatform $ \plat ->
       -- pad such that first entry begins at multiple of entry size.
       pad n = vcat $ replicate n $ pprByte 0
       initialLength = 8 + paddingSize + 2*2*wordSize
-      length = ppr (dwArngEndLabel arng)
-               <> char '-' <> ppr (dwArngStartLabel arng)
   in pprDwWord (ppr initialLength)
      $$ pprHalf 2
-     $$ sectionOffset (ppr $ mkAsmTempLabel $ dwArngUnitUnique arng)
+     $$ sectionOffset (ppr $ mkAsmTempLabel $ unitU)
                       (ptext dwarfInfoLabel)
      $$ pprByte (fromIntegral wordSize)
      $$ pprByte 0
      $$ pad paddingSize
-     -- beginning of body
-     $$ pprWord (ppr $ dwArngStartLabel arng)
-     $$ pprWord length
+     -- body
+     $$ vcat (map pprDwarfARange arngs)
      -- terminus
      $$ pprWord (char '0')
      $$ pprWord (char '0')
 
+pprDwarfARange :: DwarfARange -> SDoc
+pprDwarfARange arng = pprWord (ppr $ dwArngStartLabel arng) $$ pprWord length
+  where
+    length = ppr (dwArngEndLabel arng)
+             <> char '-' <> ppr (dwArngStartLabel arng)
+
 -- | Information about unwind instructions for a procedure. This
 -- corresponds to a "Common Information Entry" (CIE) in DWARF.
 data DwarfFrame
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 6d09c78561..523be6cbdc 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -649,8 +649,8 @@ getRegister' _ (CmmLit (CmmFloat f frep)) = do
     Amode addr addr_code <- getAmode D dynRef
     let format = floatFormat frep
         code dst =
-            LDATA ReadOnlyData (Statics lbl
-                                   [CmmStaticLit (CmmFloat f frep)])
+            LDATA (Section ReadOnlyData lbl)
+                  (Statics lbl [CmmStaticLit (CmmFloat f frep)])
             `consOL` (addr_code `snocOL` LD format dst addr)
     return (Any format code)
 
@@ -671,8 +671,7 @@ getRegister' dflags (CmmLit lit)
        let rep = cmmLitType dflags lit
            format = cmmTypeFormat rep
            code dst =
-            LDATA ReadOnlyData (Statics lbl
-                                   [CmmStaticLit lit])
+            LDATA (Section ReadOnlyData lbl) (Statics lbl [CmmStaticLit lit])
             `consOL` (addr_code `snocOL` LD format dst addr)
        return (Any format code)
 
@@ -1528,7 +1527,7 @@ generateJumpTableForInstr dflags (BCTR ids (Just lbl)) =
                       jumpTableEntryRel (Just blockid)
                         = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
                             where blockLabel = mkAsmTempLabel (getUnique blockid)
-    in Just (CmmData ReadOnlyData (Statics lbl jumpTable))
+    in Just (CmmData (Section ReadOnlyData lbl) (Statics lbl jumpTable))
 generateJumpTableForInstr _ _ = Nothing
 
 -- -----------------------------------------------------------------------------
@@ -1719,7 +1718,7 @@ coerceInt2FP' ArchPPC fromRep toRep x = do
     Amode addr addr_code <- getAmode D dynRef
     let
         code' dst = code `appOL` maybe_exts `appOL` toOL [
-                LDATA ReadOnlyData $ Statics lbl
+                LDATA (Section ReadOnlyData lbl) $ Statics lbl
                                  [CmmStaticLit (CmmInt 0x43300000 W32),
                                   CmmStaticLit (CmmInt 0x80000000 W32)],
                 XORIS itmp src (ImmInt 0x8000),
diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index 6b9150a2d1..f59118ef6e 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -7,18 +7,7 @@
 -----------------------------------------------------------------------------
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-module PPC.Ppr (
-        pprNatCmmDecl,
-        pprBasicBlock,
-        pprSectionHeader,
-        pprData,
-        pprInstr,
-        pprFormat,
-        pprImm,
-        pprDataItem,
-)
-
-where
+module PPC.Ppr (pprNatCmmDecl) where
 
 import PPC.Regs
 import PPC.Instr
@@ -49,7 +38,7 @@ import Data.Bits
 
 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
@@ -59,7 +48,7 @@ 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) $$
            (case platformArch platform of
               ArchPPC_64 ELF_V1 -> pprFunctionDescriptor lbl
               ArchPPC_64 ELF_V2 -> pprFunctionPrologue lbl
@@ -70,20 +59,24 @@ pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph 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"
 
 
 pprFunctionDescriptor :: CLabel -> SDoc
@@ -124,7 +117,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
 
@@ -314,34 +307,35 @@ pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1,
 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
 
 
-pprSectionHeader :: Section -> SDoc
-pprSectionHeader seg =
+pprSectionAlign :: Section -> SDoc
+pprSectionAlign sec@(Section seg _) =
  sdocWithPlatform $ \platform ->
  let osDarwin = platformOS platform == OSDarwin
      ppc64    = not $ target32Bit platform
  in
+ pprSectionHeader platform sec $$
  case seg of
-  Text              -> text ".text\n\t.align 2"
+  Text              -> text ".align 2"
   Data
-   | ppc64          -> text ".data\n.align 3"
-   | otherwise      -> text ".data\n.align 2"
+   | ppc64          -> text ".align 3"
+   | otherwise      -> text ".align 2"
   ReadOnlyData
-   | osDarwin       -> text ".const\n\t.align 2"
-   | ppc64          -> text ".section .rodata\n\t.align 3"
-   | otherwise      -> text ".section .rodata\n\t.align 2"
+   | osDarwin       -> text ".align 2"
+   | ppc64          -> text ".align 3"
+   | otherwise      -> text ".align 2"
   RelocatableReadOnlyData
-   | osDarwin       -> text ".const_data\n\t.align 2"
-   | ppc64          -> text ".data\n\t.align 3"
-   | otherwise      -> text ".data\n\t.align 2"
+   | osDarwin       -> text ".align 2"
+   | ppc64          -> text ".align 3"
+   | otherwise      -> text ".align 2"
   UninitialisedData
-   | osDarwin       -> text ".const_data\n\t.align 2"
-   | ppc64          -> text ".section .bss\n\t.align 3"
-   | otherwise      -> text ".section .bss\n\t.align 2"
+   | osDarwin       -> text ".align 2"
+   | ppc64          -> text ".align 3"
+   | otherwise      -> text ".align 2"
   ReadOnlyData16
-   | osDarwin       -> text ".const\n\t.align 4"
-   | otherwise      -> text ".section .rodata\n\t.align 4"
+   | osDarwin       -> text ".align 4"
+   | otherwise      -> text ".align 4"
   OtherSection _ ->
-      panic "PprMach.pprSectionHeader: unknown section"
+      panic "PprMach.pprSectionAlign: unknown section"
 
 
 pprDataItem :: CmmLit -> SDoc
diff --git a/compiler/nativeGen/PprBase.hs b/compiler/nativeGen/PprBase.hs
index 90a3b303f4..44877d6372 100644
--- a/compiler/nativeGen/PprBase.hs
+++ b/compiler/nativeGen/PprBase.hs
@@ -10,11 +10,18 @@ module PprBase (
         castFloatToWord8Array,
         castDoubleToWord8Array,
         floatToBytes,
-        doubleToBytes
+        doubleToBytes,
+        pprSectionHeader
 )
 
 where
 
+import CLabel
+import Cmm
+import DynFlags
+import Outputable
+import Platform
+
 import qualified Data.Array.Unsafe as U ( castSTUArray )
 import Data.Array.ST
 
@@ -70,3 +77,45 @@ doubleToBytes d
         i7 <- readArray arr 7
         return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7])
      )
+
+-- ----------------------------------------------------------------------------
+-- Printing section headers.
+--
+-- If -split-section was specified, include the suffix label, otherwise just
+-- print the section type. For Darwin, where subsections-for-symbols are
+-- used instead, only print section type.
+
+pprSectionHeader :: Platform -> Section -> SDoc
+pprSectionHeader platform (Section t suffix) =
+ case platformOS platform of
+   OSDarwin -> pprDarwinSectionHeader t
+   _        -> pprGNUSectionHeader t suffix
+
+pprGNUSectionHeader :: SectionType -> CLabel -> SDoc
+pprGNUSectionHeader t suffix = sdocWithDynFlags $ \dflags ->
+  let splitSections = gopt Opt_SplitSections dflags
+      subsection | splitSections = text "." <> ppr suffix
+                 | otherwise     = text "" -- empty doc?
+  in  text ".section " <> text header <> subsection
+  where
+    header = case t of
+      Text -> ".text"
+      Data -> ".data"
+      ReadOnlyData -> ".rodata"
+      RelocatableReadOnlyData -> ".data.rel.ro"
+      UninitialisedData -> ".bss"
+      ReadOnlyData16 -> ".rodata.cst16"
+      OtherSection _ ->
+        panic "PprBase.pprGNUSectionHeader: unknown section type"
+
+pprDarwinSectionHeader :: SectionType -> SDoc
+pprDarwinSectionHeader t =
+  text $ case t of
+     Text -> ".text"
+     Data -> ".data"
+     ReadOnlyData -> ".const"
+     RelocatableReadOnlyData -> ".const_data"
+     UninitialisedData -> ".data"
+     ReadOnlyData16 -> ".const"
+     OtherSection _ ->
+       panic "PprBase.pprDarwinSectionHeader: unknown section type"
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index b009ae33c0..39bf4de096 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -341,8 +341,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..d44bb83187 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 $$
+    case seg of
+      Text              -> text ".align 4"
+      Data              -> text ".align 8"
+      ReadOnlyData      -> text ".align 8"
+      RelocatableReadOnlyData
+                        -> text ".align 8"
+      UninitialisedData -> text ".align 8"
+      ReadOnlyData16    -> text ".align 16"
+      OtherSection _    -> panic "PprMach.pprSectionHeader: unknown section"
 
 -- | Pretty print a data item.
 pprDataItem :: CmmLit -> SDoc
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 26df11cd73..efbf9b7a1a 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -1223,6 +1223,7 @@ isOperand _ _            = False
 memConstant :: Int -> CmmLit -> NatM Amode
 memConstant align lit = do
   lbl <- getNewLabelNat
+  let rosection = Section ReadOnlyData lbl
   dflags <- getDynFlags
   (addr, addr_code) <- if target32Bit (targetPlatform dflags)
                        then do dynRef <- cmmMakeDynamicReference
@@ -1233,7 +1234,7 @@ memConstant align lit = do
                                return (addr, addr_code)
                        else return (ripRel (ImmCLbl lbl), nilOL)
   let code =
-        LDATA ReadOnlyData (align, Statics lbl [CmmStaticLit lit])
+        LDATA rosection (align, Statics lbl [CmmStaticLit lit])
         `consOL` addr_code
   return (Amode addr code)
 
@@ -2593,50 +2594,48 @@ genSwitch dflags expr targets
         (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset)
         lbl <- getNewLabelNat
         dflags <- getDynFlags
+        let is32bit = target32Bit (targetPlatform dflags)
+            os = platformOS (targetPlatform dflags)
+            -- Might want to use .rodata.<function we're in> instead, but as
+            -- long as it's something unique it'll work out since the
+            -- references to the jump table are in the appropriate section.
+            rosection = case os of
+              -- on Mac OS X/x86_64, put the jump table in the text section to
+              -- work around a limitation of the linker.
+              -- ld64 is unable to handle the relocations for
+              --     .quad L1 - L0
+              -- if L0 is not preceded by a non-anonymous label in its section.
+              OSDarwin | not is32bit -> Section Text lbl
+              _ -> Section ReadOnlyData lbl
         dynRef <- cmmMakeDynamicReference dflags DataReference lbl
         (tableReg,t_code) <- getSomeReg $ dynRef
         let op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
                                        (EAIndex reg (wORD_SIZE dflags)) (ImmInt 0))
 
-        return $ if target32Bit (targetPlatform dflags)
+        return $ if is32bit || os == OSDarwin
                  then e_code `appOL` t_code `appOL` toOL [
                                 ADD (intFormat (wordWidth dflags)) op (OpReg tableReg),
-                                JMP_TBL (OpReg tableReg) ids ReadOnlyData lbl
+                                JMP_TBL (OpReg tableReg) ids rosection lbl
+                       ]
+                 else -- HACK: On x86_64 binutils<2.17 is only able to generate
+                      -- PC32 relocations, hence we only get 32-bit offsets in
+                      -- the jump table. As these offsets are always negative
+                      -- we need to properly sign extend them to 64-bit. This
+                      -- hack should be removed in conjunction with the hack in
+                      -- PprMach.hs/pprDataItem once binutils 2.17 is standard.
+                      e_code `appOL` t_code `appOL` toOL [
+                               MOVSxL II32 op (OpReg reg),
+                               ADD (intFormat (wordWidth dflags)) (OpReg reg)
+                                   (OpReg tableReg),
+                               JMP_TBL (OpReg tableReg) ids rosection lbl
                        ]
-                 else case platformOS (targetPlatform dflags) of
-                      OSDarwin ->
-                          -- on Mac OS X/x86_64, put the jump table
-                          -- in the text section to work around a
-                          -- limitation of the linker.
-                          -- ld64 is unable to handle the relocations for
-                          --     .quad L1 - L0
-                          -- if L0 is not preceded by a non-anonymous
-                          -- label in its section.
-                          e_code `appOL` t_code `appOL` toOL [
-                                   ADD (intFormat (wordWidth dflags)) op (OpReg tableReg),
-                                   JMP_TBL (OpReg tableReg) ids Text lbl
-                           ]
-                      _ ->
-                          -- HACK: On x86_64 binutils<2.17 is only able
-                          -- to generate PC32 relocations, hence we only
-                          -- get 32-bit offsets in the jump table. As
-                          -- these offsets are always negative we need
-                          -- to properly sign extend them to 64-bit.
-                          -- This hack should be removed in conjunction
-                          -- with the hack in PprMach.hs/pprDataItem
-                          -- once binutils 2.17 is standard.
-                          e_code `appOL` t_code `appOL` toOL [
-                                   MOVSxL II32 op (OpReg reg),
-                                   ADD (intFormat (wordWidth dflags)) (OpReg reg) (OpReg tableReg),
-                                   JMP_TBL (OpReg tableReg) ids ReadOnlyData lbl
-                           ]
   | otherwise
   = do
         (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset)
         lbl <- getNewLabelNat
         let op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg (wORD_SIZE dflags)) (ImmCLbl lbl))
             code = e_code `appOL` toOL [
-                    JMP_TBL op ids ReadOnlyData lbl
+                    JMP_TBL op ids (Section ReadOnlyData lbl) lbl
                  ]
         return code
   where (offset, ids) = switchTargetsToTable targets
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index ce63caed6b..5fd68a5bda 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -11,8 +11,6 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module X86.Ppr (
         pprNatCmmDecl,
-        pprBasicBlock,
-        pprSectionHeader,
         pprData,
         pprInstr,
         pprFormat,
@@ -53,7 +51,7 @@ import Data.Bits
 
 pprNatCmmDecl :: NatCmmDecl (Alignment, CmmStatics) Instr -> SDoc
 pprNatCmmDecl (CmmData section dats) =
-  pprSectionHeader section $$ pprDatas dats
+  pprSectionAlign section $$ pprDatas dats
 
 pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
   sdocWithDynFlags $ \dflags ->
@@ -63,7 +61,7 @@ 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) $$
            (if gopt Opt_Debug dflags
@@ -72,32 +70,35 @@ pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
 
     Just (Statics info_lbl _) ->
       sdocWithPlatform $ \platform ->
+      pprSectionAlign (Section Text info_lbl) $$
       (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) $$
       (if gopt Opt_Debug dflags
        then ppr (mkAsmTempEndLabel info_lbl) <> char ':' else empty) $$
       pprSizeDecl info_lbl
 
+dspSection :: Section
+dspSection = Section Text $
+    panic "subsections-via-symbols doesn't combine with split-sections"
+
 -- | Output the ELF .size directive.
 pprSizeDecl :: CLabel -> SDoc
 pprSizeDecl lbl
  = sdocWithPlatform $ \platform ->
    if osElfTarget (platformOS platform)
-   then ptext (sLit "\t.size") <+> ppr lbl
-     <> ptext (sLit ", .-") <> ppr lbl
+   then ptext (sLit "\t.size") <+> ppr lbl <> ptext (sLit ", .-") <> ppr lbl
    else empty
 
 pprBasicBlock :: BlockEnv CmmStatics -> NatBasicBlock Instr -> SDoc
@@ -113,7 +114,6 @@ pprBasicBlock info_env (BasicBlock blockid instrs)
     maybe_infotable = case mapLookup blockid info_env of
        Nothing   -> empty
        Just (Statics info_lbl info) ->
-           pprSectionHeader Text $$
            infoTableLoc $$
            vcat (map pprData info) $$
            pprLabel info_lbl
@@ -384,56 +384,34 @@ pprAddr (AddrBaseIndex base index displacement)
     ppr_disp (ImmInt 0) = empty
     ppr_disp imm        = pprImm imm
 
-
-pprSectionHeader :: Section -> SDoc
-pprSectionHeader seg =
- sdocWithPlatform $ \platform ->
- case platformOS platform of
- OSDarwin
-  | target32Bit platform ->
-     case seg of
-      Text              -> text ".text\n\t.align 2"
-      Data              -> text ".data\n\t.align 2"
-      ReadOnlyData      -> text ".const\n\t.align 2"
-      RelocatableReadOnlyData
-                        -> text ".const_data\n\t.align 2"
-      UninitialisedData -> text ".data\n\t.align 2"
-      ReadOnlyData16    -> text ".const\n\t.align 4"
-      OtherSection _    -> panic "X86.Ppr.pprSectionHeader: unknown section"
-  | otherwise ->
-     case seg of
-      Text              -> text ".text\n\t.align 3"
-      Data              -> text ".data\n\t.align 3"
-      ReadOnlyData      -> text ".const\n\t.align 3"
-      RelocatableReadOnlyData
-                        -> text ".const_data\n\t.align 3"
-      UninitialisedData -> text ".data\n\t.align 3"
-      ReadOnlyData16    -> text ".const\n\t.align 4"
-      OtherSection _    -> panic "PprMach.pprSectionHeader: unknown section"
- _
-  | target32Bit platform ->
-     case seg of
-      Text              -> text ".text\n\t.align 4,0x90"
-      Data              -> text ".data\n\t.align 4"
-      ReadOnlyData      -> text ".section .rodata\n\t.align 4"
-      RelocatableReadOnlyData
-                        -> text ".section .data\n\t.align 4"
-      UninitialisedData -> text ".section .bss\n\t.align 4"
-      ReadOnlyData16    -> text ".section .rodata\n\t.align 16"
-      OtherSection _    -> panic "X86.Ppr.pprSectionHeader: unknown section"
-  | otherwise ->
-     case seg of
-      Text              -> text ".text\n\t.align 8"
-      Data              -> text ".data\n\t.align 8"
-      ReadOnlyData      -> text ".section .rodata\n\t.align 8"
-      RelocatableReadOnlyData
-                        -> text ".section .data\n\t.align 8"
-      UninitialisedData -> text ".section .bss\n\t.align 8"
-      ReadOnlyData16    -> text ".section .rodata.cst16\n\t.align 16"
-      OtherSection _    -> panic "PprMach.pprSectionHeader: unknown section"
-
-
-
+-- | Print section header and appropriate alignment for that section.
+pprSectionAlign :: Section -> SDoc
+pprSectionAlign (Section (OtherSection _) _) =
+     panic "X86.Ppr.pprSectionAlign: unknown section"
+pprSectionAlign sec@(Section seg _) =
+  sdocWithPlatform $ \platform ->
+    pprSectionHeader platform sec $$
+    text ".align " <>
+    case platformOS platform of
+      OSDarwin
+       | target32Bit platform ->
+          case seg of
+           ReadOnlyData16    -> int 4
+           _                 -> int 2
+       | otherwise ->
+          case seg of
+           ReadOnlyData16    -> int 4
+           _                 -> int 3
+      _
+       | target32Bit platform ->
+          case seg of
+           Text              -> text "4,0x90"
+           ReadOnlyData16    -> int 16
+           _                 -> int 4
+       | otherwise ->
+          case seg of
+           ReadOnlyData16    -> int 16
+           _                 -> int 8
 
 pprDataItem :: CmmLit -> SDoc
 pprDataItem lit = sdocWithDynFlags $ \dflags -> pprDataItem' dflags lit
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index 24917af252..adf98dd5d7 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -2770,6 +2770,12 @@
             <entry>-</entry>
           </row>
           <row>
+            <entry><option>-split-sections</option></entry>
+            <entry>Split sections</entry>
+            <entry>dynamic</entry>
+            <entry>-</entry>
+          </row>
+          <row>
             <entry><option>-static</option></entry>
             <entry>Use static Haskell libraries</entry>
             <entry>dynamic</entry>
diff --git a/docs/users_guide/phases.xml b/docs/users_guide/phases.xml
index eefef55d79..72bbdad048 100644
--- a/docs/users_guide/phases.xml
+++ b/docs/users_guide/phases.xml
@@ -902,6 +902,25 @@ $ cat foo.hspp</screen>
 
       <varlistentry>
         <term>
+          <option>-split-sections</option>
+          <indexterm><primary><option>-split-sections</option></primary></indexterm>
+        </term>
+        <listitem>
+          <para>Place each generated function or data item into its own section
+          in the output file if the target supports arbitrary sections. The
+          name of the function or the name of the data item determines the
+          section's name in the output file.</para>
+
+          <para>When linking, the linker can automatically remove all
+          unreferenced sections and thus produce smaller executables. The
+          effect is similar to -split-objs, but somewhat more efficient - the
+          generated library files are about 30% smaller than with
+          -split-objs.</para>
+        </listitem>
+      </varlistentry>
+
+      <varlistentry>
+        <term>
           <option>-static</option>
           <indexterm><primary><option>-static</option></primary></indexterm>
         </term>
diff --git a/mk/config.mk.in b/mk/config.mk.in
index 1b46ed73f7..256c0b4b6e 100644
--- a/mk/config.mk.in
+++ b/mk/config.mk.in
@@ -302,6 +302,17 @@ SupportsSplitObjs := $(strip \
 SplitObjs=$(SupportsSplitObjs)
 
 # ----------------------------------------------------------------------------
+# Section splitting
+#
+# Similar to -ffunction-sections -fdata-sections in GCC. Provides space saving
+# like SplitObjs, but doesn't require post-processing and splitting of object
+# files.
+#
+# Set SplitSections=YES in your build.mk to enable.
+
+SplitSections=NO
+
+# ----------------------------------------------------------------------------
 
 # There are a number of things which technically depend on GHC (e.g. if
 # ghc changes then Haskell files may be compiled differently, or Cabal
diff --git a/rts/ghc.mk b/rts/ghc.mk
index 84f1b761b9..00e20b8734 100644
--- a/rts/ghc.mk
+++ b/rts/ghc.mk
@@ -321,6 +321,10 @@ ifeq "$(BeConservative)" "YES"
 rts_CC_OPTS += -DBE_CONSERVATIVE
 endif
 
+ifeq "$(SplitSections)" "YES"
+rts_CC_OPTS += -ffunction-sections -fdata-sections
+endif
+
 #-----------------------------------------------------------------------------
 # Flags for compiling specific files
 rts/RtsMessages_CC_OPTS += -DProjectVersion=\"$(ProjectVersion)\"
diff --git a/rules/build-package.mk b/rules/build-package.mk
index f05f230c10..bd6cfcb9ee 100644
--- a/rules/build-package.mk
+++ b/rules/build-package.mk
@@ -110,6 +110,15 @@ else
 $1_$2_SplitObjs = NO
 endif
 endif
+# Disable split sections when building with stage0, it won't be supported yet
+# and it's probably not very relevant anyway (smaller stage1 ghc?).
+ifeq "$$($1_$2_SplitSections)" ""
+ifeq "$3" "1"
+$1_$2_SplitSections = $(SplitSections)
+else
+$1_$2_SplitSections = NO
+endif
+endif
 
 $(call hs-sources,$1,$2)
 $(call c-sources,$1,$2)
diff --git a/rules/distdir-way-opts.mk b/rules/distdir-way-opts.mk
index 7a4115cdd9..c29b175953 100644
--- a/rules/distdir-way-opts.mk
+++ b/rules/distdir-way-opts.mk
@@ -136,6 +136,7 @@ $1_$2_$3_ALL_HC_OPTS = \
  -hisuf $$($3_hisuf) -osuf  $$($3_osuf) -hcsuf $$($3_hcsuf) \
  $$($1_$2_$3_MOST_DIR_HC_OPTS) \
  $$(if $$(findstring YES,$$($1_$2_SplitObjs)),$$(if $$(findstring dyn,$3),,-split-objs),) \
+ $$(if $$(findstring YES,$$($1_$2_SplitSections)),$$(if $$(findstring dyn,$3),,-split-sections),) \
  $$(if $$(findstring YES,$$($1_$2_DYNAMIC_TOO)),$$(if $$(findstring v,$3),-dynamic-too))
 
 ifeq "$3" "dyn"