Interruptible FFI calls with pthread_kill and CancelSynchronousIO. v4
[ghc-hetmet.git] / rts / Linker.c
index 3618fd4..81e3f3c 100644 (file)
 #include "posix/Signals.h"
 #endif
 
-#if defined(mingw32_HOST_OS)
 // get protos for is*()
 #include <ctype.h>
-#endif
 
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>
 #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;
 
@@ -116,6 +118,15 @@ static /*Str*/HashTable *stablehash;
 /* List of currently loaded objects */
 ObjectCode *objects = NULL;    /* initially empty */
 
+static HsInt loadOc( ObjectCode* oc );
+static ObjectCode* mkOc( char *path, char *image, int imageSize
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+                       , int misalignment
+#endif
+#endif
+                       );
+
 #if defined(OBJFORMAT_ELF)
 static int ocVerifyImage_ELF    ( ObjectCode* oc );
 static int ocGetNames_ELF       ( ObjectCode* oc );
@@ -208,7 +219,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
@@ -343,15 +354,6 @@ typedef struct _RtsSymbolVal {
 #define RTS_POSIX_ONLY_SYMBOLS  /**/
 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
 
-/* Extra syms gen'ed by mingw-2's gcc-3.2: */
-#if __GNUC__>=3
-#define RTS_MINGW_EXTRA_SYMS                    \
-      SymI_NeedsProto(_imp____mb_cur_max)       \
-      SymI_NeedsProto(_imp___pctype)
-#else
-#define RTS_MINGW_EXTRA_SYMS
-#endif
-
 #if HAVE_GETTIMEOFDAY
 #define RTS_MINGW_GETTIMEOFDAY_SYM SymI_NeedsProto(gettimeofday)
 #else
@@ -452,11 +454,14 @@ typedef struct _RtsSymbolVal {
       SymI_NeedsProto(opendir)                           \
       SymI_NeedsProto(readdir)                           \
       SymI_NeedsProto(rewinddir)                         \
-      RTS_MINGW_EXTRA_SYMS                               \
+      SymI_NeedsProto(_imp____mb_cur_max)               \
+      SymI_NeedsProto(_imp___pctype)                    \
+      SymI_NeedsProto(__chkstk)                                 \
       RTS_MINGW_GETTIMEOFDAY_SYM                        \
       SymI_NeedsProto(closedir)
 #endif
 
+
 #if defined(darwin_HOST_OS) && HAVE_PRINTF_LDBLSTUB
 #define RTS_DARWIN_ONLY_SYMBOLS                                    \
      SymI_NeedsProto(asprintf$LDBLStub)                     \
@@ -515,9 +520,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 +771,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)                       \
@@ -793,6 +799,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_isCurrentThreadBoundzh)                \
       SymI_HasProto(stg_isEmptyMVarzh)                 \
       SymI_HasProto(stg_killThreadzh)                  \
+      SymI_HasProto(loadArchive)                               \
       SymI_HasProto(loadObj)                           \
       SymI_HasProto(insertStableSymbol)                \
       SymI_HasProto(insertSymbol)                      \
@@ -872,6 +879,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 +968,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 +1173,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 +1542,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 +1559,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;
@@ -1592,6 +1601,198 @@ mmap_again:
 }
 #endif // USE_MMAP
 
