Change the way module initialisation is done (#3252, #4417)

Previously the code generator generated small code fragments labelled
with __stginit_M for each module M, and these performed whatever
initialisation was necessary for that module and recursively invoked
the initialisation functions for imported modules.  This appraoch had
drawbacks:

 - FFI users had to call hs_add_root() to ensure the correct
   initialisation routines were called.  This is a non-standard,
   and ugly, API.

 - unless we were using -split-objs, the __stginit dependencies would
   entail linking the whole transitive closure of modules imported,
   whether they were actually used or not.  In an extreme case (#4387,
   #4417), a module from GHC might be imported for use in Template
   Haskell or an annotation, and that would force the whole of GHC to
   be needlessly linked into the final executable.

So now instead we do our initialisation with C functions marked with
__attribute__((constructor)), which are automatically invoked at
program startup time (or DSO load-time).  The C initialisers are
emitted into the stub.c file.  This means that every time we compile
with -prof or -hpc, we now get a stub file, but thanks to #3687 that
is now invisible to the user.

There are some refactorings in the RTS (particularly for HPC) to
handle the fact that initialisers now get run earlier than they did
before.

The __stginit symbols are still generated, and the hs_add_root()
function still exists (but does nothing), for backwards compatibility.

33 files changed, 454 insertions, 804 deletions

diff --git a/aclocal.m4 b/aclocal.m4
index 23e6bc08bf..e09bda8440 100644
--- a/aclocal.m4
+++ b/aclocal.m4
@@ -484,6 +484,31 @@ AC_SUBST([LdXFlag])
 ])# FP_PROG_LD_X
 
 
