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
#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
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;
}
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
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;
fclose(f);
#endif /* USE_MMAP */
- oc = mkOc(path, image, fileSize
+ oc = mkOc(path, image, fileSize, NULL
#ifndef USE_MMAP
#ifdef darwin_HOST_OS
, misalignment
unloadObj( char *path )
{
ObjectCode *oc, *prev;
+ HsBool unloadedAnyObj = HS_BOOL_FALSE;
ASSERT(symhash != NULL);
ASSERT(objects != NULL);
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;
+ }
}
/* -----------------------------------------------------------------------------
"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;
}
"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;
}
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;
}
{
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;
}
}
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;
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;
}