RTS tidyup sweep, first phase
[ghc-hetmet.git] / rts / Linker.c
index 3b2dd1e..7db88cb 100644 (file)
 #endif
 
 #include "Rts.h"
-#include "RtsFlags.h"
 #include "HsFFI.h"
+
+#include "sm/Storage.h"
 #include "Hash.h"
-#include "Linker.h"
 #include "LinkerInternals.h"
 #include "RtsUtils.h"
-#include "Schedule.h"
-#include "Sparks.h"
-#include "RtsTypeable.h"
-#include "Timer.h"
 #include "Trace.h"
+#include "StgPrimFloat.h" // for __int_encodeFloat etc.
+#include "Stable.h"
+
+#if !defined(mingw32_HOST_OS)
+#include "posix/Signals.h"
+#endif
 
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>
@@ -205,7 +207,7 @@ static void machoInitSymbolsWithoutUnderscore( void );
 #define MMAP_32BIT_BASE_DEFAULT 0x40000000
 #endif
 
-static void *mmap_32bit_base = MMAP_32BIT_BASE_DEFAULT;
+static void *mmap_32bit_base = (void *)MMAP_32BIT_BASE_DEFAULT;
 #endif
 
 /* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */
@@ -222,20 +224,16 @@ typedef struct _RtsSymbolVal {
     void   *addr;
 } RtsSymbolVal;
 
-#if !defined(PAR)
 #define Maybe_Stable_Names      SymI_HasProto(mkWeakzh_fast)                   \
+                               SymI_HasProto(mkWeakForeignEnvzh_fast)          \
                                SymI_HasProto(makeStableNamezh_fast)            \
                                SymI_HasProto(finalizzeWeakzh_fast)
-#else
-/* These are not available in GUM!!! -- HWL */
-#define Maybe_Stable_Names
-#endif
 
 #if !defined (mingw32_HOST_OS)
 #define RTS_POSIX_ONLY_SYMBOLS                  \
       SymI_HasProto(shutdownHaskellAndSignal)  \
-      SymI_NeedsProto(lockFile)                 \
-      SymI_NeedsProto(unlockFile)               \
+      SymI_HasProto(lockFile)                   \
+      SymI_HasProto(unlockFile)                 \
       SymI_HasProto(signal_handlers)           \
       SymI_HasProto(stg_sig_install)           \
       SymI_NeedsProto(nocldstop)
