/* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.68 2001/10/01 13:10:53 simonmar Exp $
+ * $Id: Linker.c,v 1.72 2001/10/26 11:33:13 sewardj Exp $
*
* (c) The GHC Team, 2000, 2001
*
Sym(_imp___iob) \
Sym(localtime) \
Sym(gmtime) \
- SymX(getenv) \
- SymX(free) \
- SymX(rename) \
Sym(opendir) \
Sym(readdir) \
Sym(closedir) \
- SymX(GetCurrentProcess) \
- SymX(GetProcessTimes) \
- SymX(CloseHandle) \
- SymX(GetExitCodeProcess) \
- SymX(WaitForSingleObject) \
- SymX(CreateProcessA) \
Sym(__divdi3) \
Sym(__udivdi3) \
Sym(__moddi3) \
- Sym(__umoddi3) \
- SymX(_errno)
+ Sym(__umoddi3)
#endif
};
/* -----------------------------------------------------------------------------
+ * Insert symbols into hash tables, checking for duplicates.
+ */
+static void ghciInsertStrHashTable ( char* obj_name,
+ HashTable *table,
+ char* key,
+ void *data
+ )
+{
+ if (lookupHashTable(table, (StgWord)key) == NULL)
+ {
+ insertStrHashTable(table, (StgWord)key, data);
+ return;
+ }
+ fprintf(stderr,
+ "\n\n"
+ "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
+ " %s\n"
+ "whilst processing object file\n"
+ " %s\n"
+ "This could be caused by:\n"
+ " * Loading two different object files which export the same symbol\n"
+ " * Specifying the same object file twice on the GHCi command line\n"
+ " * An incorrect `package.conf' entry, causing some object to be\n"
+ " loaded twice.\n"
+ "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
+ "\n",
+ (char*)key,
+ obj_name
+ );
+ exit(1);
+}
+
+
+/* -----------------------------------------------------------------------------
* initialize the object linker
*/
#if defined(OBJFORMAT_ELF)
/* populate the symbol table with stuff from the RTS */
for (sym = rtsSyms; sym->lbl != NULL; sym++) {
- insertStrHashTable(symhash, sym->lbl, sym->addr);
+ ghciInsertStrHashTable("(GHCi built-in symbols)",
+ symhash, sym->lbl, sym->addr);
}
# if defined(OBJFORMAT_ELF)
dl_prog_handle = dlopen(NULL, RTLD_LAZY);
OpenedDLL* o_dll;
void* sym;
for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
- /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
+ /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
if (lbl[0] == '_') {
/* HACK: if the name has an initial underscore, try stripping
it off & look that up first. I've yet to verify whether there's
stripped off when mapping from import lib name to the DLL name.
*/
sym = GetProcAddress(o_dll->instance, (lbl+1));
- if (sym != NULL) return sym;
+ if (sym != NULL) {
+ /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
+ return sym;
+ }
}
sym = GetProcAddress(o_dll->instance, lbl);
- if (sym != NULL) return sym;
+ if (sym != NULL) {
+ /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
+ return sym;
+ }
}
return NULL;
# else
/* -----------------------------------------------------------------------------
+ * Debugging aid: look in GHCi's object symbol tables for symbols
+ * within DELTA bytes of the specified address, and show their names.
+ */
+#ifdef DEBUG
+void ghci_enquire ( char* addr );
+
+void ghci_enquire ( char* addr )
+{
+ int i;
+ char* sym;
+ char* a;
+ const int DELTA = 64;
+ ObjectCode* oc;
+ for (oc = objects; oc; oc = oc->next) {
+ for (i = 0; i < oc->n_symbols; i++) {
+ sym = oc->symbols[i];
+ if (sym == NULL) continue;
+ /* fprintf(stderr, "enquire %p %p\n", sym, oc->lochash); */
+ a = NULL;
+ if (oc->lochash != NULL)
+ a = lookupStrHashTable(oc->lochash, sym);
+ if (a == NULL)
+ a = lookupStrHashTable(symhash, sym);
+ if (a == NULL) {
+ /* fprintf(stderr, "ghci_enquire: can't find %s\n", sym); */
+ }
+ else if (addr-DELTA <= a && a <= addr+DELTA) {
+ fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
+ }
+ }
+ }
+}
+#endif
+
+
+/* -----------------------------------------------------------------------------
* Load an obj (populate the global symbol table, but don't resolve yet)
*
* Returns: 1 if ok, 0 on error.
FILE *f;
/* fprintf(stderr, "loadObj %s\n", path ); */
-# ifdef DEBUG
- /* assert that we haven't already loaded this object */
+
+ /* Check that we haven't already loaded this object. Don't give up
+ at this stage; ocGetNames_* will barf later. */
{
ObjectCode *o;
- for (o = objects; o; o = o->next)
- ASSERT(strcmp(o->fileName, path));
+ int is_dup = 0;
+ for (o = objects; o; o = o->next) {
+ if (0 == strcmp(o->fileName, path))
+ is_dup = 1;
+ }
+ if (is_dup) {
+ fprintf(stderr,
+ "\n\n"
+ "GHCi runtime linker: warning: looks like you're trying to load the\n"
+ "same object file twice:\n"
+ " %s\n"
+ "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
+ "\n"
+ , path);
+ }
}
-# endif /* DEBUG */
oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
end = start + sz - 1;
- if (kind == SECTIONKIND_OTHER) {
+ if (kind == SECTIONKIND_OTHER
+ /* Ignore sections called which contain stabs debugging
+ information. */
+ && 0 != strcmp(".stab", sectab_i->Name)
+ && 0 != strcmp(".stabstr", sectab_i->Name)
+ ) {
belch("Unknown PEi386 section name `%s'", sectab_i->Name);
return 0;
}
- if (end >= start) {
+ if (kind != SECTIONKIND_OTHER && end >= start) {
addSection(oc, kind, start, end);
addProddableBlock(oc, start, end - start + 1);
}
ASSERT(i >= 0 && i < oc->n_symbols);
/* cstring_from_COFF_symbol_name always succeeds. */
oc->symbols[i] = sname;
- insertStrHashTable(symhash, sname, addr);
+ ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
} else {
# if 0
fprintf ( stderr,
= (COFF_reloc*) (
((UChar*)(oc->image)) + sectab_i->PointerToRelocations
);
+
+ /* Ignore sections called which contain stabs debugging
+ information. */
+ if (0 == strcmp(".stab", sectab_i->Name)
+ || 0 == strcmp(".stabstr", sectab_i->Name))
+ continue;
+
for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
COFF_symbol* sym;
COFF_reloc* reltab_j
{
int i;
char* ehdrC = (char*)objImage;
- Elf32_Ehdr* ehdr = ( Elf32_Ehdr*)ehdrC;
- Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
+ Elf32_Ehdr* ehdr = (Elf32_Ehdr*)ehdrC;
+ Elf32_Shdr* shdr = (Elf32_Shdr*)(ehdrC + ehdr->e_shoff);
+ char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
char* ptr = NULL;
for (i = 0; i < ehdr->e_shnum; i++) {
- if (shdr[i].sh_type == sh_type &&
- i != ehdr->e_shstrndx) {
+ if (shdr[i].sh_type == sh_type
+ /* Ignore the section header's string table. */
+ && i != ehdr->e_shstrndx
+ /* Ignore string tables named .stabstr, as they contain
+ debugging info. */
+ && 0 != strcmp(".stabstr", sh_strtab + shdr[i].sh_name)
+ ) {
ptr = ehdrC + shdr[i].sh_offset;
break;
}
strtab = NULL;
nstrtab = 0;
for (i = 0; i < ehdr->e_shnum; i++) {
- if (shdr[i].sh_type == SHT_STRTAB &&
- i != ehdr->e_shstrndx) {
- IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
+ if (shdr[i].sh_type == SHT_STRTAB
+ /* Ignore the section header's string table. */
+ && i != ehdr->e_shstrndx
+ /* Ignore string tables named .stabstr, as they contain
+ debugging info. */
+ && 0 != strcmp(".stabstr", sh_strtab + shdr[i].sh_name)
+ ) {
+ IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
strtab = ehdrC + shdr[i].sh_offset;
nstrtab++;
}
oc->symbols[j] = nm;
/* Acquire! */
if (isLocal) {
- insertStrHashTable(oc->lochash, nm, ad);
+ ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, ad);
} else {
- insertStrHashTable(symhash, nm, ad);
+ ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
}
} else {
/* Skip. */
char* ehdrC = (char*)(oc->image);
Elf32_Ehdr* ehdr = (Elf32_Ehdr*) ehdrC;
Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
+ char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
/* first find "the" symbol table */
stab = (Elf32_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
/* Process the relocation sections. */
for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
+
+ /* Skip sections called ".rel.stab". These appear to contain
+ relocation entries that, when done, make the stabs debugging
+ info point at the right places. We ain't interested in all
+ dat jazz, mun. */
+ if (0 == strcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name))
+ continue;
+
if (shdr[shnum].sh_type == SHT_REL ) {
ok = do_Elf32_Rel_relocations ( oc, ehdrC, shdr,
shnum, stab, strtab );
shnum, stab, strtab );
if (!ok) return ok;
}
+
}
/* Free the local symbol table; we won't need it again. */