X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FLinker.c;h=657c2c3886abc14bf4089b1944c2f29acf87b8e6;hb=fff1f6194c3c39de53cd645bda9865fb131b1c68;hp=e32d3247d68a00c9d1a43fd1eb35da687eca7ff9;hpb=c1d326be1992fccf8efe465b78b5735eb37d2265;p=ghc-hetmet.git

diff --git a/rts/Linker.c b/rts/Linker.c
index e32d324..657c2c3 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -18,16 +18,23 @@
 #endif
 
 #include "Rts.h"
-#include "RtsFlags.h"
 #include "HsFFI.h"
+
+#include "sm/Storage.h"
+#include "Stats.h"
 #include "Hash.h"
-#include "Linker.h"
 #include "LinkerInternals.h"
 #include "RtsUtils.h"
-#include "Schedule.h"
-#include "Sparks.h"
-#include "RtsTypeable.h"
-#include "Timer.h"
+#include "Trace.h"
+#include "StgPrimFloat.h" // for __int_encodeFloat etc.
+#include "Stable.h"
+
+#if !defined(mingw32_HOST_OS)
+#include "posix/Signals.h"
+#endif
+
+// get protos for is*()
+#include <ctype.h>
 
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>
@@ -35,6 +42,8 @@
 
 #include <stdlib.h>
 #include <string.h>
+#include <stdio.h>
+#include <assert.h>
 
 #ifdef HAVE_SYS_STAT_H
 #include <sys/stat.h>
@@ -60,27 +69,28 @@
 #include <sys/wait.h>
 #endif
 
-#if defined(ia64_HOST_ARCH) || defined(linux_HOST_OS) || defined(freebsd_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)
 #define USE_MMAP
 #include <fcntl.h>
 #include <sys/mman.h>
 
-#if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
 #ifdef HAVE_UNISTD_H
 #include <unistd.h>
 #endif
-#endif
 
 #endif
 
-#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
+#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
 #  define OBJFORMAT_ELF
+#  include <regex.h>	// regex is already used by dlopen() so this is OK
+			// to use here without requiring an additional lib
 #elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
 #  define OBJFORMAT_PEi386
 #  include <windows.h>
 #  include <math.h>
 #elif defined(darwin_HOST_OS)
 #  define OBJFORMAT_MACHO
+#  include <regex.h>
 #  include <mach-o/loader.h>
 #  include <mach-o/nlist.h>
 #  include <mach-o/reloc.h>
@@ -95,6 +105,10 @@
 #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;
 
@@ -104,6 +118,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 );
@@ -115,13 +139,16 @@ static int ocAllocateSymbolExtras_ELF ( ObjectCode* oc );
 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
 static int ocGetNames_PEi386    ( ObjectCode* oc );
 static int ocResolve_PEi386     ( ObjectCode* oc );
-static void zapTrailingAtSign   ( unsigned char* sym );
+static void *lookupSymbolInDLLs ( unsigned char *lbl );
+static void zapTrailingAtSign   ( unsigned char *sym );
 #elif defined(OBJFORMAT_MACHO)
 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
@@ -167,6 +194,50 @@ static void machoInitSymbolsWithoutUnderscore( void );
  */
 #define X86_64_ELF_NONPIC_HACK 1
 
+/* Link objects into the lower 2Gb on x86_64.  GHC assumes the
+ * small memory model on this architecture (see gcc docs,
+ * -mcmodel=small).
+ *
+ * MAP_32BIT not available on OpenBSD/amd64
+ */
+#if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT)
+#define TRY_MAP_32BIT MAP_32BIT
+#else
+#define TRY_MAP_32BIT 0
+#endif
+
+/*
+ * Due to the small memory model (see above), on x86_64 we have to map
+ * all our non-PIC object files into the low 2Gb of the address space
+ * (why 2Gb and not 4Gb?  Because all addresses must be reachable
+ * using a 32-bit signed PC-relative offset). On Linux we can do this
+ * using the MAP_32BIT flag to mmap(), however on other OSs
+ * (e.g. *BSD, see #2063, and also on Linux inside Xen, see #2512), we
+ * can't do this.  So on these systems, we have to pick a base address
+ * in the low 2Gb of the address space and try to allocate memory from
+ * there.
+ *
+ * We pick a default address based on the OS, but also make this
+ * configurable via an RTS flag (+RTS -xm)
+ */
+#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
+
+#if defined(MAP_32BIT)
+// Try to use MAP_32BIT
+#define MMAP_32BIT_BASE_DEFAULT 0
+#else
+// A guess: 1Gb.
+#define MMAP_32BIT_BASE_DEFAULT 0x40000000
+#endif
+
+static void *mmap_32bit_base = (void *)MMAP_32BIT_BASE_DEFAULT;
+#endif
+
+/* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */
+#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
+#define MAP_ANONYMOUS MAP_ANON
+#endif
+
 /* -----------------------------------------------------------------------------
  * Built-in symbols from the RTS
  */
@@ -176,20 +247,18 @@ typedef struct _RtsSymbolVal {
     void   *addr;
 } RtsSymbolVal;
 
-#if !defined(PAR)
-#define Maybe_Stable_Names      SymI_HasProto(mkWeakzh_fast)			\
-      				SymI_HasProto(makeStableNamezh_fast)		\
-      				SymI_HasProto(finalizzeWeakzh_fast)
-#else
-/* These are not available in GUM!!! -- HWL */
-#define Maybe_Stable_Names
-#endif
+#define Maybe_Stable_Names      SymI_HasProto(stg_mkWeakzh)			\
+      				SymI_HasProto(stg_mkWeakForeignEnvzh)		\
+      				SymI_HasProto(stg_makeStableNamezh)		\
+      				SymI_HasProto(stg_finalizzeWeakzh)
 
 #if !defined (mingw32_HOST_OS)
 #define RTS_POSIX_ONLY_SYMBOLS                  \
+      SymI_HasProto(__hscore_get_saved_termios)	\
+      SymI_HasProto(__hscore_set_saved_termios)	\
       SymI_HasProto(shutdownHaskellAndSignal)	\
-      SymI_NeedsProto(lockFile)                 \
-      SymI_NeedsProto(unlockFile)               \
+      SymI_HasProto(lockFile)                   \
+      SymI_HasProto(unlockFile)                 \
       SymI_HasProto(signal_handlers)		\
       SymI_HasProto(stg_sig_install)		\
       SymI_NeedsProto(nocldstop)
@@ -286,27 +355,24 @@ 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
 #define RTS_MINGW_GETTIMEOFDAY_SYM /**/
 #endif
 
+#if HAVE___MINGW_VFPRINTF
+#define RTS___MINGW_VFPRINTF_SYM SymI_HasProto(__mingw_vfprintf)
+#else
+#define RTS___MINGW_VFPRINTF_SYM /**/
+#endif
+
 /* These are statically linked from the mingw libraries into the ghc
    executable, so we have to employ this hack. */
 #define RTS_MINGW_ONLY_SYMBOLS                           \
-      SymI_HasProto(asyncReadzh_fast)			 \
-      SymI_HasProto(asyncWritezh_fast)			 \
-      SymI_HasProto(asyncDoProczh_fast)			 \
+      SymI_HasProto(stg_asyncReadzh)			 \
+      SymI_HasProto(stg_asyncWritezh)			 \
+      SymI_HasProto(stg_asyncDoProczh)			 \
       SymI_HasProto(memset)                              \
       SymI_HasProto(inet_ntoa)                           \
       SymI_HasProto(inet_addr)                           \
@@ -329,16 +395,18 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(strncpy)                             \
       SymI_HasProto(abort)                               \
       SymI_NeedsProto(_alloca)                           \
-      SymI_NeedsProto(isxdigit)                          \
-      SymI_NeedsProto(isupper)                           \
-      SymI_NeedsProto(ispunct)                           \
-      SymI_NeedsProto(islower)                           \
-      SymI_NeedsProto(isspace)                           \
-      SymI_NeedsProto(isprint)                           \
-      SymI_NeedsProto(isdigit)                           \
-      SymI_NeedsProto(iscntrl)                           \
-      SymI_NeedsProto(isalpha)                           \
-      SymI_NeedsProto(isalnum)                           \
+      SymI_HasProto(isxdigit)                          \
+      SymI_HasProto(isupper)                           \
+      SymI_HasProto(ispunct)                           \
+      SymI_HasProto(islower)                           \
+      SymI_HasProto(isspace)                           \
+      SymI_HasProto(isprint)                           \
+      SymI_HasProto(isdigit)                           \
+      SymI_HasProto(iscntrl)                           \
+      SymI_HasProto(isalpha)                           \
+      SymI_HasProto(isalnum)                           \
+      SymI_HasProto(isascii)                           \
+      RTS___MINGW_VFPRINTF_SYM                           \
       SymI_HasProto(strcmp)                              \
       SymI_HasProto(memmove)                             \
       SymI_HasProto(realloc)                             \