+static ObjectCode*
+mkOc( char *path, char *image, int imageSize
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+    , int misalignment
+#endif
+#endif
+    ) {
+   ObjectCode* oc;
+
+   oc = stgMallocBytes(sizeof(ObjectCode), "loadArchive(oc)");
+
+#  if defined(OBJFORMAT_ELF)
+   oc->formatName = "ELF";
+#  elif defined(OBJFORMAT_PEi386)
+   oc->formatName = "PEi386";
+#  elif defined(OBJFORMAT_MACHO)
+   oc->formatName = "Mach-O";
+#  else
+   stgFree(oc);
+   barf("loadObj: not implemented on this platform");
+#  endif
+
+   oc->image = image;
+   /* sigh, strdup() isn't a POSIX function, so do it the long way */
+   /* XXX What should this be for an archive? */
+   oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
+   strcpy(oc->fileName, path);
+
+   oc->fileSize          = imageSize;
+   oc->symbols           = NULL;
+   oc->sections          = NULL;
+   oc->proddables        = NULL;
+
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+   oc->misalignment = misalignment;
+#endif
+#endif
+
+   /* chain it onto the list of objects */
+   oc->next              = objects;
+   objects               = oc;
+
+   return oc;
+}
+
+#if defined(USE_ARCHIVES_FOR_GHCI)
+HsInt
+loadArchive( char *path )
+{
+   ObjectCode* oc;
+   char *image;
+   int imageSize;
+   FILE *f;
+   int n;
+   size_t fileNameSize;
+   char *file;
+   size_t fileSize;
+   int isObject;
+   char tmp[12];
+
+   IF_DEBUG(linker, debugBelch("loadArchive `%s'\n", path));
+
+   fileSize = 32;
+   file = stgMallocBytes(fileSize, "loadArchive(file)");
+
+   f = fopen(path, "rb");
+   if (!f)
+       barf("loadObj: can't read `%s'", path);
+
+   n = fread ( tmp, 1, 8, f );
+   if (strncmp(tmp, "!<arch>\n", 8) != 0)
+       barf("loadArchive: Not an archive: `%s'", path);
+
+   while(1) {
+       n = fread ( file, 1, 16, f );
+       if (n != 16) {
+           if (feof(f)) {
+               break;
+           }
+           else {
+               barf("loadArchive: Failed reading file name from `%s'", path);
+           }
+       }
+       n = fread ( tmp, 1, 12, f );
+       if (n != 12)
+           barf("loadArchive: Failed reading mod time from `%s'", path);
+       n = fread ( tmp, 1, 6, f );
+       if (n != 6)
+           barf("loadArchive: Failed reading owner from `%s'", path);
+       n = fread ( tmp, 1, 6, f );
+       if (n != 6)
+           barf("loadArchive: Failed reading group from `%s'", path);
+       n = fread ( tmp, 1, 8, f );
+       if (n != 8)
+           barf("loadArchive: Failed reading mode from `%s'", path);
+       n = fread ( tmp, 1, 10, f );
+       if (n != 10)
+           barf("loadArchive: Failed reading size from `%s'", path);
+       tmp[10] = '\0';
+       for (n = 0; isdigit(tmp[n]); n++);
+       tmp[n] = '\0';
+       imageSize = atoi(tmp);
+       n = fread ( tmp, 1, 2, f );
+       if (strncmp(tmp, "\x60\x0A", 2) != 0)
+           barf("loadArchive: Failed reading magic from `%s' at %ld. Got %c%c", path, ftell(f), tmp[0], tmp[1]);
+
+       /* Check for BSD-variant large filenames */
+       if (0 == strncmp(file, "#1/", 3)) {
+           file[16] = '\0';
+           for (n = 3; isdigit(file[n]); n++);
+           file[n] = '\0';
+           fileNameSize = atoi(file + 3);
+           imageSize -= fileNameSize;
+           if (fileNameSize > fileSize) {
+               /* Double it to avoid potentially continually
+                  increasing it by 1 */
+               fileSize = fileNameSize * 2;
+               file = stgReallocBytes(file, fileSize, "loadArchive(file)");
+           }
+           n = fread ( file, 1, fileNameSize, f );
+           if (n != (int)fileNameSize)
+               barf("loadArchive: Failed reading filename from `%s'", path);
+       }
+       else {
+           fileNameSize = 16;
+       }
+
+       isObject = 0;
+       for (n = 0; n < (int)fileNameSize - 1; n++) {
+           if ((file[n] == '.') && (file[n + 1] == 'o')) {
+               isObject = 1;
+               break;
+           }
+       }
+
+       if (isObject) {
+           /* We can't mmap from the archive directly, as object
+              files need to be 8-byte aligned but files in .ar
+              archives are 2-byte aligned, and if we malloc the
+              memory then we can be given memory above 2^32, so we
+              mmap some anonymous memory and use that. We could
+              do better here. */
+           image = mmapForLinker(imageSize, MAP_ANONYMOUS, -1);
+           n = fread ( image, 1, imageSize, f );
+           if (n != imageSize)
+               barf("loadObj: error whilst reading `%s'", path);
+           oc = mkOc(path, image, imageSize
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+                    , 0
+#endif
+#endif
+                    );
+           if (0 == loadOc(oc)) {
+               stgFree(file);
+               return 0;
+           }
+       }
+       else {
+           n = fseek(f, imageSize, SEEK_CUR);
+           if (n != 0)
+               barf("loadArchive: error whilst seeking by %d in `%s'",
+                    imageSize, path);
+       }
+       /* .ar files are 2-byte aligned */
+       if (imageSize % 2) {
+           n = fread ( tmp, 1, 1, f );
+           if (n != 1) {
+               if (feof(f)) {
+                   break;
+               }
+               else {
+                   barf("loadArchive: Failed reading padding from `%s'", path);
+               }
+           }
+       }
+   }
+
+   fclose(f);
+
+   stgFree(file);
+   return 1;
+}
+#else
+HsInt GNU_ATTRIBUTE(__noreturn__)
+loadArchive( char *path STG_UNUSED ) {
+    barf("loadArchive: not enabled");
+}
+#endif
+
 /* -----------------------------------------------------------------------------
  * Load an obj (populate the global symbol table, but don't resolve yet)
  *
@@ -1601,6 +1802,8 @@ HsInt
 loadObj( char *path )
 {
    ObjectCode* oc;
+   char *image;
+   int fileSize;
    struct stat st;
    int r;
 #ifdef USE_MMAP
@@ -1608,6 +1811,8 @@ loadObj( char *path )
 #else
    FILE *f;
 #endif
+   IF_DEBUG(linker, debugBelch("loadObj %s\n", path));
+
    initLinker();
 
    /* debugBelch("loadObj %s\n", path ); */
