projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 2004-08-13 13:04:50 by simonmar]
[ghc-hetmet.git] / ghc / rts / Linker.c
diff --git a/ghc/rts/Linker.c b/ghc/rts/Linker.c
index 093a791..e6e82aa 100644 (file)
--- a/ghc/rts/Linker.c
+++ b/ghc/rts/Linker.c
@@ -1,7 +1,6 @@
 /* -----------------------------------------------------------------------------
 /* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.136 2003/10/08 09:42:34 wolfgang Exp $
  *
  *
- * (c) The GHC Team, 2000-2003
+ * (c) The GHC Team, 2000-2004
  *
  * RTS Object Linker
  *
  *
  * RTS Object Linker
  *
@@ -10,6 +9,12 @@
 #if 0
 #include "PosixSource.h"
 #endif
 #if 0
 #include "PosixSource.h"
 #endif
+
+//  Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h>.
+#ifdef __linux__
+#define _GNU_SOURCE
+#endif
+
 #include "Rts.h"
 #include "RtsFlags.h"
 #include "HsFFI.h"
 #include "Rts.h"
 #include "RtsFlags.h"
 #include "HsFFI.h"
@@ -17,8 +22,8 @@
 #include "Linker.h"
 #include "LinkerInternals.h"
 #include "RtsUtils.h"
 #include "Linker.h"
 #include "LinkerInternals.h"
 #include "RtsUtils.h"
-#include "StoragePriv.h"
 #include "Schedule.h"
 #include "Schedule.h"
+#include "Storage.h"
 
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>
 
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>
@@ -53,10 +58,17 @@
 #include <sys/wait.h>
 #endif
 
 #include <sys/wait.h>
 #endif
 
-#if defined(ia64_TARGET_ARCH)
+#if defined(ia64_TARGET_ARCH) || defined(openbsd_TARGET_OS)
 #define USE_MMAP
 #include <fcntl.h>
 #include <sys/mman.h>
 #define USE_MMAP
 #include <fcntl.h>
 #include <sys/mman.h>
+
+#if defined(openbsd_TARGET_OS) 
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#endif
+
 #endif
 
 #if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS) || defined(netbsd_TARGET_OS) || defined(openbsd_TARGET_OS)
 #endif
 
 #if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS) || defined(netbsd_TARGET_OS) || defined(openbsd_TARGET_OS)
@@ -129,7 +141,7 @@ typedef struct _RtsSymbolVal {
 #define RTS_MINGW_ONLY_SYMBOLS /**/
 /* Don't have the ability to read import libs / archives, so
  * we have to stupidly list a lot of what libcygwin.a
 #define RTS_MINGW_ONLY_SYMBOLS /**/
 /* Don't have the ability to read import libs / archives, so
  * we have to stupidly list a lot of what libcygwin.a
- * exports; sigh. 
+ * exports; sigh.
  */
 #define RTS_CYGWIN_ONLY_SYMBOLS                 \
       SymX(regfree)                             \
  */
 #define RTS_CYGWIN_ONLY_SYMBOLS                 \
       SymX(regfree)                             \