@@ -347,6 +345,12 @@ typedef struct _RtsSymbolVal {
 #define RTS_MINGW_GETTIMEOFDAY_SYM /**/
 #endif
 
+#if HAVE___MINGW_VFPRINTF
+#define RTS___MINGW_VFPRINTF_SYM SymI_HasProto(__mingw_vfprintf)
+#else
+#define RTS___MINGW_VFPRINTF_SYM /**/
+#endif
+
 /* These are statically linked from the mingw libraries into the ghc
    executable, so we have to employ this hack. */
 #define RTS_MINGW_ONLY_SYMBOLS                           \
@@ -385,6 +389,8 @@ typedef struct _RtsSymbolVal {
       SymI_NeedsProto(iscntrl)                           \
       SymI_NeedsProto(isalpha)                           \
       SymI_NeedsProto(isalnum)                           \
+      SymI_NeedsProto(isascii)                           \
+      RTS___MINGW_VFPRINTF_SYM                           \
       SymI_HasProto(strcmp)                              \
       SymI_HasProto(memmove)                             \
       SymI_HasProto(realloc)                             \
@@ -492,7 +498,9 @@ typedef struct _RtsSymbolVal {
 
 #if !defined(mingw32_HOST_OS)
 #define RTS_USER_SIGNALS_SYMBOLS \
-   SymI_HasProto(setIOManagerPipe)
+   SymI_HasProto(setIOManagerPipe) \
+   SymI_NeedsProto(blockUserSignals) \
+   SymI_NeedsProto(unblockUserSignals)
 #else
 #define RTS_USER_SIGNALS_SYMBOLS     \
    SymI_HasProto(sendIOManagerEvent) \
@@ -539,23 +547,6 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_ap_pppppp_ret)
 #endif
 
-/* On Windows, we link libgmp.a statically into libHSrts.dll */
-#ifdef mingw32_HOST_OS
-#define GMP_SYMS                                       \
-      SymI_HasProto(__gmpz_cmp)                                \
-      SymI_HasProto(__gmpz_cmp_si)                     \
-      SymI_HasProto(__gmpz_cmp_ui)                     \
-      SymI_HasProto(__gmpz_get_si)                     \
-      SymI_HasProto(__gmpz_get_ui)
-#else
-#define GMP_SYMS                                       \
-      SymE_HasProto(__gmpz_cmp)                                \
-      SymE_HasProto(__gmpz_cmp_si)                     \
-      SymE_HasProto(__gmpz_cmp_ui)                     \
-      SymE_HasProto(__gmpz_get_si)                     \
-      SymE_HasProto(__gmpz_get_ui)
-#endif
-
 #define RTS_SYMBOLS                                    \
       Maybe_Stable_Names                               \
       SymI_HasProto(StgReturn)                         \
@@ -592,20 +583,17 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(OnExitHook)                                \
       SymI_HasProto(OutOfHeapHook)                     \
       SymI_HasProto(StackOverflowHook)                 \
-      SymI_HasProto(__encodeDouble)                    \
-      SymI_HasProto(__encodeFloat)                     \
       SymI_HasProto(addDLL)                            \
-      GMP_SYMS                                         \
       SymI_HasProto(__int_encodeDouble)                        \
       SymI_HasProto(__word_encodeDouble)               \
       SymI_HasProto(__2Int_encodeDouble)               \
       SymI_HasProto(__int_encodeFloat)                 \
       SymI_HasProto(__word_encodeFloat)                        \
-      SymI_HasProto(andIntegerzh_fast)                 \
       SymI_HasProto(atomicallyzh_fast)                 \
       SymI_HasProto(barf)                              \
       SymI_HasProto(debugBelch)                                \
       SymI_HasProto(errorBelch)                                \
+      SymI_HasProto(sysErrorBelch)                      \
       SymI_HasProto(asyncExceptionsBlockedzh_fast)     \
       SymI_HasProto(blockAsyncExceptionszh_fast)       \
       SymI_HasProto(catchzh_fast)                      \
@@ -614,12 +602,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(checkzh_fast)                       \
       SymI_HasProto(closure_flags)                      \
       SymI_HasProto(cmp_thread)                                \
-      SymI_HasProto(cmpIntegerzh_fast)                 \
-      SymI_HasProto(cmpIntegerIntzh_fast)              \
-      SymI_HasProto(complementIntegerzh_fast)          \
       SymI_HasProto(createAdjustor)                    \
-      SymI_HasProto(decodeDoublezh_fast)               \
-      SymI_HasProto(decodeFloatzh_fast)                        \
       SymI_HasProto(decodeDoublezu2Intzh_fast)         \
       SymI_HasProto(decodeFloatzuIntzh_fast)           \
       SymI_HasProto(defaultsHook)                      \
@@ -627,18 +610,13 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(deRefWeakzh_fast)                  \
       SymI_HasProto(deRefStablePtrzh_fast)             \
       SymI_HasProto(dirty_MUT_VAR)                     \
-      SymI_HasProto(divExactIntegerzh_fast)            \
-      SymI_HasProto(divModIntegerzh_fast)              \
       SymI_HasProto(forkzh_fast)                       \
       SymI_HasProto(forkOnzh_fast)                     \
       SymI_HasProto(forkProcess)                       \
       SymI_HasProto(forkOS_createThread)               \
       SymI_HasProto(freeHaskellFunctionPtr)            \
-      SymI_HasProto(freeStablePtr)                     \
       SymI_HasProto(getOrSetTypeableStore)             \
-      SymI_HasProto(gcdIntegerzh_fast)                 \
-      SymI_HasProto(gcdIntegerIntzh_fast)              \
-      SymI_HasProto(gcdIntzh_fast)                     \
+      SymI_HasProto(getOrSetSignalHandlerStore)                \
       SymI_HasProto(genSymZh)                          \
       SymI_HasProto(genericRaise)                      \
       SymI_HasProto(getProgArgv)                       \
@@ -652,30 +630,19 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(hs_free_stable_ptr)                        \
       SymI_HasProto(hs_free_fun_ptr)                   \
       SymI_HasProto(hs_hpc_rootModule)                 \
+      SymI_HasProto(hs_hpc_module)                     \
       SymI_HasProto(initLinker)                                \
       SymI_HasProto(unpackClosurezh_fast)               \
       SymI_HasProto(getApStackValzh_fast)               \
       SymI_HasProto(getSparkzh_fast)                    \
-      SymI_HasProto(int2Integerzh_fast)                        \
-      SymI_HasProto(integer2Intzh_fast)                        \
-      SymI_HasProto(integer2Wordzh_fast)               \
       SymI_HasProto(isCurrentThreadBoundzh_fast)       \
-      SymI_HasProto(isDoubleDenormalized)              \
-      SymI_HasProto(isDoubleInfinite)                  \
-      SymI_HasProto(isDoubleNaN)                       \
-      SymI_HasProto(isDoubleNegativeZero)              \
       SymI_HasProto(isEmptyMVarzh_fast)                        \
-      SymI_HasProto(isFloatDenormalized)               \
-      SymI_HasProto(isFloatInfinite)                   \
-      SymI_HasProto(isFloatNaN)                                \
-      SymI_HasProto(isFloatNegativeZero)               \
       SymI_HasProto(killThreadzh_fast)                 \
       SymI_HasProto(loadObj)                           \
       SymI_HasProto(insertStableSymbol)                \
       SymI_HasProto(insertSymbol)                      \
       SymI_HasProto(lookupSymbol)                      \
       SymI_HasProto(makeStablePtrzh_fast)              \
-      SymI_HasProto(minusIntegerzh_fast)               \
       SymI_HasProto(mkApUpd0zh_fast)                   \
       SymI_HasProto(myThreadIdzh_fast)                 \
       SymI_HasProto(labelThreadzh_fast)                 \
@@ -689,22 +656,17 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(noDuplicatezh_fast)                        \
       SymI_HasProto(atomicModifyMutVarzh_fast)         \
       SymI_HasProto(newPinnedByteArrayzh_fast)         \
+      SymI_HasProto(newAlignedPinnedByteArrayzh_fast)  \
       SymI_HasProto(newSpark)                          \
-      SymI_HasProto(orIntegerzh_fast)                  \
       SymI_HasProto(performGC)                         \
       SymI_HasProto(performMajorGC)                    \
-      SymI_HasProto(plusIntegerzh_fast)                        \
       SymI_HasProto(prog_argc)                         \
       SymI_HasProto(prog_argv)                         \
       SymI_HasProto(putMVarzh_fast)                    \
-      SymI_HasProto(quotIntegerzh_fast)                        \
-      SymI_HasProto(quotRemIntegerzh_fast)             \
       SymI_HasProto(raisezh_fast)                      \
       SymI_HasProto(raiseIOzh_fast)                    \
       SymI_HasProto(readTVarzh_fast)                   \
       SymI_HasProto(readTVarIOzh_fast)                 \
-      SymI_HasProto(remIntegerzh_fast)                 \
-      SymI_HasProto(resetNonBlockingFd)                        \
       SymI_HasProto(resumeThread)                      \
       SymI_HasProto(resolveObjs)                        \
       SymI_HasProto(retryzh_fast)                       \
@@ -753,6 +715,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(rts_mkWord32)                      \
       SymI_HasProto(rts_mkWord64)                      \
       SymI_HasProto(rts_unlock)                                \
+      SymI_HasProto(rts_unsafeGetMyCapability)          \
       SymI_HasProto(rtsSupportsBoundThreads)           \
       SymI_HasProto(__hscore_get_saved_termios)                \
       SymI_HasProto(__hscore_set_saved_termios)                \
@@ -764,13 +727,13 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stackOverflow)                     \
       SymI_HasProto(stg_CAF_BLACKHOLE_info)            \
       SymI_HasProto(__stg_EAGER_BLACKHOLE_info)                \
-      SymI_HasProto(awakenBlockedQueue)                        \
       SymI_HasProto(startTimer)                         \
       SymI_HasProto(stg_CHARLIKE_closure)              \
       SymI_HasProto(stg_MVAR_CLEAN_info)               \
       SymI_HasProto(stg_MVAR_DIRTY_info)               \
       SymI_HasProto(stg_IND_STATIC_info)               \
       SymI_HasProto(stg_INTLIKE_closure)               \
+      SymI_HasProto(stg_ARR_WORDS_info)                 \
       SymI_HasProto(stg_MUT_ARR_PTRS_DIRTY_info)       \
       SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN_info)      \
       SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN0_info)     \
