Remove libHSrtsmain.a before creating it
[ghc-hetmet.git] / rts / Linker.c
index 7e93765..beaf19e 100644 (file)
 #include "posix/Signals.h"
 #endif
 
+#if defined(mingw32_HOST_OS)
+// get protos for is*()
+#include <ctype.h>
+#endif
+
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>
 #endif
 #include <sys/wait.h>
 #endif
 
-#if defined(ia64_HOST_ARCH) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
+#if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS) || defined(darwin_HOST_OS)
 #define USE_MMAP
 #include <fcntl.h>
 #include <sys/mman.h>
 
-#if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
 #ifdef HAVE_UNISTD_H
 #include <unistd.h>
 #endif
-#endif
 
 #endif
 
@@ -89,6 +92,7 @@
 #  include <math.h>
 #elif defined(darwin_HOST_OS)
 #  define OBJFORMAT_MACHO
+#  include <regex.h>
 #  include <mach-o/loader.h>
 #  include <mach-o/nlist.h>
 #  include <mach-o/reloc.h>
@@ -130,7 +134,9 @@ static int ocVerifyImage_MachO    ( ObjectCode* oc );
 static int ocGetNames_MachO       ( ObjectCode* oc );
 static int ocResolve_MachO        ( ObjectCode* oc );
 
+#ifndef USE_MMAP
 static int machoGetMisalignment( FILE * );
+#endif
 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
 static int ocAllocateSymbolExtras_MachO ( ObjectCode* oc );
 #endif
@@ -386,17 +392,17 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(strncpy)                             \
       SymI_HasProto(abort)                               \
       SymI_NeedsProto(_alloca)                           \
-      SymI_NeedsProto(isxdigit)                          \
-      SymI_NeedsProto(isupper)                           \
-      SymI_NeedsProto(ispunct)                           \
-      SymI_NeedsProto(islower)                           \
-      SymI_NeedsProto(isspace)                           \
-      SymI_NeedsProto(isprint)                           \
-      SymI_NeedsProto(isdigit)                           \
-      SymI_NeedsProto(iscntrl)                           \
-      SymI_NeedsProto(isalpha)                           \
-      SymI_NeedsProto(isalnum)                           \
-      SymI_NeedsProto(isascii)                           \
+      SymI_HasProto(isxdigit)                          \
+      SymI_HasProto(isupper)                           \
+      SymI_HasProto(ispunct)                           \
+      SymI_HasProto(islower)                           \
+      SymI_HasProto(isspace)                           \
+      SymI_HasProto(isprint)                           \
+      SymI_HasProto(isdigit)                           \
+      SymI_HasProto(iscntrl)                           \
+      SymI_HasProto(isalpha)                           \
+      SymI_HasProto(isalnum)                           \
+      SymI_HasProto(isascii)                           \
       RTS___MINGW_VFPRINTF_SYM                           \
       SymI_HasProto(strcmp)                              \
       SymI_HasProto(memmove)                             \
@@ -451,7 +457,7 @@ typedef struct _RtsSymbolVal {
       SymI_NeedsProto(closedir)
 #endif
 
-#if defined(darwin_TARGET_OS) && HAVE_PRINTF_LDBLSTUB
+#if defined(darwin_HOST_OS) && HAVE_PRINTF_LDBLSTUB
 #define RTS_DARWIN_ONLY_SYMBOLS                                    \
      SymI_NeedsProto(asprintf$LDBLStub)                     \
      SymI_NeedsProto(err$LDBLStub)                          \
@@ -737,8 +743,9 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(debugBelch)                                \
       SymI_HasProto(errorBelch)                                \
       SymI_HasProto(sysErrorBelch)                      \
-      SymI_HasProto(stg_asyncExceptionsBlockedzh)      \
-      SymI_HasProto(stg_blockAsyncExceptionszh)                \
+      SymI_HasProto(stg_getMaskingStatezh)             \
+      SymI_HasProto(stg_maskAsyncExceptionszh)         \
+      SymI_HasProto(stg_maskUninterruptiblezh)         \
       SymI_HasProto(stg_catchzh)                       \
       SymI_HasProto(stg_catchRetryzh)                  \
       SymI_HasProto(stg_catchSTMzh)                    \
@@ -782,6 +789,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_unpackClosurezh)                \
       SymI_HasProto(stg_getApStackValzh)                \
       SymI_HasProto(stg_getSparkzh)                     \
