X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FLinker.c;h=a0e578e4de73a1d2b22287c52a1b5a05bb7c3f7f;hb=f9597b672c50fec048cfd0eebbf172ae21217fef;hp=d9c1db52c842fc2ae0e74398f57449655028860c;hpb=988a0bbe45b97f7dce825af25890f80765a980f8;p=ghc-hetmet.git diff --git a/rts/Linker.c b/rts/Linker.c index d9c1db5..a0e578e 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -1670,159 +1670,270 @@ 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]; - - IF_DEBUG(linker, debugBelch("loadArchive `%s'\n", path)); + 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_DEBUG(linker, debugBelch("loadArchive: Loading archive `%s'\n", path)); + + gnuFileIndex = NULL; + gnuFileIndexSize = 0; + + fileNameSize = 32; + fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)"); + + f = fopen(path, "rb"); + if (!f) + barf("loadObj: can't read `%s'", path); + + 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; - fileSize = 32; - file = stgMallocBytes(fileSize, "loadArchive(file)"); + for (n = 2; isdigit(fileName[n]); n++); + fileName[n] = '\0'; + n = atoi(fileName + 1); - f = fopen(path, "rb"); - if (!f) - barf("loadObj: can't read `%s'", path); + 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; + } + } + } + } - n = fread ( tmp, 1, 8, f ); - if (strncmp(tmp, "!\n", 8) != 0) - barf("loadArchive: Not an archive: `%s'", path); + IF_DEBUG(linker, + debugBelch("loadArchive: Found member file `%s'\n", 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; - } + isObject = thisFileNameSize >= 2 + && fileName[thisFileNameSize - 2] == '.' + && fileName[thisFileNameSize - 1] == 'o'; - isObject = 0; - for (n = 0; n < (int)fileNameSize - 1; n++) { - if ((file[n] == '.') && (file[n + 1] == 'o')) { - isObject = 1; - break; - } - } + if (isObject) { + char *archiveMemberName; - 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, 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); + /* 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. */ +#ifdef USE_MMAP + image = mmapForLinker(memberSize, MAP_ANONYMOUS, -1); +#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) + fileNameSize + 3, "loadArchive(file)"); - sprintf(archiveMemberName, "%s(%.*s)", path, (int)fileNameSize, file); + archiveMemberName = stgMallocBytes(strlen(path) + thisFileNameSize + 3, + "loadArchive(file)"); + sprintf(archiveMemberName, "%s(%.*s)", + path, (int)thisFileNameSize, fileName); - oc = mkOc(path, image, imageSize, archiveMemberName + oc = mkOc(path, image, memberSize, archiveMemberName #ifndef USE_MMAP #ifdef darwin_HOST_OS - , 0 + , 0 #endif #endif - ); + ); - stgFree(archiveMemberName); + stgFree(archiveMemberName); - 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); - } - } - } - } + 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 + 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); + fclose(f); - stgFree(file); - return 1; -} + stgFree(fileName); + if (gnuFileIndex != NULL) { +#ifdef USE_MMAP + munmap(gnuFileIndex, gnuFileIndexSize + 1); #else -HsInt GNU_ATTRIBUTE(__noreturn__) -loadArchive( char *path STG_UNUSED ) { - barf("loadArchive: not enabled"); -} + stgFree(gnuFileIndex); #endif + } + + return 1; +} /* ----------------------------------------------------------------------------- * Load an obj (populate the global symbol table, but don't resolve yet) @@ -2282,13 +2393,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" @@ -2302,6 +2412,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 /* -------------------------------------------------------------------------- @@ -4976,7 +5094,7 @@ static int ocGetNames_MachO(ObjectCode* oc) for(i=0;insects;i++) { -// IF_DEBUG(linker, debugBelch("ocGetNames_MachO: segment %d\n")); + IF_DEBUG(linker, debugBelch("ocGetNames_MachO: segment %d\n", i)); if (sections[i].size == 0) continue; @@ -5210,21 +5328,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