projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 2002-02-12 15:17:13 by simonmar]
[ghc-hetmet.git] / ghc / rts / Linker.c
diff --git a/ghc/rts/Linker.c b/ghc/rts/Linker.c
index c8ecee5..1d4711e 100644 (file)
--- a/ghc/rts/Linker.c
+++ b/ghc/rts/Linker.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
 /* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.70 2001/10/22 16:02:44 sewardj Exp $
+ * $Id: Linker.c,v 1.83 2002/02/12 15:17:22 simonmar Exp $
  *
  * (c) The GHC Team, 2000, 2001
  *
  *
  * (c) The GHC Team, 2000, 2001
  *
@@ -142,48 +142,44 @@ typedef struct _RtsSymbolVal {
       Sym(_imp___iob)                           \
       Sym(localtime)                            \
       Sym(gmtime)                               \
       Sym(_imp___iob)                           \
       Sym(localtime)                            \
       Sym(gmtime)                               \
-      SymX(getenv)                              \
-      SymX(free)                                \
-      SymX(rename)                              \
       Sym(opendir)                              \
       Sym(readdir)                              \
       Sym(closedir)                             \
       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(__divdi3)                             \
       Sym(__udivdi3)                            \
       Sym(__moddi3)                             \
-      Sym(__umoddi3)                            \
-      SymX(_errno)
+      Sym(__umoddi3)
 #endif
 
 #endif
 
+#ifndef SMP
+# define MAIN_CAP_SYM SymX(MainCapability)
+#else
+# define MAIN_CAP_SYM
+#endif
 
 #define RTS_SYMBOLS                            \
       Maybe_ForeignObj                         \
       Maybe_Stable_Names                       \
       Sym(StgReturn)                           \
 
 #define RTS_SYMBOLS                            \
       Maybe_ForeignObj                         \
       Maybe_Stable_Names                       \
       Sym(StgReturn)                           \
-      Sym(__stginit_PrelGHC)                   \
+      Sym(__stginit_GHCziPrim)                 \
       Sym(init_stack)                          \
       Sym(init_stack)                          \
-      Sym(stg_chk_0)                           \
-      Sym(stg_chk_1)                           \
+      SymX(__stg_chk_0)                                \
+      SymX(__stg_chk_1)                                \
       Sym(stg_enterStackTop)                   \
       Sym(stg_enterStackTop)                   \
-      Sym(stg_gc_d1)                           \
-      Sym(stg_gc_enter_1)                      \
-      Sym(stg_gc_f1)                           \
-      Sym(stg_gc_noregs)                       \
-      Sym(stg_gc_seq_1)                                \
-      Sym(stg_gc_unbx_r1)                      \
-      Sym(stg_gc_unpt_r1)                      \
-      Sym(stg_gc_ut_0_1)                       \
-      Sym(stg_gc_ut_1_0)                       \
-      Sym(stg_gen_chk)                         \
-      Sym(stg_yield_to_interpreter)            \
+      SymX(stg_gc_d1)                          \
+      SymX(stg_gc_l1)                          \
+      SymX(__stg_gc_enter_1)                   \
+      SymX(stg_gc_f1)                          \
+      SymX(stg_gc_noregs)                      \
+      SymX(stg_gc_seq_1)                       \
+      SymX(stg_gc_unbx_r1)                     \
+      SymX(stg_gc_unpt_r1)                     \
+      SymX(stg_gc_ut_0_1)                      \
+      SymX(stg_gc_ut_1_0)                      \
+      SymX(stg_gen_chk)                                \
+      SymX(stg_yield_to_interpreter)           \
       SymX(ErrorHdrHook)                       \
       SymX(ErrorHdrHook)                       \
-      SymX(MainRegTable)                       \
+      MAIN_CAP_SYM                              \
       SymX(MallocFailHook)                     \
       SymX(NoRunnableThreadsHook)              \
       SymX(OnExitHook)                         \
       SymX(MallocFailHook)                     \
       SymX(NoRunnableThreadsHook)              \
       SymX(OnExitHook)                         \
@@ -207,30 +203,42 @@ typedef struct _RtsSymbolVal {
       SymX(catchzh_fast)                       \
       SymX(cmp_thread)                         \
       SymX(complementIntegerzh_fast)           \
       SymX(catchzh_fast)                       \
       SymX(cmp_thread)                         \
       SymX(complementIntegerzh_fast)           \
+      SymX(cmpIntegerzh_fast)                  \
+      SymX(cmpIntegerIntzh_fast)               \
       SymX(createAdjustor)                     \
       SymX(decodeDoublezh_fast)                        \
       SymX(decodeFloatzh_fast)                 \
       SymX(defaultsHook)                       \
       SymX(delayzh_fast)                       \
       SymX(createAdjustor)                     \
       SymX(decodeDoublezh_fast)                        \
       SymX(decodeFloatzh_fast)                 \
       SymX(defaultsHook)                       \
       SymX(delayzh_fast)                       \
+      SymX(deRefWeakzh_fast)                   \
+      SymX(deRefStablePtrzh_fast)              \
       SymX(divExactIntegerzh_fast)             \
       SymX(divModIntegerzh_fast)               \
       SymX(forkzh_fast)                                \
       SymX(freeHaskellFunctionPtr)             \
       SymX(divExactIntegerzh_fast)             \
       SymX(divModIntegerzh_fast)               \
       SymX(forkzh_fast)                                \
       SymX(freeHaskellFunctionPtr)             \
+      SymX(freeStablePtr)                      \
       SymX(gcdIntegerzh_fast)                  \
       SymX(gcdIntegerzh_fast)                  \
+      SymX(gcdIntegerIntzh_fast)               \
+      SymX(gcdIntzh_fast)                      \
       SymX(getProgArgv)                                \
       SymX(getStablePtr)                       \
       SymX(int2Integerzh_fast)                 \
       SymX(getProgArgv)                                \
       SymX(getStablePtr)                       \
       SymX(int2Integerzh_fast)                 \
+      SymX(integer2Intzh_fast)                 \
+      SymX(integer2Wordzh_fast)                        \
       SymX(isDoubleDenormalized)               \
       SymX(isDoubleInfinite)                   \
       SymX(isDoubleNaN)                                \
       SymX(isDoubleNegativeZero)               \
       SymX(isDoubleDenormalized)               \
       SymX(isDoubleInfinite)                   \
       SymX(isDoubleNaN)                                \
       SymX(isDoubleNegativeZero)               \
+      SymX(isEmptyMVarzh_fast)                 \
       SymX(isFloatDenormalized)                        \
       SymX(isFloatInfinite)                    \
       SymX(isFloatNaN)                         \
       SymX(isFloatNegativeZero)                        \
       SymX(killThreadzh_fast)                  \
       SymX(isFloatDenormalized)                        \
       SymX(isFloatInfinite)                    \
       SymX(isFloatNaN)                         \
       SymX(isFloatNegativeZero)                        \
       SymX(killThreadzh_fast)                  \
+      SymX(makeStablePtrzh_fast)               \
       SymX(minusIntegerzh_fast)                        \
       SymX(mkApUpd0zh_fast)                    \
       SymX(minusIntegerzh_fast)                        \
       SymX(mkApUpd0zh_fast)                    \
+      SymX(myThreadIdzh_fast)                  \
       SymX(newArrayzh_fast)                    \
       SymX(newBCOzh_fast)                      \
       SymX(newByteArrayzh_fast)                        \
       SymX(newArrayzh_fast)                    \
       SymX(newBCOzh_fast)                      \
       SymX(newByteArrayzh_fast)                        \
@@ -265,6 +273,7 @@ typedef struct _RtsSymbolVal {
       SymX(rts_getInt32)                       \
       SymX(rts_getPtr)                         \
       SymX(rts_getStablePtr)                   \
       SymX(rts_getInt32)                       \
       SymX(rts_getPtr)                         \
       SymX(rts_getStablePtr)                   \
+      SymX(rts_getThreadId)                    \
       SymX(rts_getWord)                                \
       SymX(rts_getWord32)                      \
       SymX(rts_mkAddr)                         \
       SymX(rts_getWord)                                \
       SymX(rts_getWord32)                      \
       SymX(rts_mkAddr)                         \
@@ -324,7 +333,7 @@ typedef struct _RtsSymbolVal {
       SymX(stg_sel_9_upd_info)                 \
       SymX(stg_seq_frame_info)                 \
       SymX(stg_upd_frame_info)                 \
       SymX(stg_sel_9_upd_info)                 \
       SymX(stg_seq_frame_info)                 \
       SymX(stg_upd_frame_info)                 \
-      SymX(stg_update_PAP)                     \
+      SymX(__stg_update_PAP)                   \
       SymX(suspendThread)                      \
       SymX(takeMVarzh_fast)                    \
       SymX(timesIntegerzh_fast)                        \
       SymX(suspendThread)                      \
       SymX(takeMVarzh_fast)                    \
       SymX(timesIntegerzh_fast)                        \
@@ -543,7 +552,7 @@ lookupSymbol( char *lbl )
         OpenedDLL* o_dll;
         void* sym;
         for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
         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
            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
@@ -551,10 +560,16 @@ lookupSymbol( char *lbl )
                  stripped off when mapping from import lib name to the DLL name.
               */
               sym = GetProcAddress(o_dll->instance, (lbl+1));
                  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);
            }
            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
         }
         return NULL;
 #       else
@@ -567,6 +582,7 @@ lookupSymbol( char *lbl )
 }
 
 static 
 }
 
 static 
+__attribute((unused))
 void *
 lookupLocalSymbol( ObjectCode* oc, char *lbl )
 {
 void *
 lookupLocalSymbol( ObjectCode* oc, char *lbl )
 {
@@ -582,6 +598,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.
  * Load an obj (populate the global symbol table, but don't resolve yet)
  *
  * Returns: 1 if ok, 0 on error.
@@ -805,6 +857,10 @@ static void addSection ( ObjectCode* oc, SectionKind kind,
    s->kind      = kind;
    s->next      = oc->sections;
    oc->sections = s;
    s->kind      = kind;
    s->next      = oc->sections;
    oc->sections = s;
+   /* 
+   fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n", 
+                   start, ((char*)end)-1, end - start + 1, kind ); 
+   */
 }
 
 
 }
 
 
@@ -818,6 +874,33 @@ static void addSection ( ObjectCode* oc, SectionKind kind,
       and Common Object File Format Specification
       revision 5.1 January 1998
    which SimonM says comes from the MS Developer Network CDs.
       and Common Object File Format Specification
       revision 5.1 January 1998
    which SimonM says comes from the MS Developer Network CDs.
+   
+   It can be found there (on older CDs), but can also be found 
+   online at:
+
+      http://www.microsoft.com/hwdev/hardware/PECOFF.asp
+
+   (this is Rev 6.0 from February 1999).
+
+   Things move, so if that fails, try searching for it via
+
+      http://www.google.com/search?q=PE+COFF+specification     
+
+   The ultimate reference for the PE format is the Winnt.h 
+   header file that comes with the Platform SDKs; as always,
+   implementations will drift wrt their documentation.
+   
+   A good background article on the PE format is Matt Pietrek's
+   March 1994 article in Microsoft System Journal (MSJ)
+   (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
+   Win32 Portable Executable File Format." The info in there
+   has recently been updated in a two part article in 
+   MSDN magazine, issues Feb and March 2002,
+   "Inside Windows: An In-Depth Look into the Win32 Portable
+   Executable File Format"
+
+   John Levine's book "Linkers and Loaders" contains useful
+   info on PE too.
 */
       
 
 */
       
 
@@ -909,6 +992,7 @@ typedef
 /* From PE spec doc, section 4.1 */
 #define MYIMAGE_SCN_CNT_CODE             0x00000020
 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
 /* From PE spec doc, section 4.1 */
 #define MYIMAGE_SCN_CNT_CODE             0x00000020
 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
+#define MYIMAGE_SCN_LNK_NRELOC_OVFL      0x01000000
 
 /* From PE spec doc, section 5.2.1 */
 #define MYIMAGE_REL_I386_DIR32           0x0006
 
 /* From PE spec doc, section 5.2.1 */
 #define MYIMAGE_REL_I386_DIR32           0x0006
@@ -1042,7 +1126,8 @@ zapTrailingAtSign ( UChar* sym )
 static int
 ocVerifyImage_PEi386 ( ObjectCode* oc )
 {
 static int
 ocVerifyImage_PEi386 ( ObjectCode* oc )
 {
-   int i, j;
+   int i;
+   UInt32 j, noRelocs;
    COFF_header*  hdr;
    COFF_section* sectab;
    COFF_symbol*  symtab;
    COFF_header*  hdr;
    COFF_section* sectab;
    COFF_symbol*  symtab;
@@ -1085,13 +1170,15 @@ ocVerifyImage_PEi386 ( ObjectCode* oc )
       there are more than 64k relocations, despite claims to the
       contrary.  Hence this test. */
    /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
       there are more than 64k relocations, despite claims to the
       contrary.  Hence this test. */
    /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
-   if (* (UInt32*)strtab > 600000) {
+#if 0
+   if ( (*(UInt32*)strtab) > 600000 ) {
       /* Note that 600k has no special significance other than being
          big enough to handle the almost-2MB-sized lumps that
          constitute HSwin32*.o. */
       belch("PEi386 object has suspiciously large string table; > 64k relocs?");
       return 0;
    }
       /* Note that 600k has no special significance other than being
          big enough to handle the almost-2MB-sized lumps that
          constitute HSwin32*.o. */
       belch("PEi386 object has suspiciously large string table; > 64k relocs?");
       return 0;
    }
+#endif
 
    /* No further verification after this point; only debug printing. */
    i = 0;
 
    /* No further verification after this point; only debug printing. */
    i = 0;
@@ -1155,8 +1242,23 @@ ocVerifyImage_PEi386 ( ObjectCode* oc )
       reltab = (COFF_reloc*) (
                   ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
                );
       reltab = (COFF_reloc*) (
                   ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
                );
+              
+      if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
+       /* If the relocation field (a short) has overflowed, the
+        * real count can be found in the first reloc entry.
+        * 
+        * See Section 4.1 (last para) of the PE spec (rev6.0).
+        */
+        COFF_reloc* rel = (COFF_reloc*)
+                           myindex ( sizeof_COFF_reloc, reltab, 0 );
+       noRelocs = rel->VirtualAddress;
+       j = 1;
+      } else {
+       noRelocs = sectab_i->NumberOfRelocations;
+        j = 0;
+      }
 
 
-      for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
+      for (; j < noRelocs; j++) {
          COFF_symbol* sym;
          COFF_reloc* rel = (COFF_reloc*)
                            myindex ( sizeof_COFF_reloc, reltab, j );
          COFF_symbol* sym;
          COFF_reloc* rel = (COFF_reloc*)
                            myindex ( sizeof_COFF_reloc, reltab, j );
@@ -1166,6 +1268,7 @@ ocVerifyImage_PEi386 ( ObjectCode* oc )
                    rel->VirtualAddress );
          sym = (COFF_symbol*)
                myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
                    rel->VirtualAddress );
          sym = (COFF_symbol*)
                myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
+        /* Hmm..mysterious looking offset - what's it for? SOF */
          printName ( sym->Name, strtab -10 );
          fprintf ( stderr, "'\n" );
       }
          printName ( sym->Name, strtab -10 );
          fprintf ( stderr, "'\n" );
       }
@@ -1362,9 +1465,9 @@ ocGetNames_PEi386 ( ObjectCode* oc )
          /* fprintf(stderr, "BSS      section at 0x%x\n", addr); */
       }
 
          /* fprintf(stderr, "BSS      section at 0x%x\n", addr); */
       }
 
