1 /* -----------------------------------------------------------------------------
2 * $Id: Linker.c,v 1.74 2001/11/22 15:15:27 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 RTS_SYMBOLS \
159 Sym(__stginit_PrelGHC) \
163 Sym(stg_enterStackTop) \
165 SymX(__stg_gc_enter_1) \
167 SymX(stg_gc_noregs) \
169 SymX(stg_gc_unbx_r1) \
170 SymX(stg_gc_unpt_r1) \
171 SymX(stg_gc_ut_0_1) \
172 SymX(stg_gc_ut_1_0) \
174 SymX(stg_yield_to_interpreter) \
176 SymX(MainCapability) \
177 SymX(MallocFailHook) \
178 SymX(NoRunnableThreadsHook) \
180 SymX(OutOfHeapHook) \
181 SymX(PatErrorHdrHook) \
182 SymX(PostTraceHook) \
184 SymX(StackOverflowHook) \
185 SymX(__encodeDouble) \
186 SymX(__encodeFloat) \
189 SymX(__gmpz_cmp_si) \
190 SymX(__gmpz_cmp_ui) \
191 SymX(__gmpz_get_si) \
192 SymX(__gmpz_get_ui) \
193 SymX(__int_encodeDouble) \
194 SymX(__int_encodeFloat) \
195 SymX(andIntegerzh_fast) \
196 SymX(blockAsyncExceptionszh_fast) \
199 SymX(complementIntegerzh_fast) \
200 SymX(createAdjustor) \
201 SymX(decodeDoublezh_fast) \
202 SymX(decodeFloatzh_fast) \
205 SymX(divExactIntegerzh_fast) \
206 SymX(divModIntegerzh_fast) \
208 SymX(freeHaskellFunctionPtr) \
209 SymX(gcdIntegerzh_fast) \
212 SymX(int2Integerzh_fast) \
213 SymX(isDoubleDenormalized) \
214 SymX(isDoubleInfinite) \
216 SymX(isDoubleNegativeZero) \
217 SymX(isFloatDenormalized) \
218 SymX(isFloatInfinite) \
220 SymX(isFloatNegativeZero) \
221 SymX(killThreadzh_fast) \
222 SymX(minusIntegerzh_fast) \
223 SymX(mkApUpd0zh_fast) \
224 SymX(newArrayzh_fast) \
225 SymX(newBCOzh_fast) \
226 SymX(newByteArrayzh_fast) \
228 SymX(newMVarzh_fast) \
229 SymX(newMutVarzh_fast) \
230 SymX(newPinnedByteArrayzh_fast) \
231 SymX(orIntegerzh_fast) \
233 SymX(plusIntegerzh_fast) \
236 SymX(putMVarzh_fast) \
237 SymX(quotIntegerzh_fast) \
238 SymX(quotRemIntegerzh_fast) \
240 SymX(remIntegerzh_fast) \
241 SymX(resetNonBlockingFd) \
244 SymX(rts_checkSchedStatus) \
247 SymX(rts_evalLazyIO) \
252 SymX(rts_getDouble) \
257 SymX(rts_getStablePtr) \
258 SymX(rts_getThreadId) \
260 SymX(rts_getWord32) \
272 SymX(rts_mkStablePtr) \
281 SymX(shutdownHaskellAndExit) \
282 SymX(stable_ptr_table) \
283 SymX(stackOverflow) \
284 SymX(stg_CAF_BLACKHOLE_info) \
285 SymX(stg_CHARLIKE_closure) \
286 SymX(stg_EMPTY_MVAR_info) \
287 SymX(stg_IND_STATIC_info) \
288 SymX(stg_INTLIKE_closure) \
289 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
290 SymX(stg_WEAK_info) \
291 SymX(stg_ap_1_upd_info) \
292 SymX(stg_ap_2_upd_info) \
293 SymX(stg_ap_3_upd_info) \
294 SymX(stg_ap_4_upd_info) \
295 SymX(stg_ap_5_upd_info) \
296 SymX(stg_ap_6_upd_info) \
297 SymX(stg_ap_7_upd_info) \
298 SymX(stg_ap_8_upd_info) \
300 SymX(stg_sel_0_upd_info) \
301 SymX(stg_sel_10_upd_info) \
302 SymX(stg_sel_11_upd_info) \
303 SymX(stg_sel_12_upd_info) \
304 SymX(stg_sel_13_upd_info) \
305 SymX(stg_sel_14_upd_info) \
306 SymX(stg_sel_15_upd_info) \
307 SymX(stg_sel_1_upd_info) \
308 SymX(stg_sel_2_upd_info) \
309 SymX(stg_sel_3_upd_info) \
310 SymX(stg_sel_4_upd_info) \
311 SymX(stg_sel_5_upd_info) \
312 SymX(stg_sel_6_upd_info) \
313 SymX(stg_sel_7_upd_info) \
314 SymX(stg_sel_8_upd_info) \
315 SymX(stg_sel_9_upd_info) \
316 SymX(stg_seq_frame_info) \
317 SymX(stg_upd_frame_info) \
318 SymX(__stg_update_PAP) \
319 SymX(suspendThread) \
320 SymX(takeMVarzh_fast) \
321 SymX(timesIntegerzh_fast) \
322 SymX(tryPutMVarzh_fast) \
323 SymX(tryTakeMVarzh_fast) \
324 SymX(unblockAsyncExceptionszh_fast) \
325 SymX(unsafeThawArrayzh_fast) \
326 SymX(waitReadzh_fast) \
327 SymX(waitWritezh_fast) \
328 SymX(word2Integerzh_fast) \
329 SymX(xorIntegerzh_fast) \
332 #ifndef SUPPORT_LONG_LONGS
333 #define RTS_LONG_LONG_SYMS /* nothing */
335 #define RTS_LONG_LONG_SYMS \
336 SymX(int64ToIntegerzh_fast) \
337 SymX(word64ToIntegerzh_fast)
338 #endif /* SUPPORT_LONG_LONGS */
340 /* entirely bogus claims about types of these symbols */
341 #define Sym(vvv) extern void (vvv);
342 #define SymX(vvv) /**/
345 RTS_POSIX_ONLY_SYMBOLS
346 RTS_MINGW_ONLY_SYMBOLS
350 #ifdef LEADING_UNDERSCORE
351 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
353 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
356 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
358 #define SymX(vvv) Sym(vvv)
360 static RtsSymbolVal rtsSyms[] = {
363 RTS_POSIX_ONLY_SYMBOLS
364 RTS_MINGW_ONLY_SYMBOLS
365 { 0, 0 } /* sentinel */
368 /* -----------------------------------------------------------------------------
369 * Insert symbols into hash tables, checking for duplicates.
371 static void ghciInsertStrHashTable ( char* obj_name,
377 if (lookupHashTable(table, (StgWord)key) == NULL)
379 insertStrHashTable(table, (StgWord)key, data);
384 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
386 "whilst processing object file\n"
388 "This could be caused by:\n"
389 " * Loading two different object files which export the same symbol\n"
390 " * Specifying the same object file twice on the GHCi command line\n"
391 " * An incorrect `package.conf' entry, causing some object to be\n"
393 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
402 /* -----------------------------------------------------------------------------
403 * initialize the object linker
405 #if defined(OBJFORMAT_ELF)
406 static void *dl_prog_handle;
414 symhash = allocStrHashTable();
416 /* populate the symbol table with stuff from the RTS */
417 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
418 ghciInsertStrHashTable("(GHCi built-in symbols)",
419 symhash, sym->lbl, sym->addr);
421 # if defined(OBJFORMAT_ELF)
422 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
426 /* -----------------------------------------------------------------------------
427 * Add a DLL from which symbols may be found. In the ELF case, just
428 * do RTLD_GLOBAL-style add, so no further messing around needs to
429 * happen in order that symbols in the loaded .so are findable --
430 * lookupSymbol() will subsequently see them by dlsym on the program's
431 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
433 * In the PEi386 case, open the DLLs and put handles to them in a
434 * linked list. When looking for a symbol, try all handles in the
438 #if defined(OBJFORMAT_PEi386)
439 /* A record for storing handles into DLLs. */
444 struct _OpenedDLL* next;
449 /* A list thereof. */
450 static OpenedDLL* opened_dlls = NULL;
456 addDLL ( __attribute((unused)) char* path, char* dll_name )
458 # if defined(OBJFORMAT_ELF)
463 if (path == NULL || strlen(path) == 0) {
464 buf = stgMallocBytes(strlen(dll_name) + 10, "addDll");
465 sprintf(buf, "lib%s.so", dll_name);
467 buf = stgMallocBytes(strlen(path) + 1 + strlen(dll_name) + 10, "addDll");
468 sprintf(buf, "%s/lib%s.so", path, dll_name);
470 hdl = dlopen(buf, RTLD_NOW | RTLD_GLOBAL );
473 /* dlopen failed; return a ptr to the error msg. */
475 if (errmsg == NULL) errmsg = "addDLL: unknown error";
482 # elif defined(OBJFORMAT_PEi386)
484 /* Add this DLL to the list of DLLs in which to search for symbols.
485 The path argument is ignored. */
490 /* fprintf(stderr, "\naddDLL; path=`%s', dll_name = `%s'\n", path, dll_name); */
492 /* See if we've already got it, and ignore if so. */
493 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
494 if (0 == strcmp(o_dll->name, dll_name))
498 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
499 sprintf(buf, "%s.DLL", dll_name);
500 instance = LoadLibrary(buf);
502 if (instance == NULL) {
503 /* LoadLibrary failed; return a ptr to the error msg. */
504 return "addDLL: unknown error";
507 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
508 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
509 strcpy(o_dll->name, dll_name);
510 o_dll->instance = instance;
511 o_dll->next = opened_dlls;
516 barf("addDLL: not implemented on this platform");
520 /* -----------------------------------------------------------------------------
521 * lookup a symbol in the hash table
524 lookupSymbol( char *lbl )
527 ASSERT(symhash != NULL);
528 val = lookupStrHashTable(symhash, lbl);
531 # if defined(OBJFORMAT_ELF)
532 return dlsym(dl_prog_handle, lbl);
533 # elif defined(OBJFORMAT_PEi386)
536 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
537 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
539 /* HACK: if the name has an initial underscore, try stripping
540 it off & look that up first. I've yet to verify whether there's
541 a Rule that governs whether an initial '_' *should always* be
542 stripped off when mapping from import lib name to the DLL name.
544 sym = GetProcAddress(o_dll->instance, (lbl+1));
546 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
550 sym = GetProcAddress(o_dll->instance, lbl);
552 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
568 lookupLocalSymbol( ObjectCode* oc, char *lbl )
571 val = lookupStrHashTable(oc->lochash, lbl);
581 /* -----------------------------------------------------------------------------
582 * Debugging aid: look in GHCi's object symbol tables for symbols
583 * within DELTA bytes of the specified address, and show their names.
586 void ghci_enquire ( char* addr );
588 void ghci_enquire ( char* addr )
593 const int DELTA = 64;
595 for (oc = objects; oc; oc = oc->next) {
596 for (i = 0; i < oc->n_symbols; i++) {
597 sym = oc->symbols[i];
598 if (sym == NULL) continue;
599 /* fprintf(stderr, "enquire %p %p\n", sym, oc->lochash); */
601 if (oc->lochash != NULL)
602 a = lookupStrHashTable(oc->lochash, sym);
604 a = lookupStrHashTable(symhash, sym);
606 /* fprintf(stderr, "ghci_enquire: can't find %s\n", sym); */
608 else if (addr-DELTA <= a && a <= addr+DELTA) {
609 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
617 /* -----------------------------------------------------------------------------
618 * Load an obj (populate the global symbol table, but don't resolve yet)
620 * Returns: 1 if ok, 0 on error.
623 loadObj( char *path )
630 /* fprintf(stderr, "loadObj %s\n", path ); */
632 /* Check that we haven't already loaded this object. Don't give up
633 at this stage; ocGetNames_* will barf later. */
637 for (o = objects; o; o = o->next) {
638 if (0 == strcmp(o->fileName, path))
644 "GHCi runtime linker: warning: looks like you're trying to load the\n"
645 "same object file twice:\n"
647 "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
653 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
655 # if defined(OBJFORMAT_ELF)
656 oc->formatName = "ELF";
657 # elif defined(OBJFORMAT_PEi386)
658 oc->formatName = "PEi386";
661 barf("loadObj: not implemented on this platform");
665 if (r == -1) { return 0; }
667 /* sigh, strdup() isn't a POSIX function, so do it the long way */
668 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
669 strcpy(oc->fileName, path);
671 oc->fileSize = st.st_size;
672 oc->image = stgMallocBytes( st.st_size, "loadObj(image)" );
675 oc->lochash = allocStrHashTable();
676 oc->proddables = NULL;
678 /* chain it onto the list of objects */
682 /* load the image into memory */
683 f = fopen(path, "rb");
685 barf("loadObj: can't read `%s'", path);
687 n = fread ( oc->image, 1, oc->fileSize, f );
688 if (n != oc->fileSize) {
690 barf("loadObj: error whilst reading `%s'", path);
693 /* verify the in-memory image */
694 # if defined(OBJFORMAT_ELF)
695 r = ocVerifyImage_ELF ( oc );
696 # elif defined(OBJFORMAT_PEi386)
697 r = ocVerifyImage_PEi386 ( oc );
699 barf("loadObj: no verify method");
701 if (!r) { return r; }
703 /* build the symbol list for this image */
704 # if defined(OBJFORMAT_ELF)
705 r = ocGetNames_ELF ( oc );
706 # elif defined(OBJFORMAT_PEi386)
707 r = ocGetNames_PEi386 ( oc );
709 barf("loadObj: no getNames method");
711 if (!r) { return r; }
713 /* loaded, but not resolved yet */
714 oc->status = OBJECT_LOADED;
719 /* -----------------------------------------------------------------------------
720 * resolve all the currently unlinked objects in memory
722 * Returns: 1 if ok, 0 on error.
730 for (oc = objects; oc; oc = oc->next) {
731 if (oc->status != OBJECT_RESOLVED) {
732 # if defined(OBJFORMAT_ELF)
733 r = ocResolve_ELF ( oc );
734 # elif defined(OBJFORMAT_PEi386)
735 r = ocResolve_PEi386 ( oc );
737 barf("resolveObjs: not implemented on this platform");
739 if (!r) { return r; }
740 oc->status = OBJECT_RESOLVED;
746 /* -----------------------------------------------------------------------------
747 * delete an object from the pool
750 unloadObj( char *path )
752 ObjectCode *oc, *prev;
754 ASSERT(symhash != NULL);
755 ASSERT(objects != NULL);
758 for (oc = objects; oc; prev = oc, oc = oc->next) {
759 if (!strcmp(oc->fileName,path)) {
761 /* Remove all the mappings for the symbols within this
766 for (i = 0; i < oc->n_symbols; i++) {
767 if (oc->symbols[i] != NULL) {
768 removeStrHashTable(symhash, oc->symbols[i], NULL);
776 prev->next = oc->next;
779 /* We're going to leave this in place, in case there are
780 any pointers from the heap into it: */
781 /* free(oc->image); */
785 /* The local hash table should have been freed at the end
786 of the ocResolve_ call on it. */
787 ASSERT(oc->lochash == NULL);
793 belch("unloadObj: can't find `%s' to unload", path);
797 /* -----------------------------------------------------------------------------
798 * Sanity checking. For each ObjectCode, maintain a list of address ranges
799 * which may be prodded during relocation, and abort if we try and write
800 * outside any of these.
802 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
805 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
806 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
810 pb->next = oc->proddables;
814 static void checkProddableBlock ( ObjectCode* oc, void* addr )
817 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
818 char* s = (char*)(pb->start);
819 char* e = s + pb->size - 1;
820 char* a = (char*)addr;
821 /* Assumes that the biggest fixup involves a 4-byte write. This
822 probably needs to be changed to 8 (ie, +7) on 64-bit
824 if (a >= s && (a+3) <= e) return;
826 barf("checkProddableBlock: invalid fixup in runtime linker");
829 /* -----------------------------------------------------------------------------
830 * Section management.
832 static void addSection ( ObjectCode* oc, SectionKind kind,
833 void* start, void* end )
835 Section* s = stgMallocBytes(sizeof(Section), "addSection");
839 s->next = oc->sections;
845 /* --------------------------------------------------------------------------
846 * PEi386 specifics (Win32 targets)
847 * ------------------------------------------------------------------------*/
849 /* The information for this linker comes from
850 Microsoft Portable Executable
851 and Common Object File Format Specification
852 revision 5.1 January 1998
853 which SimonM says comes from the MS Developer Network CDs.
857 #if defined(OBJFORMAT_PEi386)
861 typedef unsigned char UChar;
862 typedef unsigned short UInt16;
863 typedef unsigned int UInt32;
870 UInt16 NumberOfSections;
871 UInt32 TimeDateStamp;
872 UInt32 PointerToSymbolTable;
873 UInt32 NumberOfSymbols;
874 UInt16 SizeOfOptionalHeader;
875 UInt16 Characteristics;
879 #define sizeof_COFF_header 20
886 UInt32 VirtualAddress;
887 UInt32 SizeOfRawData;
888 UInt32 PointerToRawData;
889 UInt32 PointerToRelocations;
890 UInt32 PointerToLinenumbers;
891 UInt16 NumberOfRelocations;
892 UInt16 NumberOfLineNumbers;
893 UInt32 Characteristics;
897 #define sizeof_COFF_section 40
904 UInt16 SectionNumber;
907 UChar NumberOfAuxSymbols;
911 #define sizeof_COFF_symbol 18
916 UInt32 VirtualAddress;
917 UInt32 SymbolTableIndex;
922 #define sizeof_COFF_reloc 10
925 /* From PE spec doc, section 3.3.2 */
926 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
927 windows.h -- for the same purpose, but I want to know what I'm
929 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
930 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
931 #define MYIMAGE_FILE_DLL 0x2000
932 #define MYIMAGE_FILE_SYSTEM 0x1000
933 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
934 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
935 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
937 /* From PE spec doc, section 5.4.2 and 5.4.4 */
938 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
939 #define MYIMAGE_SYM_CLASS_STATIC 3
940 #define MYIMAGE_SYM_UNDEFINED 0
942 /* From PE spec doc, section 4.1 */
943 #define MYIMAGE_SCN_CNT_CODE 0x00000020
944 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
946 /* From PE spec doc, section 5.2.1 */
947 #define MYIMAGE_REL_I386_DIR32 0x0006
948 #define MYIMAGE_REL_I386_REL32 0x0014
951 /* We use myindex to calculate array addresses, rather than
952 simply doing the normal subscript thing. That's because
953 some of the above structs have sizes which are not
954 a whole number of words. GCC rounds their sizes up to a
955 whole number of words, which means that the address calcs
956 arising from using normal C indexing or pointer arithmetic
957 are just plain wrong. Sigh.
960 myindex ( int scale, void* base, int index )
963 ((UChar*)base) + scale * index;
968 printName ( UChar* name, UChar* strtab )
970 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
971 UInt32 strtab_offset = * (UInt32*)(name+4);
972 fprintf ( stderr, "%s", strtab + strtab_offset );
975 for (i = 0; i < 8; i++) {
976 if (name[i] == 0) break;
977 fprintf ( stderr, "%c", name[i] );
984 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
986 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
987 UInt32 strtab_offset = * (UInt32*)(name+4);
988 strncpy ( dst, strtab+strtab_offset, dstSize );
994 if (name[i] == 0) break;
1004 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1007 /* If the string is longer than 8 bytes, look in the
1008 string table for it -- this will be correctly zero terminated.
1010 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1011 UInt32 strtab_offset = * (UInt32*)(name+4);
1012 return ((UChar*)strtab) + strtab_offset;
1014 /* Otherwise, if shorter than 8 bytes, return the original,
1015 which by defn is correctly terminated.
1017 if (name[7]==0) return name;
1018 /* The annoying case: 8 bytes. Copy into a temporary
1019 (which is never freed ...)
1021 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1023 strncpy(newstr,name,8);
1029 /* Just compares the short names (first 8 chars) */
1030 static COFF_section *
1031 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1035 = (COFF_header*)(oc->image);
1036 COFF_section* sectab
1038 ((UChar*)(oc->image))
1039 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1041 for (i = 0; i < hdr->NumberOfSections; i++) {
1044 COFF_section* section_i
1046 myindex ( sizeof_COFF_section, sectab, i );
1047 n1 = (UChar*) &(section_i->Name);
1049 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1050 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1051 n1[6]==n2[6] && n1[7]==n2[7])
1060 zapTrailingAtSign ( UChar* sym )
1062 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1064 if (sym[0] == 0) return;
1066 while (sym[i] != 0) i++;
1069 while (j > 0 && my_isdigit(sym[j])) j--;
1070 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1076 ocVerifyImage_PEi386 ( ObjectCode* oc )
1080 COFF_section* sectab;
1081 COFF_symbol* symtab;
1083 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1084 hdr = (COFF_header*)(oc->image);
1085 sectab = (COFF_section*) (
1086 ((UChar*)(oc->image))
1087 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1089 symtab = (COFF_symbol*) (
1090 ((UChar*)(oc->image))
1091 + hdr->PointerToSymbolTable
1093 strtab = ((UChar*)symtab)
1094 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1096 if (hdr->Machine != 0x14c) {
1097 belch("Not x86 PEi386");
1100 if (hdr->SizeOfOptionalHeader != 0) {
1101 belch("PEi386 with nonempty optional header");
1104 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1105 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1106 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1107 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1108 belch("Not a PEi386 object file");
1111 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1112 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1113 belch("Invalid PEi386 word size or endiannness: %d",
1114 (int)(hdr->Characteristics));
1117 /* If the string table size is way crazy, this might indicate that
1118 there are more than 64k relocations, despite claims to the
1119 contrary. Hence this test. */
1120 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1121 if (* (UInt32*)strtab > 600000) {
1122 /* Note that 600k has no special significance other than being
1123 big enough to handle the almost-2MB-sized lumps that
1124 constitute HSwin32*.o. */
1125 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1129 /* No further verification after this point; only debug printing. */
1131 IF_DEBUG(linker, i=1);
1132 if (i == 0) return 1;
1135 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1137 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1139 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1141 fprintf ( stderr, "\n" );
1143 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1145 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1147 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1149 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1151 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1153 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1155 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1157 /* Print the section table. */
1158 fprintf ( stderr, "\n" );
1159 for (i = 0; i < hdr->NumberOfSections; i++) {
1161 COFF_section* sectab_i
1163 myindex ( sizeof_COFF_section, sectab, i );
1170 printName ( sectab_i->Name, strtab );
1180 sectab_i->VirtualSize,
1181 sectab_i->VirtualAddress,
1182 sectab_i->SizeOfRawData,
1183 sectab_i->PointerToRawData,
1184 sectab_i->NumberOfRelocations,
1185 sectab_i->PointerToRelocations,
1186 sectab_i->PointerToRawData
1188 reltab = (COFF_reloc*) (
1189 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1192 for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
1194 COFF_reloc* rel = (COFF_reloc*)
1195 myindex ( sizeof_COFF_reloc, reltab, j );
1197 " type 0x%-4x vaddr 0x%-8x name `",
1199 rel->VirtualAddress );
1200 sym = (COFF_symbol*)
1201 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1202 printName ( sym->Name, strtab -10 );
1203 fprintf ( stderr, "'\n" );
1206 fprintf ( stderr, "\n" );
1208 fprintf ( stderr, "\n" );
1209 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1210 fprintf ( stderr, "---START of string table---\n");
1211 for (i = 4; i < *(Int32*)strtab; i++) {
1213 fprintf ( stderr, "\n"); else
1214 fprintf( stderr, "%c", strtab[i] );
1216 fprintf ( stderr, "--- END of string table---\n");
1218 fprintf ( stderr, "\n" );
1221 COFF_symbol* symtab_i;
1222 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1223 symtab_i = (COFF_symbol*)
1224 myindex ( sizeof_COFF_symbol, symtab, i );
1230 printName ( symtab_i->Name, strtab );
1239 (Int32)(symtab_i->SectionNumber),
1240 (UInt32)symtab_i->Type,
1241 (UInt32)symtab_i->StorageClass,
1242 (UInt32)symtab_i->NumberOfAuxSymbols
1244 i += symtab_i->NumberOfAuxSymbols;
1248 fprintf ( stderr, "\n" );
1254 ocGetNames_PEi386 ( ObjectCode* oc )
1257 COFF_section* sectab;
1258 COFF_symbol* symtab;
1265 hdr = (COFF_header*)(oc->image);
1266 sectab = (COFF_section*) (
1267 ((UChar*)(oc->image))
1268 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1270 symtab = (COFF_symbol*) (
1271 ((UChar*)(oc->image))
1272 + hdr->PointerToSymbolTable
1274 strtab = ((UChar*)(oc->image))
1275 + hdr->PointerToSymbolTable
1276 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1278 /* Allocate space for any (local, anonymous) .bss sections. */
1280 for (i = 0; i < hdr->NumberOfSections; i++) {
1282 COFF_section* sectab_i
1284 myindex ( sizeof_COFF_section, sectab, i );
1285 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1286 if (sectab_i->VirtualSize == 0) continue;
1287 /* This is a non-empty .bss section. Allocate zeroed space for
1288 it, and set its PointerToRawData field such that oc->image +
1289 PointerToRawData == addr_of_zeroed_space. */
1290 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1291 "ocGetNames_PEi386(anonymous bss)");
1292 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1293 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1294 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1297 /* Copy section information into the ObjectCode. */
1299 for (i = 0; i < hdr->NumberOfSections; i++) {
1305 = SECTIONKIND_OTHER;
1306 COFF_section* sectab_i
1308 myindex ( sizeof_COFF_section, sectab, i );
1309 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1312 /* I'm sure this is the Right Way to do it. However, the
1313 alternative of testing the sectab_i->Name field seems to
1314 work ok with Cygwin.
1316 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1317 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1318 kind = SECTIONKIND_CODE_OR_RODATA;
1321 if (0==strcmp(".text",sectab_i->Name) ||
1322 0==strcmp(".rodata",sectab_i->Name))
1323 kind = SECTIONKIND_CODE_OR_RODATA;
1324 if (0==strcmp(".data",sectab_i->Name) ||
1325 0==strcmp(".bss",sectab_i->Name))
1326 kind = SECTIONKIND_RWDATA;
1328 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1329 sz = sectab_i->SizeOfRawData;
1330 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1332 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1333 end = start + sz - 1;
1335 if (kind == SECTIONKIND_OTHER
1336 /* Ignore sections called which contain stabs debugging
1338 && 0 != strcmp(".stab", sectab_i->Name)
1339 && 0 != strcmp(".stabstr", sectab_i->Name)
1341 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1345 if (kind != SECTIONKIND_OTHER && end >= start) {
1346 addSection(oc, kind, start, end);
1347 addProddableBlock(oc, start, end - start + 1);
1351 /* Copy exported symbols into the ObjectCode. */
1353 oc->n_symbols = hdr->NumberOfSymbols;
1354 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1355 "ocGetNames_PEi386(oc->symbols)");
1356 /* Call me paranoid; I don't care. */
1357 for (i = 0; i < oc->n_symbols; i++)
1358 oc->symbols[i] = NULL;
1362 COFF_symbol* symtab_i;
1363 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1364 symtab_i = (COFF_symbol*)
1365 myindex ( sizeof_COFF_symbol, symtab, i );
1369 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1370 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1371 /* This symbol is global and defined, viz, exported */
1372 /* for MYIMAGE_SYMCLASS_EXTERNAL
1373 && !MYIMAGE_SYM_UNDEFINED,
1374 the address of the symbol is:
1375 address of relevant section + offset in section
1377 COFF_section* sectabent
1378 = (COFF_section*) myindex ( sizeof_COFF_section,
1380 symtab_i->SectionNumber-1 );
1381 addr = ((UChar*)(oc->image))
1382 + (sectabent->PointerToRawData
1386 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1387 && symtab_i->Value > 0) {
1388 /* This symbol isn't in any section at all, ie, global bss.
1389 Allocate zeroed space for it. */
1390 addr = stgCallocBytes(1, symtab_i->Value,
1391 "ocGetNames_PEi386(non-anonymous bss)");
1392 addSection(oc, SECTIONKIND_RWDATA, addr,
1393 ((UChar*)addr) + symtab_i->Value - 1);
1394 addProddableBlock(oc, addr, symtab_i->Value);
1395 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1399 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1400 /* fprintf(stderr,"addSymbol %p `%s'\n", addr,sname); */
1401 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1402 ASSERT(i >= 0 && i < oc->n_symbols);
1403 /* cstring_from_COFF_symbol_name always succeeds. */
1404 oc->symbols[i] = sname;
1405 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1409 "IGNORING symbol %d\n"
1413 printName ( symtab_i->Name, strtab );
1422 (Int32)(symtab_i->SectionNumber),
1423 (UInt32)symtab_i->Type,
1424 (UInt32)symtab_i->StorageClass,
1425 (UInt32)symtab_i->NumberOfAuxSymbols
1430 i += symtab_i->NumberOfAuxSymbols;
1439 ocResolve_PEi386 ( ObjectCode* oc )
1442 COFF_section* sectab;
1443 COFF_symbol* symtab;
1452 /* ToDo: should be variable-sized? But is at least safe in the
1453 sense of buffer-overrun-proof. */
1455 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1457 hdr = (COFF_header*)(oc->image);
1458 sectab = (COFF_section*) (
1459 ((UChar*)(oc->image))
1460 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1462 symtab = (COFF_symbol*) (
1463 ((UChar*)(oc->image))
1464 + hdr->PointerToSymbolTable
1466 strtab = ((UChar*)(oc->image))
1467 + hdr->PointerToSymbolTable
1468 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1470 for (i = 0; i < hdr->NumberOfSections; i++) {
1471 COFF_section* sectab_i
1473 myindex ( sizeof_COFF_section, sectab, i );
1476 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1479 /* Ignore sections called which contain stabs debugging
1481 if (0 == strcmp(".stab", sectab_i->Name)
1482 || 0 == strcmp(".stabstr", sectab_i->Name))
1485 for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
1487 COFF_reloc* reltab_j
1489 myindex ( sizeof_COFF_reloc, reltab, j );
1491 /* the location to patch */
1493 ((UChar*)(oc->image))
1494 + (sectab_i->PointerToRawData
1495 + reltab_j->VirtualAddress
1496 - sectab_i->VirtualAddress )
1498 /* the existing contents of pP */
1500 /* the symbol to connect to */
1501 sym = (COFF_symbol*)
1502 myindex ( sizeof_COFF_symbol,
1503 symtab, reltab_j->SymbolTableIndex );
1506 "reloc sec %2d num %3d: type 0x%-4x "
1507 "vaddr 0x%-8x name `",
1509 (UInt32)reltab_j->Type,
1510 reltab_j->VirtualAddress );
1511 printName ( sym->Name, strtab );
1512 fprintf ( stderr, "'\n" ));
1514 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1515 COFF_section* section_sym
1516 = findPEi386SectionCalled ( oc, sym->Name );
1518 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1521 S = ((UInt32)(oc->image))
1522 + (section_sym->PointerToRawData
1525 copyName ( sym->Name, strtab, symbol, 1000-1 );
1526 (void*)S = lookupLocalSymbol( oc, symbol );
1527 if ((void*)S != NULL) goto foundit;
1528 (void*)S = lookupSymbol( symbol );
1529 if ((void*)S != NULL) goto foundit;
1530 zapTrailingAtSign ( symbol );
1531 (void*)S = lookupLocalSymbol( oc, symbol );
1532 if ((void*)S != NULL) goto foundit;
1533 (void*)S = lookupSymbol( symbol );
1534 if ((void*)S != NULL) goto foundit;
1535 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
1539 checkProddableBlock(oc, pP);
1540 switch (reltab_j->Type) {
1541 case MYIMAGE_REL_I386_DIR32:
1544 case MYIMAGE_REL_I386_REL32:
1545 /* Tricky. We have to insert a displacement at
1546 pP which, when added to the PC for the _next_
1547 insn, gives the address of the target (S).
1548 Problem is to know the address of the next insn
1549 when we only know pP. We assume that this
1550 literal field is always the last in the insn,
1551 so that the address of the next insn is pP+4
1552 -- hence the constant 4.
1553 Also I don't know if A should be added, but so
1554 far it has always been zero.
1557 *pP = S - ((UInt32)pP) - 4;
1560 belch("%s: unhandled PEi386 relocation type %d",
1561 oc->fileName, reltab_j->Type);
1568 IF_DEBUG(linker, belch("completed %s", oc->fileName));
1572 #endif /* defined(OBJFORMAT_PEi386) */
1575 /* --------------------------------------------------------------------------
1577 * ------------------------------------------------------------------------*/
1579 #if defined(OBJFORMAT_ELF)
1584 #if defined(sparc_TARGET_ARCH)
1585 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
1586 #elif defined(i386_TARGET_ARCH)
1587 # define ELF_TARGET_386 /* Used inside <elf.h> */
1589 /* There is a similar case for IA64 in the Solaris2 headers if this
1590 * ever becomes relevant.
1596 findElfSection ( void* objImage, Elf32_Word sh_type )
1599 char* ehdrC = (char*)objImage;
1600 Elf32_Ehdr* ehdr = (Elf32_Ehdr*)ehdrC;
1601 Elf32_Shdr* shdr = (Elf32_Shdr*)(ehdrC + ehdr->e_shoff);
1602 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1604 for (i = 0; i < ehdr->e_shnum; i++) {
1605 if (shdr[i].sh_type == sh_type
1606 /* Ignore the section header's string table. */
1607 && i != ehdr->e_shstrndx
1608 /* Ignore string tables named .stabstr, as they contain
1610 && 0 != strcmp(".stabstr", sh_strtab + shdr[i].sh_name)
1612 ptr = ehdrC + shdr[i].sh_offset;
1621 ocVerifyImage_ELF ( ObjectCode* oc )
1625 int i, j, nent, nstrtab, nsymtabs;
1629 char* ehdrC = (char*)(oc->image);
1630 Elf32_Ehdr* ehdr = ( Elf32_Ehdr*)ehdrC;
1632 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
1633 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
1634 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
1635 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
1636 belch("%s: not an ELF header", oc->fileName);
1639 IF_DEBUG(linker,belch( "Is an ELF header" ));
1641 if (ehdr->e_ident[EI_CLASS] != ELFCLASS32) {
1642 belch("%s: not 32 bit ELF", oc->fileName);
1646 IF_DEBUG(linker,belch( "Is 32 bit ELF" ));
1648 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
1649 IF_DEBUG(linker,belch( "Is little-endian" ));
1651 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
1652 IF_DEBUG(linker,belch( "Is big-endian" ));
1654 belch("%s: unknown endiannness", oc->fileName);
1658 if (ehdr->e_type != ET_REL) {
1659 belch("%s: not a relocatable object (.o) file", oc->fileName);
1662 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
1664 IF_DEBUG(linker,belch( "Architecture is " ));
1665 switch (ehdr->e_machine) {
1666 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
1667 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
1668 default: IF_DEBUG(linker,belch( "unknown" ));
1669 belch("%s: unknown architecture", oc->fileName);
1673 IF_DEBUG(linker,belch(
1674 "\nSection header table: start %d, n_entries %d, ent_size %d",
1675 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
1677 ASSERT (ehdr->e_shentsize == sizeof(Elf32_Shdr));
1679 shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1681 if (ehdr->e_shstrndx == SHN_UNDEF) {
1682 belch("%s: no section header string table", oc->fileName);
1685 IF_DEBUG(linker,belch( "Section header string table is section %d",
1687 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1690 for (i = 0; i < ehdr->e_shnum; i++) {
1691 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
1692 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
1693 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
1694 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
1695 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
1696 ehdrC + shdr[i].sh_offset,
1697 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
1699 if (shdr[i].sh_type == SHT_REL) {
1700 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
1701 } else if (shdr[i].sh_type == SHT_RELA) {
1702 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
1704 IF_DEBUG(linker,fprintf(stderr," "));
1707 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
1711 IF_DEBUG(linker,belch( "\nString tables" ));
1714 for (i = 0; i < ehdr->e_shnum; i++) {
1715 if (shdr[i].sh_type == SHT_STRTAB
1716 /* Ignore the section header's string table. */
1717 && i != ehdr->e_shstrndx
1718 /* Ignore string tables named .stabstr, as they contain
1720 && 0 != strcmp(".stabstr", sh_strtab + shdr[i].sh_name)
1722 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
1723 strtab = ehdrC + shdr[i].sh_offset;
1728 belch("%s: no string tables, or too many", oc->fileName);
1733 IF_DEBUG(linker,belch( "\nSymbol tables" ));
1734 for (i = 0; i < ehdr->e_shnum; i++) {
1735 if (shdr[i].sh_type != SHT_SYMTAB) continue;
1736 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
1738 stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1739 nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1740 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
1742 shdr[i].sh_size % sizeof(Elf32_Sym)
1744 if (0 != shdr[i].sh_size % sizeof(Elf32_Sym)) {
1745 belch("%s: non-integral number of symbol table entries", oc->fileName);
1748 for (j = 0; j < nent; j++) {
1749 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
1750 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
1751 (int)stab[j].st_shndx,
1752 (int)stab[j].st_size,
1753 (char*)stab[j].st_value ));
1755 IF_DEBUG(linker,fprintf(stderr, "type=" ));
1756 switch (ELF32_ST_TYPE(stab[j].st_info)) {
1757 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
1758 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
1759 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
1760 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
1761 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
1762 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
1764 IF_DEBUG(linker,fprintf(stderr, " " ));
1766 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
1767 switch (ELF32_ST_BIND(stab[j].st_info)) {
1768 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
1769 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
1770 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
1771 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
1773 IF_DEBUG(linker,fprintf(stderr, " " ));
1775 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
1779 if (nsymtabs == 0) {
1780 belch("%s: didn't find any symbol tables", oc->fileName);
1789 ocGetNames_ELF ( ObjectCode* oc )
1794 char* ehdrC = (char*)(oc->image);
1795 Elf32_Ehdr* ehdr = (Elf32_Ehdr*)ehdrC;
1796 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
1797 Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1798 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1800 ASSERT(symhash != NULL);
1803 belch("%s: no strtab", oc->fileName);
1808 for (i = 0; i < ehdr->e_shnum; i++) {
1810 /* make a section entry for relevant sections */
1811 SectionKind kind = SECTIONKIND_OTHER;
1812 if (!strcmp(".data",sh_strtab+shdr[i].sh_name) ||
1813 !strcmp(".data1",sh_strtab+shdr[i].sh_name) ||
1814 !strcmp(".bss",sh_strtab+shdr[i].sh_name))
1815 kind = SECTIONKIND_RWDATA;
1816 if (!strcmp(".text",sh_strtab+shdr[i].sh_name) ||
1817 !strcmp(".rodata",sh_strtab+shdr[i].sh_name) ||
1818 !strcmp(".rodata1",sh_strtab+shdr[i].sh_name))
1819 kind = SECTIONKIND_CODE_OR_RODATA;
1821 if (!strcmp(".bss",sh_strtab+shdr[i].sh_name) && shdr[i].sh_size > 0) {
1822 /* This is a non-empty .bss section. Allocate zeroed space for
1823 it, and set its .sh_offset field such that
1824 ehdrC + .sh_offset == addr_of_zeroed_space. */
1825 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
1826 "ocGetNames_ELF(BSS)");
1827 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
1829 fprintf(stderr, "BSS section at 0x%x, size %d\n",
1830 zspace, shdr[i].sh_size);
1834 /* fill in the section info */
1835 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
1836 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
1837 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0)
1838 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
1840 if (shdr[i].sh_type != SHT_SYMTAB) continue;
1842 /* copy stuff into this module's object symbol table */
1843 stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1844 nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1846 oc->n_symbols = nent;
1847 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1848 "ocGetNames_ELF(oc->symbols)");
1850 for (j = 0; j < nent; j++) {
1852 char isLocal = FALSE; /* avoids uninit-var warning */
1854 char* nm = strtab + stab[j].st_name;
1855 int secno = stab[j].st_shndx;
1857 /* Figure out if we want to add it; if so, set ad to its
1858 address. Otherwise leave ad == NULL. */
1860 if (secno == SHN_COMMON) {
1862 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
1864 fprintf(stderr, "COMMON symbol, size %d name %s\n",
1865 stab[j].st_size, nm);
1867 /* Pointless to do addProddableBlock() for this area,
1868 since the linker should never poke around in it. */
1871 if ( ( ELF32_ST_BIND(stab[j].st_info)==STB_GLOBAL
1872 || ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL
1874 /* and not an undefined symbol */
1875 && stab[j].st_shndx != SHN_UNDEF
1876 /* and not in a "special section" */
1877 && stab[j].st_shndx < SHN_LORESERVE
1879 /* and it's a not a section or string table or anything silly */
1880 ( ELF32_ST_TYPE(stab[j].st_info)==STT_FUNC ||
1881 ELF32_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
1882 ELF32_ST_TYPE(stab[j].st_info)==STT_NOTYPE
1885 /* Section 0 is the undefined section, hence > and not >=. */
1886 ASSERT(secno > 0 && secno < ehdr->e_shnum);
1888 if (shdr[secno].sh_type == SHT_NOBITS) {
1889 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
1890 stab[j].st_size, stab[j].st_value, nm);
1893 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
1894 if (ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL) {
1895 IF_DEBUG(linker,belch( "addOTabName(LOCL): %10p %s %s",
1896 ad, oc->fileName, nm ));
1899 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
1900 ad, oc->fileName, nm ));
1905 /* And the decision is ... */
1909 oc->symbols[j] = nm;
1912 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, ad);
1914 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
1918 IF_DEBUG(linker,belch( "skipping `%s'",
1919 strtab + stab[j].st_name ));
1922 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
1923 (int)ELF32_ST_BIND(stab[j].st_info),
1924 (int)ELF32_ST_TYPE(stab[j].st_info),
1925 (int)stab[j].st_shndx,
1926 strtab + stab[j].st_name
1929 oc->symbols[j] = NULL;
1939 /* Do ELF relocations which lack an explicit addend. All x86-linux
1940 relocations appear to be of this form. */
1942 do_Elf32_Rel_relocations ( ObjectCode* oc, char* ehdrC,
1943 Elf32_Shdr* shdr, int shnum,
1944 Elf32_Sym* stab, char* strtab )
1949 Elf32_Rel* rtab = (Elf32_Rel*) (ehdrC + shdr[shnum].sh_offset);
1950 int nent = shdr[shnum].sh_size / sizeof(Elf32_Rel);
1951 int target_shndx = shdr[shnum].sh_info;
1952 int symtab_shndx = shdr[shnum].sh_link;
1953 stab = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
1954 targ = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
1955 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
1956 target_shndx, symtab_shndx ));
1957 for (j = 0; j < nent; j++) {
1958 Elf32_Addr offset = rtab[j].r_offset;
1959 Elf32_Word info = rtab[j].r_info;
1961 Elf32_Addr P = ((Elf32_Addr)targ) + offset;
1962 Elf32_Word* pP = (Elf32_Word*)P;
1966 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
1967 j, (void*)offset, (void*)info ));
1969 IF_DEBUG(linker,belch( " ZERO" ));
1972 /* First see if it is a nameless local symbol. */
1973 if (stab[ ELF32_R_SYM(info)].st_name == 0) {
1974 symbol = "(noname)";
1976 (ehdrC + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset
1977 + stab[ELF32_R_SYM(info)].st_value);
1979 /* No? Should be in a symbol table then; first try the
1981 symbol = strtab+stab[ ELF32_R_SYM(info)].st_name;
1982 (void*)S = lookupLocalSymbol( oc, symbol );
1983 if ((void*)S == NULL)
1984 (void*)S = lookupSymbol( symbol );
1987 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
1990 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
1992 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
1993 (void*)P, (void*)S, (void*)A ));
1994 checkProddableBlock ( oc, pP );
1995 switch (ELF32_R_TYPE(info)) {
1996 # ifdef i386_TARGET_ARCH
1997 case R_386_32: *pP = S + A; break;
1998 case R_386_PC32: *pP = S + A - P; break;
2001 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2002 oc->fileName, ELF32_R_TYPE(info));
2011 /* Do ELF relocations for which explicit addends are supplied.
2012 sparc-solaris relocations appear to be of this form. */
2014 do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2015 Elf32_Shdr* shdr, int shnum,
2016 Elf32_Sym* stab, char* strtab )
2021 Elf32_Rela* rtab = (Elf32_Rela*) (ehdrC + shdr[shnum].sh_offset);
2022 int nent = shdr[shnum].sh_size / sizeof(Elf32_Rela);
2023 int target_shndx = shdr[shnum].sh_info;
2024 int symtab_shndx = shdr[shnum].sh_link;
2025 stab = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2026 targ = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2027 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2028 target_shndx, symtab_shndx ));
2029 for (j = 0; j < nent; j++) {
2030 Elf32_Addr offset = rtab[j].r_offset;
2031 Elf32_Word info = rtab[j].r_info;
2032 Elf32_Sword addend = rtab[j].r_addend;
2033 Elf32_Addr P = ((Elf32_Addr)targ) + offset;
2034 Elf32_Addr A = addend;
2036 # if defined(sparc_TARGET_ARCH)
2037 /* This #ifdef only serves to avoid unused-var warnings. */
2038 Elf32_Word* pP = (Elf32_Word*)P;
2042 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2043 j, (void*)offset, (void*)info,
2046 IF_DEBUG(linker,belch( " ZERO" ));
2049 /* First see if it is a nameless local symbol. */
2050 if (stab[ ELF32_R_SYM(info)].st_name == 0) {
2051 symbol = "(noname)";
2053 (ehdrC + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset
2054 + stab[ELF32_R_SYM(info)].st_value);
2056 /* No? Should be in a symbol table then; first try the
2058 symbol = strtab+stab[ ELF32_R_SYM(info)].st_name;
2059 (void*)S = lookupLocalSymbol( oc, symbol );
2060 if ((void*)S == NULL)
2061 (void*)S = lookupSymbol( symbol );
2064 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2068 fprintf ( stderr, "S %p A %p S+A %p S+A-P %p\n",S,A,S+A,S+A-P);
2071 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2073 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2074 (void*)P, (void*)S, (void*)A ));
2075 checkProddableBlock ( oc, (void*)P );
2076 switch (ELF32_R_TYPE(info)) {
2077 # if defined(sparc_TARGET_ARCH)
2078 case R_SPARC_WDISP30:
2079 w1 = *pP & 0xC0000000;
2080 w2 = (Elf32_Word)((S + A - P) >> 2);
2081 ASSERT((w2 & 0xC0000000) == 0);
2086 w1 = *pP & 0xFFC00000;
2087 w2 = (Elf32_Word)((S + A) >> 10);
2088 ASSERT((w2 & 0xFFC00000) == 0);
2094 w2 = (Elf32_Word)((S + A) & 0x3FF);
2095 ASSERT((w2 & ~0x3FF) == 0);
2099 /* According to the Sun documentation:
2101 This relocation type resembles R_SPARC_32, except it refers to an
2102 unaligned word. That is, the word to be relocated must be treated
2103 as four separate bytes with arbitrary alignment, not as a word
2104 aligned according to the architecture requirements.
2106 (JRS: which means that freeloading on the R_SPARC_32 case
2107 is probably wrong, but hey ...)
2111 w2 = (Elf32_Word)(S + A);
2116 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2117 oc->fileName, ELF32_R_TYPE(info));
2127 ocResolve_ELF ( ObjectCode* oc )
2131 Elf32_Sym* stab = NULL;
2132 char* ehdrC = (char*)(oc->image);
2133 Elf32_Ehdr* ehdr = (Elf32_Ehdr*) ehdrC;
2134 Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
2135 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2137 /* first find "the" symbol table */
2138 stab = (Elf32_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2140 /* also go find the string table */
2141 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2143 if (stab == NULL || strtab == NULL) {
2144 belch("%s: can't find string or symbol table", oc->fileName);
2148 /* Process the relocation sections. */
2149 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2151 /* Skip sections called ".rel.stab". These appear to contain
2152 relocation entries that, when done, make the stabs debugging
2153 info point at the right places. We ain't interested in all
2155 if (0 == strcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name))
2158 if (shdr[shnum].sh_type == SHT_REL ) {
2159 ok = do_Elf32_Rel_relocations ( oc, ehdrC, shdr,
2160 shnum, stab, strtab );
2164 if (shdr[shnum].sh_type == SHT_RELA) {
2165 ok = do_Elf32_Rela_relocations ( oc, ehdrC, shdr,
2166 shnum, stab, strtab );
2172 /* Free the local symbol table; we won't need it again. */
2173 freeHashTable(oc->lochash, NULL);