FIX #1845 (unconditional relative branch out of range)
[ghc-hetmet.git] / rts / Linker.c
index 0624081..2894b1e 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>
 #include <sys/wait.h>
 #endif
 
-#if defined(ia64_HOST_ARCH) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
+#if defined(linux_HOST_OS    ) || defined(freebsd_HOST_OS) || \
+    defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS ) || \
+    defined(openbsd_HOST_OS  ) || \
+    ( defined(darwin_HOST_OS ) && !defined(powerpc_HOST_ARCH) )
+/* Don't use mmap on powerpc-apple-darwin as mmap doesn't support
+ * reallocating but we need to allocate jump islands just after each
+ * object images. Otherwise relative branches to jump islands can fail
+ * due to 24-bits displacement overflow.
+ */
 #define USE_MMAP
 #include <fcntl.h>
 #include <sys/mman.h>
 
-#if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
 #ifdef HAVE_UNISTD_H
 #include <unistd.h>
 #endif
-#endif
 
 #endif
 
 #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;
 
@@ -118,6 +126,16 @@ 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,
+                         char *archiveMemberName
+#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 );
@@ -136,7 +154,9 @@ static int ocVerifyImage_MachO    ( ObjectCode* oc );
 static int ocGetNames_MachO       ( ObjectCode* oc );
 static int ocResolve_MachO        ( ObjectCode* oc );
 
+#ifndef USE_MMAP
 static int machoGetMisalignment( FILE * );
+#endif
 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
 static int ocAllocateSymbolExtras_MachO ( ObjectCode* oc );
 #endif
@@ -208,7 +228,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 +363,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,12 +463,15 @@ 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_TARGET_OS) && HAVE_PRINTF_LDBLSTUB
+
+#if defined(darwin_HOST_OS) && HAVE_PRINTF_LDBLSTUB
 #define RTS_DARWIN_ONLY_SYMBOLS                                    \
      SymI_NeedsProto(asprintf$LDBLStub)                     \
      SymI_NeedsProto(err$LDBLStub)                          \
@@ -515,9 +529,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
@@ -743,8 +757,9 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(debugBelch)                                \
       SymI_HasProto(errorBelch)                                \
       SymI_HasProto(sysErrorBelch)                      \
-      SymI_HasProto(stg_asyncExceptionsBlockedzh)      \
-      SymI_HasProto(stg_blockAsyncExceptionszh)                \
+      SymI_HasProto(stg_getMaskingStatezh)             \
+      SymI_HasProto(stg_maskAsyncExceptionszh)         \
+      SymI_HasProto(stg_maskUninterruptiblezh)         \
       SymI_HasProto(stg_catchzh)                       \
       SymI_HasProto(stg_catchRetryzh)                  \
       SymI_HasProto(stg_catchSTMzh)                    \
@@ -765,11 +780,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)                       \
@@ -788,9 +804,11 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_unpackClosurezh)                \
       SymI_HasProto(stg_getApStackValzh)                \
       SymI_HasProto(stg_getSparkzh)                     \
+      SymI_HasProto(stg_numSparkszh)                    \
       SymI_HasProto(stg_isCurrentThreadBoundzh)                \
       SymI_HasProto(stg_isEmptyMVarzh)                 \
       SymI_HasProto(stg_killThreadzh)                  \
+      SymI_HasProto(loadArchive)                               \
       SymI_HasProto(loadObj)                           \
       SymI_HasProto(insertStableSymbol)                \
       SymI_HasProto(insertSymbol)                      \
@@ -870,6 +888,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)                   \
@@ -950,7 +969,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_threadStatuszh)                        \
       SymI_HasProto(stg_tryPutMVarzh)                  \
       SymI_HasProto(stg_tryTakeMVarzh)                 \
-      SymI_HasProto(stg_unblockAsyncExceptionszh)      \
+      SymI_HasProto(stg_unmaskAsyncExceptionszh)       \
       SymI_HasProto(unloadObj)                          \
       SymI_HasProto(stg_unsafeThawArrayzh)             \
       SymI_HasProto(stg_waitReadzh)                    \
@@ -958,6 +977,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)                           \
@@ -1003,7 +1023,7 @@ typedef struct _RtsSymbolVal {
 
 /* entirely bogus claims about types of these symbols */
 #define SymI_NeedsProto(vvv)  extern void vvv(void);
-#if defined(__PIC__) && defined(mingw32_TARGET_OS)
+#if defined(__PIC__) && defined(mingw32_HOST_OS)
 #define SymE_HasProto(vvv)    SymE_HasProto(vvv);
 #define SymE_NeedsProto(vvv)    extern void _imp__ ## vvv (void);
 #else
@@ -1097,7 +1117,7 @@ static void ghciInsertStrHashTable ( char* obj_name,
       (char*)key,
       obj_name
    );
-   exit(1);
+   stg_exit(1);
 }
 /* -----------------------------------------------------------------------------
  * initialize the object linker
@@ -1123,11 +1143,16 @@ initLinker( void )
     int compileResult;
 #endif
 
+    IF_DEBUG(linker, debugBelch("initLinker: start\n"));
+
     /* Make initLinker idempotent, so we can call it
        before evey relevant operation; that means we
        don't need to initialise the linker separately */
