/* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.91 2002/06/09 13:37:41 matthewc Exp $
+ * $Id: Linker.c,v 1.120 2003/05/30 09:06:24 simonmar Exp $
*
- * (c) The GHC Team, 2000, 2001
+ * (c) The GHC Team, 2000-2003
*
* RTS Object Linker
*
#include <sys/types.h>
#endif
+#include <stdlib.h>
+#include <string.h>
+
#ifdef HAVE_SYS_STAT_H
#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)
# define OBJFORMAT_ELF
#elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
# define OBJFORMAT_PEi386
# include <windows.h>
+# include <math.h>
+#elif defined(darwin_TARGET_OS)
+# include <mach-o/ppc/reloc.h>
+# define OBJFORMAT_MACHO
+# include <mach-o/loader.h>
+# include <mach-o/nlist.h>
+# include <mach-o/reloc.h>
#endif
/* Hash table mapping symbol names to Symbol */
-/*Str*/HashTable *symhash;
+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 ocVerifyImage_PEi386 ( ObjectCode* oc );
static int ocGetNames_PEi386 ( ObjectCode* oc );
static int ocResolve_PEi386 ( ObjectCode* oc );
+#elif defined(OBJFORMAT_MACHO)
+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(memset) \
+ SymX(asyncReadzh_fast) \
+ SymX(asyncWritezh_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(__stginit_GHCziPrim) \
- 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(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(rts_evalIO) \
SymX(rts_evalLazyIO) \
SymX(rts_eval_) \
- SymX(rts_getAddr) \
SymX(rts_getBool) \
SymX(rts_getChar) \
SymX(rts_getDouble) \
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_mkAddr) \
+ 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(run_queue_hd) \
SymX(setProgArgv) \
+ SymX(startupHaskell) \
+ SymX(shutdownHaskell) \
SymX(shutdownHaskellAndExit) \
SymX(stable_ptr_table) \
SymX(stackOverflow) \
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
+// 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) \
+ Sym(__eprintf)
+#else
+#define RTS_LIBGCC_SYMBOLS
+#endif
+
#ifdef ia64_TARGET_ARCH
/* force these symbols to be present */
#define RTS_EXTRA_SYMBOLS \
#define RTS_EXTRA_SYMBOLS /* nothing */
#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 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
#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_POSIX_ONLY_SYMBOLS
RTS_MINGW_ONLY_SYMBOLS
RTS_CYGWIN_ONLY_SYMBOLS
+ RTS_LIBGCC_SYMBOLS
{ 0, 0 } /* sentinel */
};
/* -----------------------------------------------------------------------------
* initialize the object linker
*/
-#if defined(OBJFORMAT_ELF)
+
+
+static int linker_init_done = 0 ;
+
+#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
static void *dl_prog_handle;
#endif
{
RtsSymbolVal *sym;
+ /* 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;
+ }
+
symhash = allocStrHashTable();
/* populate the symbol table with stuff from the RTS */
ghciInsertStrHashTable("(GHCi built-in symbols)",
symhash, sym->lbl, sym->addr);
}
-# if defined(OBJFORMAT_ELF)
+# if defined(OBJFORMAT_MACHO)
+ machoInitSymbolsWithoutUnderscore();
+# endif
+
+# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
dl_prog_handle = dlopen(NULL, RTLD_LAZY);
# endif
}
/* -----------------------------------------------------------------------------
+ * Loading DLL or .so dynamic libraries
+ * -----------------------------------------------------------------------------
+ *
* Add a DLL from which symbols may be found. In the ELF case, just
* do RTLD_GLOBAL-style add, so no further messing around needs to
* happen in order that symbols in the loaded .so are findable --
*
* In the PEi386 case, open the DLLs and put handles to them in a
* linked list. When looking for a symbol, try all handles in the
- * list.
+ * list. This means that we need to load even DLLs that are guaranteed
+ * to be in the ghc.exe image already, just so we can get a handle
+ * to give to loadSymbol, so that we can find the symbols. For such
+ * libraries, the LoadLibrary call should be a no-op except for returning
+ * the handle.
+ *
*/
#if defined(OBJFORMAT_PEi386)
static OpenedDLL* opened_dlls = NULL;
#endif
-
-
char *
addDLL( char *dll_name )
{
-# if defined(OBJFORMAT_ELF)
+# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
+ /* ------------------- ELF DLL loader ------------------- */
void *hdl;
char *errmsg;
+ initLinker();
+
hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
if (hdl == NULL) {
/* dlopen failed; return a ptr to the error msg. */
/*NOTREACHED*/
# elif defined(OBJFORMAT_PEi386)
+ /* ------------------- Win32 DLL loader ------------------- */
- /* Add this DLL to the list of DLLs in which to search for symbols.
- The path argument is ignored. */
char* buf;
OpenedDLL* o_dll;
HINSTANCE instance;
- /* fprintf(stderr, "\naddDLL; path=`%s', dll_name = `%s'\n", path, dll_name); */
+ initLinker();
+
+ /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
/* See if we've already got it, and ignore if so. */
for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
return NULL;
}
+ /* The file name has no suffix (yet) so that we can try
+ both foo.dll and foo.drv
+
+ The documentation for LoadLibrary says:
+ If no file name extension is specified in the lpFileName
+ parameter, the default library extension .dll is
+ appended. However, the file name string can include a trailing
+ point character (.) to indicate that the module name has no
+ extension. */
+
buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
sprintf(buf, "%s.DLL", dll_name);
instance = LoadLibrary(buf);
if (instance == NULL) {
- sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
+ 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" );
o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
strcpy(o_dll->name, dll_name);
lookupSymbol( char *lbl )
{
void *val;
+ initLinker() ;
ASSERT(symhash != NULL);
val = lookupStrHashTable(symhash, lbl);
if (val == NULL) {
-# if defined(OBJFORMAT_ELF)
+# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
return dlsym(dl_prog_handle, lbl);
# elif defined(OBJFORMAT_PEi386)
OpenedDLL* o_dll;
lookupLocalSymbol( ObjectCode* oc, char *lbl )
{
void *val;
+ initLinker() ;
val = lookupStrHashTable(oc->lochash, lbl);
if (val == NULL) {
char* a;
const int DELTA = 64;
ObjectCode* oc;
+
+ initLinker();
+
for (oc = objects; oc; oc = oc->next) {
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);
FILE *f;
#endif
+ initLinker();
+
/* fprintf(stderr, "loadObj %s\n", path ); */
/* Check that we haven't already loaded this object. Don't give up
oc->formatName = "ELF";
# elif defined(OBJFORMAT_PEi386)
oc->formatName = "PEi386";
+# elif defined(OBJFORMAT_MACHO)
+ oc->formatName = "Mach-O";
# else
- free(oc);
+ stgFree(oc);
barf("loadObj: not implemented on this platform");
# endif
oc->next = objects;
objects = oc;
- fd = open(path, O_RDONLY);
- if (fd == -1)
- barf("loadObj: can't open `%s'", path);
-
#ifdef USE_MMAP
#define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
r = ocVerifyImage_ELF ( oc );
# elif defined(OBJFORMAT_PEi386)
r = ocVerifyImage_PEi386 ( oc );
+# elif defined(OBJFORMAT_MACHO)
+ r = ocVerifyImage_MachO ( oc );
# else
barf("loadObj: no verify method");
# endif
r = ocGetNames_ELF ( oc );
# elif defined(OBJFORMAT_PEi386)
r = ocGetNames_PEi386 ( oc );
+# elif defined(OBJFORMAT_MACHO)
+ r = ocGetNames_MachO ( oc );
# else
barf("loadObj: no getNames method");
# endif
ObjectCode *oc;
int r;
+ initLinker();
+
for (oc = objects; oc; oc = oc->next) {
if (oc->status != OBJECT_RESOLVED) {
# if defined(OBJFORMAT_ELF)
r = ocResolve_ELF ( oc );
# elif defined(OBJFORMAT_PEi386)
r = ocResolve_PEi386 ( oc );
+# elif defined(OBJFORMAT_MACHO)
+ r = ocResolve_MachO ( oc );
# else
barf("resolveObjs: not implemented on this platform");
# endif
ASSERT(symhash != NULL);
ASSERT(objects != NULL);
+ initLinker();
+
prev = NULL;
for (oc = objects; oc; prev = oc, oc = oc->next) {
if (!strcmp(oc->fileName,path)) {
/* 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;
}
}
if ((void*)S != NULL) goto foundit;
(void*)S = lookupSymbol( symbol );
if ((void*)S != NULL) goto foundit;
- belch("%s: unknown symbol `%s'", oc->fileName, symbol);
+ /* Newline first because the interactive linker has printed "linking..." */
+ belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
return 0;
foundit:
}
return ptr;
}
+#if defined(ia64_TARGET_ARCH)
static Elf_Addr
findElfSegment ( void* objImage, Elf_Addr vaddr )
{
}
return segaddr;
}
+#endif
static int
ocVerifyImage_ELF ( ObjectCode* oc )
switch (ehdr->e_machine) {
case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
+#ifdef EM_IA_64
case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
+#endif
default: IF_DEBUG(linker,belch( "unknown" ));
belch("%s: unknown architecture", oc->fileName);
return 0;
for (j = 0; j < nent; j++) {
Elf_Addr offset = rtab[j].r_offset;
- Elf_Word info = rtab[j].r_info;
+ Elf_Addr info = rtab[j].r_info;
Elf_Addr P = ((Elf_Addr)targ) + offset;
Elf_Word* pP = (Elf_Word*)P;
{
int j;
char *symbol;
- Elf_Addr* targ;
+ Elf_Addr targ;
Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
int target_shndx = shdr[shnum].sh_info;
int symtab_shndx = shdr[shnum].sh_link;
stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
- targ = (Elf_Addr*)(ehdrC + shdr[ target_shndx ].sh_offset);
+ targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
target_shndx, symtab_shndx ));
for (j = 0; j < nent; j++) {
+#if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
+ /* This #ifdef only serves to avoid unused-var warnings. */
Elf_Addr offset = rtab[j].r_offset;
+ Elf_Addr P = targ + offset;
+#endif
Elf_Addr info = rtab[j].r_info;
Elf_Addr A = rtab[j].r_addend;
- Elf_Addr P = (Elf_Addr)targ + offset;
Elf_Addr S;
Elf_Addr value;
# if defined(sparc_TARGET_ARCH)
- /* This #ifdef only serves to avoid unused-var warnings. */
Elf_Word* pP = (Elf_Word*)P;
Elf_Word w1, w2;
# elif defined(ia64_TARGET_ARCH)
return 1;
}
-
/*
* IA64 specifics
* Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
#endif /* ia64 */
#endif /* ELF */
+
+/* --------------------------------------------------------------------------
+ * Mach-O specifics
+ * ------------------------------------------------------------------------*/
+
+#if defined(OBJFORMAT_MACHO)
+
+/*
+ Initial 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.
+*/
+
+static int ocVerifyImage_MachO(ObjectCode* oc)
+{
+ // FIXME: do some verifying here
+ return 1;
+}
+
+static int resolveImports(
+ ObjectCode* oc,
+ char *image,
+ struct symtab_command *symLC,
+ struct section *sect, // ptr to lazy or non-lazy symbol pointer section
+ unsigned long *indirectSyms,
+ struct nlist *nlist)
+{
+ unsigned i;
+
+ for(i=0;i*4<sect->size;i++)
+ {
+ // according to otool, reserved1 contains the first index into the indirect symbol table
+ struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
+ 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))
+ addr = (void*) (symbol->n_value);
+ else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
+ ;
+ else
+ addr = lookupSymbol(nm);
+ if(!addr)
+ {
+ belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
+ return 0;
+ }
+ ASSERT(addr);
+ ((void**)(image + sect->offset))[i] = addr;
+ }
+
+ return 1;
+}
+
+static int relocateSection(char *image,
+ struct symtab_command *symLC, struct nlist *nlist,
+ struct section* sections, struct section *sect)
+{
+ struct relocation_info *relocs;
+ int i,n;
+
+ if(!strcmp(sect->sectname,"__la_symbol_ptr"))
+ return 1;
+ else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
+ return 1;
+
+ n = sect->nreloc;
+ relocs = (struct relocation_info*) (image + sect->reloff);
+
+ for(i=0;i<n;i++)
+ {
+ if(relocs[i].r_address & R_SCATTERED)
+ {
+ struct scattered_relocation_info *scat =
+ (struct scattered_relocation_info*) &relocs[i];
+
+ if(!scat->r_pcrel)
+ {
+ if(scat->r_length == 2 && scat->r_type == GENERIC_RELOC_VANILLA)
+ {
+ unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
+
+ *word = scat->r_value + sect->offset + ((long) image);
+ }
+ }
+
+ continue; // FIXME: I hope it's OK to ignore all the others.
+ }
+ else
+ {
+ struct relocation_info *reloc = &relocs[i];
+ if(reloc->r_pcrel && !reloc->r_extern)
+ continue;
+
+ if(reloc->r_length == 2)
+ {
+ unsigned long word = 0;
+
+ unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
+
+ if(reloc->r_type == GENERIC_RELOC_VANILLA)
+ {
+ word = *wordPtr;
+ }
+ else if(reloc->r_type == PPC_RELOC_LO16)
+ {
+ word = ((unsigned short*) wordPtr)[1];
+ word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
+ }
+ else if(reloc->r_type == PPC_RELOC_HI16)
+ {
+ word = ((unsigned short*) wordPtr)[1] << 16;
+ word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
+ }
+ else if(reloc->r_type == PPC_RELOC_HA16)
+ {
+ 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)
+ {
+ long delta =
+ sections[reloc->r_symbolnum-1].offset
+ - sections[reloc->r_symbolnum-1].addr
+ + ((long) image);
+
+ word += delta;
+ }
+ else
+ {
+ struct nlist *symbol = &nlist[reloc->r_symbolnum];
+ char *nm = image + symLC->stroff + symbol->n_un.n_strx;
+ word = (unsigned long) (lookupSymbol(nm));
+ if(!word)
+ {
+ belch("\nunknown symbol `%s'", nm);
+ return 0;
+ }
+
+ if(reloc->r_pcrel)
+ word -= ((long)image) + sect->offset + reloc->r_address;
+ }
+
+ if(reloc->r_type == GENERIC_RELOC_VANILLA)
+ {
+ *wordPtr = word;
+ continue;
+ }
+ else if(reloc->r_type == PPC_RELOC_LO16)
+ {
+ ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
+ i++; continue;
+ }
+ else if(reloc->r_type == PPC_RELOC_HI16)
+ {
+ ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
+ i++; continue;
+ }
+ else if(reloc->r_type == PPC_RELOC_HA16)
+ {
+ ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
+ + ((word & (1<<15)) ? 1 : 0);
+ i++; continue;
+ }
+ else if(reloc->r_type == PPC_RELOC_BR24)
+ {
+ *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
+ continue;
+ }
+ }
+ barf("\nunknown relocation %d",reloc->r_type);
+ return 0;
+ }
+ }
+ return 1;
+}
+
+static int ocGetNames_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,curSymbol;
+ struct segment_command *segLC = NULL;
+ struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
+ struct symtab_command *symLC = NULL;
+ struct dysymtab_command *dsymLC = NULL;
+ struct nlist *nlist;
+ unsigned long commonSize = 0;
+ char *commonStorage = NULL;
+ unsigned long commonCounter;
+
+ for(i=0;i<header->ncmds;i++)
+ {
+ if(lc->cmd == LC_SEGMENT)
+ segLC = (struct segment_command*) lc;
+ else if(lc->cmd == LC_SYMTAB)
+ symLC = (struct symtab_command*) lc;
+ else if(lc->cmd == LC_DYSYMTAB)
+ dsymLC = (struct dysymtab_command*) lc;
+ lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
+ }
+
+ sections = (struct section*) (segLC+1);
+ nlist = (struct nlist*) (image + symLC->symoff);
+
+ 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"))
+ addSection(oc, SECTIONKIND_CODE_OR_RODATA,
+ (void*) (image + sections[i].offset),
+ (void*) (image + sections[i].offset + sections[i].size));
+ else if(!strcmp(sections[i].sectname,"__const"))
+ addSection(oc, SECTIONKIND_RWDATA,
+ (void*) (image + sections[i].offset),
+ (void*) (image + sections[i].offset + sections[i].size));
+ else if(!strcmp(sections[i].sectname,"__data"))
+ addSection(oc, SECTIONKIND_RWDATA,
+ (void*) (image + sections[i].offset),
+ (void*) (image + sections[i].offset + sections[i].size));
+ }
+
+ // count external symbols defined here
+ oc->n_symbols = 0;
+ for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
+ {
+ if((nlist[i].n_type & N_TYPE) == N_SECT)
+ oc->n_symbols++;
+ }
+ for(i=0;i<symLC->nsyms;i++)
+ {
+ if((nlist[i].n_type & N_TYPE) == N_UNDF
+ && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
+ {
+ commonSize += nlist[i].n_value;
+ oc->n_symbols++;
+ }
+ }
+ oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
+ "ocGetNames_MachO(oc->symbols)");
+
+ // insert symbols into hash table
+ for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
+ {
+ if((nlist[i].n_type & N_TYPE) == N_SECT)
+ {
+ char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
+ ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
+ sections[nlist[i].n_sect-1].offset
+ - sections[nlist[i].n_sect-1].addr
+ + nlist[i].n_value);
+ oc->symbols[curSymbol++] = nm;
+ }
+ }
+
+ // insert local symbols into lochash
+ for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
+ {
+ if((nlist[i].n_type & N_TYPE) == N_SECT)
+ {
+ char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
+ ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
+ sections[nlist[i].n_sect-1].offset
+ - sections[nlist[i].n_sect-1].addr
+ + nlist[i].n_value);
+ }
+ }
+
+
+ commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
+ commonCounter = (unsigned long)commonStorage;
+ for(i=0;i<symLC->nsyms;i++)
+ {
+ if((nlist[i].n_type & N_TYPE) == N_UNDF
+ && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
+ {
+ char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
+ unsigned long sz = nlist[i].n_value;
+
+ nlist[i].n_value = commonCounter;
+
+ ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
+ oc->symbols[curSymbol++] = nm;
+
+ commonCounter += sz;
+ }
+ }
+ return 1;
+}
+
+static int ocResolve_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;
+ struct segment_command *segLC = NULL;
+ struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
+ struct symtab_command *symLC = NULL;
+ struct dysymtab_command *dsymLC = NULL;
+ struct nlist *nlist;
+ unsigned long *indirectSyms;
+
+ for(i=0;i<header->ncmds;i++)
+ {
+ if(lc->cmd == LC_SEGMENT)
+ segLC = (struct segment_command*) lc;
+ else if(lc->cmd == LC_SYMTAB)
+ symLC = (struct symtab_command*) lc;
+ else if(lc->cmd == LC_DYSYMTAB)
+ dsymLC = (struct dysymtab_command*) lc;
+ lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
+ }
+
+ sections = (struct section*) (segLC+1);
+ nlist = (struct nlist*) (image + symLC->symoff);
+
+ 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];
+ }
+
+ indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
+
+ if(la_ptrs)
+ if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
+ return 0;
+ if(nl_ptrs)
+ if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
+ return 0;
+
+ for(i=0;i<segLC->nsects;i++)
+ {
+ if(!relocateSection(image,symLC,nlist,sections,§ions[i]))
+ return 0;
+ }
+
+ /* Free the local symbol table; we won't need it again. */
+ freeHashTable(oc->lochash, NULL);
+ oc->lochash = NULL;
+ 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