[project @ 2001-10-26 11:33:13 by sewardj]
[ghc-hetmet.git] / ghc / rts / Linker.c
index a16dd00..8cd1b02 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $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
  *
@@ -142,23 +142,13 @@ typedef struct _RtsSymbolVal {
       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
 
 
@@ -375,6 +365,40 @@ static RtsSymbolVal rtsSyms[] = {
 };
 
 /* -----------------------------------------------------------------------------
+ * 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)
@@ -390,7 +414,8 @@ initLinker( void )
 
     /* 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);
@@ -508,7 +533,7 @@ lookupSymbol( char *lbl )
         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
@@ -516,10 +541,16 @@ lookupSymbol( char *lbl )
                  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
@@ -547,6 +578,42 @@ lookupLocalSymbol( ObjectCode* oc, char *lbl )
 
 
 /* -----------------------------------------------------------------------------
+ * 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.
@@ -560,14 +627,27 @@ loadObj( char *path )
    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)");
 
@@ -1251,12 +1331,17 @@ ocGetNames_PEi386 ( ObjectCode* 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);
       }
@@ -1316,7 +1401,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
          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, 
@@ -1389,6 +1474,13 @@ ocResolve_PEi386 ( ObjectCode* oc )
          = (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 
@@ -1504,12 +1596,18 @@ findElfSection ( void* objImage, Elf32_Word sh_type )
 {
    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;
       }
@@ -1613,9 +1711,14 @@ ocVerifyImage_ELF ( ObjectCode* oc )
    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++;
       }
@@ -1805,9 +1908,9 @@ ocGetNames_ELF ( ObjectCode* oc )
            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. */
@@ -2028,6 +2131,7 @@ ocResolve_ELF ( ObjectCode* oc )
    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 );
@@ -2042,6 +2146,14 @@ ocResolve_ELF ( ObjectCode* oc )
 
    /* 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 );
@@ -2053,6 +2165,7 @@ ocResolve_ELF ( ObjectCode* oc )
                                           shnum, stab, strtab );
          if (!ok) return ok;
       }
+
    }
 
    /* Free the local symbol table; we won't need it again. */