1 /* -----------------------------------------------------------------------------
2 * $Id: Linker.c,v 1.83 2002/02/12 15:17:22 simonmar 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_GHCziPrim) \
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;
861 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
862 start, ((char*)end)-1, end - start + 1, kind );
868 /* --------------------------------------------------------------------------
869 * PEi386 specifics (Win32 targets)
870 * ------------------------------------------------------------------------*/
872 /* The information for this linker comes from
873 Microsoft Portable Executable
874 and Common Object File Format Specification
875 revision 5.1 January 1998
876 which SimonM says comes from the MS Developer Network CDs.
878 It can be found there (on older CDs), but can also be found
881 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
883 (this is Rev 6.0 from February 1999).
885 Things move, so if that fails, try searching for it via
887 http://www.google.com/search?q=PE+COFF+specification
889 The ultimate reference for the PE format is the Winnt.h
890 header file that comes with the Platform SDKs; as always,
891 implementations will drift wrt their documentation.
893 A good background article on the PE format is Matt Pietrek's
894 March 1994 article in Microsoft System Journal (MSJ)
895 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
896 Win32 Portable Executable File Format." The info in there
897 has recently been updated in a two part article in
898 MSDN magazine, issues Feb and March 2002,
899 "Inside Windows: An In-Depth Look into the Win32 Portable
900 Executable File Format"
902 John Levine's book "Linkers and Loaders" contains useful
907 #if defined(OBJFORMAT_PEi386)
911 typedef unsigned char UChar;
912 typedef unsigned short UInt16;
913 typedef unsigned int UInt32;
920 UInt16 NumberOfSections;
921 UInt32 TimeDateStamp;
922 UInt32 PointerToSymbolTable;
923 UInt32 NumberOfSymbols;
924 UInt16 SizeOfOptionalHeader;
925 UInt16 Characteristics;
929 #define sizeof_COFF_header 20
936 UInt32 VirtualAddress;
937 UInt32 SizeOfRawData;
938 UInt32 PointerToRawData;
939 UInt32 PointerToRelocations;
940 UInt32 PointerToLinenumbers;
941 UInt16 NumberOfRelocations;
942 UInt16 NumberOfLineNumbers;
943 UInt32 Characteristics;
947 #define sizeof_COFF_section 40
954 UInt16 SectionNumber;
957 UChar NumberOfAuxSymbols;
961 #define sizeof_COFF_symbol 18
966 UInt32 VirtualAddress;
967 UInt32 SymbolTableIndex;
972 #define sizeof_COFF_reloc 10
975 /* From PE spec doc, section 3.3.2 */
976 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
977 windows.h -- for the same purpose, but I want to know what I'm
979 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
980 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
981 #define MYIMAGE_FILE_DLL 0x2000
982 #define MYIMAGE_FILE_SYSTEM 0x1000
983 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
984 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
985 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
987 /* From PE spec doc, section 5.4.2 and 5.4.4 */
988 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
989 #define MYIMAGE_SYM_CLASS_STATIC 3
990 #define MYIMAGE_SYM_UNDEFINED 0
992 /* From PE spec doc, section 4.1 */
993 #define MYIMAGE_SCN_CNT_CODE 0x00000020
994 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
995 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
997 /* From PE spec doc, section 5.2.1 */
998 #define MYIMAGE_REL_I386_DIR32 0x0006
999 #define MYIMAGE_REL_I386_REL32 0x0014
1002 /* We use myindex to calculate array addresses, rather than
1003 simply doing the normal subscript thing. That's because
1004 some of the above structs have sizes which are not
1005 a whole number of words. GCC rounds their sizes up to a
1006 whole number of words, which means that the address calcs
1007 arising from using normal C indexing or pointer arithmetic
1008 are just plain wrong. Sigh.
1011 myindex ( int scale, void* base, int index )
1014 ((UChar*)base) + scale * index;
1019 printName ( UChar* name, UChar* strtab )
1021 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1022 UInt32 strtab_offset = * (UInt32*)(name+4);
1023 fprintf ( stderr, "%s", strtab + strtab_offset );
1026 for (i = 0; i < 8; i++) {
1027 if (name[i] == 0) break;
1028 fprintf ( stderr, "%c", name[i] );
1035 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1037 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1038 UInt32 strtab_offset = * (UInt32*)(name+4);
1039 strncpy ( dst, strtab+strtab_offset, dstSize );
1045 if (name[i] == 0) break;
1055 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1058 /* If the string is longer than 8 bytes, look in the
1059 string table for it -- this will be correctly zero terminated.
1061 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1062 UInt32 strtab_offset = * (UInt32*)(name+4);
1063 return ((UChar*)strtab) + strtab_offset;
1065 /* Otherwise, if shorter than 8 bytes, return the original,
1066 which by defn is correctly terminated.
1068 if (name[7]==0) return name;
1069 /* The annoying case: 8 bytes. Copy into a temporary
1070 (which is never freed ...)
1072 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1074 strncpy(newstr,name,8);
1080 /* Just compares the short names (first 8 chars) */
1081 static COFF_section *
1082 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1086 = (COFF_header*)(oc->image);
1087 COFF_section* sectab
1089 ((UChar*)(oc->image))
1090 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1092 for (i = 0; i < hdr->NumberOfSections; i++) {
1095 COFF_section* section_i
1097 myindex ( sizeof_COFF_section, sectab, i );
1098 n1 = (UChar*) &(section_i->Name);
1100 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1101 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1102 n1[6]==n2[6] && n1[7]==n2[7])
1111 zapTrailingAtSign ( UChar* sym )
1113 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1115 if (sym[0] == 0) return;
1117 while (sym[i] != 0) i++;
1120 while (j > 0 && my_isdigit(sym[j])) j--;
1121 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1127 ocVerifyImage_PEi386 ( ObjectCode* oc )
1132 COFF_section* sectab;
1133 COFF_symbol* symtab;
1135 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1136 hdr = (COFF_header*)(oc->image);
1137 sectab = (COFF_section*) (
1138 ((UChar*)(oc->image))
1139 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1141 symtab = (COFF_symbol*) (
1142 ((UChar*)(oc->image))
1143 + hdr->PointerToSymbolTable
1145 strtab = ((UChar*)symtab)
1146 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1148 if (hdr->Machine != 0x14c) {
1149 belch("Not x86 PEi386");
1152 if (hdr->SizeOfOptionalHeader != 0) {
1153 belch("PEi386 with nonempty optional header");
1156 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1157 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1158 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1159 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1160 belch("Not a PEi386 object file");
1163 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1164 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1165 belch("Invalid PEi386 word size or endiannness: %d",
1166 (int)(hdr->Characteristics));
1169 /* If the string table size is way crazy, this might indicate that
1170 there are more than 64k relocations, despite claims to the
1171 contrary. Hence this test. */
1172 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1174 if ( (*(UInt32*)strtab) > 600000 ) {
1175 /* Note that 600k has no special significance other than being
1176 big enough to handle the almost-2MB-sized lumps that
1177 constitute HSwin32*.o. */
1178 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1183 /* No further verification after this point; only debug printing. */
1185 IF_DEBUG(linker, i=1);
1186 if (i == 0) return 1;
1189 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1191 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1193 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1195 fprintf ( stderr, "\n" );
1197 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1199 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1201 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1203 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1205 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1207 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1209 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1211 /* Print the section table. */
1212 fprintf ( stderr, "\n" );
1213 for (i = 0; i < hdr->NumberOfSections; i++) {
1215 COFF_section* sectab_i
1217 myindex ( sizeof_COFF_section, sectab, i );
1224 printName ( sectab_i->Name, strtab );
1234 sectab_i->VirtualSize,
1235 sectab_i->VirtualAddress,
1236 sectab_i->SizeOfRawData,
1237 sectab_i->PointerToRawData,
1238 sectab_i->NumberOfRelocations,
1239 sectab_i->PointerToRelocations,
1240 sectab_i->PointerToRawData
1242 reltab = (COFF_reloc*) (
1243 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1246 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1247 /* If the relocation field (a short) has overflowed, the
1248 * real count can be found in the first reloc entry.
1250 * See Section 4.1 (last para) of the PE spec (rev6.0).
1252 COFF_reloc* rel = (COFF_reloc*)
1253 myindex ( sizeof_COFF_reloc, reltab, 0 );
1254 noRelocs = rel->VirtualAddress;
1257 noRelocs = sectab_i->NumberOfRelocations;
1261 for (; j < noRelocs; j++) {
1263 COFF_reloc* rel = (COFF_reloc*)
1264 myindex ( sizeof_COFF_reloc, reltab, j );
1266 " type 0x%-4x vaddr 0x%-8x name `",
1268 rel->VirtualAddress );
1269 sym = (COFF_symbol*)
1270 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1271 /* Hmm..mysterious looking offset - what's it for? SOF */
1272 printName ( sym->Name, strtab -10 );
1273 fprintf ( stderr, "'\n" );
1276 fprintf ( stderr, "\n" );
1278 fprintf ( stderr, "\n" );
1279 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1280 fprintf ( stderr, "---START of string table---\n");
1281 for (i = 4; i < *(Int32*)strtab; i++) {
1283 fprintf ( stderr, "\n"); else
1284 fprintf( stderr, "%c", strtab[i] );
1286 fprintf ( stderr, "--- END of string table---\n");
1288 fprintf ( stderr, "\n" );
1291 COFF_symbol* symtab_i;
1292 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1293 symtab_i = (COFF_symbol*)
1294 myindex ( sizeof_COFF_symbol, symtab, i );
1300 printName ( symtab_i->Name, strtab );
1309 (Int32)(symtab_i->SectionNumber),
1310 (UInt32)symtab_i->Type,
1311 (UInt32)symtab_i->StorageClass,
1312 (UInt32)symtab_i->NumberOfAuxSymbols
1314 i += symtab_i->NumberOfAuxSymbols;
1318 fprintf ( stderr, "\n" );
1324 ocGetNames_PEi386 ( ObjectCode* oc )
1327 COFF_section* sectab;
1328 COFF_symbol* symtab;
1335 hdr = (COFF_header*)(oc->image);
1336 sectab = (COFF_section*) (
1337 ((UChar*)(oc->image))
1338 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1340 symtab = (COFF_symbol*) (
1341 ((UChar*)(oc->image))
1342 + hdr->PointerToSymbolTable
1344 strtab = ((UChar*)(oc->image))
1345 + hdr->PointerToSymbolTable
1346 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1348 /* Allocate space for any (local, anonymous) .bss sections. */
1350 for (i = 0; i < hdr->NumberOfSections; i++) {
1352 COFF_section* sectab_i
1354 myindex ( sizeof_COFF_section, sectab, i );
1355 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1356 if (sectab_i->VirtualSize == 0) continue;
1357 /* This is a non-empty .bss section. Allocate zeroed space for
1358 it, and set its PointerToRawData field such that oc->image +
1359 PointerToRawData == addr_of_zeroed_space. */
1360 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1361 "ocGetNames_PEi386(anonymous bss)");
1362 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1363 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1364 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1367 /* Copy section information into the ObjectCode. */
1369 for (i = 0; i < hdr->NumberOfSections; i++) {
1375 = SECTIONKIND_OTHER;
1376 COFF_section* sectab_i
1378 myindex ( sizeof_COFF_section, sectab, i );
1379 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1382 /* I'm sure this is the Right Way to do it. However, the
1383 alternative of testing the sectab_i->Name field seems to
1384 work ok with Cygwin.
1386 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1387 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1388 kind = SECTIONKIND_CODE_OR_RODATA;
1391 if (0==strcmp(".text",sectab_i->Name) ||
1392 0==strcmp(".rodata",sectab_i->Name))
1393 kind = SECTIONKIND_CODE_OR_RODATA;
1394 if (0==strcmp(".data",sectab_i->Name) ||
1395 0==strcmp(".bss",sectab_i->Name))
1396 kind = SECTIONKIND_RWDATA;
1398 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1399 sz = sectab_i->SizeOfRawData;
1400 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1402 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1403 end = start + sz - 1;
1405 if (kind == SECTIONKIND_OTHER
1406 /* Ignore sections called which contain stabs debugging
1408 && 0 != strcmp(".stab", sectab_i->Name)
1409 && 0 != strcmp(".stabstr", sectab_i->Name)
1411 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1415 if (kind != SECTIONKIND_OTHER && end >= start) {
1416 addSection(oc, kind, start, end);
1417 addProddableBlock(oc, start, end - start + 1);
1421 /* Copy exported symbols into the ObjectCode. */
1423 oc->n_symbols = hdr->NumberOfSymbols;
1424 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1425 "ocGetNames_PEi386(oc->symbols)");
1426 /* Call me paranoid; I don't care. */
1427 for (i = 0; i < oc->n_symbols; i++)
1428 oc->symbols[i] = NULL;
1432 COFF_symbol* symtab_i;
1433 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1434 symtab_i = (COFF_symbol*)
1435 myindex ( sizeof_COFF_symbol, symtab, i );
1439 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1440 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1441 /* This symbol is global and defined, viz, exported */
1442 /* for MYIMAGE_SYMCLASS_EXTERNAL
1443 && !MYIMAGE_SYM_UNDEFINED,
1444 the address of the symbol is:
1445 address of relevant section + offset in section
1447 COFF_section* sectabent
1448 = (COFF_section*) myindex ( sizeof_COFF_section,
1450 symtab_i->SectionNumber-1 );
1451 addr = ((UChar*)(oc->image))
1452 + (sectabent->PointerToRawData
1456 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1457 && symtab_i->Value > 0) {
1458 /* This symbol isn't in any section at all, ie, global bss.
1459 Allocate zeroed space for it. */
1460 addr = stgCallocBytes(1, symtab_i->Value,
1461 "ocGetNames_PEi386(non-anonymous bss)");
1462 addSection(oc, SECTIONKIND_RWDATA, addr,
1463 ((UChar*)addr) + symtab_i->Value - 1);
1464 addProddableBlock(oc, addr, symtab_i->Value);
1465 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1468 if (addr != NULL ) {
1469 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1470 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1471 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1472 ASSERT(i >= 0 && i < oc->n_symbols);
1473 /* cstring_from_COFF_symbol_name always succeeds. */
1474 oc->symbols[i] = sname;
1475 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1479 "IGNORING symbol %d\n"
1483 printName ( symtab_i->Name, strtab );
1492 (Int32)(symtab_i->SectionNumber),
1493 (UInt32)symtab_i->Type,
1494 (UInt32)symtab_i->StorageClass,
1495 (UInt32)symtab_i->NumberOfAuxSymbols
1500 i += symtab_i->NumberOfAuxSymbols;
1509 ocResolve_PEi386 ( ObjectCode* oc )
1512 COFF_section* sectab;
1513 COFF_symbol* symtab;
1523 /* ToDo: should be variable-sized? But is at least safe in the
1524 sense of buffer-overrun-proof. */
1526 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1528 hdr = (COFF_header*)(oc->image);
1529 sectab = (COFF_section*) (
1530 ((UChar*)(oc->image))
1531 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1533 symtab = (COFF_symbol*) (
1534 ((UChar*)(oc->image))
1535 + hdr->PointerToSymbolTable
1537 strtab = ((UChar*)(oc->image))
1538 + hdr->PointerToSymbolTable
1539 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1541 for (i = 0; i < hdr->NumberOfSections; i++) {
1542 COFF_section* sectab_i
1544 myindex ( sizeof_COFF_section, sectab, i );
1547 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1550 /* Ignore sections called which contain stabs debugging
1552 if (0 == strcmp(".stab", sectab_i->Name)
1553 || 0 == strcmp(".stabstr", sectab_i->Name))
1556 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1557 /* If the relocation field (a short) has overflowed, the
1558 * real count can be found in the first reloc entry.
1560 * See Section 4.1 (last para) of the PE spec (rev6.0).
1562 COFF_reloc* rel = (COFF_reloc*)
1563 myindex ( sizeof_COFF_reloc, reltab, 0 );
1564 noRelocs = rel->VirtualAddress;
1565 fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
1568 noRelocs = sectab_i->NumberOfRelocations;
1573 for (; j < noRelocs; j++) {
1575 COFF_reloc* reltab_j
1577 myindex ( sizeof_COFF_reloc, reltab, j );
1579 /* the location to patch */
1581 ((UChar*)(oc->image))
1582 + (sectab_i->PointerToRawData
1583 + reltab_j->VirtualAddress
1584 - sectab_i->VirtualAddress )
1586 /* the existing contents of pP */
1588 /* the symbol to connect to */
1589 sym = (COFF_symbol*)
1590 myindex ( sizeof_COFF_symbol,
1591 symtab, reltab_j->SymbolTableIndex );
1594 "reloc sec %2d num %3d: type 0x%-4x "
1595 "vaddr 0x%-8x name `",
1597 (UInt32)reltab_j->Type,
1598 reltab_j->VirtualAddress );
1599 printName ( sym->Name, strtab );
1600 fprintf ( stderr, "'\n" ));
1602 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1603 COFF_section* section_sym
1604 = findPEi386SectionCalled ( oc, sym->Name );
1606 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1609 S = ((UInt32)(oc->image))
1610 + (section_sym->PointerToRawData
1613 copyName ( sym->Name, strtab, symbol, 1000-1 );
1614 (void*)S = lookupLocalSymbol( oc, symbol );
1615 if ((void*)S != NULL) goto foundit;
1616 (void*)S = lookupSymbol( symbol );
1617 if ((void*)S != NULL) goto foundit;
1618 zapTrailingAtSign ( symbol );
1619 (void*)S = lookupLocalSymbol( oc, symbol );
1620 if ((void*)S != NULL) goto foundit;
1621 (void*)S = lookupSymbol( symbol );
1622 if ((void*)S != NULL) goto foundit;
1623 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
1627 checkProddableBlock(oc, pP);
1628 switch (reltab_j->Type) {
1629 case MYIMAGE_REL_I386_DIR32:
1632 case MYIMAGE_REL_I386_REL32:
1633 /* Tricky. We have to insert a displacement at
1634 pP which, when added to the PC for the _next_
1635 insn, gives the address of the target (S).
1636 Problem is to know the address of the next insn
1637 when we only know pP. We assume that this
1638 literal field is always the last in the insn,
1639 so that the address of the next insn is pP+4
1640 -- hence the constant 4.
1641 Also I don't know if A should be added, but so
1642 far it has always been zero.
1645 *pP = S - ((UInt32)pP) - 4;
1648 belch("%s: unhandled PEi386 relocation type %d",
1649 oc->fileName, reltab_j->Type);
1656 IF_DEBUG(linker, belch("completed %s", oc->fileName));
1660 #endif /* defined(OBJFORMAT_PEi386) */
1663 /* --------------------------------------------------------------------------
1665 * ------------------------------------------------------------------------*/
1667 #if defined(OBJFORMAT_ELF)
1672 #if defined(sparc_TARGET_ARCH)
1673 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
1674 #elif defined(i386_TARGET_ARCH)
1675 # define ELF_TARGET_386 /* Used inside <elf.h> */
1677 /* There is a similar case for IA64 in the Solaris2 headers if this
1678 * ever becomes relevant.
1685 findElfSection ( void* objImage, Elf32_Word sh_type )
1688 char* ehdrC = (char*)objImage;
1689 Elf32_Ehdr* ehdr = (Elf32_Ehdr*)ehdrC;
1690 Elf32_Shdr* shdr = (Elf32_Shdr*)(ehdrC + ehdr->e_shoff);
1691 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1693 for (i = 0; i < ehdr->e_shnum; i++) {
1694 if (shdr[i].sh_type == sh_type
1695 /* Ignore the section header's string table. */
1696 && i != ehdr->e_shstrndx
1697 /* Ignore string tables named .stabstr, as they contain
1699 && 0 != strncmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
1701 ptr = ehdrC + shdr[i].sh_offset;
1710 ocVerifyImage_ELF ( ObjectCode* oc )
1714 int i, j, nent, nstrtab, nsymtabs;
1718 char* ehdrC = (char*)(oc->image);
1719 Elf32_Ehdr* ehdr = ( Elf32_Ehdr*)ehdrC;
1721 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
1722 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
1723 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
1724 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
1725 belch("%s: not an ELF header", oc->fileName);
1728 IF_DEBUG(linker,belch( "Is an ELF header" ));
1730 if (ehdr->e_ident[EI_CLASS] != ELFCLASS32) {
1731 belch("%s: not 32 bit ELF", oc->fileName);
1735 IF_DEBUG(linker,belch( "Is 32 bit ELF" ));
1737 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
1738 IF_DEBUG(linker,belch( "Is little-endian" ));
1740 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
1741 IF_DEBUG(linker,belch( "Is big-endian" ));
1743 belch("%s: unknown endiannness", oc->fileName);
1747 if (ehdr->e_type != ET_REL) {
1748 belch("%s: not a relocatable object (.o) file", oc->fileName);
1751 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
1753 IF_DEBUG(linker,belch( "Architecture is " ));
1754 switch (ehdr->e_machine) {
1755 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
1756 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
1757 default: IF_DEBUG(linker,belch( "unknown" ));
1758 belch("%s: unknown architecture", oc->fileName);
1762 IF_DEBUG(linker,belch(
1763 "\nSection header table: start %d, n_entries %d, ent_size %d",
1764 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
1766 ASSERT (ehdr->e_shentsize == sizeof(Elf32_Shdr));
1768 shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1770 if (ehdr->e_shstrndx == SHN_UNDEF) {
1771 belch("%s: no section header string table", oc->fileName);
1774 IF_DEBUG(linker,belch( "Section header string table is section %d",
1776 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1779 for (i = 0; i < ehdr->e_shnum; i++) {
1780 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
1781 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
1782 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
1783 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
1784 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
1785 ehdrC + shdr[i].sh_offset,
1786 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
1788 if (shdr[i].sh_type == SHT_REL) {
1789 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
1790 } else if (shdr[i].sh_type == SHT_RELA) {
1791 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
1793 IF_DEBUG(linker,fprintf(stderr," "));
1796 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
1800 IF_DEBUG(linker,belch( "\nString tables" ));
1803 for (i = 0; i < ehdr->e_shnum; i++) {
1804 if (shdr[i].sh_type == SHT_STRTAB
1805 /* Ignore the section header's string table. */
1806 && i != ehdr->e_shstrndx
1807 /* Ignore string tables named .stabstr, as they contain
1809 && 0 != strncmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
1811 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
1812 strtab = ehdrC + shdr[i].sh_offset;
1817 belch("%s: no string tables, or too many", oc->fileName);
1822 IF_DEBUG(linker,belch( "\nSymbol tables" ));
1823 for (i = 0; i < ehdr->e_shnum; i++) {
1824 if (shdr[i].sh_type != SHT_SYMTAB) continue;
1825 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
1827 stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1828 nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1829 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
1831 shdr[i].sh_size % sizeof(Elf32_Sym)
1833 if (0 != shdr[i].sh_size % sizeof(Elf32_Sym)) {
1834 belch("%s: non-integral number of symbol table entries", oc->fileName);
1837 for (j = 0; j < nent; j++) {
1838 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
1839 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
1840 (int)stab[j].st_shndx,
1841 (int)stab[j].st_size,
1842 (char*)stab[j].st_value ));
1844 IF_DEBUG(linker,fprintf(stderr, "type=" ));
1845 switch (ELF32_ST_TYPE(stab[j].st_info)) {
1846 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
1847 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
1848 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
1849 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
1850 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
1851 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
1853 IF_DEBUG(linker,fprintf(stderr, " " ));
1855 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
1856 switch (ELF32_ST_BIND(stab[j].st_info)) {
1857 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
1858 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
1859 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
1860 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
1862 IF_DEBUG(linker,fprintf(stderr, " " ));
1864 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
1868 if (nsymtabs == 0) {
1869 belch("%s: didn't find any symbol tables", oc->fileName);
1878 ocGetNames_ELF ( ObjectCode* oc )
1883 char* ehdrC = (char*)(oc->image);
1884 Elf32_Ehdr* ehdr = (Elf32_Ehdr*)ehdrC;
1885 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
1886 Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1888 ASSERT(symhash != NULL);
1891 belch("%s: no strtab", oc->fileName);
1896 for (i = 0; i < ehdr->e_shnum; i++) {
1897 /* Figure out what kind of section it is. Logic derived from
1898 Figure 1.14 ("Special Sections") of the ELF document
1899 ("Portable Formats Specification, Version 1.1"). */
1900 Elf32_Shdr hdr = shdr[i];
1901 SectionKind kind = SECTIONKIND_OTHER;
1904 if (hdr.sh_type == SHT_PROGBITS
1905 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
1906 /* .text-style section */
1907 kind = SECTIONKIND_CODE_OR_RODATA;
1910 if (hdr.sh_type == SHT_PROGBITS
1911 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
1912 /* .data-style section */
1913 kind = SECTIONKIND_RWDATA;
1916 if (hdr.sh_type == SHT_PROGBITS
1917 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
1918 /* .rodata-style section */
1919 kind = SECTIONKIND_CODE_OR_RODATA;
1922 if (hdr.sh_type == SHT_NOBITS
1923 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
1924 /* .bss-style section */
1925 kind = SECTIONKIND_RWDATA;
1929 if (is_bss && shdr[i].sh_size > 0) {
1930 /* This is a non-empty .bss section. Allocate zeroed space for
1931 it, and set its .sh_offset field such that
1932 ehdrC + .sh_offset == addr_of_zeroed_space. */
1933 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
1934 "ocGetNames_ELF(BSS)");
1935 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
1937 fprintf(stderr, "BSS section at 0x%x, size %d\n",
1938 zspace, shdr[i].sh_size);
1942 /* fill in the section info */
1943 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
1944 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
1945 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
1946 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
1949 if (shdr[i].sh_type != SHT_SYMTAB) continue;
1951 /* copy stuff into this module's object symbol table */
1952 stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1953 nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1955 oc->n_symbols = nent;
1956 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1957 "ocGetNames_ELF(oc->symbols)");
1959 for (j = 0; j < nent; j++) {
1961 char isLocal = FALSE; /* avoids uninit-var warning */
1963 char* nm = strtab + stab[j].st_name;
1964 int secno = stab[j].st_shndx;
1966 /* Figure out if we want to add it; if so, set ad to its
1967 address. Otherwise leave ad == NULL. */
1969 if (secno == SHN_COMMON) {
1971 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
1973 fprintf(stderr, "COMMON symbol, size %d name %s\n",
1974 stab[j].st_size, nm);
1976 /* Pointless to do addProddableBlock() for this area,
1977 since the linker should never poke around in it. */
1980 if ( ( ELF32_ST_BIND(stab[j].st_info)==STB_GLOBAL
1981 || ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL
1983 /* and not an undefined symbol */
1984 && stab[j].st_shndx != SHN_UNDEF
1985 /* and not in a "special section" */
1986 && stab[j].st_shndx < SHN_LORESERVE
1988 /* and it's a not a section or string table or anything silly */
1989 ( ELF32_ST_TYPE(stab[j].st_info)==STT_FUNC ||
1990 ELF32_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
1991 ELF32_ST_TYPE(stab[j].st_info)==STT_NOTYPE
1994 /* Section 0 is the undefined section, hence > and not >=. */
1995 ASSERT(secno > 0 && secno < ehdr->e_shnum);
1997 if (shdr[secno].sh_type == SHT_NOBITS) {
1998 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
1999 stab[j].st_size, stab[j].st_value, nm);
2002 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2003 if (ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2006 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2007 ad, oc->fileName, nm ));
2012 /* And the decision is ... */
2016 oc->symbols[j] = nm;
2019 /* Ignore entirely. */
2021 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2025 IF_DEBUG(linker,belch( "skipping `%s'",
2026 strtab + stab[j].st_name ));
2029 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2030 (int)ELF32_ST_BIND(stab[j].st_info),
2031 (int)ELF32_ST_TYPE(stab[j].st_info),
2032 (int)stab[j].st_shndx,
2033 strtab + stab[j].st_name
2036 oc->symbols[j] = NULL;
2046 /* Do ELF relocations which lack an explicit addend. All x86-linux
2047 relocations appear to be of this form. */
2049 do_Elf32_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2050 Elf32_Shdr* shdr, int shnum,
2051 Elf32_Sym* stab, char* strtab )
2056 Elf32_Rel* rtab = (Elf32_Rel*) (ehdrC + shdr[shnum].sh_offset);
2057 int nent = shdr[shnum].sh_size / sizeof(Elf32_Rel);
2058 int target_shndx = shdr[shnum].sh_info;
2059 int symtab_shndx = shdr[shnum].sh_link;
2060 stab = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2061 targ = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2062 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2063 target_shndx, symtab_shndx ));
2064 for (j = 0; j < nent; j++) {
2065 Elf32_Addr offset = rtab[j].r_offset;
2066 Elf32_Word info = rtab[j].r_info;
2068 Elf32_Addr P = ((Elf32_Addr)targ) + offset;
2069 Elf32_Word* pP = (Elf32_Word*)P;
2073 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2074 j, (void*)offset, (void*)info ));
2076 IF_DEBUG(linker,belch( " ZERO" ));
2079 Elf32_Sym sym = stab[ELF32_R_SYM(info)];
2080 /* First see if it is a local symbol. */
2081 if (ELF32_ST_BIND(sym.st_info) == STB_LOCAL) {
2082 /* Yes, so we can get the address directly from the ELF symbol
2084 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2086 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2087 + stab[ELF32_R_SYM(info)].st_value);
2090 /* No, so look up the name in our global table. */
2091 symbol = strtab + sym.st_name;
2092 (void*)S = lookupSymbol( symbol );
2095 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2098 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2100 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2101 (void*)P, (void*)S, (void*)A ));
2102 checkProddableBlock ( oc, pP );
2103 switch (ELF32_R_TYPE(info)) {
2104 # ifdef i386_TARGET_ARCH
2105 case R_386_32: *pP = S + A; break;
2106 case R_386_PC32: *pP = S + A - P; break;
2109 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2110 oc->fileName, ELF32_R_TYPE(info));
2119 /* Do ELF relocations for which explicit addends are supplied.
2120 sparc-solaris relocations appear to be of this form. */
2122 do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2123 Elf32_Shdr* shdr, int shnum,
2124 Elf32_Sym* stab, char* strtab )
2129 Elf32_Rela* rtab = (Elf32_Rela*) (ehdrC + shdr[shnum].sh_offset);
2130 int nent = shdr[shnum].sh_size / sizeof(Elf32_Rela);
2131 int target_shndx = shdr[shnum].sh_info;
2132 int symtab_shndx = shdr[shnum].sh_link;
2133 stab = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2134 targ = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2135 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2136 target_shndx, symtab_shndx ));
2137 for (j = 0; j < nent; j++) {
2138 Elf32_Addr offset = rtab[j].r_offset;
2139 Elf32_Word info = rtab[j].r_info;
2140 Elf32_Sword addend = rtab[j].r_addend;
2141 Elf32_Addr P = ((Elf32_Addr)targ) + offset;
2142 Elf32_Addr A = addend; /* Do not delete this; it is used on sparc. */
2144 # if defined(sparc_TARGET_ARCH)
2145 /* This #ifdef only serves to avoid unused-var warnings. */
2146 Elf32_Word* pP = (Elf32_Word*)P;
2150 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2151 j, (void*)offset, (void*)info,
2154 IF_DEBUG(linker,belch( " ZERO" ));
2157 Elf32_Sym sym = stab[ELF32_R_SYM(info)];
2158 /* First see if it is a local symbol. */
2159 if (ELF32_ST_BIND(sym.st_info) == STB_LOCAL) {
2160 /* Yes, so we can get the address directly from the ELF symbol
2162 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2164 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2165 + stab[ELF32_R_SYM(info)].st_value);
2168 /* No, so look up the name in our global table. */
2169 symbol = strtab + sym.st_name;
2170 (void*)S = lookupSymbol( symbol );
2173 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2177 fprintf ( stderr, "S %p A %p S+A %p S+A-P %p\n",S,A,S+A,S+A-P);
2180 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2182 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2183 (void*)P, (void*)S, (void*)A ));
2184 checkProddableBlock ( oc, (void*)P );
2185 switch (ELF32_R_TYPE(info)) {
2186 # if defined(sparc_TARGET_ARCH)
2187 case R_SPARC_WDISP30:
2188 w1 = *pP & 0xC0000000;
2189 w2 = (Elf32_Word)((S + A - P) >> 2);
2190 ASSERT((w2 & 0xC0000000) == 0);
2195 w1 = *pP & 0xFFC00000;
2196 w2 = (Elf32_Word)((S + A) >> 10);
2197 ASSERT((w2 & 0xFFC00000) == 0);
2203 w2 = (Elf32_Word)((S + A) & 0x3FF);
2204 ASSERT((w2 & ~0x3FF) == 0);
2208 /* According to the Sun documentation:
2210 This relocation type resembles R_SPARC_32, except it refers to an
2211 unaligned word. That is, the word to be relocated must be treated
2212 as four separate bytes with arbitrary alignment, not as a word
2213 aligned according to the architecture requirements.
2215 (JRS: which means that freeloading on the R_SPARC_32 case
2216 is probably wrong, but hey ...)
2220 w2 = (Elf32_Word)(S + A);
2225 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2226 oc->fileName, ELF32_R_TYPE(info));
2236 ocResolve_ELF ( ObjectCode* oc )
2240 Elf32_Sym* stab = NULL;
2241 char* ehdrC = (char*)(oc->image);
2242 Elf32_Ehdr* ehdr = (Elf32_Ehdr*) ehdrC;
2243 Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
2244 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2246 /* first find "the" symbol table */
2247 stab = (Elf32_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2249 /* also go find the string table */
2250 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2252 if (stab == NULL || strtab == NULL) {
2253 belch("%s: can't find string or symbol table", oc->fileName);
2257 /* Process the relocation sections. */
2258 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2260 /* Skip sections called ".rel.stab". These appear to contain
2261 relocation entries that, when done, make the stabs debugging
2262 info point at the right places. We ain't interested in all
2264 if (0 == strncmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2267 if (shdr[shnum].sh_type == SHT_REL ) {
2268 ok = do_Elf32_Rel_relocations ( oc, ehdrC, shdr,
2269 shnum, stab, strtab );
2273 if (shdr[shnum].sh_type == SHT_RELA) {
2274 ok = do_Elf32_Rela_relocations ( oc, ehdrC, shdr,
2275 shnum, stab, strtab );
2281 /* Free the local symbol table; we won't need it again. */
2282 freeHashTable(oc->lochash, NULL);