From: Lemmih Date: Tue, 18 Apr 2006 02:18:06 +0000 (+0000) Subject: Export 'insertSymbol' and 'insertStableSymbol'. X-Git-Tag: Before_FC_branch_merge~544 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;ds=sidebyside;h=53e5ed273237468ed64ee30caf7a82e2678c4669;p=ghc-hetmet.git Export 'insertSymbol' and 'insertStableSymbol'. 'insertStableSymbol' is used for exporting closures that are affected by the GC. --- diff --git a/compiler/ghci/ObjLink.lhs b/compiler/ghci/ObjLink.lhs index 057938a..5988165 100644 --- a/compiler/ghci/ObjLink.lhs +++ b/compiler/ghci/ObjLink.lhs @@ -16,6 +16,8 @@ module ObjLink ( loadDLL, -- :: String -> IO (Maybe String) loadObj, -- :: String -> IO () unloadObj, -- :: String -> IO () + insertSymbol, -- :: String -> String -> Ptr a -> IO () + insertStableSymbol, -- :: String -> String -> a -> IO () lookupSymbol, -- :: String -> IO (Maybe (Ptr a)) resolveObjs -- :: IO SuccessFlag ) where @@ -23,16 +25,32 @@ module ObjLink ( import Monad ( when ) import Foreign.C -import Foreign ( Ptr, nullPtr ) +import Foreign ( nullPtr ) import Panic ( panic ) import BasicTypes ( SuccessFlag, successIf ) import Config ( cLeadingUnderscore ) import Outputable +import GHC.Exts ( Ptr(..), unsafeCoerce# ) + -- --------------------------------------------------------------------------- -- RTS Linker Interface -- --------------------------------------------------------------------------- +insertSymbol :: String -> String -> Ptr a -> IO () +insertSymbol obj_name key symbol + = let str = prefixUnderscore key + in withCString obj_name $ \c_obj_name -> + withCString str $ \c_str -> + c_insertSymbol c_obj_name c_str symbol + +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 @@ -81,6 +99,9 @@ resolveObjs = do #if __GLASGOW_HASKELL__ >= 504 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 "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 @@ -88,6 +109,9 @@ foreign import ccall unsafe "resolveObjs" c_resolveObjs :: IO Int #else foreign import "addDLL" unsafe c_addDLL :: CString -> IO CString foreign import "initLinker" unsafe initLinker :: IO () +foreign import "insertSymbol" unsafe c_insertSymbol :: CString -> CString -> Ptr a -> IO () +foreign import "insertStableSymbol" unsafe c_insertStableSymbol + :: CString -> CString -> Ptr a -> IO () foreign import "lookupSymbol" unsafe c_lookupSymbol :: CString -> IO (Ptr a) foreign import "loadObj" unsafe c_loadObj :: CString -> IO Int foreign import "unloadObj" unsafe c_unloadObj :: CString -> IO Int diff --git a/includes/Linker.h b/includes/Linker.h index bb1a4c2..948745b 100644 --- a/includes/Linker.h +++ b/includes/Linker.h @@ -12,6 +12,12 @@ /* initialize the object linker */ void initLinker( void ); +/* insert a stable symbol in the hash table */ +void insertStableSymbol(char* obj_name, char* key, StgPtr data); + +/* insert a symbol in the hash table */ +void insertSymbol(char* obj_name, char* key, void* data); + /* lookup a symbol in the hash table */ void *lookupSymbol( char *lbl ); @@ -27,4 +33,7 @@ HsInt resolveObjs( void ); /* load a dynamic library */ char *addDLL( char* dll_name ); +extern void markRootPtrTable(evac_fn evac); + + #endif /* LINKER_H */ diff --git a/rts/GC.c b/rts/GC.c index d71eaee..b75c549 100644 --- a/rts/GC.c +++ b/rts/GC.c @@ -666,6 +666,10 @@ GarbageCollect ( void (*get_roots)(evac_fn), 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. diff --git a/rts/Linker.c b/rts/Linker.c index 92d0106..0db2c5e 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -92,6 +92,17 @@ /* 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; + /* List of currently loaded objects */ ObjectCode *objects = NULL; /* initially empty */ @@ -526,6 +537,8 @@ typedef struct _RtsSymbolVal { SymX(isFloatNegativeZero) \ SymX(killThreadzh_fast) \ SymX(loadObj) \ + SymX(insertStableSymbol) \ + SymX(insertSymbol) \ SymX(lookupSymbol) \ SymX(makeStablePtrzh_fast) \ SymX(minusIntegerzh_fast) \ @@ -790,6 +803,95 @@ static RtsSymbolVal rtsSyms[] = { { 0, 0 } /* sentinel */ }; + +/* ----------------------------------------------------------------------------- + * 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; +} + +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); +} + + +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; + + 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. + * -------------------------------------------------------------------------- */ + + /* ----------------------------------------------------------------------------- * Insert symbols into hash tables, checking for duplicates. */ @@ -852,6 +954,8 @@ initLinker( void ) linker_init_done = 1; } + initRootPtrTable(); + stablehash = allocStrHashTable(); symhash = allocStrHashTable(); /* populate the symbol table with stuff from the RTS */ @@ -989,6 +1093,26 @@ addDLL( char *dll_name ) } /* ----------------------------------------------------------------------------- + * insert a stable symbol in the hash table + */ + +void +insertStableSymbol(char* obj_name, char* key, StgPtr p) +{ + ghciInsertStrHashTable(obj_name, stablehash, key, getStablePtr(p)); +} + + +/* ----------------------------------------------------------------------------- + * insert a symbol in the hash table + */ +void +insertSymbol(char* obj_name, char* key, void* data) +{ + ghciInsertStrHashTable(obj_name, symhash, key, data); +} + +/* ----------------------------------------------------------------------------- * lookup a symbol in the hash table */ void * @@ -3134,6 +3258,8 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, Elf_Addr S; void* S_tmp; Elf_Addr value; + StgStablePtr stablePtr; + StgPtr stableVal; IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)", j, (void*)offset, (void*)info )); @@ -3152,10 +3278,18 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, + stab[ELF_R_SYM(info)].st_value); } else { - /* No, so look up the name in our global table. */ symbol = strtab + sym.st_name; - S_tmp = lookupSymbol( symbol ); - S = (Elf_Addr)S_tmp; + stablePtr = (StgStablePtr)lookupHashTable(stablehash, (StgWord)symbol); + if (NULL == stablePtr) { + /* No, so look up the name in our global table. */ + S_tmp = lookupSymbol( symbol ); + S = (Elf_Addr)S_tmp; + } else { + stableVal = deRefStablePtr( stablePtr ); + addRootObject((void*)P); + S_tmp = stableVal; + S = (Elf_Addr)S_tmp; + } } if (!S) { errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);