@@ -832,7 +795,6 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(suspendThread)                     \
       SymI_HasProto(takeMVarzh_fast)                   \
       SymI_HasProto(threadStatuszh_fast)               \
-      SymI_HasProto(timesIntegerzh_fast)               \
       SymI_HasProto(tryPutMVarzh_fast)                 \
       SymI_HasProto(tryTakeMVarzh_fast)                        \
       SymI_HasProto(unblockAsyncExceptionszh_fast)     \
@@ -840,11 +802,12 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(unsafeThawArrayzh_fast)            \
       SymI_HasProto(waitReadzh_fast)                   \
       SymI_HasProto(waitWritezh_fast)                  \
-      SymI_HasProto(word2Integerzh_fast)               \
       SymI_HasProto(writeTVarzh_fast)                  \
-      SymI_HasProto(xorIntegerzh_fast)                 \
       SymI_HasProto(yieldzh_fast)                       \
       SymI_NeedsProto(stg_interp_constr_entry)          \
+      SymI_HasProto(alloc_blocks)                       \
+      SymI_HasProto(alloc_blocks_lim)                   \
+      SymI_HasProto(allocateLocal)                      \
       SymI_HasProto(allocateExec)                      \
       SymI_HasProto(freeExec)                          \
       SymI_HasProto(getAllocations)                     \
