Implement function-sections for Haskell code, #8405
authorSimon Brenner <olsner@gmail.com>
Thu, 12 Nov 2015 10:10:54 +0000 (11:10 +0100)
committerBen Gamari <ben@smart-cactus.org>
Thu, 12 Nov 2015 10:10:54 +0000 (11:10 +0100)
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:
compiler/cmm/Cmm.hs
compiler/cmm/CmmBuildInfoTables.hs
compiler/cmm/CmmInfo.hs
compiler/cmm/CmmParse.y
compiler/cmm/CmmUtils.hs
compiler/cmm/PprCmmDecl.hs
compiler/codeGen/StgCmm.hs
compiler/codeGen/StgCmmUtils.hs
compiler/ghc.mk
compiler/llvmGen/LlvmCodeGen/Base.hs
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
compiler/llvmGen/LlvmCodeGen/Data.hs
compiler/llvmGen/LlvmCodeGen/Ppr.hs
compiler/main/DriverPipeline.hs
compiler/main/DynFlags.hs
compiler/main/HscMain.hs
compiler/main/SysTools.hs
compiler/nativeGen/AsmCodeGen.hs
compiler/nativeGen/Dwarf.hs
compiler/nativeGen/Dwarf/Types.hs
compiler/nativeGen/PPC/CodeGen.hs
compiler/nativeGen/PPC/Ppr.hs
compiler/nativeGen/PprBase.hs
compiler/nativeGen/SPARC/CodeGen.hs
compiler/nativeGen/SPARC/CodeGen/Gen32.hs
compiler/nativeGen/SPARC/Ppr.hs
compiler/nativeGen/X86/CodeGen.hs
compiler/nativeGen/X86/Ppr.hs
docs/users_guide/phases.rst
driver/utils/merge_sections.ld [new file with mode: 0644]
mk/config.mk.in
rts/ghc.mk
rules/build-package-way.mk
rules/build-package.mk
rules/distdir-way-opts.mk
utils/mkUserGuidePart/Options/Linking.hs

index 9e9bae9..d0564e6 100644 (file)
@@ -8,7 +8,7 @@ module Cmm (
      CmmGraph, GenCmmGraph(..),
      CmmBlock,
      RawCmmDecl, RawCmmGroup,
      CmmGraph, GenCmmGraph(..),
      CmmBlock,
      RawCmmDecl, RawCmmGroup,
-     Section(..), CmmStatics(..), CmmStatic(..),
+     Section(..), SectionType(..), CmmStatics(..), CmmStatic(..),
 
      -- ** Blocks containing lists
      GenBasicBlock(..), blockId,
 
      -- ** 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  
 
 -- 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.
 -- .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]
 
 
 type CmmProgram = [CmmGroup]
 
@@ -163,7 +165,7 @@ needsSRT (C_SRT _ _ _) = True
 --              Static Data
 -----------------------------------------------------------------------------
 
 --              Static Data
 -----------------------------------------------------------------------------
 
-data Section
+data SectionType
   = Text
   | Data
   | ReadOnlyData
   = Text
   | Data
   | ReadOnlyData
@@ -171,6 +173,9 @@ data Section
   | UninitialisedData
   | ReadOnlyData16      -- .rodata.cst16 on x86_64, 16-byte aligned
   | OtherSection String
   | UninitialisedData
   | ReadOnlyData16      -- .rodata.cst16 on x86_64, 16-byte aligned
   | OtherSection String
+  deriving (Show)
+
+data Section = Section SectionType CLabel
 
 data CmmStatic
   = CmmStaticLit CmmLit
 
 data CmmStatic
   = CmmStaticLit CmmLit
index 3bbd06f..dafaea3 100644 (file)
@@ -148,8 +148,9 @@ addCAF caf srt =
     where last  = next_elt srt
 
 srtToData :: TopSRT -> CmmGroup
     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))
     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.
 
 -- 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
   | 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)
                    Statics srt_desc_lbl $ map CmmStaticLit
                      ( cmmLabelOffW dflags top_srt off
                      : mkWordCLit dflags (fromIntegral len)
index 723f7fc..b9981f2 100644 (file)
@@ -133,7 +133,7 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl live blocks)
         --
         return (top_decls ++
                 [CmmProc mapEmpty 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)])
 
   --
                     (CmmLabel entry_lbl : rel_std_info ++ rel_extra_bits)])
 
   --
index 11e68bd..8aa3a79 100644 (file)
@@ -385,7 +385,7 @@ cmmdata :: { CmmParse () }
         : 'section' STRING '{' data_label statics '}' 
                 { do lbl <- $4;
                      ss <- sequence $5;
         : '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 ':'  
 
 data_label :: { CmmParse CLabel }
     : NAME ':'  
@@ -834,7 +834,7 @@ typenot8 :: { CmmType }
         | 'gcptr'               {% do dflags <- getDynFlags; return $ gcWord dflags }
 
 {
         | 'gcptr'               {% do dflags <- getDynFlags; return $ gcWord dflags }
 
 {
-section :: String -> Section
+section :: String -> SectionType
 section "text"      = Text
 section "data"      = Data
 section "rodata"    = ReadOnlyData
 section "text"      = Text
 section "data"      = Data
 section "rodata"    = ReadOnlyData
index 904e19a..dca57dc 100644 (file)
@@ -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
 -- 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
   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
 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
 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
     needsRelocation (CmmLabel _)      = True
     needsRelocation (CmmLabelOff _ _) = True
     needsRelocation _                 = False
index 87cda6a..830f536 100644 (file)
@@ -154,14 +154,20 @@ pprStatic s = case s of
 -- data sections
 --
 pprSection :: Section -> SDoc
 -- 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")
     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.
index efc89fe..b0dd9b1 100644 (file)
@@ -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().
         ; 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 []))
         }
 
 
         }
 
 
index ccfab85..b4dd869 100644 (file)
@@ -306,7 +306,7 @@ baseRegOffset _      reg            = pprPanic "baseRegOffset:" (ppr reg)
 
 emitDataLits :: CLabel -> [CmmLit] -> FCode ()
 -- Emit a data-segment data block
 
 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
 
 emitRODataLits :: CLabel -> [CmmLit] -> FCode ()
 -- Emit a read-only data block
index e3ea52a..887a876 100644 (file)
@@ -462,6 +462,9 @@ endif
 compiler_stage1_SplitObjs = NO
 compiler_stage2_SplitObjs = NO
 compiler_stage3_SplitObjs = NO
 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
 
 # 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
index 7a673b8..3367cda 100644 (file)
@@ -26,7 +26,7 @@ module LlvmCodeGen.Base (
 
         cmmToLlvmType, widthToLlvmFloat, widthToLlvmInt, llvmFunTy,
         llvmFunSig, llvmFunArgs, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign,
 
         cmmToLlvmType, widthToLlvmFloat, widthToLlvmInt, llvmFunTy,
         llvmFunSig, llvmFunArgs, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign,
-        llvmPtrBits, tysToParams,
+        llvmPtrBits, tysToParams, llvmFunSection,
 
         strCLabel_llvm, strDisplayName_llvm, strProcedureName_llvm,
         getGlobalPtr, generateExternDecls,
 
         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)
 
 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 =
 -- | A Function's arguments
 llvmFunArgs :: DynFlags -> LiveGlobalRegs -> [LlvmVar]
 llvmFunArgs dflags live =
index aa3a0c3..fb79a9d 100644 (file)
@@ -144,7 +144,9 @@ getInstrinct2 fname fty@(LMFunction funSig) = do
         return []
       Nothing -> do
         funInsert fname fty
         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)
 
 
     return (fv, nilOL, tops)
 
index b306748..3c1af4f 100644 (file)
@@ -15,6 +15,7 @@ import LlvmCodeGen.Base
 import BlockId
 import CLabel
 import Cmm
 import BlockId
 import CLabel
 import Cmm
+import DynFlags
 
 import FastString
 import Outputable
 
 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
 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
     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
         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
         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
 
 -- ----------------------------------------------------------------------------
 -- * Generate static data
index d7ddf80..1de630e 100644 (file)
@@ -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)
        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
 
        -- 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 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"
                               prefix lmblocks
            name = decName $ funcDecl fun
            defName = name `appendFS` fsLit "$def"
