#include <sys/wait.h>
#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 <fcntl.h>
#include <sys/mman.h>
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
- IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%s'\n", path));
+ IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%s'\n", path));
- fileSize = 32;
- file = stgMallocBytes(fileSize, "loadArchive(file)");
+ gnuFileIndex = NULL;
+ gnuFileIndexSize = 0;
- f = fopen(path, "rb");
- if (!f)
- barf("loadObj: can't read `%s'", path);
+ fileNameSize = 32;
+ fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)");
- n = fread ( tmp, 1, 8, f );
- if (strncmp(tmp, "!<arch>\n", 8) != 0)
- barf("loadArchive: Not an archive: `%s'", path);
+ f = fopen(path, "rb");
+ if (!f)
+ barf("loadObj: can't read `%s'", path);
- 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;
- }
+ n = fread ( tmp, 1, 8, f );
+ if (strncmp(tmp, "!<arch>\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;
- IF_DEBUG(linker, debugBelch("loadArchive: Found member file `%s'\n", file));
+ for (n = 2; isdigit(fileName[n]); n++);
+ fileName[n] = '\0';
+ n = atoi(fileName + 1);
- isObject = 0;
- for (n = 0; n < (int)fileNameSize - 1; n++) {
- if ((file[n] == '.') && (file[n + 1] == 'o')) {
- isObject = 1;
- break;
- }
- }
+ 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 (isObject) {
- char *archiveMemberName;
+ IF_DEBUG(linker,
+ debugBelch("loadArchive: Found member file `%s'\n", fileName));
- IF_DEBUG(linker, debugBelch("loadArchive: Member is an object file...loading...\n"));
+ isObject = thisFileNameSize >= 2
+ && fileName[thisFileNameSize - 2] == '.'
+ && fileName[thisFileNameSize - 1] == 'o';
- /* 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(imageSize, MAP_ANONYMOUS, -1);
+ 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(imageSize, "loadArchive(image)");
+ image = stgMallocBytes(memberSize, "loadArchive(image)");
#endif
- n = fread ( image, 1, imageSize, f );
- if (n != imageSize)
- barf("loadObj: error whilst reading `%s'", path);
+ 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
+ , misalignment
#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
+ stgFree(gnuFileIndex);
+#endif
+ }
+
+ return 1;
}
/* -----------------------------------------------------------------------------
int fd;
#else
FILE *f;
+# if defined(darwin_HOST_OS)
+ int misalignment;
+# endif
#endif
IF_DEBUG(linker, debugBelch("loadObj %s\n", path));
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"
"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
/* --------------------------------------------------------------------------
{
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
projects / ghc-hetmet.git / blobdiff