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"
; code_stuff <- initC dflags this_mod $ do
{ cmm_binds <- mapM (getCmm . cgTopBinding dflags) stg_binds
; cmm_tycons <- mapM cgTyCon data_tycons
- ; cmm_init <- getCmm (mkModuleInit dflags way cost_centre_info
+ ; 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
\begin{code}
mkModuleInit
- :: DynFlags
- -> String -- the "way"
+ :: String -- the "way"
-> CollectedCCs -- cost centre info
-> Module
-> Module -- name of the Main module
- -> ForeignStubs
-> [Module]
-> HpcInfo
-> Code
-mkModuleInit dflags 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,
(emitSimpleProc plain_main_init_lbl rec_descent_init)
}
where
- this_pkg = thisPackage dflags
-
- plain_init_lbl = mkPlainModuleInitLabel this_pkg this_mod
- real_init_lbl = mkModuleInitLabel this_pkg this_mod way
- plain_main_init_lbl = mkPlainModuleInitLabel this_pkg rOOT_MAIN
+ plain_init_lbl = mkPlainModuleInitLabel this_mod
+ real_init_lbl = mkModuleInitLabel this_mod way
+ plain_main_init_lbl = mkPlainModuleInitLabel rOOT_MAIN
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.
; whenC (opt_Hpc) $
initHpc this_mod hpc_info
- ; mapCs (registerModuleImport this_pkg way)
+ ; mapCs (registerModuleImport way)
(imported_mods++extra_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 || opt_Hpc
+ rec_descent_init = if opt_SccProfilingOn || isHpcUsed hpc_info
then jump_to_init
else ret_code
-----------------------
-registerModuleImport :: PackageId -> String -> Module -> Code
-registerModuleImport this_pkg way mod
+registerModuleImport :: String -> Module -> Code
+registerModuleImport 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 this_pkg mod way)) ]
+ , CmmStore (CmmReg spReg) (mkLblExpr (mkModuleInitLabel mod way)) ]
\end{code}
cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> Code
cgTopBinding dflags (StgNonRec id rhs, srts)
= do { id' <- maybeExternaliseId dflags id
- ; mapM_ (mkSRT (thisPackage dflags) [id']) srts
+ ; mapM_ (mkSRT [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
= do { let (bndrs, rhss) = unzip pairs
; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs
; let pairs' = zip bndrs' rhss
- ; mapM_ (mkSRT (thisPackage dflags) bndrs') srts
+ ; mapM_ (mkSRT bndrs') srts
; _new_binds <- fixC (\ new_binds -> do
{ addBindsC new_binds
; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' })
; nopC }
-mkSRT :: PackageId -> [Id] -> (Id,[Id]) -> Code
-mkSRT this_pkg these (id,[]) = nopC
-mkSRT this_pkg these (id,ids)
+mkSRT :: [Id] -> (Id,[Id]) -> Code
+mkSRT _ (_,[]) = nopC
+mkSRT these (id,ids)
= do { ids <- mapFCs remap ids
; id <- remap id
- ; emitRODataLits (mkSRTLabel (idName id))
- (map (CmmLabel . mkClosureLabel this_pkg . 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
-- 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)) $
- forkStatics (cgTopRhsClosure bndr cc bi srt upd_flag args body)
+ setSRTLabel (mkSRTLabel (idName bndr) (idCafInfo bndr)) $
+ setSRT srt $
+ forkStatics (cgTopRhsClosure bndr cc bi upd_flag args body)
\end{code}
projects / ghc-hetmet.git / blobdiff