diff options
Diffstat (limited to 'ghc/compiler/codeGen/CodeGen.lhs')
| -rw-r--r-- | ghc/compiler/codeGen/CodeGen.lhs | 47 |
1 files changed, 25 insertions, 22 deletions
diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs index 1aa48656f5..1ea944c2c0 100644 --- a/ghc/compiler/codeGen/CodeGen.lhs +++ b/ghc/compiler/codeGen/CodeGen.lhs @@ -29,7 +29,7 @@ import CgBindery ( CgIdInfo, addBindC, addBindsC, getCgIdInfo, cgIdInfoId ) import CgClosure ( cgTopRhsClosure ) import CgCon ( cgTopRhsCon, cgTyCon ) -import CgUtils ( cmmRegOffW, emitRODataLits, cmmNeWord, emitRtsCall ) +import CgUtils ( cmmRegOffW, emitRODataLits, cmmNeWord ) import CLabel import Cmm @@ -39,6 +39,7 @@ import MachOp ( wordRep, MachHint(..) ) import StgSyn import PrelNames ( gHC_PRIM, rOOT_MAIN, mAIN, pREL_TOP_HANDLER ) +import Packages ( HomeModules ) import DynFlags ( DynFlags(..), DynFlag(..), dopt ) import StaticFlags ( opt_SccProfilingOn ) @@ -59,6 +60,7 @@ import Outputable \begin{code} codeGen :: DynFlags + -> HomeModules -> Module -> [TyCon] -> ForeignStubs @@ -67,7 +69,7 @@ codeGen :: DynFlags -> [(StgBinding,[(Id,[Id])])] -- Bindings to convert, with SRTs -> IO [Cmm] -- Output -codeGen dflags this_mod data_tycons foreign_stubs imported_mods +codeGen dflags hmods this_mod data_tycons foreign_stubs imported_mods cost_centre_info stg_binds = do { showPass dflags "CodeGen" @@ -77,10 +79,10 @@ codeGen dflags this_mod data_tycons foreign_stubs imported_mods -- Why? -- ; mapM_ (\x -> seq x (return ())) data_tycons - ; code_stuff <- initC dflags this_mod $ do - { cmm_binds <- mapM (getCmm . cgTopBinding dflags) stg_binds + ; code_stuff <- initC dflags hmods this_mod $ do + { cmm_binds <- mapM (getCmm . cgTopBinding dflags hmods) stg_binds ; cmm_tycons <- mapM cgTyCon data_tycons - ; cmm_init <- getCmm (mkModuleInit dflags way cost_centre_info + ; cmm_init <- getCmm (mkModuleInit dflags hmods way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mods) ; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init]) @@ -141,6 +143,7 @@ We initialise the module tree by keeping a work-stack, \begin{code} mkModuleInit :: DynFlags + -> HomeModules -> String -- the "way" -> CollectedCCs -- cost centre info -> Module @@ -148,7 +151,7 @@ mkModuleInit -> ForeignStubs -> [Module] -> Code -mkModuleInit dflags way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mods +mkModuleInit dflags hmods way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mods = do { if opt_SccProfilingOn then do { -- Allocate the static boolean that records if this @@ -181,9 +184,9 @@ mkModuleInit dflags way cost_centre_info this_mod mb_main_mod foreign_stubs impo (emitSimpleProc plain_main_init_lbl jump_to_init) } where - plain_init_lbl = mkPlainModuleInitLabel dflags this_mod - real_init_lbl = mkModuleInitLabel dflags this_mod way - plain_main_init_lbl = mkPlainModuleInitLabel dflags rOOT_MAIN + plain_init_lbl = mkPlainModuleInitLabel hmods this_mod + real_init_lbl = mkModuleInitLabel hmods this_mod way + plain_main_init_lbl = mkPlainModuleInitLabel hmods rOOT_MAIN jump_to_init = stmtC (CmmJump (mkLblExpr real_init_lbl) []) @@ -205,7 +208,7 @@ mkModuleInit dflags way cost_centre_info this_mod mb_main_mod foreign_stubs impo -- Now do local stuff ; initCostCentres cost_centre_info - ; mapCs (registerModuleImport dflags way) + ; mapCs (registerModuleImport hmods way) (imported_mods++extra_imported_mods) } @@ -215,13 +218,13 @@ mkModuleInit dflags way cost_centre_info this_mod mb_main_mod foreign_stubs impo , CmmJump (CmmLoad (cmmRegOffW spReg (-1)) wordRep) [] ] ----------------------- -registerModuleImport :: DynFlags -> String -> Module -> Code -registerModuleImport dflags way mod +registerModuleImport :: HomeModules -> String -> Module -> Code +registerModuleImport hmods 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 dflags mod way)) ] + , CmmStore (CmmReg spReg) (mkLblExpr (mkModuleInitLabel hmods mod way)) ] \end{code} @@ -262,32 +265,32 @@ style, with the increasing static environment being plumbed as a state variable. \begin{code} -cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> Code -cgTopBinding dflags (StgNonRec id rhs, srts) +cgTopBinding :: DynFlags -> HomeModules -> (StgBinding,[(Id,[Id])]) -> Code +cgTopBinding dflags hmods (StgNonRec id rhs, srts) = do { id' <- maybeExternaliseId dflags id - ; mapM_ (mkSRT dflags [id']) srts + ; mapM_ (mkSRT hmods [id']) srts ; (id,info) <- cgTopRhs id' rhs ; addBindC id info -- Add the *un-externalised* Id to the envt, -- so we find it when we look up occurrences } -cgTopBinding dflags (StgRec pairs, srts) +cgTopBinding dflags hmods (StgRec pairs, srts) = do { let (bndrs, rhss) = unzip pairs ; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs ; let pairs' = zip bndrs' rhss - ; mapM_ (mkSRT dflags bndrs') srts + ; mapM_ (mkSRT hmods bndrs') srts ; _new_binds <- fixC (\ new_binds -> do { addBindsC new_binds ; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' }) ; nopC } -mkSRT :: DynFlags -> [Id] -> (Id,[Id]) -> Code -mkSRT dflags these (id,[]) = nopC -mkSRT dflags these (id,ids) +mkSRT :: HomeModules -> [Id] -> (Id,[Id]) -> Code +mkSRT hmods these (id,[]) = nopC +mkSRT hmods these (id,ids) = do { ids <- mapFCs remap ids ; id <- remap id ; emitRODataLits (mkSRTLabel (idName id)) - (map (CmmLabel . mkClosureLabel dflags . idName) ids) + (map (CmmLabel . mkClosureLabel hmods . idName) ids) } where -- Sigh, better map all the ids against the environment in |