/* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.115 2003/02/21 05:34:15 sof Exp $
+ * $Id: Linker.c,v 1.136 2003/10/08 09:42:34 wolfgang Exp $
*
- * (c) The GHC Team, 2000, 2001
+ * (c) The GHC Team, 2000-2003
*
* RTS Object Linker
*
#include <sys/mman.h>
#endif
-#if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS)
+#if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS) || defined(netbsd_TARGET_OS) || defined(openbsd_TARGET_OS)
# define OBJFORMAT_ELF
#elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
# define OBJFORMAT_PEi386
# include <mach-o/loader.h>
# include <mach-o/nlist.h>
# include <mach-o/reloc.h>
+# include <mach-o/dyld.h>
#endif
/* Hash table mapping symbol names to Symbol */
static int ocGetNames_PEi386 ( ObjectCode* oc );
static int ocResolve_PEi386 ( ObjectCode* oc );
#elif defined(OBJFORMAT_MACHO)
+static int ocAllocateJumpIslands_MachO ( ObjectCode* oc );
static int ocVerifyImage_MachO ( ObjectCode* oc );
static int ocGetNames_MachO ( ObjectCode* oc );
static int ocResolve_MachO ( ObjectCode* oc );
-static void machoInitSymbolsWithoutUnderscore();
+static void machoInitSymbolsWithoutUnderscore( void );
#endif
/* -----------------------------------------------------------------------------
SymX(uname) \
SymX(unlink) \
SymX(utime) \
- SymX(waitpid) \
- Sym(__divdi3) \
- Sym(__udivdi3) \
- Sym(__moddi3) \
- Sym(__umoddi3)
+ SymX(waitpid)
#elif !defined(mingw32_TARGET_OS)
#define RTS_MINGW_ONLY_SYMBOLS /**/
#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 \
+ Sym(_imp____mb_cur_max) \
+ Sym(_imp___pctype)
+#else
+#define RTS_MINGW_EXTRA_SYMS
+#endif
+
/* These are statically linked from the mingw libraries into the ghc
executable, so we have to employ this hack. */
#define RTS_MINGW_ONLY_SYMBOLS \
Sym(opendir) \
Sym(readdir) \
Sym(rewinddir) \
- Sym(closedir) \
- Sym(__divdi3) \
- Sym(__udivdi3) \
- Sym(__moddi3) \
- Sym(__umoddi3)
+ RTS_MINGW_EXTRA_SYMS \
+ Sym(closedir)
#endif
#ifndef SMP
SymX(divExactIntegerzh_fast) \
SymX(divModIntegerzh_fast) \
SymX(forkzh_fast) \
- SymX(forkProcesszh_fast) \
+ SymX(forkProcess) \
+ SymX(forkOS_createThread) \
SymX(freeHaskellFunctionPtr) \
SymX(freeStablePtr) \
SymX(gcdIntegerzh_fast) \
SymX(gcdIntegerIntzh_fast) \
SymX(gcdIntzh_fast) \
+ SymX(genSymZh) \
SymX(getProgArgv) \
SymX(getStablePtr) \
SymX(int2Integerzh_fast) \
SymX(integer2Intzh_fast) \
SymX(integer2Wordzh_fast) \
+ SymX(isCurrentThreadBoundzh_fast) \
SymX(isDoubleDenormalized) \
SymX(isDoubleInfinite) \
SymX(isDoubleNaN) \
SymX(quotIntegerzh_fast) \
SymX(quotRemIntegerzh_fast) \
SymX(raisezh_fast) \
+ SymX(raiseIOzh_fast) \
SymX(remIntegerzh_fast) \
SymX(resetNonBlockingFd) \
SymX(resumeThread) \
SymX(rts_eval) \
SymX(rts_evalIO) \
SymX(rts_evalLazyIO) \
+ SymX(rts_evalStableIO) \
SymX(rts_eval_) \
SymX(rts_getBool) \
SymX(rts_getChar) \
SymX(rts_mkWord64) \
SymX(rts_mkWord8) \
SymX(rts_unlock) \
+ SymX(rtsSupportsBoundThreads) \
SymX(run_queue_hd) \
+ SymX(__hscore_get_saved_termios) \
+ SymX(__hscore_set_saved_termios) \
SymX(setProgArgv) \
SymX(startupHaskell) \
SymX(shutdownHaskell) \
SymX(stable_ptr_table) \
SymX(stackOverflow) \
SymX(stg_CAF_BLACKHOLE_info) \
+ SymX(stg_BLACKHOLE_BQ_info) \
+ SymX(awakenBlockedQueue) \
SymX(stg_CHARLIKE_closure) \
SymX(stg_EMPTY_MVAR_info) \
SymX(stg_IND_STATIC_info) \
#define RTS_LONG_LONG_SYMS /* nothing */
#endif
-#ifdef ia64_TARGET_ARCH
-/* force these symbols to be present */
-#define RTS_EXTRA_SYMBOLS \
- Sym(__divsf3)
-#elif defined(powerpc_TARGET_ARCH)
-#define RTS_EXTRA_SYMBOLS \
+// 64-bit support functions in libgcc.a
+#if defined(__GNUC__) && SIZEOF_VOID_P <= 4
+#define RTS_LIBGCC_SYMBOLS \
Sym(__divdi3) \
Sym(__udivdi3) \
Sym(__moddi3) \
Sym(__ashrdi3) \
Sym(__lshrdi3) \
Sym(__eprintf)
-
+#elif defined(ia64_TARGET_ARCH)
+#define RTS_LIBGCC_SYMBOLS \
+ Sym(__divdi3) \
+ Sym(__udivdi3) \
+ Sym(__moddi3) \
+ Sym(__umoddi3) \
+ Sym(__divsf3) \
+ Sym(__divdf3)
+#else
+#define RTS_LIBGCC_SYMBOLS
+#endif
+
+#ifdef darwin_TARGET_OS
// Symbols that don't have a leading underscore
// on Mac OS X. They have to receive special treatment,
// see machoInitSymbolsWithoutUnderscore()
#define RTS_MACHO_NOUNDERLINE_SYMBOLS \
Sym(saveFP) \
Sym(restFP)
-#else
-#define RTS_EXTRA_SYMBOLS /* nothing */
#endif
/* entirely bogus claims about types of these symbols */
-#define Sym(vvv) extern void (vvv);
+#define Sym(vvv) extern void vvv(void);
#define SymX(vvv) /**/
#define SymX_redirect(vvv,xxx) /**/
RTS_SYMBOLS
RTS_LONG_LONG_SYMS
-RTS_EXTRA_SYMBOLS
RTS_POSIX_ONLY_SYMBOLS
RTS_MINGW_ONLY_SYMBOLS
RTS_CYGWIN_ONLY_SYMBOLS
+RTS_LIBGCC_SYMBOLS
#undef Sym
#undef SymX
#undef SymX_redirect
static RtsSymbolVal rtsSyms[] = {
RTS_SYMBOLS
RTS_LONG_LONG_SYMS
- RTS_EXTRA_SYMBOLS
RTS_POSIX_ONLY_SYMBOLS
RTS_MINGW_ONLY_SYMBOLS
RTS_CYGWIN_ONLY_SYMBOLS
+ RTS_LIBGCC_SYMBOLS
{ 0, 0 } /* sentinel */
};
initLinker();
+#if !defined(openbsd_TARGET_OS)
hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
+#else
+ hdl= dlopen(dll_name, RTLD_LAZY);
+#endif
if (hdl == NULL) {
/* dlopen failed; return a ptr to the error msg. */
errmsg = dlerror();
sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
instance = LoadLibrary(buf);
if (instance == NULL) {
- free(buf);
+ stgFree(buf);
/* LoadLibrary failed; return a ptr to the error msg. */
return "addDLL: unknown error";
}
}
- free(buf);
+ stgFree(buf);
/* Add this DLL to the list of DLLs in which to search for symbols. */
o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
val = lookupStrHashTable(symhash, lbl);
if (val == NULL) {
-# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
+# if defined(OBJFORMAT_ELF)
return dlsym(dl_prog_handle, lbl);
+# elif defined(OBJFORMAT_MACHO)
+ if(NSIsSymbolNameDefined(lbl)) {
+ NSSymbol symbol = NSLookupAndBindSymbol(lbl);
+ return NSAddressOfSymbol(symbol);
+ } else {
+ return NULL;
+ }
# elif defined(OBJFORMAT_PEi386)
OpenedDLL* o_dll;
void* sym;
# elif defined(OBJFORMAT_MACHO)
oc->formatName = "Mach-O";
# else
- free(oc);
+ stgFree(oc);
barf("loadObj: not implemented on this platform");
# endif
#endif /* USE_MMAP */
+# if defined(OBJFORMAT_MACHO)
+ r = ocAllocateJumpIslands_MachO ( oc );
+ if (!r) { return r; }
+#endif
+
/* verify the in-memory image */
# if defined(OBJFORMAT_ELF)
r = ocVerifyImage_ELF ( oc );
/* We're going to leave this in place, in case there are
any pointers from the heap into it: */
- /* free(oc->image); */
- free(oc->fileName);
- free(oc->symbols);
- free(oc->sections);
+ /* stgFree(oc->image); */
+ stgFree(oc->fileName);
+ stgFree(oc->symbols);
+ stgFree(oc->sections);
/* The local hash table should have been freed at the end
of the ocResolve_ call on it. */
ASSERT(oc->lochash == NULL);
- free(oc);
+ stgFree(oc);
return 1;
}
}
# define ELF_TARGET_SPARC /* Used inside <elf.h> */
#elif defined(i386_TARGET_ARCH)
# define ELF_TARGET_386 /* Used inside <elf.h> */
+#elif defined(x86_64_TARGET_ARCH)
+# define ELF_TARGET_X64_64
+# define ELF_64BIT
#elif defined (ia64_TARGET_ARCH)
# define ELF_TARGET_IA64 /* Used inside <elf.h> */
# define ELF_64BIT
# define ELF_NEED_PLT /* needs Procedure Linkage Tables */
#endif
+#if !defined(openbsd_TARGET_OS)
#include <elf.h>
+#else
+/* openbsd elf has things in different places, with diff names */
+#include <elf_abi.h>
+#include <machine/reloc.h>
+#define R_386_32 RELOC_32
+#define R_386_PC32 RELOC_PC32
+#endif
/*
* Define a set of types which can be used for both ELF32 and ELF64
#define Elf_Sym Elf32_Sym
#define Elf_Rel Elf32_Rel
#define Elf_Rela Elf32_Rela
+#ifndef ELF_ST_TYPE
#define ELF_ST_TYPE ELF32_ST_TYPE
+#endif
+#ifndef ELF_ST_BIND
#define ELF_ST_BIND ELF32_ST_BIND
+#endif
+#ifndef ELF_R_TYPE
#define ELF_R_TYPE ELF32_R_TYPE
+#endif
+#ifndef ELF_R_SYM
#define ELF_R_SYM ELF32_R_SYM
#endif
+#endif
/*
#ifdef ELF_FUNCTION_DESC
/* If a function, already a function descriptor - we would
have to copy it to add an offset. */
- if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC)
- assert(A == 0);
+ if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
+ belch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
#endif
}
if (!S) {
case R_IA64_FPTR64LSB:
*pP = value;
break;
+ case R_IA64_PCREL64LSB:
+ *pP = value - P;
+ break;
case R_IA64_SEGREL64LSB:
addr = findElfSegment(ehdrC, value);
*pP = value - addr;
ia64_reloc_gprel22(P, value);
break;
case R_IA64_LTOFF22:
+ case R_IA64_LTOFF22X:
case R_IA64_LTOFF_FPTR22:
addr = allocateGOTEntry(value);
ia64_reloc_gprel22(P, addr);
case R_IA64_PCREL21B:
ia64_reloc_pcrel21(P, S, oc);
break;
+ case R_IA64_LDXMOV:
+ /* This goes with R_IA64_LTOFF22X and points to the load to
+ * convert into a move. We don't implement relaxation. */
+ break;
# endif
default:
belch("%s: unhandled ELF relocation(RelA) type %d\n",
I hereby formally apologize for the hackish nature of this code.
Things that need to be done:
- *) get common symbols and .bss sections to work properly.
- Haskell modules seem to work, but C modules can cause problems
+ *) handle uninitialized data sections ("__common").
+ Normal common definitions work, but beware if you pass -fno-common to gcc.
*) implement ocVerifyImage_MachO
- *) add more sanity checks. The current code just has to segfault if there's a
- broken .o file.
+ *) add still more sanity checks.
+*/
+
+
+/*
+ ocAllocateJumpIslands_MachO
+
+ Allocate additional space at the end of the object file image to make room
+ for jump islands.
+
+ PowerPC relative branch instructions have a 24 bit displacement field.
+ As PPC code is always 4-byte-aligned, this yields a +-32MB range.
+ If a particular imported symbol is outside this range, we have to redirect
+ the jump to a short piece of new code that just loads the 32bit absolute
+ address and jumps there.
+ This function just allocates space for one 16 byte jump island for every
+ undefined symbol in the object file. The code for the islands is filled in by
+ makeJumpIsland below.
*/
+static const int islandSize = 16;
+
+static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
+{
+ char *image = (char*) oc->image;
+ struct mach_header *header = (struct mach_header*) image;
+ struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
+ unsigned i;
+
+ for(i=0;i<header->ncmds;i++)
+ {
+ if(lc->cmd == LC_DYSYMTAB)
+ {
+ struct dysymtab_command *dsymLC = (struct dysymtab_command*) lc;
+ unsigned long nundefsym = dsymLC->nundefsym;
+ oc->island_start_symbol = dsymLC->iundefsym;
+ oc->n_islands = nundefsym;
+
+ if(nundefsym > 0)
+ {
+#ifdef USE_MMAP
+ #error ocAllocateJumpIslands_MachO doesn't want USE_MMAP to be defined
+#else
+ oc->image = stgReallocBytes(
+ image, oc->fileSize + islandSize * nundefsym,
+ "ocAllocateJumpIslands_MachO");
+#endif
+ oc->jump_islands = oc->image + oc->fileSize;
+ memset(oc->jump_islands, 0, islandSize * nundefsym);
+ }
+
+ break; // there can be only one LC_DSYMTAB
+ }
+ lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
+ }
+ return 1;
+}
+
static int ocVerifyImage_MachO(ObjectCode* oc)
{
// FIXME: do some verifying here
return 0;
}
ASSERT(addr);
+ checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
((void**)(image + sect->offset))[i] = addr;
}
return 1;
}
-static int relocateSection(char *image,
+static void* makeJumpIsland(
+ ObjectCode* oc,
+ unsigned long symbolNumber,
+ void* target)
+{
+ if(symbolNumber < oc->island_start_symbol ||
+ symbolNumber - oc->island_start_symbol > oc->n_islands)
+ return NULL;
+ symbolNumber -= oc->island_start_symbol;
+
+ void *island = (void*) ((char*)oc->jump_islands + islandSize * symbolNumber);
+ unsigned long *p = (unsigned long*) island;
+
+ // lis r12, hi16(target)
+ *p++ = 0x3d800000 | ( ((unsigned long) target) >> 16 );
+ // ori r12, r12, lo16(target)
+ *p++ = 0x618c0000 | ( ((unsigned long) target) & 0xFFFF );
+ // mtctr r12
+ *p++ = 0x7d8903a6;
+ // bctr
+ *p++ = 0x4e800420;
+
+ return (void*) island;
+}
+
+static int relocateSection(
+ ObjectCode* oc,
+ char *image,
struct symtab_command *symLC, struct nlist *nlist,
struct section* sections, struct section *sect)
{
{
unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
+ checkProddableBlock(oc,word);
*word = scat->r_value + sect->offset + ((long) image);
}
}
if(reloc->r_length == 2)
{
unsigned long word = 0;
-
+ unsigned long jumpIsland = 0;
+ long offsetToJumpIsland;
+
unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
+ checkProddableBlock(oc,wordPtr);
if(reloc->r_type == GENERIC_RELOC_VANILLA)
{
}
if(reloc->r_pcrel)
+ {
+ jumpIsland = (long) makeJumpIsland(oc,reloc->r_symbolnum,(void*)word);
word -= ((long)image) + sect->offset + reloc->r_address;
+ if(jumpIsland != 0)
+ {
+ offsetToJumpIsland = jumpIsland
+ - (((long)image) + sect->offset + reloc->r_address);
+ }
+ }
}
if(reloc->r_type == GENERIC_RELOC_VANILLA)
}
else if(reloc->r_type == PPC_RELOC_BR24)
{
+ if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
+ {
+ // 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");
+
+ word = offsetToJumpIsland;
+ if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
+ barf("unconditional relative branch out of range: "
+ "jump island out of range");
+ }
*wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
continue;
}
addSection(oc, SECTIONKIND_RWDATA,
(void*) (image + sections[i].offset),
(void*) (image + sections[i].offset + sections[i].size));
+
+ if(sections[i].size > 0) // size 0 segments do exist
+ addProddableBlock(oc, (void*) (image + sections[i].offset),
+ sections[i].size);
}
// count external symbols defined here
for(i=0;i<segLC->nsects;i++)
{
- if(!relocateSection(image,symLC,nlist,sections,§ions[i]))
+ if(!relocateSection(oc,image,symLC,nlist,sections,§ions[i]))
return 0;
}
projects / ghc-hetmet.git / blobdiff