-      if (addr != NULL) {
+      if (addr != NULL ) {
          sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
          sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
-         /* fprintf(stderr,"addSymbol %p `%s'\n", addr,sname); */
+         /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname);  */
          IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
          ASSERT(i >= 0 && i < oc->n_symbols);
          /* cstring_from_COFF_symbol_name always succeeds. */
          IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
          ASSERT(i >= 0 && i < oc->n_symbols);
          /* cstring_from_COFF_symbol_name always succeeds. */
@@ -1414,7 +1517,8 @@ ocResolve_PEi386 ( ObjectCode* oc )
    UInt32        S;
    UInt32*       pP;
 
    UInt32        S;
    UInt32*       pP;
 
-   int i, j;
+   int i;
+   UInt32 j, noRelocs;
 
    /* ToDo: should be variable-sized?  But is at least safe in the
       sense of buffer-overrun-proof. */
 
    /* ToDo: should be variable-sized?  But is at least safe in the
       sense of buffer-overrun-proof. */
@@ -1449,7 +1553,24 @@ ocResolve_PEi386 ( ObjectCode* oc )
           || 0 == strcmp(".stabstr", sectab_i->Name))
          continue;
 
           || 0 == strcmp(".stabstr", sectab_i->Name))
          continue;
 
-      for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
+      if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
+       /* If the relocation field (a short) has overflowed, the
+        * real count can be found in the first reloc entry.
+         *
+        * See Section 4.1 (last para) of the PE spec (rev6.0).
+        */
+        COFF_reloc* rel = (COFF_reloc*)
+                           myindex ( sizeof_COFF_reloc, reltab, 0 );
+       noRelocs = rel->VirtualAddress;
+       fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
+       j = 1;
+      } else {
+       noRelocs = sectab_i->NumberOfRelocations;
+        j = 0;
+      }
+
+
+      for (; j < noRelocs; j++) {
          COFF_symbol* sym;
          COFF_reloc* reltab_j 
             = (COFF_reloc*)
          COFF_symbol* sym;
          COFF_reloc* reltab_j 
             = (COFF_reloc*)
@@ -1558,6 +1679,7 @@ ocResolve_PEi386 ( ObjectCode* oc )
  */
 
 #include <elf.h>
  */
 
 #include <elf.h>
+#include <ctype.h>
 
 static char *
 findElfSection ( void* objImage, Elf32_Word sh_type )
 
 static char *
 findElfSection ( void* objImage, Elf32_Word sh_type )
@@ -1574,7 +1696,7 @@ findElfSection ( void* objImage, Elf32_Word sh_type )
           && i != ehdr->e_shstrndx
          /* Ignore string tables named .stabstr, as they contain
              debugging info. */
           && i != ehdr->e_shstrndx
          /* Ignore string tables named .stabstr, as they contain
              debugging info. */
-          && 0 != strcmp(".stabstr", sh_strtab + shdr[i].sh_name)
+          && 0 != strncmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
          ) {
          ptr = ehdrC + shdr[i].sh_offset;
          break;
          ) {
          ptr = ehdrC + shdr[i].sh_offset;
          break;
@@ -1684,7 +1806,7 @@ ocVerifyImage_ELF ( ObjectCode* oc )
           && i != ehdr->e_shstrndx
          /* Ignore string tables named .stabstr, as they contain
              debugging info. */
           && i != ehdr->e_shstrndx
          /* Ignore string tables named .stabstr, as they contain
              debugging info. */
-          && 0 != strcmp(".stabstr", sh_strtab + shdr[i].sh_name)
+          && 0 != strncmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
          ) {
          IF_DEBUG(linker,belch("   section %d is a normal string table", i ));
          strtab = ehdrC + shdr[i].sh_offset;
          ) {
          IF_DEBUG(linker,belch("   section %d is a normal string table", i ));
          strtab = ehdrC + shdr[i].sh_offset;
@@ -1762,7 +1884,6 @@ ocGetNames_ELF ( ObjectCode* oc )
    Elf32_Ehdr* ehdr       = (Elf32_Ehdr*)ehdrC;
    char*       strtab     = findElfSection ( ehdrC, SHT_STRTAB );
    Elf32_Shdr* shdr       = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
    Elf32_Ehdr* ehdr       = (Elf32_Ehdr*)ehdrC;
    char*       strtab     = findElfSection ( ehdrC, SHT_STRTAB );
    Elf32_Shdr* shdr       = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
-   char*       sh_strtab  = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
 
    ASSERT(symhash != NULL);
 
 
    ASSERT(symhash != NULL);
 
@@ -1773,19 +1894,39 @@ ocGetNames_ELF ( ObjectCode* oc )
 
    k = 0;
    for (i = 0; i < ehdr->e_shnum; i++) {
 
    k = 0;
    for (i = 0; i < ehdr->e_shnum; i++) {
+      /* Figure out what kind of section it is.  Logic derived from
+         Figure 1.14 ("Special Sections") of the ELF document
+         ("Portable Formats Specification, Version 1.1"). */
+      Elf32_Shdr  hdr    = shdr[i];
+      SectionKind kind   = SECTIONKIND_OTHER;
+      int         is_bss = FALSE;
+
+      if (hdr.sh_type == SHT_PROGBITS 
+          && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
+         /* .text-style section */
+         kind = SECTIONKIND_CODE_OR_RODATA;
+      }
+      else
+      if (hdr.sh_type == SHT_PROGBITS 
+          && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
+         /* .data-style section */
+         kind = SECTIONKIND_RWDATA;
+      }
+      else
+      if (hdr.sh_type == SHT_PROGBITS 
+          && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
+         /* .rodata-style section */
+         kind = SECTIONKIND_CODE_OR_RODATA;
+      }
+      else
+      if (hdr.sh_type == SHT_NOBITS 
+          && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
+         /* .bss-style section */
+         kind = SECTIONKIND_RWDATA;
+         is_bss = TRUE;
+      }
 
 
-      /* make a section entry for relevant sections */
-      SectionKind kind = SECTIONKIND_OTHER;
-      if (!strcmp(".data",sh_strtab+shdr[i].sh_name) ||
-          !strcmp(".data1",sh_strtab+shdr[i].sh_name) ||
-          !strcmp(".bss",sh_strtab+shdr[i].sh_name))
-         kind = SECTIONKIND_RWDATA;
-      if (!strcmp(".text",sh_strtab+shdr[i].sh_name) ||
-          !strcmp(".rodata",sh_strtab+shdr[i].sh_name) ||
-          !strcmp(".rodata1",sh_strtab+shdr[i].sh_name))
-         kind = SECTIONKIND_CODE_OR_RODATA;
-
-      if (!strcmp(".bss",sh_strtab+shdr[i].sh_name) && shdr[i].sh_size > 0) {
+      if (is_bss && shdr[i].sh_size > 0) {
          /* This is a non-empty .bss section.  Allocate zeroed space for
             it, and set its .sh_offset field such that 
             ehdrC + .sh_offset == addr_of_zeroed_space.  */
          /* This is a non-empty .bss section.  Allocate zeroed space for
             it, and set its .sh_offset field such that 
             ehdrC + .sh_offset == addr_of_zeroed_space.  */
@@ -1799,10 +1940,11 @@ ocGetNames_ELF ( ObjectCode* oc )
       }
 
       /* fill in the section info */
       }
 
       /* fill in the section info */
-      addSection(oc, kind, ehdrC + shdr[i].sh_offset, 
-                     ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
-      if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0)
+      if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
          addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
          addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
+         addSection(oc, kind, ehdrC + shdr[i].sh_offset, 
+                        ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
+      }
 
       if (shdr[i].sh_type != SHT_SYMTAB) continue;
 
 
       if (shdr[i].sh_type != SHT_SYMTAB) continue;
 
@@ -1859,8 +2001,6 @@ ocGetNames_ELF ( ObjectCode* oc )
             */
             ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
             if (ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL) {
             */
             ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
             if (ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL) {
-               IF_DEBUG(linker,belch( "addOTabName(LOCL): %10p  %s %s",
-                                      ad, oc->fileName, nm ));
                isLocal = TRUE;
             } else {
                IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p  %s %s",
                isLocal = TRUE;
             } else {
                IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p  %s %s",
@@ -1876,7 +2016,7 @@ ocGetNames_ELF ( ObjectCode* oc )
            oc->symbols[j] = nm;
             /* Acquire! */
             if (isLocal) {
            oc->symbols[j] = nm;
             /* Acquire! */
             if (isLocal) {
-               ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, ad);
+               /* Ignore entirely. */
             } else {
                ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
             }
             } else {
                ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
             }
@@ -1936,20 +2076,21 @@ do_Elf32_Rel_relocations ( ObjectCode* oc, char* ehdrC,
          IF_DEBUG(linker,belch( " ZERO" ));
          S = 0;
       } else {
          IF_DEBUG(linker,belch( " ZERO" ));
          S = 0;
       } else {
-         /* First see if it is a nameless local symbol. */
-         if (stab[ ELF32_R_SYM(info)].st_name == 0) {
-            symbol = "(noname)";
+         Elf32_Sym sym = stab[ELF32_R_SYM(info)];
+        /* First see if it is a local symbol. */
+         if (ELF32_ST_BIND(sym.st_info) == STB_LOCAL) {
+            /* Yes, so we can get the address directly from the ELF symbol
+               table. */
+            symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
             S = (Elf32_Addr)
             S = (Elf32_Addr)
-                (ehdrC + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset
+                (ehdrC + shdr[ sym.st_shndx ].sh_offset
                        + stab[ELF32_R_SYM(info)].st_value);
                        + stab[ELF32_R_SYM(info)].st_value);
-         } else {
-            /* No?  Should be in a symbol table then; first try the
-               local one. */
-            symbol = strtab+stab[ ELF32_R_SYM(info)].st_name;
-            (void*)S = lookupLocalSymbol( oc, symbol );
-            if ((void*)S == NULL)
-               (void*)S = lookupSymbol( symbol );
-         }
+
+        } else {
+            /* No, so look up the name in our global table. */
+            symbol = strtab + sym.st_name;
+            (void*)S = lookupSymbol( symbol );
+        }
          if (!S) {
             belch("%s: unknown symbol `%s'", oc->fileName, symbol);
            return 0;
          if (!S) {
             belch("%s: unknown symbol `%s'", oc->fileName, symbol);
            return 0;
@@ -1998,7 +2139,7 @@ do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC,
       Elf32_Word  info   = rtab[j].r_info;
       Elf32_Sword addend = rtab[j].r_addend;
       Elf32_Addr  P  = ((Elf32_Addr)targ) + offset;
       Elf32_Word  info   = rtab[j].r_info;
       Elf32_Sword addend = rtab[j].r_addend;
       Elf32_Addr  P  = ((Elf32_Addr)targ) + offset;
-      Elf32_Addr  A  = addend;
+      Elf32_Addr  A  = addend; /* Do not delete this; it is used on sparc. */
       Elf32_Addr  S;
 #     if defined(sparc_TARGET_ARCH)
       /* This #ifdef only serves to avoid unused-var warnings. */
       Elf32_Addr  S;
 #     if defined(sparc_TARGET_ARCH)
       /* This #ifdef only serves to avoid unused-var warnings. */
@@ -2013,20 +2154,21 @@ do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC,
          IF_DEBUG(linker,belch( " ZERO" ));
          S = 0;
       } else {
          IF_DEBUG(linker,belch( " ZERO" ));
          S = 0;
       } else {
-         /* First see if it is a nameless local symbol. */
-         if (stab[ ELF32_R_SYM(info)].st_name == 0) {
-            symbol = "(noname)";
+         Elf32_Sym sym = stab[ELF32_R_SYM(info)];
+        /* First see if it is a local symbol. */
+         if (ELF32_ST_BIND(sym.st_info) == STB_LOCAL) {
+            /* Yes, so we can get the address directly from the ELF symbol
+               table. */
+            symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
             S = (Elf32_Addr)
             S = (Elf32_Addr)
-                (ehdrC + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset
+                (ehdrC + shdr[ sym.st_shndx ].sh_offset
                        + stab[ELF32_R_SYM(info)].st_value);
                        + stab[ELF32_R_SYM(info)].st_value);
-         } else {
-            /* No?  Should be in a symbol table then; first try the
-               local one. */
-            symbol = strtab+stab[ ELF32_R_SYM(info)].st_name;
-            (void*)S = lookupLocalSymbol( oc, symbol );
-            if ((void*)S == NULL)
-               (void*)S = lookupSymbol( symbol );
-         }
+
+        } else {
+            /* No, so look up the name in our global table. */
+            symbol = strtab + sym.st_name;
+            (void*)S = lookupSymbol( symbol );
+        }
          if (!S) {
           belch("%s: unknown symbol `%s'", oc->fileName, symbol);
           return 0;
          if (!S) {
           belch("%s: unknown symbol `%s'", oc->fileName, symbol);
           return 0;
@@ -2119,7 +2261,7 @@ ocResolve_ELF ( ObjectCode* oc )
          relocation entries that, when done, make the stabs debugging
          info point at the right places.  We ain't interested in all
          dat jazz, mun. */
          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))
+      if (0 == strncmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
          continue;
 
       if (shdr[shnum].sh_type == SHT_REL ) {
          continue;
 
       if (shdr[shnum].sh_type == SHT_REL ) {
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)