@@ -855,15 +818,9 @@ typedef struct _RtsSymbolVal {
       SymI_NeedsProto(rts_stop_on_exception)           \
       SymI_HasProto(stopTimer)                         \
       SymI_HasProto(n_capabilities)                    \
+      SymI_HasProto(traceCcszh_fast)                    \
       RTS_USER_SIGNALS_SYMBOLS
 
-#ifdef SUPPORT_LONG_LONGS
-#define RTS_LONG_LONG_SYMS                             \
-      SymI_HasProto(int64ToIntegerzh_fast)             \
-      SymI_HasProto(word64ToIntegerzh_fast)
-#else
-#define RTS_LONG_LONG_SYMS /* nothing */
-#endif
 
 // 64-bit support functions in libgcc.a
 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
@@ -911,7 +868,6 @@ typedef struct _RtsSymbolVal {
 #define SymI_HasProto_redirect(vvv,xxx) /**/
 RTS_SYMBOLS
 RTS_RET_SYMBOLS
-RTS_LONG_LONG_SYMS
 RTS_POSIX_ONLY_SYMBOLS
 RTS_MINGW_ONLY_SYMBOLS
 RTS_CYGWIN_ONLY_SYMBOLS
@@ -947,7 +903,6 @@ RTS_LIBFFI_SYMBOLS
 static RtsSymbolVal rtsSyms[] = {
       RTS_SYMBOLS
       RTS_RET_SYMBOLS
-      RTS_LONG_LONG_SYMS
       RTS_POSIX_ONLY_SYMBOLS
       RTS_MINGW_ONLY_SYMBOLS
       RTS_CYGWIN_ONLY_SYMBOLS
@@ -1047,6 +1002,16 @@ initLinker( void )
         mmap_32bit_base = (void*)RtsFlags.MiscFlags.linkerMemBase;
     }
 #endif
+
+#if defined(mingw32_HOST_OS)
+    /*
+     * These two libraries cause problems when added to the static link,
+     * but are necessary for resolving symbols in GHCi, hence we load
+     * them manually here.
+     */
+    addDLL("msvcrt");
+    addDLL("kernel32");
+#endif
 }
 
 /* -----------------------------------------------------------------------------
@@ -1302,6 +1267,7 @@ mmapForLinker (size_t bytes, nat flags, int fd)
    void *map_addr = NULL;
    void *result;
    int pagesize, size;
+   static nat fixed = 0;
 
    pagesize = getpagesize();
    size = ROUND_UP(bytes, pagesize);
@@ -1315,10 +1281,11 @@ mmap_again:
 #endif
 
    result = mmap(map_addr, size, PROT_EXEC|PROT_READ|PROT_WRITE,
-                   MAP_PRIVATE|TRY_MAP_32BIT|flags, fd, 0);
+                   MAP_PRIVATE|TRY_MAP_32BIT|fixed|flags, fd, 0);
 
    if (result == MAP_FAILED) {
-       sysErrorBelch("mmap");
+       sysErrorBelch("mmap %lu bytes at %p",(lnat)size,map_addr);
+       errorBelch("Try specifying an address with +RTS -xm<addr> -RTS");
        stg_exit(EXIT_FAILURE);
    }
    
@@ -1329,8 +1296,16 @@ mmap_again:
        } else {
            if ((W_)result > 0x80000000) {
                // oops, we were given memory over 2Gb
-               // ... try allocating memory somewhere else?;
-               barf("loadObj: failed to mmap() memory below 2Gb; asked for %lu bytes at %p, got %p.  Try specifying an address with +RTS -xm<addr> -RTS", size, map_addr, result);
+#if defined(freebsd_HOST_OS)
+               // Some platforms require MAP_FIXED.  This is normally
+               // a bad idea, because MAP_FIXED will overwrite
+               // existing mappings.
+               munmap(result,size);
+               fixed = MAP_FIXED;
+               goto mmap_again;
+#else
+               barf("loadObj: failed to mmap() memory below 2Gb; asked for %lu bytes at %p.  Try specifying an address with +RTS -xm<addr> -RTS", size, map_addr, result);
+#endif
            } else {
                // hmm, we were given memory somewhere else, but it's
                // still under 2Gb so we can use it.  Next time, ask
@@ -1464,7 +1439,6 @@ loadObj( char *path )
    close(fd);
 
 #else /* !USE_MMAP */
-
    /* load the image into memory */
    f = fopen(path, "rb");
    if (!f)
@@ -1492,10 +1466,12 @@ loadObj( char *path )
    oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
 #  endif
 
-   n = fread ( oc->image, 1, oc->fileSize, f );
-   if (n != oc->fileSize)
-      barf("loadObj: error whilst reading `%s'", path);
-
+   {
+       int n;
+       n = fread ( oc->image, 1, oc->fileSize, f );
+       if (n != oc->fileSize)
+           barf("loadObj: error whilst reading `%s'", path);
+   }
    fclose(f);
 #endif /* USE_MMAP */
 
@@ -1732,7 +1708,7 @@ static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
     if( m > n ) // we need to allocate more pages
     {
         oc->symbol_extras = mmapForLinker(sizeof(SymbolExtra) * count, 
-                                          MAP_ANONYMOUS, 0);
+                                          MAP_ANONYMOUS, -1);
     }
     else
     {
@@ -2639,8 +2615,7 @@ ocResolve_PEi386 ( ObjectCode* oc )
             copyName ( sym->Name, strtab, symbol, 1000-1 );
             S = (UInt32) lookupSymbol( symbol );
             if ((void*)S != NULL) goto foundit;
-           /* Newline first because the interactive linker has printed "linking..." */
-            errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
+            errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
             return 0;
            foundit:;
          }