index 33770b9..a1d36a6 100644 (file)
@@ -1908,6 +1908,10 @@ linkBinary' staticLink dflags o_files dep_packages = do
                           then ["-Wl,-read_only_relocs,suppress"]
                           else [])
 
                           then ["-Wl,-read_only_relocs,suppress"]
                           else [])
 
+                      ++ (if sLdIsGnuLd mySettings
+                          then ["-Wl,--gc-sections"]
+                          else [])
+
                       ++ o_files
                       ++ lib_path_opts)
                       ++ extra_ld_inputs
                       ++ o_files
                       ++ lib_path_opts)
                       ++ extra_ld_inputs
index b870560..39f4a04 100644 (file)
@@ -391,6 +391,7 @@ data GeneralFlag
    | Opt_EagerBlackHoling
    | Opt_NoHsMain
    | Opt_SplitObjs
    | Opt_EagerBlackHoling
    | Opt_NoHsMain
    | Opt_SplitObjs
+   | Opt_SplitSections
    | Opt_StgStats
    | Opt_HideAllPackages
    | Opt_PrintBindResult
    | 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.
                                       -- 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 = []
 
 wayUnsetGeneralFlags _ WayProf     = []
 wayUnsetGeneralFlags _ WayEventLog = []
 
@@ -2326,6 +2330,15 @@ dynamic_flags = [
                 then setGeneralFlag Opt_SplitObjs
                 else addWarn "ignoring -fsplit-objs"))
 
                 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)
         -------- ghc -M -----------------------------------------------------
   , defGhcFlag "dep-suffix"               (hasArg addDepSuffix)
   , defGhcFlag "dep-makefile"             (hasArg setDepMakefile)