+      SymI_HasProto(stg_numSparkszh)                    \
       SymI_HasProto(stg_isCurrentThreadBoundzh)                \
       SymI_HasProto(stg_isEmptyMVarzh)                 \
       SymI_HasProto(stg_killThreadzh)                  \
@@ -871,7 +879,10 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stable_ptr_table)                  \
       SymI_HasProto(stackOverflow)                     \
       SymI_HasProto(stg_CAF_BLACKHOLE_info)            \
+      SymI_HasProto(stg_BLACKHOLE_info)                        \
       SymI_HasProto(__stg_EAGER_BLACKHOLE_info)                \
+      SymI_HasProto(stg_BLOCKING_QUEUE_CLEAN_info)      \
+      SymI_HasProto(stg_BLOCKING_QUEUE_DIRTY_info)     \
       SymI_HasProto(startTimer)                         \
       SymI_HasProto(stg_MVAR_CLEAN_info)               \
       SymI_HasProto(stg_MVAR_DIRTY_info)               \
@@ -935,12 +946,13 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_sel_8_upd_info)                        \
       SymI_HasProto(stg_sel_9_upd_info)                        \
       SymI_HasProto(stg_upd_frame_info)                        \
+      SymI_HasProto(stg_bh_upd_frame_info)             \
       SymI_HasProto(suspendThread)                     \
       SymI_HasProto(stg_takeMVarzh)                    \
       SymI_HasProto(stg_threadStatuszh)                        \
       SymI_HasProto(stg_tryPutMVarzh)                  \
       SymI_HasProto(stg_tryTakeMVarzh)                 \
-      SymI_HasProto(stg_unblockAsyncExceptionszh)      \
+      SymI_HasProto(stg_unmaskAsyncExceptionszh)       \
       SymI_HasProto(unloadObj)                          \
       SymI_HasProto(stg_unsafeThawArrayzh)             \
       SymI_HasProto(stg_waitReadzh)                    \
