1 /* -----------------------------------------------------------------------------
2 * $Id: Linker.c,v 1.79 2002/01/29 02:41:21 sof Exp $
4 * (c) The GHC Team, 2000, 2001
8 * ---------------------------------------------------------------------------*/
10 #include "PosixSource.h"
16 #include "LinkerInternals.h"
18 #include "StoragePriv.h"
21 #ifdef HAVE_SYS_TYPES_H
22 #include <sys/types.h>
25 #ifdef HAVE_SYS_STAT_H
33 #if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS)
34 # define OBJFORMAT_ELF
35 #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
36 # define OBJFORMAT_PEi386
40 /* Hash table mapping symbol names to Symbol */
41 /*Str*/HashTable *symhash;
43 #if defined(OBJFORMAT_ELF)
44 static int ocVerifyImage_ELF ( ObjectCode* oc );
45 static int ocGetNames_ELF ( ObjectCode* oc );
46 static int ocResolve_ELF ( ObjectCode* oc );
47 #elif defined(OBJFORMAT_PEi386)
48 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
49 static int ocGetNames_PEi386 ( ObjectCode* oc );
50 static int ocResolve_PEi386 ( ObjectCode* oc );
53 /* -----------------------------------------------------------------------------
54 * Built-in symbols from the RTS
57 typedef struct _RtsSymbolVal {
64 #define Maybe_ForeignObj SymX(mkForeignObjzh_fast)
66 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
67 SymX(makeStableNamezh_fast) \
68 SymX(finalizzeWeakzh_fast)
70 /* These are not available in GUM!!! -- HWL */
71 #define Maybe_ForeignObj
72 #define Maybe_Stable_Names
75 #if !defined (mingw32_TARGET_OS)
77 #define RTS_POSIX_ONLY_SYMBOLS \
78 SymX(stg_sig_install) \
80 #define RTS_MINGW_ONLY_SYMBOLS /**/
84 #define RTS_POSIX_ONLY_SYMBOLS
86 /* These are statically linked from the mingw libraries into the ghc
87 executable, so we have to employ this hack. */
88 #define RTS_MINGW_ONLY_SYMBOLS \
100 SymX(getservbyname) \
101 SymX(getservbyport) \
102 SymX(getprotobynumber) \
103 SymX(getprotobyname) \
104 SymX(gethostbyname) \
105 SymX(gethostbyaddr) \
140 Sym(_imp___timezone) \
155 # define MAIN_CAP_SYM SymX(MainCapability)
157 # define MAIN_CAP_SYM
160 #define RTS_SYMBOLS \
164 Sym(__stginit_PrelGHC) \
168 Sym(stg_enterStackTop) \
171 SymX(__stg_gc_enter_1) \
173 SymX(stg_gc_noregs) \
175 SymX(stg_gc_unbx_r1) \
176 SymX(stg_gc_unpt_r1) \
177 SymX(stg_gc_ut_0_1) \
178 SymX(stg_gc_ut_1_0) \
180 SymX(stg_yield_to_interpreter) \
183 SymX(MallocFailHook) \
184 SymX(NoRunnableThreadsHook) \
186 SymX(OutOfHeapHook) \
187 SymX(PatErrorHdrHook) \
188 SymX(PostTraceHook) \
190 SymX(StackOverflowHook) \
191 SymX(__encodeDouble) \
192 SymX(__encodeFloat) \
195 SymX(__gmpz_cmp_si) \
196 SymX(__gmpz_cmp_ui) \
197 SymX(__gmpz_get_si) \
198 SymX(__gmpz_get_ui) \
199 SymX(__int_encodeDouble) \
200 SymX(__int_encodeFloat) \
201 SymX(andIntegerzh_fast) \
202 SymX(blockAsyncExceptionszh_fast) \
205 SymX(complementIntegerzh_fast) \
206 SymX(cmpIntegerzh_fast) \
207 SymX(cmpIntegerIntzh_fast) \
208 SymX(createAdjustor) \
209 SymX(decodeDoublezh_fast) \
210 SymX(decodeFloatzh_fast) \
213 SymX(deRefWeakzh_fast) \
214 SymX(deRefStablePtrzh_fast) \
215 SymX(divExactIntegerzh_fast) \
216 SymX(divModIntegerzh_fast) \
218 SymX(freeHaskellFunctionPtr) \
219 SymX(freeStablePtr) \
220 SymX(gcdIntegerzh_fast) \
221 SymX(gcdIntegerIntzh_fast) \
222 SymX(gcdIntzh_fast) \
225 SymX(int2Integerzh_fast) \
226 SymX(integer2Intzh_fast) \
227 SymX(integer2Wordzh_fast) \
228 SymX(isDoubleDenormalized) \
229 SymX(isDoubleInfinite) \
231 SymX(isDoubleNegativeZero) \
232 SymX(isEmptyMVarzh_fast) \
233 SymX(isFloatDenormalized) \
234 SymX(isFloatInfinite) \
236 SymX(isFloatNegativeZero) \
237 SymX(killThreadzh_fast) \
238 SymX(makeStablePtrzh_fast) \
239 SymX(minusIntegerzh_fast) \
240 SymX(mkApUpd0zh_fast) \
241 SymX(myThreadIdzh_fast) \
242 SymX(newArrayzh_fast) \
243 SymX(newBCOzh_fast) \
244 SymX(newByteArrayzh_fast) \
246 SymX(newMVarzh_fast) \
247 SymX(newMutVarzh_fast) \
248 SymX(newPinnedByteArrayzh_fast) \
249 SymX(orIntegerzh_fast) \
251 SymX(plusIntegerzh_fast) \
254 SymX(putMVarzh_fast) \
255 SymX(quotIntegerzh_fast) \
256 SymX(quotRemIntegerzh_fast) \
258 SymX(remIntegerzh_fast) \
259 SymX(resetNonBlockingFd) \
262 SymX(rts_checkSchedStatus) \
265 SymX(rts_evalLazyIO) \
270 SymX(rts_getDouble) \
275 SymX(rts_getStablePtr) \
276 SymX(rts_getThreadId) \
278 SymX(rts_getWord32) \
290 SymX(rts_mkStablePtr) \
299 SymX(shutdownHaskellAndExit) \
300 SymX(stable_ptr_table) \
301 SymX(stackOverflow) \
302 SymX(stg_CAF_BLACKHOLE_info) \
303 SymX(stg_CHARLIKE_closure) \
304 SymX(stg_EMPTY_MVAR_info) \
305 SymX(stg_IND_STATIC_info) \
306 SymX(stg_INTLIKE_closure) \
307 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
308 SymX(stg_WEAK_info) \
309 SymX(stg_ap_1_upd_info) \
310 SymX(stg_ap_2_upd_info) \
311 SymX(stg_ap_3_upd_info) \
312 SymX(stg_ap_4_upd_info) \
313 SymX(stg_ap_5_upd_info) \
314 SymX(stg_ap_6_upd_info) \
315 SymX(stg_ap_7_upd_info) \
316 SymX(stg_ap_8_upd_info) \
318 SymX(stg_sel_0_upd_info) \
319 SymX(stg_sel_10_upd_info) \
320 SymX(stg_sel_11_upd_info) \
321 SymX(stg_sel_12_upd_info) \
322 SymX(stg_sel_13_upd_info) \
323 SymX(stg_sel_14_upd_info) \
324 SymX(stg_sel_15_upd_info) \
325 SymX(stg_sel_1_upd_info) \
326 SymX(stg_sel_2_upd_info) \
327 SymX(stg_sel_3_upd_info) \
328 SymX(stg_sel_4_upd_info) \
329 SymX(stg_sel_5_upd_info) \
330 SymX(stg_sel_6_upd_info) \
331 SymX(stg_sel_7_upd_info) \
332 SymX(stg_sel_8_upd_info) \
333 SymX(stg_sel_9_upd_info) \
334 SymX(stg_seq_frame_info) \
335 SymX(stg_upd_frame_info) \
336 SymX(__stg_update_PAP) \
337 SymX(suspendThread) \
338 SymX(takeMVarzh_fast) \
339 SymX(timesIntegerzh_fast) \
340 SymX(tryPutMVarzh_fast) \
341 SymX(tryTakeMVarzh_fast) \
342 SymX(unblockAsyncExceptionszh_fast) \
343 SymX(unsafeThawArrayzh_fast) \
344 SymX(waitReadzh_fast) \
345 SymX(waitWritezh_fast) \
346 SymX(word2Integerzh_fast) \
347 SymX(xorIntegerzh_fast) \
350 #ifndef SUPPORT_LONG_LONGS
351 #define RTS_LONG_LONG_SYMS /* nothing */
353 #define RTS_LONG_LONG_SYMS \
354 SymX(int64ToIntegerzh_fast) \
355 SymX(word64ToIntegerzh_fast)
356 #endif /* SUPPORT_LONG_LONGS */
358 /* entirely bogus claims about types of these symbols */
359 #define Sym(vvv) extern void (vvv);
360 #define SymX(vvv) /**/
363 RTS_POSIX_ONLY_SYMBOLS
364 RTS_MINGW_ONLY_SYMBOLS
368 #ifdef LEADING_UNDERSCORE
369 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
371 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
374 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
376 #define SymX(vvv) Sym(vvv)
378 static RtsSymbolVal rtsSyms[] = {
381 RTS_POSIX_ONLY_SYMBOLS
382 RTS_MINGW_ONLY_SYMBOLS
383 { 0, 0 } /* sentinel */
386 /* -----------------------------------------------------------------------------
387 * Insert symbols into hash tables, checking for duplicates.
389 static void ghciInsertStrHashTable ( char* obj_name,
395 if (lookupHashTable(table, (StgWord)key) == NULL)
397 insertStrHashTable(table, (StgWord)key, data);
402 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
404 "whilst processing object file\n"
406 "This could be caused by:\n"
407 " * Loading two different object files which export the same symbol\n"
408 " * Specifying the same object file twice on the GHCi command line\n"
409 " * An incorrect `package.conf' entry, causing some object to be\n"
411 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
420 /* -----------------------------------------------------------------------------
421 * initialize the object linker
423 #if defined(OBJFORMAT_ELF)
424 static void *dl_prog_handle;
432 symhash = allocStrHashTable();
434 /* populate the symbol table with stuff from the RTS */
435 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
436 ghciInsertStrHashTable("(GHCi built-in symbols)",
437 symhash, sym->lbl, sym->addr);
439 # if defined(OBJFORMAT_ELF)
440 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
444 /* -----------------------------------------------------------------------------
445 * Add a DLL from which symbols may be found. In the ELF case, just
446 * do RTLD_GLOBAL-style add, so no further messing around needs to
447 * happen in order that symbols in the loaded .so are findable --
448 * lookupSymbol() will subsequently see them by dlsym on the program's
449 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
451 * In the PEi386 case, open the DLLs and put handles to them in a
452 * linked list. When looking for a symbol, try all handles in the
456 #if defined(OBJFORMAT_PEi386)
457 /* A record for storing handles into DLLs. */
462 struct _OpenedDLL* next;
467 /* A list thereof. */
468 static OpenedDLL* opened_dlls = NULL;
474 addDLL ( __attribute((unused)) char* path, char* dll_name )
476 # if defined(OBJFORMAT_ELF)
481 if (path == NULL || strlen(path) == 0) {
482 buf = stgMallocBytes(strlen(dll_name) + 10, "addDll");
483 sprintf(buf, "lib%s.so", dll_name);
485 buf = stgMallocBytes(strlen(path) + 1 + strlen(dll_name) + 10, "addDll");
486 sprintf(buf, "%s/lib%s.so", path, dll_name);
488 hdl = dlopen(buf, RTLD_NOW | RTLD_GLOBAL );
491 /* dlopen failed; return a ptr to the error msg. */
493 if (errmsg == NULL) errmsg = "addDLL: unknown error";
500 # elif defined(OBJFORMAT_PEi386)
502 /* Add this DLL to the list of DLLs in which to search for symbols.
503 The path argument is ignored. */
508 /* fprintf(stderr, "\naddDLL; path=`%s', dll_name = `%s'\n", path, dll_name); */
510 /* See if we've already got it, and ignore if so. */
511 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
512 if (0 == strcmp(o_dll->name, dll_name))
516 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
517 sprintf(buf, "%s.DLL", dll_name);
518 instance = LoadLibrary(buf);
520 if (instance == NULL) {
521 /* LoadLibrary failed; return a ptr to the error msg. */
522 return "addDLL: unknown error";
525 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
526 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
527 strcpy(o_dll->name, dll_name);
528 o_dll->instance = instance;
529 o_dll->next = opened_dlls;
534 barf("addDLL: not implemented on this platform");
538 /* -----------------------------------------------------------------------------
539 * lookup a symbol in the hash table
542 lookupSymbol( char *lbl )
545 ASSERT(symhash != NULL);
546 val = lookupStrHashTable(symhash, lbl);
549 # if defined(OBJFORMAT_ELF)
550 return dlsym(dl_prog_handle, lbl);
551 # elif defined(OBJFORMAT_PEi386)
554 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
555 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
557 /* HACK: if the name has an initial underscore, try stripping
558 it off & look that up first. I've yet to verify whether there's
559 a Rule that governs whether an initial '_' *should always* be
560 stripped off when mapping from import lib name to the DLL name.
562 sym = GetProcAddress(o_dll->instance, (lbl+1));
564 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
568 sym = GetProcAddress(o_dll->instance, lbl);
570 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
585 __attribute((unused))
587 lookupLocalSymbol( ObjectCode* oc, char *lbl )
590 val = lookupStrHashTable(oc->lochash, lbl);
600 /* -----------------------------------------------------------------------------
601 * Debugging aid: look in GHCi's object symbol tables for symbols
602 * within DELTA bytes of the specified address, and show their names.
605 void ghci_enquire ( char* addr );
607 void ghci_enquire ( char* addr )
612 const int DELTA = 64;
614 for (oc = objects; oc; oc = oc->next) {
615 for (i = 0; i < oc->n_symbols; i++) {
616 sym = oc->symbols[i];
617 if (sym == NULL) continue;
618 /* fprintf(stderr, "enquire %p %p\n", sym, oc->lochash); */
620 if (oc->lochash != NULL)
621 a = lookupStrHashTable(oc->lochash, sym);
623 a = lookupStrHashTable(symhash, sym);
625 /* fprintf(stderr, "ghci_enquire: can't find %s\n", sym); */
627 else if (addr-DELTA <= a && a <= addr+DELTA) {
628 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
636 /* -----------------------------------------------------------------------------
637 * Load an obj (populate the global symbol table, but don't resolve yet)
639 * Returns: 1 if ok, 0 on error.
642 loadObj( char *path )
649 /* fprintf(stderr, "loadObj %s\n", path ); */
651 /* Check that we haven't already loaded this object. Don't give up
652 at this stage; ocGetNames_* will barf later. */
656 for (o = objects; o; o = o->next) {
657 if (0 == strcmp(o->fileName, path))
663 "GHCi runtime linker: warning: looks like you're trying to load the\n"
664 "same object file twice:\n"
666 "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
672 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
674 # if defined(OBJFORMAT_ELF)
675 oc->formatName = "ELF";
676 # elif defined(OBJFORMAT_PEi386)
677 oc->formatName = "PEi386";
680 barf("loadObj: not implemented on this platform");
684 if (r == -1) { return 0; }
686 /* sigh, strdup() isn't a POSIX function, so do it the long way */
687 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
688 strcpy(oc->fileName, path);
690 oc->fileSize = st.st_size;
691 oc->image = stgMallocBytes( st.st_size, "loadObj(image)" );
694 oc->lochash = allocStrHashTable();
695 oc->proddables = NULL;
697 /* chain it onto the list of objects */
701 /* load the image into memory */
702 f = fopen(path, "rb");
704 barf("loadObj: can't read `%s'", path);
706 n = fread ( oc->image, 1, oc->fileSize, f );
707 if (n != oc->fileSize) {
709 barf("loadObj: error whilst reading `%s'", path);
712 /* verify the in-memory image */
713 # if defined(OBJFORMAT_ELF)
714 r = ocVerifyImage_ELF ( oc );
715 # elif defined(OBJFORMAT_PEi386)
716 r = ocVerifyImage_PEi386 ( oc );
718 barf("loadObj: no verify method");
720 if (!r) { return r; }
722 /* build the symbol list for this image */
723 # if defined(OBJFORMAT_ELF)
724 r = ocGetNames_ELF ( oc );
725 # elif defined(OBJFORMAT_PEi386)
726 r = ocGetNames_PEi386 ( oc );
728 barf("loadObj: no getNames method");
730 if (!r) { return r; }
732 /* loaded, but not resolved yet */
733 oc->status = OBJECT_LOADED;
738 /* -----------------------------------------------------------------------------
739 * resolve all the currently unlinked objects in memory
741 * Returns: 1 if ok, 0 on error.
749 for (oc = objects; oc; oc = oc->next) {
750 if (oc->status != OBJECT_RESOLVED) {
751 # if defined(OBJFORMAT_ELF)
752 r = ocResolve_ELF ( oc );
753 # elif defined(OBJFORMAT_PEi386)
754 r = ocResolve_PEi386 ( oc );
756 barf("resolveObjs: not implemented on this platform");
758 if (!r) { return r; }
759 oc->status = OBJECT_RESOLVED;
765 /* -----------------------------------------------------------------------------
766 * delete an object from the pool
769 unloadObj( char *path )
771 ObjectCode *oc, *prev;
773 ASSERT(symhash != NULL);
774 ASSERT(objects != NULL);
777 for (oc = objects; oc; prev = oc, oc = oc->next) {
778 if (!strcmp(oc->fileName,path)) {
780 /* Remove all the mappings for the symbols within this
785 for (i = 0; i < oc->n_symbols; i++) {
786 if (oc->symbols[i] != NULL) {
787 removeStrHashTable(symhash, oc->symbols[i], NULL);
795 prev->next = oc->next;
798 /* We're going to leave this in place, in case there are
799 any pointers from the heap into it: */
800 /* free(oc->image); */
804 /* The local hash table should have been freed at the end
805 of the ocResolve_ call on it. */
806 ASSERT(oc->lochash == NULL);
812 belch("unloadObj: can't find `%s' to unload", path);
816 /* -----------------------------------------------------------------------------
817 * Sanity checking. For each ObjectCode, maintain a list of address ranges
818 * which may be prodded during relocation, and abort if we try and write
819 * outside any of these.
821 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
824 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
825 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
829 pb->next = oc->proddables;
833 static void checkProddableBlock ( ObjectCode* oc, void* addr )
836 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
837 char* s = (char*)(pb->start);
838 char* e = s + pb->size - 1;
839 char* a = (char*)addr;
840 /* Assumes that the biggest fixup involves a 4-byte write. This
841 probably needs to be changed to 8 (ie, +7) on 64-bit
843 if (a >= s && (a+3) <= e) return;
845 barf("checkProddableBlock: invalid fixup in runtime linker");
848 /* -----------------------------------------------------------------------------
849 * Section management.
851 static void addSection ( ObjectCode* oc, SectionKind kind,
852 void* start, void* end )
854 Section* s = stgMallocBytes(sizeof(Section), "addSection");
858 s->next = oc->sections;
864 /* --------------------------------------------------------------------------
865 * PEi386 specifics (Win32 targets)
866 * ------------------------------------------------------------------------*/
868 /* The information for this linker comes from
869 Microsoft Portable Executable
870 and Common Object File Format Specification
871 revision 5.1 January 1998
872 which SimonM says comes from the MS Developer Network CDs.
876 #if defined(OBJFORMAT_PEi386)
880 typedef unsigned char UChar;
881 typedef unsigned short UInt16;
882 typedef unsigned int UInt32;
889 UInt16 NumberOfSections;
890 UInt32 TimeDateStamp;
891 UInt32 PointerToSymbolTable;
892 UInt32 NumberOfSymbols;
893 UInt16 SizeOfOptionalHeader;
894 UInt16 Characteristics;
898 #define sizeof_COFF_header 20
905 UInt32 VirtualAddress;
906 UInt32 SizeOfRawData;
907 UInt32 PointerToRawData;
908 UInt32 PointerToRelocations;
909 UInt32 PointerToLinenumbers;
910 UInt16 NumberOfRelocations;
911 UInt16 NumberOfLineNumbers;
912 UInt32 Characteristics;
916 #define sizeof_COFF_section 40
923 UInt16 SectionNumber;
926 UChar NumberOfAuxSymbols;
930 #define sizeof_COFF_symbol 18
935 UInt32 VirtualAddress;
936 UInt32 SymbolTableIndex;
941 #define sizeof_COFF_reloc 10
944 /* From PE spec doc, section 3.3.2 */
945 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
946 windows.h -- for the same purpose, but I want to know what I'm
948 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
949 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
950 #define MYIMAGE_FILE_DLL 0x2000
951 #define MYIMAGE_FILE_SYSTEM 0x1000
952 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
953 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
954 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
956 /* From PE spec doc, section 5.4.2 and 5.4.4 */
957 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
958 #define MYIMAGE_SYM_CLASS_STATIC 3
959 #define MYIMAGE_SYM_UNDEFINED 0
961 /* From PE spec doc, section 4.1 */
962 #define MYIMAGE_SCN_CNT_CODE 0x00000020
963 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
964 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
966 /* From PE spec doc, section 5.2.1 */
967 #define MYIMAGE_REL_I386_DIR32 0x0006
968 #define MYIMAGE_REL_I386_REL32 0x0014
971 /* We use myindex to calculate array addresses, rather than
972 simply doing the normal subscript thing. That's because
973 some of the above structs have sizes which are not
974 a whole number of words. GCC rounds their sizes up to a
975 whole number of words, which means that the address calcs
976 arising from using normal C indexing or pointer arithmetic
977 are just plain wrong. Sigh.
980 myindex ( int scale, void* base, int index )
983 ((UChar*)base) + scale * index;
988 printName ( UChar* name, UChar* strtab )
990 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
991 UInt32 strtab_offset = * (UInt32*)(name+4);
992 fprintf ( stderr, "%s", strtab + strtab_offset );
995 for (i = 0; i < 8; i++) {
996 if (name[i] == 0) break;
997 fprintf ( stderr, "%c", name[i] );
1004 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1006 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1007 UInt32 strtab_offset = * (UInt32*)(name+4);
1008 strncpy ( dst, strtab+strtab_offset, dstSize );
1014 if (name[i] == 0) break;
1024 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1027 /* If the string is longer than 8 bytes, look in the
1028 string table for it -- this will be correctly zero terminated.
1030 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1031 UInt32 strtab_offset = * (UInt32*)(name+4);
1032 return ((UChar*)strtab) + strtab_offset;
1034 /* Otherwise, if shorter than 8 bytes, return the original,
1035 which by defn is correctly terminated.
1037 if (name[7]==0) return name;
1038 /* The annoying case: 8 bytes. Copy into a temporary
1039 (which is never freed ...)
1041 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1043 strncpy(newstr,name,8);
1049 /* Just compares the short names (first 8 chars) */
1050 static COFF_section *
1051 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1055 = (COFF_header*)(oc->image);
1056 COFF_section* sectab
1058 ((UChar*)(oc->image))
1059 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1061 for (i = 0; i < hdr->NumberOfSections; i++) {
1064 COFF_section* section_i
1066 myindex ( sizeof_COFF_section, sectab, i );
1067 n1 = (UChar*) &(section_i->Name);
1069 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1070 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1071 n1[6]==n2[6] && n1[7]==n2[7])
1080 zapTrailingAtSign ( UChar* sym )
1082 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1084 if (sym[0] == 0) return;
1086 while (sym[i] != 0) i++;
1089 while (j > 0 && my_isdigit(sym[j])) j--;
1090 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1096 ocVerifyImage_PEi386 ( ObjectCode* oc )
1101 COFF_section* sectab;
1102 COFF_symbol* symtab;
1104 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1105 hdr = (COFF_header*)(oc->image);
1106 sectab = (COFF_section*) (
1107 ((UChar*)(oc->image))
1108 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1110 symtab = (COFF_symbol*) (
1111 ((UChar*)(oc->image))
1112 + hdr->PointerToSymbolTable
1114 strtab = ((UChar*)symtab)
1115 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1117 if (hdr->Machine != 0x14c) {
1118 belch("Not x86 PEi386");
1121 if (hdr->SizeOfOptionalHeader != 0) {
1122 belch("PEi386 with nonempty optional header");
1125 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1126 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1127 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1128 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1129 belch("Not a PEi386 object file");
1132 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1133 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1134 belch("Invalid PEi386 word size or endiannness: %d",
1135 (int)(hdr->Characteristics));
1138 /* If the string table size is way crazy, this might indicate that
1139 there are more than 64k relocations, despite claims to the
1140 contrary. Hence this test. */
1141 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1143 if ( (*(UInt32*)strtab) > 600000 ) {
1144 /* Note that 600k has no special significance other than being
1145 big enough to handle the almost-2MB-sized lumps that
1146 constitute HSwin32*.o. */
1147 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1152 /* No further verification after this point; only debug printing. */
1154 IF_DEBUG(linker, i=1);
1155 if (i == 0) return 1;
1158 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1160 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1162 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1164 fprintf ( stderr, "\n" );
1166 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1168 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1170 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1172 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1174 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1176 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1178 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1180 /* Print the section table. */
1181 fprintf ( stderr, "\n" );
1182 for (i = 0; i < hdr->NumberOfSections; i++) {
1184 COFF_section* sectab_i
1186 myindex ( sizeof_COFF_section, sectab, i );
1193 printName ( sectab_i->Name, strtab );
1203 sectab_i->VirtualSize,
1204 sectab_i->VirtualAddress,
1205 sectab_i->SizeOfRawData,
1206 sectab_i->PointerToRawData,
1207 sectab_i->NumberOfRelocations,
1208 sectab_i->PointerToRelocations,
1209 sectab_i->PointerToRawData
1211 reltab = (COFF_reloc*) (
1212 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1215 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1216 /* If the relocation field (a short) has overflowed, the
1217 * real count can be found in the first reloc entry.
1218 * The PE spec (Rev 6.0) doesn't really cover this,
1219 * but as always header files provide the final word on
1220 * details like this (cf. WinNT.h).
1222 COFF_reloc* rel = (COFF_reloc*)
1223 myindex ( sizeof_COFF_reloc, reltab, 0 );
1224 noRelocs = rel->VirtualAddress;
1227 noRelocs = sectab_i->NumberOfRelocations;
1231 for (; j < noRelocs; j++) {
1233 COFF_reloc* rel = (COFF_reloc*)
1234 myindex ( sizeof_COFF_reloc, reltab, j );
1236 " type 0x%-4x vaddr 0x%-8x name `",
1238 rel->VirtualAddress );
1239 sym = (COFF_symbol*)
1240 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1241 /* Hmm..mysterious looking offset - what's it for? SOF */
1242 printName ( sym->Name, strtab -10 );
1243 fprintf ( stderr, "'\n" );
1246 fprintf ( stderr, "\n" );
1248 fprintf ( stderr, "\n" );
1249 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1250 fprintf ( stderr, "---START of string table---\n");
1251 for (i = 4; i < *(Int32*)strtab; i++) {
1253 fprintf ( stderr, "\n"); else
1254 fprintf( stderr, "%c", strtab[i] );
1256 fprintf ( stderr, "--- END of string table---\n");
1258 fprintf ( stderr, "\n" );
1261 COFF_symbol* symtab_i;
1262 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1263 symtab_i = (COFF_symbol*)
1264 myindex ( sizeof_COFF_symbol, symtab, i );
1270 printName ( symtab_i->Name, strtab );
1279 (Int32)(symtab_i->SectionNumber),
1280 (UInt32)symtab_i->Type,
1281 (UInt32)symtab_i->StorageClass,
1282 (UInt32)symtab_i->NumberOfAuxSymbols
1284 i += symtab_i->NumberOfAuxSymbols;
1288 fprintf ( stderr, "\n" );
1294 ocGetNames_PEi386 ( ObjectCode* oc )
1297 COFF_section* sectab;
1298 COFF_symbol* symtab;
1305 hdr = (COFF_header*)(oc->image);
1306 sectab = (COFF_section*) (
1307 ((UChar*)(oc->image))
1308 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1310 symtab = (COFF_symbol*) (
1311 ((UChar*)(oc->image))
1312 + hdr->PointerToSymbolTable
1314 strtab = ((UChar*)(oc->image))
1315 + hdr->PointerToSymbolTable
1316 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1318 /* Allocate space for any (local, anonymous) .bss sections. */
1320 for (i = 0; i < hdr->NumberOfSections; i++) {
1322 COFF_section* sectab_i
1324 myindex ( sizeof_COFF_section, sectab, i );
1325 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1326 if (sectab_i->VirtualSize == 0) continue;
1327 /* This is a non-empty .bss section. Allocate zeroed space for
1328 it, and set its PointerToRawData field such that oc->image +
1329 PointerToRawData == addr_of_zeroed_space. */
1330 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1331 "ocGetNames_PEi386(anonymous bss)");
1332 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1333 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1334 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1337 /* Copy section information into the ObjectCode. */
1339 for (i = 0; i < hdr->NumberOfSections; i++) {
1345 = SECTIONKIND_OTHER;
1346 COFF_section* sectab_i
1348 myindex ( sizeof_COFF_section, sectab, i );
1349 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1352 /* I'm sure this is the Right Way to do it. However, the
1353 alternative of testing the sectab_i->Name field seems to
1354 work ok with Cygwin.
1356 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1357 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1358 kind = SECTIONKIND_CODE_OR_RODATA;
1361 if (0==strcmp(".text",sectab_i->Name) ||
1362 0==strcmp(".rodata",sectab_i->Name))
1363 kind = SECTIONKIND_CODE_OR_RODATA;
1364 if (0==strcmp(".data",sectab_i->Name) ||
1365 0==strcmp(".bss",sectab_i->Name))
1366 kind = SECTIONKIND_RWDATA;
1368 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1369 sz = sectab_i->SizeOfRawData;
1370 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1372 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1373 end = start + sz - 1;
1375 if (kind == SECTIONKIND_OTHER
1376 /* Ignore sections called which contain stabs debugging
1378 && 0 != strcmp(".stab", sectab_i->Name)
1379 && 0 != strcmp(".stabstr", sectab_i->Name)
1381 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1385 if (kind != SECTIONKIND_OTHER && end >= start) {
1386 addSection(oc, kind, start, end);
1387 addProddableBlock(oc, start, end - start + 1);
1391 /* Copy exported symbols into the ObjectCode. */
1393 oc->n_symbols = hdr->NumberOfSymbols;
1394 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1395 "ocGetNames_PEi386(oc->symbols)");
1396 /* Call me paranoid; I don't care. */
1397 for (i = 0; i < oc->n_symbols; i++)
1398 oc->symbols[i] = NULL;
1402 COFF_symbol* symtab_i;
1403 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1404 symtab_i = (COFF_symbol*)
1405 myindex ( sizeof_COFF_symbol, symtab, i );
1409 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1410 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1411 /* This symbol is global and defined, viz, exported */
1412 /* for MYIMAGE_SYMCLASS_EXTERNAL
1413 && !MYIMAGE_SYM_UNDEFINED,
1414 the address of the symbol is:
1415 address of relevant section + offset in section
1417 COFF_section* sectabent
1418 = (COFF_section*) myindex ( sizeof_COFF_section,
1420 symtab_i->SectionNumber-1 );
1421 addr = ((UChar*)(oc->image))
1422 + (sectabent->PointerToRawData
1426 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1427 && symtab_i->Value > 0) {
1428 /* This symbol isn't in any section at all, ie, global bss.
1429 Allocate zeroed space for it. */
1430 addr = stgCallocBytes(1, symtab_i->Value,
1431 "ocGetNames_PEi386(non-anonymous bss)");
1432 addSection(oc, SECTIONKIND_RWDATA, addr,
1433 ((UChar*)addr) + symtab_i->Value - 1);
1434 addProddableBlock(oc, addr, symtab_i->Value);
1435 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1438 if (addr != NULL ) {
1439 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1440 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1441 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1442 ASSERT(i >= 0 && i < oc->n_symbols);
1443 /* cstring_from_COFF_symbol_name always succeeds. */
1444 oc->symbols[i] = sname;
1445 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1449 "IGNORING symbol %d\n"
1453 printName ( symtab_i->Name, strtab );
1462 (Int32)(symtab_i->SectionNumber),
1463 (UInt32)symtab_i->Type,
1464 (UInt32)symtab_i->StorageClass,
1465 (UInt32)symtab_i->NumberOfAuxSymbols
1470 i += symtab_i->NumberOfAuxSymbols;
1479 ocResolve_PEi386 ( ObjectCode* oc )
1482 COFF_section* sectab;
1483 COFF_symbol* symtab;
1493 /* ToDo: should be variable-sized? But is at least safe in the
1494 sense of buffer-overrun-proof. */
1496 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1498 hdr = (COFF_header*)(oc->image);
1499 sectab = (COFF_section*) (
1500 ((UChar*)(oc->image))
1501 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1503 symtab = (COFF_symbol*) (
1504 ((UChar*)(oc->image))
1505 + hdr->PointerToSymbolTable
1507 strtab = ((UChar*)(oc->image))
1508 + hdr->PointerToSymbolTable
1509 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1511 for (i = 0; i < hdr->NumberOfSections; i++) {
1512 COFF_section* sectab_i
1514 myindex ( sizeof_COFF_section, sectab, i );
1517 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1520 /* Ignore sections called which contain stabs debugging
1522 if (0 == strcmp(".stab", sectab_i->Name)
1523 || 0 == strcmp(".stabstr", sectab_i->Name))
1526 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1527 /* If the relocation field (a short) has overflowed, the
1528 * real count can be found in the first reloc entry.
1529 * The PE spec (Feb 99 version) doesn't really cover this,
1530 * but as always header files provide the final word on
1531 * details like this (cf. WinNT.h).
1533 COFF_reloc* rel = (COFF_reloc*)
1534 myindex ( sizeof_COFF_reloc, reltab, 0 );
1535 noRelocs = rel->VirtualAddress;
1536 fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
1539 noRelocs = sectab_i->NumberOfRelocations;
1544 for (; j < noRelocs; j++) {
1546 COFF_reloc* reltab_j
1548 myindex ( sizeof_COFF_reloc, reltab, j );
1550 /* the location to patch */
1552 ((UChar*)(oc->image))
1553 + (sectab_i->PointerToRawData
1554 + reltab_j->VirtualAddress
1555 - sectab_i->VirtualAddress )
1557 /* the existing contents of pP */
1559 /* the symbol to connect to */
1560 sym = (COFF_symbol*)
1561 myindex ( sizeof_COFF_symbol,
1562 symtab, reltab_j->SymbolTableIndex );
1565 "reloc sec %2d num %3d: type 0x%-4x "
1566 "vaddr 0x%-8x name `",
1568 (UInt32)reltab_j->Type,
1569 reltab_j->VirtualAddress );
1570 printName ( sym->Name, strtab );
1571 fprintf ( stderr, "'\n" ));
1573 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1574 COFF_section* section_sym
1575 = findPEi386SectionCalled ( oc, sym->Name );
1577 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1580 S = ((UInt32)(oc->image))
1581 + (section_sym->PointerToRawData
1584 copyName ( sym->Name, strtab, symbol, 1000-1 );
1585 (void*)S = lookupLocalSymbol( oc, symbol );
1586 if ((void*)S != NULL) goto foundit;
1587 (void*)S = lookupSymbol( symbol );
1588 if ((void*)S != NULL) goto foundit;
1589 zapTrailingAtSign ( symbol );
1590 (void*)S = lookupLocalSymbol( oc, symbol );
1591 if ((void*)S != NULL) goto foundit;
1592 (void*)S = lookupSymbol( symbol );
1593 if ((void*)S != NULL) goto foundit;
1594 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
1598 checkProddableBlock(oc, pP);
1599 switch (reltab_j->Type) {
1600 case MYIMAGE_REL_I386_DIR32:
1603 case MYIMAGE_REL_I386_REL32:
1604 /* Tricky. We have to insert a displacement at
1605 pP which, when added to the PC for the _next_
1606 insn, gives the address of the target (S).
1607 Problem is to know the address of the next insn
1608 when we only know pP. We assume that this
1609 literal field is always the last in the insn,
1610 so that the address of the next insn is pP+4
1611 -- hence the constant 4.
1612 Also I don't know if A should be added, but so
1613 far it has always been zero.
1616 *pP = S - ((UInt32)pP) - 4;
1619 belch("%s: unhandled PEi386 relocation type %d",
1620 oc->fileName, reltab_j->Type);
1627 IF_DEBUG(linker, belch("completed %s", oc->fileName));
1631 #endif /* defined(OBJFORMAT_PEi386) */
1634 /* --------------------------------------------------------------------------
1636 * ------------------------------------------------------------------------*/
1638 #if defined(OBJFORMAT_ELF)
1643 #if defined(sparc_TARGET_ARCH)
1644 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
1645 #elif defined(i386_TARGET_ARCH)
1646 # define ELF_TARGET_386 /* Used inside <elf.h> */
1648 /* There is a similar case for IA64 in the Solaris2 headers if this
1649 * ever becomes relevant.
1656 findElfSection ( void* objImage, Elf32_Word sh_type )
1659 char* ehdrC = (char*)objImage;
1660 Elf32_Ehdr* ehdr = (Elf32_Ehdr*)ehdrC;
1661 Elf32_Shdr* shdr = (Elf32_Shdr*)(ehdrC + ehdr->e_shoff);
1662 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1664 for (i = 0; i < ehdr->e_shnum; i++) {
1665 if (shdr[i].sh_type == sh_type
1666 /* Ignore the section header's string table. */
1667 && i != ehdr->e_shstrndx
1668 /* Ignore string tables named .stabstr, as they contain
1670 && 0 != strncmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
1672 ptr = ehdrC + shdr[i].sh_offset;
1681 ocVerifyImage_ELF ( ObjectCode* oc )
1685 int i, j, nent, nstrtab, nsymtabs;
1689 char* ehdrC = (char*)(oc->image);
1690 Elf32_Ehdr* ehdr = ( Elf32_Ehdr*)ehdrC;
1692 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
1693 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
1694 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
1695 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
1696 belch("%s: not an ELF header", oc->fileName);
1699 IF_DEBUG(linker,belch( "Is an ELF header" ));
1701 if (ehdr->e_ident[EI_CLASS] != ELFCLASS32) {
1702 belch("%s: not 32 bit ELF", oc->fileName);
1706 IF_DEBUG(linker,belch( "Is 32 bit ELF" ));
1708 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
1709 IF_DEBUG(linker,belch( "Is little-endian" ));
1711 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
1712 IF_DEBUG(linker,belch( "Is big-endian" ));
1714 belch("%s: unknown endiannness", oc->fileName);
1718 if (ehdr->e_type != ET_REL) {
1719 belch("%s: not a relocatable object (.o) file", oc->fileName);
1722 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
1724 IF_DEBUG(linker,belch( "Architecture is " ));
1725 switch (ehdr->e_machine) {
1726 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
1727 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
1728 default: IF_DEBUG(linker,belch( "unknown" ));
1729 belch("%s: unknown architecture", oc->fileName);
1733 IF_DEBUG(linker,belch(
1734 "\nSection header table: start %d, n_entries %d, ent_size %d",
1735 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
1737 ASSERT (ehdr->e_shentsize == sizeof(Elf32_Shdr));
1739 shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1741 if (ehdr->e_shstrndx == SHN_UNDEF) {
1742 belch("%s: no section header string table", oc->fileName);
1745 IF_DEBUG(linker,belch( "Section header string table is section %d",
1747 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1750 for (i = 0; i < ehdr->e_shnum; i++) {
1751 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
1752 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
1753 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
1754 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
1755 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
1756 ehdrC + shdr[i].sh_offset,
1757 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
1759 if (shdr[i].sh_type == SHT_REL) {
1760 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
1761 } else if (shdr[i].sh_type == SHT_RELA) {
1762 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
1764 IF_DEBUG(linker,fprintf(stderr," "));
1767 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
1771 IF_DEBUG(linker,belch( "\nString tables" ));
1774 for (i = 0; i < ehdr->e_shnum; i++) {
1775 if (shdr[i].sh_type == SHT_STRTAB
1776 /* Ignore the section header's string table. */
1777 && i != ehdr->e_shstrndx
1778 /* Ignore string tables named .stabstr, as they contain
1780 && 0 != strncmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
1782 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
1783 strtab = ehdrC + shdr[i].sh_offset;
1788 belch("%s: no string tables, or too many", oc->fileName);
1793 IF_DEBUG(linker,belch( "\nSymbol tables" ));
1794 for (i = 0; i < ehdr->e_shnum; i++) {
1795 if (shdr[i].sh_type != SHT_SYMTAB) continue;
1796 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
1798 stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1799 nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1800 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
1802 shdr[i].sh_size % sizeof(Elf32_Sym)
1804 if (0 != shdr[i].sh_size % sizeof(Elf32_Sym)) {
1805 belch("%s: non-integral number of symbol table entries", oc->fileName);
1808 for (j = 0; j < nent; j++) {
1809 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
1810 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
1811 (int)stab[j].st_shndx,
1812 (int)stab[j].st_size,
1813 (char*)stab[j].st_value ));
1815 IF_DEBUG(linker,fprintf(stderr, "type=" ));
1816 switch (ELF32_ST_TYPE(stab[j].st_info)) {
1817 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
1818 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
1819 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
1820 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
1821 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
1822 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
1824 IF_DEBUG(linker,fprintf(stderr, " " ));
1826 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
1827 switch (ELF32_ST_BIND(stab[j].st_info)) {
1828 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
1829 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
1830 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
1831 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
1833 IF_DEBUG(linker,fprintf(stderr, " " ));
1835 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
1839 if (nsymtabs == 0) {
1840 belch("%s: didn't find any symbol tables", oc->fileName);
1849 ocGetNames_ELF ( ObjectCode* oc )
1854 char* ehdrC = (char*)(oc->image);
1855 Elf32_Ehdr* ehdr = (Elf32_Ehdr*)ehdrC;
1856 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
1857 Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1859 ASSERT(symhash != NULL);
1862 belch("%s: no strtab", oc->fileName);
1867 for (i = 0; i < ehdr->e_shnum; i++) {
1868 /* Figure out what kind of section it is. Logic derived from
1869 Figure 1.14 ("Special Sections") of the ELF document
1870 ("Portable Formats Specification, Version 1.1"). */
1871 Elf32_Shdr hdr = shdr[i];
1872 SectionKind kind = SECTIONKIND_OTHER;
1875 if (hdr.sh_type == SHT_PROGBITS
1876 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
1877 /* .text-style section */
1878 kind = SECTIONKIND_CODE_OR_RODATA;
1881 if (hdr.sh_type == SHT_PROGBITS
1882 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
1883 /* .data-style section */
1884 kind = SECTIONKIND_RWDATA;
1887 if (hdr.sh_type == SHT_PROGBITS
1888 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
1889 /* .rodata-style section */
1890 kind = SECTIONKIND_CODE_OR_RODATA;
1893 if (hdr.sh_type == SHT_NOBITS
1894 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
1895 /* .bss-style section */
1896 kind = SECTIONKIND_RWDATA;
1900 if (is_bss && shdr[i].sh_size > 0) {
1901 /* This is a non-empty .bss section. Allocate zeroed space for
1902 it, and set its .sh_offset field such that
1903 ehdrC + .sh_offset == addr_of_zeroed_space. */
1904 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
1905 "ocGetNames_ELF(BSS)");
1906 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
1908 fprintf(stderr, "BSS section at 0x%x, size %d\n",
1909 zspace, shdr[i].sh_size);
1913 /* fill in the section info */
1914 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
1915 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
1916 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0)
1917 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
1919 if (shdr[i].sh_type != SHT_SYMTAB) continue;
1921 /* copy stuff into this module's object symbol table */
1922 stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1923 nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1925 oc->n_symbols = nent;
1926 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1927 "ocGetNames_ELF(oc->symbols)");
1929 for (j = 0; j < nent; j++) {
1931 char isLocal = FALSE; /* avoids uninit-var warning */
1933 char* nm = strtab + stab[j].st_name;
1934 int secno = stab[j].st_shndx;
1936 /* Figure out if we want to add it; if so, set ad to its
1937 address. Otherwise leave ad == NULL. */
1939 if (secno == SHN_COMMON) {
1941 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
1943 fprintf(stderr, "COMMON symbol, size %d name %s\n",
1944 stab[j].st_size, nm);
1946 /* Pointless to do addProddableBlock() for this area,
1947 since the linker should never poke around in it. */
1950 if ( ( ELF32_ST_BIND(stab[j].st_info)==STB_GLOBAL
1951 || ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL
1953 /* and not an undefined symbol */
1954 && stab[j].st_shndx != SHN_UNDEF
1955 /* and not in a "special section" */
1956 && stab[j].st_shndx < SHN_LORESERVE
1958 /* and it's a not a section or string table or anything silly */
1959 ( ELF32_ST_TYPE(stab[j].st_info)==STT_FUNC ||
1960 ELF32_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
1961 ELF32_ST_TYPE(stab[j].st_info)==STT_NOTYPE
1964 /* Section 0 is the undefined section, hence > and not >=. */
1965 ASSERT(secno > 0 && secno < ehdr->e_shnum);
1967 if (shdr[secno].sh_type == SHT_NOBITS) {
1968 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
1969 stab[j].st_size, stab[j].st_value, nm);
1972 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
1973 if (ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL) {
1976 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
1977 ad, oc->fileName, nm ));
1982 /* And the decision is ... */
1986 oc->symbols[j] = nm;
1989 /* Ignore entirely. */
1991 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
1995 IF_DEBUG(linker,belch( "skipping `%s'",
1996 strtab + stab[j].st_name ));
1999 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2000 (int)ELF32_ST_BIND(stab[j].st_info),
2001 (int)ELF32_ST_TYPE(stab[j].st_info),
2002 (int)stab[j].st_shndx,
2003 strtab + stab[j].st_name
2006 oc->symbols[j] = NULL;
2016 /* Do ELF relocations which lack an explicit addend. All x86-linux
2017 relocations appear to be of this form. */
2019 do_Elf32_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2020 Elf32_Shdr* shdr, int shnum,
2021 Elf32_Sym* stab, char* strtab )
2026 Elf32_Rel* rtab = (Elf32_Rel*) (ehdrC + shdr[shnum].sh_offset);
2027 int nent = shdr[shnum].sh_size / sizeof(Elf32_Rel);
2028 int target_shndx = shdr[shnum].sh_info;
2029 int symtab_shndx = shdr[shnum].sh_link;
2030 stab = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2031 targ = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2032 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2033 target_shndx, symtab_shndx ));
2034 for (j = 0; j < nent; j++) {
2035 Elf32_Addr offset = rtab[j].r_offset;
2036 Elf32_Word info = rtab[j].r_info;
2038 Elf32_Addr P = ((Elf32_Addr)targ) + offset;
2039 Elf32_Word* pP = (Elf32_Word*)P;
2043 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2044 j, (void*)offset, (void*)info ));
2046 IF_DEBUG(linker,belch( " ZERO" ));
2049 Elf32_Sym sym = stab[ELF32_R_SYM(info)];
2050 /* First see if it is a local symbol. */
2051 if (ELF32_ST_BIND(sym.st_info) == STB_LOCAL) {
2052 /* Yes, so we can get the address directly from the ELF symbol
2054 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2056 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2057 + stab[ELF32_R_SYM(info)].st_value);
2060 /* No, so look up the name in our global table. */
2061 symbol = strtab + sym.st_name;
2062 (void*)S = lookupSymbol( symbol );
2065 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2068 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2070 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2071 (void*)P, (void*)S, (void*)A ));
2072 checkProddableBlock ( oc, pP );
2073 switch (ELF32_R_TYPE(info)) {
2074 # ifdef i386_TARGET_ARCH
2075 case R_386_32: *pP = S + A; break;
2076 case R_386_PC32: *pP = S + A - P; break;
2079 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2080 oc->fileName, ELF32_R_TYPE(info));
2089 /* Do ELF relocations for which explicit addends are supplied.
2090 sparc-solaris relocations appear to be of this form. */
2092 do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2093 Elf32_Shdr* shdr, int shnum,
2094 Elf32_Sym* stab, char* strtab )
2099 Elf32_Rela* rtab = (Elf32_Rela*) (ehdrC + shdr[shnum].sh_offset);
2100 int nent = shdr[shnum].sh_size / sizeof(Elf32_Rela);
2101 int target_shndx = shdr[shnum].sh_info;
2102 int symtab_shndx = shdr[shnum].sh_link;
2103 stab = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2104 targ = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2105 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2106 target_shndx, symtab_shndx ));
2107 for (j = 0; j < nent; j++) {
2108 Elf32_Addr offset = rtab[j].r_offset;
2109 Elf32_Word info = rtab[j].r_info;
2110 Elf32_Sword addend = rtab[j].r_addend;
2111 Elf32_Addr P = ((Elf32_Addr)targ) + offset;
2112 Elf32_Addr A = addend; /* Do not delete this; it is used on sparc. */
2114 # if defined(sparc_TARGET_ARCH)
2115 /* This #ifdef only serves to avoid unused-var warnings. */
2116 Elf32_Word* pP = (Elf32_Word*)P;
2120 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2121 j, (void*)offset, (void*)info,
2124 IF_DEBUG(linker,belch( " ZERO" ));
2127 Elf32_Sym sym = stab[ELF32_R_SYM(info)];
2128 /* First see if it is a local symbol. */
2129 if (ELF32_ST_BIND(sym.st_info) == STB_LOCAL) {
2130 /* Yes, so we can get the address directly from the ELF symbol
2132 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2134 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2135 + stab[ELF32_R_SYM(info)].st_value);
2138 /* No, so look up the name in our global table. */
2139 symbol = strtab + sym.st_name;
2140 (void*)S = lookupSymbol( symbol );
2143 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2147 fprintf ( stderr, "S %p A %p S+A %p S+A-P %p\n",S,A,S+A,S+A-P);
2150 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2152 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2153 (void*)P, (void*)S, (void*)A ));
2154 checkProddableBlock ( oc, (void*)P );
2155 switch (ELF32_R_TYPE(info)) {
2156 # if defined(sparc_TARGET_ARCH)
2157 case R_SPARC_WDISP30:
2158 w1 = *pP & 0xC0000000;
2159 w2 = (Elf32_Word)((S + A - P) >> 2);
2160 ASSERT((w2 & 0xC0000000) == 0);
2165 w1 = *pP & 0xFFC00000;
2166 w2 = (Elf32_Word)((S + A) >> 10);
2167 ASSERT((w2 & 0xFFC00000) == 0);
2173 w2 = (Elf32_Word)((S + A) & 0x3FF);
2174 ASSERT((w2 & ~0x3FF) == 0);
2178 /* According to the Sun documentation:
2180 This relocation type resembles R_SPARC_32, except it refers to an
2181 unaligned word. That is, the word to be relocated must be treated
2182 as four separate bytes with arbitrary alignment, not as a word
2183 aligned according to the architecture requirements.
2185 (JRS: which means that freeloading on the R_SPARC_32 case
2186 is probably wrong, but hey ...)
2190 w2 = (Elf32_Word)(S + A);
2195 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2196 oc->fileName, ELF32_R_TYPE(info));
2206 ocResolve_ELF ( ObjectCode* oc )
2210 Elf32_Sym* stab = NULL;
2211 char* ehdrC = (char*)(oc->image);
2212 Elf32_Ehdr* ehdr = (Elf32_Ehdr*) ehdrC;
2213 Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
2214 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2216 /* first find "the" symbol table */
2217 stab = (Elf32_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2219 /* also go find the string table */
2220 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2222 if (stab == NULL || strtab == NULL) {
2223 belch("%s: can't find string or symbol table", oc->fileName);
2227 /* Process the relocation sections. */
2228 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2230 /* Skip sections called ".rel.stab". These appear to contain
2231 relocation entries that, when done, make the stabs debugging
2232 info point at the right places. We ain't interested in all
2234 if (0 == strncmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2237 if (shdr[shnum].sh_type == SHT_REL ) {
2238 ok = do_Elf32_Rel_relocations ( oc, ehdrC, shdr,
2239 shnum, stab, strtab );
2243 if (shdr[shnum].sh_type == SHT_RELA) {
2244 ok = do_Elf32_Rela_relocations ( oc, ehdrC, shdr,
2245 shnum, stab, strtab );
2251 /* Free the local symbol table; we won't need it again. */
2252 freeHashTable(oc->lochash, NULL);