-codeGen :: FAST_STRING -- module name
- -> ([CostCentre], -- local cost-centres needing declaring/registering
- [CostCentre]) -- "extern" cost-centres needing declaring
- -> [FAST_STRING] -- import names
- -> (GlobalSwitch -> SwitchResult)
- -- global switch lookup function
- -> [TyCon] -- tycons with data constructors to convert
- -> FiniteMap TyCon [[Maybe UniType]]
- -- tycon specialisation info
- -> PlainStgProgram -- bindings to convert
- -> AbstractC -- output
-
-codeGen mod_name (local_CCs, extern_CCs) import_names sw_lookup_fn gen_tycons tycon_specs stg_pgm
- = let
- switch_is_on = switchIsOn sw_lookup_fn
- doing_profiling = switch_is_on SccProfilingOn
- compiling_prelude = switch_is_on CompilingPrelude
- splitting = switch_is_on (EnsureSplittableC (panic "codeGen:esc"))
- in
- if not doing_profiling then
- let
- cinfo = MkCompInfo switch_is_on mod_name
- in
- mkAbstractCs [
- genStaticConBits cinfo gen_tycons tycon_specs,
- initC cinfo (cgTopBindings splitting stg_pgm) ]
-
- else -- yes, cost-centre profiling:
- -- Besides the usual stuff, we must produce:
- --
- -- * Declarations for the cost-centres defined in this module;
- -- * Code to participate in "registering" all the cost-centres
- -- in the program (done at startup time when the pgm is run).
- --
- -- (The local cost-centres involved in this are passed
- -- into the code-generator, as are the imported-modules' names.)
- --
- -- Note: we don't register/etc if compiling Prelude bits.
- let
- cinfo = MkCompInfo switch_is_on mod_name
- in
- mkAbstractCs [
- if compiling_prelude
- then AbsCNop
- else mkAbstractCs [mkAbstractCs (map (CCostCentreDecl True) local_CCs),
- mkAbstractCs (map (CCostCentreDecl False) extern_CCs),
- mkCcRegister local_CCs import_names],
-
- genStaticConBits cinfo gen_tycons tycon_specs,
- initC cinfo (cgTopBindings splitting stg_pgm) ]
+mkModuleInit
+ :: DynFlags
+ -> HomeModules
+ -> String -- the "way"
+ -> CollectedCCs -- cost centre info
+ -> Module
+ -> Module -- name of the Main module
+ -> ForeignStubs
+ -> [Module]
+ -> Code
+mkModuleInit dflags hmods way cost_centre_info this_mod main_mod foreign_stubs imported_mods
+ = do {
+ if opt_SccProfilingOn
+ then do { -- Allocate the static boolean that records if this
+ -- module has been registered already
+ emitData Data [CmmDataLabel moduleRegdLabel,
+ CmmStaticLit zeroCLit]
+
+ ; 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)
+ }
+ }
+ else emitSimpleProc real_init_lbl ret_code
+
+ -- 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
+ ; whenC (this_mod == main_mod)
+ (emitSimpleProc plain_main_init_lbl jump_to_init)
+ }