[project @ 2003-05-30 09:06:24 by simonmar]
[ghc-hetmet.git] / ghc / rts / Linker.c
index 532765d..7d9a550 100644 (file)
@@ -1,7 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.95 2002/06/12 22:29:43 wolfgang Exp $
+ * $Id: Linker.c,v 1.120 2003/05/30 09:06:24 simonmar Exp $
  *
- * (c) The GHC Team, 2000, 2001
+ * (c) The GHC Team, 2000-2003
  *
  * RTS Object Linker
  *
 #include <sys/types.h>
 #endif
 
+#include <stdlib.h>
+#include <string.h>
+
 #ifdef HAVE_SYS_STAT_H
 #include <sys/stat.h>
 #endif
 
-#ifdef HAVE_DLFCN_H
+#if defined(HAVE_FRAMEWORK_HASKELLSUPPORT)
+#include <HaskellSupport/dlfcn.h>
+#elif defined(HAVE_DLFCN_H)
 #include <dlfcn.h>
 #endif
 
 #include <sys/mman.h>
 #endif
 
-#if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS)
+#if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS) || defined(netbsd_TARGET_OS)
 #  define OBJFORMAT_ELF
 #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
 #  define OBJFORMAT_PEi386
 #  include <windows.h>
+#  include <math.h>
 #elif defined(darwin_TARGET_OS)
+#  include <mach-o/ppc/reloc.h>
 #  define OBJFORMAT_MACHO
 #  include <mach-o/loader.h>
 #  include <mach-o/nlist.h>
 #endif
 
 /* Hash table mapping symbol names to Symbol */
-/*Str*/HashTable *symhash;
+static /*Str*/HashTable *symhash;
+
+/* List of currently loaded objects */
+ObjectCode *objects = NULL;    /* initially empty */
 
 #if defined(OBJFORMAT_ELF)
 static int ocVerifyImage_ELF    ( ObjectCode* oc );
@@ -81,6 +91,8 @@ static int ocResolve_PEi386     ( ObjectCode* oc );
 static int ocVerifyImage_MachO    ( ObjectCode* oc );
 static int ocGetNames_MachO       ( ObjectCode* oc );
 static int ocResolve_MachO        ( ObjectCode* oc );
+
+static void machoInitSymbolsWithoutUnderscore( void );
 #endif
 
 /* -----------------------------------------------------------------------------
@@ -193,11 +205,7 @@ typedef struct _RtsSymbolVal {
       SymX(uname)                               \
       SymX(unlink)                              \
       SymX(utime)                               \
-      SymX(waitpid)                             \
-      Sym(__divdi3)                             \
-      Sym(__udivdi3)                            \
-      Sym(__moddi3)                             \
-      Sym(__umoddi3)
+      SymX(waitpid)
 
 #elif !defined(mingw32_TARGET_OS)
 #define RTS_MINGW_ONLY_SYMBOLS /**/
@@ -206,10 +214,20 @@ 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                    \
+      Sym(_imp____mb_cur_max)                   \
+      Sym(_imp___pctype)            
+#else
+#define RTS_MINGW_EXTRA_SYMS
+#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                  \
-      SymX(memset)                              \
+      SymX(asyncReadzh_fast)                   \
+      SymX(asyncWritezh_fast)                  \
       SymX(memset)                              \
       SymX(inet_ntoa)                           \
       SymX(inet_addr)                           \
