1 /* -----------------------------------------------------------------------------
2 * $Id: Linker.c,v 1.84 2002/03/25 05:21:19 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) \
156 # define MAIN_CAP_SYM SymX(MainCapability)
158 # define MAIN_CAP_SYM
161 #define RTS_SYMBOLS \
165 Sym(__stginit_GHCziPrim) \
169 Sym(stg_enterStackTop) \
172 SymX(__stg_gc_enter_1) \
174 SymX(stg_gc_noregs) \
176 SymX(stg_gc_unbx_r1) \
177 SymX(stg_gc_unpt_r1) \
178 SymX(stg_gc_ut_0_1) \
179 SymX(stg_gc_ut_1_0) \
181 SymX(stg_yield_to_interpreter) \
184 SymX(MallocFailHook) \
185 SymX(NoRunnableThreadsHook) \
187 SymX(OutOfHeapHook) \
188 SymX(PatErrorHdrHook) \
189 SymX(PostTraceHook) \
191 SymX(StackOverflowHook) \
192 SymX(__encodeDouble) \
193 SymX(__encodeFloat) \
196 SymX(__gmpz_cmp_si) \
197 SymX(__gmpz_cmp_ui) \
198 SymX(__gmpz_get_si) \
199 SymX(__gmpz_get_ui) \
200 SymX(__int_encodeDouble) \
201 SymX(__int_encodeFloat) \
202 SymX(andIntegerzh_fast) \
203 SymX(blockAsyncExceptionszh_fast) \
206 SymX(complementIntegerzh_fast) \
207 SymX(cmpIntegerzh_fast) \
208 SymX(cmpIntegerIntzh_fast) \
209 SymX(createAdjustor) \
210 SymX(decodeDoublezh_fast) \
211 SymX(decodeFloatzh_fast) \
214 SymX(deRefWeakzh_fast) \
215 SymX(deRefStablePtrzh_fast) \
216 SymX(divExactIntegerzh_fast) \
217 SymX(divModIntegerzh_fast) \
219 SymX(freeHaskellFunctionPtr) \
220 SymX(freeStablePtr) \
221 SymX(gcdIntegerzh_fast) \
222 SymX(gcdIntegerIntzh_fast) \
223 SymX(gcdIntzh_fast) \
226 SymX(int2Integerzh_fast) \
227 SymX(integer2Intzh_fast) \
228 SymX(integer2Wordzh_fast) \
229 SymX(isDoubleDenormalized) \
230 SymX(isDoubleInfinite) \
232 SymX(isDoubleNegativeZero) \
233 SymX(isEmptyMVarzh_fast) \
234 SymX(isFloatDenormalized) \
235 SymX(isFloatInfinite) \
237 SymX(isFloatNegativeZero) \
238 SymX(killThreadzh_fast) \
239 SymX(makeStablePtrzh_fast) \
240 SymX(minusIntegerzh_fast) \
241 SymX(mkApUpd0zh_fast) \
242 SymX(myThreadIdzh_fast) \
243 SymX(newArrayzh_fast) \
244 SymX(newBCOzh_fast) \
245 SymX(newByteArrayzh_fast) \
247 SymX(newMVarzh_fast) \
248 SymX(newMutVarzh_fast) \
249 SymX(newPinnedByteArrayzh_fast) \
250 SymX(orIntegerzh_fast) \
252 SymX(plusIntegerzh_fast) \
255 SymX(putMVarzh_fast) \
256 SymX(quotIntegerzh_fast) \
257 SymX(quotRemIntegerzh_fast) \
259 SymX(remIntegerzh_fast) \
260 SymX(resetNonBlockingFd) \
263 SymX(rts_checkSchedStatus) \
266 SymX(rts_evalLazyIO) \
271 SymX(rts_getDouble) \
276 SymX(rts_getStablePtr) \
277 SymX(rts_getThreadId) \
279 SymX(rts_getWord32) \
291 SymX(rts_mkStablePtr) \
300 SymX(shutdownHaskellAndExit) \
301 SymX(stable_ptr_table) \
302 SymX(stackOverflow) \
303 SymX(stg_CAF_BLACKHOLE_info) \
304 SymX(stg_CHARLIKE_closure) \
305 SymX(stg_EMPTY_MVAR_info) \
306 SymX(stg_IND_STATIC_info) \
307 SymX(stg_INTLIKE_closure) \
308 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
309 SymX(stg_WEAK_info) \
310 SymX(stg_ap_1_upd_info) \
311 SymX(stg_ap_2_upd_info) \
312 SymX(stg_ap_3_upd_info) \
313 SymX(stg_ap_4_upd_info) \
314 SymX(stg_ap_5_upd_info) \
315 SymX(stg_ap_6_upd_info) \
316 SymX(stg_ap_7_upd_info) \
317 SymX(stg_ap_8_upd_info) \
319 SymX(stg_sel_0_upd_info) \
320 SymX(stg_sel_10_upd_info) \
321 SymX(stg_sel_11_upd_info) \
322 SymX(stg_sel_12_upd_info) \
323 SymX(stg_sel_13_upd_info) \
324 SymX(stg_sel_14_upd_info) \
325 SymX(stg_sel_15_upd_info) \
326 SymX(stg_sel_1_upd_info) \
327 SymX(stg_sel_2_upd_info) \
328 SymX(stg_sel_3_upd_info) \
329 SymX(stg_sel_4_upd_info) \
330 SymX(stg_sel_5_upd_info) \
331 SymX(stg_sel_6_upd_info) \
332 SymX(stg_sel_7_upd_info) \
333 SymX(stg_sel_8_upd_info) \
334 SymX(stg_sel_9_upd_info) \
335 SymX(stg_seq_frame_info) \
336 SymX(stg_upd_frame_info) \
337 SymX(__stg_update_PAP) \
338 SymX(suspendThread) \
339 SymX(takeMVarzh_fast) \
340 SymX(timesIntegerzh_fast) \
341 SymX(tryPutMVarzh_fast) \
342 SymX(tryTakeMVarzh_fast) \
343 SymX(unblockAsyncExceptionszh_fast) \
344 SymX(unsafeThawArrayzh_fast) \
345 SymX(waitReadzh_fast) \
346 SymX(waitWritezh_fast) \
347 SymX(word2Integerzh_fast) \
348 SymX(xorIntegerzh_fast) \
351 #ifndef SUPPORT_LONG_LONGS
352 #define RTS_LONG_LONG_SYMS /* nothing */
354 #define RTS_LONG_LONG_SYMS \
355 SymX(int64ToIntegerzh_fast) \
356 SymX(word64ToIntegerzh_fast)
357 #endif /* SUPPORT_LONG_LONGS */
359 /* entirely bogus claims about types of these symbols */
360 #define Sym(vvv) extern void (vvv);
361 #define SymX(vvv) /**/
364 RTS_POSIX_ONLY_SYMBOLS
365 RTS_MINGW_ONLY_SYMBOLS
369 #ifdef LEADING_UNDERSCORE
370 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
372 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
375 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
377 #define SymX(vvv) Sym(vvv)
379 static RtsSymbolVal rtsSyms[] = {
382 RTS_POSIX_ONLY_SYMBOLS
383 RTS_MINGW_ONLY_SYMBOLS
384 { 0, 0 } /* sentinel */
387 /* -----------------------------------------------------------------------------
388 * Insert symbols into hash tables, checking for duplicates.
390 static void ghciInsertStrHashTable ( char* obj_name,
396 if (lookupHashTable(table, (StgWord)key) == NULL)
398 insertStrHashTable(table, (StgWord)key, data);
403 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
405 "whilst processing object file\n"
407 "This could be caused by:\n"
408 " * Loading two different object files which export the same symbol\n"
409 " * Specifying the same object file twice on the GHCi command line\n"
410 " * An incorrect `package.conf' entry, causing some object to be\n"
412 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
421 /* -----------------------------------------------------------------------------
422 * initialize the object linker
424 #if defined(OBJFORMAT_ELF)
425 static void *dl_prog_handle;
433 symhash = allocStrHashTable();
435 /* populate the symbol table with stuff from the RTS */
436 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
437 ghciInsertStrHashTable("(GHCi built-in symbols)",
438 symhash, sym->lbl, sym->addr);
440 # if defined(OBJFORMAT_ELF)
441 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
445 /* -----------------------------------------------------------------------------
446 * Add a DLL from which symbols may be found. In the ELF case, just
447 * do RTLD_GLOBAL-style add, so no further messing around needs to
448 * happen in order that symbols in the loaded .so are findable --
449 * lookupSymbol() will subsequently see them by dlsym on the program's
450 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
452 * In the PEi386 case, open the DLLs and put handles to them in a
453 * linked list. When looking for a symbol, try all handles in the
457 #if defined(OBJFORMAT_PEi386)
458 /* A record for storing handles into DLLs. */
463 struct _OpenedDLL* next;
468 /* A list thereof. */
469 static OpenedDLL* opened_dlls = NULL;
475 addDLL ( __attribute((unused)) char* path, char* dll_name )
477 # if defined(OBJFORMAT_ELF)
482 if (path == NULL || strlen(path) == 0) {
483 buf = stgMallocBytes(strlen(dll_name) + 10, "addDll");
484 sprintf(buf, "lib%s.so", dll_name);
486 buf = stgMallocBytes(strlen(path) + 1 + strlen(dll_name) + 10, "addDll");
487 sprintf(buf, "%s/lib%s.so", path, dll_name);
489 hdl = dlopen(buf, RTLD_NOW | RTLD_GLOBAL );
492 /* dlopen failed; return a ptr to the error msg. */
494 if (errmsg == NULL) errmsg = "addDLL: unknown error";
501 # elif defined(OBJFORMAT_PEi386)
503 /* Add this DLL to the list of DLLs in which to search for symbols.
504 The path argument is ignored. */
509 /* fprintf(stderr, "\naddDLL; path=`%s', dll_name = `%s'\n", path, dll_name); */
511 /* See if we've already got it, and ignore if so. */
512 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
513 if (0 == strcmp(o_dll->name, dll_name))
517 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
518 sprintf(buf, "%s.DLL", dll_name);
519 instance = LoadLibrary(buf);
521 if (instance == NULL) {
522 /* LoadLibrary failed; return a ptr to the error msg. */
523 return "addDLL: unknown error";
526 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
527 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
528 strcpy(o_dll->name, dll_name);
529 o_dll->instance = instance;
530 o_dll->next = opened_dlls;
535 barf("addDLL: not implemented on this platform");
539 /* -----------------------------------------------------------------------------
540 * lookup a symbol in the hash table
543 lookupSymbol( char *lbl )
546 ASSERT(symhash != NULL);
547 val = lookupStrHashTable(symhash, lbl);
550 # if defined(OBJFORMAT_ELF)
551 return dlsym(dl_prog_handle, lbl);
552 # elif defined(OBJFORMAT_PEi386)
555 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
556 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
558 /* HACK: if the name has an initial underscore, try stripping
559 it off & look that up first. I've yet to verify whether there's
560 a Rule that governs whether an initial '_' *should always* be
561 stripped off when mapping from import lib name to the DLL name.
563 sym = GetProcAddress(o_dll->instance, (lbl+1));
565 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
569 sym = GetProcAddress(o_dll->instance, lbl);
571 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
586 __attribute((unused))
588 lookupLocalSymbol( ObjectCode* oc, char *lbl )
591 val = lookupStrHashTable(oc->lochash, lbl);
601 /* -----------------------------------------------------------------------------
602 * Debugging aid: look in GHCi's object symbol tables for symbols
603 * within DELTA bytes of the specified address, and show their names.
606 void ghci_enquire ( char* addr );
608 void ghci_enquire ( char* addr )
613 const int DELTA = 64;
615 for (oc = objects; oc; oc = oc->next) {
616 for (i = 0; i < oc->n_symbols; i++) {
617 sym = oc->symbols[i];
618 if (sym == NULL) continue;
619 /* fprintf(stderr, "enquire %p %p\n", sym, oc->lochash); */
621 if (oc->lochash != NULL)
622 a = lookupStrHashTable(oc->lochash, sym);
624 a = lookupStrHashTable(symhash, sym);
626 /* fprintf(stderr, "ghci_enquire: can't find %s\n", sym); */
628 else if (addr-DELTA <= a && a <= addr+DELTA) {
629 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
637 /* -----------------------------------------------------------------------------
638 * Load an obj (populate the global symbol table, but don't resolve yet)
640 * Returns: 1 if ok, 0 on error.
643 loadObj( char *path )
650 /* fprintf(stderr, "loadObj %s\n", path ); */
652 /* Check that we haven't already loaded this object. Don't give up
653 at this stage; ocGetNames_* will barf later. */
657 for (o = objects; o; o = o->next) {
658 if (0 == strcmp(o->fileName, path))
664 "GHCi runtime linker: warning: looks like you're trying to load the\n"
665 "same object file twice:\n"
667 "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
673 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
675 # if defined(OBJFORMAT_ELF)
676 oc->formatName = "ELF";
677 # elif defined(OBJFORMAT_PEi386)
678 oc->formatName = "PEi386";
681 barf("loadObj: not implemented on this platform");
685 if (r == -1) { return 0; }
687 /* sigh, strdup() isn't a POSIX function, so do it the long way */
688 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
689 strcpy(oc->fileName, path);
691 oc->fileSize = st.st_size;
692 oc->image = stgMallocBytes( st.st_size, "loadObj(image)" );
695 oc->lochash = allocStrHashTable();
696 oc->proddables = NULL;
698 /* chain it onto the list of objects */
702 /* load the image into memory */
703 f = fopen(path, "rb");
705 barf("loadObj: can't read `%s'", path);
707 n = fread ( oc->image, 1, oc->fileSize, f );
708 if (n != oc->fileSize) {
710 barf("loadObj: error whilst reading `%s'", path);
713 /* verify the in-memory image */
714 # if defined(OBJFORMAT_ELF)
715 r = ocVerifyImage_ELF ( oc );
716 # elif defined(OBJFORMAT_PEi386)
717 r = ocVerifyImage_PEi386 ( oc );
719 barf("loadObj: no verify method");
721 if (!r) { return r; }
723 /* build the symbol list for this image */
724 # if defined(OBJFORMAT_ELF)
725 r = ocGetNames_ELF ( oc );
726 # elif defined(OBJFORMAT_PEi386)
727 r = ocGetNames_PEi386 ( oc );
729 barf("loadObj: no getNames method");
731 if (!r) { return r; }
733 /* loaded, but not resolved yet */
734 oc->status = OBJECT_LOADED;
739 /* -----------------------------------------------------------------------------
740 * resolve all the currently unlinked objects in memory
742 * Returns: 1 if ok, 0 on error.
750 for (oc = objects; oc; oc = oc->next) {
751 if (oc->status != OBJECT_RESOLVED) {
752 # if defined(OBJFORMAT_ELF)
753 r = ocResolve_ELF ( oc );
754 # elif defined(OBJFORMAT_PEi386)
755 r = ocResolve_PEi386 ( oc );
757 barf("resolveObjs: not implemented on this platform");
759 if (!r) { return r; }
760 oc->status = OBJECT_RESOLVED;
766 /* -----------------------------------------------------------------------------
767 * delete an object from the pool
770 unloadObj( char *path )
772 ObjectCode *oc, *prev;
774 ASSERT(symhash != NULL);
775 ASSERT(objects != NULL);
778 for (oc = objects; oc; prev = oc, oc = oc->next) {
779 if (!strcmp(oc->fileName,path)) {
781 /* Remove all the mappings for the symbols within this
786 for (i = 0; i < oc->n_symbols; i++) {
787 if (oc->symbols[i] != NULL) {
788 removeStrHashTable(symhash, oc->symbols[i], NULL);
796 prev->next = oc->next;
799 /* We're going to leave this in place, in case there are
800 any pointers from the heap into it: */
801 /* free(oc->image); */
805 /* The local hash table should have been freed at the end
806 of the ocResolve_ call on it. */
807 ASSERT(oc->lochash == NULL);
813 belch("unloadObj: can't find `%s' to unload", path);
817 /* -----------------------------------------------------------------------------
818 * Sanity checking. For each ObjectCode, maintain a list of address ranges
819 * which may be prodded during relocation, and abort if we try and write
820 * outside any of these.
822 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
825 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
826 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
830 pb->next = oc->proddables;
834 static void checkProddableBlock ( ObjectCode* oc, void* addr )
837 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
838 char* s = (char*)(pb->start);
839 char* e = s + pb->size - 1;
840 char* a = (char*)addr;
841 /* Assumes that the biggest fixup involves a 4-byte write. This
842 probably needs to be changed to 8 (ie, +7) on 64-bit
844 if (a >= s && (a+3) <= e) return;
846 barf("checkProddableBlock: invalid fixup in runtime linker");
849 /* -----------------------------------------------------------------------------
850 * Section management.
852 static void addSection ( ObjectCode* oc, SectionKind kind,
853 void* start, void* end )
855 Section* s = stgMallocBytes(sizeof(Section), "addSection");
859 s->next = oc->sections;
862 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
863 start, ((char*)end)-1, end - start + 1, kind );
869 /* --------------------------------------------------------------------------
870 * PEi386 specifics (Win32 targets)
871 * ------------------------------------------------------------------------*/
873 /* The information for this linker comes from
874 Microsoft Portable Executable
875 and Common Object File Format Specification
876 revision 5.1 January 1998
877 which SimonM says comes from the MS Developer Network CDs.
879 It can be found there (on older CDs), but can also be found
882 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
884 (this is Rev 6.0 from February 1999).
886 Things move, so if that fails, try searching for it via
888 http://www.google.com/search?q=PE+COFF+specification
890 The ultimate reference for the PE format is the Winnt.h
891 header file that comes with the Platform SDKs; as always,
892 implementations will drift wrt their documentation.
894 A good background article on the PE format is Matt Pietrek's
895 March 1994 article in Microsoft System Journal (MSJ)
896 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
897 Win32 Portable Executable File Format." The info in there
898 has recently been updated in a two part article in
899 MSDN magazine, issues Feb and March 2002,
900 "Inside Windows: An In-Depth Look into the Win32 Portable
901 Executable File Format"
903 John Levine's book "Linkers and Loaders" contains useful
908 #if defined(OBJFORMAT_PEi386)
912 typedef unsigned char UChar;
913 typedef unsigned short UInt16;
914 typedef unsigned int UInt32;
921 UInt16 NumberOfSections;
922 UInt32 TimeDateStamp;
923 UInt32 PointerToSymbolTable;
924 UInt32 NumberOfSymbols;
925 UInt16 SizeOfOptionalHeader;
926 UInt16 Characteristics;
930 #define sizeof_COFF_header 20
937 UInt32 VirtualAddress;
938 UInt32 SizeOfRawData;
939 UInt32 PointerToRawData;
940 UInt32 PointerToRelocations;
941 UInt32 PointerToLinenumbers;
942 UInt16 NumberOfRelocations;
943 UInt16 NumberOfLineNumbers;
944 UInt32 Characteristics;
948 #define sizeof_COFF_section 40
955 UInt16 SectionNumber;
958 UChar NumberOfAuxSymbols;
962 #define sizeof_COFF_symbol 18
967 UInt32 VirtualAddress;
968 UInt32 SymbolTableIndex;
973 #define sizeof_COFF_reloc 10
976 /* From PE spec doc, section 3.3.2 */
977 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
978 windows.h -- for the same purpose, but I want to know what I'm
980 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
981 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
982 #define MYIMAGE_FILE_DLL 0x2000
983 #define MYIMAGE_FILE_SYSTEM 0x1000
984 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
985 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
986 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
988 /* From PE spec doc, section 5.4.2 and 5.4.4 */
989 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
990 #define MYIMAGE_SYM_CLASS_STATIC 3
991 #define MYIMAGE_SYM_UNDEFINED 0
993 /* From PE spec doc, section 4.1 */
994 #define MYIMAGE_SCN_CNT_CODE 0x00000020
995 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
996 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
998 /* From PE spec doc, section 5.2.1 */
999 #define MYIMAGE_REL_I386_DIR32 0x0006
1000 #define MYIMAGE_REL_I386_REL32 0x0014
1003 /* We use myindex to calculate array addresses, rather than
1004 simply doing the normal subscript thing. That's because
1005 some of the above structs have sizes which are not
1006 a whole number of words. GCC rounds their sizes up to a
1007 whole number of words, which means that the address calcs
1008 arising from using normal C indexing or pointer arithmetic
1009 are just plain wrong. Sigh.
1012 myindex ( int scale, void* base, int index )
1015 ((UChar*)base) + scale * index;
1020 printName ( UChar* name, UChar* strtab )
1022 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1023 UInt32 strtab_offset = * (UInt32*)(name+4);
1024 fprintf ( stderr, "%s", strtab + strtab_offset );
1027 for (i = 0; i < 8; i++) {
1028 if (name[i] == 0) break;
1029 fprintf ( stderr, "%c", name[i] );
1036 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1038 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1039 UInt32 strtab_offset = * (UInt32*)(name+4);
1040 strncpy ( dst, strtab+strtab_offset, dstSize );
1046 if (name[i] == 0) break;
1056 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1059 /* If the string is longer than 8 bytes, look in the
1060 string table for it -- this will be correctly zero terminated.
1062 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1063 UInt32 strtab_offset = * (UInt32*)(name+4);
1064 return ((UChar*)strtab) + strtab_offset;
1066 /* Otherwise, if shorter than 8 bytes, return the original,
1067 which by defn is correctly terminated.
1069 if (name[7]==0) return name;
1070 /* The annoying case: 8 bytes. Copy into a temporary
1071 (which is never freed ...)
1073 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1075 strncpy(newstr,name,8);
1081 /* Just compares the short names (first 8 chars) */
1082 static COFF_section *
1083 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1087 = (COFF_header*)(oc->image);
1088 COFF_section* sectab
1090 ((UChar*)(oc->image))
1091 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1093 for (i = 0; i < hdr->NumberOfSections; i++) {
1096 COFF_section* section_i
1098 myindex ( sizeof_COFF_section, sectab, i );
1099 n1 = (UChar*) &(section_i->Name);
1101 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1102 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1103 n1[6]==n2[6] && n1[7]==n2[7])
1112 zapTrailingAtSign ( UChar* sym )
1114 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1116 if (sym[0] == 0) return;
1118 while (sym[i] != 0) i++;
1121 while (j > 0 && my_isdigit(sym[j])) j--;
1122 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1128 ocVerifyImage_PEi386 ( ObjectCode* oc )
1133 COFF_section* sectab;
1134 COFF_symbol* symtab;
1136 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1137 hdr = (COFF_header*)(oc->image);
1138 sectab = (COFF_section*) (
1139 ((UChar*)(oc->image))
1140 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1142 symtab = (COFF_symbol*) (
1143 ((UChar*)(oc->image))
1144 + hdr->PointerToSymbolTable
1146 strtab = ((UChar*)symtab)
1147 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1149 if (hdr->Machine != 0x14c) {
1150 belch("Not x86 PEi386");
1153 if (hdr->SizeOfOptionalHeader != 0) {
1154 belch("PEi386 with nonempty optional header");
1157 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1158 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1159 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1160 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1161 belch("Not a PEi386 object file");
1164 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1165 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1166 belch("Invalid PEi386 word size or endiannness: %d",
1167 (int)(hdr->Characteristics));
1170 /* If the string table size is way crazy, this might indicate that
1171 there are more than 64k relocations, despite claims to the
1172 contrary. Hence this test. */
1173 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1175 if ( (*(UInt32*)strtab) > 600000 ) {
1176 /* Note that 600k has no special significance other than being
1177 big enough to handle the almost-2MB-sized lumps that
1178 constitute HSwin32*.o. */
1179 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1184 /* No further verification after this point; only debug printing. */
1186 IF_DEBUG(linker, i=1);
1187 if (i == 0) return 1;
1190 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1192 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1194 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1196 fprintf ( stderr, "\n" );
1198 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1200 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1202 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1204 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1206 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1208 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1210 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1212 /* Print the section table. */
1213 fprintf ( stderr, "\n" );
1214 for (i = 0; i < hdr->NumberOfSections; i++) {
1216 COFF_section* sectab_i
1218 myindex ( sizeof_COFF_section, sectab, i );
1225 printName ( sectab_i->Name, strtab );
1235 sectab_i->VirtualSize,
1236 sectab_i->VirtualAddress,
1237 sectab_i->SizeOfRawData,
1238 sectab_i->PointerToRawData,
1239 sectab_i->NumberOfRelocations,
1240 sectab_i->PointerToRelocations,
1241 sectab_i->PointerToRawData
1243 reltab = (COFF_reloc*) (
1244 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1247 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1248 /* If the relocation field (a short) has overflowed, the
1249 * real count can be found in the first reloc entry.
1251 * See Section 4.1 (last para) of the PE spec (rev6.0).
1253 COFF_reloc* rel = (COFF_reloc*)
1254 myindex ( sizeof_COFF_reloc, reltab, 0 );
1255 noRelocs = rel->VirtualAddress;
1258 noRelocs = sectab_i->NumberOfRelocations;
1262 for (; j < noRelocs; j++) {
1264 COFF_reloc* rel = (COFF_reloc*)
1265 myindex ( sizeof_COFF_reloc, reltab, j );
1267 " type 0x%-4x vaddr 0x%-8x name `",
1269 rel->VirtualAddress );
1270 sym = (COFF_symbol*)
1271 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1272 /* Hmm..mysterious looking offset - what's it for? SOF */
1273 printName ( sym->Name, strtab -10 );
1274 fprintf ( stderr, "'\n" );
1277 fprintf ( stderr, "\n" );
1279 fprintf ( stderr, "\n" );
1280 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1281 fprintf ( stderr, "---START of string table---\n");
1282 for (i = 4; i < *(Int32*)strtab; i++) {
1284 fprintf ( stderr, "\n"); else
1285 fprintf( stderr, "%c", strtab[i] );
1287 fprintf ( stderr, "--- END of string table---\n");
1289 fprintf ( stderr, "\n" );
1292 COFF_symbol* symtab_i;
1293 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1294 symtab_i = (COFF_symbol*)
1295 myindex ( sizeof_COFF_symbol, symtab, i );
1301 printName ( symtab_i->Name, strtab );
1310 (Int32)(symtab_i->SectionNumber),
1311 (UInt32)symtab_i->Type,
1312 (UInt32)symtab_i->StorageClass,
1313 (UInt32)symtab_i->NumberOfAuxSymbols
1315 i += symtab_i->NumberOfAuxSymbols;
1319 fprintf ( stderr, "\n" );
1325 ocGetNames_PEi386 ( ObjectCode* oc )
1328 COFF_section* sectab;
1329 COFF_symbol* symtab;
1336 hdr = (COFF_header*)(oc->image);
1337 sectab = (COFF_section*) (
1338 ((UChar*)(oc->image))
1339 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1341 symtab = (COFF_symbol*) (
1342 ((UChar*)(oc->image))
1343 + hdr->PointerToSymbolTable
1345 strtab = ((UChar*)(oc->image))
1346 + hdr->PointerToSymbolTable
1347 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1349 /* Allocate space for any (local, anonymous) .bss sections. */
1351 for (i = 0; i < hdr->NumberOfSections; i++) {
1353 COFF_section* sectab_i
1355 myindex ( sizeof_COFF_section, sectab, i );
1356 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1357 if (sectab_i->VirtualSize == 0) continue;
1358 /* This is a non-empty .bss section. Allocate zeroed space for
1359 it, and set its PointerToRawData field such that oc->image +
1360 PointerToRawData == addr_of_zeroed_space. */
1361 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1362 "ocGetNames_PEi386(anonymous bss)");
1363 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1364 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1365 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1368 /* Copy section information into the ObjectCode. */
1370 for (i = 0; i < hdr->NumberOfSections; i++) {
1376 = SECTIONKIND_OTHER;
1377 COFF_section* sectab_i
1379 myindex ( sizeof_COFF_section, sectab, i );
1380 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1383 /* I'm sure this is the Right Way to do it. However, the
1384 alternative of testing the sectab_i->Name field seems to
1385 work ok with Cygwin.
1387 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1388 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1389 kind = SECTIONKIND_CODE_OR_RODATA;
1392 if (0==strcmp(".text",sectab_i->Name) ||
1393 0==strcmp(".rodata",sectab_i->Name))
1394 kind = SECTIONKIND_CODE_OR_RODATA;
1395 if (0==strcmp(".data",sectab_i->Name) ||
1396 0==strcmp(".bss",sectab_i->Name))
1397 kind = SECTIONKIND_RWDATA;
1399 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1400 sz = sectab_i->SizeOfRawData;
1401 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1403 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1404 end = start + sz - 1;
1406 if (kind == SECTIONKIND_OTHER
1407 /* Ignore sections called which contain stabs debugging
1409 && 0 != strcmp(".stab", sectab_i->Name)
1410 && 0 != strcmp(".stabstr", sectab_i->Name)
1412 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1416 if (kind != SECTIONKIND_OTHER && end >= start) {
1417 addSection(oc, kind, start, end);
1418 addProddableBlock(oc, start, end - start + 1);
1422 /* Copy exported symbols into the ObjectCode. */
1424 oc->n_symbols = hdr->NumberOfSymbols;
1425 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1426 "ocGetNames_PEi386(oc->symbols)");
1427 /* Call me paranoid; I don't care. */
1428 for (i = 0; i < oc->n_symbols; i++)
1429 oc->symbols[i] = NULL;
1433 COFF_symbol* symtab_i;
1434 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1435 symtab_i = (COFF_symbol*)
1436 myindex ( sizeof_COFF_symbol, symtab, i );
1440 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1441 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1442 /* This symbol is global and defined, viz, exported */
1443 /* for MYIMAGE_SYMCLASS_EXTERNAL
1444 && !MYIMAGE_SYM_UNDEFINED,
1445 the address of the symbol is:
1446 address of relevant section + offset in section
1448 COFF_section* sectabent
1449 = (COFF_section*) myindex ( sizeof_COFF_section,
1451 symtab_i->SectionNumber-1 );
1452 addr = ((UChar*)(oc->image))
1453 + (sectabent->PointerToRawData
1457 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1458 && symtab_i->Value > 0) {
1459 /* This symbol isn't in any section at all, ie, global bss.
1460 Allocate zeroed space for it. */
1461 addr = stgCallocBytes(1, symtab_i->Value,
1462 "ocGetNames_PEi386(non-anonymous bss)");
1463 addSection(oc, SECTIONKIND_RWDATA, addr,
1464 ((UChar*)addr) + symtab_i->Value - 1);
1465 addProddableBlock(oc, addr, symtab_i->Value);
1466 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1469 if (addr != NULL ) {
1470 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1471 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1472 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1473 ASSERT(i >= 0 && i < oc->n_symbols);
1474 /* cstring_from_COFF_symbol_name always succeeds. */
1475 oc->symbols[i] = sname;
1476 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1480 "IGNORING symbol %d\n"
1484 printName ( symtab_i->Name, strtab );
1493 (Int32)(symtab_i->SectionNumber),
1494 (UInt32)symtab_i->Type,
1495 (UInt32)symtab_i->StorageClass,
1496 (UInt32)symtab_i->NumberOfAuxSymbols
1501 i += symtab_i->NumberOfAuxSymbols;
1510 ocResolve_PEi386 ( ObjectCode* oc )
1513 COFF_section* sectab;
1514 COFF_symbol* symtab;
1524 /* ToDo: should be variable-sized? But is at least safe in the
1525 sense of buffer-overrun-proof. */
1527 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1529 hdr = (COFF_header*)(oc->image);
1530 sectab = (COFF_section*) (
1531 ((UChar*)(oc->image))
1532 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1534 symtab = (COFF_symbol*) (
1535 ((UChar*)(oc->image))
1536 + hdr->PointerToSymbolTable
1538 strtab = ((UChar*)(oc->image))
1539 + hdr->PointerToSymbolTable
1540 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1542 for (i = 0; i < hdr->NumberOfSections; i++) {
1543 COFF_section* sectab_i
1545 myindex ( sizeof_COFF_section, sectab, i );
1548 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1551 /* Ignore sections called which contain stabs debugging
1553 if (0 == strcmp(".stab", sectab_i->Name)
1554 || 0 == strcmp(".stabstr", sectab_i->Name))
1557 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1558 /* If the relocation field (a short) has overflowed, the
1559 * real count can be found in the first reloc entry.
1561 * See Section 4.1 (last para) of the PE spec (rev6.0).
1563 COFF_reloc* rel = (COFF_reloc*)
1564 myindex ( sizeof_COFF_reloc, reltab, 0 );
1565 noRelocs = rel->VirtualAddress;
1566 fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
1569 noRelocs = sectab_i->NumberOfRelocations;
1574 for (; j < noRelocs; j++) {
1576 COFF_reloc* reltab_j
1578 myindex ( sizeof_COFF_reloc, reltab, j );
1580 /* the location to patch */
1582 ((UChar*)(oc->image))
1583 + (sectab_i->PointerToRawData
1584 + reltab_j->VirtualAddress
1585 - sectab_i->VirtualAddress )
1587 /* the existing contents of pP */
1589 /* the symbol to connect to */
1590 sym = (COFF_symbol*)
1591 myindex ( sizeof_COFF_symbol,
1592 symtab, reltab_j->SymbolTableIndex );
1595 "reloc sec %2d num %3d: type 0x%-4x "
1596 "vaddr 0x%-8x name `",
1598 (UInt32)reltab_j->Type,
1599 reltab_j->VirtualAddress );
1600 printName ( sym->Name, strtab );
1601 fprintf ( stderr, "'\n" ));
1603 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1604 COFF_section* section_sym
1605 = findPEi386SectionCalled ( oc, sym->Name );
1607 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1610 S = ((UInt32)(oc->image))
1611 + (section_sym->PointerToRawData
1614 copyName ( sym->Name, strtab, symbol, 1000-1 );
1615 (void*)S = lookupLocalSymbol( oc, symbol );
1616 if ((void*)S != NULL) goto foundit;
1617 (void*)S = lookupSymbol( symbol );
1618 if ((void*)S != NULL) goto foundit;
1619 zapTrailingAtSign ( symbol );
1620 (void*)S = lookupLocalSymbol( oc, symbol );
1621 if ((void*)S != NULL) goto foundit;
1622 (void*)S = lookupSymbol( symbol );
1623 if ((void*)S != NULL) goto foundit;
1624 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
1628 checkProddableBlock(oc, pP);
1629 switch (reltab_j->Type) {
1630 case MYIMAGE_REL_I386_DIR32:
1633 case MYIMAGE_REL_I386_REL32:
1634 /* Tricky. We have to insert a displacement at
1635 pP which, when added to the PC for the _next_
1636 insn, gives the address of the target (S).
1637 Problem is to know the address of the next insn
1638 when we only know pP. We assume that this
1639 literal field is always the last in the insn,
1640 so that the address of the next insn is pP+4
1641 -- hence the constant 4.
1642 Also I don't know if A should be added, but so
1643 far it has always been zero.
1646 *pP = S - ((UInt32)pP) - 4;
1649 belch("%s: unhandled PEi386 relocation type %d",
1650 oc->fileName, reltab_j->Type);
1657 IF_DEBUG(linker, belch("completed %s", oc->fileName));
1661 #endif /* defined(OBJFORMAT_PEi386) */
1664 /* --------------------------------------------------------------------------
1666 * ------------------------------------------------------------------------*/
1668 #if defined(OBJFORMAT_ELF)
1673 #if defined(sparc_TARGET_ARCH)
1674 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
1675 #elif defined(i386_TARGET_ARCH)
1676 # define ELF_TARGET_386 /* Used inside <elf.h> */
1678 /* There is a similar case for IA64 in the Solaris2 headers if this
1679 * ever becomes relevant.
1686 findElfSection ( void* objImage, Elf32_Word sh_type )
1689 char* ehdrC = (char*)objImage;
1690 Elf32_Ehdr* ehdr = (Elf32_Ehdr*)ehdrC;
1691 Elf32_Shdr* shdr = (Elf32_Shdr*)(ehdrC + ehdr->e_shoff);
1692 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1694 for (i = 0; i < ehdr->e_shnum; i++) {
1695 if (shdr[i].sh_type == sh_type
1696 /* Ignore the section header's string table. */
1697 && i != ehdr->e_shstrndx
1698 /* Ignore string tables named .stabstr, as they contain
1700 && 0 != strncmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
1702 ptr = ehdrC + shdr[i].sh_offset;
1711 ocVerifyImage_ELF ( ObjectCode* oc )
1715 int i, j, nent, nstrtab, nsymtabs;
1719 char* ehdrC = (char*)(oc->image);
1720 Elf32_Ehdr* ehdr = ( Elf32_Ehdr*)ehdrC;
1722 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
1723 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
1724 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
1725 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
1726 belch("%s: not an ELF header", oc->fileName);
1729 IF_DEBUG(linker,belch( "Is an ELF header" ));
1731 if (ehdr->e_ident[EI_CLASS] != ELFCLASS32) {
1732 belch("%s: not 32 bit ELF", oc->fileName);
1736 IF_DEBUG(linker,belch( "Is 32 bit ELF" ));
1738 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
1739 IF_DEBUG(linker,belch( "Is little-endian" ));
1741 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
1742 IF_DEBUG(linker,belch( "Is big-endian" ));
1744 belch("%s: unknown endiannness", oc->fileName);
1748 if (ehdr->e_type != ET_REL) {
1749 belch("%s: not a relocatable object (.o) file", oc->fileName);
1752 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
1754 IF_DEBUG(linker,belch( "Architecture is " ));
1755 switch (ehdr->e_machine) {
1756 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
1757 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
1758 default: IF_DEBUG(linker,belch( "unknown" ));
1759 belch("%s: unknown architecture", oc->fileName);
1763 IF_DEBUG(linker,belch(
1764 "\nSection header table: start %d, n_entries %d, ent_size %d",
1765 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
1767 ASSERT (ehdr->e_shentsize == sizeof(Elf32_Shdr));
1769 shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1771 if (ehdr->e_shstrndx == SHN_UNDEF) {
1772 belch("%s: no section header string table", oc->fileName);
1775 IF_DEBUG(linker,belch( "Section header string table is section %d",
1777 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1780 for (i = 0; i < ehdr->e_shnum; i++) {
1781 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
1782 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
1783 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
1784 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
1785 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
1786 ehdrC + shdr[i].sh_offset,
1787 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
1789 if (shdr[i].sh_type == SHT_REL) {
1790 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
1791 } else if (shdr[i].sh_type == SHT_RELA) {
1792 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
1794 IF_DEBUG(linker,fprintf(stderr," "));
1797 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
1801 IF_DEBUG(linker,belch( "\nString tables" ));
1804 for (i = 0; i < ehdr->e_shnum; i++) {
1805 if (shdr[i].sh_type == SHT_STRTAB
1806 /* Ignore the section header's string table. */
1807 && i != ehdr->e_shstrndx
1808 /* Ignore string tables named .stabstr, as they contain
1810 && 0 != strncmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
1812 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
1813 strtab = ehdrC + shdr[i].sh_offset;
1818 belch("%s: no string tables, or too many", oc->fileName);
1823 IF_DEBUG(linker,belch( "\nSymbol tables" ));
1824 for (i = 0; i < ehdr->e_shnum; i++) {
1825 if (shdr[i].sh_type != SHT_SYMTAB) continue;
1826 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
1828 stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1829 nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1830 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
1832 shdr[i].sh_size % sizeof(Elf32_Sym)
1834 if (0 != shdr[i].sh_size % sizeof(Elf32_Sym)) {
1835 belch("%s: non-integral number of symbol table entries", oc->fileName);
1838 for (j = 0; j < nent; j++) {
1839 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
1840 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
1841 (int)stab[j].st_shndx,
1842 (int)stab[j].st_size,
1843 (char*)stab[j].st_value ));
1845 IF_DEBUG(linker,fprintf(stderr, "type=" ));
1846 switch (ELF32_ST_TYPE(stab[j].st_info)) {
1847 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
1848 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
1849 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
1850 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
1851 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
1852 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
1854 IF_DEBUG(linker,fprintf(stderr, " " ));
1856 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
1857 switch (ELF32_ST_BIND(stab[j].st_info)) {
1858 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
1859 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
1860 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
1861 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
1863 IF_DEBUG(linker,fprintf(stderr, " " ));
1865 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
1869 if (nsymtabs == 0) {
1870 belch("%s: didn't find any symbol tables", oc->fileName);
1879 ocGetNames_ELF ( ObjectCode* oc )
1884 char* ehdrC = (char*)(oc->image);
1885 Elf32_Ehdr* ehdr = (Elf32_Ehdr*)ehdrC;
1886 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
1887 Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1889 ASSERT(symhash != NULL);
1892 belch("%s: no strtab", oc->fileName);
1897 for (i = 0; i < ehdr->e_shnum; i++) {
1898 /* Figure out what kind of section it is. Logic derived from
1899 Figure 1.14 ("Special Sections") of the ELF document
1900 ("Portable Formats Specification, Version 1.1"). */
1901 Elf32_Shdr hdr = shdr[i];
1902 SectionKind kind = SECTIONKIND_OTHER;
1905 if (hdr.sh_type == SHT_PROGBITS
1906 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
1907 /* .text-style section */
1908 kind = SECTIONKIND_CODE_OR_RODATA;
1911 if (hdr.sh_type == SHT_PROGBITS
1912 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
1913 /* .data-style section */
1914 kind = SECTIONKIND_RWDATA;
1917 if (hdr.sh_type == SHT_PROGBITS
1918 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
1919 /* .rodata-style section */
1920 kind = SECTIONKIND_CODE_OR_RODATA;
1923 if (hdr.sh_type == SHT_NOBITS
1924 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
1925 /* .bss-style section */
1926 kind = SECTIONKIND_RWDATA;
1930 if (is_bss && shdr[i].sh_size > 0) {
1931 /* This is a non-empty .bss section. Allocate zeroed space for
1932 it, and set its .sh_offset field such that
1933 ehdrC + .sh_offset == addr_of_zeroed_space. */
1934 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
1935 "ocGetNames_ELF(BSS)");
1936 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
1938 fprintf(stderr, "BSS section at 0x%x, size %d\n",
1939 zspace, shdr[i].sh_size);
1943 /* fill in the section info */
1944 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
1945 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
1946 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
1947 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
1950 if (shdr[i].sh_type != SHT_SYMTAB) continue;
1952 /* copy stuff into this module's object symbol table */
1953 stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1954 nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1956 oc->n_symbols = nent;
1957 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1958 "ocGetNames_ELF(oc->symbols)");
1960 for (j = 0; j < nent; j++) {
1962 char isLocal = FALSE; /* avoids uninit-var warning */
1964 char* nm = strtab + stab[j].st_name;
1965 int secno = stab[j].st_shndx;
1967 /* Figure out if we want to add it; if so, set ad to its
1968 address. Otherwise leave ad == NULL. */
1970 if (secno == SHN_COMMON) {
1972 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
1974 fprintf(stderr, "COMMON symbol, size %d name %s\n",
1975 stab[j].st_size, nm);
1977 /* Pointless to do addProddableBlock() for this area,
1978 since the linker should never poke around in it. */
1981 if ( ( ELF32_ST_BIND(stab[j].st_info)==STB_GLOBAL
1982 || ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL
1984 /* and not an undefined symbol */
1985 && stab[j].st_shndx != SHN_UNDEF
1986 /* and not in a "special section" */
1987 && stab[j].st_shndx < SHN_LORESERVE
1989 /* and it's a not a section or string table or anything silly */
1990 ( ELF32_ST_TYPE(stab[j].st_info)==STT_FUNC ||
1991 ELF32_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
1992 ELF32_ST_TYPE(stab[j].st_info)==STT_NOTYPE
1995 /* Section 0 is the undefined section, hence > and not >=. */
1996 ASSERT(secno > 0 && secno < ehdr->e_shnum);
1998 if (shdr[secno].sh_type == SHT_NOBITS) {
1999 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2000 stab[j].st_size, stab[j].st_value, nm);
2003 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2004 if (ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2007 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2008 ad, oc->fileName, nm ));
2013 /* And the decision is ... */
2017 oc->symbols[j] = nm;
2020 /* Ignore entirely. */
2022 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2026 IF_DEBUG(linker,belch( "skipping `%s'",
2027 strtab + stab[j].st_name ));
2030 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2031 (int)ELF32_ST_BIND(stab[j].st_info),
2032 (int)ELF32_ST_TYPE(stab[j].st_info),
2033 (int)stab[j].st_shndx,
2034 strtab + stab[j].st_name
2037 oc->symbols[j] = NULL;
2047 /* Do ELF relocations which lack an explicit addend. All x86-linux
2048 relocations appear to be of this form. */
2050 do_Elf32_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2051 Elf32_Shdr* shdr, int shnum,
2052 Elf32_Sym* stab, char* strtab )
2057 Elf32_Rel* rtab = (Elf32_Rel*) (ehdrC + shdr[shnum].sh_offset);
2058 int nent = shdr[shnum].sh_size / sizeof(Elf32_Rel);
2059 int target_shndx = shdr[shnum].sh_info;
2060 int symtab_shndx = shdr[shnum].sh_link;
2061 stab = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2062 targ = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2063 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2064 target_shndx, symtab_shndx ));
2065 for (j = 0; j < nent; j++) {
2066 Elf32_Addr offset = rtab[j].r_offset;
2067 Elf32_Word info = rtab[j].r_info;
2069 Elf32_Addr P = ((Elf32_Addr)targ) + offset;
2070 Elf32_Word* pP = (Elf32_Word*)P;
2074 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2075 j, (void*)offset, (void*)info ));
2077 IF_DEBUG(linker,belch( " ZERO" ));
2080 Elf32_Sym sym = stab[ELF32_R_SYM(info)];
2081 /* First see if it is a local symbol. */
2082 if (ELF32_ST_BIND(sym.st_info) == STB_LOCAL) {
2083 /* Yes, so we can get the address directly from the ELF symbol
2085 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2087 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2088 + stab[ELF32_R_SYM(info)].st_value);
2091 /* No, so look up the name in our global table. */
2092 symbol = strtab + sym.st_name;
2093 (void*)S = lookupSymbol( symbol );
2096 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2099 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2101 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2102 (void*)P, (void*)S, (void*)A ));
2103 checkProddableBlock ( oc, pP );
2104 switch (ELF32_R_TYPE(info)) {
2105 # ifdef i386_TARGET_ARCH
2106 case R_386_32: *pP = S + A; break;
2107 case R_386_PC32: *pP = S + A - P; break;
2110 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2111 oc->fileName, ELF32_R_TYPE(info));
2120 /* Do ELF relocations for which explicit addends are supplied.
2121 sparc-solaris relocations appear to be of this form. */
2123 do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2124 Elf32_Shdr* shdr, int shnum,
2125 Elf32_Sym* stab, char* strtab )
2130 Elf32_Rela* rtab = (Elf32_Rela*) (ehdrC + shdr[shnum].sh_offset);
2131 int nent = shdr[shnum].sh_size / sizeof(Elf32_Rela);
2132 int target_shndx = shdr[shnum].sh_info;
2133 int symtab_shndx = shdr[shnum].sh_link;
2134 stab = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2135 targ = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2136 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2137 target_shndx, symtab_shndx ));
2138 for (j = 0; j < nent; j++) {
2139 Elf32_Addr offset = rtab[j].r_offset;
2140 Elf32_Word info = rtab[j].r_info;
2141 Elf32_Sword addend = rtab[j].r_addend;
2142 Elf32_Addr P = ((Elf32_Addr)targ) + offset;
2143 Elf32_Addr A = addend; /* Do not delete this; it is used on sparc. */
2145 # if defined(sparc_TARGET_ARCH)
2146 /* This #ifdef only serves to avoid unused-var warnings. */
2147 Elf32_Word* pP = (Elf32_Word*)P;
2151 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2152 j, (void*)offset, (void*)info,
2155 IF_DEBUG(linker,belch( " ZERO" ));
2158 Elf32_Sym sym = stab[ELF32_R_SYM(info)];
2159 /* First see if it is a local symbol. */
2160 if (ELF32_ST_BIND(sym.st_info) == STB_LOCAL) {
2161 /* Yes, so we can get the address directly from the ELF symbol
2163 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2165 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2166 + stab[ELF32_R_SYM(info)].st_value);
2169 /* No, so look up the name in our global table. */
2170 symbol = strtab + sym.st_name;
2171 (void*)S = lookupSymbol( symbol );
2174 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2178 fprintf ( stderr, "S %p A %p S+A %p S+A-P %p\n",S,A,S+A,S+A-P);
2181 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2183 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2184 (void*)P, (void*)S, (void*)A ));
2185 checkProddableBlock ( oc, (void*)P );
2186 switch (ELF32_R_TYPE(info)) {
2187 # if defined(sparc_TARGET_ARCH)
2188 case R_SPARC_WDISP30:
2189 w1 = *pP & 0xC0000000;
2190 w2 = (Elf32_Word)((S + A - P) >> 2);
2191 ASSERT((w2 & 0xC0000000) == 0);
2196 w1 = *pP & 0xFFC00000;
2197 w2 = (Elf32_Word)((S + A) >> 10);
2198 ASSERT((w2 & 0xFFC00000) == 0);
2204 w2 = (Elf32_Word)((S + A) & 0x3FF);
2205 ASSERT((w2 & ~0x3FF) == 0);
2209 /* According to the Sun documentation:
2211 This relocation type resembles R_SPARC_32, except it refers to an
2212 unaligned word. That is, the word to be relocated must be treated
2213 as four separate bytes with arbitrary alignment, not as a word
2214 aligned according to the architecture requirements.
2216 (JRS: which means that freeloading on the R_SPARC_32 case
2217 is probably wrong, but hey ...)
2221 w2 = (Elf32_Word)(S + A);
2226 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2227 oc->fileName, ELF32_R_TYPE(info));
2237 ocResolve_ELF ( ObjectCode* oc )
2241 Elf32_Sym* stab = NULL;
2242 char* ehdrC = (char*)(oc->image);
2243 Elf32_Ehdr* ehdr = (Elf32_Ehdr*) ehdrC;
2244 Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
2245 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2247 /* first find "the" symbol table */
2248 stab = (Elf32_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2250 /* also go find the string table */
2251 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2253 if (stab == NULL || strtab == NULL) {
2254 belch("%s: can't find string or symbol table", oc->fileName);
2258 /* Process the relocation sections. */
2259 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2261 /* Skip sections called ".rel.stab". These appear to contain
2262 relocation entries that, when done, make the stabs debugging
2263 info point at the right places. We ain't interested in all
2265 if (0 == strncmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2268 if (shdr[shnum].sh_type == SHT_REL ) {
2269 ok = do_Elf32_Rel_relocations ( oc, ehdrC, shdr,
2270 shnum, stab, strtab );
2274 if (shdr[shnum].sh_type == SHT_RELA) {
2275 ok = do_Elf32_Rela_relocations ( oc, ehdrC, shdr,
2276 shnum, stab, strtab );
2282 /* Free the local symbol table; we won't need it again. */
2283 freeHashTable(oc->lochash, NULL);