+# FP_PROG_LD_BUILD_ID
+# ------------
+
+# Sets the output variable LdHasBuildId to YES if ld supports
+# --build-id, or NO otherwise.
+AC_DEFUN([FP_PROG_LD_BUILD_ID],
+[
+AC_CACHE_CHECK([whether ld understands --build-id], [fp_cv_ld_build_id],
+[echo 'foo() {}' > conftest.c
+${CC-cc} -c conftest.c
+if ${LdCmd} -r --build-id=none -o conftest2.o conftest.o > /dev/null 2>&1; then
+   fp_cv_ld_build_id=yes
+else
+   fp_cv_ld_build_id=no
+fi
+rm -rf conftest*])
+if test "$fp_cv_ld_build_id" = yes; then
+  LdHasBuildId=YES
+else
+  LdHasBuildId=NO
+fi
+AC_SUBST([LdHasBuildId])
+])# FP_PROG_LD_BUILD_ID
+
+
 # FP_PROG_LD_IS_GNU
 # -----------------
 # Sets the output variable LdIsGNULd to YES or NO, depending on whether it is
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 4d9596197e..c151a26391 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -51,9 +51,7 @@ module CLabel (
 
 	mkAsmTempLabel,
 
-	mkModuleInitLabel,
-	mkPlainModuleInitLabel,
-	mkModuleInitTableLabel,
+        mkPlainModuleInitLabel,
 
 	mkSplitMarkerLabel,
 	mkDirty_MUT_VAR_Label,
@@ -70,10 +68,7 @@ module CLabel (
 	mkRtsPrimOpLabel,
 	mkRtsSlowTickyCtrLabel,
 
-	moduleRegdLabel,
-	moduleRegTableLabel,
-
-	mkSelectorInfoLabel,
+        mkSelectorInfoLabel,
 	mkSelectorEntryLabel,
 
 	mkCmmInfoLabel,
@@ -102,7 +97,6 @@ module CLabel (
         mkDeadStripPreventer,
 
         mkHpcTicksLabel,
-        mkHpcModuleNameLabel,
 
         hasCAF,
 	infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,
@@ -202,23 +196,9 @@ data CLabel
   | StringLitLabel
 	{-# UNPACK #-} !Unique
 
-  | ModuleInitLabel 
-	Module			-- the module name
-	String			-- its "way"
-	-- at some point we might want some kind of version number in
-	-- the module init label, to guard against compiling modules in
-	-- the wrong order.  We can't use the interface file version however,
-	-- because we don't always recompile modules which depend on a module
-	-- whose version has changed.
-
-  | PlainModuleInitLabel	-- without the version & way info
+  | PlainModuleInitLabel        -- without the version & way info
 	Module
 
-  | ModuleInitTableLabel	-- table of imported modules to init
-	Module
-
-  | ModuleRegdLabel
-
   | CC_Label  CostCentre
   | CCS_Label CostCentreStack
 
@@ -242,9 +222,6 @@ data CLabel
   -- | Per-module table of tick locations
   | HpcTicksLabel Module
 
-  -- | Per-module name of the module for Hpc
-  | HpcModuleNameLabel
-
   -- | Label of an StgLargeSRT
   | LargeSRTLabel
         {-# UNPACK #-} !Unique
@@ -490,7 +467,6 @@ mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
 
 -- Constructing Code Coverage Labels
 mkHpcTicksLabel                = HpcTicksLabel
-mkHpcModuleNameLabel           = HpcModuleNameLabel
 
 
 -- Constructing labels used for dynamic linking
@@ -515,19 +491,9 @@ mkStringLitLabel		= StringLitLabel
 mkAsmTempLabel :: Uniquable a => a -> CLabel
 mkAsmTempLabel a		= AsmTempLabel (getUnique a)
 
-mkModuleInitLabel :: Module -> String -> CLabel
-mkModuleInitLabel mod way	= ModuleInitLabel mod way
-
 mkPlainModuleInitLabel :: Module -> CLabel
 mkPlainModuleInitLabel mod	= PlainModuleInitLabel mod
 
-mkModuleInitTableLabel :: Module -> CLabel
-mkModuleInitTableLabel mod	= ModuleInitTableLabel mod
-
-moduleRegdLabel			= ModuleRegdLabel
-moduleRegTableLabel		= ModuleInitTableLabel	
-
-
 -- -----------------------------------------------------------------------------
 -- Converting between info labels and entry/ret labels.
 
@@ -591,10 +557,7 @@ needsCDecl (LargeSRTLabel _)		= False
 needsCDecl (LargeBitmapLabel _)		= False
 needsCDecl (IdLabel _ _ _)		= True
 needsCDecl (CaseLabel _ _)	        = True
-needsCDecl (ModuleInitLabel _ _)	= True
-needsCDecl (PlainModuleInitLabel _)	= True
-needsCDecl (ModuleInitTableLabel _)	= True
-needsCDecl ModuleRegdLabel		= False
+needsCDecl (PlainModuleInitLabel _)     = True
 
 needsCDecl (StringLitLabel _)		= False
 needsCDecl (AsmTempLabel _)		= False
@@ -612,7 +575,6 @@ needsCDecl l@(ForeignLabel{})		= not (isMathFun l)
 needsCDecl (CC_Label _)			= True
 needsCDecl (CCS_Label _)		= True
 needsCDecl (HpcTicksLabel _)            = True
-needsCDecl HpcModuleNameLabel           = False
 
 
 -- | Check whether a label is a local temporary for native code generation
@@ -725,11 +687,8 @@ externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 externallyVisibleCLabel (CaseLabel _ _)		= False
 externallyVisibleCLabel (StringLitLabel _)	= False
 externallyVisibleCLabel (AsmTempLabel _)	= False
-externallyVisibleCLabel (ModuleInitLabel _ _)	= True
 externallyVisibleCLabel (PlainModuleInitLabel _)= True
-externallyVisibleCLabel (ModuleInitTableLabel _)= False
-externallyVisibleCLabel ModuleRegdLabel		= False
-externallyVisibleCLabel (RtsLabel _)		= True
+externallyVisibleCLabel (RtsLabel _)            = True
 externallyVisibleCLabel (CmmLabel _ _ _)	= True
 externallyVisibleCLabel (ForeignLabel{})	= True
 externallyVisibleCLabel (IdLabel name _ _)	= isExternalName name
@@ -737,8 +696,7 @@ externallyVisibleCLabel (CC_Label _)		= True
 externallyVisibleCLabel (CCS_Label _)		= True
 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
 externallyVisibleCLabel (HpcTicksLabel _)	= True
-externallyVisibleCLabel HpcModuleNameLabel	= False
-externallyVisibleCLabel (LargeBitmapLabel _)	= False
+externallyVisibleCLabel (LargeBitmapLabel _)    = False
 externallyVisibleCLabel (LargeSRTLabel _)	= False
 
 -- -----------------------------------------------------------------------------
@@ -777,9 +735,7 @@ labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
 labelType (RtsLabel (RtsApFast _))              = CodeLabel
 labelType (CaseLabel _ CaseReturnInfo)          = DataLabel
 labelType (CaseLabel _ _)	                = CodeLabel
-labelType (ModuleInitLabel _ _)                 = CodeLabel
 labelType (PlainModuleInitLabel _)              = CodeLabel
-labelType (ModuleInitTableLabel _)              = DataLabel
 labelType (LargeSRTLabel _)                     = DataLabel
 labelType (LargeBitmapLabel _)                  = DataLabel
 labelType (ForeignLabel _ _ _ IsFunction)	= CodeLabel
@@ -837,10 +793,8 @@ labelDynamic this_pkg lbl =
    CmmLabel pkg _ _     -> True 
 
 #endif
-   ModuleInitLabel m _    -> not opt_Static && this_pkg /= (modulePackageId m)
    PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
-   ModuleInitTableLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
-   
+
    -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
    _ 		     -> False
 
@@ -1008,9 +962,6 @@ pprCLbl (RtsLabel (RtsPrimOp primop))
 pprCLbl (RtsLabel (RtsSlowTickyCtr pat)) 
   = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
 
-pprCLbl ModuleRegdLabel
-  = ptext (sLit "_module_registered")
-
 pprCLbl (ForeignLabel str _ _ _)
   = ftext str
 
@@ -1019,22 +970,12 @@ pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor
 pprCLbl (CC_Label cc) 		= ppr cc
 pprCLbl (CCS_Label ccs) 	= ppr ccs
 
-pprCLbl (ModuleInitLabel mod way)
-   = ptext (sLit "__stginit_") <> ppr mod
-	<> char '_' <> text way
-
 pprCLbl (PlainModuleInitLabel mod)
    = ptext (sLit "__stginit_") <> ppr mod
 
-pprCLbl (ModuleInitTableLabel mod)
-   = ptext (sLit "__stginittable_") <> ppr mod
-
 pprCLbl (HpcTicksLabel mod)
   = ptext (sLit "_hpc_tickboxes_")  <> ppr mod <> ptext (sLit "_hpc")
 
-pprCLbl HpcModuleNameLabel
-  = ptext (sLit "_hpc_module_name_str")
-
 ppIdFlavor :: IdLabelInfo -> SDoc
 ppIdFlavor x = pp_cSEP <>
 	       (case x of
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index ca6fa74ffa..10f4e8bacf 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -105,18 +105,19 @@ pprTop (CmmProc info clbl (ListGraph blocks)) =
         then pprDataExterns info $$
              pprWordArray (entryLblToInfoLbl clbl) info
         else empty) $$
-    (case blocks of
-        [] -> empty
-         -- the first block doesn't get a label:
-        (BasicBlock _ stmts : rest) -> vcat [
+    (vcat [
 	   blankLine,
 	   extern_decls,
            (if (externallyVisibleCLabel clbl)
                     then mkFN_ else mkIF_) (pprCLabel clbl) <+> lbrace,
            nest 8 temp_decls,
            nest 8 mkFB_,
-           nest 8 (vcat (map pprStmt stmts)) $$
-              vcat (map pprBBlock rest),
+           case blocks of
+               [] -> empty
+               -- the first block doesn't get a label:
+               (BasicBlock _ stmts : rest) ->
+                    nest 8 (vcat (map pprStmt stmts)) $$
+                       vcat (map pprBBlock rest),
            nest 8 mkFE_,
            rbrace ]
     )
diff --git a/compiler/codeGen/CgHpc.hs b/compiler/codeGen/CgHpc.hs
index 8da2715ac2..48756505c3 100644
--- a/compiler/codeGen/CgHpc.hs
+++ b/compiler/codeGen/CgHpc.hs
@@ -6,24 +6,14 @@
 --
 -----------------------------------------------------------------------------
 
-module CgHpc (cgTickBox, initHpc, hpcTable) where
+module CgHpc (cgTickBox, hpcTable) where
 
 import OldCmm
 import CLabel
 import Module
 import OldCmmUtils
-import CgUtils
 import CgMonad
-import CgForeignCall
-import ForeignCall
-import ClosureInfo
-import FastString
 import HscTypes
-import Panic
-import BasicTypes
-
-import Data.Char
-import Data.Word
 
 cgTickBox :: Module -> Int -> Code
 cgTickBox mod n = do
@@ -40,47 +30,10 @@ cgTickBox mod n = do
 
 hpcTable :: Module -> HpcInfo -> Code
 hpcTable this_mod (HpcInfo hpc_tickCount _) = do
-                        emitData ReadOnlyData
-                                        [ CmmDataLabel mkHpcModuleNameLabel
-                                        , CmmString $ map (fromIntegral . ord)
-                                                         (full_name_str)
-                                                      ++ [0]
-                                        ]
                         emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
                                         ] ++
                                         [ CmmStaticLit (CmmInt 0 W64)
                                         | _ <- take hpc_tickCount [0::Int ..]
                                         ]
-  where
-    module_name_str = moduleNameString (Module.moduleName this_mod)
-    full_name_str   = if modulePackageId this_mod == mainPackageId 
-		      then module_name_str
-		      else packageIdString (modulePackageId this_mod) ++ "/" ++
-			   module_name_str
 
 hpcTable _ (NoHpcInfo {}) = error "TODO: impossible"
-
-initHpc :: Module -> HpcInfo -> Code
-initHpc this_mod (HpcInfo tickCount hashNo)
-  = do { id <- newTemp bWord
-       ; emitForeignCall'
-               PlayRisky
-               [CmmHinted id NoHint]
-               (CmmCallee
-                 (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing ForeignLabelInThisPackage IsFunction)
-                  CCallConv
-               )
-               [ CmmHinted (mkLblExpr mkHpcModuleNameLabel) AddrHint
-               , CmmHinted (word32 tickCount) NoHint
-               , CmmHinted (word32 hashNo)    NoHint
-               , CmmHinted (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod) AddrHint
-               ]
-               (Just [])
-               NoC_SRT -- No SRT b/c we PlayRisky
-               CmmMayReturn
-       }
-  where
-       word32 i = CmmLit (CmmInt (fromIntegral (fromIntegral i :: Word32)) W32)
-       mod_alloc = mkFastString "hs_hpc_module"
-initHpc _ (NoHpcInfo {}) = panic "initHpc: NoHpcInfo"
-
diff --git a/compiler/codeGen/CgProf.hs b/compiler/codeGen/CgProf.hs
index 0cf209e89c..243aa1d89a 100644
--- a/compiler/codeGen/CgProf.hs
+++ b/compiler/codeGen/CgProf.hs
@@ -16,8 +16,7 @@ module CgProf (
 	costCentreFrom, 
 	curCCS, curCCSAddr,
 	emitCostCentreDecl, emitCostCentreStackDecl, 
-	emitRegisterCC, emitRegisterCCS,
-	emitSetCCC, emitCCS,
+        emitSetCCC, emitCCS,
 
 	-- Lag/drag/void stuff
 	ldvEnter, ldvEnterClosure, ldvRecordCreate
@@ -348,56 +347,6 @@ sizeof_ccs_words
    (ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE
 
 -- ---------------------------------------------------------------------------
--- Registering CCs and CCSs
-
---   (cc)->link = CC_LIST;
---   CC_LIST = (cc);
---   (cc)->ccID = CC_ID++;
-
-emitRegisterCC :: CostCentre -> Code
-emitRegisterCC cc = do
-  { tmp <- newTemp cInt
-  ; stmtsC [
-     CmmStore (cmmOffsetB cc_lit oFFSET_CostCentre_link)
-		 (CmmLoad cC_LIST bWord),
-     CmmStore cC_LIST cc_lit,
-     CmmAssign (CmmLocal tmp) (CmmLoad cC_ID cInt),
-     CmmStore (cmmOffsetB cc_lit oFFSET_CostCentre_ccID) (CmmReg (CmmLocal tmp)),
-     CmmStore cC_ID (cmmRegOffB (CmmLocal tmp) 1)
-   ]
-  }
-  where
-    cc_lit = CmmLit (CmmLabel (mkCCLabel cc))
-
---  (ccs)->prevStack = CCS_LIST;
---  CCS_LIST = (ccs);
---  (ccs)->ccsID = CCS_ID++;
-
-emitRegisterCCS :: CostCentreStack -> Code
-emitRegisterCCS ccs = do
-  { tmp <- newTemp cInt
-  ; stmtsC [
-     CmmStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_prevStack) 
-			(CmmLoad cCS_LIST bWord),
-     CmmStore cCS_LIST ccs_lit,
-     CmmAssign (CmmLocal tmp) (CmmLoad cCS_ID cInt),
-     CmmStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_ccsID) (CmmReg (CmmLocal tmp)),
-     CmmStore cCS_ID (cmmRegOffB (CmmLocal tmp) 1)
-   ]
-  }
-  where
-    ccs_lit = CmmLit (CmmLabel (mkCCSLabel ccs))
-
-
-cC_LIST, cC_ID :: CmmExpr
-cC_LIST = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CC_LIST")))
-cC_ID   = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CC_ID")))
-
-cCS_LIST, cCS_ID :: CmmExpr
-cCS_LIST = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCS_LIST")))
-cCS_ID   = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCS_ID")))
-
--- ---------------------------------------------------------------------------
 -- Set the current cost centre stack
 
 emitSetCCC :: CostCentre -> Code
diff --git a/compiler/codeGen/CodeGen.lhs b/compiler/codeGen/CodeGen.lhs
index 6ce8fca55b..81a65f7325 100644
--- a/compiler/codeGen/CodeGen.lhs
+++ b/compiler/codeGen/CodeGen.lhs
@@ -29,7 +29,6 @@ import CgHpc
 
 import CLabel
 import OldCmm
-import OldCmmUtils
 import OldPprCmm
 
 import StgSyn
@@ -51,8 +50,7 @@ import Panic
 codeGen :: DynFlags
 	-> Module
 	-> [TyCon]
-	-> [Module]		-- directly-imported modules
-	-> CollectedCCs		-- (Local/global) cost-centres needing declaring/registering.
+        -> CollectedCCs         -- (Local/global) cost-centres needing declaring/registering.
 	-> [(StgBinding,[(Id,[Id])])]	-- Bindings to convert, with SRTs
 	-> HpcInfo
 	-> IO [Cmm]		-- Output
@@ -61,8 +59,7 @@ codeGen :: DynFlags
                 -- possible for object splitting to split up the
                 -- pieces later.
 
-codeGen dflags this_mod data_tycons imported_mods 
-	cost_centre_info stg_binds hpc_info
+codeGen dflags this_mod data_tycons cost_centre_info stg_binds hpc_info
   = do	
   { showPass dflags "CodeGen"
 
@@ -73,167 +70,46 @@ codeGen dflags this_mod data_tycons imported_mods
 		{ cmm_binds  <- mapM (getCmm . cgTopBinding dflags) stg_binds
 		; cmm_tycons <- mapM cgTyCon data_tycons
 		; cmm_init   <- getCmm (mkModuleInit dflags cost_centre_info 
-					     this_mod imported_mods hpc_info)
-		; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init])
+                                             this_mod hpc_info)
+                ; return (cmm_init : cmm_binds ++ concat cmm_tycons)
 		}
 		-- Put datatype_stuff after code_stuff, because the
 		-- datatype closure table (for enumeration types) to
 		-- (say) PrelBase_True_closure, which is defined in
 		-- code_stuff
 
+                -- Note [codegen-split-init] the cmm_init block must
+                -- come FIRST.  This is because when -split-objs is on
+                -- we need to combine this block with its
+                -- initialisation routines; see Note
+                -- [pipeline-split-init].
+
   ; dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprCmms code_stuff)
 
   ; return code_stuff }
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[codegen-init]{Module initialisation code}
-%*									*
-%************************************************************************
-
-/* -----------------------------------------------------------------------------
-   Module initialisation
-
-   The module initialisation code looks like this, roughly:
-
-	FN(__stginit_Foo) {
- 	  JMP_(__stginit_Foo_1_p)
-	}
-
-	FN(__stginit_Foo_1_p) {
-	...
-	}
-
-   We have one version of the init code with a module version and the
-   'way' attached to it.  The version number helps to catch cases
-   where modules are not compiled in dependency order before being
-   linked: if a module has been compiled since any modules which depend on
-   it, then the latter modules will refer to a different version in their
-   init blocks and a link error will ensue.
-
-   The 'way' suffix helps to catch cases where modules compiled in different
-   ways are linked together (eg. profiled and non-profiled).
-
-   We provide a plain, unadorned, version of the module init code
-   which just jumps to the version with the label and way attached.  The
-   reason for this is that when using foreign exports, the caller of
-   startupHaskell() must supply the name of the init function for the "top"
-   module in the program, and we don't want to require that this name
-   has the version and way info appended to it.
-   --------------------------------------------------------------------------  */
-
-We initialise the module tree by keeping a work-stack, 
-	* pointed to by Sp
-	* that grows downward
-	* Sp points to the last occupied slot
-
 
-\begin{code}
-mkModuleInit 
+mkModuleInit
         :: DynFlags
 	-> CollectedCCs         -- cost centre info
 	-> Module
-	-> [Module]
-	-> HpcInfo
+        -> HpcInfo
 	-> Code
-mkModuleInit dflags cost_centre_info this_mod imported_mods hpc_info
-  = do	{ -- Allocate the static boolean that records if this
-          -- module has been registered already
-	  emitData Data [CmmDataLabel moduleRegdLabel, 
-		         CmmStaticLit zeroCLit]
 
+mkModuleInit dflags cost_centre_info this_mod hpc_info
+  = do	{ -- Allocate the static boolean that records if this
         ; whenC (opt_Hpc) $
               hpcTable this_mod hpc_info
 
-          -- we emit a recursive descent module search for all modules
-	  -- and *choose* to chase it in :Main, below.
-          -- In this way, Hpc enabled modules can interact seamlessly with
-	  -- not Hpc enabled moduled, provided Main is compiled with Hpc.
-
-        ; emitSimpleProc real_init_lbl $ do
-                       { ret_blk <- forkLabelledCode ret_code
-
-                        ; init_blk <- forkLabelledCode $ do
-                                        { mod_init_code; stmtC (CmmBranch ret_blk) }
-                                    
-                        ; stmtC (CmmCondBranch (cmmNeWord (CmmLit zeroCLit) mod_reg_val)
-                                    ret_blk)
-                        ; stmtC (CmmBranch init_blk)	    
-                        }
-
- 	    -- Make the "plain" procedure jump to the "real" init procedure
-	; emitSimpleProc plain_init_lbl jump_to_init
-
-	-- When compiling the module in which the 'main' function lives,
-	-- (that is, this_mod == main_mod)
-	-- we inject an extra stg_init procedure for stg_init_ZCMain, for the 
-	-- RTS to invoke.  We must consult the -main-is flag in case the
-	-- user specified a different function to Main.main
- 
-        -- Notice that the recursive descent is optional, depending on what options
-	-- are enabled.
-
-	; whenC (this_mod == main_mod)
-		(emitSimpleProc plain_main_init_lbl rec_descent_init)
-    }
-  where
-    -- The way string we attach to the __stginit label to catch
-    -- accidental linking of modules compiled in different ways.  We
-    -- omit "dyn" from this way, because we want to be able to load
-    -- both dynamic and non-dynamic modules into a dynamic GHC.
-    way = mkBuildTag (filter want_way (ways dflags))
-    want_way w = not (wayRTSOnly w) && wayName w /= WayDyn
-
-    main_mod = mainModIs dflags
-
-    plain_init_lbl = mkPlainModuleInitLabel this_mod
-    real_init_lbl  = mkModuleInitLabel this_mod way
-    plain_main_init_lbl = mkPlainModuleInitLabel rOOT_MAIN
-
-    jump_to_init = stmtC (CmmJump (mkLblExpr real_init_lbl) [])
-
-    mod_reg_val = CmmLoad (mkLblExpr moduleRegdLabel) bWord
-
-    -- Main refers to GHC.TopHandler.runIO, so make sure we call the
-    -- init function for GHC.TopHandler.
-    extra_imported_mods
-	| this_mod == main_mod = [gHC_TOP_HANDLER]
-	| otherwise	       = []
-
-    mod_init_code = do
-	{ 	-- Set mod_reg to 1 to record that we've been here
-	  stmtC (CmmStore (mkLblExpr moduleRegdLabel) (CmmLit (mkIntCLit 1)))
-
         ; whenC (opt_SccProfilingOn) $ do 
 	    initCostCentres cost_centre_info
 
-        ; whenC (opt_Hpc) $
-            initHpc this_mod hpc_info
-         
-	; mapCs (registerModuleImport way)
-		(imported_mods++extra_imported_mods)
-
-	} 
-
-                    -- The return-code pops the work stack by 
-                    -- incrementing Sp, and then jumpd to the popped item
-    ret_code = stmtsC [ CmmAssign spReg (cmmRegOffW spReg 1)
-                      , CmmJump (CmmLoad (cmmRegOffW spReg (-1)) bWord) [] ]
-
-
-    rec_descent_init = if opt_SccProfilingOn || isHpcUsed hpc_info
-		       then jump_to_init
-		       else ret_code
-
------------------------
-registerModuleImport :: String -> Module -> Code
-registerModuleImport way mod
-  | mod == gHC_PRIM
-  = nopC 
-  | otherwise 	-- Push the init procedure onto the work stack
-  = stmtsC [ CmmAssign spReg (cmmRegOffW spReg (-1))
-	   , CmmStore (CmmReg spReg) (mkLblExpr (mkModuleInitLabel mod way)) ]
+            -- For backwards compatibility: user code may refer to this
+            -- label for calling hs_add_root().
+        ; emitSimpleProc (mkPlainModuleInitLabel this_mod) $ return ()
+
+        ; whenC (this_mod == mainModIs dflags) $
+             emitSimpleProc (mkPlainModuleInitLabel rOOT_MAIN) $ return ()
+    }
 \end{code}
 
 
@@ -252,9 +128,7 @@ initCostCentres (local_CCs, ___extern_CCs, singleton_CCSs)
   | otherwise
   = do	{ mapM_ emitCostCentreDecl  	 local_CCs
 	; mapM_ emitCostCentreStackDecl  singleton_CCSs
-	; mapM_ emitRegisterCC           local_CCs
-	; mapM_ emitRegisterCCS          singleton_CCSs
-	}
+        }
 \end{code}
 
 %************************************************************************
diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs
index 26ace0780f..fa3dcfed83 100644
--- a/compiler/codeGen/StgCmm.hs
+++ b/compiler/codeGen/StgCmm.hs
@@ -24,16 +24,12 @@ import StgCmmHpc
 import StgCmmTicky
 
 import MkGraph
-import CmmDecl
 import CmmExpr
-import CmmUtils
 import CLabel
 import PprCmm
 
 import StgSyn
-import PrelNames
 import DynFlags
-import StaticFlags
 
 import HscTypes
 import CostCentre
@@ -50,17 +46,14 @@ import Outputable
 codeGen :: DynFlags
 	 -> Module
 	 -> [TyCon]
-	 -> [Module]			-- Directly-imported modules
-	 -> CollectedCCs		-- (Local/global) cost-centres needing declaring/registering.
+         -> CollectedCCs                -- (Local/global) cost-centres needing declaring/registering.
 	 -> [(StgBinding,[(Id,[Id])])]	-- Bindings to convert, with SRTs
 	 -> HpcInfo
 	 -> IO [Cmm]		-- Output
 
-codeGen dflags this_mod data_tycons imported_mods 
+codeGen dflags this_mod data_tycons
         cost_centre_info stg_binds hpc_info
   = do  { showPass dflags "New CodeGen"
-        ; let way = buildTag dflags
-              main_mod = mainModIs dflags
 
 -- Why?
 --   ; mapM_ (\x -> seq x (return ())) data_tycons
@@ -68,10 +61,9 @@ codeGen dflags this_mod data_tycons imported_mods
         ; code_stuff <- initC dflags this_mod $ do 
                 { cmm_binds  <- mapM (getCmm . cgTopBinding dflags) stg_binds
                 ; cmm_tycons <- mapM cgTyCon data_tycons
-                ; cmm_init   <- getCmm (mkModuleInit way cost_centre_info 
-                                             this_mod main_mod
-                                             imported_mods hpc_info)
-                ; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init])
+                ; cmm_init   <- getCmm (mkModuleInit cost_centre_info
+                                             this_mod hpc_info)
+                ; return (cmm_init : cmm_binds ++ concat cmm_tycons)
                 }
                 -- Put datatype_stuff after code_stuff, because the
                 -- datatype closure table (for enumeration types) to
@@ -82,6 +74,12 @@ codeGen dflags this_mod data_tycons imported_mods
                 -- possible for object splitting to split up the
                 -- pieces later.
 
+                -- Note [codegen-split-init] the cmm_init block must
+                -- come FIRST.  This is because when -split-objs is on
+                -- we need to combine this block with its
+                -- initialisation routines; see Note
+                -- [pipeline-split-init].
+
         ; dumpIfSet_dyn dflags Opt_D_dump_cmmz "New Cmm" (pprCmms code_stuff)
 
         ; return code_stuff }
@@ -173,89 +171,18 @@ We initialise the module tree by keeping a work-stack,
 -}
 
 mkModuleInit 
-	:: String		-- the "way"
-	-> CollectedCCs         -- cost centre info
+        :: CollectedCCs         -- cost centre info
 	-> Module
-	-> Module		-- name of the Main module
-	-> [Module]
-	-> HpcInfo
+        -> HpcInfo
 	-> FCode ()
-mkModuleInit way cost_centre_info this_mod main_mod imported_mods hpc_info
-  = do	{ -- Allocate the static boolean that records if this
-          -- module has been registered already
-	  emitData Data [CmmDataLabel moduleRegdLabel, 
-		         CmmStaticLit zeroCLit]
-
-        ; init_hpc  <- initHpc this_mod hpc_info
-	; init_prof <- initCostCentres cost_centre_info
-
-          -- We emit a recursive descent module search for all modules
-	  -- and *choose* to chase it in :Main, below.
-          -- In this way, Hpc enabled modules can interact seamlessly with
-	  -- not Hpc enabled moduled, provided Main is compiled with Hpc.
-
-        ; updfr_sz <- getUpdFrameOff
-        ; tail <- getCode (pushUpdateFrame imports
-                       (do updfr_sz' <- getUpdFrameOff
-                           emit $ mkReturn (ret_e updfr_sz') [] (pop_ret_loc updfr_sz')))
-        ; emitSimpleProc real_init_lbl $ (withFreshLabel "ret_block" $ \retId -> catAGraphs
-		[ check_already_done retId updfr_sz
-		, init_prof
-		, init_hpc
-                , tail])
- 	    -- Make the "plain" procedure jump to the "real" init procedure
-	; emitSimpleProc plain_init_lbl (jump_to_init updfr_sz)
-
-	-- When compiling the module in which the 'main' function lives,
-	-- (that is, this_mod == main_mod)
-	-- we inject an extra stg_init procedure for stg_init_ZCMain, for the 
-	-- RTS to invoke.  We must consult the -main-is flag in case the
-	-- user specified a different function to Main.main
- 
-        -- Notice that the recursive descent is optional, depending on what options
-	-- are enabled.
-
-
-	; whenC (this_mod == main_mod)
-		(emitSimpleProc plain_main_init_lbl (rec_descent_init updfr_sz))
-    }
-  where
-    plain_init_lbl = mkPlainModuleInitLabel this_mod
-    real_init_lbl  = mkModuleInitLabel this_mod way
-    plain_main_init_lbl = mkPlainModuleInitLabel rOOT_MAIN
-
-    jump_to_init updfr_sz = mkJump (mkLblExpr real_init_lbl) [] updfr_sz
-
-
-    -- Main refers to GHC.TopHandler.runIO, so make sure we call the
-    -- init function for GHC.TopHandler.
-    extra_imported_mods
-	| this_mod == main_mod = [gHC_TOP_HANDLER]
-	| otherwise	       = []
-    all_imported_mods = imported_mods ++ extra_imported_mods
-    imports = map (\mod -> mkLblExpr (mkModuleInitLabel mod way))
-                  (filter (gHC_PRIM /=) all_imported_mods)
-
-    mod_reg_val = CmmLoad (mkLblExpr moduleRegdLabel) bWord
-    check_already_done retId updfr_sz
-     = mkCmmIfThenElse (cmmNeWord (CmmLit zeroCLit) mod_reg_val)
-		       (mkLabel retId <*> mkReturn (ret_e updfr_sz) [] (pop_ret_loc updfr_sz)) mkNop
-	<*>  	-- Set mod_reg to 1 to record that we've been here
-	    mkStore (mkLblExpr moduleRegdLabel) (CmmLit (mkIntCLit 1))
-
-                    -- The return-code pops the work stack by 
-                    -- incrementing Sp, and then jumps to the popped item
-    ret_e updfr_sz = CmmLoad (CmmStackSlot (CallArea Old) updfr_sz) gcWord
-    ret_code updfr_sz = mkJump (ret_e updfr_sz) [] (pop_ret_loc updfr_sz)
-      -- mkAssign spReg (cmmRegOffW spReg 1) <*>
-      -- mkJump (CmmLoad (cmmRegOffW spReg (-1)) bWord) [] updfr_sz
-
-    pop_ret_loc updfr_sz = updfr_sz - widthInBytes (typeWidth bWord)
-
-    rec_descent_init updfr_sz =
-      if opt_SccProfilingOn || isHpcUsed hpc_info
-      then jump_to_init updfr_sz
-      else ret_code updfr_sz
+
+mkModuleInit cost_centre_info this_mod hpc_info
+  = do  { initHpc this_mod hpc_info
+        ; initCostCentres cost_centre_info
+            -- For backwards compatibility: user code may refer to this
+            -- label for calling hs_add_root().
+        ; emitSimpleProc (mkPlainModuleInitLabel this_mod) $ emptyAGraph
+        }
 
 ---------------------------------------------------------------
 --	Generating static stuff for algebraic data types
