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

36 files changed, 413 insertions, 247 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 723f7fc4cc..b9981f247b 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -133,7 +133,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 11e68bd4e1..8aa3a79bc8 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -385,7 +385,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 ':'  
@@ -834,7 +834,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..830f536891 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 <+> char '.' <+> ppr suffix)
+  where
     section = ptext (sLit "section")
+
+pprSectionType :: SectionType -> SDoc
+pprSectionType s = doubleQuotes (ptext t)
+ where
+  t = case s of
+    Text              -> sLit "text"
+    Data              -> sLit "data"
+    ReadOnlyData      -> sLit "readonly"
+    ReadOnlyData16    -> sLit "readonly16"
+    RelocatableReadOnlyData
+                      -> sLit "relreadonly"
+    UninitialisedData -> sLit "uninitialised"
+    OtherSection s'   -> sLit s' -- Not actually a literal though.
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 ccfab85a5a..b4dd869039 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 e3ea52acec..887a876b56 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -462,6 +462,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 7a673b8ec3..3367cdaf45 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -26,7 +26,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 aa3a0c3f1e..fb79a9d973 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -144,7 +144,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..3c1af4f587 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,43 @@ 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
+
+-- | Format the section type part of a Cmm Section
+llvmSectionType :: SectionType -> FastString
+llvmSectionType t = case t of
+    Text                    -> fsLit ".text"
+    ReadOnlyData            -> fsLit ".rodata"
+    RelocatableReadOnlyData -> fsLit ".data.rel.ro"
+    ReadOnlyData16          -> fsLit ".rodata.cst16"
+    Data                    -> fsLit ".data"
+    UninitialisedData       -> fsLit ".bss"
+    (OtherSection _)        -> panic "llvmSectionType: unknown section type"
+
+-- | Format a Cmm Section into a LLVM section name
+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
+    return (Just (concatFS [llvmSectionType t, fsLit ".", lmsuffix]))
 
 -- ----------------------------------------------------------------------------
 -- * Generate static data
diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
index d7ddf804f2..1de630ef10 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 33770b92f6..a1d36a6b54 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1908,6 +1908,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 b8705603c7..39f4a0487f 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -391,6 +391,7 @@ data GeneralFlag
    | Opt_EagerBlackHoling
    | Opt_NoHsMain
    | Opt_SplitObjs
+   | Opt_SplitSections
    | Opt_StgStats
    | Opt_HideAllPackages
    | Opt_PrintBindResult
@@ -1283,7 +1284,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 = []
 
@@ -2326,6 +2330,15 @@ dynamic_flags = [
                 then setGeneralFlag Opt_SplitObjs
                 else addWarn "ignoring -fsplit-objs"))
 