@@ -369,6 +437,10 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(expf)                                \
       SymI_HasProto(logf)                                \
       SymI_HasProto(sqrtf)                               \
+      SymI_HasProto(erf)                                \
+      SymI_HasProto(erfc)                                \
+      SymI_HasProto(erff)                                \
+      SymI_HasProto(erfcf)                               \
       SymI_HasProto(memcpy)                              \
       SymI_HasProto(rts_InstallConsoleEvent)             \
       SymI_HasProto(rts_ConsoleHandlerDone)              \
@@ -383,12 +455,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)                          \
@@ -446,9 +521,14 @@ 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(blockUserSignals) \
+   SymI_HasProto(unblockUserSignals)
 #else
 #define RTS_USER_SIGNALS_SYMBOLS     \
+   SymI_HasProto(ioManagerWakeup) \
    SymI_HasProto(sendIOManagerEvent) \
    SymI_HasProto(readIOManagerEvent) \
    SymI_HasProto(getIOManagerEvent)  \
@@ -493,25 +573,137 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_ap_pppppp_ret)
 #endif
 
-/* On Windows, we link libgmp.a statically into libHSrts.dll */
-#ifdef mingw32_HOST_OS
-#define GMP_SYMS				        \
-      SymI_HasProto(__gmpz_cmp)				\
-      SymI_HasProto(__gmpz_cmp_si)			\
-      SymI_HasProto(__gmpz_cmp_ui)			\
-      SymI_HasProto(__gmpz_get_si)			\
-      SymI_HasProto(__gmpz_get_ui)
+/* Modules compiled with -ticky may mention ticky counters */
+/* This list should marry up with the one in $(TOP)/includes/stg/Ticky.h */
+#define RTS_TICKY_SYMBOLS                       \
+      SymI_NeedsProto(ticky_entry_ctrs)         \
+      SymI_NeedsProto(top_ct)                   \
+                                                \
+      SymI_HasProto(ENT_VIA_NODE_ctr)		\
+      SymI_HasProto(ENT_STATIC_THK_ctr)		\
+      SymI_HasProto(ENT_DYN_THK_ctr)		\
+      SymI_HasProto(ENT_STATIC_FUN_DIRECT_ctr)	\
+      SymI_HasProto(ENT_DYN_FUN_DIRECT_ctr)	\
+      SymI_HasProto(ENT_STATIC_CON_ctr)		\
+      SymI_HasProto(ENT_DYN_CON_ctr)		\
+      SymI_HasProto(ENT_STATIC_IND_ctr)		\
+      SymI_HasProto(ENT_DYN_IND_ctr)		\
+      SymI_HasProto(ENT_PERM_IND_ctr)		\
+      SymI_HasProto(ENT_PAP_ctr)		\
+      SymI_HasProto(ENT_AP_ctr)		        \
+      SymI_HasProto(ENT_AP_STACK_ctr)		\
+      SymI_HasProto(ENT_BH_ctr)	        	\
+      SymI_HasProto(UNKNOWN_CALL_ctr)		\
+      SymI_HasProto(SLOW_CALL_v_ctr)		\
+      SymI_HasProto(SLOW_CALL_f_ctr)		\
+      SymI_HasProto(SLOW_CALL_d_ctr)		\
+      SymI_HasProto(SLOW_CALL_l_ctr)		\
+      SymI_HasProto(SLOW_CALL_n_ctr)		\
+      SymI_HasProto(SLOW_CALL_p_ctr)		\
+      SymI_HasProto(SLOW_CALL_pv_ctr)		\
+      SymI_HasProto(SLOW_CALL_pp_ctr)		\
+      SymI_HasProto(SLOW_CALL_ppv_ctr)		\
+      SymI_HasProto(SLOW_CALL_ppp_ctr)		\
+      SymI_HasProto(SLOW_CALL_pppv_ctr)		\
+      SymI_HasProto(SLOW_CALL_pppp_ctr)		\
+      SymI_HasProto(SLOW_CALL_ppppp_ctr)		\
+      SymI_HasProto(SLOW_CALL_pppppp_ctr)		\
+      SymI_HasProto(SLOW_CALL_OTHER_ctr)		\
+      SymI_HasProto(ticky_slow_call_unevald)            \
+      SymI_HasProto(SLOW_CALL_ctr)		        \
+      SymI_HasProto(MULTI_CHUNK_SLOW_CALL_ctr)		\
+      SymI_HasProto(MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr)	\
+      SymI_HasProto(KNOWN_CALL_ctr)		        \
+      SymI_HasProto(KNOWN_CALL_TOO_FEW_ARGS_ctr)	\
+      SymI_HasProto(KNOWN_CALL_EXTRA_ARGS_ctr)		\
+      SymI_HasProto(SLOW_CALL_FUN_TOO_FEW_ctr)		\
+      SymI_HasProto(SLOW_CALL_FUN_CORRECT_ctr)		\
+      SymI_HasProto(SLOW_CALL_FUN_TOO_MANY_ctr)		\
+      SymI_HasProto(SLOW_CALL_PAP_TOO_FEW_ctr)		\
+      SymI_HasProto(SLOW_CALL_PAP_CORRECT_ctr)		\
+      SymI_HasProto(SLOW_CALL_PAP_TOO_MANY_ctr)		\
+      SymI_HasProto(SLOW_CALL_UNEVALD_ctr)		\
+      SymI_HasProto(UPDF_OMITTED_ctr)		\
+      SymI_HasProto(UPDF_PUSHED_ctr)		\
+      SymI_HasProto(CATCHF_PUSHED_ctr)		\
+      SymI_HasProto(UPDF_RCC_PUSHED_ctr)	\
+      SymI_HasProto(UPDF_RCC_OMITTED_ctr)	\
+      SymI_HasProto(UPD_SQUEEZED_ctr)		\
+      SymI_HasProto(UPD_CON_IN_NEW_ctr)		\
+      SymI_HasProto(UPD_CON_IN_PLACE_ctr)	\
+      SymI_HasProto(UPD_PAP_IN_NEW_ctr)		\
+      SymI_HasProto(UPD_PAP_IN_PLACE_ctr)	\
+      SymI_HasProto(ALLOC_HEAP_ctr)		\
+      SymI_HasProto(ALLOC_HEAP_tot)             \
+      SymI_HasProto(ALLOC_FUN_ctr)		\
+      SymI_HasProto(ALLOC_FUN_adm)              \
+      SymI_HasProto(ALLOC_FUN_gds)              \
+      SymI_HasProto(ALLOC_FUN_slp)              \
+      SymI_HasProto(UPD_NEW_IND_ctr)		\
+      SymI_HasProto(UPD_NEW_PERM_IND_ctr)	\
+      SymI_HasProto(UPD_OLD_IND_ctr)		\
+      SymI_HasProto(UPD_OLD_PERM_IND_ctr)		\
+      SymI_HasProto(UPD_BH_UPDATABLE_ctr)		\
+      SymI_HasProto(UPD_BH_SINGLE_ENTRY_ctr)		\
+      SymI_HasProto(UPD_CAF_BH_UPDATABLE_ctr)		\
+      SymI_HasProto(UPD_CAF_BH_SINGLE_ENTRY_ctr)	\
+      SymI_HasProto(GC_SEL_ABANDONED_ctr)		\
+      SymI_HasProto(GC_SEL_MINOR_ctr)		\
+      SymI_HasProto(GC_SEL_MAJOR_ctr)		\
+      SymI_HasProto(GC_FAILED_PROMOTION_ctr)	\
+      SymI_HasProto(ALLOC_UP_THK_ctr)		\
+      SymI_HasProto(ALLOC_SE_THK_ctr)		\
+      SymI_HasProto(ALLOC_THK_adm)		\
+      SymI_HasProto(ALLOC_THK_gds)		\
+      SymI_HasProto(ALLOC_THK_slp)		\
+      SymI_HasProto(ALLOC_CON_ctr)		\
+      SymI_HasProto(ALLOC_CON_adm)		\
+      SymI_HasProto(ALLOC_CON_gds)		\
+      SymI_HasProto(ALLOC_CON_slp)		\
+      SymI_HasProto(ALLOC_TUP_ctr)		\
+      SymI_HasProto(ALLOC_TUP_adm)		\
+      SymI_HasProto(ALLOC_TUP_gds)		\
+      SymI_HasProto(ALLOC_TUP_slp)		\
+      SymI_HasProto(ALLOC_BH_ctr)		\
+      SymI_HasProto(ALLOC_BH_adm)		\
+      SymI_HasProto(ALLOC_BH_gds)		\
+      SymI_HasProto(ALLOC_BH_slp)		\
+      SymI_HasProto(ALLOC_PRIM_ctr)		\
+      SymI_HasProto(ALLOC_PRIM_adm)		\
+      SymI_HasProto(ALLOC_PRIM_gds)		\
+      SymI_HasProto(ALLOC_PRIM_slp)		\
+      SymI_HasProto(ALLOC_PAP_ctr)		\
+      SymI_HasProto(ALLOC_PAP_adm)		\
+      SymI_HasProto(ALLOC_PAP_gds)		\
+      SymI_HasProto(ALLOC_PAP_slp)		\
+      SymI_HasProto(ALLOC_TSO_ctr)		\
+      SymI_HasProto(ALLOC_TSO_adm)		\
+      SymI_HasProto(ALLOC_TSO_gds)		\
+      SymI_HasProto(ALLOC_TSO_slp)		\
+      SymI_HasProto(RET_NEW_ctr)		\
+      SymI_HasProto(RET_OLD_ctr)		\
+      SymI_HasProto(RET_UNBOXED_TUP_ctr)	\
+      SymI_HasProto(RET_SEMI_loads_avoided)
+
+
+// On most platforms, the garbage collector rewrites references
+//	to small integer and char objects to a set of common, shared ones.
+//
+// We don't do this when compiling to Windows DLLs at the moment because
+//	it doesn't support cross package data references well.
+//
+#if defined(__PIC__) && defined(mingw32_HOST_OS)
+#define RTS_INTCHAR_SYMBOLS
 #else
