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 a52ff7619e8b7d74a9d933d922eeea49f580bca8
("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: Sergei 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

10 files changed, 3 insertions, 100 deletions

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 5f13bed309..d7051f76b0 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -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")
 
diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs
index a420677625..d92b410a7f 100644
--- a/compiler/codeGen/StgCmm.hs
+++ b/compiler/codeGen/StgCmm.hs
@@ -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 []))
         }
 
 
diff --git a/docs/users_guide/8.4.1-notes.rst b/docs/users_guide/8.4.1-notes.rst
index 193515c077..e72213fd5e 100644
--- a/docs/users_guide/8.4.1-notes.rst
+++ b/docs/users_guide/8.4.1-notes.rst
@@ -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
 ~~~~~~~~~~~~~~~~
 
diff --git a/includes/HsFFI.h b/includes/HsFFI.h
index 8e9ff40a2e..53478a7a5e 100644
--- a/includes/HsFFI.h
+++ b/includes/HsFFI.h
@@ -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);
diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h
index 8894535dd6..9d907ab3ba 100644
--- a/includes/stg/MiscClosures.h
+++ b/includes/stg/MiscClosures.h
@@ -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);
 
 /* -----------------------------------------------------------------------------
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index 9ec8af8145..36a99d7a56 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -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
  *
diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index 7db5a27cf1..dac801d5c2 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -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)                            \
diff --git a/rts/StgStartup.cmm b/rts/StgStartup.cmm
index 4cc84bc225..3a80e45bed 100644
--- a/rts/StgStartup.cmm
+++ b/rts/StgStartup.cmm
@@ -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 [];
-}
diff --git a/testsuite/tests/concurrent/should_run/conc059_c.c b/testsuite/tests/concurrent/should_run/conc059_c.c
index f15fbdd735..55510c12cf 100644
--- a/testsuite/tests/concurrent/should_run/conc059_c.c
+++ b/testsuite/tests/concurrent/should_run/conc059_c.c
@@ -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);
diff --git a/testsuite/tests/dynlibs/T3807-export.c b/testsuite/tests/dynlibs/T3807-export.c
index aba129e944..ac54fd73cb 100644
--- a/testsuite/tests/dynlibs/T3807-export.c
+++ b/testsuite/tests/dynlibs/T3807-export.c
@@ -1,8 +1,6 @@
 
 #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