[project @ 2001-08-31 14:32:03 by sewardj]
[ghc-hetmet.git] / ghc / rts / Linker.c
index fe6326b..1f958cb 100644 (file)
@@ -1,12 +1,13 @@
 /* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.56 2001/08/13 14:34:40 simonmar Exp $
+ * $Id: Linker.c,v 1.62 2001/08/31 14:32:03 sewardj Exp $
  *
- * (c) The GHC Team, 2000
+ * (c) The GHC Team, 2000, 2001
  *
  * RTS Object Linker
  *
  * ---------------------------------------------------------------------------*/
 
+#include "PosixSource.h"
 #include "Rts.h"
 #include "RtsFlags.h"
 #include "HsFFI.h"
@@ -273,6 +274,8 @@ typedef struct _RtsSymbolVal {
       SymX(__gmpz_get_ui)                      \
       SymX(prog_argv)                          \
       SymX(prog_argc)                          \
+      SymX(getProgArgv)                                \
+      SymX(setProgArgv)                                \
       SymX(resetNonBlockingFd)                 \
       SymX(performGC)                          \
       SymX(getStablePtr)                       \
@@ -421,7 +424,7 @@ static OpenedDLL* opened_dlls = NULL;
 
 
 char*
-addDLL ( char* path, char* dll_name )
+addDLL ( __attribute((unused)) char* path, char* dll_name )
 {
 #  if defined(OBJFORMAT_ELF)
    void *hdl;
@@ -586,6 +589,7 @@ loadObj( char *path )
    oc->symbols           = NULL;
    oc->sections          = NULL;
    oc->lochash           = allocStrHashTable();
+   oc->proddables        = NULL;
 
    /* chain it onto the list of objects */
    oc->next              = objects;
@@ -706,6 +710,39 @@ unloadObj( char *path )
     return 0;
 }
 
+/* -----------------------------------------------------------------------------
+ * Sanity checking.  For each ObjectCode, maintain a list of address ranges
+ * which may be prodded during relocation, and abort if we try and write
+ * outside any of these.
+ */
+static void addProddableBlock ( ObjectCode* oc, void* start, int size )
+{
+   ProddableBlock* pb 
+      = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
+   /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
+   ASSERT(size > 0);
+   pb->start      = start;
+   pb->size       = size;
+   pb->next       = oc->proddables;
+   oc->proddables = pb;
+}
+
+static void checkProddableBlock ( ObjectCode* oc, void* addr )
+{
+   ProddableBlock* pb;
+   for (pb = oc->proddables; pb != NULL; pb = pb->next) {
+      char* s = (char*)(pb->start);
+      char* e = s + pb->size - 1;
+      char* a = (char*)addr;
+      /* Assumes that the biggest fixup involves a 4-byte write.  This
+         probably needs to be changed to 8 (ie, +7) on 64-bit
+         plats. */
+      if (a >= s && (a+3) <= e) return;
+   }
+   barf("checkProddableBlock: invalid fixup in runtime linker");
+}
+
+
 /* --------------------------------------------------------------------------
  * PEi386 specifics (Win32 targets)
  * ------------------------------------------------------------------------*/
@@ -1033,13 +1070,15 @@ ocVerifyImage_PEi386 ( ObjectCode* oc )
                 "  data sz %d\n"
                 " data off %d\n"
                 "  num rel %d\n"
-                "  off rel %d\n",
+                "  off rel %d\n"
+                "  ptr raw 0x%x\n",
                 sectab_i->VirtualSize,
                 sectab_i->VirtualAddress,
                 sectab_i->SizeOfRawData,
                 sectab_i->PointerToRawData,
                 sectab_i->NumberOfRelocations,
-                sectab_i->PointerToRelocations
+                sectab_i->PointerToRelocations,
+                sectab_i->PointerToRawData
               );
       reltab = (COFF_reloc*) (
                   ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
@@ -1058,9 +1097,9 @@ ocVerifyImage_PEi386 ( ObjectCode* oc )
          printName ( sym->Name, strtab -10 );
          fprintf ( stderr, "'\n" );
       }
+
       fprintf ( stderr, "\n" );
    }
-
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
    fprintf ( stderr, "---START of string table---\n");
@@ -1087,12 +1126,12 @@ ocVerifyImage_PEi386 ( ObjectCode* oc )
       fprintf ( stderr, 
                 "'\n"
                 "    value 0x%x\n"
-                "     sec# %d\n"
+                "   1+sec# %d\n"
                 "     type 0x%x\n"
                 "   sclass 0x%x\n"
                 "     nAux %d\n",
                 symtab_i->Value,
-                (Int32)(symtab_i->SectionNumber) - 1,
+                (Int32)(symtab_i->SectionNumber),
                 (UInt32)symtab_i->Type,
                 (UInt32)symtab_i->StorageClass,
                 (UInt32)symtab_i->NumberOfAuxSymbols 
@@ -1131,6 +1170,25 @@ ocGetNames_PEi386 ( ObjectCode* oc )
             + hdr->PointerToSymbolTable
             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
 
+   /* Allocate space for any (local, anonymous) .bss sections. */
+
+   for (i = 0; i < hdr->NumberOfSections; i++) {
+      UChar* zspace;
+      COFF_section* sectab_i
+         = (COFF_section*)
+           myindex ( sizeof_COFF_section, sectab, i );
+      if (0 != strcmp(sectab_i->Name, ".bss")) continue;
+      if (sectab_i->VirtualSize == 0) continue;
+      /* This is a non-empty .bss section.  Allocate zeroed space for
+         it, and set its PointerToRawData field such that oc->image +
+         PointerToRawData == addr_of_zeroed_space.  */
+      zspace = stgCallocBytes(1, sectab_i->VirtualSize, 
+                              "ocGetNames_PEi386(anonymous bss)");
+      sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
+      addProddableBlock(oc, zspace, sectab_i->VirtualSize);
+      /* fprintf(stderr, "BSS section at 0x%x\n", zspace); */
+   }
+
    /* Copy exported symbols into the ObjectCode. */
 
    oc->n_symbols = hdr->NumberOfSymbols;
@@ -1147,33 +1205,66 @@ ocGetNames_PEi386 ( ObjectCode* oc )
       symtab_i = (COFF_symbol*)
                  myindex ( sizeof_COFF_symbol, symtab, i );
 
-      if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL &&
-          symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
+      addr  = NULL;
 
+      if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
+          && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
          /* This symbol is global and defined, viz, exported */
-         COFF_section* sectabent;
-
-         /* cstring_from_COFF_symbol_name always succeeds. */
-         sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
-
          /* for MYIMAGE_SYMCLASS_EXTERNAL 
                 && !MYIMAGE_SYM_UNDEFINED,
             the address of the symbol is: 
                 address of relevant section + offset in section
          */
-         sectabent = (COFF_section*)
-                     myindex ( sizeof_COFF_section, 
-                               sectab,
-                               symtab_i->SectionNumber-1 );
+         COFF_section* sectabent 
+            = (COFF_section*) myindex ( sizeof_COFF_section, 
+                                        sectab,
+                                        symtab_i->SectionNumber-1 );
          addr = ((UChar*)(oc->image))
                 + (sectabent->PointerToRawData
                    + symtab_i->Value);
+      } 
+      else
+      if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
+         && symtab_i->Value > 0) {
+         /* This symbol isn't in any section at all, ie, global bss.
+            Allocate zeroed space for it. */
+         addr = stgCallocBytes(1, symtab_i->Value, 
+                               "ocGetNames_PEi386(non-anonymous bss)");
+         addProddableBlock(oc, addr, symtab_i->Value);
+      }
+
+      if (addr != NULL) {
+         sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
          /* 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. */
          oc->symbols[i] = sname;
          insertStrHashTable(symhash, sname, addr);
+      } else {
+#        if 0
+         fprintf ( stderr, 
+                   "IGNORING symbol %d\n"
+                   "     name `",
+                   i 
+                 );
+         printName ( symtab_i->Name, strtab );
+         fprintf ( stderr, 
+                   "'\n"
+                   "    value 0x%x\n"
+                   "   1+sec# %d\n"
+                   "     type 0x%x\n"
+                   "   sclass 0x%x\n"
+                   "     nAux %d\n",
+                   symtab_i->Value,
+                   (Int32)(symtab_i->SectionNumber),
+                   (UInt32)symtab_i->Type,
+                   (UInt32)symtab_i->StorageClass,
+                   (UInt32)symtab_i->NumberOfAuxSymbols 
+                 );
+#        endif
       }
+
       i += symtab_i->NumberOfAuxSymbols;
       i++;
    }
@@ -1195,7 +1286,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
            myindex ( sizeof_COFF_section, sectab, i );
       IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
 
-#if 0
+#     if 0
       /* I'm sure this is the Right Way to do it.  However, the 
          alternative of testing the sectab_i->Name field seems to
          work ok with Cygwin.
@@ -1203,7 +1294,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
       if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE || 
           sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
          kind = SECTIONKIND_CODE_OR_RODATA;
-#endif
+#     endif
 
       if (0==strcmp(".text",sectab_i->Name) ||
           0==strcmp(".rodata",sectab_i->Name))
@@ -1222,9 +1313,12 @@ ocGetNames_PEi386 ( ObjectCode* oc )
          return 0;
       }
 
-      oc->sections[i].start = start;
-      oc->sections[i].end   = end;
-      oc->sections[i].kind  = kind;
+      if (end >= start) {
+         oc->sections[i].start = start;
+         oc->sections[i].end   = end;
+         oc->sections[i].kind  = kind;
+         addProddableBlock(oc, start, end - start + 1);
+      }
    }
 
    return 1;   
@@ -1321,7 +1415,7 @@ ocResolve_PEi386 ( ObjectCode* oc )
                return 0;
             }
          }
-
+         checkProddableBlock(oc, pP);
          switch (reltab_j->Type) {
             case MYIMAGE_REL_I386_DIR32: 
                *pP = A + S; 
@@ -1588,18 +1682,38 @@ ocGetNames_ELF ( ObjectCode* oc )
       /* 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(".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) {
+         /* 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.  */
+         char* zspace = stgCallocBytes(1, shdr[i].sh_size, 
+                                       "ocGetNames_ELF(anonymous bss)");
+         shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
+         /* We don't prod BSS sections, hence the following isn't
+            necessary:
+               addProddableBlock(oc, zspace, shdr[i].sh_size);
+         */
+         /*
+         fprintf(stderr, "BSS section at 0x%x, size %d\n", 
+                         zspace, shdr[i].sh_size);
+         */
+      }
+
       /* fill in the section info */
       oc->sections[i].start = ehdrC + shdr[i].sh_offset;
       oc->sections[i].end   = ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1;
       oc->sections[i].kind  = kind;
-      
+      if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0)
+         addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
+
       if (shdr[i].sh_type != SHT_SYMTAB) continue;
 
       /* copy stuff into this module's object symbol table */
@@ -1624,11 +1738,20 @@ ocGetNames_ELF ( ObjectCode* oc )
                 ELF32_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
                 ELF32_ST_TYPE(stab[j].st_info)==STT_NOTYPE 
               )
-            ) { 
-            char* nm = strtab + stab[j].st_name;
-            char* ad = ehdrC 
-                       + shdr[ stab[j].st_shndx ].sh_offset
-                       + stab[j].st_value;
+            ) {
+            char* nm;
+            char* ad; 
+           int secno = stab[j].st_shndx;
+           /* Section 0 is the undefined section, hence > and not >=. */
+            ASSERT(secno > 0 && secno < ehdr->e_shnum);
+            nm = strtab + stab[j].st_name;
+            /*
+            if (shdr[secno].sh_type == SHT_NOBITS) {
+               fprintf(stderr, "bss symbol, size %d off %d name %s\n", 
+               stab[j].st_size, stab[j].st_value, nm);
+            }
+            */
+            ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
             ASSERT(nm != NULL);
             ASSERT(ad != NULL);
            oc->symbols[j] = nm;
@@ -1718,6 +1841,7 @@ do_Elf32_Rel_relocations ( ObjectCode* oc, char* ehdrC,
       }
       IF_DEBUG(linker,belch( "Reloc: P = %p   S = %p   A = %p",
                             (void*)P, (void*)S, (void*)A )); 
+      checkProddableBlock ( oc, pP );
       switch (ELF32_R_TYPE(info)) {
 #        ifdef i386_TARGET_ARCH
          case R_386_32:   *pP = S + A;     break;
@@ -1799,6 +1923,7 @@ do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC,
       }
       IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p   S = %p   A = %p\n",
                                         (void*)P, (void*)S, (void*)A )); 
+      checkProddableBlock ( oc, P );
       switch (ELF32_R_TYPE(info)) {
 #        if defined(sparc_TARGET_ARCH)
          case R_SPARC_WDISP30: 
@@ -1822,6 +1947,17 @@ do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC,
             w1 |= w2;
             *pP = w1;
             break;
+         /* According to the Sun documentation:
+            R_SPARC_UA32 
+            This relocation type resembles R_SPARC_32, except it refers to an
+            unaligned word. That is, the word to be relocated must be treated
+            as four separate bytes with arbitrary alignment, not as a word
+            aligned according to the architecture requirements.
+
+            (JRS: which means that freeloading on the R_SPARC_32 case
+            is probably wrong, but hey ...)  
+         */
+         case R_SPARC_UA32:
          case R_SPARC_32:
             w2 = (Elf32_Word)(S + A);
             *pP = w2;