-#define GMP_SYMS				        \
-      SymE_HasProto(__gmpz_cmp)			        \
-      SymE_HasProto(__gmpz_cmp_si)			\
-      SymE_HasProto(__gmpz_cmp_ui)			\
-      SymE_HasProto(__gmpz_get_si)			\
-      SymE_HasProto(__gmpz_get_ui)
+#define RTS_INTCHAR_SYMBOLS				\
+      SymI_HasProto(stg_CHARLIKE_closure)		\
+      SymI_HasProto(stg_INTLIKE_closure)		
 #endif
 
+
 #define RTS_SYMBOLS				        \
       Maybe_Stable_Names			        \
+      RTS_TICKY_SYMBOLS                                 \
       SymI_HasProto(StgReturn)				\
       SymI_HasProto(stg_enter_info)			\
       SymI_HasProto(stg_gc_void_info)			\
@@ -546,53 +738,46 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(OnExitHook)				\
       SymI_HasProto(OutOfHeapHook)			\
       SymI_HasProto(StackOverflowHook)			\
-      SymI_HasProto(__encodeDouble)			\
-      SymI_HasProto(__encodeFloat)			\
       SymI_HasProto(addDLL)               		\
-      GMP_SYMS					        \
       SymI_HasProto(__int_encodeDouble)			\
       SymI_HasProto(__word_encodeDouble)		\
       SymI_HasProto(__2Int_encodeDouble)		\
       SymI_HasProto(__int_encodeFloat)			\
       SymI_HasProto(__word_encodeFloat)			\
-      SymI_HasProto(andIntegerzh_fast)			\
-      SymI_HasProto(atomicallyzh_fast)			\
+      SymI_HasProto(stg_atomicallyzh)			\
       SymI_HasProto(barf)				\
       SymI_HasProto(debugBelch)				\
       SymI_HasProto(errorBelch)				\
-      SymI_HasProto(asyncExceptionsBlockedzh_fast)	\
-      SymI_HasProto(blockAsyncExceptionszh_fast)	\
-      SymI_HasProto(catchzh_fast)			\
-      SymI_HasProto(catchRetryzh_fast)			\
-      SymI_HasProto(catchSTMzh_fast)			\
-      SymI_HasProto(checkzh_fast)                       \
+      SymI_HasProto(sysErrorBelch)                      \
+      SymI_HasProto(stg_getMaskingStatezh)		\
+      SymI_HasProto(stg_maskAsyncExceptionszh)	        \
+      SymI_HasProto(stg_maskUninterruptiblezh)	        \
+      SymI_HasProto(stg_catchzh)			\
+      SymI_HasProto(stg_catchRetryzh)			\
+      SymI_HasProto(stg_catchSTMzh)			\
+      SymI_HasProto(stg_checkzh)                        \
       SymI_HasProto(closure_flags)                      \
       SymI_HasProto(cmp_thread)				\
-      SymI_HasProto(cmpIntegerzh_fast)	        	\
-      SymI_HasProto(cmpIntegerIntzh_fast)	      	\
-      SymI_HasProto(complementIntegerzh_fast)		\
       SymI_HasProto(createAdjustor)			\
-      SymI_HasProto(decodeDoublezh_fast)		\
-      SymI_HasProto(decodeFloatzh_fast)			\
-      SymI_HasProto(decodeDoublezu2Intzh_fast)		\
-      SymI_HasProto(decodeFloatzuIntzh_fast)		\
+      SymI_HasProto(stg_decodeDoublezu2Intzh)		\
+      SymI_HasProto(stg_decodeFloatzuIntzh)		\
       SymI_HasProto(defaultsHook)			\
-      SymI_HasProto(delayzh_fast)			\
-      SymI_HasProto(deRefWeakzh_fast)			\
-      SymI_HasProto(deRefStablePtrzh_fast)		\
+      SymI_HasProto(stg_delayzh)			\
+      SymI_HasProto(stg_deRefWeakzh)			\
+      SymI_HasProto(stg_deRefStablePtrzh)		\
       SymI_HasProto(dirty_MUT_VAR)			\
-      SymI_HasProto(divExactIntegerzh_fast)		\
-      SymI_HasProto(divModIntegerzh_fast)		\
-      SymI_HasProto(forkzh_fast)			\
-      SymI_HasProto(forkOnzh_fast)			\
+      SymI_HasProto(stg_forkzh)			        \
+      SymI_HasProto(stg_forkOnzh)			\
       SymI_HasProto(forkProcess)			\
       SymI_HasProto(forkOS_createThread)		\
       SymI_HasProto(freeHaskellFunctionPtr)		\
-      SymI_HasProto(freeStablePtr)		        \
       SymI_HasProto(getOrSetTypeableStore)		\
-      SymI_HasProto(gcdIntegerzh_fast)			\
-      SymI_HasProto(gcdIntegerIntzh_fast)		\
-      SymI_HasProto(gcdIntzh_fast)			\
+      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)			\
@@ -606,62 +791,48 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(hs_free_stable_ptr)			\
       SymI_HasProto(hs_free_fun_ptr)			\
       SymI_HasProto(hs_hpc_rootModule)		        \
+      SymI_HasProto(hs_hpc_module)		        \
       SymI_HasProto(initLinker)				\
-      SymI_HasProto(unpackClosurezh_fast)               \
-      SymI_HasProto(getApStackValzh_fast)               \
-      SymI_HasProto(getSparkzh_fast)                    \
-      SymI_HasProto(int2Integerzh_fast)			\
-      SymI_HasProto(integer2Intzh_fast)			\
-      SymI_HasProto(integer2Wordzh_fast)		\
-      SymI_HasProto(isCurrentThreadBoundzh_fast)	\
-      SymI_HasProto(isDoubleDenormalized)		\
-      SymI_HasProto(isDoubleInfinite)			\
-      SymI_HasProto(isDoubleNaN)			\
-      SymI_HasProto(isDoubleNegativeZero)		\
-      SymI_HasProto(isEmptyMVarzh_fast)			\
-      SymI_HasProto(isFloatDenormalized)		\
-      SymI_HasProto(isFloatInfinite)			\
-      SymI_HasProto(isFloatNaN)				\
-      SymI_HasProto(isFloatNegativeZero)		\
-      SymI_HasProto(killThreadzh_fast)			\
+      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)     			\
       SymI_HasProto(lookupSymbol)     			\
-      SymI_HasProto(makeStablePtrzh_fast)		\
-      SymI_HasProto(minusIntegerzh_fast)		\
-      SymI_HasProto(mkApUpd0zh_fast)			\
-      SymI_HasProto(myThreadIdzh_fast)			\
-      SymI_HasProto(labelThreadzh_fast)                 \
-      SymI_HasProto(newArrayzh_fast)			\
-      SymI_HasProto(newBCOzh_fast)			\
-      SymI_HasProto(newByteArrayzh_fast)		\
+      SymI_HasProto(stg_makeStablePtrzh)		\
+      SymI_HasProto(stg_mkApUpd0zh)			\
+      SymI_HasProto(stg_myThreadIdzh)			\
+      SymI_HasProto(stg_labelThreadzh)                  \
+      SymI_HasProto(stg_newArrayzh)			\
+      SymI_HasProto(stg_newBCOzh)			\
+      SymI_HasProto(stg_newByteArrayzh)  		\
       SymI_HasProto_redirect(newCAF, newDynCAF)		\
-      SymI_HasProto(newMVarzh_fast)			\
-      SymI_HasProto(newMutVarzh_fast)			\
-      SymI_HasProto(newTVarzh_fast)			\
-      SymI_HasProto(noDuplicatezh_fast)			\
-      SymI_HasProto(atomicModifyMutVarzh_fast)		\
-      SymI_HasProto(newPinnedByteArrayzh_fast)		\
+      SymI_HasProto(stg_newMVarzh)			\
+      SymI_HasProto(stg_newMutVarzh)			\
+      SymI_HasProto(stg_newTVarzh)			\
+      SymI_HasProto(stg_noDuplicatezh)			\
+      SymI_HasProto(stg_atomicModifyMutVarzh)		\
+      SymI_HasProto(stg_newPinnedByteArrayzh)		\
+      SymI_HasProto(stg_newAlignedPinnedByteArrayzh)	\
       SymI_HasProto(newSpark)				\
