X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FLinker.c;h=878c86b60aa4fd58dce8a626b0b684ba3df6343a;hb=7cc184af587cdc8f29608cd98b738fa0322cfec4;hp=df91b65144a9f21cdae61cd2650f6748bd82695f;hpb=277eb982ef12a1dfcae330271134bf4672437ebe;p=ghc-hetmet.git diff --git a/rts/Linker.c b/rts/Linker.c index df91b65..878c86b 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -69,7 +69,15 @@ #include #endif -#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) +#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 ) && !defined(powerpc_HOST_ARCH) ) +/* Don't use mmap on powerpc-apple-darwin as mmap doesn't support + * reallocating but we need to allocate jump islands just after each + * object images. Otherwise relative branches to jump islands can fail + * due to 24-bits displacement overflow. + */ #define USE_MMAP #include #include @@ -119,7 +127,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 @@ -260,6 +269,7 @@ typedef struct _RtsSymbolVal { SymI_HasProto(unlockFile) \ SymI_HasProto(signal_handlers) \ SymI_HasProto(stg_sig_install) \ + SymI_HasProto(rtsTimerSignal) \ SymI_NeedsProto(nocldstop) #endif @@ -354,15 +364,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 +464,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) \ @@ -885,7 +889,7 @@ typedef struct _RtsSymbolVal { SymI_HasProto(rts_unlock) \ SymI_HasProto(rts_unsafeGetMyCapability) \ SymI_HasProto(rtsSupportsBoundThreads) \ - SymI_HasProto(rts_isProfiled) \ + SymI_HasProto(rts_isProfiled) \ SymI_HasProto(setProgArgv) \ SymI_HasProto(startupHaskell) \ SymI_HasProto(shutdownHaskell) \ @@ -1114,7 +1118,7 @@ static void ghciInsertStrHashTable ( char* obj_name, (char*)key, obj_name ); - exit(1); + stg_exit(1); } /* ----------------------------------------------------------------------------- * initialize the object linker @@ -1140,11 +1144,16 @@ initLinker( void ) int compileResult; #endif + IF_DEBUG(linker, debugBelch("initLinker: start\n")); + /* Make initLinker idempotent, so we can call it before evey relevant operation; that means we don't need to initialise the linker separately */ - if (linker_init_done == 1) { return; } else { - linker_init_done = 1; + if (linker_init_done == 1) { + IF_DEBUG(linker, debugBelch("initLinker: idempotent return\n")); + return; + } else { + linker_init_done = 1; } #if defined(THREADED_RTS) && (defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)) @@ -1157,6 +1166,7 @@ initLinker( void ) for (sym = rtsSyms; sym->lbl != NULL; sym++) { ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, sym->lbl, sym->addr); + IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr)); } # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH) machoInitSymbolsWithoutUnderscore(); @@ -1195,6 +1205,9 @@ initLinker( void ) addDLL("msvcrt"); addDLL("kernel32"); #endif + + IF_DEBUG(linker, debugBelch("initLinker: done\n")); + return; } void @@ -1449,11 +1462,13 @@ void * lookupSymbol( char *lbl ) { void *val; + IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s\n", lbl)); initLinker() ; ASSERT(symhash != NULL); val = lookupStrHashTable(symhash, lbl); if (val == NULL) { + IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n")); # if defined(OBJFORMAT_ELF) return dlsym(dl_prog_handle, lbl); # elif defined(OBJFORMAT_MACHO) @@ -1466,6 +1481,7 @@ lookupSymbol( char *lbl ) symbol name. For now, we simply strip it off here (and ONLY here). */ + IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s with dlsym\n", lbl)); ASSERT(lbl[0] == '_'); return dlsym(dl_prog_handle, lbl+1); # else @@ -1494,6 +1510,7 @@ lookupSymbol( char *lbl ) return NULL; # endif } else { + IF_DEBUG(linker, debugBelch("lookupSymbol: value of %s is %p\n", lbl, val)); return val; } } @@ -1608,7 +1625,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 +1650,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; @@ -1654,148 +1679,278 @@ mkOc( char *path, char *image, int imageSize return oc; } -#if defined(USE_ARCHIVES_FOR_GHCI) HsInt loadArchive( char *path ) { - ObjectCode* oc; - char *image; - int imageSize; - FILE *f; - int n; - size_t fileNameSize; - char *file; - size_t fileSize; - int isObject; - char tmp[12]; + ObjectCode* oc; + char *image; + int memberSize; + FILE *f; + int n; + size_t thisFileNameSize; + char *fileName; + size_t fileNameSize; + int isObject, isGnuIndex; + char tmp[12]; + char *gnuFileIndex; + int gnuFileIndexSize; +#if !defined(USE_MMAP) && defined(darwin_HOST_OS) + int misalignment; +#endif - fileSize = 32; - file = stgMallocBytes(fileSize, "loadArchive(file)"); + IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%s'\n", path)); - f = fopen(path, "rb"); - if (!f) - barf("loadObj: can't read `%s'", path); + gnuFileIndex = NULL; + gnuFileIndexSize = 0; - n = fread ( tmp, 1, 8, f ); - if (strncmp(tmp, "!\n", 8) != 0) - barf("loadArchive: Not an archive: `%s'", path); + fileNameSize = 32; + fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)"); - while(1) { - n = fread ( file, 1, 16, f ); - if (n != 16) { - if (feof(f)) { - break; - } - else { - barf("loadArchive: Failed reading file name from `%s'", path); - } - } - n = fread ( tmp, 1, 12, f ); - if (n != 12) - barf("loadArchive: Failed reading mod time from `%s'", path); - n = fread ( tmp, 1, 6, f ); - if (n != 6) - barf("loadArchive: Failed reading owner from `%s'", path); - n = fread ( tmp, 1, 6, f ); - if (n != 6) - barf("loadArchive: Failed reading group from `%s'", path); - n = fread ( tmp, 1, 8, f ); - if (n != 8) - barf("loadArchive: Failed reading mode from `%s'", path); - n = fread ( tmp, 1, 10, f ); - if (n != 10) - barf("loadArchive: Failed reading size from `%s'", path); - tmp[10] = '\0'; - for (n = 0; isdigit(tmp[n]); n++); - tmp[n] = '\0'; - imageSize = atoi(tmp); - n = fread ( tmp, 1, 2, f ); - if (strncmp(tmp, "\x60\x0A", 2) != 0) - barf("loadArchive: Failed reading magic from `%s' at %ld. Got %c%c", path, ftell(f), tmp[0], tmp[1]); - - /* Check for BSD-variant large filenames */ - if (0 == strncmp(file, "#1/", 3)) { - file[16] = '\0'; - for (n = 3; isdigit(file[n]); n++); - file[n] = '\0'; - fileNameSize = atoi(file + 3); - imageSize -= fileNameSize; - if (fileNameSize > fileSize) { - /* Double it to avoid potentially continually - increasing it by 1 */ - fileSize = fileNameSize * 2; - file = stgReallocBytes(file, fileSize, "loadArchive(file)"); - } - n = fread ( file, 1, fileNameSize, f ); - if (n != (int)fileNameSize) - barf("loadArchive: Failed reading filename from `%s'", path); - } - else { - fileNameSize = 16; - } + f = fopen(path, "rb"); + if (!f) + barf("loadObj: can't read `%s'", path); - isObject = 0; - for (n = 0; n < (int)fileNameSize - 1; n++) { - if ((file[n] == '.') && (file[n] == 'o')) { - isObject = 1; - break; - } - } + n = fread ( tmp, 1, 8, f ); + if (strncmp(tmp, "!\n", 8) != 0) + barf("loadArchive: Not an archive: `%s'", path); + + while(1) { + n = fread ( fileName, 1, 16, f ); + if (n != 16) { + if (feof(f)) { + break; + } + else { + barf("loadArchive: Failed reading file name from `%s'", path); + } + } + n = fread ( tmp, 1, 12, f ); + if (n != 12) + barf("loadArchive: Failed reading mod time from `%s'", path); + n = fread ( tmp, 1, 6, f ); + if (n != 6) + barf("loadArchive: Failed reading owner from `%s'", path); + n = fread ( tmp, 1, 6, f ); + if (n != 6) + barf("loadArchive: Failed reading group from `%s'", path); + n = fread ( tmp, 1, 8, f ); + if (n != 8) + barf("loadArchive: Failed reading mode from `%s'", path); + n = fread ( tmp, 1, 10, f ); + if (n != 10) + barf("loadArchive: Failed reading size from `%s'", path); + tmp[10] = '\0'; + for (n = 0; isdigit(tmp[n]); n++); + tmp[n] = '\0'; + memberSize = atoi(tmp); + n = fread ( tmp, 1, 2, f ); + if (strncmp(tmp, "\x60\x0A", 2) != 0) + barf("loadArchive: Failed reading magic from `%s' at %ld. Got %c%c", + path, ftell(f), tmp[0], tmp[1]); + + isGnuIndex = 0; + /* Check for BSD-variant large filenames */ + if (0 == strncmp(fileName, "#1/", 3)) { + fileName[16] = '\0'; + if (isdigit(fileName[3])) { + for (n = 4; isdigit(fileName[n]); n++); + fileName[n] = '\0'; + thisFileNameSize = atoi(fileName + 3); + memberSize -= thisFileNameSize; + if (thisFileNameSize >= fileNameSize) { + /* Double it to avoid potentially continually + increasing it by 1 */ + fileNameSize = thisFileNameSize * 2; + fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)"); + } + n = fread ( fileName, 1, thisFileNameSize, f ); + if (n != (int)thisFileNameSize) { + barf("loadArchive: Failed reading filename from `%s'", + path); + } + fileName[thisFileNameSize] = 0; + } + else { + barf("loadArchive: BSD-variant filename size not found while reading filename from `%s'", path); + } + } + /* Check for GNU file index file */ + else if (0 == strncmp(fileName, "//", 2)) { + fileName[0] = '\0'; + thisFileNameSize = 0; + isGnuIndex = 1; + } + /* Check for a file in the GNU file index */ + else if (fileName[0] == '/') { + if (isdigit(fileName[1])) { + int i; + + for (n = 2; isdigit(fileName[n]); n++); + fileName[n] = '\0'; + n = atoi(fileName + 1); - if (isObject) { - /* 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 - memory then we can be given memory above 2^32, so we - mmap some anonymous memory and use that. We could - do better here. */ - image = mmapForLinker(imageSize, MAP_ANONYMOUS, -1); - n = fread ( image, 1, imageSize, f ); - if (n != imageSize) - barf("loadObj: error whilst reading `%s'", path); - oc = mkOc(path, image, imageSize + if (gnuFileIndex == NULL) { + barf("loadArchive: GNU-variant filename without an index while reading from `%s'", path); + } + if (n < 0 || n > gnuFileIndexSize) { + barf("loadArchive: GNU-variant filename offset %d out of range [0..%d] while reading filename from `%s'", n, gnuFileIndexSize, path); + } + if (n != 0 && gnuFileIndex[n - 1] != '\n') { + barf("loadArchive: GNU-variant filename offset %d invalid (range [0..%d]) while reading filename from `%s'", n, gnuFileIndexSize, path); + } + for (i = n; gnuFileIndex[i] != '/'; i++); + thisFileNameSize = i - n; + if (thisFileNameSize >= fileNameSize) { + /* Double it to avoid potentially continually + increasing it by 1 */ + fileNameSize = thisFileNameSize * 2; + fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)"); + } + memcpy(fileName, gnuFileIndex + n, thisFileNameSize); + fileName[thisFileNameSize] = '\0'; + } + else if (fileName[1] == ' ') { + fileName[0] = '\0'; + thisFileNameSize = 0; + } + else { + barf("loadArchive: GNU-variant filename offset not found while reading filename from `%s'", path); + } + } + /* Finally, the case where the filename field actually contains + the filename */ + else { + /* GNU ar terminates filenames with a '/', this allowing + spaces in filenames. So first look to see if there is a + terminating '/'. */ + for (thisFileNameSize = 0; + thisFileNameSize < 16; + thisFileNameSize++) { + if (fileName[thisFileNameSize] == '/') { + fileName[thisFileNameSize] = '\0'; + break; + } + } + /* If we didn't find a '/', then a space teminates the + filename. Note that if we don't find one, then + thisFileNameSize ends up as 16, and we already have the + '\0' at the end. */ + if (thisFileNameSize == 16) { + for (thisFileNameSize = 0; + thisFileNameSize < 16; + thisFileNameSize++) { + if (fileName[thisFileNameSize] == ' ') { + fileName[thisFileNameSize] = '\0'; + break; + } + } + } + } + + IF_DEBUG(linker, + debugBelch("loadArchive: Found member file `%s'\n", fileName)); + + isObject = thisFileNameSize >= 2 + && fileName[thisFileNameSize - 2] == '.' + && fileName[thisFileNameSize - 1] == 'o'; + + if (isObject) { + char *archiveMemberName; + + IF_DEBUG(linker, debugBelch("loadArchive: Member is an object file...loading...\n")); + + /* 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. When possible we use mmap + to get some anonymous memory, as on 64-bit platforms if + we use malloc then we can be given memory above 2^32. + In the mmap case we're probably wasting lots of space; + we could do better. */ +#if defined(USE_MMAP) + image = mmapForLinker(memberSize, MAP_ANONYMOUS, -1); +#elif defined(darwin_HOST_OS) + /* See loadObj() */ + misalignment = machoGetMisalignment(f); + image = stgMallocBytes(memberSize + misalignment, "loadArchive(image)"); + image += misalignment; +#else + image = stgMallocBytes(memberSize, "loadArchive(image)"); +#endif + n = fread ( image, 1, memberSize, f ); + if (n != memberSize) { + barf("loadArchive: error whilst reading `%s'", path); + } + + archiveMemberName = stgMallocBytes(strlen(path) + thisFileNameSize + 3, + "loadArchive(file)"); + sprintf(archiveMemberName, "%s(%.*s)", + path, (int)thisFileNameSize, fileName); + + oc = mkOc(path, image, memberSize, archiveMemberName #ifndef USE_MMAP #ifdef darwin_HOST_OS - , 0 + , misalignment #endif #endif - ); - if (0 == loadOc(oc)) { - stgFree(file); - return 0; - } - } - else { - n = fseek(f, imageSize, SEEK_CUR); - if (n != 0) - barf("loadArchive: error whilst seeking by %d in `%s'", - imageSize, path); - } - /* .ar files are 2-byte aligned */ - if (imageSize % 2) { - n = fread ( tmp, 1, 1, f ); - if (n != 1) { - if (feof(f)) { - break; - } - else { - barf("loadArchive: Failed reading padding from `%s'", path); - } - } - } - } + ); - fclose(f); + stgFree(archiveMemberName); - stgFree(file); - return 1; -} + if (0 == loadOc(oc)) { + stgFree(fileName); + return 0; + } + } + else if (isGnuIndex) { + if (gnuFileIndex != NULL) { + barf("loadArchive: GNU-variant index found, but already have an index, while reading filename from `%s'", path); + } + IF_DEBUG(linker, debugBelch("loadArchive: Found GNU-variant file index\n")); +#ifdef USE_MMAP + gnuFileIndex = mmapForLinker(memberSize + 1, MAP_ANONYMOUS, -1); #else -HsInt GNU_ATTRIBUTE(__noreturn__) -loadArchive( char *path STG_UNUSED ) { - barf("loadArchive: not enabled"); -} + gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)"); #endif + n = fread ( gnuFileIndex, 1, memberSize, f ); + if (n != memberSize) { + barf("loadArchive: error whilst reading `%s'", path); + } + gnuFileIndex[memberSize] = '/'; + gnuFileIndexSize = memberSize; + } + else { + n = fseek(f, memberSize, SEEK_CUR); + if (n != 0) + barf("loadArchive: error whilst seeking by %d in `%s'", + memberSize, path); + } + /* .ar files are 2-byte aligned */ + if (memberSize % 2) { + n = fread ( tmp, 1, 1, f ); + if (n != 1) { + if (feof(f)) { + break; + } + else { + barf("loadArchive: Failed reading padding from `%s'", path); + } + } + } + } + + fclose(f); + + stgFree(fileName); + if (gnuFileIndex != NULL) { +#ifdef USE_MMAP + munmap(gnuFileIndex, gnuFileIndexSize + 1); +#else + stgFree(gnuFileIndex); +#endif + } + + return 1; +} /* ----------------------------------------------------------------------------- * Load an obj (populate the global symbol table, but don't resolve yet) @@ -1814,6 +1969,9 @@ loadObj( char *path ) int fd; #else FILE *f; +# if defined(darwin_HOST_OS) + int misalignment; +# endif #endif IF_DEBUG(linker, debugBelch("loadObj %s\n", path)); @@ -1903,7 +2061,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 +2076,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) { @@ -1964,6 +2124,7 @@ loadOc( ObjectCode* oc ) { /* loaded, but not resolved yet */ oc->status = OBJECT_LOADED; + IF_DEBUG(linker, debugBelch("loadObj done.\n")); return 1; } @@ -1979,6 +2140,7 @@ resolveObjs( void ) ObjectCode *oc; int r; + IF_DEBUG(linker, debugBelch("resolveObjs: start\n")); initLinker(); for (oc = objects; oc; oc = oc->next) { @@ -1996,6 +2158,7 @@ resolveObjs( void ) oc->status = OBJECT_RESOLVED; } } + IF_DEBUG(linker, debugBelch("resolveObjs: done\n")); return 1; } @@ -2006,6 +2169,7 @@ HsInt unloadObj( char *path ) { ObjectCode *oc, *prev; + HsBool unloadedAnyObj = HS_BOOL_FALSE; ASSERT(symhash != NULL); ASSERT(objects != NULL); @@ -2045,12 +2209,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; + } } /* ----------------------------------------------------------------------------- @@ -2062,7 +2234,7 @@ static void addProddableBlock ( ObjectCode* oc, void* start, int size ) { ProddableBlock* pb = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock"); - /* debugBelch("aPB %p %p %d\n", oc, start, size); */ + IF_DEBUG(linker, debugBelch("addProddableBlock %p %p %d\n", oc, start, size)); ASSERT(size > 0); pb->start = start; pb->size = size; @@ -2241,13 +2413,12 @@ static SymbolExtra* makeSymbolExtra( ObjectCode* oc, Because the PPC has split data/instruction caches, we have to do that whenever we modify code at runtime. */ - -static void ocFlushInstructionCache( ObjectCode *oc ) +static void ocFlushInstructionCacheFrom(void* begin, size_t length) { - int n = (oc->fileSize + sizeof( SymbolExtra ) * oc->n_symbol_extras + 3) / 4; - unsigned long *p = (unsigned long *) oc->image; + size_t n = (length + 3) / 4; + unsigned long* p = begin; - while( n-- ) + while (n--) { __asm__ volatile ( "dcbf 0,%0\n\t" "sync\n\t" @@ -2261,6 +2432,14 @@ static void ocFlushInstructionCache( ObjectCode *oc ) "isync" ); } +static void ocFlushInstructionCache( ObjectCode *oc ) +{ + /* The main object code */ + ocFlushInstructionCacheFrom(oc->image + oc->misalignment, oc->fileSize); + + /* Jump Islands */ + ocFlushInstructionCacheFrom(oc->symbol_extras, sizeof(SymbolExtra) * oc->n_symbol_extras); +} #endif /* -------------------------------------------------------------------------- @@ -4332,6 +4511,8 @@ static int resolveImports( unsigned i; size_t itemSize = 4; + IF_DEBUG(linker, debugBelch("resolveImports: start\n")); + #if i386_HOST_ARCH int isJumpTable = 0; if(!strcmp(sect->sectname,"__jump_table")) @@ -4349,12 +4530,16 @@ static int resolveImports( char *nm = image + symLC->stroff + symbol->n_un.n_strx; void *addr = NULL; - if((symbol->n_type & N_TYPE) == N_UNDF - && (symbol->n_type & N_EXT) && (symbol->n_value != 0)) + IF_DEBUG(linker, debugBelch("resolveImports: resolving %s\n", nm)); + if ((symbol->n_type & N_TYPE) == N_UNDF + && (symbol->n_type & N_EXT) && (symbol->n_value != 0)) { addr = (void*) (symbol->n_value); - else + IF_DEBUG(linker, debugBelch("resolveImports: undefined external %s has value %p\n", nm, addr)); + } else { addr = lookupSymbol(nm); - if(!addr) + IF_DEBUG(linker, debugBelch("resolveImports: looking up %s, %p\n", nm, addr)); + } + if (!addr) { errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm); return 0; @@ -4377,6 +4562,7 @@ static int resolveImports( } } + IF_DEBUG(linker, debugBelch("resolveImports: done\n")); return 1; } @@ -4387,9 +4573,11 @@ static unsigned long relocateAddress( unsigned long address) { int i; - for(i = 0; i < nSections; i++) + IF_DEBUG(linker, debugBelch("relocateAddress: start\n")); + for (i = 0; i < nSections; i++) { - if(sections[i].addr <= address + IF_DEBUG(linker, debugBelch(" relocating address in section %d\n", i)); + if (sections[i].addr <= address && address < sections[i].addr + sections[i].size) { return (unsigned long)oc->image @@ -4408,7 +4596,9 @@ static int relocateSection( int nSections, struct section* sections, struct section *sect) { struct relocation_info *relocs; - int i,n; + int i, n; + + IF_DEBUG(linker, debugBelch("relocateSection: start\n")); if(!strcmp(sect->sectname,"__la_symbol_ptr")) return 1; @@ -4420,6 +4610,8 @@ static int relocateSection( return 1; n = sect->nreloc; + IF_DEBUG(linker, debugBelch("relocateSection: number of relocations: %d\n", n)); + relocs = (struct relocation_info*) (image + sect->reloff); for(i=0;ir_length, thing, baseValue)); + + if (type == X86_64_RELOC_GOT || type == X86_64_RELOC_GOT_LOAD) { + struct nlist *symbol = &nlist[reloc->r_symbolnum]; + char *nm = image + symLC->stroff + symbol->n_un.n_strx; + + IF_DEBUG(linker, debugBelch("relocateSection: making jump island for %s, extern = %d, X86_64_RELOC_GOT\n", nm, reloc->r_extern)); ASSERT(reloc->r_extern); - value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)->addr; + value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, (unsigned long)lookupSymbol(nm))->addr; type = X86_64_RELOC_SIGNED; } @@ -4470,11 +4670,21 @@ static int relocateSection( { struct nlist *symbol = &nlist[reloc->r_symbolnum]; char *nm = image + symLC->stroff + symbol->n_un.n_strx; - if(symbol->n_value == 0) - value = (uint64_t) lookupSymbol(nm); - else + + IF_DEBUG(linker, debugBelch("relocateSection: looking up external symbol %s\n", nm)); + IF_DEBUG(linker, debugBelch(" : type = %d\n", symbol->n_type)); + IF_DEBUG(linker, debugBelch(" : sect = %d\n", symbol->n_sect)); + IF_DEBUG(linker, debugBelch(" : desc = %d\n", symbol->n_desc)); + IF_DEBUG(linker, debugBelch(" : value = %d\n", symbol->n_value)); + if ((symbol->n_type & N_TYPE) == N_SECT) { value = relocateAddress(oc, nSections, sections, symbol->n_value); + IF_DEBUG(linker, debugBelch("relocateSection, defined external symbol %s, relocated address %p\n", nm, value)); + } + else { + value = (uint64_t) lookupSymbol(nm); + IF_DEBUG(linker, debugBelch("relocateSection: external symbol %s, address %p\n", nm, value)); + } } else { @@ -4482,8 +4692,10 @@ static int relocateSection( - sections[reloc->r_symbolnum-1].addr + (uint64_t) image; } - - if(type == X86_64_RELOC_BRANCH) + + IF_DEBUG(linker, debugBelch("relocateSection: value = %p\n", value)); + + if (type == X86_64_RELOC_BRANCH) { if((int32_t)(value - baseValue) != (int64_t)(value - baseValue)) { @@ -4633,7 +4845,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 +4884,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 +4896,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 +4952,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 +5029,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,14 +5066,17 @@ 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; } } #endif } + IF_DEBUG(linker, debugBelch("relocateSection: done\n")); return 1; } @@ -4859,6 +5094,8 @@ static int ocGetNames_MachO(ObjectCode* oc) char *commonStorage = NULL; unsigned long commonCounter; + IF_DEBUG(linker,debugBelch("ocGetNames_MachO: start\n")); + for(i=0;incmds;i++) { if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64) @@ -4877,7 +5114,8 @@ static int ocGetNames_MachO(ObjectCode* oc) for(i=0;insects;i++) { - if(sections[i].size == 0) + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: segment %d\n", i)); + if (sections[i].size == 0) continue; if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL) @@ -4930,6 +5168,7 @@ static int ocGetNames_MachO(ObjectCode* oc) } } } + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: %d external symbols\n", oc->n_symbols)); oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*), "ocGetNames_MachO(oc->symbols)"); @@ -4944,10 +5183,13 @@ static int ocGetNames_MachO(ObjectCode* oc) if(nlist[i].n_type & N_EXT) { char *nm = image + symLC->stroff + nlist[i].n_un.n_strx; - if((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm)) - ; // weak definition, and we already have a definition + if ((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm)) { + // weak definition, and we already have a definition + IF_DEBUG(linker, debugBelch(" weak: %s\n", nm)); + } else { + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting %s\n", nm)); ghciInsertStrHashTable(oc->fileName, symhash, nm, image + sections[nlist[i].n_sect-1].offset @@ -4974,6 +5216,7 @@ static int ocGetNames_MachO(ObjectCode* oc) nlist[i].n_value = commonCounter; + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting common symbol: %s\n", nm)); ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter); oc->symbols[curSymbol++] = nm; @@ -4997,7 +5240,8 @@ static int ocResolve_MachO(ObjectCode* oc) struct dysymtab_command *dsymLC = NULL; struct nlist *nlist; - for(i=0;incmds;i++) + IF_DEBUG(linker, debugBelch("ocResolve_MachO: start\n")); + for (i = 0; i < header->ncmds; i++) { if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64) segLC = (struct segment_command*) lc; @@ -5017,7 +5261,8 @@ static int ocResolve_MachO(ObjectCode* oc) unsigned long *indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff); - for(i=0;insects;i++) + IF_DEBUG(linker, debugBelch("ocResolve_MachO: resolving dsymLC\n")); + for (i = 0; i < segLC->nsects; i++) { if( !strcmp(sections[i].sectname,"__la_symbol_ptr") || !strcmp(sections[i].sectname,"__la_sym_ptr2") @@ -5037,12 +5282,18 @@ static int ocResolve_MachO(ObjectCode* oc) if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist)) return 0; } + else + { + IF_DEBUG(linker, debugBelch("ocResolve_MachO: unknown section\n")); + } } } for(i=0;insects;i++) { - if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i])) + IF_DEBUG(linker, debugBelch("ocResolve_MachO: relocating section %d\n", i)); + + if (!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i])) return 0; } @@ -5097,21 +5348,24 @@ static int machoGetMisalignment( FILE * f ) { struct mach_header header; int misalignment; - - fread(&header, sizeof(header), 1, f); - rewind(f); + + { + int n = fread(&header, sizeof(header), 1, f); + if (n != 1) { + barf("machoGetMisalignment: can't read the Mach-O header"); + } + } + fseek(f, -sizeof(header), SEEK_CUR); #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; + barf("Bad magic. Expected: %08x, got: %08x.", + MH_MAGIC_64, header.magic); } #else if(header.magic != MH_MAGIC) { - errorBelch("Bad magic. Expected: %08x, got: %08x.\n", - MH_MAGIC, header->magic); - return 0; + barf("Bad magic. Expected: %08x, got: %08x.", + MH_MAGIC, header.magic); } #endif