Commit a92ff5d6 authored by Sergei Trofimovich's avatar Sergei Trofimovich

hs_add_root() RTS API removal

Before ghc-7.2 hs_add_root() had to be used to initialize haskell
modules when haskell was called from FFI.

commit a52ff761
("Change the way module initialisation is done (#3252, #4417)")
removed needs for hs_add_root() and made function a no-op.
For backward compatibility '__stginit_<module>' symbol was
not removed.

This change removes no-op hs_add_root() function and unused
'__stginit_<module>' symbol from each haskell module.
Signed-off-by: default avatarSergei Trofimovich <slyfox@gentoo.org>

Test Plan: ./validate

Reviewers: simonmar, austin, bgamari, erikd

Reviewed By: simonmar

Subscribers: rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D3460
parent 29ef7141
......@@ -47,8 +47,6 @@ module CLabel (
mkAsmTempEndLabel,
mkAsmTempDieLabel,
mkPlainModuleInitLabel,
mkSplitMarkerLabel,
mkDirty_MUT_VAR_Label,
mkUpdInfoLabel,
......@@ -205,9 +203,6 @@ data CLabel
| StringLitLabel
{-# UNPACK #-} !Unique
| PlainModuleInitLabel -- without the version & way info
Module
| CC_Label CostCentre
| CCS_Label CostCentreStack
......@@ -273,8 +268,6 @@ instance Ord CLabel where
compare b1 b2
compare (StringLitLabel u1) (StringLitLabel u2) =
nonDetCmpUnique u1 u2
compare (PlainModuleInitLabel a1) (PlainModuleInitLabel a2) =
compare a1 a2
compare (CC_Label a1) (CC_Label a2) =
compare a1 a2
compare (CCS_Label a1) (CCS_Label a2) =
......@@ -309,8 +302,6 @@ instance Ord CLabel where
compare _ AsmTempDerivedLabel{} = GT
compare StringLitLabel{} _ = LT
compare _ StringLitLabel{} = GT
compare PlainModuleInitLabel{} _ = LT
compare _ PlainModuleInitLabel{} = GT
compare CC_Label{} _ = LT
compare _ CC_Label{} = GT
compare CCS_Label{} _ = LT
......@@ -652,8 +643,6 @@ mkAsmTempDerivedLabel = AsmTempDerivedLabel
mkAsmTempEndLabel :: CLabel -> CLabel
mkAsmTempEndLabel l = mkAsmTempDerivedLabel l (fsLit "_end")
mkPlainModuleInitLabel :: Module -> CLabel
mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
-- | Construct a label for a DWARF Debug Information Entity (DIE)
-- describing another symbol.
......@@ -738,7 +727,6 @@ needsCDecl (LargeSRTLabel _) = False
needsCDecl (LargeBitmapLabel _) = False
needsCDecl (IdLabel _ _ _) = True
needsCDecl (CaseLabel _ _) = True
needsCDecl (PlainModuleInitLabel _) = True
needsCDecl (StringLitLabel _) = False
needsCDecl (AsmTempLabel _) = False
......@@ -872,7 +860,6 @@ externallyVisibleCLabel (CaseLabel _ _) = False
externallyVisibleCLabel (StringLitLabel _) = False
externallyVisibleCLabel (AsmTempLabel _) = False
externallyVisibleCLabel (AsmTempDerivedLabel _ _)= False
externallyVisibleCLabel (PlainModuleInitLabel _)= True
externallyVisibleCLabel (RtsLabel _) = True
externallyVisibleCLabel (CmmLabel _ _ _) = True
externallyVisibleCLabel (ForeignLabel{}) = True
......@@ -930,7 +917,6 @@ labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
labelType (RtsLabel (RtsApFast _)) = CodeLabel
labelType (CaseLabel _ CaseReturnInfo) = DataLabel
labelType (CaseLabel _ _) = CodeLabel
labelType (PlainModuleInitLabel _) = CodeLabel
labelType (SRTLabel _) = DataLabel
labelType (LargeSRTLabel _) = DataLabel
labelType (LargeBitmapLabel _) = DataLabel
......@@ -996,8 +982,6 @@ labelDynamic dflags this_mod lbl =
-- libraries
True
PlainModuleInitLabel m -> (WayDyn `elem` ways dflags) && this_pkg /= (moduleUnitId m)
HpcTicksLabel m -> (WayDyn `elem` ways dflags) && this_mod /= m
-- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
......@@ -1226,9 +1210,6 @@ pprCLbl (IdLabel name _cafs flavor) = ppr name <> ppIdFlavor flavor
pprCLbl (CC_Label cc) = ppr cc
pprCLbl (CCS_Label ccs) = ppr ccs
pprCLbl (PlainModuleInitLabel mod)
= text "__stginit_" <> ppr mod
pprCLbl (HpcTicksLabel mod)
= text "_hpc_tickboxes_" <> ppr mod <> ptext (sLit "_hpc")
......
......@@ -160,39 +160,6 @@ cgTopRhs dflags rec bndr (StgRhsClosure cc bi fvs upd_flag args body)
-- Module initialisation code
---------------------------------------------------------------
{- 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,
* pointed to by Sp
* that grows downward
* Sp points to the last occupied slot
-}
mkModuleInit
:: CollectedCCs -- cost centre info
-> Module
......@@ -202,10 +169,6 @@ mkModuleInit
mkModuleInit cost_centre_info this_mod hpc_info
= do { initHpc this_mod hpc_info
; initCostCentres cost_centre_info
-- For backwards compatibility: user code may refer to this
-- label for calling hs_add_root().
; let lbl = mkPlainModuleInitLabel this_mod
; emitDecl (CmmData (Section Data lbl) (Statics lbl []))
}
......
......@@ -77,6 +77,9 @@ Now we generate ::
Runtime system
~~~~~~~~~~~~~~
- Function ``hs_add_root()`` was removed. It was a no-op since GHC-7.2.1
where module initialisation stopped requiring a call to ``hs_add_root()``.
Template Haskell
~~~~~~~~~~~~~~~~
......
......@@ -98,7 +98,6 @@ extern void hs_init (int *argc, char **argv[]);
extern void hs_exit (void);
extern void hs_exit_nowait(void);
extern void hs_set_argv (int argc, char *argv[]);
extern void hs_add_root (void (*init_root)(void));
extern void hs_thread_done (void);
extern void hs_perform_gc (void);
......
......@@ -339,9 +339,6 @@ RTS_FUN_DECL(stg_returnToSchedNotPaused);
RTS_FUN_DECL(stg_returnToSchedButFirst);
RTS_FUN_DECL(stg_threadFinished);
RTS_FUN_DECL(stg_init_finish);
RTS_FUN_DECL(stg_init);
RTS_FUN_DECL(StgReturn);
/* -----------------------------------------------------------------------------
......
......@@ -301,17 +301,6 @@ startupHaskell(int argc, char *argv[], void (*init_root)(void) STG_UNUSED)
hs_init(&argc, &argv);
}
/* -----------------------------------------------------------------------------
hs_add_root: backwards compatibility. (see #3252)
-------------------------------------------------------------------------- */
void
hs_add_root(void (*init_root)(void) STG_UNUSED)
{
/* nothing */
}
/* ----------------------------------------------------------------------------
* Shutting down the RTS
*
......
......@@ -613,7 +613,6 @@
SymI_HasProto(hs_exit) \
SymI_HasProto(hs_exit_nowait) \
SymI_HasProto(hs_set_argv) \
SymI_HasProto(hs_add_root) \
SymI_HasProto(hs_perform_gc) \
SymI_HasProto(hs_lock_stable_tables) \
SymI_HasProto(hs_unlock_stable_tables) \
......
......@@ -178,25 +178,3 @@ INFO_TABLE_RET(stg_forceIO, RET_SMALL, P_ info_ptr)
{
ENTER(ret);
}
/* -----------------------------------------------------------------------------
Special STG entry points for module registration.
-------------------------------------------------------------------------- */
stg_init_finish /* no args: explicit stack layout */
{
jump StgReturn [];
}
/* On entry to stg_init:
* init_stack[0] = &stg_init_ret;
* init_stack[1] = __stginit_Something;
*/
stg_init /* no args: explicit stack layout */
{
W_ next;
Sp = W_[BaseReg + OFFSET_StgRegTable_rSp];
next = W_[Sp];
Sp_adj(1);
jump next [];
}
......@@ -6,12 +6,9 @@
#include <windows.h>
#endif
void __stginit_Test(void);
int main(int argc, char *argv[])
{
hs_init(&argc,&argv);
hs_add_root(__stginit_Test);
f(500000);
#if mingw32_HOST_OS
Sleep(100);
......
#include <HsFFI.h>
extern void __stginit_T3807Export(void);
void
test_init (void)
{
......@@ -11,7 +9,6 @@ test_init (void)
static int argc = 1;
hs_init (&argc, &argv_);
hs_add_root (__stginit_T3807Export);
}
void
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment