Allow "INLINEABLE" as a synonym
[ghc-hetmet.git] / rts / Linker.c
index beaf19e..6387ee1 100644 (file)
 #endif
 #endif
 
+#if defined(x86_64_HOST_ARCH) && defined(darwin_HOST_OS)
+#define ALWAYS_PIC
+#endif
+
 /* Hash table mapping symbol names to Symbol */
 static /*Str*/HashTable *symhash;
 
@@ -208,7 +212,7 @@ static void machoInitSymbolsWithoutUnderscore( void );
  * We pick a default address based on the OS, but also make this
  * configurable via an RTS flag (+RTS -xm)
  */
-#if defined(x86_64_HOST_ARCH)
+#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
 
 #if defined(MAP_32BIT)
 // Try to use MAP_32BIT
@@ -515,9 +519,9 @@ typedef struct _RtsSymbolVal {
 
 #if !defined(mingw32_HOST_OS)
 #define RTS_USER_SIGNALS_SYMBOLS \
-   SymI_HasProto(setIOManagerPipe) \
+   SymI_HasProto(setIOManagerControlFd) \
+   SymI_HasProto(setIOManagerWakeupFd) \
    SymI_HasProto(ioManagerWakeup) \
-   SymI_HasProto(ioManagerSync) \
    SymI_HasProto(blockUserSignals) \
    SymI_HasProto(unblockUserSignals)
 #else
@@ -766,11 +770,12 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(forkOS_createThread)               \
       SymI_HasProto(freeHaskellFunctionPtr)            \
       SymI_HasProto(getOrSetTypeableStore)             \
-      SymI_HasProto(getOrSetGHCConcSignalHandlerStore)         \
-      SymI_HasProto(getOrSetGHCConcPendingEventsStore)         \
-      SymI_HasProto(getOrSetGHCConcPendingDelaysStore)         \
-      SymI_HasProto(getOrSetGHCConcIOManagerThreadStore)       \
-      SymI_HasProto(getOrSetGHCConcProddingStore)              \
+      SymI_HasProto(getOrSetGHCConcSignalSignalHandlerStore)           \
+      SymI_HasProto(getOrSetGHCConcWindowsPendingDelaysStore)          \
+      SymI_HasProto(getOrSetGHCConcWindowsIOManagerThreadStore)        \
+      SymI_HasProto(getOrSetGHCConcWindowsProddingStore)               \
+      SymI_HasProto(getOrSetSystemEventThreadEventManagerStore)                \
+      SymI_HasProto(getOrSetSystemEventThreadIOManagerThreadStore)             \
       SymI_HasProto(genSymZh)                          \
       SymI_HasProto(genericRaise)                      \
       SymI_HasProto(getProgArgv)                       \
@@ -872,6 +877,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(rts_unlock)                                \
       SymI_HasProto(rts_unsafeGetMyCapability)          \
       SymI_HasProto(rtsSupportsBoundThreads)           \
+      SymI_HasProto(rts_isProfiled)                    \
       SymI_HasProto(setProgArgv)                       \
       SymI_HasProto(startupHaskell)                    \
       SymI_HasProto(shutdownHaskell)                   \
@@ -960,6 +966,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_writeTVarzh)                   \
       SymI_HasProto(stg_yieldzh)                        \
       SymI_NeedsProto(stg_interp_constr_entry)          \
+      SymI_HasProto(stg_arg_bitmaps)                    \
       SymI_HasProto(alloc_blocks_lim)                   \
       SymI_HasProto(g0)                                 \
       SymI_HasProto(allocate)                           \
@@ -1164,7 +1171,7 @@ initLinker( void )
     ASSERT( compileResult == 0 );
 #   endif
 
-#if defined(x86_64_HOST_ARCH)
+#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
     if (RtsFlags.MiscFlags.linkerMemBase != 0) {
         // User-override for mmap_32bit_base
         mmap_32bit_base = (void*)RtsFlags.MiscFlags.linkerMemBase;
@@ -1533,7 +1540,7 @@ mmapForLinker (size_t bytes, nat flags, int fd)
    pagesize = getpagesize();
    size = ROUND_UP(bytes, pagesize);
 
-#if defined(x86_64_HOST_ARCH)
+#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
 mmap_again:
 
    if (mmap_32bit_base != 0) {
@@ -1550,7 +1557,7 @@ mmap_again:
        stg_exit(EXIT_FAILURE);
    }
    
-#if defined(x86_64_HOST_ARCH)
+#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
    if (mmap_32bit_base != 0) {
        if (result == map_addr) {
            mmap_32bit_base = (StgWord8*)map_addr + size;
@@ -2266,7 +2273,7 @@ cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
    */
    if (name[7]==0) return name;
    /* The annoying case: 8 bytes.  Copy into a temporary
-      (which is never freed ...)
+      (XXX which is never freed ...)
    */
    newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
    ASSERT(newstr);
@@ -2275,6 +2282,33 @@ cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
    return newstr;
 }
 
+/* Getting the name of a section is mildly tricky, so we make a
+   function for it.  Sadly, in one case we have to copy the string 
+   (when it is exactly 8 bytes long there's no trailing '\0'), so for
+   consistency we *always* copy the string; the caller must free it
+*/
+static char *
+cstring_from_section_name (UChar* name, UChar* strtab)
+{
+    char *newstr;
+    
+    if (name[0]=='/') {
+        int strtab_offset = strtol((char*)name+1,NULL,10);
+        int len = strlen(((char*)strtab) + strtab_offset);
+
+        newstr = stgMallocBytes(len, "cstring_from_section_symbol_name");
+        strcpy((char*)newstr, (char*)((UChar*)strtab) + strtab_offset);
+        return newstr;
+    }
+    else
+    {
+        newstr = stgMallocBytes(9, "cstring_from_section_symbol_name");
+        ASSERT(newstr);
+        strncpy((char*)newstr,(char*)name,8);
+        newstr[8] = 0;
+        return newstr;
+    }
+}
 
 /* Just compares the short names (first 8 chars) */
 static COFF_section *
@@ -2573,7 +2607,16 @@ ocGetNames_PEi386 ( ObjectCode* oc )
       COFF_section* sectab_i
          = (COFF_section*)
            myindex ( sizeof_COFF_section, sectab, i );
-      if (0 != strcmp((char*)sectab_i->Name, ".bss")) continue;
+
+      char *secname = cstring_from_section_name(sectab_i->Name, strtab);
+
+      if (0 != strcmp(secname, ".bss")) {
+          stgFree(secname);
+          continue;
+      }
+
+      stgFree(secname);
+
       /* sof 10/05: the PE spec text isn't too clear regarding what
        * the SizeOfRawData field is supposed to hold for object
        * file sections containing just uninitialized data -- for executables,
@@ -2614,7 +2657,10 @@ ocGetNames_PEi386 ( ObjectCode* oc )
       COFF_section* sectab_i
          = (COFF_section*)
            myindex ( sizeof_COFF_section, sectab, i );
-      IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
+
+      char *secname = cstring_from_section_name(sectab_i->Name, strtab);
+
+      IF_DEBUG(linker, debugBelch("section name = %s\n", secname ));
 
 #     if 0
       /* I'm sure this is the Right Way to do it.  However, the
@@ -2626,12 +2672,12 @@ ocGetNames_PEi386 ( ObjectCode* oc )
          kind = SECTIONKIND_CODE_OR_RODATA;
 #     endif
 
-      if (0==strcmp(".text",(char*)sectab_i->Name) ||
-          0==strcmp(".rdata",(char*)sectab_i->Name)||
-          0==strcmp(".rodata",(char*)sectab_i->Name))
+      if (0==strcmp(".text",(char*)secname) ||
+          0==strcmp(".rdata",(char*)secname)||
+          0==strcmp(".rodata",(char*)secname))
          kind = SECTIONKIND_CODE_OR_RODATA;
-      if (0==strcmp(".data",(char*)sectab_i->Name) ||
-          0==strcmp(".bss",(char*)sectab_i->Name))
+      if (0==strcmp(".data",(char*)secname) ||
+          0==strcmp(".bss",(char*)secname))
          kind = SECTIONKIND_RWDATA;
 
       ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
@@ -2644,16 +2690,18 @@ ocGetNames_PEi386 ( ObjectCode* oc )
       if (kind == SECTIONKIND_OTHER
           /* Ignore sections called which contain stabs debugging
              information. */
-          && 0 != strcmp(".stab", (char*)sectab_i->Name)
-          && 0 != strcmp(".stabstr", (char*)sectab_i->Name)
+          && 0 != strcmp(".stab", (char*)secname)
+          && 0 != strcmp(".stabstr", (char*)secname)
           /* ignore constructor section for now */
-          && 0 != strcmp(".ctors", (char*)sectab_i->Name)
+          && 0 != strcmp(".ctors", (char*)secname)
           /* ignore section generated from .ident */
-          && 0!= strcmp("/4", (char*)sectab_i->Name)
+          && 0!= strncmp(".debug", (char*)secname, 6)
          /* ignore unknown section that appeared in gcc 3.4.5(?) */
-          && 0!= strcmp(".reloc", (char*)sectab_i->Name)
+          && 0!= strcmp(".reloc", (char*)secname)
+          && 0 != strcmp(".rdata$zzz", (char*)secname)
          ) {
-         errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
+         errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", secname, oc->fileName);
+         stgFree(secname);
          return 0;
       }
 
@@ -2661,6 +2709,8 @@ ocGetNames_PEi386 ( ObjectCode* oc )
          addSection(oc, kind, start, end);
          addProddableBlock(oc, start, end - start + 1);
       }
+
+      stgFree(secname);
    }
 
    /* Copy exported symbols into the ObjectCode. */
@@ -2792,12 +2842,20 @@ ocResolve_PEi386 ( ObjectCode* oc )
               ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
            );
 
+      char *secname = cstring_from_section_name(sectab_i->Name, strtab);
+
       /* Ignore sections called which contain stabs debugging
          information. */
-      if (0 == strcmp(".stab", (char*)sectab_i->Name)
-          || 0 == strcmp(".stabstr", (char*)sectab_i->Name)
-          || 0 == strcmp(".ctors", (char*)sectab_i->Name))
-         continue;
+      if (0 == strcmp(".stab", (char*)secname)
+          || 0 == strcmp(".stabstr", (char*)secname)
+          || 0 == strcmp(".ctors", (char*)secname)
+          || 0 == strncmp(".debug", (char*)secname, 6)
+          || 0 == strcmp(".rdata$zzz", (char*)secname)) {
+          stgFree(secname);
+          continue;
+      }
+
+      stgFree(secname);
 
       if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
        /* If the relocation field (a short) has overflowed, the
@@ -3777,6 +3835,9 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
 
       case R_X86_64_PC32:
       {
+#if defined(ALWAYS_PIC)
+          barf("R_X86_64_PC32 relocation, but ALWAYS_PIC.");
+#else
          StgInt64 off = value - P;
          if (off >= 0x7fffffffL || off < -0x80000000L) {
 #if X86_64_ELF_NONPIC_HACK
@@ -3789,6 +3850,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
 #endif
           }
          *(Elf64_Word *)P = (Elf64_Word)off;
+#endif
          break;
       }
 
@@ -3800,6 +3862,9 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
       }
 
       case R_X86_64_32:
+#if defined(ALWAYS_PIC)
+          barf("R_X86_64_32 relocation, but ALWAYS_PIC.");
+#else
          if (value >= 0x7fffffffL) {
 #if X86_64_ELF_NONPIC_HACK           
               StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
@@ -3811,9 +3876,13 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
 #endif
           }
          *(Elf64_Word *)P = (Elf64_Word)value;
+#endif
          break;
 
       case R_X86_64_32S:
+#if defined(ALWAYS_PIC)
+          barf("R_X86_64_32S relocation, but ALWAYS_PIC.");
+#else
          if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
 #if X86_64_ELF_NONPIC_HACK           
               StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
@@ -3825,6 +3894,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
 #endif
          }
          *(Elf64_Sword *)P = (Elf64_Sword)value;
+#endif
          break;
          
       case R_X86_64_GOTPCREL:
@@ -3837,6 +3907,9 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
       
       case R_X86_64_PLT32:
       {
+#if defined(ALWAYS_PIC)
+          barf("R_X86_64_PLT32 relocation, but ALWAYS_PIC.");
+#else
          StgInt64 off = value - P;
          if (off >= 0x7fffffffL || off < -0x80000000L) {
               StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
@@ -3844,6 +3917,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
               off = pltAddress + A - P;
          }
          *(Elf64_Word *)P = (Elf64_Word)off;
+#endif
          break;
       }
 #endif
@@ -4857,4 +4931,3 @@ static int machoGetMisalignment( FILE * f )
 #endif
 
 #endif
-