/* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.104 2002/10/02 09:36:00 wolfgang Exp $
*
- * (c) The GHC Team, 2000, 2001
+ * (c) The GHC Team, 2000-2003
*
* RTS Object Linker
*
#include <sys/stat.h>
#endif
-#ifdef HAVE_DLFCN_H
+#if defined(HAVE_FRAMEWORK_HASKELLSUPPORT)
+#include <HaskellSupport/dlfcn.h>
+#elif defined(HAVE_DLFCN_H)
#include <dlfcn.h>
#endif
#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 /*Str*/HashTable *symhash;
+/* List of currently loaded objects */
+ObjectCode *objects = NULL; /* initially empty */
+
#if defined(OBJFORMAT_ELF)
static int ocVerifyImage_ELF ( ObjectCode* oc );
static int ocGetNames_ELF ( ObjectCode* oc );
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( 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 \
+ SymX(asyncReadzh_fast) \
+ SymX(asyncWritezh_fast) \
+ SymX(asyncDoProczh_fast) \
SymX(memset) \
SymX(inet_ntoa) \
SymX(inet_addr) \
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
Maybe_ForeignObj \
Maybe_Stable_Names \
Sym(StgReturn) \
- Sym(init_stack) \
- SymX(__stg_chk_0) \
- SymX(__stg_chk_1) \
- SymX(stg_chk_2) \
- SymX(stg_chk_3) \
- SymX(stg_chk_4) \
- SymX(stg_chk_5) \
- SymX(stg_chk_6) \
- SymX(stg_chk_7) \
- SymX(stg_chk_8) \
- Sym(stg_enterStackTop) \
- SymX(stg_gc_d1) \
- SymX(stg_gc_l1) \
+ SymX(stg_enter_info) \
+ SymX(stg_enter_ret) \
+ SymX(stg_gc_void_info) \
SymX(__stg_gc_enter_1) \
- SymX(stg_gc_enter_2) \
- SymX(stg_gc_enter_3) \
- SymX(stg_gc_enter_4) \
- SymX(stg_gc_enter_5) \
- SymX(stg_gc_enter_6) \
- SymX(stg_gc_enter_7) \
- SymX(stg_gc_enter_8) \
- SymX(stg_gc_f1) \
SymX(stg_gc_noregs) \
- SymX(stg_gc_seq_1) \
- SymX(stg_gc_unbx_r1) \
+ SymX(stg_gc_unpt_r1_info) \
SymX(stg_gc_unpt_r1) \
- SymX(stg_gc_ut_0_1) \
- SymX(stg_gc_ut_1_0) \
- SymX(stg_gen_chk) \
+ SymX(stg_gc_unbx_r1_info) \
+ SymX(stg_gc_unbx_r1) \
+ SymX(stg_gc_f1_info) \
+ SymX(stg_gc_f1) \
+ SymX(stg_gc_d1_info) \
+ SymX(stg_gc_d1) \
+ SymX(stg_gc_l1_info) \
+ SymX(stg_gc_l1) \
+ SymX(__stg_gc_fun) \
+ SymX(stg_gc_fun_info) \
+ SymX(stg_gc_fun_ret) \
+ SymX(stg_gc_gen) \
+ SymX(stg_gc_gen_info) \
+ SymX(stg_gc_gen_hp) \
+ SymX(stg_gc_ut) \
+ SymX(stg_gen_yield) \
+ SymX(stg_yield_noregs) \
SymX(stg_yield_to_interpreter) \
+ SymX(stg_gen_block) \
+ SymX(stg_block_noregs) \
+ SymX(stg_block_1) \
+ SymX(stg_block_takemvar) \
+ SymX(stg_block_putmvar) \
+ SymX(stg_seq_frame_info) \
SymX(ErrorHdrHook) \
MAIN_CAP_SYM \
SymX(MallocFailHook) \
- SymX(NoRunnableThreadsHook) \
SymX(OnExitHook) \
SymX(OutOfHeapHook) \
SymX(PatErrorHdrHook) \
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(newArrayzh_fast) \
SymX(newBCOzh_fast) \
SymX(newByteArrayzh_fast) \
- SymX(newCAF) \
+ SymX_redirect(newCAF, newDynCAF) \
SymX(newMVarzh_fast) \
SymX(newMutVarzh_fast) \
+ SymX(atomicModifyMutVarzh_fast) \
SymX(newPinnedByteArrayzh_fast) \
SymX(orIntegerzh_fast) \
SymX(performGC) \
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_getInt) \
SymX(rts_getInt32) \
SymX(rts_getPtr) \
+ SymX(rts_getFunPtr) \
SymX(rts_getStablePtr) \
SymX(rts_getThreadId) \
SymX(rts_getWord) \
SymX(rts_getWord32) \
+ SymX(rts_lock) \
SymX(rts_mkBool) \
SymX(rts_mkChar) \
SymX(rts_mkDouble) \
SymX(rts_mkInt64) \
SymX(rts_mkInt8) \
SymX(rts_mkPtr) \
+ SymX(rts_mkFunPtr) \
SymX(rts_mkStablePtr) \
SymX(rts_mkString) \
SymX(rts_mkWord) \
SymX(rts_mkWord32) \
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(shutdownHaskellAndExit) \
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) \
SymX(stg_INTLIKE_closure) \
SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
SymX(stg_WEAK_info) \
+ SymX(stg_ap_v_info) \
+ SymX(stg_ap_f_info) \
+ SymX(stg_ap_d_info) \
+ SymX(stg_ap_l_info) \
+ SymX(stg_ap_n_info) \
+ SymX(stg_ap_p_info) \
+ SymX(stg_ap_pv_info) \
+ SymX(stg_ap_pp_info) \
+ SymX(stg_ap_ppv_info) \
+ SymX(stg_ap_ppp_info) \
+ SymX(stg_ap_pppp_info) \
+ SymX(stg_ap_ppppp_info) \
+ SymX(stg_ap_pppppp_info) \
+ SymX(stg_ap_ppppppp_info) \
+ SymX(stg_ap_0_ret) \
+ SymX(stg_ap_v_ret) \
+ SymX(stg_ap_f_ret) \
+ SymX(stg_ap_d_ret) \
+ SymX(stg_ap_l_ret) \
+ SymX(stg_ap_n_ret) \
+ SymX(stg_ap_p_ret) \
+ SymX(stg_ap_pv_ret) \
+ SymX(stg_ap_pp_ret) \
+ SymX(stg_ap_ppv_ret) \
+ SymX(stg_ap_ppp_ret) \
+ SymX(stg_ap_pppp_ret) \
+ SymX(stg_ap_ppppp_ret) \
+ SymX(stg_ap_pppppp_ret) \
+ SymX(stg_ap_ppppppp_ret) \
SymX(stg_ap_1_upd_info) \
SymX(stg_ap_2_upd_info) \
SymX(stg_ap_3_upd_info) \
SymX(stg_sel_7_upd_info) \
SymX(stg_sel_8_upd_info) \
SymX(stg_sel_9_upd_info) \
- SymX(stg_seq_frame_info) \
SymX(stg_upd_frame_info) \
- SymX(__stg_update_PAP) \
SymX(suspendThread) \
SymX(takeMVarzh_fast) \
SymX(timesIntegerzh_fast) \
#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 \
+#ifdef HAVE_TERMIOS_H
+#define RTS_TERMIOS_SYMS \
+ Sym(saved_termios)
+#else
+#define RTS_TERMIOS_SYMS /* nothing */
+#endif
+
+// 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(__umoddi3) \
- Sym(__ashldi3) \
- Sym(__ashrdi3) \
- Sym(__lshrdi3) \
- SymX(__eprintf)
+ Sym(__umoddi3) \
+ Sym(__ashldi3) \
+ 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_EXTRA_SYMBOLS /* nothing */
+#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)
#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_TERMIOS_SYMS
+RTS_LIBGCC_SYMBOLS
#undef Sym
#undef SymX
+#undef SymX_redirect
#ifdef LEADING_UNDERSCORE
#define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
(void*)(&(vvv)) },
#define SymX(vvv) Sym(vvv)
+// SymX_redirect allows us to redirect references to one symbol to
+// another symbol. See newCAF/newDynCAF for an example.
+#define SymX_redirect(vvv,xxx) \
+ { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
+ (void*)(&(xxx)) },
+
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 */
};
ghciInsertStrHashTable("(GHCi built-in symbols)",
symhash, sym->lbl, sym->addr);
}
+# if defined(OBJFORMAT_MACHO)
+ machoInitSymbolsWithoutUnderscore();
+# endif
+
# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
dl_prog_handle = dlopen(NULL, RTLD_LAZY);
# endif
initLinker();
hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
+
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;
for (i = 0; i < oc->n_symbols; i++) {
sym = oc->symbols[i];
if (sym == NULL) continue;
- /* fprintf(stderr, "enquire %p %p\n", sym, oc->lochash); */
+ // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
a = NULL;
- if (oc->lochash != NULL)
+ if (oc->lochash != NULL) {
a = lookupStrHashTable(oc->lochash, sym);
- if (a == NULL)
+ }
+ if (a == NULL) {
a = lookupStrHashTable(symhash, sym);
+ }
if (a == NULL) {
- /* fprintf(stderr, "ghci_enquire: can't find %s\n", sym); */
+ // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
}
else if (addr-DELTA <= a && a <= addr+DELTA) {
fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, 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;
}
}
* real count can be found in the first reloc entry.
*
* See Section 4.1 (last para) of the PE spec (rev6.0).
+ *
+ * Nov2003 update: the GNU linker still doesn't correctly
+ * handle the generation of relocatable object files with
+ * overflown relocations. Hence the output to warn of potential
+ * troubles.
*/
COFF_reloc* rel = (COFF_reloc*)
myindex ( sizeof_COFF_reloc, reltab, 0 );
noRelocs = rel->VirtualAddress;
- fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
+ fprintf(stderr, "WARNING: Overflown relocation field (# relocs found: %u)\n", noRelocs); fflush(stderr);
j = 1;
} else {
noRelocs = sectab_i->NumberOfRelocations;
# 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",
#if defined(OBJFORMAT_MACHO)
/*
- Initial support for MachO linking on Darwin/MacOS X on PowerPC chips
+ Support for MachO linking on Darwin/MacOS X on PowerPC chips
by Wolfgang Thaller (wolfgang.thaller@gmx.net)
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
*) 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 doesnt 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 1;
}
-static void resolveImports(
+static int resolveImports(
ObjectCode* oc,
char *image,
struct symtab_command *symLC,
addr = lookupSymbol(nm);
if(!addr)
{
- fprintf(stderr, "not found: %s\n", nm);
- abort();
+ belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
+ return 0;
}
ASSERT(addr);
+ checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
((void**)(image + sect->offset))[i] = addr;
}
+
+ return 1;
}
-static void 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 char* relocateAddress(
+ ObjectCode* oc,
+ int nSections,
+ struct section* sections,
+ unsigned long address)
+{
+ int i;
+ for(i = 0; i < nSections; i++)
+ {
+ if(sections[i].addr <= address
+ && address < sections[i].addr + sections[i].size)
+ {
+ return oc->image + sections[i].offset + address - sections[i].addr;
+ }
+ }
+ barf("Invalid Mach-O file:"
+ "Address out of bounds while relocating object file");
+ return NULL;
+}
+
+static int relocateSection(
+ ObjectCode* oc,
+ char *image,
struct symtab_command *symLC, struct nlist *nlist,
- struct section* sections, struct section *sect)
+ int nSections, struct section* sections, struct section *sect)
{
struct relocation_info *relocs;
int i,n;
if(!strcmp(sect->sectname,"__la_symbol_ptr"))
- return;
+ return 1;
else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
- return;
+ return 1;
n = sect->nreloc;
relocs = (struct relocation_info*) (image + sect->reloff);
if(!scat->r_pcrel)
{
- if(scat->r_length == 2 && scat->r_type == GENERIC_RELOC_VANILLA)
+ if(scat->r_length == 2)
{
- unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
+ unsigned long word = 0;
+ unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
+ checkProddableBlock(oc,wordPtr);
- *word = scat->r_value + sect->offset + ((long) image);
+ // Step 1: Figure out what the relocated value should be
+ if(scat->r_type == GENERIC_RELOC_VANILLA)
+ {
+ word = scat->r_value + sect->offset + ((long) image);
+ }
+ else if(scat->r_type == PPC_RELOC_SECTDIFF
+ || scat->r_type == PPC_RELOC_LO16_SECTDIFF
+ || scat->r_type == PPC_RELOC_HI16_SECTDIFF
+ || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
+ {
+ struct scattered_relocation_info *pair =
+ (struct scattered_relocation_info*) &relocs[i+1];
+
+ if(!pair->r_scattered || pair->r_type != PPC_RELOC_PAIR)
+ barf("Invalid Mach-O file: "
+ "PPC_RELOC_*_SECTDIFF not followed by PPC_RELOC_PAIR");
+
+ word = (unsigned long)
+ (relocateAddress(oc, nSections, sections, scat->r_value)
+ - relocateAddress(oc, nSections, sections, pair->r_value));
+ i++;
+ }
+ else
+ continue; // ignore the others
+
+ if(scat->r_type == GENERIC_RELOC_VANILLA
+ || scat->r_type == PPC_RELOC_SECTDIFF)
+ {
+ *wordPtr = word;
+ }
+ else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF)
+ {
+ ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
+ }
+ else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF)
+ {
+ ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
+ }
+ else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF)
+ {
+ ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
+ + ((word & (1<<15)) ? 1 : 0);
+ }
}
}
if(reloc->r_pcrel && !reloc->r_extern)
continue;
- if(!reloc->r_pcrel && reloc->r_length == 2)
+ if(reloc->r_length == 2)
{
- unsigned long word;
-
+ 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)
{
word = ((unsigned short*) wordPtr)[1] << 16;
word += ((short)relocs[i+1].r_address & (short)0xFFFF);
}
+ else if(reloc->r_type == PPC_RELOC_BR24)
+ {
+ word = *wordPtr;
+ word = (word & 0x03FFFFFC) | (word & 0x02000000) ? 0xFC000000 : 0;
+ }
+
if(!reloc->r_extern)
{
struct nlist *symbol = &nlist[reloc->r_symbolnum];
char *nm = image + symLC->stroff + symbol->n_un.n_strx;
word = (unsigned long) (lookupSymbol(nm));
- ASSERT(word);
+ if(!word)
+ {
+ belch("\nunknown symbol `%s'", nm);
+ return 0;
+ }
+
+ 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)
+ ((word & (1<<15)) ? 1 : 0);
i++; continue;
}
- continue;
+ 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;
+ }
}
- fprintf(stderr, "unknown reloc\n");
- abort();
- ASSERT(2 + 2 == 5);
+ barf("\nunknown relocation %d",reloc->r_type);
+ return 0;
}
}
+ return 1;
}
static int ocGetNames_MachO(ObjectCode* oc)
struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
unsigned i,curSymbol;
struct segment_command *segLC = NULL;
- struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
+ struct section *sections;
struct symtab_command *symLC = NULL;
struct dysymtab_command *dsymLC = NULL;
struct nlist *nlist;
for(i=0;i<segLC->nsects;i++)
{
- if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
- la_ptrs = §ions[i];
- else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
- nl_ptrs = §ions[i];
-
- // for now, only add __text and __const to the sections table
- else if(!strcmp(sections[i].sectname,"__text"))
+ if(sections[i].size == 0)
+ continue;
+
+ if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
+ {
+ char * zeroFillArea = stgCallocBytes(1,sections[i].size,
+ "ocGetNames_MachO(common symbols)");
+ sections[i].offset = zeroFillArea - image;
+ }
+
+ if(!strcmp(sections[i].sectname,"__text"))
addSection(oc, SECTIONKIND_CODE_OR_RODATA,
(void*) (image + sections[i].offset),
(void*) (image + sections[i].offset + sections[i].size));
addSection(oc, SECTIONKIND_RWDATA,
(void*) (image + sections[i].offset),
(void*) (image + sections[i].offset + sections[i].size));
+ else if(!strcmp(sections[i].sectname,"__bss")
+ || !strcmp(sections[i].sectname,"__common"))
+ addSection(oc, SECTIONKIND_RWDATA,
+ (void*) (image + sections[i].offset),
+ (void*) (image + sections[i].offset + sections[i].size));
+
+ addProddableBlock(oc, (void*) (image + sections[i].offset),
+ sections[i].size);
}
// count external symbols defined here
indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
if(la_ptrs)
- resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist);
+ if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
+ return 0;
if(nl_ptrs)
- resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist);
+ if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
+ return 0;
for(i=0;i<segLC->nsects;i++)
{
- relocateSection(image,symLC,nlist,sections,§ions[i]);
+ if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
+ return 0;
}
/* Free the local symbol table; we won't need it again. */
freeHashTable(oc->lochash, NULL);
oc->lochash = NULL;
+
+ /*
+ Flush the data & instruction caches.
+ Because the PPC has split data/instruction caches, we have to
+ do that whenever we modify code at runtime.
+ */
+ {
+ int n = (oc->fileSize + islandSize * oc->n_islands) / 4;
+ unsigned long *p = (unsigned long*)oc->image;
+ while(n--)
+ {
+ __asm__ volatile ("dcbf 0,%0\n\tsync\n\ticbi 0,%0"
+ : : "r" (p));
+ p++;
+ }
+ __asm__ volatile ("sync\n\tisync");
+ }
return 1;
}
+/*
+ * The Mach-O object format uses leading underscores. But not everywhere.
+ * There is a small number of runtime support functions defined in
+ * libcc_dynamic.a whose name does not have a leading underscore.
+ * As a consequence, we can't get their address from C code.
+ * We have to use inline assembler just to take the address of a function.
+ * Yuck.
+ */
+
+static void machoInitSymbolsWithoutUnderscore()
+{
+ void *p;
+
+#undef Sym
+#define Sym(x) \
+ __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p)); \
+ ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p);
+
+ RTS_MACHO_NOUNDERLINE_SYMBOLS
+
+}
#endif
projects / ghc-hetmet.git / blobdiff