[project @ 2005-03-08 04:45:29 by wolfgang]
[ghc-hetmet.git] / ghc / rts / Linker.c
index 09a30a4..9ee1858 100644 (file)
@@ -10,7 +10,9 @@
 #include "PosixSource.h"
 #endif
 
-//  Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h>.
+/* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h> and 
+   MREMAP_MAYMOVE from <sys/mman.h>.
+ */
 #ifdef __linux__
 #define _GNU_SOURCE
 #endif
@@ -36,9 +38,7 @@
 #include <sys/stat.h>
 #endif
 
-#if defined(HAVE_FRAMEWORK_HASKELLSUPPORT)
-#include <HaskellSupport/dlfcn.h>
-#elif defined(HAVE_DLFCN_H)
+#if defined(HAVE_DLFCN_H)
 #include <dlfcn.h>
 #endif
 
 #include <sys/wait.h>
 #endif
 
-#if defined(ia64_HOST_ARCH) || defined(openbsd_HOST_OS) || defined(linux_HOST_OS)
+#if defined(ia64_HOST_ARCH) || defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
 #define USE_MMAP
 #include <fcntl.h>
 #include <sys/mman.h>
 
-#if defined(openbsd_HOST_OS) || defined(linux_HOST_OS)
+#if defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
 #ifdef HAVE_UNISTD_H
 #include <unistd.h>
 #endif
