X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FLinker.c;h=e63ac4036eb232c9427c53b4fd9fbc6937a091fb;hb=ae643785c19dc658822eceab647627f42a7b4cd6;hp=74e7093c67e2888340a6ea350b535771a6f24aba;hpb=9af77fa423926fbda946b31e174173d0ec5ebac8;p=ghc-hetmet.git diff --git a/ghc/rts/Linker.c b/ghc/rts/Linker.c index 74e7093..e63ac40 100644 --- a/ghc/rts/Linker.c +++ b/ghc/rts/Linker.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Linker.c,v 1.103 2002/09/13 15:02:50 simonpj Exp $ + * $Id: Linker.c,v 1.111 2003/01/28 17:05:32 simonmar Exp $ * * (c) The GHC Team, 2000, 2001 * @@ -31,7 +31,9 @@ #include #endif -#ifdef HAVE_DLFCN_H +#if defined(HAVE_FRAMEWORK_HASKELLSUPPORT) +#include +#elif defined(HAVE_DLFCN_H) #include #endif @@ -64,6 +66,7 @@ # include # include #elif defined(darwin_TARGET_OS) +# include # define OBJFORMAT_MACHO # include # include @@ -73,6 +76,9 @@ /* 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 ); @@ -290,39 +296,40 @@ typedef struct _RtsSymbolVal { 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) \ @@ -385,9 +392,10 @@ typedef struct _RtsSymbolVal { 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) \ @@ -436,7 +444,8 @@ typedef struct _RtsSymbolVal { SymX(rts_mkWord64) \ SymX(rts_mkWord8) \ SymX(run_queue_hd) \ - SymX(setProgArgv) \ + SymX(startupHaskell) \ + SymX(shutdownHaskell) \ SymX(shutdownHaskellAndExit) \ SymX(stable_ptr_table) \ SymX(stackOverflow) \ @@ -447,6 +456,35 @@ typedef struct _RtsSymbolVal { 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) \ @@ -472,9 +510,7 @@ typedef struct _RtsSymbolVal { 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) \ @@ -501,15 +537,15 @@ typedef struct _RtsSymbolVal { #define RTS_EXTRA_SYMBOLS \ Sym(__divsf3) #elif defined(powerpc_TARGET_ARCH) -#define RTS_EXTRA_SYMBOLS \ +#define RTS_EXTRA_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) #else #define RTS_EXTRA_SYMBOLS /* nothing */ #endif @@ -517,6 +553,7 @@ typedef struct _RtsSymbolVal { /* 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 @@ -525,6 +562,7 @@ RTS_MINGW_ONLY_SYMBOLS RTS_CYGWIN_ONLY_SYMBOLS #undef Sym #undef SymX +#undef SymX_redirect #ifdef LEADING_UNDERSCORE #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s) @@ -536,6 +574,12 @@ RTS_CYGWIN_ONLY_SYMBOLS (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 @@ -812,14 +856,16 @@ void ghci_enquire ( char* addr ) 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); @@ -2963,12 +3009,32 @@ static void relocateSection(char *image, if(reloc->r_pcrel && !reloc->r_extern) continue; - if(!reloc->r_pcrel - && reloc->r_length == 2 - && reloc->r_type == GENERIC_RELOC_VANILLA) + if(!reloc->r_pcrel && reloc->r_length == 2) { - unsigned long* word = (unsigned long*) (image + sect->offset + reloc->r_address); + unsigned long word; + + 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); + } + if(!reloc->r_extern) { long delta = @@ -2976,14 +3042,36 @@ static void relocateSection(char *image, - sections[reloc->r_symbolnum-1].addr + ((long) image); - *word += delta; + 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)); - ASSERT(*word); + word = (unsigned long) (lookupSymbol(nm)); + ASSERT(word); + } + + 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; } continue; }