@@ -3516,17 +3491,26 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
             w1 |= w2;
             *pP = w1;
             break;
+
          /* According to the Sun documentation:
             R_SPARC_UA32
             This relocation type resembles R_SPARC_32, except it refers to an
             unaligned word. That is, the word to be relocated must be treated
             as four separate bytes with arbitrary alignment, not as a word
             aligned according to the architecture requirements.
-
-            (JRS: which means that freeloading on the R_SPARC_32 case
-            is probably wrong, but hey ...)
          */
          case R_SPARC_UA32:
+            w2 = (Elf_Word)value;
+
+            // SPARC doesn't do misaligned writes of 32 bit words,
+           //       so we have to do this one byte-at-a-time.
+           char *pPc   = (char*)pP;
+           pPc[0]      = (char) ((Elf_Word)(w2 & 0xff000000) >> 24);
+           pPc[1]      = (char) ((Elf_Word)(w2 & 0x00ff0000) >> 16);
+           pPc[2]      = (char) ((Elf_Word)(w2 & 0x0000ff00) >> 8);
+           pPc[3]      = (char) ((Elf_Word)(w2 & 0x000000ff));
+           break;
+
          case R_SPARC_32:
             w2 = (Elf_Word)value;
             *pP = w2;
@@ -4081,7 +4065,9 @@ static int relocateSection(
         
         char    *thingPtr = image + sect->offset + reloc->r_address;
         uint64_t thing;
-        uint64_t value;
+        /* We shouldn't need to initialise this, but gcc on OS X 64 bit
+           complains that it may be used uninitialized if we don't */
+        uint64_t value = 0;
         uint64_t baseValue;
         int type = reloc->r_type;
         
@@ -4673,7 +4659,7 @@ static void machoInitSymbolsWithoutUnderscore()
     void **p = symbolsWithoutUnderscore;
     __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
 
-#undef Sym
+#undef SymI_NeedsProto
 #define SymI_NeedsProto(x)  \
     __asm__ volatile(".long " # x);
 
@@ -4681,13 +4667,13 @@ static void machoInitSymbolsWithoutUnderscore()
 
     __asm__ volatile(".text");
     
-#undef Sym
+#undef SymI_NeedsProto
 #define SymI_NeedsProto(x)  \
     ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
     
     RTS_MACHO_NOUNDERLINE_SYMBOLS
     
-#undef Sym
+#undef SymI_NeedsProto
 }
 #endif