-      SymI_HasProto(orIntegerzh_fast)			\
       SymI_HasProto(performGC)				\
       SymI_HasProto(performMajorGC)			\
-      SymI_HasProto(plusIntegerzh_fast)			\
       SymI_HasProto(prog_argc)				\
       SymI_HasProto(prog_argv)				\
-      SymI_HasProto(putMVarzh_fast)			\
-      SymI_HasProto(quotIntegerzh_fast)			\
-      SymI_HasProto(quotRemIntegerzh_fast)		\
-      SymI_HasProto(raisezh_fast)			\
-      SymI_HasProto(raiseIOzh_fast)			\
-      SymI_HasProto(readTVarzh_fast)			\
-      SymI_HasProto(readTVarIOzh_fast)			\
-      SymI_HasProto(remIntegerzh_fast)			\
-      SymI_HasProto(resetNonBlockingFd)			\
+      SymI_HasProto(stg_putMVarzh)			\
+      SymI_HasProto(stg_raisezh)			\
+      SymI_HasProto(stg_raiseIOzh)			\
+      SymI_HasProto(stg_readTVarzh)			\
+      SymI_HasProto(stg_readTVarIOzh)			\
       SymI_HasProto(resumeThread)			\
       SymI_HasProto(resolveObjs)                        \
-      SymI_HasProto(retryzh_fast)                       \
+      SymI_HasProto(stg_retryzh)                        \
       SymI_HasProto(rts_apply)				\
       SymI_HasProto(rts_checkSchedStatus)		\
       SymI_HasProto(rts_eval)				\
@@ -707,9 +878,9 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(rts_mkWord32)			\
       SymI_HasProto(rts_mkWord64)			\
       SymI_HasProto(rts_unlock)				\
+      SymI_HasProto(rts_unsafeGetMyCapability)          \
       SymI_HasProto(rtsSupportsBoundThreads)		\
-      SymI_HasProto(__hscore_get_saved_termios)		\
-      SymI_HasProto(__hscore_set_saved_termios)		\
+      SymI_HasProto(rts_isProfiled)			\
       SymI_HasProto(setProgArgv)			\
       SymI_HasProto(startupHaskell)			\
       SymI_HasProto(shutdownHaskell)			\
@@ -717,13 +888,15 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stable_ptr_table)			\
       SymI_HasProto(stackOverflow)			\
       SymI_HasProto(stg_CAF_BLACKHOLE_info)		\
-      SymI_HasProto(awakenBlockedQueue)			\
+      SymI_HasProto(stg_BLACKHOLE_info)			\
+      SymI_HasProto(__stg_EAGER_BLACKHOLE_info)		\
+      SymI_HasProto(stg_BLOCKING_QUEUE_CLEAN_info)      \
+      SymI_HasProto(stg_BLOCKING_QUEUE_DIRTY_info)	\
       SymI_HasProto(startTimer)                         \
-      SymI_HasProto(stg_CHARLIKE_closure)		\
       SymI_HasProto(stg_MVAR_CLEAN_info)		\
       SymI_HasProto(stg_MVAR_DIRTY_info)		\
       SymI_HasProto(stg_IND_STATIC_info)		\
-      SymI_HasProto(stg_INTLIKE_closure)		\
+      SymI_HasProto(stg_ARR_WORDS_info)                 \
       SymI_HasProto(stg_MUT_ARR_PTRS_DIRTY_info)	\
       SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN_info)	\
       SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN0_info)	\
@@ -782,22 +955,24 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_sel_8_upd_info)			\
       SymI_HasProto(stg_sel_9_upd_info)			\
       SymI_HasProto(stg_upd_frame_info)			\
+      SymI_HasProto(stg_bh_upd_frame_info)		\
       SymI_HasProto(suspendThread)			\
-      SymI_HasProto(takeMVarzh_fast)			\
-      SymI_HasProto(threadStatuszh_fast)		\
-      SymI_HasProto(timesIntegerzh_fast)		\
-      SymI_HasProto(tryPutMVarzh_fast)			\
-      SymI_HasProto(tryTakeMVarzh_fast)			\
-      SymI_HasProto(unblockAsyncExceptionszh_fast)	\
+      SymI_HasProto(stg_takeMVarzh)			\
+      SymI_HasProto(stg_threadStatuszh)		        \
+      SymI_HasProto(stg_tryPutMVarzh)			\
+      SymI_HasProto(stg_tryTakeMVarzh)			\
+      SymI_HasProto(stg_unmaskAsyncExceptionszh)	\
       SymI_HasProto(unloadObj)                          \
-      SymI_HasProto(unsafeThawArrayzh_fast)		\
-      SymI_HasProto(waitReadzh_fast)			\
-      SymI_HasProto(waitWritezh_fast)			\
-      SymI_HasProto(word2Integerzh_fast)		\
-      SymI_HasProto(writeTVarzh_fast)			\
-      SymI_HasProto(xorIntegerzh_fast)			\
-      SymI_HasProto(yieldzh_fast)                       \
+      SymI_HasProto(stg_unsafeThawArrayzh)		\
+      SymI_HasProto(stg_waitReadzh)			\
+      SymI_HasProto(stg_waitWritezh)			\
+      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)                           \
       SymI_HasProto(allocateExec)	                \
       SymI_HasProto(freeExec)		                \
       SymI_HasProto(getAllocations)                     \
@@ -808,15 +983,11 @@ typedef struct _RtsSymbolVal {
       SymI_NeedsProto(rts_stop_on_exception)		\
       SymI_HasProto(stopTimer)				\
       SymI_HasProto(n_capabilities)			\
-      RTS_USER_SIGNALS_SYMBOLS
+      SymI_HasProto(stg_traceCcszh)                     \
+      SymI_HasProto(stg_traceEventzh)                   \
+      RTS_USER_SIGNALS_SYMBOLS				\
+      RTS_INTCHAR_SYMBOLS
 
-#ifdef SUPPORT_LONG_LONGS
-#define RTS_LONG_LONG_SYMS			        \
-      SymI_HasProto(int64ToIntegerzh_fast)		\
-      SymI_HasProto(word64ToIntegerzh_fast)
-#else
-#define RTS_LONG_LONG_SYMS /* nothing */
-#endif
 
 // 64-bit support functions in libgcc.a
 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
@@ -828,16 +999,7 @@ typedef struct _RtsSymbolVal {
       SymI_NeedsProto(__muldi3)			       \
       SymI_NeedsProto(__ashldi3)		       \
       SymI_NeedsProto(__ashrdi3)		       \
-      SymI_NeedsProto(__lshrdi3)		       \
-      SymI_NeedsProto(__eprintf)
-#elif defined(ia64_HOST_ARCH)
-#define RTS_LIBGCC_SYMBOLS			        \
-      SymI_NeedsProto(__divdi3)				\
-      SymI_NeedsProto(__udivdi3)                        \
-      SymI_NeedsProto(__moddi3)				\
-      SymI_NeedsProto(__umoddi3)			\
-      SymI_NeedsProto(__divsf3)				\
-      SymI_NeedsProto(__divdf3)
+      SymI_NeedsProto(__lshrdi3)
 #else
 #define RTS_LIBGCC_SYMBOLS
 #endif
@@ -853,7 +1015,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
@@ -864,7 +1026,6 @@ typedef struct _RtsSymbolVal {
 #define SymI_HasProto_redirect(vvv,xxx) /**/
 RTS_SYMBOLS
 RTS_RET_SYMBOLS
-RTS_LONG_LONG_SYMS
 RTS_POSIX_ONLY_SYMBOLS
 RTS_MINGW_ONLY_SYMBOLS
 RTS_CYGWIN_ONLY_SYMBOLS
@@ -900,7 +1061,6 @@ RTS_LIBFFI_SYMBOLS
 static RtsSymbolVal rtsSyms[] = {
       RTS_SYMBOLS
       RTS_RET_SYMBOLS
-      RTS_LONG_LONG_SYMS
       RTS_POSIX_ONLY_SYMBOLS
       RTS_MINGW_ONLY_SYMBOLS
       RTS_CYGWIN_ONLY_SYMBOLS
@@ -949,7 +1109,7 @@ static void ghciInsertStrHashTable ( char* obj_name,
       (char*)key,
       obj_name
    );
-   exit(1);
+   stg_exit(1);
 }
 /* -----------------------------------------------------------------------------
  * initialize the object linker
@@ -960,20 +1120,36 @@ static int linker_init_done = 0 ;
 
 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
 static void *dl_prog_handle;
+static regex_t re_invalid;
+static regex_t re_realso;
+#ifdef THREADED_RTS
+static Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section
+#endif
 #endif
 
 void
 initLinker( void )
 {
     RtsSymbolVal *sym;
+#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
+    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))
+    initMutex(&dl_mutex);
+#endif
     stablehash = allocStrHashTable();
     symhash = allocStrHashTable();
 
@@ -981,6 +1157,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();
@@ -992,7 +1169,49 @@ initLinker( void )
 #   else
     dl_prog_handle = dlopen(NULL, RTLD_LAZY);
 #   endif /* RTLD_DEFAULT */
+
+    compileResult = regcomp(&re_invalid,
+           "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*invalid ELF header",
+           REG_EXTENDED);
+    ASSERT( compileResult == 0 );
+    compileResult = regcomp(&re_realso,
+           "GROUP *\\( *(([^ )])+)",
+           REG_EXTENDED);
+    ASSERT( compileResult == 0 );
 #   endif
+
+#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;
+    }
+#endif
+
+#if defined(mingw32_HOST_OS)
+    /*
+     * These two libraries cause problems when added to the static link,
+     * but are necessary for resolving symbols in GHCi, hence we load
+     * them manually here.
+     */
+    addDLL("msvcrt");
+    addDLL("kernel32");
+#endif
+
+    IF_DEBUG(linker, debugBelch("initLinker: done\n"));
+    return;
+}
+
+void
+exitLinker( void ) {
+#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
+   if (linker_init_done == 1) {
+      regfree(&re_invalid);
+      regfree(&re_realso);
+#ifdef THREADED_RTS
+      closeMutex(&dl_mutex);
+#endif
+   }
+#endif
 }
 
 /* -----------------------------------------------------------------------------
@@ -1030,29 +1249,113 @@ typedef
 static OpenedDLL* opened_dlls = NULL;
 #endif
 
-const char *
-addDLL( char *dll_name )
-{
 #  if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
-   /* ------------------- ELF DLL loader ------------------- */
+
+static const char *
+internal_dlopen(const char *dll_name)
+{
    void *hdl;
    const char *errmsg;
-
-   initLinker();
+   char *errmsg_copy;
 
    // omitted: RTLD_NOW
    // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html
-   hdl= dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL);
+   IF_DEBUG(linker,
+      debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name));
 
