[project @ 2002-02-01 02:05:52 by sof]
[ghc-hetmet.git] / ghc / rts / Linker.c
index a82babc..3ed1843 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.76 2001/12/10 17:59:54 sof Exp $
+ * $Id: Linker.c,v 1.81 2002/02/01 02:05:52 sof Exp $
  *
  * (c) The GHC Team, 2000, 2001
  *
@@ -203,30 +203,42 @@ typedef struct _RtsSymbolVal {
       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(deRefWeakzh_fast)                   \
+      SymX(deRefStablePtrzh_fast)              \
       SymX(divExactIntegerzh_fast)             \
       SymX(divModIntegerzh_fast)               \
       SymX(forkzh_fast)                                \
       SymX(freeHaskellFunctionPtr)             \
+      SymX(freeStablePtr)                      \
       SymX(gcdIntegerzh_fast)                  \
+      SymX(gcdIntegerIntzh_fast)               \
+      SymX(gcdIntzh_fast)                      \
       SymX(getProgArgv)                                \
       SymX(getStablePtr)                       \
       SymX(int2Integerzh_fast)                 \
+      SymX(integer2Intzh_fast)                 \
+      SymX(integer2Wordzh_fast)                        \
       SymX(isDoubleDenormalized)               \
       SymX(isDoubleInfinite)                   \
       SymX(isDoubleNaN)                                \
       SymX(isDoubleNegativeZero)               \
+      SymX(isEmptyMVarzh_fast)                 \
       SymX(isFloatDenormalized)                        \
       SymX(isFloatInfinite)                    \
       SymX(isFloatNaN)                         \
       SymX(isFloatNegativeZero)                        \
       SymX(killThreadzh_fast)                  \
+      SymX(makeStablePtrzh_fast)               \
       SymX(minusIntegerzh_fast)                        \
       SymX(mkApUpd0zh_fast)                    \
+      SymX(myThreadIdzh_fast)                  \
       SymX(newArrayzh_fast)                    \
       SymX(newBCOzh_fast)                      \
       SymX(newByteArrayzh_fast)                        \
@@ -570,6 +582,7 @@ lookupSymbol( char *lbl )
 }
 
 static 
+__attribute((unused))
 void *
 lookupLocalSymbol( ObjectCode* oc, char *lbl )
 {
@@ -857,6 +870,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.
+   
+   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.
 */
       
 
@@ -948,6 +988,7 @@ typedef
 /* 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
@@ -1081,7 +1122,8 @@ zapTrailingAtSign ( UChar* sym )
 static int
 ocVerifyImage_PEi386 ( ObjectCode* oc )
 {
-   int i, j;
+   int i;
+   UInt32 j, noRelocs;
    COFF_header*  hdr;
    COFF_section* sectab;
    COFF_symbol*  symtab;
@@ -1124,13 +1166,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); */
-   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;
    }
+#endif
 
    /* No further verification after this point; only debug printing. */
    i = 0;
@@ -1194,8 +1238,23 @@ ocVerifyImage_PEi386 ( ObjectCode* oc )
       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 );
@@ -1205,6 +1264,7 @@ ocVerifyImage_PEi386 ( ObjectCode* oc )
                    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" );
       }
@@ -1401,9 +1461,9 @@ ocGetNames_PEi386 ( ObjectCode* oc )
          /* 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 );
-         /* 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. */
@@ -1453,7 +1513,8 @@ ocResolve_PEi386 ( ObjectCode* oc )
    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. */
@@ -1488,7 +1549,24 @@ ocResolve_PEi386 ( ObjectCode* oc )
           || 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*)
@@ -1597,6 +1675,7 @@ ocResolve_PEi386 ( ObjectCode* oc )
  */
 
 #include <elf.h>
+#include <ctype.h>
 
 static char *
 findElfSection ( void* objImage, Elf32_Word sh_type )
@@ -1613,7 +1692,7 @@ findElfSection ( void* objImage, Elf32_Word sh_type )
           && 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;
@@ -1723,7 +1802,7 @@ ocVerifyImage_ELF ( ObjectCode* oc )
           && 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;
@@ -1801,7 +1880,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);
-   char*       sh_strtab  = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
 
    ASSERT(symhash != NULL);
 
@@ -1812,19 +1890,39 @@ ocGetNames_ELF ( ObjectCode* oc )
 
    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.  */
@@ -1898,8 +1996,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) {
-               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",
@@ -1915,7 +2011,7 @@ ocGetNames_ELF ( ObjectCode* oc )
            oc->symbols[j] = nm;
             /* Acquire! */
             if (isLocal) {
-               ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, ad);
+               /* Ignore entirely. */
             } else {
                ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
             }
@@ -1975,20 +2071,21 @@ do_Elf32_Rel_relocations ( ObjectCode* oc, char* ehdrC,
          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)
-                (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);
-         } 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;
@@ -2037,7 +2134,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_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. */
@@ -2052,20 +2149,21 @@ do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC,
          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)
-                (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);
-         } 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;
@@ -2158,7 +2256,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. */
-      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 ) {