@@ -1634,34 +1839,13 @@ loadObj( char *path )
        }
    }
 
-   oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
-
-#  if defined(OBJFORMAT_ELF)
-   oc->formatName = "ELF";
-#  elif defined(OBJFORMAT_PEi386)
-   oc->formatName = "PEi386";
-#  elif defined(OBJFORMAT_MACHO)
-   oc->formatName = "Mach-O";
-#  else
-   stgFree(oc);
-   barf("loadObj: not implemented on this platform");
-#  endif
-
    r = stat(path, &st);
-   if (r == -1) { return 0; }
-
-   /* sigh, strdup() isn't a POSIX function, so do it the long way */
-   oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
-   strcpy(oc->fileName, path);
-
-   oc->fileSize          = st.st_size;
-   oc->symbols           = NULL;
-   oc->sections          = NULL;
-   oc->proddables        = NULL;
+   if (r == -1) {
+       IF_DEBUG(linker, debugBelch("File doesn't exist\n"));
+       return 0;
+   }
 
-   /* chain it onto the list of objects */
-   oc->next              = objects;
-   objects               = oc;
+   fileSize = st.st_size;
 
 #ifdef USE_MMAP
    /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
@@ -1674,7 +1858,7 @@ loadObj( char *path )
    if (fd == -1)
       barf("loadObj: can't open `%s'", path);
 
-   oc->image = mmapForLinker(oc->fileSize, 0, fd);
+   image = mmapForLinker(fileSize, 0, fd);
 
    close(fd);
 
@@ -1687,7 +1871,7 @@ loadObj( char *path )
 #   if defined(mingw32_HOST_OS)
        // TODO: We would like to use allocateExec here, but allocateExec
        //       cannot currently allocate blocks large enough.
-    oc->image = VirtualAlloc(NULL, oc->fileSize, MEM_RESERVE | MEM_COMMIT,
+    image = VirtualAlloc(NULL, fileSize, MEM_RESERVE | MEM_COMMIT,
                              PAGE_EXECUTE_READWRITE);
 #   elif defined(darwin_HOST_OS)
     // In a Mach-O .o file, all sections can and will be misaligned
@@ -1697,30 +1881,53 @@ loadObj( char *path )
     // as SSE (used by gcc for floating point) and Altivec require
     // 16-byte alignment.
     // We calculate the correct alignment from the header before
-    // reading the file, and then we misalign oc->image on purpose so
+    // reading the file, and then we misalign image on purpose so
     // that the actual sections end up aligned again.
-   oc->misalignment = machoGetMisalignment(f);
-   oc->image = stgMallocBytes(oc->fileSize + oc->misalignment, "loadObj(image)");
-   oc->image += oc->misalignment;
+   misalignment = machoGetMisalignment(f);
+   image = stgMallocBytes(fileSize + misalignment, "loadObj(image)");
+   image += misalignment;
 #  else
-   oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
+   image = stgMallocBytes(fileSize, "loadObj(image)");
 #  endif
 
    {
        int n;
-       n = fread ( oc->image, 1, oc->fileSize, f );
-       if (n != oc->fileSize)
+       n = fread ( image, 1, fileSize, f );
+       if (n != fileSize)
            barf("loadObj: error whilst reading `%s'", path);
    }
    fclose(f);
 #endif /* USE_MMAP */
 
+   oc = mkOc(path, image, fileSize
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+            , misalignment
+#endif
+#endif
+            );
+
+   return loadOc(oc);
+}
+
+static HsInt
+loadOc( ObjectCode* oc ) {
+   int r;
+
+   IF_DEBUG(linker, debugBelch("loadOc\n"));
+
 #  if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
    r = ocAllocateSymbolExtras_MachO ( oc );
-   if (!r) { return r; }
+   if (!r) {
+       IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO failed\n"));
+       return r;
+   }
 #  elif defined(OBJFORMAT_ELF) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
    r = ocAllocateSymbolExtras_ELF ( oc );
-   if (!r) { return r; }
+   if (!r) {
+       IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_ELF failed\n"));
+       return r;
+   }
 #endif
 
    /* verify the in-memory image */
@@ -1733,7 +1940,10 @@ loadObj( char *path )
 #  else
    barf("loadObj: no verify method");
 #  endif
-   if (!r) { return r; }
+   if (!r) {
+       IF_DEBUG(linker, debugBelch("ocVerifyImage_* failed\n"));
+       return r;
+   }
 
    /* build the symbol list for this image */
 #  if defined(OBJFORMAT_ELF)
@@ -1745,7 +1955,10 @@ loadObj( char *path )
 #  else
    barf("loadObj: no getNames method");
 #  endif
-   if (!r) { return r; }
+   if (!r) {
+       IF_DEBUG(linker, debugBelch("ocGetNames_* failed\n"));
+       return r;
+   }
 
    /* loaded, but not resolved yet */
    oc->status = OBJECT_LOADED;
@@ -2250,7 +2463,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);
@@ -2259,6 +2472,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 *
@@ -2557,7 +2797,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,
@@ -2598,7 +2847,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
@@ -2610,12 +2862,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);
@@ -2628,16 +2880,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;
       }
 
