[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 7b9df7f..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
 
@@ -425,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)                        \
@@ -751,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
 }
 
@@ -798,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);
@@ -2176,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) {
@@ -3317,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;
@@ -3348,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;
@@ -3391,7 +3414,7 @@ static int resolveImports(
     return 1;
 }
 
-static char* relocateAddress(
+static unsigned long relocateAddress(
     ObjectCode* oc,
     int nSections,
     struct section* sections,
@@ -3403,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(
@@ -3544,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);
@@ -3588,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);
@@ -3600,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)
@@ -3611,7 +3637,7 @@ static int relocateSection(
                     }
                     else
                     {
-                        word += symbolAddress;
+                        word += (unsigned long) symbolAddress;
                     }
                }
 
@@ -3669,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;
@@ -3751,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)