Commit 53e5ed27 authored by David Himmelstrup's avatar David Himmelstrup
Browse files

Export 'insertSymbol' and 'insertStableSymbol'.

'insertStableSymbol' is used for exporting closures that are affected by the GC.
parent 6b2cf62b
......@@ -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
......
......@@ -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 */
......@@ -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.
......
......@@ -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 */
......@@ -988,6 +1092,26 @@ addDLL( char *dll_name )
# endif
}
/* -----------------------------------------------------------------------------
* 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
*/
......@@ -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);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment