functions drive the mangling of top-level bindings.
\begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
module CodeGen ( codeGen ) where
#include "HsVersions.h"
import CgHpc
import CLabel
-import Cmm
-import CmmUtils
-import PprCmm
+import OldCmm
+import OldCmmUtils
+import OldPprCmm
import StgSyn
import PrelNames
import DynFlags
import StaticFlags
-import PackageConfig
import HscTypes
import CostCentre
import Id
import Name
-import OccName
-import Outputable
import TyCon
import Module
import ErrUtils
cost_centre_info stg_binds hpc_info
= do
{ showPass dflags "CodeGen"
- ; let way = buildTag dflags
- main_mod = mainModIs dflags
-- Why?
-- ; mapM_ (\x -> seq x (return ())) data_tycons
; 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 way cost_centre_info
- this_mod main_mod
- imported_mods hpc_info)
+ ; cmm_init <- getCmm (mkModuleInit dflags cost_centre_info
+ this_mod imported_mods hpc_info)
; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init])
}
-- Put datatype_stuff after code_stuff, because the
\begin{code}
mkModuleInit
- :: String -- the "way"
+ :: DynFlags
-> CollectedCCs -- cost centre info
-> Module
- -> Module -- name of the Main module
-> [Module]
-> HpcInfo
-> Code
-mkModuleInit way cost_centre_info this_mod main_mod imported_mods hpc_info
+mkModuleInit dflags cost_centre_info this_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
+ -- The way string we attach to the __stginit label to catch
+ -- accidental linking of modules compiled in different ways. We
+ -- omit "dyn" from this way, because we want to be able to load
+ -- both dynamic and non-dynamic modules into a dynamic GHC.
+ way = mkBuildTag (filter want_way (ways dflags))
+ want_way w = not (wayRTSOnly w) && wayName w /= WayDyn
+
+ main_mod = mainModIs dflags
+
plain_init_lbl = mkPlainModuleInitLabel this_mod
real_init_lbl = mkModuleInitLabel this_mod way
plain_main_init_lbl = mkPlainModuleInitLabel rOOT_MAIN
; nopC }
mkSRT :: [Id] -> (Id,[Id]) -> Code
-mkSRT these (id,[]) = nopC
+mkSRT _ (_,[]) = nopC
mkSRT these (id,ids)
= do { ids <- mapFCs remap ids
; id <- remap id
-- 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)