+   //-------------- Begin critical section ------------------
+   // This critical section is necessary because dlerror() is not
+   // required to be reentrant (see POSIX -- IEEE Std 1003.1-2008)
+   // Also, the error message returned must be copied to preserve it
+   // (see POSIX also)
+
+   ACQUIRE_LOCK(&dl_mutex);
+   hdl = dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL);
+
+   errmsg = NULL;
    if (hdl == NULL) {
       /* dlopen failed; return a ptr to the error msg. */
       errmsg = dlerror();
       if (errmsg == NULL) errmsg = "addDLL: unknown error";
-      return errmsg;
-   } else {
+      errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL");
+      strcpy(errmsg_copy, errmsg);
+      errmsg = errmsg_copy;
+   }
+   RELEASE_LOCK(&dl_mutex);
+   //--------------- End critical section -------------------
+
+   return errmsg;
+}
+#  endif
+
+const char *
+addDLL( char *dll_name )
+{
+#  if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
+   /* ------------------- ELF DLL loader ------------------- */
+
+#define NMATCH 5
+   regmatch_t match[NMATCH];
+   const char *errmsg;
+   FILE* fp;
+   size_t match_length;
+#define MAXLINE 1000
+   char line[MAXLINE];
+   int result;
+
+   initLinker();
+
+   IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name));
+   errmsg = internal_dlopen(dll_name);
+
+   if (errmsg == NULL) {
       return NULL;
    }
-   /*NOTREACHED*/
+
+   // GHC Trac ticket #2615
+   // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so)
+   // contain linker scripts rather than ELF-format object code. This
+   // code handles the situation by recognizing the real object code
+   // file name given in the linker script.
+   //
+   // If an "invalid ELF header" error occurs, it is assumed that the
+   // .so file contains a linker script instead of ELF object code.
+   // In this case, the code looks for the GROUP ( ... ) linker
+   // directive. If one is found, the first file name inside the
+   // parentheses is treated as the name of a dynamic library and the
+   // code attempts to dlopen that file. If this is also unsuccessful,
+   // an error message is returned.
+
+   // see if the error message is due to an invalid ELF header
+   IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg));
+   result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0);
+   IF_DEBUG(linker, debugBelch("result = %i\n", result));
+   if (result == 0) {
+      // success -- try to read the named file as a linker script
+      match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so),
+		                 MAXLINE-1);
+      strncpy(line, (errmsg+(match[1].rm_so)),match_length);
+      line[match_length] = '\0'; // make sure string is null-terminated
+      IF_DEBUG(linker, debugBelch ("file name = '%s'\n", line));
+      if ((fp = fopen(line, "r")) == NULL) {
+	 return errmsg;	// return original error if open fails
+      }
+      // try to find a GROUP ( ... ) command
+      while (fgets(line, MAXLINE, fp) != NULL) {
+	 IF_DEBUG(linker, debugBelch("input line = %s", line));
+	 if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) {
+            // success -- try to dlopen the first named file
+            IF_DEBUG(linker, debugBelch("match%s\n",""));
+	    line[match[1].rm_eo] = '\0';
+	    errmsg = internal_dlopen(line+match[1].rm_so);
+	    break;
+	 }
+	 // if control reaches here, no GROUP ( ... ) directive was found
+	 // and the original error message is returned to the caller
+      }
+      fclose(fp);
+   }
+   return errmsg;
 
 #  elif defined(OBJFORMAT_PEi386)
    /* ------------------- Win32 DLL loader ------------------- */
@@ -1150,11 +1453,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)
@@ -1167,6 +1472,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
@@ -1178,37 +1484,24 @@ lookupSymbol( char *lbl )
 	}
 #       endif /* HAVE_DLFCN_H */
 #       elif defined(OBJFORMAT_PEi386)
-        OpenedDLL* o_dll;
         void* sym;
 
