X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FLinker.c;h=7d9a5500b11bba7682235521b45c58a5706dac78;hb=424774f4fc2ad8532dd4c135b00c33b578f80d97;hp=261caf19675c635931de4d166400d5beb84ddc92;hpb=31442604c1d4ee4102a459a64e4afc39c49fc8a2;p=ghc-hetmet.git diff --git a/ghc/rts/Linker.c b/ghc/rts/Linker.c index 261caf1..7d9a550 100644 --- a/ghc/rts/Linker.c +++ b/ghc/rts/Linker.c @@ -1,7 +1,7 @@ /* ----------------------------------------------------------------------------- - * $Id: Linker.c,v 1.105 2002/10/12 23:12:08 wolfgang 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 * @@ -59,7 +59,7 @@ #include #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 @@ -76,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 ); @@ -88,6 +91,8 @@ static int ocResolve_PEi386 ( 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 /* ----------------------------------------------------------------------------- @@ -200,11 +205,7 @@ typedef struct _RtsSymbolVal { 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 /**/ @@ -213,9 +214,20 @@ typedef struct _RtsSymbolVal { #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(memset) \ SymX(inet_ntoa) \ SymX(inet_addr) \ @@ -275,11 +287,8 @@ typedef struct _RtsSymbolVal { 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 @@ -292,40 +301,40 @@ typedef struct _RtsSymbolVal { 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) \ @@ -388,9 +397,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) \ @@ -417,10 +427,12 @@ typedef struct _RtsSymbolVal { 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) \ @@ -431,6 +443,7 @@ typedef struct _RtsSymbolVal { SymX(rts_mkInt64) \ SymX(rts_mkInt8) \ SymX(rts_mkPtr) \ + SymX(rts_mkFunPtr) \ SymX(rts_mkStablePtr) \ SymX(rts_mkString) \ SymX(rts_mkWord) \ @@ -438,8 +451,11 @@ typedef struct _RtsSymbolVal { 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) \ @@ -450,6 +466,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) \ @@ -475,9 +520,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) \ @@ -499,12 +542,9 @@ typedef struct _RtsSymbolVal { #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) \ @@ -514,20 +554,40 @@ typedef struct _RtsSymbolVal { Sym(__lshrdi3) \ Sym(__eprintf) #else +#define RTS_LIBGCC_SYMBOLS +#endif + +#ifdef ia64_TARGET_ARCH +/* force these symbols to be present */ +#define RTS_EXTRA_SYMBOLS \ + Sym(__divsf3) +#else #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) @@ -539,6 +599,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 @@ -546,6 +612,7 @@ static RtsSymbolVal rtsSyms[] = { RTS_POSIX_ONLY_SYMBOLS RTS_MINGW_ONLY_SYMBOLS RTS_CYGWIN_ONLY_SYMBOLS + RTS_LIBGCC_SYMBOLS { 0, 0 } /* sentinel */ }; @@ -613,6 +680,10 @@ initLinker( void ) 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 @@ -708,13 +779,13 @@ addDLL( char *dll_name ) 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" ); @@ -815,14 +886,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); @@ -888,7 +961,7 @@ loadObj( char *path ) # elif defined(OBJFORMAT_MACHO) oc->formatName = "Mach-O"; # else - free(oc); + stgFree(oc); barf("loadObj: not implemented on this platform"); # endif @@ -1053,14 +1126,14 @@ unloadObj( char *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; } } @@ -2892,7 +2965,7 @@ static int ocVerifyImage_MachO(ObjectCode* oc) return 1; } -static void resolveImports( +static int resolveImports( ObjectCode* oc, char *image, struct symtab_command *symLC, @@ -2918,15 +2991,17 @@ static void resolveImports( 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); ((void**)(image + sect->offset))[i] = addr; } + + return 1; } -static void relocateSection(char *image, +static int relocateSection(char *image, struct symtab_command *symLC, struct nlist *nlist, struct section* sections, struct section *sect) { @@ -2934,9 +3009,9 @@ static void relocateSection(char *image, 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); @@ -2966,9 +3041,9 @@ static void relocateSection(char *image, 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* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address); @@ -2991,6 +3066,12 @@ static void relocateSection(char *image, 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) { @@ -3006,7 +3087,14 @@ static void relocateSection(char *image, 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) + word -= ((long)image) + sect->offset + reloc->r_address; } if(reloc->r_type == GENERIC_RELOC_VANILLA) @@ -3030,13 +3118,17 @@ static void relocateSection(char *image, + ((word & (1<<15)) ? 1 : 0); i++; continue; } - continue; + else if(reloc->r_type == PPC_RELOC_BR24) + { + *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) @@ -3196,13 +3288,16 @@ static int ocResolve_MachO(ObjectCode* oc) 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;insects;i++) { - relocateSection(image,symLC,nlist,sections,§ions[i]); + if(!relocateSection(image,symLC,nlist,sections,§ions[i])) + return 0; } /* Free the local symbol table; we won't need it again. */ @@ -3211,4 +3306,25 @@ static int ocResolve_MachO(ObjectCode* oc) 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