[project @ 2005-03-27 13:41:13 by panne]

[ghc-hetmet.git] / ghc / rts / Linker.c

diff --git a/ghc/rts/Linker.c b/ghc/rts/Linker.c
index 4fb0ed6..11c1783 100644 (file)
--- a/ghc/rts/Linker.c
+++ b/ghc/rts/Linker.c
@@ -38,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
 
@@ -758,7 +756,7 @@ initLinker( void )
 #   if defined(openbsd_HOST_OS)
     dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
 #   endif
-#   endif // RTLD_DEFAULT
+#   endif /* RTLD_DEFAULT */
 #   endif
 }
 
@@ -805,6 +803,24 @@ addDLL( char *dll_name )
    void *hdl;
    char *errmsg;
 
+   // *** HACK
+   // If we load libHSbase_cbits_dyn.[so|dylib],
+   // then we know that we need to activate another newCAF
+   // related hack in Storage.c because we can't redirect
+   // newCAF to newDynCAF with the system dynamic linker.
+#ifdef OBJFORMAT_MACHO
+   const char *hsbase = "/libHSbase_cbits_dyn.dylib";
+#else
+   const char *hsbase = "/libHSbase_cbits_dyn.so";
+#endif
+   int namelen = strlen(dll_name);
+   int baselen = strlen(hsbase);
+   if(namelen > baselen && !strcmp(dll_name + namelen - baselen, hsbase))
+   {
+      keepCAFs = rtsTrue;
+   }
+   // *** END HACK.
+
    initLinker();
 
    hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
@@ -2183,7 +2199,7 @@ ocResolve_PEi386 ( ObjectCode* oc )
            /* Newline first because the interactive linker has printed "linking..." */
             errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
             return 0;
-           foundit:
+           foundit:;
          }
          checkProddableBlock(oc, pP);
          switch (reltab_j->Type) {
@@ -3324,7 +3340,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;
@@ -3355,7 +3371,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;
@@ -3398,7 +3414,7 @@ static int resolveImports(
     return 1;
 }
 
-static char* relocateAddress(
+static unsigned long relocateAddress(
     ObjectCode* oc,
     int nSections,
     struct section* sections,
@@ -3410,12 +3426,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(
@@ -3551,7 +3568,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);
@@ -3595,7 +3614,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);
@@ -3607,7 +3626,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)
@@ -3618,7 +3637,7 @@ static int relocateSection(
                     }
                     else
                     {
-                        word += symbolAddress;
+                        word += (unsigned long) symbolAddress;
                     }
                }
 
@@ -3676,7 +3695,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;
@@ -3758,7 +3777,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)