-    if (linker_init_done == 1) { return; } else {
-      linker_init_done = 1;
+    if (linker_init_done == 1) { 
+       IF_DEBUG(linker, debugBelch("initLinker: idempotent return\n"));
+       return;
+    } else {
+        linker_init_done = 1;
     }
 
 #if defined(THREADED_RTS) && (defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO))
@@ -1140,6 +1165,7 @@ initLinker( void )
     for (sym = rtsSyms; sym->lbl != NULL; sym++) {
        ghciInsertStrHashTable("(GHCi built-in symbols)",
                                symhash, sym->lbl, sym->addr);
+       IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr));
     }
 #   if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
     machoInitSymbolsWithoutUnderscore();
@@ -1162,7 +1188,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;
@@ -1178,6 +1204,9 @@ initLinker( void )
     addDLL("msvcrt");
     addDLL("kernel32");
 #endif
+
+    IF_DEBUG(linker, debugBelch("initLinker: done\n"));
+    return;
 }
 
 void
@@ -1230,11 +1259,12 @@ static OpenedDLL* opened_dlls = NULL;
 
 #  if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
 
-static char *
+static const char *
 internal_dlopen(const char *dll_name)
 {
    void *hdl;
-   char *errmsg, *errmsg_copy;
+   const char *errmsg;
+   char *errmsg_copy;
 
    // omitted: RTLD_NOW
    // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html
@@ -1274,7 +1304,7 @@ addDLL( char *dll_name )
 
 #define NMATCH 5
    regmatch_t match[NMATCH];
-   char *errmsg;
+   const char *errmsg;
    FILE* fp;
    size_t match_length;
 #define MAXLINE 1000
@@ -1431,11 +1461,13 @@ void *
 lookupSymbol( char *lbl )
 {
     void *val;
+    IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s\n", lbl));
     initLinker() ;
     ASSERT(symhash != NULL);
     val = lookupStrHashTable(symhash, lbl);
 
     if (val == NULL) {
+       IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n"));
 #       if defined(OBJFORMAT_ELF)
        return dlsym(dl_prog_handle, lbl);
 #       elif defined(OBJFORMAT_MACHO)
@@ -1448,6 +1480,7 @@ lookupSymbol( char *lbl )
                  symbol name. For now, we simply strip it off here (and ONLY
                  here).
         */
+        IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s with dlsym\n", lbl));
         ASSERT(lbl[0] == '_');
         return dlsym(dl_prog_handle, lbl+1);
 #       else
@@ -1476,6 +1509,7 @@ lookupSymbol( char *lbl )
         return NULL;
 #       endif
     } else {
+       IF_DEBUG(linker, debugBelch("lookupSymbol: value of %s is %p\n", lbl, val));
        return val;
     }
 }
@@ -1530,7 +1564,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) {
@@ -1547,7 +1581,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;
@@ -1589,6 +1623,334 @@ mmap_again:
 }
 #endif // USE_MMAP
 
