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.

8 files changed, 182 insertions, 219 deletions

diff --git a/rts/Hpc.c b/rts/Hpc.c
index 81c802cea2..c4ff8d3be1 100644
--- a/rts/Hpc.c
+++ b/rts/Hpc.c
@@ -6,6 +6,8 @@
 #include "Rts.h"
 
 #include "Trace.h"
+#include "Hash.h"
+#include "RtsUtils.h"
 
 #include <stdio.h>
 #include <ctype.h>
@@ -36,11 +38,11 @@ static pid_t hpc_pid = 0;		// pid of this process at hpc-boot time.
 static FILE *tixFile;			// file being read/written
 static int tix_ch;			// current char
 
+static HashTable * moduleHash = NULL;   // module name -> HpcModuleInfo
+
 HpcModuleInfo *modules = 0;
-HpcModuleInfo *nextModule = 0;
-int totalTixes = 0;		// total number of tix boxes.
 
-static char *tixFilename;
+static char *tixFilename = NULL;
 
 static void GNU_ATTRIBUTE(__noreturn__)
 failure(char *msg) {
@@ -78,7 +80,7 @@ static void ws(void) {
 }
 
 static char *expectString(void) {
-  char tmp[256], *res;
+  char tmp[256], *res; // XXX
   int tmp_ix = 0;
   expect('"');
   while (tix_ch != '"') {
@@ -87,7 +89,7 @@ static char *expectString(void) {
   }
   tmp[tmp_ix++] = 0;
   expect('"');
-  res = malloc(tmp_ix);
+  res = stgMallocBytes(tmp_ix,"Hpc.expectString");
   strcpy(res,tmp);
   return res;
 }
@@ -104,10 +106,8 @@ static StgWord64 expectWord64(void) {
 static void
 readTix(void) {
   unsigned int i;
-  HpcModuleInfo *tmpModule;
+  HpcModuleInfo *tmpModule, *lookup;
 
-  totalTixes = 0;
-    
   ws();
   expect('T');
   expect('i');
@@ -117,7 +117,9 @@ readTix(void) {
   ws();
   
   while(tix_ch != ']') {
-    tmpModule = (HpcModuleInfo *)calloc(1,sizeof(HpcModuleInfo));
+    tmpModule = (HpcModuleInfo *)stgMallocBytes(sizeof(HpcModuleInfo),
+                                                "Hpc.readTix");
+    tmpModule->from_file = rtsTrue;
     expect('T');
     expect('i');
     expect('x');
@@ -134,8 +136,6 @@ readTix(void) {
     ws();
     tmpModule -> tickCount = (int)expectWord64();
     tmpModule -> tixArr = (StgWord64 *)calloc(tmpModule->tickCount,sizeof(StgWord64));
-    tmpModule -> tickOffset = totalTixes;
-    totalTixes += tmpModule -> tickCount;
     ws();
     expect('[');
     ws();
@@ -150,13 +150,32 @@ readTix(void) {
     expect(']');
     ws();
     
-    if (!modules) {
-      modules = tmpModule;
+    lookup = lookupHashTable(moduleHash, (StgWord)tmpModule->modName);
+    if (tmpModule == NULL) {
+        debugTrace(DEBUG_hpc,"readTix: new HpcModuleInfo for %s",
+                   tmpModule->modName);
+        insertHashTable(moduleHash, (StgWord)tmpModule->modName, tmpModule);
     } else {
-      nextModule->next=tmpModule;
+        ASSERT(lookup->tixArr != 0);
+        ASSERT(!strcmp(tmpModule->modName, lookup->modName));
+        debugTrace(DEBUG_hpc,"readTix: existing HpcModuleInfo for %s",
+                   tmpModule->modName);
+        if (tmpModule->hashNo != lookup->hashNo) {
+            fprintf(stderr,"in module '%s'\n",tmpModule->modName);
+            failure("module mismatch with .tix/.mix file hash number");
+            if (tixFilename != NULL) {
+                fprintf(stderr,"(perhaps remove %s ?)\n",tixFilename);
+            }
+            stg_exit(EXIT_FAILURE);
+        }
+        for (i=0; i < tmpModule->tickCount; i++) {
+            lookup->tixArr[i] = tmpModule->tixArr[i];
+        }
+        stgFree(tmpModule->tixArr);
+        stgFree(tmpModule->modName);
+        stgFree(tmpModule);
     }
-    nextModule=tmpModule;
-    
+
     if (tix_ch == ',') {
       expect(',');
       ws();
@@ -166,9 +185,18 @@ readTix(void) {
   fclose(tixFile);
 }
 
-static void hpc_init(void) {
+void
+startupHpc(void)
+{
   char *hpc_tixdir;
   char *hpc_tixfile;
+
+  if (moduleHash == NULL) {
+      // no modules were registered with hs_hpc_module, so don't bother
+      // creating the .tix file.
+      return;
+  }
+
   if (hpc_inited != 0) {
     return;
   }
@@ -177,6 +205,8 @@ static void hpc_init(void) {
   hpc_tixdir = getenv("HPCTIXDIR");
   hpc_tixfile = getenv("HPCTIXFILE");
 
+  debugTrace(DEBUG_hpc,"startupHpc");
+
   /* XXX Check results of mallocs/strdups, and check we are requesting
          enough bytes */
   if (hpc_tixfile != NULL) {
@@ -192,10 +222,13 @@ static void hpc_init(void) {
 #endif
     /* Then, try open the file
      */
-    tixFilename = (char *) malloc(strlen(hpc_tixdir) + strlen(prog_name) + 12);
+    tixFilename = (char *) stgMallocBytes(strlen(hpc_tixdir) +
+                                          strlen(prog_name) + 12,
+                                          "Hpc.startupHpc");
     sprintf(tixFilename,"%s/%s-%d.tix",hpc_tixdir,prog_name,(int)hpc_pid);
   } else {
-    tixFilename = (char *) malloc(strlen(prog_name) + 6);
+    tixFilename = (char *) stgMallocBytes(strlen(prog_name) + 6,
+                                          "Hpc.startupHpc");
     sprintf(tixFilename, "%s.tix", prog_name);
   }
 
@@ -204,90 +237,80 @@ static void hpc_init(void) {
   }
 }
 
-/* Called on a per-module basis, at startup time, declaring where the tix boxes are stored in memory.
- * This memory can be uninitized, because we will initialize it with either the contents
- * of the tix file, or all zeros.
+/*
+ * Called on a per-module basis, by a constructor function compiled
+ * with each module (see Coverage.hpcInitCode), declaring where the
+ * tix boxes are stored in memory.  This memory can be uninitized,
+ * because we will initialize it with either the contents of the tix
+ * file, or all zeros.
+ *
+ * Note that we might call this before reading the .tix file, or after
+ * in the case where we loaded some Haskell code from a .so with
+ * dlopen().  So we must handle the case where we already have an
+ * HpcModuleInfo for the module which was read from the .tix file.
  */
 
-int
+void
 hs_hpc_module(char *modName,
 	      StgWord32 modCount,
 	      StgWord32 modHashNo,
-	      StgWord64 *tixArr) {
-  HpcModuleInfo *tmpModule, *lastModule;
-  unsigned int i;
-  int offset = 0;
-  
-  debugTrace(DEBUG_hpc,"hs_hpc_module(%s,%d)",modName,(nat)modCount);
+              StgWord64 *tixArr)
+{
+  HpcModuleInfo *tmpModule;
+  nat i;
 
-  hpc_init();
+  if (moduleHash == NULL) {
+      moduleHash = allocStrHashTable();
+  }
 
-  tmpModule = modules;
-  lastModule = 0;
-  
-  for(;tmpModule != 0;tmpModule = tmpModule->next) {
-    if (!strcmp(tmpModule->modName,modName)) {
+  tmpModule = lookupHashTable(moduleHash, (StgWord)modName);
+  if (tmpModule == NULL)
+  {
+      // Did not find entry so add one on.
+      tmpModule = (HpcModuleInfo *)stgMallocBytes(sizeof(HpcModuleInfo),
+                                                  "Hpc.hs_hpc_module");
+      tmpModule->modName = modName;
+      tmpModule->tickCount = modCount;
+      tmpModule->hashNo = modHashNo;
+
+      tmpModule->tixArr = tixArr;
+      for(i=0;i < modCount;i++) {
+          tixArr[i] = 0;
+      }
+      tmpModule->next = modules;
+      tmpModule->from_file = rtsFalse;
+      modules = tmpModule;
+      insertHashTable(moduleHash, (StgWord)modName, tmpModule);
+  }
+  else
+  {
       if (tmpModule->tickCount != modCount) {
-	failure("inconsistent number of tick boxes");
+          failure("inconsistent number of tick boxes");
       }
-      assert(tmpModule->tixArr != 0);	
+      ASSERT(tmpModule->tixArr != 0);
       if (tmpModule->hashNo != modHashNo) {
-	fprintf(stderr,"in module '%s'\n",tmpModule->modName);
-	failure("module mismatch with .tix/.mix file hash number");
-	fprintf(stderr,"(perhaps remove %s ?)\n",tixFilename);
-	stg_exit(1);
-
+          fprintf(stderr,"in module '%s'\n",tmpModule->modName);
+          failure("module mismatch with .tix/.mix file hash number");
+          if (tixFilename != NULL) {
+              fprintf(stderr,"(perhaps remove %s ?)\n",tixFilename);
+          }
+          stg_exit(EXIT_FAILURE);
       }
+      // The existing tixArr was made up when we read the .tix file,
+      // whereas this is the real tixArr, so copy the data from the
+      // .tix into the real tixArr.
       for(i=0;i < modCount;i++) {
-	tixArr[i] = tmpModule->tixArr[i];
+          tixArr[i] = tmpModule->tixArr[i];
       }
-      tmpModule->tixArr = tixArr;
-      return tmpModule->tickOffset;
-    }
-    lastModule = tmpModule;
-  }
-  // Did not find entry so add one on.
-  tmpModule = (HpcModuleInfo *)calloc(1,sizeof(HpcModuleInfo));
-  tmpModule->modName = modName;
-  tmpModule->tickCount = modCount;
-  tmpModule->hashNo = modHashNo;
-  if (lastModule) {
-    tmpModule->tickOffset = lastModule->tickOffset + lastModule->tickCount;
-  } else {
-    tmpModule->tickOffset = 0;
-  }
-  tmpModule->tixArr = tixArr;
-  for(i=0;i < modCount;i++) {
-    tixArr[i] = 0;
-  }
-  tmpModule->next = 0;
-
-  if (!modules) {
-    modules = tmpModule;
-  } else {
-    lastModule->next=tmpModule;
-  }
-
-  debugTrace(DEBUG_hpc,"end: hs_hpc_module");
-
-  return offset;
-}
-
 
-/* This is called after all the modules have registered their local tixboxes,
- * and does a sanity check: are we good to go?
- */
-
-void
-startupHpc(void) {
-  debugTrace(DEBUG_hpc,"startupHpc");
- 
- if (hpc_inited == 0) {
-    return;
+      if (tmpModule->from_file) {
+          stgFree(tmpModule->modName);
+          stgFree(tmpModule->tixArr);
+      }
+      tmpModule->from_file = rtsFalse;
   }
 }
 
-
 static void
 writeTix(FILE *f) {
   HpcModuleInfo *tmpModule;  
@@ -311,11 +334,10 @@ writeTix(FILE *f) {
 	   tmpModule->modName,
 	    (nat)tmpModule->hashNo,
 	    (nat)tmpModule->tickCount);
-    debugTrace(DEBUG_hpc,"%s: %u (offset=%u) (hash=%u)\n",
+    debugTrace(DEBUG_hpc,"%s: %u (hash=%u)\n",
 	       tmpModule->modName,
 	       (nat)tmpModule->tickCount,
-	       (nat)tmpModule->hashNo,
-	       (nat)tmpModule->tickOffset);
+               (nat)tmpModule->hashNo);
 
     inner_comma = 0;
     for(i = 0;i < tmpModule->tickCount;i++) {
@@ -338,7 +360,17 @@ writeTix(FILE *f) {
   fclose(f);
 }
 
-/* Called at the end of execution, to write out the Hpc *.tix file  
+static void
+freeHpcModuleInfo (HpcModuleInfo *mod)
+{
+    if (mod->from_file) {
+        stgFree(mod->modName);
+        stgFree(mod->tixArr);
+    }
+    stgFree(mod);
+}
+
+/* Called at the end of execution, to write out the Hpc *.tix file
  * for this exection. Safe to call, even if coverage is not used.
  */
 void
@@ -357,6 +389,12 @@ exitHpc(void) {
     FILE *f = fopen(tixFilename,"w");
     writeTix(f);
   }
+
+  freeHashTable(moduleHash, (void (*)(void *))freeHpcModuleInfo);
+  moduleHash = NULL;
+
+  stgFree(tixFilename);
+  tixFilename = NULL;
 }
 
 //////////////////////////////////////////////////////////////////////////////
diff --git a/rts/Main.c b/rts/Main.c
index c1b028ff1b..c7a559fc14 100644
--- a/rts/Main.c
+++ b/rts/Main.c
@@ -15,16 +15,10 @@
 #include "Rts.h"
 #include "RtsMain.h"
 
-/* The symbol for the Haskell Main module's init function. It is safe to refer
- * to it here because this Main.o object file will only be linked in if we are
- * linking a Haskell program that uses a Haskell Main.main function.
- */
-extern void __stginit_ZCMain(void);
-
 /* Similarly, we can refer to the ZCMain_main_closure here */
 extern StgClosure ZCMain_main_closure;
 
 int main(int argc, char *argv[])
 {
-    return hs_main(argc, argv, &__stginit_ZCMain, &ZCMain_main_closure);
+    return hs_main(argc, argv, &ZCMain_main_closure);
 }
diff --git a/rts/ProfHeap.c b/rts/ProfHeap.c
index 39b64d4c51..f7fbd321be 100644
--- a/rts/ProfHeap.c
+++ b/rts/ProfHeap.c
@@ -309,7 +309,7 @@ void initProfiling1 (void)
 {
 }
 
-void freeProfiling1 (void)
+void freeProfiling (void)
 {
 }
 
diff --git a/rts/Profiling.c b/rts/Profiling.c
index 1d8627c5b1..5648f31e00 100644
--- a/rts/Profiling.c
+++ b/rts/Profiling.c
@@ -34,9 +34,9 @@ Arena *prof_arena;
  * closure_cats
  */
 
-unsigned int CC_ID;
-unsigned int CCS_ID;
-unsigned int HP_ID;
+unsigned int CC_ID  = 1;
+unsigned int CCS_ID = 1;
+unsigned int HP_ID  = 1;
 
 /* figures for the profiling report.
  */
@@ -58,8 +58,8 @@ CostCentreStack *CCCS;
 /* Linked lists to keep track of cc's and ccs's that haven't
  * been declared in the log file yet
  */
-CostCentre *CC_LIST;
-CostCentreStack *CCS_LIST;
+CostCentre      *CC_LIST  = NULL;
+CostCentreStack *CCS_LIST = NULL;
 
 /*
  * Built-in cost centres and cost-centre stacks:
@@ -152,41 +152,10 @@ initProfiling1 (void)
 
   /* for the benefit of allocate()... */
   CCCS = CCS_SYSTEM;
-  
-  /* Initialize counters for IDs */
-  CC_ID  = 1;
-  CCS_ID = 1;
-  HP_ID  = 1;
-  
-  /* Initialize Declaration lists to NULL */
-  CC_LIST  = NULL;
-  CCS_LIST = NULL;
-
-  /* Register all the cost centres / stacks in the program 
-   * CC_MAIN gets link = 0, all others have non-zero link.
-   */
-  REGISTER_CC(CC_MAIN);
-  REGISTER_CC(CC_SYSTEM);
-  REGISTER_CC(CC_GC);
-  REGISTER_CC(CC_OVERHEAD);
-  REGISTER_CC(CC_SUBSUMED);
-  REGISTER_CC(CC_DONT_CARE);
-  REGISTER_CCS(CCS_MAIN);
-  REGISTER_CCS(CCS_SYSTEM);
-  REGISTER_CCS(CCS_GC);
-  REGISTER_CCS(CCS_OVERHEAD);
-  REGISTER_CCS(CCS_SUBSUMED);
-  REGISTER_CCS(CCS_DONT_CARE);
-
-  CCCS = CCS_OVERHEAD;
-
-  /* cost centres are registered by the per-module 
-   * initialisation code now... 
-   */
 }
 
 void
-freeProfiling1 (void)
+freeProfiling (void)
 {
     arenaFree(prof_arena);
 }
@@ -202,17 +171,36 @@ initProfiling2 (void)
    * information into it.  */
   initProfilingLogFile();
 
+  /* Register all the cost centres / stacks in the program
+   * CC_MAIN gets link = 0, all others have non-zero link.
+   */
+  REGISTER_CC(CC_MAIN);
+  REGISTER_CC(CC_SYSTEM);
+  REGISTER_CC(CC_GC);
+  REGISTER_CC(CC_OVERHEAD);
+  REGISTER_CC(CC_SUBSUMED);
+  REGISTER_CC(CC_DONT_CARE);
+
+  REGISTER_CCS(CCS_SYSTEM);
+  REGISTER_CCS(CCS_GC);
+  REGISTER_CCS(CCS_OVERHEAD);
+  REGISTER_CCS(CCS_SUBSUMED);
+  REGISTER_CCS(CCS_DONT_CARE);
+  REGISTER_CCS(CCS_MAIN);
+
   /* find all the "special" cost centre stacks, and make them children
    * of CCS_MAIN.
    */
-  ASSERT(CCS_MAIN->prevStack == 0);
+  ASSERT(CCS_LIST == CCS_MAIN);
+  CCS_LIST = CCS_LIST->prevStack;
+  CCS_MAIN->prevStack = NULL;
   CCS_MAIN->root = CC_MAIN;
   ccsSetSelected(CCS_MAIN);
   DecCCS(CCS_MAIN);
 
-  for (ccs = CCS_LIST; ccs != CCS_MAIN; ) {
+  for (ccs = CCS_LIST; ccs != NULL; ) {
     next = ccs->prevStack;
-    ccs->prevStack = 0;
+    ccs->prevStack = NULL;
     ActualPush_(CCS_MAIN,ccs->cc,ccs);
     ccs->root = ccs->cc;
     ccs = next;
diff --git a/rts/Profiling.h b/rts/Profiling.h
index 3a4184fba6..e27ad4c5ed 100644
--- a/rts/Profiling.h
+++ b/rts/Profiling.h
@@ -14,9 +14,9 @@
 #include "BeginPrivate.h"
 
 void initProfiling1 (void);
-void freeProfiling1 (void);
 void initProfiling2 (void);
 void endProfiling   (void);
+void freeProfiling  (void);
 
 extern FILE *prof_file;
 extern FILE *hp_file;
diff --git a/rts/RtsMain.c b/rts/RtsMain.c
index b6cf546aea..0ed6df494c 100644
--- a/rts/RtsMain.c
+++ b/rts/RtsMain.c
@@ -28,13 +28,10 @@
 # include <windows.h>
 #endif
 
-extern void __stginit_ZCMain(void);
-
 /* Annoying global vars for passing parameters to real_main() below
  * This is to get around problem with Windows SEH, see hs_main(). */
 static int progargc;
 static char **progargv;
-static void (*progmain_init)(void);   /* This will be __stginit_ZCMain */
 static StgClosure *progmain_closure;  /* This will be ZCMain_main_closure */
 
 /* Hack: we assume that we're building a batch-mode system unless 
@@ -47,7 +44,7 @@ static void real_main(void)
     SchedulerStatus status;
     /* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */
 
-    startupHaskell(progargc,progargv,progmain_init);
+    startupHaskell(progargc,progargv,NULL);
 
     /* kick off the computation by creating the main thread with a pointer
        to mainIO_closure representing the computation of the overall program;
@@ -95,18 +92,17 @@ static void real_main(void)
  * This gets called from a tiny main function which gets linked into each
  * compiled Haskell program that uses a Haskell main function.
  *
- * We expect the caller to pass __stginit_ZCMain for main_init and
- * ZCMain_main_closure for main_closure. The reason we cannot refer to
- * these symbols directly is because we're inside the rts and we do not know
- * for sure that we'll be using a Haskell main function.
+ * We expect the caller to pass ZCMain_main_closure for
+ * main_closure. The reason we cannot refer to this symbol directly
+ * is because we're inside the rts and we do not know for sure that
+ * we'll be using a Haskell main function.
  */
-int hs_main(int argc, char *argv[], void (*main_init)(void), StgClosure *main_closure)
+int hs_main(int argc, char *argv[], StgClosure *main_closure)
 {
     /* We do this dance with argc and argv as otherwise the SEH exception
        stuff (the BEGIN/END CATCH below) on Windows gets confused */
     progargc = argc;
     progargv = argv;
-    progmain_init    = main_init;
     progmain_closure = main_closure;
 
 #if defined(mingw32_HOST_OS)
diff --git a/rts/RtsMain.h b/rts/RtsMain.h
index 4aabc56517..24e58199bb 100644
--- a/rts/RtsMain.h
+++ b/rts/RtsMain.h
@@ -13,6 +13,6 @@
  * The entry point for Haskell programs that use a Haskell main function
  * -------------------------------------------------------------------------- */
 
-int hs_main(int argc, char *argv[], void (*main_init)(void), StgClosure *main_closure);
+int hs_main(int argc, char *argv[], StgClosure *main_closure);
 
 #endif /* RTSMAIN_H */
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index b860667fe4..236d07a9e0 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -224,90 +224,37 @@ hs_init(int *argc, char **argv[])
     x86_init_fpu();
 #endif
 
+    startupHpc();
+
+    // This must be done after module initialisation.
+    // ToDo: make this work in the presence of multiple hs_add_root()s.
+    initProfiling2();
+
+    // ditto.
+#if defined(THREADED_RTS)
+    ioManagerStart();
+#endif
+
     /* Record initialization times */
     stat_endInit();
 }
 
 // Compatibility interface
 void
-startupHaskell(int argc, char *argv[], void (*init_root)(void))
+startupHaskell(int argc, char *argv[], void (*init_root)(void) STG_UNUSED)
 {
     hs_init(&argc, &argv);
-    if(init_root)
-        hs_add_root(init_root);
 }
 
 
 /* -----------------------------------------------------------------------------
-   Per-module initialisation
-
-   This process traverses all the compiled modules in the program
-   starting with "Main", and performing per-module initialisation for
-   each one.
-
-   So far, two things happen at initialisation time:
-
-      - we register stable names for each foreign-exported function
-        in that module.  This prevents foreign-exported entities, and
-	things they depend on, from being garbage collected.
-
-      - we supply a unique integer to each statically declared cost
-        centre and cost centre stack in the program.
-
-   The code generator inserts a small function "__stginit_<module>" in each
-   module and calls the registration functions in each of the modules it
-   imports.
-
-   The init* functions are compiled in the same way as STG code,
-   i.e. without normal C call/return conventions.  Hence we must use
-   StgRun to call this stuff.
+   hs_add_root: backwards compatibility.  (see #3252)
    -------------------------------------------------------------------------- */
 
-/* The init functions use an explicit stack... 
- */
-#define INIT_STACK_BLOCKS  4
-static StgFunPtr *init_stack = NULL;
-
 void
-hs_add_root(void (*init_root)(void))
+hs_add_root(void (*init_root)(void) STG_UNUSED)
 {
-    bdescr *bd;
-    nat init_sp;
-    Capability *cap;
-
-    cap = rts_lock();
-
-    if (hs_init_count <= 0) {
-	barf("hs_add_root() must be called after hs_init()");
-    }
-
-    /* The initialisation stack grows downward, with sp pointing 
-       to the last occupied word */
-    init_sp = INIT_STACK_BLOCKS*BLOCK_SIZE_W;
-    bd = allocGroup_lock(INIT_STACK_BLOCKS);
-    init_stack = (StgFunPtr *)bd->start;
-    init_stack[--init_sp] = (StgFunPtr)stg_init_finish;
-    if (init_root != NULL) {
-	init_stack[--init_sp] = (StgFunPtr)init_root;
-    }
-    
-    cap->r.rSp = (P_)(init_stack + init_sp);
-    StgRun((StgFunPtr)stg_init, &cap->r);
-
-    freeGroup_lock(bd);
-
-    startupHpc();
-
-    // This must be done after module initialisation.
-    // ToDo: make this work in the presence of multiple hs_add_root()s.
-    initProfiling2();
-
-    rts_unlock(cap);
-
-    // ditto.
-#if defined(THREADED_RTS)
-    ioManagerStart();
-#endif
+    /* nothing */
 }
 
 /* ----------------------------------------------------------------------------
@@ -424,7 +371,7 @@ hs_exit_(rtsBool wait_foreign)
 #endif
 
     endProfiling();
-    freeProfiling1();
+    freeProfiling();
 
 #ifdef PROFILING
     // Originally, this was in report_ccs_profiling().  Now, retainer