add readTVarIO :: TVar a -> IO a
[ghc-hetmet.git] / rts / Linker.c
index db495dd..0b556b7 100644 (file)
@@ -27,6 +27,7 @@
 #include "Schedule.h"
 #include "Sparks.h"
 #include "RtsTypeable.h"
+#include "Timer.h"
 
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>
 #include <sys/wait.h>
 #endif
 
-#if defined(ia64_HOST_ARCH) || defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
+#if defined(ia64_HOST_ARCH) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
 #define USE_MMAP
 #include <fcntl.h>
 #include <sys/mman.h>
 
-#if defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
+#if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
 #ifdef HAVE_UNISTD_H
 #include <unistd.h>
 #endif
@@ -174,6 +175,7 @@ typedef struct _RtsSymbolVal {
 
 #if !defined (mingw32_HOST_OS)
 #define RTS_POSIX_ONLY_SYMBOLS                  \
+      SymX(shutdownHaskellAndSignal)           \
       Sym(lockFile)                             \
       Sym(unlockFile)                           \
       SymX(signal_handlers)                    \
@@ -546,6 +548,7 @@ typedef struct _RtsSymbolVal {
       SymX(barf)                               \
       SymX(debugBelch)                         \
       SymX(errorBelch)                         \
+      SymX(asyncExceptionsBlockedzh_fast)      \
       SymX(blockAsyncExceptionszh_fast)                \
       SymX(catchzh_fast)                       \
       SymX(catchRetryzh_fast)                  \
@@ -640,6 +643,7 @@ typedef struct _RtsSymbolVal {
       SymX(raisezh_fast)                       \
       SymX(raiseIOzh_fast)                     \
       SymX(readTVarzh_fast)                    \
+      SymX(readTVarIOzh_fast)                  \
       SymX(remIntegerzh_fast)                  \
       SymX(resetNonBlockingFd)                 \
       SymX(resumeThread)                       \
@@ -701,6 +705,7 @@ typedef struct _RtsSymbolVal {
       SymX(stackOverflow)                      \
       SymX(stg_CAF_BLACKHOLE_info)             \
       SymX(awakenBlockedQueue)                 \
+      SymX(startTimer)                          \
       SymX(stg_CHARLIKE_closure)               \
       SymX(stg_MVAR_CLEAN_info)                        \
       SymX(stg_MVAR_DIRTY_info)                        \
@@ -766,6 +771,7 @@ typedef struct _RtsSymbolVal {
       SymX(stg_upd_frame_info)                 \
       SymX(suspendThread)                      \
       SymX(takeMVarzh_fast)                    \
+      SymX(threadStatuszh_fast)                        \
       SymX(timesIntegerzh_fast)                        \
       SymX(tryPutMVarzh_fast)                  \
       SymX(tryTakeMVarzh_fast)                 \
@@ -1016,7 +1022,9 @@ addDLL( char *dll_name )
 
    initLinker();
 
-   hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
+   // omitted: RTLD_NOW
+   // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html
+   hdl= dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL);
 
    if (hdl == NULL) {
       /* dlopen failed; return a ptr to the error msg. */
@@ -1059,14 +1067,19 @@ addDLL( char *dll_name )
    sprintf(buf, "%s.DLL", dll_name);
    instance = LoadLibrary(buf);
    if (instance == NULL) {
-        sprintf(buf, "%s.DRV", dll_name);      // KAA: allow loading of drivers (like winspool.drv)
-        instance = LoadLibrary(buf);
-        if (instance == NULL) {
-               stgFree(buf);
-
-           /* LoadLibrary failed; return a ptr to the error msg. */
-           return "addDLL: unknown error";
-        }
+       if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
+       // KAA: allow loading of drivers (like winspool.drv)
+       sprintf(buf, "%s.DRV", dll_name);
+       instance = LoadLibrary(buf);
+       if (instance == NULL) {
+           if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
+           // #1883: allow loading of unix-style libfoo.dll DLLs
+           sprintf(buf, "lib%s.DLL", dll_name);
+           instance = LoadLibrary(buf);
+           if (instance == NULL) {
+               goto error;
+           }
+       }
    }
    stgFree(buf);
 
@@ -1079,6 +1092,14 @@ addDLL( char *dll_name )
    opened_dlls     = o_dll;
 
    return NULL;
+
+error:
+   stgFree(buf);
+   sysErrorBelch(dll_name);
+
+   /* LoadLibrary failed; return a ptr to the error msg. */
+   return "addDLL: could not load DLL";
+
 #  else
    barf("addDLL: not implemented on this platform");
 #  endif
@@ -1171,23 +1192,6 @@ lookupSymbol( char *lbl )
     }
 }
 
-static
-__attribute((unused))
-void *
-lookupLocalSymbol( ObjectCode* oc, char *lbl )
-{
-    void *val;
-    initLinker() ;
-    val = lookupStrHashTable(oc->lochash, lbl);
-
-    if (val == NULL) {
-        return NULL;
-    } else {
-       return val;
-    }
-}
-
-
 /* -----------------------------------------------------------------------------
  * Debugging aid: look in GHCi's object symbol tables for symbols
  * within DELTA bytes of the specified address, and show their names.
@@ -1209,11 +1213,7 @@ void ghci_enquire ( char* addr )
       for (i = 0; i < oc->n_symbols; i++) {
          sym = oc->symbols[i];
          if (sym == NULL) continue;
-         // debugBelch("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);
         }
@@ -1298,7 +1298,6 @@ loadObj( char *path )
    oc->fileSize          = st.st_size;
    oc->symbols           = NULL;
    oc->sections          = NULL;
-   oc->lochash           = allocStrHashTable();
    oc->proddables        = NULL;
 
    /* chain it onto the list of objects */
@@ -1507,9 +1506,6 @@ unloadObj( char *path )
            stgFree(oc->fileName);
            stgFree(oc->symbols);
            stgFree(oc->sections);
-           /* The local hash table should have been freed at the end
-               of the ocResolve_ call on it. */
-            ASSERT(oc->lochash == NULL);
            stgFree(oc);
            return 1;
        }
@@ -1618,47 +1614,36 @@ static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
     aligned = (oc->fileSize + 3) & ~3;
 
 #ifdef USE_MMAP
-    #ifndef linux_HOST_OS /* mremap is a linux extension */
-        #error ocAllocateSymbolExtras doesnt want USE_MMAP to be defined
-    #endif
-
     pagesize = getpagesize();
     n = ROUND_UP( oc->fileSize, pagesize );
     m = ROUND_UP( aligned + sizeof (SymbolExtra) * count, pagesize );
 
-    /* If we have a half-page-size file and map one page of it then
-     * the part of the page after the size of the file remains accessible.
-     * If, however, we map in 2 pages, the 2nd page is not accessible
-     * and will give a "Bus Error" on access.  To get around this, we check
-     * if we need any extra pages for the jump islands and map them in
-     * anonymously.  We must check that we actually require extra pages
-     * otherwise the attempt to mmap 0 pages of anonymous memory will
-     * fail -EINVAL.
+    /* we try to use spare space at the end of the last page of the
+     * image for the jump islands, but if there isn't enough space
+     * then we have to map some (anonymously, remembering MAP_32BIT).
      */
-
-    if( m > n )
+    if( m > n ) // we need to allocate more pages
     {
-      /* The effect of this mremap() call is only the ensure that we have
-       * a sufficient number of virtually contiguous pages.  As returned from
-       * mremap, the pages past the end of the file are not backed.  We give
-       * them a backing by using MAP_FIXED to map in anonymous pages.
-       */
-      oc->image = mremap( oc->image, n, m, MREMAP_MAYMOVE );
-
-      if( oc->image == MAP_FAILED )
-      {
-        errorBelch( "Unable to mremap for Jump Islands\n" );
-        return 0;
-      }
-
-      if( mmap( oc->image + n, m - n, PROT_READ | PROT_WRITE | PROT_EXEC,
-                MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, 0, 0 ) == MAP_FAILED )
-      {
-        errorBelch( "Unable to mmap( MAP_FIXED ) for Jump Islands\n" );
-        return 0;
-      }
+        oc->symbol_extras = mmap (NULL, sizeof(SymbolExtra) * count,
+                                  PROT_EXEC|PROT_READ|PROT_WRITE,
+                                  MAP_PRIVATE|MAP_ANONYMOUS|EXTRA_MAP_FLAGS,
+                                  0, 0);
+        if (oc->symbol_extras == MAP_FAILED)
+        {
+            errorBelch( "Unable to mmap() for jump islands\n" );
+            return 0;
+        }
+#ifdef x86_64_HOST_ARCH
+        if ((StgWord)oc->symbol_extras > 0x80000000)
+        {
+            barf("mmap() returned memory outside 2Gb");
+        }
+#endif
+    }
+    else
+    {
+        oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
     }
-
 #else
     oc->image -= misalignment;
     oc->image = stgReallocBytes( oc->image,
@@ -1666,9 +1651,10 @@ static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
                                  aligned + sizeof (SymbolExtra) * count,
                                  "ocAllocateSymbolExtras" );
     oc->image += misalignment;
-#endif /* USE_MMAP */
 
     oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
+#endif /* USE_MMAP */
+
     memset( oc->symbol_extras, 0, sizeof (SymbolExtra) * count );
   }
   else
@@ -2527,13 +2513,9 @@ ocResolve_PEi386 ( ObjectCode* oc )
                    + sym->Value);
          } else {
             copyName ( sym->Name, strtab, symbol, 1000-1 );
-            S = (UInt32) lookupLocalSymbol( oc, symbol );
-            if ((void*)S != NULL) goto foundit;
             S = (UInt32) lookupSymbol( symbol );
             if ((void*)S != NULL) goto foundit;
             zapTrailingAtSign ( symbol );
-            S = (UInt32) lookupLocalSymbol( oc, symbol );
-            if ((void*)S != NULL) goto foundit;
             S = (UInt32) lookupSymbol( symbol );
             if ((void*)S != NULL) goto foundit;
            /* Newline first because the interactive linker has printed "linking..." */
@@ -3161,7 +3143,7 @@ ocGetNames_ELF ( ObjectCode* oc )
                if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
                    ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
 #endif
-               IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p  %s %s",
+               IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p  %s %s\n",
                                       ad, oc->fileName, nm ));
                isLocal = FALSE;
             }
@@ -3623,10 +3605,6 @@ ocResolve_ELF ( ObjectCode* oc )
       }
    }
 
-   /* Free the local symbol table; we won't need it again. */
-   freeHashTable(oc->lochash, NULL);
-   oc->lochash = NULL;
-
 #if defined(powerpc_HOST_ARCH)
    ocFlushInstructionCache( oc );
 #endif
@@ -3905,8 +3883,6 @@ static int resolveImports(
        if((symbol->n_type & N_TYPE) == N_UNDF
            && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
            addr = (void*) (symbol->n_value);
-       else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
-           ;
        else
            addr = lookupSymbol(nm);
        if(!addr)
@@ -4553,10 +4529,6 @@ static int ocResolve_MachO(ObjectCode* oc)
            return 0;
     }
 
-    /* Free the local symbol table; we won't need it again. */
-    freeHashTable(oc->lochash, NULL);
-    oc->lochash = NULL;
-
 #if defined (powerpc_HOST_ARCH)
     ocFlushInstructionCache( oc );
 #endif