+static ObjectCode*
+mkOc( char *path, char *image, int imageSize,
+      char *archiveMemberName
+#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 */
+   oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
+   strcpy(oc->fileName, path);
+
+   if (archiveMemberName) {
+       oc->archiveMemberName = stgMallocBytes( strlen(archiveMemberName)+1, "loadObj" );
+       strcpy(oc->archiveMemberName, archiveMemberName);
+   }
+   else {
+       oc->archiveMemberName = NULL;
+   }
+
+   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;
+}
+
+HsInt
+loadArchive( char *path )
+{
+    ObjectCode* oc;
+    char *image;
+    int memberSize;
+    FILE *f;
+    int n;
+    size_t thisFileNameSize;
+    char *fileName;
+    size_t fileNameSize;
+    int isObject, isGnuIndex;
+    char tmp[12];
+    char *gnuFileIndex;
+    int gnuFileIndexSize;
+#if !defined(USE_MMAP) && defined(darwin_HOST_OS)
+    int misalignment;
+#endif
+
+    IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%s'\n", path));
+
+    gnuFileIndex = NULL;
+    gnuFileIndexSize = 0;
+
+    fileNameSize = 32;
+    fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)");
+
+    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 ( fileName, 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';
+        memberSize = 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]);
+
+        isGnuIndex = 0;
+        /* Check for BSD-variant large filenames */
+        if (0 == strncmp(fileName, "#1/", 3)) {
+            fileName[16] = '\0';
+            if (isdigit(fileName[3])) {
+                for (n = 4; isdigit(fileName[n]); n++);
+                fileName[n] = '\0';
+                thisFileNameSize = atoi(fileName + 3);
+                memberSize -= thisFileNameSize;
+                if (thisFileNameSize >= fileNameSize) {
+                    /* Double it to avoid potentially continually
+                       increasing it by 1 */
+                    fileNameSize = thisFileNameSize * 2;
+                    fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
+                }
+                n = fread ( fileName, 1, thisFileNameSize, f );
+                if (n != (int)thisFileNameSize) {
+                    barf("loadArchive: Failed reading filename from `%s'",
+                         path);
+                }
+                fileName[thisFileNameSize] = 0;
+            }
+            else {
+                barf("loadArchive: BSD-variant filename size not found while reading filename from `%s'", path);
+            }
+        }
+        /* Check for GNU file index file */
+        else if (0 == strncmp(fileName, "//", 2)) {
+            fileName[0] = '\0';
+            thisFileNameSize = 0;
+            isGnuIndex = 1;
+        }
+        /* Check for a file in the GNU file index */
+        else if (fileName[0] == '/') {
+            if (isdigit(fileName[1])) {
+                int i;
+
+                for (n = 2; isdigit(fileName[n]); n++);
+                fileName[n] = '\0';
+                n = atoi(fileName + 1);
+
+                if (gnuFileIndex == NULL) {
+                    barf("loadArchive: GNU-variant filename without an index while reading from `%s'", path);
+                }
+                if (n < 0 || n > gnuFileIndexSize) {
+                    barf("loadArchive: GNU-variant filename offset %d out of range [0..%d] while reading filename from `%s'", n, gnuFileIndexSize, path);
+                }
+                if (n != 0 && gnuFileIndex[n - 1] != '\n') {
+                    barf("loadArchive: GNU-variant filename offset %d invalid (range [0..%d]) while reading filename from `%s'", n, gnuFileIndexSize, path);
+                }
+                for (i = n; gnuFileIndex[i] != '/'; i++);
+                thisFileNameSize = i - n;
+                if (thisFileNameSize >= fileNameSize) {
+                    /* Double it to avoid potentially continually
+                       increasing it by 1 */
+                    fileNameSize = thisFileNameSize * 2;
+                    fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
+                }
+                memcpy(fileName, gnuFileIndex + n, thisFileNameSize);
+                fileName[thisFileNameSize] = '\0';
+            }
+            else if (fileName[1] == ' ') {
+                fileName[0] = '\0';
+                thisFileNameSize = 0;
+            }
+            else {
+                barf("loadArchive: GNU-variant filename offset not found while reading filename from `%s'", path);
+            }
+        }
+        /* Finally, the case where the filename field actually contains
+           the filename */
+        else {
+            /* GNU ar terminates filenames with a '/', this allowing
+               spaces in filenames. So first look to see if there is a
+               terminating '/'. */
+            for (thisFileNameSize = 0;
+                 thisFileNameSize < 16;
+                 thisFileNameSize++) {
+                if (fileName[thisFileNameSize] == '/') {
+                    fileName[thisFileNameSize] = '\0';
+                    break;
+                }
+            }
+            /* If we didn't find a '/', then a space teminates the
+               filename. Note that if we don't find one, then
+               thisFileNameSize ends up as 16, and we already have the
+               '\0' at the end. */
+            if (thisFileNameSize == 16) {
+                for (thisFileNameSize = 0;
+                     thisFileNameSize < 16;
+                     thisFileNameSize++) {
+                    if (fileName[thisFileNameSize] == ' ') {
+                        fileName[thisFileNameSize] = '\0';
+                        break;
+                    }
+                }
+            }
+        }
+
+        IF_DEBUG(linker,
+                 debugBelch("loadArchive: Found member file `%s'\n", fileName));
+
+        isObject = thisFileNameSize >= 2
+                && fileName[thisFileNameSize - 2] == '.'
+                && fileName[thisFileNameSize - 1] == 'o';
+
+        if (isObject) {
+            char *archiveMemberName;
+
+            IF_DEBUG(linker, debugBelch("loadArchive: Member is an object file...loading...\n"));
+
+            /* 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. When possible we use mmap
+               to get some anonymous memory, as on 64-bit platforms if
+               we use malloc then we can be given memory above 2^32.
+               In the mmap case we're probably wasting lots of space;
+               we could do better. */
+#if defined(USE_MMAP)
+            image = mmapForLinker(memberSize, MAP_ANONYMOUS, -1);
+#elif defined(darwin_HOST_OS)
+            /* See loadObj() */
+            misalignment = machoGetMisalignment(f);
+            image = stgMallocBytes(memberSize + misalignment, "loadArchive(image)");
+            image += misalignment;
+#else
+            image = stgMallocBytes(memberSize, "loadArchive(image)");
+#endif
+            n = fread ( image, 1, memberSize, f );
+            if (n != memberSize) {
+                barf("loadArchive: error whilst reading `%s'", path);
+            }
+
+            archiveMemberName = stgMallocBytes(strlen(path) + thisFileNameSize + 3,
+                                               "loadArchive(file)");
+            sprintf(archiveMemberName, "%s(%.*s)",
+                    path, (int)thisFileNameSize, fileName);
+
+            oc = mkOc(path, image, memberSize, archiveMemberName
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+                     , misalignment
+#endif
+#endif
+                     );
+
+            stgFree(archiveMemberName);
+
+            if (0 == loadOc(oc)) {
+                stgFree(fileName);
+                return 0;
+            }
+        }
+        else if (isGnuIndex) {
+            if (gnuFileIndex != NULL) {
+                barf("loadArchive: GNU-variant index found, but already have an index, while reading filename from `%s'", path);
+            }
+            IF_DEBUG(linker, debugBelch("loadArchive: Found GNU-variant file index\n"));
+#ifdef USE_MMAP
+            gnuFileIndex = mmapForLinker(memberSize + 1, MAP_ANONYMOUS, -1);
+#else
+            gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)");
+#endif
+            n = fread ( gnuFileIndex, 1, memberSize, f );
+            if (n != memberSize) {
+                barf("loadArchive: error whilst reading `%s'", path);
+            }
+            gnuFileIndex[memberSize] = '/';
+            gnuFileIndexSize = memberSize;
+        }
+        else {
+            n = fseek(f, memberSize, SEEK_CUR);
+            if (n != 0)
+                barf("loadArchive: error whilst seeking by %d in `%s'",
+                     memberSize, path);
+        }
+        /* .ar files are 2-byte aligned */
+        if (memberSize % 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(fileName);
+    if (gnuFileIndex != NULL) {
+#ifdef USE_MMAP
+        munmap(gnuFileIndex, gnuFileIndexSize + 1);
+#else
+        stgFree(gnuFileIndex);
+#endif
+    }
+
+    return 1;
+}
+
 /* -----------------------------------------------------------------------------
  * Load an obj (populate the global symbol table, but don't resolve yet)
  *
@@ -1598,13 +1960,20 @@ HsInt
 loadObj( char *path )
 {
    ObjectCode* oc;
+   char *image;
+   int fileSize;
    struct stat st;
    int r;
 #ifdef USE_MMAP
    int fd;
 #else
    FILE *f;
+#  if defined(darwin_HOST_OS)
+   int misalignment;
+#  endif
 #endif
+   IF_DEBUG(linker, debugBelch("loadObj %s\n", path));
+
    initLinker();
 
    /* debugBelch("loadObj %s\n", path ); */
