Fix initialisation of strictness in the demand analyser
[ghc-hetmet.git] / rts / Linker.c
index df91b65..3741386 100644 (file)
@@ -119,7 +119,8 @@ static /*Str*/HashTable *stablehash;
 ObjectCode *objects = NULL;    /* initially empty */
 
 static HsInt loadOc( ObjectCode* oc );
-static ObjectCode* mkOc( char *path, char *image, int imageSize
+static ObjectCode* mkOc( char *path, char *image, int imageSize,
+                         char *archiveMemberName
 #ifndef USE_MMAP
 #ifdef darwin_HOST_OS
                        , int misalignment
@@ -354,15 +355,6 @@ typedef struct _RtsSymbolVal {
 #define RTS_POSIX_ONLY_SYMBOLS  /**/
 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
 
-/* Extra syms gen'ed by mingw-2's gcc-3.2: */
-#if __GNUC__>=3
-#define RTS_MINGW_EXTRA_SYMS                    \
-      SymI_NeedsProto(_imp____mb_cur_max)       \
-      SymI_NeedsProto(_imp___pctype)
-#else
-#define RTS_MINGW_EXTRA_SYMS
-#endif
-
 #if HAVE_GETTIMEOFDAY
 #define RTS_MINGW_GETTIMEOFDAY_SYM SymI_NeedsProto(gettimeofday)
 #else
@@ -463,11 +455,14 @@ typedef struct _RtsSymbolVal {
       SymI_NeedsProto(opendir)                           \
       SymI_NeedsProto(readdir)                           \
       SymI_NeedsProto(rewinddir)                         \
-      RTS_MINGW_EXTRA_SYMS                               \
+      SymI_NeedsProto(_imp____mb_cur_max)               \
+      SymI_NeedsProto(_imp___pctype)                    \
+      SymI_NeedsProto(__chkstk)                                 \
       RTS_MINGW_GETTIMEOFDAY_SYM                        \
       SymI_NeedsProto(closedir)
 #endif
 
+
 #if defined(darwin_HOST_OS) && HAVE_PRINTF_LDBLSTUB
 #define RTS_DARWIN_ONLY_SYMBOLS                                    \
      SymI_NeedsProto(asprintf$LDBLStub)                     \
@@ -1608,7 +1603,8 @@ mmap_again:
 #endif // USE_MMAP
 
 static ObjectCode*
-mkOc( char *path, char *image, int imageSize
+mkOc( char *path, char *image, int imageSize,
+      char *archiveMemberName
 #ifndef USE_MMAP
 #ifdef darwin_HOST_OS
     , int misalignment
@@ -1632,10 +1628,17 @@ mkOc( char *path, char *image, int imageSize
 
    oc->image = image;
    /* sigh, strdup() isn't a POSIX function, so do it the long way */
-   /* XXX What should this be for an archive? */
    oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
    strcpy(oc->fileName, path);
 
+   if (archiveMemberName) {
+       oc->archiveMemberName = stgMallocBytes( strlen(archiveMemberName)+1, "loadObj" );
+       strcpy(oc->archiveMemberName, archiveMemberName);
+   }
+   else {
+       oc->archiveMemberName = NULL;
+   }
+
    oc->fileSize          = imageSize;
    oc->symbols           = NULL;
    oc->sections          = NULL;
@@ -1669,6 +1672,8 @@ loadArchive( char *path )
    int isObject;
    char tmp[12];
 
+   IF_DEBUG(linker, debugBelch("loadArchive `%s'\n", path));
+
    fileSize = 32;
    file = stgMallocBytes(fileSize, "loadArchive(file)");
 
@@ -1736,13 +1741,15 @@ loadArchive( char *path )
 
        isObject = 0;
        for (n = 0; n < (int)fileNameSize - 1; n++) {
-           if ((file[n] == '.') && (file[n] == 'o')) {
+           if ((file[n] == '.') && (file[n + 1] == 'o')) {
                isObject = 1;
                break;
            }
        }
 
        if (isObject) {
+           char *archiveMemberName;
+
            /* We can't mmap from the archive directly, as object
               files need to be 8-byte aligned but files in .ar
               archives are 2-byte aligned, and if we malloc the
@@ -1753,13 +1760,20 @@ loadArchive( char *path )
            n = fread ( image, 1, imageSize, f );
            if (n != imageSize)
                barf("loadObj: error whilst reading `%s'", path);
-           oc = mkOc(path, image, imageSize
+
+           archiveMemberName = stgMallocBytes(strlen(path) + fileNameSize + 3, "loadArchive(file)");
+           sprintf(archiveMemberName, "%s(%.*s)", path, (int)fileNameSize, file);
+
+           oc = mkOc(path, image, imageSize, archiveMemberName
 #ifndef USE_MMAP
 #ifdef darwin_HOST_OS
                     , 0
 #endif
 #endif
                     );
+
+           stgFree(archiveMemberName);
+
            if (0 == loadOc(oc)) {
                stgFree(file);
                return 0;
@@ -1903,7 +1917,7 @@ loadObj( char *path )
    fclose(f);
 #endif /* USE_MMAP */
 
-   oc = mkOc(path, image, fileSize
+   oc = mkOc(path, image, fileSize, NULL
 #ifndef USE_MMAP
 #ifdef darwin_HOST_OS
             , misalignment
@@ -1918,6 +1932,8 @@ static HsInt
 loadOc( ObjectCode* oc ) {
    int r;
 
+   IF_DEBUG(linker, debugBelch("loadOc\n"));
+
 #  if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
    r = ocAllocateSymbolExtras_MachO ( oc );
    if (!r) {
@@ -2006,6 +2022,7 @@ HsInt
 unloadObj( char *path )
 {
     ObjectCode *oc, *prev;
+    HsBool unloadedAnyObj = HS_BOOL_FALSE;
 
     ASSERT(symhash != NULL);
     ASSERT(objects != NULL);
@@ -2045,12 +2062,20 @@ unloadObj( char *path )
            stgFree(oc->symbols);
            stgFree(oc->sections);
            stgFree(oc);
-           return 1;
+
+            /* This could be a member of an archive so continue
+             * unloading other members. */
+            unloadedAnyObj = HS_BOOL_TRUE;
        }
     }
 
-    errorBelch("unloadObj: can't find `%s' to unload", path);
-    return 0;
+    if (unloadedAnyObj) {
+        return 1;
+    }
+    else {
+        errorBelch("unloadObj: can't find `%s' to unload", path);
+        return 0;
+    }
 }
 
 /* -----------------------------------------------------------------------------
@@ -4633,7 +4658,9 @@ static int relocateSection(
                              "scattered relocation entry: "
                               "object file %s; entry type %ld; "
                               "address %#lx\n", 
-                              oc->fileName, scat->r_type, scat->r_address);
+                              OC_INFORMATIVE_FILENAME(oc),
+                              scat->r_type,
+                              scat->r_address);
                         return 0;
                      }
 
@@ -4670,7 +4697,9 @@ static int relocateSection(
                         "with this r_length tag: "
                          "object file %s; entry type %ld; "
                          "r_length tag %ld; address %#lx\n", 
-                         oc->fileName, scat->r_type, scat->r_length,
+                         OC_INFORMATIVE_FILENAME(oc),
+                         scat->r_type,
+                         scat->r_length,
                          scat->r_address);
                     return 0;
                }
@@ -4680,7 +4709,9 @@ static int relocateSection(
                barf("Don't know how to handle *PC-relative* Mach-O "
                     "scattered relocation entry: "
                      "object file %s; entry type %ld; address %#lx\n", 
-                     oc->fileName, scat->r_type, scat->r_address);
+                     OC_INFORMATIVE_FILENAME(oc),
+                     scat->r_type,
+                     scat->r_address);
                return 0;
            }
 
@@ -4734,8 +4765,10 @@ static int relocateSection(
                 {
                     barf("Can't handle this Mach-O relocation entry "
                         "(not scattered): "
-                         "object file %s; entry type %ld; address %#lx\n", 
-                         oc->fileName, reloc->r_type, reloc->r_address);
+                         "object file %s; entry type %ld; address %#lx\n",
+                         OC_INFORMATIVE_FILENAME(oc),
+                         reloc->r_type,
+                         reloc->r_address);
                     return 0;
                 }
 
@@ -4809,20 +4842,32 @@ static int relocateSection(
                }
                else if(reloc->r_type == PPC_RELOC_BR24)
                {
-                    if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
+                    if((word & 0x03) != 0)
+                        barf("%s: unconditional relative branch with a displacement "
+                             "which isn't a multiple of 4 bytes: %#lx",
+                             OC_INFORMATIVE_FILENAME(oc),
+                             word);
+
+                    if((word & 0xFE000000) != 0xFE000000 &&
+                       (word & 0xFE000000) != 0x00000000)
                     {
                         // The branch offset is too large.
                         // Therefore, we try to use a jump island.
                         if(jumpIsland == 0)
                         {
-                            barf("unconditional relative branch out of range: "
-                                 "no jump island available");
+                            barf("%s: unconditional relative branch out of range: "
+                                 "no jump island available: %#lx",
+                                 OC_INFORMATIVE_FILENAME(oc),
+                                 word);
                         }
                         
                         word = offsetToJumpIsland;
-                        if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
-                            barf("unconditional relative branch out of range: "
-                                 "jump island out of range");
+                        if((word & 0xFE000000) != 0xFE000000 &&
+                           (word & 0xFE000000) != 0x00000000)
+                            barf("%s: unconditional relative branch out of range: "
+                                 "jump island out of range: %#lx",
+                                 OC_INFORMATIVE_FILENAME(oc),
+                                 word);
                     }
                    *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
                    continue;
@@ -4834,8 +4879,10 @@ static int relocateSection(
                 barf("Can't handle Mach-O relocation entry (not scattered) "
                       "with this r_length tag: "
                       "object file %s; entry type %ld; "
-                      "r_length tag %ld; address %#lx\n", 
-                      oc->fileName, reloc->r_type, reloc->r_length,
+                      "r_length tag %ld; address %#lx\n",
+                      OC_INFORMATIVE_FILENAME(oc),
+                      reloc->r_type,
+                      reloc->r_length,
                       reloc->r_address);
                 return 0;
            }
@@ -4859,6 +4906,8 @@ static int ocGetNames_MachO(ObjectCode* oc)
     char    *commonStorage = NULL;
     unsigned long commonCounter;
 
+    IF_DEBUG(linker,debugBelch("ocGetNames_MachO\n"));
+
     for(i=0;i<header->ncmds;i++)
     {
        if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
@@ -4948,6 +4997,7 @@ static int ocGetNames_MachO(ObjectCode* oc)
                         ; // weak definition, and we already have a definition
                     else
                     {
+                            IF_DEBUG(linker,debugBelch("Adding symbol 1 %s\n", nm));
                             ghciInsertStrHashTable(oc->fileName, symhash, nm,
                                                     image
                                                     + sections[nlist[i].n_sect-1].offset
@@ -4974,6 +5024,7 @@ static int ocGetNames_MachO(ObjectCode* oc)
 
                nlist[i].n_value = commonCounter;
 
+            IF_DEBUG(linker,debugBelch("Adding symbol 2 %s\n", nm));
                ghciInsertStrHashTable(oc->fileName, symhash, nm,
                                       (void*)commonCounter);
                oc->symbols[curSymbol++] = nm;