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.

6 files changed, 54 insertions, 432 deletions

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 ()