@@ -1631,34 +2000,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. */
@@ -1671,7 +2019,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);
 
@@ -1684,7 +2032,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
@@ -1694,30 +2042,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, NULL
+#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 */
@@ -1730,7 +2101,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)
@@ -1742,10 +2116,14 @@ 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;
+   IF_DEBUG(linker, debugBelch("loadObj done.\n"));
 
    return 1;
 }
@@ -1761,6 +2139,7 @@ resolveObjs( void )
     ObjectCode *oc;
     int r;
 
+    IF_DEBUG(linker, debugBelch("resolveObjs: start\n"));
     initLinker();
 
     for (oc = objects; oc; oc = oc->next) {
@@ -1778,6 +2157,7 @@ resolveObjs( void )
            oc->status = OBJECT_RESOLVED;
        }
     }
+    IF_DEBUG(linker, debugBelch("resolveObjs: done\n"));
     return 1;
 }
 
@@ -1788,6 +2168,7 @@ HsInt
 unloadObj( char *path )
 {
     ObjectCode *oc, *prev;
+    HsBool unloadedAnyObj = HS_BOOL_FALSE;
 
     ASSERT(symhash != NULL);
     ASSERT(objects != NULL);
@@ -1827,12 +2208,20 @@ unloadObj( char *path )
            stgFree(oc->symbols);
            stgFree(oc->sections);
            stgFree(oc);
-           return 1;
+
+            /* This could be a member of an archive so continue
+             * unloading other members. */
+            unloadedAnyObj = HS_BOOL_TRUE;
        }
     }
 
-    errorBelch("unloadObj: can't find `%s' to unload", path);
-    return 0;
+    if (unloadedAnyObj) {
+        return 1;
+    }
+    else {
+        errorBelch("unloadObj: can't find `%s' to unload", path);
+        return 0;
+    }
 }
 
 /* -----------------------------------------------------------------------------
@@ -1844,7 +2233,7 @@ static void addProddableBlock ( ObjectCode* oc, void* start, int size )
 {
    ProddableBlock* pb
       = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
-   /* debugBelch("aPB %p %p %d\n", oc, start, size); */
+   IF_DEBUG(linker, debugBelch("addProddableBlock %p %p %d\n", oc, start, size));
    ASSERT(size > 0);
    pb->start      = start;
    pb->size       = size;
