X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=inline;f=ghc%2Frts%2FLinker.c;h=1d4711e9c4ef4f6080ea42e0e726fab51f0c9350;hb=2cc5b907318f97e19b28b2ad8ed9ff8c1f401dcc;hp=c8ecee5d92590662a629138ba7b6538d693a5c3c;hpb=829355e5c01dfcf964e7c210c21c4dc1ebaa5a54;p=ghc-hetmet.git diff --git a/ghc/rts/Linker.c b/ghc/rts/Linker.c index c8ecee5..1d4711e 100644 --- a/ghc/rts/Linker.c +++ b/ghc/rts/Linker.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Linker.c,v 1.70 2001/10/22 16:02:44 sewardj Exp $ + * $Id: Linker.c,v 1.83 2002/02/12 15:17:22 simonmar Exp $ * * (c) The GHC Team, 2000, 2001 * @@ -142,48 +142,44 @@ typedef struct _RtsSymbolVal { Sym(_imp___iob) \ Sym(localtime) \ Sym(gmtime) \ - SymX(getenv) \ - SymX(free) \ - SymX(rename) \ Sym(opendir) \ Sym(readdir) \ Sym(closedir) \ - SymX(GetCurrentProcess) \ - SymX(GetProcessTimes) \ - SymX(CloseHandle) \ - SymX(GetExitCodeProcess) \ - SymX(WaitForSingleObject) \ - SymX(CreateProcessA) \ Sym(__divdi3) \ Sym(__udivdi3) \ Sym(__moddi3) \ - Sym(__umoddi3) \ - SymX(_errno) + Sym(__umoddi3) #endif +#ifndef SMP +# define MAIN_CAP_SYM SymX(MainCapability) +#else +# define MAIN_CAP_SYM +#endif #define RTS_SYMBOLS \ Maybe_ForeignObj \ Maybe_Stable_Names \ Sym(StgReturn) \ - Sym(__stginit_PrelGHC) \ + Sym(__stginit_GHCziPrim) \ Sym(init_stack) \ - Sym(stg_chk_0) \ - Sym(stg_chk_1) \ + SymX(__stg_chk_0) \ + SymX(__stg_chk_1) \ Sym(stg_enterStackTop) \ - Sym(stg_gc_d1) \ - Sym(stg_gc_enter_1) \ - Sym(stg_gc_f1) \ - Sym(stg_gc_noregs) \ - Sym(stg_gc_seq_1) \ - Sym(stg_gc_unbx_r1) \ - Sym(stg_gc_unpt_r1) \ - Sym(stg_gc_ut_0_1) \ - Sym(stg_gc_ut_1_0) \ - Sym(stg_gen_chk) \ - Sym(stg_yield_to_interpreter) \ + SymX(stg_gc_d1) \ + SymX(stg_gc_l1) \ + SymX(__stg_gc_enter_1) \ + SymX(stg_gc_f1) \ + SymX(stg_gc_noregs) \ + SymX(stg_gc_seq_1) \ + SymX(stg_gc_unbx_r1) \ + SymX(stg_gc_unpt_r1) \ + SymX(stg_gc_ut_0_1) \ + SymX(stg_gc_ut_1_0) \ + SymX(stg_gen_chk) \ + SymX(stg_yield_to_interpreter) \ SymX(ErrorHdrHook) \ - SymX(MainRegTable) \ + MAIN_CAP_SYM \ SymX(MallocFailHook) \ SymX(NoRunnableThreadsHook) \ SymX(OnExitHook) \ @@ -207,30 +203,42 @@ typedef struct _RtsSymbolVal { SymX(catchzh_fast) \ SymX(cmp_thread) \ SymX(complementIntegerzh_fast) \ + SymX(cmpIntegerzh_fast) \ + SymX(cmpIntegerIntzh_fast) \ SymX(createAdjustor) \ SymX(decodeDoublezh_fast) \ SymX(decodeFloatzh_fast) \ SymX(defaultsHook) \ SymX(delayzh_fast) \ + SymX(deRefWeakzh_fast) \ + SymX(deRefStablePtrzh_fast) \ SymX(divExactIntegerzh_fast) \ SymX(divModIntegerzh_fast) \ SymX(forkzh_fast) \ SymX(freeHaskellFunctionPtr) \ + SymX(freeStablePtr) \ SymX(gcdIntegerzh_fast) \ + SymX(gcdIntegerIntzh_fast) \ + SymX(gcdIntzh_fast) \ SymX(getProgArgv) \ SymX(getStablePtr) \ SymX(int2Integerzh_fast) \ + SymX(integer2Intzh_fast) \ + SymX(integer2Wordzh_fast) \ SymX(isDoubleDenormalized) \ SymX(isDoubleInfinite) \ SymX(isDoubleNaN) \ SymX(isDoubleNegativeZero) \ + SymX(isEmptyMVarzh_fast) \ SymX(isFloatDenormalized) \ SymX(isFloatInfinite) \ SymX(isFloatNaN) \ SymX(isFloatNegativeZero) \ SymX(killThreadzh_fast) \ + SymX(makeStablePtrzh_fast) \ SymX(minusIntegerzh_fast) \ SymX(mkApUpd0zh_fast) \ + SymX(myThreadIdzh_fast) \ SymX(newArrayzh_fast) \ SymX(newBCOzh_fast) \ SymX(newByteArrayzh_fast) \ @@ -265,6 +273,7 @@ typedef struct _RtsSymbolVal { SymX(rts_getInt32) \ SymX(rts_getPtr) \ SymX(rts_getStablePtr) \ + SymX(rts_getThreadId) \ SymX(rts_getWord) \ SymX(rts_getWord32) \ SymX(rts_mkAddr) \ @@ -324,7 +333,7 @@ typedef struct _RtsSymbolVal { SymX(stg_sel_9_upd_info) \ SymX(stg_seq_frame_info) \ SymX(stg_upd_frame_info) \ - SymX(stg_update_PAP) \ + SymX(__stg_update_PAP) \ SymX(suspendThread) \ SymX(takeMVarzh_fast) \ SymX(timesIntegerzh_fast) \ @@ -543,7 +552,7 @@ lookupSymbol( char *lbl ) OpenedDLL* o_dll; void* sym; for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) { - /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */ + /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */ if (lbl[0] == '_') { /* HACK: if the name has an initial underscore, try stripping it off & look that up first. I've yet to verify whether there's @@ -551,10 +560,16 @@ lookupSymbol( char *lbl ) stripped off when mapping from import lib name to the DLL name. */ sym = GetProcAddress(o_dll->instance, (lbl+1)); - if (sym != NULL) return sym; + if (sym != NULL) { + /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/ + return sym; + } } sym = GetProcAddress(o_dll->instance, lbl); - if (sym != NULL) return sym; + if (sym != NULL) { + /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/ + return sym; + } } return NULL; # else @@ -567,6 +582,7 @@ lookupSymbol( char *lbl ) } static +__attribute((unused)) void * lookupLocalSymbol( ObjectCode* oc, char *lbl ) { @@ -582,6 +598,42 @@ lookupLocalSymbol( ObjectCode* oc, char *lbl ) /* ----------------------------------------------------------------------------- + * Debugging aid: look in GHCi's object symbol tables for symbols + * within DELTA bytes of the specified address, and show their names. + */ +#ifdef DEBUG +void ghci_enquire ( char* addr ); + +void ghci_enquire ( char* addr ) +{ + int i; + char* sym; + char* a; + const int DELTA = 64; + ObjectCode* oc; + 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); */ + a = NULL; + if (oc->lochash != NULL) + a = lookupStrHashTable(oc->lochash, sym); + if (a == NULL) + a = lookupStrHashTable(symhash, sym); + if (a == NULL) { + /* 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); + } + } + } +} +#endif + + +/* ----------------------------------------------------------------------------- * Load an obj (populate the global symbol table, but don't resolve yet) * * Returns: 1 if ok, 0 on error. @@ -805,6 +857,10 @@ static void addSection ( ObjectCode* oc, SectionKind kind, s->kind = kind; s->next = oc->sections; oc->sections = s; + /* + fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n", + start, ((char*)end)-1, end - start + 1, kind ); + */ } @@ -818,6 +874,33 @@ static void addSection ( ObjectCode* oc, SectionKind kind, and Common Object File Format Specification revision 5.1 January 1998 which SimonM says comes from the MS Developer Network CDs. + + It can be found there (on older CDs), but can also be found + online at: + + http://www.microsoft.com/hwdev/hardware/PECOFF.asp + + (this is Rev 6.0 from February 1999). + + Things move, so if that fails, try searching for it via + + http://www.google.com/search?q=PE+COFF+specification + + The ultimate reference for the PE format is the Winnt.h + header file that comes with the Platform SDKs; as always, + implementations will drift wrt their documentation. + + A good background article on the PE format is Matt Pietrek's + March 1994 article in Microsoft System Journal (MSJ) + (Vol.9, No. 3): "Peering Inside the PE: A Tour of the + Win32 Portable Executable File Format." The info in there + has recently been updated in a two part article in + MSDN magazine, issues Feb and March 2002, + "Inside Windows: An In-Depth Look into the Win32 Portable + Executable File Format" + + John Levine's book "Linkers and Loaders" contains useful + info on PE too. */ @@ -909,6 +992,7 @@ typedef /* From PE spec doc, section 4.1 */ #define MYIMAGE_SCN_CNT_CODE 0x00000020 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040 +#define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000 /* From PE spec doc, section 5.2.1 */ #define MYIMAGE_REL_I386_DIR32 0x0006 @@ -1042,7 +1126,8 @@ zapTrailingAtSign ( UChar* sym ) static int ocVerifyImage_PEi386 ( ObjectCode* oc ) { - int i, j; + int i; + UInt32 j, noRelocs; COFF_header* hdr; COFF_section* sectab; COFF_symbol* symtab; @@ -1085,13 +1170,15 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) there are more than 64k relocations, despite claims to the contrary. Hence this test. */ /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */ - if (* (UInt32*)strtab > 600000) { +#if 0 + if ( (*(UInt32*)strtab) > 600000 ) { /* Note that 600k has no special significance other than being big enough to handle the almost-2MB-sized lumps that constitute HSwin32*.o. */ belch("PEi386 object has suspiciously large string table; > 64k relocs?"); return 0; } +#endif /* No further verification after this point; only debug printing. */ i = 0; @@ -1155,8 +1242,23 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) reltab = (COFF_reloc*) ( ((UChar*)(oc->image)) + sectab_i->PointerToRelocations ); + + if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) { + /* If the relocation field (a short) has overflowed, the + * real count can be found in the first reloc entry. + * + * See Section 4.1 (last para) of the PE spec (rev6.0). + */ + COFF_reloc* rel = (COFF_reloc*) + myindex ( sizeof_COFF_reloc, reltab, 0 ); + noRelocs = rel->VirtualAddress; + j = 1; + } else { + noRelocs = sectab_i->NumberOfRelocations; + j = 0; + } - for (j = 0; j < sectab_i->NumberOfRelocations; j++) { + for (; j < noRelocs; j++) { COFF_symbol* sym; COFF_reloc* rel = (COFF_reloc*) myindex ( sizeof_COFF_reloc, reltab, j ); @@ -1166,6 +1268,7 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) rel->VirtualAddress ); sym = (COFF_symbol*) myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex ); + /* Hmm..mysterious looking offset - what's it for? SOF */ printName ( sym->Name, strtab -10 ); fprintf ( stderr, "'\n" ); } @@ -1362,9 +1465,9 @@ ocGetNames_PEi386 ( ObjectCode* oc ) /* fprintf(stderr, "BSS section at 0x%x\n", addr); */ } - if (addr != NULL) { + if (addr != NULL ) { sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab ); - /* fprintf(stderr,"addSymbol %p `%s'\n", addr,sname); */ + /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */ IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);) ASSERT(i >= 0 && i < oc->n_symbols); /* cstring_from_COFF_symbol_name always succeeds. */ @@ -1414,7 +1517,8 @@ ocResolve_PEi386 ( ObjectCode* oc ) UInt32 S; UInt32* pP; - int i, j; + int i; + UInt32 j, noRelocs; /* ToDo: should be variable-sized? But is at least safe in the sense of buffer-overrun-proof. */ @@ -1449,7 +1553,24 @@ ocResolve_PEi386 ( ObjectCode* oc ) || 0 == strcmp(".stabstr", sectab_i->Name)) continue; - for (j = 0; j < sectab_i->NumberOfRelocations; j++) { + if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) { + /* If the relocation field (a short) has overflowed, the + * real count can be found in the first reloc entry. + * + * See Section 4.1 (last para) of the PE spec (rev6.0). + */ + COFF_reloc* rel = (COFF_reloc*) + myindex ( sizeof_COFF_reloc, reltab, 0 ); + noRelocs = rel->VirtualAddress; + fprintf(stderr, "Overflown relocs: %u\n", noRelocs); + j = 1; + } else { + noRelocs = sectab_i->NumberOfRelocations; + j = 0; + } + + + for (; j < noRelocs; j++) { COFF_symbol* sym; COFF_reloc* reltab_j = (COFF_reloc*) @@ -1558,6 +1679,7 @@ ocResolve_PEi386 ( ObjectCode* oc ) */ #include +#include static char * findElfSection ( void* objImage, Elf32_Word sh_type ) @@ -1574,7 +1696,7 @@ findElfSection ( void* objImage, Elf32_Word sh_type ) && i != ehdr->e_shstrndx /* Ignore string tables named .stabstr, as they contain debugging info. */ - && 0 != strcmp(".stabstr", sh_strtab + shdr[i].sh_name) + && 0 != strncmp(".stabstr", sh_strtab + shdr[i].sh_name, 8) ) { ptr = ehdrC + shdr[i].sh_offset; break; @@ -1684,7 +1806,7 @@ ocVerifyImage_ELF ( ObjectCode* oc ) && i != ehdr->e_shstrndx /* Ignore string tables named .stabstr, as they contain debugging info. */ - && 0 != strcmp(".stabstr", sh_strtab + shdr[i].sh_name) + && 0 != strncmp(".stabstr", sh_strtab + shdr[i].sh_name, 8) ) { IF_DEBUG(linker,belch(" section %d is a normal string table", i )); strtab = ehdrC + shdr[i].sh_offset; @@ -1762,7 +1884,6 @@ ocGetNames_ELF ( ObjectCode* oc ) Elf32_Ehdr* ehdr = (Elf32_Ehdr*)ehdrC; char* strtab = findElfSection ( ehdrC, SHT_STRTAB ); Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff); - char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset; ASSERT(symhash != NULL); @@ -1773,19 +1894,39 @@ ocGetNames_ELF ( ObjectCode* oc ) k = 0; for (i = 0; i < ehdr->e_shnum; i++) { + /* Figure out what kind of section it is. Logic derived from + Figure 1.14 ("Special Sections") of the ELF document + ("Portable Formats Specification, Version 1.1"). */ + Elf32_Shdr hdr = shdr[i]; + SectionKind kind = SECTIONKIND_OTHER; + int is_bss = FALSE; + + if (hdr.sh_type == SHT_PROGBITS + && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) { + /* .text-style section */ + kind = SECTIONKIND_CODE_OR_RODATA; + } + else + if (hdr.sh_type == SHT_PROGBITS + && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) { + /* .data-style section */ + kind = SECTIONKIND_RWDATA; + } + else + if (hdr.sh_type == SHT_PROGBITS + && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) { + /* .rodata-style section */ + kind = SECTIONKIND_CODE_OR_RODATA; + } + else + if (hdr.sh_type == SHT_NOBITS + && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) { + /* .bss-style section */ + kind = SECTIONKIND_RWDATA; + is_bss = TRUE; + } - /* make a section entry for relevant sections */ - SectionKind kind = SECTIONKIND_OTHER; - if (!strcmp(".data",sh_strtab+shdr[i].sh_name) || - !strcmp(".data1",sh_strtab+shdr[i].sh_name) || - !strcmp(".bss",sh_strtab+shdr[i].sh_name)) - kind = SECTIONKIND_RWDATA; - if (!strcmp(".text",sh_strtab+shdr[i].sh_name) || - !strcmp(".rodata",sh_strtab+shdr[i].sh_name) || - !strcmp(".rodata1",sh_strtab+shdr[i].sh_name)) - kind = SECTIONKIND_CODE_OR_RODATA; - - if (!strcmp(".bss",sh_strtab+shdr[i].sh_name) && shdr[i].sh_size > 0) { + if (is_bss && shdr[i].sh_size > 0) { /* This is a non-empty .bss section. Allocate zeroed space for it, and set its .sh_offset field such that ehdrC + .sh_offset == addr_of_zeroed_space. */ @@ -1799,10 +1940,11 @@ ocGetNames_ELF ( ObjectCode* oc ) } /* fill in the section info */ - addSection(oc, kind, ehdrC + shdr[i].sh_offset, - ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1); - if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) + if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) { addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size); + addSection(oc, kind, ehdrC + shdr[i].sh_offset, + ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1); + } if (shdr[i].sh_type != SHT_SYMTAB) continue; @@ -1859,8 +2001,6 @@ ocGetNames_ELF ( ObjectCode* oc ) */ ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value; if (ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL) { - IF_DEBUG(linker,belch( "addOTabName(LOCL): %10p %s %s", - ad, oc->fileName, nm )); isLocal = TRUE; } else { IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s", @@ -1876,7 +2016,7 @@ ocGetNames_ELF ( ObjectCode* oc ) oc->symbols[j] = nm; /* Acquire! */ if (isLocal) { - ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, ad); + /* Ignore entirely. */ } else { ghciInsertStrHashTable(oc->fileName, symhash, nm, ad); } @@ -1936,20 +2076,21 @@ do_Elf32_Rel_relocations ( ObjectCode* oc, char* ehdrC, IF_DEBUG(linker,belch( " ZERO" )); S = 0; } else { - /* First see if it is a nameless local symbol. */ - if (stab[ ELF32_R_SYM(info)].st_name == 0) { - symbol = "(noname)"; + Elf32_Sym sym = stab[ELF32_R_SYM(info)]; + /* First see if it is a local symbol. */ + if (ELF32_ST_BIND(sym.st_info) == STB_LOCAL) { + /* Yes, so we can get the address directly from the ELF symbol + table. */ + symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name; S = (Elf32_Addr) - (ehdrC + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset + (ehdrC + shdr[ sym.st_shndx ].sh_offset + stab[ELF32_R_SYM(info)].st_value); - } else { - /* No? Should be in a symbol table then; first try the - local one. */ - symbol = strtab+stab[ ELF32_R_SYM(info)].st_name; - (void*)S = lookupLocalSymbol( oc, symbol ); - if ((void*)S == NULL) - (void*)S = lookupSymbol( symbol ); - } + + } else { + /* No, so look up the name in our global table. */ + symbol = strtab + sym.st_name; + (void*)S = lookupSymbol( symbol ); + } if (!S) { belch("%s: unknown symbol `%s'", oc->fileName, symbol); return 0; @@ -1998,7 +2139,7 @@ do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC, Elf32_Word info = rtab[j].r_info; Elf32_Sword addend = rtab[j].r_addend; Elf32_Addr P = ((Elf32_Addr)targ) + offset; - Elf32_Addr A = addend; + Elf32_Addr A = addend; /* Do not delete this; it is used on sparc. */ Elf32_Addr S; # if defined(sparc_TARGET_ARCH) /* This #ifdef only serves to avoid unused-var warnings. */ @@ -2013,20 +2154,21 @@ do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC, IF_DEBUG(linker,belch( " ZERO" )); S = 0; } else { - /* First see if it is a nameless local symbol. */ - if (stab[ ELF32_R_SYM(info)].st_name == 0) { - symbol = "(noname)"; + Elf32_Sym sym = stab[ELF32_R_SYM(info)]; + /* First see if it is a local symbol. */ + if (ELF32_ST_BIND(sym.st_info) == STB_LOCAL) { + /* Yes, so we can get the address directly from the ELF symbol + table. */ + symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name; S = (Elf32_Addr) - (ehdrC + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset + (ehdrC + shdr[ sym.st_shndx ].sh_offset + stab[ELF32_R_SYM(info)].st_value); - } else { - /* No? Should be in a symbol table then; first try the - local one. */ - symbol = strtab+stab[ ELF32_R_SYM(info)].st_name; - (void*)S = lookupLocalSymbol( oc, symbol ); - if ((void*)S == NULL) - (void*)S = lookupSymbol( symbol ); - } + + } else { + /* No, so look up the name in our global table. */ + symbol = strtab + sym.st_name; + (void*)S = lookupSymbol( symbol ); + } if (!S) { belch("%s: unknown symbol `%s'", oc->fileName, symbol); return 0; @@ -2119,7 +2261,7 @@ ocResolve_ELF ( ObjectCode* oc ) relocation entries that, when done, make the stabs debugging info point at the right places. We ain't interested in all dat jazz, mun. */ - if (0 == strcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name)) + if (0 == strncmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9)) continue; if (shdr[shnum].sh_type == SHT_REL ) {