1 /* -----------------------------------------------------------------------------
2 * $Id: Linker.c,v 1.98 2002/07/08 14:38:26 simonpj Exp $
4 * (c) The GHC Team, 2000, 2001
8 * ---------------------------------------------------------------------------*/
11 #include "PosixSource.h"
18 #include "LinkerInternals.h"
20 #include "StoragePriv.h"
23 #ifdef HAVE_SYS_TYPES_H
24 #include <sys/types.h>
27 #ifdef HAVE_SYS_STAT_H
35 #if defined(cygwin32_TARGET_OS)
40 #ifdef HAVE_SYS_TIME_H
44 #include <sys/fcntl.h>
45 #include <sys/termios.h>
46 #include <sys/utime.h>
47 #include <sys/utsname.h>
51 #if defined(ia64_TARGET_ARCH)
57 #if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS)
58 # define OBJFORMAT_ELF
59 #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
60 # define OBJFORMAT_PEi386
62 #elif defined(darwin_TARGET_OS)
63 # define OBJFORMAT_MACHO
64 # include <mach-o/loader.h>
65 # include <mach-o/nlist.h>
66 # include <mach-o/reloc.h>
69 /* Hash table mapping symbol names to Symbol */
70 /*Str*/HashTable *symhash;
72 #if defined(OBJFORMAT_ELF)
73 static int ocVerifyImage_ELF ( ObjectCode* oc );
74 static int ocGetNames_ELF ( ObjectCode* oc );
75 static int ocResolve_ELF ( ObjectCode* oc );
76 #elif defined(OBJFORMAT_PEi386)
77 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
78 static int ocGetNames_PEi386 ( ObjectCode* oc );
79 static int ocResolve_PEi386 ( ObjectCode* oc );
80 #elif defined(OBJFORMAT_MACHO)
81 static int ocVerifyImage_MachO ( ObjectCode* oc );
82 static int ocGetNames_MachO ( ObjectCode* oc );
83 static int ocResolve_MachO ( ObjectCode* oc );
86 /* -----------------------------------------------------------------------------
87 * Built-in symbols from the RTS
90 typedef struct _RtsSymbolVal {
97 #define Maybe_ForeignObj SymX(mkForeignObjzh_fast)
99 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
100 SymX(makeStableNamezh_fast) \
101 SymX(finalizzeWeakzh_fast)
103 /* These are not available in GUM!!! -- HWL */
104 #define Maybe_ForeignObj
105 #define Maybe_Stable_Names
108 #if !defined (mingw32_TARGET_OS)
109 #define RTS_POSIX_ONLY_SYMBOLS \
110 SymX(stg_sig_install) \
114 #if defined (cygwin32_TARGET_OS)
115 #define RTS_MINGW_ONLY_SYMBOLS /**/
116 /* Don't have the ability to read import libs / archives, so
117 * we have to stupidly list a lot of what libcygwin.a
120 #define RTS_CYGWIN_ONLY_SYMBOLS \
202 #elif !defined(mingw32_TARGET_OS)
203 #define RTS_MINGW_ONLY_SYMBOLS /**/
204 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
205 #else /* defined(mingw32_TARGET_OS) */
206 #define RTS_POSIX_ONLY_SYMBOLS /**/
207 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
209 /* These are statically linked from the mingw libraries into the ghc
210 executable, so we have to employ this hack. */
211 #define RTS_MINGW_ONLY_SYMBOLS \
223 SymX(getservbyname) \
224 SymX(getservbyport) \
225 SymX(getprotobynumber) \
226 SymX(getprotobyname) \
227 SymX(gethostbyname) \
228 SymX(gethostbyaddr) \
263 Sym(_imp___timezone) \
279 # define MAIN_CAP_SYM SymX(MainCapability)
281 # define MAIN_CAP_SYM
284 #define RTS_SYMBOLS \
288 Sym(__stginit_GHCziPrim) \
299 Sym(stg_enterStackTop) \
302 SymX(__stg_gc_enter_1) \
303 SymX(stg_gc_enter_2) \
304 SymX(stg_gc_enter_3) \
305 SymX(stg_gc_enter_4) \
306 SymX(stg_gc_enter_5) \
307 SymX(stg_gc_enter_6) \
308 SymX(stg_gc_enter_7) \
309 SymX(stg_gc_enter_8) \
311 SymX(stg_gc_noregs) \
313 SymX(stg_gc_unbx_r1) \
314 SymX(stg_gc_unpt_r1) \
315 SymX(stg_gc_ut_0_1) \
316 SymX(stg_gc_ut_1_0) \
318 SymX(stg_yield_to_interpreter) \
321 SymX(MallocFailHook) \
322 SymX(NoRunnableThreadsHook) \
324 SymX(OutOfHeapHook) \
325 SymX(PatErrorHdrHook) \
326 SymX(PostTraceHook) \
328 SymX(StackOverflowHook) \
329 SymX(__encodeDouble) \
330 SymX(__encodeFloat) \
333 SymX(__gmpz_cmp_si) \
334 SymX(__gmpz_cmp_ui) \
335 SymX(__gmpz_get_si) \
336 SymX(__gmpz_get_ui) \
337 SymX(__int_encodeDouble) \
338 SymX(__int_encodeFloat) \
339 SymX(andIntegerzh_fast) \
340 SymX(blockAsyncExceptionszh_fast) \
343 SymX(complementIntegerzh_fast) \
344 SymX(cmpIntegerzh_fast) \
345 SymX(cmpIntegerIntzh_fast) \
346 SymX(createAdjustor) \
347 SymX(decodeDoublezh_fast) \
348 SymX(decodeFloatzh_fast) \
351 SymX(deRefWeakzh_fast) \
352 SymX(deRefStablePtrzh_fast) \
353 SymX(divExactIntegerzh_fast) \
354 SymX(divModIntegerzh_fast) \
356 SymX(forkProcesszh_fast) \
357 SymX(freeHaskellFunctionPtr) \
358 SymX(freeStablePtr) \
359 SymX(gcdIntegerzh_fast) \
360 SymX(gcdIntegerIntzh_fast) \
361 SymX(gcdIntzh_fast) \
364 SymX(int2Integerzh_fast) \
365 SymX(integer2Intzh_fast) \
366 SymX(integer2Wordzh_fast) \
367 SymX(isDoubleDenormalized) \
368 SymX(isDoubleInfinite) \
370 SymX(isDoubleNegativeZero) \
371 SymX(isEmptyMVarzh_fast) \
372 SymX(isFloatDenormalized) \
373 SymX(isFloatInfinite) \
375 SymX(isFloatNegativeZero) \
376 SymX(killThreadzh_fast) \
377 SymX(makeStablePtrzh_fast) \
378 SymX(minusIntegerzh_fast) \
379 SymX(mkApUpd0zh_fast) \
380 SymX(myThreadIdzh_fast) \
381 SymX(labelThreadzh_fast) \
382 SymX(newArrayzh_fast) \
383 SymX(newBCOzh_fast) \
384 SymX(newByteArrayzh_fast) \
386 SymX(newMVarzh_fast) \
387 SymX(newMutVarzh_fast) \
388 SymX(newPinnedByteArrayzh_fast) \
389 SymX(orIntegerzh_fast) \
391 SymX(plusIntegerzh_fast) \
394 SymX(putMVarzh_fast) \
395 SymX(quotIntegerzh_fast) \
396 SymX(quotRemIntegerzh_fast) \
398 SymX(remIntegerzh_fast) \
399 SymX(resetNonBlockingFd) \
402 SymX(rts_checkSchedStatus) \
405 SymX(rts_evalLazyIO) \
410 SymX(rts_getDouble) \
415 SymX(rts_getStablePtr) \
416 SymX(rts_getThreadId) \
418 SymX(rts_getWord32) \
430 SymX(rts_mkStablePtr) \
439 SymX(shutdownHaskellAndExit) \
440 SymX(stable_ptr_table) \
441 SymX(stackOverflow) \
442 SymX(stg_CAF_BLACKHOLE_info) \
443 SymX(stg_CHARLIKE_closure) \
444 SymX(stg_EMPTY_MVAR_info) \
445 SymX(stg_IND_STATIC_info) \
446 SymX(stg_INTLIKE_closure) \
447 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
448 SymX(stg_WEAK_info) \
449 SymX(stg_ap_1_upd_info) \
450 SymX(stg_ap_2_upd_info) \
451 SymX(stg_ap_3_upd_info) \
452 SymX(stg_ap_4_upd_info) \
453 SymX(stg_ap_5_upd_info) \
454 SymX(stg_ap_6_upd_info) \
455 SymX(stg_ap_7_upd_info) \
456 SymX(stg_ap_8_upd_info) \
458 SymX(stg_sel_0_upd_info) \
459 SymX(stg_sel_10_upd_info) \
460 SymX(stg_sel_11_upd_info) \
461 SymX(stg_sel_12_upd_info) \
462 SymX(stg_sel_13_upd_info) \
463 SymX(stg_sel_14_upd_info) \
464 SymX(stg_sel_15_upd_info) \
465 SymX(stg_sel_1_upd_info) \
466 SymX(stg_sel_2_upd_info) \
467 SymX(stg_sel_3_upd_info) \
468 SymX(stg_sel_4_upd_info) \
469 SymX(stg_sel_5_upd_info) \
470 SymX(stg_sel_6_upd_info) \
471 SymX(stg_sel_7_upd_info) \
472 SymX(stg_sel_8_upd_info) \
473 SymX(stg_sel_9_upd_info) \
474 SymX(stg_seq_frame_info) \
475 SymX(stg_upd_frame_info) \
476 SymX(__stg_update_PAP) \
477 SymX(suspendThread) \
478 SymX(takeMVarzh_fast) \
479 SymX(timesIntegerzh_fast) \
480 SymX(tryPutMVarzh_fast) \
481 SymX(tryTakeMVarzh_fast) \
482 SymX(unblockAsyncExceptionszh_fast) \
483 SymX(unsafeThawArrayzh_fast) \
484 SymX(waitReadzh_fast) \
485 SymX(waitWritezh_fast) \
486 SymX(word2Integerzh_fast) \
487 SymX(xorIntegerzh_fast) \
490 #ifdef SUPPORT_LONG_LONGS
491 #define RTS_LONG_LONG_SYMS \
492 SymX(int64ToIntegerzh_fast) \
493 SymX(word64ToIntegerzh_fast)
495 #define RTS_LONG_LONG_SYMS /* nothing */
498 #ifdef ia64_TARGET_ARCH
499 /* force these symbols to be present */
500 #define RTS_EXTRA_SYMBOLS \
502 #elif defined(powerpc_TARGET_ARCH)
503 #define RTS_EXTRA_SYMBOLS \
513 #define RTS_EXTRA_SYMBOLS /* nothing */
516 /* entirely bogus claims about types of these symbols */
517 #define Sym(vvv) extern void (vvv);
518 #define SymX(vvv) /**/
522 RTS_POSIX_ONLY_SYMBOLS
523 RTS_MINGW_ONLY_SYMBOLS
524 RTS_CYGWIN_ONLY_SYMBOLS
528 #ifdef LEADING_UNDERSCORE
529 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
531 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
534 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
536 #define SymX(vvv) Sym(vvv)
538 static RtsSymbolVal rtsSyms[] = {
542 RTS_POSIX_ONLY_SYMBOLS
543 RTS_MINGW_ONLY_SYMBOLS
544 RTS_CYGWIN_ONLY_SYMBOLS
545 { 0, 0 } /* sentinel */
548 /* -----------------------------------------------------------------------------
549 * Insert symbols into hash tables, checking for duplicates.
551 static void ghciInsertStrHashTable ( char* obj_name,
557 if (lookupHashTable(table, (StgWord)key) == NULL)
559 insertStrHashTable(table, (StgWord)key, data);
564 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
566 "whilst processing object file\n"
568 "This could be caused by:\n"
569 " * Loading two different object files which export the same symbol\n"
570 " * Specifying the same object file twice on the GHCi command line\n"
571 " * An incorrect `package.conf' entry, causing some object to be\n"
573 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
582 /* -----------------------------------------------------------------------------
583 * initialize the object linker
585 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
586 static void *dl_prog_handle;
594 symhash = allocStrHashTable();
596 /* populate the symbol table with stuff from the RTS */
597 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
598 ghciInsertStrHashTable("(GHCi built-in symbols)",
599 symhash, sym->lbl, sym->addr);
601 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
602 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
606 /* -----------------------------------------------------------------------------
607 * Add a DLL from which symbols may be found. In the ELF case, just
608 * do RTLD_GLOBAL-style add, so no further messing around needs to
609 * happen in order that symbols in the loaded .so are findable --
610 * lookupSymbol() will subsequently see them by dlsym on the program's
611 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
613 * In the PEi386 case, open the DLLs and put handles to them in a
614 * linked list. When looking for a symbol, try all handles in the
618 #if defined(OBJFORMAT_PEi386)
619 /* A record for storing handles into DLLs. */
624 struct _OpenedDLL* next;
629 /* A list thereof. */
630 static OpenedDLL* opened_dlls = NULL;
636 addDLL( char *dll_name )
638 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
642 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
644 /* dlopen failed; return a ptr to the error msg. */
646 if (errmsg == NULL) errmsg = "addDLL: unknown error";
653 # elif defined(OBJFORMAT_PEi386)
655 /* Add this DLL to the list of DLLs in which to search for symbols.
656 The path argument is ignored. */
661 /* fprintf(stderr, "\naddDLL; path=`%s', dll_name = `%s'\n", path, dll_name); */
663 /* See if we've already got it, and ignore if so. */
664 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
665 if (0 == strcmp(o_dll->name, dll_name))
669 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
670 sprintf(buf, "%s.DLL", dll_name);
671 instance = LoadLibrary(buf);
672 if (instance == NULL) {
673 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
674 instance = LoadLibrary(buf);
675 if (instance == NULL) {
678 /* LoadLibrary failed; return a ptr to the error msg. */
679 return "addDLL: unknown error";
684 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
685 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
686 strcpy(o_dll->name, dll_name);
687 o_dll->instance = instance;
688 o_dll->next = opened_dlls;
693 barf("addDLL: not implemented on this platform");
697 /* -----------------------------------------------------------------------------
698 * lookup a symbol in the hash table
701 lookupSymbol( char *lbl )
704 ASSERT(symhash != NULL);
705 val = lookupStrHashTable(symhash, lbl);
708 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
709 return dlsym(dl_prog_handle, lbl);
710 # elif defined(OBJFORMAT_PEi386)
713 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
714 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
716 /* HACK: if the name has an initial underscore, try stripping
717 it off & look that up first. I've yet to verify whether there's
718 a Rule that governs whether an initial '_' *should always* be
719 stripped off when mapping from import lib name to the DLL name.
721 sym = GetProcAddress(o_dll->instance, (lbl+1));
723 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
727 sym = GetProcAddress(o_dll->instance, lbl);
729 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
744 __attribute((unused))
746 lookupLocalSymbol( ObjectCode* oc, char *lbl )
749 val = lookupStrHashTable(oc->lochash, lbl);
759 /* -----------------------------------------------------------------------------
760 * Debugging aid: look in GHCi's object symbol tables for symbols
761 * within DELTA bytes of the specified address, and show their names.
764 void ghci_enquire ( char* addr );
766 void ghci_enquire ( char* addr )
771 const int DELTA = 64;
773 for (oc = objects; oc; oc = oc->next) {
774 for (i = 0; i < oc->n_symbols; i++) {
775 sym = oc->symbols[i];
776 if (sym == NULL) continue;
777 /* fprintf(stderr, "enquire %p %p\n", sym, oc->lochash); */
779 if (oc->lochash != NULL)
780 a = lookupStrHashTable(oc->lochash, sym);
782 a = lookupStrHashTable(symhash, sym);
784 /* fprintf(stderr, "ghci_enquire: can't find %s\n", sym); */
786 else if (addr-DELTA <= a && a <= addr+DELTA) {
787 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
794 #ifdef ia64_TARGET_ARCH
795 static unsigned int PLTSize(void);
798 /* -----------------------------------------------------------------------------
799 * Load an obj (populate the global symbol table, but don't resolve yet)
801 * Returns: 1 if ok, 0 on error.
804 loadObj( char *path )
816 /* fprintf(stderr, "loadObj %s\n", path ); */
818 /* Check that we haven't already loaded this object. Don't give up
819 at this stage; ocGetNames_* will barf later. */
823 for (o = objects; o; o = o->next) {
824 if (0 == strcmp(o->fileName, path))
830 "GHCi runtime linker: warning: looks like you're trying to load the\n"
831 "same object file twice:\n"
833 "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
839 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
841 # if defined(OBJFORMAT_ELF)
842 oc->formatName = "ELF";
843 # elif defined(OBJFORMAT_PEi386)
844 oc->formatName = "PEi386";
845 # elif defined(OBJFORMAT_MACHO)
846 oc->formatName = "Mach-O";
849 barf("loadObj: not implemented on this platform");
853 if (r == -1) { return 0; }
855 /* sigh, strdup() isn't a POSIX function, so do it the long way */
856 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
857 strcpy(oc->fileName, path);
859 oc->fileSize = st.st_size;
862 oc->lochash = allocStrHashTable();
863 oc->proddables = NULL;
865 /* chain it onto the list of objects */
870 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
872 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
874 fd = open(path, O_RDONLY);
876 barf("loadObj: can't open `%s'", path);
878 pagesize = getpagesize();
880 #ifdef ia64_TARGET_ARCH
881 /* The PLT needs to be right before the object */
882 n = ROUND_UP(PLTSize(), pagesize);
883 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
884 if (oc->plt == MAP_FAILED)
885 barf("loadObj: can't allocate PLT");
888 map_addr = oc->plt + n;
891 n = ROUND_UP(oc->fileSize, pagesize);
892 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
893 if (oc->image == MAP_FAILED)
894 barf("loadObj: can't map `%s'", path);
898 #else /* !USE_MMAP */
900 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
902 /* load the image into memory */
903 f = fopen(path, "rb");
905 barf("loadObj: can't read `%s'", path);
907 n = fread ( oc->image, 1, oc->fileSize, f );
908 if (n != oc->fileSize)
909 barf("loadObj: error whilst reading `%s'", path);
913 #endif /* USE_MMAP */
915 /* verify the in-memory image */
916 # if defined(OBJFORMAT_ELF)
917 r = ocVerifyImage_ELF ( oc );
918 # elif defined(OBJFORMAT_PEi386)
919 r = ocVerifyImage_PEi386 ( oc );
920 # elif defined(OBJFORMAT_MACHO)
921 r = ocVerifyImage_MachO ( oc );
923 barf("loadObj: no verify method");
925 if (!r) { return r; }
927 /* build the symbol list for this image */
928 # if defined(OBJFORMAT_ELF)
929 r = ocGetNames_ELF ( oc );
930 # elif defined(OBJFORMAT_PEi386)
931 r = ocGetNames_PEi386 ( oc );
932 # elif defined(OBJFORMAT_MACHO)
933 r = ocGetNames_MachO ( oc );
935 barf("loadObj: no getNames method");
937 if (!r) { return r; }
939 /* loaded, but not resolved yet */
940 oc->status = OBJECT_LOADED;
945 /* -----------------------------------------------------------------------------
946 * resolve all the currently unlinked objects in memory
948 * Returns: 1 if ok, 0 on error.
956 for (oc = objects; oc; oc = oc->next) {
957 if (oc->status != OBJECT_RESOLVED) {
958 # if defined(OBJFORMAT_ELF)
959 r = ocResolve_ELF ( oc );
960 # elif defined(OBJFORMAT_PEi386)
961 r = ocResolve_PEi386 ( oc );
962 # elif defined(OBJFORMAT_MACHO)
963 r = ocResolve_MachO ( oc );
965 barf("resolveObjs: not implemented on this platform");
967 if (!r) { return r; }
968 oc->status = OBJECT_RESOLVED;
974 /* -----------------------------------------------------------------------------
975 * delete an object from the pool
978 unloadObj( char *path )
980 ObjectCode *oc, *prev;
982 ASSERT(symhash != NULL);
983 ASSERT(objects != NULL);
986 for (oc = objects; oc; prev = oc, oc = oc->next) {
987 if (!strcmp(oc->fileName,path)) {
989 /* Remove all the mappings for the symbols within this
994 for (i = 0; i < oc->n_symbols; i++) {
995 if (oc->symbols[i] != NULL) {
996 removeStrHashTable(symhash, oc->symbols[i], NULL);
1004 prev->next = oc->next;
1007 /* We're going to leave this in place, in case there are
1008 any pointers from the heap into it: */
1009 /* free(oc->image); */
1013 /* The local hash table should have been freed at the end
1014 of the ocResolve_ call on it. */
1015 ASSERT(oc->lochash == NULL);
1021 belch("unloadObj: can't find `%s' to unload", path);
1025 /* -----------------------------------------------------------------------------
1026 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1027 * which may be prodded during relocation, and abort if we try and write
1028 * outside any of these.
1030 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1033 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1034 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1038 pb->next = oc->proddables;
1039 oc->proddables = pb;
1042 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1045 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1046 char* s = (char*)(pb->start);
1047 char* e = s + pb->size - 1;
1048 char* a = (char*)addr;
1049 /* Assumes that the biggest fixup involves a 4-byte write. This
1050 probably needs to be changed to 8 (ie, +7) on 64-bit
1052 if (a >= s && (a+3) <= e) return;
1054 barf("checkProddableBlock: invalid fixup in runtime linker");
1057 /* -----------------------------------------------------------------------------
1058 * Section management.
1060 static void addSection ( ObjectCode* oc, SectionKind kind,
1061 void* start, void* end )
1063 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1067 s->next = oc->sections;
1070 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1071 start, ((char*)end)-1, end - start + 1, kind );
1077 /* --------------------------------------------------------------------------
1078 * PEi386 specifics (Win32 targets)
1079 * ------------------------------------------------------------------------*/
1081 /* The information for this linker comes from
1082 Microsoft Portable Executable
1083 and Common Object File Format Specification
1084 revision 5.1 January 1998
1085 which SimonM says comes from the MS Developer Network CDs.
1087 It can be found there (on older CDs), but can also be found
1090 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1092 (this is Rev 6.0 from February 1999).
1094 Things move, so if that fails, try searching for it via
1096 http://www.google.com/search?q=PE+COFF+specification
1098 The ultimate reference for the PE format is the Winnt.h
1099 header file that comes with the Platform SDKs; as always,
1100 implementations will drift wrt their documentation.
1102 A good background article on the PE format is Matt Pietrek's
1103 March 1994 article in Microsoft System Journal (MSJ)
1104 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1105 Win32 Portable Executable File Format." The info in there
1106 has recently been updated in a two part article in
1107 MSDN magazine, issues Feb and March 2002,
1108 "Inside Windows: An In-Depth Look into the Win32 Portable
1109 Executable File Format"
1111 John Levine's book "Linkers and Loaders" contains useful
1116 #if defined(OBJFORMAT_PEi386)
1120 typedef unsigned char UChar;
1121 typedef unsigned short UInt16;
1122 typedef unsigned int UInt32;
1129 UInt16 NumberOfSections;
1130 UInt32 TimeDateStamp;
1131 UInt32 PointerToSymbolTable;
1132 UInt32 NumberOfSymbols;
1133 UInt16 SizeOfOptionalHeader;
1134 UInt16 Characteristics;
1138 #define sizeof_COFF_header 20
1145 UInt32 VirtualAddress;
1146 UInt32 SizeOfRawData;
1147 UInt32 PointerToRawData;
1148 UInt32 PointerToRelocations;
1149 UInt32 PointerToLinenumbers;
1150 UInt16 NumberOfRelocations;
1151 UInt16 NumberOfLineNumbers;
1152 UInt32 Characteristics;
1156 #define sizeof_COFF_section 40
1163 UInt16 SectionNumber;
1166 UChar NumberOfAuxSymbols;
1170 #define sizeof_COFF_symbol 18
1175 UInt32 VirtualAddress;
1176 UInt32 SymbolTableIndex;
1181 #define sizeof_COFF_reloc 10
1184 /* From PE spec doc, section 3.3.2 */
1185 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1186 windows.h -- for the same purpose, but I want to know what I'm
1188 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1189 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1190 #define MYIMAGE_FILE_DLL 0x2000
1191 #define MYIMAGE_FILE_SYSTEM 0x1000
1192 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1193 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1194 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1196 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1197 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1198 #define MYIMAGE_SYM_CLASS_STATIC 3
1199 #define MYIMAGE_SYM_UNDEFINED 0
1201 /* From PE spec doc, section 4.1 */
1202 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1203 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1204 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1206 /* From PE spec doc, section 5.2.1 */
1207 #define MYIMAGE_REL_I386_DIR32 0x0006
1208 #define MYIMAGE_REL_I386_REL32 0x0014
1211 /* We use myindex to calculate array addresses, rather than
1212 simply doing the normal subscript thing. That's because
1213 some of the above structs have sizes which are not
1214 a whole number of words. GCC rounds their sizes up to a
1215 whole number of words, which means that the address calcs
1216 arising from using normal C indexing or pointer arithmetic
1217 are just plain wrong. Sigh.
1220 myindex ( int scale, void* base, int index )
1223 ((UChar*)base) + scale * index;
1228 printName ( UChar* name, UChar* strtab )
1230 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1231 UInt32 strtab_offset = * (UInt32*)(name+4);
1232 fprintf ( stderr, "%s", strtab + strtab_offset );
1235 for (i = 0; i < 8; i++) {
1236 if (name[i] == 0) break;
1237 fprintf ( stderr, "%c", name[i] );
1244 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1246 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1247 UInt32 strtab_offset = * (UInt32*)(name+4);
1248 strncpy ( dst, strtab+strtab_offset, dstSize );
1254 if (name[i] == 0) break;
1264 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1267 /* If the string is longer than 8 bytes, look in the
1268 string table for it -- this will be correctly zero terminated.
1270 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1271 UInt32 strtab_offset = * (UInt32*)(name+4);
1272 return ((UChar*)strtab) + strtab_offset;
1274 /* Otherwise, if shorter than 8 bytes, return the original,
1275 which by defn is correctly terminated.
1277 if (name[7]==0) return name;
1278 /* The annoying case: 8 bytes. Copy into a temporary
1279 (which is never freed ...)
1281 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1283 strncpy(newstr,name,8);
1289 /* Just compares the short names (first 8 chars) */
1290 static COFF_section *
1291 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1295 = (COFF_header*)(oc->image);
1296 COFF_section* sectab
1298 ((UChar*)(oc->image))
1299 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1301 for (i = 0; i < hdr->NumberOfSections; i++) {
1304 COFF_section* section_i
1306 myindex ( sizeof_COFF_section, sectab, i );
1307 n1 = (UChar*) &(section_i->Name);
1309 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1310 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1311 n1[6]==n2[6] && n1[7]==n2[7])
1320 zapTrailingAtSign ( UChar* sym )
1322 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1324 if (sym[0] == 0) return;
1326 while (sym[i] != 0) i++;
1329 while (j > 0 && my_isdigit(sym[j])) j--;
1330 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1336 ocVerifyImage_PEi386 ( ObjectCode* oc )
1341 COFF_section* sectab;
1342 COFF_symbol* symtab;
1344 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1345 hdr = (COFF_header*)(oc->image);
1346 sectab = (COFF_section*) (
1347 ((UChar*)(oc->image))
1348 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1350 symtab = (COFF_symbol*) (
1351 ((UChar*)(oc->image))
1352 + hdr->PointerToSymbolTable
1354 strtab = ((UChar*)symtab)
1355 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1357 if (hdr->Machine != 0x14c) {
1358 belch("Not x86 PEi386");
1361 if (hdr->SizeOfOptionalHeader != 0) {
1362 belch("PEi386 with nonempty optional header");
1365 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1366 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1367 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1368 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1369 belch("Not a PEi386 object file");
1372 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1373 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1374 belch("Invalid PEi386 word size or endiannness: %d",
1375 (int)(hdr->Characteristics));
1378 /* If the string table size is way crazy, this might indicate that
1379 there are more than 64k relocations, despite claims to the
1380 contrary. Hence this test. */
1381 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1383 if ( (*(UInt32*)strtab) > 600000 ) {
1384 /* Note that 600k has no special significance other than being
1385 big enough to handle the almost-2MB-sized lumps that
1386 constitute HSwin32*.o. */
1387 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1392 /* No further verification after this point; only debug printing. */
1394 IF_DEBUG(linker, i=1);
1395 if (i == 0) return 1;
1398 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1400 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1402 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1404 fprintf ( stderr, "\n" );
1406 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1408 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1410 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1412 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1414 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1416 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1418 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1420 /* Print the section table. */
1421 fprintf ( stderr, "\n" );
1422 for (i = 0; i < hdr->NumberOfSections; i++) {
1424 COFF_section* sectab_i
1426 myindex ( sizeof_COFF_section, sectab, i );
1433 printName ( sectab_i->Name, strtab );
1443 sectab_i->VirtualSize,
1444 sectab_i->VirtualAddress,
1445 sectab_i->SizeOfRawData,
1446 sectab_i->PointerToRawData,
1447 sectab_i->NumberOfRelocations,
1448 sectab_i->PointerToRelocations,
1449 sectab_i->PointerToRawData
1451 reltab = (COFF_reloc*) (
1452 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1455 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1456 /* If the relocation field (a short) has overflowed, the
1457 * real count can be found in the first reloc entry.
1459 * See Section 4.1 (last para) of the PE spec (rev6.0).
1461 COFF_reloc* rel = (COFF_reloc*)
1462 myindex ( sizeof_COFF_reloc, reltab, 0 );
1463 noRelocs = rel->VirtualAddress;
1466 noRelocs = sectab_i->NumberOfRelocations;
1470 for (; j < noRelocs; j++) {
1472 COFF_reloc* rel = (COFF_reloc*)
1473 myindex ( sizeof_COFF_reloc, reltab, j );
1475 " type 0x%-4x vaddr 0x%-8x name `",
1477 rel->VirtualAddress );
1478 sym = (COFF_symbol*)
1479 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1480 /* Hmm..mysterious looking offset - what's it for? SOF */
1481 printName ( sym->Name, strtab -10 );
1482 fprintf ( stderr, "'\n" );
1485 fprintf ( stderr, "\n" );
1487 fprintf ( stderr, "\n" );
1488 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1489 fprintf ( stderr, "---START of string table---\n");
1490 for (i = 4; i < *(Int32*)strtab; i++) {
1492 fprintf ( stderr, "\n"); else
1493 fprintf( stderr, "%c", strtab[i] );
1495 fprintf ( stderr, "--- END of string table---\n");
1497 fprintf ( stderr, "\n" );
1500 COFF_symbol* symtab_i;
1501 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1502 symtab_i = (COFF_symbol*)
1503 myindex ( sizeof_COFF_symbol, symtab, i );
1509 printName ( symtab_i->Name, strtab );
1518 (Int32)(symtab_i->SectionNumber),
1519 (UInt32)symtab_i->Type,
1520 (UInt32)symtab_i->StorageClass,
1521 (UInt32)symtab_i->NumberOfAuxSymbols
1523 i += symtab_i->NumberOfAuxSymbols;
1527 fprintf ( stderr, "\n" );
1533 ocGetNames_PEi386 ( ObjectCode* oc )
1536 COFF_section* sectab;
1537 COFF_symbol* symtab;
1544 hdr = (COFF_header*)(oc->image);
1545 sectab = (COFF_section*) (
1546 ((UChar*)(oc->image))
1547 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1549 symtab = (COFF_symbol*) (
1550 ((UChar*)(oc->image))
1551 + hdr->PointerToSymbolTable
1553 strtab = ((UChar*)(oc->image))
1554 + hdr->PointerToSymbolTable
1555 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1557 /* Allocate space for any (local, anonymous) .bss sections. */
1559 for (i = 0; i < hdr->NumberOfSections; i++) {
1561 COFF_section* sectab_i
1563 myindex ( sizeof_COFF_section, sectab, i );
1564 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1565 if (sectab_i->VirtualSize == 0) continue;
1566 /* This is a non-empty .bss section. Allocate zeroed space for
1567 it, and set its PointerToRawData field such that oc->image +
1568 PointerToRawData == addr_of_zeroed_space. */
1569 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1570 "ocGetNames_PEi386(anonymous bss)");
1571 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1572 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1573 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1576 /* Copy section information into the ObjectCode. */
1578 for (i = 0; i < hdr->NumberOfSections; i++) {
1584 = SECTIONKIND_OTHER;
1585 COFF_section* sectab_i
1587 myindex ( sizeof_COFF_section, sectab, i );
1588 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1591 /* I'm sure this is the Right Way to do it. However, the
1592 alternative of testing the sectab_i->Name field seems to
1593 work ok with Cygwin.
1595 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1596 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1597 kind = SECTIONKIND_CODE_OR_RODATA;
1600 if (0==strcmp(".text",sectab_i->Name) ||
1601 0==strcmp(".rodata",sectab_i->Name))
1602 kind = SECTIONKIND_CODE_OR_RODATA;
1603 if (0==strcmp(".data",sectab_i->Name) ||
1604 0==strcmp(".bss",sectab_i->Name))
1605 kind = SECTIONKIND_RWDATA;
1607 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1608 sz = sectab_i->SizeOfRawData;
1609 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1611 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1612 end = start + sz - 1;
1614 if (kind == SECTIONKIND_OTHER
1615 /* Ignore sections called which contain stabs debugging
1617 && 0 != strcmp(".stab", sectab_i->Name)
1618 && 0 != strcmp(".stabstr", sectab_i->Name)
1620 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1624 if (kind != SECTIONKIND_OTHER && end >= start) {
1625 addSection(oc, kind, start, end);
1626 addProddableBlock(oc, start, end - start + 1);
1630 /* Copy exported symbols into the ObjectCode. */
1632 oc->n_symbols = hdr->NumberOfSymbols;
1633 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1634 "ocGetNames_PEi386(oc->symbols)");
1635 /* Call me paranoid; I don't care. */
1636 for (i = 0; i < oc->n_symbols; i++)
1637 oc->symbols[i] = NULL;
1641 COFF_symbol* symtab_i;
1642 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1643 symtab_i = (COFF_symbol*)
1644 myindex ( sizeof_COFF_symbol, symtab, i );
1648 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1649 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1650 /* This symbol is global and defined, viz, exported */
1651 /* for MYIMAGE_SYMCLASS_EXTERNAL
1652 && !MYIMAGE_SYM_UNDEFINED,
1653 the address of the symbol is:
1654 address of relevant section + offset in section
1656 COFF_section* sectabent
1657 = (COFF_section*) myindex ( sizeof_COFF_section,
1659 symtab_i->SectionNumber-1 );
1660 addr = ((UChar*)(oc->image))
1661 + (sectabent->PointerToRawData
1665 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1666 && symtab_i->Value > 0) {
1667 /* This symbol isn't in any section at all, ie, global bss.
1668 Allocate zeroed space for it. */
1669 addr = stgCallocBytes(1, symtab_i->Value,
1670 "ocGetNames_PEi386(non-anonymous bss)");
1671 addSection(oc, SECTIONKIND_RWDATA, addr,
1672 ((UChar*)addr) + symtab_i->Value - 1);
1673 addProddableBlock(oc, addr, symtab_i->Value);
1674 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1677 if (addr != NULL ) {
1678 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1679 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1680 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1681 ASSERT(i >= 0 && i < oc->n_symbols);
1682 /* cstring_from_COFF_symbol_name always succeeds. */
1683 oc->symbols[i] = sname;
1684 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1688 "IGNORING symbol %d\n"
1692 printName ( symtab_i->Name, strtab );
1701 (Int32)(symtab_i->SectionNumber),
1702 (UInt32)symtab_i->Type,
1703 (UInt32)symtab_i->StorageClass,
1704 (UInt32)symtab_i->NumberOfAuxSymbols
1709 i += symtab_i->NumberOfAuxSymbols;
1718 ocResolve_PEi386 ( ObjectCode* oc )
1721 COFF_section* sectab;
1722 COFF_symbol* symtab;
1732 /* ToDo: should be variable-sized? But is at least safe in the
1733 sense of buffer-overrun-proof. */
1735 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1737 hdr = (COFF_header*)(oc->image);
1738 sectab = (COFF_section*) (
1739 ((UChar*)(oc->image))
1740 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1742 symtab = (COFF_symbol*) (
1743 ((UChar*)(oc->image))
1744 + hdr->PointerToSymbolTable
1746 strtab = ((UChar*)(oc->image))
1747 + hdr->PointerToSymbolTable
1748 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1750 for (i = 0; i < hdr->NumberOfSections; i++) {
1751 COFF_section* sectab_i
1753 myindex ( sizeof_COFF_section, sectab, i );
1756 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1759 /* Ignore sections called which contain stabs debugging
1761 if (0 == strcmp(".stab", sectab_i->Name)
1762 || 0 == strcmp(".stabstr", sectab_i->Name))
1765 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1766 /* If the relocation field (a short) has overflowed, the
1767 * real count can be found in the first reloc entry.
1769 * See Section 4.1 (last para) of the PE spec (rev6.0).
1771 COFF_reloc* rel = (COFF_reloc*)
1772 myindex ( sizeof_COFF_reloc, reltab, 0 );
1773 noRelocs = rel->VirtualAddress;
1774 fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
1777 noRelocs = sectab_i->NumberOfRelocations;
1782 for (; j < noRelocs; j++) {
1784 COFF_reloc* reltab_j
1786 myindex ( sizeof_COFF_reloc, reltab, j );
1788 /* the location to patch */
1790 ((UChar*)(oc->image))
1791 + (sectab_i->PointerToRawData
1792 + reltab_j->VirtualAddress
1793 - sectab_i->VirtualAddress )
1795 /* the existing contents of pP */
1797 /* the symbol to connect to */
1798 sym = (COFF_symbol*)
1799 myindex ( sizeof_COFF_symbol,
1800 symtab, reltab_j->SymbolTableIndex );
1803 "reloc sec %2d num %3d: type 0x%-4x "
1804 "vaddr 0x%-8x name `",
1806 (UInt32)reltab_j->Type,
1807 reltab_j->VirtualAddress );
1808 printName ( sym->Name, strtab );
1809 fprintf ( stderr, "'\n" ));
1811 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1812 COFF_section* section_sym
1813 = findPEi386SectionCalled ( oc, sym->Name );
1815 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1818 S = ((UInt32)(oc->image))
1819 + (section_sym->PointerToRawData
1822 copyName ( sym->Name, strtab, symbol, 1000-1 );
1823 (void*)S = lookupLocalSymbol( oc, symbol );
1824 if ((void*)S != NULL) goto foundit;
1825 (void*)S = lookupSymbol( symbol );
1826 if ((void*)S != NULL) goto foundit;
1827 zapTrailingAtSign ( symbol );
1828 (void*)S = lookupLocalSymbol( oc, symbol );
1829 if ((void*)S != NULL) goto foundit;
1830 (void*)S = lookupSymbol( symbol );
1831 if ((void*)S != NULL) goto foundit;
1832 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
1836 checkProddableBlock(oc, pP);
1837 switch (reltab_j->Type) {
1838 case MYIMAGE_REL_I386_DIR32:
1841 case MYIMAGE_REL_I386_REL32:
1842 /* Tricky. We have to insert a displacement at
1843 pP which, when added to the PC for the _next_
1844 insn, gives the address of the target (S).
1845 Problem is to know the address of the next insn
1846 when we only know pP. We assume that this
1847 literal field is always the last in the insn,
1848 so that the address of the next insn is pP+4
1849 -- hence the constant 4.
1850 Also I don't know if A should be added, but so
1851 far it has always been zero.
1854 *pP = S - ((UInt32)pP) - 4;
1857 belch("%s: unhandled PEi386 relocation type %d",
1858 oc->fileName, reltab_j->Type);
1865 IF_DEBUG(linker, belch("completed %s", oc->fileName));
1869 #endif /* defined(OBJFORMAT_PEi386) */
1872 /* --------------------------------------------------------------------------
1874 * ------------------------------------------------------------------------*/
1876 #if defined(OBJFORMAT_ELF)
1881 #if defined(sparc_TARGET_ARCH)
1882 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
1883 #elif defined(i386_TARGET_ARCH)
1884 # define ELF_TARGET_386 /* Used inside <elf.h> */
1885 #elif defined (ia64_TARGET_ARCH)
1886 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
1888 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
1889 # define ELF_NEED_GOT /* needs Global Offset Table */
1890 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
1896 * Define a set of types which can be used for both ELF32 and ELF64
1900 #define ELFCLASS ELFCLASS64
1901 #define Elf_Addr Elf64_Addr
1902 #define Elf_Word Elf64_Word
1903 #define Elf_Sword Elf64_Sword
1904 #define Elf_Ehdr Elf64_Ehdr
1905 #define Elf_Phdr Elf64_Phdr
1906 #define Elf_Shdr Elf64_Shdr
1907 #define Elf_Sym Elf64_Sym
1908 #define Elf_Rel Elf64_Rel
1909 #define Elf_Rela Elf64_Rela
1910 #define ELF_ST_TYPE ELF64_ST_TYPE
1911 #define ELF_ST_BIND ELF64_ST_BIND
1912 #define ELF_R_TYPE ELF64_R_TYPE
1913 #define ELF_R_SYM ELF64_R_SYM
1915 #define ELFCLASS ELFCLASS32
1916 #define Elf_Addr Elf32_Addr
1917 #define Elf_Word Elf32_Word
1918 #define Elf_Sword Elf32_Sword
1919 #define Elf_Ehdr Elf32_Ehdr
1920 #define Elf_Phdr Elf32_Phdr
1921 #define Elf_Shdr Elf32_Shdr
1922 #define Elf_Sym Elf32_Sym
1923 #define Elf_Rel Elf32_Rel
1924 #define Elf_Rela Elf32_Rela
1925 #define ELF_ST_TYPE ELF32_ST_TYPE
1926 #define ELF_ST_BIND ELF32_ST_BIND
1927 #define ELF_R_TYPE ELF32_R_TYPE
1928 #define ELF_R_SYM ELF32_R_SYM
1933 * Functions to allocate entries in dynamic sections. Currently we simply
1934 * preallocate a large number, and we don't check if a entry for the given
1935 * target already exists (a linear search is too slow). Ideally these
1936 * entries would be associated with symbols.
1939 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
1940 #define GOT_SIZE 0x20000
1941 #define FUNCTION_TABLE_SIZE 0x10000
1942 #define PLT_SIZE 0x08000
1945 static Elf_Addr got[GOT_SIZE];
1946 static unsigned int gotIndex;
1947 static Elf_Addr gp_val = (Elf_Addr)got;
1950 allocateGOTEntry(Elf_Addr target)
1954 if (gotIndex >= GOT_SIZE)
1955 barf("Global offset table overflow");
1957 entry = &got[gotIndex++];
1959 return (Elf_Addr)entry;
1963 #ifdef ELF_FUNCTION_DESC
1969 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
1970 static unsigned int functionTableIndex;
1973 allocateFunctionDesc(Elf_Addr target)
1975 FunctionDesc *entry;
1977 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
1978 barf("Function table overflow");
1980 entry = &functionTable[functionTableIndex++];
1982 entry->gp = (Elf_Addr)gp_val;
1983 return (Elf_Addr)entry;
1987 copyFunctionDesc(Elf_Addr target)
1989 FunctionDesc *olddesc = (FunctionDesc *)target;
1990 FunctionDesc *newdesc;
1992 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
1993 newdesc->gp = olddesc->gp;
1994 return (Elf_Addr)newdesc;
1999 #ifdef ia64_TARGET_ARCH
2000 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2001 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2003 static unsigned char plt_code[] =
2005 /* taken from binutils bfd/elfxx-ia64.c */
2006 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2007 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2008 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2009 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2010 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2011 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2014 /* If we can't get to the function descriptor via gp, take a local copy of it */
2015 #define PLT_RELOC(code, target) { \
2016 Elf64_Sxword rel_value = target - gp_val; \
2017 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2018 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2020 ia64_reloc_gprel22((Elf_Addr)code, target); \
2025 unsigned char code[sizeof(plt_code)];
2029 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2031 PLTEntry *plt = (PLTEntry *)oc->plt;
2034 if (oc->pltIndex >= PLT_SIZE)
2035 barf("Procedure table overflow");
2037 entry = &plt[oc->pltIndex++];
2038 memcpy(entry->code, plt_code, sizeof(entry->code));
2039 PLT_RELOC(entry->code, target);
2040 return (Elf_Addr)entry;
2046 return (PLT_SIZE * sizeof(PLTEntry));
2052 * Generic ELF functions
2056 findElfSection ( void* objImage, Elf_Word sh_type )
2058 char* ehdrC = (char*)objImage;
2059 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2060 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2061 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2065 for (i = 0; i < ehdr->e_shnum; i++) {
2066 if (shdr[i].sh_type == sh_type
2067 /* Ignore the section header's string table. */
2068 && i != ehdr->e_shstrndx
2069 /* Ignore string tables named .stabstr, as they contain
2071 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2073 ptr = ehdrC + shdr[i].sh_offset;
2080 #if defined(ia64_TARGET_ARCH)
2082 findElfSegment ( void* objImage, Elf_Addr vaddr )
2084 char* ehdrC = (char*)objImage;
2085 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2086 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2087 Elf_Addr segaddr = 0;
2090 for (i = 0; i < ehdr->e_phnum; i++) {
2091 segaddr = phdr[i].p_vaddr;
2092 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2100 ocVerifyImage_ELF ( ObjectCode* oc )
2104 int i, j, nent, nstrtab, nsymtabs;
2108 char* ehdrC = (char*)(oc->image);
2109 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2111 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2112 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2113 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2114 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2115 belch("%s: not an ELF object", oc->fileName);
2119 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2120 belch("%s: unsupported ELF format", oc->fileName);
2124 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2125 IF_DEBUG(linker,belch( "Is little-endian" ));
2127 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2128 IF_DEBUG(linker,belch( "Is big-endian" ));
2130 belch("%s: unknown endiannness", oc->fileName);
2134 if (ehdr->e_type != ET_REL) {
2135 belch("%s: not a relocatable object (.o) file", oc->fileName);
2138 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2140 IF_DEBUG(linker,belch( "Architecture is " ));
2141 switch (ehdr->e_machine) {
2142 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
2143 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2145 case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2147 default: IF_DEBUG(linker,belch( "unknown" ));
2148 belch("%s: unknown architecture", oc->fileName);
2152 IF_DEBUG(linker,belch(
2153 "\nSection header table: start %d, n_entries %d, ent_size %d",
2154 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2156 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2158 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2160 if (ehdr->e_shstrndx == SHN_UNDEF) {
2161 belch("%s: no section header string table", oc->fileName);
2164 IF_DEBUG(linker,belch( "Section header string table is section %d",
2166 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2169 for (i = 0; i < ehdr->e_shnum; i++) {
2170 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
2171 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
2172 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
2173 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
2174 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
2175 ehdrC + shdr[i].sh_offset,
2176 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2178 if (shdr[i].sh_type == SHT_REL) {
2179 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
2180 } else if (shdr[i].sh_type == SHT_RELA) {
2181 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2183 IF_DEBUG(linker,fprintf(stderr," "));
2186 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2190 IF_DEBUG(linker,belch( "\nString tables" ));
2193 for (i = 0; i < ehdr->e_shnum; i++) {
2194 if (shdr[i].sh_type == SHT_STRTAB
2195 /* Ignore the section header's string table. */
2196 && i != ehdr->e_shstrndx
2197 /* Ignore string tables named .stabstr, as they contain
2199 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2201 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
2202 strtab = ehdrC + shdr[i].sh_offset;
2207 belch("%s: no string tables, or too many", oc->fileName);
2212 IF_DEBUG(linker,belch( "\nSymbol tables" ));
2213 for (i = 0; i < ehdr->e_shnum; i++) {
2214 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2215 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2217 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2218 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2219 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
2221 shdr[i].sh_size % sizeof(Elf_Sym)
2223 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2224 belch("%s: non-integral number of symbol table entries", oc->fileName);
2227 for (j = 0; j < nent; j++) {
2228 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
2229 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
2230 (int)stab[j].st_shndx,
2231 (int)stab[j].st_size,
2232 (char*)stab[j].st_value ));
2234 IF_DEBUG(linker,fprintf(stderr, "type=" ));
2235 switch (ELF_ST_TYPE(stab[j].st_info)) {
2236 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2237 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2238 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
2239 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2240 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
2241 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2243 IF_DEBUG(linker,fprintf(stderr, " " ));
2245 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2246 switch (ELF_ST_BIND(stab[j].st_info)) {
2247 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2248 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2249 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
2250 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2252 IF_DEBUG(linker,fprintf(stderr, " " ));
2254 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2258 if (nsymtabs == 0) {
2259 belch("%s: didn't find any symbol tables", oc->fileName);
2268 ocGetNames_ELF ( ObjectCode* oc )
2273 char* ehdrC = (char*)(oc->image);
2274 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2275 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2276 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2278 ASSERT(symhash != NULL);
2281 belch("%s: no strtab", oc->fileName);
2286 for (i = 0; i < ehdr->e_shnum; i++) {
2287 /* Figure out what kind of section it is. Logic derived from
2288 Figure 1.14 ("Special Sections") of the ELF document
2289 ("Portable Formats Specification, Version 1.1"). */
2290 Elf_Shdr hdr = shdr[i];
2291 SectionKind kind = SECTIONKIND_OTHER;
2294 if (hdr.sh_type == SHT_PROGBITS
2295 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2296 /* .text-style section */
2297 kind = SECTIONKIND_CODE_OR_RODATA;
2300 if (hdr.sh_type == SHT_PROGBITS
2301 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2302 /* .data-style section */
2303 kind = SECTIONKIND_RWDATA;
2306 if (hdr.sh_type == SHT_PROGBITS
2307 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2308 /* .rodata-style section */
2309 kind = SECTIONKIND_CODE_OR_RODATA;
2312 if (hdr.sh_type == SHT_NOBITS
2313 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2314 /* .bss-style section */
2315 kind = SECTIONKIND_RWDATA;
2319 if (is_bss && shdr[i].sh_size > 0) {
2320 /* This is a non-empty .bss section. Allocate zeroed space for
2321 it, and set its .sh_offset field such that
2322 ehdrC + .sh_offset == addr_of_zeroed_space. */
2323 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2324 "ocGetNames_ELF(BSS)");
2325 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2327 fprintf(stderr, "BSS section at 0x%x, size %d\n",
2328 zspace, shdr[i].sh_size);
2332 /* fill in the section info */
2333 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2334 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2335 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2336 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2339 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2341 /* copy stuff into this module's object symbol table */
2342 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2343 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2345 oc->n_symbols = nent;
2346 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2347 "ocGetNames_ELF(oc->symbols)");
2349 for (j = 0; j < nent; j++) {
2351 char isLocal = FALSE; /* avoids uninit-var warning */
2353 char* nm = strtab + stab[j].st_name;
2354 int secno = stab[j].st_shndx;
2356 /* Figure out if we want to add it; if so, set ad to its
2357 address. Otherwise leave ad == NULL. */
2359 if (secno == SHN_COMMON) {
2361 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2363 fprintf(stderr, "COMMON symbol, size %d name %s\n",
2364 stab[j].st_size, nm);
2366 /* Pointless to do addProddableBlock() for this area,
2367 since the linker should never poke around in it. */
2370 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2371 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2373 /* and not an undefined symbol */
2374 && stab[j].st_shndx != SHN_UNDEF
2375 /* and not in a "special section" */
2376 && stab[j].st_shndx < SHN_LORESERVE
2378 /* and it's a not a section or string table or anything silly */
2379 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2380 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2381 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2384 /* Section 0 is the undefined section, hence > and not >=. */
2385 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2387 if (shdr[secno].sh_type == SHT_NOBITS) {
2388 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2389 stab[j].st_size, stab[j].st_value, nm);
2392 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2393 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2396 #ifdef ELF_FUNCTION_DESC
2397 /* dlsym() and the initialisation table both give us function
2398 * descriptors, so to be consistent we store function descriptors
2399 * in the symbol table */
2400 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2401 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2403 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2404 ad, oc->fileName, nm ));
2409 /* And the decision is ... */
2413 oc->symbols[j] = nm;
2416 /* Ignore entirely. */
2418 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2422 IF_DEBUG(linker,belch( "skipping `%s'",
2423 strtab + stab[j].st_name ));
2426 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2427 (int)ELF_ST_BIND(stab[j].st_info),
2428 (int)ELF_ST_TYPE(stab[j].st_info),
2429 (int)stab[j].st_shndx,
2430 strtab + stab[j].st_name
2433 oc->symbols[j] = NULL;
2442 /* Do ELF relocations which lack an explicit addend. All x86-linux
2443 relocations appear to be of this form. */
2445 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2446 Elf_Shdr* shdr, int shnum,
2447 Elf_Sym* stab, char* strtab )
2452 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2453 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2454 int target_shndx = shdr[shnum].sh_info;
2455 int symtab_shndx = shdr[shnum].sh_link;
2457 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2458 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2459 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2460 target_shndx, symtab_shndx ));
2462 for (j = 0; j < nent; j++) {
2463 Elf_Addr offset = rtab[j].r_offset;
2464 Elf_Addr info = rtab[j].r_info;
2466 Elf_Addr P = ((Elf_Addr)targ) + offset;
2467 Elf_Word* pP = (Elf_Word*)P;
2472 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2473 j, (void*)offset, (void*)info ));
2475 IF_DEBUG(linker,belch( " ZERO" ));
2478 Elf_Sym sym = stab[ELF_R_SYM(info)];
2479 /* First see if it is a local symbol. */
2480 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2481 /* Yes, so we can get the address directly from the ELF symbol
2483 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2485 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2486 + stab[ELF_R_SYM(info)].st_value);
2489 /* No, so look up the name in our global table. */
2490 symbol = strtab + sym.st_name;
2491 (void*)S = lookupSymbol( symbol );
2494 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2497 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2500 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2501 (void*)P, (void*)S, (void*)A ));
2502 checkProddableBlock ( oc, pP );
2506 switch (ELF_R_TYPE(info)) {
2507 # ifdef i386_TARGET_ARCH
2508 case R_386_32: *pP = value; break;
2509 case R_386_PC32: *pP = value - P; break;
2512 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2513 oc->fileName, ELF_R_TYPE(info));
2521 /* Do ELF relocations for which explicit addends are supplied.
2522 sparc-solaris relocations appear to be of this form. */
2524 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2525 Elf_Shdr* shdr, int shnum,
2526 Elf_Sym* stab, char* strtab )
2531 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2532 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2533 int target_shndx = shdr[shnum].sh_info;
2534 int symtab_shndx = shdr[shnum].sh_link;
2536 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2537 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2538 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2539 target_shndx, symtab_shndx ));
2541 for (j = 0; j < nent; j++) {
2542 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2543 /* This #ifdef only serves to avoid unused-var warnings. */
2544 Elf_Addr offset = rtab[j].r_offset;
2545 Elf_Addr P = targ + offset;
2547 Elf_Addr info = rtab[j].r_info;
2548 Elf_Addr A = rtab[j].r_addend;
2551 # if defined(sparc_TARGET_ARCH)
2552 Elf_Word* pP = (Elf_Word*)P;
2554 # elif defined(ia64_TARGET_ARCH)
2555 Elf64_Xword *pP = (Elf64_Xword *)P;
2559 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2560 j, (void*)offset, (void*)info,
2563 IF_DEBUG(linker,belch( " ZERO" ));
2566 Elf_Sym sym = stab[ELF_R_SYM(info)];
2567 /* First see if it is a local symbol. */
2568 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2569 /* Yes, so we can get the address directly from the ELF symbol
2571 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2573 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2574 + stab[ELF_R_SYM(info)].st_value);
2575 #ifdef ELF_FUNCTION_DESC
2576 /* Make a function descriptor for this function */
2577 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2578 S = allocateFunctionDesc(S + A);
2583 /* No, so look up the name in our global table. */
2584 symbol = strtab + sym.st_name;
2585 (void*)S = lookupSymbol( symbol );
2587 #ifdef ELF_FUNCTION_DESC
2588 /* If a function, already a function descriptor - we would
2589 have to copy it to add an offset. */
2590 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC)
2595 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2598 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2601 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2602 (void*)P, (void*)S, (void*)A ));
2603 /* checkProddableBlock ( oc, (void*)P ); */
2607 switch (ELF_R_TYPE(info)) {
2608 # if defined(sparc_TARGET_ARCH)
2609 case R_SPARC_WDISP30:
2610 w1 = *pP & 0xC0000000;
2611 w2 = (Elf_Word)((value - P) >> 2);
2612 ASSERT((w2 & 0xC0000000) == 0);
2617 w1 = *pP & 0xFFC00000;
2618 w2 = (Elf_Word)(value >> 10);
2619 ASSERT((w2 & 0xFFC00000) == 0);
2625 w2 = (Elf_Word)(value & 0x3FF);
2626 ASSERT((w2 & ~0x3FF) == 0);
2630 /* According to the Sun documentation:
2632 This relocation type resembles R_SPARC_32, except it refers to an
2633 unaligned word. That is, the word to be relocated must be treated
2634 as four separate bytes with arbitrary alignment, not as a word
2635 aligned according to the architecture requirements.
2637 (JRS: which means that freeloading on the R_SPARC_32 case
2638 is probably wrong, but hey ...)
2642 w2 = (Elf_Word)value;
2645 # elif defined(ia64_TARGET_ARCH)
2646 case R_IA64_DIR64LSB:
2647 case R_IA64_FPTR64LSB:
2650 case R_IA64_SEGREL64LSB:
2651 addr = findElfSegment(ehdrC, value);
2654 case R_IA64_GPREL22:
2655 ia64_reloc_gprel22(P, value);
2657 case R_IA64_LTOFF22:
2658 case R_IA64_LTOFF_FPTR22:
2659 addr = allocateGOTEntry(value);
2660 ia64_reloc_gprel22(P, addr);
2662 case R_IA64_PCREL21B:
2663 ia64_reloc_pcrel21(P, S, oc);
2667 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2668 oc->fileName, ELF_R_TYPE(info));
2677 ocResolve_ELF ( ObjectCode* oc )
2681 Elf_Sym* stab = NULL;
2682 char* ehdrC = (char*)(oc->image);
2683 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2684 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2685 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2687 /* first find "the" symbol table */
2688 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2690 /* also go find the string table */
2691 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2693 if (stab == NULL || strtab == NULL) {
2694 belch("%s: can't find string or symbol table", oc->fileName);
2698 /* Process the relocation sections. */
2699 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2701 /* Skip sections called ".rel.stab". These appear to contain
2702 relocation entries that, when done, make the stabs debugging
2703 info point at the right places. We ain't interested in all
2705 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2708 if (shdr[shnum].sh_type == SHT_REL ) {
2709 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2710 shnum, stab, strtab );
2714 if (shdr[shnum].sh_type == SHT_RELA) {
2715 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2716 shnum, stab, strtab );
2721 /* Free the local symbol table; we won't need it again. */
2722 freeHashTable(oc->lochash, NULL);
2730 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2731 * at the front. The following utility functions pack and unpack instructions, and
2732 * take care of the most common relocations.
2735 #ifdef ia64_TARGET_ARCH
2738 ia64_extract_instruction(Elf64_Xword *target)
2741 int slot = (Elf_Addr)target & 3;
2742 (Elf_Addr)target &= ~3;
2750 return ((w1 >> 5) & 0x1ffffffffff);
2752 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2756 barf("ia64_extract_instruction: invalid slot %p", target);
2761 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2763 int slot = (Elf_Addr)target & 3;
2764 (Elf_Addr)target &= ~3;
2769 *target |= value << 5;
2772 *target |= value << 46;
2773 *(target+1) |= value >> 18;
2776 *(target+1) |= value << 23;
2782 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
2784 Elf64_Xword instruction;
2785 Elf64_Sxword rel_value;
2787 rel_value = value - gp_val;
2788 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
2789 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
2791 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2792 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
2793 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
2794 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
2795 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2796 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2800 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
2802 Elf64_Xword instruction;
2803 Elf64_Sxword rel_value;
2806 entry = allocatePLTEntry(value, oc);
2808 rel_value = (entry >> 4) - (target >> 4);
2809 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
2810 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
2812 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2813 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
2814 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2815 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2822 /* --------------------------------------------------------------------------
2824 * ------------------------------------------------------------------------*/
2826 #if defined(OBJFORMAT_MACHO)
2829 Initial support for MachO linking on Darwin/MacOS X on PowerPC chips
2830 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
2832 I hereby formally apologize for the hackish nature of this code.
2833 Things that need to be done:
2834 *) get common symbols and .bss sections to work properly.
2835 Haskell modules seem to work, but C modules can cause problems
2836 *) implement ocVerifyImage_MachO
2837 *) add more sanity checks. The current code just has to segfault if there's a
2841 static int ocVerifyImage_MachO(ObjectCode* oc)
2843 // FIXME: do some verifying here
2847 static void resolveImports(
2850 struct symtab_command *symLC,
2851 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
2852 unsigned long *indirectSyms,
2853 struct nlist *nlist)
2857 for(i=0;i*4<sect->size;i++)
2859 // according to otool, reserved1 contains the first index into the indirect symbol table
2860 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
2861 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
2864 if((symbol->n_type & N_TYPE) == N_UNDF
2865 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
2866 addr = (void*) (symbol->n_value);
2867 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
2870 addr = lookupSymbol(nm);
2873 fprintf(stderr, "not found: %s\n", nm);
2877 ((void**)(image + sect->offset))[i] = addr;
2881 static void relocateSection(char *image,
2882 struct symtab_command *symLC, struct nlist *nlist,
2883 struct section* sections, struct section *sect)
2885 struct relocation_info *relocs;
2888 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
2890 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
2894 relocs = (struct relocation_info*) (image + sect->reloff);
2898 if(relocs[i].r_address & R_SCATTERED)
2900 struct scattered_relocation_info *scat =
2901 (struct scattered_relocation_info*) &relocs[i];
2905 if(scat->r_length == 2 && scat->r_type == GENERIC_RELOC_VANILLA)
2907 unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
2909 *word = scat->r_value + sect->offset + ((long) image);
2913 continue; // FIXME: I hope it's OK to ignore all the others.
2917 struct relocation_info *reloc = &relocs[i];
2918 if(reloc->r_pcrel && !reloc->r_extern)
2922 && reloc->r_length == 2
2923 && reloc->r_type == GENERIC_RELOC_VANILLA)
2925 unsigned long* word = (unsigned long*) (image + sect->offset + reloc->r_address);
2927 if(!reloc->r_extern)
2930 sections[reloc->r_symbolnum-1].offset
2931 - sections[reloc->r_symbolnum-1].addr
2938 struct nlist *symbol = &nlist[reloc->r_symbolnum];
2939 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
2940 *word = (unsigned long) (lookupSymbol(nm));
2945 fprintf(stderr, "unknown reloc\n");
2952 static int ocGetNames_MachO(ObjectCode* oc)
2954 char *image = (char*) oc->image;
2955 struct mach_header *header = (struct mach_header*) image;
2956 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
2957 unsigned i,curSymbol;
2958 struct segment_command *segLC = NULL;
2959 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
2960 struct symtab_command *symLC = NULL;
2961 struct dysymtab_command *dsymLC = NULL;
2962 struct nlist *nlist;
2963 unsigned long commonSize = 0;
2964 char *commonStorage = NULL;
2965 unsigned long commonCounter;
2967 for(i=0;i<header->ncmds;i++)
2969 if(lc->cmd == LC_SEGMENT)
2970 segLC = (struct segment_command*) lc;
2971 else if(lc->cmd == LC_SYMTAB)
2972 symLC = (struct symtab_command*) lc;
2973 else if(lc->cmd == LC_DYSYMTAB)
2974 dsymLC = (struct dysymtab_command*) lc;
2975 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
2978 sections = (struct section*) (segLC+1);
2979 nlist = (struct nlist*) (image + symLC->symoff);
2981 for(i=0;i<segLC->nsects;i++)
2983 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
2984 la_ptrs = §ions[i];
2985 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
2986 nl_ptrs = §ions[i];
2988 // for now, only add __text and __const to the sections table
2989 else if(!strcmp(sections[i].sectname,"__text"))
2990 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
2991 (void*) (image + sections[i].offset),
2992 (void*) (image + sections[i].offset + sections[i].size));
2993 else if(!strcmp(sections[i].sectname,"__const"))
2994 addSection(oc, SECTIONKIND_RWDATA,
2995 (void*) (image + sections[i].offset),
2996 (void*) (image + sections[i].offset + sections[i].size));
2997 else if(!strcmp(sections[i].sectname,"__data"))
2998 addSection(oc, SECTIONKIND_RWDATA,
2999 (void*) (image + sections[i].offset),
3000 (void*) (image + sections[i].offset + sections[i].size));
3003 // count external symbols defined here
3005 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3007 if((nlist[i].n_type & N_TYPE) == N_SECT)
3010 for(i=0;i<symLC->nsyms;i++)
3012 if((nlist[i].n_type & N_TYPE) == N_UNDF
3013 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3015 commonSize += nlist[i].n_value;
3019 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3020 "ocGetNames_MachO(oc->symbols)");
3022 // insert symbols into hash table
3023 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3025 if((nlist[i].n_type & N_TYPE) == N_SECT)
3027 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3028 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3029 sections[nlist[i].n_sect-1].offset
3030 - sections[nlist[i].n_sect-1].addr
3031 + nlist[i].n_value);
3032 oc->symbols[curSymbol++] = nm;
3036 // insert local symbols into lochash
3037 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3039 if((nlist[i].n_type & N_TYPE) == N_SECT)
3041 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3042 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3043 sections[nlist[i].n_sect-1].offset
3044 - sections[nlist[i].n_sect-1].addr
3045 + nlist[i].n_value);
3050 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3051 commonCounter = (unsigned long)commonStorage;
3052 for(i=0;i<symLC->nsyms;i++)
3054 if((nlist[i].n_type & N_TYPE) == N_UNDF
3055 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3057 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3058 unsigned long sz = nlist[i].n_value;
3060 nlist[i].n_value = commonCounter;
3062 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3063 oc->symbols[curSymbol++] = nm;
3065 commonCounter += sz;
3071 static int ocResolve_MachO(ObjectCode* oc)
3073 char *image = (char*) oc->image;
3074 struct mach_header *header = (struct mach_header*) image;
3075 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3077 struct segment_command *segLC = NULL;
3078 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3079 struct symtab_command *symLC = NULL;
3080 struct dysymtab_command *dsymLC = NULL;
3081 struct nlist *nlist;
3082 unsigned long *indirectSyms;
3084 for(i=0;i<header->ncmds;i++)
3086 if(lc->cmd == LC_SEGMENT)
3087 segLC = (struct segment_command*) lc;
3088 else if(lc->cmd == LC_SYMTAB)
3089 symLC = (struct symtab_command*) lc;
3090 else if(lc->cmd == LC_DYSYMTAB)
3091 dsymLC = (struct dysymtab_command*) lc;
3092 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3095 sections = (struct section*) (segLC+1);
3096 nlist = (struct nlist*) (image + symLC->symoff);
3098 for(i=0;i<segLC->nsects;i++)
3100 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3101 la_ptrs = §ions[i];
3102 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3103 nl_ptrs = §ions[i];
3106 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3109 resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist);
3111 resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist);
3113 for(i=0;i<segLC->nsects;i++)
3115 relocateSection(image,symLC,nlist,sections,§ions[i]);
3118 /* Free the local symbol table; we won't need it again. */
3119 freeHashTable(oc->lochash, NULL);