+  , defGhcFlag "split-sections"
+      (noArgM (\dflags -> do
+        if platformHasSubsectionsViaSymbols (targetPlatform dflags)
+          then do addErr $
+                    "-split-sections is not useful on this platform " ++
+                    "since it always uses subsections via symbols."
+                  return dflags
+          else return (gopt_set dflags 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 53c6f626e5..a6d263781c 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -1434,7 +1434,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 879b035d03..303e8dee90 100644
--- a/compiler/main/SysTools.hs
+++ b/compiler/main/SysTools.hs
@@ -791,6 +791,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 1b57a504bd..b3988026be 100644
--- a/compiler/nativeGen/AsmCodeGen.hs
+++ b/compiler/nativeGen/AsmCodeGen.hs
@@ -373,10 +373,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
@@ -388,8 +388,10 @@ cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs
 
           -- Emit & clear DWARF information when generating split
           -- object files, as we need it to land in the same object file
+          -- When using split sections, note that we do not split the debug
+          -- info but emit all the info at once in finishNativeGen.
           (ngs'', us'') <-
-            if debugFlag && splitFlag
+            if debugFlag && splitObjs
             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..6bf49f0e0d 100644
--- a/compiler/nativeGen/Dwarf.hs
+++ b/compiler/nativeGen/Dwarf.hs
@@ -83,11 +83,22 @@ dwarfGen df modLoc us blocks = do
                  pprDwarfFrame (debugFrame framesU procs)
 
   -- .aranges section: Information about the bounds of compilation units
-  let aranges = dwarfARangesSection $$
-                pprDwarfARange (DwarfARange lowLabel highLabel unitU)
+  let aranges' | gopt Opt_SplitSections df = map mkDwarfARange procs
+               | otherwise                 = [DwarfARange lowLabel highLabel]
+  let aranges = dwarfARangesSection $$ pprDwarfARanges aranges' 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 abded88468..8647253c26 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 e2d86a93aa..56025f44ac 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -650,8 +650,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)
 
@@ -672,8 +672,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)
 
@@ -1530,7 +1529,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
 
 -- -----------------------------------------------------------------------------
@@ -1721,7 +1720,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 99f9ab77ea..0fbce8ccd9 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
@@ -69,22 +58,21 @@ 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 $$
-               ppr (mkDeadStripPreventer info_lbl) <> char ':'
+          then 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)
 
 pprFunctionDescriptor :: CLabel -> SDoc
 pprFunctionDescriptor lab = pprGloblDecl lab
@@ -124,7 +112,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,35 +302,33 @@ 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
- case seg of
-  Text              -> text ".text\n\t.align 2"
-  Data
-   | ppc64          -> text ".data\n.align 3"
-   | otherwise      -> text ".data\n.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"
-  RelocatableReadOnlyData
-   | osDarwin       -> text ".const_data\n\t.align 2"
-   | ppc64          -> text ".data\n\t.align 3"
-   | otherwise      -> text ".data\n\t.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"
-  ReadOnlyData16
-   | osDarwin       -> text ".const\n\t.align 4"
-   | otherwise      -> text ".section .rodata\n\t.align 4"
-  OtherSection _ ->
-      panic "PprMach.pprSectionHeader: unknown section"
-
+     align    = ptext $ case seg of
+       Text              -> sLit ".align 2"
+       Data
+        | ppc64          -> sLit ".align 3"
+        | otherwise      -> sLit ".align 2"
+       ReadOnlyData
+        | osDarwin       -> sLit ".align 2"
+        | ppc64          -> sLit ".align 3"
+        | otherwise      -> sLit ".align 2"
+       RelocatableReadOnlyData
+        | osDarwin       -> sLit ".align 2"
+        | ppc64          -> sLit ".align 3"
+        | otherwise      -> sLit ".align 2"
+       UninitialisedData
+        | osDarwin       -> sLit ".align 2"
+        | ppc64          -> sLit ".align 3"
+        | otherwise      -> sLit ".align 2"
+       ReadOnlyData16
+        | osDarwin       -> sLit ".align 4"
+        | otherwise      -> sLit ".align 4"
+       OtherSection _    -> panic "PprMach.pprSectionAlign: unknown section"
+ in pprSectionHeader platform sec $$ align
 
 pprDataItem :: CmmLit -> SDoc
 pprDataItem lit
diff --git a/compiler/nativeGen/PprBase.hs b/compiler/nativeGen/PprBase.hs
index 90a3b303f4..b2e574af4c 100644
--- a/compiler/nativeGen/PprBase.hs
+++ b/compiler/nativeGen/PprBase.hs
@@ -10,11 +10,19 @@ module PprBase (
         castFloatToWord8Array,
         castDoubleToWord8Array,
         floatToBytes,
-        doubleToBytes
+        doubleToBytes,
+        pprSectionHeader
 )
 
 where
 
+import CLabel
+import Cmm
+import DynFlags
+import FastString
+import Outputable
+import Platform
+
 import qualified Data.Array.Unsafe as U ( castSTUArray )
 import Data.Array.ST
 
@@ -70,3 +78,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 = char '.' <> ppr suffix
+                 | otherwise     = empty
+  in  ptext (sLit ".section ") <> ptext header <> subsection
+  where
+    header = case t of
+      Text -> sLit ".text"
+      Data -> sLit ".data"
+      ReadOnlyData -> sLit ".rodata"
+      RelocatableReadOnlyData -> sLit ".data.rel.ro"
+      UninitialisedData -> sLit ".bss"
+      ReadOnlyData16 -> sLit ".rodata.cst16"
+      OtherSection _ ->
+        panic "PprBase.pprGNUSectionHeader: unknown section type"
+
+pprDarwinSectionHeader :: SectionType -> SDoc
+pprDarwinSectionHeader t =
+  ptext $ case t of
+     Text -> sLit ".text"
+     Data -> sLit ".data"
+     ReadOnlyData -> sLit ".const"
+     RelocatableReadOnlyData -> sLit ".const_data"
+     UninitialisedData -> sLit ".data"
+     ReadOnlyData16 -> sLit ".const"
+     OtherSection _ ->
+       panic "PprBase.pprDarwinSectionHeader: unknown section type"
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
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 30ecc2db8b..2d22734378 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -1224,6 +1224,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
@@ -1234,7 +1235,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)
 