@@ -2645,6 +2899,8 @@ ocGetNames_PEi386 ( ObjectCode* oc )
          addSection(oc, kind, start, end);
          addProddableBlock(oc, start, end - start + 1);
       }
+
+      stgFree(secname);
    }
 
    /* Copy exported symbols into the ObjectCode. */
@@ -2776,12 +3032,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
@@ -3761,6 +4025,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
@@ -3773,6 +4040,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
 #endif
           }
          *(Elf64_Word *)P = (Elf64_Word)off;
+#endif
          break;
       }
 
@@ -3784,6 +4052,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)
@@ -3795,9 +4066,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)
@@ -3809,6 +4084,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
 #endif
          }
          *(Elf64_Sword *)P = (Elf64_Sword)value;
+#endif
          break;
          
       case R_X86_64_GOTPCREL:
@@ -3821,6 +4097,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)
@@ -3828,6 +4107,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
               off = pltAddress + A - P;
          }
          *(Elf64_Word *)P = (Elf64_Word)off;
+#endif
          break;
       }
 #endif
@@ -4023,11 +4303,17 @@ static int ocVerifyImage_MachO(ObjectCode* oc)
     struct mach_header *header = (struct mach_header*) image;
 
 #if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
-    if(header->magic != MH_MAGIC_64)
+    if(header->magic != MH_MAGIC_64) {
+        errorBelch("%s: Bad magic. Expected: %08x, got: %08x.\n",
+                   oc->fileName, MH_MAGIC_64, header->magic);
         return 0;
+    }
 #else
-    if(header->magic != MH_MAGIC)
+    if(header->magic != MH_MAGIC) {
+        errorBelch("%s: Bad magic. Expected: %08x, got: %08x.\n",
+                   oc->fileName, MH_MAGIC, header->magic);
         return 0;
+    }
 #endif
     // FIXME: do some more verifying here
     return 1;
@@ -4571,6 +4857,8 @@ static int ocGetNames_MachO(ObjectCode* oc)
     char    *commonStorage = NULL;
     unsigned long commonCounter;
 
+    IF_DEBUG(linker,debugBelch("ocGetNames_MachO\n"));
+
     for(i=0;i<header->ncmds;i++)
     {
        if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
@@ -4660,6 +4948,7 @@ static int ocGetNames_MachO(ObjectCode* oc)
                         ; // weak definition, and we already have a definition
                     else
                     {
+                            IF_DEBUG(linker,debugBelch("Adding symbol 1 %s\n", nm));
                             ghciInsertStrHashTable(oc->fileName, symhash, nm,
                                                     image
                                                     + sections[nlist[i].n_sect-1].offset
@@ -4686,6 +4975,7 @@ static int ocGetNames_MachO(ObjectCode* oc)
 
                nlist[i].n_value = commonCounter;
 
+            IF_DEBUG(linker,debugBelch("Adding symbol 2 %s\n", nm));
                ghciInsertStrHashTable(oc->fileName, symhash, nm,
                                       (void*)commonCounter);
                oc->symbols[curSymbol++] = nm;
@@ -4814,11 +5104,17 @@ static int machoGetMisalignment( FILE * f )
     rewind(f);
 
 #if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
-    if(header.magic != MH_MAGIC_64)
+    if(header.magic != MH_MAGIC_64) {
+        errorBelch("Bad magic. Expected: %08x, got: %08x.\n",
+                   MH_MAGIC_64, header->magic);
         return 0;
+    }
 #else
-    if(header.magic != MH_MAGIC)
+    if(header.magic != MH_MAGIC) {
+        errorBelch("Bad magic. Expected: %08x, got: %08x.\n",
+                   MH_MAGIC, header->magic);
         return 0;
+    }
 #endif
 
     misalignment = (header.sizeofcmds + sizeof(header))
@@ -4829,4 +5125,3 @@ static int machoGetMisalignment( FILE * f )
 #endif
 
 #endif
-