@@ -2015,7 +2404,7 @@ static SymbolExtra* makeSymbolExtra( ObjectCode* oc,
  * PowerPC specifics (instruction cache flushing)
  * ------------------------------------------------------------------------*/
 
-#ifdef powerpc_TARGET_ARCH
+#ifdef powerpc_HOST_ARCH
 /*
    ocFlushInstructionCache
 
@@ -2023,13 +2412,12 @@ static SymbolExtra* makeSymbolExtra( ObjectCode* oc,
    Because the PPC has split data/instruction caches, we have to
    do that whenever we modify code at runtime.
  */
-
-static void ocFlushInstructionCache( ObjectCode *oc )
+static void ocFlushInstructionCacheFrom(void* begin, size_t length)
 {
-    int n = (oc->fileSize + sizeof( SymbolExtra ) * oc->n_symbol_extras + 3) / 4;
-    unsigned long *p = (unsigned long *) oc->image;
+    size_t         n = (length + 3) / 4;
+    unsigned long* p = begin;
 
-    while( n-- )
+    while (n--)
     {
         __asm__ volatile ( "dcbf 0,%0\n\t"
                            "sync\n\t"
@@ -2043,6 +2431,14 @@ static void ocFlushInstructionCache( ObjectCode *oc )
                        "isync"
                      );
 }
+static void ocFlushInstructionCache( ObjectCode *oc )
+{
+    /* The main object code */
+    ocFlushInstructionCacheFrom(oc->image + oc->misalignment, oc->fileSize);
+
+    /* Jump Islands */
+    ocFlushInstructionCacheFrom(oc->symbol_extras, sizeof(SymbolExtra) * oc->n_symbol_extras);
+}
 #endif
 
 /* --------------------------------------------------------------------------
@@ -2247,7 +2643,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);
@@ -2256,6 +2652,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 *
@@ -2554,7 +2977,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,
@@ -2595,7 +3027,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
@@ -2607,12 +3042,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);
@@ -2625,16 +3060,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;
       }
 
@@ -2642,6 +3079,8 @@ ocGetNames_PEi386 ( ObjectCode* oc )
          addSection(oc, kind, start, end);
          addProddableBlock(oc, start, end - start + 1);
       }
+
+      stgFree(secname);
    }
 
    /* Copy exported symbols into the ObjectCode. */
@@ -2773,12 +3212,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
@@ -2953,10 +3400,18 @@ ocResolve_PEi386 ( ObjectCode* oc )
 #define Elf_Sym     Elf64_Sym
 #define Elf_Rel     Elf64_Rel
 #define Elf_Rela    Elf64_Rela
+#ifndef ELF_ST_TYPE
 #define ELF_ST_TYPE ELF64_ST_TYPE
+#endif
+#ifndef ELF_ST_BIND
 #define ELF_ST_BIND ELF64_ST_BIND
+#endif
+#ifndef ELF_R_TYPE
 #define ELF_R_TYPE  ELF64_R_TYPE
+#endif
+#ifndef ELF_R_SYM
 #define ELF_R_SYM   ELF64_R_SYM
+#endif
 #else
 #define ELFCLASS    ELFCLASS32
 #define Elf_Addr    Elf32_Addr
@@ -3750,6 +4205,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
@@ -3762,6 +4220,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
 #endif
           }
          *(Elf64_Word *)P = (Elf64_Word)off;
+#endif
          break;
       }
 
@@ -3773,6 +4232,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)
@@ -3784,9 +4246,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)
@@ -3798,6 +4264,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
 #endif
          }
          *(Elf64_Sword *)P = (Elf64_Sword)value;
+#endif
          break;
          
       case R_X86_64_GOTPCREL:
@@ -3810,6 +4277,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)
@@ -3817,6 +4287,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
               off = pltAddress + A - P;
          }
          *(Elf64_Word *)P = (Elf64_Word)off;
+#endif
          break;
       }
 #endif
@@ -4011,12 +4482,18 @@ static int ocVerifyImage_MachO(ObjectCode* oc)
     char *image = (char*) oc->image;
     struct mach_header *header = (struct mach_header*) image;
 
