1 /* -----------------------------------------------------------------------------
2 * $Id: Linker.c,v 1.100 2002/07/18 06:05:29 sof 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>
30 #ifdef HAVE_SYS_STAT_H
38 #if defined(cygwin32_TARGET_OS)
43 #ifdef HAVE_SYS_TIME_H
47 #include <sys/fcntl.h>
48 #include <sys/termios.h>
49 #include <sys/utime.h>
50 #include <sys/utsname.h>
54 #if defined(ia64_TARGET_ARCH)
60 #if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS)
61 # define OBJFORMAT_ELF
62 #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
63 # define OBJFORMAT_PEi386
66 #elif defined(darwin_TARGET_OS)
67 # define OBJFORMAT_MACHO
68 # include <mach-o/loader.h>
69 # include <mach-o/nlist.h>
70 # include <mach-o/reloc.h>
73 /* Hash table mapping symbol names to Symbol */
74 /*Str*/HashTable *symhash;
76 #if defined(OBJFORMAT_ELF)
77 static int ocVerifyImage_ELF ( ObjectCode* oc );
78 static int ocGetNames_ELF ( ObjectCode* oc );
79 static int ocResolve_ELF ( ObjectCode* oc );
80 #elif defined(OBJFORMAT_PEi386)
81 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
82 static int ocGetNames_PEi386 ( ObjectCode* oc );
83 static int ocResolve_PEi386 ( ObjectCode* oc );
84 #elif defined(OBJFORMAT_MACHO)
85 static int ocVerifyImage_MachO ( ObjectCode* oc );
86 static int ocGetNames_MachO ( ObjectCode* oc );
87 static int ocResolve_MachO ( ObjectCode* oc );
90 /* -----------------------------------------------------------------------------
91 * Built-in symbols from the RTS
94 typedef struct _RtsSymbolVal {
101 #define Maybe_ForeignObj SymX(mkForeignObjzh_fast)
103 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
104 SymX(makeStableNamezh_fast) \
105 SymX(finalizzeWeakzh_fast)
107 /* These are not available in GUM!!! -- HWL */
108 #define Maybe_ForeignObj
109 #define Maybe_Stable_Names
112 #if !defined (mingw32_TARGET_OS)
113 #define RTS_POSIX_ONLY_SYMBOLS \
114 SymX(stg_sig_install) \
118 #if defined (cygwin32_TARGET_OS)
119 #define RTS_MINGW_ONLY_SYMBOLS /**/
120 /* Don't have the ability to read import libs / archives, so
121 * we have to stupidly list a lot of what libcygwin.a
124 #define RTS_CYGWIN_ONLY_SYMBOLS \
206 #elif !defined(mingw32_TARGET_OS)
207 #define RTS_MINGW_ONLY_SYMBOLS /**/
208 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
209 #else /* defined(mingw32_TARGET_OS) */
210 #define RTS_POSIX_ONLY_SYMBOLS /**/
211 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
213 /* These are statically linked from the mingw libraries into the ghc
214 executable, so we have to employ this hack. */
215 #define RTS_MINGW_ONLY_SYMBOLS \
227 SymX(getservbyname) \
228 SymX(getservbyport) \
229 SymX(getprotobynumber) \
230 SymX(getprotobyname) \
231 SymX(gethostbyname) \
232 SymX(gethostbyaddr) \
267 Sym(_imp___timezone) \
283 # define MAIN_CAP_SYM SymX(MainCapability)
285 # define MAIN_CAP_SYM
288 #define RTS_SYMBOLS \
302 Sym(stg_enterStackTop) \
305 SymX(__stg_gc_enter_1) \
306 SymX(stg_gc_enter_2) \
307 SymX(stg_gc_enter_3) \
308 SymX(stg_gc_enter_4) \
309 SymX(stg_gc_enter_5) \
310 SymX(stg_gc_enter_6) \
311 SymX(stg_gc_enter_7) \
312 SymX(stg_gc_enter_8) \
314 SymX(stg_gc_noregs) \
316 SymX(stg_gc_unbx_r1) \
317 SymX(stg_gc_unpt_r1) \
318 SymX(stg_gc_ut_0_1) \
319 SymX(stg_gc_ut_1_0) \
321 SymX(stg_yield_to_interpreter) \
324 SymX(MallocFailHook) \
325 SymX(NoRunnableThreadsHook) \
327 SymX(OutOfHeapHook) \
328 SymX(PatErrorHdrHook) \
329 SymX(PostTraceHook) \
331 SymX(StackOverflowHook) \
332 SymX(__encodeDouble) \
333 SymX(__encodeFloat) \
336 SymX(__gmpz_cmp_si) \
337 SymX(__gmpz_cmp_ui) \
338 SymX(__gmpz_get_si) \
339 SymX(__gmpz_get_ui) \
340 SymX(__int_encodeDouble) \
341 SymX(__int_encodeFloat) \
342 SymX(andIntegerzh_fast) \
343 SymX(blockAsyncExceptionszh_fast) \
346 SymX(complementIntegerzh_fast) \
347 SymX(cmpIntegerzh_fast) \
348 SymX(cmpIntegerIntzh_fast) \
349 SymX(createAdjustor) \
350 SymX(decodeDoublezh_fast) \
351 SymX(decodeFloatzh_fast) \
354 SymX(deRefWeakzh_fast) \
355 SymX(deRefStablePtrzh_fast) \
356 SymX(divExactIntegerzh_fast) \
357 SymX(divModIntegerzh_fast) \
359 SymX(forkProcesszh_fast) \
360 SymX(freeHaskellFunctionPtr) \
361 SymX(freeStablePtr) \
362 SymX(gcdIntegerzh_fast) \
363 SymX(gcdIntegerIntzh_fast) \
364 SymX(gcdIntzh_fast) \
367 SymX(int2Integerzh_fast) \
368 SymX(integer2Intzh_fast) \
369 SymX(integer2Wordzh_fast) \
370 SymX(isDoubleDenormalized) \
371 SymX(isDoubleInfinite) \
373 SymX(isDoubleNegativeZero) \
374 SymX(isEmptyMVarzh_fast) \
375 SymX(isFloatDenormalized) \
376 SymX(isFloatInfinite) \
378 SymX(isFloatNegativeZero) \
379 SymX(killThreadzh_fast) \
380 SymX(makeStablePtrzh_fast) \
381 SymX(minusIntegerzh_fast) \
382 SymX(mkApUpd0zh_fast) \
383 SymX(myThreadIdzh_fast) \
384 SymX(labelThreadzh_fast) \
385 SymX(newArrayzh_fast) \
386 SymX(newBCOzh_fast) \
387 SymX(newByteArrayzh_fast) \
389 SymX(newMVarzh_fast) \
390 SymX(newMutVarzh_fast) \
391 SymX(newPinnedByteArrayzh_fast) \
392 SymX(orIntegerzh_fast) \
394 SymX(plusIntegerzh_fast) \
397 SymX(putMVarzh_fast) \
398 SymX(quotIntegerzh_fast) \
399 SymX(quotRemIntegerzh_fast) \
401 SymX(remIntegerzh_fast) \
402 SymX(resetNonBlockingFd) \
405 SymX(rts_checkSchedStatus) \
408 SymX(rts_evalLazyIO) \
413 SymX(rts_getDouble) \
418 SymX(rts_getStablePtr) \
419 SymX(rts_getThreadId) \
421 SymX(rts_getWord32) \
433 SymX(rts_mkStablePtr) \
442 SymX(shutdownHaskellAndExit) \
443 SymX(stable_ptr_table) \
444 SymX(stackOverflow) \
445 SymX(stg_CAF_BLACKHOLE_info) \
446 SymX(stg_CHARLIKE_closure) \
447 SymX(stg_EMPTY_MVAR_info) \
448 SymX(stg_IND_STATIC_info) \
449 SymX(stg_INTLIKE_closure) \
450 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
451 SymX(stg_WEAK_info) \
452 SymX(stg_ap_1_upd_info) \
453 SymX(stg_ap_2_upd_info) \
454 SymX(stg_ap_3_upd_info) \
455 SymX(stg_ap_4_upd_info) \
456 SymX(stg_ap_5_upd_info) \
457 SymX(stg_ap_6_upd_info) \
458 SymX(stg_ap_7_upd_info) \
459 SymX(stg_ap_8_upd_info) \
461 SymX(stg_sel_0_upd_info) \
462 SymX(stg_sel_10_upd_info) \
463 SymX(stg_sel_11_upd_info) \
464 SymX(stg_sel_12_upd_info) \
465 SymX(stg_sel_13_upd_info) \
466 SymX(stg_sel_14_upd_info) \
467 SymX(stg_sel_15_upd_info) \
468 SymX(stg_sel_1_upd_info) \
469 SymX(stg_sel_2_upd_info) \
470 SymX(stg_sel_3_upd_info) \
471 SymX(stg_sel_4_upd_info) \
472 SymX(stg_sel_5_upd_info) \
473 SymX(stg_sel_6_upd_info) \
474 SymX(stg_sel_7_upd_info) \
475 SymX(stg_sel_8_upd_info) \
476 SymX(stg_sel_9_upd_info) \
477 SymX(stg_seq_frame_info) \
478 SymX(stg_upd_frame_info) \
479 SymX(__stg_update_PAP) \
480 SymX(suspendThread) \
481 SymX(takeMVarzh_fast) \
482 SymX(timesIntegerzh_fast) \
483 SymX(tryPutMVarzh_fast) \
484 SymX(tryTakeMVarzh_fast) \
485 SymX(unblockAsyncExceptionszh_fast) \
486 SymX(unsafeThawArrayzh_fast) \
487 SymX(waitReadzh_fast) \
488 SymX(waitWritezh_fast) \
489 SymX(word2Integerzh_fast) \
490 SymX(xorIntegerzh_fast) \
493 #ifdef SUPPORT_LONG_LONGS
494 #define RTS_LONG_LONG_SYMS \
495 SymX(int64ToIntegerzh_fast) \
496 SymX(word64ToIntegerzh_fast)
498 #define RTS_LONG_LONG_SYMS /* nothing */
501 #ifdef ia64_TARGET_ARCH
502 /* force these symbols to be present */
503 #define RTS_EXTRA_SYMBOLS \
505 #elif defined(powerpc_TARGET_ARCH)
506 #define RTS_EXTRA_SYMBOLS \
516 #define RTS_EXTRA_SYMBOLS /* nothing */
519 /* entirely bogus claims about types of these symbols */
520 #define Sym(vvv) extern void (vvv);
521 #define SymX(vvv) /**/
525 RTS_POSIX_ONLY_SYMBOLS
526 RTS_MINGW_ONLY_SYMBOLS
527 RTS_CYGWIN_ONLY_SYMBOLS
531 #ifdef LEADING_UNDERSCORE
532 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
534 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
537 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
539 #define SymX(vvv) Sym(vvv)
541 static RtsSymbolVal rtsSyms[] = {
545 RTS_POSIX_ONLY_SYMBOLS
546 RTS_MINGW_ONLY_SYMBOLS
547 RTS_CYGWIN_ONLY_SYMBOLS
548 { 0, 0 } /* sentinel */
551 /* -----------------------------------------------------------------------------
552 * Insert symbols into hash tables, checking for duplicates.
554 static void ghciInsertStrHashTable ( char* obj_name,
560 if (lookupHashTable(table, (StgWord)key) == NULL)
562 insertStrHashTable(table, (StgWord)key, data);
567 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
569 "whilst processing object file\n"
571 "This could be caused by:\n"
572 " * Loading two different object files which export the same symbol\n"
573 " * Specifying the same object file twice on the GHCi command line\n"
574 " * An incorrect `package.conf' entry, causing some object to be\n"
576 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
585 /* -----------------------------------------------------------------------------
586 * initialize the object linker
588 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
589 static void *dl_prog_handle;
597 symhash = allocStrHashTable();
599 /* populate the symbol table with stuff from the RTS */
600 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
601 ghciInsertStrHashTable("(GHCi built-in symbols)",
602 symhash, sym->lbl, sym->addr);
604 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
605 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
609 /* -----------------------------------------------------------------------------
610 * Add a DLL from which symbols may be found. In the ELF case, just
611 * do RTLD_GLOBAL-style add, so no further messing around needs to
612 * happen in order that symbols in the loaded .so are findable --
613 * lookupSymbol() will subsequently see them by dlsym on the program's
614 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
616 * In the PEi386 case, open the DLLs and put handles to them in a
617 * linked list. When looking for a symbol, try all handles in the
621 #if defined(OBJFORMAT_PEi386)
622 /* A record for storing handles into DLLs. */
627 struct _OpenedDLL* next;
632 /* A list thereof. */
633 static OpenedDLL* opened_dlls = NULL;
639 addDLL( char *dll_name )
641 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
645 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
647 /* dlopen failed; return a ptr to the error msg. */
649 if (errmsg == NULL) errmsg = "addDLL: unknown error";
656 # elif defined(OBJFORMAT_PEi386)
658 /* Add this DLL to the list of DLLs in which to search for symbols.
659 The path argument is ignored. */
664 /* fprintf(stderr, "\naddDLL; path=`%s', dll_name = `%s'\n", path, dll_name); */
666 /* See if we've already got it, and ignore if so. */
667 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
668 if (0 == strcmp(o_dll->name, dll_name))
672 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
673 sprintf(buf, "%s.DLL", dll_name);
674 instance = LoadLibrary(buf);
675 if (instance == NULL) {
676 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
677 instance = LoadLibrary(buf);
678 if (instance == NULL) {
681 /* LoadLibrary failed; return a ptr to the error msg. */
682 return "addDLL: unknown error";
687 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
688 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
689 strcpy(o_dll->name, dll_name);
690 o_dll->instance = instance;
691 o_dll->next = opened_dlls;
696 barf("addDLL: not implemented on this platform");
700 /* -----------------------------------------------------------------------------
701 * lookup a symbol in the hash table
704 lookupSymbol( char *lbl )
707 ASSERT(symhash != NULL);
708 val = lookupStrHashTable(symhash, lbl);
711 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
712 return dlsym(dl_prog_handle, lbl);
713 # elif defined(OBJFORMAT_PEi386)
716 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
717 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
719 /* HACK: if the name has an initial underscore, try stripping
720 it off & look that up first. I've yet to verify whether there's
721 a Rule that governs whether an initial '_' *should always* be
722 stripped off when mapping from import lib name to the DLL name.
724 sym = GetProcAddress(o_dll->instance, (lbl+1));
726 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
730 sym = GetProcAddress(o_dll->instance, lbl);
732 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
747 __attribute((unused))
749 lookupLocalSymbol( ObjectCode* oc, char *lbl )
752 val = lookupStrHashTable(oc->lochash, lbl);
762 /* -----------------------------------------------------------------------------
763 * Debugging aid: look in GHCi's object symbol tables for symbols
764 * within DELTA bytes of the specified address, and show their names.
767 void ghci_enquire ( char* addr );
769 void ghci_enquire ( char* addr )
774 const int DELTA = 64;
776 for (oc = objects; oc; oc = oc->next) {
777 for (i = 0; i < oc->n_symbols; i++) {
778 sym = oc->symbols[i];
779 if (sym == NULL) continue;
780 /* fprintf(stderr, "enquire %p %p\n", sym, oc->lochash); */
782 if (oc->lochash != NULL)
783 a = lookupStrHashTable(oc->lochash, sym);
785 a = lookupStrHashTable(symhash, sym);
787 /* fprintf(stderr, "ghci_enquire: can't find %s\n", sym); */
789 else if (addr-DELTA <= a && a <= addr+DELTA) {
790 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
797 #ifdef ia64_TARGET_ARCH
798 static unsigned int PLTSize(void);
801 /* -----------------------------------------------------------------------------
802 * Load an obj (populate the global symbol table, but don't resolve yet)
804 * Returns: 1 if ok, 0 on error.
807 loadObj( char *path )
819 /* fprintf(stderr, "loadObj %s\n", path ); */
821 /* Check that we haven't already loaded this object. Don't give up
822 at this stage; ocGetNames_* will barf later. */
826 for (o = objects; o; o = o->next) {
827 if (0 == strcmp(o->fileName, path))
833 "GHCi runtime linker: warning: looks like you're trying to load the\n"
834 "same object file twice:\n"
836 "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
842 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
844 # if defined(OBJFORMAT_ELF)
845 oc->formatName = "ELF";
846 # elif defined(OBJFORMAT_PEi386)
847 oc->formatName = "PEi386";
848 # elif defined(OBJFORMAT_MACHO)
849 oc->formatName = "Mach-O";
852 barf("loadObj: not implemented on this platform");
856 if (r == -1) { return 0; }
858 /* sigh, strdup() isn't a POSIX function, so do it the long way */
859 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
860 strcpy(oc->fileName, path);
862 oc->fileSize = st.st_size;
865 oc->lochash = allocStrHashTable();
866 oc->proddables = NULL;
868 /* chain it onto the list of objects */
873 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
875 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
877 fd = open(path, O_RDONLY);
879 barf("loadObj: can't open `%s'", path);
881 pagesize = getpagesize();
883 #ifdef ia64_TARGET_ARCH
884 /* The PLT needs to be right before the object */
885 n = ROUND_UP(PLTSize(), pagesize);
886 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
887 if (oc->plt == MAP_FAILED)
888 barf("loadObj: can't allocate PLT");
891 map_addr = oc->plt + n;
894 n = ROUND_UP(oc->fileSize, pagesize);
895 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
896 if (oc->image == MAP_FAILED)
897 barf("loadObj: can't map `%s'", path);
901 #else /* !USE_MMAP */
903 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
905 /* load the image into memory */
906 f = fopen(path, "rb");
908 barf("loadObj: can't read `%s'", path);
910 n = fread ( oc->image, 1, oc->fileSize, f );
911 if (n != oc->fileSize)
912 barf("loadObj: error whilst reading `%s'", path);
916 #endif /* USE_MMAP */
918 /* verify the in-memory image */
919 # if defined(OBJFORMAT_ELF)
920 r = ocVerifyImage_ELF ( oc );
921 # elif defined(OBJFORMAT_PEi386)
922 r = ocVerifyImage_PEi386 ( oc );
923 # elif defined(OBJFORMAT_MACHO)
924 r = ocVerifyImage_MachO ( oc );
926 barf("loadObj: no verify method");
928 if (!r) { return r; }
930 /* build the symbol list for this image */
931 # if defined(OBJFORMAT_ELF)
932 r = ocGetNames_ELF ( oc );
933 # elif defined(OBJFORMAT_PEi386)
934 r = ocGetNames_PEi386 ( oc );
935 # elif defined(OBJFORMAT_MACHO)
936 r = ocGetNames_MachO ( oc );
938 barf("loadObj: no getNames method");
940 if (!r) { return r; }
942 /* loaded, but not resolved yet */
943 oc->status = OBJECT_LOADED;
948 /* -----------------------------------------------------------------------------
949 * resolve all the currently unlinked objects in memory
951 * Returns: 1 if ok, 0 on error.
959 for (oc = objects; oc; oc = oc->next) {
960 if (oc->status != OBJECT_RESOLVED) {
961 # if defined(OBJFORMAT_ELF)
962 r = ocResolve_ELF ( oc );
963 # elif defined(OBJFORMAT_PEi386)
964 r = ocResolve_PEi386 ( oc );
965 # elif defined(OBJFORMAT_MACHO)
966 r = ocResolve_MachO ( oc );
968 barf("resolveObjs: not implemented on this platform");
970 if (!r) { return r; }
971 oc->status = OBJECT_RESOLVED;
977 /* -----------------------------------------------------------------------------
978 * delete an object from the pool
981 unloadObj( char *path )
983 ObjectCode *oc, *prev;
985 ASSERT(symhash != NULL);
986 ASSERT(objects != NULL);
989 for (oc = objects; oc; prev = oc, oc = oc->next) {
990 if (!strcmp(oc->fileName,path)) {
992 /* Remove all the mappings for the symbols within this
997 for (i = 0; i < oc->n_symbols; i++) {
998 if (oc->symbols[i] != NULL) {
999 removeStrHashTable(symhash, oc->symbols[i], NULL);
1007 prev->next = oc->next;
1010 /* We're going to leave this in place, in case there are
1011 any pointers from the heap into it: */
1012 /* free(oc->image); */
1016 /* The local hash table should have been freed at the end
1017 of the ocResolve_ call on it. */
1018 ASSERT(oc->lochash == NULL);
1024 belch("unloadObj: can't find `%s' to unload", path);
1028 /* -----------------------------------------------------------------------------
1029 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1030 * which may be prodded during relocation, and abort if we try and write
1031 * outside any of these.
1033 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1036 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1037 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1041 pb->next = oc->proddables;
1042 oc->proddables = pb;
1045 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1048 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1049 char* s = (char*)(pb->start);
1050 char* e = s + pb->size - 1;
1051 char* a = (char*)addr;
1052 /* Assumes that the biggest fixup involves a 4-byte write. This
1053 probably needs to be changed to 8 (ie, +7) on 64-bit
1055 if (a >= s && (a+3) <= e) return;
1057 barf("checkProddableBlock: invalid fixup in runtime linker");
1060 /* -----------------------------------------------------------------------------
1061 * Section management.
1063 static void addSection ( ObjectCode* oc, SectionKind kind,
1064 void* start, void* end )
1066 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1070 s->next = oc->sections;
1073 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1074 start, ((char*)end)-1, end - start + 1, kind );
1080 /* --------------------------------------------------------------------------
1081 * PEi386 specifics (Win32 targets)
1082 * ------------------------------------------------------------------------*/
1084 /* The information for this linker comes from
1085 Microsoft Portable Executable
1086 and Common Object File Format Specification
1087 revision 5.1 January 1998
1088 which SimonM says comes from the MS Developer Network CDs.
1090 It can be found there (on older CDs), but can also be found
1093 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1095 (this is Rev 6.0 from February 1999).
1097 Things move, so if that fails, try searching for it via
1099 http://www.google.com/search?q=PE+COFF+specification
1101 The ultimate reference for the PE format is the Winnt.h
1102 header file that comes with the Platform SDKs; as always,
1103 implementations will drift wrt their documentation.
1105 A good background article on the PE format is Matt Pietrek's
1106 March 1994 article in Microsoft System Journal (MSJ)
1107 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1108 Win32 Portable Executable File Format." The info in there
1109 has recently been updated in a two part article in
1110 MSDN magazine, issues Feb and March 2002,
1111 "Inside Windows: An In-Depth Look into the Win32 Portable
1112 Executable File Format"
1114 John Levine's book "Linkers and Loaders" contains useful
1119 #if defined(OBJFORMAT_PEi386)
1123 typedef unsigned char UChar;
1124 typedef unsigned short UInt16;
1125 typedef unsigned int UInt32;
1132 UInt16 NumberOfSections;
1133 UInt32 TimeDateStamp;
1134 UInt32 PointerToSymbolTable;
1135 UInt32 NumberOfSymbols;
1136 UInt16 SizeOfOptionalHeader;
1137 UInt16 Characteristics;
1141 #define sizeof_COFF_header 20
1148 UInt32 VirtualAddress;
1149 UInt32 SizeOfRawData;
1150 UInt32 PointerToRawData;
1151 UInt32 PointerToRelocations;
1152 UInt32 PointerToLinenumbers;
1153 UInt16 NumberOfRelocations;
1154 UInt16 NumberOfLineNumbers;
1155 UInt32 Characteristics;
1159 #define sizeof_COFF_section 40
1166 UInt16 SectionNumber;
1169 UChar NumberOfAuxSymbols;
1173 #define sizeof_COFF_symbol 18
1178 UInt32 VirtualAddress;
1179 UInt32 SymbolTableIndex;
1184 #define sizeof_COFF_reloc 10
1187 /* From PE spec doc, section 3.3.2 */
1188 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1189 windows.h -- for the same purpose, but I want to know what I'm
1191 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1192 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1193 #define MYIMAGE_FILE_DLL 0x2000
1194 #define MYIMAGE_FILE_SYSTEM 0x1000
1195 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1196 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1197 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1199 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1200 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1201 #define MYIMAGE_SYM_CLASS_STATIC 3
1202 #define MYIMAGE_SYM_UNDEFINED 0
1204 /* From PE spec doc, section 4.1 */
1205 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1206 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1207 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1209 /* From PE spec doc, section 5.2.1 */
1210 #define MYIMAGE_REL_I386_DIR32 0x0006
1211 #define MYIMAGE_REL_I386_REL32 0x0014
1214 /* We use myindex to calculate array addresses, rather than
1215 simply doing the normal subscript thing. That's because
1216 some of the above structs have sizes which are not
1217 a whole number of words. GCC rounds their sizes up to a
1218 whole number of words, which means that the address calcs
1219 arising from using normal C indexing or pointer arithmetic
1220 are just plain wrong. Sigh.
1223 myindex ( int scale, void* base, int index )
1226 ((UChar*)base) + scale * index;
1231 printName ( UChar* name, UChar* strtab )
1233 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1234 UInt32 strtab_offset = * (UInt32*)(name+4);
1235 fprintf ( stderr, "%s", strtab + strtab_offset );
1238 for (i = 0; i < 8; i++) {
1239 if (name[i] == 0) break;
1240 fprintf ( stderr, "%c", name[i] );
1247 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1249 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1250 UInt32 strtab_offset = * (UInt32*)(name+4);
1251 strncpy ( dst, strtab+strtab_offset, dstSize );
1257 if (name[i] == 0) break;
1267 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1270 /* If the string is longer than 8 bytes, look in the
1271 string table for it -- this will be correctly zero terminated.
1273 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1274 UInt32 strtab_offset = * (UInt32*)(name+4);
1275 return ((UChar*)strtab) + strtab_offset;
1277 /* Otherwise, if shorter than 8 bytes, return the original,
1278 which by defn is correctly terminated.
1280 if (name[7]==0) return name;
1281 /* The annoying case: 8 bytes. Copy into a temporary
1282 (which is never freed ...)
1284 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1286 strncpy(newstr,name,8);
1292 /* Just compares the short names (first 8 chars) */
1293 static COFF_section *
1294 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1298 = (COFF_header*)(oc->image);
1299 COFF_section* sectab
1301 ((UChar*)(oc->image))
1302 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1304 for (i = 0; i < hdr->NumberOfSections; i++) {
1307 COFF_section* section_i
1309 myindex ( sizeof_COFF_section, sectab, i );
1310 n1 = (UChar*) &(section_i->Name);
1312 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1313 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1314 n1[6]==n2[6] && n1[7]==n2[7])
1323 zapTrailingAtSign ( UChar* sym )
1325 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1327 if (sym[0] == 0) return;
1329 while (sym[i] != 0) i++;
1332 while (j > 0 && my_isdigit(sym[j])) j--;
1333 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1339 ocVerifyImage_PEi386 ( ObjectCode* oc )
1344 COFF_section* sectab;
1345 COFF_symbol* symtab;
1347 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1348 hdr = (COFF_header*)(oc->image);
1349 sectab = (COFF_section*) (
1350 ((UChar*)(oc->image))
1351 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1353 symtab = (COFF_symbol*) (
1354 ((UChar*)(oc->image))
1355 + hdr->PointerToSymbolTable
1357 strtab = ((UChar*)symtab)
1358 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1360 if (hdr->Machine != 0x14c) {
1361 belch("Not x86 PEi386");
1364 if (hdr->SizeOfOptionalHeader != 0) {
1365 belch("PEi386 with nonempty optional header");
1368 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1369 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1370 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1371 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1372 belch("Not a PEi386 object file");
1375 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1376 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1377 belch("Invalid PEi386 word size or endiannness: %d",
1378 (int)(hdr->Characteristics));
1381 /* If the string table size is way crazy, this might indicate that
1382 there are more than 64k relocations, despite claims to the
1383 contrary. Hence this test. */
1384 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1386 if ( (*(UInt32*)strtab) > 600000 ) {
1387 /* Note that 600k has no special significance other than being
1388 big enough to handle the almost-2MB-sized lumps that
1389 constitute HSwin32*.o. */
1390 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1395 /* No further verification after this point; only debug printing. */
1397 IF_DEBUG(linker, i=1);
1398 if (i == 0) return 1;
1401 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1403 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1405 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1407 fprintf ( stderr, "\n" );
1409 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1411 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1413 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1415 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1417 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1419 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1421 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1423 /* Print the section table. */
1424 fprintf ( stderr, "\n" );
1425 for (i = 0; i < hdr->NumberOfSections; i++) {
1427 COFF_section* sectab_i
1429 myindex ( sizeof_COFF_section, sectab, i );
1436 printName ( sectab_i->Name, strtab );
1446 sectab_i->VirtualSize,
1447 sectab_i->VirtualAddress,
1448 sectab_i->SizeOfRawData,
1449 sectab_i->PointerToRawData,
1450 sectab_i->NumberOfRelocations,
1451 sectab_i->PointerToRelocations,
1452 sectab_i->PointerToRawData
1454 reltab = (COFF_reloc*) (
1455 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1458 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1459 /* If the relocation field (a short) has overflowed, the
1460 * real count can be found in the first reloc entry.
1462 * See Section 4.1 (last para) of the PE spec (rev6.0).
1464 COFF_reloc* rel = (COFF_reloc*)
1465 myindex ( sizeof_COFF_reloc, reltab, 0 );
1466 noRelocs = rel->VirtualAddress;
1469 noRelocs = sectab_i->NumberOfRelocations;
1473 for (; j < noRelocs; j++) {
1475 COFF_reloc* rel = (COFF_reloc*)
1476 myindex ( sizeof_COFF_reloc, reltab, j );
1478 " type 0x%-4x vaddr 0x%-8x name `",
1480 rel->VirtualAddress );
1481 sym = (COFF_symbol*)
1482 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1483 /* Hmm..mysterious looking offset - what's it for? SOF */
1484 printName ( sym->Name, strtab -10 );
1485 fprintf ( stderr, "'\n" );
1488 fprintf ( stderr, "\n" );
1490 fprintf ( stderr, "\n" );
1491 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1492 fprintf ( stderr, "---START of string table---\n");
1493 for (i = 4; i < *(Int32*)strtab; i++) {
1495 fprintf ( stderr, "\n"); else
1496 fprintf( stderr, "%c", strtab[i] );
1498 fprintf ( stderr, "--- END of string table---\n");
1500 fprintf ( stderr, "\n" );
1503 COFF_symbol* symtab_i;
1504 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1505 symtab_i = (COFF_symbol*)
1506 myindex ( sizeof_COFF_symbol, symtab, i );
1512 printName ( symtab_i->Name, strtab );
1521 (Int32)(symtab_i->SectionNumber),
1522 (UInt32)symtab_i->Type,
1523 (UInt32)symtab_i->StorageClass,
1524 (UInt32)symtab_i->NumberOfAuxSymbols
1526 i += symtab_i->NumberOfAuxSymbols;
1530 fprintf ( stderr, "\n" );
1536 ocGetNames_PEi386 ( ObjectCode* oc )
1539 COFF_section* sectab;
1540 COFF_symbol* symtab;
1547 hdr = (COFF_header*)(oc->image);
1548 sectab = (COFF_section*) (
1549 ((UChar*)(oc->image))
1550 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1552 symtab = (COFF_symbol*) (
1553 ((UChar*)(oc->image))
1554 + hdr->PointerToSymbolTable
1556 strtab = ((UChar*)(oc->image))
1557 + hdr->PointerToSymbolTable
1558 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1560 /* Allocate space for any (local, anonymous) .bss sections. */
1562 for (i = 0; i < hdr->NumberOfSections; i++) {
1564 COFF_section* sectab_i
1566 myindex ( sizeof_COFF_section, sectab, i );
1567 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1568 if (sectab_i->VirtualSize == 0) continue;
1569 /* This is a non-empty .bss section. Allocate zeroed space for
1570 it, and set its PointerToRawData field such that oc->image +
1571 PointerToRawData == addr_of_zeroed_space. */
1572 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1573 "ocGetNames_PEi386(anonymous bss)");
1574 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1575 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1576 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1579 /* Copy section information into the ObjectCode. */
1581 for (i = 0; i < hdr->NumberOfSections; i++) {
1587 = SECTIONKIND_OTHER;
1588 COFF_section* sectab_i
1590 myindex ( sizeof_COFF_section, sectab, i );
1591 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1594 /* I'm sure this is the Right Way to do it. However, the
1595 alternative of testing the sectab_i->Name field seems to
1596 work ok with Cygwin.
1598 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1599 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1600 kind = SECTIONKIND_CODE_OR_RODATA;
1603 if (0==strcmp(".text",sectab_i->Name) ||
1604 0==strcmp(".rodata",sectab_i->Name))
1605 kind = SECTIONKIND_CODE_OR_RODATA;
1606 if (0==strcmp(".data",sectab_i->Name) ||
1607 0==strcmp(".bss",sectab_i->Name))
1608 kind = SECTIONKIND_RWDATA;
1610 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1611 sz = sectab_i->SizeOfRawData;
1612 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1614 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1615 end = start + sz - 1;
1617 if (kind == SECTIONKIND_OTHER
1618 /* Ignore sections called which contain stabs debugging
1620 && 0 != strcmp(".stab", sectab_i->Name)
1621 && 0 != strcmp(".stabstr", sectab_i->Name)
1623 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1627 if (kind != SECTIONKIND_OTHER && end >= start) {
1628 addSection(oc, kind, start, end);
1629 addProddableBlock(oc, start, end - start + 1);
1633 /* Copy exported symbols into the ObjectCode. */
1635 oc->n_symbols = hdr->NumberOfSymbols;
1636 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1637 "ocGetNames_PEi386(oc->symbols)");
1638 /* Call me paranoid; I don't care. */
1639 for (i = 0; i < oc->n_symbols; i++)
1640 oc->symbols[i] = NULL;
1644 COFF_symbol* symtab_i;
1645 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1646 symtab_i = (COFF_symbol*)
1647 myindex ( sizeof_COFF_symbol, symtab, i );
1651 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1652 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1653 /* This symbol is global and defined, viz, exported */
1654 /* for MYIMAGE_SYMCLASS_EXTERNAL
1655 && !MYIMAGE_SYM_UNDEFINED,
1656 the address of the symbol is:
1657 address of relevant section + offset in section
1659 COFF_section* sectabent
1660 = (COFF_section*) myindex ( sizeof_COFF_section,
1662 symtab_i->SectionNumber-1 );
1663 addr = ((UChar*)(oc->image))
1664 + (sectabent->PointerToRawData
1668 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1669 && symtab_i->Value > 0) {
1670 /* This symbol isn't in any section at all, ie, global bss.
1671 Allocate zeroed space for it. */
1672 addr = stgCallocBytes(1, symtab_i->Value,
1673 "ocGetNames_PEi386(non-anonymous bss)");
1674 addSection(oc, SECTIONKIND_RWDATA, addr,
1675 ((UChar*)addr) + symtab_i->Value - 1);
1676 addProddableBlock(oc, addr, symtab_i->Value);
1677 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1680 if (addr != NULL ) {
1681 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1682 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1683 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1684 ASSERT(i >= 0 && i < oc->n_symbols);
1685 /* cstring_from_COFF_symbol_name always succeeds. */
1686 oc->symbols[i] = sname;
1687 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1691 "IGNORING symbol %d\n"
1695 printName ( symtab_i->Name, strtab );
1704 (Int32)(symtab_i->SectionNumber),
1705 (UInt32)symtab_i->Type,
1706 (UInt32)symtab_i->StorageClass,
1707 (UInt32)symtab_i->NumberOfAuxSymbols
1712 i += symtab_i->NumberOfAuxSymbols;
1721 ocResolve_PEi386 ( ObjectCode* oc )
1724 COFF_section* sectab;
1725 COFF_symbol* symtab;
1735 /* ToDo: should be variable-sized? But is at least safe in the
1736 sense of buffer-overrun-proof. */
1738 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1740 hdr = (COFF_header*)(oc->image);
1741 sectab = (COFF_section*) (
1742 ((UChar*)(oc->image))
1743 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1745 symtab = (COFF_symbol*) (
1746 ((UChar*)(oc->image))
1747 + hdr->PointerToSymbolTable
1749 strtab = ((UChar*)(oc->image))
1750 + hdr->PointerToSymbolTable
1751 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1753 for (i = 0; i < hdr->NumberOfSections; i++) {
1754 COFF_section* sectab_i
1756 myindex ( sizeof_COFF_section, sectab, i );
1759 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1762 /* Ignore sections called which contain stabs debugging
1764 if (0 == strcmp(".stab", sectab_i->Name)
1765 || 0 == strcmp(".stabstr", sectab_i->Name))
1768 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1769 /* If the relocation field (a short) has overflowed, the
1770 * real count can be found in the first reloc entry.
1772 * See Section 4.1 (last para) of the PE spec (rev6.0).
1774 COFF_reloc* rel = (COFF_reloc*)
1775 myindex ( sizeof_COFF_reloc, reltab, 0 );
1776 noRelocs = rel->VirtualAddress;
1777 fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
1780 noRelocs = sectab_i->NumberOfRelocations;
1785 for (; j < noRelocs; j++) {
1787 COFF_reloc* reltab_j
1789 myindex ( sizeof_COFF_reloc, reltab, j );
1791 /* the location to patch */
1793 ((UChar*)(oc->image))
1794 + (sectab_i->PointerToRawData
1795 + reltab_j->VirtualAddress
1796 - sectab_i->VirtualAddress )
1798 /* the existing contents of pP */
1800 /* the symbol to connect to */
1801 sym = (COFF_symbol*)
1802 myindex ( sizeof_COFF_symbol,
1803 symtab, reltab_j->SymbolTableIndex );
1806 "reloc sec %2d num %3d: type 0x%-4x "
1807 "vaddr 0x%-8x name `",
1809 (UInt32)reltab_j->Type,
1810 reltab_j->VirtualAddress );
1811 printName ( sym->Name, strtab );
1812 fprintf ( stderr, "'\n" ));
1814 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1815 COFF_section* section_sym
1816 = findPEi386SectionCalled ( oc, sym->Name );
1818 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1821 S = ((UInt32)(oc->image))
1822 + (section_sym->PointerToRawData
1825 copyName ( sym->Name, strtab, symbol, 1000-1 );
1826 (void*)S = lookupLocalSymbol( oc, symbol );
1827 if ((void*)S != NULL) goto foundit;
1828 (void*)S = lookupSymbol( symbol );
1829 if ((void*)S != NULL) goto foundit;
1830 zapTrailingAtSign ( symbol );
1831 (void*)S = lookupLocalSymbol( oc, symbol );
1832 if ((void*)S != NULL) goto foundit;
1833 (void*)S = lookupSymbol( symbol );
1834 if ((void*)S != NULL) goto foundit;
1835 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
1839 checkProddableBlock(oc, pP);
1840 switch (reltab_j->Type) {
1841 case MYIMAGE_REL_I386_DIR32:
1844 case MYIMAGE_REL_I386_REL32:
1845 /* Tricky. We have to insert a displacement at
1846 pP which, when added to the PC for the _next_
1847 insn, gives the address of the target (S).
1848 Problem is to know the address of the next insn
1849 when we only know pP. We assume that this
1850 literal field is always the last in the insn,
1851 so that the address of the next insn is pP+4
1852 -- hence the constant 4.
1853 Also I don't know if A should be added, but so
1854 far it has always been zero.
1857 *pP = S - ((UInt32)pP) - 4;
1860 belch("%s: unhandled PEi386 relocation type %d",
1861 oc->fileName, reltab_j->Type);
1868 IF_DEBUG(linker, belch("completed %s", oc->fileName));
1872 #endif /* defined(OBJFORMAT_PEi386) */
1875 /* --------------------------------------------------------------------------
1877 * ------------------------------------------------------------------------*/
1879 #if defined(OBJFORMAT_ELF)
1884 #if defined(sparc_TARGET_ARCH)
1885 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
1886 #elif defined(i386_TARGET_ARCH)
1887 # define ELF_TARGET_386 /* Used inside <elf.h> */
1888 #elif defined (ia64_TARGET_ARCH)
1889 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
1891 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
1892 # define ELF_NEED_GOT /* needs Global Offset Table */
1893 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
1899 * Define a set of types which can be used for both ELF32 and ELF64
1903 #define ELFCLASS ELFCLASS64
1904 #define Elf_Addr Elf64_Addr
1905 #define Elf_Word Elf64_Word
1906 #define Elf_Sword Elf64_Sword
1907 #define Elf_Ehdr Elf64_Ehdr
1908 #define Elf_Phdr Elf64_Phdr
1909 #define Elf_Shdr Elf64_Shdr
1910 #define Elf_Sym Elf64_Sym
1911 #define Elf_Rel Elf64_Rel
1912 #define Elf_Rela Elf64_Rela
1913 #define ELF_ST_TYPE ELF64_ST_TYPE
1914 #define ELF_ST_BIND ELF64_ST_BIND
1915 #define ELF_R_TYPE ELF64_R_TYPE
1916 #define ELF_R_SYM ELF64_R_SYM
1918 #define ELFCLASS ELFCLASS32
1919 #define Elf_Addr Elf32_Addr
1920 #define Elf_Word Elf32_Word
1921 #define Elf_Sword Elf32_Sword
1922 #define Elf_Ehdr Elf32_Ehdr
1923 #define Elf_Phdr Elf32_Phdr
1924 #define Elf_Shdr Elf32_Shdr
1925 #define Elf_Sym Elf32_Sym
1926 #define Elf_Rel Elf32_Rel
1927 #define Elf_Rela Elf32_Rela
1928 #define ELF_ST_TYPE ELF32_ST_TYPE
1929 #define ELF_ST_BIND ELF32_ST_BIND
1930 #define ELF_R_TYPE ELF32_R_TYPE
1931 #define ELF_R_SYM ELF32_R_SYM
1936 * Functions to allocate entries in dynamic sections. Currently we simply
1937 * preallocate a large number, and we don't check if a entry for the given
1938 * target already exists (a linear search is too slow). Ideally these
1939 * entries would be associated with symbols.
1942 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
1943 #define GOT_SIZE 0x20000
1944 #define FUNCTION_TABLE_SIZE 0x10000
1945 #define PLT_SIZE 0x08000
1948 static Elf_Addr got[GOT_SIZE];
1949 static unsigned int gotIndex;
1950 static Elf_Addr gp_val = (Elf_Addr)got;
1953 allocateGOTEntry(Elf_Addr target)
1957 if (gotIndex >= GOT_SIZE)
1958 barf("Global offset table overflow");
1960 entry = &got[gotIndex++];
1962 return (Elf_Addr)entry;
1966 #ifdef ELF_FUNCTION_DESC
1972 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
1973 static unsigned int functionTableIndex;
1976 allocateFunctionDesc(Elf_Addr target)
1978 FunctionDesc *entry;
1980 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
1981 barf("Function table overflow");
1983 entry = &functionTable[functionTableIndex++];
1985 entry->gp = (Elf_Addr)gp_val;
1986 return (Elf_Addr)entry;
1990 copyFunctionDesc(Elf_Addr target)
1992 FunctionDesc *olddesc = (FunctionDesc *)target;
1993 FunctionDesc *newdesc;
1995 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
1996 newdesc->gp = olddesc->gp;
1997 return (Elf_Addr)newdesc;
2002 #ifdef ia64_TARGET_ARCH
2003 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2004 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2006 static unsigned char plt_code[] =
2008 /* taken from binutils bfd/elfxx-ia64.c */
2009 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2010 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2011 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2012 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2013 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2014 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2017 /* If we can't get to the function descriptor via gp, take a local copy of it */
2018 #define PLT_RELOC(code, target) { \
2019 Elf64_Sxword rel_value = target - gp_val; \
2020 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2021 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2023 ia64_reloc_gprel22((Elf_Addr)code, target); \
2028 unsigned char code[sizeof(plt_code)];
2032 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2034 PLTEntry *plt = (PLTEntry *)oc->plt;
2037 if (oc->pltIndex >= PLT_SIZE)
2038 barf("Procedure table overflow");
2040 entry = &plt[oc->pltIndex++];
2041 memcpy(entry->code, plt_code, sizeof(entry->code));
2042 PLT_RELOC(entry->code, target);
2043 return (Elf_Addr)entry;
2049 return (PLT_SIZE * sizeof(PLTEntry));
2055 * Generic ELF functions
2059 findElfSection ( void* objImage, Elf_Word sh_type )
2061 char* ehdrC = (char*)objImage;
2062 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2063 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2064 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2068 for (i = 0; i < ehdr->e_shnum; i++) {
2069 if (shdr[i].sh_type == sh_type
2070 /* Ignore the section header's string table. */
2071 && i != ehdr->e_shstrndx
2072 /* Ignore string tables named .stabstr, as they contain
2074 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2076 ptr = ehdrC + shdr[i].sh_offset;
2083 #if defined(ia64_TARGET_ARCH)
2085 findElfSegment ( void* objImage, Elf_Addr vaddr )
2087 char* ehdrC = (char*)objImage;
2088 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2089 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2090 Elf_Addr segaddr = 0;
2093 for (i = 0; i < ehdr->e_phnum; i++) {
2094 segaddr = phdr[i].p_vaddr;
2095 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2103 ocVerifyImage_ELF ( ObjectCode* oc )
2107 int i, j, nent, nstrtab, nsymtabs;
2111 char* ehdrC = (char*)(oc->image);
2112 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2114 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2115 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2116 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2117 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2118 belch("%s: not an ELF object", oc->fileName);
2122 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2123 belch("%s: unsupported ELF format", oc->fileName);
2127 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2128 IF_DEBUG(linker,belch( "Is little-endian" ));
2130 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2131 IF_DEBUG(linker,belch( "Is big-endian" ));
2133 belch("%s: unknown endiannness", oc->fileName);
2137 if (ehdr->e_type != ET_REL) {
2138 belch("%s: not a relocatable object (.o) file", oc->fileName);
2141 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2143 IF_DEBUG(linker,belch( "Architecture is " ));
2144 switch (ehdr->e_machine) {
2145 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
2146 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2148 case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2150 default: IF_DEBUG(linker,belch( "unknown" ));
2151 belch("%s: unknown architecture", oc->fileName);
2155 IF_DEBUG(linker,belch(
2156 "\nSection header table: start %d, n_entries %d, ent_size %d",
2157 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2159 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2161 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2163 if (ehdr->e_shstrndx == SHN_UNDEF) {
2164 belch("%s: no section header string table", oc->fileName);
2167 IF_DEBUG(linker,belch( "Section header string table is section %d",
2169 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2172 for (i = 0; i < ehdr->e_shnum; i++) {
2173 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
2174 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
2175 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
2176 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
2177 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
2178 ehdrC + shdr[i].sh_offset,
2179 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2181 if (shdr[i].sh_type == SHT_REL) {
2182 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
2183 } else if (shdr[i].sh_type == SHT_RELA) {
2184 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2186 IF_DEBUG(linker,fprintf(stderr," "));
2189 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2193 IF_DEBUG(linker,belch( "\nString tables" ));
2196 for (i = 0; i < ehdr->e_shnum; i++) {
2197 if (shdr[i].sh_type == SHT_STRTAB
2198 /* Ignore the section header's string table. */
2199 && i != ehdr->e_shstrndx
2200 /* Ignore string tables named .stabstr, as they contain
2202 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2204 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
2205 strtab = ehdrC + shdr[i].sh_offset;
2210 belch("%s: no string tables, or too many", oc->fileName);
2215 IF_DEBUG(linker,belch( "\nSymbol tables" ));
2216 for (i = 0; i < ehdr->e_shnum; i++) {
2217 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2218 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2220 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2221 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2222 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
2224 shdr[i].sh_size % sizeof(Elf_Sym)
2226 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2227 belch("%s: non-integral number of symbol table entries", oc->fileName);
2230 for (j = 0; j < nent; j++) {
2231 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
2232 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
2233 (int)stab[j].st_shndx,
2234 (int)stab[j].st_size,
2235 (char*)stab[j].st_value ));
2237 IF_DEBUG(linker,fprintf(stderr, "type=" ));
2238 switch (ELF_ST_TYPE(stab[j].st_info)) {
2239 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2240 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2241 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
2242 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2243 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
2244 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2246 IF_DEBUG(linker,fprintf(stderr, " " ));
2248 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2249 switch (ELF_ST_BIND(stab[j].st_info)) {
2250 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2251 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2252 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
2253 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2255 IF_DEBUG(linker,fprintf(stderr, " " ));
2257 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2261 if (nsymtabs == 0) {
2262 belch("%s: didn't find any symbol tables", oc->fileName);
2271 ocGetNames_ELF ( ObjectCode* oc )
2276 char* ehdrC = (char*)(oc->image);
2277 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2278 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2279 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2281 ASSERT(symhash != NULL);
2284 belch("%s: no strtab", oc->fileName);
2289 for (i = 0; i < ehdr->e_shnum; i++) {
2290 /* Figure out what kind of section it is. Logic derived from
2291 Figure 1.14 ("Special Sections") of the ELF document
2292 ("Portable Formats Specification, Version 1.1"). */
2293 Elf_Shdr hdr = shdr[i];
2294 SectionKind kind = SECTIONKIND_OTHER;
2297 if (hdr.sh_type == SHT_PROGBITS
2298 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2299 /* .text-style section */
2300 kind = SECTIONKIND_CODE_OR_RODATA;
2303 if (hdr.sh_type == SHT_PROGBITS
2304 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2305 /* .data-style section */
2306 kind = SECTIONKIND_RWDATA;
2309 if (hdr.sh_type == SHT_PROGBITS
2310 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2311 /* .rodata-style section */
2312 kind = SECTIONKIND_CODE_OR_RODATA;
2315 if (hdr.sh_type == SHT_NOBITS
2316 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2317 /* .bss-style section */
2318 kind = SECTIONKIND_RWDATA;
2322 if (is_bss && shdr[i].sh_size > 0) {
2323 /* This is a non-empty .bss section. Allocate zeroed space for
2324 it, and set its .sh_offset field such that
2325 ehdrC + .sh_offset == addr_of_zeroed_space. */
2326 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2327 "ocGetNames_ELF(BSS)");
2328 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2330 fprintf(stderr, "BSS section at 0x%x, size %d\n",
2331 zspace, shdr[i].sh_size);
2335 /* fill in the section info */
2336 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2337 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2338 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2339 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2342 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2344 /* copy stuff into this module's object symbol table */
2345 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2346 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2348 oc->n_symbols = nent;
2349 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2350 "ocGetNames_ELF(oc->symbols)");
2352 for (j = 0; j < nent; j++) {
2354 char isLocal = FALSE; /* avoids uninit-var warning */
2356 char* nm = strtab + stab[j].st_name;
2357 int secno = stab[j].st_shndx;
2359 /* Figure out if we want to add it; if so, set ad to its
2360 address. Otherwise leave ad == NULL. */
2362 if (secno == SHN_COMMON) {
2364 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2366 fprintf(stderr, "COMMON symbol, size %d name %s\n",
2367 stab[j].st_size, nm);
2369 /* Pointless to do addProddableBlock() for this area,
2370 since the linker should never poke around in it. */
2373 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2374 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2376 /* and not an undefined symbol */
2377 && stab[j].st_shndx != SHN_UNDEF
2378 /* and not in a "special section" */
2379 && stab[j].st_shndx < SHN_LORESERVE
2381 /* and it's a not a section or string table or anything silly */
2382 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2383 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2384 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2387 /* Section 0 is the undefined section, hence > and not >=. */
2388 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2390 if (shdr[secno].sh_type == SHT_NOBITS) {
2391 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2392 stab[j].st_size, stab[j].st_value, nm);
2395 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2396 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2399 #ifdef ELF_FUNCTION_DESC
2400 /* dlsym() and the initialisation table both give us function
2401 * descriptors, so to be consistent we store function descriptors
2402 * in the symbol table */
2403 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2404 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2406 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2407 ad, oc->fileName, nm ));
2412 /* And the decision is ... */
2416 oc->symbols[j] = nm;
2419 /* Ignore entirely. */
2421 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2425 IF_DEBUG(linker,belch( "skipping `%s'",
2426 strtab + stab[j].st_name ));
2429 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2430 (int)ELF_ST_BIND(stab[j].st_info),
2431 (int)ELF_ST_TYPE(stab[j].st_info),
2432 (int)stab[j].st_shndx,
2433 strtab + stab[j].st_name
2436 oc->symbols[j] = NULL;
2445 /* Do ELF relocations which lack an explicit addend. All x86-linux
2446 relocations appear to be of this form. */
2448 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2449 Elf_Shdr* shdr, int shnum,
2450 Elf_Sym* stab, char* strtab )
2455 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2456 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2457 int target_shndx = shdr[shnum].sh_info;
2458 int symtab_shndx = shdr[shnum].sh_link;
2460 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2461 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2462 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2463 target_shndx, symtab_shndx ));
2465 for (j = 0; j < nent; j++) {
2466 Elf_Addr offset = rtab[j].r_offset;
2467 Elf_Addr info = rtab[j].r_info;
2469 Elf_Addr P = ((Elf_Addr)targ) + offset;
2470 Elf_Word* pP = (Elf_Word*)P;
2475 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2476 j, (void*)offset, (void*)info ));
2478 IF_DEBUG(linker,belch( " ZERO" ));
2481 Elf_Sym sym = stab[ELF_R_SYM(info)];
2482 /* First see if it is a local symbol. */
2483 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2484 /* Yes, so we can get the address directly from the ELF symbol
2486 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2488 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2489 + stab[ELF_R_SYM(info)].st_value);
2492 /* No, so look up the name in our global table. */
2493 symbol = strtab + sym.st_name;
2494 (void*)S = lookupSymbol( symbol );
2497 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2500 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2503 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2504 (void*)P, (void*)S, (void*)A ));
2505 checkProddableBlock ( oc, pP );
2509 switch (ELF_R_TYPE(info)) {
2510 # ifdef i386_TARGET_ARCH
2511 case R_386_32: *pP = value; break;
2512 case R_386_PC32: *pP = value - P; break;
2515 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2516 oc->fileName, ELF_R_TYPE(info));
2524 /* Do ELF relocations for which explicit addends are supplied.
2525 sparc-solaris relocations appear to be of this form. */
2527 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2528 Elf_Shdr* shdr, int shnum,
2529 Elf_Sym* stab, char* strtab )
2534 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2535 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2536 int target_shndx = shdr[shnum].sh_info;
2537 int symtab_shndx = shdr[shnum].sh_link;
2539 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2540 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2541 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2542 target_shndx, symtab_shndx ));
2544 for (j = 0; j < nent; j++) {
2545 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2546 /* This #ifdef only serves to avoid unused-var warnings. */
2547 Elf_Addr offset = rtab[j].r_offset;
2548 Elf_Addr P = targ + offset;
2550 Elf_Addr info = rtab[j].r_info;
2551 Elf_Addr A = rtab[j].r_addend;
2554 # if defined(sparc_TARGET_ARCH)
2555 Elf_Word* pP = (Elf_Word*)P;
2557 # elif defined(ia64_TARGET_ARCH)
2558 Elf64_Xword *pP = (Elf64_Xword *)P;
2562 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2563 j, (void*)offset, (void*)info,
2566 IF_DEBUG(linker,belch( " ZERO" ));
2569 Elf_Sym sym = stab[ELF_R_SYM(info)];
2570 /* First see if it is a local symbol. */
2571 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2572 /* Yes, so we can get the address directly from the ELF symbol
2574 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2576 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2577 + stab[ELF_R_SYM(info)].st_value);
2578 #ifdef ELF_FUNCTION_DESC
2579 /* Make a function descriptor for this function */
2580 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2581 S = allocateFunctionDesc(S + A);
2586 /* No, so look up the name in our global table. */
2587 symbol = strtab + sym.st_name;
2588 (void*)S = lookupSymbol( symbol );
2590 #ifdef ELF_FUNCTION_DESC
2591 /* If a function, already a function descriptor - we would
2592 have to copy it to add an offset. */
2593 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC)
2598 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2601 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2604 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2605 (void*)P, (void*)S, (void*)A ));
2606 /* checkProddableBlock ( oc, (void*)P ); */
2610 switch (ELF_R_TYPE(info)) {
2611 # if defined(sparc_TARGET_ARCH)
2612 case R_SPARC_WDISP30:
2613 w1 = *pP & 0xC0000000;
2614 w2 = (Elf_Word)((value - P) >> 2);
2615 ASSERT((w2 & 0xC0000000) == 0);
2620 w1 = *pP & 0xFFC00000;
2621 w2 = (Elf_Word)(value >> 10);
2622 ASSERT((w2 & 0xFFC00000) == 0);
2628 w2 = (Elf_Word)(value & 0x3FF);
2629 ASSERT((w2 & ~0x3FF) == 0);
2633 /* According to the Sun documentation:
2635 This relocation type resembles R_SPARC_32, except it refers to an
2636 unaligned word. That is, the word to be relocated must be treated
2637 as four separate bytes with arbitrary alignment, not as a word
2638 aligned according to the architecture requirements.
2640 (JRS: which means that freeloading on the R_SPARC_32 case
2641 is probably wrong, but hey ...)
2645 w2 = (Elf_Word)value;
2648 # elif defined(ia64_TARGET_ARCH)
2649 case R_IA64_DIR64LSB:
2650 case R_IA64_FPTR64LSB:
2653 case R_IA64_SEGREL64LSB:
2654 addr = findElfSegment(ehdrC, value);
2657 case R_IA64_GPREL22:
2658 ia64_reloc_gprel22(P, value);
2660 case R_IA64_LTOFF22:
2661 case R_IA64_LTOFF_FPTR22:
2662 addr = allocateGOTEntry(value);
2663 ia64_reloc_gprel22(P, addr);
2665 case R_IA64_PCREL21B:
2666 ia64_reloc_pcrel21(P, S, oc);
2670 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2671 oc->fileName, ELF_R_TYPE(info));
2680 ocResolve_ELF ( ObjectCode* oc )
2684 Elf_Sym* stab = NULL;
2685 char* ehdrC = (char*)(oc->image);
2686 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2687 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2688 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2690 /* first find "the" symbol table */
2691 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2693 /* also go find the string table */
2694 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2696 if (stab == NULL || strtab == NULL) {
2697 belch("%s: can't find string or symbol table", oc->fileName);
2701 /* Process the relocation sections. */
2702 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2704 /* Skip sections called ".rel.stab". These appear to contain
2705 relocation entries that, when done, make the stabs debugging
2706 info point at the right places. We ain't interested in all
2708 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2711 if (shdr[shnum].sh_type == SHT_REL ) {
2712 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2713 shnum, stab, strtab );
2717 if (shdr[shnum].sh_type == SHT_RELA) {
2718 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2719 shnum, stab, strtab );
2724 /* Free the local symbol table; we won't need it again. */
2725 freeHashTable(oc->lochash, NULL);
2733 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2734 * at the front. The following utility functions pack and unpack instructions, and
2735 * take care of the most common relocations.
2738 #ifdef ia64_TARGET_ARCH
2741 ia64_extract_instruction(Elf64_Xword *target)
2744 int slot = (Elf_Addr)target & 3;
2745 (Elf_Addr)target &= ~3;
2753 return ((w1 >> 5) & 0x1ffffffffff);
2755 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2759 barf("ia64_extract_instruction: invalid slot %p", target);
2764 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2766 int slot = (Elf_Addr)target & 3;
2767 (Elf_Addr)target &= ~3;
2772 *target |= value << 5;
2775 *target |= value << 46;
2776 *(target+1) |= value >> 18;
2779 *(target+1) |= value << 23;
2785 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
2787 Elf64_Xword instruction;
2788 Elf64_Sxword rel_value;
2790 rel_value = value - gp_val;
2791 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
2792 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
2794 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2795 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
2796 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
2797 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
2798 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2799 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2803 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
2805 Elf64_Xword instruction;
2806 Elf64_Sxword rel_value;
2809 entry = allocatePLTEntry(value, oc);
2811 rel_value = (entry >> 4) - (target >> 4);
2812 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
2813 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
2815 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2816 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
2817 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2818 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2825 /* --------------------------------------------------------------------------
2827 * ------------------------------------------------------------------------*/
2829 #if defined(OBJFORMAT_MACHO)
2832 Initial support for MachO linking on Darwin/MacOS X on PowerPC chips
2833 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
2835 I hereby formally apologize for the hackish nature of this code.
2836 Things that need to be done:
2837 *) get common symbols and .bss sections to work properly.
2838 Haskell modules seem to work, but C modules can cause problems
2839 *) implement ocVerifyImage_MachO
2840 *) add more sanity checks. The current code just has to segfault if there's a
2844 static int ocVerifyImage_MachO(ObjectCode* oc)
2846 // FIXME: do some verifying here
2850 static void resolveImports(
2853 struct symtab_command *symLC,
2854 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
2855 unsigned long *indirectSyms,
2856 struct nlist *nlist)
2860 for(i=0;i*4<sect->size;i++)
2862 // according to otool, reserved1 contains the first index into the indirect symbol table
2863 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
2864 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
2867 if((symbol->n_type & N_TYPE) == N_UNDF
2868 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
2869 addr = (void*) (symbol->n_value);
2870 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
2873 addr = lookupSymbol(nm);
2876 fprintf(stderr, "not found: %s\n", nm);
2880 ((void**)(image + sect->offset))[i] = addr;
2884 static void relocateSection(char *image,
2885 struct symtab_command *symLC, struct nlist *nlist,
2886 struct section* sections, struct section *sect)
2888 struct relocation_info *relocs;
2891 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
2893 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
2897 relocs = (struct relocation_info*) (image + sect->reloff);
2901 if(relocs[i].r_address & R_SCATTERED)
2903 struct scattered_relocation_info *scat =
2904 (struct scattered_relocation_info*) &relocs[i];
2908 if(scat->r_length == 2 && scat->r_type == GENERIC_RELOC_VANILLA)
2910 unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
2912 *word = scat->r_value + sect->offset + ((long) image);
2916 continue; // FIXME: I hope it's OK to ignore all the others.
2920 struct relocation_info *reloc = &relocs[i];
2921 if(reloc->r_pcrel && !reloc->r_extern)
2925 && reloc->r_length == 2
2926 && reloc->r_type == GENERIC_RELOC_VANILLA)
2928 unsigned long* word = (unsigned long*) (image + sect->offset + reloc->r_address);
2930 if(!reloc->r_extern)
2933 sections[reloc->r_symbolnum-1].offset
2934 - sections[reloc->r_symbolnum-1].addr
2941 struct nlist *symbol = &nlist[reloc->r_symbolnum];
2942 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
2943 *word = (unsigned long) (lookupSymbol(nm));
2948 fprintf(stderr, "unknown reloc\n");
2955 static int ocGetNames_MachO(ObjectCode* oc)
2957 char *image = (char*) oc->image;
2958 struct mach_header *header = (struct mach_header*) image;
2959 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
2960 unsigned i,curSymbol;
2961 struct segment_command *segLC = NULL;
2962 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
2963 struct symtab_command *symLC = NULL;
2964 struct dysymtab_command *dsymLC = NULL;
2965 struct nlist *nlist;
2966 unsigned long commonSize = 0;
2967 char *commonStorage = NULL;
2968 unsigned long commonCounter;
2970 for(i=0;i<header->ncmds;i++)
2972 if(lc->cmd == LC_SEGMENT)
2973 segLC = (struct segment_command*) lc;
2974 else if(lc->cmd == LC_SYMTAB)
2975 symLC = (struct symtab_command*) lc;
2976 else if(lc->cmd == LC_DYSYMTAB)
2977 dsymLC = (struct dysymtab_command*) lc;
2978 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
2981 sections = (struct section*) (segLC+1);
2982 nlist = (struct nlist*) (image + symLC->symoff);
2984 for(i=0;i<segLC->nsects;i++)
2986 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
2987 la_ptrs = §ions[i];
2988 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
2989 nl_ptrs = §ions[i];
2991 // for now, only add __text and __const to the sections table
2992 else if(!strcmp(sections[i].sectname,"__text"))
2993 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
2994 (void*) (image + sections[i].offset),
2995 (void*) (image + sections[i].offset + sections[i].size));
2996 else if(!strcmp(sections[i].sectname,"__const"))
2997 addSection(oc, SECTIONKIND_RWDATA,
2998 (void*) (image + sections[i].offset),
2999 (void*) (image + sections[i].offset + sections[i].size));
3000 else if(!strcmp(sections[i].sectname,"__data"))
3001 addSection(oc, SECTIONKIND_RWDATA,
3002 (void*) (image + sections[i].offset),
3003 (void*) (image + sections[i].offset + sections[i].size));
3006 // count external symbols defined here
3008 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3010 if((nlist[i].n_type & N_TYPE) == N_SECT)
3013 for(i=0;i<symLC->nsyms;i++)
3015 if((nlist[i].n_type & N_TYPE) == N_UNDF
3016 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3018 commonSize += nlist[i].n_value;
3022 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3023 "ocGetNames_MachO(oc->symbols)");
3025 // insert symbols into hash table
3026 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3028 if((nlist[i].n_type & N_TYPE) == N_SECT)
3030 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3031 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3032 sections[nlist[i].n_sect-1].offset
3033 - sections[nlist[i].n_sect-1].addr
3034 + nlist[i].n_value);
3035 oc->symbols[curSymbol++] = nm;
3039 // insert local symbols into lochash
3040 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3042 if((nlist[i].n_type & N_TYPE) == N_SECT)
3044 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3045 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3046 sections[nlist[i].n_sect-1].offset
3047 - sections[nlist[i].n_sect-1].addr
3048 + nlist[i].n_value);
3053 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3054 commonCounter = (unsigned long)commonStorage;
3055 for(i=0;i<symLC->nsyms;i++)
3057 if((nlist[i].n_type & N_TYPE) == N_UNDF
3058 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3060 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3061 unsigned long sz = nlist[i].n_value;
3063 nlist[i].n_value = commonCounter;
3065 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3066 oc->symbols[curSymbol++] = nm;
3068 commonCounter += sz;
3074 static int ocResolve_MachO(ObjectCode* oc)
3076 char *image = (char*) oc->image;
3077 struct mach_header *header = (struct mach_header*) image;
3078 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3080 struct segment_command *segLC = NULL;
3081 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3082 struct symtab_command *symLC = NULL;
3083 struct dysymtab_command *dsymLC = NULL;
3084 struct nlist *nlist;
3085 unsigned long *indirectSyms;
3087 for(i=0;i<header->ncmds;i++)
3089 if(lc->cmd == LC_SEGMENT)
3090 segLC = (struct segment_command*) lc;
3091 else if(lc->cmd == LC_SYMTAB)
3092 symLC = (struct symtab_command*) lc;
3093 else if(lc->cmd == LC_DYSYMTAB)
3094 dsymLC = (struct dysymtab_command*) lc;
3095 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3098 sections = (struct section*) (segLC+1);
3099 nlist = (struct nlist*) (image + symLC->symoff);
3101 for(i=0;i<segLC->nsects;i++)
3103 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3104 la_ptrs = §ions[i];
3105 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3106 nl_ptrs = §ions[i];
3109 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3112 resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist);
3114 resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist);
3116 for(i=0;i<segLC->nsects;i++)
3118 relocateSection(image,symLC,nlist,sections,§ions[i]);
3121 /* Free the local symbol table; we won't need it again. */
3122 freeHashTable(oc->lochash, NULL);