From 354672b03f0d765145ada7821b5e001db22274dd Mon Sep 17 00:00:00 2001 From: Lemmih Date: Tue, 21 Nov 2006 19:37:01 +0000 Subject: [PATCH] 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. --- compiler/ghci/ObjLink.lhs | 14 ------- rts/Linker.c | 93 --------------------------------------------- rts/sm/GC.c | 4 -- 3 files changed, 111 deletions(-) diff --git a/compiler/ghci/ObjLink.lhs b/compiler/ghci/ObjLink.lhs index 48deb46..7675c71 100644 --- 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 () --- Suspicious; see defn --- insertStableSymbol, -- :: String -> String -> a -> IO () 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 -{- 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 @@ -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 () --- 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 diff --git a/rts/Linker.c b/rts/Linker.c index 54251ac..d508216 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -92,14 +92,8 @@ /* 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; -rootEntry *root_ptr_table = NULL; -static rootEntry *root_ptr_free = NULL; 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 ); - addRootObject((void*)P); S_tmp = stableVal; S = (Elf_Addr)S_tmp; } diff --git a/rts/sm/GC.c b/rts/sm/GC.c index 2870be1..17211ac 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -482,10 +482,6 @@ GarbageCollect ( rtsBool force_major_gc ) */ 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. -- 1.7.10.4