-#if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
-    if(header->magic != MH_MAGIC_64)
+#if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
+    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;
@@ -4033,6 +4510,8 @@ static int resolveImports(
     unsigned i;
     size_t itemSize = 4;
 
+    IF_DEBUG(linker, debugBelch("resolveImports: start\n"));
+
 #if i386_HOST_ARCH
     int isJumpTable = 0;
     if(!strcmp(sect->sectname,"__jump_table"))
@@ -4050,12 +4529,16 @@ static int resolveImports(
        char *nm = image + symLC->stroff + symbol->n_un.n_strx;
        void *addr = NULL;
 
-       if((symbol->n_type & N_TYPE) == N_UNDF
-           && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
+       IF_DEBUG(linker, debugBelch("resolveImports: resolving %s\n", nm));
+       if ((symbol->n_type & N_TYPE) == N_UNDF
+           && (symbol->n_type & N_EXT) && (symbol->n_value != 0)) {
            addr = (void*) (symbol->n_value);
-       else
+           IF_DEBUG(linker, debugBelch("resolveImports: undefined external %s has value %p\n", nm, addr));
+       } else {
            addr = lookupSymbol(nm);
-       if(!addr)
+           IF_DEBUG(linker, debugBelch("resolveImports: looking up %s, %p\n", nm, addr));
+       }
+       if (!addr)
        {
            errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
            return 0;
@@ -4078,6 +4561,7 @@ static int resolveImports(
         }
     }
 
+    IF_DEBUG(linker, debugBelch("resolveImports: done\n"));
     return 1;
 }
 
@@ -4088,9 +4572,11 @@ static unsigned long relocateAddress(
     unsigned long address)
 {
     int i;
-    for(i = 0; i < nSections; i++)
+    IF_DEBUG(linker, debugBelch("relocateAddress: start\n"));
+    for (i = 0; i < nSections; i++)
     {
-        if(sections[i].addr <= address
+           IF_DEBUG(linker, debugBelch("    relocating address in section %d\n", i));
+        if (sections[i].addr <= address
             && address < sections[i].addr + sections[i].size)
         {
             return (unsigned long)oc->image
@@ -4109,7 +4595,9 @@ static int relocateSection(
     int nSections, struct section* sections, struct section *sect)
 {
     struct relocation_info *relocs;
-    int i,n;
+    int i, n;
+
+    IF_DEBUG(linker, debugBelch("relocateSection: start\n"));
 
     if(!strcmp(sect->sectname,"__la_symbol_ptr"))
        return 1;
@@ -4121,6 +4609,8 @@ static int relocateSection(
        return 1;
 
     n = sect->nreloc;
+    IF_DEBUG(linker, debugBelch("relocateSection: number of relocations: %d\n", n));
+
     relocs = (struct relocation_info*) (image + sect->reloff);
 
     for(i=0;i<n;i++)
@@ -4158,12 +4648,20 @@ static int relocateSection(
             default:
                 barf("Unknown size.");
         }
-        
-        if(type == X86_64_RELOC_GOT
+
+       IF_DEBUG(linker,
+                debugBelch("relocateSection: length = %d, thing = %d, baseValue = %p\n",
+                           reloc->r_length, thing, baseValue));
+
+        if (type == X86_64_RELOC_GOT
            || type == X86_64_RELOC_GOT_LOAD)
         {
+            struct nlist *symbol = &nlist[reloc->r_symbolnum];
+            char *nm = image + symLC->stroff + symbol->n_un.n_strx;
+
+           IF_DEBUG(linker, debugBelch("relocateSection: making jump island for %s, extern = %d, X86_64_RELOC_GOT\n", nm, reloc->r_extern));
             ASSERT(reloc->r_extern);
-            value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)->addr;
+            value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, (unsigned long)lookupSymbol(nm))->addr;
             
             type = X86_64_RELOC_SIGNED;
         }
@@ -4171,11 +4669,21 @@ static int relocateSection(
         {
             struct nlist *symbol = &nlist[reloc->r_symbolnum];
             char *nm = image + symLC->stroff + symbol->n_un.n_strx;
-            if(symbol->n_value == 0)
-                value = (uint64_t) lookupSymbol(nm);
-            else
+
+           IF_DEBUG(linker, debugBelch("relocateSection: looking up external symbol %s\n", nm));
+           IF_DEBUG(linker, debugBelch("               : type  = %d\n", symbol->n_type));
+           IF_DEBUG(linker, debugBelch("               : sect  = %d\n", symbol->n_sect));
+           IF_DEBUG(linker, debugBelch("               : desc  = %d\n", symbol->n_desc));
+           IF_DEBUG(linker, debugBelch("               : value = %d\n", symbol->n_value));
+            if ((symbol->n_type & N_TYPE) == N_SECT) {
                 value = relocateAddress(oc, nSections, sections,
                                         symbol->n_value);
+               IF_DEBUG(linker, debugBelch("relocateSection, defined external symbol %s, relocated address %p\n", nm, value));
+           }
+            else {
+                value = (uint64_t) lookupSymbol(nm);
+               IF_DEBUG(linker, debugBelch("relocateSection: external symbol %s, address %p\n", nm, value));
+           }
         }
         else
         {
@@ -4183,8 +4691,10 @@ static int relocateSection(
                   - sections[reloc->r_symbolnum-1].addr
                  + (uint64_t) image;
         }
-        
-        if(type == X86_64_RELOC_BRANCH)
+      
+       IF_DEBUG(linker, debugBelch("relocateSection: value = %p\n", value));
+
+        if (type == X86_64_RELOC_BRANCH)
         {
             if((int32_t)(value - baseValue) != (int64_t)(value - baseValue))
             {
@@ -4203,6 +4713,9 @@ static int relocateSection(
                 thing += value;
                 break;
             case X86_64_RELOC_SIGNED:
+            case X86_64_RELOC_SIGNED_1:
+            case X86_64_RELOC_SIGNED_2:
+            case X86_64_RELOC_SIGNED_4:
                 ASSERT(reloc->r_pcrel);
                 thing += value - baseValue;
                 break;
@@ -4266,7 +4779,8 @@ static int relocateSection(
                    else if(scat->r_type == PPC_RELOC_SECTDIFF
                        || scat->r_type == PPC_RELOC_LO16_SECTDIFF
                        || scat->r_type == PPC_RELOC_HI16_SECTDIFF
-                       || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
+                       || scat->r_type == PPC_RELOC_HA16_SECTDIFF
+                       || scat->r_type == PPC_RELOC_LOCAL_SECTDIFF)
 #else
                     else if(scat->r_type == GENERIC_RELOC_SECTDIFF
                         || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
@@ -4330,7 +4844,9 @@ static int relocateSection(
                              "scattered relocation entry: "
                               "object file %s; entry type %ld; "
                               "address %#lx\n", 
-                              oc->fileName, scat->r_type, scat->r_address);
+                              OC_INFORMATIVE_FILENAME(oc),
+                              scat->r_type,
+                              scat->r_address);
                         return 0;
                      }
 
@@ -4367,7 +4883,9 @@ static int relocateSection(
                         "with this r_length tag: "
                          "object file %s; entry type %ld; "
                          "r_length tag %ld; address %#lx\n", 
-                         oc->fileName, scat->r_type, scat->r_length,
+                         OC_INFORMATIVE_FILENAME(oc),
+                         scat->r_type,
+                         scat->r_length,
                          scat->r_address);
                     return 0;
                }
@@ -4377,7 +4895,9 @@ static int relocateSection(
                barf("Don't know how to handle *PC-relative* Mach-O "
                     "scattered relocation entry: "
                      "object file %s; entry type %ld; address %#lx\n", 
-                     oc->fileName, scat->r_type, scat->r_address);
+                     OC_INFORMATIVE_FILENAME(oc),
+                     scat->r_type,
+                     scat->r_address);
                return 0;
            }
 
@@ -4431,8 +4951,10 @@ static int relocateSection(
                 {
                     barf("Can't handle this Mach-O relocation entry "
                         "(not scattered): "
-                         "object file %s; entry type %ld; address %#lx\n", 
-                         oc->fileName, reloc->r_type, reloc->r_address);
+                         "object file %s; entry type %ld; address %#lx\n",
+                         OC_INFORMATIVE_FILENAME(oc),
+                         reloc->r_type,
+                         reloc->r_address);
                     return 0;
                 }
 
@@ -4506,20 +5028,32 @@ static int relocateSection(
                }
                else if(reloc->r_type == PPC_RELOC_BR24)
                {
-                    if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
+                    if((word & 0x03) != 0)
+                        barf("%s: unconditional relative branch with a displacement "
+                             "which isn't a multiple of 4 bytes: %#lx",
+                             OC_INFORMATIVE_FILENAME(oc),
+                             word);
+
+                    if((word & 0xFE000000) != 0xFE000000 &&
+                       (word & 0xFE000000) != 0x00000000)
                     {
                         // The branch offset is too large.
                         // Therefore, we try to use a jump island.
                         if(jumpIsland == 0)
                         {
-                            barf("unconditional relative branch out of range: "
-                                 "no jump island available");
+                            barf("%s: unconditional relative branch out of range: "
+                                 "no jump island available: %#lx",
+                                 OC_INFORMATIVE_FILENAME(oc),
+                                 word);
                         }
                         
                         word = offsetToJumpIsland;
-                        if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
-                            barf("unconditional relative branch out of range: "
-                                 "jump island out of range");
+                        if((word & 0xFE000000) != 0xFE000000 &&
+                           (word & 0xFE000000) != 0x00000000)
+                            barf("%s: unconditional relative branch out of range: "
+                                 "jump island out of range: %#lx",
+                                 OC_INFORMATIVE_FILENAME(oc),
+                                 word);
                     }
                    *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
                    continue;
@@ -4531,14 +5065,17 @@ static int relocateSection(
                 barf("Can't handle Mach-O relocation entry (not scattered) "
                       "with this r_length tag: "
                       "object file %s; entry type %ld; "
-                      "r_length tag %ld; address %#lx\n", 
-                      oc->fileName, reloc->r_type, reloc->r_length,
+                      "r_length tag %ld; address %#lx\n",
+                      OC_INFORMATIVE_FILENAME(oc),
+                      reloc->r_type,
+                      reloc->r_length,
                       reloc->r_address);
                 return 0;
            }
        }
 #endif
     }
+    IF_DEBUG(linker, debugBelch("relocateSection: done\n"));
     return 1;
 }
 
@@ -4556,6 +5093,8 @@ static int ocGetNames_MachO(ObjectCode* oc)
     char    *commonStorage = NULL;
     unsigned long commonCounter;
 
+    IF_DEBUG(linker,debugBelch("ocGetNames_MachO: start\n"));
+
     for(i=0;i<header->ncmds;i++)
     {
        if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
@@ -4574,7 +5113,8 @@ static int ocGetNames_MachO(ObjectCode* oc)
 
     for(i=0;i<segLC->nsects;i++)
     {
-        if(sections[i].size == 0)
+        IF_DEBUG(linker, debugBelch("ocGetNames_MachO: segment %d\n", i));
+        if (sections[i].size == 0)
             continue;
 
         if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
@@ -4627,6 +5167,7 @@ static int ocGetNames_MachO(ObjectCode* oc)
             }
         }
     }
+    IF_DEBUG(linker, debugBelch("ocGetNames_MachO: %d external symbols\n", oc->n_symbols));
     oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
                                   "ocGetNames_MachO(oc->symbols)");
 
@@ -4641,10 +5182,13 @@ static int ocGetNames_MachO(ObjectCode* oc)
                 if(nlist[i].n_type & N_EXT)
                 {
                     char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
-                    if((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm))
-                        ; // weak definition, and we already have a definition
+                    if ((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm)) {
+                        // weak definition, and we already have a definition
+                       IF_DEBUG(linker, debugBelch("    weak: %s\n", nm));
+                   }
                     else
                     {
+                           IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting %s\n", nm));
                             ghciInsertStrHashTable(oc->fileName, symhash, nm,
                                                     image
                                                     + sections[nlist[i].n_sect-1].offset
@@ -4671,6 +5215,7 @@ static int ocGetNames_MachO(ObjectCode* oc)
 
                nlist[i].n_value = commonCounter;
 
+               IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting common symbol: %s\n", nm));
                ghciInsertStrHashTable(oc->fileName, symhash, nm,
                                       (void*)commonCounter);
                oc->symbols[curSymbol++] = nm;
@@ -4694,7 +5239,8 @@ static int ocResolve_MachO(ObjectCode* oc)
     struct dysymtab_command *dsymLC = NULL;
     struct nlist *nlist;
 
-    for(i=0;i<header->ncmds;i++)
+    IF_DEBUG(linker, debugBelch("ocResolve_MachO: start\n"));
+    for (i = 0; i < header->ncmds; i++)
     {
        if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
            segLC = (struct segment_command*) lc;
@@ -4714,7 +5260,8 @@ static int ocResolve_MachO(ObjectCode* oc)
         unsigned long *indirectSyms
             = (unsigned long*) (image + dsymLC->indirectsymoff);
 
-        for(i=0;i<segLC->nsects;i++)
+       IF_DEBUG(linker, debugBelch("ocResolve_MachO: resolving dsymLC\n"));
+        for (i = 0; i < segLC->nsects; i++)
         {
             if(    !strcmp(sections[i].sectname,"__la_symbol_ptr")
                 || !strcmp(sections[i].sectname,"__la_sym_ptr2")
@@ -4734,12 +5281,18 @@ static int ocResolve_MachO(ObjectCode* oc)
                 if(!resolveImports(oc,image,symLC,&sections[i],indirectSyms,nlist))
                     return 0;
             }
+           else
+           {
+               IF_DEBUG(linker, debugBelch("ocResolve_MachO: unknown section\n"));
+           }
         }
     }
     
     for(i=0;i<segLC->nsects;i++)
     {
-       if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,&sections[i]))
+           IF_DEBUG(linker, debugBelch("ocResolve_MachO: relocating section %d\n", i));
+
+       if (!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,&sections[i]))
            return 0;
     }
 
@@ -4785,6 +5338,7 @@ static void machoInitSymbolsWithoutUnderscore()
 }
 #endif
 
+#ifndef USE_MMAP
 /*
  * Figure out by how much to shift the entire Mach-O file in memory
  * when loading so that its single segment ends up 16-byte-aligned
@@ -4793,16 +5347,25 @@ static int machoGetMisalignment( FILE * f )
 {
     struct mach_header header;
     int misalignment;
-    
-    fread(&header, sizeof(header), 1, f);
-    rewind(f);
 
-#if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
-    if(header.magic != MH_MAGIC_64)
-        return 0;
+    {
+        int n = fread(&header, sizeof(header), 1, f);
+        if (n != 1) {
+            barf("machoGetMisalignment: can't read the Mach-O header");
+        }
+    }
+    fseek(f, -sizeof(header), SEEK_CUR);
+
+#if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
+    if(header.magic != MH_MAGIC_64) {
+        barf("Bad magic. Expected: %08x, got: %08x.",
+             MH_MAGIC_64, header.magic);
+    }
 #else
-    if(header.magic != MH_MAGIC)
-        return 0;
+    if(header.magic != MH_MAGIC) {
+        barf("Bad magic. Expected: %08x, got: %08x.",
+             MH_MAGIC, header.magic);
+    }
 #endif
 
     misalignment = (header.sizeofcmds + sizeof(header))
@@ -4810,6 +5373,6 @@ static int machoGetMisalignment( FILE * f )
 
     return misalignment ? (16 - misalignment) : 0;
 }
-
 #endif
 
+#endif