@@ -2599,50 +2600,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 0c9507ab28..1a1fd86c00 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,21 +70,20 @@ 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 $$
-               ppr (mkDeadStripPreventer info_lbl) <> char ':'
+          then 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
@@ -96,8 +93,7 @@ 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 +109,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 +379,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 $$
+    ptext (sLit ".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              -> ptext (sLit "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/phases.rst b/docs/users_guide/phases.rst
index 8945e3bbe7..27b54cb0a8 100644
--- a/docs/users_guide/phases.rst
+++ b/docs/users_guide/phases.rst
@@ -613,6 +613,20 @@ for example).
     the library itself (the ``.a`` file) can be a factor of 2 to 2.5
     larger. We use this feature for building GHC's libraries.
 
+``-split-sections``
+    .. index::
+       single: -split-sections
+
+    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.
+
+    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``.
+
 ``-static``
     .. index::
        single: -static
diff --git a/driver/utils/merge_sections.ld b/driver/utils/merge_sections.ld
new file mode 100644
index 0000000000..8c82ca09b5
--- /dev/null
+++ b/driver/utils/merge_sections.ld
@@ -0,0 +1,26 @@
+/* Linker script to undo -split-sections and merge all sections together when
+ * linking relocatable object files for GHCi.
+ * ld -r normally retains the individual sections, which is what you would want
+ * if the intention is to eventually link into a binary with --gc-sections, but
+ * it doesn't have a flag for directly doing what we want. */
+SECTIONS
+{
+    .text : {
+        *(.text*)
+    }
+    .rodata.cst16 : {
+        *(.rodata.cst16*)
+    }
+    .rodata : {
+        *(.rodata*)
+    }
+    .data.rel.ro : {
+        *(.data.rel.ro*)
+    }
+    .data : {
+        *(.data*)
+    }
+    .bss : {
+        *(.bss*)
+    }
+}
diff --git a/mk/config.mk.in b/mk/config.mk.in
index 0a9f92b64d..035443a5fd 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 c7c5e75831..1f5f996906 100644
--- a/rts/ghc.mk
+++ b/rts/ghc.mk
@@ -334,6 +334,10 @@ ifeq "$$(TargetOS_CPP)" "mingw32"
 rts_CC_OPTS += -DWINVER=$(rts_WINVER)
 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-way.mk b/rules/build-package-way.mk
index a10e53833e..d048f74b95 100644
--- a/rules/build-package-way.mk
+++ b/rules/build-package-way.mk
@@ -136,6 +136,8 @@ BINDIST_LIBS += $$($1_$2_$3_LIB)
 BINDIST_LIBS += $$($1_$2_$3_LIB0)
 endif
 
+$1_$2_LD_SCRIPT = driver/utils/merge_sections.ld
+
 # Build the GHCi library
 ifeq "$$(DYNAMIC_GHC_PROGRAMS)" "YES"
 $1_$2_GHCI_LIB = $$($1_$2_dyn_LIB)
@@ -148,8 +150,8 @@ ifneq "$4" "0"
 BINDIST_LIBS += $$($1_$2_GHCI_LIB)
 endif
 endif
-$$($1_$2_GHCI_LIB) : $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS)
-	$$(call cmd,LD) $$(CONF_LD_LINKER_OPTS_STAGE$4) -r -o $$@ $$(EXTRA_LD_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS)
+$$($1_$2_GHCI_LIB) : $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) $$($1_$2_LD_SCRIPT)
+	$$(call cmd,LD) $$(CONF_LD_LINKER_OPTS_STAGE$4) -r $(if $(filter YES,$(LdIsGNULd)),-T $$($1_$2_LD_SCRIPT)) -o $$@ $$(EXTRA_LD_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS)
 
 ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES"
 # Don't bother making ghci libs for bootstrapping packages
diff --git a/rules/build-package.mk b/rules/build-package.mk
index 688e1d2ca5..9599c57eb3 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 920ff07f20..47f6f90237 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"
diff --git a/utils/mkUserGuidePart/Options/Linking.hs b/utils/mkUserGuidePart/Options/Linking.hs
index cc42db80ff..14c4783585 100644
--- a/utils/mkUserGuidePart/Options/Linking.hs
+++ b/utils/mkUserGuidePart/Options/Linking.hs
@@ -105,6 +105,10 @@ linkingOptions =
          , flagDescription = "Split objects (for libraries)"
          , flagType = DynamicFlag
          }
+  , flag { flagName = "-split-sections"
+         , flagDescription = "Split sections for link-time dead-code stripping"
+         , flagType = DynamicFlag
+         }
   , flag { flagName = "-static"
          , flagDescription = "Use static Haskell libraries"
          , flagType = DynamicFlag