index 53c6f62..a6d2637 100644 (file)
@@ -1434,7 +1434,7 @@ doCodeGen hsc_env this_mod data_tycons
     -- we generate one SRT for the whole module.
     let
      pipeline_stream
     -- 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
         = {-# SCC "cmmPipeline" #-}
           let run_pipeline us cmmgroup = do
                 let (topSRT', us') = initUs us emptySRT
index 879b035..303e8de 100644 (file)
@@ -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.
           -- 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
           return (GnuLD $ map Option ["-Wl,--hash-size=31",
                                       "-Wl,--reduce-memory-overheads",
                                       -- ELF specific flag
index 1b57a50..b398802 100644 (file)
@@ -373,10 +373,10 @@ cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs
               dbgMap = debugToMap ndbgs
 
           -- Insert split marker, generate native code
               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") []
               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
                     | 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
 
           -- 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'') <-
           (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 = []
             then do (dwarf, us'') <- dwarfGen dflags modLoc us ldbgs
                     emitNativeCode dflags h dwarf
                     return (ngs' { ngs_debug = []
index 35ee9c9..6bf49f0 100644 (file)
@@ -83,11 +83,22 @@ dwarfGen df modLoc us blocks = do
                  pprDwarfFrame (debugFrame framesU procs)
 
   -- .aranges section: Information about the bounds of compilation units
                  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'')
 
 
   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
 -- | Header for a compilation unit, establishing global format
 -- parameters
 compileUnitHeader :: Unique -> SDoc
index abded88..8647253 100644 (file)
@@ -5,7 +5,7 @@ module Dwarf.Types
   , pprAbbrevDecls
     -- * Dwarf address range table
   , DwarfARange(..)
   , pprAbbrevDecls
     -- * Dwarf address range table
   , DwarfARange(..)
-  , pprDwarfARange
+  , pprDwarfARanges
     -- * Dwarf frame
   , DwarfFrame(..), DwarfFrameProc(..), DwarfFrameBlock(..)
   , pprDwarfFrame
     -- * Dwarf frame
   , DwarfFrame(..), DwarfFrameProc(..), DwarfFrameBlock(..)
   , pprDwarfFrame
@@ -159,14 +159,12 @@ data DwarfARange
   = DwarfARange
     { dwArngStartLabel :: CLabel
     , dwArngEndLabel   :: CLabel
   = 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.
     }
 
 -- | 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.
   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
       -- 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
   in pprDwWord (ppr initialLength)
      $$ pprHalf 2
-     $$ sectionOffset (ppr $ mkAsmTempLabel $ dwArngUnitUnique arng)
+     $$ sectionOffset (ppr $ mkAsmTempLabel $ unitU)
                       (ptext dwarfInfoLabel)
      $$ pprByte (fromIntegral wordSize)
      $$ pprByte 0
      $$ pad paddingSize
                       (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')
 
      -- 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
 -- | Information about unwind instructions for a procedure. This
 -- corresponds to a "Common Information Entry" (CIE) in DWARF.
 data DwarfFrame
index e2d86a9..56025f4 100644 (file)
@@ -650,8 +650,8 @@ getRegister' _ (CmmLit (CmmFloat f frep)) = do
     Amode addr addr_code <- getAmode D dynRef
     let format = floatFormat frep
         code dst =
     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)
 
             `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 =
        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)
 
             `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)
                       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
 
 -- -----------------------------------------------------------------------------
 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 [
     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),
                                  [CmmStaticLit (CmmInt 0x43300000 W32),
                                   CmmStaticLit (CmmInt 0x80000000 W32)],
                 XORIS itmp src (ImmInt 0x8000),
index 99f9ab7..0fbce8c 100644 (file)
@@ -7,18 +7,7 @@
 -----------------------------------------------------------------------------
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 
 {-# 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
 
 import PPC.Regs
 import PPC.Instr
@@ -49,7 +38,7 @@ import Data.Bits
 
 pprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc
 pprNatCmmDecl (CmmData section dats) =
 
 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
 
 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:
          []     -> -- 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
            (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 ->
 
     Just (Statics info_lbl _) ->
       sdocWithPlatform $ \platform ->
+      pprSectionAlign (Section Text info_lbl) $$
       (if platformHasSubsectionsViaSymbols platform
       (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) $$
           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
 
 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) ->
     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
 
            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 ')' ]
 
 
 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
  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
 
 pprDataItem :: CmmLit -> SDoc
 pprDataItem lit
index 90a3b30..b2e574a 100644 (file)
@@ -10,11 +10,19 @@ module PprBase (
         castFloatToWord8Array,
         castDoubleToWord8Array,
         floatToBytes,
         castFloatToWord8Array,
         castDoubleToWord8Array,
         floatToBytes,
-        doubleToBytes
+        doubleToBytes,
+        pprSectionHeader
 )
 
 where
 
 )
 
 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
 
 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])
      )
         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"
index 330d4fa..a6d3f94 100644 (file)
@@ -342,8 +342,8 @@ genSwitch dflags expr targets
 generateJumpTableForInstr :: DynFlags -> Instr
                           -> Maybe (NatCmmDecl CmmStatics Instr)
 generateJumpTableForInstr dflags (JMP_TBL _ ids label) =
 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
 
 
 generateJumpTableForInstr _ _ = Nothing
 
 
