[project @ 2002-02-12 15:17:13 by simonmar]
[ghc-hetmet.git] / ghc / rts / Linker.c
index f60899a..1d4711e 100644 (file)
@@ -1,7 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.58 2001/08/15 08:57:31 simonmar Exp $
+ * $Id: Linker.c,v 1.83 2002/02/12 15:17:22 simonmar Exp $
  *
- * (c) The GHC Team, 2000
+ * (c) The GHC Team, 2000, 2001
  *
  * RTS Object Linker
  *
@@ -16,6 +16,7 @@
 #include "LinkerInternals.h"
 #include "RtsUtils.h"
 #include "StoragePriv.h"
+#include "Schedule.h"
 
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>
@@ -138,44 +139,173 @@ typedef struct _RtsSymbolVal {
       Sym(mktime)                               \
       Sym(_imp___timezone)                      \
       Sym(_imp___tzname)                        \
+      Sym(_imp___iob)                           \
       Sym(localtime)                            \
       Sym(gmtime)                               \
-      SymX(getenv)                              \
-      SymX(free)                                \
-      SymX(rename)                              \
       Sym(opendir)                              \
       Sym(readdir)                              \
       Sym(closedir)                             \
-      SymX(GetCurrentProcess)                   \
-      SymX(GetProcessTimes)                     \
-      SymX(CloseHandle)                         \
-      SymX(GetExitCodeProcess)                  \
-      SymX(WaitForSingleObject)                 \
-      SymX(CreateProcessA)                      \
       Sym(__divdi3)                             \
       Sym(__udivdi3)                            \
       Sym(__moddi3)                             \
-      Sym(__umoddi3)                            \
-      SymX(_errno)
+      Sym(__umoddi3)
 #endif
 
+#ifndef SMP
+# define MAIN_CAP_SYM SymX(MainCapability)
+#else
+# define MAIN_CAP_SYM
+#endif
 
 #define RTS_SYMBOLS                            \
-      SymX(MainRegTable)                       \
-      Sym(stg_gc_enter_1)                      \
-      Sym(stg_gc_noregs)                       \
-      Sym(stg_gc_seq_1)                                \
-      Sym(stg_gc_d1)                           \
-      Sym(stg_gc_f1)                           \
-      Sym(stg_gc_ut_1_0)                       \
-      Sym(stg_gc_ut_0_1)                       \
-      Sym(stg_gc_unpt_r1)                      \
-      Sym(stg_gc_unbx_r1)                      \
-      Sym(stg_chk_0)                           \
-      Sym(stg_chk_1)                           \
-      Sym(stg_gen_chk)                         \
-      SymX(stg_exit)                           \
-      SymX(stg_update_PAP)                     \
+      Maybe_ForeignObj                         \
+      Maybe_Stable_Names                       \
+      Sym(StgReturn)                           \
+      Sym(__stginit_GHCziPrim)                 \
+      Sym(init_stack)                          \
+      SymX(__stg_chk_0)                                \
+      SymX(__stg_chk_1)                                \
+      Sym(stg_enterStackTop)                   \
+      SymX(stg_gc_d1)                          \
+      SymX(stg_gc_l1)                          \
+      SymX(__stg_gc_enter_1)                   \
+      SymX(stg_gc_f1)                          \
+      SymX(stg_gc_noregs)                      \
+      SymX(stg_gc_seq_1)                       \
+      SymX(stg_gc_unbx_r1)                     \
+      SymX(stg_gc_unpt_r1)                     \
+      SymX(stg_gc_ut_0_1)                      \
+      SymX(stg_gc_ut_1_0)                      \
+      SymX(stg_gen_chk)                                \
+      SymX(stg_yield_to_interpreter)           \
+      SymX(ErrorHdrHook)                       \
+      MAIN_CAP_SYM                              \
+      SymX(MallocFailHook)                     \
+      SymX(NoRunnableThreadsHook)              \
+      SymX(OnExitHook)                         \
+      SymX(OutOfHeapHook)                      \
+      SymX(PatErrorHdrHook)                    \
+      SymX(PostTraceHook)                      \
+      SymX(PreTraceHook)                       \
+      SymX(StackOverflowHook)                  \
+      SymX(__encodeDouble)                     \
+      SymX(__encodeFloat)                      \
+      SymX(__gmpn_gcd_1)                       \
+      SymX(__gmpz_cmp)                         \
+      SymX(__gmpz_cmp_si)                      \
+      SymX(__gmpz_cmp_ui)                      \
+      SymX(__gmpz_get_si)                      \
+      SymX(__gmpz_get_ui)                      \
+      SymX(__int_encodeDouble)                 \
+      SymX(__int_encodeFloat)                  \
+      SymX(andIntegerzh_fast)                  \
+      SymX(blockAsyncExceptionszh_fast)                \
+      SymX(catchzh_fast)                       \
+      SymX(cmp_thread)                         \
+      SymX(complementIntegerzh_fast)           \
+      SymX(cmpIntegerzh_fast)                  \
+      SymX(cmpIntegerIntzh_fast)               \
+      SymX(createAdjustor)                     \
+      SymX(decodeDoublezh_fast)                        \
+      SymX(decodeFloatzh_fast)                 \
+      SymX(defaultsHook)                       \
+      SymX(delayzh_fast)                       \
+      SymX(deRefWeakzh_fast)                   \
+      SymX(deRefStablePtrzh_fast)              \
+      SymX(divExactIntegerzh_fast)             \
+      SymX(divModIntegerzh_fast)               \
+      SymX(forkzh_fast)                                \
+      SymX(freeHaskellFunctionPtr)             \
+      SymX(freeStablePtr)                      \
+      SymX(gcdIntegerzh_fast)                  \
+      SymX(gcdIntegerIntzh_fast)               \
+      SymX(gcdIntzh_fast)                      \
+      SymX(getProgArgv)                                \
+      SymX(getStablePtr)                       \
+      SymX(int2Integerzh_fast)                 \
+      SymX(integer2Intzh_fast)                 \
+      SymX(integer2Wordzh_fast)                        \
+      SymX(isDoubleDenormalized)               \
+      SymX(isDoubleInfinite)                   \
+      SymX(isDoubleNaN)                                \
+      SymX(isDoubleNegativeZero)               \
+      SymX(isEmptyMVarzh_fast)                 \
+      SymX(isFloatDenormalized)                        \
+      SymX(isFloatInfinite)                    \
+      SymX(isFloatNaN)                         \
+      SymX(isFloatNegativeZero)                        \
+      SymX(killThreadzh_fast)                  \
+      SymX(makeStablePtrzh_fast)               \
+      SymX(minusIntegerzh_fast)                        \
+      SymX(mkApUpd0zh_fast)                    \
+      SymX(myThreadIdzh_fast)                  \
+      SymX(newArrayzh_fast)                    \
+      SymX(newBCOzh_fast)                      \
+      SymX(newByteArrayzh_fast)                        \
+      SymX(newCAF)                             \
+      SymX(newMVarzh_fast)                     \
+      SymX(newMutVarzh_fast)                   \
+      SymX(newPinnedByteArrayzh_fast)          \
+      SymX(orIntegerzh_fast)                   \
+      SymX(performGC)                          \
+      SymX(plusIntegerzh_fast)                 \
+      SymX(prog_argc)                          \
+      SymX(prog_argv)                          \
+      SymX(putMVarzh_fast)                     \
+      SymX(quotIntegerzh_fast)                 \
+      SymX(quotRemIntegerzh_fast)              \
+      SymX(raisezh_fast)                       \
+      SymX(remIntegerzh_fast)                  \
+      SymX(resetNonBlockingFd)                 \
+      SymX(resumeThread)                       \
+      SymX(rts_apply)                          \
+      SymX(rts_checkSchedStatus)               \
+      SymX(rts_eval)                           \
+      SymX(rts_evalIO)                         \
+      SymX(rts_evalLazyIO)                     \
+      SymX(rts_eval_)                          \
+      SymX(rts_getAddr)                                \
+      SymX(rts_getBool)                                \
+      SymX(rts_getChar)                                \
+      SymX(rts_getDouble)                      \
+      SymX(rts_getFloat)                       \
+      SymX(rts_getInt)                         \
+      SymX(rts_getInt32)                       \
+      SymX(rts_getPtr)                         \
+      SymX(rts_getStablePtr)                   \
+      SymX(rts_getThreadId)                    \
+      SymX(rts_getWord)                                \
+      SymX(rts_getWord32)                      \
+      SymX(rts_mkAddr)                         \
+      SymX(rts_mkBool)                         \
+      SymX(rts_mkChar)                         \
+      SymX(rts_mkDouble)                       \
+      SymX(rts_mkFloat)                                \
+      SymX(rts_mkInt)                          \
+      SymX(rts_mkInt16)                                \
+      SymX(rts_mkInt32)                                \
+      SymX(rts_mkInt64)                                \
+      SymX(rts_mkInt8)                         \
+      SymX(rts_mkPtr)                          \
+      SymX(rts_mkStablePtr)                    \
+      SymX(rts_mkString)                       \
+      SymX(rts_mkWord)                         \
+      SymX(rts_mkWord16)                       \
+      SymX(rts_mkWord32)                       \
+      SymX(rts_mkWord64)                       \
+      SymX(rts_mkWord8)                                \
+      SymX(run_queue_hd)                       \
+      SymX(setProgArgv)                                \
+      SymX(shutdownHaskellAndExit)             \
+      SymX(stable_ptr_table)                   \
+      SymX(stackOverflow)                      \
+      SymX(stg_CAF_BLACKHOLE_info)             \
+      SymX(stg_CHARLIKE_closure)               \
+      SymX(stg_EMPTY_MVAR_info)                        \
+      SymX(stg_IND_STATIC_info)                        \
+      SymX(stg_INTLIKE_closure)                        \
+      SymX(stg_MUT_ARR_PTRS_FROZEN_info)       \
+      SymX(stg_WEAK_info)                       \
       SymX(stg_ap_1_upd_info)                  \
       SymX(stg_ap_2_upd_info)                  \
       SymX(stg_ap_3_upd_info)                  \
@@ -184,7 +314,14 @@ typedef struct _RtsSymbolVal {
       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_sel_11_upd_info)                        \
+      SymX(stg_sel_12_upd_info)                        \
+      SymX(stg_sel_13_upd_info)                        \
+      SymX(stg_sel_14_upd_info)                        \
+      SymX(stg_sel_15_upd_info)                        \
       SymX(stg_sel_1_upd_info)                 \
       SymX(stg_sel_2_upd_info)                 \
       SymX(stg_sel_3_upd_info)                 \
@@ -194,146 +331,21 @@ typedef struct _RtsSymbolVal {
       SymX(stg_sel_7_upd_info)                 \
       SymX(stg_sel_8_upd_info)                 \
       SymX(stg_sel_9_upd_info)                 \
-      SymX(stg_sel_10_upd_info)                        \
-      SymX(stg_sel_11_upd_info)                        \
-      SymX(stg_sel_12_upd_info)                        \
-      SymX(stg_sel_13_upd_info)                        \
-      SymX(stg_sel_14_upd_info)                        \
-      SymX(stg_sel_15_upd_info)                        \
-      SymX(stg_upd_frame_info)                 \
       SymX(stg_seq_frame_info)                 \
-      SymX(stg_CAF_BLACKHOLE_info)             \
-      SymX(stg_IND_STATIC_info)                        \
-      SymX(stg_EMPTY_MVAR_info)                        \
-      SymX(stg_MUT_ARR_PTRS_FROZEN_info)       \
-      SymX(stg_WEAK_info)                       \
-      SymX(stg_CHARLIKE_closure)               \
-      SymX(stg_INTLIKE_closure)                        \
-      SymX(newCAF)                             \
-      SymX(newBCOzh_fast)                      \
-      SymX(mkApUpd0zh_fast)                    \
-      SymX(putMVarzh_fast)                     \
-      SymX(newMVarzh_fast)                     \
+      SymX(stg_upd_frame_info)                 \
+      SymX(__stg_update_PAP)                   \
+      SymX(suspendThread)                      \
       SymX(takeMVarzh_fast)                    \
-      SymX(tryTakeMVarzh_fast)                 \
+      SymX(timesIntegerzh_fast)                        \
       SymX(tryPutMVarzh_fast)                  \
-      SymX(catchzh_fast)                       \
-      SymX(raisezh_fast)                       \
-      SymX(forkzh_fast)                                \
-      SymX(delayzh_fast)                       \
-      SymX(yieldzh_fast)                       \
-      SymX(killThreadzh_fast)                  \
+      SymX(tryTakeMVarzh_fast)                 \
+      SymX(unblockAsyncExceptionszh_fast)      \
+      SymX(unsafeThawArrayzh_fast)             \
       SymX(waitReadzh_fast)                    \
       SymX(waitWritezh_fast)                   \
-      SymX(suspendThread)                      \
-      SymX(resumeThread)                       \
-      SymX(stackOverflow)                      \
-      SymX(int2Integerzh_fast)                 \
       SymX(word2Integerzh_fast)                        \
-      Maybe_ForeignObj                         \
-      SymX(__encodeDouble)                     \
-      SymX(decodeDoublezh_fast)                        \
-      SymX(decodeFloatzh_fast)                 \
-      SymX(gcdIntegerzh_fast)                  \
-      SymX(newArrayzh_fast)                    \
-      SymX(unsafeThawArrayzh_fast)             \
-      SymX(newByteArrayzh_fast)                        \
-      SymX(newPinnedByteArrayzh_fast)          \
-      SymX(newMutVarzh_fast)                   \
-      SymX(quotRemIntegerzh_fast)              \
-      SymX(quotIntegerzh_fast)                 \
-      SymX(remIntegerzh_fast)                  \
-      SymX(divExactIntegerzh_fast)             \
-      SymX(divModIntegerzh_fast)               \
-      SymX(timesIntegerzh_fast)                        \
-      SymX(minusIntegerzh_fast)                        \
-      SymX(plusIntegerzh_fast)                 \
-      SymX(andIntegerzh_fast)                  \
-      SymX(orIntegerzh_fast)                   \
       SymX(xorIntegerzh_fast)                  \
-      SymX(complementIntegerzh_fast)           \
-      Maybe_Stable_Names                       \
-      SymX(blockAsyncExceptionszh_fast)                \
-      SymX(unblockAsyncExceptionszh_fast)      \
-      SymX(isDoubleNaN)                                \
-      SymX(isDoubleInfinite)                   \
-      SymX(isDoubleDenormalized)               \
-      SymX(isDoubleNegativeZero)               \
-      SymX(__encodeFloat)                      \
-      SymX(isFloatNaN)                         \
-      SymX(isFloatInfinite)                    \
-      SymX(isFloatDenormalized)                        \
-      SymX(isFloatNegativeZero)                        \
-      SymX(__int_encodeFloat)                  \
-      SymX(__int_encodeDouble)                 \
-      SymX(__gmpz_cmp_si)                      \
-      SymX(__gmpz_cmp_ui)                      \
-      SymX(__gmpz_cmp)                         \
-      SymX(__gmpn_gcd_1)                       \
-      SymX(__gmpz_get_si)                      \
-      SymX(__gmpz_get_ui)                      \
-      SymX(prog_argv)                          \
-      SymX(prog_argc)                          \
-      SymX(getProgArgv)                                \
-      SymX(setProgArgv)                                \
-      SymX(resetNonBlockingFd)                 \
-      SymX(performGC)                          \
-      SymX(getStablePtr)                       \
-      SymX(stable_ptr_table)                   \
-      SymX(shutdownHaskellAndExit)             \
-      Sym(stg_enterStackTop)                   \
-      Sym(stg_yield_to_interpreter)            \
-      Sym(StgReturn)                           \
-      Sym(init_stack)                          \
-      SymX(cmp_thread)                         \
-      Sym(__init_PrelGHC)                      \
-      SymX(freeHaskellFunctionPtr)             \
-      SymX(OnExitHook)                         \
-      SymX(ErrorHdrHook)                       \
-      SymX(NoRunnableThreadsHook)              \
-      SymX(StackOverflowHook)                  \
-      SymX(OutOfHeapHook)                      \
-      SymX(MallocFailHook)                     \
-      SymX(PatErrorHdrHook)                    \
-      SymX(defaultsHook)                       \
-      SymX(PreTraceHook)                       \
-      SymX(PostTraceHook)                      \
-      SymX(createAdjustor)                     \
-      SymX(rts_mkChar)                         \
-      SymX(rts_mkInt)                          \
-      SymX(rts_mkInt8)                         \
-      SymX(rts_mkInt16)                                \
-      SymX(rts_mkInt32)                                \
-      SymX(rts_mkInt64)                                \
-      SymX(rts_mkWord)                         \
-      SymX(rts_mkWord8)                                \
-      SymX(rts_mkWord16)                       \
-      SymX(rts_mkWord32)                       \
-      SymX(rts_mkWord64)                       \
-      SymX(rts_mkPtr)                          \
-      SymX(rts_mkFloat)                                \
-      SymX(rts_mkDouble)                       \
-      SymX(rts_mkStablePtr)                    \
-      SymX(rts_mkBool)                         \
-      SymX(rts_mkString)                       \
-      SymX(rts_apply)                          \
-      SymX(rts_mkAddr)                         \
-      SymX(rts_getChar)                                \
-      SymX(rts_getInt)                         \
-      SymX(rts_getInt32)                       \
-      SymX(rts_getWord)                                \
-      SymX(rts_getWord32)                      \
-      SymX(rts_getPtr)                         \
-      SymX(rts_getFloat)                       \
-      SymX(rts_getDouble)                      \
-      SymX(rts_getStablePtr)                   \
-      SymX(rts_getBool)                                \
-      SymX(rts_getAddr)                                \
-      SymX(rts_eval)                           \
-      SymX(rts_eval_)                          \
-      SymX(rts_evalIO)                         \
-      SymX(rts_evalLazyIO)                     \
-      SymX(rts_checkSchedStatus)
+      SymX(yieldzh_fast)
 
 #ifndef SUPPORT_LONG_LONGS
 #define RTS_LONG_LONG_SYMS /* nothing */
@@ -372,6 +384,40 @@ static RtsSymbolVal rtsSyms[] = {
 };
 
 /* -----------------------------------------------------------------------------
+ * Insert symbols into hash tables, checking for duplicates.
+ */
+static void ghciInsertStrHashTable ( char* obj_name,
+                                     HashTable *table,
+                                     char* key, 
+                                     void *data
+                                  )
+{
+   if (lookupHashTable(table, (StgWord)key) == NULL)
+   {
+      insertStrHashTable(table, (StgWord)key, data);
+      return;
+   }
+   fprintf(stderr, 
+      "\n\n"
+      "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
+      "   %s\n"
+      "whilst processing object file\n"
+      "   %s\n"
+      "This could be caused by:\n"
+      "   * Loading two different object files which export the same symbol\n"
+      "   * Specifying the same object file twice on the GHCi command line\n"
+      "   * An incorrect `package.conf' entry, causing some object to be\n"
+      "     loaded twice.\n"
+      "GHCi cannot safely continue in this situation.  Exiting now.  Sorry.\n"
+      "\n",
+      (char*)key,
+      obj_name
+   );
+   exit(1);
+}
+
+
+/* -----------------------------------------------------------------------------
  * initialize the object linker
  */
 #if defined(OBJFORMAT_ELF)
@@ -387,7 +433,8 @@ initLinker( void )
 
     /* populate the symbol table with stuff from the RTS */
     for (sym = rtsSyms; sym->lbl != NULL; sym++) {
-       insertStrHashTable(symhash, sym->lbl, sym->addr);
+       ghciInsertStrHashTable("(GHCi built-in symbols)",
+                               symhash, sym->lbl, sym->addr);
     }
 #   if defined(OBJFORMAT_ELF)
     dl_prog_handle = dlopen(NULL, RTLD_LAZY);
@@ -424,7 +471,7 @@ static OpenedDLL* opened_dlls = NULL;
 
 
 char*
-addDLL ( char* path, char* dll_name )
+addDLL ( __attribute((unused)) char* path, char* dll_name )
 {
 #  if defined(OBJFORMAT_ELF)
    void *hdl;
@@ -505,18 +552,24 @@ lookupSymbol( char *lbl )
         OpenedDLL* o_dll;
         void* sym;
         for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
-           /* fprintf(stderr, "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) return sym;
-          }
+         /* fprintf(stderr, "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) {
+               /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
+               return sym;
+             } 
+           }
            sym = GetProcAddress(o_dll->instance, lbl);
-           if (sym != NULL) return sym;
+           if (sym != NULL) {
+            /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
+            return sym;
+          }
         }
         return NULL;
 #       else
@@ -529,6 +582,7 @@ lookupSymbol( char *lbl )
 }
 
 static 
+__attribute((unused))
 void *
 lookupLocalSymbol( ObjectCode* oc, char *lbl )
 {
@@ -544,6 +598,42 @@ lookupLocalSymbol( ObjectCode* oc, char *lbl )
 
 
 /* -----------------------------------------------------------------------------
+ * Debugging aid: look in GHCi's object symbol tables for symbols
+ * within DELTA bytes of the specified address, and show their names.
+ */
+#ifdef DEBUG
+void ghci_enquire ( char* addr );
+
+void ghci_enquire ( char* addr )
+{
+   int   i;
+   char* sym;
+   char* a;
+   const int DELTA = 64;
+   ObjectCode* oc;
+   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); */
+         a = NULL;
+         if (oc->lochash != NULL)
+            a = lookupStrHashTable(oc->lochash, sym);
+         if (a == NULL)
+            a = lookupStrHashTable(symhash, sym);
+         if (a == NULL) {
+            /* 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);
+         }
+      }
+   }
+}
+#endif
+
+
+/* -----------------------------------------------------------------------------
  * Load an obj (populate the global symbol table, but don't resolve yet)
  *
  * Returns: 1 if ok, 0 on error.
@@ -557,14 +647,27 @@ loadObj( char *path )
    FILE *f;
 
    /* fprintf(stderr, "loadObj %s\n", path ); */
-#  ifdef DEBUG
-   /* assert that we haven't already loaded this object */
+
+   /* Check that we haven't already loaded this object.  Don't give up
+      at this stage; ocGetNames_* will barf later. */
    { 
        ObjectCode *o;
-       for (o = objects; o; o = o->next)
-          ASSERT(strcmp(o->fileName, path));
+       int is_dup = 0;
+       for (o = objects; o; o = o->next) {
+          if (0 == strcmp(o->fileName, path))
+             is_dup = 1;
+       }
+       if (is_dup) {
+        fprintf(stderr, 
+            "\n\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);
+       }
    }
-#  endif /* DEBUG */   
 
    oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
 
@@ -589,6 +692,7 @@ loadObj( char *path )
    oc->symbols           = NULL;
    oc->sections          = NULL;
    oc->lochash           = allocStrHashTable();
+   oc->proddables        = NULL;
 
    /* chain it onto the list of objects */
    oc->next              = objects;
@@ -709,6 +813,58 @@ unloadObj( char *path )
     return 0;
 }
 
+/* -----------------------------------------------------------------------------
+ * Sanity checking.  For each ObjectCode, maintain a list of address ranges
+ * which may be prodded during relocation, and abort if we try and write
+ * outside any of these.
+ */
+static void addProddableBlock ( ObjectCode* oc, void* start, int size )
+{
+   ProddableBlock* pb 
+      = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
+   /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
+   ASSERT(size > 0);
+   pb->start      = start;
+   pb->size       = size;
+   pb->next       = oc->proddables;
+   oc->proddables = pb;
+}
+
+static void checkProddableBlock ( ObjectCode* oc, void* addr )
+{
+   ProddableBlock* pb;
+   for (pb = oc->proddables; pb != NULL; pb = pb->next) {
+      char* s = (char*)(pb->start);
+      char* e = s + pb->size - 1;
+      char* a = (char*)addr;
+      /* Assumes that the biggest fixup involves a 4-byte write.  This
+         probably needs to be changed to 8 (ie, +7) on 64-bit
+         plats. */
+      if (a >= s && (a+3) <= e) return;
+   }
+   barf("checkProddableBlock: invalid fixup in runtime linker");
+}
+
+/* -----------------------------------------------------------------------------
+ * Section management.
+ */
+static void addSection ( ObjectCode* oc, SectionKind kind,
+                         void* start, void* end )
+{
+   Section* s   = stgMallocBytes(sizeof(Section), "addSection");
+   s->start     = start;
+   s->end       = end;
+   s->kind      = kind;
+   s->next      = oc->sections;
+   oc->sections = s;
+   /* 
+   fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n", 
+                   start, ((char*)end)-1, end - start + 1, kind ); 
+   */
+}
+
+
+
 /* --------------------------------------------------------------------------
  * PEi386 specifics (Win32 targets)
  * ------------------------------------------------------------------------*/
@@ -718,6 +874,33 @@ unloadObj( char *path )
       and Common Object File Format Specification
       revision 5.1 January 1998
    which SimonM says comes from the MS Developer Network CDs.
+   
+   It can be found there (on older CDs), but can also be found 
+   online at:
+
+      http://www.microsoft.com/hwdev/hardware/PECOFF.asp
+
+   (this is Rev 6.0 from February 1999).
+
+   Things move, so if that fails, try searching for it via
+
+      http://www.google.com/search?q=PE+COFF+specification     
+
+   The ultimate reference for the PE format is the Winnt.h 
+   header file that comes with the Platform SDKs; as always,
+   implementations will drift wrt their documentation.
+   
+   A good background article on the PE format is Matt Pietrek's
+   March 1994 article in Microsoft System Journal (MSJ)
+   (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
+   Win32 Portable Executable File Format." The info in there
+   has recently been updated in a two part article in 
+   MSDN magazine, issues Feb and March 2002,
+   "Inside Windows: An In-Depth Look into the Win32 Portable
+   Executable File Format"
+
+   John Levine's book "Linkers and Loaders" contains useful
+   info on PE too.
 */
       
 
@@ -809,6 +992,7 @@ typedef
 /* From PE spec doc, section 4.1 */
 #define MYIMAGE_SCN_CNT_CODE             0x00000020
 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
+#define MYIMAGE_SCN_LNK_NRELOC_OVFL      0x01000000
 
 /* From PE spec doc, section 5.2.1 */
 #define MYIMAGE_REL_I386_DIR32           0x0006
@@ -942,7 +1126,8 @@ zapTrailingAtSign ( UChar* sym )
 static int
 ocVerifyImage_PEi386 ( ObjectCode* oc )
 {
-   int i, j;
+   int i;
+   UInt32 j, noRelocs;
    COFF_header*  hdr;
    COFF_section* sectab;
    COFF_symbol*  symtab;
@@ -981,11 +1166,19 @@ ocVerifyImage_PEi386 ( ObjectCode* oc )
             (int)(hdr->Characteristics));
       return 0;
    }
+   /* If the string table size is way crazy, this might indicate that
+      there are more than 64k relocations, despite claims to the
+      contrary.  Hence this test. */
    /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
-   if (* (UInt32*)strtab > 510000) {
+#if 0
+   if ( (*(UInt32*)strtab) > 600000 ) {
+      /* Note that 600k has no special significance other than being
+         big enough to handle the almost-2MB-sized lumps that
+         constitute HSwin32*.o. */
       belch("PEi386 object has suspiciously large string table; > 64k relocs?");
       return 0;
    }
+#endif
 
    /* No further verification after this point; only debug printing. */
    i = 0;
@@ -1036,19 +1229,36 @@ ocVerifyImage_PEi386 ( ObjectCode* oc )
                 "  data sz %d\n"
                 " data off %d\n"
                 "  num rel %d\n"
-                "  off rel %d\n",
+                "  off rel %d\n"
+                "  ptr raw 0x%x\n",
                 sectab_i->VirtualSize,
                 sectab_i->VirtualAddress,
                 sectab_i->SizeOfRawData,
                 sectab_i->PointerToRawData,
                 sectab_i->NumberOfRelocations,
-                sectab_i->PointerToRelocations
+                sectab_i->PointerToRelocations,
+                sectab_i->PointerToRawData
               );
       reltab = (COFF_reloc*) (
                   ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
                );
+              
+      if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
+       /* If the relocation field (a short) has overflowed, the
+        * real count can be found in the first reloc entry.
+        * 
+        * See Section 4.1 (last para) of the PE spec (rev6.0).
+        */
+        COFF_reloc* rel = (COFF_reloc*)
+                           myindex ( sizeof_COFF_reloc, reltab, 0 );
+       noRelocs = rel->VirtualAddress;
+       j = 1;
+      } else {
+       noRelocs = sectab_i->NumberOfRelocations;
+        j = 0;
+      }
 
-      for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
+      for (; j < noRelocs; j++) {
          COFF_symbol* sym;
          COFF_reloc* rel = (COFF_reloc*)
                            myindex ( sizeof_COFF_reloc, reltab, j );
@@ -1058,12 +1268,13 @@ ocVerifyImage_PEi386 ( ObjectCode* oc )
                    rel->VirtualAddress );
          sym = (COFF_symbol*)
                myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
+        /* Hmm..mysterious looking offset - what's it for? SOF */
          printName ( sym->Name, strtab -10 );
          fprintf ( stderr, "'\n" );
       }
+
       fprintf ( stderr, "\n" );
    }
-
    fprintf ( stderr, "\n" );
    fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
    fprintf ( stderr, "---START of string table---\n");
@@ -1090,12 +1301,12 @@ ocVerifyImage_PEi386 ( ObjectCode* oc )
       fprintf ( stderr, 
                 "'\n"
                 "    value 0x%x\n"
-                "     sec# %d\n"
+                "   1+sec# %d\n"
                 "     type 0x%x\n"
                 "   sclass 0x%x\n"
                 "     nAux %d\n",
                 symtab_i->Value,
-                (Int32)(symtab_i->SectionNumber) - 1,
+                (Int32)(symtab_i->SectionNumber),
                 (UInt32)symtab_i->Type,
                 (UInt32)symtab_i->StorageClass,
                 (UInt32)symtab_i->NumberOfAuxSymbols 
@@ -1134,62 +1345,31 @@ ocGetNames_PEi386 ( ObjectCode* oc )
             + hdr->PointerToSymbolTable
             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
 
-   /* Copy exported symbols into the ObjectCode. */
-
-   oc->n_symbols = hdr->NumberOfSymbols;
-   oc->symbols   = stgMallocBytes(oc->n_symbols * sizeof(char*),
-                                  "ocGetNames_PEi386(oc->symbols)");
-   /* Call me paranoid; I don't care. */
-   for (i = 0; i < oc->n_symbols; i++) 
-      oc->symbols[i] = NULL;
+   /* Allocate space for any (local, anonymous) .bss sections. */
 
-   i = 0;
-   while (1) {
-      COFF_symbol* symtab_i;
-      if (i >= (Int32)(hdr->NumberOfSymbols)) break;
-      symtab_i = (COFF_symbol*)
-                 myindex ( sizeof_COFF_symbol, symtab, i );
-
-      if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL &&
-          symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
-
-         /* This symbol is global and defined, viz, exported */
-         COFF_section* sectabent;
-
-         /* cstring_from_COFF_symbol_name always succeeds. */
-         sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
-
-         /* for MYIMAGE_SYMCLASS_EXTERNAL 
-                && !MYIMAGE_SYM_UNDEFINED,
-            the address of the symbol is: 
-                address of relevant section + offset in section
-         */
-         sectabent = (COFF_section*)
-                     myindex ( sizeof_COFF_section, 
-                               sectab,
-                               symtab_i->SectionNumber-1 );
-         addr = ((UChar*)(oc->image))
-                + (sectabent->PointerToRawData
-                   + symtab_i->Value);
-         /* fprintf(stderr,"addSymbol %p `%s'\n", addr,sname); */
-         IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
-         ASSERT(i >= 0 && i < oc->n_symbols);
-         oc->symbols[i] = sname;
-         insertStrHashTable(symhash, sname, addr);
-      }
-      i += symtab_i->NumberOfAuxSymbols;
-      i++;
+   for (i = 0; i < hdr->NumberOfSections; i++) {
+      UChar* zspace;
+      COFF_section* sectab_i
+         = (COFF_section*)
+           myindex ( sizeof_COFF_section, sectab, i );
+      if (0 != strcmp(sectab_i->Name, ".bss")) continue;
+      if (sectab_i->VirtualSize == 0) continue;
+      /* This is a non-empty .bss section.  Allocate zeroed space for
+         it, and set its PointerToRawData field such that oc->image +
+         PointerToRawData == addr_of_zeroed_space.  */
+      zspace = stgCallocBytes(1, sectab_i->VirtualSize, 
+                              "ocGetNames_PEi386(anonymous bss)");
+      sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
+      addProddableBlock(oc, zspace, sectab_i->VirtualSize);
+      /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
    }
 
    /* Copy section information into the ObjectCode. */
 
-   oc->n_sections = hdr->NumberOfSections;
-   oc->sections = stgMallocBytes( oc->n_sections * sizeof(Section), 
-                                  "ocGetNamesPEi386" );
-
-   for (i = 0; i < oc->n_sections; i++) {
+   for (i = 0; i < hdr->NumberOfSections; i++) {
       UChar* start;
       UChar* end;
+      UInt32 sz;
 
       SectionKind kind 
          = SECTIONKIND_OTHER;
@@ -1198,7 +1378,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
            myindex ( sizeof_COFF_section, sectab, i );
       IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
 
-#if 0
+#     if 0
       /* I'm sure this is the Right Way to do it.  However, the 
          alternative of testing the sectab_i->Name field seems to
          work ok with Cygwin.
@@ -1206,7 +1386,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
       if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE || 
           sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
          kind = SECTIONKIND_CODE_OR_RODATA;
-#endif
+#     endif
 
       if (0==strcmp(".text",sectab_i->Name) ||
           0==strcmp(".rodata",sectab_i->Name))
@@ -1215,19 +1395,110 @@ ocGetNames_PEi386 ( ObjectCode* oc )
           0==strcmp(".bss",sectab_i->Name))
          kind = SECTIONKIND_RWDATA;
 
-      start = ((UChar*)(oc->image)) 
-              + sectab_i->PointerToRawData;
-      end   = start 
-              + sectab_i->SizeOfRawData - 1;
+      ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
+      sz = sectab_i->SizeOfRawData;
+      if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
+
+      start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
+      end   = start + sz - 1;
 
-      if (kind == SECTIONKIND_OTHER) {
+      if (kind == SECTIONKIND_OTHER
+          /* Ignore sections called which contain stabs debugging
+             information. */
+          && 0 != strcmp(".stab", sectab_i->Name)
+          && 0 != strcmp(".stabstr", sectab_i->Name)
+         ) {
          belch("Unknown PEi386 section name `%s'", sectab_i->Name);
          return 0;
       }
 
-      oc->sections[i].start = start;
-      oc->sections[i].end   = end;
-      oc->sections[i].kind  = kind;
+      if (kind != SECTIONKIND_OTHER && end >= start) {
+         addSection(oc, kind, start, end);
+         addProddableBlock(oc, start, end - start + 1);
+      }
+   }
+
+   /* Copy exported symbols into the ObjectCode. */
+
+   oc->n_symbols = hdr->NumberOfSymbols;
+   oc->symbols   = stgMallocBytes(oc->n_symbols * sizeof(char*),
+                                  "ocGetNames_PEi386(oc->symbols)");
+   /* Call me paranoid; I don't care. */
+   for (i = 0; i < oc->n_symbols; i++) 
+      oc->symbols[i] = NULL;
+
+   i = 0;
+   while (1) {
+      COFF_symbol* symtab_i;
+      if (i >= (Int32)(hdr->NumberOfSymbols)) break;
+      symtab_i = (COFF_symbol*)
+                 myindex ( sizeof_COFF_symbol, symtab, i );
+
+      addr  = NULL;
+
+      if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
+          && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
+         /* This symbol is global and defined, viz, exported */
+         /* for MYIMAGE_SYMCLASS_EXTERNAL 
+                && !MYIMAGE_SYM_UNDEFINED,
+            the address of the symbol is: 
+                address of relevant section + offset in section
+         */
+         COFF_section* sectabent 
+            = (COFF_section*) myindex ( sizeof_COFF_section, 
+                                        sectab,
+                                        symtab_i->SectionNumber-1 );
+         addr = ((UChar*)(oc->image))
+                + (sectabent->PointerToRawData
+                   + symtab_i->Value);
+      } 
+      else
+      if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
+         && symtab_i->Value > 0) {
+         /* This symbol isn't in any section at all, ie, global bss.
+            Allocate zeroed space for it. */
+         addr = stgCallocBytes(1, symtab_i->Value, 
+                               "ocGetNames_PEi386(non-anonymous bss)");
+         addSection(oc, SECTIONKIND_RWDATA, addr, 
+                        ((UChar*)addr) + symtab_i->Value - 1);
+         addProddableBlock(oc, addr, symtab_i->Value);
+         /* fprintf(stderr, "BSS      section at 0x%x\n", addr); */
+      }
+
+      if (addr != NULL ) {
+         sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
+         /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname);  */
+         IF_DEBUG(linker, belch("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);
+      } else {
+#        if 0
+         fprintf ( stderr, 
+                   "IGNORING symbol %d\n"
+                   "     name `",
+                   i 
+                 );
+         printName ( symtab_i->Name, strtab );
+         fprintf ( stderr, 
+                   "'\n"
+                   "    value 0x%x\n"
+                   "   1+sec# %d\n"
+                   "     type 0x%x\n"
+                   "   sclass 0x%x\n"
+                   "     nAux %d\n",
+                   symtab_i->Value,
+                   (Int32)(symtab_i->SectionNumber),
+                   (UInt32)symtab_i->Type,
+                   (UInt32)symtab_i->StorageClass,
+                   (UInt32)symtab_i->NumberOfAuxSymbols 
+                 );
+#        endif
+      }
+
+      i += symtab_i->NumberOfAuxSymbols;
+      i++;
    }
 
    return 1;   
@@ -1246,7 +1517,8 @@ ocResolve_PEi386 ( ObjectCode* oc )
    UInt32        S;
    UInt32*       pP;
 
-   int i, j;
+   int i;
+   UInt32 j, noRelocs;
 
    /* ToDo: should be variable-sized?  But is at least safe in the
       sense of buffer-overrun-proof. */
@@ -1274,7 +1546,31 @@ ocResolve_PEi386 ( ObjectCode* oc )
          = (COFF_reloc*) (
               ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
            );
-      for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
+
+      /* Ignore sections called which contain stabs debugging
+         information. */
+      if (0 == strcmp(".stab", sectab_i->Name)
+          || 0 == strcmp(".stabstr", sectab_i->Name))
+         continue;
+
+      if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
+       /* If the relocation field (a short) has overflowed, the
+        * real count can be found in the first reloc entry.
+         *
+        * See Section 4.1 (last para) of the PE spec (rev6.0).
+        */
+        COFF_reloc* rel = (COFF_reloc*)
+                           myindex ( sizeof_COFF_reloc, reltab, 0 );
+       noRelocs = rel->VirtualAddress;
+       fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
+       j = 1;
+      } else {
+       noRelocs = sectab_i->NumberOfRelocations;
+        j = 0;
+      }
+
+
+      for (; j < noRelocs; j++) {
          COFF_symbol* sym;
          COFF_reloc* reltab_j 
             = (COFF_reloc*)
@@ -1315,16 +1611,20 @@ ocResolve_PEi386 ( ObjectCode* oc )
                    + sym->Value);
          } else {
             copyName ( sym->Name, strtab, symbol, 1000-1 );
+            (void*)S = lookupLocalSymbol( oc, symbol );
+            if ((void*)S != NULL) goto foundit;
+            (void*)S = lookupSymbol( symbol );
+            if ((void*)S != NULL) goto foundit;
             zapTrailingAtSign ( symbol );
             (void*)S = lookupLocalSymbol( oc, symbol );
-            if ((void*)S == NULL)
-               (void*)S = lookupSymbol( symbol );
-            if (S == 0) {
-               belch("%s: unknown symbol `%s'", oc->fileName, symbol);
-               return 0;
-            }
+            if ((void*)S != NULL) goto foundit;
+            (void*)S = lookupSymbol( symbol );
+            if ((void*)S != NULL) goto foundit;
+            belch("%s: unknown symbol `%s'", oc->fileName, symbol);
+            return 0;
+           foundit:
          }
