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
#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
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) \
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))
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();
addDLL("msvcrt");
addDLL("kernel32");
#endif
+
+ IF_DEBUG(linker, debugBelch("initLinker: done\n"));
+ return;
}
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)
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
return NULL;
# endif
} else {
+ IF_DEBUG(linker, debugBelch("lookupSymbol: value of %s is %p\n", lbl, val));
return val;
}
}
#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;
int imageSize;
FILE *f;
int n;
- char tmp[16];
+ size_t fileNameSize;
+ char *file;
+ size_t fileSize;
int isObject;
+ char tmp[12];
+
+ IF_DEBUG(linker, debugBelch("loadArchive `%s'\n", path));
+
+ fileSize = 32;
+ file = stgMallocBytes(fileSize, "loadArchive(file)");
f = fopen(path, "rb");
if (!f)
barf("loadArchive: Not an archive: `%s'", path);
while(1) {
- n = fread ( tmp, 1, 16, f );
+ n = fread ( file, 1, 16, f );
if (n != 16) {
if (feof(f)) {
break;
barf("loadArchive: Failed reading file name from `%s'", path);
}
}
- /* Ignore special files */
- if ((0 == strncmp(tmp, "/ ", 16)) ||
- (0 == strncmp(tmp, "// ", 16))) {
- isObject = 0;
- }
- else {
- isObject = 1;
- }
n = fread ( tmp, 1, 12, f );
if (n != 12)
barf("loadArchive: Failed reading mod time from `%s'", path);
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 = 0;
+ for (n = 0; n < (int)fileNameSize - 1; n++) {
+ 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
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;
}
}
else {
n = fseek(f, imageSize, SEEK_CUR);
if (n != 0)
- barf("loadArchive: error whilst seeking to %d in `%s'",
+ barf("loadArchive: error whilst seeking by %d in `%s'",
imageSize, path);
}
/* .ar files are 2-byte aligned */
fclose(f);
+ stgFree(file);
return 1;
}
#else
fclose(f);
#endif /* USE_MMAP */
- oc = mkOc(path, image, fileSize
+ oc = mkOc(path, image, fileSize, NULL
#ifndef USE_MMAP
#ifdef darwin_HOST_OS
, misalignment
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) {
/* loaded, but not resolved yet */
oc->status = OBJECT_LOADED;
+ IF_DEBUG(linker, debugBelch("loadObj done.\n"));
return 1;
}
ObjectCode *oc;
int r;
+ IF_DEBUG(linker, debugBelch("resolveObjs: start\n"));
initLinker();
for (oc = objects; oc; oc = oc->next) {
oc->status = OBJECT_RESOLVED;
}
}
+ IF_DEBUG(linker, debugBelch("resolveObjs: done\n"));
return 1;
}
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;
+ }
}
/* -----------------------------------------------------------------------------
{
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;
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"))
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;
}
}
+ IF_DEBUG(linker, debugBelch("resolveImports: done\n"));
return 1;
}
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
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;
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;i<n;i++)
default:
barf("Unknown size.");
}
-
- if(type == X86_64_RELOC_GOT
+
+ IF_DEBUG(linker,
+ debugBelch("relocateSection: length = %d, thing = %d, baseValue = %p\n",
+ reloc->r_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;
}
{
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
{
- 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))
{
"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;
}
}
#endif
}
+ IF_DEBUG(linker, debugBelch("relocateSection: done\n"));
return 1;
}
char *commonStorage = NULL;
unsigned long commonCounter;
+ IF_DEBUG(linker,debugBelch("ocGetNames_MachO: start\n"));
+
for(i=0;i<header->ncmds;i++)
{
if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
for(i=0;i<segLC->nsects;i++)
{
- if(sections[i].size == 0)
+ IF_DEBUG(linker, debugBelch("ocGetNames_MachO: segment %d\n"));
+ if (sections[i].size == 0)
continue;
if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
}
}
}
+ 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)");
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
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;
struct dysymtab_command *dsymLC = NULL;
struct nlist *nlist;
- for(i=0;i<header->ncmds;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;
unsigned long *indirectSyms
= (unsigned long*) (image + dsymLC->indirectsymoff);
- for(i=0;i<segLC->nsects;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")
if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
return 0;
}
+ else
+ {
+ IF_DEBUG(linker, debugBelch("ocResolve_MachO: unknown section\n"));
+ }
}
}
for(i=0;i<segLC->nsects;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;
}
projects / ghc-hetmet.git / blobdiff