@@ -220,7 +232,7 @@ typedef struct _RtsSymbolVal {
 #if __GNUC__>=3
 #define RTS_MINGW_EXTRA_SYMS                    \
       Sym(_imp____mb_cur_max)                   \
 #if __GNUC__>=3
 #define RTS_MINGW_EXTRA_SYMS                    \
       Sym(_imp____mb_cur_max)                   \
-      Sym(_imp___pctype)            
+      Sym(_imp___pctype)
 #else
 #define RTS_MINGW_EXTRA_SYMS
 #endif
 #else
 #define RTS_MINGW_EXTRA_SYMS
 #endif
@@ -230,6 +242,7 @@ typedef struct _RtsSymbolVal {
 #define RTS_MINGW_ONLY_SYMBOLS                  \
       SymX(asyncReadzh_fast)                   \
       SymX(asyncWritezh_fast)                  \
 #define RTS_MINGW_ONLY_SYMBOLS                  \
       SymX(asyncReadzh_fast)                   \
       SymX(asyncWritezh_fast)                  \
+      SymX(asyncDoProczh_fast)                 \
       SymX(memset)                              \
       SymX(inet_ntoa)                           \
       SymX(inet_addr)                           \
       SymX(memset)                              \
       SymX(inet_ntoa)                           \
       SymX(inet_addr)                           \
@@ -299,12 +312,34 @@ typedef struct _RtsSymbolVal {
 # define MAIN_CAP_SYM
 #endif
 
 # define MAIN_CAP_SYM
 #endif
 
+#ifdef TABLES_NEXT_TO_CODE
+#define RTS_RET_SYMBOLS /* nothing */
+#else
+#define RTS_RET_SYMBOLS                        \
+      SymX(stg_enter_ret)                      \
+      SymX(stg_gc_fun_ret)                     \
+      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_pppv_ret)                    \
+      SymX(stg_ap_pppp_ret)                    \
+      SymX(stg_ap_ppppp_ret)                   \
+      SymX(stg_ap_pppppp_ret)
+#endif
+
 #define RTS_SYMBOLS                            \
       Maybe_ForeignObj                         \
       Maybe_Stable_Names                       \
       Sym(StgReturn)                           \
       SymX(stg_enter_info)                     \
 #define RTS_SYMBOLS                            \
       Maybe_ForeignObj                         \
       Maybe_Stable_Names                       \
       Sym(StgReturn)                           \
       SymX(stg_enter_info)                     \
-      SymX(stg_enter_ret)                      \
       SymX(stg_gc_void_info)                   \
       SymX(__stg_gc_enter_1)                   \
       SymX(stg_gc_noregs)                      \
       SymX(stg_gc_void_info)                   \
       SymX(__stg_gc_enter_1)                   \
       SymX(stg_gc_noregs)                      \
@@ -320,7 +355,6 @@ typedef struct _RtsSymbolVal {
       SymX(stg_gc_l1)                          \
       SymX(__stg_gc_fun)                       \
       SymX(stg_gc_fun_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_gen)                         \
       SymX(stg_gc_gen_info)                    \
       SymX(stg_gc_gen_hp)                      \
@@ -334,17 +368,14 @@ typedef struct _RtsSymbolVal {
       SymX(stg_block_takemvar)                 \
       SymX(stg_block_putmvar)                  \
       SymX(stg_seq_frame_info)                 \
       SymX(stg_block_takemvar)                 \
       SymX(stg_block_putmvar)                  \
       SymX(stg_seq_frame_info)                 \
-      SymX(ErrorHdrHook)                       \
       MAIN_CAP_SYM                              \
       SymX(MallocFailHook)                     \
       SymX(OnExitHook)                         \
       SymX(OutOfHeapHook)                      \
       MAIN_CAP_SYM                              \
       SymX(MallocFailHook)                     \
       SymX(OnExitHook)                         \
       SymX(OutOfHeapHook)                      \
-      SymX(PatErrorHdrHook)                    \
-      SymX(PostTraceHook)                      \
-      SymX(PreTraceHook)                       \
       SymX(StackOverflowHook)                  \
       SymX(__encodeDouble)                     \
       SymX(__encodeFloat)                      \
       SymX(StackOverflowHook)                  \
       SymX(__encodeDouble)                     \
       SymX(__encodeFloat)                      \
+      SymX(addDLL)                             \
       SymX(__gmpn_gcd_1)                       \
       SymX(__gmpz_cmp)                         \
       SymX(__gmpz_cmp_si)                      \
       SymX(__gmpn_gcd_1)                       \
       SymX(__gmpz_cmp)                         \
       SymX(__gmpz_cmp_si)                      \
@@ -354,6 +385,7 @@ typedef struct _RtsSymbolVal {
       SymX(__int_encodeDouble)                 \
       SymX(__int_encodeFloat)                  \
       SymX(andIntegerzh_fast)                  \
       SymX(__int_encodeDouble)                 \
       SymX(__int_encodeFloat)                  \
       SymX(andIntegerzh_fast)                  \
+      SymX(barf)                               \
       SymX(blockAsyncExceptionszh_fast)                \
       SymX(catchzh_fast)                       \
       SymX(cmp_thread)                         \
       SymX(blockAsyncExceptionszh_fast)                \
       SymX(catchzh_fast)                       \
       SymX(cmp_thread)                         \
@@ -380,6 +412,7 @@ typedef struct _RtsSymbolVal {
       SymX(genSymZh)                           \
       SymX(getProgArgv)                                \
       SymX(getStablePtr)                       \
       SymX(genSymZh)                           \
       SymX(getProgArgv)                                \
       SymX(getStablePtr)                       \
+      SymX(initLinker)                         \
       SymX(int2Integerzh_fast)                 \
       SymX(integer2Intzh_fast)                 \
       SymX(integer2Wordzh_fast)                        \
       SymX(int2Integerzh_fast)                 \
       SymX(integer2Intzh_fast)                 \
       SymX(integer2Wordzh_fast)                        \
@@ -394,6 +427,8 @@ typedef struct _RtsSymbolVal {
       SymX(isFloatNaN)                         \
       SymX(isFloatNegativeZero)                        \
       SymX(killThreadzh_fast)                  \
       SymX(isFloatNaN)                         \
       SymX(isFloatNegativeZero)                        \
       SymX(killThreadzh_fast)                  \
+      SymX(loadObj)                            \
+      SymX(lookupSymbol)                       \
       SymX(makeStablePtrzh_fast)               \
       SymX(minusIntegerzh_fast)                        \
       SymX(mkApUpd0zh_fast)                    \
       SymX(makeStablePtrzh_fast)               \
       SymX(minusIntegerzh_fast)                        \
       SymX(mkApUpd0zh_fast)                    \
@@ -409,6 +444,7 @@ typedef struct _RtsSymbolVal {
       SymX(newPinnedByteArrayzh_fast)          \
       SymX(orIntegerzh_fast)                   \
       SymX(performGC)                          \
       SymX(newPinnedByteArrayzh_fast)          \
       SymX(orIntegerzh_fast)                   \
       SymX(performGC)                          \
+      SymX(performMajorGC)                     \
       SymX(plusIntegerzh_fast)                 \
       SymX(prog_argc)                          \
       SymX(prog_argv)                          \
       SymX(plusIntegerzh_fast)                 \
       SymX(prog_argc)                          \
       SymX(prog_argv)                          \
@@ -420,6 +456,7 @@ typedef struct _RtsSymbolVal {
       SymX(remIntegerzh_fast)                  \
       SymX(resetNonBlockingFd)                 \
       SymX(resumeThread)                       \
       SymX(remIntegerzh_fast)                  \
       SymX(resetNonBlockingFd)                 \
       SymX(resumeThread)                       \
+      SymX(resolveObjs)                         \
       SymX(rts_apply)                          \
       SymX(rts_checkSchedStatus)               \
       SymX(rts_eval)                           \
       SymX(rts_apply)                          \
       SymX(rts_checkSchedStatus)               \
       SymX(rts_eval)                           \
@@ -488,25 +525,10 @@ typedef struct _RtsSymbolVal {
       SymX(stg_ap_pp_info)                     \
       SymX(stg_ap_ppv_info)                    \
       SymX(stg_ap_ppp_info)                    \
       SymX(stg_ap_pp_info)                     \
       SymX(stg_ap_ppv_info)                    \
       SymX(stg_ap_ppp_info)                    \
+      SymX(stg_ap_pppv_info)                   \
       SymX(stg_ap_pppp_info)                   \
       SymX(stg_ap_ppppp_info)                  \
       SymX(stg_ap_pppppp_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)                  \
       SymX(stg_ap_1_upd_info)                  \
       SymX(stg_ap_2_upd_info)                  \
       SymX(stg_ap_3_upd_info)                  \
@@ -514,7 +536,6 @@ typedef struct _RtsSymbolVal {
       SymX(stg_ap_5_upd_info)                  \
       SymX(stg_ap_6_upd_info)                  \
       SymX(stg_ap_7_upd_info)                  \
       SymX(stg_ap_5_upd_info)                  \
       SymX(stg_ap_6_upd_info)                  \
       SymX(stg_ap_7_upd_info)                  \
-      SymX(stg_ap_8_upd_info)                  \
       SymX(stg_exit)                           \
       SymX(stg_sel_0_upd_info)                 \
       SymX(stg_sel_10_upd_info)                        \
       SymX(stg_exit)                           \
       SymX(stg_sel_0_upd_info)                 \
       SymX(stg_sel_10_upd_info)                        \
@@ -539,6 +560,7 @@ typedef struct _RtsSymbolVal {
       SymX(tryPutMVarzh_fast)                  \
       SymX(tryTakeMVarzh_fast)                 \
       SymX(unblockAsyncExceptionszh_fast)      \
       SymX(tryPutMVarzh_fast)                  \
       SymX(tryTakeMVarzh_fast)                 \
       SymX(unblockAsyncExceptionszh_fast)      \
+      SymX(unloadObj)                           \
       SymX(unsafeThawArrayzh_fast)             \
       SymX(waitReadzh_fast)                    \
       SymX(waitWritezh_fast)                   \
       SymX(unsafeThawArrayzh_fast)             \
       SymX(waitReadzh_fast)                    \
       SymX(waitWritezh_fast)                   \
@@ -591,6 +613,7 @@ typedef struct _RtsSymbolVal {
 #define SymX(vvv) /**/
 #define SymX_redirect(vvv,xxx) /**/
 RTS_SYMBOLS
 #define SymX(vvv) /**/
 #define SymX_redirect(vvv,xxx) /**/
 RTS_SYMBOLS
+RTS_RET_SYMBOLS
 RTS_LONG_LONG_SYMS
 RTS_POSIX_ONLY_SYMBOLS
 RTS_MINGW_ONLY_SYMBOLS
 RTS_LONG_LONG_SYMS
 RTS_POSIX_ONLY_SYMBOLS
 RTS_MINGW_ONLY_SYMBOLS
@@ -671,6 +694,11 @@ static int linker_init_done = 0 ;
 static void *dl_prog_handle;
 #endif
 
 static void *dl_prog_handle;
 #endif
 
+/* dlopen(NULL,..) doesn't work so we grab libc explicitly */
+#if defined(openbsd_TARGET_OS)
+static void *dl_libc_handle;
+#endif
+
 void
 initLinker( void )
 {
 void
 initLinker( void )
 {
@@ -695,7 +723,14 @@ initLinker( void )
 #   endif
 
 #   if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
 #   endif
 
 #   if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
+#   if defined(RTLD_DEFAULT)
+    dl_prog_handle = RTLD_DEFAULT;
+#   else
     dl_prog_handle = dlopen(NULL, RTLD_LAZY);
     dl_prog_handle = dlopen(NULL, RTLD_LAZY);
+#   if defined(openbsd_TARGET_OS)
+    dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
+#   endif
+#   endif // RTLD_DEFAULT
 #   endif
 }
 
 #   endif
 }
 
@@ -716,7 +751,7 @@ initLinker( void )
  * 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.
  * 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)
  */
 
 #if defined(OBJFORMAT_PEi386)
@@ -744,11 +779,8 @@ addDLL( char *dll_name )
 
    initLinker();
 
 
    initLinker();
 
-#if !defined(openbsd_TARGET_OS)
    hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
    hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
-#else
-   hdl= dlopen(dll_name, RTLD_LAZY);
-#endif
+
    if (hdl == NULL) {
       /* dlopen failed; return a ptr to the error msg. */
       errmsg = dlerror();
    if (hdl == NULL) {
       /* dlopen failed; return a ptr to the error msg. */
       errmsg = dlerror();
@@ -828,7 +860,12 @@ lookupSymbol( char *lbl )
 
     if (val == NULL) {
 #       if defined(OBJFORMAT_ELF)
 
     if (val == NULL) {
 #       if defined(OBJFORMAT_ELF)
+#      if defined(openbsd_TARGET_OS)
+       val = dlsym(dl_prog_handle, lbl);
+       return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
+#      else /* not openbsd */
        return dlsym(dl_prog_handle, lbl);
        return dlsym(dl_prog_handle, lbl);
+#      endif
 #       elif defined(OBJFORMAT_MACHO)
        if(NSIsSymbolNameDefined(lbl)) {
            NSSymbol symbol = NSLookupAndBindSymbol(lbl);
 #       elif defined(OBJFORMAT_MACHO)
        if(NSIsSymbolNameDefined(lbl)) {
            NSSymbol symbol = NSLookupAndBindSymbol(lbl);
@@ -943,7 +980,7 @@ loadObj( char *path )
    int r, n;
 #ifdef USE_MMAP
    int fd, pagesize;
    int r, n;
 #ifdef USE_MMAP
    int fd, pagesize;
-   void *map_addr;
+   void *map_addr = NULL;
 #else
    FILE *f;
 #endif
 #else
    FILE *f;
 #endif
@@ -952,24 +989,25 @@ loadObj( char *path )
 
    /* fprintf(stderr, "loadObj %s\n", path ); */
 
 
    /* fprintf(stderr, "loadObj %s\n", path ); */
 
-   /* Check that we haven't already loaded this object.  Don't give up
-      at this stage; ocGetNames_* will barf later. */
+   /* Check that we haven't already loaded this object. 
+      Ignore requests to load multiple times */
    {
        ObjectCode *o;
        int is_dup = 0;
        for (o = objects; o; o = o->next) {
    {
        ObjectCode *o;
        int is_dup = 0;
        for (o = objects; o; o = o->next) {
-          if (0 == strcmp(o->fileName, path))
+          if (0 == strcmp(o->fileName, path)) {
              is_dup = 1;
              is_dup = 1;
+             break; /* don't need to search further */
+          }
        }
        if (is_dup) {
        }
        if (is_dup) {
-        fprintf(stderr,
-            "\n\n"
+          IF_DEBUG(linker, belch(
             "GHCi runtime linker: warning: looks like you're trying to load the\n"
             "same object file twice:\n"
             "   %s\n"
             "GHCi runtime linker: warning: looks like you're trying to load the\n"
             "same object file twice:\n"
             "   %s\n"
-            "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
-            "\n"
-            , path);
+            "GHCi will ignore this, but be warned.\n"
+            , path));
+          return 1; /* success */
        }
    }
 
        }
    }
 
@@ -1008,7 +1046,11 @@ loadObj( char *path )
 
    /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
 
 
    /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
 
+#if defined(openbsd_TARGET_OS)
+   fd = open(path, O_RDONLY, S_IRUSR);
+#else
    fd = open(path, O_RDONLY);
    fd = open(path, O_RDONLY);
+#endif
    if (fd == -1)
       barf("loadObj: can't open `%s'", path);
 
    if (fd == -1)
       barf("loadObj: can't open `%s'", path);
 
@@ -1126,7 +1168,7 @@ unloadObj( char *path )
     ASSERT(symhash != NULL);
     ASSERT(objects != NULL);
 
     ASSERT(symhash != NULL);
     ASSERT(objects != NULL);
 
-    initLinker(); 
+    initLinker();
 
     prev = NULL;
     for (oc = objects; oc; prev = oc, oc = oc->next) {
 
     prev = NULL;
     for (oc = objects; oc; prev = oc, oc = oc->next) {
@@ -1913,11 +1955,16 @@ ocResolve_PEi386 ( ObjectCode* oc )
         * real count can be found in the first reloc entry.
          *
         * See Section 4.1 (last para) of the PE spec (rev6.0).
         * real count can be found in the first reloc entry.
          *
         * See Section 4.1 (last para) of the PE spec (rev6.0).
+        *
+        * Nov2003 update: the GNU linker still doesn't correctly
+        * handle the generation of relocatable object files with
+        * overflown relocations. Hence the output to warn of potential
+        * troubles.
         */
         COFF_reloc* rel = (COFF_reloc*)
                            myindex ( sizeof_COFF_reloc, reltab, 0 );
        noRelocs = rel->VirtualAddress;
         */
         COFF_reloc* rel = (COFF_reloc*)
                            myindex ( sizeof_COFF_reloc, reltab, 0 );
        noRelocs = rel->VirtualAddress;
-       fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
+       fprintf(stderr, "WARNING: Overflown relocation field (# relocs found: %u)\n", noRelocs); fflush(stderr);
        j = 1;
       } else {
        noRelocs = sectab_i->NumberOfRelocations;
        j = 1;
       } else {
        noRelocs = sectab_i->NumberOfRelocations;
@@ -3000,13 +3047,11 @@ ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
 #if defined(OBJFORMAT_MACHO)
 
 /*
 #if defined(OBJFORMAT_MACHO)
 
 /*
-  Initial support for MachO linking on Darwin/MacOS X on PowerPC chips
+  Support for MachO linking on Darwin/MacOS X on PowerPC chips
   by Wolfgang Thaller (wolfgang.thaller@gmx.net)
   by Wolfgang Thaller (wolfgang.thaller@gmx.net)
-  
+
   I hereby formally apologize for the hackish nature of this code.
   Things that need to be done:
   I hereby formally apologize for the hackish nature of this code.
   Things that need to be done:
-  *) handle uninitialized data sections ("__common").
-       Normal common definitions work, but beware if you pass -fno-common to gcc.
   *) implement ocVerifyImage_MachO
   *) add still more sanity checks.
 */
   *) implement ocVerifyImage_MachO
   *) add still more sanity checks.
 */
@@ -3014,10 +3059,10 @@ ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
 
 /*
   ocAllocateJumpIslands_MachO
 
 /*
   ocAllocateJumpIslands_MachO
-  
+
   Allocate additional space at the end of the object file image to make room
   for jump islands.
   Allocate additional space at the end of the object file image to make room
   for jump islands.
-  
+
   PowerPC relative branch instructions have a 24 bit displacement field.
   As PPC code is always 4-byte-aligned, this yields a +-32MB range.
   If a particular imported symbol is outside this range, we have to redirect
   PowerPC relative branch instructions have a 24 bit displacement field.
   As PPC code is always 4-byte-aligned, this yields a +-32MB range.
   If a particular imported symbol is outside this range, we have to redirect
@@ -3045,20 +3090,20 @@ static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
             unsigned long nundefsym = dsymLC->nundefsym;
             oc->island_start_symbol = dsymLC->iundefsym;
             oc->n_islands = nundefsym;
             unsigned long nundefsym = dsymLC->nundefsym;
             oc->island_start_symbol = dsymLC->iundefsym;
             oc->n_islands = nundefsym;
-            
+
             if(nundefsym > 0)
             {
 #ifdef USE_MMAP
             if(nundefsym > 0)
             {
 #ifdef USE_MMAP
-                #error ocAllocateJumpIslands_MachO doesn't want USE_MMAP to be defined
+                #error ocAllocateJumpIslands_MachO doesnt want USE_MMAP to be defined
 #else
                 oc->image = stgReallocBytes(
                     image, oc->fileSize + islandSize * nundefsym,
                     "ocAllocateJumpIslands_MachO");
 #else
                 oc->image = stgReallocBytes(
                     image, oc->fileSize + islandSize * nundefsym,
                     "ocAllocateJumpIslands_MachO");
-#endif                    
+#endif
                 oc->jump_islands = oc->image + oc->fileSize;
                 memset(oc->jump_islands, 0, islandSize * nundefsym);
             }
                 oc->jump_islands = oc->image + oc->fileSize;
                 memset(oc->jump_islands, 0, islandSize * nundefsym);
             }
-            
+
             break;  // there can be only one LC_DSYMTAB
         }
        lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
             break;  // there can be only one LC_DSYMTAB
         }
        lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
@@ -3081,14 +3126,14 @@ static int resolveImports(
     struct nlist *nlist)
 {
     unsigned i;
     struct nlist *nlist)
 {
     unsigned i;
-    
+
     for(i=0;i*4<sect->size;i++)
     {
        // according to otool, reserved1 contains the first index into the indirect symbol table
        struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
        char *nm = image + symLC->stroff + symbol->n_un.n_strx;
        void *addr = NULL;
     for(i=0;i*4<sect->size;i++)
     {
        // according to otool, reserved1 contains the first index into the indirect symbol table
        struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
        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))
            addr = (void*) (symbol->n_value);
        if((symbol->n_type & N_TYPE) == N_UNDF
            && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
            addr = (void*) (symbol->n_value);
@@ -3105,7 +3150,7 @@ static int resolveImports(
        checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
        ((void**)(image + sect->offset))[i] = addr;
     }
        checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
        ((void**)(image + sect->offset))[i] = addr;
     }
-    
+
     return 1;
 }
 
     return 1;
 }
 
@@ -3118,31 +3163,51 @@ static void* makeJumpIsland(
         symbolNumber - oc->island_start_symbol > oc->n_islands)
         return NULL;
     symbolNumber -= oc->island_start_symbol;
         symbolNumber - oc->island_start_symbol > oc->n_islands)
         return NULL;
     symbolNumber -= oc->island_start_symbol;
-    
+
     void *island = (void*) ((char*)oc->jump_islands + islandSize * symbolNumber);
     unsigned long *p = (unsigned long*) island;
     void *island = (void*) ((char*)oc->jump_islands + islandSize * symbolNumber);
     unsigned long *p = (unsigned long*) island;
-    
+
         // lis r12, hi16(target)
     *p++ = 0x3d800000 | ( ((unsigned long) target) >> 16 );
         // ori r12, r12, lo16(target)
         // lis r12, hi16(target)
     *p++ = 0x3d800000 | ( ((unsigned long) target) >> 16 );
         // ori r12, r12, lo16(target)
-    *p++ = 0x618c0000 | ( ((unsigned long) target) & 0xFFFF ); 
+    *p++ = 0x618c0000 | ( ((unsigned long) target) & 0xFFFF );
         // mtctr r12
     *p++ = 0x7d8903a6;
         // bctr
     *p++ = 0x4e800420;
         // mtctr r12
     *p++ = 0x7d8903a6;
         // bctr
     *p++ = 0x4e800420;
-    
+
     return (void*) island;
 }
 
     return (void*) island;
 }
 
+static char* relocateAddress(
+    ObjectCode* oc,
+    int nSections,
+    struct section* sections,
+    unsigned long address)
+{
+    int i;
+    for(i = 0; i < nSections; i++)
+    {
+        if(sections[i].addr <= address
+            && address < sections[i].addr + sections[i].size)
+        {
+            return oc->image + sections[i].offset + address - sections[i].addr;
+        }
+    }
+    barf("Invalid Mach-O file:"
+         "Address out of bounds while relocating object file");
+    return NULL;
+}
+
 static int relocateSection(
     ObjectCode* oc,
 static int relocateSection(
     ObjectCode* oc,
-    char *image, 
+    char *image,
     struct symtab_command *symLC, struct nlist *nlist,
     struct symtab_command *symLC, struct nlist *nlist,
-    struct section* sections, struct section *sect)
+    int nSections, struct section* sections, struct section *sect)
 {
     struct relocation_info *relocs;
     int i,n;
 {
     struct relocation_info *relocs;
     int i,n;
-    
+
     if(!strcmp(sect->sectname,"__la_symbol_ptr"))
        return 1;
     else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
     if(!strcmp(sect->sectname,"__la_symbol_ptr"))
        return 1;
     else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
@@ -3150,25 +3215,106 @@ static int relocateSection(
 
     n = sect->nreloc;
     relocs = (struct relocation_info*) (image + sect->reloff);
 
     n = sect->nreloc;
     relocs = (struct relocation_info*) (image + sect->reloff);
-    
+
     for(i=0;i<n;i++)
     {
        if(relocs[i].r_address & R_SCATTERED)
        {
            struct scattered_relocation_info *scat =
                (struct scattered_relocation_info*) &relocs[i];
     for(i=0;i<n;i++)
     {
        if(relocs[i].r_address & R_SCATTERED)
        {
            struct scattered_relocation_info *scat =
                (struct scattered_relocation_info*) &relocs[i];
-           
+
            if(!scat->r_pcrel)
            {
            if(!scat->r_pcrel)
            {
-               if(scat->r_length == 2 && scat->r_type == GENERIC_RELOC_VANILLA)
+               if(scat->r_length == 2)
                {
                {
-                   unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
-                   
-                   checkProddableBlock(oc,word);
-                   *word = scat->r_value + sect->offset + ((long) image);
+                   unsigned long word = 0;
+                   unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
+                   checkProddableBlock(oc,wordPtr);
+
+                   // Step 1: Figure out what the relocated value should be
+                   if(scat->r_type == GENERIC_RELOC_VANILLA)
+                   {
+                       word = scat->r_value + sect->offset + ((long) image);
+                   }
+                   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)
+                   {
+                       struct scattered_relocation_info *pair =
+                               (struct scattered_relocation_info*) &relocs[i+1];
+
+                       if(!pair->r_scattered || pair->r_type != PPC_RELOC_PAIR)
+                           barf("Invalid Mach-O file: "
+                                "PPC_RELOC_*_SECTDIFF not followed by PPC_RELOC_PAIR");
+
+                       word = (unsigned long)
+                              (relocateAddress(oc, nSections, sections, scat->r_value)
+                             - relocateAddress(oc, nSections, sections, pair->r_value));
+                       i++;
+                   }
+                   else if(scat->r_type == PPC_RELOC_HI16
+                         || scat->r_type == PPC_RELOC_LO16
+                         || scat->r_type == PPC_RELOC_HA16
+                         || scat->r_type == PPC_RELOC_LO14)
+                    {   // these are generated by label+offset things
+                       struct relocation_info *pair = &relocs[i+1];
+                        if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
+                           barf("Invalid Mach-O file: "
+                                "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
+                        
+                        if(scat->r_type == PPC_RELOC_LO16)
+                        {
+                            word = ((unsigned short*) wordPtr)[1];
+                            word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
+                        }
+                        else if(scat->r_type == PPC_RELOC_LO14)
+                        {
+                            barf("Unsupported Relocation: PPC_RELOC_LO14");
+                            word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
+                            word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
+                        }
+                        else if(scat->r_type == PPC_RELOC_HI16)
+                        {
+                            word = ((unsigned short*) wordPtr)[1] << 16;
+                            word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
+                        }
+                        else if(scat->r_type == PPC_RELOC_HA16)
+                        {
+                            word = ((unsigned short*) wordPtr)[1] << 16;
+                            word += ((short)relocs[i+1].r_address & (short)0xFFFF);
+                        }
+                       
+                        
+                        word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
+                                                - scat->r_value;
+                        
+                        i++;
+                    }
+                    else
+                       continue;  // ignore the others
+
+                    if(scat->r_type == GENERIC_RELOC_VANILLA
+                        || scat->r_type == PPC_RELOC_SECTDIFF)
+                    {
+                        *wordPtr = word;
+                    }
+                    else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
+                    {
+                        ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
+                    }
+                    else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
+                    {
+                        ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
+                    }
+                    else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
+                    {
+                        ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
+                            + ((word & (1<<15)) ? 1 : 0);
+                    }
                }
            }
                }
            }
-           
+
            continue; // FIXME: I hope it's OK to ignore all the others.
        }
        else
            continue; // FIXME: I hope it's OK to ignore all the others.
        }
        else
@@ -3176,16 +3322,16 @@ static int relocateSection(
            struct relocation_info *reloc = &relocs[i];
            if(reloc->r_pcrel && !reloc->r_extern)
                continue;
            struct relocation_info *reloc = &relocs[i];
            if(reloc->r_pcrel && !reloc->r_extern)
                continue;
-               
+
            if(reloc->r_length == 2)
            {
                unsigned long word = 0;
                 unsigned long jumpIsland = 0;
                 long offsetToJumpIsland;
            if(reloc->r_length == 2)
            {
                unsigned long word = 0;
                 unsigned long jumpIsland = 0;
                 long offsetToJumpIsland;
-                
+
                unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
                checkProddableBlock(oc,wordPtr);
                unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
                checkProddableBlock(oc,wordPtr);
-               
+
                if(reloc->r_type == GENERIC_RELOC_VANILLA)
                {
                    word = *wordPtr;
                if(reloc->r_type == GENERIC_RELOC_VANILLA)
                {
                    word = *wordPtr;
@@ -3214,26 +3360,28 @@ static int relocateSection(
 
                if(!reloc->r_extern)
                {
 
                if(!reloc->r_extern)
                {
-                   long delta = 
+                   long delta =
                        sections[reloc->r_symbolnum-1].offset
                        - sections[reloc->r_symbolnum-1].addr
                        + ((long) image);
                        sections[reloc->r_symbolnum-1].offset
                        - sections[reloc->r_symbolnum-1].addr
                        + ((long) image);
-                   
+
                    word += delta;
                }
                else
                {
                    struct nlist *symbol = &nlist[reloc->r_symbolnum];
                    char *nm = image + symLC->stroff + symbol->n_un.n_strx;
                    word += delta;
                }
                else
                {
                    struct nlist *symbol = &nlist[reloc->r_symbolnum];
                    char *nm = image + symLC->stroff + symbol->n_un.n_strx;
-                   word = (unsigned long) (lookupSymbol(nm));
-                   if(!word)
+                   unsigned long symbolAddress = (unsigned long) (lookupSymbol(nm));
+                   if(!symbolAddress)
                    {
                        belch("\nunknown symbol `%s'", nm);
                        return 0;
                    }
                    {
                        belch("\nunknown symbol `%s'", nm);
                        return 0;
                    }
-                   
+
                    if(reloc->r_pcrel)
                    if(reloc->r_pcrel)
-                    {
+                    {  
+                        ASSERT(word == 0);
+                        word = symbolAddress;
                         jumpIsland = (long) makeJumpIsland(oc,reloc->r_symbolnum,(void*)word);
                        word -= ((long)image) + sect->offset + reloc->r_address;
                         if(jumpIsland != 0)
                         jumpIsland = (long) makeJumpIsland(oc,reloc->r_symbolnum,(void*)word);
                        word -= ((long)image) + sect->offset + reloc->r_address;
                         if(jumpIsland != 0)
@@ -3242,8 +3390,12 @@ static int relocateSection(
                                 - (((long)image) + sect->offset + reloc->r_address);
                         }
                     }
                                 - (((long)image) + sect->offset + reloc->r_address);
                         }
                     }
+                    else
+                    {
+                        word += symbolAddress;
+                    }
                }
                }
-               
+
                if(reloc->r_type == GENERIC_RELOC_VANILLA)
                {
                    *wordPtr = word;
                if(reloc->r_type == GENERIC_RELOC_VANILLA)
                {
                    *wordPtr = word;
@@ -3274,7 +3426,7 @@ static int relocateSection(
                         if(jumpIsland == 0)
                             barf("unconditional relative branch out of range: "
                                  "no jump island available");
                         if(jumpIsland == 0)
                             barf("unconditional relative branch out of range: "
                                  "no jump island available");
-                            
+
                         word = offsetToJumpIsland;
                         if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
                             barf("unconditional relative branch out of range: "
                         word = offsetToJumpIsland;
                         if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
                             barf("unconditional relative branch out of range: "
@@ -3298,7 +3450,7 @@ static int ocGetNames_MachO(ObjectCode* oc)
     struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
     unsigned i,curSymbol;
     struct segment_command *segLC = NULL;
     struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
     unsigned i,curSymbol;
     struct segment_command *segLC = NULL;
-    struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
+    struct section *sections;
     struct symtab_command *symLC = NULL;
     struct dysymtab_command *dsymLC = NULL;
     struct nlist *nlist;
     struct symtab_command *symLC = NULL;
     struct dysymtab_command *dsymLC = NULL;
     struct nlist *nlist;
@@ -3317,33 +3469,41 @@ static int ocGetNames_MachO(ObjectCode* oc)
        lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
     }
 
        lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
     }
 
-    sections = (struct section*) (segLC+1); 
+    sections = (struct section*) (segLC+1);
     nlist = (struct nlist*) (image + symLC->symoff);
 
     for(i=0;i<segLC->nsects;i++)
     {
     nlist = (struct nlist*) (image + symLC->symoff);
 
     for(i=0;i<segLC->nsects;i++)
     {
-       if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
-           la_ptrs = &sections[i];
-       else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
-           nl_ptrs = &sections[i];
-           
-           // for now, only add __text and __const to the sections table
-       else if(!strcmp(sections[i].sectname,"__text"))
-           addSection(oc, SECTIONKIND_CODE_OR_RODATA, 
+        if(sections[i].size == 0)
+            continue;
+
+        if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
+        {
+            char * zeroFillArea = stgCallocBytes(1,sections[i].size,
+                                      "ocGetNames_MachO(common symbols)");
+            sections[i].offset = zeroFillArea - image;
+        }
+
+       if(!strcmp(sections[i].sectname,"__text"))
+           addSection(oc, SECTIONKIND_CODE_OR_RODATA,
                (void*) (image + sections[i].offset),
                (void*) (image + sections[i].offset + sections[i].size));
        else if(!strcmp(sections[i].sectname,"__const"))
                (void*) (image + sections[i].offset),
                (void*) (image + sections[i].offset + sections[i].size));
        else if(!strcmp(sections[i].sectname,"__const"))
-           addSection(oc, SECTIONKIND_RWDATA, 
+           addSection(oc, SECTIONKIND_RWDATA,
                (void*) (image + sections[i].offset),
                (void*) (image + sections[i].offset + sections[i].size));
        else if(!strcmp(sections[i].sectname,"__data"))
                (void*) (image + sections[i].offset),
                (void*) (image + sections[i].offset + sections[i].size));
        else if(!strcmp(sections[i].sectname,"__data"))
-           addSection(oc, SECTIONKIND_RWDATA, 
+           addSection(oc, SECTIONKIND_RWDATA,
+               (void*) (image + sections[i].offset),
+               (void*) (image + sections[i].offset + sections[i].size));
+       else if(!strcmp(sections[i].sectname,"__bss")
+               || !strcmp(sections[i].sectname,"__common"))
+           addSection(oc, SECTIONKIND_RWDATA,
                (void*) (image + sections[i].offset),
                (void*) (image + sections[i].offset + sections[i].size));
                (void*) (image + sections[i].offset),
                (void*) (image + sections[i].offset + sections[i].size));
-               
-       if(sections[i].size > 0)    // size 0 segments do exist
-           addProddableBlock(oc, (void*) (image + sections[i].offset),
-                                           sections[i].size);
+
+        addProddableBlock(oc, (void*) (image + sections[i].offset),
+                                        sections[i].size);
     }
 
        // count external symbols defined here
     }
 
        // count external symbols defined here
@@ -3364,35 +3524,35 @@ static int ocGetNames_MachO(ObjectCode* oc)
     }
     oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
                                   "ocGetNames_MachO(oc->symbols)");
     }
     oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
                                   "ocGetNames_MachO(oc->symbols)");
-    
+
        // insert symbols into hash table
     for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
     {
        if((nlist[i].n_type & N_TYPE) == N_SECT)
        {
            char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
        // insert symbols into hash table
     for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
     {
        if((nlist[i].n_type & N_TYPE) == N_SECT)
        {
            char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
-           ghciInsertStrHashTable(oc->fileName, symhash, nm, image + 
+           ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
                sections[nlist[i].n_sect-1].offset
                - sections[nlist[i].n_sect-1].addr
                + nlist[i].n_value);
            oc->symbols[curSymbol++] = nm;
        }
     }
                sections[nlist[i].n_sect-1].offset
                - sections[nlist[i].n_sect-1].addr
                + nlist[i].n_value);
            oc->symbols[curSymbol++] = nm;
        }
     }
-    
+
        // 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;
        // 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 + 
+           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);
        }
     }
 
                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++)
     commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
     commonCounter = (unsigned long)commonStorage;
     for(i=0;i<symLC->nsyms;i++)
@@ -3402,12 +3562,12 @@ static int ocGetNames_MachO(ObjectCode* oc)
        {
            char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
            unsigned long sz = nlist[i].n_value;
        {
            char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
            unsigned long sz = nlist[i].n_value;
-           
+
            nlist[i].n_value = commonCounter;
            nlist[i].n_value = commonCounter;
-           
+
            ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
            oc->symbols[curSymbol++] = nm;
            ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
            oc->symbols[curSymbol++] = nm;
-           
+
            commonCounter += sz;
        }
     }
            commonCounter += sz;
        }
     }
@@ -3437,8 +3597,8 @@ static int ocResolve_MachO(ObjectCode* oc)
            dsymLC = (struct dysymtab_command*) lc;
        lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
     }
            dsymLC = (struct dysymtab_command*) lc;
        lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
     }
-    
-    sections = (struct section*) (segLC+1); 
+
+    sections = (struct section*) (segLC+1);
     nlist = (struct nlist*) (image + symLC->symoff);
 
     for(i=0;i<segLC->nsects;i++)
     nlist = (struct nlist*) (image + symLC->symoff);
 
     for(i=0;i<segLC->nsects;i++)
@@ -3448,7 +3608,7 @@ static int ocResolve_MachO(ObjectCode* oc)
        else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
            nl_ptrs = &sections[i];
     }
        else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
            nl_ptrs = &sections[i];
     }
-    
+
     indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
 
     if(la_ptrs)
     indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
 
     if(la_ptrs)
@@ -3457,16 +3617,33 @@ static int ocResolve_MachO(ObjectCode* oc)
     if(nl_ptrs)
        if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
            return 0;
     if(nl_ptrs)
        if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
            return 0;
-    
+
     for(i=0;i<segLC->nsects;i++)
     {
     for(i=0;i<segLC->nsects;i++)
     {
-       if(!relocateSection(oc,image,symLC,nlist,sections,&sections[i]))
+       if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,&sections[i]))
            return 0;
     }
 
     /* Free the local symbol table; we won't need it again. */
     freeHashTable(oc->lochash, NULL);
     oc->lochash = NULL;
            return 0;
     }
 
     /* Free the local symbol table; we won't need it again. */
     freeHashTable(oc->lochash, NULL);
     oc->lochash = NULL;
+
+    /*
+        Flush the data & instruction caches.
+        Because the PPC has split data/instruction caches, we have to
+        do that whenever we modify code at runtime.
+    */
+    {
+        int n = (oc->fileSize + islandSize * oc->n_islands) / 4;
+        unsigned long *p = (unsigned long*)oc->image;
+        while(n--)
+        {
+            __asm__ volatile ("dcbf 0,%0\n\tsync\n\ticbi 0,%0"
+                                : : "r" (p));
+            p++;
+        }
+        __asm__ volatile ("sync\n\tisync");
+    }
     return 1;
 }
 
     return 1;
 }
 
@@ -3483,11 +3660,11 @@ static void machoInitSymbolsWithoutUnderscore()
 {
     void *p;
 
 {
     void *p;
 
-#undef Sym    
+#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);
 #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
 
 }
     RTS_MACHO_NOUNDERLINE_SYMBOLS
 
 }
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)