X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcodeGen%2FCodeGen.lhs;h=106fcc1cf1af08957f46394790d2b1fa8527db1e;hp=64ee9e4c4b309fe48282c692181908663600161d;hb=703ca1542c8e0983cc9d8eebce6e9f3dd3fd71e2;hpb=81b2276ff9434d97aff683218c34c86479a8d868 diff --git a/compiler/codeGen/CodeGen.lhs b/compiler/codeGen/CodeGen.lhs index 64ee9e4..106fcc1 100644 --- a/compiler/codeGen/CodeGen.lhs +++ b/compiler/codeGen/CodeGen.lhs @@ -31,40 +31,37 @@ import CLabel import Cmm import CmmUtils import PprCmm -import MachOp import StgSyn import PrelNames import DynFlags import StaticFlags -import PackageConfig import HscTypes import CostCentre import Id import Name -import OccName import TyCon import Module import ErrUtils - -#ifdef DEBUG import Panic -#endif \end{code} \begin{code} codeGen :: DynFlags -> Module -> [TyCon] - -> ForeignStubs -> [Module] -- directly-imported modules -> 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 foreign_stubs imported_mods + -- N.B. returning '[Cmm]' and not 'Cmm' here makes it + -- 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 = do { showPass dflags "CodeGen" @@ -79,7 +76,7 @@ codeGen dflags this_mod data_tycons foreign_stubs imported_mods ; cmm_tycons <- mapM cgTyCon data_tycons ; cmm_init <- getCmm (mkModuleInit way cost_centre_info this_mod main_mod - foreign_stubs imported_mods hpc_info) + imported_mods hpc_info) ; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init]) } -- Put datatype_stuff after code_stuff, because the @@ -141,11 +138,10 @@ mkModuleInit -> CollectedCCs -- cost centre info -> Module -> Module -- name of the Main module - -> ForeignStubs -> [Module] -> HpcInfo -> Code -mkModuleInit way cost_centre_info this_mod main_mod foreign_stubs imported_mods hpc_info +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, @@ -192,7 +188,7 @@ mkModuleInit way cost_centre_info this_mod main_mod foreign_stubs imported_mods jump_to_init = stmtC (CmmJump (mkLblExpr real_init_lbl) []) - mod_reg_val = CmmLoad (mkLblExpr moduleRegdLabel) wordRep + mod_reg_val = CmmLoad (mkLblExpr moduleRegdLabel) bWord -- Main refers to GHC.TopHandler.runIO, so make sure we call the -- init function for GHC.TopHandler. @@ -218,7 +214,7 @@ mkModuleInit way cost_centre_info this_mod main_mod foreign_stubs 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)) wordRep) [] ] + , CmmJump (CmmLoad (cmmRegOffW spReg (-1)) bWord) [] ] rec_descent_init = if opt_SccProfilingOn || isHpcUsed hpc_info @@ -293,12 +289,12 @@ cgTopBinding dflags (StgRec pairs, srts) ; nopC } mkSRT :: [Id] -> (Id,[Id]) -> Code -mkSRT these (id,[]) = nopC +mkSRT _ (_,[]) = nopC mkSRT these (id,ids) = do { ids <- mapFCs remap ids ; id <- remap id - ; emitRODataLits (mkSRTLabel (idName id)) - (map (CmmLabel . mkClosureLabel . idName) ids) + ; emitRODataLits "CodeGen.mkSRT" (mkSRTLabel (idName id) (idCafInfo id)) + (map (\id -> CmmLabel $ mkClosureLabel (idName id) (idCafInfo id)) ids) } where -- Sigh, better map all the ids against the environment in @@ -315,12 +311,12 @@ cgTopRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo) -- The Id is passed along for setting up a binding... -- It's already been externalised if necessary -cgTopRhs bndr (StgRhsCon cc con args) +cgTopRhs bndr (StgRhsCon _cc con args) = forkStatics (cgTopRhsCon bndr con args) cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag srt args body) = ASSERT(null fvs) -- There should be no free variables - setSRTLabel (mkSRTLabel (idName bndr)) $ + setSRTLabel (mkSRTLabel (idName bndr) (idCafInfo bndr)) $ setSRT srt $ forkStatics (cgTopRhsClosure bndr cc bi upd_flag args body) \end{code}