Commit a52ff761 authored by Simon Marlow's avatar Simon Marlow
Browse files

Change the way module initialisation is done (#3252, #4417)

Previously the code generator generated small code fragments labelled
with __stginit_M for each module M, and these performed whatever
initialisation was necessary for that module and recursively invoked
the initialisation functions for imported modules.  This appraoch had
drawbacks:

 - FFI users had to call hs_add_root() to ensure the correct
   initialisation routines were called.  This is a non-standard,
   and ugly, API.

 - unless we were using -split-objs, the __stginit dependencies would
   entail linking the whole transitive closure of modules imported,
   whether they were actually used or not.  In an extreme case (#4387,
   #4417), a module from GHC might be imported for use in Template
   Haskell or an annotation, and that would force the whole of GHC to
   be needlessly linked into the final executable.

So now instead we do our initialisation with C functions marked with
__attribute__((constructor)), which are automatically invoked at
program startup time (or DSO load-time).  The C initialisers are
emitted into the stub.c file.  This means that every time we compile
with -prof or -hpc, we now get a stub file, but thanks to #3687 that
is now invisible to the user.

There are some refactorings in the RTS (particularly for HPC) to
handle the fact that initialisers now get run earlier than they did
before.

The __stginit symbols are still generated, and the hs_add_root()
function still exists (but does nothing), for backwards compatibility.
parent 5463b55b
...@@ -484,6 +484,31 @@ AC_SUBST([LdXFlag]) ...@@ -484,6 +484,31 @@ AC_SUBST([LdXFlag])
])# FP_PROG_LD_X ])# FP_PROG_LD_X
# FP_PROG_LD_BUILD_ID
# ------------
# Sets the output variable LdHasBuildId to YES if ld supports
# --build-id, or NO otherwise.
AC_DEFUN([FP_PROG_LD_BUILD_ID],
[
AC_CACHE_CHECK([whether ld understands --build-id], [fp_cv_ld_build_id],
[echo 'foo() {}' > conftest.c
${CC-cc} -c conftest.c
if ${LdCmd} -r --build-id=none -o conftest2.o conftest.o > /dev/null 2>&1; then
fp_cv_ld_build_id=yes
else
fp_cv_ld_build_id=no
fi
rm -rf conftest*])
if test "$fp_cv_ld_build_id" = yes; then
LdHasBuildId=YES
else
LdHasBuildId=NO
fi
AC_SUBST([LdHasBuildId])
])# FP_PROG_LD_BUILD_ID
# FP_PROG_LD_IS_GNU # FP_PROG_LD_IS_GNU
# ----------------- # -----------------
# Sets the output variable LdIsGNULd to YES or NO, depending on whether it is # Sets the output variable LdIsGNULd to YES or NO, depending on whether it is
......
...@@ -51,9 +51,7 @@ module CLabel ( ...@@ -51,9 +51,7 @@ module CLabel (
mkAsmTempLabel, mkAsmTempLabel,
mkModuleInitLabel, mkPlainModuleInitLabel,
mkPlainModuleInitLabel,
mkModuleInitTableLabel,
mkSplitMarkerLabel, mkSplitMarkerLabel,
mkDirty_MUT_VAR_Label, mkDirty_MUT_VAR_Label,
...@@ -70,10 +68,7 @@ module CLabel ( ...@@ -70,10 +68,7 @@ module CLabel (
mkRtsPrimOpLabel, mkRtsPrimOpLabel,
mkRtsSlowTickyCtrLabel, mkRtsSlowTickyCtrLabel,
moduleRegdLabel, mkSelectorInfoLabel,
moduleRegTableLabel,
mkSelectorInfoLabel,
mkSelectorEntryLabel, mkSelectorEntryLabel,
mkCmmInfoLabel, mkCmmInfoLabel,
...@@ -102,7 +97,6 @@ module CLabel ( ...@@ -102,7 +97,6 @@ module CLabel (
mkDeadStripPreventer, mkDeadStripPreventer,
mkHpcTicksLabel, mkHpcTicksLabel,
mkHpcModuleNameLabel,
hasCAF, hasCAF,
infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl, infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,
...@@ -202,23 +196,9 @@ data CLabel ...@@ -202,23 +196,9 @@ data CLabel
| StringLitLabel | StringLitLabel
{-# UNPACK #-} !Unique {-# UNPACK #-} !Unique
| ModuleInitLabel | PlainModuleInitLabel -- without the version & way info
Module -- the module name
String -- its "way"
-- at some point we might want some kind of version number in
-- the module init label, to guard against compiling modules in
-- the wrong order. We can't use the interface file version however,
-- because we don't always recompile modules which depend on a module
-- whose version has changed.
| PlainModuleInitLabel -- without the version & way info
Module Module
| ModuleInitTableLabel -- table of imported modules to init
Module
| ModuleRegdLabel
| CC_Label CostCentre | CC_Label CostCentre
| CCS_Label CostCentreStack | CCS_Label CostCentreStack
...@@ -242,9 +222,6 @@ data CLabel ...@@ -242,9 +222,6 @@ data CLabel
-- | Per-module table of tick locations -- | Per-module table of tick locations
| HpcTicksLabel Module | HpcTicksLabel Module
-- | Per-module name of the module for Hpc
| HpcModuleNameLabel
-- | Label of an StgLargeSRT -- | Label of an StgLargeSRT
| LargeSRTLabel | LargeSRTLabel
{-# UNPACK #-} !Unique {-# UNPACK #-} !Unique
...@@ -490,7 +467,6 @@ mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat) ...@@ -490,7 +467,6 @@ mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
-- Constructing Code Coverage Labels -- Constructing Code Coverage Labels
mkHpcTicksLabel = HpcTicksLabel mkHpcTicksLabel = HpcTicksLabel
mkHpcModuleNameLabel = HpcModuleNameLabel
-- Constructing labels used for dynamic linking -- Constructing labels used for dynamic linking
...@@ -515,19 +491,9 @@ mkStringLitLabel = StringLitLabel ...@@ -515,19 +491,9 @@ mkStringLitLabel = StringLitLabel
mkAsmTempLabel :: Uniquable a => a -> CLabel mkAsmTempLabel :: Uniquable a => a -> CLabel
mkAsmTempLabel a = AsmTempLabel (getUnique a) mkAsmTempLabel a = AsmTempLabel (getUnique a)
mkModuleInitLabel :: Module -> String -> CLabel
mkModuleInitLabel mod way = ModuleInitLabel mod way
mkPlainModuleInitLabel :: Module -> CLabel mkPlainModuleInitLabel :: Module -> CLabel
mkPlainModuleInitLabel mod = PlainModuleInitLabel mod mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
mkModuleInitTableLabel :: Module -> CLabel
mkModuleInitTableLabel mod = ModuleInitTableLabel mod
moduleRegdLabel = ModuleRegdLabel
moduleRegTableLabel = ModuleInitTableLabel
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- Converting between info labels and entry/ret labels. -- Converting between info labels and entry/ret labels.
...@@ -591,10 +557,7 @@ needsCDecl (LargeSRTLabel _) = False ...@@ -591,10 +557,7 @@ needsCDecl (LargeSRTLabel _) = False
needsCDecl (LargeBitmapLabel _) = False needsCDecl (LargeBitmapLabel _) = False
needsCDecl (IdLabel _ _ _) = True needsCDecl (IdLabel _ _ _) = True
needsCDecl (CaseLabel _ _) = True needsCDecl (CaseLabel _ _) = True
needsCDecl (ModuleInitLabel _ _) = True needsCDecl (PlainModuleInitLabel _) = True
needsCDecl (PlainModuleInitLabel _) = True
needsCDecl (ModuleInitTableLabel _) = True
needsCDecl ModuleRegdLabel = False
needsCDecl (StringLitLabel _) = False needsCDecl (StringLitLabel _) = False
needsCDecl (AsmTempLabel _) = False needsCDecl (AsmTempLabel _) = False
...@@ -612,7 +575,6 @@ needsCDecl l@(ForeignLabel{}) = not (isMathFun l) ...@@ -612,7 +575,6 @@ needsCDecl l@(ForeignLabel{}) = not (isMathFun l)
needsCDecl (CC_Label _) = True needsCDecl (CC_Label _) = True
needsCDecl (CCS_Label _) = True needsCDecl (CCS_Label _) = True
needsCDecl (HpcTicksLabel _) = True needsCDecl (HpcTicksLabel _) = True
needsCDecl HpcModuleNameLabel = False
-- | Check whether a label is a local temporary for native code generation -- | Check whether a label is a local temporary for native code generation
...@@ -725,11 +687,8 @@ externallyVisibleCLabel :: CLabel -> Bool -- not C "static" ...@@ -725,11 +687,8 @@ externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
externallyVisibleCLabel (CaseLabel _ _) = False externallyVisibleCLabel (CaseLabel _ _) = False
externallyVisibleCLabel (StringLitLabel _) = False externallyVisibleCLabel (StringLitLabel _) = False
externallyVisibleCLabel (AsmTempLabel _) = False externallyVisibleCLabel (AsmTempLabel _) = False
externallyVisibleCLabel (ModuleInitLabel _ _) = True
externallyVisibleCLabel (PlainModuleInitLabel _)= True externallyVisibleCLabel (PlainModuleInitLabel _)= True
externallyVisibleCLabel (ModuleInitTableLabel _)= False externallyVisibleCLabel (RtsLabel _) = True
externallyVisibleCLabel ModuleRegdLabel = False
externallyVisibleCLabel (RtsLabel _) = True
externallyVisibleCLabel (CmmLabel _ _ _) = True externallyVisibleCLabel (CmmLabel _ _ _) = True
externallyVisibleCLabel (ForeignLabel{}) = True externallyVisibleCLabel (ForeignLabel{}) = True
externallyVisibleCLabel (IdLabel name _ _) = isExternalName name externallyVisibleCLabel (IdLabel name _ _) = isExternalName name
...@@ -737,8 +696,7 @@ externallyVisibleCLabel (CC_Label _) = True ...@@ -737,8 +696,7 @@ externallyVisibleCLabel (CC_Label _) = True
externallyVisibleCLabel (CCS_Label _) = True externallyVisibleCLabel (CCS_Label _) = True
externallyVisibleCLabel (DynamicLinkerLabel _ _) = False externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
externallyVisibleCLabel (HpcTicksLabel _) = True externallyVisibleCLabel (HpcTicksLabel _) = True
externallyVisibleCLabel HpcModuleNameLabel = False externallyVisibleCLabel (LargeBitmapLabel _) = False
externallyVisibleCLabel (LargeBitmapLabel _) = False
externallyVisibleCLabel (LargeSRTLabel _) = False externallyVisibleCLabel (LargeSRTLabel _) = False
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
...@@ -777,9 +735,7 @@ labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel ...@@ -777,9 +735,7 @@ labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
labelType (RtsLabel (RtsApFast _)) = CodeLabel labelType (RtsLabel (RtsApFast _)) = CodeLabel
labelType (CaseLabel _ CaseReturnInfo) = DataLabel labelType (CaseLabel _ CaseReturnInfo) = DataLabel
labelType (CaseLabel _ _) = CodeLabel labelType (CaseLabel _ _) = CodeLabel
labelType (ModuleInitLabel _ _) = CodeLabel
labelType (PlainModuleInitLabel _) = CodeLabel labelType (PlainModuleInitLabel _) = CodeLabel
labelType (ModuleInitTableLabel _) = DataLabel
labelType (LargeSRTLabel _) = DataLabel labelType (LargeSRTLabel _) = DataLabel
labelType (LargeBitmapLabel _) = DataLabel labelType (LargeBitmapLabel _) = DataLabel
labelType (ForeignLabel _ _ _ IsFunction) = CodeLabel labelType (ForeignLabel _ _ _ IsFunction) = CodeLabel
...@@ -837,10 +793,8 @@ labelDynamic this_pkg lbl = ...@@ -837,10 +793,8 @@ labelDynamic this_pkg lbl =
CmmLabel pkg _ _ -> True CmmLabel pkg _ _ -> True
#endif #endif
ModuleInitLabel m _ -> not opt_Static && this_pkg /= (modulePackageId m)
PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m) PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
ModuleInitTableLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
-- Note that DynamicLinkerLabels do NOT require dynamic linking themselves. -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
_ -> False _ -> False
...@@ -1008,9 +962,6 @@ pprCLbl (RtsLabel (RtsPrimOp primop)) ...@@ -1008,9 +962,6 @@ pprCLbl (RtsLabel (RtsPrimOp primop))
pprCLbl (RtsLabel (RtsSlowTickyCtr pat)) pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
= ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr") = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
pprCLbl ModuleRegdLabel
= ptext (sLit "_module_registered")
pprCLbl (ForeignLabel str _ _ _) pprCLbl (ForeignLabel str _ _ _)
= ftext str = ftext str
...@@ -1019,22 +970,12 @@ pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor ...@@ -1019,22 +970,12 @@ pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor
pprCLbl (CC_Label cc) = ppr cc pprCLbl (CC_Label cc) = ppr cc
pprCLbl (CCS_Label ccs) = ppr ccs pprCLbl (CCS_Label ccs) = ppr ccs
pprCLbl (ModuleInitLabel mod way)
= ptext (sLit "__stginit_") <> ppr mod
<> char '_' <> text way
pprCLbl (PlainModuleInitLabel mod) pprCLbl (PlainModuleInitLabel mod)
= ptext (sLit "__stginit_") <> ppr mod = ptext (sLit "__stginit_") <> ppr mod
pprCLbl (ModuleInitTableLabel mod)
= ptext (sLit "__stginittable_") <> ppr mod
pprCLbl (HpcTicksLabel mod) pprCLbl (HpcTicksLabel mod)
= ptext (sLit "_hpc_tickboxes_") <> ppr mod <> ptext (sLit "_hpc") = ptext (sLit "_hpc_tickboxes_") <> ppr mod <> ptext (sLit "_hpc")
pprCLbl HpcModuleNameLabel
= ptext (sLit "_hpc_module_name_str")
ppIdFlavor :: IdLabelInfo -> SDoc ppIdFlavor :: IdLabelInfo -> SDoc
ppIdFlavor x = pp_cSEP <> ppIdFlavor x = pp_cSEP <>
(case x of (case x of
......
...@@ -105,18 +105,19 @@ pprTop (CmmProc info clbl (ListGraph blocks)) = ...@@ -105,18 +105,19 @@ pprTop (CmmProc info clbl (ListGraph blocks)) =
then pprDataExterns info $$ then pprDataExterns info $$
pprWordArray (entryLblToInfoLbl clbl) info pprWordArray (entryLblToInfoLbl clbl) info
else empty) $$ else empty) $$
(case blocks of (vcat [
[] -> empty
-- the first block doesn't get a label:
(BasicBlock _ stmts : rest) -> vcat [
blankLine, blankLine,
extern_decls, extern_decls,
(if (externallyVisibleCLabel clbl) (if (externallyVisibleCLabel clbl)
then mkFN_ else mkIF_) (pprCLabel clbl) <+> lbrace, then mkFN_ else mkIF_) (pprCLabel clbl) <+> lbrace,
nest 8 temp_decls, nest 8 temp_decls,
nest 8 mkFB_, nest 8 mkFB_,
nest 8 (vcat (map pprStmt stmts)) $$ case blocks of
vcat (map pprBBlock rest), [] -> empty
-- the first block doesn't get a label:
(BasicBlock _ stmts : rest) ->
nest 8 (vcat (map pprStmt stmts)) $$
vcat (map pprBBlock rest),
nest 8 mkFE_, nest 8 mkFE_,
rbrace ] rbrace ]
) )
......
...@@ -6,24 +6,14 @@ ...@@ -6,24 +6,14 @@
-- --
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module CgHpc (cgTickBox, initHpc, hpcTable) where module CgHpc (cgTickBox, hpcTable) where
import OldCmm import OldCmm
import CLabel import CLabel
import Module import Module
import OldCmmUtils import OldCmmUtils
import CgUtils
import CgMonad import CgMonad
import CgForeignCall
import ForeignCall
import ClosureInfo
import FastString
import HscTypes import HscTypes
import Panic
import BasicTypes
import Data.Char
import Data.Word
cgTickBox :: Module -> Int -> Code cgTickBox :: Module -> Int -> Code
cgTickBox mod n = do cgTickBox mod n = do
...@@ -40,47 +30,10 @@ cgTickBox mod n = do ...@@ -40,47 +30,10 @@ cgTickBox mod n = do
hpcTable :: Module -> HpcInfo -> Code hpcTable :: Module -> HpcInfo -> Code
hpcTable this_mod (HpcInfo hpc_tickCount _) = do hpcTable this_mod (HpcInfo hpc_tickCount _) = do
emitData ReadOnlyData
[ CmmDataLabel mkHpcModuleNameLabel
, CmmString $ map (fromIntegral . ord)
(full_name_str)
++ [0]
]
emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod) emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
] ++ ] ++
[ CmmStaticLit (CmmInt 0 W64) [ CmmStaticLit (CmmInt 0 W64)
| _ <- take hpc_tickCount [0::Int ..] | _ <- take hpc_tickCount [0::Int ..]
] ]
where
module_name_str = moduleNameString (Module.moduleName this_mod)
full_name_str = if modulePackageId this_mod == mainPackageId
then module_name_str
else packageIdString (modulePackageId this_mod) ++ "/" ++
module_name_str
hpcTable _ (NoHpcInfo {}) = error "TODO: impossible" hpcTable _ (NoHpcInfo {}) = error "TODO: impossible"
initHpc :: Module -> HpcInfo -> Code
initHpc this_mod (HpcInfo tickCount hashNo)
= do { id <- newTemp bWord
; emitForeignCall'
PlayRisky
[CmmHinted id NoHint]
(CmmCallee
(CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing ForeignLabelInThisPackage IsFunction)
CCallConv
)
[ CmmHinted (mkLblExpr mkHpcModuleNameLabel) AddrHint
, CmmHinted (word32 tickCount) NoHint
, CmmHinted (word32 hashNo) NoHint
, CmmHinted (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod) AddrHint
]
(Just [])
NoC_SRT -- No SRT b/c we PlayRisky
CmmMayReturn
}
where
word32 i = CmmLit (CmmInt (fromIntegral (fromIntegral i :: Word32)) W32)
mod_alloc = mkFastString "hs_hpc_module"
initHpc _ (NoHpcInfo {}) = panic "initHpc: NoHpcInfo"
...@@ -16,8 +16,7 @@ module CgProf ( ...@@ -16,8 +16,7 @@ module CgProf (
costCentreFrom, costCentreFrom,
curCCS, curCCSAddr, curCCS, curCCSAddr,
emitCostCentreDecl, emitCostCentreStackDecl, emitCostCentreDecl, emitCostCentreStackDecl,
emitRegisterCC, emitRegisterCCS, emitSetCCC, emitCCS,
emitSetCCC, emitCCS,
-- Lag/drag/void stuff -- Lag/drag/void stuff
ldvEnter, ldvEnterClosure, ldvRecordCreate ldvEnter, ldvEnterClosure, ldvRecordCreate
...@@ -347,56 +346,6 @@ sizeof_ccs_words ...@@ -347,56 +346,6 @@ sizeof_ccs_words
where where
(ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE (ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE
-- ---------------------------------------------------------------------------
-- Registering CCs and CCSs
-- (cc)->link = CC_LIST;
-- CC_LIST = (cc);
-- (cc)->ccID = CC_ID++;
emitRegisterCC :: CostCentre -> Code
emitRegisterCC cc = do
{ tmp <- newTemp cInt
; stmtsC [
CmmStore (cmmOffsetB cc_lit oFFSET_CostCentre_link)
(CmmLoad cC_LIST bWord),
CmmStore cC_LIST cc_lit,
CmmAssign (CmmLocal tmp) (CmmLoad cC_ID cInt),
CmmStore (cmmOffsetB cc_lit oFFSET_CostCentre_ccID) (CmmReg (CmmLocal tmp)),
CmmStore cC_ID (cmmRegOffB (CmmLocal tmp) 1)
]
}
where
cc_lit = CmmLit (CmmLabel (mkCCLabel cc))
-- (ccs)->prevStack = CCS_LIST;
-- CCS_LIST = (ccs);
-- (ccs)->ccsID = CCS_ID++;
emitRegisterCCS :: CostCentreStack -> Code
emitRegisterCCS ccs = do
{ tmp <- newTemp cInt
; stmtsC [
CmmStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_prevStack)
(CmmLoad cCS_LIST bWord),
CmmStore cCS_LIST ccs_lit,
CmmAssign (CmmLocal tmp) (CmmLoad cCS_ID cInt),
CmmStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_ccsID) (CmmReg (CmmLocal tmp)),
CmmStore cCS_ID (cmmRegOffB (CmmLocal tmp) 1)
]
}
where
ccs_lit = CmmLit (CmmLabel (mkCCSLabel ccs))
cC_LIST, cC_ID :: CmmExpr
cC_LIST = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CC_LIST")))
cC_ID = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CC_ID")))
cCS_LIST, cCS_ID :: CmmExpr
cCS_LIST = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCS_LIST")))
cCS_ID = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCS_ID")))
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- Set the current cost centre stack -- Set the current cost centre stack
......
...@@ -29,7 +29,6 @@ import CgHpc ...@@ -29,7 +29,6 @@ import CgHpc
import CLabel import CLabel
import OldCmm import OldCmm
import OldCmmUtils
import OldPprCmm import OldPprCmm
import StgSyn import StgSyn
...@@ -51,8 +50,7 @@ import Panic ...@@ -51,8 +50,7 @@ import Panic
codeGen :: DynFlags codeGen :: DynFlags
-> Module -> Module
-> [TyCon] -> [TyCon]
-> [Module] -- directly-imported modules -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering.
-> CollectedCCs -- (Local/global) cost-centres needing declaring/registering.
-> [(StgBinding,[(Id,[Id])])] -- Bindings to convert, with SRTs -> [(StgBinding,[(Id,[Id])])] -- Bindings to convert, with SRTs
-> HpcInfo -> HpcInfo
-> IO [Cmm] -- Output -> IO [Cmm] -- Output
...@@ -61,8 +59,7 @@ codeGen :: DynFlags ...@@ -61,8 +59,7 @@ codeGen :: DynFlags
-- possible for object splitting to split up the -- possible for object splitting to split up the
-- pieces later. -- pieces later.
codeGen dflags this_mod data_tycons imported_mods codeGen dflags this_mod data_tycons cost_centre_info stg_binds hpc_info
cost_centre_info stg_binds hpc_info
= do = do
{ showPass dflags "CodeGen" { showPass dflags "CodeGen"
...@@ -73,167 +70,46 @@ codeGen dflags this_mod data_tycons imported_mods ...@@ -73,167 +70,46 @@ codeGen dflags this_mod data_tycons imported_mods
{ cmm_binds <- mapM (getCmm . cgTopBinding dflags) stg_binds { cmm_binds <- mapM (getCmm . cgTopBinding dflags) stg_binds
; cmm_tycons <- mapM cgTyCon data_tycons ; cmm_tycons <- mapM cgTyCon data_tycons
; cmm_init <- getCmm (mkModuleInit dflags cost_centre_info ; cmm_init <- getCmm (mkModuleInit dflags cost_centre_info
this_mod imported_mods hpc_info) this_mod hpc_info)
; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init]) ; return (cmm_init : cmm_binds ++ concat cmm_tycons)
} }
-- Put datatype_stuff after code_stuff, because the -- Put datatype_stuff after code_stuff, because the
-- datatype closure table (for enumeration types) to -- datatype closure table (for enumeration types) to
-- (say) PrelBase_True_closure, which is defined in -- (say) PrelBase_True_closure, which is defined in
-- code_stuff -- code_stuff
-- Note [codegen-split-init] the cmm_init block must
-- come FIRST. This is because when -split-objs is on
-- we need to combine this block with its
-- initialisation routines; see Note
-- [pipeline-split-init].
; dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprCmms code_stuff) ; dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprCmms code_stuff)
; return code_stuff } ; return code_stuff }
\end{code}
%************************************************************************
%* *
\subsection[codegen-init]{Module initialisation code}
%* *
%************************************************************************
/* -----------------------------------------------------------------------------
Module initialisation
The module initialisation code looks like this, roughly:
FN(__stginit_Foo) {
JMP_(__stginit_Foo_1_p)
}
FN(__stginit_Foo_1_p) {
...
}
We have one version of the init code with a module version and the
'way' attached to it. The version number helps to catch cases
where modules are not compiled in dependency order before being
linked: if a module has been compiled since any modules which depend on
it, then the latter modules will refer to a different version in their
init blocks and a link error will ensue.
The 'way' suffix helps to catch cases where modules compiled in different
ways are linked together (eg. profiled and non-profiled).
We provide a plain, unadorned, version of the module init code
which just jumps to the version with the label and way attached. The
reason for this is that when using foreign exports, the caller of
startupHaskell() must supply the name of the init function for the "top"
module in the program, and we don't want to require that this name
has the version and way info appended to it.
-------------------------------------------------------------------------- */
We initialise the module tree by keeping a work-stack,