Remove the concept of stableRoots.

StableRoots opened new possibilities in the world
of plugins with their ability to link partially
applied closures against object code.
Exporting '(fn pluginwideState)' severely reduced
the complexity of HIDE's plugin system. The previous
system of global variables was both fragile and hard
to scale.

Good bye, StableRoots. We sure had some fun.

diff --git a/compiler/ghci/ObjLink.lhs b/compiler/ghci/ObjLink.lhs
index 48deb46..7675c71 100644 (file)
--- a/compiler/ghci/ObjLink.lhs
+++ b/compiler/ghci/ObjLink.lhs
@@ -17,8 +17,6 @@ module ObjLink (
    loadObj,             -- :: String -> IO ()
    unloadObj,           -- :: String -> IO ()
    insertSymbol,         -- :: String -> String -> Ptr a -> IO ()
    loadObj,             -- :: String -> IO ()
    unloadObj,           -- :: String -> IO ()
    insertSymbol,         -- :: String -> String -> Ptr a -> IO ()

--- Suspicious; see defn
---    insertStableSymbol,   -- :: String -> String -> a -> IO ()

    lookupSymbol,        -- :: String -> IO (Maybe (Ptr a))
    resolveObjs          -- :: IO SuccessFlag
   )  where
    lookupSymbol,        -- :: String -> IO (Maybe (Ptr a))
    resolveObjs          -- :: IO SuccessFlag
   )  where

@@ -44,15 +42,6 @@ insertSymbol obj_name key symbol
          withCString str $ \c_str ->
           c_insertSymbol c_obj_name c_str symbol
 
          withCString str $ \c_str ->
           c_insertSymbol c_obj_name c_str symbol
 

-{- Deeply suspicious use of unsafeCoerce#; should use makeStablePtr#
-insertStableSymbol :: String -> String -> a -> IO ()
-insertStableSymbol obj_name key symbol
-    = let str = prefixUnderscore key
-      in withCString obj_name $ \c_obj_name ->
-         withCString str $ \c_str ->
-          c_insertStableSymbol c_obj_name c_str (Ptr (unsafeCoerce# symbol))
--}
-

 lookupSymbol :: String -> IO (Maybe (Ptr a))
 lookupSymbol str_in = do
    let str = prefixUnderscore str_in
 lookupSymbol :: String -> IO (Maybe (Ptr a))
 lookupSymbol str_in = do
    let str = prefixUnderscore str_in

@@ -101,9 +90,6 @@ resolveObjs = do
 foreign import ccall unsafe "addDLL"      c_addDLL :: CString -> IO CString
 foreign import ccall unsafe "initLinker"   initObjLinker :: IO ()
 foreign import ccall unsafe "insertSymbol" c_insertSymbol :: CString -> CString -> Ptr a -> IO ()
 foreign import ccall unsafe "addDLL"      c_addDLL :: CString -> IO CString
 foreign import ccall unsafe "initLinker"   initObjLinker :: IO ()
 foreign import ccall unsafe "insertSymbol" c_insertSymbol :: CString -> CString -> Ptr a -> IO ()

--- Suspicious: should take a stable pointer
--- foreign import ccall unsafe "insertStableSymbol" c_insertStableSymbol
---     :: CString -> CString -> Ptr a -> IO ()

 foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a)
 foreign import ccall unsafe "loadObj"      c_loadObj :: CString -> IO Int
 foreign import ccall unsafe "unloadObj"    c_unloadObj :: CString -> IO Int
 foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a)
 foreign import ccall unsafe "loadObj"      c_loadObj :: CString -> IO Int
 foreign import ccall unsafe "unloadObj"    c_unloadObj :: CString -> IO Int

diff --git a/rts/Linker.c b/rts/Linker.c
index 54251ac..d508216 100644 (file)
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -92,14 +92,8 @@
 /* Hash table mapping symbol names to Symbol */
 static /*Str*/HashTable *symhash;
 
 /* Hash table mapping symbol names to Symbol */
 static /*Str*/HashTable *symhash;
 

-typedef struct {
-  void *addr;
-} rootEntry;
-

 /* Hash table mapping symbol names to StgStablePtr */
 static /*Str*/HashTable *stablehash;
 /* Hash table mapping symbol names to StgStablePtr */
 static /*Str*/HashTable *stablehash;