diff --git a/compiler/codeGen/StgCmmHpc.hs b/compiler/codeGen/StgCmmHpc.hs
index a93af34961..fae3bef016 100644
--- a/compiler/codeGen/StgCmmHpc.hs
+++ b/compiler/codeGen/StgCmmHpc.hs
@@ -8,9 +8,7 @@
 
 module StgCmmHpc ( initHpc, mkTickBox ) where
 
-import StgCmmUtils
 import StgCmmMonad
-import StgCmmForeign
 
 import MkGraph
 import CmmDecl
@@ -18,11 +16,8 @@ import CmmExpr
 import CLabel
 import Module
 import CmmUtils
-import FastString
 import HscTypes
-import Data.Char
 import StaticFlags
-import BasicTypes
 
 mkTickBox :: Module -> Int -> CmmAGraph
 mkTickBox mod n 
@@ -35,41 +30,15 @@ mkTickBox mod n
                         (CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
                         n
 
-initHpc :: Module -> HpcInfo -> FCode CmmAGraph
+initHpc :: Module -> HpcInfo -> FCode ()
 -- Emit top-level tables for HPC and return code to initialise
 initHpc _ (NoHpcInfo {})
-  = return mkNop
-initHpc this_mod (HpcInfo tickCount hashNo)
-  = getCode $ whenC opt_Hpc $
-    do	{ emitData ReadOnlyData
-              [ CmmDataLabel mkHpcModuleNameLabel
-              , CmmString $ map (fromIntegral . ord)
-                               (full_name_str)
-                            ++ [0]
-              ]
-        ; emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
+  = return ()
+initHpc this_mod (HpcInfo tickCount _hashNo)
+  = whenC opt_Hpc $
+    do  { emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
               ] ++
               [ CmmStaticLit (CmmInt 0 W64)
               | _ <- take tickCount [0::Int ..]
               ]
-
-    	; id <- newTemp bWord -- TODO FIXME NOW
-        ; emitCCall
-               [(id,NoHint)]
-               (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing ForeignLabelInThisPackage IsFunction)
-               [ (mkLblExpr mkHpcModuleNameLabel,AddrHint)
-               , (CmmLit $ mkIntCLit tickCount,NoHint)
-               , (CmmLit $ mkIntCLit hashNo,NoHint)
-               , (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,AddrHint)
-               ]
        }
-  where
-    mod_alloc = mkFastString "hs_hpc_module"
-    module_name_str = moduleNameString (Module.moduleName this_mod)
-    full_name_str   = if modulePackageId this_mod == mainPackageId 
-		      then module_name_str
-		      else packageIdString (modulePackageId this_mod) ++ "/" ++
-			   module_name_str
-
-
-         
diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs
index 36d05acf90..08bf52952c 100644
--- a/compiler/codeGen/StgCmmProf.hs
+++ b/compiler/codeGen/StgCmmProf.hs
@@ -348,14 +348,12 @@ ifProfilingL xs
 --	Initialising Cost Centres & CCSs
 ---------------------------------------------------------------
 
-initCostCentres :: CollectedCCs -> FCode CmmAGraph
--- Emit the declarations, and return code to register them
+initCostCentres :: CollectedCCs -> FCode ()
+-- Emit the declarations
 initCostCentres (local_CCs, ___extern_CCs, singleton_CCSs)
-  = getCode $ whenC opt_SccProfilingOn $
+  = whenC opt_SccProfilingOn $
     do	{ mapM_ emitCostCentreDecl local_CCs
-  	; mapM_ emitCostCentreStackDecl  singleton_CCSs 
-	; emit $ catAGraphs $ map mkRegisterCC local_CCs
-	; emit $ catAGraphs $ map mkRegisterCCS singleton_CCSs }
+        ; mapM_ emitCostCentreStackDecl  singleton_CCSs  }
 
 
 emitCostCentreDecl :: CostCentre -> FCode ()
@@ -409,54 +407,6 @@ sizeof_ccs_words
    (ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE
 
 -- ---------------------------------------------------------------------------
--- Registering CCs and CCSs
-
---   (cc)->link = CC_LIST;
---   CC_LIST = (cc);
---   (cc)->ccID = CC_ID++;
-
-mkRegisterCC :: CostCentre -> CmmAGraph
-mkRegisterCC cc
-  = withTemp cInt $ \tmp -> 
-    catAGraphs [
-     mkStore (cmmOffsetB cc_lit oFFSET_CostCentre_link)
-		 (CmmLoad cC_LIST bWord),
-     mkStore cC_LIST cc_lit,
-     mkAssign (CmmLocal tmp) (CmmLoad cC_ID cInt),
-     mkStore (cmmOffsetB cc_lit oFFSET_CostCentre_ccID) (CmmReg (CmmLocal tmp)),
-     mkStore cC_ID (cmmRegOffB (CmmLocal tmp) 1)
-   ]
-  where
-	cc_lit = CmmLit (CmmLabel (mkCCLabel cc))
-
---  (ccs)->prevStack = CCS_LIST;
---  CCS_LIST = (ccs);
---  (ccs)->ccsID = CCS_ID++;
-
-mkRegisterCCS :: CostCentreStack -> CmmAGraph
-mkRegisterCCS ccs
-  = withTemp cInt $ \ tmp ->
-    catAGraphs [
-     mkStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_prevStack) 
-			(CmmLoad cCS_LIST bWord),
-     mkStore cCS_LIST ccs_lit,
-     mkAssign (CmmLocal tmp) (CmmLoad cCS_ID cInt),
-     mkStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_ccsID) (CmmReg (CmmLocal tmp)),
-     mkStore cCS_ID (cmmRegOffB (CmmLocal tmp) 1)
-   ]
-  where
-    ccs_lit = CmmLit (CmmLabel (mkCCSLabel ccs))
-
-
-cC_LIST, cC_ID :: CmmExpr
-cC_LIST = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CC_LIST")))
-cC_ID   = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CC_ID")))
-
-cCS_LIST, cCS_ID :: CmmExpr
-cCS_LIST = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCS_LIST")))
-cCS_ID   = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCS_ID")))
-
--- ---------------------------------------------------------------------------
 -- Set the current cost centre stack
 
 emitSetCCC :: CostCentre -> FCode ()
diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs
index 95b70f091a..b28f3eba3f 100644
--- a/compiler/deSugar/Coverage.lhs
+++ b/compiler/deSugar/Coverage.lhs
@@ -5,7 +5,7 @@
 \section[Coverage]{@coverage@: the main function}
 
 \begin{code}
-module Coverage (addCoverageTicksToBinds) where
+module Coverage (addCoverageTicksToBinds, hpcInitCode) where
 
 import HsSyn
 import Module
@@ -25,6 +25,8 @@ import StaticFlags
 import TyCon
 import MonadUtils
 import Maybes
+import CLabel
+import Util
 
 import Data.Array
 import System.Directory ( createDirectoryIfMissing )
@@ -871,3 +873,56 @@ mixHash :: FilePath -> Integer -> Int -> [MixEntry] -> Int
 mixHash file tm tabstop entries = fromIntegral $ hashString
 	(show $ Mix file tm 0 tabstop entries)
 \end{code}
+
+%************************************************************************
+%*									*
+%*              initialisation
+%*									*
+%************************************************************************
+
+Each module compiled with -fhpc declares an initialisation function of
+the form `hpc_init_<module>()`, which is emitted into the _stub.c file
+and annotated with __attribute__((constructor)) so that it gets
+executed at startup time.
+
+The function's purpose is to call hs_hpc_module to register this
+module with the RTS, and it looks something like this:
+
+static void hpc_init_Main(void) __attribute__((constructor));
+static void hpc_init_Main(void)
+{extern StgWord64 _hpc_tickboxes_Main_hpc[];
+ hs_hpc_module("Main",8,1150288664,_hpc_tickboxes_Main_hpc);}
+
+\begin{code}
+hpcInitCode :: Module -> HpcInfo -> SDoc
+hpcInitCode _ (NoHpcInfo {}) = empty
+hpcInitCode this_mod (HpcInfo tickCount hashNo)
+ = vcat
+    [ text "static void hpc_init_" <> ppr this_mod
+         <> text "(void) __attribute__((constructor));"
+    , text "static void hpc_init_" <> ppr this_mod <> text "(void)"
+    , braces (vcat [
+        ptext (sLit "extern StgWord64 ") <> tickboxes <>
+               ptext (sLit "[]") <> semi,
+        ptext (sLit "hs_hpc_module") <>
+          parens (hcat (punctuate comma [
+              doubleQuotes full_name_str,
+              int tickCount, -- really StgWord32
+              int hashNo,    -- really StgWord32
+              tickboxes
+            ])) <> semi
+       ])
+    ]
+  where
+    tickboxes = pprCLabel (mkHpcTicksLabel $ this_mod)
+
+    module_name  = hcat (map (text.charToC) $
+                         bytesFS (moduleNameFS (Module.moduleName this_mod)))
+    package_name = hcat (map (text.charToC) $
+                         bytesFS (packageIdFS  (modulePackageId this_mod)))
+    full_name_str
+       | modulePackageId this_mod == mainPackageId
+       = module_name
+       | otherwise
+       = package_name <> char '/' <> module_name
+\end{code}
diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs
index 142f695cb5..37a3cf9236 100644
--- a/compiler/deSugar/Desugar.lhs
+++ b/compiler/deSugar/Desugar.lhs
@@ -105,10 +105,14 @@ deSugar hsc_env
                           ; (ds_fords, foreign_prs) <- dsForeigns fords
                           ; ds_rules <- mapMaybeM dsRule rules
                           ; ds_vects <- mapM dsVect vects
