-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.
-
- ; emitSimpleProc real_init_lbl $ withFreshLabel "ret_block" $ \retId -> catAGraphs
- [ check_already_done retId
- , init_prof
- , init_hpc
- , catAGraphs $ map (registerImport way) all_imported_mods
- , mkBranch retId ]
- -- 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
- plain_init_lbl = mkPlainModuleInitLabel this_mod
- real_init_lbl = mkModuleInitLabel this_mod way
- plain_main_init_lbl = mkPlainModuleInitLabel rOOT_MAIN
-
- jump_to_init = mkJump (mkLblExpr real_init_lbl) []
-
-
- -- 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
-
- mod_reg_val = CmmLoad (mkLblExpr moduleRegdLabel) bWord
- check_already_done retId
- = mkCmmIfThenElse (cmmNeWord (CmmLit zeroCLit) mod_reg_val)
- (mkLabel retId Nothing <*> mkReturn []) 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 jumpd to the popped item
- ret_code = mkAssign spReg (cmmRegOffW spReg 1)
- <*> mkJump (CmmLoad (cmmRegOffW spReg (-1)) bWord) []
-
- rec_descent_init = if opt_SccProfilingOn || isHpcUsed hpc_info
- then jump_to_init
- else ret_code
-
------------------------
-registerImport :: String -> Module -> CmmAGraph
-registerImport way mod
- | mod == gHC_PRIM
- = mkNop
- | otherwise -- Push the init procedure onto the work stack
- = mkCmmCall init_lbl [] [] NoC_SRT
- where
- init_lbl = mkLblExpr $ mkModuleInitLabel mod way
-