-rootEntry *root_ptr_table = NULL;
-static rootEntry *root_ptr_free = NULL;

 
 static unsigned int RPT_size = 0;
 
 
 static unsigned int RPT_size = 0;
 

@@ -809,92 +803,6 @@ static RtsSymbolVal rtsSyms[] = {
 };
 
 
 };
 
 

-/* -----------------------------------------------------------------------------
- * Utilities for handling root pointers.
- * -------------------------------------------------------------------------- */
-
-
-#define INIT_RPT_SIZE 64
-
-STATIC_INLINE void
-initFreeList(rootEntry *table, nat n, rootEntry *free)
-{
-  rootEntry *p;
-
-  for (p = table + n - 1; p >= table; p--) {
-    p->addr   = (P_)free;
-    free = p;
-  }
-  root_ptr_free = table;
-}
-
-static void
-initRootPtrTable(void)
-{
-  if (RPT_size > 0)
-    return;
-
-  RPT_size = INIT_RPT_SIZE;
-  root_ptr_table = stgMallocBytes(RPT_size * sizeof(rootEntry),
-                                    "initRootPtrTable");
-
-  initFreeList(root_ptr_table,INIT_RPT_SIZE,NULL);
-}
-
-
-static void
-enlargeRootPtrTable(void)
-{
-  nat old_RPT_size = RPT_size;
-
-  // 2nd and subsequent times
-  RPT_size *= 2;
-  root_ptr_table =
-    stgReallocBytes(root_ptr_table,
-                    RPT_size * sizeof(rootEntry),
-                    "enlargeRootPtrTable");
-
-  initFreeList(root_ptr_table + old_RPT_size, old_RPT_size, NULL);
-}
-
-static void
-addRootObject(void *addr)
-{
-  StgWord rt;
-  initRootPtrTable();
-  if (root_ptr_free == NULL) {
-    enlargeRootPtrTable();
-  }
-
-  rt = root_ptr_free - root_ptr_table;
-  root_ptr_free  = (rootEntry*)(root_ptr_free->addr);
-  root_ptr_table[rt].addr = addr;
-}
-
-/* -----------------------------------------------------------------------------
- * Treat root pointers as roots for the garbage collector.
- * -------------------------------------------------------------------------- */
-
-void
-markRootPtrTable(evac_fn evac)
-{
-  rootEntry *p, *end_root_ptr_table;
-  StgPtr q;
-
-  end_root_ptr_table = &root_ptr_table[RPT_size];
-
-  for (p = root_ptr_table; p < end_root_ptr_table; p++) {
-    q = p->addr;
-
-    if (q && (q < (P_)root_ptr_table || q >= (P_)end_root_ptr_table)) {
-        evac((StgClosure **)p->addr);
-    }
-  }
-}
-
-/* -----------------------------------------------------------------------------
- * End of utilities for handling root pointers.
- * -------------------------------------------------------------------------- */

 
 
 /* -----------------------------------------------------------------------------
 
 
 /* -----------------------------------------------------------------------------

@@ -3284,7 +3192,6 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
               S = (Elf_Addr)S_tmp;
             } else {
               stableVal = deRefStablePtr( stablePtr );
               S = (Elf_Addr)S_tmp;
             } else {
               stableVal = deRefStablePtr( stablePtr );

-              addRootObject((void*)P);

               S_tmp = stableVal;
               S = (Elf_Addr)S_tmp;
             }
               S_tmp = stableVal;
               S = (Elf_Addr)S_tmp;
             }

diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 2870be1..17211ac 100644 (file)
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -482,10 +482,6 @@ GarbageCollect ( rtsBool force_major_gc )
    */
   markStablePtrTable(mark_root);
 
    */
   markStablePtrTable(mark_root);
 

-  /* Mark the root pointer table.
-   */
-  markRootPtrTable(mark_root);
-

   /* -------------------------------------------------------------------------
    * Repeatedly scavenge all the areas we know about until there's no
    * more scavenging to be done.
   /* -------------------------------------------------------------------------
    * Repeatedly scavenge all the areas we know about until there's no
    * more scavenging to be done.