@@ -391,6 +391,8 @@ typedef struct _RtsSymbolVal {
       SymX(andIntegerzh_fast)                  \
       SymX(atomicallyzh_fast)                  \
       SymX(barf)                               \
+      SymX(debugBelch)                         \
+      SymX(errorBelch)                         \
       SymX(blockAsyncExceptionszh_fast)                \
       SymX(catchzh_fast)                       \
       SymX(catchRetryzh_fast)                  \
@@ -421,7 +423,14 @@ typedef struct _RtsSymbolVal {
       SymX(genericRaise)                       \
       SymX(getProgArgv)                                \
       SymX(getStablePtr)                       \
-      SymX(initLinker)                         \
+      SymX(hs_init)                            \
+      SymX(hs_exit)                            \
+      SymX(hs_set_argv)                                \
+      SymX(hs_add_root)                                \
+      SymX(hs_perform_gc)                      \
+      SymX(hs_free_stable_ptr)                 \
+      SymX(hs_free_fun_ptr)                    \
+      SymX(initLinker)                         \
       SymX(int2Integerzh_fast)                 \
       SymX(integer2Intzh_fast)                 \
       SymX(integer2Wordzh_fast)                        \
@@ -526,6 +535,7 @@ typedef struct _RtsSymbolVal {
       SymX(stg_IND_STATIC_info)                        \
       SymX(stg_INTLIKE_closure)                        \
       SymX(stg_MUT_ARR_PTRS_FROZEN_info)       \
+      SymX(stg_MUT_ARR_PTRS_FROZEN0_info)      \
       SymX(stg_WEAK_info)                       \
       SymX(stg_ap_0_info)                      \
       SymX(stg_ap_v_info)                      \
@@ -1304,21 +1314,51 @@ static void addSection ( ObjectCode* oc, SectionKind kind,
 
 static int ocAllocateJumpIslands( ObjectCode* oc, int count, int first )
 {
+#ifdef USE_MMAP
+  int pagesize, n, m;
+#endif
   int aligned;
 
   if( count > 0 )
   {
-#ifdef USE_MMAP
-    #error ocAllocateJumpIslands doesnt want USE_MMAP to be defined
-#endif
     // round up to the nearest 4
     aligned = (oc->fileSize + 3) & ~3;
 
+#ifdef USE_MMAP
+    #ifndef linux_HOST_OS /* mremap is a linux extension */
+        #error ocAllocateJumpIslands doesnt want USE_MMAP to be defined
+    #endif
+
+    pagesize = getpagesize();
+    n = ROUND_UP( oc->fileSize, pagesize );
+    m = ROUND_UP( aligned + sizeof (ppcJumpIsland) * count, pagesize );
+
+    /* 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.
+     */
+    if( (oc->image = mremap( oc->image, n, m, MREMAP_MAYMOVE )) == 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;
+    }
+
+#else
     oc->image = stgReallocBytes( oc->image,
-                                 aligned + sizeof( ppcJumpIsland ) * count,
+                                 aligned + sizeof (ppcJumpIsland) * count,
                                  "ocAllocateJumpIslands" );
-    oc->jump_islands = (ppcJumpIsland *) (((char *) oc->image) + aligned);
-    memset( oc->jump_islands, 0, sizeof( ppcJumpIsland ) * count );
+#endif /* USE_MMAP */
+
+    oc->jump_islands = (ppcJumpIsland *) (oc->image + aligned);
+    memset( oc->jump_islands, 0, sizeof (ppcJumpIsland) * count );
   }
   else
     oc->jump_islands = NULL;
@@ -3282,7 +3322,7 @@ static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
                 // symbol, so we don't have to allocate too many
                 // jump islands.
             struct symtab_command *symLC = (struct symtab_command *) lc;
-            int min = symLC->nsyms, max = 0;
+            unsigned min = symLC->nsyms, max = 0;
             struct nlist *nlist =
                 symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
                       : NULL;
@@ -3313,7 +3353,7 @@ static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
     return ocAllocateJumpIslands(oc,0,0);
 }
 
-static int ocVerifyImage_MachO(ObjectCode* oc)
+static int ocVerifyImage_MachO(ObjectCode* oc STG_UNUSED)
 {
     // FIXME: do some verifying here
     return 1;
@@ -3356,7 +3396,7 @@ static int resolveImports(
     return 1;
 }
 
-static char* relocateAddress(
+static unsigned long relocateAddress(
     ObjectCode* oc,
     int nSections,
     struct section* sections,
@@ -3368,12 +3408,13 @@ static char* relocateAddress(
         if(sections[i].addr <= address
             && address < sections[i].addr + sections[i].size)
         {
-            return oc->image + sections[i].offset + address - sections[i].addr;
+            return (unsigned long)oc->image
+                    + sections[i].offset + address - sections[i].addr;
         }
     }
     barf("Invalid Mach-O file:"
          "Address out of bounds while relocating object file");
-    return NULL;
+    return 0;
 }
 
 static int relocateSection(
@@ -3509,7 +3550,9 @@ static int relocateSection(
            {
                unsigned long word = 0;
                 unsigned long jumpIsland = 0;
-                long offsetToJumpIsland;
+                long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
+                                                      // to avoid warning and to catch
+                                                      // bugs.
 
                unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
                checkProddableBlock(oc,wordPtr);
@@ -3553,7 +3596,7 @@ static int relocateSection(
                {
                    struct nlist *symbol = &nlist[reloc->r_symbolnum];
                    char *nm = image + symLC->stroff + symbol->n_un.n_strx;
-                   unsigned long symbolAddress = (unsigned long) (lookupSymbol(nm));
+                   void *symbolAddress = lookupSymbol(nm);
                    if(!symbolAddress)
                    {
                        errorBelch("\nunknown symbol `%s'", nm);
@@ -3565,7 +3608,7 @@ static int relocateSection(
                             // In the .o file, this should be a relative jump to NULL
                             // and we'll change it to a jump to a relative jump to the symbol
                         ASSERT(-word == reloc->r_address);
-                        word = symbolAddress;
+                        word = (unsigned long) symbolAddress;
                         jumpIsland = makeJumpIsland(oc,reloc->r_symbolnum,word);
                        word -= ((long)image) + sect->offset + reloc->r_address;
                         if(jumpIsland != 0)
@@ -3576,7 +3619,7 @@ static int relocateSection(
                     }
                     else
                     {
-                        word += symbolAddress;
+                        word += (unsigned long) symbolAddress;
                     }
                }
 
@@ -3634,7 +3677,7 @@ static int ocGetNames_MachO(ObjectCode* oc)
     char *image = (char*) oc->image;
     struct mach_header *header = (struct mach_header*) image;
     struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
-    unsigned i,curSymbol;
+    unsigned i,curSymbol = 0;
     struct segment_command *segLC = NULL;
     struct section *sections;
     struct symtab_command *symLC = NULL;
@@ -3716,7 +3759,6 @@ static int ocGetNames_MachO(ObjectCode* oc)
 
     if(symLC)
     {
-        curSymbol = 0;
         for(i=0;i<symLC->nsyms;i++)
         {
             if(nlist[i].n_type & N_STAB)