-
+         checkProddableBlock(oc, pP);
          switch (reltab_j->Type) {
             case MYIMAGE_REL_I386_DIR32: 
                *pP = A + S; 
@@ -1379,18 +1679,25 @@ ocResolve_PEi386 ( ObjectCode* oc )
  */
 
 #include <elf.h>
+#include <ctype.h>
 
 static char *
 findElfSection ( void* objImage, Elf32_Word sh_type )
 {
    int i;
    char* ehdrC = (char*)objImage;
-   Elf32_Ehdr* ehdr = ( Elf32_Ehdr*)ehdrC;
-   Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
+   Elf32_Ehdr* ehdr = (Elf32_Ehdr*)ehdrC;
+   Elf32_Shdr* shdr = (Elf32_Shdr*)(ehdrC + ehdr->e_shoff);
+   char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
    char* ptr = NULL;
    for (i = 0; i < ehdr->e_shnum; i++) {
-      if (shdr[i].sh_type == sh_type &&
-          i !=  ehdr->e_shstrndx) {
+      if (shdr[i].sh_type == sh_type
+          /* Ignore the section header's string table. */
+          && i != ehdr->e_shstrndx
+         /* Ignore string tables named .stabstr, as they contain
+             debugging info. */
+          && 0 != strncmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
+         ) {
          ptr = ehdrC + shdr[i].sh_offset;
          break;
       }
@@ -1494,9 +1801,14 @@ ocVerifyImage_ELF ( ObjectCode* oc )
    strtab = NULL;
    nstrtab = 0;
    for (i = 0; i < ehdr->e_shnum; i++) {
-      if (shdr[i].sh_type == SHT_STRTAB &&
-          i !=  ehdr->e_shstrndx) {
-         IF_DEBUG(linker,belch("   section %d is a normal string table", i ));
+      if (shdr[i].sh_type == SHT_STRTAB
+          /* Ignore the section header's string table. */
+          && i != ehdr->e_shstrndx
+         /* Ignore string tables named .stabstr, as they contain
+             debugging info. */
+          && 0 != strncmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
+         ) {
+         IF_DEBUG(linker,belch("   section %d is a normal string table", i ));
          strtab = ehdrC + shdr[i].sh_offset;
          nstrtab++;
       }
@@ -1572,7 +1884,6 @@ ocGetNames_ELF ( ObjectCode* oc )
    Elf32_Ehdr* ehdr       = (Elf32_Ehdr*)ehdrC;
    char*       strtab     = findElfSection ( ehdrC, SHT_STRTAB );
    Elf32_Shdr* shdr       = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
-   char*       sh_strtab  = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
 
    ASSERT(symhash != NULL);
 
@@ -1582,27 +1893,59 @@ ocGetNames_ELF ( ObjectCode* oc )
    }
 
    k = 0;
-   oc->n_sections = ehdr->e_shnum;
-   oc->sections = stgMallocBytes( oc->n_sections * sizeof(Section), 
-                                  "ocGetNames_ELF(oc->sections)" );
-
-   for (i = 0; i < oc->n_sections; i++) {
-
-      /* make a section entry for relevant sections */
-      SectionKind kind = SECTIONKIND_OTHER;
-      if (!strcmp(".data",sh_strtab+shdr[i].sh_name) ||
-          !strcmp(".data1",sh_strtab+shdr[i].sh_name))
-         kind = SECTIONKIND_RWDATA;
-      if (!strcmp(".text",sh_strtab+shdr[i].sh_name) ||
-          !strcmp(".rodata",sh_strtab+shdr[i].sh_name) ||
-          !strcmp(".rodata1",sh_strtab+shdr[i].sh_name))
-         kind = SECTIONKIND_CODE_OR_RODATA;
+   for (i = 0; i < ehdr->e_shnum; i++) {
+      /* Figure out what kind of section it is.  Logic derived from
+         Figure 1.14 ("Special Sections") of the ELF document
+         ("Portable Formats Specification, Version 1.1"). */
+      Elf32_Shdr  hdr    = shdr[i];
+      SectionKind kind   = SECTIONKIND_OTHER;
+      int         is_bss = FALSE;
+
+      if (hdr.sh_type == SHT_PROGBITS 
+          && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
+         /* .text-style section */
+         kind = SECTIONKIND_CODE_OR_RODATA;
+      }
+      else
+      if (hdr.sh_type == SHT_PROGBITS 
+          && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
+         /* .data-style section */
+         kind = SECTIONKIND_RWDATA;
+      }
+      else
+      if (hdr.sh_type == SHT_PROGBITS 
+          && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
+         /* .rodata-style section */
+         kind = SECTIONKIND_CODE_OR_RODATA;
+      }
+      else
+      if (hdr.sh_type == SHT_NOBITS 
+          && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
+         /* .bss-style section */
+         kind = SECTIONKIND_RWDATA;
+         is_bss = TRUE;
+      }
+
+      if (is_bss && shdr[i].sh_size > 0) {
+         /* This is a non-empty .bss section.  Allocate zeroed space for
+            it, and set its .sh_offset field such that 
+            ehdrC + .sh_offset == addr_of_zeroed_space.  */
+         char* zspace = stgCallocBytes(1, shdr[i].sh_size, 
+                                       "ocGetNames_ELF(BSS)");
+         shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
+        /*         
+         fprintf(stderr, "BSS section at 0x%x, size %d\n", 
+                         zspace, shdr[i].sh_size);
+        */
+      }
 
       /* fill in the section info */
-      oc->sections[i].start = ehdrC + shdr[i].sh_offset;
-      oc->sections[i].end   = ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1;
-      oc->sections[i].kind  = kind;
-      
+      if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
+         addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
+         addSection(oc, kind, ehdrC + shdr[i].sh_offset, 
+                        ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
+      }
+
       if (shdr[i].sh_type != SHT_SYMTAB) continue;
 
       /* copy stuff into this module's object symbol table */
@@ -1614,6 +1957,26 @@ ocGetNames_ELF ( ObjectCode* oc )
                                    "ocGetNames_ELF(oc->symbols)");
 
       for (j = 0; j < nent; j++) {
+
+         char  isLocal = FALSE; /* avoids uninit-var warning */
+         char* ad      = NULL;
+         char* nm      = strtab + stab[j].st_name;
+         int   secno   = stab[j].st_shndx;
+
+        /* Figure out if we want to add it; if so, set ad to its
+            address.  Otherwise leave ad == NULL. */
+
+         if (secno == SHN_COMMON) {
+            isLocal = FALSE;
+            ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
+           /*
+            fprintf(stderr, "COMMON symbol, size %d name %s\n", 
+                            stab[j].st_size, nm);
+           */
+           /* Pointless to do addProddableBlock() for this area,
+               since the linker should never poke around in it. */
+        }
+         else
          if ( ( ELF32_ST_BIND(stab[j].st_info)==STB_GLOBAL
                 || ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL
               )
@@ -1627,25 +1990,38 @@ ocGetNames_ELF ( ObjectCode* oc )
                 ELF32_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
                 ELF32_ST_TYPE(stab[j].st_info)==STT_NOTYPE 
               )
-            ) { 
-            char* nm = strtab + stab[j].st_name;
-            char* ad = ehdrC 
-                       + shdr[ stab[j].st_shndx ].sh_offset
-                       + stab[j].st_value;
-            ASSERT(nm != NULL);
-            ASSERT(ad != NULL);
-           oc->symbols[j] = nm;
+            ) {
+           /* Section 0 is the undefined section, hence > and not >=. */
+            ASSERT(secno > 0 && secno < ehdr->e_shnum);
+           /*            
+            if (shdr[secno].sh_type == SHT_NOBITS) {
+               fprintf(stderr, "   BSS symbol, size %d off %d name %s\n", 
+                               stab[j].st_size, stab[j].st_value, nm);
+            }
+            */
+            ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
             if (ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL) {
-               IF_DEBUG(linker,belch( "addOTabName(LOCL): %10p  %s %s",
-                                      ad, oc->fileName, nm ));
-               insertStrHashTable(oc->lochash, nm, ad);
+               isLocal = TRUE;
             } else {
                IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p  %s %s",
                                       ad, oc->fileName, nm ));
-               insertStrHashTable(symhash, nm, ad);
+               isLocal = FALSE;
             }
          }
-         else {
+
+         /* And the decision is ... */
+
+         if (ad != NULL) {
+            ASSERT(nm != NULL);
+           oc->symbols[j] = nm;
+            /* Acquire! */
+            if (isLocal) {
+               /* Ignore entirely. */
+            } else {
+               ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
+            }
+         } else {
+            /* Skip. */
             IF_DEBUG(linker,belch( "skipping `%s'", 
                                    strtab + stab[j].st_name ));
             /*
@@ -1659,6 +2035,7 @@ ocGetNames_ELF ( ObjectCode* oc )
             */
             oc->symbols[j] = NULL;
          }
+
       }
    }
 
@@ -1699,20 +2076,21 @@ do_Elf32_Rel_relocations ( ObjectCode* oc, char* ehdrC,
          IF_DEBUG(linker,belch( " ZERO" ));
          S = 0;
       } else {
-         /* First see if it is a nameless local symbol. */
-         if (stab[ ELF32_R_SYM(info)].st_name == 0) {
-            symbol = "(noname)";
+         Elf32_Sym sym = stab[ELF32_R_SYM(info)];
+        /* First see if it is a local symbol. */
+         if (ELF32_ST_BIND(sym.st_info) == STB_LOCAL) {
+            /* Yes, so we can get the address directly from the ELF symbol
+               table. */
+            symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
             S = (Elf32_Addr)
-                (ehdrC + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset
+                (ehdrC + shdr[ sym.st_shndx ].sh_offset
                        + stab[ELF32_R_SYM(info)].st_value);
-         } else {
-            /* No?  Should be in a symbol table then; first try the
-               local one. */
-            symbol = strtab+stab[ ELF32_R_SYM(info)].st_name;
-            (void*)S = lookupLocalSymbol( oc, symbol );
-            if ((void*)S == NULL)
-               (void*)S = lookupSymbol( symbol );
-         }
+
+        } else {
+            /* No, so look up the name in our global table. */
+            symbol = strtab + sym.st_name;
+            (void*)S = lookupSymbol( symbol );
+        }
          if (!S) {
             belch("%s: unknown symbol `%s'", oc->fileName, symbol);
            return 0;
@@ -1721,6 +2099,7 @@ do_Elf32_Rel_relocations ( ObjectCode* oc, char* ehdrC,
       }
       IF_DEBUG(linker,belch( "Reloc: P = %p   S = %p   A = %p",
                             (void*)P, (void*)S, (void*)A )); 
+      checkProddableBlock ( oc, pP );
       switch (ELF32_R_TYPE(info)) {
 #        ifdef i386_TARGET_ARCH
          case R_386_32:   *pP = S + A;     break;
@@ -1759,9 +2138,8 @@ do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC,
       Elf32_Addr  offset = rtab[j].r_offset;
       Elf32_Word  info   = rtab[j].r_info;
       Elf32_Sword addend = rtab[j].r_addend;
-
       Elf32_Addr  P  = ((Elf32_Addr)targ) + offset;
-      Elf32_Addr  A  = addend;
+      Elf32_Addr  A  = addend; /* Do not delete this; it is used on sparc. */
       Elf32_Addr  S;
 #     if defined(sparc_TARGET_ARCH)
       /* This #ifdef only serves to avoid unused-var warnings. */
@@ -1776,20 +2154,21 @@ do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC,
          IF_DEBUG(linker,belch( " ZERO" ));
          S = 0;
       } else {
-         /* First see if it is a nameless local symbol. */
-         if (stab[ ELF32_R_SYM(info)].st_name == 0) {
-            symbol = "(noname)";
+         Elf32_Sym sym = stab[ELF32_R_SYM(info)];
+        /* First see if it is a local symbol. */
+         if (ELF32_ST_BIND(sym.st_info) == STB_LOCAL) {
+            /* Yes, so we can get the address directly from the ELF symbol
+               table. */
+            symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
             S = (Elf32_Addr)
-                (ehdrC + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset
+                (ehdrC + shdr[ sym.st_shndx ].sh_offset
                        + stab[ELF32_R_SYM(info)].st_value);
-         } else {
-            /* No?  Should be in a symbol table then; first try the
-               local one. */
-            symbol = strtab+stab[ ELF32_R_SYM(info)].st_name;
-            (void*)S = lookupLocalSymbol( oc, symbol );
-            if ((void*)S == NULL)
-               (void*)S = lookupSymbol( symbol );
-         }
+
+        } else {
+            /* No, so look up the name in our global table. */
+            symbol = strtab + sym.st_name;
+            (void*)S = lookupSymbol( symbol );
+        }
          if (!S) {
           belch("%s: unknown symbol `%s'", oc->fileName, symbol);
           return 0;
@@ -1802,6 +2181,7 @@ do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC,
       }
       IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p   S = %p   A = %p\n",
                                         (void*)P, (void*)S, (void*)A )); 
+      checkProddableBlock ( oc, (void*)P );
       switch (ELF32_R_TYPE(info)) {
 #        if defined(sparc_TARGET_ARCH)
          case R_SPARC_WDISP30: 
@@ -1825,6 +2205,17 @@ do_Elf32_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:
          case R_SPARC_32:
             w2 = (Elf32_Word)(S + A);
             *pP = w2;
@@ -1850,6 +2241,7 @@ ocResolve_ELF ( ObjectCode* oc )
    char*       ehdrC = (char*)(oc->image);
    Elf32_Ehdr* ehdr = (Elf32_Ehdr*) ehdrC;
    Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
+   char* sh_strtab  = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
 
    /* first find "the" symbol table */
    stab = (Elf32_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
@@ -1864,6 +2256,14 @@ ocResolve_ELF ( ObjectCode* oc )
 
    /* Process the relocation sections. */
    for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
+
+      /* Skip sections called ".rel.stab".  These appear to contain
+         relocation entries that, when done, make the stabs debugging
+         info point at the right places.  We ain't interested in all
+         dat jazz, mun. */
+      if (0 == strncmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
+         continue;
+
       if (shdr[shnum].sh_type == SHT_REL ) {
          ok = do_Elf32_Rel_relocations ( oc, ehdrC, shdr, 
                                          shnum, stab, strtab );
@@ -1875,6 +2275,7 @@ ocResolve_ELF ( ObjectCode* oc )
                                           shnum, stab, strtab );
          if (!ok) return ok;
       }
+
    }
 
    /* Free the local symbol table; we won't need it again. */