@@ -269,39 +287,8 @@ typedef struct _RtsSymbolVal {
       Sym(opendir)                              \
       Sym(readdir)                              \
       Sym(rewinddir)                            \
-      Sym(closedir)                             \
-      Sym(__divdi3)                             \
-      Sym(__udivdi3)                            \
-      Sym(__moddi3)                             \
-      Sym(__umoddi3)
-#endif
-
-#ifdef darwin_TARGET_OS
-#define RTS_DARWIN_ONLY_SYMBOLS                 \
-      Sym(__divdi3)                             \
-      Sym(__udivdi3)                            \
-      Sym(__moddi3)                             \
-      Sym(__umoddi3)                                                   \
-         Sym(__ashldi3)                                                        \
-         Sym(__ashrdi3)                                                        \
-         Sym(__lshrdi3)                                                        \
-         SymX(stg_gc_enter_2)                                          \
-         SymX(stg_gc_enter_3)                                          \
-         SymX(stg_gc_enter_4)                                          \
-         SymX(stg_gc_enter_5)                                          \
-         SymX(stg_gc_enter_6)                                          \
-         SymX(stg_gc_enter_7)                                          \
-         SymX(stg_gc_enter_8)                                          \
-         SymX(stg_chk_2)                                                       \
-         SymX(stg_chk_3)                                                       \
-         SymX(stg_chk_4)                                                       \
-         SymX(stg_chk_5)                                                       \
-         SymX(stg_chk_6)                                                       \
-         SymX(stg_chk_7)                                                       \
-         SymX(stg_chk_8)                                                       \
-
-#else
-#define RTS_DARWIN_ONLY_SYMBOLS
+      RTS_MINGW_EXTRA_SYMS                      \
+      Sym(closedir)
 #endif
 
 #ifndef SMP
@@ -314,41 +301,40 @@ typedef struct _RtsSymbolVal {
       Maybe_ForeignObj                         \
       Maybe_Stable_Names                       \
       Sym(StgReturn)                           \
-      Sym(__stginit_GHCziPrim)                 \
-      Sym(init_stack)                          \
-      SymX(__stg_chk_0)                                \
-      SymX(__stg_chk_1)                                \
-      SymX(stg_chk_2)                          \
-      SymX(stg_chk_3)                          \
-      SymX(stg_chk_4)                          \
-      SymX(stg_chk_5)                          \
-      SymX(stg_chk_6)                          \
-      SymX(stg_chk_7)                          \
-      SymX(stg_chk_8)                          \
-      Sym(stg_enterStackTop)                   \
-      SymX(stg_gc_d1)                          \
-      SymX(stg_gc_l1)                          \
+      SymX(stg_enter_info)                     \
+      SymX(stg_enter_ret)                      \
+      SymX(stg_gc_void_info)                   \
       SymX(__stg_gc_enter_1)                   \
-      SymX(stg_gc_enter_2)                     \
-      SymX(stg_gc_enter_3)                     \
-      SymX(stg_gc_enter_4)                     \
-      SymX(stg_gc_enter_5)                     \
-      SymX(stg_gc_enter_6)                     \
-      SymX(stg_gc_enter_7)                     \
-      SymX(stg_gc_enter_8)                     \
-      SymX(stg_gc_f1)                          \
       SymX(stg_gc_noregs)                      \
-      SymX(stg_gc_seq_1)                       \
-      SymX(stg_gc_unbx_r1)                     \
+      SymX(stg_gc_unpt_r1_info)                        \
       SymX(stg_gc_unpt_r1)                     \
-      SymX(stg_gc_ut_0_1)                      \
-      SymX(stg_gc_ut_1_0)                      \
-      SymX(stg_gen_chk)                                \
+      SymX(stg_gc_unbx_r1_info)                        \
+      SymX(stg_gc_unbx_r1)                     \
+      SymX(stg_gc_f1_info)                     \
+      SymX(stg_gc_f1)                          \
+      SymX(stg_gc_d1_info)                     \
+      SymX(stg_gc_d1)                          \
+      SymX(stg_gc_l1_info)                     \
+      SymX(stg_gc_l1)                          \
+      SymX(__stg_gc_fun)                       \
+      SymX(stg_gc_fun_info)                    \
+      SymX(stg_gc_fun_ret)                     \
+      SymX(stg_gc_gen)                         \
+      SymX(stg_gc_gen_info)                    \
+      SymX(stg_gc_gen_hp)                      \
+      SymX(stg_gc_ut)                          \
+      SymX(stg_gen_yield)                      \
+      SymX(stg_yield_noregs)                   \
       SymX(stg_yield_to_interpreter)           \
+      SymX(stg_gen_block)                      \
+      SymX(stg_block_noregs)                   \
+      SymX(stg_block_1)                                \
+      SymX(stg_block_takemvar)                 \
+      SymX(stg_block_putmvar)                  \
+      SymX(stg_seq_frame_info)                 \
       SymX(ErrorHdrHook)                       \
       MAIN_CAP_SYM                              \
       SymX(MallocFailHook)                     \
-      SymX(NoRunnableThreadsHook)              \
       SymX(OnExitHook)                         \
       SymX(OutOfHeapHook)                      \
       SymX(PatErrorHdrHook)                    \
@@ -411,9 +397,10 @@ typedef struct _RtsSymbolVal {
       SymX(newArrayzh_fast)                    \
       SymX(newBCOzh_fast)                      \
       SymX(newByteArrayzh_fast)                        \
-      SymX(newCAF)                             \
+      SymX_redirect(newCAF, newDynCAF)         \
       SymX(newMVarzh_fast)                     \
       SymX(newMutVarzh_fast)                   \
+      SymX(atomicModifyMutVarzh_fast)          \
       SymX(newPinnedByteArrayzh_fast)          \
       SymX(orIntegerzh_fast)                   \
       SymX(performGC)                          \
@@ -433,7 +420,6 @@ typedef struct _RtsSymbolVal {
       SymX(rts_evalIO)                         \
       SymX(rts_evalLazyIO)                     \
       SymX(rts_eval_)                          \
-      SymX(rts_getAddr)                                \
       SymX(rts_getBool)                                \
       SymX(rts_getChar)                                \
       SymX(rts_getDouble)                      \
@@ -441,11 +427,12 @@ typedef struct _RtsSymbolVal {
       SymX(rts_getInt)                         \
       SymX(rts_getInt32)                       \
       SymX(rts_getPtr)                         \
+      SymX(rts_getFunPtr)                      \
       SymX(rts_getStablePtr)                   \
       SymX(rts_getThreadId)                    \
       SymX(rts_getWord)                                \
       SymX(rts_getWord32)                      \
-      SymX(rts_mkAddr)                         \
+      SymX(rts_lock)                           \
       SymX(rts_mkBool)                         \
       SymX(rts_mkChar)                         \
       SymX(rts_mkDouble)                       \
@@ -456,6 +443,7 @@ typedef struct _RtsSymbolVal {
       SymX(rts_mkInt64)                                \
       SymX(rts_mkInt8)                         \
       SymX(rts_mkPtr)                          \
+      SymX(rts_mkFunPtr)                       \
       SymX(rts_mkStablePtr)                    \
       SymX(rts_mkString)                       \
       SymX(rts_mkWord)                         \
@@ -463,8 +451,11 @@ typedef struct _RtsSymbolVal {
       SymX(rts_mkWord32)                       \
       SymX(rts_mkWord64)                       \
       SymX(rts_mkWord8)                                \
+      SymX(rts_unlock)                         \
       SymX(run_queue_hd)                       \
       SymX(setProgArgv)                                \
+      SymX(startupHaskell)                     \
+      SymX(shutdownHaskell)                    \
       SymX(shutdownHaskellAndExit)             \
       SymX(stable_ptr_table)                   \
       SymX(stackOverflow)                      \
@@ -475,6 +466,35 @@ typedef struct _RtsSymbolVal {
       SymX(stg_INTLIKE_closure)                        \
       SymX(stg_MUT_ARR_PTRS_FROZEN_info)       \
       SymX(stg_WEAK_info)                       \
+      SymX(stg_ap_v_info)                      \
+      SymX(stg_ap_f_info)                      \
+      SymX(stg_ap_d_info)                      \
+      SymX(stg_ap_l_info)                      \
+      SymX(stg_ap_n_info)                      \
+      SymX(stg_ap_p_info)                      \
+      SymX(stg_ap_pv_info)                     \
+      SymX(stg_ap_pp_info)                     \
+      SymX(stg_ap_ppv_info)                    \
+      SymX(stg_ap_ppp_info)                    \
+      SymX(stg_ap_pppp_info)                   \
+      SymX(stg_ap_ppppp_info)                  \
+      SymX(stg_ap_pppppp_info)                 \
+      SymX(stg_ap_ppppppp_info)                        \
+      SymX(stg_ap_0_ret)                       \
+      SymX(stg_ap_v_ret)                       \
+      SymX(stg_ap_f_ret)                       \
+      SymX(stg_ap_d_ret)                       \
+      SymX(stg_ap_l_ret)                       \
+      SymX(stg_ap_n_ret)                       \
+      SymX(stg_ap_p_ret)                       \
+      SymX(stg_ap_pv_ret)                      \
+      SymX(stg_ap_pp_ret)                      \
+      SymX(stg_ap_ppv_ret)                     \
+      SymX(stg_ap_ppp_ret)                     \
+      SymX(stg_ap_pppp_ret)                    \
+      SymX(stg_ap_ppppp_ret)                   \
+      SymX(stg_ap_pppppp_ret)                  \
+      SymX(stg_ap_ppppppp_ret)                 \
       SymX(stg_ap_1_upd_info)                  \
       SymX(stg_ap_2_upd_info)                  \
       SymX(stg_ap_3_upd_info)                  \
@@ -500,9 +520,7 @@ typedef struct _RtsSymbolVal {
       SymX(stg_sel_7_upd_info)                 \
       SymX(stg_sel_8_upd_info)                 \
       SymX(stg_sel_9_upd_info)                 \
-      SymX(stg_seq_frame_info)                 \
       SymX(stg_upd_frame_info)                 \
-      SymX(__stg_update_PAP)                   \
       SymX(suspendThread)                      \
       SymX(takeMVarzh_fast)                    \
       SymX(timesIntegerzh_fast)                        \
@@ -524,6 +542,21 @@ typedef struct _RtsSymbolVal {
 #define RTS_LONG_LONG_SYMS /* nothing */
 #endif
 
+// 64-bit support functions in libgcc.a
+#if defined(__GNUC__) && SIZEOF_VOID_P <= 4
+#define RTS_LIBGCC_SYMBOLS                     \
+      Sym(__divdi3)                             \
+      Sym(__udivdi3)                            \
+      Sym(__moddi3)                             \
+      Sym(__umoddi3)                           \
+      Sym(__ashldi3)                           \
+      Sym(__ashrdi3)                           \
+      Sym(__lshrdi3)                           \
+      Sym(__eprintf)
+#else
+#define RTS_LIBGCC_SYMBOLS
+#endif
+
 #ifdef ia64_TARGET_ARCH
 /* force these symbols to be present */
 #define RTS_EXTRA_SYMBOLS                      \
@@ -532,18 +565,29 @@ typedef struct _RtsSymbolVal {
 #define RTS_EXTRA_SYMBOLS /* nothing */
 #endif
 
+#ifdef darwin_TARGET_OS
+      // Symbols that don't have a leading underscore
+      // on Mac OS X. They have to receive special treatment,
+      // see machoInitSymbolsWithoutUnderscore()
+#define RTS_MACHO_NOUNDERLINE_SYMBOLS          \
+      Sym(saveFP)                              \
+      Sym(restFP)
+#endif
+
 /* entirely bogus claims about types of these symbols */
 #define Sym(vvv)  extern void (vvv);
 #define SymX(vvv) /**/
+#define SymX_redirect(vvv,xxx) /**/
 RTS_SYMBOLS
 RTS_LONG_LONG_SYMS
 RTS_EXTRA_SYMBOLS
 RTS_POSIX_ONLY_SYMBOLS
 RTS_MINGW_ONLY_SYMBOLS
 RTS_CYGWIN_ONLY_SYMBOLS
-RTS_DARWIN_ONLY_SYMBOLS
+RTS_LIBGCC_SYMBOLS
 #undef Sym
 #undef SymX
+#undef SymX_redirect
 
 #ifdef LEADING_UNDERSCORE
 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
@@ -555,6 +599,12 @@ RTS_DARWIN_ONLY_SYMBOLS
                     (void*)(&(vvv)) },
 #define SymX(vvv) Sym(vvv)
 
+// SymX_redirect allows us to redirect references to one symbol to
+// another symbol.  See newCAF/newDynCAF for an example.
+#define SymX_redirect(vvv,xxx) \
+    { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
+      (void*)(&(xxx)) },
+
 static RtsSymbolVal rtsSyms[] = {
       RTS_SYMBOLS
       RTS_LONG_LONG_SYMS
@@ -562,7 +612,7 @@ static RtsSymbolVal rtsSyms[] = {
       RTS_POSIX_ONLY_SYMBOLS
       RTS_MINGW_ONLY_SYMBOLS
       RTS_CYGWIN_ONLY_SYMBOLS
-         RTS_DARWIN_ONLY_SYMBOLS
+      RTS_LIBGCC_SYMBOLS
       { 0, 0 } /* sentinel */
 };
 
@@ -603,6 +653,10 @@ static void ghciInsertStrHashTable ( char* obj_name,
 /* -----------------------------------------------------------------------------
  * initialize the object linker
  */
+
+
+static int linker_init_done = 0 ;
+
 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
 static void *dl_prog_handle;
 #endif
@@ -612,6 +666,13 @@ initLinker( void )
 {
     RtsSymbolVal *sym;
 
+    /* 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;
+    }
+
     symhash = allocStrHashTable();
 
     /* populate the symbol table with stuff from the RTS */
@@ -619,12 +680,19 @@ initLinker( void )
        ghciInsertStrHashTable("(GHCi built-in symbols)",
                                symhash, sym->lbl, sym->addr);
     }
+#   if defined(OBJFORMAT_MACHO)
+    machoInitSymbolsWithoutUnderscore();
+#   endif
+
 #   if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
     dl_prog_handle = dlopen(NULL, RTLD_LAZY);
 #   endif
 }
 
 /* -----------------------------------------------------------------------------
+ *                  Loading DLL or .so dynamic libraries
+ * -----------------------------------------------------------------------------
+ *
  * Add a DLL from which symbols may be found.  In the ELF case, just
  * do RTLD_GLOBAL-style add, so no further messing around needs to
  * happen in order that symbols in the loaded .so are findable --
@@ -633,7 +701,12 @@ initLinker( void )
  *
  * In the PEi386 case, open the DLLs and put handles to them in a
  * linked list.  When looking for a symbol, try all handles in the
- * list.
+ * list.  This means that we need to load even DLLs that are guaranteed
+ * to be in the ghc.exe image already, just so we can get a handle
+ * to give to loadSymbol, so that we can find the symbols.  For such
+ * libraries, the LoadLibrary call should be a no-op except for returning
+ * the handle.
+ * 
  */
 
 #if defined(OBJFORMAT_PEi386)
@@ -651,15 +724,16 @@ typedef
 static OpenedDLL* opened_dlls = NULL;
 #endif
 
-
-
 char *
 addDLL( char *dll_name )
 {
 #  if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
+   /* ------------------- ELF DLL loader ------------------- */
    void *hdl;
    char *errmsg;
 
+   initLinker();
+
    hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
    if (hdl == NULL) {
       /* dlopen failed; return a ptr to the error msg. */
@@ -672,14 +746,15 @@ addDLL( char *dll_name )
    /*NOTREACHED*/
 
 #  elif defined(OBJFORMAT_PEi386)
+   /* ------------------- Win32 DLL loader ------------------- */
 
-   /* Add this DLL to the list of DLLs in which to search for symbols.
-      The path argument is ignored. */
    char*      buf;
    OpenedDLL* o_dll;
    HINSTANCE  instance;
 
-   /* fprintf(stderr, "\naddDLL; path=`%s', dll_name = `%s'\n", path, dll_name); */
+   initLinker();
+
+   /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
 
    /* See if we've already got it, and ignore if so. */
    for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
@@ -687,21 +762,32 @@ addDLL( char *dll_name )
          return NULL;
    }
 
+   /* The file name has no suffix (yet) so that we can try
+      both foo.dll and foo.drv
+
+      The documentation for LoadLibrary says:
+       If no file name extension is specified in the lpFileName
+       parameter, the default library extension .dll is
+       appended. However, the file name string can include a trailing
+       point character (.) to indicate that the module name has no
+       extension. */
+
    buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
    sprintf(buf, "%s.DLL", dll_name);
    instance = LoadLibrary(buf);
    if (instance == NULL) {
-        sprintf(buf, "%s.DRV", dll_name);              // KAA: allow loading of drivers (like winspool.drv)
+        sprintf(buf, "%s.DRV", dll_name);      // KAA: allow loading of drivers (like winspool.drv)
         instance = LoadLibrary(buf);
         if (instance == NULL) {
-               free(buf);
+               stgFree(buf);
 
            /* LoadLibrary failed; return a ptr to the error msg. */
            return "addDLL: unknown error";
         }
    }
-   free(buf);
+   stgFree(buf);
 
+   /* Add this DLL to the list of DLLs in which to search for symbols. */
    o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
    o_dll->name     = stgMallocBytes(1+strlen(dll_name), "addDLL");
    strcpy(o_dll->name, dll_name);
@@ -722,6 +808,7 @@ void *
 lookupSymbol( char *lbl )
 {
     void *val;
+    initLinker() ;
     ASSERT(symhash != NULL);
     val = lookupStrHashTable(symhash, lbl);
 
@@ -767,6 +854,7 @@ void *
 lookupLocalSymbol( ObjectCode* oc, char *lbl )
 {
     void *val;
+    initLinker() ;
     val = lookupStrHashTable(oc->lochash, lbl);
 
     if (val == NULL) {
@@ -791,18 +879,23 @@ void ghci_enquire ( char* addr )
    char* a;
    const int DELTA = 64;
    ObjectCode* oc;
+
+   initLinker();
+
    for (oc = objects; oc; oc = oc->next) {
       for (i = 0; i < oc->n_symbols; i++) {
          sym = oc->symbols[i];
          if (sym == NULL) continue;
-         /* fprintf(stderr, "enquire %p %p\n", sym, oc->lochash); */
+         // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
          a = NULL;
-         if (oc->lochash != NULL)
+         if (oc->lochash != NULL) {
             a = lookupStrHashTable(oc->lochash, sym);
-         if (a == NULL)
+        }
+         if (a == NULL) {
             a = lookupStrHashTable(symhash, sym);
+        }
          if (a == NULL) {
-            /* fprintf(stderr, "ghci_enquire: can't find %s\n", sym); */
+            // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
          }
          else if (addr-DELTA <= a && a <= addr+DELTA) {
             fprintf(stderr, "%p + %3d  ==  `%s'\n", addr, a - addr, sym);
@@ -834,6 +927,8 @@ loadObj( char *path )
    FILE *f;
 #endif
 
+   initLinker();
+
    /* fprintf(stderr, "loadObj %s\n", path ); */
 
    /* Check that we haven't already loaded this object.  Don't give up
@@ -866,7 +961,7 @@ loadObj( char *path )
 #  elif defined(OBJFORMAT_MACHO)
    oc->formatName = "Mach-O";
 #  else
-   free(oc);
+   stgFree(oc);
    barf("loadObj: not implemented on this platform");
 #  endif
 
@@ -974,6 +1069,8 @@ resolveObjs( void )
     ObjectCode *oc;
     int r;
 
+    initLinker();
+
     for (oc = objects; oc; oc = oc->next) {
        if (oc->status != OBJECT_RESOLVED) {
 #           if defined(OBJFORMAT_ELF)
@@ -1003,6 +1100,8 @@ unloadObj( char *path )
     ASSERT(symhash != NULL);
     ASSERT(objects != NULL);
 
+    initLinker(); 
+
     prev = NULL;
     for (oc = objects; oc; prev = oc, oc = oc->next) {
        if (!strcmp(oc->fileName,path)) {
@@ -1027,14 +1126,14 @@ unloadObj( char *path )
 
            /* We're going to leave this in place, in case there are
               any pointers from the heap into it: */
-           /* free(oc->image); */
-           free(oc->fileName);
-           free(oc->symbols);
-           free(oc->sections);
+           /* stgFree(oc->image); */
+           stgFree(oc->fileName);
+           stgFree(oc->symbols);
+           stgFree(oc->sections);
            /* The local hash table should have been freed at the end
                of the ocResolve_ call on it. */
             ASSERT(oc->lochash == NULL);
-           free(oc);
+           stgFree(oc);
            return 1;
        }
     }
@@ -1850,7 +1949,8 @@ ocResolve_PEi386 ( ObjectCode* oc )
             if ((void*)S != NULL) goto foundit;
             (void*)S = lookupSymbol( symbol );
             if ((void*)S != NULL) goto foundit;
-            belch("%s: unknown symbol `%s'", oc->fileName, symbol);
+           /* Newline first because the interactive linker has printed "linking..." */
+            belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
             return 0;
            foundit:
          }
@@ -2865,7 +2965,8 @@ static int ocVerifyImage_MachO(ObjectCode* oc)
     return 1;
 }
 
-static void resolveImports(
+static int resolveImports(
+    ObjectCode* oc,
     char *image,
     struct symtab_command *symLC,
     struct section *sect,    // ptr to lazy or non-lazy symbol pointer section
@@ -2884,19 +2985,23 @@ static void resolveImports(
        if((symbol->n_type & N_TYPE) == N_UNDF
            && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
            addr = (void*) (symbol->n_value);
+       else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
+           ;
        else
            addr = lookupSymbol(nm);
        if(!addr)
        {
-           fprintf(stderr, "not found: %s\n", nm);
-           abort();
+           belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
+           return 0;
        }
        ASSERT(addr);
        ((void**)(image + sect->offset))[i] = addr;
     }
+    
+    return 1;
 }
 
-static void relocateSection(char *image, 
+static int relocateSection(char *image, 
     struct symtab_command *symLC, struct nlist *nlist,
     struct section* sections, struct section *sect)
 {
@@ -2904,9 +3009,9 @@ static void relocateSection(char *image,
     int i,n;
     
     if(!strcmp(sect->sectname,"__la_symbol_ptr"))
-       return;
+       return 1;
     else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
-       return;
+       return 1;
 
     n = sect->nreloc;
     relocs = (struct relocation_info*) (image + sect->reloff);
@@ -2936,12 +3041,38 @@ static void relocateSection(char *image,
            if(reloc->r_pcrel && !reloc->r_extern)
                continue;
                
-           if(!reloc->r_pcrel
-               && reloc->r_length == 2
-               && reloc->r_type == GENERIC_RELOC_VANILLA)
+           if(reloc->r_length == 2)
            {
-               unsigned long* word = (unsigned long*) (image + sect->offset + reloc->r_address);
+               unsigned long word = 0;
+
+               unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
                
+               if(reloc->r_type == GENERIC_RELOC_VANILLA)
+               {
+                   word = *wordPtr;
+               }
+               else if(reloc->r_type == PPC_RELOC_LO16)
+               {
+                   word = ((unsigned short*) wordPtr)[1];
+                   word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
+               }
+               else if(reloc->r_type == PPC_RELOC_HI16)
+               {
+                   word = ((unsigned short*) wordPtr)[1] << 16;
+                   word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
+               }
+               else if(reloc->r_type == PPC_RELOC_HA16)
+               {
+                   word = ((unsigned short*) wordPtr)[1] << 16;
+                   word += ((short)relocs[i+1].r_address & (short)0xFFFF);
+               }
+               else if(reloc->r_type == PPC_RELOC_BR24)
+               {
+                   word = *wordPtr;
+                   word = (word & 0x03FFFFFC) | (word & 0x02000000) ? 0xFC000000 : 0;
+               }
+
+
                if(!reloc->r_extern)
                {
                    long delta = 
@@ -2949,22 +3080,55 @@ static void relocateSection(char *image,
                        - sections[reloc->r_symbolnum-1].addr
                        + ((long) image);
                    
-                   *word += delta;
+                   word += delta;
                }
                else
                {
                    struct nlist *symbol = &nlist[reloc->r_symbolnum];
                    char *nm = image + symLC->stroff + symbol->n_un.n_strx;
-                   *word = lookupSymbol(nm);
-                   ASSERT(*word);
+                   word = (unsigned long) (lookupSymbol(nm));
+                   if(!word)
+                   {
+                       belch("\nunknown symbol `%s'", nm);
+                       return 0;
+                   }
+                   
+                   if(reloc->r_pcrel)
+                       word -= ((long)image) + sect->offset + reloc->r_address;
+               }
+               
+               if(reloc->r_type == GENERIC_RELOC_VANILLA)
+               {
+                   *wordPtr = word;
+                   continue;
+               }
+               else if(reloc->r_type == PPC_RELOC_LO16)
+               {
+                   ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
+                   i++; continue;
+               }
+               else if(reloc->r_type == PPC_RELOC_HI16)
+               {
+                   ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
+                   i++; continue;
+               }
+               else if(reloc->r_type == PPC_RELOC_HA16)
+               {
+                   ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
+                       + ((word & (1<<15)) ? 1 : 0);
+                   i++; continue;
+               }
+               else if(reloc->r_type == PPC_RELOC_BR24)
+               {
+                   *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
+                   continue;
                }
-               continue;
            }
-           fprintf(stderr, "unknown reloc\n");
-           abort();
-           ASSERT(2 + 2 == 5);
+           barf("\nunknown relocation %d",reloc->r_type);
+           return 0;
        }
     }
+    return 1;
 }
 
 static int ocGetNames_MachO(ObjectCode* oc)
@@ -2972,7 +3136,7 @@ static int ocGetNames_MachO(ObjectCode* oc)
     char *image = (char*) oc->image;
     struct mach_header *header = (struct mach_header*) image;
     struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
-    int i,curSymbol;
+    unsigned i,curSymbol;
     struct segment_command *segLC = NULL;
     struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
     struct symtab_command *symLC = NULL;
@@ -3051,6 +3215,20 @@ static int ocGetNames_MachO(ObjectCode* oc)
        }
     }
     
+       // insert local symbols into lochash
+    for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
+    {
+       if((nlist[i].n_type & N_TYPE) == N_SECT)
+       {
+           char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
+           ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image + 
+               sections[nlist[i].n_sect-1].offset
+               - sections[nlist[i].n_sect-1].addr
+               + nlist[i].n_value);
+       }
+    }
+
+    
     commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
     commonCounter = (unsigned long)commonStorage;
     for(i=0;i<symLC->nsyms;i++)
@@ -3063,7 +3241,7 @@ static int ocGetNames_MachO(ObjectCode* oc)
            
            nlist[i].n_value = commonCounter;
            
-           ghciInsertStrHashTable(oc->fileName, symhash, nm, nlist[i].n_value);
+           ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
            oc->symbols[curSymbol++] = nm;
            
            commonCounter += sz;
@@ -3077,7 +3255,7 @@ static int ocResolve_MachO(ObjectCode* oc)
     char *image = (char*) oc->image;
     struct mach_header *header = (struct mach_header*) image;
     struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
-    int i;
+    unsigned i;
     struct segment_command *segLC = NULL;
     struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
     struct symtab_command *symLC = NULL;
@@ -3110,13 +3288,16 @@ static int ocResolve_MachO(ObjectCode* oc)
     indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
 
     if(la_ptrs)
-       resolveImports(image,symLC,la_ptrs,indirectSyms,nlist);
+       if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
+           return 0;
     if(nl_ptrs)
-       resolveImports(image,symLC,nl_ptrs,indirectSyms,nlist);
+       if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
+           return 0;
     
     for(i=0;i<segLC->nsects;i++)
     {
-       relocateSection(image,symLC,nlist,sections,&sections[i]);
+       if(!relocateSection(image,symLC,nlist,sections,&sections[i]))
+           return 0;
     }
 
     /* Free the local symbol table; we won't need it again. */
@@ -3125,4 +3306,25 @@ static int ocResolve_MachO(ObjectCode* oc)
     return 1;
 }
 
+/*
+ * The Mach-O object format uses leading underscores. But not everywhere.
+ * There is a small number of runtime support functions defined in
+ * libcc_dynamic.a whose name does not have a leading underscore.
+ * As a consequence, we can't get their address from C code.
+ * We have to use inline assembler just to take the address of a function.
+ * Yuck.
+ */
+
+static void machoInitSymbolsWithoutUnderscore()
+{
+    void *p;
+
+#undef Sym    
+#define Sym(x)                                         \
+    __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p));      \
+    ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p);
+    
+    RTS_MACHO_NOUNDERLINE_SYMBOLS
+
+}
 #endif