-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