+                          ; let hpc_init
+                                  | opt_Hpc   = hpcInitCode mod ds_hpc_info
+                                  | otherwise = empty
                           ; return ( ds_ev_binds
                                    , foreign_prs `appOL` core_prs `appOL` spec_prs
                                    , spec_rules ++ ds_rules, ds_vects
-                                   , ds_fords, ds_hpc_info, modBreaks) }
+                                   , ds_fords `appendStubC` hpc_init
+                                   , ds_hpc_info, modBreaks) }
 
         ; case mb_res of {
            Nothing -> return (msgs, Nothing) ;
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 32d13f839b..c509eb6255 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -350,6 +350,7 @@ Library
         TysPrim
         TysWiredIn
         CostCentre
+        ProfInit
         SCCfinal
         RnBinds
         RnEnv
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 48a802af49..a7a353d66e 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -140,6 +140,8 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/.
 	@echo 'cMKDLL                = "$(BLD_DLL)"'                        >> $@
 	@echo 'cLdIsGNULd            :: String'                             >> $@
 	@echo 'cLdIsGNULd            = "$(LdIsGNULd)"'                      >> $@
+	@echo 'cLdHasBuildId         :: String'                             >> $@
+	@echo 'cLdHasBuildId         = "$(LdHasBuildId)"'                   >> $@
 	@echo 'cLD_X                 :: String'                             >> $@
 	@echo 'cLD_X                 = "$(LD_X)"'                           >> $@
 	@echo 'cGHC_DRIVER_DIR       :: String'                             >> $@
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index d7d6ae331d..61486fc3b6 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1227,6 +1227,8 @@ runPhase SplitAs _input_fn dflags
                                   Just x -> x
 
         let split_s   n = split_s_prefix ++ "__" ++ show n <.> "s"
+
+            split_obj :: Int -> FilePath
             split_obj n = split_odir </>
                           takeFileName base_o ++ "__" ++ show n <.> osuf
 
@@ -1253,15 +1255,31 @@ runPhase SplitAs _input_fn dflags
 
         io $ mapM_ assemble_file [1..n]
 
-        -- If there's a stub_o file, then we make it the n+1th split object.
+        -- Note [pipeline-split-init]
+        -- If we have a stub file, it may contain constructor
+        -- functions for initialisation of this module.  We can't
+        -- simply leave the stub as a separate object file, because it
+        -- will never be linked in: nothing refers to it.  We need to
+        -- ensure that if we ever refer to the data in this module
+        -- that needs initialisation, then we also pull in the
+        -- initialisation routine.
+        --
+        -- To that end, we make a DANGEROUS ASSUMPTION here: the data
+        -- that needs to be initialised is all in the FIRST split
+        -- object.  See Note [codegen-split-init].
+
         PipeState{maybe_stub_o} <- getPipeState
-        n' <- case maybe_stub_o of
-                  Nothing     -> return n
-                  Just stub_o -> do io $ copyFile stub_o (split_obj (n+1))
-                                    return (n+1)
+        case maybe_stub_o of
+            Nothing     -> return ()
+            Just stub_o -> io $ do
+                     tmp_split_1 <- newTempName dflags osuf
+                     let split_1 = split_obj 1
+                     copyFile split_1 tmp_split_1
+                     removeFile split_1
+                     joinObjectFiles dflags [tmp_split_1, stub_o] split_1
 
         -- join them into a single .o file
-        io $ joinObjectFiles dflags (map split_obj [1..n']) output_fn
+        io $ joinObjectFiles dflags (map split_obj [1..n]) output_fn
 
         return (next_phase, output_fn)
 
@@ -1979,14 +1997,22 @@ joinObjectFiles dflags o_files output_fn = do
                             SysTools.Option "-nostdlib",
                             SysTools.Option "-nodefaultlibs",
                             SysTools.Option "-Wl,-r",
+                            SysTools.Option ld_build_id,
                             SysTools.Option ld_x_flag,
                             SysTools.Option "-o",
                             SysTools.FileOption "" output_fn ]
                          ++ map SysTools.Option md_c_flags
                          ++ args)
+
       ld_x_flag | null cLD_X = ""
                 | otherwise  = "-Wl,-x"
 
+      -- suppress the generation of the .note.gnu.build-id section,
+      -- which we don't need and sometimes causes ld to emit a
+      -- warning:
+      ld_build_id | cLdHasBuildId == "YES"  = "-Wl,--build-id=none"
+                  | otherwise               = ""
+
       md_c_flags = machdepCCOpts dflags
   
   if cLdIsGNULd == "YES"
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 0d94ade469..ca2e14cee2 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -756,9 +756,7 @@ data CoreModule
       -- | Type environment for types declared in this module
       cm_types    :: !TypeEnv,
       -- | Declarations
-      cm_binds    :: [CoreBind],
-      -- | Imports
-      cm_imports  :: ![Module]
+      cm_binds    :: [CoreBind]
     }
 
 instance Outputable CoreModule where
@@ -857,11 +855,11 @@ compileCore simplify fn = do
         gutsToCoreModule :: Either (CgGuts, ModDetails) ModGuts -> CoreModule
         gutsToCoreModule (Left (cg, md))  = CoreModule {
           cm_module = cg_module cg,    cm_types = md_types md,
-          cm_imports = cg_dir_imps cg, cm_binds = cg_binds cg
+          cm_binds = cg_binds cg
         }
         gutsToCoreModule (Right mg) = CoreModule {
           cm_module  = mg_module mg,                   cm_types   = mg_types mg,
-          cm_imports = moduleEnvKeys (mg_dir_imps mg), cm_binds   = mg_binds mg
+          cm_binds   = mg_binds mg
          }
 
 -- %************************************************************************
diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 841125a0c5..70ddd6adb8 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -109,7 +109,8 @@ import CoreToStg	( coreToStg )
 import qualified StgCmm	( codeGen )
 import StgSyn
 import CostCentre
-import TyCon		( TyCon, isDataTyCon )
+import ProfInit
+import TyCon            ( TyCon, isDataTyCon )
 import Name		( Name, NamedThing(..) )
 import SimplStg		( stg2stg )
 import CodeGen		( codeGen )
@@ -863,8 +864,7 @@ hscGenHardCode cgguts mod_summary
                      cg_module   = this_mod,
                      cg_binds    = core_binds,
                      cg_tycons   = tycons,
-                     cg_dir_imps = dir_imps,
-                     cg_foreign  = foreign_stubs,
+                     cg_foreign  = foreign_stubs0,
                      cg_dep_pkgs = dependencies,
                      cg_hpc_info = hpc_info } = cgguts
              dflags = hsc_dflags hsc_env