-        zapTrailingAtSign ( lbl );
-
-        for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
-	  /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
-           if (lbl[0] == '_') {
-              /* HACK: if the name has an initial underscore, try stripping
-                 it off & look that up first. I've yet to verify whether there's
-                 a Rule that governs whether an initial '_' *should always* be
-                 stripped off when mapping from import lib name to the DLL name.
-              */
-              sym = GetProcAddress(o_dll->instance, (lbl+1));
-              if (sym != NULL) {
-		/*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
-		return sym;
-	      }
-           }
-           sym = GetProcAddress(o_dll->instance, lbl);
-           if (sym != NULL) {
-	     /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
-	     return sym;
-	   }
-        }
+        sym = lookupSymbolInDLLs((unsigned char*)lbl);
+        if (sym != NULL) { return sym; };
+
+        // Also try looking up the symbol without the @N suffix.  Some
+        // DLLs have the suffixes on their symbols, some don't.
+        zapTrailingAtSign ( (unsigned char*)lbl );
+        sym = lookupSymbolInDLLs((unsigned char*)lbl);
+        if (sym != NULL) { return sym; };
         return NULL;
+
 #       else
         ASSERT(2+2 == 5);
         return NULL;
 #       endif
     } else {
+	IF_DEBUG(linker, debugBelch("lookupSymbol: value of %s is %p\n", lbl, val));
 	return val;
     }
 }
@@ -1249,8 +1542,286 @@ void ghci_enquire ( char* addr )
 }
 #endif
 
-#ifdef ia64_HOST_ARCH
-static unsigned int PLTSize(void);
+#ifdef USE_MMAP
+#define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
+
+static void *
+mmapForLinker (size_t bytes, nat flags, int fd)
+{
+   void *map_addr = NULL;
+   void *result;
+   int pagesize, size;
+   static nat fixed = 0;
+
+   pagesize = getpagesize();
+   size = ROUND_UP(bytes, pagesize);
+
+#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
+mmap_again:
+
+   if (mmap_32bit_base != 0) {
+       map_addr = mmap_32bit_base;
+   }
+#endif
+
+   result = mmap(map_addr, size, PROT_EXEC|PROT_READ|PROT_WRITE,
+		    MAP_PRIVATE|TRY_MAP_32BIT|fixed|flags, fd, 0);
+
+   if (result == MAP_FAILED) {
+       sysErrorBelch("mmap %lu bytes at %p",(lnat)size,map_addr);
+       errorBelch("Try specifying an address with +RTS -xm<addr> -RTS");
+       stg_exit(EXIT_FAILURE);
+   }
+   
+#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;
+       } else {
+           if ((W_)result > 0x80000000) {
+               // oops, we were given memory over 2Gb
+#if defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS)
+               // Some platforms require MAP_FIXED.  This is normally
+               // a bad idea, because MAP_FIXED will overwrite
+               // existing mappings.
+               munmap(result,size);
+               fixed = MAP_FIXED;
+               goto mmap_again;
+#else
+               barf("loadObj: failed to mmap() memory below 2Gb; asked for %lu bytes at %p.  Try specifying an address with +RTS -xm<addr> -RTS", size, map_addr, result);
+#endif
+           } else {
+               // hmm, we were given memory somewhere else, but it's
+               // still under 2Gb so we can use it.  Next time, ask
+               // for memory right after the place we just got some
+               mmap_32bit_base = (StgWord8*)result + size;
+           }
+       }
+   } else {
+       if ((W_)result > 0x80000000) {
+           // oops, we were given memory over 2Gb
+           // ... try allocating memory somewhere else?;
+           debugTrace(DEBUG_linker,"MAP_32BIT didn't work; gave us %lu bytes at 0x%p", bytes, result);
+           munmap(result, size);
+           
+           // Set a base address and try again... (guess: 1Gb)
+           mmap_32bit_base = (void*)0x40000000;
+           goto mmap_again;
+       }
+   }
+#endif
+
+   return result;
+}
+#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;
+}
+
+#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) {
+           char *archiveMemberName;
+
+           /* 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);
+
+           archiveMemberName = stgMallocBytes(strlen(path) + fileNameSize + 3, "loadArchive(file)");
+           sprintf(archiveMemberName, "%s(%.*s)", path, (int)fileNameSize, file);
+
+           oc = mkOc(path, image, imageSize, archiveMemberName
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+                    , 0
+#endif
+#endif
+                    );
+
+           stgFree(archiveMemberName);
+
+           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
 
 /* -----------------------------------------------------------------------------
@@ -1262,14 +1833,17 @@ HsInt
 loadObj( char *path )
 {
    ObjectCode* oc;
+   char *image;
+   int fileSize;
    struct stat st;
-   int r, n;
+   int r;
 #ifdef USE_MMAP
-   int fd, pagesize;
-   void *map_addr = NULL;
+   int fd;
 #else
    FILE *f;
 #endif
+   IF_DEBUG(linker, debugBelch("loadObj %s\n", path));
+
    initLinker();
 
    /* debugBelch("loadObj %s\n", path ); */
@@ -1296,38 +1870,15 @@ 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
-#define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
-
    /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
 
 #if defined(openbsd_HOST_OS)
@@ -1338,47 +1889,11 @@ loadObj( char *path )
    if (fd == -1)
       barf("loadObj: can't open `%s'", path);
 
-   pagesize = getpagesize();
-
-#ifdef ia64_HOST_ARCH
-   /* The PLT needs to be right before the object */
-   n = ROUND_UP(PLTSize(), pagesize);
-   oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
-   if (oc->plt == MAP_FAILED)
-      barf("loadObj: can't allocate PLT");
-
-   oc->pltIndex = 0;
-   map_addr = oc->plt + n;
-#endif
-
-   n = ROUND_UP(oc->fileSize, pagesize);
-
-   /* Link objects into the lower 2Gb on x86_64.  GHC assumes the
-    * small memory model on this architecture (see gcc docs,
-    * -mcmodel=small).
-    *
-    * MAP_32BIT not available on OpenBSD/amd64
-    */
-#if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT)
-#define EXTRA_MAP_FLAGS MAP_32BIT
-#else
-#define EXTRA_MAP_FLAGS 0
-#endif
-
-   /* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */
-#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
-#define MAP_ANONYMOUS MAP_ANON
-#endif
-
-   oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE,
-		    MAP_PRIVATE|EXTRA_MAP_FLAGS, fd, 0);
-   if (oc->image == MAP_FAILED)
-      barf("loadObj: can't map `%s'", path);
+   image = mmapForLinker(fileSize, 0, fd);
 
    close(fd);
 
 #else /* !USE_MMAP */
-
    /* load the image into memory */
    f = fopen(path, "rb");
    if (!f)
@@ -1387,7 +1902,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
@@ -1397,28 +1912,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
 
-   n = fread ( oc->image, 1, oc->fileSize, f );
-   if (n != oc->fileSize)
-      barf("loadObj: error whilst reading `%s'", path);
-
+   {
+       int n;
+       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 */
@@ -1431,7 +1971,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)
@@ -1443,10 +1986,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;
 }
@@ -1462,6 +2009,7 @@ resolveObjs( void )
     ObjectCode *oc;
     int r;
 
+    IF_DEBUG(linker, debugBelch("resolveObjs: start\n"));
     initLinker();
 
     for (oc = objects; oc; oc = oc->next) {
@@ -1479,6 +2027,7 @@ resolveObjs( void )
 	    oc->status = OBJECT_RESOLVED;
 	}
     }
+    IF_DEBUG(linker, debugBelch("resolveObjs: done\n"));
     return 1;
 }
 