index 566cc33..a708558 100644 (file)
@@ -86,7 +86,7 @@ getRegister (CmmLit (CmmFloat f W32)) = do
 
     let code dst = toOL [
             -- the data area
 
     let code dst = toOL [
             -- the data area
-            LDATA ReadOnlyData $ Statics lbl
+            LDATA (Section ReadOnlyData lbl) $ Statics lbl
                          [CmmStaticLit (CmmFloat f W32)],
 
             -- load the literal
                          [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 [
     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]
                          [CmmStaticLit (CmmFloat d W64)],
             SETHI (HI (ImmCLbl lbl)) tmp,
             LD II64 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
index b9462df..93beabe 100644 (file)
@@ -13,7 +13,6 @@
 module SPARC.Ppr (
         pprNatCmmDecl,
         pprBasicBlock,
 module SPARC.Ppr (
         pprNatCmmDecl,
         pprBasicBlock,
-        pprSectionHeader,
         pprData,
         pprInstr,
         pprFormat,
         pprData,
         pprInstr,
         pprFormat,
@@ -53,7 +52,7 @@ import Data.Word
 
 pprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc
 pprNatCmmDecl (CmmData section dats) =
 
 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
 
 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:
          []     -> -- 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
            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) $$
                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)
 
 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) ->
     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
 
            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.
 --
 --      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
 
 -- | Pretty print a data item.
 pprDataItem :: CmmLit -> SDoc
index 30ecc2d..2d22734 100644 (file)
@@ -1224,6 +1224,7 @@ isOperand _ _            = False
 memConstant :: Int -> CmmLit -> NatM Amode
 memConstant align lit = do
   lbl <- getNewLabelNat
 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
   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 =
                                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)
 
         `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
         (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))
 
         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),
                  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 [
   | 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
                  ]
         return code
   where (offset, ids) = switchTargetsToTable targets
index 0c9507a..1a1fd86 100644 (file)
@@ -11,8 +11,6 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module X86.Ppr (
         pprNatCmmDecl,
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module X86.Ppr (
         pprNatCmmDecl,
-        pprBasicBlock,
-        pprSectionHeader,
         pprData,
         pprInstr,
         pprFormat,
         pprData,
         pprInstr,
         pprFormat,
@@ -53,7 +51,7 @@ import Data.Bits
 
 pprNatCmmDecl :: NatCmmDecl (Alignment, CmmStatics) Instr -> SDoc
 pprNatCmmDecl (CmmData section dats) =
 
 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 ->
 
 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:
          []     -> -- 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
            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 ->
 
     Just (Statics info_lbl _) ->
       sdocWithPlatform $ \platform ->
+      pprSectionAlign (Section Text info_lbl) $$
       (if platformHasSubsectionsViaSymbols platform
       (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) $$
           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
       (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)
 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
    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) ->
     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
            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
 
     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
 
 pprDataItem :: CmmLit -> SDoc
 pprDataItem lit = sdocWithDynFlags $ \dflags -> pprDataItem' dflags lit
index 8945e3b..27b54cb 100644 (file)
@@ -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.
 
     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
 ``-static``
     .. index::
        single: -static
diff --git a/driver/utils/merge_sections.ld b/driver/utils/merge_sections.ld
new file mode 100644 (file)
index 0000000..8c82ca0
--- /dev/null
@@ -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*)
+    }
+}
index 0a9f92b..035443a 100644 (file)
@@ -302,6 +302,17 @@ SupportsSplitObjs := $(strip \
 SplitObjs=$(SupportsSplitObjs)
 
 # ----------------------------------------------------------------------------
 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
 
 # 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
index c7c5e75..1f5f996 100644 (file)
@@ -334,6 +334,10 @@ ifeq "$$(TargetOS_CPP)" "mingw32"
 rts_CC_OPTS += -DWINVER=$(rts_WINVER)
 endif
 
 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)\"
 #-----------------------------------------------------------------------------
 # Flags for compiling specific files
 rts/RtsMessages_CC_OPTS += -DProjectVersion=\"$(ProjectVersion)\"
index a10e538..d048f74 100644 (file)
@@ -136,6 +136,8 @@ BINDIST_LIBS += $$($1_$2_$3_LIB)
 BINDIST_LIBS += $$($1_$2_$3_LIB0)
 endif
 
 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)
 # 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
 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
 
 ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES"
 # Don't bother making ghci libs for bootstrapping packages
index 688e1d2..9599c57 100644 (file)
@@ -110,6 +110,15 @@ else
 $1_$2_SplitObjs = NO
 endif
 endif
 $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)
 
 $(call hs-sources,$1,$2)
 $(call c-sources,$1,$2)
index 920ff07..47f6f90 100644 (file)
@@ -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),) \
  -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"
  $$(if $$(findstring YES,$$($1_$2_DYNAMIC_TOO)),$$(if $$(findstring v,$3),-dynamic-too))
 
 ifeq "$3" "dyn"
index cc42db8..14c4783 100644 (file)
@@ -105,6 +105,10 @@ linkingOptions =
          , flagDescription = "Split objects (for libraries)"
          , flagType = DynamicFlag
          }
          , 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
   , flag { flagName = "-static"
          , flagDescription = "Use static Haskell libraries"
          , flagType = DynamicFlag