@@ -883,16 +883,19 @@ hscGenHardCode cgguts mod_summary
              <- {-# SCC "CoreToStg" #-}
                 myCoreToStg dflags this_mod prepd_binds	
 
+         let prof_init = profilingInitCode this_mod cost_centre_info
+             foreign_stubs = foreign_stubs0 `appendStubC` prof_init
+
          ------------------  Code generation ------------------
          
          cmms <- if dopt Opt_TryNewCodeGen dflags
                  then do cmms <- tryNewCodeGen hsc_env this_mod data_tycons
-                                 dir_imps cost_centre_info
+                                 cost_centre_info
                                  stg_binds hpc_info
                          return cmms
                  else {-# SCC "CodeGen" #-}
                        codeGen dflags this_mod data_tycons
-                               dir_imps cost_centre_info
+                               cost_centre_info
                                stg_binds hpc_info
 
          --- Optionally run experimental Cmm transformations ---
@@ -963,15 +966,15 @@ hscCompileCmmFile hsc_env filename
 
 -------------------- Stuff for new code gen ---------------------
 
-tryNewCodeGen	:: HscEnv -> Module -> [TyCon] -> [Module]
+tryNewCodeGen   :: HscEnv -> Module -> [TyCon]
 		-> CollectedCCs
 		-> [(StgBinding,[(Id,[Id])])]
 		-> HpcInfo
 		-> IO [Cmm]
-tryNewCodeGen hsc_env this_mod data_tycons imported_mods 
+tryNewCodeGen hsc_env this_mod data_tycons
 	      cost_centre_info stg_binds hpc_info =
   do	{ let dflags = hsc_dflags hsc_env
-        ; prog <- StgCmm.codeGen dflags this_mod data_tycons imported_mods 
+        ; prog <- StgCmm.codeGen dflags this_mod data_tycons
 		 	 cost_centre_info stg_binds hpc_info
 	; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Cmm produced by new codegen" 
 		(pprCmms prog)
diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 3d441cce57..e59c2239a7 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -14,7 +14,7 @@ module HscTypes (
 
         -- * Information about modules
 	ModDetails(..),	emptyModDetails,
-	ModGuts(..), CgGuts(..), ForeignStubs(..),
+        ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC,
         ImportedMods,
 
 	ModSummary(..), ms_mod_name, showModMsg, isBootSummary,
@@ -799,11 +799,7 @@ data CgGuts
 		-- data constructor workers; reason: we we regard them
 		-- as part of the code-gen of tycons
 
-	cg_dir_imps :: ![Module],
-		-- ^ Directly-imported modules; used to generate
-		-- initialisation code
-
-	cg_foreign  :: !ForeignStubs,	-- ^ Foreign export stubs
+        cg_foreign  :: !ForeignStubs,   -- ^ Foreign export stubs
 	cg_dep_pkgs :: ![PackageId],	-- ^ Dependent packages, used to 
 	                                -- generate #includes for C code gen
         cg_hpc_info :: !HpcInfo,        -- ^ Program coverage tick box information
@@ -823,6 +819,10 @@ data ForeignStubs = NoStubs             -- ^ We don't have any stubs
                    --
                    --  2) C stubs to use when calling
                    --     "foreign exported" functions
+
+appendStubC :: ForeignStubs -> SDoc -> ForeignStubs
+appendStubC NoStubs            c_code = ForeignStubs empty c_code
+appendStubC (ForeignStubs h c) c_code = ForeignStubs h (c $$ c_code)
 \end{code}
 
 \begin{code}
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index b78c0dbef2..f23280bc19 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -292,8 +292,7 @@ tidyProgram hsc_env  (ModGuts { mg_module = mod, mg_exports = exports,
 				mg_binds = binds, 
 				mg_rules = imp_rules,
                                 mg_vect_info = vect_info,
-				mg_dir_imps = dir_imps, 
-				mg_anns = anns,
+                                mg_anns = anns,
                                 mg_deps = deps, 
 				mg_foreign = foreign_stubs,
 			        mg_hpc_info = hpc_info,
@@ -363,13 +362,10 @@ tidyProgram hsc_env  (ModGuts { mg_module = mod, mg_exports = exports,
                            <+> int (cs_ty cs) 
                            <+> int (cs_co cs) ))
 
-        ; let dir_imp_mods = moduleEnvKeys dir_imps
-
-	; return (CgGuts { cg_module   = mod, 
-			   cg_tycons   = alg_tycons,
-			   cg_binds    = all_tidy_binds,
-			   cg_dir_imps = dir_imp_mods,
-			   cg_foreign  = foreign_stubs,
+        ; return (CgGuts { cg_module   = mod,
+                           cg_tycons   = alg_tycons,
+                           cg_binds    = all_tidy_binds,
+                           cg_foreign  = foreign_stubs,
 			   cg_dep_pkgs = dep_pkgs deps,
 			   cg_hpc_info = hpc_info,
                            cg_modBreaks = modBreaks }, 
diff --git a/compiler/profiling/ProfInit.hs b/compiler/profiling/ProfInit.hs
new file mode 100644
index 0000000000..7e223f80e9
--- /dev/null
+++ b/compiler/profiling/ProfInit.hs
@@ -0,0 +1,45 @@
+-- -----------------------------------------------------------------------------
+--
+-- (c) The University of Glasgow, 2011
+--
+-- Generate code to initialise cost centres
+--
+-- -----------------------------------------------------------------------------
+
+module ProfInit (profilingInitCode) where
+
+import CLabel
+import CostCentre
+import Outputable
+import StaticFlags
+import FastString
+import Module
+
+-- -----------------------------------------------------------------------------
+-- Initialising cost centres
+
+-- We must produce declarations for the cost-centres defined in this
+-- module;
+
+profilingInitCode :: Module -> CollectedCCs -> SDoc
+profilingInitCode this_mod (local_CCs, ___extern_CCs, singleton_CCSs)
+ | not opt_SccProfilingOn = empty
+ | otherwise
+ = vcat
+    [ text "static void prof_init_" <> ppr this_mod
+         <> text "(void) __attribute__((constructor));"
+    , text "static void prof_init_" <> ppr this_mod <> text "(void)"
+    , braces (vcat (
+         map emitRegisterCC           local_CCs ++
+         map emitRegisterCCS          singleton_CCSs
+       ))
+    ]
+ where
+   emitRegisterCC cc   =
+      ptext (sLit "extern CostCentre ") <> cc_lbl <> ptext (sLit "[];") $$
+      ptext (sLit "REGISTER_CC(") <> cc_lbl <> char ')' <> semi
+     where cc_lbl = ppr (mkCCLabel cc)
+   emitRegisterCCS ccs =
+      ptext (sLit "extern CostCentreStack ") <> ccs_lbl <> ptext (sLit "[];") $$
+      ptext (sLit "REGISTER_CCS(") <> ccs_lbl <> char ')' <> semi
+     where ccs_lbl = ppr (mkCCSLabel ccs)
diff --git a/configure.ac b/configure.ac
index 21e965b71c..7baa3ddb5c 100644
--- a/configure.ac
+++ b/configure.ac
@@ -816,6 +816,7 @@ FP_LEADING_UNDERSCORE
 dnl ** check for ld, whether it has an -x option, and if it is GNU ld
 FP_PROG_LD_X
 FP_PROG_LD_IS_GNU
+FP_PROG_LD_BUILD_ID
 
 dnl ** check for Apple-style dead-stripping support
 dnl    (.subsections-via-symbols assembler directive)
diff --git a/docs/users_guide/ffi-chap.xml b/docs/users_guide/ffi-chap.xml
index 47c0f01ba9..97a237876f 100644
--- a/docs/users_guide/ffi-chap.xml
+++ b/docs/users_guide/ffi-chap.xml
@@ -245,18 +245,11 @@ extern HsInt foo(HsInt a0);</programlisting>
 #include "foo_stub.h"
 #endif
 
-#ifdef __GLASGOW_HASKELL__
-extern void __stginit_Foo ( void );
-#endif
-
 int main(int argc, char *argv[])
 {
   int i;
 
   hs_init(&amp;argc, &amp;argv);
-#ifdef __GLASGOW_HASKELL__
-  hs_add_root(__stginit_Foo);
-#endif
 
   for (i = 0; i &lt; 5; i++) {
     printf("%d\n", foo(2500));
@@ -283,26 +276,6 @@ int main(int argc, char *argv[])
 	(i.e. those arguments between
 	<literal>+RTS...-RTS</literal>).</para>
 
-	<para>Next, we call
-	<function>hs_add_root</function><indexterm><primary><function>hs_add_root</function></primary>
-	</indexterm>, a GHC-specific interface which is required to
-	initialise the Haskell modules in the program.  The argument
-	to <function>hs_add_root</function> should be the name of the
-	initialization function for the "root" module in your program
-	- in other words, the module which directly or indirectly
-	imports all the other Haskell modules in the program.  In a
-	standalone Haskell program the root module is normally
-	<literal>Main</literal>, but when you are using Haskell code
-	from a library it may not be.  If your program has multiple
-	root modules, then you can call
-	<function>hs_add_root</function> multiple times, one for each
-	root.  The name of the initialization function for module
-	<replaceable>M</replaceable> is
-	<literal>__stginit_<replaceable>M</replaceable></literal>, and
-	it may be declared as an external function symbol as in the
-	code above.  Note that the symbol name should be transformed
-	according to the Z-encoding:</para>
-
       <informaltable>
 	<tgroup cols="2" align="left" colsep="1" rowsep="1">
 	  <thead>
@@ -380,9 +353,6 @@ int main(int argc, char *argv[])
    // Initialize Haskell runtime
    hs_init(&amp;argc, &amp;argv);
 
-   // Tell Haskell about all root modules
-   hs_add_root(__stginit_Foo);
-
    // do any other initialization here and
    // return false if there was a problem
    return HS_BOOL_TRUE;
@@ -394,7 +364,7 @@ int main(int argc, char *argv[])
 </programlisting>
 
         <para>The initialisation routine, <literal>mylib_init</literal>, calls
-          <literal>hs_init()</literal> and <literal>hs_add_root()</literal> as
+          <literal>hs_init()</literal> as
           normal to initialise the Haskell runtime, and the corresponding
           deinitialisation function <literal>mylib_end()</literal> calls
           <literal>hs_exit()</literal> to shut down the runtime.</para>
@@ -599,8 +569,7 @@ int main(int argc, char *argv[])
           invoke <literal>foreign export</literal>ed functions from
           multiple OS threads concurrently.  The runtime system must
           be initialised as usual by
-          calling <literal>hs_init()</literal>
-          and <literal>hs_add_root</literal>, and these calls must
+          calling <literal>hs_init()</literal>, and this call must
           complete before invoking any <literal>foreign
           export</literal>ed functions.</para>
       </sect3>
diff --git a/docs/users_guide/packages.xml b/docs/users_guide/packages.xml
index 5915046c3e..86df5944b2 100644
--- a/docs/users_guide/packages.xml
+++ b/docs/users_guide/packages.xml
@@ -279,7 +279,6 @@ exposed-modules: Network.BSD,
 <programlisting>
 /usr/bin/ld: Undefined symbols:
 _ZCMain_main_closure
-___stginit_ZCMain
 </programlisting>
 </para>
 
diff --git a/docs/users_guide/win32-dlls.xml b/docs/users_guide/win32-dlls.xml
index bf243a2cd1..f00e1e2c38 100644
--- a/docs/users_guide/win32-dlls.xml
+++ b/docs/users_guide/win32-dlls.xml
@@ -429,8 +429,6 @@ foreign export stdcall adder :: Int -> Int -> IO Int
 // StartEnd.c
 #include &lt;Rts.h&gt;
 
-extern void __stginit_Adder(void);
-
 void HsStart()
 {
    int argc = 1;
@@ -439,9 +437,6 @@ void HsStart()
    // Initialize Haskell runtime
    char** args = argv;
    hs_init(&amp;argc, &amp;args);
-
-   // Tell Haskell about all root modules
-   hs_add_root(__stginit_Adder);
 }
 
 void HsEnd()
diff --git a/includes/rts/Hpc.h b/includes/rts/Hpc.h
index 26da35d4cd..bceb81c961 100644
--- a/includes/rts/Hpc.h
+++ b/includes/rts/Hpc.h
@@ -18,16 +18,16 @@
 typedef struct _HpcModuleInfo {
   char *modName;		// name of module
   StgWord32 tickCount;		// number of ticks
-  StgWord32 tickOffset;		// offset into a single large .tix Array
-  StgWord32 hashNo;		// Hash number for this module's mix info
+  StgWord32 hashNo;             // Hash number for this module's mix info
   StgWord64 *tixArr;		// tix Array; local for this module
+  rtsBool from_file;            // data was read from the .tix file
   struct _HpcModuleInfo *next;
 } HpcModuleInfo;
 
-int hs_hpc_module (char *modName, 
-                   StgWord32 modCount, 
-                   StgWord32 modHashNo,
-                   StgWord64 *tixArr);
+void hs_hpc_module (char *modName,
+                    StgWord32 modCount,
+                    StgWord32 modHashNo,
+                    StgWord64 *tixArr);
 
 HpcModuleInfo * hs_hpc_rootModule (void);
 
diff --git a/mk/config.mk.in b/mk/config.mk.in
index 10911e6934..be8b57bcb7 100644
--- a/mk/config.mk.in
+++ b/mk/config.mk.in
@@ -659,6 +659,10 @@ LD_X			= @LdXFlag@
 # overflowing command-line length limits.
 LdIsGNULd		= @LdIsGNULd@
 
+# Set to YES if ld has the --build-id flag.  Sometimes we need to
+# disable it with --build-id=none.
+LdHasBuildId	        = @LdHasBuildId@
+
 # On MSYS, building with SplitObjs=YES fails with 
 #   ar: Bad file number
 # see #3201.  We need to specify a smaller max command-line size
diff --git a/rts/Hpc.c b/rts/Hpc.c
index 81c802cea2..c4ff8d3be1 100644
--- a/rts/Hpc.c
+++ b/rts/Hpc.c
@@ -6,6 +6,8 @@
 #include "Rts.h"
 
 #include "Trace.h"
+#include "Hash.h"
+#include "RtsUtils.h"
 
 #include <stdio.h>
 #include <ctype.h>
@@ -36,11 +38,11 @@ static pid_t hpc_pid = 0;		// pid of this process at hpc-boot time.
 static FILE *tixFile;			// file being read/written
 static int tix_ch;			// current char
 
+static HashTable * moduleHash = NULL;   // module name -> HpcModuleInfo
+
 HpcModuleInfo *modules = 0;
-HpcModuleInfo *nextModule = 0;
-int totalTixes = 0;		// total number of tix boxes.
 
-static char *tixFilename;
+static char *tixFilename = NULL;
 
 static void GNU_ATTRIBUTE(__noreturn__)
 failure(char *msg) {
@@ -78,7 +80,7 @@ static void ws(void) {
 }
 
 static char *expectString(void) {
-  char tmp[256], *res;
+  char tmp[256], *res; // XXX
   int tmp_ix = 0;
   expect('"');
   while (tix_ch != '"') {
@@ -87,7 +89,7 @@ static char *expectString(void) {
   }
   tmp[tmp_ix++] = 0;
   expect('"');
-  res = malloc(tmp_ix);
+  res = stgMallocBytes(tmp_ix,"Hpc.expectString");
   strcpy(res,tmp);
   return res;
 }
@@ -104,10 +106,8 @@ static StgWord64 expectWord64(void) {
 static void
 readTix(void) {
   unsigned int i;
-  HpcModuleInfo *tmpModule;
+  HpcModuleInfo *tmpModule, *lookup;
 
-  totalTixes = 0;
-    
   ws();
   expect('T');
   expect('i');
@@ -117,7 +117,9 @@ readTix(void) {
   ws();
   
   while(tix_ch != ']') {
-    tmpModule = (HpcModuleInfo *)calloc(1,sizeof(HpcModuleInfo));
+    tmpModule = (HpcModuleInfo *)stgMallocBytes(sizeof(HpcModuleInfo),
+                                                "Hpc.readTix");
+    tmpModule->from_file = rtsTrue;
     expect('T');
     expect('i');
     expect('x');
@@ -134,8 +136,6 @@ readTix(void) {
     ws();
     tmpModule -> tickCount = (int)expectWord64();
     tmpModule -> tixArr = (StgWord64 *)calloc(tmpModule->tickCount,sizeof(StgWord64));
-    tmpModule -> tickOffset = totalTixes;
-    totalTixes += tmpModule -> tickCount;
     ws();
     expect('[');
     ws();
@@ -150,13 +150,32 @@ readTix(void) {
     expect(']');
     ws();
     
-    if (!modules) {
-      modules = tmpModule;
+    lookup = lookupHashTable(moduleHash, (StgWord)tmpModule->modName);
+    if (tmpModule == NULL) {
+        debugTrace(DEBUG_hpc,"readTix: new HpcModuleInfo for %s",
+                   tmpModule->modName);
+        insertHashTable(moduleHash, (StgWord)tmpModule->modName, tmpModule);
     } else {
-      nextModule->next=tmpModule;
+        ASSERT(lookup->tixArr != 0);
+        ASSERT(!strcmp(tmpModule->modName, lookup->modName));
+        debugTrace(DEBUG_hpc,"readTix: existing HpcModuleInfo for %s",
+                   tmpModule->modName);
+        if (tmpModule->hashNo != lookup->hashNo) {
+            fprintf(stderr,"in module '%s'\n",tmpModule->modName);
+            failure("module mismatch with .tix/.mix file hash number");
+            if (tixFilename != NULL) {
+                fprintf(stderr,"(perhaps remove %s ?)\n",tixFilename);
+            }
+            stg_exit(EXIT_FAILURE);
+        }
+        for (i=0; i < tmpModule->tickCount; i++) {
+            lookup->tixArr[i] = tmpModule->tixArr[i];
+        }
+        stgFree(tmpModule->tixArr);
+        stgFree(tmpModule->modName);
+        stgFree(tmpModule);
     }
-    nextModule=tmpModule;
-    
+
     if (tix_ch == ',') {
       expect(',');
       ws();
@@ -166,9 +185,18 @@ readTix(void) {
   fclose(tixFile);
 }
 
-static void hpc_init(void) {
+void
+startupHpc(void)
+{
   char *hpc_tixdir;
   char *hpc_tixfile;
+
+  if (moduleHash == NULL) {
+      // no modules were registered with hs_hpc_module, so don't bother
+      // creating the .tix file.
+      return;
+  }
+
   if (hpc_inited != 0) {
     return;
   }
@@ -177,6 +205,8 @@ static void hpc_init(void) {
   hpc_tixdir = getenv("HPCTIXDIR");
   hpc_tixfile = getenv("HPCTIXFILE");
 
+  debugTrace(DEBUG_hpc,"startupHpc");
+
   /* XXX Check results of mallocs/strdups, and check we are requesting
          enough bytes */
   if (hpc_tixfile != NULL) {
@@ -192,10 +222,13 @@ static void hpc_init(void) {
 #endif
     /* Then, try open the file
      */
-    tixFilename = (char *) malloc(strlen(hpc_tixdir) + strlen(prog_name) + 12);
+    tixFilename = (char *) stgMallocBytes(strlen(hpc_tixdir) +
+                                          strlen(prog_name) + 12,
+                                          "Hpc.startupHpc");
     sprintf(tixFilename,"%s/%s-%d.tix",hpc_tixdir,prog_name,(int)hpc_pid);
   } else {
-    tixFilename = (char *) malloc(strlen(prog_name) + 6);
+    tixFilename = (char *) stgMallocBytes(strlen(prog_name) + 6,
+                                          "Hpc.startupHpc");
     sprintf(tixFilename, "%s.tix", prog_name);
   }
 
@@ -204,90 +237,80 @@ static void hpc_init(void) {
   }
 }
 
-/* Called on a per-module basis, at startup time, declaring where the tix boxes are stored in memory.
- * This memory can be uninitized, because we will initialize it with either the contents
- * of the tix file, or all zeros.
+/*
+ * Called on a per-module basis, by a constructor function compiled
+ * with each module (see Coverage.hpcInitCode), declaring where the
+ * tix boxes are stored in memory.  This memory can be uninitized,
+ * because we will initialize it with either the contents of the tix
+ * file, or all zeros.
+ *
+ * Note that we might call this before reading the .tix file, or after
+ * in the case where we loaded some Haskell code from a .so with
+ * dlopen().  So we must handle the case where we already have an
+ * HpcModuleInfo for the module which was read from the .tix file.
  */
 
-int
+void
 hs_hpc_module(char *modName,
 	      StgWord32 modCount,
 	      StgWord32 modHashNo,
-	      StgWord64 *tixArr) {
-  HpcModuleInfo *tmpModule, *lastModule;
-  unsigned int i;
-  int offset = 0;
-  
-  debugTrace(DEBUG_hpc,"hs_hpc_module(%s,%d)",modName,(nat)modCount);
+              StgWord64 *tixArr)
+{
+  HpcModuleInfo *tmpModule;
+  nat i;
 
-  hpc_init();
+  if (moduleHash == NULL) {
+      moduleHash = allocStrHashTable();
+  }
 
-  tmpModule = modules;
-  lastModule = 0;
-  
-  for(;tmpModule != 0;tmpModule = tmpModule->next) {
-    if (!strcmp(tmpModule->modName,modName)) {
+  tmpModule = lookupHashTable(moduleHash, (StgWord)modName);
+  if (tmpModule == NULL)
+  {
+      // Did not find entry so add one on.
+      tmpModule = (HpcModuleInfo *)stgMallocBytes(sizeof(HpcModuleInfo),
+                                                  "Hpc.hs_hpc_module");
+      tmpModule->modName = modName;
+      tmpModule->tickCount = modCount;
+      tmpModule->hashNo = modHashNo;
+
+      tmpModule->tixArr = tixArr;
+      for(i=0;i < modCount;i++) {
+          tixArr[i] = 0;
+      }
+      tmpModule->next = modules;
+      tmpModule->from_file = rtsFalse;
+      modules = tmpModule;
+      insertHashTable(moduleHash, (StgWord)modName, tmpModule);
+  }
+  else
+  {
       if (tmpModule->tickCount != modCount) {
-	failure("inconsistent number of tick boxes");
+          failure("inconsistent number of tick boxes");
       }
-      assert(tmpModule->tixArr != 0);	
+      ASSERT(tmpModule->tixArr != 0);
       if (tmpModule->hashNo != modHashNo) {
-	fprintf(stderr,"in module '%s'\n",tmpModule->modName);
-	failure("module mismatch with .tix/.mix file hash number");
-	fprintf(stderr,"(perhaps remove %s ?)\n",tixFilename);
-	stg_exit(1);
-
+          fprintf(stderr,"in module '%s'\n",tmpModule->modName);
+          failure("module mismatch with .tix/.mix file hash number");
+          if (tixFilename != NULL) {
+              fprintf(stderr,"(perhaps remove %s ?)\n",tixFilename);
+          }
+          stg_exit(EXIT_FAILURE);
       }
+      // The existing tixArr was made up when we read the .tix file,
+      // whereas this is the real tixArr, so copy the data from the
+      // .tix into the real tixArr.
       for(i=0;i < modCount;i++) {
-	tixArr[i] = tmpModule->tixArr[i];
+          tixArr[i] = tmpModule->tixArr[i];
       }
-      tmpModule->tixArr = tixArr;
-      return tmpModule->tickOffset;
-    }
-    lastModule = tmpModule;
-  }
-  // Did not find entry so add one on.
-  tmpModule = (HpcModuleInfo *)calloc(1,sizeof(HpcModuleInfo));
-  tmpModule->modName = modName;
-  tmpModule->tickCount = modCount;
-  tmpModule->hashNo = modHashNo;
-  if (lastModule) {
-    tmpModule->tickOffset = lastModule->tickOffset + lastModule->tickCount;
-  } else {
-    tmpModule->tickOffset = 0;
-  }
-  tmpModule->tixArr = tixArr;
-  for(i=0;i < modCount;i++) {
-    tixArr[i] = 0;
-  }
-  tmpModule->next = 0;
-
-  if (!modules) {
-    modules = tmpModule;
-  } else {
-    lastModule->next=tmpModule;
-  }
-
-  debugTrace(DEBUG_hpc,"end: hs_hpc_module");
-
-  return offset;
-}
-
 
-/* This is called after all the modules have registered their local tixboxes,
- * and does a sanity check: are we good to go?
- */
-
-void
-startupHpc(void) {
-  debugTrace(DEBUG_hpc,"startupHpc");
- 
- if (hpc_inited == 0) {
-    return;
+      if (tmpModule->from_file) {
+          stgFree(tmpModule->modName);
+          stgFree(tmpModule->tixArr);
+      }
+      tmpModule->from_file = rtsFalse;
   }
 }
 
-
 static void
 writeTix(FILE *f) {
   HpcModuleInfo *tmpModule;  
@@ -311,11 +334,10 @@ writeTix(FILE *f) {
 	   tmpModule->modName,
 	    (nat)tmpModule->hashNo,
 	    (nat)tmpModule->tickCount);
-    debugTrace(DEBUG_hpc,"%s: %u (offset=%u) (hash=%u)\n",
+    debugTrace(DEBUG_hpc,"%s: %u (hash=%u)\n",
 	       tmpModule->modName,
 	       (nat)tmpModule->tickCount,
-	       (nat)tmpModule->hashNo,
-	       (nat)tmpModule->tickOffset);
+               (nat)tmpModule->hashNo);
 
     inner_comma = 0;
     for(i = 0;i < tmpModule->tickCount;i++) {
@@ -338,7 +360,17 @@ writeTix(FILE *f) {
   fclose(f);
 }
 
-/* Called at the end of execution, to write out the Hpc *.tix file  
+static void
+freeHpcModuleInfo (HpcModuleInfo *mod)
+{
+    if (mod->from_file) {
+        stgFree(mod->modName);
+        stgFree(mod->tixArr);
+    }
+    stgFree(mod);
+}
+
+/* Called at the end of execution, to write out the Hpc *.tix file
  * for this exection. Safe to call, even if coverage is not used.
  */
 void
@@ -357,6 +389,12 @@ exitHpc(void) {
     FILE *f = fopen(tixFilename,"w");
     writeTix(f);
   }
+
+  freeHashTable(moduleHash, (void (*)(void *))freeHpcModuleInfo);
+  moduleHash = NULL;
+
+  stgFree(tixFilename);
+  tixFilename = NULL;
 }
 
 //////////////////////////////////////////////////////////////////////////////
diff --git a/rts/Main.c b/rts/Main.c
index c1b028ff1b..c7a559fc14 100644
--- a/rts/Main.c
+++ b/rts/Main.c
@@ -15,16 +15,10 @@
 #include "Rts.h"
 #include "RtsMain.h"
 
-/* The symbol for the Haskell Main module's init function. It is safe to refer
- * to it here because this Main.o object file will only be linked in if we are
- * linking a Haskell program that uses a Haskell Main.main function.
- */
-extern void __stginit_ZCMain(void);
-
 /* Similarly, we can refer to the ZCMain_main_closure here */
 extern StgClosure ZCMain_main_closure;
 
 int main(int argc, char *argv[])
 {
-    return hs_main(argc, argv, &__stginit_ZCMain, &ZCMain_main_closure);
+    return hs_main(argc, argv, &ZCMain_main_closure);
 }
diff --git a/rts/ProfHeap.c b/rts/ProfHeap.c
index 39b64d4c51..f7fbd321be 100644
--- a/rts/ProfHeap.c
+++ b/rts/ProfHeap.c
@@ -309,7 +309,7 @@ void initProfiling1 (void)
 {
 }
 
-void freeProfiling1 (void)
+void freeProfiling (void)
 {
 }
 
diff --git a/rts/Profiling.c b/rts/Profiling.c
index 1d8627c5b1..5648f31e00 100644
--- a/rts/Profiling.c
+++ b/rts/Profiling.c
@@ -34,9 +34,9 @@ Arena *prof_arena;
  * closure_cats
  */
 
-unsigned int CC_ID;
-unsigned int CCS_ID;
-unsigned int HP_ID;
+unsigned int CC_ID  = 1;
+unsigned int CCS_ID = 1;
+unsigned int HP_ID  = 1;
 
 /* figures for the profiling report.
  */
@@ -58,8 +58,8 @@ CostCentreStack *CCCS;
 /* Linked lists to keep track of cc's and ccs's that haven't
  * been declared in the log file yet
  */
-CostCentre *CC_LIST;
-CostCentreStack *CCS_LIST;
+CostCentre      *CC_LIST  = NULL;
+CostCentreStack *CCS_LIST = NULL;
 
 /*
  * Built-in cost centres and cost-centre stacks:
@@ -152,41 +152,10 @@ initProfiling1 (void)
 
   /* for the benefit of allocate()... */
   CCCS = CCS_SYSTEM;
-  
-  /* Initialize counters for IDs */
-  CC_ID  = 1;
-  CCS_ID = 1;
-  HP_ID  = 1;
-  
-  /* Initialize Declaration lists to NULL */
-  CC_LIST  = NULL;
-  CCS_LIST = NULL;
-
-  /* Register all the cost centres / stacks in the program 
-   * CC_MAIN gets link = 0, all others have non-zero link.
-   */
-  REGISTER_CC(CC_MAIN);
-  REGISTER_CC(CC_SYSTEM);
-  REGISTER_CC(CC_GC);
-  REGISTER_CC(CC_OVERHEAD);
-  REGISTER_CC(CC_SUBSUMED);
-  REGISTER_CC(CC_DONT_CARE);
-  REGISTER_CCS(CCS_MAIN);
-  REGISTER_CCS(CCS_SYSTEM);
-  REGISTER_CCS(CCS_GC);
-  REGISTER_CCS(CCS_OVERHEAD);
-  REGISTER_CCS(CCS_SUBSUMED);
-  REGISTER_CCS(CCS_DONT_CARE);
-
-  CCCS = CCS_OVERHEAD;
-
-  /* cost centres are registered by the per-module 
-   * initialisation code now... 
-   */
 }
 
 void
-freeProfiling1 (void)
+freeProfiling (void)
 {
     arenaFree(prof_arena);
 }
@@ -202,17 +171,36 @@ initProfiling2 (void)
    * information into it.  */
   initProfilingLogFile();
 
+  /* Register all the cost centres / stacks in the program
+   * CC_MAIN gets link = 0, all others have non-zero link.
+   */
+  REGISTER_CC(CC_MAIN);
+  REGISTER_CC(CC_SYSTEM);
+  REGISTER_CC(CC_GC);
+  REGISTER_CC(CC_OVERHEAD);
+  REGISTER_CC(CC_SUBSUMED);
+  REGISTER_CC(CC_DONT_CARE);
+
+  REGISTER_CCS(CCS_SYSTEM);
+  REGISTER_CCS(CCS_GC);
+  REGISTER_CCS(CCS_OVERHEAD);
+  REGISTER_CCS(CCS_SUBSUMED);
+  REGISTER_CCS(CCS_DONT_CARE);
+  REGISTER_CCS(CCS_MAIN);
+
   /* find all the "special" cost centre stacks, and make them children
    * of CCS_MAIN.
    */
-  ASSERT(CCS_MAIN->prevStack == 0);
+  ASSERT(CCS_LIST == CCS_MAIN);
+  CCS_LIST = CCS_LIST->prevStack;
+  CCS_MAIN->prevStack = NULL;
   CCS_MAIN->root = CC_MAIN;
   ccsSetSelected(CCS_MAIN);
   DecCCS(CCS_MAIN);
 
-  for (ccs = CCS_LIST; ccs != CCS_MAIN; ) {
+  for (ccs = CCS_LIST; ccs != NULL; ) {
     next = ccs->prevStack;
-    ccs->prevStack = 0;
+    ccs->prevStack = NULL;
     ActualPush_(CCS_MAIN,ccs->cc,ccs);
     ccs->root = ccs->cc;
     ccs = next;
diff --git a/rts/Profiling.h b/rts/Profiling.h
index 3a4184fba6..e27ad4c5ed 100644
--- a/rts/Profiling.h
+++ b/rts/Profiling.h
@@ -14,9 +14,9 @@
 #include "BeginPrivate.h"
 
 void initProfiling1 (void);
-void freeProfiling1 (void);
 void initProfiling2 (void);
 void endProfiling   (void);
+void freeProfiling  (void);
 
 extern FILE *prof_file;
 extern FILE *hp_file;
diff --git a/rts/RtsMain.c b/rts/RtsMain.c
index b6cf546aea..0ed6df494c 100644
--- a/rts/RtsMain.c
+++ b/rts/RtsMain.c
@@ -28,13 +28,10 @@
 # include <windows.h>
 #endif
 
-extern void __stginit_ZCMain(void);
-
 /* Annoying global vars for passing parameters to real_main() below
  * This is to get around problem with Windows SEH, see hs_main(). */
 static int progargc;
 static char **progargv;
-static void (*progmain_init)(void);   /* This will be __stginit_ZCMain */
 static StgClosure *progmain_closure;  /* This will be ZCMain_main_closure */
 
 /* Hack: we assume that we're building a batch-mode system unless 
@@ -47,7 +44,7 @@ static void real_main(void)
     SchedulerStatus status;
     /* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */
 
-    startupHaskell(progargc,progargv,progmain_init);
+    startupHaskell(progargc,progargv,NULL);
 
     /* kick off the computation by creating the main thread with a pointer
        to mainIO_closure representing the computation of the overall program;
@@ -95,18 +92,17 @@ static void real_main(void)
  * This gets called from a tiny main function which gets linked into each
  * compiled Haskell program that uses a Haskell main function.
  *
- * We expect the caller to pass __stginit_ZCMain for main_init and
- * ZCMain_main_closure for main_closure. The reason we cannot refer to
- * these symbols directly is because we're inside the rts and we do not know
- * for sure that we'll be using a Haskell main function.
+ * We expect the caller to pass ZCMain_main_closure for
+ * main_closure. The reason we cannot refer to this symbol directly
+ * is because we're inside the rts and we do not know for sure that
+ * we'll be using a Haskell main function.
  */
-int hs_main(int argc, char *argv[], void (*main_init)(void), StgClosure *main_closure)
+int hs_main(int argc, char *argv[], StgClosure *main_closure)
 {
     /* We do this dance with argc and argv as otherwise the SEH exception
        stuff (the BEGIN/END CATCH below) on Windows gets confused */
     progargc = argc;
     progargv = argv;
-    progmain_init    = main_init;
     progmain_closure = main_closure;
 
 #if defined(mingw32_HOST_OS)
diff --git a/rts/RtsMain.h b/rts/RtsMain.h
index 4aabc56517..24e58199bb 100644
--- a/rts/RtsMain.h
+++ b/rts/RtsMain.h
@@ -13,6 +13,6 @@
  * The entry point for Haskell programs that use a Haskell main function
  * -------------------------------------------------------------------------- */
 
-int hs_main(int argc, char *argv[], void (*main_init)(void), StgClosure *main_closure);
+int hs_main(int argc, char *argv[], StgClosure *main_closure);
 
 #endif /* RTSMAIN_H */
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index b860667fe4..236d07a9e0 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -224,90 +224,37 @@ hs_init(int *argc, char **argv[])
     x86_init_fpu();
 #endif
 
+    startupHpc();
+
+    // This must be done after module initialisation.
+    // ToDo: make this work in the presence of multiple hs_add_root()s.
+    initProfiling2();
+
+    // ditto.
+#if defined(THREADED_RTS)
+    ioManagerStart();
+#endif
+
     /* Record initialization times */
     stat_endInit();
 }
 
 // Compatibility interface
 void
-startupHaskell(int argc, char *argv[], void (*init_root)(void))
+startupHaskell(int argc, char *argv[], void (*init_root)(void) STG_UNUSED)
 {
     hs_init(&argc, &argv);
-    if(init_root)
-        hs_add_root(init_root);
 }
 
 
 /* -----------------------------------------------------------------------------
-   Per-module initialisation
-
-   This process traverses all the compiled modules in the program
-   starting with "Main", and performing per-module initialisation for
-   each one.
-
-   So far, two things happen at initialisation time:
-
-      - we register stable names for each foreign-exported function
-        in that module.  This prevents foreign-exported entities, and
-	things they depend on, from being garbage collected.
-
-      - we supply a unique integer to each statically declared cost
-        centre and cost centre stack in the program.
-
-   The code generator inserts a small function "__stginit_<module>" in each
-   module and calls the registration functions in each of the modules it
-   imports.
-
-   The init* functions are compiled in the same way as STG code,
-   i.e. without normal C call/return conventions.  Hence we must use
-   StgRun to call this stuff.
+   hs_add_root: backwards compatibility.  (see #3252)
    -------------------------------------------------------------------------- */
 
-/* The init functions use an explicit stack... 
- */
-#define INIT_STACK_BLOCKS  4
-static StgFunPtr *init_stack = NULL;
-
 void
-hs_add_root(void (*init_root)(void))
+hs_add_root(void (*init_root)(void) STG_UNUSED)
 {
-    bdescr *bd;
-    nat init_sp;
-    Capability *cap;
-
-    cap = rts_lock();
-
-    if (hs_init_count <= 0) {
-	barf("hs_add_root() must be called after hs_init()");
-    }
-
-    /* The initialisation stack grows downward, with sp pointing 
-       to the last occupied word */
-    init_sp = INIT_STACK_BLOCKS*BLOCK_SIZE_W;
-    bd = allocGroup_lock(INIT_STACK_BLOCKS);
-    init_stack = (StgFunPtr *)bd->start;
-    init_stack[--init_sp] = (StgFunPtr)stg_init_finish;
-    if (init_root != NULL) {
-	init_stack[--init_sp] = (StgFunPtr)init_root;
-    }
-    
-    cap->r.rSp = (P_)(init_stack + init_sp);
-    StgRun((StgFunPtr)stg_init, &cap->r);
-
-    freeGroup_lock(bd);
-
-    startupHpc();
-
-    // This must be done after module initialisation.
-    // ToDo: make this work in the presence of multiple hs_add_root()s.
-    initProfiling2();
-
-    rts_unlock(cap);
-
-    // ditto.
-#if defined(THREADED_RTS)
-    ioManagerStart();
-#endif
+    /* nothing */
 }
 
 /* ----------------------------------------------------------------------------
@@ -424,7 +371,7 @@ hs_exit_(rtsBool wait_foreign)
 #endif
 
     endProfiling();
-    freeProfiling1();
+    freeProfiling();
 
 #ifdef PROFILING
     // Originally, this was in report_ccs_profiling().  Now, retainer