@@ -1489,6 +2038,7 @@ HsInt
 unloadObj( char *path )
 {
     ObjectCode *oc, *prev;
+    HsBool unloadedAnyObj = HS_BOOL_FALSE;
 
     ASSERT(symhash != NULL);
     ASSERT(objects != NULL);
@@ -1528,12 +2078,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;
+    }
 }
 
 /* -----------------------------------------------------------------------------
@@ -1545,7 +2103,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;
@@ -1645,21 +2203,8 @@ static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
      */
     if( m > n ) // we need to allocate more pages
     {
-        oc->symbol_extras = mmap (NULL, sizeof(SymbolExtra) * count,
-                                  PROT_EXEC|PROT_READ|PROT_WRITE,
-                                  MAP_PRIVATE|MAP_ANONYMOUS|EXTRA_MAP_FLAGS,
-                                  0, 0);
-        if (oc->symbol_extras == MAP_FAILED)
-        {
-            errorBelch( "Unable to mmap() for jump islands\n" );
-            return 0;
-        }
-#ifdef x86_64_HOST_ARCH
-        if ((StgWord)oc->symbol_extras > 0x80000000)
-        {
-            barf("mmap() returned memory outside 2Gb");
-        }
-#endif
+        oc->symbol_extras = mmapForLinker(sizeof(SymbolExtra) * count, 
+                                          MAP_ANONYMOUS, -1);
     }
     else
     {
@@ -1729,7 +2274,7 @@ static SymbolExtra* makeSymbolExtra( ObjectCode* oc,
  * PowerPC specifics (instruction cache flushing)
  * ------------------------------------------------------------------------*/
 
-#ifdef powerpc_TARGET_ARCH
+#ifdef powerpc_HOST_ARCH
 /*
    ocFlushInstructionCache
 
@@ -1930,7 +2475,7 @@ copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
 {
    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
       UInt32 strtab_offset = * (UInt32*)(name+4);
-      strncpy ( dst, strtab+strtab_offset, dstSize );
+      strncpy ( (char*)dst, (char*)strtab+strtab_offset, dstSize );
       dst[dstSize-1] = 0;
    } else {
       int i = 0;
@@ -1961,19 +2506,46 @@ 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);
-   strncpy(newstr,name,8);
+   strncpy((char*)newstr,(char*)name,8);
    newstr[8] = 0;
    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 *
-findPEi386SectionCalled ( ObjectCode* oc,  char* name )
+findPEi386SectionCalled ( ObjectCode* oc,  UChar* name )
 {
    int i;
    COFF_header* hdr
@@ -2016,6 +2588,36 @@ zapTrailingAtSign ( UChar* sym )
 #  undef my_isdigit
 }
 
+static void *
+lookupSymbolInDLLs ( UChar *lbl )
+{
+    OpenedDLL* o_dll;
+    void *sym;
+
+    for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
+        /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
+
+        if (lbl[0] == '_') {
+            /* HACK: if the name has an initial underscore, try stripping
+               it off & look that up first. I've yet to verify whether there's
+               a Rule that governs whether an initial '_' *should always* be
+               stripped off when mapping from import lib name to the DLL name.
+            */
+            sym = GetProcAddress(o_dll->instance, (char*)(lbl+1));
+            if (sym != NULL) {
+		/*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
+		return sym;
+            }
+        }
+        sym = GetProcAddress(o_dll->instance, (char*)lbl);
+        if (sym != NULL) {
+            /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
+            return sym;
+	   }
+    }
+    return NULL;
+}
+
 
 static int
 ocVerifyImage_PEi386 ( ObjectCode* oc )
@@ -2238,7 +2840,16 @@ ocGetNames_PEi386 ( ObjectCode* oc )
       COFF_section* sectab_i
          = (COFF_section*)
            myindex ( sizeof_COFF_section, sectab, i );
-      if (0 != strcmp(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,
@@ -2279,7 +2890,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
@@ -2291,12 +2905,12 @@ ocGetNames_PEi386 ( ObjectCode* oc )
          kind = SECTIONKIND_CODE_OR_RODATA;
 #     endif
 
-      if (0==strcmp(".text",sectab_i->Name) ||
-          0==strcmp(".rdata",sectab_i->Name)||
-          0==strcmp(".rodata",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",sectab_i->Name) ||
-          0==strcmp(".bss",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);
@@ -2309,16 +2923,18 @@ ocGetNames_PEi386 ( ObjectCode* oc )
       if (kind == SECTIONKIND_OTHER
           /* Ignore sections called which contain stabs debugging
              information. */
-          && 0 != strcmp(".stab", sectab_i->Name)
-          && 0 != strcmp(".stabstr", sectab_i->Name)
+          && 0 != strcmp(".stab", (char*)secname)
+          && 0 != strcmp(".stabstr", (char*)secname)
           /* ignore constructor section for now */
-          && 0 != strcmp(".ctors", sectab_i->Name)
+          && 0 != strcmp(".ctors", (char*)secname)
           /* ignore section generated from .ident */
-          && 0!= strcmp("/4", sectab_i->Name)
+          && 0!= strncmp(".debug", (char*)secname, 6)
 	  /* ignore unknown section that appeared in gcc 3.4.5(?) */
-          && 0!= strcmp(".reloc", 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;
       }
 
@@ -2326,6 +2942,8 @@ ocGetNames_PEi386 ( ObjectCode* oc )
          addSection(oc, kind, start, end);
          addProddableBlock(oc, start, end - start + 1);
       }
+
+      stgFree(secname);
    }
 
    /* Copy exported symbols into the ObjectCode. */
@@ -2381,8 +2999,8 @@ ocGetNames_PEi386 ( ObjectCode* oc )
          IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
          ASSERT(i >= 0 && i < oc->n_symbols);
          /* cstring_from_COFF_symbol_name always succeeds. */
-         oc->symbols[i] = sname;
-         ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
+         oc->symbols[i] = (char*)sname;
+         ghciInsertStrHashTable(oc->fileName, symhash, (char*)sname, addr);
       } else {
 #        if 0
          debugBelch(
@@ -2432,7 +3050,7 @@ ocResolve_PEi386 ( ObjectCode* oc )
 
    /* ToDo: should be variable-sized?  But is at least safe in the
       sense of buffer-overrun-proof. */
-   char symbol[1000];
+   UChar symbol[1000];
    /* debugBelch("resolving for %s\n", oc->fileName); */
 
    hdr = (COFF_header*)(oc->image);
@@ -2457,12 +3075,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", sectab_i->Name)
-          || 0 == strcmp(".stabstr", sectab_i->Name)
-          || 0 == strcmp(".ctors", 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
@@ -2534,10 +3160,9 @@ ocResolve_PEi386 ( ObjectCode* oc )
                    + sym->Value);
          } else {
             copyName ( sym->Name, strtab, symbol, 1000-1 );
-            S = (UInt32) lookupSymbol( symbol );
+            S = (UInt32) lookupSymbol( (char*)symbol );
             if ((void*)S != NULL) goto foundit;
-	    /* Newline first because the interactive linker has printed "linking..." */
-            errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
+            errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
             return 0;
            foundit:;
          }
@@ -2606,12 +3231,6 @@ ocResolve_PEi386 ( ObjectCode* oc )
 #elif defined(x86_64_HOST_ARCH)
 #  define ELF_TARGET_X64_64
 #  define ELF_64BIT
-#elif defined (ia64_HOST_ARCH)
-#  define ELF_TARGET_IA64   /* Used inside <elf.h> */
-#  define ELF_64BIT
-#  define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
-#  define ELF_NEED_GOT      /* needs Global Offset Table */
-#  define ELF_NEED_PLT      /* needs Procedure Linkage Tables */
 #endif
 
 #if !defined(openbsd_HOST_OS)
@@ -2644,10 +3263,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
@@ -2741,30 +3368,6 @@ copyFunctionDesc(Elf_Addr target)
 #endif
 
 #ifdef ELF_NEED_PLT
-#ifdef ia64_HOST_ARCH
-static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
-static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
-
-static unsigned char plt_code[] =
-{
-   /* taken from binutils bfd/elfxx-ia64.c */
-   0x0b, 0x78, 0x00, 0x02, 0x00, 0x24,  /*   [MMI]       addl r15=0,r1;;    */
-   0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0,  /*               ld8 r16=[r15],8    */
-   0x01, 0x08, 0x00, 0x84,              /*               mov r14=r1;;       */
-   0x11, 0x08, 0x00, 0x1e, 0x18, 0x10,  /*   [MIB]       ld8 r1=[r15]       */
-   0x60, 0x80, 0x04, 0x80, 0x03, 0x00,  /*               mov b6=r16         */
-   0x60, 0x00, 0x80, 0x00               /*               br.few b6;;        */
-};
-
-/* If we can't get to the function descriptor via gp, take a local copy of it */
-#define PLT_RELOC(code, target) { \
-   Elf64_Sxword rel_value = target - gp_val; \
-   if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
-      ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
-   else \
-      ia64_reloc_gprel22((Elf_Addr)code, target); \
-   }
-#endif
 
 typedef struct {
    unsigned char code[sizeof(plt_code)];
@@ -2822,25 +3425,6 @@ findElfSection ( void* objImage, Elf_Word sh_type )
    return ptr;
 }
 
-#if defined(ia64_HOST_ARCH)
-static Elf_Addr
-findElfSegment ( void* objImage, Elf_Addr vaddr )
-{
-   char* ehdrC = (char*)objImage;
-   Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
-   Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
-   Elf_Addr segaddr = 0;
-   int i;
-
-   for (i = 0; i < ehdr->e_phnum; i++) {
-      segaddr = phdr[i].p_vaddr;
-      if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
-	      break;
-   }
-   return segaddr;
-}
-#endif
-
 static int
 ocVerifyImage_ELF ( ObjectCode* oc )
 {
@@ -3334,9 +3918,6 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
 #     if defined(sparc_HOST_ARCH)
       Elf_Word* pP = (Elf_Word*)P;
       Elf_Word  w1, w2;
-#     elif defined(ia64_HOST_ARCH)
-      Elf64_Xword *pP = (Elf64_Xword *)P;
-      Elf_Addr addr;
 #     elif defined(powerpc_HOST_ARCH)
       Elf_Sword delta;
 #     endif
@@ -3413,49 +3994,30 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
             w1 |= w2;
             *pP = w1;
             break;
+
          /* According to the Sun documentation:
             R_SPARC_UA32
             This relocation type resembles R_SPARC_32, except it refers to an
             unaligned word. That is, the word to be relocated must be treated
             as four separate bytes with arbitrary alignment, not as a word
             aligned according to the architecture requirements.
-
-            (JRS: which means that freeloading on the R_SPARC_32 case
-            is probably wrong, but hey ...)
          */
          case R_SPARC_UA32:
+            w2	= (Elf_Word)value;
+
+            // SPARC doesn't do misaligned writes of 32 bit words,
+	    //       so we have to do this one byte-at-a-time.
+	    char *pPc 	= (char*)pP;
+	    pPc[0]	= (char) ((Elf_Word)(w2 & 0xff000000) >> 24);
+	    pPc[1]	= (char) ((Elf_Word)(w2 & 0x00ff0000) >> 16);
+	    pPc[2]	= (char) ((Elf_Word)(w2 & 0x0000ff00) >> 8);
+	    pPc[3]	= (char) ((Elf_Word)(w2 & 0x000000ff));
+	    break;
+
          case R_SPARC_32:
             w2 = (Elf_Word)value;
             *pP = w2;
             break;
-#        elif defined(ia64_HOST_ARCH)
-	 case R_IA64_DIR64LSB:
-	 case R_IA64_FPTR64LSB:
-	    *pP = value;
-	    break;
-	 case R_IA64_PCREL64LSB:
-	    *pP = value - P;
-	    break;
-	 case R_IA64_SEGREL64LSB:
-	    addr = findElfSegment(ehdrC, value);
-	    *pP = value - addr;
-	    break;
-	 case R_IA64_GPREL22:
-	    ia64_reloc_gprel22(P, value);
-	    break;
-	 case R_IA64_LTOFF22:
-	 case R_IA64_LTOFF22X:
-	 case R_IA64_LTOFF_FPTR22:
-	    addr = allocateGOTEntry(value);
-	    ia64_reloc_gprel22(P, addr);
-	    break;
-	 case R_IA64_PCREL21B:
-	    ia64_reloc_pcrel21(P, S, oc);
-	    break;
-	 case R_IA64_LDXMOV:
-	    /* This goes with R_IA64_LTOFF22X and points to the load to
-	     * convert into a move.  We don't implement relaxation. */
-	    break;
 #        elif defined(powerpc_HOST_ARCH)
          case R_PPC_ADDR16_LO:
             *(Elf32_Half*) P = value;
@@ -3506,6 +4068,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
@@ -3518,6 +4083,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
 #endif
           }
 	  *(Elf64_Word *)P = (Elf64_Word)off;
+#endif
 	  break;
       }
 
@@ -3529,6 +4095,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)
@@ -3540,9 +4109,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)
@@ -3554,6 +4127,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
 #endif
 	  }
 	  *(Elf64_Sword *)P = (Elf64_Sword)value;
+#endif
 	  break;
 	  
       case R_X86_64_GOTPCREL:
@@ -3566,6 +4140,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)
@@ -3573,6 +4150,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
               off = pltAddress + A - P;
 	  }
 	  *(Elf64_Word *)P = (Elf64_Word)off;
+#endif
 	  break;
       }
 #endif
@@ -3631,98 +4209,6 @@ ocResolve_ELF ( ObjectCode* oc )
 }
 
 /*
- * IA64 specifics
- * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
- * at the front.  The following utility functions pack and unpack instructions, and
- * take care of the most common relocations.
- */
-
-#ifdef ia64_HOST_ARCH
-
-static Elf64_Xword
-ia64_extract_instruction(Elf64_Xword *target)
-{
-   Elf64_Xword w1, w2;
-   int slot = (Elf_Addr)target & 3;
-   target = (Elf_Addr)target & ~3;
-
-   w1 = *target;
-   w2 = *(target+1);
-
-   switch (slot)
-   {
-      case 0:
-         return ((w1 >> 5) & 0x1ffffffffff);
-      case 1:
-         return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
-      case 2:
-         return (w2 >> 23);
-      default:
-         barf("ia64_extract_instruction: invalid slot %p", target);
-   }
-}
-
-static void
-ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
-{
-   int slot = (Elf_Addr)target & 3;
-   target = (Elf_Addr)target & ~3;
-
-   switch (slot)
-   {
-      case 0:
-         *target |= value << 5;
-         break;
-      case 1:
-         *target |= value << 46;
-         *(target+1) |= value >> 18;
-         break;
-      case 2:
-         *(target+1) |= value << 23;
-         break;
-   }
-}
-
-static void
-ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
-{
-   Elf64_Xword instruction;
-   Elf64_Sxword rel_value;
-
-   rel_value = value - gp_val;
-   if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
-      barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
-
-   instruction = ia64_extract_instruction((Elf64_Xword *)target);
-   instruction |= (((rel_value >> 0) & 0x07f) << 13)		/* imm7b */
-		    | (((rel_value >> 7) & 0x1ff) << 27)	/* imm9d */
-		    | (((rel_value >> 16) & 0x01f) << 22)	/* imm5c */
-		    | ((Elf64_Xword)(rel_value < 0) << 36);	/* s */
-   ia64_deposit_instruction((Elf64_Xword *)target, instruction);
-}
-
-static void
-ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
-{
-   Elf64_Xword instruction;
-   Elf64_Sxword rel_value;
-   Elf_Addr entry;
-
-   entry = allocatePLTEntry(value, oc);
-
-   rel_value = (entry >> 4) - (target >> 4);
-   if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
-      barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
-
-   instruction = ia64_extract_instruction((Elf64_Xword *)target);
-   instruction |= ((rel_value & 0xfffff) << 13) 		/* imm20b */
-	    	    | ((Elf64_Xword)(rel_value < 0) << 36);	/* s */
-   ia64_deposit_instruction((Elf64_Xword *)target, instruction);
-}
-
-#endif /* ia64 */
-
-/*
  * PowerPC & X86_64 ELF specifics
  */
 
@@ -3859,12 +4345,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;
@@ -3881,6 +4373,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"))
@@ -3898,12 +4392,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;
@@ -3926,6 +4424,7 @@ static int resolveImports(
         }
     }
 
+    IF_DEBUG(linker, debugBelch("resolveImports: done\n"));
     return 1;
 }
 
@@ -3936,9 +4435,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
@@ -3957,7 +4458,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;
@@ -3969,6 +4472,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++)
@@ -3978,7 +4483,9 @@ static int relocateSection(
         
         char    *thingPtr = image + sect->offset + reloc->r_address;
         uint64_t thing;
-        uint64_t value;
+        /* We shouldn't need to initialise this, but gcc on OS X 64 bit
+           complains that it may be used uninitialized if we don't */
+        uint64_t value = 0;
         uint64_t baseValue;
         int type = reloc->r_type;
         
@@ -4004,12 +4511,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;
         }
@@ -4017,11 +4532,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
         {
@@ -4029,8 +4554,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))
             {
@@ -4049,6 +4576,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;
@@ -4112,9 +4642,11 @@ 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)
+                    else if(scat->r_type == GENERIC_RELOC_SECTDIFF
+                        || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
 #endif
 		    {
 		        struct scattered_relocation_info *pair =
@@ -4170,14 +4702,24 @@ static int relocateSection(
                     }
  #endif
                     else
-		        continue;  // ignore the others
+                    {
+		        barf ("Don't know how to handle this Mach-O "
+		              "scattered relocation entry: "
+                              "object file %s; entry type %ld; "
+                              "address %#lx\n", 
+                              OC_INFORMATIVE_FILENAME(oc),
+                              scat->r_type,
+                              scat->r_address);
+                        return 0;
+                     }
 
 #ifdef powerpc_HOST_ARCH
                     if(scat->r_type == GENERIC_RELOC_VANILLA
                         || scat->r_type == PPC_RELOC_SECTDIFF)
 #else
                     if(scat->r_type == GENERIC_RELOC_VANILLA
-                        || scat->r_type == GENERIC_RELOC_SECTDIFF)
+                        || scat->r_type == GENERIC_RELOC_SECTDIFF
+                        || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
 #endif
                     {
                         *wordPtr = word;
@@ -4198,11 +4740,32 @@ static int relocateSection(
                     }
 #endif
 		}
+		else
+		{
+            	    barf("Can't handle Mach-O scattered relocation entry "
+            	         "with this r_length tag: "
+                         "object file %s; entry type %ld; "
+                         "r_length tag %ld; address %#lx\n", 
+                         OC_INFORMATIVE_FILENAME(oc),
+                         scat->r_type,
+                         scat->r_length,
+                         scat->r_address);
+                    return 0;
+		}
+	    }
+	    else /* scat->r_pcrel */
+	    {
+	        barf("Don't know how to handle *PC-relative* Mach-O "
+	             "scattered relocation entry: "
+                     "object file %s; entry type %ld; address %#lx\n", 
+                     OC_INFORMATIVE_FILENAME(oc),
+                     scat->r_type,
+                     scat->r_address);
+               return 0;
 	    }
 
-	    continue; // FIXME: I hope it's OK to ignore all the others.
 	}
-	else
+	else /* !(relocs[i].r_address & R_SCATTERED) */
 	{
 	    struct relocation_info *reloc = &relocs[i];
 	    if(reloc->r_pcrel && !reloc->r_extern)
@@ -4247,6 +4810,16 @@ static int relocateSection(
 		    word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
 		}
 #endif
+                else
+                {
+                    barf("Can't handle this Mach-O relocation entry "
+		         "(not scattered): "
+                         "object file %s; entry type %ld; address %#lx\n",
+                         OC_INFORMATIVE_FILENAME(oc),
+                         reloc->r_type,
+                         reloc->r_address);
+                    return 0;
+                }
 
 		if(!reloc->r_extern)
 		{
@@ -4318,31 +4891,54 @@ 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;
 		}
 #endif
             }
-	    barf("\nunknown relocation %d",reloc->r_type);
-	    return 0;
+            else
+            {
+ 	         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_INFORMATIVE_FILENAME(oc),
+                      reloc->r_type,
+                      reloc->r_length,
+                      reloc->r_address);
+	         return 0;
+	    }
 	}
 #endif
     }
+    IF_DEBUG(linker, debugBelch("relocateSection: done\n"));
     return 1;
 }
 
@@ -4360,6 +4956,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)
@@ -4378,7 +4976,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)
@@ -4431,6 +5030,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)");
 
@@ -4445,10 +5045,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
@@ -4475,6 +5078,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;
@@ -4498,7 +5102,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;
@@ -4518,7 +5123,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")
@@ -4538,12 +5144,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;
     }
 
@@ -4564,13 +5176,14 @@ static int ocResolve_MachO(ObjectCode* oc)
  * Yuck.
  */
 
+extern void* symbolsWithoutUnderscore[];
+
 static void machoInitSymbolsWithoutUnderscore()
 {
-    extern void* symbolsWithoutUnderscore[];
     void **p = symbolsWithoutUnderscore;
     __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
 
-#undef Sym
+#undef SymI_NeedsProto
 #define SymI_NeedsProto(x)  \
     __asm__ volatile(".long " # x);
 
@@ -4578,16 +5191,17 @@ static void machoInitSymbolsWithoutUnderscore()
 
     __asm__ volatile(".text");
     
-#undef Sym
+#undef SymI_NeedsProto
 #define SymI_NeedsProto(x)  \
     ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
     
     RTS_MACHO_NOUNDERLINE_SYMBOLS
     
-#undef Sym
+#undef SymI_NeedsProto
 }
 #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
@@ -4600,12 +5214,18 @@ static int machoGetMisalignment( FILE * f )
     fread(&header, sizeof(header), 1, f);
     rewind(f);
 
-#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("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))
@@ -4613,6 +5233,6 @@ static int machoGetMisalignment( FILE * f )
 
     return misalignment ? (16 - misalignment) : 0;
 }
-
 #endif
 
+#endif