@@ -993,7 +1005,7 @@ typedef struct _RtsSymbolVal {
 
 /* entirely bogus claims about types of these symbols */
 #define SymI_NeedsProto(vvv)  extern void vvv(void);
-#if defined(__PIC__) && defined(mingw32_TARGET_OS)
+#if defined(__PIC__) && defined(mingw32_HOST_OS)
 #define SymE_HasProto(vvv)    SymE_HasProto(vvv);
 #define SymE_NeedsProto(vvv)    extern void _imp__ ## vvv (void);
 #else
@@ -1109,7 +1121,9 @@ void
 initLinker( void )
 {
     RtsSymbolVal *sym;
+#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
     int compileResult;
+#endif
 
     /* Make initLinker idempotent, so we can call it
        before evey relevant operation; that means we
@@ -1118,7 +1132,7 @@ initLinker( void )
       linker_init_done = 1;
     }
 
-#ifdef THREADED_RTS
+#if defined(THREADED_RTS) && (defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO))
     initMutex(&dl_mutex);
 #endif
     stablehash = allocStrHashTable();
@@ -1218,11 +1232,12 @@ static OpenedDLL* opened_dlls = NULL;
 
 #  if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
 
-static char *
+static const char *
 internal_dlopen(const char *dll_name)
 {
    void *hdl;
-   char *errmsg, *errmsg_copy;
+   const char *errmsg;
+   char *errmsg_copy;
 
    // omitted: RTLD_NOW
    // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html
@@ -1262,7 +1277,7 @@ addDLL( char *dll_name )
 
 #define NMATCH 5
    regmatch_t match[NMATCH];
-   char *errmsg;
+   const char *errmsg;
    FILE* fp;
    size_t match_length;
 #define MAXLINE 1000
@@ -1449,13 +1464,13 @@ lookupSymbol( char *lbl )
 #       elif defined(OBJFORMAT_PEi386)
         void* sym;
 
-        sym = lookupSymbolInDLLs(lbl);
+        sym = lookupSymbolInDLLs((unsigned char*)lbl);
         if (sym != NULL) { return sym; };
 
         // Also try looking up the symbol without the @N suffix.  Some
         // DLLs have the suffixes on their symbols, some don't.
-        zapTrailingAtSign ( lbl );
-        sym = lookupSymbolInDLLs(lbl);
+        zapTrailingAtSign ( (unsigned char*)lbl );
+        sym = lookupSymbolInDLLs((unsigned char*)lbl);
         if (sym != NULL) { return sym; };
         return NULL;
 
@@ -1593,6 +1608,7 @@ loadObj( char *path )
 #else
    FILE *f;
 #endif
+   IF_DEBUG(linker, debugBelch("loadObj %s\n", path));
    initLinker();
 
    /* debugBelch("loadObj %s\n", path ); */
@@ -1633,7 +1649,10 @@ loadObj( char *path )
 #  endif
 
    r = stat(path, &st);
-   if (r == -1) { return 0; }
+   if (r == -1) {
+       IF_DEBUG(linker, debugBelch("File doesn't exist\n"));
+       return 0;
+   }
 
    /* sigh, strdup() isn't a POSIX function, so do it the long way */
    oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
@@ -1702,10 +1721,16 @@ loadObj( char *path )
 
 #  if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
    r = ocAllocateSymbolExtras_MachO ( oc );
-   if (!r) { return r; }
+   if (!r) {
+       IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO failed\n"));
+       return r;
+   }
 #  elif defined(OBJFORMAT_ELF) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
    r = ocAllocateSymbolExtras_ELF ( oc );
-   if (!r) { return r; }
+   if (!r) {
+       IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_ELF failed\n"));
+       return r;
+   }
 #endif
 
    /* verify the in-memory image */
@@ -1718,7 +1743,10 @@ loadObj( char *path )
 #  else
    barf("loadObj: no verify method");
 #  endif
-   if (!r) { return r; }
+   if (!r) {
+       IF_DEBUG(linker, debugBelch("ocVerifyImage_* failed\n"));
+       return r;
+   }
 
    /* build the symbol list for this image */
 #  if defined(OBJFORMAT_ELF)
@@ -1730,7 +1758,10 @@ loadObj( char *path )
 #  else
    barf("loadObj: no getNames method");
 #  endif
-   if (!r) { return r; }
+   if (!r) {
+       IF_DEBUG(linker, debugBelch("ocGetNames_* failed\n"));
+       return r;
+   }
 
    /* loaded, but not resolved yet */
    oc->status = OBJECT_LOADED;
@@ -2003,7 +2034,7 @@ static SymbolExtra* makeSymbolExtra( ObjectCode* oc,
  * PowerPC specifics (instruction cache flushing)
  * ------------------------------------------------------------------------*/
 
-#ifdef powerpc_TARGET_ARCH
+#ifdef powerpc_HOST_ARCH
 /*
    ocFlushInstructionCache
 
@@ -2204,7 +2235,7 @@ copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
 {
    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
       UInt32 strtab_offset = * (UInt32*)(name+4);
-      strncpy ( dst, strtab+strtab_offset, dstSize );
+      strncpy ( (char*)dst, (char*)strtab+strtab_offset, dstSize );
       dst[dstSize-1] = 0;
    } else {
       int i = 0;
@@ -2239,7 +2270,7 @@ cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
    */
    newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
    ASSERT(newstr);
-   strncpy(newstr,name,8);
+   strncpy((char*)newstr,(char*)name,8);
    newstr[8] = 0;
    return newstr;
 }
@@ -2247,7 +2278,7 @@ cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
 
 /* Just compares the short names (first 8 chars) */
 static COFF_section *
-findPEi386SectionCalled ( ObjectCode* oc,  char* name )
+findPEi386SectionCalled ( ObjectCode* oc,  UChar* name )
 {
    int i;
    COFF_header* hdr
@@ -2305,13 +2336,13 @@ lookupSymbolInDLLs ( UChar *lbl )
                a Rule that governs whether an initial '_' *should always* be
                stripped off when mapping from import lib name to the DLL name.
             */
-            sym = GetProcAddress(o_dll->instance, (lbl+1));
+            sym = GetProcAddress(o_dll->instance, (char*)(lbl+1));
             if (sym != NULL) {
                /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
                return sym;
             }
         }
-        sym = GetProcAddress(o_dll->instance, lbl);
+        sym = GetProcAddress(o_dll->instance, (char*)lbl);
         if (sym != NULL) {
             /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
             return sym;
@@ -2542,7 +2573,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
       COFF_section* sectab_i
          = (COFF_section*)
            myindex ( sizeof_COFF_section, sectab, i );
-      if (0 != strcmp(sectab_i->Name, ".bss")) continue;
+      if (0 != strcmp((char*)sectab_i->Name, ".bss")) continue;
       /* sof 10/05: the PE spec text isn't too clear regarding what
        * the SizeOfRawData field is supposed to hold for object
        * file sections containing just uninitialized data -- for executables,
@@ -2595,12 +2626,12 @@ ocGetNames_PEi386 ( ObjectCode* oc )
          kind = SECTIONKIND_CODE_OR_RODATA;
 #     endif
 
-      if (0==strcmp(".text",sectab_i->Name) ||
-          0==strcmp(".rdata",sectab_i->Name)||
-          0==strcmp(".rodata",sectab_i->Name))
+      if (0==strcmp(".text",(char*)sectab_i->Name) ||
+          0==strcmp(".rdata",(char*)sectab_i->Name)||
+          0==strcmp(".rodata",(char*)sectab_i->Name))
          kind = SECTIONKIND_CODE_OR_RODATA;
-      if (0==strcmp(".data",sectab_i->Name) ||
-          0==strcmp(".bss",sectab_i->Name))
+      if (0==strcmp(".data",(char*)sectab_i->Name) ||
+          0==strcmp(".bss",(char*)sectab_i->Name))
          kind = SECTIONKIND_RWDATA;
 
       ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
@@ -2613,14 +2644,14 @@ ocGetNames_PEi386 ( ObjectCode* oc )
       if (kind == SECTIONKIND_OTHER
           /* Ignore sections called which contain stabs debugging
              information. */
-          && 0 != strcmp(".stab", sectab_i->Name)
-          && 0 != strcmp(".stabstr", sectab_i->Name)
+          && 0 != strcmp(".stab", (char*)sectab_i->Name)
+          && 0 != strcmp(".stabstr", (char*)sectab_i->Name)
           /* ignore constructor section for now */
-          && 0 != strcmp(".ctors", sectab_i->Name)
+          && 0 != strcmp(".ctors", (char*)sectab_i->Name)
           /* ignore section generated from .ident */
-          && 0!= strcmp("/4", sectab_i->Name)
+          && 0!= strcmp("/4", (char*)sectab_i->Name)
          /* ignore unknown section that appeared in gcc 3.4.5(?) */
-          && 0!= strcmp(".reloc", sectab_i->Name)
+          && 0!= strcmp(".reloc", (char*)sectab_i->Name)
          ) {
          errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
          return 0;
@@ -2685,8 +2716,8 @@ ocGetNames_PEi386 ( ObjectCode* oc )
          IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
          ASSERT(i >= 0 && i < oc->n_symbols);
          /* cstring_from_COFF_symbol_name always succeeds. */
-         oc->symbols[i] = sname;
-         ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
+         oc->symbols[i] = (char*)sname;
+         ghciInsertStrHashTable(oc->fileName, symhash, (char*)sname, addr);
       } else {
 #        if 0
          debugBelch(
@@ -2736,7 +2767,7 @@ ocResolve_PEi386 ( ObjectCode* oc )
 
    /* ToDo: should be variable-sized?  But is at least safe in the
       sense of buffer-overrun-proof. */
-   char symbol[1000];
+   UChar symbol[1000];
    /* debugBelch("resolving for %s\n", oc->fileName); */
 
    hdr = (COFF_header*)(oc->image);
@@ -2763,9 +2794,9 @@ ocResolve_PEi386 ( ObjectCode* oc )
 
       /* Ignore sections called which contain stabs debugging
          information. */
-      if (0 == strcmp(".stab", sectab_i->Name)
-          || 0 == strcmp(".stabstr", sectab_i->Name)
-          || 0 == strcmp(".ctors", sectab_i->Name))
+      if (0 == strcmp(".stab", (char*)sectab_i->Name)
+          || 0 == strcmp(".stabstr", (char*)sectab_i->Name)
+          || 0 == strcmp(".ctors", (char*)sectab_i->Name))
          continue;
 
       if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
@@ -2838,7 +2869,7 @@ ocResolve_PEi386 ( ObjectCode* oc )
                    + sym->Value);
          } else {
             copyName ( sym->Name, strtab, symbol, 1000-1 );
-            S = (UInt32) lookupSymbol( symbol );
+            S = (UInt32) lookupSymbol( (char*)symbol );
             if ((void*)S != NULL) goto foundit;
             errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
             return 0;
@@ -2941,10 +2972,18 @@ ocResolve_PEi386 ( ObjectCode* oc )
 #define Elf_Sym     Elf64_Sym
 #define Elf_Rel     Elf64_Rel
 #define Elf_Rela    Elf64_Rela
+#ifndef ELF_ST_TYPE
 #define ELF_ST_TYPE ELF64_ST_TYPE
+#endif
+#ifndef ELF_ST_BIND
 #define ELF_ST_BIND ELF64_ST_BIND
+#endif
+#ifndef ELF_R_TYPE
 #define ELF_R_TYPE  ELF64_R_TYPE
+#endif
+#ifndef ELF_R_SYM
 #define ELF_R_SYM   ELF64_R_SYM
+#endif
 #else
 #define ELFCLASS    ELFCLASS32
 #define Elf_Addr    Elf32_Addr
@@ -3999,12 +4038,18 @@ static int ocVerifyImage_MachO(ObjectCode* oc)
     char *image = (char*) oc->image;
     struct mach_header *header = (struct mach_header*) image;
 
-#if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
-    if(header->magic != MH_MAGIC_64)
+#if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
+    if(header->magic != MH_MAGIC_64) {
+        errorBelch("%s: Bad magic. Expected: %08x, got: %08x.\n",
+                   oc->fileName, MH_MAGIC_64, header->magic);
         return 0;
+    }
 #else
-    if(header->magic != MH_MAGIC)
+    if(header->magic != MH_MAGIC) {
+        errorBelch("%s: Bad magic. Expected: %08x, got: %08x.\n",
+                   oc->fileName, MH_MAGIC, header->magic);
         return 0;
+    }
 #endif
     // FIXME: do some more verifying here
     return 1;
@@ -4191,6 +4236,9 @@ static int relocateSection(
                 thing += value;
                 break;
             case X86_64_RELOC_SIGNED:
+            case X86_64_RELOC_SIGNED_1:
+            case X86_64_RELOC_SIGNED_2:
+            case X86_64_RELOC_SIGNED_4:
                 ASSERT(reloc->r_pcrel);
                 thing += value - baseValue;
                 break;
@@ -4254,7 +4302,8 @@ static int relocateSection(
                    else if(scat->r_type == PPC_RELOC_SECTDIFF
                        || scat->r_type == PPC_RELOC_LO16_SECTDIFF
                        || scat->r_type == PPC_RELOC_HI16_SECTDIFF
-                       || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
+                       || scat->r_type == PPC_RELOC_HA16_SECTDIFF
+                       || scat->r_type == PPC_RELOC_LOCAL_SECTDIFF)
 #else
                     else if(scat->r_type == GENERIC_RELOC_SECTDIFF
                         || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
@@ -4748,9 +4797,10 @@ static int ocResolve_MachO(ObjectCode* oc)
  * Yuck.
  */
 
+extern void* symbolsWithoutUnderscore[];
+
 static void machoInitSymbolsWithoutUnderscore()
 {
-    extern void* symbolsWithoutUnderscore[];
     void **p = symbolsWithoutUnderscore;
     __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
 
@@ -4772,6 +4822,7 @@ static void machoInitSymbolsWithoutUnderscore()
 }
 #endif
 
+#ifndef USE_MMAP
 /*
  * Figure out by how much to shift the entire Mach-O file in memory
  * when loading so that its single segment ends up 16-byte-aligned
@@ -4784,12 +4835,18 @@ static int machoGetMisalignment( FILE * f )
     fread(&header, sizeof(header), 1, f);
     rewind(f);
 
-#if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
-    if(header.magic != MH_MAGIC_64)
+#if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
+    if(header.magic != MH_MAGIC_64) {
+        errorBelch("Bad magic. Expected: %08x, got: %08x.\n",
+                   MH_MAGIC_64, header->magic);
         return 0;
+    }
 #else
-    if(header.magic != MH_MAGIC)
+    if(header.magic != MH_MAGIC) {
+        errorBelch("Bad magic. Expected: %08x, got: %08x.\n",
+                   MH_MAGIC, header->magic);
         return 0;
+    }
 #endif
 
     misalignment = (header.sizeofcmds + sizeof(header))
@@ -4797,6 +4854,7 @@ static int machoGetMisalignment( FILE * f )
 
     return misalignment ? (16 - misalignment) : 0;
 }
+#endif
 
 #endif